diff --git a/example/train-and-write.f90 b/example/train-and-write.f90 new file mode 100644 index 000000000..ea0d1b995 --- /dev/null +++ b/example/train-and-write.f90 @@ -0,0 +1,92 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +program train_and_write + !! This program demonstrates how to train a neural network and write it to a JSON file. + use inference_engine_m, only : & + inference_engine_t, trainable_engine_t, rkind, sigmoid_t, mini_batch_t, inputs_t, expected_outputs_t, input_output_pair_t + use sourcery_m, only : string_t, file_t, command_line_t + implicit none + + type(string_t) file_name + type(command_line_t) command_line + real(rkind), parameter :: false=0._rkind, true=1._rkind + + file_name = string_t(command_line%flag_value("--output-file")) + + if (len(file_name%string())==0) then + error stop new_line('a') // new_line('a') // & + 'Usage: ./build/run-fpm.sh run --example train-and-write -- --output-file ""' + end if + + block + type(trainable_engine_t) trainable_engine + type(inference_engine_t) inference_engine + type(file_t) json_file + type(mini_batch_t), allocatable :: mini_batches(:) + type(inputs_t), allocatable :: training_inputs(:,:), tmp(:), inputs(:) + type(expected_outputs_t), allocatable :: training_outputs(:,:), tmp2(:), expected_outputs(:) + real(rkind) t_start, t_end + real(rkind), allocatable :: harvest(:,:,:) + integer, parameter :: num_inputs=2, mini_batch_size = 1, num_iterations=8000000 + integer batch, iter, i + + allocate(harvest(num_inputs, mini_batch_size, num_iterations)) + call random_number(harvest) + + ! The following temporary copies are required by gfortran bug 100650 and possibly 49324 + ! See https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100650 and https://gcc.gnu.org/bugzilla/show_bug.cgi?id=49324 + tmp = [([(inputs_t(merge(true, false, harvest(:,batch,iter) < 0.5E0)), batch=1, mini_batch_size)], iter=1, num_iterations)] + training_inputs = reshape(tmp, [mini_batch_size, num_iterations]) + + tmp2 = [([(xor(training_inputs(batch, iter)), batch = 1, mini_batch_size)], iter = 1, num_iterations )] + training_outputs = reshape(tmp2, [mini_batch_size, num_iterations]) + + mini_batches = [(mini_batch_t(input_output_pair_t(training_inputs(:,iter), training_outputs(:,iter))), iter=1, num_iterations)] + trainable_engine = one_random_hidden_layer() + + call cpu_time(t_start) + call trainable_engine%train(mini_batches) + call cpu_time(t_end) + + print *,"Training time: ",t_end - t_start + + inputs = [inputs_t([true,true]), inputs_t([true,false]), inputs_t([false,true]), inputs_t([false,false])] + print *, "sample inputs: ",("[",inputs(i)%values(),"]", i=1, size(inputs)) + expected_outputs = xor(inputs) + print *, "expected outputs: ",(expected_outputs(i)%outputs(), i=1, size(expected_outputs)) + associate(outputs => trainable_engine%infer(inputs)) + print *, "actual outputs: ",(outputs(i)%outputs(), i=1, size(outputs)) + end associate + + inference_engine = trainable_engine%to_inference_engine() + json_file = inference_engine%to_json() + call json_file%write_lines(file_name) + end block + +contains + + elemental function xor(inputs) result(expected_outputs) + type(inputs_t), intent(in) :: inputs + type(expected_outputs_t) expected_outputs + associate(sum_inputs => sum(inputs%values())) + expected_outputs = expected_outputs_t([merge(true, false, sum_inputs > 0.99 .and. sum_inputs < 1.01)]) + end associate + end function + + function one_random_hidden_layer() result(trainable_engine) + type(trainable_engine_t) trainable_engine + integer, parameter :: inputs = 2, outputs = 1, hidden = 2 ! number of neurons in input, output, and hidden layers + integer, parameter :: n(*) = [inputs, hidden, outputs] ! neurons per layer + integer, parameter :: n_max = maxval(n), layers=size(n) ! max layer width, number of layers + real(rkind) w(n_max, n_max, layers-1), b(n_max, n_max) + + call random_number(b) + call random_number(w) + + trainable_engine = trainable_engine_t( & + nodes = n, weights = w, biases = b, differentiable_activation_strategy = sigmoid_t(), & + metadata = [string_t("1 hide|2 wide"), string_t("D. Rouson"), string_t("2023-06-30"), string_t("sigmoid"), string_t("false")]& + ) + end function + +end program diff --git a/example/write-read-infer.f90 b/example/write-read-infer.f90 index 378c38826..c0c339ddd 100644 --- a/example/write-read-infer.f90 +++ b/example/write-read-infer.f90 @@ -29,6 +29,19 @@ program write_read_infer contains + function single_hidden_layer_xor_network() result(inference_engine) + type(inference_engine_t) inference_engine + integer, parameter :: nodes_per_layer(*) = [2, 3, 1] + integer, parameter :: max_n = maxval(nodes_per_layer), layers = size(nodes_per_layer) + + inference_engine = inference_engine_t( & + metadata = [string_t("XOR"), string_t("Damian Rouson"), string_t("2023-07-02"), string_t("step"), string_t("false")], & + weights = reshape([real(rkind):: [1,1,0, 0,1,1, 0,0,0], [1,0,0, -2,0,0, 1,0,0]], [max_n, max_n, layers-1]), & + biases = reshape([[0.,-1.99,0.], [0., 0., 0.]], [max_n, layers-1]), & + nodes = nodes_per_layer & + ) + end function + subroutine write_read_query_infer(output_file_name) type(string_t), intent(in) :: output_file_name type(string_t) activation_name @@ -42,14 +55,8 @@ subroutine write_read_query_infer(output_file_name) real(rkind), parameter :: false = 0._rkind, true = 1._rkind print *, "Constructing an inference_engine_t neural-network object from scratch." - xor_network = inference_engine_t( & - metadata = [string_t("XOR"), string_t("Damian Rouson"), string_t("2023-02-18"), string_t("step"), string_t("false")], & - input_weights = real(reshape([1,0,1,1,0,1], [num_inputs, num_neurons]), rkind), & - hidden_weights = real(identity, rkind), & - output_weights = real(reshape([1,-2,1], [num_outputs, num_neurons]), rkind), & - biases = reshape([real(rkind):: 0.,-1.99,0., 0.,0.,0.], [num_neurons, num_hidden_layers]), & - output_biases = [real(rkind):: 0.] & - ) + xor_network = single_hidden_layer_xor_network() + print *, "Converting an inference_engine_t object to a file_t object." json_output_file = xor_network%to_json() diff --git a/fpm.toml b/fpm.toml index 5af0525eb..3c3380f92 100644 --- a/fpm.toml +++ b/fpm.toml @@ -6,5 +6,5 @@ maintainer = "rouson@lbl.gov" [dependencies] assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.4.0"} -sourcery = {git = "https://github.com/sourceryinstitute/sourcery", tag = "3.6.0"} +sourcery = {git = "https://github.com/sourceryinstitute/sourcery", tag = "3.8.2"} netcdf-interfaces = {git = "https://github.com/rouson/netcdf-interfaces.git", branch = "implicit-interfaces"} diff --git a/src/inference_engine/inference_engine_m_.f90 b/src/inference_engine/inference_engine_m_.f90 index 5e20242f5..93a920e2a 100644 --- a/src/inference_engine/inference_engine_m_.f90 +++ b/src/inference_engine/inference_engine_m_.f90 @@ -13,6 +13,7 @@ module inference_engine_m_ private public :: inference_engine_t + public :: difference_t character(len=*), parameter :: key(*) = [character(len=len("usingSkipConnections")) :: & "modelName", "modelAuthor", "compilationDate", "activationFunction", "usingSkipConnections"] @@ -21,23 +22,15 @@ module inference_engine_m_ !! Encapsulate the minimal information needed to perform inference private type(string_t) metadata_(size(key)) - real(rkind), allocatable :: weights_(:,:,:), biases__(:,:) + real(rkind), allocatable :: weights_(:,:,:), biases_(:,:) integer, allocatable :: nodes_(:) class(activation_strategy_t), allocatable :: activation_strategy_ ! Strategy Pattern facilitates elemental activation - - ! TODO: rm these legacy components - real(rkind), allocatable :: input_weights_(:,:) ! weights applied to go from the inputs to first hidden layer - real(rkind), allocatable :: hidden_weights_(:,:,:) ! weights applied to go from one hidden layer to the next - real(rkind), allocatable :: output_weights_(:,:) ! weights applied to go from the final hidden layer to the outputs - real(rkind), allocatable :: biases_(:,:) ! neuronal offsets for each hidden layer - real(rkind), allocatable :: output_biases_(:) ! neuronal offsets applied to outputs contains procedure :: infer procedure :: to_json procedure :: num_inputs procedure :: num_outputs procedure :: nodes_per_layer - procedure :: norm procedure :: assert_conformable_with procedure :: skip procedure, private :: subtract @@ -45,6 +38,14 @@ module inference_engine_m_ procedure :: activation_function_name end type + type difference_t + private + real(rkind), allocatable :: weights_difference_(:,:,:), biases_difference_(:,:) + integer, allocatable :: nodes_difference_(:) + contains + procedure :: norm + end type + interface inference_engine_t pure module function construct_from_padded_arrays(metadata, weights, biases, nodes) result(inference_engine) @@ -55,16 +56,6 @@ pure module function construct_from_padded_arrays(metadata, weights, biases, nod type(inference_engine_t) inference_engine end function - pure module function construct_from_legacy_arrays( & - metadata, input_weights, hidden_weights, output_weights, biases, output_biases & - ) result(inference_engine) - implicit none - type(string_t), intent(in) :: metadata(:) - real(rkind), intent(in), dimension(:,:) :: input_weights, output_weights, biases - real(rkind), intent(in) :: hidden_weights(:,:,:), output_biases(:) - type(inference_engine_t) inference_engine - end function - impure elemental module function construct_from_json(file_) result(inference_engine) implicit none type(file_t), intent(in) :: file_ @@ -83,7 +74,7 @@ impure elemental module function to_json(self) result(json_file) elemental module function norm(self) result(norm_of_self) implicit none - class(inference_engine_t), intent(in) :: self + class(difference_t), intent(in) :: self real(rkind) norm_of_self end function @@ -91,7 +82,7 @@ elemental module function subtract(self, rhs) result(difference) implicit none class(inference_engine_t), intent(in) :: self type(inference_engine_t), intent(in) :: rhs - type(inference_engine_t) difference + type(difference_t) difference end function elemental module subroutine assert_conformable_with(self, inference_engine) diff --git a/src/inference_engine/inference_engine_s.f90 b/src/inference_engine/inference_engine_s.f90 index 49e8ff690..321e6c5f8 100644 --- a/src/inference_engine/inference_engine_s.f90 +++ b/src/inference_engine/inference_engine_s.f90 @@ -13,6 +13,11 @@ use outputs_m, only : outputs_t implicit none + interface assert_consistency + module procedure inference_engine_consistency + module procedure difference_consistency + end interface + contains module procedure infer @@ -23,7 +28,7 @@ call assert_consistency(self) - associate(w => self%weights_, b => self%biases__, n => self%nodes_, output_layer => ubound(self%nodes_,1)) + associate(w => self%weights_, b => self%biases_, n => self%nodes_, output_layer => ubound(self%nodes_,1)) allocate(a(maxval(n), input_layer:output_layer)) @@ -42,27 +47,47 @@ end procedure - pure module subroutine assert_consistency(self) + pure module subroutine inference_engine_consistency(self) type(inference_engine_t), intent(in) :: self integer, parameter :: input_layer=0 associate( & - all_allocated=>[allocated(self%weights_),allocated(self%biases__),allocated(self%nodes_),allocated(self%activation_strategy_)]& + all_allocated=>[allocated(self%weights_),allocated(self%biases_),allocated(self%nodes_),allocated(self%activation_strategy_)]& ) - call assert(all(all_allocated),"inference_engine_s(assert_consistency): fully_allocated",intrinsic_array_t(all_allocated)) + call assert(all(all_allocated),"inference_engine_s(inference_engine_consistency): fully_allocated", & + intrinsic_array_t(all_allocated)) end associate - associate(max_width=>maxval(self%nodes_), component_dims=>[size(self%biases__,1), size(self%weights_,1), size(self%weights_,2)]) - call assert(all(component_dims == max_width), "inference_engine_s(assert_consistency): conformable arrays", & + associate(max_width=>maxval(self%nodes_), component_dims=>[size(self%biases_,1), size(self%weights_,1), size(self%weights_,2)]) + call assert(all(component_dims == max_width), "inference_engine_s(inference_engine_consistency): conformable arrays", & intrinsic_array_t([max_width,component_dims])) end associate associate(input_subscript => lbound(self%nodes_,1)) - call assert(input_subscript == input_layer, "inference_engine_s(assert_consistency): n base subsscript", input_subscript) + call assert(input_subscript == input_layer, "inference_engine_s(inference_engine_consistency): n base subsscript", & + input_subscript) + end associate + + end subroutine + + pure module subroutine difference_consistency(self) + + type(difference_t), intent(in) :: self + + integer, parameter :: input_layer=0 + + associate( & + all_allocated=>[allocated(self%weights_difference_),allocated(self%biases_difference_),allocated(self%nodes_difference_)] & + ) + call assert(all(all_allocated),"inference_engine_s(difference_consistency): fully_allocated",intrinsic_array_t(all_allocated)) end associate + call assert(all(size(self%biases_difference_,1)==[size(self%weights_difference_,1), size(self%weights_difference_,2)]), & + "inference_engine_s(difference_consistency): conformable arrays" & + ) + end subroutine pure subroutine set_activation_strategy(inference_engine) @@ -87,80 +112,16 @@ pure subroutine set_activation_strategy(inference_engine) inference_engine%metadata_ = metadata inference_engine%weights_ = weights - inference_engine%biases__ = biases + inference_engine%biases_ = biases inference_engine%nodes_ = nodes call set_activation_strategy(inference_engine) call assert_consistency(inference_engine) end procedure construct_from_padded_arrays - module procedure construct_from_legacy_arrays - - real(rkind), allocatable :: transposed(:,:,:) - integer layer, j, l - - allocate(transposed(size(hidden_weights,2), size(hidden_weights,1), size(hidden_weights,3))) - do concurrent(layer = 1:size(hidden_weights,3)) - transposed(:,:,layer) = transpose(hidden_weights(:,:,layer)) - end do - - inference_engine%metadata_ = metadata - inference_engine%input_weights_ = transpose(input_weights) - inference_engine%hidden_weights_ = transposed - inference_engine%output_weights_ = output_weights - inference_engine%biases_ = biases - inference_engine%output_biases_ = output_biases - - associate( & - n_max => max(size(inference_engine%biases_,1),size(inference_engine%output_biases_,1),size(inference_engine%input_weights_,1)),& - n_hidden => size(inference_engine%biases_,2), & - n_inputs => size(inference_engine%input_weights_,1), & - n_outputs => size(inference_engine%output_biases_) & - ) - associate(layers => n_hidden + 2) - - allocate(inference_engine%weights_(n_max, n_max, layers)) - allocate(inference_engine%biases__(n_max, n_max)) - associate(n => [n_inputs, [(size(biases,1), l=1,size(biases,2))], n_outputs]) - allocate(inference_engine%nodes_(0:size(n)-1), source = n) - end associate - - associate(n => inference_engine%nodes_) - l = 1 - do concurrent(j = 1:n(l)) - inference_engine%weights_(j,1:n(l-1),l) = inference_engine%input_weights_(j,1:n(l-1)) - end do - - do concurrent(l = 2:n_hidden) - do concurrent(j = 1:n(l)) - inference_engine%weights_(j,1:n(l-1),l) = inference_engine%hidden_weights_(j,1:n(l-1),l-1) - end do - end do - - l = n_hidden + 1 - do concurrent(j = 1:n(l)) - inference_engine%weights_(j,1:n(l-1),l) = inference_engine%output_weights_(j,1:n(l-1)) - end do - - do concurrent(l = 1:n_hidden) - inference_engine%biases_(1:n(l),l) = inference_engine%biases__(1:n(l),l) - end do - - l = n_hidden + 1 - inference_engine%biases_(1:n(l),l) = inference_engine%output_biases_(1:n(l)) - end associate - end associate - end associate - - call set_activation_strategy(inference_engine) - call assert_consistent(inference_engine) - call assert_consistency(inference_engine) - - end procedure - module procedure construct_from_json - type(string_t), allocatable :: lines(:) + type(string_t), allocatable :: lines(:), metadata(:) type(layer_t) hidden_layers, output_layer type(neuron_t) output_neuron real(rkind), allocatable :: hidden_weights(:,:,:) @@ -172,7 +133,7 @@ pure subroutine set_activation_strategy(inference_engine) call assert(adjustl(lines(l)%string())=="{", "construct_from_json: expecting '{' to start outermost object", lines(l)%string()) l = 2 - inference_engine%metadata_ = [string_t(""),string_t(""),string_t(""),string_t(""),string_t("false")] + metadata = [string_t(""),string_t(""),string_t(""),string_t(""),string_t("false")] if (adjustl(lines(l)%string()) == '"metadata": {') then block character(len=:), allocatable :: justified_line @@ -180,7 +141,7 @@ pure subroutine set_activation_strategy(inference_engine) l = l + 1 justified_line = adjustl(lines(l)%string()) if (justified_line == "},") exit - inference_engine%metadata_(findloc(key, trim(get_key_string(justified_line)), dim=1)) = get_key_value(justified_line) + metadata(findloc(key, trim(get_key_string(justified_line)), dim=1)) = get_key_value(justified_line) end do l = l + 1 end block @@ -192,7 +153,7 @@ pure subroutine set_activation_strategy(inference_engine) block integer, parameter :: lines_per_neuron=4, bracket_lines_per_layer=2 character(len=:), allocatable :: output_layer_line - + hidden_layers = layer_t(lines, start=l) associate( output_layer_line_number => l + lines_per_neuron*sum(hidden_layers%count_neurons()) & @@ -206,37 +167,10 @@ pure subroutine set_activation_strategy(inference_engine) end associate end block - inference_engine%input_weights_ = transpose(hidden_layers%input_weights()) - - block - type(layer_t), pointer :: next_layer - real(rkind), allocatable :: transposed(:,:,:) - integer layer - - next_layer => hidden_layers%next_pointer() - - if (hidden_layers%next_allocated()) then - hidden_weights = next_layer%hidden_weights() - else - associate(neurons_per_layer => size(inference_engine%input_weights_,1)) ! keep consistent with the eponymous function - allocate(hidden_weights(neurons_per_layer, neurons_per_layer, 0)) - end associate - end if - - inference_engine%biases_ = hidden_layers%hidden_biases() - - allocate(transposed(size(hidden_weights,2), size(hidden_weights,1), size(hidden_weights,3))) - do concurrent(layer = 1:size(hidden_weights,3)) - transposed(:,:,layer) = transpose(hidden_weights(:,:,layer)) - end do - inference_engine%hidden_weights_ = transposed - end block - - inference_engine%output_weights_ = output_layer%output_weights() - inference_engine%output_biases_ = output_layer%output_biases() + inference_engine = hidden_layers%inference_engine(metadata, output_layer) call set_activation_strategy(inference_engine) - call assert_consistent(inference_engine) + call assert_consistency(inference_engine) contains @@ -272,15 +206,13 @@ function get_key_value(line) result(value_) module procedure assert_conformable_with - call assert_consistent(self) - call assert_consistent(inference_engine) + call assert_consistency(self) + call assert_consistency(inference_engine) associate(equal_shapes => [ & - shape(self%input_weights_ ) == shape(inference_engine%input_weights_ ), & - shape(self%hidden_weights_) == shape(inference_engine%hidden_weights_), & - shape(self%output_weights_) == shape(inference_engine%output_weights_), & - shape(self%biases_ ) == shape(inference_engine%biases_ ), & - shape(self%output_biases_ ) == shape(inference_engine%output_biases_ ) & + shape(self%weights_) == shape(inference_engine%weights_), & + shape(self%biases_) == shape(inference_engine%biases_), & + shape(self%nodes_) == shape(inference_engine%nodes_) & ]) call assert(all(equal_shapes), "assert_conformable_with: all(equal_shapes)", intrinsic_array_t(equal_shapes)) end associate @@ -290,61 +222,42 @@ function get_key_value(line) result(value_) end procedure module procedure subtract + + call assert_consistency(self) + call assert_consistency(rhs) call self%assert_conformable_with(rhs) - difference%metadata_ = self%metadata_ - difference%input_weights_ = self%input_weights_ - rhs%input_weights_ - difference%hidden_weights_ = self%hidden_weights_ - rhs%hidden_weights_ - difference%output_weights_ = self%output_weights_ - rhs%output_weights_ - difference%biases_ = self%biases_ - rhs%biases_ - difference%output_biases_ = self%output_biases_ - rhs%output_biases_ - difference%activation_strategy_ = self%activation_strategy_ + block + integer l + + allocate(difference%weights_difference_, mold = self%weights_) + allocate(difference%biases_difference_, mold = self%biases_) + allocate(difference%nodes_difference_, mold = self%nodes_) + + difference%weights_difference_ = 0. + difference%biases_difference_ = 0. + difference%nodes_difference_ = 0. + + l = 0 + difference%nodes_difference_(l) = self%nodes_(l) - rhs%nodes_(l) + + associate(n => self%nodes_) + do concurrent(l = 1:ubound(n,1)) + difference%weights_difference_(1:n(l),1:n(l-1),l) = self%weights_(1:n(l),1:n(l-1),l) - rhs%weights_(1:n(l),1:n(l-1),l) + difference%biases_difference_(1:n(l),l) = self%biases_(1:n(l),l) - rhs%biases_(1:n(l),l) + difference%nodes_difference_(l) = self%nodes_(l) - rhs%nodes_(l) + end do + end associate - call assert_consistent(difference) + end block + + call assert_consistency(difference) end procedure module procedure norm - call assert_consistent(self) - norm_of_self = maxval(abs(self%input_weights_)) + maxval(abs(self%hidden_weights_)) + maxval(abs(self%output_weights_)) + & - maxval(abs(self%biases_)) + maxval(abs(self%output_biases_)) + norm_of_self = maxval([abs(self%weights_difference_), abs(self%biases_difference_), real(abs(self%nodes_difference_))]) end procedure - pure subroutine assert_consistent(self) - type(inference_engine_t), intent(in) :: self - - call assert(all(self%metadata_%is_allocated()), "inference_engine_t%assert_consistent: self%metadata_s%is_allocated()") - call assert(allocated(self%activation_strategy_), "inference_engine_t%assert_consistent: allocated(self%activation_strategy_)") - - associate(allocated_components => & - [allocated(self%input_weights_), allocated(self%hidden_weights_), allocated(self%output_weights_), & - allocated(self%biases_), allocated(self%output_biases_)] & - ) - call assert(all(allocated_components), "inference_engine_s(assert_consistent): fully allocated object", & - intrinsic_array_t(allocated_components)) - end associate - - associate(num_neurons => 1 + & - [ ubound(self%biases_, 1) - lbound(self%biases_, 1), & - ubound(self%hidden_weights_, 1) - lbound(self%hidden_weights_, 1), & - ubound(self%hidden_weights_, 2) - lbound(self%hidden_weights_, 2), & - ubound(self%input_weights_, 1) - lbound(self%input_weights_, 1), & - ubound(self%output_weights_, 2) - lbound(self%output_weights_, 2) & - ] ) - call assert(all(num_neurons == num_neurons(1)), "inference_engine_s(assert_consistent): num_neurons", & - intrinsic_array_t(num_neurons) & - ) - end associate - - associate(output_count => 1 + & - [ ubound(self%output_weights_, 1) - lbound(self%output_weights_, 1), & - ubound(self%output_biases_, 1) - lbound(self%output_biases_, 1) & - ] ) - call assert(all(output_count == output_count(1)), "inference_engine_s(assert_consistent): output_count", & - intrinsic_array_t(output_count) & - ) - end associate - end subroutine - module procedure num_outputs call assert_consistency(self) output_count = self%nodes_(ubound(self%nodes_,1)) @@ -371,13 +284,19 @@ pure subroutine assert_consistent(self) outer_object_braces = 2, hidden_layer_outer_brackets = 2, lines_per_neuron = 4, inner_brackets_per_layer = 2, & output_layer_brackets = 2, metadata_outer_braces = 2 - call assert_consistent(self) + call assert_consistency(self) csv_format = separated_values(separator=",", mold=[real(rkind)::]) - associate(num_hidden_layers => size(self%hidden_weights_,3)+1, & - neurons_per_layer => ubound(self%input_weights_,1) - lbound(self%input_weights_,1) + 1, & - num_outputs => self%num_outputs(), num_inputs => self%num_inputs()) + associate(num_hidden_layers => size(self%nodes_)-2, & + neurons_per_layer => self%nodes_(lbound(self%nodes_,1)+1), & + num_outputs => self%num_outputs(), & + num_inputs => self%num_inputs() & + ) + + call assert(all(neurons_per_layer==self%nodes_(lbound(self%nodes_,1)+1 : ubound(self%nodes_,1)-1)), & + "to_json: uniform hidden layers") + associate(num_lines => & outer_object_braces & + metadata_outer_braces + size(key) & @@ -421,10 +340,16 @@ pure subroutine assert_consistent(self) line = line + 1 lines(line) = string_t(' {') line = line + 1 + if (allocated(comma_separated_values)) deallocate(comma_separated_values) allocate(character(len=num_inputs*(characters_per_value+1)-1)::comma_separated_values) - write(comma_separated_values, fmt = csv_format) self%input_weights_(neuron,:) + block + integer l + associate(n => self%nodes_) + l = 1 + write(comma_separated_values, fmt = csv_format) self%weights_(neuron,1:n(l-1),l) + end associate + end block lines(line) = string_t(' "weights": [' // trim(comma_separated_values) // '],') - deallocate(comma_separated_values) line = line + 1 write(single_value, fmt = csv_format) self%biases_(neuron,layer) lines(line) = string_t(' "bias": ' // trim(single_value)) @@ -437,20 +362,32 @@ pure subroutine assert_consistent(self) do layer = 1, num_hidden_layers-1 line = line + 1 lines(line) = string_t(' [') + block + real(rkind), allocatable :: hidden_layer_weights(:,:) + integer j, l + + associate(n => self%nodes_, l => layer + 1) + allocate(hidden_layer_weights(n(l),n(l-1))) + do concurrent(j = 1:n(l)) + hidden_layer_weights(j,1:n(l-1)) = self%weights_(j,1:n(l-1),l) + end do + hidden_layer_weights = transpose(hidden_layer_weights) + end associate do neuron = 1, neurons_per_layer line = line + 1 lines(line) = string_t(' {') line = line + 1 + if (allocated(comma_separated_values)) deallocate(comma_separated_values) allocate(character(len=neurons_per_layer*(characters_per_value+1)-1)::comma_separated_values) - write(comma_separated_values, fmt = csv_format) self%hidden_weights_(:, neuron, layer) + write(comma_separated_values, fmt = csv_format) hidden_layer_weights(:, neuron) lines(line) = string_t(' "weights": [' // trim(comma_separated_values) // '],') - deallocate(comma_separated_values) line = line + 1 write(single_value, fmt = csv_format) self%biases_(neuron,layer+1) lines(line) = string_t(' "bias": ' // trim(single_value)) line = line + 1 lines(line) = string_t(" }" // trim(merge(' ',',',neuron==neurons_per_layer))) end do + end block line = line + 1 lines(line) = string_t(" ]" // trim(merge(' ',',',layer==num_hidden_layers-1))) end do @@ -465,15 +402,17 @@ pure subroutine assert_consistent(self) line = line + 1 lines(line) = string_t(' {') line = line + 1 + if (allocated(comma_separated_values)) deallocate(comma_separated_values) allocate(character(len=neurons_per_layer*(characters_per_value+1)-1)::comma_separated_values) - write(comma_separated_values, fmt = csv_format) self%output_weights_(neuron,:) + associate(n => self%nodes_, l => ubound(self%nodes_,1)) + write(comma_separated_values, fmt = csv_format) self%weights_(neuron,1:n(l-1),l) + end associate lines(line) = string_t(' "weights": [' // trim(comma_separated_values) // '],') - deallocate(comma_separated_values) line = line + 1 - write(single_value, fmt = csv_format) self%output_biases_(neuron) + write(single_value, fmt = csv_format) self%biases_(neuron,ubound(self%biases_,2)) lines(line) = string_t(' "bias": ' // trim(single_value)) line = line + 1 - lines(line) = string_t(" }") + lines(line) = string_t(" }" // trim(merge(' ',',',neuron==num_outputs))) end do line = line + 1 diff --git a/src/inference_engine/layer_m.f90 b/src/inference_engine/layer_m.f90 index 3563b64ad..291bf2383 100644 --- a/src/inference_engine/layer_m.f90 +++ b/src/inference_engine/layer_m.f90 @@ -2,8 +2,9 @@ ! Terms of use are as specified in LICENSE.txt module layer_m use neuron_m, only : neuron_t - use string_m, only : string_t + use sourcery_m, only : string_t use kind_parameters_m, only : rkind + use inference_engine_m_, only : inference_engine_t implicit none private @@ -15,13 +16,10 @@ module layer_m type(neuron_t) neuron !! linked list of this layer's neurons type(layer_t), allocatable :: next !! next layer contains + procedure :: inference_engine procedure :: count_layers procedure :: count_neurons - procedure :: input_weights - procedure :: hidden_weights - procedure :: output_weights - procedure :: output_biases - procedure :: hidden_biases + procedure :: count_inputs procedure :: neurons_per_layer procedure :: next_allocated procedure :: next_pointer @@ -41,6 +39,14 @@ recursive module function construct(layer_lines, start) result(layer) interface + module function inference_engine(hidden_layers, metadata, output_layer) result(inference_engine_) + implicit none + class(layer_t), intent(in), target :: hidden_layers + type(layer_t), intent(in), target :: output_layer + type(string_t), intent(in) :: metadata(:) + type(inference_engine_t) inference_engine_ + end function + module function count_layers(layer) result(num_layers) implicit none class(layer_t), intent(in), target :: layer @@ -53,34 +59,10 @@ module function count_neurons(layer) result(neurons_per_layer) integer, allocatable :: neurons_per_layer(:) end function - module function input_weights(self) result(weights) - implicit none - class(layer_t), intent(in), target :: self - real(rkind), allocatable :: weights(:,:) - end function - - module function hidden_weights(self) result(weights) - implicit none - class(layer_t), intent(in), target :: self - real(rkind), allocatable :: weights(:,:,:) - end function - - module function output_weights(self) result(weights) - implicit none - class(layer_t), intent(in), target :: self - real(rkind), allocatable :: weights(:,:) - end function - - module function output_biases(self) result(biases) + module function count_inputs(layer) result(num_inputs) implicit none - class(layer_t), intent(in), target :: self - real(rkind), allocatable :: biases(:) - end function - - module function hidden_biases(self) result(biases) - implicit none - class(layer_t), intent(in), target :: self - real(rkind), allocatable :: biases(:,:) + class(layer_t), intent(in) :: layer + integer num_inputs end function module function neurons_per_layer(self) result(num_neurons) diff --git a/src/inference_engine/layer_s.f90 b/src/inference_engine/layer_s.f90 index 7f39a282d..6f43c6f0c 100644 --- a/src/inference_engine/layer_s.f90 +++ b/src/inference_engine/layer_s.f90 @@ -38,6 +38,78 @@ end procedure + module procedure inference_engine + + associate( & + num_inputs => hidden_layers%count_inputs(), & + num_outputs => output_layer%count_neurons(), & + neurons_per_hidden_layer => hidden_layers%count_neurons(), & + num_hidden_layers => hidden_layers%count_layers(), & + num_output_layers => output_layer%count_layers() & + ) + call assert(num_output_layers==1, "inference_engine_s(construct_from_json): 1 output layer", num_output_layers) + + associate(nodes => [num_inputs, neurons_per_hidden_layer, num_outputs]) + associate(n_max => maxval(nodes)) + block + real(rkind), allocatable :: weights(:,:,:), biases(:,:) + type(layer_t), pointer :: layer_ptr + type(neuron_t), pointer :: neuron_ptr + integer j, l + + allocate(weights(n_max, n_max, num_hidden_layers + num_output_layers)) + allocate(biases(n_max, num_hidden_layers + num_output_layers)) + + layer_ptr => hidden_layers + l = 0 + loop_over_hidden_Layers: & + do + l = l + 1 + neuron_ptr => layer_ptr%neuron + j = 0 + loop_over_hidden_neurons: & + do + j = j + 1 + associate(w => neuron_ptr%weights()) + weights(j,1:size(w,1),l) = w + end associate + biases(j,l) = neuron_ptr%bias() + + if (.not. neuron_ptr%next_allocated()) exit + neuron_ptr => neuron_ptr%next_pointer() + + end do loop_over_hidden_neurons + + if (.not. allocated(layer_ptr%next)) exit + layer_ptr => layer_ptr%next_pointer() + + end do loop_over_hidden_Layers + + layer_ptr => output_layer + l = l + 1 + neuron_ptr => layer_ptr%neuron + j = 0 + loop_over_output_neurons: & + do + j = j + 1 + associate(w => neuron_ptr%weights()) + weights(j,1:size(w,1),l) = w + end associate + biases(j,l) = neuron_ptr%bias() + + if (.not. neuron_ptr%next_allocated()) exit + neuron_ptr => neuron_ptr%next_pointer() + + end do loop_over_output_neurons + + inference_engine_ = inference_engine_t(metadata, weights, biases, nodes) + end block + end associate + end associate + end associate + + end procedure + module procedure count_layers type(layer_t), pointer :: layer_ptr @@ -77,180 +149,10 @@ end procedure - module procedure input_weights - - type(neuron_t), pointer :: neuron - integer i - - associate(num_inputs => self%neuron%num_inputs(), neurons_per_layer => self%neurons_per_layer()) - - allocate(weights(num_inputs, neurons_per_layer)) - - neuron => self%neuron - weights(:,1) = neuron%weights() - - do i = 2, neurons_per_layer - 1 - call assert(neuron%next_allocated(), "layer_t%input_weights: neuron%next_allocated()") - neuron => neuron%next_pointer() - weights(:,i) = neuron%weights() - call assert(neuron%num_inputs() == num_inputs, "layer_t%input_weights: constant number of inputs") - end do - neuron => neuron%next_pointer() - call assert(.not. neuron%next_allocated(), "layer_t%input_weights: .not. neuron%next_allocated()") - if (neurons_per_layer /= 1) weights(:,neurons_per_layer) = neuron%weights() - - end associate - - end procedure - - module procedure hidden_weights - - type(neuron_t), pointer :: neuron - type(layer_t), pointer :: layer - integer n, l - - associate( & - num_inputs => self%neuron%num_inputs(), neurons_per_layer => self%neurons_per_layer(), num_layers => self%count_layers()) - - allocate(weights(num_inputs, neurons_per_layer, num_layers)) - - layer => self - - loop_over_layers: & - do l = 1, num_layers - - neuron => layer%neuron - weights(:,1,l) = neuron%weights() - - loop_over_neurons: & - do n = 2, neurons_per_layer - 1 - call assert(neuron%next_allocated(), "layer_t%hidden_weights: neuron%next_allocated()") - neuron => neuron%next_pointer() - weights(:,n,l) = neuron%weights() - call assert(neuron%num_inputs() == num_inputs, "layer_t%hidden_weights: constant number of inputs", & - intrinsic_array_t([num_inputs, neuron%num_inputs(), l, n])) - end do loop_over_neurons - - call assert(neuron%next_allocated(), "layer_t%hidden_weights: neuron%next_allocated()") - neuron => neuron%next_pointer() - if (neurons_per_layer /= 1) weights(:,neurons_per_layer,l) = neuron%weights() ! avoid redundant assignment - - if (l/=num_layers) then - layer => layer%next - else - call assert(.not. layer%next_allocated(), "layer_t%hidden_weights: .not. layer%next_allocated()") - end if - - end do loop_over_Layers - - end associate - - end procedure - - module procedure output_weights - - type(neuron_t), pointer :: neuron - integer n - - associate(num_outputs => self%neurons_per_layer(), neurons_per_hidden_layer => self%neuron%num_inputs()) - - neuron => self%neuron - allocate(weights(num_outputs, neurons_per_hidden_layer)) - weights(1,:) = neuron%weights() - - loop_over_output_neurons: & - do n = 2, num_outputs - 1 - call assert(neuron%next_allocated(), "layer_t%output_weights: neuron%next_allocated()") - neuron => neuron%next_pointer() - weights(n,:) = neuron%weights() - call assert(neuron%num_inputs() == neurons_per_hidden_layer, "layer_t%output_weights: constant number of inputs") - end do loop_over_output_neurons - - if (num_outputs > 1) then - call assert(neuron%next_allocated(), "layer_t%output_weights: neuron%next_allocated()") - neuron => neuron%next_pointer() - weights(num_outputs,:) = neuron%weights() ! avoid redundant assignment - call assert(.not. self%next_allocated(), "layer_t%output_weights: .not. layer%next_allocated()") - end if - - end associate - + module procedure count_inputs + num_inputs = layer%neuron%num_inputs() ! assume fully connected input layer end procedure - module procedure output_biases - - type(neuron_t), pointer :: neuron - integer n - - associate(num_outputs => self%neurons_per_layer()) - - neuron => self%neuron - allocate(biases(num_outputs)) - biases(1) = neuron%bias() - - loop_over_output_neurons: & - do n = 2, num_outputs - 1 - call assert(neuron%next_allocated(), "layer_t%output_biases: neuron%next_allocated()") - neuron => neuron%next_pointer() - biases(n) = neuron%bias() - end do loop_over_output_neurons - - if (num_outputs > 1) then - call assert(neuron%next_allocated(), "layer_t%output_biases: neuron%next_allocated()") - neuron => neuron%next_pointer() - biases(num_outputs) = neuron%bias() ! avoid redundant assignment - call assert(.not. self%next_allocated(), "layer_t%output_biases: .not. layer%next_allocated()") - end if - - end associate - - end procedure - - module procedure hidden_biases - - type(neuron_t), pointer :: neuron - type(layer_t), pointer :: layer - integer n, l - - associate(neurons_per_layer => self%neurons_per_layer(), num_layers => self%count_layers()) - - allocate(biases(neurons_per_layer, num_layers)) - - layer => self - - loop_over_layers: & - do l = 1, num_layers - - neuron => layer%neuron - biases(1,l) = neuron%bias() - - loop_over_neurons: & - do n = 2, neurons_per_layer - 1 - call assert(neuron%next_allocated(), "layer_t%hidden_biases: neuron%next_allocated()", intrinsic_array_t([l,n])) - neuron => neuron%next_pointer() - biases(n,l) = neuron%bias() - end do loop_over_neurons - - call assert(neuron%next_allocated(), "layer_t%hidden_biases: neuron%next_allocated()", & - intrinsic_array_t([l,neurons_per_layer])) - neuron => neuron%next_pointer() - call assert(.not. neuron%next_allocated(), "layer_t%hidden_biases: .not. neuron%next_allocated()", & - intrinsic_array_t([l,neurons_per_layer])) - if (neurons_per_layer /= 1) biases(neurons_per_layer,l) = neuron%bias() ! avoid redundant assignment - - if (l/=num_layers) then - layer => layer%next - else - call assert(.not. layer%next_allocated(), "layer_t%hidden_biases: .not. layer%next_allocated()") - end if - - end do loop_over_layers - - end associate - - - end procedure hidden_biases - module procedure neurons_per_layer type(neuron_t), pointer :: neuron diff --git a/src/inference_engine/trainable_engine_m.f90 b/src/inference_engine/trainable_engine_m.f90 index 2162fa315..f6a47e55b 100644 --- a/src/inference_engine/trainable_engine_m.f90 +++ b/src/inference_engine/trainable_engine_m.f90 @@ -2,13 +2,14 @@ ! Terms of use are as specified in LICENSE.txt module trainable_engine_m !! Define an abstraction that supports training a neural network - use inference_strategy_m, only : inference_strategy_t + + use sourcery_m, only : string_t + use inference_engine_m_, only : inference_engine_t use outputs_m, only : outputs_t use differentiable_activation_strategy_m, only : differentiable_activation_strategy_t - use string_m, only : string_t use kind_parameters_m, only : rkind - use inputs_m, only : inputs_t - use expected_outputs_m, only : expected_outputs_t + use inputs_m, only : inputs_t + use expected_outputs_m, only : expected_outputs_t use mini_batch_m, only : mini_batch_t implicit none @@ -18,6 +19,7 @@ module trainable_engine_m type trainable_engine_t !! Encapsulate the information needed to perform training private + type(string_t), allocatable :: metadata_(:) real(rkind), allocatable :: w(:,:,:) ! weights real(rkind), allocatable :: b(:,:) ! biases integer, allocatable :: n(:) ! nuerons per layer @@ -28,6 +30,7 @@ module trainable_engine_m procedure :: infer procedure :: num_layers procedure :: num_inputs + procedure :: to_inference_engine end type integer, parameter :: input_layer = 0 @@ -71,13 +74,19 @@ elemental module function num_inputs(self) result(n_in) class(trainable_engine_t), intent(in) :: self integer n_in end function - + elemental module function num_layers(self) result(n_layers) implicit none class(trainable_engine_t), intent(in) :: self integer n_layers end function - + + pure module function to_inference_engine(self) result(inference_engine) + implicit none + class(trainable_engine_t), intent(in) :: self + type(inference_engine_t) :: inference_engine + end function + end interface end module trainable_engine_m diff --git a/src/inference_engine/trainable_engine_s.f90 b/src/inference_engine/trainable_engine_s.f90 index bf2380ca0..49288d91c 100644 --- a/src/inference_engine/trainable_engine_s.f90 +++ b/src/inference_engine/trainable_engine_s.f90 @@ -43,7 +43,7 @@ call self%assert_consistent - associate(w => self%w, b => self%b, n => self%n, output_layer => ubound(self%b,2)) + associate(w => self%w, b => self%b, n => self%n, output_layer => ubound(self%n,1)) allocate(z, mold=b) allocate(a(maxval(n), input_layer:output_layer)) ! Activations @@ -151,6 +151,7 @@ module procedure construct_from_padded_arrays + trainable_engine%metadata_ = metadata trainable_engine%n = nodes trainable_engine%w = weights trainable_engine%b = biases @@ -159,4 +160,8 @@ call trainable_engine%assert_consistent end procedure + module procedure to_inference_engine + inference_engine = inference_engine_t(metadata = self%metadata_, weights = self%w, biases = self%b, nodes = self%n) + end procedure + end submodule trainable_engine_s diff --git a/src/inference_engine_m.f90 b/src/inference_engine_m.f90 index e92143522..cc15bc7cc 100644 --- a/src/inference_engine_m.f90 +++ b/src/inference_engine_m.f90 @@ -8,8 +8,7 @@ module inference_engine_m use expected_outputs_m, only : expected_outputs_t use inputs_m, only : inputs_t use input_output_pair_m, only : input_output_pair_t - use inference_engine_m_, only : inference_engine_t - use inference_strategy_m, only :inference_strategy_t + use inference_engine_m_, only : inference_engine_t, difference_t use kind_parameters_m, only : rkind use matmul_m, only : matmul_t use mini_batch_m, only : mini_batch_t diff --git a/test/inference_engine_test_m.f90 b/test/inference_engine_test_m.f90 index b5c784c7f..c4f7d1306 100644 --- a/test/inference_engine_test_m.f90 +++ b/test/inference_engine_test_m.f90 @@ -9,9 +9,10 @@ module inference_engine_test_m use string_m, only : string_t use test_m, only : test_t use test_result_m, only : test_result_t + use file_m, only : file_t ! Internal dependencies - use inference_engine_m, only : inference_engine_t, inputs_t, outputs_t + use inference_engine_m, only : inference_engine_t, inputs_t, outputs_t, difference_t implicit none @@ -35,19 +36,18 @@ function results() result(test_results) type(test_result_t), allocatable :: test_results(:) character(len=*), parameter :: longest_description = & - "converting a single-hidden-layer network to and from JSON format" + "converting a network with 2 hidden layers to and from JSON format" associate( & descriptions => & [ character(len=len(longest_description)) :: & "performing elemental inference with 1 hidden layer", & "performing elemental inference with 2 hidden layers", & - "converting a single-hidden-layer network to and from JSON format", & - "converting a multi-hidden-layer network to and from JSON format" & + "converting a network with 2 hidden layers to and from JSON format" & ], & outcomes => & [ elemental_infer_with_1_hidden_layer_xor_net(), elemental_infer_with_2_hidden_layer_xor_net(), & - single_hidden_layer_net_to_from_json(), multi_hidden_layer_net_to_from_json() & + multi_hidden_layer_net_to_from_json() & ] & ) call assert(size(descriptions) == size(outcomes), "inference_engine_test(results): size(descriptions) == size(outcomes)") @@ -82,61 +82,40 @@ function multi_layer_xor_network() result(inference_engine) ) end function - function single_layer_perceptron() result(inference_engine) + function distinct_parameters() result(inference_engine) type(inference_engine_t) inference_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 = 1 ! number of hidden layers - - inference_engine = inference_engine_t( & - metadata = [string_t("Single-Layer XOR"), string_t("Damian Rouson"), string_t("2023-05-09"), string_t("step"), string_t("false")], & - input_weights = real(reshape([1,0,1,1,0,1], [n_in, neurons]), rkind), & - hidden_weights = reshape([real(rkind)::], [neurons,neurons,n_hidden-1]), & - output_weights = real(reshape([1,-2,1], [n_out, neurons]), rkind), & - biases = reshape([real(rkind):: 0.,-1.99,0.], [neurons, n_hidden]), & - output_biases = [real(rkind):: 0.] & - ) - end function + integer, parameter :: inputs = 2, hidden = 3, outputs = 1 ! number of neurons in input, output, and hidden layers + integer, parameter :: n(*) = [inputs, hidden, hidden, outputs] ! nodes per layer + integer, parameter :: n_max = maxval(n), layers=size(n) ! max layer width, number of layers + integer, parameter :: w_shape(*) = [n_max, n_max, layers-1], b_shape(*) = [n_max, n_max] + integer i + real(rkind), allocatable :: w(:,:,:), b(:,:) + + w = reshape( [(i, i=1,product(w_shape))], w_shape) + b = reshape( [(maxval(w) + i, i=1,product(b_shape))], b_shape) - function xor_network() result(inference_engine) - type(inference_engine_t) inference_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 i, j - integer, parameter :: identity(*,*,*) = & - reshape([((merge(1,0,i==j), i=1,neurons), j=1,neurons)], shape=[neurons,neurons,n_hidden-1]) - inference_engine = inference_engine_t( & - metadata = [string_t("XOR"), string_t("Damian Rouson"), string_t("2023-02-18"), string_t("step"), string_t("false")], & - input_weights = real(reshape([1,0,1,1,0,1], [n_in, neurons]), rkind), & - hidden_weights = real(identity, rkind), & - output_weights = real(reshape([1,-2,1], [n_out, neurons]), rkind), & - biases = reshape([real(rkind):: 0.,-1.99,0., 0.,0.,0.], [neurons, n_hidden]), & - output_biases = [real(rkind):: 0.] & - ) + metadata = [string_t("random"), string_t("Damian Rouson"), string_t("2023-07-15"), string_t("sigmoid"), string_t("false")], & + weights = w, biases = b, nodes = n & + ) end function function multi_hidden_layer_net_to_from_json() result(test_passes) logical, allocatable :: test_passes - type(inference_engine_t) xor, difference + type(inference_engine_t) inference_engine, from_json + type(file_t) json_file !, round_trip + type(difference_t) difference real, parameter :: tolerance = 1.0E-06 - xor = xor_network() - difference = inference_engine_t(xor%to_json()) - xor - test_passes = difference%norm() < tolerance - end function + inference_engine = distinct_parameters() + json_file = inference_engine%to_json() + from_json = inference_engine_t(json_file) - function single_hidden_layer_net_to_from_json() result(test_passes) - logical, allocatable :: test_passes - type(inference_engine_t) one_hidden_layer_network, difference - - real, parameter :: tolerance = 1.0E-06 + !call json_file%write_lines() + !round_trip = from_json%to_json() + !call round_trip%write_lines() - one_hidden_layer_network = single_layer_perceptron() - difference = inference_engine_t(one_hidden_layer_network%to_json()) - one_hidden_layer_network + difference = inference_engine - from_json test_passes = difference%norm() < tolerance end function