Skip to content

Commit 91dcc50

Browse files
jvdp1jvdp1
authored
Merge pull request #848 from jvdp1/split_sort_index
`sort_index`: use of only `int_index` iterators inside `sort_index`
2 parents 59509b1 + 3041d97 commit 91dcc50

File tree

3 files changed

+63
-63
lines changed

3 files changed

+63
-63
lines changed

Diff for: ‎src/stdlib_sorting.fypp

+4-6
Original file line numberDiff line numberDiff line change
@@ -151,16 +151,14 @@ module stdlib_sorting
151151
max_merge_stack = int( ceiling( log( 2._dp**64 ) / &
152152
log(1.6180339887_dp) ) )
153153

154-
#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME
155-
type run_type_${namei}$
154+
type run_type
156155
!! Version: experimental
157156
!!
158157
!! Used to pass state around in a stack among helper functions for the
159158
!! `ORD_SORT` and `SORT_INDEX` algorithms
160-
${ti}$ :: base = 0
161-
${ti}$ :: len = 0
162-
end type run_type_${namei}$
163-
#:endfor
159+
integer(int_index) :: base = 0
160+
integer(int_index) :: len = 0
161+
end type run_type
164162

165163
public ord_sort
166164
!! Version: experimental

Diff for: ‎src/stdlib_sorting_ord_sort.fypp

+6-6
Original file line numberDiff line numberDiff line change
@@ -118,9 +118,9 @@ contains
118118

119119
array_size = size( array, kind=int_index )
120120
if ( present(work) ) then
121-
if ( size( work, kind=int_index) < array_size/2 ) then
121+
if ( size(work, kind=int_index) < array_size/2 ) then
122122
error stop "${name1}$_${sname}$_ord_sort: work array is too small."
123-
endif
123+
end if
124124
! Use the work array as scratch memory
125125
call merge_sort( array, work )
126126
else
@@ -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_default), intent(in), target :: runs(0:)
189+
type(run_type), 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_default) :: runs(0:max_merge_stack-1), left, right
280+
type(run_type) :: 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_default( base = start, &
329+
runs(r_count) = run_type( 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_default( base = left % base, &
345+
runs(r) = run_type( 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

Diff for: ‎src/stdlib_sorting_sort_index.fypp

+53-51
Original file line numberDiff line numberDiff line change
@@ -80,44 +80,45 @@ contains
8080
! a non-increasing sort. The logic of the determination of indexing largely
8181
! follows the `"Rust" sort` found in `slice.rs`:
8282
! https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs#L2159
83-
! The Rust version is a simplification of the Timsort algorithm described
84-
! in https://svn.python.org/projects/python/trunk/Objects/listsort.txt, as
83+
! The Rust version in turn is a simplification of the Timsort algorithm
84+
! described in
85+
! https://svn.python.org/projects/python/trunk/Objects/listsort.txt, as
8586
! it drops both the use of 'galloping' to identify bounds of regions to be
8687
! sorted and the estimation of the optimal `run size`. However it remains
8788
! a hybrid sorting algorithm combining an iterative Merge sort controlled
8889
! by a stack of `RUNS` identified by regions of uniformly decreasing or
89-
! non-decreasing sequences that may be expanded to a minimum run size, with
90-
! an insertion sort.
90+
! non-decreasing sequences that may be expanded to a minimum run size and
91+
! initially processed by an insertion sort.
9192
!
9293
! Note the Fortran implementation simplifies the logic as it only has to
9394
! deal with Fortran arrays of intrinsic types and not the full generality
9495
! of Rust's arrays and lists for arbitrary types. It also adds the
9596
! estimation of the optimal `run size` as suggested in Tim Peters'
96-
! original listsort.txt, and the optional `work` and `iwork` arrays to be
97+
! original `listsort.txt`, and the optional `work` and `iwork` arrays to be
9798
! used as scratch memory.
9899

99-
${t1}$, intent(inout) :: array(0:)
100+
${t1}$, intent(inout) :: array(0:)
100101
${ti}$, intent(out) :: index(0:)
101-
${t3}$, intent(out), optional :: work(0:)
102+
${t3}$, intent(out), optional :: work(0:)
102103
${ti}$, intent(out), optional :: iwork(0:)
103-
logical, intent(in), optional :: reverse
104+
logical, intent(in), optional :: reverse
104105

105-
${ti}$ :: array_size, i, stat
106106
${t2}$, allocatable :: buf(:)
107107
${ti}$, allocatable :: ibuf(:)
108+
integer(int_index) :: array_size, i, stat
108109

109-
if ( size(array, kind=int_index) > huge(1_${ki}$) ) then
110+
array_size = size(array, kind=int_index)
111+
112+
if ( array_size > huge(index)) then
110113
error stop "Too many entries for the kind of index."
111114
end if
112115

113-
array_size = size(array, kind=${ki}$)
114-
115-
if ( size(index, kind=${ki}$) < array_size ) then
116-
error stop "index array is too small."
116+
if ( array_size > size(index, kind=int_index) ) then
117+
error stop "Too many entries for the size of index."
117118
end if
118119

119120
do i = 0, array_size-1
120-
index(i) = i+1
121+
index(i) = int(i+1, kind=${ki}$)
121122
end do
122123

123124
if ( optval(reverse, .false.) ) then
@@ -126,11 +127,11 @@ contains
126127

127128
! If necessary allocate buffers to serve as scratch memory.
128129
if ( present(work) ) then
129-
if ( size(work, kind=${ki}$) < array_size/2 ) then
130+
if ( size(work, kind=int_index) < array_size/2 ) then
130131
error stop "work array is too small."
131132
end if
132133
if ( present(iwork) ) then
133-
if ( size(iwork, kind=${ki}$) < array_size/2 ) then
134+
if ( size(iwork, kind=int_index) < array_size/2 ) then
134135
error stop "iwork array is too small."
135136
endif
136137
call merge_sort( array, index, work, iwork )
@@ -148,7 +149,7 @@ contains
148149
#:endif
149150
if ( stat /= 0 ) error stop "Allocation of array buffer failed."
150151
if ( present(iwork) ) then
151-
if ( size(iwork, kind=${ki}$) < array_size/2 ) then
152+
if ( size(iwork, kind=int_index) < array_size/2 ) then
152153
error stop "iwork array is too small."
153154
endif
154155
call merge_sort( array, index, buf, iwork )
@@ -169,17 +170,17 @@ contains
169170
!! Returns the minimum length of a run from 32-63 so that N/MIN_RUN is
170171
!! less than or equal to a power of two. See
171172
!! https://svn.python.org/projects/python/trunk/Objects/listsort.txt
172-
${ti}$ :: min_run
173-
${ti}$, intent(in) :: n
173+
integer(int_index) :: min_run
174+
integer(int_index), intent(in) :: n
174175

175-
${ti}$ :: num, r
176+
integer(int_index) :: num, r
176177

177178
num = n
178-
r = 0_${ki}$
179+
r = 0_int_index
179180

180181
do while( num >= 64 )
181-
r = ior( r, iand(num, 1_${ki}$) )
182-
num = ishft(num, -1_${ki}$)
182+
r = ior( r, iand(num, 1_int_index) )
183+
num = ishft(num, -1_int_index)
183184
end do
184185
min_run = num + r
185186

@@ -189,13 +190,14 @@ contains
189190
pure subroutine insertion_sort( array, index )
190191
! Sorts `ARRAY` using an insertion sort, while maintaining consistency in
191192
! location of the indices in `INDEX` to the elements of `ARRAY`.
192-
${t1}$, intent(inout) :: array(0:)
193+
${t1}$, intent(inout) :: array(0:)
193194
${ti}$, intent(inout) :: index(0:)
194195

195-
${ti}$ :: i, j, key_index
196+
integer(int_index) :: i, j
197+
${ti}$ :: key_index
196198
${t3}$ :: key
197199

198-
do j=1, size(array, kind=${ki}$)-1
200+
do j=1, size(array, kind=int_index)-1
199201
key = array(j)
200202
key_index = index(j)
201203
i = j - 1
@@ -218,14 +220,13 @@ contains
218220
!
219221
! 1. len(-3) > len(-2) + len(-1)
220222
! 2. len(-2) > len(-1)
223+
integer(int_index) :: r
224+
type(run_type), intent(in), target :: runs(0:)
221225

222-
${ti}$ :: r
223-
type(run_type_${namei}$), intent(in), target :: runs(0:)
224-
225-
${ti}$ :: n
226+
integer(int_index) :: n
226227
logical :: test
227228

228-
n = size(runs, kind=${ki}$)
229+
n = size(runs, kind=int_index)
229230
test = .false.
230231
if (n >= 2) then
231232
if ( runs( n-1 ) % base == 0 .or. &
@@ -273,15 +274,16 @@ contains
273274
! Consistency of the indices in `index` with the elements of `array`
274275
! are maintained.
275276

276-
${t1}$, intent(inout) :: array(0:)
277+
${t1}$, intent(inout) :: array(0:)
277278
${ti}$, intent(inout) :: index(0:)
278279

279280
${t3}$ :: tmp
280-
${ti}$ :: i, tmp_index
281+
integer(int_index) :: i
282+
${ti}$ :: tmp_index
281283

282284
tmp = array(0)
283285
tmp_index = index(0)
284-
find_hole: do i=1, size(array, kind=${ki}$)-1
286+
find_hole: do i=1, size(array, kind=int_index)-1
285287
if ( array(i) >= tmp ) exit find_hole
286288
array(i-1) = array(i)
287289
index(i-1) = index(i)
@@ -313,16 +315,16 @@ contains
313315
! worst-case. Consistency of the indices in `index` with the elements of
314316
! `array` are maintained.
315317

316-
${t1}$, intent(inout) :: array(0:)
318+
${t1}$, intent(inout) :: array(0:)
317319
${ti}$, intent(inout) :: index(0:)
318-
${t3}$, intent(inout) :: buf(0:)
320+
${t3}$, intent(inout) :: buf(0:)
319321
${ti}$, intent(inout) :: ibuf(0:)
320322

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

325-
array_size = size(array, kind=${ki}$)
327+
array_size = size(array, kind=int_index)
326328

327329
! Very short runs are extended using insertion sort to span at least this
328330
! many elements. Slices of up to this length are sorted using insertion sort.
@@ -333,7 +335,6 @@ contains
333335
return
334336
end if
335337

336-
337338
! Following Rust sort, natural runs in `array` are identified by traversing
338339
! it backwards. By traversing it backward, merges more often go in the
339340
! opposite direction (forwards). According to developers of Rust sort,
@@ -370,7 +371,7 @@ contains
370371
end do Insert
371372
if ( start == 0 .and. finish == array_size - 1 ) return
372373

373-
runs(r_count) = run_type_${namei}$( base = start, &
374+
runs(r_count) = run_type( base = start, &
374375
len = finish - start + 1 )
375376
finish = start-1
376377
r_count = r_count + 1
@@ -383,12 +384,12 @@ contains
383384
left = runs( r + 1 )
384385
right = runs( r )
385386
call merge( array( left % base: &
386-
right % base + right % len - 1 ), &
387+
right % base + right % len - 1 ), &
387388
left % len, buf, &
388389
index( left % base: &
389390
right % base + right % len - 1 ), ibuf )
390391

391-
runs(r) = run_type_${namei}$( base = left % base, &
392+
runs(r) = run_type( base = left % base, &
392393
len = left % len + right % len )
393394
if ( r == r_count - 3 ) runs(r+1) = runs(r+2)
394395
r_count = r_count - 1
@@ -406,15 +407,15 @@ contains
406407
! using `BUF` as temporary storage, and stores the merged runs into
407408
! `ARRAY(0:)`. `MID` must be > 0, and < `SIZE(ARRAY)-1`. Buffer `BUF`
408409
! must be long enough to hold the shorter of the two runs.
409-
${t1}$, intent(inout) :: array(0:)
410-
${ti}$, intent(in) :: mid
411-
${t3}$, intent(inout) :: buf(0:)
410+
${t1}$, intent(inout) :: array(0:)
411+
integer(int_index), intent(in) :: mid
412+
${t3}$, intent(inout) :: buf(0:)
412413
${ti}$, intent(inout) :: index(0:)
413414
${ti}$, intent(inout) :: ibuf(0:)
414415

415-
${ti}$ :: array_len, i, j, k
416+
integer(int_index) :: array_len, i, j, k
416417

417-
array_len = size(array, kind=${ki}$)
418+
array_len = size(array, kind=int_index)
418419

419420
! Merge first copies the shorter run into `buf`. Then, depending on which
420421
! run was shorter, it traces the copied run and the longer run forwards
@@ -474,11 +475,12 @@ contains
474475
${t1}$, intent(inout) :: array(0:)
475476
${ti}$, intent(inout) :: index(0:)
476477

477-
${ti}$ :: itemp, lo, hi
478+
${ti}$ :: itemp
479+
integer(int_index) :: lo, hi
478480
${t3}$ :: temp
479481

480482
lo = 0
481-
hi = size( array, kind=${ki}$ ) - 1
483+
hi = size( array, kind=int_index ) - 1
482484
do while( lo < hi )
483485
temp = array(lo)
484486
array(lo) = array(hi)

0 commit comments

Comments
 (0)