---------------------------------------------------------------------------
-- FIRE_One (C) David Wallace Croft 1994.  All rights reserved.
-- CompuServe [76600,102], InterNet CroftDW@Portia.Caltech.Edu
--
-- Demonstrates the neural network learning and training algorithms
-- FISL Learning and FIRE Training with 1 input, 1 weight, and 1 neuron.
--
-- Input          ==> Weight ==> Neuron
-- __/\__/\__/\__ ==> WE/WI  ==> __/| __/| __/| __
--                                  |/   |/   |/
-- FISL Learning = Frustrated Inhibitive Synaptic Localized Learning:
-- The FISL rule states that when neurotransmitter is released at the
-- synaptic junction, the synaptic weight is potentiated if the neural
-- membrane potential is depolarized and the synaptic weight is depressed
-- if the neural membrane potential is hyperpolarized.
--
-- FIRE Training = Forward Inculcated Relief of Excitation Training:
-- FIRE trains the weight by increasing the frequency of the input by the
-- absolute error.  The error is defined as the difference between the
-- desired output in "firings" per second and the actual output.
---------------------------------------------------------------------------

with Text_IO; use Text_IO; -- For status output

procedure FIRE_One is
---------------------------------------------------------------------------
---------------------------------------------------------------------------
  WE : float :=  1.0;  -- initial value for excitatory weight
  WI : float :=  1.0;  -- initial value for inhibitory weight

procedure Pause is
---------------------------------------------------------------------------
  Item : string ( 1..1 );
  Last : natural;
begin
  Put ( "Please press ENTER to continue..." );
  Get_Line ( Item, Last );
end Pause;

procedure Show (
  Input       : in float;
  Potential   : in float;
  WE          : in float;
  WI          : in float;
  Average     : in float;
  Sum         : in natural;
  Time        : in float ) is
---------------------------------------------------------------------------
  package Float_IO is new Float_IO ( float );         -- floating point i/o
  use Float_IO;
  package Integer_IO is new Integer_IO ( integer );   -- integer i/o
  use Integer_IO;
  W : float;        -- W := ( WE / WI ) since inhibitory shunts excitatory.
begin
  Put ( "T:"   ); Put ( Time     , 4, 2, 0 );
  Put ( " I: " ); Put ( Input    , 0, 3, 0 );
  W := WE / WI;
  Put ( " W: " ); Put ( W        , 0, 6 );
  Put ( " P: " ); Put ( Potential, 2, 2 );
  Put ( " S: " ); Put ( Sum      , 2 );
  Put ( " A: " ); Put ( Average  , 0, 2 );
  Put_Line ( "" );
end Show;

procedure FISL (
  P     : in out float;
  WE    : in out float;
  WI    : in out float;
  dT    : in     float;
  Input : in     float ) is
---------------------------------------------------------------------------
  Decay : constant float := 0.997700063; -- Decay := 0.1 ** dT;
begin
  P := ( P + ( WE / WI ) * Input * dT ) * Decay;
    -- A very simple model of neural capacitance, input, and leakage.
  if P > 1.0 then                     -- Depolarization causes...
    P := -P;                          --   hyperpolarization in this
  end if;                             --   model of an action potential.
  WE := WE + P * Input * WE * dt;     -- FISL rule for excitatory weight
  WI := WI - P * Input * WI * dt;     -- FISL rule for inhibitory weight
end FISL;

procedure FIRE_Pain (
  Pain           :    out float;
  Time_Last      : in out float;
  Time_Next      : in out float;
  Input_Freq     : in     float;
  Output_Desired : in     float;
  Output_Actual  : in     float;
  Time           : in     float ) is
---------------------------------------------------------------------------
  Error :          float;
  Freq  :          float;
begin
  if Time >= Time_Next then
    Error := Output_Desired - Output_Actual;
    Freq := Input_Freq + abs ( Error );
    Time_Last := Time;
    Time_Next := Time + ( 1.0 / Freq );
  end if;
  if ( Time - 0.1 ) <= Time_Last then
    Pain := 1.0;
  else
    Pain := 0.0;
  end if;
end FIRE_Pain;

procedure FIRE (
  WE             : in out float;             -- excitatory weight
  WI             : in out float;             -- inhibitory weight
  Output_Desired : in     float := 0.05 ) is -- desired output firings/sec
---------------------------------------------------------------------------
  P              :          float   := 0.0;  -- membrane potential
  Time           :          float   := 0.0;  -- time
  dT             : constant float   := 0.001;-- delta time increment
  Input_Freq     : constant float   := 1.0;  -- normal input frequency
  Output_Actual  :          float   := 0.0;  -- actual  output firings/sec
  Pain           :          float   := 0.0;  -- input modified by error
  P_Old          :          float   := 0.0;  -- used to count firings
  Sum            :          natural := 0;    -- firings over period of time
  Time_Max       : constant float   := 2.0;  -- period of time
  Time_Win       :          float   := 0.0;  -- time since last period
  Time_Next      :          float   := 1.0;  -- time when next gets input
  Time_Last      :          float   := 0.0;  -- time when last got  input
begin
  loop
--    Show ( Pain, P, WE, WI, Output_Actual, Sum, Time );
    FIRE_Pain ( Pain, Time_Last, Time_Next,
      Input_Freq, Output_Desired, Output_Actual, Time);
    P_Old := P;
    FISL ( P, WE, WI, dT, Pain ); -- Outputs new P, WE, and WI.
    Time := Time + dT;
    Time_Win := Time_Win + dT;
    Output_Actual := float ( Sum ) / Time_Win;
    if ( P_Old > 0.0 ) and ( P < 0.0 ) then -- Counts firings by noting
      Sum := Sum + 1;                     -- transitions from depolarized
    end if;                               -- to hyperpolarized potential.
    if Time_Win > Time_Max then -- Firings averaged over 2 second window.
      exit when Time > 10_000.0;
--      Sum := 0;
--      Time_Win := 0.0;
    end if;
  end loop;
  Show ( Pain, P, WE, WI, Output_Actual, Sum, Time );
end FIRE;

---------------------------------------------------------------------------
---------------------------------------------------------------------------
begin
  FIRE ( WE, WI, Output_Desired =>  1.0 );
  FIRE ( WE, WI, Output_Desired =>  1.0 );
end FIRE_One;