Skip to content

Commit bdec191

Browse files
jvdp1jvdp1
authored
Merge pull request #723 from degawa/support-sorting-bitsets
Support sorting arrays of bitsets
2 parents 0b00b7b + e661cd2 commit bdec191

File tree

9 files changed

+700
-82
lines changed

9 files changed

+700
-82
lines changed

‎doc/specs/stdlib_sorting.md‎

Lines changed: 52 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ to the value of `int64` from the `stdlib_kinds` module.
4141
The `stdlib_sorting` module provides three different overloaded
4242
subroutines intended to sort three different kinds of arrays of
4343
data:
44+
4445
* `ORD_SORT` is intended to sort simple arrays of intrinsic data
4546
that have significant sections that were partially ordered before
4647
the sort;
@@ -235,8 +236,9 @@ Generic subroutine.
235236

236237
`array` : shall be a rank one array of any of the types:
237238
`integer(int8)`, `integer(int16)`, `integer(int32)`, `integer(int64)`,
238-
`real(sp)`, `real(dp)`, `real(qp)`, `character(*)`, or
239-
`type(string_type)`. It is an `intent(inout)` argument. On input it is
239+
`real(sp)`, `real(dp)`, `real(qp)`, `character(*)`, `type(string_type)`,
240+
`type(bitset_64)`, or `type(bitset_large)`.
241+
It is an `intent(inout)` argument. On input it is
240242
the array to be sorted. If both the type of `array` is real and at
241243
least one of the elements is a `NaN`, then the ordering of the result
242244
is undefined. Otherwise on return its elements will be sorted in order
@@ -301,8 +303,9 @@ Pure generic subroutine.
301303

302304
`array` : shall be a rank one array of any of the types:
303305
`integer(int8)`, `integer(int16)`, `integer(int32)`, `integer(int64)`,
304-
`real(sp)`, `real(dp)`, `real(qp)`. `character(*)`, or
305-
`type(string_type)`. It is an `intent(inout)` argument. On return its
306+
`real(sp)`, `real(dp)`, `real(qp)`. `character(*)`, `type(string_type)`,
307+
`type(bitset_64)`, or `type(bitset_large)`.
308+
It is an `intent(inout)` argument. On return its
306309
input elements will be sorted in order of non-decreasing value.
307310

308311

@@ -405,8 +408,9 @@ Generic subroutine.
405408

406409
`array`: shall be a rank one array of any of the types:
407410
`integer(int8)`, `integer(int16)`, `integer(int32)`, `integer(int64)`,
408-
`real(sp)`, `real(dp)`, `real(qp)`, `character(*)`, or
409-
`type(string_type)`. It is an `intent(inout)` argument. On input it
411+
`real(sp)`, `real(dp)`, `real(qp)`, `character(*)`, `type(string_type)`,
412+
`type(bitset_64)`, or `type(bitset_large)`.
413+
It is an `intent(inout)` argument. On input it
410414
will be an array whose sorting indices are to be determined. On return
411415
it will be the sorted array.
412416

@@ -460,60 +464,60 @@ Sorting a related rank one array:
460464
! Sort `a`, and also sort `b` to be reorderd the same way as `a`
461465
integer, intent(inout) :: a(:)
462466
integer(int32), intent(inout) :: b(:) ! The same size as a
463-
integer(int32), intent(out) :: work(:)
464-
integer(int_size), intent(out) :: index(:)
465-
integer(int_size), intent(out) :: iwork(:)
466-
! Find the indices to sort a
467+
integer(int32), intent(out) :: work(:)
468+
integer(int_size), intent(out) :: index(:)
469+
integer(int_size), intent(out) :: iwork(:)
470+
! Find the indices to sort a
467471
call sort_index(a, index(1:size(a)),&
468472
work(1:size(a)/2), iwork(1:size(a)/2))
469-
! Sort b based on the sorting of a
470-
b(:) = b( index(1:size(a)) )
471-
end subroutine sort_related_data
473+
! Sort b based on the sorting of a
474+
b(:) = b( index(1:size(a)) )
475+
end subroutine sort_related_data
472476
```
473477

474478
Sorting a rank 2 array based on the data in a column
475479

476480
```Fortran
477-
subroutine sort_related_data( array, column, work, index, iwork )
478-
! Reorder rows of `array` such that `array(:, column)` is sorted
479-
integer, intent(inout) :: array(:,:)
480-
integer(int32), intent(in) :: column
481-
integer(int32), intent(out) :: work(:)
482-
integer(int_size), intent(out) :: index(:)
483-
integer(int_size), intent(out) :: iwork(:)
484-
integer, allocatable :: dummy(:)
485-
integer :: i
486-
allocate(dummy(size(array, dim=1)))
487-
! Extract a column of `array`
488-
dummy(:) = array(:, column)
489-
! Find the indices to sort the column
490-
call sort_index(dummy, index(1:size(dummy)),&
491-
work(1:size(dummy)/2), iwork(1:size(dummy)/2))
492-
! Sort a based on the sorting of its column
493-
do i=1, size(array, dim=2)
494-
array(:, i) = array(index(1:size(array, dim=1)), i)
495-
end do
496-
end subroutine sort_related_data
481+
subroutine sort_related_data( array, column, work, index, iwork )
482+
! Reorder rows of `array` such that `array(:, column)` is sorted
483+
integer, intent(inout) :: array(:,:)
484+
integer(int32), intent(in) :: column
485+
integer(int32), intent(out) :: work(:)
486+
integer(int_size), intent(out) :: index(:)
487+
integer(int_size), intent(out) :: iwork(:)
488+
integer, allocatable :: dummy(:)
489+
integer :: i
490+
allocate(dummy(size(array, dim=1)))
491+
! Extract a column of `array`
492+
dummy(:) = array(:, column)
493+
! Find the indices to sort the column
494+
call sort_index(dummy, index(1:size(dummy)),&
495+
work(1:size(dummy)/2), iwork(1:size(dummy)/2))
496+
! Sort a based on the sorting of its column
497+
do i=1, size(array, dim=2)
498+
array(:, i) = array(index(1:size(array, dim=1)), i)
499+
end do
500+
end subroutine sort_related_data
497501
```
498502

499503
Sorting an array of a derived type based on the data in one component
500504

501505
```fortran
502-
subroutine sort_a_data( a_data, a, work, index, iwork )
503-
! Sort `a_data` in terms or its component `a`
504-
type(a_type), intent(inout) :: a_data(:)
505-
integer(int32), intent(inout) :: a(:)
506-
integer(int32), intent(out) :: work(:)
507-
integer(int_size), intent(out) :: index(:)
508-
integer(int_size), intent(out) :: iwork(:)
509-
! Extract a component of `a_data`
510-
a(1:size(a_data)) = a_data(:) % a
511-
! Find the indices to sort the component
512-
call sort_index(a(1:size(a_data)), index(1:size(a_data)),&
513-
work(1:size(a_data)/2), iwork(1:size(a_data)/2))
514-
! Sort a_data based on the sorting of that component
515-
a_data(:) = a_data( index(1:size(a_data)) )
516-
end subroutine sort_a_data
506+
subroutine sort_a_data( a_data, a, work, index, iwork )
507+
! Sort `a_data` in terms or its component `a`
508+
type(a_type), intent(inout) :: a_data(:)
509+
integer(int32), intent(inout) :: a(:)
510+
integer(int32), intent(out) :: work(:)
511+
integer(int_size), intent(out) :: index(:)
512+
integer(int_size), intent(out) :: iwork(:)
513+
! Extract a component of `a_data`
514+
a(1:size(a_data)) = a_data(:) % a
515+
! Find the indices to sort the component
516+
call sort_index(a(1:size(a_data)), index(1:size(a_data)),&
517+
work(1:size(a_data)/2), iwork(1:size(a_data)/2))
518+
! Sort a_data based on the sorting of that component
519+
a_data(:) = a_data( index(1:size(a_data)) )
520+
end subroutine sort_a_data
517521
```
518522

519523

‎example/sorting/CMakeLists.txt‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
11
ADD_EXAMPLE(ord_sort)
22
ADD_EXAMPLE(sort)
3-
ADD_EXAMPLE(radix_sort)
3+
ADD_EXAMPLE(radix_sort)
4+
ADD_EXAMPLE(sort_bitset)

‎example/sorting/example_sort_bitset.f90‎

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
program example_sort_bitset
2+
use stdlib_kinds, only: int32
3+
use stdlib_sorting, only: sort
4+
use stdlib_bitsets, only: bitset_large
5+
implicit none
6+
type(bitset_large), allocatable :: array(:)
7+
integer(int32) :: i
8+
9+
array = [bitset_l("0101"), & ! 5
10+
bitset_l("0100"), & ! 4
11+
bitset_l("0011"), & ! 3
12+
bitset_l("0001"), & ! 1
13+
bitset_l("1010"), & ! 10
14+
bitset_l("0100"), & ! 4
15+
bitset_l("1001")] ! 9
16+
17+
call sort(array)
18+
19+
do i = 1, size(array)
20+
print *, to_string(array(i))
21+
! 0001
22+
! 0011
23+
! 0100
24+
! 0100
25+
! 0101
26+
! 1001
27+
! 1010
28+
end do
29+
30+
deallocate(array)
31+
contains
32+
function bitset_l(str) result(new_bitsetl)
33+
character(*), intent(in) :: str
34+
type(bitset_large) :: new_bitsetl
35+
36+
call new_bitsetl%from_string(str)
37+
end function bitset_l
38+
39+
function to_string(bitset) result(str)
40+
type(bitset_large), intent(in) :: bitset
41+
character(:), allocatable :: str
42+
43+
call bitset%to_string(str)
44+
end function to_string
45+
end program example_sort_bitset

‎src/common.fypp‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -78,6 +78,11 @@
7878
#! Collected (kind, type) tuples for string derived types
7979
#:set STRING_KINDS_TYPES = list(zip(STRING_KINDS, STRING_TYPES))
8080

81+
#! Derived type bitsets
82+
#:set BITSET_KINDS = ["bitset_64", "bitset_large"]
83+
84+
#! Bitset types to be considered during templating
85+
#:set BITSET_TYPES = ["type({})".format(k) for k in BITSET_KINDS]
8186

8287
#! Whether Fortran 90 compatible code should be generated
8388
#:set VERSION90 = defined('VERSION90')

‎src/stdlib_sorting.fypp‎

Lines changed: 18 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -4,11 +4,13 @@
44
#:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS))
55
#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_KINDS))
66
#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=len(array))"], ["char"]))
7+
#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_KINDS))
78

89
#! For better code reuse in fypp, make lists that contain the input types,
910
#! with each having output types and a separate name prefix for subroutines
1011
#! This approach allows us to have the same code for all input types.
11-
#:set IRSC_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME
12+
#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME &
13+
& + BITSET_TYPES_ALT_NAME
1214

1315
!! Licensing:
1416
!!
@@ -129,6 +131,9 @@ module stdlib_sorting
129131
use stdlib_string_type, only: string_type, assignment(=), operator(>), &
130132
operator(>=), operator(<), operator(<=)
131133

134+
use stdlib_bitsets, only: bitset_64, bitset_large, &
135+
assignment(=), operator(>), operator(>=), operator(<), operator(<=)
136+
132137
implicit none
133138
private
134139

@@ -165,7 +170,8 @@ module stdlib_sorting
165170
!! * array: the rank 1 array to be sorted. It is an `intent(inout)`
166171
!! argument of any of the types `integer(int8)`, `integer(int16)`,
167172
!! `integer(int32)`, `integer(int64)`, `real(real32)`, `real(real64)`,
168-
!! `real(real128)`, `character(*)`, `type(string_type)`. If both the
173+
!! `real(real128)`, `character(*)`, `type(string_type)`,
174+
!! `type(bitset_64)`, `type(bitset_large)`. If both the
169175
!! type of `array` is real and at least one of the elements is a
170176
!! `NaN`, then the ordering of the result is undefined. Otherwise it
171177
!! is defined to be the original elements in non-decreasing order.
@@ -215,7 +221,8 @@ module stdlib_sorting
215221
!! * array: the rank 1 array to be sorted. It is an `intent(inout)`
216222
!! argument of any of the types `integer(int8)`, `integer(int16)`,
217223
!! `integer(int32)`, `integer(int64)`, `real(real32)`, `real(real64)`,
218-
!! `real(real128)`, `character(*)`, `type(string_type)`. If both the type
224+
!! `real(real128)`, `character(*)`, `type(string_type)`,
225+
!! `type(bitset_64)`, `type(bitset_large)`. If both the type
219226
!! of `array` is real and at least one of the elements is a `NaN`, then
220227
!! the ordering of the result is undefined. Otherwise it is defined to be the
221228
!! original elements in non-decreasing order.
@@ -299,7 +306,8 @@ module stdlib_sorting
299306
!! * array: the rank 1 array to be sorted. It is an `intent(inout)`
300307
!! argument of any of the types `integer(int8)`, `integer(int16)`,
301308
!! `integer(int32)`, `integer(int64)`, `real(real32)`, `real(real64)`,
302-
!! `real(real128)`, `character(*)`, `type(string_type)`. If both the
309+
!! `real(real128)`, `character(*)`, `type(string_type)`,
310+
!! `type(bitset_64)`, `type(bitset_large)`. If both the
303311
!! type of `array` is real and at least one of the elements is a `NaN`,
304312
!! then the ordering of the `array` and `index` results is undefined.
305313
!! Otherwise it is defined to be as specified by reverse.
@@ -410,12 +418,12 @@ module stdlib_sorting
410418
!! sorted data, having O(N) performance on uniformly non-increasing or
411419
!! non-decreasing data.
412420

413-
#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME
421+
#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME
414422
module subroutine ${name1}$_ord_sort( array, work, reverse )
415423
!! Version: experimental
416424
!!
417425
!! `${name1}$_ord_sort( array )` sorts the input `ARRAY` of type `${t1}$`
418-
!! using a hybrid sort based on the `'Rust" sort` algorithm found in `slice.rs`
426+
!! using a hybrid sort based on the `"Rust" sort` algorithm found in `slice.rs`
419427
${t1}$, intent(inout) :: array(0:)
420428
${t2}$, intent(out), optional :: work(0:)
421429
logical, intent(in), optional :: reverse
@@ -476,7 +484,7 @@ module stdlib_sorting
476484
!! on the `introsort` of David Musser.
477485
!! ([Specification](../page/specs/stdlib_sorting.html#sort-sorts-an-input-array))
478486

479-
#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME
487+
#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME
480488
pure module subroutine ${name1}$_sort( array, reverse )
481489
!! Version: experimental
482490
!!
@@ -507,15 +515,15 @@ module stdlib_sorting
507515
!! non-decreasing sort, but if the optional argument `REVERSE` is present
508516
!! with a value of `.TRUE.` the indices correspond to a non-increasing sort.
509517

510-
#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME
518+
#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME
511519
module subroutine ${name1}$_sort_index( array, index, work, iwork, &
512520
reverse )
513521
!! Version: experimental
514522
!!
515523
!! `${name1}$_sort_index( array, index[, work, iwork, reverse] )` sorts
516524
!! an input `ARRAY` of type `${t1}$`
517-
!! using a hybrid sort based on the `'Rust" sort` algorithm found in `slice.rs`
518-
!! and returns the sorted `ARRAY` and an array `INDEX of indices in the
525+
!! using a hybrid sort based on the `"Rust" sort` algorithm found in `slice.rs`
526+
!! and returns the sorted `ARRAY` and an array `INDEX` of indices in the
519527
!! order that would sort the input `ARRAY` in the desired direction.
520528
${t1}$, intent(inout) :: array(0:)
521529
integer(int_size), intent(out) :: index(0:)

‎src/stdlib_sorting_ord_sort.fypp‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,11 +3,13 @@
33
#:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS))
44
#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_TYPES, STRING_KINDS))
55
#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=:)"], ["character(len=len(array))"], ["char"]))
6+
#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_TYPES, BITSET_KINDS))
67

78
#! For better code reuse in fypp, make lists that contain the input types,
89
#! with each having output types and a separate name prefix for subroutines
910
#! This approach allows us to have the same code for all input types.
10-
#:set IRSC_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME
11+
#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME &
12+
& + BITSET_TYPES_ALT_NAME
1113

1214
#:set SIGN_NAME = ["increase", "decrease"]
1315
#:set SIGN_TYPE = [">", "<"]
@@ -69,7 +71,7 @@ submodule(stdlib_sorting) stdlib_sorting_ord_sort
6971

7072
contains
7173

72-
#:for t1, t2, t3, name1 in IRSC_TYPES_ALT_NAME
74+
#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME
7375
module subroutine ${name1}$_ord_sort( array, work, reverse )
7476
${t1}$, intent(inout) :: array(0:)
7577
${t3}$, intent(out), optional :: work(0:)
@@ -85,7 +87,7 @@ contains
8587
#:endfor
8688

8789
#:for sname, signt, signoppt in SIGN_NAME_TYPE
88-
#:for t1, t2, t3, name1 in IRSC_TYPES_ALT_NAME
90+
#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME
8991

9092
subroutine ${name1}$_${sname}$_ord_sort( array, work )
9193
! A translation to Fortran 2008, of the `"Rust" sort` algorithm found in

‎src/stdlib_sorting_sort.fypp‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,11 +3,13 @@
33
#:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS))
44
#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_KINDS))
55
#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=len(array))"], ["char"]))
6+
#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_KINDS))
67

78
#! For better code reuse in fypp, make lists that contain the input types,
89
#! with each having output types and a separate name prefix for subroutines
910
#! This approach allows us to have the same code for all input types.
10-
#:set IRSC_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME
11+
#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME &
12+
& + BITSET_TYPES_ALT_NAME
1113

1214
#:set SIGN_NAME = ["increase", "decrease"]
1315
#:set SIGN_TYPE = [">", "<"]
@@ -73,7 +75,7 @@ submodule(stdlib_sorting) stdlib_sorting_sort
7375

7476
contains
7577

76-
#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME
78+
#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME
7779
pure module subroutine ${name1}$_sort( array, reverse )
7880
${t1}$, intent(inout) :: array(0:)
7981
logical, intent(in), optional :: reverse
@@ -87,7 +89,7 @@ contains
8789
#:endfor
8890

8991
#:for sname, signt, signoppt in SIGN_NAME_TYPE
90-
#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME
92+
#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME
9193

9294
pure subroutine ${name1}$_${sname}$_sort( array )
9395
! `${name1}$_${sname}$_sort( array )` sorts the input `ARRAY` of type `${t1}$`

0 commit comments

Comments
 (0)