input_output_pair_m.f90 Source File


This file depends on

sourcefile~~input_output_pair_m.f90~~EfferentGraph sourcefile~input_output_pair_m.f90 input_output_pair_m.f90 sourcefile~kind_parameters_m.f90 kind_parameters_m.f90 sourcefile~input_output_pair_m.f90->sourcefile~kind_parameters_m.f90 sourcefile~tensor_m.f90 tensor_m.f90 sourcefile~input_output_pair_m.f90->sourcefile~tensor_m.f90 sourcefile~tensor_m.f90->sourcefile~kind_parameters_m.f90

Files dependent on this one

sourcefile~~input_output_pair_m.f90~~AfferentGraph sourcefile~input_output_pair_m.f90 input_output_pair_m.f90 sourcefile~fiats_m.f90 fiats_m.f90 sourcefile~fiats_m.f90->sourcefile~input_output_pair_m.f90 sourcefile~mini_batch_m.f90 mini_batch_m.f90 sourcefile~fiats_m.f90->sourcefile~mini_batch_m.f90 sourcefile~trainable_network_m.f90 trainable_network_m.f90 sourcefile~fiats_m.f90->sourcefile~trainable_network_m.f90 sourcefile~neural_network_m.f90 neural_network_m.f90 sourcefile~fiats_m.f90->sourcefile~neural_network_m.f90 sourcefile~input_output_pair_s.f90 input_output_pair_s.f90 sourcefile~input_output_pair_s.f90->sourcefile~input_output_pair_m.f90 sourcefile~mini_batch_m.f90->sourcefile~input_output_pair_m.f90 sourcefile~trainable_network_m.f90->sourcefile~input_output_pair_m.f90 sourcefile~trainable_network_m.f90->sourcefile~mini_batch_m.f90 sourcefile~trainable_network_m.f90->sourcefile~neural_network_m.f90 sourcefile~concurrent-inferences.f90 concurrent-inferences.f90 sourcefile~concurrent-inferences.f90->sourcefile~fiats_m.f90 sourcefile~learn-addition.f90 learn-addition.F90 sourcefile~learn-addition.f90->sourcefile~fiats_m.f90 sourcefile~learn-exponentiation.f90 learn-exponentiation.F90 sourcefile~learn-exponentiation.f90->sourcefile~fiats_m.f90 sourcefile~learn-multiplication.f90 learn-multiplication.F90 sourcefile~learn-multiplication.f90->sourcefile~fiats_m.f90 sourcefile~learn-power-series.f90 learn-power-series.F90 sourcefile~learn-power-series.f90->sourcefile~fiats_m.f90 sourcefile~learn-saturated-mixing-ratio.f90 learn-saturated-mixing-ratio.F90 sourcefile~learn-saturated-mixing-ratio.f90->sourcefile~fiats_m.f90 sourcefile~saturated_mixing_ratio_m.f90 saturated_mixing_ratio_m.f90 sourcefile~learn-saturated-mixing-ratio.f90->sourcefile~saturated_mixing_ratio_m.f90 sourcefile~mini_batch_s.f90 mini_batch_s.f90 sourcefile~mini_batch_s.f90->sourcefile~mini_batch_m.f90 sourcefile~neural_network_m.f90->sourcefile~mini_batch_m.f90 sourcefile~print-training-configuration.f90 print-training-configuration.F90 sourcefile~print-training-configuration.f90->sourcefile~fiats_m.f90 sourcefile~read-query-infer.f90 read-query-infer.f90 sourcefile~read-query-infer.f90->sourcefile~fiats_m.f90 sourcefile~saturated_mixing_ratio_m.f90->sourcefile~fiats_m.f90 sourcefile~train-and-write.f90 train-and-write.F90 sourcefile~train-and-write.f90->sourcefile~fiats_m.f90 sourcefile~trainable_network_s.f90 trainable_network_s.F90 sourcefile~trainable_network_s.f90->sourcefile~trainable_network_m.f90 sourcefile~write-read-infer.f90 write-read-infer.F90 sourcefile~write-read-infer.f90->sourcefile~fiats_m.f90 sourcefile~layer_m.f90 layer_m.f90 sourcefile~layer_m.f90->sourcefile~neural_network_m.f90 sourcefile~neural_network_s.f90 neural_network_s.F90 sourcefile~neural_network_s.f90->sourcefile~neural_network_m.f90 sourcefile~neural_network_s.f90->sourcefile~layer_m.f90 sourcefile~unmapped_network_s.f90 unmapped_network_s.F90 sourcefile~unmapped_network_s.f90->sourcefile~neural_network_m.f90 sourcefile~workspace_s.f90 workspace_s.F90 sourcefile~workspace_s.f90->sourcefile~neural_network_m.f90 sourcefile~layer_s.f90 layer_s.F90 sourcefile~layer_s.f90->sourcefile~layer_m.f90

Source Code

! Copyright (c), The Regents of the University of California
! Terms of use are as specified in LICENSE.txt
module input_output_pair_m
  use tensor_m, only : tensor_t
  use kind_parameters_m, only : default_real, double_precision
  implicit none

  private
  public :: input_output_pair_t
  public :: shuffle
  public :: write_to_stdout

  type input_output_pair_t(k)
    integer, kind :: k = default_real
    type(tensor_t(k)), private :: inputs_, expected_outputs_
  contains
    generic :: inputs                   => default_real_inputs, double_precision_inputs
    procedure, private, non_overridable :: default_real_inputs, double_precision_inputs
    generic :: expected_outputs         => default_real_expected_outputs, double_precision_expected_outputs
    procedure, private, non_overridable :: default_real_expected_outputs, double_precision_expected_outputs
  end type

  interface input_output_pair_t

    elemental module function default_real_construct(inputs, expected_outputs) result(input_output_pair)
      implicit none
      type(tensor_t), intent(in) :: inputs, expected_outputs
      type(input_output_pair_t) input_output_pair
    end function

    elemental module function double_precision_construct(inputs, expected_outputs) result(input_output_pair)
      implicit none
      type(tensor_t(double_precision)), intent(in) :: inputs, expected_outputs
      type(input_output_pair_t(double_precision)) input_output_pair
    end function

  end interface

  interface

    elemental module function default_real_inputs(self) result(my_inputs)
      implicit none
      class(input_output_pair_t), intent(in) :: self
      type(tensor_t) :: my_inputs
    end function

    elemental module function double_precision_inputs(self) result(my_inputs)
      implicit none
      class(input_output_pair_t(double_precision)), intent(in) :: self
      type(tensor_t(double_precision)) :: my_inputs
    end function

    elemental module function default_real_expected_outputs(self) result(my_expected_outputs)
      implicit none
      class(input_output_pair_t), intent(in) :: self
      type(tensor_t) :: my_expected_outputs
    end function

    elemental module function double_precision_expected_outputs(self) result(my_expected_outputs)
      implicit none
      class(input_output_pair_t(double_precision)), intent(in) :: self
      type(tensor_t(double_precision)) :: my_expected_outputs
    end function

  end interface

  interface shuffle

    module subroutine default_real_shuffle(pairs)
      implicit none
      type(input_output_pair_t), intent(inout) :: pairs(:)
    end subroutine

    module subroutine double_precision_shuffle(pairs)
      implicit none
      type(input_output_pair_t(double_precision)), intent(inout) :: pairs(:)
    end subroutine

  end interface

  interface write_to_stdout

    module subroutine default_real_write_to_stdout(input_output_pairs)
      implicit none
      type(input_output_pair_t), intent(in) :: input_output_pairs(:)
    end subroutine

    module subroutine double_precision_write_to_stdout(input_output_pairs)
      implicit none
      type(input_output_pair_t(double_precision)), intent(in) :: input_output_pairs(:)
    end subroutine

  end interface

end module input_output_pair_m