--Give it time to float through the layers before turning training on.
--Stop looping after pass through all training sets successfully without
--  changing.

with
  NAS_Math_Rand_Gens_Real,
  DC_Curs,
  DC_Keyb,
  DC_Scrn,
  DC_Type;

use
  DC_Curs,
  DC_Keyb,
  DC_Scrn,
  DC_Type;

package body ANN5S is
---------------------------------------------------------------------------
---------------------------------------------------------------------------

procedure Pattern_Train (
	    Pattern_Inputs  : in     Array_Boolean;
	    Pattern_Outputs : in     Array_Boolean;
	    Weights          : in out Array_Float_2;
	    Debug_Mode       : in     boolean := false ) is
---------------------------------------------------------------------------
  States : Array_Boolean ( Weights'range ) := ( others => false );
  Train        : boolean := true;
  Propagation  : integer := 0;
  Neuron_Count : integer := Weights'last;
  Still_Propagating : boolean := false;
  Outputs_Count   : Array_Integer ( Pattern_Outputs'range );
  Overall_Outputs : Array_Boolean ( Pattern_Outputs'range );
begin
  if Debug_Mode then
    ClrScr;
  end if;
  loop
    if ( Propagation mod Neuron_Count = 0 ) or not Still_Propagating then
      Train := not Train;
      Propagation := 1;
      Outputs_Count := ( others => 0 );
      States := ( others => false );
      States ( Pattern_Inputs'range ) := Pattern_Inputs;
      if Debug_Mode then
	Move ( 0, 0 );
	Put ( "States freshened.  " );
      end if;
    else
      Propagation := Propagation + 1;
      if Debug_Mode then
	Move ( 0, 0 );
	Put ( "States released.   " );
      end if;
    end if;
    if Debug_Mode then
      if Train then
	Put ( "Training is ON.   " );
      else
	Put ( "Training is OFF.  " );
      end if;
      Put_Line ( "Propagation: " & integer'image ( Propagation ) & " " );
      Array_Boolean_Show ( States  );
      Array_Float_2_Show ( Weights );
    end if;
    Net ( States, Weights, Train );
    if Debug_Mode then
      Array_Boolean_Show ( States  );
      Array_Float_2_Show ( Weights );
    end if;
    Still_Propagating := false;
    for State in States'range loop
      Still_Propagating := Still_Propagating or States ( State );
    end loop;
    Boolean_Average ( Outputs_Count, States ( Pattern_Outputs'range ),
      Propagation, Overall_Outputs );
    if Debug_Mode then
      Put_Line ( "Overall Outputs" );
      Array_Boolean_Show ( Overall_Outputs );
      Pause;
    end if;
    if not Still_Propagating or else
      ( Propagation mod Neuron_Count = 0 ) then
	exit when Overall_Outputs = Pattern_Outputs;
    end if;
  end loop;
end Pattern_Train;

procedure Demo_Xor is
---------------------------------------------------------------------------
  Input_Count  : constant := 2;
  Output_Count : constant := 1;
  Neuron_Count : constant := Input_Count;
  Input_Last   : constant := Input_Count;
  Output_First : constant := Neuron_Count - Output_Count + 1;
  Weights : Array_Float_2 ( 1..Neuron_Count, 1..Neuron_Count )
    := ( others => ( others => 0.0 ) );
  Pattern_Count : constant := 4;
  Patterns : constant array ( 1..Pattern_Count )
    of Pattern_Type ( Input_Last, Output_First, Neuron_Count ) :=
      ( ( Input_Last, Output_First, Neuron_Count,
	  ( false, false ), ( others => false ) ),
	( Input_Last, Output_First, Neuron_Count,
	  ( false, true  ), ( others => true  ) ),
	( Input_Last, Output_First, Neuron_Count,
	  ( true, false  ), ( others => true  ) ),
	( Input_Last, Output_First, Neuron_Count,
	  ( true, true   ), ( others => false ) ) );
--  Pattern : integer;
begin
  loop
-- Randomly choose Training Set.
--    Pattern := integer (
--      NAS_Math_Rand_Gens_Real.Uniform_AB (
--        1.0, float ( Pattern_Count + 1 ) ) - 0.5 );
    for Pattern in Patterns'range loop
      Pattern_Train (
	Patterns ( Pattern ).Pattern_Inputs,
	Patterns ( Pattern ).Pattern_Outputs,
	Weights,
	Debug_Mode => true );
    end loop;
  end loop;
end Demo_Xor;

procedure Net (
	    States  : in out Array_Boolean;
	    Weights : in out Array_Float_2;
	    Train   : in     boolean := false ) is
---------------------------------------------------------------------------
  States_New : Array_Boolean ( States'range ) := States;
  Weighted_Sum    : Array_Float ( States'range ) := ( others => 0.0 );
begin
-- Determine next states based on present inputs, regardless of charge.
  for State in States'range loop
      for Weight in States'range loop
	if States ( Weight ) then
	  Weighted_Sum ( State ) := Weights ( State, Weight )
	    + Weighted_Sum ( State );
	end if;
      end loop;
      States_New ( State ) := Weighted_Sum ( State ) >= Threshhold;
  end loop;
  if Train then
    for State in States'range loop
Weight_Loop:
      for Weight in States'range loop
	if States ( Weight ) then -- weight was triggered
--          if NAS_Math_Rand_Gens_Real.Uniform_AB ( 0.0, 1.0 ) <=
--            ( 1.0 / ( float ( States'last ) ** 2 ) ) then
-- if tired, lower weight
	      if States ( State ) then -- tired
		Weight_Change ( Weights ( State, Weight ),
		  Direction => Down, Neuron_Count => States'last );
		exit Weight_Loop;
	      end if;
-- if charged, raise weight
	      if not States ( State ) then -- charged
		Weight_Change ( Weights ( State, Weight ),
		  Direction => Up, Neuron_Count => States'last );
		exit Weight_Loop;
	      end if;
--          end if;
	end if;
      end loop Weight_Loop;
    end loop;
  end if;
  for State in States'range loop
    States ( State ) := States_New ( State );
  end loop;
end Net;

procedure Weight_Change (
	    Weight       : in out float;
	    Direction    : in Direction_Type;
	    Neuron_Count : in positive ) is
---------------------------------------------------------------------------
  Weight_Delta : float := Threshhold / float ( Neuron_Count - 1 );
  Weight_Min   : float := - Threshhold;
  Weight_Max   : float := + Threshhold;
begin
  case Direction is
    when Down =>
      Weight := Weight - Weight_Delta;
      if Weight < Weight_Min then
	Weight := Weight_Min;
      end if;
    when Up =>
      Weight := Weight + Weight_Delta;
      if Weight > Weight_Max then
	Weight := Weight_Max;
      end if;
  end case;
end Weight_Change;

---------------------------------------------------------------------------
---------------------------------------------------------------------------
end ANN5S;