Merge pull request #48 from sourceryinstitute/add-bins

Add bin abstraction

Author: rouson

fpm.toml

@@ -6,4 +6,4 @@ maintainer = "[email protected]"
 copyright = "2020-2023 Sourcery Institute"
 
 [dependencies]
-assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.4.0"}
+assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.5.0"}

src/sourcery/bin_m.f90

@@ -0,0 +1,47 @@
+module bin_m
+  !! distribute item numbers across bins such that the number of items differs by at most 1 between any two bins
+  implicit none
+
+  private
+  public :: bin_t
+
+  type bin_t
+    !! encapsulate a range of item numbers associated with a bin 
+    private
+    integer  first_, last_
+  contains
+    procedure first
+    procedure last
+  end type
+
+  interface bin_t
+
+    elemental module function construct(num_items, num_bins, bin_number) result(bin)
+      !! the result is a bin associated with a range of item numbers
+      integer, intent(in) :: num_items, num_bins, bin_number
+      type(bin_t) bin
+    end function
+
+  end interface
+
+  interface
+
+    elemental module function first(self, bin_number) result(first_item_number)
+      !! the result is the first item number associated with the given bin
+      implicit none
+      class(bin_t), intent(in) :: self
+      integer, intent(in) :: bin_number
+      integer first_item_number
+    end function
+
+    elemental module function last(self, bin_number) result(last_item_number)
+      !! the result is the last item number associated with the given bin
+      implicit none
+      class(bin_t), intent(in) :: self
+      integer, intent(in) :: bin_number
+      integer last_item_number
+    end function
+
+  end interface
+
+end module bin_m

src/sourcery/bin_s.f90

@@ -0,0 +1,33 @@
+submodule(bin_m) bin_s
+  use assert_m, only : assert, intrinsic_array_t
+  implicit none
+
+contains
+
+  module procedure construct
+
+      call assert( num_items>=num_bins, "bin_s(construct): num_items>=num_bins", intrinsic_array_t([num_items,num_bins]))
+
+      associate( remainder => mod(num_items, num_bins), items_per_bin => num_items/num_bins)
+
+        if (bin_number <= remainder) then
+          bin%first_ = 1 + (bin_number-1)*(items_per_bin+1)
+          bin%last_  = bin_number*(items_per_bin+1)
+        else
+          bin%first_ = 1 + (remainder-1)*(items_per_bin+1) + 1 + (bin_number-remainder)*items_per_bin
+          bin%last_ = remainder*(items_per_bin+1) + (bin_number-remainder)*items_per_bin
+        end if
+
+      end associate
+
+  end procedure
+
+  module procedure first
+    first_item_number  = self%first_
+  end procedure
+
+  module procedure last
+    last_item_number = self%last_
+  end procedure
+
+end submodule bin_s

src/sourcery_m.f90

@@ -2,6 +2,7 @@ module sourcery_m
   !! export all public entities from every other sourcery module
   use command_line_m, only : command_line_t
   use data_partition_m, only : data_partition_t
+  use bin_m, only : bin_t
   use formats_m, only : csv, cscv, separated_values
   use file_m, only : file_t
   use string_m, only : string_t

test/bin_test.f90

@@ -0,0 +1,76 @@
+module bin_test_m
+  !! verify data partitioning across bins
+  use sourcery_m, only : bin_t, test_t, test_result_t
+  use assert_m, only : assert
+  implicit none
+
+  private
+  public :: bin_test_t
+
+  type, extends(test_t) :: bin_test_t
+  contains
+    procedure, nopass :: subject
+    procedure, nopass :: results
+  end type
+
+contains
+
+  pure function subject() result(specimen)
+    character(len=:), allocatable :: specimen
+    specimen = "An array of bin_t objects (bins)" 
+  end function
+
+  function results() result(test_results)
+    type(test_result_t), allocatable :: test_results(:)
+    character(len=*), parameter :: longest_description = &
+          "partitioning all item across all bins without item loss"
+
+    associate( &
+      descriptions => &
+        [ character(len=len(longest_description)) :: &
+          "partitioning items nearly evenly across bins", &
+          "partitioning all item across all bins without item loss" &
+        ], &
+      outcomes => &
+         [ verify_block_partitioning(), &
+           verify_all_items_partitioned() &
+         ] &
+     )
+       call assert(size(descriptions) == size(outcomes), "bin_test_m(results): size(descriptions) == size(outcomes)")
+       test_results = test_result_t(descriptions, outcomes)
+     end associate
+
+  end function
+
+  function verify_block_partitioning() result(test_passes)
+    !! Verify that the items are partitioned across bins evenly to within a difference of one item per bin
+    logical test_passes
+
+    type(bin_t), allocatable :: bins(:)
+    integer, parameter :: n_items=11, n_bins=7
+    integer b
+
+    bins = [( bin_t(num_items=n_items, num_bins=n_bins, bin_number=b), b = 1,n_bins )]
+    associate(in_bin => [(bins(b)%last(b) - bins(b)%first(b) + 1, b = 1, n_bins)])
+      associate(remainder => mod(n_items, n_bins), items_per_bin => n_items/n_bins)
+        test_passes = all([(in_bin(1:remainder) == items_per_bin + 1)]) .and. all([(in_bin(remainder+1:) == items_per_bin)])
+      end associate
+    end associate
+
+  end function
+
+  function verify_all_items_partitioned() result(test_passes)
+    !! Verify that the number of items in each bin sums to the total number of items
+    type(bin_t) partition
+    logical test_passes
+
+    type(bin_t), allocatable :: bins(:)
+    integer, parameter :: n_items=11, n_bins=6
+    integer b
+
+    bins = [( bin_t(num_items=n_items, num_bins=n_bins, bin_number=b), b = 1,n_bins )]
+    test_passes = sum([(bins(b)%last(b) - bins(b)%first(b) + 1, b = 1, n_bins)]) == n_items
+
+  end function
+
+end module bin_test_m

test/main.f90

@@ -1,6 +1,7 @@
 program main
   use user_defined_collectives_test_m, only : collectives_test_t  
   use data_partition_test_m, only : data_partition_test_t
+  use bin_test_m, only : bin_test_t
   use object_m_test_m, only : object_test_t  
   use formats_test_m, only : formats_test_t  
   use test_result_test_m, only : test_result_test_t  
@@ -10,6 +11,7 @@ program main
 
   type(collectives_test_t) collectives_test
   type(data_partition_test_t) data_partition_test
+  type(bin_test_t) bin_test
   type(formats_test_t) formats_test
   type(object_test_t) object_test
   type(test_result_test_t) test_result_test
@@ -19,6 +21,7 @@ program main
   integer :: passes=0, tests=0
 
 
+  call bin_test%report(passes, tests)
   call data_partition_test%report(passes, tests)
   call collectives_test%report(passes, tests)
   call object_test%report(passes, tests)