Задача на проверку баланса скобок в строке, я решение знаю, предложи свое Опции

[Флогримм]

вот задачку недавно решил, так понравилась!

Задача.
В строке могут содержаться скобки '}',']',')','{','[','('. Прверить баланс скобок в строке. Считать, что он соблюдается, если: 1) для каждой открывающей скобки есть своя закрывающая и наоборот; 2) соблюдается вложеность; На выходе вывести 'false' или 'true' в зависимости от ответа.
пример:

Код

[(a+B)+c{b-a}]*{(a+c)(c-a)} - баланс скобок соблюден
[(a+B)+c{b-a] - баланс не соблюден: нет закрывающей скобки '}'
[(a+B)+c{b-a]} - баланс не соблюден: неправильная вложенность

какие предложения, господа?

Сообщение отредактировано: Pioneer - 27.10.2004 6:51

[xds]

вот задачку недавно решил, так понравилась!

Это круто! Положительные эмоции - один из важнейших инструментов разработки :D

1. Классика:

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.

2. С использованием динамической памяти:

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.

3.

БРЕДОВОЙ СИНДРОМ. Бред - ложное, возникшее на болезненной основе не соответствующее действительности, полностью овладевающее сознанием больного умозаключение (суждение), не поддающееся исправлению никакими доводами... Бред - несомненный признак психического заболевания...

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.

Сообщение отредактировано: Altair - 26.02.2006 15:21

[APAL]

Вариант решения через работу со строкой:

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;

P.S.: А вобще-то я хотел сделать через рекурсию... но что-то не пошло - надо немного подредактировать.
Но зато выше представленный вариант короче получился... :D

Сообщение отредактировано: Altair - 26.02.2006 15:22

[xds]

Немного тяжеловато, но оригинально

[xds]

У меня с рекурсией получилось так:

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.

По сути этот вариант аналогичен первому, только использует системный стек, причем тратит место на выравнивание параметра, адрес возврата и сохранение BP (по 7 дополнительных байт на каждую открывающуюся скобку). Лучше всего на ассемблере и без рекурсии

Сообщение отредактировано: Altair - 26.02.2006 15:27

[Altair]

Так, так, так.... ИМХО тут в половине решений, не проверяется на вложенность!
(вообще-то я код не читал, просто пробежал глазами, так что если я не прав, можете поспорить )

({} () <(){}> )

[xds]

Код

[(a+B)+c{b-a]} - баланс не соблюден: неправильная вложенность

- единственное указание на то, что в данном случае называется "вложенностью": несоответствие парности скобок. Если под этим термином подразумевалось что-либо другое, например, порядок вложения пар "{}", "[]" и "()", то это следовало указать в условии.

Кстати, твой пример помог обнаружить ошибку в третьем ("бредовом") решении - в процедуре Push3: вместо '}' стояло ']'. После исправлений все четыре моих решения для указанного тобой случая возвращают TRUE. 10x

Сообщение отредактировано: xds - 28.10.2004 3:31

[APAL]

У меня тоже со вложенностью все в порядке.