Skip to content

Commit 6e77312

Browse files
jvdp1jvdp1
committed
add reverse to sort
1 parent 8e59d2f commit 6e77312

File tree

3 files changed

+208
-45
lines changed

3 files changed

+208
-45
lines changed

‎src/stdlib_sorting.fypp‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -365,20 +365,21 @@ module stdlib_sorting
365365
!! on the `introsort` of David Musser.
366366

367367
#:for k1, t1 in IRS_KINDS_TYPES
368-
pure module subroutine ${k1}$_sort( array )
368+
pure module subroutine ${k1}$_sort( array, reverse )
369369
!! Version: experimental
370370
!!
371371
!! `${k1}$_sort( array )` sorts the input `ARRAY` of type `${t1}$`
372372
!! using a hybrid sort based on the `introsort` of David Musser.
373373
!! The algorithm is of order O(N Ln(N)) for all inputs.
374374
!! Because it relies on `quicksort`, the coefficient of the O(N Ln(N))
375375
!! behavior is small for random data compared to other sorting algorithms.
376-
${t1}$, intent(inout) :: array(0:)
376+
${t1}$, intent(inout) :: array(0:)
377+
logical, intent(in), optional :: reverse
377378
end subroutine ${k1}$_sort
378379

379380
#:endfor
380381

381-
pure module subroutine char_sort( array )
382+
pure module subroutine char_sort( array, reverse )
382383
!! Version: experimental
383384
!!
384385
!! `char_sort( array )` sorts the input `ARRAY` of type `CHARACTER(*)`
@@ -387,6 +388,7 @@ module stdlib_sorting
387388
!! Because it relies on `quicksort`, the coefficient of the O(N Ln(N))
388389
!! behavior is small for random data compared to other sorting algorithms.
389390
character(len=*), intent(inout) :: array(0:)
391+
logical, intent(in), optional :: reverse
390392
end subroutine char_sort
391393

392394
end interface sort

‎src/stdlib_sorting_sort.fypp‎

Lines changed: 58 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,11 @@
11
#:include "common.fypp"
22
#:set IRS_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + STRING_KINDS_TYPES
33

4+
#:set SIGN_NAME = ["increase", "decrease"]
5+
#:set SIGN_TYPE = [">", "<"]
6+
#:set SIGN_OPP_TYPE = ["<", ">"]
7+
#:set SIGN_NAME_TYPE = list(zip(SIGN_NAME, SIGN_TYPE, SIGN_OPP_TYPE))
8+
49
!! Licensing:
510
!!
611
!! This file is subjec† both to the Fortran Standard Library license, and
@@ -60,10 +65,28 @@ submodule(stdlib_sorting) stdlib_sorting_sort
6065

6166
contains
6267

68+
#:for k1, t1 in IRS_KINDS_TYPES
69+
pure module subroutine ${k1}$_sort( array, reverse )
70+
${t1}$, intent(inout) :: array(0:)
71+
logical, intent(in), optional :: reverse
72+
73+
logical :: reverse_
74+
75+
reverse_ = .false.
76+
if(present(reverse)) reverse_ = reverse
6377

78+
if(reverse_)then
79+
call ${k1}$_decrease_sort(array)
80+
else
81+
call ${k1}$_increase_sort(array)
82+
endif
83+
end subroutine ${k1}$_sort
84+
#:endfor
85+
86+
#:for sname, signt, signoppt in SIGN_NAME_TYPE
6487
#:for k1, t1 in IRS_KINDS_TYPES
6588

66-
pure module subroutine ${k1}$_sort( array )
89+
pure module subroutine ${k1}$_${sname}$_sort( array )
6790
! `${k1}$_sort( array )` sorts the input `ARRAY` of type `${t1}$`
6891
! using a hybrid sort based on the `introsort` of David Musser. As with
6992
! `introsort`, `${k1}$_sort( array )` is an unstable hybrid comparison
@@ -126,12 +149,12 @@ contains
126149
u = array( 0 )
127150
v = array( size(array, kind=int_size)/2-1 )
128151
w = array( size(array, kind=int_size)-1 )
129-
if ( (u > v) .neqv. (u > w) ) then
152+
if ( (u ${signt}$ v) .neqv. (u ${signt}$ w) ) then
130153
x = u
131154
y = array(0)
132155
array(0) = array( size( array, kind=int_size ) - 1 )
133156
array( size( array, kind=int_size ) - 1 ) = y
134-
else if ( (v < u) .neqv. (v < w) ) then
157+
else if ( (v ${signoppt}$ u) .neqv. (v ${signoppt}$ w) ) then
135158
x = v
136159
y = array(size( array, kind=int_size )/2-1)
137160
array( size( array, kind=int_size )/2-1 ) = &
@@ -143,7 +166,7 @@ contains
143166
! Partition the array.
144167
i = -1_int_size
145168
do j = 0_int_size, size(array, kind=int_size)-2
146-
if ( array(j) <= x ) then
169+
if ( array(j) ${signoppt}$= x ) then
147170
i = i + 1
148171
y = array(i)
149172
array(i) = array(j)
@@ -168,7 +191,7 @@ contains
168191
key = array(j)
169192
i = j - 1
170193
do while( i >= 0 )
171-
if ( array(i) <= key ) exit
194+
if ( array(i) ${signoppt}$= key ) exit
172195
array(i+1) = array(i)
173196
i = i - 1
174197
end do
@@ -212,10 +235,10 @@ contains
212235
l = 2_int_size * i + 1_int_size
213236
r = l + 1_int_size
214237
if ( l < heap_size ) then
215-
if ( array(l) > array(largest) ) largest = l
238+
if ( array(l) ${signt}$ array(largest) ) largest = l
216239
end if
217240
if ( r < heap_size ) then
218-
if ( array(r) > array(largest) ) largest = r
241+
if ( array(r) ${signt}$ array(largest) ) largest = r
219242
end if
220243
if ( largest /= i ) then
221244
y = array(i)
@@ -226,14 +249,32 @@ contains
226249

227250
end subroutine max_heapify
228251

229-
end subroutine ${k1}$_sort
252+
end subroutine ${k1}$_${sname}$_sort
230253

231254
#:endfor
255+
#:endfor
256+
232257

258+
pure module subroutine char_sort( array, reverse )
259+
character(len=*), intent(inout) :: array(0:)
260+
logical, intent(in), optional :: reverse
233261

262+
logical :: reverse_
234263

264+
reverse_ = .false.
265+
if(present(reverse)) reverse_ = reverse
266+
267+
if(reverse_)then
268+
call char_decrease_sort(array)
269+
else
270+
call char_increase_sort(array)
271+
endif
272+
end subroutine char_sort
235273

236-
pure module subroutine char_sort( array )
274+
275+
276+
#:for sname, signt, signoppt in SIGN_NAME_TYPE
277+
pure module subroutine char_${sname}$_sort( array )
237278
! `char_sort( array )` sorts the input `ARRAY` of type `CHARACTER(*)`
238279
! using a hybrid sort based on the `introsort` of David Musser. As with
239280
! `introsort`, `char_sort( array )` is an unstable hybrid comparison
@@ -296,12 +337,12 @@ contains
296337
u = array( 0 )
297338
v = array( size(array, kind=int_size)/2-1 )
298339
w = array( size(array, kind=int_size)-1 )
299-
if ( (u > v) .neqv. (u > w) ) then
340+
if ( (u ${signt}$ v) .neqv. (u ${signt}$ w) ) then
300341
x = u
301342
y = array(0)
302343
array(0) = array( size( array, kind=int_size ) - 1 )
303344
array( size( array, kind=int_size ) - 1 ) = y
304-
else if ( (v < u) .neqv. (v < w) ) then
345+
else if ( (v ${signoppt}$ u) .neqv. (v ${signoppt}$ w) ) then
305346
x = v
306347
y = array(size( array, kind=int_size )/2-1)
307348
array( size( array, kind=int_size )/2-1 ) = &
@@ -313,7 +354,7 @@ contains
313354
! Partition the array.
314355
i = -1_int_size
315356
do j = 0_int_size, size(array, kind=int_size)-2
316-
if ( array(j) <= x ) then
357+
if ( array(j) ${signoppt}$= x ) then
317358
i = i + 1
318359
y = array(i)
319360
array(i) = array(j)
@@ -338,7 +379,7 @@ contains
338379
key = array(j)
339380
i = j - 1
340381
do while( i >= 0 )
341-
if ( array(i) <= key ) exit
382+
if ( array(i) ${signoppt}$= key ) exit
342383
array(i+1) = array(i)
343384
i = i - 1
344385
end do
@@ -382,10 +423,10 @@ contains
382423
l = 2_int_size * i + 1_int_size
383424
r = l + 1_int_size
384425
if ( l < heap_size ) then
385-
if ( array(l) > array(largest) ) largest = l
426+
if ( array(l) ${signt}$ array(largest) ) largest = l
386427
end if
387428
if ( r < heap_size ) then
388-
if ( array(r) > array(largest) ) largest = r
429+
if ( array(r) ${signt}$ array(largest) ) largest = r
389430
end if
390431
if ( largest /= i ) then
391432
y = array(i)
@@ -396,6 +437,7 @@ contains
396437

397438
end subroutine max_heapify
398439

399-
end subroutine char_sort
440+
end subroutine char_${sname}$_sort
441+
#:endfor
400442

401443
end submodule stdlib_sorting_sort

0 commit comments

Comments
 (0)