From: hannahp@topaz.ucq.edu.au
Newsgroups: comp.ai.neural-nets
Subject: Problems with Ada back-prop code, any pointers?
Date: 22 Dec 92 23:26:23 AET
Organization: University of Central Queensland, Australia

I have tried to produce a back-prop package in Ada and have arrived
at the following code.  Needless to say, it doesnt work!  Is there any 
NN guru out there who might have any idea what I have done wrong/left out?

Any ideas much appreciated!!!


Thanks.
Paul Hannah.


-------------------------------

generic

   input_nodes,
   hidden1_nodes,
   hidden2_nodes,
   output_nodes  : positive;

package network is

   type input_array   is array (1..input_nodes)   of float;
   type hidden1_array is array (1..hidden1_nodes) of float;
   type hidden2_array is array (1..hidden2_nodes) of float;
   type output_array  is array (1..output_nodes)  of float;


   function learn (input_state : in input_array;
                   ideal_output_state : in output_array)
      return output_array;

   procedure learn (input_state : in input_array;
                    ideal_output_state : in output_array);

   function recall (input_state : in input_array)
      return output_array;

   procedure reset;

end network;



with math_lib; use math_lib;

package activation_functions is

   function sigmoid (x : float) return float;

end activation_functions;

package body activation_functions is

   function sigmoid (x : float) return float is
   begin
      return 1.0/(1.0+exp(-x/4.0));
   end sigmoid;

end activation_functions;





with activation_functions;
use activation_functions;

package body network is

   weight_1 : array (1..hidden1_nodes,1..input_nodes) of float
      := (others => (others => 1.0));
   weight_2 : array (1..hidden2_nodes,1..hidden1_nodes) of float
      := (others => (others => 1.0));
   weight_O : array (1..output_nodes,1..hidden2_nodes) of float
      := (others => (others => 1.0));

   threshold_1 : array (1..hidden1_nodes) of float
      := (others => 0.0);
   threshold_2 : array (1..hidden2_nodes) of float
      := (others => 0.0);
   threshold_O : array (1..output_nodes) of float
      := (others => 0.0);

   hidden1_state : hidden1_array;
   hidden2_state : hidden2_array;


   function learn (input_state : in input_array;
                   ideal_output_state : in output_array)
      return output_array is

      delta_O : output_array;
      delta_2 : hidden2_array;
      delta_1 : hidden1_array;

      neta : float := 0.8;
      alpha : float := 0.2;

      output_state : output_array := recall (input_state);

   begin
      for i in output_state'range loop
         delta_O(i) := (ideal_output_state(i)-output_state(i))*
                     output_state(i)*
                     (1.0-output_state(i));
      end loop;

      for i in weight_O'range(1) loop
         for j in weight_O'range(2) loop
            weight_O(i,j) := weight_O(i,j)+
                             neta*
                             delta_O(i)*
                             hidden2_state(j);
         end loop;
      end loop;




      for i in hidden2_state'range loop
         declare
            sum : float:=0.0;
         begin
            for j in output_state'range loop
               sum := delta_O(j)*weight_O(j,i);
            end loop;
               delta_2(i) :=  hidden2_state(i)*
                             (1.0-hidden2_state(i))*
                              sum;
         end;
      end loop;

      for i in weight_2'range(1) loop
         for j in weight_2'range(2) loop
            weight_2(i,j) := weight_2(i,j)+
                             neta*
                             delta_2(i)*
                             hidden1_state(j);
         end loop;
      end loop;





      for i in hidden1_state'range loop
         declare
            sum : float:=0.0;
         begin
            for j in hidden2_state'range loop
               sum := delta_2(j)*weight_2(j,i);
            end loop;
               delta_1(i) :=  hidden1_state(i)*
                             (1.0-hidden1_state(i))*
                              sum;
         end;
      end loop;

      for i in weight_1'range(1) loop
         for j in weight_1'range(2) loop
            weight_1(i,j) := weight_1(i,j)+
                             neta*
                             delta_1(i)*
                             input_state(j);
         end loop;
      end loop;


      return output_state;
   end learn;















   procedure learn (input_state : in input_array;
                    ideal_output_state : in output_array) is

      delta_O : output_array;
      delta_2 : hidden2_array;
      delta_1 : hidden1_array;

      neta : float := 0.4;
      alpha : float := 0.2;

      output_state : output_array := recall (input_state);

   begin
      for i in output_state'range loop
         delta_O(i) := (ideal_output_state(i)-output_state(i))*
                     output_state(i)*
                     (1.0-output_state(i));
      end loop;

      for i in weight_O'range(1) loop
         for j in weight_O'range(2) loop
            weight_O(i,j) := weight_O(i,j)+
                             neta*
                             delta_O(i)*
                             hidden2_state(j);
         end loop;
      end loop;




      for i in hidden2_state'range loop
         declare
            sum : float:=0.0;
         begin
            for j in output_state'range loop
               sum := delta_O(j)*weight_O(j,i);
            end loop;
               delta_2(i) :=  hidden2_state(i)*
                             (1.0-hidden2_state(i))*
                              sum;
         end;
      end loop;

      for i in weight_2'range(1) loop
         for j in weight_2'range(2) loop
            weight_2(i,j) := weight_2(i,j)+
                             neta*
                             delta_2(i)*
                             hidden1_state(j);
         end loop;
      end loop;





      for i in hidden1_state'range loop
         declare
            sum : float:=0.0;
         begin
            for j in hidden2_state'range loop
               sum := delta_2(j)*weight_2(j,i);
            end loop;
               delta_1(i) :=  hidden1_state(i)*
                             (1.0-hidden1_state(i))*
                              sum;
         end;
      end loop;

      for i in weight_1'range(1) loop
         for j in weight_1'range(2) loop
            weight_1(i,j) := weight_1(i,j)+
                             neta*
                             delta_1(i)*
                             input_state(j);
         end loop;
      end loop;

   end learn;










   function recall (input_state : in input_array)
      return output_array is

      output_state : output_array;

   begin
      hidden1_state := (others => 0.0);
      for i in weight_1'range(1) loop
         for j in weight_1'range(2) loop
            hidden1_state(i) := hidden1_state(i)+
                                weight_1(i,j)*
                                input_state(j);
         end loop;
      end loop;

      for i in hidden1_state'range loop
         hidden1_state(i):=sigmoid(hidden1_state(i)-threshold_1(i));
      end loop;


      hidden2_state := (others => 0.0);
      for i in weight_2'range(1) loop
         for j in weight_2'range(2) loop
            hidden2_state(i) := hidden2_state(i)+
                                weight_2(i,j)*
                                hidden1_state(j);
         end loop;
      end loop;

      for i in hidden2_state'range loop
         hidden2_state(i):=sigmoid(hidden2_state(i)-threshold_2(i));
      end loop;

      output_state := (others => 0.0);
      for i in weight_O'range(1) loop
         for j in weight_O'range(2) loop
            output_state(i) := output_state(i)+
                               weight_O(i,j)*
                               hidden2_state(j);
         end loop;
      end loop;
      for i in output_state'range loop
         output_state(i):=sigmoid(output_state(i)-threshold_O(i));
      end loop;

      return output_state;

   end recall;

   procedure reset is
   begin
      weight_1    := (others => (others => 0.0));
      weight_2    := (others => (others => 0.0));
      weight_O    := (others => (others => 0.0));

      threshold_1 := (others => 0.0);
      threshold_2 := (others => 0.0);
      threshold_O := (others => 0.0);
   end reset;

begin

   reset;
   null; -- create the network.

end network;