with DC_Curs, DC_Keyb, DC_Neur, DC_Scrn, DC_Type;
use                    DC_Neur, DC_Scrn, DC_Type;

procedure XOR_Net is
---------------------------------------------------------------------------
---------------------------------------------------------------------------
---------------------------------------------------------------------------
Neuron_Count : constant := 5;
Sets_Count : constant := 4;
type Training_Inputs_Type is array ( 1..Sets_Count )
       of Array_Float ( 1..Neuron_Count );
Training_Inputs : constant Training_Inputs_Type
  := ( ( 0.0, 0.0, others => 0.0 ),
       ( 0.0, 1.0, others => 0.0 ),
       ( 1.0, 0.0, others => 0.0 ),
       ( 1.0, 1.0, others => 0.0 ) );
type Training_Outputs_Type is array ( 1..Sets_Count ) of boolean;
Training_Outputs : constant Training_Outputs_Type
  := ( false, true, true, false );
type Training_Sets_Type is
       record
	 Training_Inputs  : Training_Inputs_Type;
	 Training_Outputs : Training_Outputs_Type;
       end record;
Training_Sets : constant Training_Sets_Type
  := ( Training_Inputs  => Training_Inputs,
       Training_Outputs => Training_Outputs );

procedure Net (
	    Neuron_Count  : in positive;
	    Training_Sets : in Training_Sets_Type ) is
---------------------------------------------------------------------------
---------------------------------------------------------------------------
  Neuron_Init : Neuron_Type :=
    ( Outputs_Count  => Neuron_Count,
      Weights        => ( others => 0.5 ),
      Weights_Growth => ( others => 0.0 ),
      Excitation     => 0.0,
      Charge         => 1.0,
      Is_Trained     => true );
  type Net_Type is array ( 1..Neuron_Count )
    of Neuron_Type ( Neuron_Count );
  Net : Net_Type := ( others => Neuron_Init );
  Net_Excitations : Array_Float ( 1..Neuron_Count );
  Net_States : Array_Boolean ( 1..Neuron_Count );
  Inputs,
  Inputs_New,
  Weighted_Outputs : Array_Float ( 1..Neuron_Count )
    := ( others => 0.0 );
  Is_Charged : Array_Boolean ( 1..Neuron_Count ):= ( others => true );
  Layer : positive;
  Not_Trained : boolean;
  Old_Net : Net_Type;
  Output_Time : constant integer := ( Neuron_Count + 1 ) / 2; -- := Layers!
  Prior_Net : Net_Type;
  Propagation : integer;
  Weights_Unchanged : boolean;
---------------------------------------------------------------------------
---------------------------------------------------------------------------

procedure Inputs_Reset ( Training_Inputs : in     Array_Float;
			 Inputs          : in out Array_Float ) is
---------------------------------------------------------------------------
begin
  if Propagation mod Output_Time = 0 then
    for index in 1..2 loop
      Inputs ( index )
	:= Training_Inputs ( index );
    end loop;
  end if;
end Inputs_Reset;

procedure Inputs_Show ( Inputs : in Array_Float ) is
---------------------------------------------------------------------------
begin
  Array_Float_Show ( Inputs );
  Put_Line;
  Put_Line;
end Inputs_Show;

procedure Inputs_Sum ( Weighted_Outputs : in Array_Float ) is
---------------------------------------------------------------------------
begin
  for index in Weighted_Outputs'range loop
    Inputs_New ( index )
      := Inputs_New ( index ) + Weighted_Outputs ( index );
  end loop;
end Inputs_Sum;

function  Is_Trained ( Training_Output : in boolean ) return boolean is
---------------------------------------------------------------------------
  Temp : boolean := false;
begin
  if Propagation mod Output_Time = 0 then
    if Training_Output = Net_States ( Neuron_Count ) then
	if ( Net ( Neuron_Count ).Charge >= 1.0 ) or else
	  Net_States ( Neuron_Count ) then
	    Temp := true;
	end if;
    end if;
  end if;
  return Temp;
end Is_Trained;

procedure Neuron_Charge (
	    Neuron       : in out Neuron_Type;
	    Layer        : in     positive;
	    Total_Charge : in     boolean;
	    Is_Charged   :    out boolean ) is
---------------------------------------------------------------------------
--  Layers : constant := 3;
begin
  if Neuron.Charge < 1.0 then
    Neuron.Charge := Neuron.Charge
      + ( 1.0 / float ( Output_Time ) );
      --Layers * Layer ) ); -- ( Output_Time * Layer * 2 ) );
    if Neuron.Charge > 0.999 then
      Neuron.Charge := 1.0;
    end if;
    if Total_Charge then
      Neuron.Charge := 1.0;
    end if;
    Is_Charged := Neuron.Charge >= 1.0;
  else
    Is_Charged := true;
  end if;
end Neuron_Charge;

procedure Net_Reset is
---------------------------------------------------------------------------
begin
  for index in Net'range loop
    Net ( index ).Charge := 1.0;
    Net ( index ).Excitation := 0.0;
    Net ( index ).Weights_Growth := ( others => 0.0 );
  end loop;
end Net_Reset;

procedure Net_Show is
---------------------------------------------------------------------------
begin
  for index in Net'range loop
    Neuron_Show ( Net ( index ) );
    Put_Line ( "" );
  end loop;
  Put_Line ( "" );
end Net_Show;

procedure States_Show ( Net_States : in Array_Boolean ) is
---------------------------------------------------------------------------
begin
  for index in Net_States'range loop
    if Net_States ( index ) then
      Put ( " " & boolean'image ( Net_States ( index ) ) & "   " );
    else
      Put ( " " & boolean'image ( Net_States ( index ) ) & "  " );
    end if;
  end loop;
  Put_Line;
end States_Show;

function  Weights_Are_Same ( Net1, Net2 : in Net_Type ) return boolean is
---------------------------------------------------------------------------
  Temp : boolean := true;
begin
  for index in Net'range loop
    Temp := Temp and
      ( Net1 ( index ).Weights = Net2 ( index ).Weights );
    exit when not Temp;
  end loop;
  return Temp;
end Weights_Are_Same;

procedure Weights_Disconnect is
---------------------------------------------------------------------------
begin
  Net ( 1 ).Weights ( 2 ) := 0.0;
  Net ( 1 ).Weights ( 5 ) := 0.0;
  Net ( 2 ).Weights ( 5 ) := 0.0;
  Net ( 3 ).Weights ( 4 ) := 0.0;
  for index in Net'range loop
    for index8 in 1..index loop
      Net ( index ).Weights ( index8 ) := 0.0;
    end loop;
  end loop;
end Weights_Disconnect;

procedure Inputs_Apply ( Training_Inputs : in Array_Float;
			 Training_Output : in boolean ) is
---------------------------------------------------------------------------
  Inputs : Array_Float ( Training_Inputs'range );
begin
  loop
    Propagation := 0;
    Prior_Net := Net;
    Inputs := Training_Inputs;
    loop
      Propagation := Propagation + 1;
      DC_Curs.Move ( 0, 35 );
      Put_Line ( "Propagation" & integer'image ( Propagation ) & " " );
      Put_Line ( "Inputs" );
      Inputs_Show ( Inputs );
      Put_Line ( "Original Weights" );
      Net_Show;
      for index in Net'range loop
	Neuron_Resolve
	  ( Inputs ( index ),
	    Net ( index ),
	    Weighted_Outputs,
	    Net_States ( index ) );
	Inputs_Sum ( Weighted_Outputs );
	Neuron_Charge (
	  Neuron => Net ( index ),
	  Layer => ( index + 1 ) / 2,
	  Total_Charge => ( index = 1 ) or ( index = 2 ),
	  Is_Charged => Is_Charged ( index ) );
      end loop;
      Inputs := Inputs_New;
      Inputs_New := ( others => 0.0 );
      Put_Line ( "Net States and New Inputs" );
      States_Show ( Net_States );
      Inputs_Show ( Inputs );
      Inputs_Reset ( Training_Inputs, Inputs );
      for index in Net_Excitations'range loop
	Net_Excitations ( index ) := Net ( index ).Excitation;
      end loop;
      for index in Net'range loop
	Neuron_Train
	  ( Is_Trained         => Net ( index ).Is_Trained,
	    Was_Fired          => Net_States ( index ),
	    Net_Inputs         => Inputs,
	    Net_Excitations    => Net_Excitations,
	    Targets_Charged    => Is_Charged,
	    Weights_Growth     => Net ( index ).Weights_Growth,
	    Weights            => Net ( index ).Weights
	  );
      end loop;
      Put_Line ( "Adjusted Weights" );
      Weights_Disconnect;
      Net_Show;
      if Weights_Unchanged then
	DC_Keyb.Pause;
      end if;
      exit when Is_Trained ( Training_Output );
      Not_Trained := false;
    end loop;
    Net_Reset;
    exit when Prior_Net = Net;
    Prior_Net := Net;
  end loop;
end Inputs_Apply;

---------------------------------------------------------------------------
---------------------------------------------------------------------------
begin
  for Main_Loop in 1..100 loop
    DC_Curs.Move ( 0, 0 );
    Put_Line ( "Main Loop" & integer'image ( Main_Loop ) & " " );
    Not_Trained := true;
    Weights_Unchanged := Weights_Are_Same ( Net, Old_Net );
    if Weights_Unchanged and then ( Main_Loop /= 1 ) then
      Put_Line ( "Weights unchanged." );
      DC_Keyb.Pause;
      DC_Scrn.ClrScr;
    end if;
    Old_Net := Net;
    for Training_Set in 1..Sets_Count loop
      DC_Curs.Move ( 0, 15 );
      Put ( "Training Set" & integer'image ( Training_Set ) & " " );
      Inputs_Apply (
	Training_Inputs => Training_Sets.Training_Inputs ( Training_Set ),
	Training_Output => Training_Sets.Training_Outputs ( Training_Set ) );
    end loop;
    exit when Not_Trained;
  end loop;
end Net;

---------------------------------------------------------------------------
---------------------------------------------------------------------------
begin
  DC_Scrn.ClrScr;
  Net ( Neuron_Count => Neuron_Count,
	Training_Sets => Training_Sets );
  Put_Line ( "" );
  Put_Line ( "Network trained." );
  DC_Keyb.Pause;
---------------------------------------------------------------------------
---------------------------------------------------------------------------
---------------------------------------------------------------------------
end XOR_Net;