diff --git a/fpm.toml b/fpm.toml index fe6923d9..5d76c81a 100644 --- a/fpm.toml +++ b/fpm.toml @@ -6,4 +6,4 @@ maintainer = "damian@archaeologic.codes" 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"} diff --git a/src/sourcery/bin_m.f90 b/src/sourcery/bin_m.f90 new file mode 100644 index 00000000..cd533d7f --- /dev/null +++ b/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 diff --git a/src/sourcery/bin_s.f90 b/src/sourcery/bin_s.f90 new file mode 100644 index 00000000..20bfcf29 --- /dev/null +++ b/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 diff --git a/src/sourcery_m.f90 b/src/sourcery_m.f90 index 6b13a499..e2d3d21b 100644 --- a/src/sourcery_m.f90 +++ b/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 diff --git a/test/bin_test.f90 b/test/bin_test.f90 new file mode 100644 index 00000000..38be4e30 --- /dev/null +++ b/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 diff --git a/test/main.f90 b/test/main.f90 index a5673f44..533387f1 100644 --- a/test/main.f90 +++ b/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)