---------------------------------------------------------------------------
-- Title       :  Hopfield
-- Version     :  1.1
-- Author      :  David Wallace Croft, CompuServe [76600,102]
-- Compiler    :  Ada
-- Unit Type   :  procedure
-- Copyright   :  1993 David Wallace Croft.  All rights reserved.
-- Description :  A Hopfield neural network program.
---------------------------------------------------------------------------

with DC_Data;
with DC_Disk;
with DC_Keyb;
with DC_Math;
with DC_Scrn;
with DC_Strg;

procedure Hopfield is
---------------------------------------------------------------------------
---------------------------------------------------------------------------

subtype State_Type is integer range -1..+1;
type Pattern_Type is array ( positive range <> ) of
       State_Type;
Pattern_Size : constant positive := 100;
type Patterns_Type is array ( positive range <> )
       of Pattern_Type ( 1..Pattern_Size );
Patterns_Count : constant positive := 10;
Patterns:  Patterns_Type ( 1..Patterns_Count );
subtype Weight_Type is float;
Neuron_Count : constant positive := Pattern_Size;
type Weights_Type is array ( 1..Neuron_Count, 1..Neuron_Count ) of
       Weight_Type;
Weights : Weights_Type;
type Network_Type is array ( 1..Neuron_Count ) of float;
Network : Network_Type;

procedure Load ( Patterns :  out Patterns_Type ) is
---------------------------------------------------------------------------
  use DC_Data;
  use DC_Disk;
  use DC_Strg;
  Error     : Error_Type;
  File_Name : File_Name_Type ( 1..11 );
  Handle    : File_Handle_Type;
  Is_EOF    : boolean;
  OutStr    : Str79;
  State     : State_Type;
  States    : String_Array_Type ( 1..10 );
begin
  for Pattern in Patterns'range loop
    File_Name := "Pattern."
      & Image ( Pattern, Width => 3, Signed => false, Zeroed => true );
    Open_File ( File_Name, Handle, Error );
    for Line in 0..9 loop
      ReadLn ( Handle, OutStr, Is_EOF, Error );
      Parse ( States, OutStr );
      for Column in 1..10 loop
	Patterns ( Pattern ) ( Line * 10 + Column )
	  := integer'value ( States ( Column ) );
      end loop;
    end loop;
    Close_File ( Handle, Error );
  end loop;
end Load;

procedure Settle (
	    Network : in out Network_Type;
	    Weights : in     Weights_Type ) is
---------------------------------------------------------------------------
  State_Changes : Network_Type;
  Sum1, Sum2 : float;
  Gain : constant float := 1.0;
  Epsilon : constant float := 0.0001;
begin
  loop
    for Neuron in Network'range loop
      DC_Scrn.Put ( Network ( Neuron ) );
      DC_Scrn.Put ( " " );
    end loop;
    DC_Scrn.Put_Line;
    DC_Keyb.Pause;
    for Neuron_I in Network'range loop
      Sum1 := 0.0;
      Sum2 := 0.0;
      for Neuron_J in Network'range loop
	Sum1 := Sum1 + abs ( Weights ( Neuron_I, Neuron_J ) );
	Sum2 := Sum2 + Weights ( Neuron_I, Neuron_J )
	  * ( DC_Math.Sigmoid ( Gain * Network ( Neuron_J ) ) - 0.5 );
      end loop;
      State_Changes ( Neuron_I )
	:= Epsilon * ( - Network ( Neuron_I ) * Sum1 + Sum2 );
    end loop;
    for Neuron in Network'range loop
      Network ( Neuron )
	:= Network ( Neuron ) + State_Changes ( Neuron );
    end loop;
  end loop;
end Settle;

procedure Store (
	    Weights  : in out Weights_Type;
	    Patterns : in     Patterns_Type ) is
---------------------------------------------------------------------------
  Sum : float;
begin
  for Neuron_I in Weights'range ( 1 ) loop
    for Neuron_J in Weights'range ( 2 ) loop
      Sum := 0.0;
      for Pattern in Patterns'range loop
	Sum := Sum + float (
		     Patterns ( Pattern ) ( Neuron_I )
		   * Patterns ( Pattern ) ( Neuron_J ) );
      end loop;
      Weights ( Neuron_I, Neuron_J ) := Sum;
    end loop;
  end loop;
end Store;

---------------------------------------------------------------------------
---------------------------------------------------------------------------
begin
  Load ( Patterns );
  Store ( Weights, Patterns );
  for Pattern in Patterns'range loop
    for Neuron in Network'range loop
      Network ( Neuron )
	:= float ( Patterns ( Pattern ) ( Neuron ) );
    end loop;
    Settle ( Network, Weights );
  end loop;
end Hopfield;