From 07c0e1050611b0bd9bf472f6eaaaf0813663f99a Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 17:03:44 +0900 Subject: [PATCH 01/26] added BITSET_KINDS and BITSET_TYPES - BITSET_KINDS_TYPES is not needed to support sorting bitsets. --- src/common.fypp | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/common.fypp b/src/common.fypp index 364a8ae72..52ca02941 100644 --- a/src/common.fypp +++ b/src/common.fypp @@ -78,6 +78,11 @@ #! Collected (kind, type) tuples for string derived types #:set STRING_KINDS_TYPES = list(zip(STRING_KINDS, STRING_TYPES)) +#! Derived type bitsets +#:set BITSET_KINDS = ["bitset_64", "bitset_large"] + +#! Bitset types to be considered during templating +#:set BITSET_TYPES = ["type({})".format(k) for k in BITSET_KINDS] #! Whether Fortran 90 compatible code should be generated #:set VERSION90 = defined('VERSION90') From 04104b1befb2135c963c1d6e7f3ca088adf8543e Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 17:14:50 +0900 Subject: [PATCH 02/26] added `use` statement for stdlib_bitsets --- src/stdlib_sorting.fypp | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index 7420816e2..fdf4a1658 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -129,6 +129,9 @@ module stdlib_sorting use stdlib_string_type, only: string_type, assignment(=), operator(>), & operator(>=), operator(<), operator(<=) + use stdlib_bitsets, only: bitset_64, bitset_large, & + assignment(=), operator(>), operator(>=),operator(<),operator(<=) + implicit none private From b4825347e4b325ab2bac2adca0640e5d2c331826 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 17:18:12 +0900 Subject: [PATCH 03/26] added BITSET_TYPES_ALT_NAME --- src/stdlib_sorting.fypp | 1 + src/stdlib_sorting_ord_sort.fypp | 1 + src/stdlib_sorting_sort.fypp | 1 + src/stdlib_sorting_sort_index.fypp | 1 + 4 files changed, 4 insertions(+) diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index fdf4a1658..55f6952e0 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -4,6 +4,7 @@ #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS)) #:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_KINDS)) #:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=len(array))"], ["char"])) +#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_KINDS)) #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines diff --git a/src/stdlib_sorting_ord_sort.fypp b/src/stdlib_sorting_ord_sort.fypp index a5d950447..377bda1d6 100644 --- a/src/stdlib_sorting_ord_sort.fypp +++ b/src/stdlib_sorting_ord_sort.fypp @@ -3,6 +3,7 @@ #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS)) #:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_TYPES, STRING_KINDS)) #:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=:)"], ["character(len=len(array))"], ["char"])) +#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_TYPES, BITSET_KINDS)) #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines diff --git a/src/stdlib_sorting_sort.fypp b/src/stdlib_sorting_sort.fypp index ecc2c3154..03c960c46 100644 --- a/src/stdlib_sorting_sort.fypp +++ b/src/stdlib_sorting_sort.fypp @@ -3,6 +3,7 @@ #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS)) #:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_KINDS)) #:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=len(array))"], ["char"])) +#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_KINDS)) #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines diff --git a/src/stdlib_sorting_sort_index.fypp b/src/stdlib_sorting_sort_index.fypp index b2a100d92..e40a03576 100644 --- a/src/stdlib_sorting_sort_index.fypp +++ b/src/stdlib_sorting_sort_index.fypp @@ -3,6 +3,7 @@ #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS)) #:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_TYPES, STRING_KINDS)) #:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=:)"], ["character(len=len(array))"], ["char"])) +#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_TYPES, BITSET_KINDS)) #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines From 799ce0dd68332c67fdbcb1b89ffcac4e30f40f93 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 17:28:45 +0900 Subject: [PATCH 04/26] appended ALT_NAME of bitsets to IRSC ALT_NAME --- src/stdlib_sorting.fypp | 9 +++++---- src/stdlib_sorting_ord_sort.fypp | 7 ++++--- src/stdlib_sorting_sort.fypp | 7 ++++--- src/stdlib_sorting_sort_index.fypp | 5 +++-- 4 files changed, 16 insertions(+), 12 deletions(-) diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index 55f6952e0..fffe97dc0 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -9,7 +9,8 @@ #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines #! This approach allows us to have the same code for all input types. -#:set IRSC_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME +#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME & + & + BITSET_TYPES_ALT_NAME !! Licensing: !! @@ -414,7 +415,7 @@ module stdlib_sorting !! sorted data, having O(N) performance on uniformly non-increasing or !! non-decreasing data. -#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME module subroutine ${name1}$_ord_sort( array, work, reverse ) !! Version: experimental !! @@ -480,7 +481,7 @@ module stdlib_sorting !! on the `introsort` of David Musser. !! ([Specification](../page/specs/stdlib_sorting.html#sort-sorts-an-input-array)) -#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME pure module subroutine ${name1}$_sort( array, reverse ) !! Version: experimental !! @@ -511,7 +512,7 @@ module stdlib_sorting !! non-decreasing sort, but if the optional argument `REVERSE` is present !! with a value of `.TRUE.` the indices correspond to a non-increasing sort. -#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME module subroutine ${name1}$_sort_index( array, index, work, iwork, & reverse ) !! Version: experimental diff --git a/src/stdlib_sorting_ord_sort.fypp b/src/stdlib_sorting_ord_sort.fypp index 377bda1d6..4c5ea24c7 100644 --- a/src/stdlib_sorting_ord_sort.fypp +++ b/src/stdlib_sorting_ord_sort.fypp @@ -8,7 +8,8 @@ #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines #! This approach allows us to have the same code for all input types. -#:set IRSC_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME +#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME & + & + BITSET_TYPES_ALT_NAME #:set SIGN_NAME = ["increase", "decrease"] #:set SIGN_TYPE = [">", "<"] @@ -70,7 +71,7 @@ submodule(stdlib_sorting) stdlib_sorting_ord_sort contains -#:for t1, t2, t3, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME module subroutine ${name1}$_ord_sort( array, work, reverse ) ${t1}$, intent(inout) :: array(0:) ${t3}$, intent(out), optional :: work(0:) @@ -86,7 +87,7 @@ contains #:endfor #:for sname, signt, signoppt in SIGN_NAME_TYPE -#:for t1, t2, t3, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME subroutine ${name1}$_${sname}$_ord_sort( array, work ) ! A translation to Fortran 2008, of the `"Rust" sort` algorithm found in diff --git a/src/stdlib_sorting_sort.fypp b/src/stdlib_sorting_sort.fypp index 03c960c46..4a9171f77 100644 --- a/src/stdlib_sorting_sort.fypp +++ b/src/stdlib_sorting_sort.fypp @@ -8,7 +8,8 @@ #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines #! This approach allows us to have the same code for all input types. -#:set IRSC_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME +#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME & + & + BITSET_TYPES_ALT_NAME #:set SIGN_NAME = ["increase", "decrease"] #:set SIGN_TYPE = [">", "<"] @@ -74,7 +75,7 @@ submodule(stdlib_sorting) stdlib_sorting_sort contains -#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME pure module subroutine ${name1}$_sort( array, reverse ) ${t1}$, intent(inout) :: array(0:) logical, intent(in), optional :: reverse @@ -88,7 +89,7 @@ contains #:endfor #:for sname, signt, signoppt in SIGN_NAME_TYPE -#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME pure subroutine ${name1}$_${sname}$_sort( array ) ! `${name1}$_${sname}$_sort( array )` sorts the input `ARRAY` of type `${t1}$` diff --git a/src/stdlib_sorting_sort_index.fypp b/src/stdlib_sorting_sort_index.fypp index e40a03576..6f0101219 100644 --- a/src/stdlib_sorting_sort_index.fypp +++ b/src/stdlib_sorting_sort_index.fypp @@ -8,7 +8,8 @@ #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines #! This approach allows us to have the same code for all input types. -#:set IRSC_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME +#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME & + & + BITSET_TYPES_ALT_NAME !! Licensing: !! @@ -65,7 +66,7 @@ submodule(stdlib_sorting) stdlib_sorting_sort_index contains -#:for t1, t2, t3, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME module subroutine ${name1}$_sort_index( array, index, work, iwork, reverse ) ! A modification of `${name1}$_ord_sort` to return an array of indices that From bd92e375e36f1e0b1571d841d574ba01a72307b2 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 17:32:11 +0900 Subject: [PATCH 05/26] added whitespace after comma --- src/stdlib_sorting.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index fffe97dc0..b380a725d 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -132,7 +132,7 @@ module stdlib_sorting operator(>=), operator(<), operator(<=) use stdlib_bitsets, only: bitset_64, bitset_large, & - assignment(=), operator(>), operator(>=),operator(<),operator(<=) + assignment(=), operator(>), operator(>=), operator(<), operator(<=) implicit none private From 4d3057ad9cdde9530637041168e062b2cf547d16 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 18:15:17 +0900 Subject: [PATCH 06/26] added tests for bitset_large and bitset_64 - tests for `ord_sort` procedure - tests for `sort` procedure - tests for `sort_index` procedure - verification procedures for ascending and reverse sorting --- test/sorting/test_sorting.f90 | 555 +++++++++++++++++++++++++++++++++- 1 file changed, 554 insertions(+), 1 deletion(-) diff --git a/test/sorting/test_sorting.f90 b/test/sorting/test_sorting.f90 index c3de24c2f..e3598e30c 100644 --- a/test/sorting/test_sorting.f90 +++ b/test/sorting/test_sorting.f90 @@ -5,6 +5,8 @@ module test_sorting use stdlib_sorting use stdlib_string_type, only: string_type, assignment(=), operator(>), & operator(<), write(formatted) + use stdlib_bitsets, only: bitset_64, bitset_large, & + assignment(=), operator(>), operator(<) use testdrive, only: new_unittest, unittest_type, error_type, check implicit none @@ -14,6 +16,7 @@ module test_sorting integer(int32), parameter :: test_size = 2_int32**test_power integer(int32), parameter :: char_size = char_set_size**4 integer(int32), parameter :: string_size = char_set_size**3 + integer(int32), parameter :: bitset_size = char_set_size**4 integer(int32), parameter :: block_size = test_size/6 integer, parameter :: repeat = 1 @@ -36,15 +39,27 @@ module test_sorting string_decrease(0:string_size-1), & string_increase(0:string_size-1), & string_rand(0:string_size-1) + type(bitset_large) :: & + bitsetl_decrease(0:bitset_size-1), & + bitsetl_increase(0:bitset_size-1), & + bitsetl_rand(0:bitset_size-1) + type(bitset_64) :: & + bitset64_decrease(0:bitset_size-1), & + bitset64_increase(0:bitset_size-1), & + bitset64_rand(0:bitset_size-1) integer(int32) :: dummy(0:test_size-1) real(sp) :: real_dummy(0:test_size-1) character(len=4) :: char_dummy(0:char_size-1) type(string_type) :: string_dummy(0:string_size-1) + type(bitset_large) :: bitsetl_dummy(0:bitset_size-1) + type(bitset_64) :: bitset64_dummy(0:bitset_size-1) integer(int_size) :: index(0:max(test_size, char_size, string_size)-1) integer(int32) :: work(0:test_size/2-1) character(len=4) :: char_work(0:char_size/2-1) type(string_type) :: string_work(0:string_size/2-1) + type(bitset_large) :: bitsetl_work(0:bitset_size/2-1) + type(bitset_64) :: bitset64_work(0:bitset_size/2-1) integer(int_size) :: iwork(0:max(test_size, char_size, & string_size)/2-1) integer :: count, i, index1, index2, j, k, l, temp @@ -53,6 +68,8 @@ module test_sorting integer :: lun character(len=4) :: char_temp type(string_type) :: string_temp + type(bitset_large) :: bitsetl_temp + type(bitset_64) :: bitset64_temp logical :: ltest, ldummy contains @@ -66,14 +83,20 @@ subroutine collect_sorting(testsuite) new_unittest('int_ord_sorts', test_int_ord_sorts), & new_unittest('char_ord_sorts', test_char_ord_sorts), & new_unittest('string_ord_sorts', test_string_ord_sorts), & + new_unittest('bitset_large_ord_sorts', test_bitsetl_ord_sorts), & + new_unittest('bitset_64_ord_sorts', test_bitset64_ord_sorts), & new_unittest('int_radix_sorts', test_int_radix_sorts), & new_unittest('real_radix_sorts', test_real_radix_sorts), & new_unittest('int_sorts', test_int_sorts), & new_unittest('char_sorts', test_char_sorts), & new_unittest('string_sorts', test_string_sorts), & + new_unittest('bitset_large_sorts', test_bitsetl_sorts), & + new_unittest('bitset_64_sorts', test_bitset64_sorts), & new_unittest('int_sort_indexes', test_int_sort_indexes), & new_unittest('char_sort_indexes', test_char_sort_indexes), & - new_unittest('string_sort_indexes', test_string_sort_indexes) & + new_unittest('string_sort_indexes', test_string_sort_indexes), & + new_unittest('bitset_large_sort_indexes', test_bitsetl_sort_indexes), & + new_unittest('bitset_64_sort_indexes', test_bitset64_sort_indexes) & ] end subroutine collect_sorting @@ -173,6 +196,46 @@ subroutine initialize_tests() string_rand(index1) = string_temp end do + block + character(32):: bin + do i = 0, bitset_size-1 + write(bin,'(b32.32)') i + call bitsetl_increase(i)%from_string(bin) + end do + end block + do i=0, bitset_size-1 + bitsetl_decrease(bitset_size-1-i) = bitsetl_increase(i) + end do + + bitsetl_rand(:) = bitsetl_increase(:) + do i=0, bitset_size-1 + call random_number( arand ) + index1 = int( floor( arand * bitset_size ), kind=int32 ) + bitsetl_temp = bitsetl_rand(i) + bitsetl_rand(i) = bitsetl_rand(index1) + bitsetl_rand(index1) = bitsetl_temp + end do + + block + character(64):: bin + do i = 0, bitset_size-1 + write(bin,'(b64.64)') i + call bitset64_increase(i)%from_string(bin) + end do + end block + do i=0, bitset_size-1 + bitset64_decrease(bitset_size-1-i) = bitset64_increase(i) + end do + + bitset64_rand(:) = bitset64_increase(:) + do i=0, bitset_size-1 + call random_number( arand ) + index1 = int( floor( arand * bitset_size ), kind=int32 ) + bitset64_temp = bitset64_rand(i) + bitset64_rand(i) = bitset64_rand(index1) + bitset64_rand(index1) = bitset64_temp + end do + ! Create and intialize file to report the results of the sortings open( newunit=lun, file=filename, access='sequential', action='write', & form='formatted', status='replace' ) @@ -453,6 +516,180 @@ subroutine test_string_ord_sort( a, a_name, ltest ) end subroutine test_string_ord_sort + subroutine test_bitsetl_ord_sorts(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + logical:: ltest + + call test_bitsetl_ord_sort( bitsetl_decrease, "Bitset Decrease", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitsetl_ord_sort( bitsetl_increase, "Bitset Increase", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitsetl_ord_sort( bitsetl_rand, "Bitset Random" , ltest) + call check(error, ltest) + + end subroutine test_bitsetl_ord_sorts + + subroutine test_bitsetl_ord_sort( a, a_name, ltest ) + type(bitset_large), intent(in) :: a(0:) + character(*), intent(in) :: a_name + logical, intent(out) :: ltest + + integer(int64) :: t0, t1, tdiff + real(dp) :: rate + integer(int64) :: i + logical :: valid + character(:), allocatable :: bin_im1, bin_i + + ltest = .true. + + tdiff = 0 + do i = 1, repeat + bitsetl_dummy = a + call system_clock( t0, rate ) + call ord_sort( bitsetl_dummy, bitsetl_work ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 + end do + tdiff = tdiff/repeat + + call verify_bitsetl_sort( bitsetl_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "ORD_SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitsetl_dummy(i-1)%to_string(bin_im1) + call bitsetl_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + write( lun, '("| Bitset_large |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + 'a12, " |", F10.6, " |" )' ) & + bitset_size, a_name, "Ord_Sort", tdiff/rate + + !reverse + bitsetl_dummy = a + call ord_sort( bitsetl_dummy, bitsetl_work, reverse = .true. ) + + call verify_bitsetl_reverse_sort( bitsetl_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // & + "." + write(*,*) 'i = ', i + call bitsetl_dummy(i-1)%to_string(bin_im1) + call bitsetl_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + + bitsetl_dummy = a + call ord_sort( bitsetl_dummy, reverse = .true. ) + + call verify_bitsetl_reverse_sort( bitsetl_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "reverse ORD_SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitsetl_dummy(i-1)%to_string(bin_im1) + call bitsetl_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + + end subroutine test_bitsetl_ord_sort + + subroutine test_bitset64_ord_sorts(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + logical:: ltest + + call test_bitset64_ord_sort( bitset64_decrease, "Bitset Decrease", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitset64_ord_sort( bitset64_increase, "Bitset Increase", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitset64_ord_sort( bitset64_rand, "Bitset Random" , ltest) + call check(error, ltest) + + end subroutine test_bitset64_ord_sorts + + subroutine test_bitset64_ord_sort( a, a_name, ltest ) + type(bitset_64), intent(in) :: a(0:) + character(*), intent(in) :: a_name + logical, intent(out) :: ltest + + integer(int64) :: t0, t1, tdiff + real(dp) :: rate + integer(int64) :: i + logical :: valid + character(:), allocatable :: bin_im1, bin_i + + ltest = .true. + + tdiff = 0 + do i = 1, repeat + bitset64_dummy = a + call system_clock( t0, rate ) + call ord_sort( bitset64_dummy, bitset64_work ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 + end do + tdiff = tdiff/repeat + + call verify_bitset64_sort( bitset64_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "ORD_SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitset64_dummy(i-1)%to_string(bin_im1) + call bitset64_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitset64_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + write( lun, '("| Bitset_64 |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + 'a12, " |", F10.6, " |" )' ) & + bitset_size, a_name, "Ord_Sort", tdiff/rate + + !reverse + bitset64_dummy = a + call ord_sort( bitset64_dummy, bitset64_work, reverse = .true. ) + + call verify_bitset64_reverse_sort( bitset64_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // & + "." + write(*,*) 'i = ', i + call bitset64_dummy(i-1)%to_string(bin_im1) + call bitset64_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitset64_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + + bitset64_dummy = a + call ord_sort( bitset64_dummy, reverse = .true. ) + + call verify_bitset64_reverse_sort( bitset64_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "reverse ORD_SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitset64_dummy(i-1)%to_string(bin_im1) + call bitset64_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitset64_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + + end subroutine test_bitset64_ord_sort + subroutine test_int_radix_sorts(error) !> Error handling type(error_type), allocatable, intent(out) :: error @@ -834,6 +1071,146 @@ subroutine test_string_sort( a, a_name, ltest ) end subroutine test_string_sort + subroutine test_bitsetl_sorts(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + logical :: ltest + + call test_bitsetl_sort( bitsetl_decrease, "Bitset Decrease", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitsetl_sort( bitsetl_increase, "Bitset Increase", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitsetl_sort( bitsetl_rand, "Bitset Random", ltest ) + call check(error, ltest) + + end subroutine test_bitsetl_sorts + + subroutine test_bitsetl_sort( a, a_name, ltest ) + type(bitset_large), intent(in) :: a(0:) + character(*), intent(in) :: a_name + logical, intent(out) :: ltest + + integer(int64) :: t0, t1, tdiff + real(dp) :: rate + integer(int64) :: i + logical :: valid + character(:), allocatable :: bin_im1, bin_i + + ltest = .true. + + tdiff = 0 + do i = 1, repeat + bitsetl_dummy = a + call system_clock( t0, rate ) + call sort( bitsetl_dummy ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 + end do + tdiff = tdiff/repeat + + call verify_bitsetl_sort( bitsetl_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitsetl_dummy(i-1)%to_string(bin_im1) + call bitsetl_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + write( lun, '("| Bitset_large |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + 'a12, " |", F10.6, " |" )' ) & + bitset_size, a_name, "Sort", tdiff/rate + + ! reverse + bitsetl_dummy = a + call sort( bitsetl_dummy, .true.) + call verify_bitsetl_reverse_sort(bitsetl_dummy, valid, i) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "reverse SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitsetl_dummy(i-1)%to_string(bin_im1) + call bitsetl_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + end subroutine test_bitsetl_sort + + subroutine test_bitset64_sorts(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + logical :: ltest + + call test_bitset64_sort( bitset64_decrease, "Bitset Decrease", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitset64_sort( bitset64_increase, "Bitset Increase", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitset64_sort( bitset64_rand, "Bitset Random", ltest ) + call check(error, ltest) + + end subroutine test_bitset64_sorts + + subroutine test_bitset64_sort( a, a_name, ltest ) + type(bitset_64), intent(in) :: a(0:) + character(*), intent(in) :: a_name + logical, intent(out) :: ltest + + integer(int64) :: t0, t1, tdiff + real(dp) :: rate + integer(int64) :: i + logical :: valid + character(:), allocatable :: bin_im1, bin_i + + ltest = .true. + + tdiff = 0 + do i = 1, repeat + bitset64_dummy = a + call system_clock( t0, rate ) + call sort( bitset64_dummy ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 + end do + tdiff = tdiff/repeat + + call verify_bitset64_sort( bitset64_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitset64_dummy(i-1)%to_string(bin_im1) + call bitset64_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitset64_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + write( lun, '("| Bitset_64 |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + 'a12, " |", F10.6, " |" )' ) & + bitset_size, a_name, "Sort", tdiff/rate + + ! reverse + bitset64_dummy = a + call sort( bitset64_dummy, .true.) + call verify_bitset64_reverse_sort(bitset64_dummy, valid, i) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "reverse SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitset64_dummy(i-1)%to_string(bin_im1) + call bitset64_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + end subroutine test_bitset64_sort + subroutine test_int_sort_indexes(error) !> Error handling type(error_type), allocatable, intent(out) :: error @@ -1045,6 +1422,119 @@ subroutine test_string_sort_index( a, a_name, ltest ) end subroutine test_string_sort_index + subroutine test_bitsetl_sort_indexes(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + logical :: ltest + + call test_bitsetl_sort_index( bitsetl_decrease, "Bitset Decrease", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitsetl_sort_index( bitsetl_increase, "Bitset Increase", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitsetl_sort_index( bitsetl_rand, "Bitset Random", ltest ) + call check(error, ltest) + + end subroutine test_bitsetl_sort_indexes + + subroutine test_bitsetl_sort_index( a, a_name, ltest ) + type(bitset_large), intent(in) :: a(0:) + character(*), intent(in) :: a_name + logical, intent(out) :: ltest + + integer(int64) :: t0, t1, tdiff + real(dp) :: rate + integer(int64) :: i + logical :: valid + character(:), allocatable :: bin_im1, bin_i + + ltest = .true. + + tdiff = 0 + do i = 1, repeat + bitsetl_dummy = a + call system_clock( t0, rate ) + call sort_index( bitsetl_dummy, index, bitsetl_work, iwork ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 + end do + tdiff = tdiff/repeat + + call verify_bitsetl_sort( bitsetl_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "SORT_INDEX did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitsetl_dummy(i-1)%to_string(bin_im1) + call bitsetl_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + write( lun, '("| Bitset_large |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + 'a12, " |", F10.6, " |" )' ) & + bitset_size, a_name, "Sort_Index", tdiff/rate + + end subroutine test_bitsetl_sort_index + + subroutine test_bitset64_sort_indexes(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + logical :: ltest + + call test_bitset64_sort_index( bitset64_decrease, "Bitset Decrease", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitset64_sort_index( bitset64_increase, "Bitset Increase", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitset64_sort_index( bitset64_rand, "Bitset Random", ltest ) + call check(error, ltest) + + end subroutine test_bitset64_sort_indexes + + subroutine test_bitset64_sort_index( a, a_name, ltest ) + type(bitset_64), intent(in) :: a(0:) + character(*), intent(in) :: a_name + logical, intent(out) :: ltest + + integer(int64) :: t0, t1, tdiff + real(dp) :: rate + integer(int64) :: i + logical :: valid + character(:), allocatable :: bin_im1, bin_i + + ltest = .true. + + tdiff = 0 + do i = 1, repeat + bitset64_dummy = a + call system_clock( t0, rate ) + call sort_index( bitset64_dummy, index, bitset64_work, iwork ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 + end do + tdiff = tdiff/repeat + + call verify_bitset64_sort( bitset64_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "SORT_INDEX did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitset64_dummy(i-1)%to_string(bin_im1) + call bitset64_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitset64_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + write( lun, '("| Bitset_64 |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + 'a12, " |", F10.6, " |" )' ) & + bitset_size, a_name, "Sort_Index", tdiff/rate + + end subroutine test_bitset64_sort_index subroutine verify_sort( a, valid, i ) integer(int32), intent(in) :: a(0:) @@ -1094,6 +1584,38 @@ subroutine verify_string_sort( a, valid, i ) end subroutine verify_string_sort + subroutine verify_bitsetl_sort( a, valid, i ) + type(bitset_large), intent(in) :: a(0:) + logical, intent(out) :: valid + integer(int64), intent(out) :: i + + integer(int64) :: n + + n = size( a, kind=int64 ) + valid = .false. + do i=1, n-1 + if ( a(i-1) > a(i) ) return + end do + valid = .true. + + end subroutine verify_bitsetl_sort + + subroutine verify_bitset64_sort( a, valid, i ) + type(bitset_64), intent(in) :: a(0:) + logical, intent(out) :: valid + integer(int64), intent(out) :: i + + integer(int64) :: n + + n = size( a, kind=int64 ) + valid = .false. + do i=1, n-1 + if ( a(i-1) > a(i) ) return + end do + valid = .true. + + end subroutine verify_bitset64_sort + subroutine verify_char_sort( a, valid, i ) character(len=4), intent(in) :: a(0:) logical, intent(out) :: valid @@ -1174,6 +1696,37 @@ subroutine verify_string_reverse_sort( a, valid, i ) end subroutine verify_string_reverse_sort + subroutine verify_bitsetl_reverse_sort( a, valid, i ) + type(bitset_large), intent(in) :: a(0:) + logical, intent(out) :: valid + integer(int64), intent(out) :: i + + integer(int64) :: n + + n = size( a, kind=int64 ) + valid = .false. + do i=1, n-1 + if ( a(i-1) < a(i) ) return + end do + valid = .true. + + end subroutine verify_bitsetl_reverse_sort + + subroutine verify_bitset64_reverse_sort( a, valid, i ) + type(bitset_64), intent(in) :: a(0:) + logical, intent(out) :: valid + integer(int64), intent(out) :: i + + integer(int64) :: n + + n = size( a, kind=int64 ) + valid = .false. + do i=1, n-1 + if ( a(i-1) < a(i) ) return + end do + valid = .true. + + end subroutine verify_bitset64_reverse_sort end module test_sorting From a99f19d51f932a504679a13b76cd45cdae45aefc Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 18:31:41 +0900 Subject: [PATCH 07/26] aligned the frame of the table of results --- test/sorting/test_sorting.f90 | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/test/sorting/test_sorting.f90 b/test/sorting/test_sorting.f90 index e3598e30c..6224a6486 100644 --- a/test/sorting/test_sorting.f90 +++ b/test/sorting/test_sorting.f90 @@ -241,9 +241,9 @@ subroutine initialize_tests() form='formatted', status='replace' ) write( lun, '(a)' ) trim(compiler_version()) write( lun, * ) - write( lun, '("| Type | Elements | Array Name | Method ' // & + write( lun, '("| Type | Elements | Array Name | Method ' // & ' | Time (s) |")' ) - write( lun, '("|-------------|----------|-----------------|-----------' // & + write( lun, '("|--------------|----------|-----------------|-----------' // & '--|-----------|")' ) end subroutine initialize_tests @@ -330,7 +330,7 @@ subroutine test_int_ord_sort( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i) end if - write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Ord_Sort", tdiff/rate @@ -405,7 +405,7 @@ subroutine test_char_ord_sort( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a, 2(1x,a4))') 'char_dummy(i-1:i) = ', char_dummy(i-1:i) end if - write( lun, '("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & char_size, a_name, "Ord_Sort", tdiff/rate @@ -484,7 +484,7 @@ subroutine test_string_ord_sort( a, a_name, ltest ) write(*,'(a, 2(1x,a))') 'string_dummy(i-1:i) = ', & string_dummy(i-1:i) end if - write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & string_size, a_name, "Ord_Sort", tdiff/rate @@ -770,7 +770,7 @@ subroutine test_int_radix_sort( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i) end if - write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Radix_Sort", tdiff/rate @@ -816,7 +816,7 @@ subroutine test_real_radix_sort( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a12, 2f12.5)') 'real_dummy(i-1:i) = ', real_dummy(i-1:i) end if - write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Real |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Radix_Sort", tdiff/rate @@ -923,7 +923,7 @@ subroutine test_int_sort( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i) end if - write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Sort", tdiff/rate @@ -987,7 +987,7 @@ subroutine test_char_sort( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a17, 2(1x,a4))') 'char_dummy(i-1:i) = ', char_dummy(i-1:i) end if - write( lun, '("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & char_size, a_name, "Sort", tdiff/rate @@ -1052,7 +1052,7 @@ subroutine test_string_sort( a, a_name, ltest ) write(*,'(a17, 2(1x,a4))') 'string_dummy(i-1:i) = ', & string_dummy(i-1:i) end if - write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & string_size, a_name, "Sort", tdiff/rate @@ -1293,7 +1293,7 @@ subroutine test_int_sort_index( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a18, 2i7)') 'a(index(i-1:i)) = ', a(index(i-1:i)) end if - write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Sort_Index", tdiff/rate @@ -1362,7 +1362,7 @@ subroutine test_char_sort_index( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a17, 2(1x,a4))') 'char_dummy(i-1:i) = ', char_dummy(i-1:i) end if - write( lun, '("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & char_size, a_name, "Sort_Index", tdiff/rate @@ -1416,7 +1416,7 @@ subroutine test_string_sort_index( a, a_name, ltest ) write(*,'(a17, 2(1x,a4))') 'string_dummy(i-1:i) = ', & string_dummy(i-1:i) end if - write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & string_size, a_name, "Sort_Index", tdiff/rate From 6154e2b606fa64506c4ee563981256708fec6c6a Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 18:34:50 +0900 Subject: [PATCH 08/26] fixed incorrect right-hand side value --- test/sorting/test_sorting.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/sorting/test_sorting.f90 b/test/sorting/test_sorting.f90 index 6224a6486..845e59480 100644 --- a/test/sorting/test_sorting.f90 +++ b/test/sorting/test_sorting.f90 @@ -184,7 +184,7 @@ subroutine initialize_tests() end do do i=0, string_size-1 - string_decrease(string_size - 1 - i) = char_increase(i) + string_decrease(string_size - 1 - i) = string_increase(i) end do string_rand(:) = string_increase(:) From 423a8b4993992f7ea23f5334cc77b8b4dbc610c5 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 19:26:24 +0900 Subject: [PATCH 09/26] added an example for sorting array of bitset_large --- example/sorting/CMakeLists.txt | 3 +- example/sorting/example_sort_bitsetl.f90 | 46 ++++++++++++++++++++++++ 2 files changed, 48 insertions(+), 1 deletion(-) create mode 100644 example/sorting/example_sort_bitsetl.f90 diff --git a/example/sorting/CMakeLists.txt b/example/sorting/CMakeLists.txt index 4800cc376..e59c8cf65 100644 --- a/example/sorting/CMakeLists.txt +++ b/example/sorting/CMakeLists.txt @@ -1,3 +1,4 @@ ADD_EXAMPLE(ord_sort) ADD_EXAMPLE(sort) -ADD_EXAMPLE(radix_sort) \ No newline at end of file +ADD_EXAMPLE(radix_sort) +ADD_EXAMPLE(sort_bitsetl) \ No newline at end of file diff --git a/example/sorting/example_sort_bitsetl.f90 b/example/sorting/example_sort_bitsetl.f90 new file mode 100644 index 000000000..04b92e08b --- /dev/null +++ b/example/sorting/example_sort_bitsetl.f90 @@ -0,0 +1,46 @@ +program example_sort_bitsetl + use stdlib_sorting, only: sort + use stdlib_bitsets + implicit none + type(bitset_large), allocatable :: array(:) + + array = [bitset_l("0101"), & ! 5 + bitset_l("0100"), & ! 4 + bitset_l("0011"), & ! 3 + bitset_l("0001"), & ! 1 + bitset_l("1010"), & ! 10 + bitset_l("0100"), & ! 4 + bitset_l("1001")] ! 9 + + call sort(array) + + block + integer(int32) :: i + do i = 1, size(array) + print *, to_string(array(i)) + ! 0001 + ! 0011 + ! 0100 + ! 0100 + ! 0101 + ! 1001 + ! 1010 + end do + end block + + deallocate(array) +contains + function bitset_l(str) result(new_bitsetl) + character(*), intent(in) :: str + type(bitset_large) :: new_bitsetl + + call new_bitsetl%from_string(str) + end function bitset_l + + function to_string(bitset) result(str) + type(bitset_large), intent(in) :: bitset + character(:), allocatable :: str + + call bitset%to_string(str) + end function to_string +end program example_sort_bitsetl From 0ee5fb19b31f04b4b891ea981545cbc49a588adb Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 20:47:57 +0900 Subject: [PATCH 10/26] updated api-docs --- doc/specs/stdlib_sorting.md | 15 +++++++++------ src/stdlib_sorting.fypp | 9 ++++++--- 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index f37cefaec..d4c9d3e18 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -235,8 +235,9 @@ Generic subroutine. `array` : shall be a rank one array of any of the types: `integer(int8)`, `integer(int16)`, `integer(int32)`, `integer(int64)`, -`real(sp)`, `real(dp)`, `real(qp)`, `character(*)`, or -`type(string_type)`. It is an `intent(inout)` argument. On input it is +`real(sp)`, `real(dp)`, `real(qp)`, `character(*)`, `type(string_type)`, +`type(bitset_64)`, or `type(bitset_large)`. +It is an `intent(inout)` argument. On input it is the array to be sorted. If both the type of `array` is real and at least one of the elements is a `NaN`, then the ordering of the result is undefined. Otherwise on return its elements will be sorted in order @@ -301,8 +302,9 @@ Pure generic subroutine. `array` : shall be a rank one array of any of the types: `integer(int8)`, `integer(int16)`, `integer(int32)`, `integer(int64)`, -`real(sp)`, `real(dp)`, `real(qp)`. `character(*)`, or -`type(string_type)`. It is an `intent(inout)` argument. On return its +`real(sp)`, `real(dp)`, `real(qp)`. `character(*)`, `type(string_type)`, +`type(bitset_64)`, or `type(bitset_large)`. +It is an `intent(inout)` argument. On return its input elements will be sorted in order of non-decreasing value. @@ -405,8 +407,9 @@ Generic subroutine. `array`: shall be a rank one array of any of the types: `integer(int8)`, `integer(int16)`, `integer(int32)`, `integer(int64)`, -`real(sp)`, `real(dp)`, `real(qp)`, `character(*)`, or -`type(string_type)`. It is an `intent(inout)` argument. On input it +`real(sp)`, `real(dp)`, `real(qp)`, `character(*)`, `type(string_type)`, +`type(bitset_64)`, or `type(bitset_large)`. +It is an `intent(inout)` argument. On input it will be an array whose sorting indices are to be determined. On return it will be the sorted array. diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index b380a725d..b506614e0 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -170,7 +170,8 @@ module stdlib_sorting !! * array: the rank 1 array to be sorted. It is an `intent(inout)` !! argument of any of the types `integer(int8)`, `integer(int16)`, !! `integer(int32)`, `integer(int64)`, `real(real32)`, `real(real64)`, -!! `real(real128)`, `character(*)`, `type(string_type)`. If both the +!! `real(real128)`, `character(*)`, `type(string_type)`, +!! `type(bitset_64)`, `type(bitset_large)`. If both the !! type of `array` is real and at least one of the elements is a !! `NaN`, then the ordering of the result is undefined. Otherwise it !! is defined to be the original elements in non-decreasing order. @@ -220,7 +221,8 @@ module stdlib_sorting !! * array: the rank 1 array to be sorted. It is an `intent(inout)` !! argument of any of the types `integer(int8)`, `integer(int16)`, !! `integer(int32)`, `integer(int64)`, `real(real32)`, `real(real64)`, -!! `real(real128)`, `character(*)`, `type(string_type)`. If both the type +!! `real(real128)`, `character(*)`, `type(string_type)`, +!! `type(bitset_64)`, `type(bitset_large)`. If both the type !! of `array` is real and at least one of the elements is a `NaN`, then !! the ordering of the result is undefined. Otherwise it is defined to be the !! original elements in non-decreasing order. @@ -304,7 +306,8 @@ module stdlib_sorting !! * array: the rank 1 array to be sorted. It is an `intent(inout)` !! argument of any of the types `integer(int8)`, `integer(int16)`, !! `integer(int32)`, `integer(int64)`, `real(real32)`, `real(real64)`, -!! `real(real128)`, `character(*)`, `type(string_type)`. If both the +!! `real(real128)`, `character(*)`, `type(string_type)`, +!! `type(bitset_64)`, `type(bitset_large)`. If both the !! type of `array` is real and at least one of the elements is a `NaN`, !! then the ordering of the `array` and `index` results is undefined. !! Otherwise it is defined to be as specified by reverse. From a9254e17c32e74c4622f89c9095ca0f8c1ada015 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 21:17:58 +0900 Subject: [PATCH 11/26] fixed enclosure symbol mismatches --- src/stdlib_sorting.fypp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index b506614e0..6975bcda1 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -423,7 +423,7 @@ module stdlib_sorting !! Version: experimental !! !! `${name1}$_ord_sort( array )` sorts the input `ARRAY` of type `${t1}$` -!! using a hybrid sort based on the `'Rust" sort` algorithm found in `slice.rs` +!! using a hybrid sort based on the `"Rust" sort` algorithm found in `slice.rs` ${t1}$, intent(inout) :: array(0:) ${t2}$, intent(out), optional :: work(0:) logical, intent(in), optional :: reverse @@ -522,8 +522,8 @@ module stdlib_sorting !! !! `${name1}$_sort_index( array, index[, work, iwork, reverse] )` sorts !! an input `ARRAY` of type `${t1}$` -!! using a hybrid sort based on the `'Rust" sort` algorithm found in `slice.rs` -!! and returns the sorted `ARRAY` and an array `INDEX of indices in the +!! using a hybrid sort based on the `"Rust" sort` algorithm found in `slice.rs` +!! and returns the sorted `ARRAY` and an array `INDEX` of indices in the !! order that would sort the input `ARRAY` in the desired direction. ${t1}$, intent(inout) :: array(0:) integer(int_size), intent(out) :: index(0:) From e1b520ceff425af4f4089c8c2f46098380e60be7 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 21:23:42 +0900 Subject: [PATCH 12/26] added a newline to enable the unordered list --- doc/specs/stdlib_sorting.md | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index d4c9d3e18..fcd67d72c 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -41,6 +41,7 @@ to the value of `int64` from the `stdlib_kinds` module. The `stdlib_sorting` module provides three different overloaded subroutines intended to sort three different kinds of arrays of data: + * `ORD_SORT` is intended to sort simple arrays of intrinsic data that have significant sections that were partially ordered before the sort; From 185c69530f3407199389661ed3a4d75765ca311a Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 21:24:52 +0900 Subject: [PATCH 13/26] replaced tab with spaces --- doc/specs/stdlib_sorting.md | 54 ++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index fcd67d72c..4549fddab 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -464,40 +464,40 @@ Sorting a related rank one array: ! Sort `a`, and also sort `b` to be reorderd the same way as `a` integer, intent(inout) :: a(:) integer(int32), intent(inout) :: b(:) ! The same size as a - integer(int32), intent(out) :: work(:) - integer(int_size), intent(out) :: index(:) - integer(int_size), intent(out) :: iwork(:) - ! Find the indices to sort a + integer(int32), intent(out) :: work(:) + integer(int_size), intent(out) :: index(:) + integer(int_size), intent(out) :: iwork(:) + ! Find the indices to sort a call sort_index(a, index(1:size(a)),& work(1:size(a)/2), iwork(1:size(a)/2)) - ! Sort b based on the sorting of a - b(:) = b( index(1:size(a)) ) - end subroutine sort_related_data + ! Sort b based on the sorting of a + b(:) = b( index(1:size(a)) ) + end subroutine sort_related_data ``` Sorting a rank 2 array based on the data in a column ```Fortran - subroutine sort_related_data( array, column, work, index, iwork ) - ! Reorder rows of `array` such that `array(:, column)` is sorted - integer, intent(inout) :: array(:,:) - integer(int32), intent(in) :: column - integer(int32), intent(out) :: work(:) - integer(int_size), intent(out) :: index(:) - integer(int_size), intent(out) :: iwork(:) - integer, allocatable :: dummy(:) - integer :: i - allocate(dummy(size(array, dim=1))) - ! Extract a column of `array` - dummy(:) = array(:, column) - ! Find the indices to sort the column - call sort_index(dummy, index(1:size(dummy)),& - work(1:size(dummy)/2), iwork(1:size(dummy)/2)) - ! Sort a based on the sorting of its column - do i=1, size(array, dim=2) - array(:, i) = array(index(1:size(array, dim=1)), i) - end do - end subroutine sort_related_data + subroutine sort_related_data( array, column, work, index, iwork ) + ! Reorder rows of `array` such that `array(:, column)` is sorted + integer, intent(inout) :: array(:,:) + integer(int32), intent(in) :: column + integer(int32), intent(out) :: work(:) + integer(int_size), intent(out) :: index(:) + integer(int_size), intent(out) :: iwork(:) + integer, allocatable :: dummy(:) + integer :: i + allocate(dummy(size(array, dim=1))) + ! Extract a column of `array` + dummy(:) = array(:, column) + ! Find the indices to sort the column + call sort_index(dummy, index(1:size(dummy)),& + work(1:size(dummy)/2), iwork(1:size(dummy)/2)) + ! Sort a based on the sorting of its column + do i=1, size(array, dim=2) + array(:, i) = array(index(1:size(array, dim=1)), i) + end do + end subroutine sort_related_data ``` Sorting an array of a derived type based on the data in one component From 1b0d50af26b3144609fdb88fddcd228947b37161 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 21:26:17 +0900 Subject: [PATCH 14/26] aligned indent width --- doc/specs/stdlib_sorting.md | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index 4549fddab..4de232dd4 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -503,21 +503,21 @@ Sorting a rank 2 array based on the data in a column Sorting an array of a derived type based on the data in one component ```fortran - subroutine sort_a_data( a_data, a, work, index, iwork ) - ! Sort `a_data` in terms or its component `a` - type(a_type), intent(inout) :: a_data(:) - integer(int32), intent(inout) :: a(:) - integer(int32), intent(out) :: work(:) - integer(int_size), intent(out) :: index(:) - integer(int_size), intent(out) :: iwork(:) - ! Extract a component of `a_data` - a(1:size(a_data)) = a_data(:) % a - ! Find the indices to sort the component - call sort_index(a(1:size(a_data)), index(1:size(a_data)),& - work(1:size(a_data)/2), iwork(1:size(a_data)/2)) - ! Sort a_data based on the sorting of that component - a_data(:) = a_data( index(1:size(a_data)) ) - end subroutine sort_a_data + subroutine sort_a_data( a_data, a, work, index, iwork ) + ! Sort `a_data` in terms or its component `a` + type(a_type), intent(inout) :: a_data(:) + integer(int32), intent(inout) :: a(:) + integer(int32), intent(out) :: work(:) + integer(int_size), intent(out) :: index(:) + integer(int_size), intent(out) :: iwork(:) + ! Extract a component of `a_data` + a(1:size(a_data)) = a_data(:) % a + ! Find the indices to sort the component + call sort_index(a(1:size(a_data)), index(1:size(a_data)),& + work(1:size(a_data)/2), iwork(1:size(a_data)/2)) + ! Sort a_data based on the sorting of that component + a_data(:) = a_data( index(1:size(a_data)) ) + end subroutine sort_a_data ``` From 47e9c1977b16b44b35cb5676211f008893859632 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 22:45:20 +0900 Subject: [PATCH 15/26] fixed missing stdlib_kinds module --- example/sorting/example_sort_bitsetl.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/example/sorting/example_sort_bitsetl.f90 b/example/sorting/example_sort_bitsetl.f90 index 04b92e08b..1a98a25a6 100644 --- a/example/sorting/example_sort_bitsetl.f90 +++ b/example/sorting/example_sort_bitsetl.f90 @@ -1,4 +1,5 @@ program example_sort_bitsetl + use stdlib_kinds use stdlib_sorting, only: sort use stdlib_bitsets implicit none From e27e9afa0e26e733c17b860c016f3b5f5d4b4fa7 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 25 Jun 2023 22:49:00 +0900 Subject: [PATCH 16/26] reduced the size of bitset arrays to reduce the time for testing --- test/sorting/test_sorting.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/sorting/test_sorting.f90 b/test/sorting/test_sorting.f90 index 845e59480..221b06eb7 100644 --- a/test/sorting/test_sorting.f90 +++ b/test/sorting/test_sorting.f90 @@ -16,7 +16,7 @@ module test_sorting integer(int32), parameter :: test_size = 2_int32**test_power integer(int32), parameter :: char_size = char_set_size**4 integer(int32), parameter :: string_size = char_set_size**3 - integer(int32), parameter :: bitset_size = char_set_size**4 + integer(int32), parameter :: bitset_size = char_set_size**3 integer(int32), parameter :: block_size = test_size/6 integer, parameter :: repeat = 1 From e7e6e4166b430c6a194d1d22ac2c280c7b9f7c88 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Mon, 26 Jun 2023 10:26:53 +0900 Subject: [PATCH 17/26] changed `intent` from `out` to `inout` to support assignment of the same variable, i.e., `set=set` --- src/stdlib_bitsets.fypp | 4 ++-- src/stdlib_bitsets_large.fypp | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/stdlib_bitsets.fypp b/src/stdlib_bitsets.fypp index 0605f2792..5c8a53d3d 100644 --- a/src/stdlib_bitsets.fypp +++ b/src/stdlib_bitsets.fypp @@ -1170,8 +1170,8 @@ module stdlib_bitsets !! Version: experimental !! !! Used to define assignment for `bitset_large`. - type(bitset_large), intent(out) :: set1 - type(bitset_large), intent(in) :: set2 + type(bitset_large), intent(inout) :: set1 + type(bitset_large), intent(in) :: set2 end subroutine assign_large #:for k1 in INT_KINDS diff --git a/src/stdlib_bitsets_large.fypp b/src/stdlib_bitsets_large.fypp index 324f19741..4b68a7abf 100644 --- a/src/stdlib_bitsets_large.fypp +++ b/src/stdlib_bitsets_large.fypp @@ -91,8 +91,8 @@ contains pure module subroutine assign_large( set1, set2 ) ! Used to define assignment for bitset_large - type(bitset_large), intent(out) :: set1 - type(bitset_large), intent(in) :: set2 + type(bitset_large), intent(inout) :: set1 + type(bitset_large), intent(in) :: set2 set1 % num_bits = set2 % num_bits allocate( set1 % blocks( size( set2 % blocks, kind=bits_kind ) ) ) From 5f1195f61985af5765a8c5c7cfab46c4f05a0241 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Mon, 26 Jun 2023 10:27:52 +0900 Subject: [PATCH 18/26] changed component assignment operation --- src/stdlib_bitsets_large.fypp | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/stdlib_bitsets_large.fypp b/src/stdlib_bitsets_large.fypp index 4b68a7abf..4799d58f2 100644 --- a/src/stdlib_bitsets_large.fypp +++ b/src/stdlib_bitsets_large.fypp @@ -95,8 +95,7 @@ contains type(bitset_large), intent(in) :: set2 set1 % num_bits = set2 % num_bits - allocate( set1 % blocks( size( set2 % blocks, kind=bits_kind ) ) ) - set1 % blocks(:) = set2 % blocks(:) + set1 % blocks = set2 % blocks(:) end subroutine assign_large From 4100e6101b032fce0b78a7139527fb4f33416033 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 2 Jul 2023 14:26:15 +0900 Subject: [PATCH 19/26] specified the entity to be used in the example Co-authored-by: Jeremie Vandenplas --- example/sorting/example_sort_bitsetl.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/example/sorting/example_sort_bitsetl.f90 b/example/sorting/example_sort_bitsetl.f90 index 1a98a25a6..a1ca70037 100644 --- a/example/sorting/example_sort_bitsetl.f90 +++ b/example/sorting/example_sort_bitsetl.f90 @@ -1,5 +1,5 @@ program example_sort_bitsetl - use stdlib_kinds + use stdlib_kinds, only: int32 use stdlib_sorting, only: sort use stdlib_bitsets implicit none From bdd6dccbc4b1bef97056f94fd2e321fe40d94f48 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 2 Jul 2023 14:26:30 +0900 Subject: [PATCH 20/26] specified the entity to be used in the example Co-authored-by: Jeremie Vandenplas --- example/sorting/example_sort_bitsetl.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/example/sorting/example_sort_bitsetl.f90 b/example/sorting/example_sort_bitsetl.f90 index a1ca70037..0f8504056 100644 --- a/example/sorting/example_sort_bitsetl.f90 +++ b/example/sorting/example_sort_bitsetl.f90 @@ -1,7 +1,7 @@ program example_sort_bitsetl use stdlib_kinds, only: int32 use stdlib_sorting, only: sort - use stdlib_bitsets + use stdlib_bitsets, only: bitset_large implicit none type(bitset_large), allocatable :: array(:) From 61029eedc5c2fba2fc5bd50f63f8130d199b6ab5 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 2 Jul 2023 16:51:57 +0900 Subject: [PATCH 21/26] deleted tailing "l" --- example/sorting/CMakeLists.txt | 2 +- .../{example_sort_bitsetl.f90 => example_sort_bitset.f90} | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) rename example/sorting/{example_sort_bitsetl.f90 => example_sort_bitset.f90} (94%) diff --git a/example/sorting/CMakeLists.txt b/example/sorting/CMakeLists.txt index e59c8cf65..416ffecdf 100644 --- a/example/sorting/CMakeLists.txt +++ b/example/sorting/CMakeLists.txt @@ -1,4 +1,4 @@ ADD_EXAMPLE(ord_sort) ADD_EXAMPLE(sort) ADD_EXAMPLE(radix_sort) -ADD_EXAMPLE(sort_bitsetl) \ No newline at end of file +ADD_EXAMPLE(sort_bitset) \ No newline at end of file diff --git a/example/sorting/example_sort_bitsetl.f90 b/example/sorting/example_sort_bitset.f90 similarity index 94% rename from example/sorting/example_sort_bitsetl.f90 rename to example/sorting/example_sort_bitset.f90 index 0f8504056..9d81bbe6e 100644 --- a/example/sorting/example_sort_bitsetl.f90 +++ b/example/sorting/example_sort_bitset.f90 @@ -1,4 +1,4 @@ -program example_sort_bitsetl +program example_sort_bitset use stdlib_kinds, only: int32 use stdlib_sorting, only: sort use stdlib_bitsets, only: bitset_large @@ -44,4 +44,4 @@ function to_string(bitset) result(str) call bitset%to_string(str) end function to_string -end program example_sort_bitsetl +end program example_sort_bitset From 7d6d97993d03bde8987a31ae31ce0cb03c8ff2fc Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sun, 2 Jul 2023 17:08:16 +0900 Subject: [PATCH 22/26] removed `block` structures --- example/sorting/example_sort_bitset.f90 | 24 +++++++++++------------- test/sorting/test_sorting.f90 | 24 ++++++++++-------------- 2 files changed, 21 insertions(+), 27 deletions(-) diff --git a/example/sorting/example_sort_bitset.f90 b/example/sorting/example_sort_bitset.f90 index 9d81bbe6e..5d9c89f08 100644 --- a/example/sorting/example_sort_bitset.f90 +++ b/example/sorting/example_sort_bitset.f90 @@ -4,6 +4,7 @@ program example_sort_bitset use stdlib_bitsets, only: bitset_large implicit none type(bitset_large), allocatable :: array(:) + integer(int32) :: i array = [bitset_l("0101"), & ! 5 bitset_l("0100"), & ! 4 @@ -15,19 +16,16 @@ program example_sort_bitset call sort(array) - block - integer(int32) :: i - do i = 1, size(array) - print *, to_string(array(i)) - ! 0001 - ! 0011 - ! 0100 - ! 0100 - ! 0101 - ! 1001 - ! 1010 - end do - end block + do i = 1, size(array) + print *, to_string(array(i)) + ! 0001 + ! 0011 + ! 0100 + ! 0100 + ! 0101 + ! 1001 + ! 1010 + end do deallocate(array) contains diff --git a/test/sorting/test_sorting.f90 b/test/sorting/test_sorting.f90 index 221b06eb7..4c9f1ffa5 100644 --- a/test/sorting/test_sorting.f90 +++ b/test/sorting/test_sorting.f90 @@ -71,6 +71,8 @@ module test_sorting type(bitset_large) :: bitsetl_temp type(bitset_64) :: bitset64_temp logical :: ltest, ldummy + character(32) :: bin32 + character(64) :: bin64 contains @@ -196,13 +198,10 @@ subroutine initialize_tests() string_rand(index1) = string_temp end do - block - character(32):: bin - do i = 0, bitset_size-1 - write(bin,'(b32.32)') i - call bitsetl_increase(i)%from_string(bin) - end do - end block + do i = 0, bitset_size-1 + write(bin32,'(b32.32)') i + call bitsetl_increase(i)%from_string(bin32) + end do do i=0, bitset_size-1 bitsetl_decrease(bitset_size-1-i) = bitsetl_increase(i) end do @@ -216,13 +215,10 @@ subroutine initialize_tests() bitsetl_rand(index1) = bitsetl_temp end do - block - character(64):: bin - do i = 0, bitset_size-1 - write(bin,'(b64.64)') i - call bitset64_increase(i)%from_string(bin) - end do - end block + do i = 0, bitset_size-1 + write(bin64,'(b64.64)') i + call bitset64_increase(i)%from_string(bin64) + end do do i=0, bitset_size-1 bitset64_decrease(bitset_size-1-i) = bitset64_increase(i) end do From de2dbbbc577c2115e746b2f5564671ff40988fc3 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 8 Jul 2023 21:28:33 +0200 Subject: [PATCH 23/26] add explicity in test_stdlib_bitset_large --- test/bitsets/test_stdlib_bitset_large.f90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/test/bitsets/test_stdlib_bitset_large.f90 b/test/bitsets/test_stdlib_bitset_large.f90 index 7d268b86f..ec9ede8ab 100644 --- a/test/bitsets/test_stdlib_bitset_large.f90 +++ b/test/bitsets/test_stdlib_bitset_large.f90 @@ -1,7 +1,15 @@ module test_stdlib_bitset_large use testdrive, only : new_unittest, unittest_type, error_type, check use :: stdlib_kinds, only : int8, int16, int32, int64 - use stdlib_bitsets + use stdlib_bitsets, only: bitset_large, bits_kind& + , bits & + , success & + , and, and_not, or, xor& + , extract& + , assignment(=)& + , operator(<), operator(<=)& + , operator(>), operator(>=)& + , operator(/=), operator(==) implicit none character(*), parameter :: & bitstring_0 = '000000000000000000000000000000000', & From 96763e1ea661790698bc04350926079987c95a67 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 8 Jul 2023 21:50:02 +0200 Subject: [PATCH 24/26] add test following issue #726 --- test/bitsets/test_stdlib_bitset_large.f90 | 31 +++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/test/bitsets/test_stdlib_bitset_large.f90 b/test/bitsets/test_stdlib_bitset_large.f90 index ec9ede8ab..cd3204697 100644 --- a/test/bitsets/test_stdlib_bitset_large.f90 +++ b/test/bitsets/test_stdlib_bitset_large.f90 @@ -28,6 +28,7 @@ subroutine collect_stdlib_bitset_large(testsuite) new_unittest("string-operations", test_string_operations), & new_unittest("io", test_io), & new_unittest("initialization", test_initialization), & + new_unittest("bitset-assignment-array", test_assignment_array), & new_unittest("bitset-inquiry", test_bitset_inquiry), & new_unittest("bit-operations", test_bit_operations), & new_unittest("bitset-comparisons", test_bitset_comparisons), & @@ -558,6 +559,36 @@ subroutine test_initialization(error) end subroutine test_initialization + subroutine test_assignment_array(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + logical(int8) :: log1(64) = .true. + + integer :: i + type(bitset_large) :: set1(0:4) + + do i = 0, size(set1) - 1 + set1(i) = log1 + enddo + + do i = 0, size(set1) - 1 + call check(error, set1(i) % bits(), 64, & + ' initialization with logical(int8) failed to set' // & + ' the right size in a bitset array.') + if (allocated(error)) return + enddo + + !Test added following issue https://github.com/fortran-lang/stdlib/issues/726 + set1(0) = set1(0) + + call check(error, set1(0) % bits(), 64, & + ' initialization from bitset_large failed to set' // & + ' the right size in a bitset array.') + if (allocated(error)) return + + end subroutine test_assignment_array + subroutine test_bitset_inquiry(error) !> Error handling type(error_type), allocatable, intent(out) :: error From efbc0cc70dd9de69a146ecde7fa008a77aab5d24 Mon Sep 17 00:00:00 2001 From: Tomohiro Degawa Date: Sat, 15 Jul 2023 18:31:52 +0900 Subject: [PATCH 25/26] removed `assign_large` --- src/stdlib_bitsets.fypp | 8 -------- src/stdlib_bitsets_large.fypp | 10 ---------- 2 files changed, 18 deletions(-) diff --git a/src/stdlib_bitsets.fypp b/src/stdlib_bitsets.fypp index 5c8a53d3d..6c1f57807 100644 --- a/src/stdlib_bitsets.fypp +++ b/src/stdlib_bitsets.fypp @@ -1166,14 +1166,6 @@ module stdlib_bitsets !! end program example_assignment !!``` - pure module subroutine assign_large( set1, set2 ) -!! Version: experimental -!! -!! Used to define assignment for `bitset_large`. - type(bitset_large), intent(inout) :: set1 - type(bitset_large), intent(in) :: set2 - end subroutine assign_large - #:for k1 in INT_KINDS pure module subroutine assign_log${k1}$_large( self, logical_vector ) !! Version: experimental diff --git a/src/stdlib_bitsets_large.fypp b/src/stdlib_bitsets_large.fypp index 4799d58f2..62f9f727d 100644 --- a/src/stdlib_bitsets_large.fypp +++ b/src/stdlib_bitsets_large.fypp @@ -89,16 +89,6 @@ contains end function any_large - pure module subroutine assign_large( set1, set2 ) -! Used to define assignment for bitset_large - type(bitset_large), intent(inout) :: set1 - type(bitset_large), intent(in) :: set2 - - set1 % num_bits = set2 % num_bits - set1 % blocks = set2 % blocks(:) - - end subroutine assign_large - #:for k1 in INT_KINDS pure module subroutine assign_log${k1}$_large( self, logical_vector ) ! Used to define assignment from an array of type logical for bitset_large From e661cd28ed75ba58d9e4ad4909ec6de20497e1e8 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 8 Aug 2023 01:43:26 -0400 Subject: [PATCH 26/26] Removed additional empty lines introduced by resolving conflicts --- src/stdlib_bitsets.fypp | 1 - src/stdlib_bitsets_large.fypp | 2 -- 2 files changed, 3 deletions(-) diff --git a/src/stdlib_bitsets.fypp b/src/stdlib_bitsets.fypp index 8c51202f4..5c9ffc0e5 100644 --- a/src/stdlib_bitsets.fypp +++ b/src/stdlib_bitsets.fypp @@ -1167,7 +1167,6 @@ module stdlib_bitsets !!``` - #:for k1 in INT_KINDS pure module subroutine assign_log${k1}$_large( self, logical_vector ) !! Version: experimental diff --git a/src/stdlib_bitsets_large.fypp b/src/stdlib_bitsets_large.fypp index def3927c1..fef726525 100644 --- a/src/stdlib_bitsets_large.fypp +++ b/src/stdlib_bitsets_large.fypp @@ -90,8 +90,6 @@ contains - - #:for k1 in INT_KINDS pure module subroutine assign_log${k1}$_large( self, logical_vector ) ! Used to define assignment from an array of type logical for bitset_large