Merge pull request #723 from degawa/support-sorting-bitsets

Support sorting arrays of bitsets

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;
@@ -235,8 +236,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 +303,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 +408,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.
 
@@ -460,60 +464,60 @@ 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
 
 ```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
 ```
 
 

example/sorting/CMakeLists.txt

@@ -1,3 +1,4 @@
 ADD_EXAMPLE(ord_sort)
 ADD_EXAMPLE(sort)
-ADD_EXAMPLE(radix_sort)
+ADD_EXAMPLE(radix_sort)
+ADD_EXAMPLE(sort_bitset)

example/sorting/example_sort_bitset.f90

@@ -0,0 +1,45 @@
+program example_sort_bitset
+  use stdlib_kinds, only: int32
+  use stdlib_sorting, only: sort
+  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
+           bitset_l("0011"), & ! 3
+           bitset_l("0001"), & ! 1
+           bitset_l("1010"), & ! 10
+           bitset_l("0100"), & ! 4
+           bitset_l("1001")]   ! 9
+
+  call sort(array)
+
+  do i = 1, size(array)
+    print *, to_string(array(i))
+    ! 0001
+    ! 0011
+    ! 0100
+    ! 0100
+    ! 0101
+    ! 1001
+    ! 1010
+  end do
+
+  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_bitset

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')

src/stdlib_sorting.fypp

@@ -4,11 +4,13 @@
 #: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
 #! 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:
 !!
@@ -129,6 +131,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
 
@@ -165,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.
@@ -215,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.
@@ -299,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.
@@ -410,12 +418,12 @@ 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
 !!
 !! `${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
@@ -476,7 +484,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
 !!
@@ -507,15 +515,15 @@ 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
 !!
 !! `${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:)

src/stdlib_sorting_ord_sort.fypp

@@ -3,11 +3,13 @@
 #: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
 #! 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 = [">", "<"]
@@ -69,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:)
@@ -85,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

src/stdlib_sorting_sort.fypp

@@ -3,11 +3,13 @@
 #: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
 #! 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 = [">", "<"]
@@ -73,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
@@ -87,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}$`