Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

sort_index: use of only int_index iterators inside sort_index #848

Merged
merged 7 commits into from
Jul 9, 2024
Merged

sort_index: use of only int_index iterators inside sort_index #848

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
e7cab10
Split index and iterators in sort_index
jvdp1 Jul 9, 2024
6bf7785
sort_index: all iterators are now set to int_index
jvdp1 Jul 9, 2024
3037722
Rename run_type_default (removed from fypp processing)
jvdp1 Jul 9, 2024
5514f48
rename run_type_default to run_type
jvdp1 Jul 9, 2024
cdfa62c
Update src/stdlib_sorting_sort_index.fypp
jvdp1 Jul 9, 2024
0077952
fix tests on index array
jvdp1 Jul 9, 2024
3041d97
Only some formatting edits to keep consistency between sort_index and…
jvdp1 Jul 9, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 4 additions & 6 deletions src/stdlib_sorting.fypp
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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
Loading