File : eliza-bot.adb


-- Bush page: http://www.pegasoft.ca/docs/discus/index_bush.html

-- Eliza chatterbot

--

-- Original author: Joseph Weizenbaum

-- Translated from Bush to Ada by Alejandro Mosteo (public@mosteo.com)


with Eliza.Phrases; 
use  Eliza.Phrases;

with Strings.Fields;
use  Strings.Fields;

with Ada.Numerics.Float_random;
use  Ada.Numerics.Float_random;
with Ada.Strings.Unbounded;
use  Ada.Strings.Unbounded;

use  Ada;

package body Eliza.Bot is

   function U (This : in String) return Unbounded_string 
      renames To_unbounded_string;
   function S (This : in Unbounded_String) return String 
      renames To_string;

   subtype ustring is Unbounded_string;
   type ustring_array is array (Positive range <>) of ustring;

   Byes : Ustring_array := (
      U ("BYE!"),
      U ("SEE YOU..."),
      U ("BYEBYE"),
      u ("GOOD BYE"));

   Repeats : Ustring_array := (
      U ("AGAIN?"),
      U ("I UNDERSTAND IT THE FIRST TIME"),
      U ("AHA"),
      U ("OK, OK"),
      U ("I SEE"),
      U ("CORRECT"),
      U ("OK"));

   function Field (
      str       : in UString; 
      Delimiter : in Character; 
      Pos       : in Positive) return UString is
   begin
      return U (Select_field (S (str), Pos, Delimiter));
   end Field;

   ------------------------------------------------------------------------

   -- Choose                                                             --

   ------------------------------------------------------------------------

   -- Selects a string from a ustring array

   function Choose (From : in Ustring_array) return String is
      Rand : Generator;
   begin
      Reset (Rand);
      return S (From (
         Positive (
            Float'Floor (Random (Rand) * Float (From'Length) + 1.0))));
   exception
      when others =>
         return S (From (From'Last));
   end Choose;

   ------------------------------------------------------------------------

   -- Initialize                                                         --

   ------------------------------------------------------------------------

   -- Prepares internals.

   procedure Initialize (This : in out Object) is
   begin
      Reset (This.Rand);
   end Initialize;

   ------------------------------------------------------------------------

   -- Get_greeting                                                       --

   ------------------------------------------------------------------------

   -- Get a random greeting phrase

   function Get_greeting (This : in Object) return String is
      pragma Unreferenced (This);
      Greets : Ustring_array := (
         U ("HELLO. HOW ARE YOU?"),
         U ("HI. HOW ARE YOU?"),
         U ("NICE TO MEET YOU. HOW ARE YOU DOING?"));
   begin
      return Choose (Greets);
   end Get_greeting;

   ------------------------------------------------------------------------

   -- Is_done                                                            --

   ------------------------------------------------------------------------

   -- Returns true if the conversation is after a bye.

   function Is_done (This : in Object) return Boolean is
   begin
      return This.Done;
   end Is_done;

   ------------------------------------------------------------------------

   -- Get_response                                                       --

   ------------------------------------------------------------------------

   -- Gets the next phrase from Eliza.

   -- You must supply your answer to the previous statement.

   function Get_response (This : access Object; Phrase : in String)
      return String 
   is
      i    : Ustring := U (Phrase);
   begin
      i := U (" ") & i & U (" ");

      -- clean up input


      declare
        c : character;
        new_i : ustring := U ("");
        last_was_space : boolean := false;
      begin
        for l in 1..length( i ) loop
          c := element( i, l );
          if c = ' ' then
             if last_was_space then
                null;
             else
                new_i := new_i & c;
                last_was_space := true;
             end if;
          else
             last_was_space := false;
             if c >= 'a' and c <= 'z' then
                new_i := new_i & character'val(  character'pos( c ) - 32 );
             elsif c >= '0' and c <= '9' then
                new_i := new_i & c;
             elsif c >= 'A' and c <= 'Z' then
                new_i := new_i & c;
             end if;
          end if;
        end loop;
        i := new_i;
      end;

      -- test for the basics


      if i = This.Prev then
         return Choose (Repeats);
      elsif i = " BYE " or 
            i = " GOOD BYE " or 
            i = " GOODBYE " or 
            i = " BYEBYE " or
            i = " SEEYOU " or
            i = " SEE YOU " or
            i = " NIGHT " or
            i = " DAY " or
            i = " GNIGHT " or
            i = " GDAY "
      then
         This.Done := true;
         return Choose (Byes);
      else
         This.Prev := i;

         -- look for keyword(s)


         declare
            remains : ustring := U ("");

            eliza_reply : ustring := U ("");
            testword    : ustring := U ("");
            response_pos: natural := 0;
         begin

            -- look for single keywords


            declare
              k : positive; -- keyword in the user's input

              keyword : ustring;
            begin
              k := 2; -- skip first null "field"

              loop
                testword := U (select_field( S (i), k, ' ' ));
                exit when testword = U ("");
                -- not 100% since doesn't take into account leading delimiter

                -- since first single keyword has no leading delimiter

           if index( single_keywords, S (testword & delimiter) ) > 0 then
                   for sk in 1..num_single loop
                       keyword := U (select_field( S (single_keywords), sk, delimiter ));
                       if keyword = testword then
                     response_pos := natural'value( select_field( S (single_keywords), sk+1, delimiter ) );
                          exit;
                       end if;
                   end loop;
                end if;
                exit when response_pos > 0;
           k := k + 1;
              end loop;
            end;

            -- no match? look for multiple keywords


            if response_pos = 0 then
               declare
                 k  : positive;
               begin
                 k := 1;
                 while k < positive( num_multi ) loop
                testword := field( multi_keywords, delimiter, k ); 
                if index( i, S (' ' & testword & ' ') ) > 0 then
                   response_pos := natural'value( S (field( multi_keywords, delimiter, k+1 ) ));
                   exit;
                     end if;
                k := k+1;
                 end loop;
               end;
            end if;

            -- still no match? use fallback responses else get remainder

            -- of user input after the keyword(s)


            if response_pos = 0 then
          testword := U (nokey_marker);
          response_pos := natural'value( S (field( single_keywords, delimiter, num_single ) ));
            else
               remains := U (slice( i, positive( index( i, S (testword) ) +
                  length( testword ) ), length( i ) ));
            end if;

            -- rewrite the remainder of the input


            declare
              c : natural;
              p : positive;
            begin
              c := index( remains, " ARE " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+4, " AM+ " );
              end if;
              c := index( remains, " AM " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+3, " ARE+ " );
              end if;
              c := index( remains, " WERE " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+5, " WAS+ " );
              end if;
              c := index( remains, " WAS " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+4, " WERE+ " );
              end if;
              c := index( remains, " YOU " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+4, " I+ " );
              end if;
              c := index( remains, " I " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+2, " YOU+ " );
              end if;
              c := index( remains, " YOUR " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+5, " MY+ " );
              end if;
              c := index( remains, " MY " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+3, " YOUR+ " );
              end if;
              c := index( remains, " IVE " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+4, " YOUVE+ " );
              end if;
              c := index( remains, " YOUVE " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+6, " IVE+ " );
              end if;
              c := index( remains, " IM " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+3, " YOURE+ " );
              end if;
              c := index( remains, " ME " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+3, " YOU+ " );
              end if;
              c := index( remains, " US " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+3, " YOU+ " );
              end if;
              c := index( remains, " WE " );
              if c > 0 then
                 p := positive( c );
                 remains := replace_slice( remains, p, c+3, " YOU+ " );
              end if;
              loop
                 c := index( remains, "+" );
                 exit when c = 0;
                 remains := delete( remains, positive( c ), c );
              end loop;
              if tail( remains, 3 ) = " I " then
                 remains := U (slice( remains, 1,
                    length( remains ) - 2 ))
                    & "ME ";
         end if;
            end;
      --put_line( "Remains (after conjugation): " & remains );


          -- attach reply


            declare
              last_pos    : natural := 0;
              reply_cnt   : natural := 0;
              reply       : natural := 0;
              ch          : character;
              response    : ustring;
            begin

              -- count replies


              last_pos := response_pos+1;
              loop
                 response := field( responses, delimiter, last_pos );
                 exit when response = "";
                 last_pos := last_pos+1;
              end loop;
              reply_cnt := last_pos - response_pos;

         reply :=  Natural (Float'Floor (random (This.rand) * float (reply_cnt)));
              eliza_reply := field( responses, delimiter,
                response_pos + reply );

              ch := element( eliza_reply, positive( length( eliza_reply ) ) );
              if ch = '*' then
                 eliza_reply := head( eliza_reply,
                   length( eliza_reply )-1 ) & remains;
              end if;
            end;
            return S (eliza_reply);
         end;
      end if;
   end Get_response;

end Eliza.Bot;