with PragmARC.REM_NN_Wrapper;
use PragmARC.REM_NN_Wrapper;
with PragmARC.Math.Functions;
with Generic_Extended_Binary_Code;
with Direct_Io;
with Time_To_Date, Ada.Strings.Fixed, Split_Heure, Text_Io;
use Time_To_Date, Ada.Strings, Split_Heure, Text_Io;
with Ada.Characters.Handling;
use Ada.Characters.Handling;
with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;
with Ada.Directories;
use Ada.Directories;
with PragmARC.Wrapping;
package body Ai is
task body T_Console is
Status : Unbounded_String;
Date : String(1..80) := (others => Character'Val(32));
Title : String(1..80) := (others => Character'Val(32));
End_Of_Task : Boolean := False;
Word : String(1..64) := (others => Character'Val(32));
Word_Last : Natural := 0;
Response,
Line : T_Lang_Array(1..Sentence_lenght) := (others => 0);
Line_Last : Natural := 0;
Length : Natural := 0;
Count_Line : Integer := 0;
Available : Boolean := False;
Input_Message : T_Message_Box := (new String ' (Logname.all),
(others => 0));
Output_Message : T_Message_Box := (null,
(others => 0));
Data_Entry : Boolean := False;
Data : T_Lang_Array(1..Sentence_Lenght) := (others => Keyword("" ));
begin
Fixed.Move("Prophet Server",
Title, Error, Center, Space);
while not End_Of_Task loop
select
Message_Io.Look(Logname.all, available);
if Available then
Message_Io.Send(Logname.all, Output_message);
Response := Output_Message.Message;
end if;
or
delay 0.05;
end select;
select
accept Receive(Char : in Character) do
begin
if Is_Special(Char) then
case Char is
when Character'Val(32) =>
if Line_Last < Line'Length and
Word_Last /= 0 then
begin
Line(Line_Last + 1) :=
Keyword(Word(1..Word_Last));
Line_Last := Line_Last + 1;
Word := (others => Character'Val(32));
Word_Last := 0;
exception
when others => -- Specification_Error =>
null;
end;
end if;
when others =>
if Word_Last < Word'Length then
Word(Word_Last + 1) := Char;
Word_Last := Word_Last + 1;
end if;
end case;
else
case Char is
when Character'Val(10) =>
if Line_Last < Line'Length and
Word_Last /= 0 then
begin
Line(Line_Last + 1) :=
Keyword(Word(1..Word_Last));
Line_Last := Line_Last + 1;
Input_Message.Message := Line;
Message_Io.Receive(Program_Logname, Input_Message);
Line := (others => 0);
Line_Last := 0;
Word := (others => Character'Val(32));
Word_Last := 0;
exception
when others => -- Specification_Error =>
null;
end;
end if;
when Character'Val(127) =>
if Word_Last > 0 then
Word(Word_Last) := Character'Val(32);
Word_Last := Word_Last - 1;
elsif Line_Last /= 0 then
Line(Line_Last) := 0;
Line_Last := Line_Last - 1;
end if;
when others =>
if Word_Last < Word'Length then
Word(Word_Last + 1) := Char;
Word_Last := Word_Last + 1;
end if;
end case;
end if;
exception
when others =>
null;
end;
Put(Clear_Screen);
Fixed.Move(Full_Datify_String(Clock),
Date, Error, center, Space);
Put_Line(Bold_Mode & Title & Normal);
Put_Line(Yellow & Date & Normal);
New_Line;
Put_Line(Green & To_String(Status) & Normal);
New_Line;
Put('#' & Blue);
Length := 0;
for Key in 1..Response'length loop
begin
Put(Image(Response(Key)) & ' ');
Length := Length + Image(Response(Key))'Length + 1;
exception
when others => -- Specification_Error =>
null;
end;
end loop;
Count_Line := 10;
Count_Line := Count_line - (Length/80+1);
if Count_Line > 0 then
New_Line(Text_Io.Count(Count_Line));
else
New_Line;
end if;
Length := 0;
Put(normal & '#' & Blue);
for Key in 1..Line_Last loop
Put(Image(Line(Key)) & ' ');
Length := Length + Image(Line(Key))'Length+1;
end loop;
Put(Red & Word(1..Word_Last) & Normal);
end Receive;
or
accept Halt do
End_Of_Task := True;
end Halt;
or
delay 0.25;
select
Life_Cycle.Status(Status, Data_Entry, data);
or
delay 0.1;
end select;
Put(Clear_Screen);
Put_Line(Bold_mode & Title & normal);
Fixed.Move(Full_Datify_String(Clock),
Date, Error, Center, Space);
Put_Line(Yellow & Date & Normal);
New_Line;
Put_line(Green & To_String(Status) & Normal);
New_Line;
if Data_Entry then
for Key in 1..data'length loop
begin
Put(Image(data(Key)) & ' ');
Length := Length + Image(data(Key))'Length + 1;
exception
when others => -- Specification_Error =>
null;
end;
end loop;
end if;
New_Line;
Put('#' & blue);
Length := 0;
Count_Line := 10;
for Key in 1..Response'length loop
begin
Put(Image(Response(Key)) & ' ');
Length := Length + Image(Response(Key))'Length + 1;
exception
when others => -- Specification_Error =>
null;
end;
end loop;
Count_Line := Count_line - (Length/80+1);
if Count_Line > 0 then
New_Line(Text_Io.Count(Count_Line));
else
New_Line;
end if;
Length := 0;
Put(Normal & '#' & Blue);
for Key in 1..Line_Last loop
Put(Image(Line(Key)) & ' ');
Length := Length + Image(Line(Key))'Length + 1;
end loop;
Put(Red & Word(1..Word_Last) & Normal);
end select;
end loop;
end T_Console;
--package Real_Io is new Text_Io.Float_Io(Real);
package Real_Math is new PragmARC.Math.Functions (Supplied_Real => Real);
package Coded_Word is new Generic_Extended_Binary_Code(T_Language);
use Coded_Word;
subtype T_Register is Node_Set(1..Sentence_Lenght*T_Code'length);
package Register_Io is new Direct_Io(T_Register);
use Register_Io;
procedure Table2register(Table : in T_Lang_Array;
Register : out T_Register) 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 T_Register;
Table : out T_Lang_Array) is
Code : T_Code;
begin
for I in 0..Table'Length-1 loop
begin
Code := Register(I*T_Code'Length+1..I*T_Code'Length+T_Code'Length);
Table(I+1) := Item_Of(Code);
exception
when others =>
null;
end;
end loop;
end Register2table;
-- Gadget --
type T_Cross is ('-', '\', '|', '/');
package Cross_Wrapping is new PragmARC.Wrapping(T_Cross);
use Cross_Wrapping;
task Network_Manager is
entry Start(Train_Length : in Positive;
Train_Filename : in String;
Network_Filename : in String;
Reuse_Network : in boolean);
entry Status(Info : out Ada.Strings.Unbounded.Unbounded_String;
Available : out Boolean; Sentence : out T_Lang_array);
entry Respond(Network : in String;
Register : in out T_Register);
entry Stop;
entry Halt;
end Network_Manager;
task body Network_Manager is
Train_File,
Prob_File : Register_Io.File_Type;
Prob_Filename : constant String := "data/registers/prob.bin";
Filename, Network : Unbounded_String;
Length : Positive;
Reuse : Boolean;
End_Of_Task, Suspended : Boolean := False;
Opened : Boolean := False;
begin
while not End_Of_Task loop
Suspended := false;
select
accept Start(Train_Length : in Positive;
Train_Filename : in String;
Network_Filename : in String;
Reuse_Network : in boolean) do
Length := Train_Length;
Network := To_Unbounded_String(Network_Filename);
Reuse := Reuse_Network;
Filename := To_Unbounded_String(Train_Filename);
Text_Io.Put_Line("TOTO 6" );
end Start;
or
accept Respond(Network : in String;
Register : in out T_Register) do
Register_Io.create(Prob_File,
Register_Io.Out_File,
Prob_Filename);
Register_Io.Write(Prob_File, Register);
Register_Io.Close(Prob_File);
declare
procedure Get_Expl(Pattern : in Positive;
Input : out Node_Set;
Desired : out Node_Set) is
Register : T_Register := (others => 0.0);
begin
Register_Io.Open(Prob_File,
Register_Io.In_File,
Prob_Filename);
Read(Prob_File,
Register,
1);
Input := Node_Set(Register);
Desired := (others => 0.0);
Register_Io.Close(Prob_File);
end Get_Expl;
package REM_NN_Expl is new REM_NN
(
Num_Input_Nodes => T_Register'length,
Num_Hidden_Nodes => T_Register'Length/T_Code'Length,
Num_Output_Nodes => T_Register'length,
Num_Patterns => 1,
New_Random_Weights => False,
Input_To_Output_Connections => False,
Weight_File_Name => Network,
Get_Input => Get_Expl
);
use REM_NN_Expl;
begin
Respond(1, Register);
end;
Register_Io.open(Prob_File,
Register_Io.Out_File,
Prob_Filename);
Register_Io.Delete(Prob_File);
Suspended := True;
end Respond;
or
accept Halt do
Suspended := True;
End_Of_Task := True;
end Halt;
end select;
if not Suspended then
Text_Io.Put_Line("TOTO 7" );
Register_Io.Open(Train_File,
Register_Io.In_File,
To_String(Filename));
declare
procedure Get_Train(Pattern : in Positive;
Input : out Node_Set;
Desired : out Node_Set) is
Register : T_Register := (others => 0.0);
begin
Read(Train_File,
Register,
Register_Io.Count(Pattern*2-1));
Input := Node_Set(Register);
Read(Train_File,
Register,
Register_Io.Count(Pattern*2));
Desired := Node_Set(Register);
end Get_Train;
package REM_NN_Train is new REM_NN
(
Num_Input_Nodes => T_Register'length,
Num_Hidden_Nodes => T_Register'Length/T_Code'Length,
Num_Output_Nodes => T_Register'length,
Num_Patterns => Length,
New_Random_Weights => not Reuse,
Input_To_Output_Connections => False,
Weight_File_Name => To_String(Network),
Get_Input => Get_Train
);
use REM_NN_Train;
Register : T_Register := (others => 0.0);
Response : REM_NN_Train.Output_Set := (others => 0.0);
Desired_Output : array (1..Length) of
REM_NN_Train.Output_Set;
RMS_Error : Real := 0.5;
Error : Real := 0.0;
Converged : constant real := 0.05;
Max_Epochs : constant Positive := Length*500;
Epoch : Natural := 0;
Cross : T_Cross := T_Cross'Val(0);
-- Time indication
Date : Time := Clock;
Heure, Minute, Seconde, Reste : Natural := 0;
begin
Text_Io.Put_Line("TOTO 8" );
for I in 1..Desired_Output'Length loop
Register_Io.Read(train_File,
Register,
Register_Io.Count(i*2));
Desired_Output(I) := REM_NN_Train.Output_Set(Register);
end loop;
Date := Clock;
while not Suspended loop
select
accept Respond(Network : in String;
Register : in out T_Register) do
Register_Io.create(Prob_File,
Register_Io.Out_File,
Prob_Filename);
Register_Io.Write(Prob_File, Register);
Register_Io.Close(Prob_File);
if Register_Io.Is_Open(Train_File) then
Opened := True;
Register_Io.Close(Train_File);
end if;
declare
procedure Get_Expl(Pattern : in Positive;
Input : out Node_Set;
Desired : out Node_Set) is
Register : T_Register := (others => 0.0);
begin
Register_Io.Open(Prob_File,
Register_Io.In_File,
Prob_Filename);
Read(Prob_File,
Register,
1);
Input := Node_Set(Register);
Desired := (others => 0.0);
Register_Io.Close(Prob_File);
end Get_Expl;
package REM_NN_Expl is new REM_NN
(
Num_Input_Nodes => T_Register'length,
Num_Hidden_Nodes => T_Register'Length/T_Code'Length,
Num_Output_Nodes => T_Register'length,
Num_Patterns => 1,
New_Random_Weights => False,
Input_To_Output_Connections => False,
Weight_File_Name => Network,
Get_Input => Get_Expl
);
use REM_NN_Expl;
begin
REM_NN_Expl.Respond(1, Register);
end;
if Opened then
Register_Io.Open(Train_File,
Register_Io.In_File,
To_String(Filename));
Opened := False;
end if;
end Respond;
or
accept Status(Info : out Ada.Strings.Unbounded.Unbounded_String;
Available : out Boolean; Sentence : out T_Lang_array) do
Split(Clock - Date, Heure, Minute, Seconde, reste);
Info :=
To_Unbounded_String
(" Trainning Expe file of length :" &
Integer'Image(Length) &
Character'Val(10) &
" Epoch : " &
Integer'Image(Epoch) &
" ; " &
"RMS_Error : " &
Real'Image(RMS_Error) &
" " &
(Character'value
(T_Cross'image(Cross)))
& " " &
Integer'Image(Integer((Converged/RMS_error)*100.0)) &
'%' &
Integer'Image(Heure) &
':' &
Integer'Image(Minute) &
':' &
Integer'Image(Seconde) &
':' &
Integer'Image(Reste) & Latin_1.Lf &
Reverse_Video &
Fixed."*"(Integer((((80.0/RMS_Error)/(20.0))))+1,' ') & Normal);
Available := True;
for I in Register'Range loop
if Register(I) > 0.5 then
Register(I) := 1.0;
else
Register(I) := 0.0;
end if;
end loop;
Register2Table(Response, Sentence);
Cross := Wrap_Succ(Cross);
end Status;
or
when RMS_Error < Converged or Epoch > Max_Epochs =>
accept Stop do
Suspended := True;
end Stop;
or
delay 0.01;
if ((Epoch <= Max_Epochs ) and
(RMS_Error > Converged)) or
Epoch < 50 then
for Pattern in 1..Length loop
REM_NN_Train.Train;
REM_NN_Train.Respond (Pattern, Response);
for I in Response'Range loop
Error := Error + (Desired_Output(Pattern)(i) - Response(i) );
end loop;
RMS_Error := RMS_Error + ((Error/Real(Response'Length)) ** 2);
Error := 0.0;
Response := (others => 0.0);
end loop;
RMS_Error := Real_Math.Sqrt(RMS_Error/Real(Length));
Epoch := Epoch + 1;
end if;
end select;
end loop;
REM_NN_Train.Save_Weights;
end;
Register_Io.Close(Train_File);
end if;
end loop;
end Network_Manager;
task body Life_Cycle is
Source_File : Text_Io.File_Type;
Source_Filename : Unbounded_String;
Word : String(1..64) := (others => Character'Val(32));
Word_Last : Natural := 0;
Char : Character;
Sentence : T_Lang_Array(1..Sentence_Lenght) := (others => 0);
Sentence_Index : Natural := 0;
Train_File,
Prob_File : Register_Io.File_Type;
Train_Filename : Unbounded_String;
Register, Feed_back : T_Register := (others => 0.0);
Train_Length : Natural := 0;
End_Of_Task : Boolean := False;
Input : T_Message_Box := (null, (others => 0));
Output : T_Message_Box := (new String ' (Program_Logname), (others => 0));
Available : Boolean := False;
Cross : T_Cross := T_Cross'Val(0);
-- Time indication
Date_string : String(1..80) := (others => Character'Val(32));
Banner : String(1..80) := (others => Character'Val(32));
-- Experience set
Expe_Filename : constant String := "data/registers/expe.bin";
Expe_File : Register_Io.File_Type;
Expe_Length : Natural := 0;
Free : Boolean := True;
Info : Unbounded_String;
begin
accept Start(Date : out Time) do
Date := Clock;
Put_Line("TOTO -1" );
Register_Io.Create(Prob_File,
Register_Io.Out_File,
Expe_filename);
Register_Io.Write(Prob_File, Register);
Register_Io.Close(Prob_File);
if not Exists("data/networks/Expe.wgt" ) then
Put_Line("TOTO 0" );
Register_Io.Create(Expe_File,
Register_Io.Out_File,
Expe_filename);
Register_Io.Write(Expe_File,
Feed_Back,
Register_Io.Size(Expe_File)+1);
Register_Io.Write(Expe_File,
register,
Register_Io.Size(Expe_File)+1);
Register_Io.Close(Expe_File);
Put_Line("TOTO 1" );
Expe_Length := 1;
Put_Line("TOTO 2" );
Network_Manager.Start(
Expe_Length,
Expe_Filename,
"data/networks/Expe.wgt",
False
);
Put_Line("TOTO 3" );
while not Free loop
select
Network_Manager.Stop;
Free := True;
or
delay 0.05;
Put(Clear_Screen);
Text_Io.New_Line(2);
Fixed.Move(Fixed."*"(80,Character'Val(32)), Date_string, Ada.Strings.Error, Center, space);
Fixed.Move(Full_Datify_String(Clock), Date_string, Ada.Strings.Error, Center);
Put (Clear_Screen);
Fixed.Move("Prophet Server" , Banner, Ada.Strings.Error, Center);
Put_line(Normal & Bold_mode & Banner & Normal);
Put_Line(Yellow & Date_String & normal);
select
Network_Manager.Status(Info, Available, Sentence);
Put(To_String(Green & Info & normal));
or
delay 0.1;
end select;
end select;
end loop;
Free := False;
end if;
end Start;
Put_Line("TOTO 5" );
while not End_Of_Task loop
select
accept Halt do
Network_Manager.Halt;
End_Of_Task := True;
end Halt;
or
accept Read_File(Filename : in String;
Reuse_network : in boolean) do
if Exists("data/sources/" & Filename) then
Put_Line("Reading source file data/sources/" &
Filename);
Source_Filename :=
To_Unbounded_String("data/sources/" &
Filename);
Train_Filename :=
To_Unbounded_String("data/registers/" &
Base_Name(Filename) & ".bin" );
Put_Line("Creating train file..." );
Register_Io.Create(Train_File,
Register_Io.Out_File,
To_String(Train_Filename));
Put_Line("opening source file..." );
Text_Io.Open(Source_File,
Text_Io.In_File,
To_String(Source_Filename));
Text_Io.Put_Line("Reading file for train... Please wait ! " );
while not Text_Io.End_Of_File(Source_File) loop
begin
Text_Io.Get_Immediate(Source_File, Char);
case Char is
when Character'Val(10) | -- 'Enter' ;
Character'Val(33) | -- '!' ;
Character'Val(46) | -- '.' ; Point.
Character'Val(59) | -- ';' ; .
Character'Val(63) => -- '?' ; .
if Word_Last /= 0 then
Sentence(Sentence_Index + 1) :=
Keyword(To_Lower(Word(1..Word_Last)));
Word_Last := 0;
Sentence_Index := Sentence_Index + 1;
Table2register(Sentence, Register);
Register_Io.Write(Train_File,
Register,
Register_Io.Size(Train_File)+1);
Register := (others => 0.0);
Sentence := (others => 0);
Sentence_Index := 0;
Put('.');
end if;
when Character'Val(32) |
Character'Val(44) =>
if Word_Last /= 0 then
Sentence(Sentence_Index + 1) :=
Keyword(To_Lower(Word(1..Word_Last)));
Word_Last := 0;
Sentence_Index := Sentence_Index + 1;
end if;
when others =>
Word(Word_Last + 1) := Char;
Word_Last := Word_Last + 1;
end case;
exception
when others =>
Text_Io.Put_Line(Word(1..Word_Last));
Word_Last := 0;
end;
end loop;
if Word_Last /= 0 then
Sentence(Sentence_Index + 1) :=
Keyword(To_Lower(Word(1..Word_Last)));
Word_Last := 0;
Sentence_Index := Sentence_Index + 1;
Table2register(Sentence, Register);
Register_Io.Write(Train_File,
Register,
Register_Io.Size(Train_File)+1);
Register := (others => 0.0);
Sentence := (others => 0);
Sentence_Index := 0;
Put('.');
end if;
New_Line;
Text_Io.Close(Source_File);
Text_Io.Put_Line("Done." );
Train_Length := Natural(Size(Train_File)/2);
Register_Io.Close(Train_File);
Network_Manager.Start(
Train_Length,
To_String(Train_Filename),
"data/networks/network.wgt",
Reuse_network);
Put_Line("Initialize network..." );
while not Free loop
select
Network_Manager.Stop;
Free := True;
or
delay 0.05;
Put(Clear_Screen);
Text_Io.New_Line(2);
Fixed.Move(Fixed."*"(80,Character'Val(32)), Date_string, Ada.Strings.Error, Center, space);
Fixed.Move(Full_Datify_String(Clock), Date_string, Ada.Strings.Error, Center);
Put (Clear_Screen);
Fixed.Move("Prophet Server" , Banner, Ada.Strings.Error, Center);
Put_line(Normal & Bold_mode & Banner & Normal);
Put_Line(Yellow & Date_String & normal);
select
Network_Manager.Status(Info, Available, Sentence);
Put(To_String(Green & Info & normal));
or
delay 0.1;
end select;
end select;
end loop;
Free := False;
end if;
end Read_File;
or
delay 1.0;
Message_IO.Look(Program_Logname, Available);
if Available then
Text_Io.Put("Message available" );
Message_Io.Send(Program_Logname, Input);
Table2register(Input.Message, Register);
Feed_Back := Register;
Text_Io.Put("respond train" );
Network_Manager.Respond("data/networks/network.wgt", Register);
for I in Register'Range loop
if Register(I) > 0.5 then
Register(I) := 1.0;
else
Register(I) := 0.0;
end if;
end loop;
Register_Io.Open(Expe_File,
Register_Io.Out_File,
Expe_filename);
Register_Io.Write(Expe_File,
register,
Register_Io.Size(Expe_File)+1);
Register_Io.Write(Expe_File,
Feed_back,
Register_Io.Size(Expe_File)+1);
Expe_Length := Natural(Size(Expe_File)/2);
Register_Io.Close(Expe_File);
Text_Io.Put("respond expe" );
Network_Manager.respond("data/networks/Expe.wgt", Feed_back);
for I in Feed_Back'Range loop
if Feed_Back(I) > 0.5 then
Feed_Back(I) := 1.0;
else
Feed_Back(I) := 0.0;
end if;
end loop;
Register2table(Feed_Back, Output.Message);
Output.Logname := new String ' (Program_Logname);
Message_IO.Receive(Input.Logname.all, Output);
Text_Io.Put("train expe" );
Network_Manager.Start(
Expe_Length,
Expe_Filename,
"data/networks/Expe.wgt",
false);
Text_Io.Put("plantage 0" );
Free := false;
else
select
when Free =>
accept Status(Info : out Ada.Strings.Unbounded.Unbounded_String;
Available : out Boolean; Sentence : out T_Lang_array) do
Info := To_Unbounded_String(" I'm free... Enjoy !" &
" " &
(Character'value
(T_Cross'image
(Cross))) & " " );
Available := False;
Cross := Wrap_Succ(Cross);
end Status;
or
when not Free =>
accept Status(Info : out Ada.Strings.Unbounded.Unbounded_String;
Available : out Boolean; Sentence : out T_Lang_array) do
Text_Io.Put("plantage 1" );
Network_Manager.Status(Info, Available, Sentence);
end Status;
end select;
end if;
select
Network_Manager.Stop;
Free := True;
or
delay 0.05;
end select;
end select;
end loop;
end Life_Cycle;