Solution to exercise #7

{ This program is a solution to exercise #7 for CSC 206, ``Fundamentals of
  computer science II,'' offered at Grinnell College in fall semester,
  1996.  It tallies the votes cast on various local propositions in a
  community election and reports the total number of valid ballots cast
  in favor of and against each proposition.

  The file /u2/stone/courses/fundamentals/exercises/votes.dat contains a
  record of each ballot cast in the election.  Each ballot is represented
  by a single line of the file.  Columns 1 to 4 of the line are occupied by
  a four-digit numeral (in the range from 0000 to 9999) identifying the
  voter who cast the ballot.  Column 5 is always a space.  The rest of the
  line contains zero or more vote indicators, each consisting of a
  two-digit numeral (in the range from 10 to 99), identifying the
  proposition, and a plus sign or a minus sign, indicating whether the vote
  was cast for or against the proposition.  Adjacent vote indicators are
  separated by one or more spaces. Thus a typical ballot line might look
  like this: 

  4727 11+ 13+ 14- 15+

  indicating a vote for propositions 11, 13, and 15, and against
  proposition 14, or like this: 

  8607        14+  72+          53-

  indicating a vote for propositions 14 and 72 and against proposition 53.

  A ballot line that does not begin with a four-digit numeral is an error;
  this program tallies such ballots and reports how many of them were
  encountered, but otherwise ignores them.

  A ballot line that begins with a four-digit numeral, but does not follow
  the prescribed form, is a spoiled ballot and is not counted for or
  against any of the propositions. 

  Finally, if two or more of the ballot lines in the file begin with the
  same voter identification number, all of them are fraudulent ballots, and
  none of them is counted for or against any of the propositions.  Even if
  all but one of a group of ballot lines beginning with the same voter
  identification number are spoiled, the remaining one is still fraudulent
  and does not contribute to the vote tally.  

  The report of the results begins with a count of the number of ballot
  lines that were found to be valid, the number that were errors, the
  number of spoiled ballots, and the number of fraudulent ballots.  (Note
  that the last two categories are not mutually exclusive.)  It then gives
  the results for each proposition on which valid ballots were cast, in
  ascending numerical order, listing the number of votes for and against
  each one and the number of valid ballots that did not indicate any vote
  on that proposition. If some proposition number does not appear at all on
  any valid ballot, the report skips over that proposition number without
  comment.

  Programmer: John Stone, Grinnell College.
  Original version: December 17-18, 1996. }

{ HP Pascal does not actually recycle any dynamically allocated storage
  unless the $heap_dispose compiler option is turned on. }

$heap_dispose on$

program VoteTallier (BallotFile, Output);

const
  VoterIDLength = 4;
    { the number of digits in a voter identification number }
  LeastPropositionNumber = 10;
  GreatestPropositionNumber = 99;
    { the lower and upper bounds for the identification numbers for
      propositions appearing on the ballot }
  BallotFileName = '/u2/stone/courses/fundamentals/exercises/votes.dat';
    { the operating system's name for the file containing the ballot
      records }

type
  Natural = 0 .. MaxInt;
    { the type of small natural numbers }
  VoterID = packed array [1 .. VoterIDLength] of Char;
    { the type of a voter identification number }
  PropositionNumber = LeastPropositionNumber .. GreatestPropositionNumber;
    { the range of valid identification numbers for propositions on the
      ballot }
  Direction = (Yes, No);
    { the possible votes that can be recorded on a proposition }
  Link = ^LLComponent;
  LLComponent = record
                  Prop: PropositionNumber;
                  Vote: Direction;
                  Next: Link
                end;
  Cast = Link;
    { types defining a linked list of proposition numbers, with a vote
      recorded on each one }
  BinarySearchTree = ^BSTComponent;
  BSTComponent = record
                   Voter: VoterID;
                   Votes: Cast;
                   Left, Right: BinarySearchTree
                 end;
    { types defining a binary search tree, keyed by voter identification
      numbers, in which ballot information can be held }
  Tally = array [Direction] of Natural;
  Tallies = array [PropositionNumber] of Tally;
    { types for recording the vote totals for and against each proposition }

var
  ErrorCount: Natural;
    { the number of errors -- lines not beginning with four-digit voter
      identification numbers -- encountered during the reading of the
      ballots }
  SpoiledCount: Natural;
    { the number of spoiled ballots -- syntactically incorrect lines with
      voter identification numbers }
  FraudulentCount: Natural;
    { the number of fraudulent ballots -- lines bearing voter
      identification numbers that are duplicated on other ballots }
  ValidVotes: BinarySearchTree;
    { a binary search tree containing the valid votes (those on
      non-erroneous, non-spoiled, non-fraudulent ballots) cast for and
      against various propositions, keyed by voter ID }
  BallotFile: Text;
    { the file containing the ballot records }
  Propositions: Tallies;
    { a structure that keeps track of the number of yes votes, no votes,
      and abstentions (on valid ballots) for each proposition }
  ValidCount: Natural;
    { the number of valid ballots cast }

  { The following procedures and functions operate on linked lists of
    the Cast type. }

  { The MakeEmptyCast function returns a list of this type, initially
    empty. }

  function MakeEmptyCast: Cast;
  begin
    MakeEmptyCast := nil
  end;

  { The AddToCast procedure attaches information about one vote on one
    proposition to a Cast. }

  procedure AddToCast (var C: Cast; PropNumber: PropositionNumber;
    Dir: Direction);
  var
    Extra: Link;
      { an extra pointer to the component being added to the list }
  begin
    New (Extra);
    Extra^.Prop := PropNumber;
    Extra^.Vote := Dir;
    Extra^.Next := C;
    C := Extra
  end;

  { The DuplicatePropNumber determines whether a vote for or against the
    proposition with a given number has already been recorded as part of
    a given Cast. }

  function DuplicatePropNumber (Candidate: PropositionNumber; C: Cast):
    Boolean; 
  begin
    if C = nil then
      DuplicatePropNumber := False
    else if C^.Prop = Candidate then
      DuplicatePropNumber := True
    else
      DuplicatePropNumber := DuplicatePropNumber (Candidate, C^.Next)
  end;

  { The ApplyAlongCast traverses a given Cast, applying a specified
    procedure to the proposition number and ``direction'' within each
    of its components. }

  procedure ApplyAlongCast (C: Cast;
    procedure Applicand (PropNumber: PropositionNumber; Dir: Direction));
  begin
    if C <> nil then begin
      Applicand (C^.Prop, C^.Vote);
      ApplyAlongCast (C^.Next, Applicand)
    end
  end;

  { The DeallocateCast procedure recycles all of the storage associated
    with a given Cast, leaving it empty. }

  procedure DeallocateCast (var C: Cast);
  begin
    if C <> nil then begin
      DeallocateCast (C^.Next);
      Dispose (C);
      C := nil
    end
  end;

  { The following procedures and functions define a simple implementation
    of binary search trees, keyed by voter identification numbers, in which
    each node also contains information about the ballot that voter cast. }

  { The MakeEmptyBinarySearchTree function returns an empty binary search
    tree. } 

  function MakeEmptyBinarySearchTree: BinarySearchTree;
  begin
    MakeEmptyBinarySearchTree := nil
  end;

  { The InsertIntoBinarySearchTree procedure adds a node to an existing
    binary search tree; it presupposes that the binary search tree does not
    already contain a node with the same key. }

  procedure InsertIntoBinarySearchTree (NewVoter: VoterID; NewVotes: Cast;
    var BST: BinarySearchTree);
  begin
    if BST = nil then begin
      New (BST);
      BST^.Voter := NewVoter;
      BST^.Votes := NewVotes;
      BST^.Left := nil;
      BST^.Right := nil
    end
    else if NewVoter < BST^.Voter then
      InsertIntoBinarySearchTree (NewVoter, NewVotes, BST^.Left)
    else if BST^.Voter < NewVoter then
      InsertIntoBinarySearchTree (NewVoter, NewVotes, BST^.Right)
  end;

  { The DeleteFromBinarySearchTree procedure removes a node with a
    specified voter identification number from a given binary search tree,
    if such a node is present (otherwise it does nothing). }

  procedure DeleteFromBinarySearchTree (Sought: VoterID;
    var BST: BinarySearchTree);
  var
    Delend: BinarySearchTree;
      { a spare pointer to the component to be recycled }

    { The DeleteLargest procedure finds and returns the Voter and Votes
      fields of the node with the greatest voter identification number in a
      given binary search tree and simultaneously deletes it from that
      binary search tree.  It presupposes that the binary search tree is
      not empty. } 

    procedure DeleteLargest (var Site: BinarySearchTree;
      var Largest: VoterID; var LargestVotes: Cast);
    var
      Delend: BinarySearchTree;
        { a spare pointer to the component to be recycled }
    begin
      if Site^.Right = nil then begin
        Largest := Site^.Voter;
        LargestVotes := Site^.Votes;
        Delend := Site;
        Site := Site^.Left;
        Dispose (Delend)
      end
      else
        DeleteLargest (Site^.Right, Largest, LargestVotes)
    end;

  begin { procedure DeleteFromBinarySearchTree }
    if BST <> nil then begin
      if Sought < BST^.Voter then
        DeleteFromBinarySearchTree (Sought, BST^.Left)
      else if BST^.Voter < Sought then
        DeleteFromBinarySearchTree (Sought, BST^.Right)
      else begin { we've found the datum to be deleted }
        if BST^.Left = nil then begin
          Delend := BST;
          BST := BST^.Right;
          Dispose (Delend)
        end
        else if BST^.Right = nil then begin
          Delend := BST;
          BST := BST^.Left;
          Dispose (Delend)
        end
        else
          DeleteLargest (BST^.Left, BST^.Voter, BST^.Votes)
      end
    end
  end;

  { The ApplyThroughoutBinarySearchTree procedure traverses a given binary
    search tree, applying a specified procedure to each voter
    identification number and record of votes cast. }

  procedure ApplyThroughoutBinarySearchTree (BST: BinarySearchTree;
    procedure Applicand (CurrentVoter: VoterID; CurrentVotes: Cast));
  begin
    if BST <> nil then begin
      ApplyThroughoutBinarySearchTree (BST^.Left, Applicand);
      Applicand (BST^.Voter, BST^.Votes);
      ApplyThroughoutBinarySearchTree (BST^.Right, Applicand)
    end
  end;  

  { The DeallocateBinarySearchTree procedure recycles all of the storage
    associated with a given binary search tree, leaving it empty. }

  procedure DeallocateBinarySearchTree (var BST: BinarySearchTree);
  begin
    if BST <> nil then begin
      DeallocateBinarySearchTree (BST^.Left);
      DeallocateBinarySearchTree (BST^.Right);
      DeallocateCast (BST^.Votes);
      Dispose (BST);
      BST := nil
    end
  end;

  { The ReadAndValidateData procedure examines all of the raw data in the
    source file, determines the number of ballots that are defective in
    various ways, and recovers and returns in the ValidVotes parameter
    a binary search tree containing all of the valid ballots cast. }

  procedure ReadAndValidateData (var BallotFile: Text; var ErrorCount,
    SpoiledCount, FraudulentCount: Natural;
    var ValidVotes: BinarySearchTree);
  type
    MutableSet = ^MSComponent;
    MSComponent = record
                    Datum: VoterID;
                    Left, Right: MutableSet
                  end;
      { types defining a structure for holding mutable sets }
    CharSet = set of Char;
      { a standard Pascal character set type }
  var
    PreviousVoters: MutableSet;
      { a set containing, throughout the reading of the ballots, the voter
        identification numbers on previously examined ballots }
    FraudulentVoters: MutableSet;
      { a set containing voter identification numbers previously determined
        to be fraudulent (i.e., having appeared on two or more previously
        examined ballots }
    CurrentVoter: VoterID;
      { a voter identification number extracted from the ballot most
        recently read in }
    CurrentVotes: Cast;
      { a record of the votes cast for and against various propositions on
        the ballot most recently read in }
    Error: Boolean;
      { indicates whether the ballot line most recently read in was
        erroneous }
    Spoiled: Boolean;
      { indicates whether the ballot most recently read in was spoiled }

    { The following procedures and functions define a basic implementation
      of mutable sets of voter identification numbers.  The implementation
      is, in effect, a binary search tree, but not the same as the binary
      search tree type to which ValidVotes belongs. }

    { The MakeEmptyMutableSet function returns an empty set. }

    function MakeEmptyMutableSet: MutableSet;
    begin
      MakeEmptyMutableSet := nil
    end;

    { The AdjoinToMutableSet procedure adds a voter identification number
      to a given set, if it is not already present. }

    procedure AdjoinToMutableSet (var Sett: MutableSet; Adjunct: VoterID);
    var
      Extra: MutableSet;
        { an extra pointer to the component that will contain the adjunct }
    begin
      if Sett = nil then begin
        New (Sett);
        Sett^.Datum := Adjunct;
        Sett^.Left := nil;
        Sett^.Right := nil
      end
      else if Adjunct < Sett^.Datum then
        AdjoinToMutableSet (Sett^.Left, Adjunct)
      else if Sett^.Datum < Adjunct then
        AdjoinToMutableSet (Sett^.Right, Adjunct)
    end;

    { The MemberOfMutableSet function determines whether a given voter
      identification number belongs to a given set. }

    function MemberOfMutableSet (Candidate: VoterID; Sett: MutableSet):
      Boolean;
    begin
      if Sett = nil then
        MemberOfMutableSet := False
      else if Candidate < Sett^.Datum then
        MemberOfMutableSet := MemberOfMutableSet (Candidate, Sett^.Left)
      else if Sett^.Datum < Candidate then
        MemberOfMutableSet := MemberOfMutableSet (Candidate, Sett^.Right)
      else
        MemberOfMutableSet := True
    end;

    { The DeallocateMutableSet procedure recycles the storage associated
      with a given set, leaving it empty. }

    procedure DeallocateMutableSet (var Delend: MutableSet);
    begin
      if Delend <> nil then begin
        DeallocateMutableSet (Delend^.Left);
        DeallocateMutableSet (Delend^.Right);
        Dispose (Delend);
        Delend := nil
      end
    end;

    { The Blocked function returns True if the end of a specified file
      has been reached, or if the end of a line in that file has been
      reached.  Otherwise, the function checks to see whether the next
      character in the file belongs to a specified set and returns True
      if the outcome of this test matches the setting of the Stop
      parameter. }

    function Blocked (var Source: Text; Specials: CharSet; Stop: Boolean):
      Boolean; 
    begin
      if EOF (Source) then
        Blocked := True
      else if EOLN (Source) then
        Blocked := True
      else
        Blocked := (Stop = (Source^ in Specials))
    end;

    { The ReadBallot procedure consumes exactly one line from BallotFile
      and analyzes and reports on its contents, setting Error to True if
      the line does not contain a voter identification number, setting
      Spoiled to True if it contains any other syntax error, and otherwise
      returning the voter ID and the votes cast through the CurrentVoter
      and CurrentVotes parameters. }

    procedure ReadBallot (var BallotFile: Text; var CurrentVoter: VoterID;
      var CurrentVotes: Cast; var Error, Spoiled: Boolean);
    const
      Space = ' ';
        { a more legible name for the space character }
    var
      Position: Natural;
        { counts off positions in the voter identification number }
      Finished: Boolean;
        { indicates whether all of the information that can be recovered
          from the line has already been collected }
      PropNumber: PropositionNumber;
        { the number of one proposition on which a vote was cast }
      Dir: Direction;
        { indicates whether the vote cast was for or against the
          proposition }

      { The SkipSpaces procedure discards characters from a given file
        until it reaches the end of the file, the end of a line, or a
        non-space character. }

      procedure SkipSpaces (var Source: Text);
      begin
        while not Blocked (Source, [Space], False) do
          Get (Source);
      end;

      { The ReadVote procedure reads in and returns a proposition number
        and a direction (for or against), as recorded on a ballot in a
        given source file.  If the next thing cannot be parsed as a
        proposition number and a direction, ReadVote sets Spoiled to True
        and returns; if the parsing is successful, ReadVote sets Spoiled
        to False. }

      procedure ReadVote (var Source: Text;
        var PropNumber: PropositionNumber; var Dir: Direction;
        var Spoiled: Boolean);
      var
        Candidate: Integer;
          { a proposed proposition number, as read from the source file }
      begin
        if Blocked (Source, ['0' .. '9'], False) then
          Spoiled := True
        else begin

          { Read a number and check whether it's in range. }

          Read (Source, Candidate);
          if (Candidate < LeastPropositionNumber) or
                        (GreatestPropositionNumber < Candidate) then
            Spoiled := True
          else begin
            PropNumber := Candidate;

            { Look at the character after the number; check whether it's
              a valid vote indicator and set Dir appropriately. }

            if Blocked (Source, ['+', '-'], False) then
              Spoiled := True
            else begin
              case Source^ of
              '+':
                Dir := Yes;
              '-':
                Dir := No;
              end;

              { Discard the vote-indicator and make sure that we're either
                at the end of the file, at the end of a line, or about to
                read a space. }

              Get (Source);
              Spoiled := not Blocked (Source, [Space], True)
            end
          end
        end
      end;

    begin { procedure ReadBallot }

      { Collect the VoterID carefully. }

      Spoiled := False;
      Error := False;
      Position := 1;
      while (Position <= VoterIDLength) and not Error do
        if Blocked (BallotFile, ['0' .. '9'], False) then
          Error := True
        else begin
          Read (BallotFile, CurrentVoter[Position]);
          Position := Position + 1
        end;

      { If we're OK so far, collect any votes that are recorded on the
        ballot in CurrentVotes. }

      if not Error then begin

        { Make sure that there is a space after the VoterID (if not, the
          ballot is spoiled). }

        if Blocked (BallotFile, [Space], False) then
          Spoiled := True
        else begin
          Get (BallotFile);
          CurrentVotes := MakeEmptyCast;
          Finished := False;
          SkipSpaces (BallotFile);
          while not Finished and not Spoiled do
            if EOF (BallotFile) then
              Finished := True
            else if EOLn (BallotFile) then
              Finished := True
            else begin
              ReadVote (BallotFile, PropNumber, Dir, Spoiled);
              if not Spoiled then begin
                if DuplicatePropNumber (PropNumber, CurrentVotes) then
                  Spoiled := True
                else
                  AddToCast (CurrentVotes, PropNumber, Dir)
              end;
              SkipSpaces (BallotFile)
            end;
          if Spoiled then
            DeallocateCast (CurrentVotes)
        end
      end;
      if not EOF (BallotFile) then
        ReadLn (BallotFile)
    end;

  begin { procedure ReadAndValidateData }

    { Initialize the variables and data structures that validate the
      ballots and tally invalid ones. }

    ErrorCount := 0;
    SpoiledCount := 0;
    FraudulentCount := 0;
    PreviousVoters := MakeEmptyMutableSet;
    FraudulentVoters := MakeEmptyMutableSet;
    ValidVotes := MakeEmptyBinarySearchTree;

    { Go through the ballots, classifying each one appropriately and storing
      valid ones for subsequent tallying. }

    while not EOF (BallotFile) do begin

      { Read in a ballot line and check it for syntax errors. }

      ReadBallot (BallotFile, CurrentVoter, CurrentVotes, Error, Spoiled);

      { Classify and tally any defects. }

      if Error then
        ErrorCount := ErrorCount + 1
      else begin
        if Spoiled then
          SpoiledCount := SpoiledCount + 1;
        if MemberOfMutableSet (CurrentVoter, PreviousVoters) then begin

          { The voter identification number on the current ballot matches
            one encountered on a previous ballot.  Score it as
            fraudulent. } 

          FraudulentCount := FraudulentCount + 1;

          { If this voter was not previously known to be fraudulent, the 
            earlier ballot bearing the same voter identification number may
            have been accepted as valid.  Score that one as fraudulent and
            delete it from the ValidVotes structure. }

          if not MemberOfMutableSet (CurrentVoter, FraudulentVoters)
                                                                then begin
            AdjoinToMutableSet (FraudulentVoters, CurrentVoter);
            FraudulentCount := FraudulentCount + 1;
            DeleteFromBinarySearchTree (CurrentVoter, ValidVotes)
          end
        end
        else begin
          AdjoinToMutableSet (PreviousVoters, CurrentVoter);
          if not Spoiled then
            InsertIntoBinarySearchTree (CurrentVoter, CurrentVotes,
                                        ValidVotes)
        end
      end
    end;

    { The PreviousVoters and FraudulentVoters sets are no longer needed,
      so the storage for them can be recycled. }

    DeallocateMutableSet (PreviousVoters);
    DeallocateMutableSet (FraudulentVoters);
  end;

  { The InitializeTallies procedure initializes (to zero) the vote total
    for and against each proposition. }

  procedure InitializeTallies (var Propositions: Tallies);
  var
    Dir: Direction;
    PropNumber: PropositionNumber;
  begin
    for PropNumber :=
                LeastPropositionNumber to GreatestPropositionNumber do
      for Dir := Yes to No do
        Propositions[PropNumber][Dir] := 0
  end;

  { The TallyOneVote procedure records a vote for or against one
    proposition. }

  procedure TallyOneVote (PropNumber: PropositionNumber; Dir: Direction);
  begin
    Propositions[PropNumber][Dir] := Propositions[PropNumber][Dir] + 1
  end;

  { The TallyVotes procedure records the votes associated with one valid
    ballot in the Propositions table and increments the count of valid
    ballots. }

  procedure TallyVotes (CurrentVoter: VoterID; CurrentVotes: Cast);
  begin
    ValidCount := ValidCount + 1;
    ApplyAlongCast (CurrentVotes, TallyOneVote)
  end;

  { The GenerateReport procedure displays the computed data in a user-
    readable format. }

  procedure GenerateReport (ValidCount, ErrorCount, SpoiledCount,
    FraudulentCount: Integer; Propositions: Tallies);
  const
    VoteWidth = 6;
      { the width of the field in which each vote total will be printed }
  var
    PropNumber: PropositionNumber;
      { runs through the possible proposition numbers }
    VotesCast: Natural;
      { the number of 'yes' and 'no' votes cast on a proposition }
  begin
    WriteLn ('Valid ballots cast: ', ValidCount : 1);
    WriteLn ('Errors: ', ErrorCount : 1);
    WriteLn ('Spoiled ballots: ', SpoiledCount : 1);
    WriteLn ('Fraudulent ballots: ', FraudulentCount : 1);
    WriteLn;
    for PropNumber :=
        LeastPropositionNumber to GreatestPropositionNumber do begin
      VotesCast :=
        Propositions[PropNumber][Yes] + Propositions[PropNumber][No];
      if VotesCast <> 0 then begin
        WriteLn ('Proposition #', PropNumber : 1);
        WriteLn (Propositions[PropNumber][Yes] : VoteWidth, ' for');
        WriteLn (Propositions[PropNumber][No] : VoteWidth, ' against');
        WriteLn (ValidCount - VotesCast : VoteWidth, ' not voting');
        WriteLn
      end
    end
  end;

begin { main program }

  { Read the ballot data, determine the number of ballots that were
    defective in various ways, and recover the valid ballots cast. }

  Reset (BallotFile, BallotFileName);
  ReadAndValidateData (BallotFile, ErrorCount, SpoiledCount,
                       FraudulentCount, ValidVotes);

  { Initialize the variables and data structures in which the valid votes
    will be tallied. }

  ValidCount := 0;
  InitializeTallies (Propositions);

  { Traverse the ValidVotes structure, tallying the valid votes. }

  ApplyThroughoutBinarySearchTree (ValidVotes, TallyVotes);
  DeallocateBinarySearchTree (ValidVotes);

  { Report the results. }

  GenerateReport (ValidCount, ErrorCount, SpoiledCount, FraudulentCount,
                  Propositions)
end.

created December 19, 1996
last revised December 19, 1996

John David Stone (stone@math.grin.edu)