Skip to content

Commit 6460442

Browse files
jvdp1jvdp1
committed
Add sort_index with int32 index
1 parent ec38362 commit 6460442

File tree

3 files changed

+68
-56
lines changed

3 files changed

+68
-56
lines changed

‎src/stdlib_sorting.fypp

Lines changed: 18 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,8 @@
66
#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=len(array))"], ["char"]))
77
#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_KINDS))
88

9+
#:set INT_INDEX_TYPES_ALT_NAME = list(zip(["int_index", "int_index_low"], ["integer(int_index)", "integer(int_index_low)"], ["default", "low"]))
10+
911
#! For better code reuse in fypp, make lists that contain the input types,
1012
#! with each having output types and a separate name prefix for subroutines
1113
#! This approach allows us to have the same code for all input types.
@@ -138,6 +140,8 @@ module stdlib_sorting
138140
private
139141

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

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

150-
type run_type
154+
#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME
155+
type run_type_${namei}$
151156
!! Version: experimental
152157
!!
153158
!! Used to pass state around in a stack among helper functions for the
154159
!! `ORD_SORT` and `SORT_INDEX` algorithms
155-
integer(int_index) :: base = 0
156-
integer(int_index) :: len = 0
157-
end type run_type
160+
${ti}$ :: base = 0
161+
${ti}$ :: len = 0
162+
end type run_type_${namei}$
163+
#:endfor
158164

159165
public ord_sort
160166
!! Version: experimental
@@ -515,23 +521,25 @@ module stdlib_sorting
515521
!! non-decreasing sort, but if the optional argument `REVERSE` is present
516522
!! with a value of `.TRUE.` the indices correspond to a non-increasing sort.
517523

518-
#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME
519-
module subroutine ${name1}$_sort_index( array, index, work, iwork, &
524+
#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME
525+
#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME
526+
module subroutine ${name1}$_sort_index_${namei}$( array, index, work, iwork, &
520527
reverse )
521528
!! Version: experimental
522529
!!
523-
!! `${name1}$_sort_index( array, index[, work, iwork, reverse] )` sorts
530+
!! `${name1}$_sort_index_${namei}$( array, index[, work, iwork, reverse] )` sorts
524531
!! an input `ARRAY` of type `${t1}$`
525532
!! using a hybrid sort based on the `"Rust" sort` algorithm found in `slice.rs`
526533
!! and returns the sorted `ARRAY` and an array `INDEX` of indices in the
527534
!! order that would sort the input `ARRAY` in the desired direction.
528535
${t1}$, intent(inout) :: array(0:)
529-
integer(int_index), intent(out) :: index(0:)
536+
${ti}$, intent(out) :: index(0:)
530537
${t2}$, intent(out), optional :: work(0:)
531-
integer(int_index), intent(out), optional :: iwork(0:)
538+
${ti}$, intent(out), optional :: iwork(0:)
532539
logical, intent(in), optional :: reverse
533-
end subroutine ${name1}$_sort_index
540+
end subroutine ${name1}$_sort_index_${namei}$
534541

542+
#:endfor
535543
#:endfor
536544

537545
end interface sort_index

‎src/stdlib_sorting_ord_sort.fypp

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -186,7 +186,7 @@ contains
186186
! 1. len(-3) > len(-2) + len(-1)
187187
! 2. len(-2) > len(-1)
188188
integer(int_index) :: r
189-
type(run_type), intent(in), target :: runs(0:)
189+
type(run_type_default), intent(in), target :: runs(0:)
190190

191191
integer(int_index) :: n
192192
logical :: test
@@ -277,7 +277,7 @@ contains
277277

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

282282
array_size = size(array, kind=int_index)
283283

@@ -326,7 +326,7 @@ contains
326326
end do Insert
327327
if ( start == 0 .and. finish == array_size - 1 ) return
328328

329-
runs(r_count) = run_type( base = start, &
329+
runs(r_count) = run_type_default( base = start, &
330330
len = finish - start + 1 )
331331
finish = start-1
332332
r_count = r_count + 1
@@ -342,7 +342,7 @@ contains
342342
right % base + right % len - 1 ), &
343343
left % len, buf )
344344

345-
runs(r) = run_type( base = left % base, &
345+
runs(r) = run_type_default( base = left % base, &
346346
len = left % len + right % len )
347347
if ( r == r_count - 3 ) runs(r+1) = runs(r+2)
348348
r_count = r_count - 1

‎src/stdlib_sorting_sort_index.fypp

Lines changed: 46 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,8 @@
55
#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=:)"], ["character(len=len(array))"], ["char"]))
66
#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_TYPES, BITSET_KINDS))
77

8+
#:set INT_INDEX_TYPES_ALT_NAME = list(zip(["int_index", "int_index_low"], ["integer(int_index)", "integer(int_index_low)"], ["default", "low"]))
9+
810
#! For better code reuse in fypp, make lists that contain the input types,
911
#! with each having output types and a separate name prefix for subroutines
1012
#! This approach allows us to have the same code for all input types.
@@ -66,9 +68,10 @@ submodule(stdlib_sorting) stdlib_sorting_sort_index
6668

6769
contains
6870

69-
#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME
71+
#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME
72+
#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME
7073

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

9699
${t1}$, intent(inout) :: array(0:)
97-
integer(int_index), intent(out) :: index(0:)
100+
${ti}$, intent(out) :: index(0:)
98101
${t3}$, intent(out), optional :: work(0:)
99-
integer(int_index), intent(out), optional :: iwork(0:)
102+
${ti}$, intent(out), optional :: iwork(0:)
100103
logical, intent(in), optional :: reverse
101104

102-
integer(int_index) :: array_size, i, stat
105+
${ti}$ :: array_size, i, stat
103106
${t2}$, allocatable :: buf(:)
104-
integer(int_index), allocatable :: ibuf(:)
107+
${ti}$, allocatable :: ibuf(:)
105108

106-
array_size = size(array, kind=int_index)
109+
array_size = size(array, kind=${ki}$)
107110

108111
do i = 0, array_size-1
109112
index(i) = i+1
@@ -115,11 +118,11 @@ contains
115118

116119
! If necessary allocate buffers to serve as scratch memory.
117120
if ( present(work) ) then
118-
if ( size(work, kind=int_index) < array_size/2 ) then
121+
if ( size(work, kind=${ki}$) < array_size/2 ) then
119122
error stop "work array is too small."
120123
end if
121124
if ( present(iwork) ) then
122-
if ( size(iwork, kind=int_index) < array_size/2 ) then
125+
if ( size(iwork, kind=${ki}$) < array_size/2 ) then
123126
error stop "iwork array is too small."
124127
endif
125128
call merge_sort( array, index, work, iwork )
@@ -137,7 +140,7 @@ contains
137140
#:endif
138141
if ( stat /= 0 ) error stop "Allocation of array buffer failed."
139142
if ( present(iwork) ) then
140-
if ( size(iwork, kind=int_index) < array_size/2 ) then
143+
if ( size(iwork, kind=${ki}$) < array_size/2 ) then
141144
error stop "iwork array is too small."
142145
endif
143146
call merge_sort( array, index, buf, iwork )
@@ -158,17 +161,17 @@ contains
158161
!! Returns the minimum length of a run from 32-63 so that N/MIN_RUN is
159162
!! less than or equal to a power of two. See
160163
!! https://svn.python.org/projects/python/trunk/Objects/listsort.txt
161-
integer(int_index) :: min_run
162-
integer(int_index), intent(in) :: n
164+
${ti}$ :: min_run
165+
${ti}$, intent(in) :: n
163166

164-
integer(int_index) :: num, r
167+
${ti}$ :: num, r
165168

166169
num = n
167-
r = 0_int_index
170+
r = 0_${ki}$
168171

169172
do while( num >= 64 )
170-
r = ior( r, iand(num, 1_int_index) )
171-
num = ishft(num, -1_int_index)
173+
r = ior( r, iand(num, 1_${ki}$) )
174+
num = ishft(num, -1_${ki}$)
172175
end do
173176
min_run = num + r
174177

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

184-
integer(int_index) :: i, j, key_index
187+
${ti}$ :: i, j, key_index
185188
${t3}$ :: key
186189

187-
do j=1, size(array, kind=int_index)-1
190+
do j=1, size(array, kind=${ki}$)-1
188191
key = array(j)
189192
key_index = index(j)
190193
i = j - 1
@@ -208,13 +211,13 @@ contains
208211
! 1. len(-3) > len(-2) + len(-1)
209212
! 2. len(-2) > len(-1)
210213

211-
integer(int_index) :: r
212-
type(run_type), intent(in), target :: runs(0:)
214+
${ti}$ :: r
215+
type(run_type_${namei}$), intent(in), target :: runs(0:)
213216

214-
integer(int_index) :: n
217+
${ti}$ :: n
215218
logical :: test
216219

217-
n = size(runs, kind=int_index)
220+
n = size(runs, kind=${ki}$)
218221
test = .false.
219222
if (n >= 2) then
220223
if ( runs( n-1 ) % base == 0 .or. &
@@ -263,14 +266,14 @@ contains
263266
! are maintained.
264267

265268
${t1}$, intent(inout) :: array(0:)
266-
integer(int_index), intent(inout) :: index(0:)
269+
${ti}$, intent(inout) :: index(0:)
267270

268271
${t3}$ :: tmp
269-
integer(int_index) :: i, tmp_index
272+
${ti}$ :: i, tmp_index
270273

271274
tmp = array(0)
272275
tmp_index = index(0)
273-
find_hole: do i=1, size(array, kind=int_index)-1
276+
find_hole: do i=1, size(array, kind=${ki}$)-1
274277
if ( array(i) >= tmp ) exit find_hole
275278
array(i-1) = array(i)
276279
index(i-1) = index(i)
@@ -303,15 +306,15 @@ contains
303306
! `array` are maintained.
304307

305308
${t1}$, intent(inout) :: array(0:)
306-
integer(int_index), intent(inout) :: index(0:)
309+
${ti}$, intent(inout) :: index(0:)
307310
${t3}$, intent(inout) :: buf(0:)
308-
integer(int_index), intent(inout) :: ibuf(0:)
311+
${ti}$, intent(inout) :: ibuf(0:)
309312

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

314-
array_size = size(array, kind=int_index)
317+
array_size = size(array, kind=${ki}$)
315318

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

362-
runs(r_count) = run_type( base = start, &
365+
runs(r_count) = run_type_${namei}$( base = start, &
363366
len = finish - start + 1 )
364367
finish = start-1
365368
r_count = r_count + 1
@@ -377,7 +380,7 @@ contains
377380
index( left % base: &
378381
right % base + right % len - 1 ), ibuf )
379382

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

404-
integer(int_index) :: array_len, i, j, k
407+
${ti}$ :: array_len, i, j, k
405408

406-
array_len = size(array, kind=int_index)
409+
array_len = size(array, kind=${ki}$)
407410

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

466-
integer(int_index) :: itemp, lo, hi
469+
${ti}$ :: itemp, lo, hi
467470
${t3}$ :: temp
468471

469472
lo = 0
470-
hi = size( array, kind=int_index ) - 1
473+
hi = size( array, kind=${ki}$ ) - 1
471474
do while( lo < hi )
472475
temp = array(lo)
473476
array(lo) = array(hi)
@@ -481,8 +484,9 @@ contains
481484

482485
end subroutine reverse_segment
483486

484-
end subroutine ${name1}$_sort_index
487+
end subroutine ${name1}$_sort_index_${namei}$
485488

489+
#:endfor
486490
#:endfor
487491

488492
end submodule stdlib_sorting_sort_index

0 commit comments

Comments
 (0)