with ConsAKD; use ConsAKD; -- with CursAKD; with InteAKD; use InteAKD; -- with FloaAKD; use FloaAKD; with HyperDis; use HyperDis; with HyperMus; use HyperMus; with MathAKD; use MathAKD; with SounAKD; use SounAKD; with TextAKD; use TextAKD; package body HyperNet is ---------------------------------------------------------------------- ---------------------------------------------------------------------- procedure Clamp ( Notes : in out Notes_Type; Neurons : in out Neurons_Type; Axons : in out Axons_Type; Weights : in out Weights_Type; Opt : in out Options_Type; Note : in positive ) is ---------------------------------------------------------------------- Error_Min : float := Opt.Spike - E_Hyp; Rate_Old : float; begin for Neuron in Opt.Music'range loop if Opt.Music ( Neuron ) ( Note ) = 'D' then Neurons ( Neuron ).Error := Opt.Spike - Neurons ( Neuron ).Vm; if abs ( Neurons ( Neuron ).Error ) < Error_Min then Error_Min := abs ( Neurons ( Neuron ).Error ); end if; if Neurons ( Neuron ).Vm > Opt.Spike then Neurons ( Neuron ).Vm := Opt.Spike; -- := - ( Neurons ( Neuron ).Vm - Opt.Spike ); -- Axons ( Neuron ) ( 1 ) := E_Shu; Notes ( Neuron ) := '!'; elsif Neurons ( Neuron ).Vm = Opt.Spike then Notes ( Neuron ) := '!'; elsif Neurons ( Neuron ).Vm >= Opt.Threshold then Neurons ( Neuron ).Vm := Opt.Spike; -- ( Opt.Spike - Neurons ( Neuron ).Vm ) / 2.0; Notes ( Neuron ) := '|'; elsif Neurons ( Neuron ).Vm >= 0.0 then Neurons ( Neuron ).Vm := Opt.Spike; -- Neurons ( Neuron ).Vm -- ( Opt.Spike - Neurons ( Neuron ).Vm ) / 2.0; Notes ( Neuron ) := 'D'; -- Axons ( Neuron ) ( 1 ) := E_Dep; -- elsif Axons ( Neuron ) ( 1 ) >= Opt.Spike then -- Axons ( Neuron ) ( 1 ) := E_Shu; -- Neurons ( Neuron ).Vm := Neurons ( Neuron ).Vm * 1.01; -- Notes ( Neuron ) := 'H'; else Neurons ( Neuron ).Vm := Opt.Spike; -- ( Opt.Spike - Neurons ( Neuron ).Vm ) / 2.0; -- Axons ( Neuron ) ( 1 ) := E_Dep; Notes ( Neuron ) := 'd'; end if; elsif Opt.Music ( Neuron ) ( Note ) = 'R' then if Neurons ( Neuron ).Vm >= Opt.Threshold / 2.0 then Notes ( Neuron ) := 'k'; Neurons ( Neuron ).Vm := -Opt.Spike; elsif Neurons ( Neuron ).Vm > E_Shu then Neurons ( Neuron ).Vm := E_Shu; Notes ( Neuron ) := 'R'; elsif Neurons ( Neuron ).Vm = E_Shu then Notes ( Neuron ) := '0'; elsif Neurons ( Neuron ).Vm < E_Shu then Neurons ( Neuron ).Vm := E_Shu; Notes ( Neuron ) := 'r'; end if; elsif Opt.Music ( Neuron ) ( Note ) = 'H' then if Neurons ( Neuron ).Vm >= E_Shu then Neurons ( Neuron ).Vm := -Opt.Spike; Notes ( Neuron ) := 'h'; elsif Neurons ( Neuron ).Vm >= -Opt.Spike then Neurons ( Neuron ).Vm := -Opt.Spike; Notes ( Neuron ) := 'H'; elsif Neurons ( Neuron ).Vm <= -Opt.Spike then Neurons ( Neuron ).Vm := -Opt.Spike; Notes ( Neuron ) := '\'; end if; elsif Opt.Music ( Neuron ) ( Note ) = 'I' then Reset ( Axons, Neurons, Weights, Neuron ); Notes ( Neuron ) := 'I'; elsif Opt.Music ( Neuron ) ( Note ) = 'S' then if Neurons ( Neuron ).Vm >= Opt.Threshold then Neurons ( Neuron ).Vm := E_Shu; Notes ( Neuron ) := 's'; end if; elsif Opt.Music ( Neuron ) ( Note ) = 'X' then null; else if Neurons ( Neuron ).Vm >= Opt.Spike then Neurons ( Neuron ).Vm := -Opt.Spike; Notes ( Neuron ) := 'J'; -- elsif Neurons ( Neuron ).Vm >= Opt.Threshold then -- Neurons ( Neuron ).Vm := -- -( Neurons ( Neuron ).Vm - Opt.Threshold ); -- Notes ( Neuron ) := 'j'; end if; end if; end loop; if Opt.Auto_Rate then Rate_Old := Opt.Learn_Rate; Opt.Learn_Rate := Opt.Learn_Init * ( Error_Min ** 2 ); if Opt.Learn_Rate > Rate_Old then Opt.Learn_Rate := Rate_Old; end if; end if; end Clamp; procedure Current_Soma ( I_Dep : out float; I_Shu : out float; I_Hyp : out float; Neuron : in out Neuron_Type; Opt : in Options_Type ) is ---------------------------------------------------------------------- G_Dep, G_Shu, G_Hyp : float := 0.0; begin G_Shu := Opt.G_Leak; -- if Neuron.Vm < E_Shu then -- G_Hyp := Opt.G_Leak * Neuron.Vm / E_Hyp; -- if Neuron.Vm > Opt.Threshold then -- G_Dep := Opt.G_Leak * Neuron.Vm / E_Dep; -- G_Shu := 0.0; -- end if; I_Dep := G_Dep * ( Neuron.Vm - E_Dep ); I_Shu := G_Shu * ( Neuron.Vm - E_Shu ); I_Hyp := G_Hyp * ( Neuron.Vm - E_Hyp ); end Current_Soma; procedure Current_Synapse ( Weight : in out Weight_Type; G_Dep, G_Shu, G_Hyp : in float; Vm : in float ) is ---------------------------------------------------------------------- begin if G_Dep >= 0.0 then Weight.I_Dep := G_Dep * ( Vm - E_Dep ); else Weight.I_Dep := G_Dep * ( Vm - E_Shu ); end if; Weight.I_Shu := G_Shu * ( Vm - E_Shu ); Weight.I_Hyp := G_Hyp * ( Vm - E_Hyp ); end Current_Synapse; procedure Demo is ---------------------------------------------------------------------- Segments : positive; Opt : Options_Type; Quit : boolean := false; Refresh : boolean; Refresh_Count : natural; Axons : Axons_Type := ( 0..Neuron_Max => Axon_Def ); Neurons : Neurons_Type := ( 0..Neuron_Max => Neuron_Def ); Weights : Weights_Type := ( 0..Neuron_Max => ( 0..Neuron_Max => Weight_Def ) ); Note : positive := Song_Size; Silent_Char : character := '.'; begin Music_Load ( Opt.Music ); loop Options_Setup ( Opt, Axons, Neurons, Weights ); exit when Opt.Quit; Segments := positive ( Opt.Time_Lag / Opt.dt ); Clear_Screen; Put ( "Press 0 to" ); if Opt.N_Last > 9 then Put ( " 9" ); else Put ( positive'image ( Opt.N_Last ) ); end if; Put_Line ( " to voltage clamp, ENTER to quit, any other to refresh." ); Refresh_Count := 0; declare Notes : Notes_Type ( 0..Opt.N_Last ); begin loop Note := Note + 1; if Note > Song_Size then Note := 1; if Silent_Char = '.' then Silent_Char := '_'; else Silent_Char := '.'; end if; end if; Update ( Notes, Axons, Neurons, Weights, Opt, Segments ); if Opt.Training_On then Clamp ( Notes, Neurons, Axons, Weights, Opt, Note ); end if; Voltage_Clamp ( Quit, Refresh, Notes, Axons, Neurons, Opt ); for Neuron in 0..Opt.N_Last loop for Pre_Neuron in 0..Opt.N_Last loop if Opt.Learn_Init /= 0.0 then Weight_Learn ( Weights ( Neuron, Pre_Neuron ), Neurons ( Neuron ).V_Avg, Opt, Neurons ( Neuron ).Vm ); end if; -- Weights ( Neuron, Pre_Neuron ).Nt -- := Weights ( Neuron, Pre_Neuron ).Nt -- - Weights ( Neuron, Pre_Neuron ).Nt_Used -- - Opt.dt * Opt.Decay * Weights ( Neuron, Pre_Neuron ).Nt; -- if Weights ( Neuron, Pre_Neuron ).Nt < 0.0 then -- Weights ( Neuron, Pre_Neuron ).Nt := 0.0; -- end if; end loop; end loop; if Refresh_Count = natural'last then Refresh_Count := 1; else Refresh_Count := Refresh_Count + 1; end if; if Refresh or else Refresh_Count = Opt.Refresh_Rate then Weights_Display ( Weights, Opt.N_Last, Opt.Deci ); -- New_Line; -- Put_Line ( -- "Neurotransmitter, Current, Voltage, Error, Vm Average" ); -- Neurons_Display ( Neurons, Opt.N_Last, Opt.Deci ); -- New_Line; -- New_Line; -- Put_Line ( "Axon Segments" ); -- Axons_Display ( Axons, Opt.N_Last, Opt.Deci, Segments ); Music_Display ( Notes, Note, Silent_Char, Opt ); Refresh_Count := 0; if Opt.Screen_Delay > 0.0 then delay ( duration ( Opt.Screen_Delay ) ); end if; else for Neuron in 0..Opt.N_Last loop if Notes ( Neuron ) = '!' then Spike_Sound ( Neuron, Opt.Tones_On ); exit; end if; end loop; end if; exit when Quit; end loop; end; --declare Speaker_Tone_Toggle ( false ); end loop; end Demo; procedure Reset ( Axons : in out Axons_Type; Neurons : in out Neurons_Type; Weights : in out Weights_Type; Neuron : in integer := -1 ) is ---------------------------------------------------------------------- -- Does not reset long-term weight values ---------------------------------------------------------------------- begin if Neuron < 0 then Axons := ( others => Axon_Def ); Neurons := ( others => Neuron_Def ); for Post_Neuron in Neurons'range loop for Pre_Neuron in Neurons'range loop Weights ( Post_Neuron, Pre_Neuron ).Nt := 0.0; Weights ( Post_Neuron, Pre_Neuron ).G := 0.0; Weights ( Post_Neuron, Pre_Neuron ).G_dt := 0.0; Weights ( Post_Neuron, Pre_Neuron ).I_Dep := 0.0; Weights ( Post_Neuron, Pre_Neuron ).I_Shu := 0.0; Weights ( Post_Neuron, Pre_Neuron ).I_Hyp := 0.0; end loop; end loop; else Axons ( Neuron ) := Axon_Def; Neurons ( Neuron ) := Neuron_Def; for Pre_Neuron in Neurons'range loop Weights ( Neuron, Pre_Neuron ).Nt := 0.0; Weights ( Neuron, Pre_Neuron ).G := 0.0; Weights ( Neuron, Pre_Neuron ).G_dt := 0.0; Weights ( Neuron, Pre_Neuron ).I_Dep := 0.0; Weights ( Neuron, Pre_Neuron ).I_Shu := 0.0; Weights ( Neuron, Pre_Neuron ).I_Hyp := 0.0; end loop; end if; end Reset; procedure Update ( Notes : out Notes_Type; Axons : in out Axons_Type; Neurons : in out Neurons_Type; Weights : in out Weights_Type; Opt : in Options_Type; Segments : in positive ) is ---------------------------------------------------------------------- Neurons_Old : array ( 0..Opt.N_Last ) of Neuron_Type; Nt_Total : float; Total_Weight : float; G_Dep, G_Shu, G_Hyp : float; G : G_Type ( 0..Opt.N_Last ); -- G_New : array ( 0..Opt.N_Last ) of float; -- G_dt_New : array ( 0..Opt.N_Last ) of float; Rate : float; Weights_Old : array ( 0..Opt.N_Last ) of Weight_Type; begin for Neuron in 0..Opt.N_Last loop Rate := 1.0; loop Nt_Total := 0.0; for Pre_Neuron in 0..Opt.N_Last loop Weights_Old ( Pre_Neuron ) := Weights ( Neuron, Pre_Neuron ); if Axons ( Pre_Neuron ) ( Segments ) >= Opt.Spike then Weights ( Neuron, Pre_Neuron ).Nt := ( Weights ( Neuron, Pre_Neuron ).Nt + 1.0 ) * Rate; Weights ( Neuron, Pre_Neuron ).G := 0.0; Weights ( Neuron, Pre_Neuron ).G_dt := 0.0; else Weights ( Neuron, Pre_Neuron ).Nt := Weights ( Neuron, Pre_Neuron ).Nt * Rate; end if; if Weights ( Neuron, Pre_Neuron ).Nt > 1.0 then Weights ( Neuron, Pre_Neuron ).Nt := 1.0; end if; Alpha ( Weights ( Neuron, Pre_Neuron ).G, Weights ( Neuron, Pre_Neuron ).G_dt, Weights ( Neuron, Pre_Neuron ).Nt / Opt.dt, Decay => 1.0 / Opt.Time_Peak, dt => Opt.dt ); Nt_Total := Nt_Total + Weights ( Neuron, Pre_Neuron ).Nt; G ( Pre_Neuron ).Dep := Weights ( Neuron, Pre_Neuron ).Dep * Weights ( Neuron, Pre_Neuron ).G * Exp ( 1.0 ) / Opt.Time_Peak; if G ( Pre_Neuron ).Dep > Weights ( Neuron, Pre_Neuron ).Dep then G ( Pre_Neuron ).Dep := Weights ( Neuron, Pre_Neuron ).Dep; end if; G ( Pre_Neuron ).Shu := Weights ( Neuron, Pre_Neuron ).Shu * Weights ( Neuron, Pre_Neuron ).G * Exp ( 1.0 ) / Opt.Time_Peak; if G ( Pre_Neuron ).Shu > Weights ( Neuron, Pre_Neuron ).Shu then G ( Pre_Neuron ).Shu := Weights ( Neuron, Pre_Neuron ).Shu; end if; G ( Pre_Neuron ).Hyp := Weights ( Neuron, Pre_Neuron ).Hyp * Weights ( Neuron, Pre_Neuron ).G * Exp ( 1.0 ) / Opt.Time_Peak; if G ( Pre_Neuron ).Hyp > Weights ( Neuron, Pre_Neuron ).Hyp then G ( Pre_Neuron ).Hyp := Weights ( Neuron, Pre_Neuron ).Hyp; end if; end loop; Neurons_Old ( Neuron ) := Neurons ( Neuron ); Neurons ( Neuron ).Nt := Nt_Total; if Neurons_Old ( Neuron ).Vm >= Opt.Spike then Neurons ( Neuron ).Vm := -Neurons ( Neuron ).Vm; end if; Voltage_Membrane ( Neurons ( Neuron ), Weights, G, Neuron, Opt ); -- exit when Neurons_Old ( Neuron ).Vm >= Opt.Spike; exit when Rate < 0.01; exit when Neurons ( Neuron ).Vm <= Opt.Spike; for Pre_Neuron in 0..Opt.N_Last loop Weights ( Neuron, Pre_Neuron ) := Weights_Old ( Pre_Neuron ); end loop; Rate := Rate * 0.99; Neurons ( Neuron ) := Neurons_Old ( Neuron ); end loop; if Rate < 1.0 then Neurons ( Neuron ).Vm := Opt.Spike; end if; for Pre_Neuron in 0..Opt.N_Last loop Weights ( Neuron, Pre_Neuron ).Nt := Weights ( Neuron, Pre_Neuron ).Nt * ( 1.0 - Rate ) / Rate; end loop; Notes ( Neuron ) := ' '; if Neurons_Old ( Neuron ).Vm >= Opt.Spike then Neurons ( Neuron ).Vm := -Neurons_Old ( Neuron ).Vm; -- + 1.0 - Exp ( Neurons_Old ( Neuron ).Vm - Opt.Spike ); -- if Neurons ( Neuron ).Vm > Opt.Spike then -- Notes ( Neuron ) := '+'; -- Neurons ( Neuron ).Vm := Opt.Spike; elsif Neurons ( Neuron ).Vm = Opt.Spike then Notes ( Neuron ) := '!'; -- elsif Neurons ( Neuron ).Vm < -Opt.Spike then -- Neurons ( Neuron ).Vm := -Opt.Spike; end if; end loop; for Neuron in 0..Opt.N_Last loop for Segment in reverse 2..Segments loop Axons ( Neuron ) ( Segment ) := Axons ( Neuron ) ( Segment - 1 ); end loop; Axons ( Neuron ) ( 1 ) := Neurons_Old ( Neuron ).Vm; end loop; end Update; procedure Voltage_Membrane ( Neuron : in out Neuron_Type; Weights : in out Weights_Type; G : in G_Type; N : in natural; Opt : in Options_Type ) is ---------------------------------------------------------------------- I_Dep_Soma, I_Shu_Soma, I_Hyp_Soma : float; I_Dep_Synapses : float := 0.0; I_Shu_Synapses : float := 0.0; I_Hyp_Synapses : float := 0.0; Vm_Delta : float; begin Current_Soma ( I_Dep_Soma, I_Shu_Soma, I_Hyp_Soma, Neuron, Opt ); for Pre_Neuron in 0..Opt.N_Last loop Current_Synapse ( Weights ( N, Pre_Neuron ), G ( Pre_Neuron ).Dep, G ( Pre_Neuron ).Shu, G ( Pre_Neuron ).Hyp, Neuron.Vm ); I_Dep_Synapses := I_Dep_Synapses + Weights ( N, Pre_Neuron ).I_Dep; I_Shu_Synapses := I_Shu_Synapses + Weights ( N, Pre_Neuron ).I_Shu; I_Hyp_Synapses := I_Hyp_Synapses + Weights ( N, Pre_Neuron ).I_Hyp; end loop; Neuron.Im := I_Dep_Synapses + I_Shu_Synapses + I_Hyp_Synapses + I_Dep_Soma + I_Shu_Soma + I_Hyp_Soma; if Neuron.Im < -9.9e+9 then Neuron.Im := -9.9e+9; end if; if Neuron.Im > 9.9e+9 then Neuron.Im := 9.9e+9; end if; if abs ( Neuron.Im ) < 1.0e-99 then Neuron.Im := 0.0; end if; Vm_Delta := -Opt.dt * Neuron.Im / Cm; if ( ( Neuron.Vm > E_Shu ) and ( Neuron.Vm + Vm_Delta < E_Shu ) ) and ( I_Shu_Synapses + I_Shu_Soma > I_Hyp_Synapses + I_Hyp_Soma ) then Neuron.Vm := E_Shu; elsif ( ( Neuron.Vm < E_Shu ) and ( Neuron.Vm + Vm_Delta > E_Shu ) ) and ( I_Shu_Synapses + I_Shu_Soma < I_Dep_Synapses + I_Dep_Soma ) then Neuron.Vm := E_Shu; else Neuron.Vm := Neuron.Vm + Vm_Delta; end if; end Voltage_Membrane; procedure Weight_Learn ( Weight : in out Weight_Type; V_Avg : in out float; Opt : in Options_Type; Vm : in float ) is ---------------------------------------------------------------------- Weight_Total : float; V_Avg_dt : float; begin V_Avg_dt := Opt.dt * ( Vm - V_Avg ); V_Avg := V_Avg + V_Avg_dt; Weight.Dep := Weight.Dep - Opt.dt * Opt.Learn_Rate * ( Weight.I_Dep / Weight.Dep ) * Vm; -- * ( Vm - Opt.Threshold ); -- * ( Exp ( Vm - Opt.Threshold ) - Exp ( -Vm - Opt.Threshold ) ); if Weight.Dep < Opt.W_Min then Weight.Dep := Opt.W_Min; end if; if Weight.Dep > Opt.W_Max then Weight.Dep := Opt.W_Max; end if; if Opt.Wgt_Shu and Weight.Dep = Opt.W_Min then Weight.Shu := Weight.Shu + Opt.dt * Opt.Learn_Rate * ( Weight.I_Shu / Weight.Shu ) * Vm; -- * ( Vm - Opt.Threshold ); -- * ( Exp ( Vm - Opt.Threshold ) - Exp ( -Vm - Opt.Threshold ) ); if Weight.Shu < Opt.W_Min then Weight.Shu := Opt.W_Min; end if; if Weight.Shu > Opt.W_Max then Weight.Shu := Opt.W_Max; end if; end if; end Weight_Learn; ---------------------------------------------------------------------- ---------------------------------------------------------------------- end HyperNet;