Re: OO Style with Ada Containers

[Matthew Heaney <matthewjheaney@earthlink.net>]

braver <deliverable@gmail.com> writes:

> As you can see, I've managed to do prefix notation everywhere except
> cursors.  How do they coexist with prefix notation -- or are they
> replaced by something cooler already, too?  :)

No, cursors aren't tagged because an operation can only be primitive for a
single tagged type, and the container type is already tagged.


> I'd appreciate any improvements to the above, which I deduced from ARM
> and Rosetta Stone examples in an hour and then prefix'ised thanks to
> Adam's hint!  (Well I've followed Ada since 1987 so the spirit is easy
> to follow...)

The problem with your code is here:

   Ngram_Cursor := Ngram_Counts.Find(s);

   if not Has_Element(Ngram_Cursor) then
       Ngram_Counts.Insert(s, 1);
       New_Word_Count := New_Word_Count + 1;
   else -- a valid position in Ngram_Pos
       Count := Element(Ngram_Cursor);
       Ngram_Counts.Replace_Element(Ngram_Cursor, Count+1);
  end if;


The issue is that Find duplicates the search that must already be performed by
Insert. You don't want to be doing this if the map has many elements.

The solution is to use the conditional form of Insert, which does an atomic
search-and-insert and reports back the result of the search.  If the key is
already in the map, the cursor returned designates the existing key/element
pair (which is not modified); if the key is not in the map, the key/element
pair is inserted and the cursor passed back designates the newly-inserted pair.

What you do here is insert a count of 0 for the word, and then increment the
count. If the word is already in the map, the existing count is increment.  If
the word is not already in the map, the count is 0, so it gets incremented to
the value 1 (which is the desired value).

I have included an example program below.  Also included is a simple scanner
that returns a lexeme for each whitespace-delimited word on a line of text.

Feel free to write if you have any comments or questions.

Regards,
Matt


--STX
with Ada.Command_Line;  use Ada.Command_Line;
with Ada.Text_IO;  use Ada.Text_IO;
with Ada.Integer_Text_IO;  use Ada.Integer_Text_IO;
with Scanners;     use Scanners;
with Ada.Containers.Indefinite_Hashed_Maps;  use Ada.Containers;
with Ada.Strings.Hash_Case_Insensitive;
with Ada.Strings.Equal_Case_Insensitive;  use Ada.Strings;

procedure Count_Words is
   Line      : String (1 .. 256);
   Line_Last : Natural;

   package Map_Types is new Indefinite_Hashed_Maps
     (String,
      Natural,
      Hash_Case_Insensitive,
      Equal_Case_Insensitive);
   
   M : Map_Types.Map;
   use Map_Types;

   F : File_Type;

begin
   Open (F, In_File, Argument (1));

   while not End_Of_File (F) loop
      Get_Line(F, Line, Line_Last);

      declare
         procedure Increment_Count 
           (Word  : String; 
            Count : in out Natural)
         is
         begin
            Count := Count + 1;
         end;

         S : Scanner := Scan (Line (Line'First .. Line_Last));
         
         C : Map_Types.Cursor;
         B : Boolean;

      begin
         while S.Has_Word loop
            M.Insert (S.Word, 0, C, B);
            M.Update_Element (C, Increment_Count'Access);
         end loop;
      end;
   end loop;

   declare
      procedure Process (C : Map_Types.Cursor) is
         Word  : constant String := Key (C);
         Count : constant Natural := Element (C);

      begin
         Put (Word);
         Put (':');
         Put (Count, Width => 0);
         New_Line;
      end Process;

   begin
      M.Iterate (Process'Access);
   end;

end Count_Words;

package Scanners is
   pragma Pure;

   type Scanner (<>) is tagged limited private;

   function Scan (Line : String) return Scanner;

   function Has_Word (S : Scanner) return Boolean;
   function Word (S : Scanner) return String;

private

   type Handle (S : not null access Scanner) is limited null record;

   type Scanner (Last : Natural) is tagged limited record
      H          : Handle (Scanner'Access);
      Line       : String (1 .. Last);
      Word_First : Positive;
      Word_Last  : Natural;
   end record;

end Scanners;

with Ada.Characters.Latin_1;  use Ada.Characters;

package body Scanners is

   function Is_Whitespace (C : Character) return Boolean is
   begin
      case C is
         when ' ' | Latin_1.HT => 
            return True;
         when others =>
            return False;
      end case;
   end Is_Whitespace;
      

   procedure Next (S : in out Scanner) is
      I : Integer renames S.Word_First;
      J : Integer renames S.Word_Last;
      
   begin
      I := J + 1;
      while I <= S.Last 
        and then Is_Whitespace (S.Line (I))
      loop
         I := I + 1;
      end loop;
      
      if I > S.Last then
         return;  -- no more words on this line
      end if;
      
      J := I;
      while J < S.Last 
        and then not Is_Whitespace (S.Line (J + 1))
      loop
         J := J + 1;
      end loop;
   end Next;
      

   function Scan (Line : String) return Scanner is
   begin
      return S : Scanner (Line'Length) do
        S.Line := Line;
        -- S.Word_First := 1;
        S.Word_Last := 0;
        Next (S);
      end return;
   end Scan;


   function Has_Word (S : Scanner) return Boolean is
   begin
      return S.Word_First <= S.Word_Last;
   end Has_Word;


   function Word (S : Scanner) return String is
      L : constant Positive := S.Word_Last - S.Word_First + 1;
      
   begin
      return Result : String (1 .. L) do
        Result := S.Line (S.Word_First .. S.Word_Last);
        Next (S.H.S.all);
      end return;
   end Word;

end Scanners;