diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index 76f1a174f..e0bb93827 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -151,16 +151,14 @@ module stdlib_sorting max_merge_stack = int( ceiling( log( 2._dp**64 ) / & log(1.6180339887_dp) ) ) -#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME - type run_type_${namei}$ + type run_type !! Version: experimental !! !! Used to pass state around in a stack among helper functions for the !! `ORD_SORT` and `SORT_INDEX` algorithms - ${ti}$ :: base = 0 - ${ti}$ :: len = 0 - end type run_type_${namei}$ -#:endfor + integer(int_index) :: base = 0 + integer(int_index) :: len = 0 + end type run_type public ord_sort !! Version: experimental diff --git a/src/stdlib_sorting_ord_sort.fypp b/src/stdlib_sorting_ord_sort.fypp index b648cbfed..b96ea295a 100644 --- a/src/stdlib_sorting_ord_sort.fypp +++ b/src/stdlib_sorting_ord_sort.fypp @@ -118,9 +118,9 @@ contains array_size = size( array, kind=int_index ) if ( present(work) ) then - if ( size( work, kind=int_index) < array_size/2 ) then + if ( size(work, kind=int_index) < array_size/2 ) then error stop "${name1}$_${sname}$_ord_sort: work array is too small." - endif + end if ! Use the work array as scratch memory call merge_sort( array, work ) else @@ -186,7 +186,7 @@ contains ! 1. len(-3) > len(-2) + len(-1) ! 2. len(-2) > len(-1) integer(int_index) :: r - type(run_type_default), intent(in), target :: runs(0:) + type(run_type), intent(in), target :: runs(0:) integer(int_index) :: n logical :: test @@ -277,7 +277,7 @@ contains integer(int_index) :: array_size, finish, min_run, r, r_count, & start - type(run_type_default) :: runs(0:max_merge_stack-1), left, right + type(run_type) :: runs(0:max_merge_stack-1), left, right array_size = size(array, kind=int_index) @@ -326,7 +326,7 @@ contains end do Insert if ( start == 0 .and. finish == array_size - 1 ) return - runs(r_count) = run_type_default( base = start, & + runs(r_count) = run_type( base = start, & len = finish - start + 1 ) finish = start-1 r_count = r_count + 1 @@ -342,7 +342,7 @@ contains right % base + right % len - 1 ), & left % len, buf ) - runs(r) = run_type_default( base = left % base, & + runs(r) = run_type( base = left % base, & len = left % len + right % len ) if ( r == r_count - 3 ) runs(r+1) = runs(r+2) r_count = r_count - 1 diff --git a/src/stdlib_sorting_sort_index.fypp b/src/stdlib_sorting_sort_index.fypp index bd926f7d9..cc2afe9cf 100644 --- a/src/stdlib_sorting_sort_index.fypp +++ b/src/stdlib_sorting_sort_index.fypp @@ -80,44 +80,45 @@ contains ! a non-increasing sort. The logic of the determination of indexing largely ! follows the `"Rust" sort` found in `slice.rs`: ! https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs#L2159 -! The Rust version is a simplification of the Timsort algorithm described -! in https://svn.python.org/projects/python/trunk/Objects/listsort.txt, as +! The Rust version in turn is a simplification of the Timsort algorithm +! described in +! https://svn.python.org/projects/python/trunk/Objects/listsort.txt, as ! it drops both the use of 'galloping' to identify bounds of regions to be ! sorted and the estimation of the optimal `run size`. However it remains ! a hybrid sorting algorithm combining an iterative Merge sort controlled ! by a stack of `RUNS` identified by regions of uniformly decreasing or -! non-decreasing sequences that may be expanded to a minimum run size, with -! an insertion sort. +! non-decreasing sequences that may be expanded to a minimum run size and +! initially processed by an insertion sort. ! ! Note the Fortran implementation simplifies the logic as it only has to ! deal with Fortran arrays of intrinsic types and not the full generality ! of Rust's arrays and lists for arbitrary types. It also adds the ! estimation of the optimal `run size` as suggested in Tim Peters' -! original listsort.txt, and the optional `work` and `iwork` arrays to be +! original `listsort.txt`, and the optional `work` and `iwork` arrays to be ! used as scratch memory. - ${t1}$, intent(inout) :: array(0:) + ${t1}$, intent(inout) :: array(0:) ${ti}$, intent(out) :: index(0:) - ${t3}$, intent(out), optional :: work(0:) + ${t3}$, intent(out), optional :: work(0:) ${ti}$, intent(out), optional :: iwork(0:) - logical, intent(in), optional :: reverse + logical, intent(in), optional :: reverse - ${ti}$ :: array_size, i, stat ${t2}$, allocatable :: buf(:) ${ti}$, allocatable :: ibuf(:) + integer(int_index) :: array_size, i, stat - if ( size(array, kind=int_index) > huge(1_${ki}$) ) then + array_size = size(array, kind=int_index) + + if ( array_size > huge(index)) then error stop "Too many entries for the kind of index." end if - array_size = size(array, kind=${ki}$) - - if ( size(index, kind=${ki}$) < array_size ) then - error stop "index array is too small." + if ( array_size > size(index, kind=int_index) ) then + error stop "Too many entries for the size of index." end if do i = 0, array_size-1 - index(i) = i+1 + index(i) = int(i+1, kind=${ki}$) end do if ( optval(reverse, .false.) ) then @@ -126,11 +127,11 @@ contains ! If necessary allocate buffers to serve as scratch memory. if ( present(work) ) then - if ( size(work, kind=${ki}$) < array_size/2 ) then + if ( size(work, kind=int_index) < array_size/2 ) then error stop "work array is too small." end if if ( present(iwork) ) then - if ( size(iwork, kind=${ki}$) < array_size/2 ) then + if ( size(iwork, kind=int_index) < array_size/2 ) then error stop "iwork array is too small." endif call merge_sort( array, index, work, iwork ) @@ -148,7 +149,7 @@ contains #:endif if ( stat /= 0 ) error stop "Allocation of array buffer failed." if ( present(iwork) ) then - if ( size(iwork, kind=${ki}$) < array_size/2 ) then + if ( size(iwork, kind=int_index) < array_size/2 ) then error stop "iwork array is too small." endif call merge_sort( array, index, buf, iwork ) @@ -169,17 +170,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 - ${ti}$ :: min_run - ${ti}$, intent(in) :: n + integer(int_index) :: min_run + integer(int_index), intent(in) :: n - ${ti}$ :: num, r + integer(int_index) :: num, r num = n - r = 0_${ki}$ + r = 0_int_index do while( num >= 64 ) - r = ior( r, iand(num, 1_${ki}$) ) - num = ishft(num, -1_${ki}$) + r = ior( r, iand(num, 1_int_index) ) + num = ishft(num, -1_int_index) end do min_run = num + r @@ -189,13 +190,14 @@ contains pure subroutine insertion_sort( array, index ) ! 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:) + ${t1}$, intent(inout) :: array(0:) ${ti}$, intent(inout) :: index(0:) - ${ti}$ :: i, j, key_index + integer(int_index) :: i, j + ${ti}$ :: key_index ${t3}$ :: key - do j=1, size(array, kind=${ki}$)-1 + do j=1, size(array, kind=int_index)-1 key = array(j) key_index = index(j) i = j - 1 @@ -218,14 +220,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:) - - ${ti}$ :: n + integer(int_index) :: n logical :: test - n = size(runs, kind=${ki}$) + n = size(runs, kind=int_index) test = .false. if (n >= 2) then if ( runs( n-1 ) % base == 0 .or. & @@ -273,15 +274,16 @@ contains ! Consistency of the indices in `index` with the elements of `array` ! are maintained. - ${t1}$, intent(inout) :: array(0:) + ${t1}$, intent(inout) :: array(0:) ${ti}$, intent(inout) :: index(0:) ${t3}$ :: tmp - ${ti}$ :: i, tmp_index + integer(int_index) :: i + ${ti}$ :: tmp_index tmp = array(0) tmp_index = index(0) - find_hole: do i=1, size(array, kind=${ki}$)-1 + find_hole: do i=1, size(array, kind=int_index)-1 if ( array(i) >= tmp ) exit find_hole array(i-1) = array(i) index(i-1) = index(i) @@ -313,16 +315,16 @@ contains ! worst-case. Consistency of the indices in `index` with the elements of ! `array` are maintained. - ${t1}$, intent(inout) :: array(0:) + ${t1}$, intent(inout) :: array(0:) ${ti}$, intent(inout) :: index(0:) - ${t3}$, intent(inout) :: buf(0:) + ${t3}$, intent(inout) :: buf(0:) ${ti}$, intent(inout) :: ibuf(0:) - ${ti}$ :: array_size, finish, min_run, r, r_count, & + integer(int_index) :: array_size, finish, min_run, r, r_count, & start - type(run_type_${namei}$) :: runs(0:max_merge_stack-1), left, right + type(run_type) :: runs(0:max_merge_stack-1), left, right - array_size = size(array, kind=${ki}$) + array_size = size(array, kind=int_index) ! 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. @@ -333,7 +335,6 @@ contains return end if - ! Following Rust sort, natural runs in `array` are identified by traversing ! it backwards. By traversing it backward, merges more often go in the ! opposite direction (forwards). According to developers of Rust sort, @@ -370,7 +371,7 @@ contains end do Insert if ( start == 0 .and. finish == array_size - 1 ) return - runs(r_count) = run_type_${namei}$( base = start, & + runs(r_count) = run_type( base = start, & len = finish - start + 1 ) finish = start-1 r_count = r_count + 1 @@ -383,12 +384,12 @@ contains left = runs( r + 1 ) right = runs( r ) call merge( array( left % base: & - right % base + right % len - 1 ), & + right % base + right % len - 1 ), & left % len, buf, & index( left % base: & right % base + right % len - 1 ), ibuf ) - runs(r) = run_type_${namei}$( base = left % base, & + runs(r) = run_type( base = left % base, & len = left % len + right % len ) if ( r == r_count - 3 ) runs(r+1) = runs(r+2) r_count = r_count - 1 @@ -406,15 +407,15 @@ contains ! using `BUF` as temporary storage, and stores the merged runs into ! `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:) - ${ti}$, intent(in) :: mid - ${t3}$, intent(inout) :: buf(0:) + ${t1}$, intent(inout) :: array(0:) + integer(int_index), intent(in) :: mid + ${t3}$, intent(inout) :: buf(0:) ${ti}$, intent(inout) :: index(0:) ${ti}$, intent(inout) :: ibuf(0:) - ${ti}$ :: array_len, i, j, k + integer(int_index) :: array_len, i, j, k - array_len = size(array, kind=${ki}$) + array_len = size(array, kind=int_index) ! 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 @@ -474,11 +475,12 @@ contains ${t1}$, intent(inout) :: array(0:) ${ti}$, intent(inout) :: index(0:) - ${ti}$ :: itemp, lo, hi + ${ti}$ :: itemp + integer(int_index) :: lo, hi ${t3}$ :: temp lo = 0 - hi = size( array, kind=${ki}$ ) - 1 + hi = size( array, kind=int_index ) - 1 do while( lo < hi ) temp = array(lo) array(lo) = array(hi)