|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 7105 (0x1bc1)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Text_Io;
package body Sfam is
type Pattern_Array is
record
Normal : Raw_Input_Pattern;
Complement : Raw_Input_Pattern;
end record;
type Activation is delta Sfam_Units.Pattern'Delta range 0.0 .. 100.0;
type Node;
type Node_Ptr is access Node;
type Node is
record
Cat : Category;
Act : Activation;
W : Pattern_Array;
end record;
type Link;
type Link_Ptr is access Link;
type Link is
record
Node : Node_Ptr;
Next : Link_Ptr;
end record;
Output_Nodes : Link_Ptr := null;
Sorted_Nodes : Link_Ptr := null;
function Create_Pattern_Array
(Normal : Raw_Input_Pattern) return Pattern_Array is
P : Pattern_Array;
begin
P.Normal := Normal;
for I in Normal'Range loop
P.Complement (I) := Sfam_Units.Complement (P.Normal (I));
end loop;
return P;
end Create_Pattern_Array;
function And_Pattern_Array (P1, P2 : Pattern_Array) return Pattern_Array is
R : Pattern_Array;
function Min (P1, P2 : Sfam_Units.Pattern) return Sfam_Units.Pattern is
use Sfam_Units;
begin
if P1 < P2 then
return P1;
else
return P2;
end if;
end Min;
begin
for I in R.Normal'Range loop
R.Normal (I) := Min (P1.Normal (I), P2.Normal (I));
end loop;
for I in R.Complement'Range loop
R.Complement (I) := Min (P1.Complement (I), P2.Complement (I));
end loop;
return R;
end And_Pattern_Array;
function Norm_Of_Pattern_Array (P : Pattern_Array) return Activation is
Norm : Activation := 0.0;
begin
for I in P.Normal'Range loop
Norm := Norm + Activation (P.Normal (I));
end loop;
for I in P.Complement'Range loop
Norm := Norm + Activation (P.Complement (I));
end loop;
return Norm;
end Norm_Of_Pattern_Array;
function Create_Node (Its_Category : Category; Its_Pattern : Pattern_Array)
return Node_Ptr is
begin
return new Node'(Its_Category, 0.0, Its_Pattern);
end Create_Node;
procedure Display_Node (N : Node_Ptr) is
package Fio is new Text_Io.Fixed_Io (Activation);
package Pio is new Text_Io.Fixed_Io (Sfam_Units.Pattern);
begin
Text_Io.Put ("Node : ");
Text_Io.Put (Image (N.Cat));
Text_Io.Put (" T = ");
Fio.Put (N.Act);
for I in N.W.Normal'Range loop
Text_Io.Put (" n ");
Pio.Put (N.W.Normal (I));
end loop;
for I in N.W.Complement'Range loop
Text_Io.Put (" c ");
Pio.Put (N.W.Complement (I));
end loop;
Text_Io.Put_Line ("");
end Display_Node;
function Category_Is_Known (A_Category : Category) return Boolean is
N : Link_Ptr := Output_Nodes;
begin
while N /= null loop
if N.Node.Cat = A_Category then
return True;
end if;
N := N.Next;
end loop;
return False;
end Category_Is_Known;
procedure Evaluate_Activation (N : Node_Ptr; I : Pattern_Array) is
Alpha : constant Activation := 0.000_000_1;
begin
N.Act := Activation (Norm_Of_Pattern_Array
(And_Pattern_Array (I, N.W)) /
(Alpha + Norm_Of_Pattern_Array (N.W)));
end Evaluate_Activation;
procedure Sort_Nodes is
Sorted : Link_Ptr := null;
L : Link_Ptr;
procedure Insert (N : Node_Ptr) is
P, Q : Link_Ptr;
begin
if Sorted = null then
Sorted := new Link'(Node => N, Next => null);
elsif N.Act > Sorted.Node.Act then
Sorted := new Link'(Node => N, Next => Sorted);
else
Q := Sorted;
P := Sorted.Next;
while P /= null loop
if N.Act > P.Node.Act then
Q.Next := new Link'(Node => N, Next => P);
return;
end if;
Q := P;
P := P.Next;
end loop;
Q.Next := new Link'(Node => N, Next => null);
end if;
end Insert;
begin
L := Output_Nodes;
while L /= null loop
Insert (L.Node);
L := L.Next;
end loop;
Sorted_Nodes := Sorted;
end Sort_Nodes;
procedure Treat_Labeled_Pattern (Its_Category : Category;
Its_Pattern : Raw_Input_Pattern) is
use Sfam_Units;
N : Node_Ptr;
L : Link_Ptr;
Vigilance : Sfam_Units.Pattern;
Match_Value : Sfam_Units.Pattern;
Input : Pattern_Array;
Mismatch : Boolean := False;
begin
Input := Create_Pattern_Array (Its_Pattern);
if not Category_Is_Known (Its_Category) then
N := Create_Node (Its_Category, Input);
Output_Nodes := new Link'(Node => N, Next => Output_Nodes);
else
Vigilance := Base_Vigilance;
L := Output_Nodes;
while L /= null loop
Evaluate_Activation (L.Node, Input);
L := L.Next;
end loop;
Sort_Nodes;
L1:
while Sorted_Nodes /= null loop
Match_Value := Pattern
(Norm_Of_Pattern_Array
(And_Pattern_Array
(Input, Sorted_Nodes.Node.W)) /
Its_Pattern'Length);
if Match_Value < Vigilance then
Sorted_Nodes.Node.Act := 0.0;
Mismatch := True;
else
if Sorted_Nodes.Node.Cat = Its_Category then
Sorted_Nodes.Node.W :=
And_Pattern_Array (Input, Sorted_Nodes.Node.W);
Mismatch := False;
exit L1;
else
Vigilance := Pattern (Match_Value + 0.000_000_1);
Sorted_Nodes.Node.Act := 0.0;
Mismatch := True;
end if;
end if;
Sorted_Nodes := Sorted_Nodes.Next;
end loop L1;
if Mismatch then
N := Create_Node (Its_Category, Input);
Output_Nodes := new Link'(Node => N, Next => Output_Nodes);
end if;
end if;
Text_Io.Put_Line ("----------");
L := Output_Nodes;
while L /= null loop
Display_Node (L.Node);
L := L.Next;
end loop;
end Treat_Labeled_Pattern;
end Sfam;