Skip to content

Commit

Permalink
Merge pull request #848 from jvdp1/split_sort_index
Browse files Browse the repository at this point in the history 
`sort_index`: use of only `int_index` iterators inside `sort_index`
  • Loading branch information
@jvdp1
jvdp1 authored Jul 9, 2024
2 parents 59509b1 + 3041d97 commit 91dcc50
Show file tree
Hide file tree
Showing 3 changed files with 63 additions and 63 deletions.
10 changes: 4 additions & 6 deletions src/stdlib_sorting.fypp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
12 changes: 6 additions & 6 deletions src/stdlib_sorting_ord_sort.fypp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
104 changes: 53 additions & 51 deletions src/stdlib_sorting_sort_index.fypp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 )
Expand All @@ -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 )
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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. &
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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.
Expand All @@ -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,
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand Down

0 comments on commit 91dcc50

Please sign in to comment.