with PragmARC.REM_NN_Wrapper;
use PragmARC.REM_NN_Wrapper;
with PragmARC.Math.Functions;
with PragmARC.Ansi_Tty_Control;
use PragmARC.Ansi_Tty_Control;
with Generic_Extended_Binary_Code;
with Calendar;
use Calendar;
with Text_Io;
use Text_Io;
with Ada.Command_Line;
use Ada.Command_Line;
package body Intelligent_Desing is
package Coded_Word is new Generic_Extended_Binary_Code(T_Language);
use Coded_Word;
subtype T_Layer_Id is Natural range 1..8;
task type T_NN_Layer(Id : T_Layer_Id) is
entry Respond(Data : in Node_Set;
Response : out Node_set);
end T_NN_Layer;
type Layer_Access is access T_NN_Layer;
package Real_Math is new PragmARC.Math.Functions (Supplied_Real => Real);
package Real_Io is new Text_Io.Float_Io(Real);
type T_Data is record
Data : Node_Set(1..T_Code'Length*Sentence_Length) := (others => 0.0);
Response : Node_Set(1..T_Code'Length*Sentence_Length) := (others => 0.0);
end record;
type T_Data_Stack is array (1..8) of T_Data;
task body T_NN_Layer is
Date : Time := Clock + 60.0;
Data_Stack : T_Data_Stack;
Stack_Index : Natural := 0;
Buffer : Node_Set(1..T_Code'Length*Sentence_Length) := (others => 0.0);
begin
if Argument_Count > 0 and then
Argument(1) = "-i" then
declare
procedure Get_Init(Pattern : in Positive;
Input : out Node_Set;
Desired : out Node_Set) is
begin
Input := (others => 0.0);
Desired := (others => 0.0);
end Get_Init;
package NN_Init is new REM_NN
(
Num_Input_Nodes => Sentence_Length * T_Code'Length,
Num_Hidden_Nodes => Sentence_Length,
Num_Output_Nodes => Sentence_Length * T_Code'length,
Num_Patterns => 1,
New_Random_Weights => true,
Input_To_Output_Connections => False,
Weight_File_Name => "network" & T_Layer_Id'Image(Id) & ".wgt",
Get_Input => Get_Init
);
use NN_Init;
begin
NN_Init.Train;
NN_Init.Save_Weights;
end;
end if;
loop
select
accept Respond(Data : in Node_Set;
Response : out Node_set) do
declare
procedure Get(Pattern : in Positive;
Input : out Node_Set;
Desired : out Node_Set) is
begin
Input := Data;
Desired := (others => 0.0);
end Get;
package NN is new REM_NN
(
Num_Input_Nodes => Sentence_Length * T_Code'Length,
Num_Hidden_Nodes => Sentence_Length,
Num_Output_Nodes => Sentence_Length * T_Code'length,
Num_Patterns => 1,
New_Random_Weights => False,
Input_To_Output_Connections => False,
Weight_File_Name => "network" & T_Layer_Id'Image(Id) & ".wgt",
Get_Input => Get
);
use NN;
begin
Put("Layer_id : " & Natural'Image(Id));
Put("Respond..." );
NN.Respond(1,Response);
Put("Respond done." );
for I in Response'Range loop
if Response(I) > 0.5 then
Response(I) := 1.0;
else
Response(I) := 0.0;
end if;
end loop;
end;
Put("Push data into the stack..." );
if Stack_Index < Data_Stack'Length then
Data_Stack(Stack_Index + 1) := (Buffer, Data);
Stack_Index := Stack_Index + 1;
end if;
Put("Push done." );
Buffer := response;
Date := Clock + 60.0;
end Respond;
or
delay until Date;
if Stack_Index /= 0 then
declare
procedure Get_Expl(Pattern : in Positive;
Input : out Node_Set;
Desired : out Node_Set) is
begin
Input := Data_Stack(Pattern).data;
Desired := Data_Stack(Pattern).Response;
end Get_Expl;
package NN_Expl is new REM_NN
(
Num_Input_Nodes => Sentence_Length * T_Code'Length,
Num_Hidden_Nodes => Sentence_Length,
Num_Output_Nodes => Sentence_Length * T_Code'length,
Num_Patterns => Stack_index,
New_Random_Weights => False,
Input_To_Output_Connections => False,
Weight_File_Name => "network" & T_Layer_Id'Image(Id) & ".wgt",
Get_Input => Get_Expl
);
use NN_Expl;
Desired, Response : Node_Set(1..Sentence_Length * T_Code'Length) :=
(others => 0.0);
RMS_Error : Real := 0.0;
Error : Real := 0.0;
Converged : constant real := 1.0/Real(Stack_Index);
Max_Epochs : constant Positive := 2500;
Epoch : Natural := 0;
begin
loop
All_Patterns :
for Pattern in 1..Stack_index Loop
NN_Expl.Train;
NN_Expl.Respond (Pattern, Response);
for I in Response'Range loop
Error :=
Error + (Data_Stack(Pattern).Response(i) - Response(i) );
end loop;
RMS_Error := RMS_Error + ((Error/Real(Response'Length)) ** 2);
Error := 0.0;
end loop All_Patterns;
RMS_Error := Real_Math.Sqrt(RMS_Error / Real (Stack_index)) ;
if Epoch > 50 and then
((RMS_Error <= Converged) or
(Epoch >= Max_Epochs)) then
exit;
else
Text_Io.Put(Position(Id, 1));
Text_Io.Put ("Epoch" );
Text_Io.Put (Integer'Image (Epoch) );
Text_Io.Put(" => RMS_Error: " );
Real_Io.Put(RMS_Error);
end if;
Epoch := Epoch + 1;
end loop;
NN_Expl.Save_Weights;
end;
end if;
Stack_Index := 0;
Date := Clock + 60.0;
end select;
end loop;
end T_NN_Layer;
procedure Table2register(Table : in T_Lang_Array;
Register : out Node_Set) is
Code : T_Code;
begin
for I in 0..Table'length-1 loop
Code := Code_Of(Table(I+1));
for J in T_Code'Range loop
Register(I*T_Code'Length+J) := Code(J);
end loop;
end loop;
end Table2register;
procedure Register2table(Register : in Node_Set;
Table : out T_Lang_Array) is
Code : T_Code;
begin
for I in 0..Table'length-1 loop
Code := Register(I*T_Code'Length+1..I*T_Code'Length+T_Code'Length);
Table(I+1) := Item_Of(Code);
end loop;
end Register2table;
type T_Layer_Stack is array(T_Layer_Id'range) of Layer_access;
task body Life_Cycle is
Brain : T_Layer_Stack;
Input, Output : Node_Set(1..T_Code'Length*Sentence_Length) := (others => 0.0);
Section : T_Layer_Id := T_Layer_Id'first;
Available : Boolean := False;
begin
for I in brain'Range loop
Brain(I) := new T_NN_Layer(I);
end loop;
loop
select
accept Compute(Data : in T_Lang_Array;
Response : out T_Lang_Array) do
Table2register(Data, Input);
for I in Reverse T_Layer_Id'First..section loop
select
Brain(I).Respond(Input, Output);
Input := Output;
or
delay 1.0;
exit;
end select;
end loop;
if Section < T_Layer_Id'Last then
Section := Section + 1;
else
Section := T_Layer_Id'First;
end if;
Register2table(Output, Response);
end Compute;
or
when Available =>
accept Compute(Info : out T_Lang_Array) do
Register2table(Output, Info);
Available := False;
end Compute;
or
delay 180.0;
for I in Reverse T_Layer_Id'First..section loop
Brain(I).Respond(Output, Input);
Output := input;
end loop;
if Section < T_Layer_Id'Last then
Section := Section + 1;
else
Section := T_Layer_Id'First;
end if;
Available := True;
end select;
end loop;
end Life_Cycle;
end Intelligent_Desing;