-----------------------------------
--                               --
--             Sens              --
--                               --
-----------------------------------
with Text_Io;                       use Text_Io;
with Neurologic;                    use Neurologic;
with PragmARC.REM_NN_Wrapper;       use PragmARC.REM_NN_Wrapper;
procedure Sens is
         
   Intel : Binary_Net;            
   Verax : Real := 0.0;
begin
   
   loop      
      Free(Verax, Intel);                 
      delay 1.0;
   end loop;
end Sens;

with Ada.Finalization;              use Ada.Finalization;
with PragmARC.REM_NN_Wrapper;       use PragmARC.REM_NN_Wrapper;
 
package Neurologic is
   
   type Binary_Net is new Limited_Controlled with private;
   procedure free(Value : in out Real; Net : in out Binary_Net);
         
private   
   type Value_Type is
      record
     Value : Node_Set(1..1) := (1 => 0.0);     
      end record;
   
   type Binary_Node;
   
   type Node_Access is access all Binary_Node;
   
   type Binary_Node is new Controlled with
      record
     Name  : Natural := 0;
     node : Value_Type;     
     Left  : Node_Access;
     Right : Node_Access;
      end record;
   procedure Initialize(Node : in out Binary_Node);
     
   type Binary_Net is new Limited_Controlled with
      record
     Root  : Node_Access;
     Count : Natural := 0;
      end record;      
   procedure Initialize(Net : in out Binary_Net);
end Neurologic;

with Text_Io;                      use Text_Io;
with PragmARC.Math.Functions;
 
package body Neurologic is
   
   
   
   procedure Initialize(Node : in out Binary_Node) is
   begin
      Put_Line("initialize node" );
      Put_line("initialize node done." );
   end Initialize;
   
   
   package Real_Math is new PragmARC.Math.Functions (Supplied_Real => Real);
   package Real_Io is new Text_Io.Float_Io(Real);
   
   
   procedure Initialize(Net : in out Binary_Net) is
      
      Init_Node : array (1..4) of Node_Set(1..2) :=
    (1 => (1 => 0.0, 2 => 0.0),
     2 => (1 => 0.0, 2 => 1.0),
     3 => (1 => 1.0, 2 => 0.0),
     4 => (1 => 1.0, 2 => 1.0));
    
      output : array (1..4) of Node_Set(1..1) :=
    (1 => (1 => 1.0),
     2 => (1 => 0.0),
     3 => (1 => 0.0),
     4 => (1 => 1.0));
      
      procedure Get_Input(Pattern : in Positive;
              Input   : out Node_Set;
              Desired : out Node_Set) is
      begin
     Input := Init_Node(Pattern);
     Desired := Output(Pattern);
      end Get_Input;
      
      package Binary_NN is new REM_NN(Num_Input_Nodes => 2,
                      Num_Hidden_Nodes => 2,
                      Num_Output_Nodes => 1,
                      Num_Patterns => 4,
                      New_Random_Weights => True,
                      Input_To_Output_Connections => False,
                      Weight_File_Name => "node 1.wgt",
                      Get_Input => Get_Input);
      
      
      Desired : Node_Set(1..1) := (1 => 0.0);
      RMS_Error : Real := 1.0;
      Error     : Real := 0.0;
      Converged  : constant real := 0.3;
      Current_Epoch : Long_integer := 0;
      Response : Node_Set(1..1);
      
      
   begin
      Put_Line("initialize net" );
      Net.Root := new Binary_Node;
      Net.Count := 1;
      loop
     for Pattern in 1..4 Loop
        Binary_NN.Train;
        Binary_NN.Respond (Pattern, Response);
        Desired := output(Pattern);                   
        Error :=
          Error + (Desired(1) - Response(1));        
        RMS_Error := RMS_Error + (Error ** 2);
        Error := 0.0;
     end loop;
     Binary_NN.Save_Weights;
     RMS_Error :=
       Real_Math.Sqrt(RMS_Error / Real (4)) ;
     Current_Epoch := Current_Epoch + 1;
     
     if (Current_Epoch > 10 and RMS_Error <= Converged) then
        exit;
     else
        Real_Io.Put(Rms_Error);
        New_Line;
     end if;
      end loop;      
        
      Put_Line("initialize net done." );
   end Initialize;            
   
   procedure Free(Value : in out Real; Net : in out Binary_Net) is
      
      
      
      
      Next : Node_Access := Net.Root;
      
      
      procedure Get_Input(Pattern : in Positive;
              Input   : out Node_Set;
              Desired : out Node_Set) is
      begin
     Input := (Next.Node.Value(1), Value);
     Desired := (1 => 0.0);
      end Get_Input;
     
      
      package Binary_NN is new REM_NN(Num_Input_Nodes => 2,
                      Num_Hidden_Nodes => 2,
                      Num_Output_Nodes => 1,
                      Num_Patterns => 1,
                      New_Random_Weights => False,
                      Input_To_Output_Connections => False,
                      Weight_File_Name => "node 1.wgt",
                      Get_Input => Get_Input);
      Response : Node_Set(1..1);
   begin
      
      Binary_NN.Respond(1, Response);
      Value := Response(1);   
      if Value > 0.5 then
     Value := 1.0;
      else
     Value := 0.0;
      end if;   
      Put_Line(Real'Image(Value));
   end Free;
end Neurologic;

procedure Free(Value : in out Real; Net : in out Binary_Net) is
      
      Next : Node_Access := Net.Root;
      
      procedure Get_Input(Pattern : in Positive;
              Input   : out Node_Set;
              Desired : out Node_Set) is
      begin
     Input := (Next.Node.Value(1), Value);
     Desired := (1 => 0.0);
      end Get_Input;
     
      
      package Binary_NN is new REM_NN(Num_Input_Nodes => 2,
                      Num_Hidden_Nodes => 2,
                      Num_Output_Nodes => 1,
                      Num_Patterns => 1,
                      New_Random_Weights => False,
                      Input_To_Output_Connections => False,
                      Weight_File_Name => "node 1.wgt",
                      Get_Input => Get_Input);
      Response : Node_Set(1..1);
   begin
      
      Binary_NN.Respond(1, Response);
      Value := Response(1);   
      if Value > 0.5 then
     Value := 1.0;
      else
     Value := 0.0;
      end if;   
      
      Add(Next, Value, Net.Count);
      Put("Adding " );
      Real_Io.Put(Value, 1, 1);
      Net.Count := Net.Count + 1;
      New_Line;
      Unfree(next, Value);
   end Free;

procedure Add(Root : in Node_Access; 
         Value : in out Real; 
         Count : in positive) is
      
      Next : Node_Access := Root;
      
      procedure Get_Input(Pattern : in Positive;
              Input   : out Node_Set;
              Desired : out Node_Set) is
      begin
     Input := (Next.Node.Value(1), Value);
     Desired := (1 => 0.0);
      end Get_Input;
      
      package Binary_NN is new REM_NN(Num_Input_Nodes => 2,
                      Num_Hidden_Nodes => 2,
                      Num_Output_Nodes => 1,
                      Num_Patterns => 1,
                      New_Random_Weights => False,
                      Input_To_Output_Connections => False,
                      Weight_File_Name => "node 1.wgt",
                      Get_Input => Get_Input);
      Response : Node_Set(1..1);                        
      New_Node : Node_Access;
   begin
      New_Node:= new Binary_Node;
      loop
     Binary_NN.Respond(1, Response);                
     Value := Response(1);                                   
     if Value > 0.5 then
        Value := 1.0;        
     else        
        Value := 0.0;                  
     end if;                    
     
     if Next.Node.Value(1) = 1.0 then
        if Next.Right /= null then
           Next := Next.Right;
        else
           Next.Right := New_Node;
           exit;
        end if;
     else
        if Next.Left /= null then
           Next := Next.Left;
        else           
           Next.Left := New_Node;           
           exit;
        end if;
     end if;
     
     
      end loop;
      New_Node.Name := Count;
      New_Node.Node := (Value => (others => Value));           
      New_Line;      
   end Add;

procedure Unfree(Root : in Node_Access; Value : in out Real) is
      Next : Node_Access := Root;
   begin      
      if Next.Left /= null then
     Put("Left, " );
     Unfree(Next.Left, Value);
      end if;        
      declare
     procedure Get_Input(Pattern : in Positive;
                 Input   : out Node_Set;
                 Desired : out Node_Set) is
     begin
        Input := (Next.Node.Value(1), Value);
        Desired := (1 => 0.0);
     end Get_Input;
     
     package Binary_NN is new REM_NN(Num_Input_Nodes => 2,
                     Num_Hidden_Nodes => 2,
                     Num_Output_Nodes => 1,
                     Num_Patterns => 1,
                     New_Random_Weights => False,
                     Input_To_Output_Connections => False,
                     Weight_File_Name => "node 1.wgt",
                     Get_Input => Get_Input);
     Response : Node_Set(1..1);
     
      begin
 
     Binary_NN.Respond(1, Response);                
     Value := Response(1);                                   
     if Value > 0.5 then
        Value := 1.0;
     else
        Value := 0.0;          
     end if;
     Next.Node.Value(1) := Value;
      end;
      if Next.Right /= null then
     Put("Right, " );
     Unfree(Next.Right, Value);        
      end if;
   end Unfree;