Enable forward pass for dropout; backward pass TODO

Author: milancurcic

src/nf/nf_dropout_layer_submodule.f90

@@ -35,17 +35,24 @@ end subroutine init
   module subroutine forward(self, input)
     class(dropout_layer), intent(in out) :: self
     real, intent(in) :: input(:)
+    real :: scale
 
     ! Generate random mask for dropout
     call random_number(self % mask)
     where (self % mask < self % dropout_rate)
       self % mask = 0
     elsewhere
-      self % mask = 1 / (1 - self % dropout_rate)  ! Scale to preserve expected value
+      self % mask = 1
     end where
 
     ! Apply dropout mask
     self % output = input * self % mask
+
+    ! Scale output and mask to preserve the input sum
+    scale = sum(input) / sum(self % output)
+    self % output = self % output * scale
+    self % mask = self % mask * scale
+
   end subroutine forward
 
 

src/nf/nf_layer.f90

@@ -76,7 +76,7 @@ end subroutine backward_3d
 
   interface
 
-    pure module subroutine forward(self, input)
+    module subroutine forward(self, input)
       !! Apply a forward pass on the layer.
       !! This changes the internal state of the layer.
       !! This is normally called internally by the `network % forward`

src/nf/nf_layer_submodule.f90

@@ -107,7 +107,7 @@ pure module subroutine backward_3d(self, previous, gradient)
   end subroutine backward_3d
 
 
-  pure module subroutine forward(self, input)
+  module subroutine forward(self, input)
     implicit none
     class(layer), intent(in out) :: self
     class(layer), intent(in) :: input
@@ -126,6 +126,18 @@ pure module subroutine forward(self, input)
             call this_layer % forward(prev_layer % output)
         end select
 
+      type is(dropout_layer)
+
+        ! Upstream layers permitted: input1d, dense, flatten
+        select type(prev_layer => input % p)
+          type is(input1d_layer)
+            call this_layer % forward(prev_layer % output)
+          type is(dense_layer)
+            call this_layer % forward(prev_layer % output)
+          type is(flatten_layer)
+            call this_layer % forward(prev_layer % output)
+        end select
+
       type is(conv2d_layer)
 
         ! Upstream layers permitted: input3d, conv2d, maxpool2d, reshape3d

src/nf/nf_network_submodule.f90

@@ -2,6 +2,7 @@
 
   use nf_conv2d_layer, only: conv2d_layer
   use nf_dense_layer, only: dense_layer
+  use nf_dropout_layer, only: dropout_layer
   use nf_flatten_layer, only: flatten_layer
   use nf_input1d_layer, only: input1d_layer
   use nf_input3d_layer, only: input3d_layer
@@ -227,6 +228,8 @@ module function predict_1d(self, input) result(res)
     select type(output_layer => self % layers(num_layers) % p)
       type is(dense_layer)
         res = output_layer % output
+      type is(dropout_layer)
+        res = output_layer % output
       type is(flatten_layer)
         res = output_layer % output
       class default

test/test_dropout_layer.f90

@@ -65,6 +65,32 @@ program test_dropout_layer
 
   end select
 
+  ! Now we're gonna run the forward pass and check that the dropout indeed
+  ! drops according to the requested dropout rate.
+  forward_pass: block
+    real :: input_data(5)
+    real :: output_data(size(input_data))
+    integer :: n
+
+    net = network([ &
+      input(size(input_data)), &
+      dropout(0.5) &
+    ])
+
+    call random_number(input_data)
+    do n = 1, 10000
+      output_data = net % predict(input_data)
+      ! Check that sum of output matches sum of input within small tolerance
+      if (abs(sum(output_data) - sum(input_data)) > 1e-5) then
+        ok = .false.
+        exit
+      end if
+    end do
+    if (.not. ok) then
+      write(stderr, '(a)') 'dropout layer output sum should match input sum within 1% tolerance.. failed'
+    end if
+  end block forward_pass
+
   if (ok) then
     print '(a)', 'test_dropout_layer: All tests passed.'
   else