Train deep networks

app/neural_network.f90

@@ -0,0 +1,143 @@
+module activation_m
+  implicit none
+
+contains
+
+  double precision function sigmoid(z)
+    double precision z
+    sigmoid = 1.d0/(1.d0 + exp(-z))
+  end function sigmoid
+
+  double precision function deriv_sigmoid(z)
+    double precision z
+    deriv_sigmoid = exp(-z)/(1.d0 + exp(-z))**2
+  end function deriv_sigmoid
+
+end module
+
+program neural_network
+  use activation_m, only : sigmoid, deriv_sigmoid
+  implicit none
+  integer i,j,k,l,n,n_outer
+  integer nhidden,nodes_max
+  integer n_outer_iterations,n_inner_iterations
+  double precision r,eta,ir,rr
+  double precision cost
+  integer, allocatable :: nodes(:)
+  double precision, allocatable :: w(:,:,:),z(:,:),b(:,:),a(:,:),y(:),delta(:,:)
+  double precision, allocatable :: dcdw(:,:,:),dcdb(:,:)
+
+  open(unit=8,file='cost')
+  nhidden = 2
+  n_inner_iterations = 200
+  n_outer_iterations = 50000
+
+  allocate(nodes(0:nhidden+1))
+  ! Number of nodes in each layes
+  nodes(0) = 2 ! Number of nodes in the input layer
+  nodes(1) = 3
+  nodes(2) = 3
+  nodes(3) = 1 ! Number of nodes in the output layer
+
+  nodes_max = maxval(nodes)
+
+  eta = 1.5d0 ! Learning parameter
+
+  allocate(a(nodes_max,0:nhidden+1)) ! Activations, Layer 0: Inputs, Layer nhidden+1: Outputs
+  allocate(z(nodes_max,nhidden+1)) ! z-values: Sum z_j^l = w_jk^{l} a_k^{l-1} + b_j^l
+  allocate(w(nodes_max,nodes_max,nhidden+1)) ! Weights w_{jk}^l is the weight from the k'th neuron in the (l-1)'th layer to the j'th neuron in the l'th layer
+  allocate(b(nodes_max,nhidden+1)) ! Bias b_j^l is the bias in j'th neuron of the l'th layer
+  allocate(delta(nodes_max,nhidden+1))
+  allocate(dcdw(nodes_max,nodes_max,nhidden+1)) ! Gradient of cost function with respect to weights
+  allocate(dcdb(nodes_max,nhidden+1)) ! Gradient of cost function with respect with biases
+  allocate(y(nodes(nhidden+1))) ! Desired output
+
+  w = 0.d0 ! Initialize weights
+  b = 0.d0 ! Initialize biases
+
+
+  do n_outer = 1,n_outer_iterations
+
+     cost = 0.d0
+     dcdw = 0.d0
+     dcdb = 0.d0
+
+     do n = 1,n_inner_iterations
+
+        ! Create an AND gate
+        do k = 1,nodes(0)
+           r = rand(0)
+           if (r .lt. .5d0) then
+              ir = 1.d0
+           else
+              ir = 0.d0
+           end if
+           a(k,0) = ir
+        end do
+
+        if (a(1,0) + a(2,0) .le. 1.5d0) then
+           y(1) = 0.d0 
+        else
+           y(1) = 1.d0 
+        end if
+
+        ! Feedforward
+        do l = 1,nhidden+1
+           do j = 1,nodes(l)
+              z(j,l) = 0.d0
+              do k = 1,nodes(l-1)
+                 z(j,l) = z(j,l) + w(j,k,l)*a(k,l-1)
+              end do
+              z(j,l) = z(j,l) + b(j,l)
+              a(j,l) = sigmoid(z(j,l))
+           end do
+        end do
+
+        do k = 1,nodes(nhidden+1)
+           cost = cost + (y(k)-a(k,nhidden+1))**2
+        end do
+
+        do k = 1,nodes(nhidden+1)
+           delta(k,nhidden+1) = (a(k,nhidden+1)-y(k))*deriv_sigmoid(z(k,nhidden+1))
+        end do
+
+        ! Backpropagate the error
+        do l = nhidden,1,-1
+           do j = 1,nodes(l)
+              delta(j,l) = 0.d0
+              do k = 1,nodes(l+1)
+                 delta(j,l) = delta(j,l) + w(k,j,l+1)*delta(k,l+1)
+              end do
+              delta(j,l) = delta(j,l)*deriv_sigmoid(z(j,l))
+           end do
+        end do
+
+        ! Sum up gradients in the inner iteration
+        do l = 1,nhidden+1
+            do j = 1,nodes(l)
+              do k = 1,nodes(l-1)
+                 dcdw(j,k,l) = dcdw(j,k,l) + a(k,l-1)*delta(j,l)
+              end do
+              dcdb(j,l) = dcdb(j,l) + delta(j,l)
+           end do
+         end do
+
+     end do
+
+     cost = cost/(2.d0*dble(n_inner_iterations))
+     write(8,*) n_outer,log10(cost)
+
+     do l = 1,nhidden+1
+        do j = 1,nodes(l)
+           do k = 1,nodes(l-1)
+              dcdw(j,k,l) = dcdw(j,k,l)/dble(n_inner_iterations)
+              w(j,k,l) = w(j,k,l) - eta*dcdw(j,k,l) ! Adjust weights
+           end do
+           dcdb(j,l) = dcdb(j,l)/dble(n_inner_iterations)
+           b(j,l) = b(j,l) - eta*dcdb(j,l) ! Adjust biases
+        end do
+     end do
+
+  end do
+
+end program neural_network

example/train-and-gate.f90

@@ -0,0 +1,155 @@
+! Copyright (c), The Regents of the University of California
+! Terms of use are as specified in LICENSE.txt
+module trainable_engine_example_m
+  !! Define inference tests and procedures required for reporting results
+  use assert_m, only : assert
+  use string_m, only : string_t
+  use test_m, only : test_t
+  use test_result_m, only : test_result_t
+  use trainable_engine_m, only : trainable_engine_t
+  use inputs_m, only : inputs_t
+  use outputs_m, only : outputs_t
+  use expected_outputs_m, only : expected_outputs_t
+  use matmul_m, only : matmul_t
+  use kind_parameters_m, only : rkind
+  use sigmoid_m, only : sigmoid_t
+  use input_output_pair_m, only : input_output_pair_t 
+  use mini_batch_m, only : mini_batch_t
+  implicit none
+
+  private
+  public :: trainable_engine_test_t
+
+  type, extends(test_t) :: trainable_engine_test_t
+  contains
+    procedure, nopass :: subject
+    procedure, nopass :: results
+  end type
+
+contains
+
+  pure function subject() result(specimen)
+    character(len=:), allocatable :: specimen
+    specimen = "A trainable_engine_t" 
+  end function
+
+  function results() result(test_results)
+    type(test_result_t), allocatable :: test_results(:)
+
+    character(len=*), parameter :: longest_description = &
+        "learning the mapping (false,false) -> false using two hidden layers"
+
+    associate( &
+      descriptions => &
+      [ character(len=len(longest_description)) :: &
+        "learning the mapping (true,true) -> false using two hidden layers", &
+        "learning the mapping (false,true) -> false using two hidden layers", &
+        "learning the mapping (true,false) -> false using two hidden layers", &
+        "learning the mapping (false,false) -> false using two hidden layers" &
+      ], outcomes => [ &
+        train_on_and_truth_table_mini_batch() &
+      ] &
+    )
+      call assert(size(descriptions) == size(outcomes), "trainable_engine_test_m(results): size(descritions) == size(outcomes)")
+      test_results = test_result_t(descriptions, outcomes)
+    end associate
+  end function
+
+  function train_on_and_truth_table_mini_batch() result(test_passes)
+    logical, allocatable :: test_passes(:)
+    type(trainable_engine_t) trainable_engine
+    integer, parameter :: mini_batch_size = 200, num_inputs=2, num_outputs=1, num_iterations=1 !50000
+    type(inputs_t) inputs(mini_batch_size)
+    type(outputs_t), allocatable :: actual_output(:)
+    type(expected_outputs_t) expected_outputs(mini_batch_size)
+    type(mini_batch_t) mini_batches(mini_batch_size)
+    real(rkind) harvest(mini_batch_size, num_inputs)
+    integer pair, iter, i
+    real(rkind), parameter :: false = 0._rkind, true = 1._rkind
+
+    call random_init(image_distinct=.true., repeatable=.true.)
+
+    trainable_engine = two_hidden_layers()
+
+    do iter = 1, num_iterations
+      call random_number(harvest)
+      do pair = 1, mini_batch_size
+        inputs(pair) = inputs_t(harvest(pair,:))
+        expected_outputs(pair) = and(inputs(pair))
+      end do
+      mini_batches = mini_batch_t(input_output_pair_t(inputs, expected_outputs))
+      call trainable_engine%train(mini_batches, matmul_t())
+      actual_output = trainable_engine%infer(inputs, matmul_t())
+    end do
+
+    block
+      type(inputs_t), allocatable :: inputs(:)
+      type(expected_outputs_t), allocatable :: expected_outputs(:)
+      real(rkind), parameter :: tolerance = 1.E-02_rkind
+
+      inputs = [ & 
+        inputs_t([true,true]), inputs_t([false,true]), inputs_t([true,false]), inputs_t([false,false]) &
+      ]
+      expected_outputs = [ & 
+        expected_outputs_t([true]), expected_outputs_t([false]), expected_outputs_t([false]), expected_outputs_t([false]) &
+      ]
+      actual_output = trainable_engine%infer(inputs, matmul_t())
+      print *,"expected output: ",[(expected_outputs(i)%outputs(), i=1,size(expected_outputs))]
+      print *,"actual output:   ",[(actual_output(i)%outputs(), i=1,size(actual_output))]
+      test_passes = [(abs(actual_output(i)%outputs() - expected_outputs(i)%outputs()) < tolerance, i=1, size(actual_output))]
+    end block
+
+  contains
+
+    elemental function and(inputs_object) result(expected_outputs_object)
+       type(inputs_t), intent(in) :: inputs_object 
+       type(expected_outputs_t) expected_outputs_object 
+       expected_outputs_object = expected_outputs_t([merge(false, true, sum(inputs_object%inputs())<=1.5_rkind)])
+    end function
+
+    function two_hidden_layers() result(trainable_engine)
+      type(trainable_engine_t) trainable_engine
+      integer, parameter :: n_in = 2 ! number of inputs
+      integer, parameter :: n_out = 1 ! number of outputs
+      integer, parameter :: neurons = 3 ! number of neurons per layer
+      integer, parameter :: n_hidden = 2 ! number of hidden layers 
+      integer n
+
+      trainable_engine = trainable_engine_t( &
+        metadata = [ & 
+         string_t("2-hidden-layer network"), string_t("Damian Rouson"), string_t("2023-05-30"), string_t("sigmoid"), &
+         string_t("false") &
+        ], &
+        input_weights = reshape([(0._rkind, n=1, n_in*neurons)], [n_in, neurons]), &
+        hidden_weights = reshape([(0._rkind, n=1, neurons*neurons*(n_hidden-1))], [neurons,neurons,n_hidden-1]), &
+        output_weights = reshape([(0._rkind, n=1, n_out*neurons)], [n_out, neurons]), &
+        biases = reshape([(0.,n=1, neurons*n_hidden)], [neurons, n_hidden]), &
+        output_biases = [0._rkind], &
+        differentiable_activation_strategy = sigmoid_t() &
+      )   
+    end function
+  end function
+
+end module trainable_engine_example_m
+
+program train_and_gate
+  use trainable_engine_example_m, only : trainable_engine_test_t  
+  implicit none
+
+  type(trainable_engine_test_t) trainable_engine_test
+  real t_start, t_finish
+
+  integer :: passes=0, tests=0
+
+  call cpu_time(t_start)
+  call trainable_engine_test%report(passes, tests)
+  call cpu_time(t_finish)
+
+  print *
+  print *,"Test suite execution time: ",t_finish - t_start
+  print *
+  print '(*(a,:,g0))',"_________ In total, ",passes," of ",tests, " tests pass. _________"
+  sync all
+  print *
+  if (passes/=tests) error stop "-------- One or more tests failed. See the above report. ---------"
+end program

src/inference_engine/expected_outputs_m.f90

@@ -16,7 +16,7 @@ module expected_outputs_m
 
   interface expected_outputs_t
 
-    module function construct(outputs) result(expected_outputs)
+    pure module function construct(outputs) result(expected_outputs)
       implicit none
       real(rkind), intent(in) :: outputs(:)
       type(expected_outputs_t) expected_outputs