Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Support of int32 index array in sort_index #829

Merged
merged 5 commits into from
May 31, 2024
Merged
Show file tree
Hide file tree
Changes from 3 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
19 changes: 10 additions & 9 deletions doc/specs/stdlib_sorting.md
Original file line number Diff line number Diff line change
Expand Up @@ -24,17 +24,18 @@ module's `string_type` type.

## Overview of the module

The module `stdlib_sorting` defines several public entities, one
default integer parameter, `int_index`, and four overloaded
The module `stdlib_sorting` defines several public entities, two
default integer parameters, `int_index` and `int_index_low`, and four overloaded
subroutines: `ORD_SORT`, `SORT`, `RADIX_SORT` and `SORT_INDEX`. The
overloaded subroutines also each have several specific names for
versions corresponding to different types of array arguments.

### The `int_index` parameter
### The parameters `int_index` and `int_index_low`

The `int_index` parameter is used to specify the kind of integer used
in indexing the various arrays. Currently the module sets `int_index`
to the value of `int64` from the `stdlib_kinds` module.
The parameters `int_index` and `int_index_low` are used to specify the kind of integer used
in indexing the various arrays. Currently the module sets `int_index` and
`int_index_low`
to the value of `int64` and `int32` from the `stdlib_kinds` module, respectively.

### The module subroutines

Expand Down Expand Up @@ -414,7 +415,7 @@ 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.

`index`: shall be a rank one integer array of kind `int_index` and of
`index`: shall be a rank one integer array of kind `int_index` or `int_index_low` and of
the size of `array`. It is an `intent(out)` argument. On return it
shall have values that are the indices needed to sort the original
array in the desired direction.
Expand All @@ -426,8 +427,8 @@ memory for internal record keeping. If associated with an array in
static storage, its use can significantly reduce the stack memory
requirements for the code. Its contents on return are undefined.

`iwork` (optional): shall be a rank one integer array of kind
`int_index`, and shall have at least `size(array)/2` elements. It
`iwork` (optional): shall be a rank one integer array of the same kind
of the array `index`, and shall have at least `size(array)/2` elements. It
is an `intent(out)` argument. It is intended to be used as "scratch"
memory for internal record keeping. If associated with an array in
static storage, its use can significantly reduce the stack memory
Expand Down
28 changes: 18 additions & 10 deletions src/stdlib_sorting.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,8 @@
#: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))

#:set INT_INDEX_TYPES_ALT_NAME = list(zip(["int_index", "int_index_low"], ["integer(int_index)", "integer(int_index_low)"], ["default", "low"]))

#! 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.
Expand Down Expand Up @@ -138,6 +140,8 @@ module stdlib_sorting
private

integer, parameter, public :: int_index = int64 !! Integer kind for indexing
integer, parameter, public :: int_index_low = int32 !! Integer kind for indexing using less than `huge(1_int32)` values


! Constants for use by tim_sort
integer, parameter :: &
Expand All @@ -147,14 +151,16 @@ module stdlib_sorting
max_merge_stack = int( ceiling( log( 2._dp**64 ) / &
log(1.6180339887_dp) ) )

type run_type
#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME
type run_type_${namei}$
perazz marked this conversation as resolved.
Show resolved Hide resolved
!! Version: experimental
!!
!! Used to pass state around in a stack among helper functions for the
!! `ORD_SORT` and `SORT_INDEX` algorithms
integer(int_index) :: base = 0
integer(int_index) :: len = 0
end type run_type
${ti}$ :: base = 0
${ti}$ :: len = 0
end type run_type_${namei}$
#:endfor

public ord_sort
!! Version: experimental
Expand Down Expand Up @@ -515,23 +521,25 @@ 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 IRSCB_TYPES_ALT_NAME
module subroutine ${name1}$_sort_index( array, index, work, iwork, &
#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME
#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME
module subroutine ${name1}$_sort_index_${namei}$( array, index, work, iwork, &
reverse )
!! Version: experimental
!!
!! `${name1}$_sort_index( array, index[, work, iwork, reverse] )` sorts
!! `${name1}$_sort_index_${namei}$( 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
!! order that would sort the input `ARRAY` in the desired direction.
${t1}$, intent(inout) :: array(0:)
integer(int_index), intent(out) :: index(0:)
${ti}$, intent(out) :: index(0:)
${t2}$, intent(out), optional :: work(0:)
integer(int_index), intent(out), optional :: iwork(0:)
${ti}$, intent(out), optional :: iwork(0:)
logical, intent(in), optional :: reverse
end subroutine ${name1}$_sort_index
end subroutine ${name1}$_sort_index_${namei}$

#:endfor
#:endfor

end interface sort_index
Expand Down
8 changes: 4 additions & 4 deletions src/stdlib_sorting_ord_sort.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -186,7 +186,7 @@ contains
! 1. len(-3) > len(-2) + len(-1)
! 2. len(-2) > len(-1)
integer(int_index) :: r
type(run_type), intent(in), target :: runs(0:)
type(run_type_default), intent(in), target :: runs(0:)

integer(int_index) :: n
logical :: test
Expand Down Expand Up @@ -277,7 +277,7 @@ contains

integer(int_index) :: array_size, finish, min_run, r, r_count, &
start
type(run_type) :: runs(0:max_merge_stack-1), left, right
type(run_type_default) :: runs(0:max_merge_stack-1), left, right

array_size = size(array, kind=int_index)

Expand Down Expand Up @@ -326,7 +326,7 @@ contains
end do Insert
if ( start == 0 .and. finish == array_size - 1 ) return

runs(r_count) = run_type( base = start, &
runs(r_count) = run_type_default( base = start, &
len = finish - start + 1 )
finish = start-1
r_count = r_count + 1
Expand All @@ -342,7 +342,7 @@ contains
right % base + right % len - 1 ), &
left % len, buf )

runs(r) = run_type( base = left % base, &
runs(r) = run_type_default( base = left % base, &
len = left % len + right % len )
if ( r == r_count - 3 ) runs(r+1) = runs(r+2)
r_count = r_count - 1
Expand Down
88 changes: 46 additions & 42 deletions src/stdlib_sorting_sort_index.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,8 @@
#: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))

#:set INT_INDEX_TYPES_ALT_NAME = list(zip(["int_index", "int_index_low"], ["integer(int_index)", "integer(int_index_low)"], ["default", "low"]))

#! 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.
Expand Down Expand Up @@ -66,9 +68,10 @@ submodule(stdlib_sorting) stdlib_sorting_sort_index

contains

#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME
#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME
#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME

module subroutine ${name1}$_sort_index( array, index, work, iwork, reverse )
module subroutine ${name1}$_sort_index_${namei}$( array, index, work, iwork, reverse )
! A modification of `${name1}$_ord_sort` to return an array of indices that
! would perform a stable sort of the `ARRAY` as input, and also sort `ARRAY`
! as desired. The indices by default
Expand All @@ -94,16 +97,16 @@ contains
! used as scratch memory.

${t1}$, intent(inout) :: array(0:)
integer(int_index), intent(out) :: index(0:)
${ti}$, intent(out) :: index(0:)
${t3}$, intent(out), optional :: work(0:)
integer(int_index), intent(out), optional :: iwork(0:)
${ti}$, intent(out), optional :: iwork(0:)
logical, intent(in), optional :: reverse

integer(int_index) :: array_size, i, stat
${ti}$ :: array_size, i, stat
${t2}$, allocatable :: buf(:)
integer(int_index), allocatable :: ibuf(:)
${ti}$, allocatable :: ibuf(:)

array_size = size(array, kind=int_index)
array_size = size(array, kind=${ki}$)

do i = 0, array_size-1
index(i) = i+1
Expand All @@ -115,11 +118,11 @@ contains

! If necessary allocate buffers to serve as scratch memory.
if ( present(work) ) then
if ( size(work, kind=int_index) < array_size/2 ) then
if ( size(work, kind=${ki}$) < array_size/2 ) then
error stop "work array is too small."
end if
if ( present(iwork) ) then
if ( size(iwork, kind=int_index) < array_size/2 ) then
if ( size(iwork, kind=${ki}$) < array_size/2 ) then
error stop "iwork array is too small."
endif
call merge_sort( array, index, work, iwork )
Expand All @@ -137,7 +140,7 @@ contains
#:endif
if ( stat /= 0 ) error stop "Allocation of array buffer failed."
if ( present(iwork) ) then
if ( size(iwork, kind=int_index) < array_size/2 ) then
if ( size(iwork, kind=${ki}$) < array_size/2 ) then
error stop "iwork array is too small."
endif
call merge_sort( array, index, buf, iwork )
Expand All @@ -158,17 +161,17 @@ contains
!! Returns the minimum length of a run from 32-63 so that N/MIN_RUN is
!! less than or equal to a power of two. See
!! https://svn.python.org/projects/python/trunk/Objects/listsort.txt
integer(int_index) :: min_run
integer(int_index), intent(in) :: n
${ti}$ :: min_run
${ti}$, intent(in) :: n

integer(int_index) :: num, r
${ti}$ :: num, r

num = n
r = 0_int_index
r = 0_${ki}$

do while( num >= 64 )
r = ior( r, iand(num, 1_int_index) )
num = ishft(num, -1_int_index)
r = ior( r, iand(num, 1_${ki}$) )
num = ishft(num, -1_${ki}$)
end do
min_run = num + r

Expand All @@ -179,12 +182,12 @@ contains
! Sorts `ARRAY` using an insertion sort, while maintaining consistency in
! location of the indices in `INDEX` to the elements of `ARRAY`.
${t1}$, intent(inout) :: array(0:)
integer(int_index), intent(inout) :: index(0:)
${ti}$, intent(inout) :: index(0:)

integer(int_index) :: i, j, key_index
${ti}$ :: i, j, key_index
${t3}$ :: key

do j=1, size(array, kind=int_index)-1
do j=1, size(array, kind=${ki}$)-1
key = array(j)
key_index = index(j)
i = j - 1
Expand All @@ -208,13 +211,13 @@ contains
! 1. len(-3) > len(-2) + len(-1)
! 2. len(-2) > len(-1)

integer(int_index) :: r
type(run_type), intent(in), target :: runs(0:)
${ti}$ :: r
type(run_type_${namei}$), intent(in), target :: runs(0:)

integer(int_index) :: n
${ti}$ :: n
logical :: test

n = size(runs, kind=int_index)
n = size(runs, kind=${ki}$)
test = .false.
if (n >= 2) then
if ( runs( n-1 ) % base == 0 .or. &
Expand Down Expand Up @@ -263,14 +266,14 @@ contains
! are maintained.

${t1}$, intent(inout) :: array(0:)
integer(int_index), intent(inout) :: index(0:)
${ti}$, intent(inout) :: index(0:)

${t3}$ :: tmp
integer(int_index) :: i, tmp_index
${ti}$ :: i, tmp_index

tmp = array(0)
tmp_index = index(0)
find_hole: do i=1, size(array, kind=int_index)-1
find_hole: do i=1, size(array, kind=${ki}$)-1
if ( array(i) >= tmp ) exit find_hole
array(i-1) = array(i)
index(i-1) = index(i)
Expand Down Expand Up @@ -303,15 +306,15 @@ contains
! `array` are maintained.

${t1}$, intent(inout) :: array(0:)
integer(int_index), intent(inout) :: index(0:)
${ti}$, intent(inout) :: index(0:)
${t3}$, intent(inout) :: buf(0:)
integer(int_index), intent(inout) :: ibuf(0:)
${ti}$, intent(inout) :: ibuf(0:)

integer(int_index) :: array_size, finish, min_run, r, r_count, &
${ti}$ :: array_size, finish, min_run, r, r_count, &
start
type(run_type) :: runs(0:max_merge_stack-1), left, right
type(run_type_${namei}$) :: runs(0:max_merge_stack-1), left, right

array_size = size(array, kind=int_index)
array_size = size(array, kind=${ki}$)

! Very short runs are extended using insertion sort to span at least this
! many elements. Slices of up to this length are sorted using insertion sort.
Expand Down Expand Up @@ -359,7 +362,7 @@ contains
end do Insert
if ( start == 0 .and. finish == array_size - 1 ) return

runs(r_count) = run_type( base = start, &
runs(r_count) = run_type_${namei}$( base = start, &
len = finish - start + 1 )
finish = start-1
r_count = r_count + 1
Expand All @@ -377,7 +380,7 @@ contains
index( left % base: &
right % base + right % len - 1 ), ibuf )

runs(r) = run_type( base = left % base, &
runs(r) = run_type_${namei}$( base = left % base, &
len = left % len + right % len )
if ( r == r_count - 3 ) runs(r+1) = runs(r+2)
r_count = r_count - 1
Expand All @@ -396,14 +399,14 @@ contains
! `ARRAY(0:)`. `MID` must be > 0, and < `SIZE(ARRAY)-1`. Buffer `BUF`
! must be long enough to hold the shorter of the two runs.
${t1}$, intent(inout) :: array(0:)
integer(int_index), intent(in) :: mid
${ti}$, intent(in) :: mid
${t3}$, intent(inout) :: buf(0:)
integer(int_index), intent(inout) :: index(0:)
integer(int_index), intent(inout) :: ibuf(0:)
${ti}$, intent(inout) :: index(0:)
${ti}$, intent(inout) :: ibuf(0:)

integer(int_index) :: array_len, i, j, k
${ti}$ :: array_len, i, j, k

array_len = size(array, kind=int_index)
array_len = size(array, kind=${ki}$)

! Merge first copies the shorter run into `buf`. Then, depending on which
! run was shorter, it traces the copied run and the longer run forwards
Expand Down Expand Up @@ -461,13 +464,13 @@ contains
pure subroutine reverse_segment( array, index )
! Reverse a segment of an array in place
${t1}$, intent(inout) :: array(0:)
integer(int_index), intent(inout) :: index(0:)
${ti}$, intent(inout) :: index(0:)

integer(int_index) :: itemp, lo, hi
${ti}$ :: itemp, lo, hi
${t3}$ :: temp

lo = 0
hi = size( array, kind=int_index ) - 1
hi = size( array, kind=${ki}$ ) - 1
do while( lo < hi )
temp = array(lo)
array(lo) = array(hi)
Expand All @@ -481,8 +484,9 @@ contains

end subroutine reverse_segment

end subroutine ${name1}$_sort_index
end subroutine ${name1}$_sort_index_${namei}$

#:endfor
#:endfor

end submodule stdlib_sorting_sort_index
7 changes: 6 additions & 1 deletion test/sorting/CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -1,2 +1,7 @@
ADDTEST(sorting)
set(
fppFiles
"test_sorting.fypp"
)
fypp_f90("${fyppFlags}" "${fppFiles}" outFiles)

ADDTEST(sorting)
Loading
Loading