Search code examples
performancelogicpascalturbo-pascal

Check if bracket order is valid


what I am trying to do, is determine, whether brackets are in correct order. For example ([][[]]<<>>) is vallid, but ][]<<(>>) is not.

I got a working version, but it has terrible efficiency and when it gets 1000+ brackets, its just crazy slow. I was hoping someone might suggest some possible improvements or another way to do it.

Here is my code:

program Codex;

const
    C_FNAME = 'zavorky.in';

var TmpChar     : char;
    leftBrackets, rightBrackets : string;
    bracketPos         : integer;
    i,i2,i3         : integer;
    Arr, empty : array [0..10000] of String[2];
    tfIn    : Text;
    result : boolean;

begin
    leftBrackets := ' ( [ /* ($ <! << ';
    rightBrackets := ' ) ] */ $) !> >> ';
    i := 0;
    result := true;
    Assign(tfIn, C_FNAME);
    Reset(tfIn);

    { load data into array }
    while not eof(tfIn) do
    begin
        while not eoln(tfIn) do
        begin
            read(tfIn, TmpChar);
            if (TmpChar <> ' ') then begin
                if (TmpChar <> '') then begin
                    Arr[i] := Arr[i] + TmpChar;
                    end
                end
            else
                begin                                       
                    i := i + 1;
                end
        end;

        i2 := -1;
        while (i2 < 10000) do begin     
            i2 := i2 + 1;
            {if (i2 = 0) then
                writeln('STARTED LOOP!');}
            if (Arr[i2] <> '') then begin
                bracketPos := Pos(' ' + Arr[i2] + ' ',rightBrackets);
                if (bracketPos > 0) then begin
                    if (i2 > 0) then begin
                        if(bracketPos = Pos(' ' + Arr[i2-1] + ' ',leftBrackets)) then begin
                            {write(Arr[i2-1] + ' and ' + Arr[i2] + ' - MATCH ');}

                            Arr[i2-1] := '';
                            Arr[i2] := '';
                            { reindex our array }
                            for i3 := i2 to 10000 - 2 do begin
                                Arr[i3 - 1] := Arr[i3+1];
                                end;

                            i2 := -1;
                            end;
                        end;                    
                    end;
                end;
            end;

        {writeln('RESULT: ');}
        For i2:=0 to 10 do begin
            if (Arr[i2] <> '') then begin
                {write(Arr[i2]);}
                result := false;
            end;
            {else
            write('M');}
        end;

        if (result = true) then begin
            writeln('true');
            end
        else begin
            writeln('false');
        end;

        result := true;

        { move to next row in file }
        Arr := empty;
        i := 0;
        readln(tfIn);
    end;

    Close(tfIn);

    readln;
end.

The input data in the file zavorky.in look for example like this:

<< $) >> << >> ($ $) [ ] <! ( ) !>
( ) /* << /* [ ] */ >> <! !> */

I determine for each row whether it is valid or not. Max number of brackets on a row is 10000.


Solution

  • You read chars from your file. File read in byte-by-byte mode is very slow. You need to optimize the way to read the strings (buffers) instead or load the file in memory first.

    Hereunder I propose the other way to process the fetched string.

    First I declare the consts that will state the brackets that you might have:

    const
      OBr: array [1 .. 5{6}]   of string = ('(', '[', '/*', '<!', '<<'{, 'begin'});
      CBr: array [11 .. 15{16}] of string = (')', ']', '*/', '!>', '>>'{, 'end'});
    

    I decided to do this as now you are not limited to the length of the brackets expression and/or number of brackets' types. Every closing and corresponding opening bracket has index difference equal to 10.

    And here is the code for the function:

    function ExpressionIsValid(const InputStr: string): boolean;
    var
      BracketsArray: array of byte;
      i, Offset, CurrPos: word;
      Stack: array of byte;
    begin
      result := false;
      Setlength(BracketsArray, Length(InputStr) + 1);
      for i := 0 to High(BracketsArray) do
        BracketsArray[i] := 0; // initialize the pos array
    
      for i := Low(OBr) to High(OBr) do
      begin
        Offset := 1;
        Repeat
          CurrPos := Pos(OBr[i], InputStr, Offset);
          if CurrPos > 0 then
          begin
            BracketsArray[CurrPos] := i;
            Offset := CurrPos + 1;
          end;
        Until CurrPos = 0;
      end; // insert the positions of the opening brackets
    
      for i := Low(CBr) to High(CBr) do
      begin
        Offset := 1;
        Repeat
          CurrPos := Pos(CBr[i], InputStr, Offset);
          if CurrPos > 0 then
          begin
            BracketsArray[CurrPos] := i;
            Offset := CurrPos + 1;
          end;
        Until CurrPos = 0;
      end; // insert the positions of the closing brackets
    
      Setlength(Stack, 0); // initialize the stack to push/pop the last bracket
      for i := 0 to High(BracketsArray) do
        case BracketsArray[i] of
          Low(OBr) .. High(OBr):
            begin
              Setlength(Stack, Length(Stack) + 1);
              Stack[High(Stack)] := BracketsArray[i];
            end; // there is an opening bracket
          Low(CBr) .. High(CBr):
            begin
              if Length(Stack) = 0 then
                exit(false); // we can not begin an expression with Closing bracket
              if Stack[High(Stack)] <> BracketsArray[i] - 10 then
                exit(false) // here we do check if the previous bracket suits the
                            // closing bracket
              else
                Setlength(Stack, Length(Stack) - 1); // remove the last opening
                                                     // bracket from stack
            end;
        end;
      if Length(Stack) = 0 then
        result := true;
    end;
    

    Perhaps, we do an extra work by creating a byte array, but it seems that this method is i) more easy to understand and ii) is flexible as we can change the length of brackets expressions for example use and check begin/end brackets etc.

    Appended

    As soon as I see that the major problem is in organizing block reading of file I give here an idea of how to do it:

    procedure BlckRead;
    var
      f: file;
      pc, pline: { PChar } PAnsiChar;
      Ch: { Char } AnsiChar;
      LngthLine, LngthPc: word;
    begin
      AssignFile(f, 'b:\br.txt');   //open the file
      Reset(f, 1);
      GetMem(pc, FileSize(f) + 1);  //initialize memory blocks
      inc(pc, FileSize(f)); //null terminate the string
      pc^ := #0;
      dec(pc, FileSize(f)); //return the pointer to the beginning of the block
    
      GetMem(pline, FileSize(f)); //not optimal, but here is just an idea.
      pline^ := #0;//set termination => length=0
      BlockRead(f, pc^, FileSize(f)); // read the whole file
                                      //you can optimize that if you wish,
                                      //add exception catchers etc.
      LngthLine := 0; // current pointers' offsets
      LngthPc := 0;
      repeat
        repeat
          Ch := pc^;
          if (Ch <> #$D) and (Ch <> #$A) and (Ch <> #$0) then
          begin // if the symbol is not string-terminating then we append it to pc
            pline^ := Ch;
            inc(pline);
            inc(pc);
            inc(LngthPc);
            inc(LngthLine);
          end
          else
          begin //otherwise we terminate pc with Chr($0);
            pline^ := #0;
            inc(LngthPc);
            if LngthPc < FileSize(f) then
              inc(pc);
          end;
        until (Ch = Chr($D)) or (Ch = Chr($A)) or (Ch = Chr($0)) or
          (LngthPc = FileSize(f));
    
        dec(pline, LngthLine);
        if LngthLine > 0 then //or do other outputs
          Showmessage(pline + #13#10 + Booltostr(ExpressionIsValid(pline), true));
    
        pline^ := #0; //actually can be skipped but you know your file structure better
        LngthLine := 0;
      until LngthPc = FileSize(f);
    
      FreeMem(pline);                          //free the blocks and close the file
      dec(pc, FileSize(f) - 1);
      FreeMem(pc);
      CloseFile(f);
    end;