with Text_IO;

package body FIST is
---------------------------------------------------------------------------
---------------------------------------------------------------------------
-- David W. Croft, CompuServe [76600,102]
---------------------------------------------------------------------------
---------------------------------------------------------------------------

function Activate_Neuron
	   ( Neuron_State  : in Neuron_State_Type;
	     Network_State : in Network_State_Type;
	     Weight_Array  : in Weight_Array_Type
	   ) return Neuron_State_Type is
---------------------------------------------------------------------------
  Weighted_Sum : integer := 0;
  Threshold : constant integer := 1;
  Temp : Neuron_State_Type;
begin
  case Neuron_State is
    when Cold =>
      return Rest;
    when Fire    =>
      return Cold;
    when Rest | Ooze =>
      Temp := Rest;
      for Weight in Network_State'range loop
	case Network_State ( Weight ) is
	  when Cold | Rest | Ooze => null;
	  when Fire =>
	    Temp := Ooze;
	    case Weight_Array ( Weight ) is
	      when Inhibitory   => Weighted_Sum := Weighted_Sum - 1;
	      when Disconnected => null;
	      when Excitatory   => Weighted_Sum := Weighted_Sum + 1;
	    end case;
	end case;
      end loop;
      if Weighted_Sum >= Threshold then
	return Fire;
      else
	return Temp;
      end if;
  end case;
end Activate_Neuron;

function Activate_Network
	   ( Neuron_Count : in positive;
	     Weight_Matrix: in Weight_Matrix_Type;
	     Network_State: in Network_State_Type
	   ) return Network_State_Type is
---------------------------------------------------------------------------
Weight_Array : Weight_Array_Type ( 1..Neuron_Count );
Network_State_New : Network_State_Type ( Network_State'range )
  := Network_State;
---------------------------------------------------------------------------
begin
  for Neuron in 1..Neuron_Count loop
    for Weight in 1..Neuron_Count loop
      Weight_Array ( Weight ) := Weight_Matrix ( Neuron, Weight );
    end loop;
    Network_State_New ( Neuron )
      := Activate_Neuron
	   ( Neuron_State  => Network_State ( Neuron ),
	     Network_State => Network_State,
	     Weight_Array  => Weight_Array );
  end loop;
  return Network_State_New;
end Activate_Network;

function Train_Neuron
	   ( Input_States  : in Network_State_Type;
	     Input_Weights : in Weight_Array_Type;
	     Prior_State   : in Neuron_State_Type;
	     Output_State  : in Neuron_State_Type
	   ) return Weight_Array_Type is
---------------------------------------------------------------------------
  Weights_New : Weight_Array_Type ( Input_Weights'range ) := Input_Weights;
begin
  for Weight in Weights_New'range loop
    case Input_States ( Weight ) is
      when Fire    =>
	case Output_State is
	  when Cold =>
	    case Weights_New ( Weight ) is
	      when Inhibitory   => null;
	      when Disconnected => Weights_New ( Weight ) := Inhibitory;
	      when Excitatory   => Weights_New ( Weight ) := Disconnected;
	    end case;
	  when Ooze =>
	    case Weights_New ( Weight ) is
	      when Inhibitory   => Weights_New ( Weight ) := Disconnected;
	      when Disconnected => Weights_New ( Weight ) := Excitatory;
	      when Excitatory   => null;
	    end case;
	  when Rest | Fire => null;
	end case;
      when Cold | Rest | Ooze => null;
    end case;
  end loop;
  return Weights_New;
end Train_Neuron;

function Train_Network
	   ( Neuron_Count      : in positive;
	     Weight_Matrix     : in Weight_Matrix_Type;
	     Network_State     : in Network_State_Type;
	     Network_State_New : in Network_State_Type
	   ) return Weight_Matrix_Type is
---------------------------------------------------------------------------
Weight_Array : Weight_Array_Type ( 1..Neuron_Count );
Weight_Matrix_New : Weight_Matrix_Type
  ( Weight_Matrix'range, Weight_Matrix'range ( 2 ) );
---------------------------------------------------------------------------
begin
  for Neuron in 1..Neuron_Count loop
    for Weight in 1..Neuron_Count loop
      Weight_Array ( Weight ) := Weight_Matrix ( Neuron, Weight );
    end loop;
    Weight_Array
      := Train_Neuron
	( Input_States  => Network_State,
	  Input_Weights => Weight_Array,
	  Prior_State   => Network_State ( Neuron ),
	  Output_State  => Network_State_New ( Neuron ) );
    for Weight in 1..Neuron_Count loop
      Weight_Matrix_New ( Neuron, Weight ) := Weight_Array ( Weight );
    end loop;
  end loop;
  return Weight_Matrix_New;
end Train_Network;

procedure Display_Status
	    ( Network_State : in Network_State_Type;
	      Weight_Matrix : in Weight_Matrix_Type ) is
---------------------------------------------------------------------------
  use Text_IO;
begin
  for Neuron in Network_State'range loop
    Put ( Neuron_State_Type'image ( Network_State ( Neuron ) ) ( 1 ) );
    Put ( " " );
  end loop;
  Put_Line ( "" );
  Put_Line ( "" );
  for Neuron in Network_State'range loop
    for Weight in Network_State'range loop
      Put ( Weight_Type'image ( Weight_Matrix ( Neuron, Weight ) ) ( 1 ) );
      Put ( " " );
    end loop;
    Put_Line ( "" );
  end loop;
end Display_Status;

procedure Pause is
---------------------------------------------------------------------------
  Item : string ( 1..1 );
  Last : natural;
begin
  Text_IO.Get_Line ( Item, Last );
end Pause;

procedure Match_Input_To_Output
	    ( Weight_Matrix: in out Weight_Matrix_Type;
	      IO_Set       : in     IO_Set_Type := Default_IO_Set ) is
---------------------------------------------------------------------------
Inputs_Count  : constant positive := IO_Set.Inputs'last;
Outputs_Count : constant positive := IO_Set.Outputs'last ( 2 );
Neuron_Count  : constant positive := Weight_Matrix'last ( 1 );
Extras_Count  : constant natural
  := Neuron_Count - Inputs_Count - Outputs_Count;
Network_State : Network_State_Type ( 1..Neuron_Count )
  := ( others => Rest );
Network_State_Predicted : Network_State_Type ( Network_State'range )
  := Network_State;
Network_State_New : Network_State_Type ( Network_State'range )
  := Network_State;
Input_Period : constant positive := IO_Set.Outputs'last ( 1 );
Desired_Output : Neuron_State_Type;
---------------------------------------------------------------------------
begin
  Text_IO.Put_Line ( "Resting all neurons..." );
  Network_State := ( others => Rest );
  Text_IO.Put_Line ( "Applying Inputs..." );
  Network_State ( IO_Set.Inputs'range ) := IO_Set.Inputs;
  Display_Status ( Network_State, Weight_Matrix );
  Pause;
  for Step in 1..Input_Period loop
    Text_IO.Put_Line ( "Predicting Activation Rule Results..." );
    Network_State_Predicted :=
      Activate_Network ( Neuron_Count, Weight_Matrix, Network_State );
    Display_Status ( Network_State_Predicted, Weight_Matrix );
    Pause;
    Text_IO.Put_Line ( "Comparing Predicted Results to Desired Outputs"
      & " for Step" & positive'image ( Step ) & "..." );
    for Output in
      ( Neuron_Count - Outputs_Count + 1 )..Neuron_Count loop
	Desired_Output := IO_Set.Outputs
	  ( Step, Output - ( Inputs_Count + Extras_Count ) );
	case Network_State_Predicted ( Output ) is
	  when Fire =>
	    if Desired_Output = Rest then
	      Network_State ( Output ) := Fire;
	    end if;
	  when Rest  =>
	    if Desired_Output = Fire then
	      Network_State ( Output ) := Ooze;
	    end if;
	  when Ooze =>
	    if Desired_Output = Rest then
	      Network_State ( Output ) := Cold;
	    end if;
	  when Cold => null;
	end case;
    end loop;
    Display_Status ( Network_State, Weight_Matrix );
    Pause;
    Text_IO.Put_Line ( "Applying Activation Rule Results..." );
    Network_State_New :=
      Activate_Network ( Neuron_Count, Weight_Matrix, Network_State );
    Text_IO.Put_Line ( "Applying Learning Rule..." );
    Weight_Matrix := Train_Network ( Neuron_Count, Weight_Matrix,
      Network_State, Network_State_New );
    Network_State := Network_State_New;
    Display_Status ( Network_State, Weight_Matrix );
    Pause;
  end loop;
end Match_Input_To_Output;

function Test_IO_Set
	    ( Weight_Matrix: in Weight_Matrix_Type;
	      IO_Set       : in IO_Set_Type := Default_IO_Set
	    ) return boolean is
---------------------------------------------------------------------------
--Inputs_Count  : constant positive := IO_Set.Inputs'last;
Outputs_Count : constant positive := IO_Set.Outputs'last ( 2 );
Neuron_Count  : constant positive := Weight_Matrix'last ( 1 );
--Extras_Count  : constant natural
--  := Neuron_Count - Inputs_Count - Outputs_Count;
Network_State : Network_State_Type ( 1..Neuron_Count )
  := ( others => Rest );
Input_Period : constant positive := IO_Set.Outputs'last ( 1 );
Temp : boolean := false;
---------------------------------------------------------------------------
begin
  Text_IO.Put_Line ( "Resting all neurons..." );
  Network_State := ( others => Rest );
  Text_IO.Put_Line ( "Applying Inputs..." );
  Network_State ( IO_Set.Inputs'range ) := IO_Set.Inputs;
  Display_Status ( Network_State, Weight_Matrix );
  Pause;
  for Step in 1..Input_Period loop
    Text_IO.Put_Line ( "Applying Activation Rule..." );
    Network_State :=
      Activate_Network ( Neuron_Count, Weight_Matrix, Network_State );
    Display_Status ( Network_State, Weight_Matrix );
    Pause;
    for Output in 1..Outputs_Count loop
      case IO_Set.Outputs ( Step, Output ) is
	when Rest  => Temp := Network_State
	  ( Neuron_Count - Outputs_Count + Output ) /= Fire;
	when Fire => Temp := Network_State
	  ( Neuron_Count - Outputs_Count + Output ) = Fire;
	when others => Temp := true;
      end case;
      exit when not Temp;
    end loop;
    exit when not Temp;
  end loop;
  return Temp;
end Test_IO_Set;

procedure Match_Function
	    ( Weight_Matrix   : in out Weight_Matrix_Type;
	      Function_Desired: in   Function_Type := Default_Function ) is
---------------------------------------------------------------------------
begin
  for Set in Function_Desired'range loop
    Match_Input_To_Output
      ( Weight_Matrix => Weight_Matrix,
	IO_Set        => Function_Desired ( Set ) );
  end loop;
end Match_Function;

function  Test_Function
	    ( Weight_Matrix   : in Weight_Matrix_Type;
	      Function_Desired: in Function_Type := Default_Function
	    ) return boolean is
---------------------------------------------------------------------------
  Temp: boolean := false;
begin
  for Set in Function_Desired'range loop
    Temp := Test_IO_Set
      ( Weight_Matrix => Weight_Matrix,
	IO_Set        => Function_Desired ( Set ) );
    exit when not Temp;
  end loop;
  Text_IO.Put_Line ( "Test Function result:  " & boolean'image ( Temp ) );
  return Temp;
end Test_Function;

procedure Inculcate
  ( Function_Desired : in Function_Type := Default_Function ) is
---------------------------------------------------------------------------
Extras_Count : constant natural := Default_Extras_Count;
Neuron_Count : constant positive
  := Function_Desired ( 1 ).Inputs_Count
   + Extras_Count
   + Function_Desired ( 1 ).Outputs_Count;
Weight_Matrix : Weight_Matrix_Type ( 1..Neuron_Count, 1..Neuron_Count )
  := ( others => ( others => Disconnected ) );
---------------------------------------------------------------------------
begin
  loop
    Match_Function ( Weight_Matrix, Function_Desired );
    exit when Test_Function ( Weight_Matrix, Function_Desired );
  end loop;
end Inculcate;

procedure Demonstrate is
---------------------------------------------------------------------------
begin
--  Text_IO.Put_Line ( "Demonstrating the function ""Or""." );
--  Inculcate ( Function_Or  );
  Text_IO.Put_Line ( "Demonstrating the function ""And""." );
  Inculcate ( Function_And );
end Demonstrate;

---------------------------------------------------------------------------
---------------------------------------------------------------------------
end FIST;