{
  ZIPCode.Pas - ZIP code recognizer program

  This program takes a file with a binary image (coded with 1's and 0's)
  of a 10-digit ZIP code and tries to recognize the individual digits.
}

program ZIPCodeReader(Input, Output);

{ Let's first define some useful constants }
const
  DEBUG = FALSE;      { Set to TRUE for additional info to be printed out }
  NumDigits = 10;     { Number of digits in the input image }
  MaxX = 250;         { Maximum dimensions of the input image }
  MaxY = 50;

{  Let use now define a type for a digit so we can manipulate it
   more easily later on in the program }
type
  DigitType = record

{ Inside our big image we will have a bounding box for every digit }
                 x0, y0 : integer;  { Lower left hand corner of the box }
                 x1, y1 : integer;  { Upper right hand corner of the box }

{ Now, let us define some properties for our digit.  You can add more
  properies here, as you expand on our code }
                 EulerNumber : integer; { one minus the number of "holes" }
                 Column : boolean;  { TRUE if this digit has a vertical line }

{ We also need to define our Guess -- what we think this digit is.
  However, instead of defining it as a single integer, we will use the
  concept of Likelihood Distribution which is explained in the problem
  description }
                 Guess : array[0..9] of integer;
  end;

{ Now for some global variables }
var
  image : array[1..MaxX, 1..MaxY] of integer;  { holds a 10-character image }
  SizeX, SizeY : integer; { the actual size of the image }

  Digits : array[1..NumDigits] of DigitType;  { Array of digits }
  i : integer;


{**********************************************************
 ***                INPUT and SETUP block               ***
 **********************************************************}

{ Go thru every Digit record and set the values to 0 }

procedure InitializeDigits;
var
  i, j : integer;
begin
  for i := 1 to NumDigits do
    with digits[i] do
    begin
      x0 := 0;      y0 := 0;
      x1 := 0;      y1 := 0;
      EulerNumber := 0;
      Column := FALSE;
      for j := 0 to 9 do
        Guess[j] := 0;
    end;
end;


{ Read the image file from the disk and store it into the image array.
  Also, set the SizeX and SizeY to the actual size of the image }

procedure ReadImageFile;
var
  InFile : text;    { Define a text file to be read }
  FileName : string;
  x, y, n : integer;
  ch : char;
begin
  { Get the file name and try to open the file }
  write('Enter the name of the image file: ');
  readln(FileName);

  {$I-}   { Turn off I/O error checking }
  assign(InFile, FileName);
  reset(InFile);
  {$I+}   { Turn it back on }

  { Check if the file was opened succesfully }
  if (IOResult <> 0) then
  begin
    writeln('File ', FileName, ' not found.');
    halt;   { Quit the program }
  end;

  { Read the size of the image in the file which is recorded on the
    first two lines of the file and check if it can be accepted }
  readln(InFile, SizeX);
  readln(InFile, SizeY);
  if (SizeX > MaxX) or (SizeY > MaxY) then
  begin
    writeln('The image is too big to be processed.');
    halt;  

  end;

  { Now read the rest of the file and store it into the image array }
  for x := 1 to SizeX do
  begin
    for y := 1 to SizeY do
    begin
      read(InFile,ch);    { read a char from the file }
      n := ord(ch) - 48;  { convert ASCII char into digit }
      image[x,y] := n;    { store the digit into the array }
    end; { y }
    readln(InFile);       { Go to the next line in the file }
  end; { x }
  close(InFile);
end;


{ In order for the Euler Number procedure to work reliably we need to
  improve the image first.  More specifically, look for patterns:

            1 0                  0 1
            0 1        and       1 0

  and set them to all 1's.  This eliminates any diagonal edges
  and makes the procedure for finding holes much easier. }

function ImproveImage : boolean;
var
  x, y : integer;
  changed : boolean;    { See if we needed to make changes on this pass }
begin
  changed := FALSE;

  for x := 1 to SizeX - 1 do
  begin
    for y := 1 to SizeY - 1 do
    begin
      if (image[x,y] = 1) and (image[x+1,y+1] = 1) and
         (image[x+1,y] = 0) and (image[x,y+1] = 0) then
      begin
        image[x+1,y] := 1;
        image[x,y+1] := 1;
        changed := TRUE;
      end;
      if (image[x,y] = 0) and (image[x+1,y+1] = 0) and
         (image[x+1,y] = 1) and (image[x,y+1] = 1) then
      begin
        image[x,y] := 1;
        image[x+1,y+1] := 1;
        changed := TRUE;
      end;
    end; { y }
  end;  { x }
  ImproveImage := changed;
end;


{ This procedure separates the digits into bounding boxes so we can
  work on each digit separately. The bounding boxes are garanteed to
  have all 0's on the borders (just so it's easier to process later) }

procedure SeparateDigits;
var
  x,y,result,CurrentDigit : integer;
  inside : boolean;


{ Find the y0 and y1 of the digit after we know its x0 and x1 }

   procedure FindHeight(var d : DigitType);
   var
     x,y,result : integer;
   begin
     { Look for digit's buttom edge }
     y := 0;
     repeat
       y := y + 1;
       result := 0;
       for x := d.x0 to d.x1 do    { add up the values in the row }
         result := result + image[x,y];
     until (result > 0);
     d.y0 := y - 1;

     { Look for digit's top edge }
     y := SizeY+1;
     repeat
       y := y - 1;
       result := 0;
       for x := d.x0 to d.x1 do    { add up the values in the row }
         result := result + image[x,y];
     until (result > 0);
     d.y1 := y + 1;
   end;  { FindHeight }


begin  { Separate Digits }
  CurrentDigit := 0;
  inside := FALSE;
  for x := 1 to SizeX do   { for every column in the image }
  begin
    result := 0;
    for y := 1 to SizeY do   { add up the values in the column }
      result := result + image[x,y];

    { If the column is not empty and we are not already inside of
      a digit, start a new digit }
    if (result > 0) and (not inside) then
    begin
      CurrentDigit := CurrentDigit + 1;
      Digits[CurrentDigit].x0 := x - 1;
      inside := TRUE;
    end;

    { if the column is empty and we are inside a digit, end the digit }
    if (result = 0) and inside then
    begin
      Digits[CurrentDigit].x1 := x;
      inside := FALSE;
      FindHeight(Digits[CurrentDigit]); { find the y0 and y1 of the digit }
    end;
  end;
end;


{***********************************************************
 ***               COMPUTING PROPERTIES                  ***
 ***********************************************************}


{ This function returns the Euler number for the digit d.  The Euler
  number for any binary image is defined as the number of distinct
  objects in the image minus the number of holes.  So, for example,
  the letter 'B' will have Euler number of -1 since it has a single
  object and two holes.  Computing the Euler number is surprisingly
  simple!  The image is searched for the following patterns:
           0 0           0 1
           0 1     and   1 1
  and the Euler number becomes the number of times the first pattern
  is encountered minus the number of times the second one is encountered.
  However, for this procedure to work, we must make sure that the
  image doesn't have diagonal edges in it (see procedure ImproveImage).
}

function FindEulerNumber(d : DigitType) : integer;
var
  x,y,result : integer;
begin
  result := 0;

  for x := d.x0 to d.x1-1 do
  begin
    for y := d.y1 downto d.y0+1 do
    begin
      if (image[x,y] = 0) and (image[x+1,y-1] = 1) then
      begin
        if (image[x+1,y] = 0) and (image[x,y-1] = 0) then
          result := result + 1
        else if (image[x+1,y] = 1) and (image[x,y-1] = 1) then
          result := result - 1;
      end;
    end; {y}
  end; {x}

  FindEulerNumber := result;
end;


{ Return TRUE if a vertical line or "filled column" is found in the digit.
  A filled column is defined not merely as having almost all 1's, but also
  having almost all 0's in the columns surrounding it.  Also, we have to 
  keep in mind that a "filled column" doesn't have to be a simple column 
  of values, but can span several columns. }

function FindColumn(d : DigitType) : boolean;
var
  x, y, sum, state, status : integer;
  result : real;
  FoundIt : boolean;
begin
  { Setup a histogram that holds the number of 1's in each column }
  for x := d.x0 to d.x1 do   { for every column }
  begin
    sum := 0;
    for y := d.y0 to d.y1 do    { add up all values in the column }
      sum := sum + image[x,y];

    result := sum / (d.y1 - d.y0 - 1);   { filled cells divided by total
					   number of cells in the column }

    { We now assign a "status value" for every column.  Since we know
      that the y0 row of the image is always going to be 0, we can use
      it to store our status values.
      If a column is less than 35% filled, we consider it to be empty
      and assign it a status of 0.  If it's more than 85% filled we
      consider it to be filled and assign it a status of 1.  Otherwise,
      we treat the column as half-filled and assign it a status of 2. }
    if (result < 0.35)
      then image[x,d.y0] := 0
      else if (result > 0.85)
        then image[x,d.y0] := 1
        else image[x,d.y0] := 2;
  end;

  { Find "filled columns" in our digit.  We use the state variable to
    tell us which state of processing we are currently in. The states are:
      -1 : Looking for a brand-new filled column
       0 : Found an empty column -- waiting for what comes next
       1 : Found a filled column -- but need to check if there is an
           empty column after it.  }
  state := -1;
  FoundIt := FALSE;
  for x := d.x0 to d.x1 do
  begin
    status := image[x,d.y0];   { Get the status of the column }
    image[x,d.y0] := 0;        { Restore the 0 in the image array }
    case state of
      -1 : if (status = 0)     { if column empty, switch to 0 }
             then state := 0;
       0 : if (status = 1)     {if column filled, switch to 1 }
             then state := 1
             else if (status = 2) {if half-filled, go back to -1}
               then state := -1;
       1 : if (status = 0)        { if column empty, you FOUND IT! }
             then FoundIt := TRUE
             else if (status = 2)  { but if it's half-filled, back to }
               then state := -1;   { square one. }
    end; {case}
  end; {x}

  FindColumn := FoundIt;
end;

{ This function counts the maximum number of "layers" in a digit.
  That is, if traversing an image from the buttom up, what's the max
  number of times you cross a black region.  For example, for the
  letter "G" CountLayer will return 3, and for the symbol "+" CountLayer
  will return 1. }

function CountLayers(d :  DigitType) : integer;
var
   x, MaxLayers, Layers : integer;


  { Counts the number of "layers" (regions of 1's) in the column x }
  function ColumnLayerCount(x : integer) : integer;
  begin
    { Not written }
  end;
   
begin
   MaxLayers := 0;

   { Go through every column counting layers and finding max }
   for x := d.x0 to d.x1 do
   begin
      Layers := ColumnLayerCount(x);
      if (Layers > MaxLayers) then
	 MaxLayers := Layers;
   end;

   { Return the maximum count of layers }
   CountLayers := MaxLayers;
end;
   


{***********************************************************
 ***                 GENERATING A GUESS                  ***
 ***********************************************************}

{ Compute a guess array distribution for every digit. }

procedure ComputeGuesses;
var
  i : integer;
begin
  for i := 1 to NumDigits do
    with Digits[i] do
    begin

      { Guesses based on the Euler number are very strong,
        we will give them a weight of 3 }
      case EulerNumber of

        { Digits with one object and no holes are: 1,2,3,5,7 }
        1 : begin
              guess[1] := guess[1] + 3;
              guess[2] := guess[2] + 3;
              guess[3] := guess[3] + 3;
              guess[5] := guess[5] + 3;
              guess[7] := guess[7] + 3;
            end;

        { Digits with one object and one hole are: 0,4,6,9 }
        0 : begin
              guess[0] := guess[0] + 3;
              guess[4] := guess[4] + 3;
              guess[6] := guess[6] + 3;
              guess[9] := guess[9] + 3;
            end;

        { The only digit with one object and two holes is 8 }
       -1 : guess[8] := guess[8] + 3;
      else
        if DEBUG
          then writeln('The Euler Number is probably wrong!');
      end; { case }


      { Guessses based on filled column test are not so strong,
        since the test itself is prone to errors.  Thus weight is 1 }
      if Column then

      { The only digits with filled columns should be 1 and 4 }
      begin
        guess[1] := guess[1] + 1;
        guess[4] := guess[4] + 1;
      end
      else

      { all the other digits don't have filled columns }
      begin
        guess[0] := guess[0] + 1;
        guess[2] := guess[2] + 1;
        guess[3] := guess[3] + 1;
        guess[5] := guess[5] + 1;
        guess[6] := guess[6] + 1;
        guess[7] := guess[7] + 1;
        guess[8] := guess[8] + 1;
        guess[9] := guess[9] + 1;
      end; {column}
    end; {with}
end;


{***********************************************************
 ***                 OUTPUT block                        ***
 ***********************************************************}

{ Print the best guesses for each digit.  If DEBUG constant is true,
  additional information will also be displayed }

procedure PrintResults;
var
  x,y,i : integer;


   { Analyze the Guess array and print your best guess }

   procedure PrintGuess(d : DigitType);
    var
     i, MostLikely : integer;
   begin
     { Set the likelihood to 0}
    MostLikely := 0;

     { Find the highest likelihood }
     for i := 0 to 9 do
     begin
       if (d.guess[i] > MostLikely)
         then MostLikely := d.guess[i];
     end;

     { If DEBUGing, print the likelihood }
    if DEBUG
       then writeln('The likelihood is: ', MostLikely);

     { Print out all guesses with this likelihood }
     write('MY GUESS IS: ');
     for i := 0 to 9 do
    begin
       if (d.guess[i] = MostLikely)
         then write(i, ' ');
     end;
     writeln;
   end; { PrintGuess }

begin
  for i := 1 to NumDigits do
  begin
    if DEBUG then
    begin
      for y := Digits[i].y1 downto Digits[i].y0 do
      begin
        for x := Digits[i].x0 to Digits[i].x1 do
          write(image[x,y]);
        writeln;
      end;
      writeln('Euler number : ', Digits[i].EulerNumber);
      writeln('Column found : ', Digits[i].Column);
      PrintGuess(Digits[i]);
      writeln('Press RETURN to continue');
      readln;
    end {DEBUG}
    else
      PrintGuess(Digits[i]);
  end;
end; { PrintResults }



{ Main Program }

begin
  InitializeDigits;        { Initialize the Digits records }
  ReadImageFile;           { Read in the image file }
  while ImproveImage       { Improve the image until there is }
    do;                    { nothing to improve }

  SeparateDigits;          { Separate the image into digits }

  for i := 1 to NumDigits do      { Cycle thru all digits }
  begin                           { and generate properties }
    Digits[i].EulerNumber := FindEulerNumber(Digits[i]);
    Digits[i].Column := FindColumn(Digits[i]);
  end;

  ComputeGuesses;          { Compute the guess array for every digit }

  PrintResults;            { Print out the results }
end.