вот задачку недавно решил, так понравилась!
Задача.
В строке могут содержаться скобки '}',']',')','{','[','('. Прверить баланс скобок в строке. Считать, что он соблюдается, если: 1) для каждой открывающей скобки есть своя закрывающая и наоборот; 2) соблюдается вложеность; На выходе вывести 'false' или 'true' в зависимости от ответа.
пример:
var
s: String;
Stack: array[0..127] of Char;
sp, i: Integer;
procedure Push(c: Char);
begin
if sp < 0 then begin Writeln(False); Halt; end;
Stack[sp] := c;
Dec(sp);
end;
begin
Write('s>');
Readln(s);
Stack[127] := #0;
sp := 126;
for i := 1 to Length(s) do
case s[i] of
'(': Push(')');
'[': Push(']');
'{': Push('}');
')', ']', '}':
begin
Inc(sp);
if (s[i] <> Stack[sp]) then begin Writeln(False); Halt; end;
end;
end;
Writeln(sp = 126);
end.
type
PItem = ^TItem;
TItem = record
Next: PItem;
c: Char;
end;
var
s: String;
sp, p: PItem;
i: Integer;
procedure Push(c: Char);
begin
New(p);
p^.Next := sp;
p^.c := c;
sp := p;
end;
begin
Write('s>');
Readln(s);
sp := nil;
Push(#0);
for i := 1 to Length(s) do
case s[i] of
'(': Push(')');
'[': Push(']');
'{': Push('}');
')', ']', '}':
begin
if (s[i] <> sp^.c) then
begin
Writeln(False);
Halt;
end;
p := sp;
sp := sp^.Next;
Dispose(p);
end;
end;
Writeln(sp^.c = #0);
end.
type
TCheck = procedure;
var
s: String;
Stack: array[0..127] of Char;
sp, i: Integer;
procedure Push(c: Char);
begin
if sp < 0 then begin Writeln(False); Halt(0); end;
Stack[sp] := c;
Dec(sp);
end;
procedure Push1;
begin
Push(')');
end;
procedure Push2;
begin
Push(']');
end;
procedure Push3;
begin
Push('}');
end;
procedure Pop;
begin
Inc(sp);
if (s[i] <> Stack[sp]) then begin Writeln(False); Halt(0); end;
end;
procedure Null; begin end;
var
Check: array[Char] of Pointer;
begin
Write('s>');
Readln(s);
for i := 0 to 255 do
Check[Chr(i)] := @Null;
Check['('] := @Push1;
Check['['] := @Push2;
Check['{'] := @Push3;
Check['}'] := @Pop;
Check[')'] := @Pop;
Check[']'] := @Pop;
Stack[127] := #0;
sp := 126;
for i := 1 to Length(s) do
TCheck(Check[s[i]]);
Writeln(sp = 126);
end.
Вариант решения через работу со строкой:
Function CheckS(St : String) : Boolean;
Var i : Byte;
s : String;
Begin
CheckS:=False;
s:='';
For i:=1 to Length(St) do
Case St[i] of
'{','}','[',']','(',')' : s:=s+St[i];
End;
For i:=1 to Length(s) do
Begin
If Pos('{}',s)<>0 then Delete(s,Pos('{}',s),2);
If Pos('[]',s)<>0 then Delete(s,Pos('[]',s),2);
If Pos('()',s)<>0 then Delete(s,Pos('()',s),2);
End;
If s='' then CheckS:=True;
End;
Немного тяжеловато, но оригинально
У меня с рекурсией получилось так:
var
s: String;
i: Integer;
procedure Rec(c: Char);
begin
Inc(i);
while i <= Length(s) do
begin
case s[i] of
'(': Rec(')');
'[': Rec(']');
'{': Rec('}');
')', ']', '}':
if s[i] = c then
Exit
else
begin
Writeln(False);
Halt;
end;
end;
Inc(i);
end;
Writeln(c = #0);
Halt;
end;
begin
Write('s>');
Readln(s);
i := 0;
Rec(#0);
end.
Так, так, так.... ИМХО тут в половине решений, не проверяется на вложенность!
(вообще-то я код не читал, просто пробежал глазами, так что если я не прав, можете поспорить )
({} () <(){}> )
У меня тоже со вложенностью все в порядке.