Set dropout's training mode to true in net % train(); add tests

Author: milancurcic

src/nf/nf_dropout_layer_submodule.f90

@@ -66,8 +66,13 @@ pure module subroutine backward(self, input, gradient)
     real, intent(in) :: input(:)
     real, intent(in) :: gradient(:)
 
-    ! Backpropagate gradient through dropout mask
-    self % gradient = gradient * self % mask * self % scale
+    if (self % training) then
+      ! Backpropagate gradient through dropout mask
+      self % gradient = gradient * self % mask * self % scale
+    else
+      ! In inference mode, pass through the gradient unchanged
+      self % gradient = gradient
+    end if
   end subroutine backward
 
 end submodule nf_dropout_layer_submodule 

src/nf/nf_network_submodule.f90

@@ -288,12 +288,21 @@ module function predict_batch_1d(self, input) result(res)
     class(network), intent(in out) :: self
     real, intent(in) :: input(:,:)
     real, allocatable :: res(:,:)
-    integer :: i, batch_size, num_layers, output_size
+    integer :: i, n, batch_size, num_layers, output_size
 
     num_layers = size(self % layers)
     batch_size = size(input, dim=rank(input))
     output_size = product(self % layers(num_layers) % layer_shape)
 
+    ! predict is run in inference mode only;
+    ! set all dropout layers' training mode to false.
+    do n = 2, num_layers
+      select type(this_layer => self % layers(n) % p)
+        type is(dropout_layer)
+          this_layer % training = .false.
+      end select
+    end do
+
     allocate(res(output_size, batch_size))
 
     batch: do i = 1, size(res, dim=2)
@@ -318,12 +327,21 @@ module function predict_batch_3d(self, input) result(res)
     class(network), intent(in out) :: self
     real, intent(in) :: input(:,:,:,:)
     real, allocatable :: res(:,:)
-    integer :: i, batch_size, num_layers, output_size
+    integer :: i, n, batch_size, num_layers, output_size
 
     num_layers = size(self % layers)
     batch_size = size(input, dim=rank(input))
     output_size = product(self % layers(num_layers) % layer_shape)
 
+    ! predict is run in inference mode only;
+    ! set all dropout layers' training mode to false.
+    do n = 2, num_layers
+      select type(this_layer => self % layers(n) % p)
+        type is(dropout_layer)
+          this_layer % training = .false.
+      end select
+    end do
+
     allocate(res(output_size, batch_size))
 
     batch: do i = 1, batch_size
@@ -457,6 +475,14 @@ module subroutine train(self, input_data, output_data, batch_size, &
       self % loss = quadratic()
     end if
 
+    ! Set all dropout layers' training mode to true.
+    do n = 2, size(self % layers)
+      select type(this_layer => self % layers(n) % p)
+        type is(dropout_layer)
+          this_layer % training = .true.
+      end select
+    end do
+
     dataset_size = size(output_data, dim=2)
 
     epoch_loop: do n = 1, epochs

test/test_dropout_layer.f90

@@ -19,6 +19,16 @@ program test_dropout_layer
   select type(layer1_p => layer1 % p)
     type is(dropout_layer)
 
+      if (layer1_p % dropout_rate /= 0.5) then
+        ok = .false.
+        write(stderr, '(a)') 'dropout layer dropout rate should be 0.5.. failed'
+      end if
+
+      if (layer1_p % training) then
+        ok = .false.
+        write(stderr, '(a)') 'dropout layer default training mode should be false.. failed'
+      end if
+
       if (layer1_p % input_size /= 0) then
         print *, 'input_size: ', layer1_p % input_size
         ok = .false.
@@ -32,6 +42,25 @@ program test_dropout_layer
 
   end select
 
+  ! Test setting training mode explicitly.
+  layer1 = dropout(0.5, training=.true.)
+  select type(layer1_p => layer1 % p)
+    type is(dropout_layer)
+      if (.not. layer1_p % training) then
+        ok = .false.
+        write(stderr, '(a)') 'dropout layer training mode should be true.. failed'
+      end if
+  end select
+
+  layer1 = dropout(0.5, training=.false.)
+  select type(layer1_p => layer1 % p)
+    type is(dropout_layer)
+      if (layer1_p % training) then
+        ok = .false.
+        write(stderr, '(a)') 'dropout layer training mode should be false.. failed'
+      end if
+  end select
+
   ! Now we're gonna initialize a minimal network with an input layer and a
   ! dropout that follows and we'll check that the dropout layer has expected
   ! state.