Skip to content

Commit f26a47b

Browse files
jvdp1jvdp1
committed
sort: add fypp variable for code simplifications + fix typo
1 parent 30fda42 commit f26a47b

File tree

2 files changed

+4
-180
lines changed

2 files changed

+4
-180
lines changed

‎src/stdlib_sorting.fypp‎

Lines changed: 2 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
#:include "common.fypp"
2-
#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + STRING_KINDS_TYPES
2+
#:set IRS_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + STRING_KINDS_TYPES
33

44
!! Licensing:
55
!!
@@ -385,7 +385,7 @@ module stdlib_sorting
385385
!! The generic subroutine interface implementing the `SORT` algorithm, based
386386
!! on the `introsort` of David Musser.
387387

388-
#:for k1, t1 in IR_KINDS_TYPES
388+
#:for k1, t1 in IRS_KINDS_TYPES
389389
pure module subroutine ${k1}$_sort( array )
390390
!! Version: experimental
391391
!!
@@ -410,17 +410,6 @@ module stdlib_sorting
410410
character(len=*), intent(inout) :: array(0:)
411411
end subroutine char_sort
412412

413-
pure module subroutine string_sort( array )
414-
!! Version: experimental
415-
!!
416-
!! `string_sort( array )` sorts the input `ARRAY` of type `STRING_TYPE`
417-
!! using a hybrid sort based on the `introsort` of David Musser.
418-
!! The algorithm is of order O(N Ln(N)) for all inputs.
419-
!! Because it relies on `quicksort`, the coefficient of the O(N Ln(N))
420-
!! behavior is small for random data compared to other sorting algorithms.
421-
type(string_type), intent(inout) :: array(0:)
422-
end subroutine string_sort
423-
424413
end interface sort
425414

426415
interface sort_index

‎src/stdlib_sorting_sort.fypp‎

Lines changed: 2 additions & 167 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
#:include "common.fypp"
2-
#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES
2+
#:set IRS_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + STRING_KINDS_TYPES
33

44
!! Licensing:
55
!!
@@ -61,7 +61,7 @@ submodule(stdlib_sorting) stdlib_sorting_sort
6161
contains
6262

6363

64-
#:for k1, t1 in IR_KINDS_TYPES
64+
#:for k1, t1 in IRS_KINDS_TYPES
6565

6666
pure module subroutine ${k1}$_sort( array )
6767
! `${k1}$_sort( array )` sorts the input `ARRAY` of type `${t1}$`
@@ -398,169 +398,4 @@ contains
398398

399399
end subroutine char_sort
400400

401-
pure module subroutine string_sort( array )
402-
! `string_sort( array )` sorts the input `ARRAY` of type `STRING_TyPE`
403-
! using a hybrid sort based on the `introsort` of David Musser. As with
404-
! `introsort`, `string_sort( array )` is an unstable hybrid comparison
405-
! algorithm using `quicksort` for the main body of the sort tree,
406-
! supplemented by `insertion sort` for the outer brances, but if
407-
! `quicksort` is converging too slowly the algorithm resorts
408-
! to `heapsort`. The algorithm is of order O(N Ln(N)) for all inputs.
409-
! Because it relies on `quicksort`, the coefficient of the O(N Ln(N))
410-
! behavior is typically small compared to other sorting algorithms.
411-
412-
type(string_type), intent(inout) :: array(0:)
413-
414-
integer(int32) :: depth_limit
415-
416-
depth_limit = 2 * int( floor( log( real( size( array, kind=int64 ), &
417-
kind=dp) ) / log(2.0_dp) ), &
418-
kind=int32 )
419-
call introsort(array, depth_limit)
420-
421-
contains
422-
423-
pure recursive subroutine introsort( array, depth_limit )
424-
! It devolves to `insertionsort` if the remaining number of elements
425-
! is fewer than or equal to `INSERT_SIZE`, `heapsort` if the completion
426-
! of the `quicksort` is too slow as estimated from `DEPTH_LIMIT`,
427-
! otherwise sorting is done by a `quicksort`.
428-
type(string_type), intent(inout) :: array(0:)
429-
integer(int32), intent(in) :: depth_limit
430-
431-
integer(int_size), parameter :: insert_size = 16_int_size
432-
integer(int_size) :: index
433-
434-
if ( size(array, kind=int_size) <= insert_size ) then
435-
! May be best at the end of SORT processing the whole array
436-
! See Musser, D.R., “Introspective Sorting and Selection
437-
! Algorithms,” Software—Practice and Experience, Vol. 27(8),
438-
! 983–993 (August 1997).
439-
440-
call insertion_sort( array )
441-
else if ( depth_limit == 0 ) then
442-
call heap_sort( array )
443-
else
444-
call partition( array, index )
445-
call introsort( array(0:index-1), depth_limit-1 )
446-
call introsort( array(index+1:), depth_limit-1 )
447-
end if
448-
449-
end subroutine introsort
450-
451-
452-
pure subroutine partition( array, index )
453-
! quicksort partition using median of three.
454-
type(string_type), intent(inout) :: array(0:)
455-
integer(int_size), intent(out) :: index
456-
457-
integer(int_size) :: i, j
458-
type(string_type) :: u, v, w, x, y
459-
460-
! Determine median of three and exchange it with the end.
461-
u = array( 0 )
462-
v = array( size(array, kind=int_size)/2-1 )
463-
w = array( size(array, kind=int_size)-1 )
464-
if ( (u > v) .neqv. (u > w) ) then
465-
x = u
466-
y = array(0)
467-
array(0) = array( size( array, kind=int_size ) - 1 )
468-
array( size( array, kind=int_size ) - 1 ) = y
469-
else if ( (v < u) .neqv. (v < w) ) then
470-
x = v
471-
y = array(size( array, kind=int_size )/2-1)
472-
array( size( array, kind=int_size )/2-1 ) = &
473-
array( size( array, kind=int_size )-1 )
474-
array( size( array, kind=int_size )-1 ) = y
475-
else
476-
x = w
477-
end if
478-
! Partition the array.
479-
i = -1_int_size
480-
do j = 0_int_size, size(array, kind=int_size)-2
481-
if ( array(j) <= x ) then
482-
i = i + 1
483-
y = array(i)
484-
array(i) = array(j)
485-
array(j) = y
486-
end if
487-
end do
488-
y = array(i+1)
489-
array(i+1) = array(size(array, kind=int_size)-1)
490-
array(size(array, kind=int_size)-1) = y
491-
index = i + 1
492-
493-
end subroutine partition
494-
495-
pure subroutine insertion_sort( array )
496-
! Bog standard insertion sort.
497-
type(string_type), intent(inout) :: array(0:)
498-
499-
integer(int_size) :: i, j
500-
type(string_type) :: key
501-
502-
do j=1_int_size, size(array, kind=int_size)-1
503-
key = array(j)
504-
i = j - 1
505-
do while( i >= 0 )
506-
if ( array(i) <= key ) exit
507-
array(i+1) = array(i)
508-
i = i - 1
509-
end do
510-
array(i+1) = key
511-
end do
512-
513-
end subroutine insertion_sort
514-
515-
pure subroutine heap_sort( array )
516-
! A bog standard heap sort
517-
type(string_type), intent(inout) :: array(0:)
518-
519-
integer(int_size) :: i, heap_size
520-
type(string_type) :: y
521-
522-
heap_size = size( array, kind=int_size )
523-
! Build the max heap
524-
do i = (heap_size-2)/2_int_size, 0_int_size, -1_int_size
525-
call max_heapify( array, i, heap_size )
526-
end do
527-
do i = heap_size-1, 1_int_size, -1_int_size
528-
! Swap the first element with the current final element
529-
y = array(0)
530-
array(0) = array(i)
531-
array(i) = y
532-
! Sift down using max_heapify
533-
call max_heapify( array, 0_int_size, i )
534-
end do
535-
536-
end subroutine heap_sort
537-
538-
pure recursive subroutine max_heapify( array, i, heap_size )
539-
! Transform the array into a max heap
540-
type(string_type), intent(inout) :: array(0:)
541-
integer(int_size), intent(in) :: i, heap_size
542-
543-
integer(int_size) :: l, r, largest
544-
type(string_type) :: y
545-
546-
largest = i
547-
l = 2_int_size * i + 1_int_size
548-
r = l + 1_int_size
549-
if ( l < heap_size ) then
550-
if ( array(l) > array(largest) ) largest = l
551-
end if
552-
if ( r < heap_size ) then
553-
if ( array(r) > array(largest) ) largest = r
554-
end if
555-
if ( largest /= i ) then
556-
y = array(i)
557-
array(i) = array(largest)
558-
array(largest) = y
559-
call max_heapify( array, largest, heap_size )
560-
end if
561-
562-
end subroutine max_heapify
563-
564-
end subroutine string_sort
565-
566401
end submodule stdlib_sorting_sort

0 commit comments

Comments
 (0)