Skip to content

Add option for reverse sort in sort and ord_sort #2

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

Merged
merged 5 commits into from
May 29, 2021
Merged

Add option for reverse sort in sort and ord_sort #2

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
6e77312
add reverse to sort
jvdp1 May 28, 2021
40e084e
sort_sign: add reverse in ord_sort
jvdp1 May 28, 2021
940b6fc
sort_sign: add checks (error stop) to all tests
jvdp1 May 28, 2021
df150f2
sort_sign: remove module subroutines when inappropriate
jvdp1 May 28, 2021
41b8b8e
sort_sign: add init ltest
jvdp1 May 28, 2021
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
14 changes: 9 additions & 5 deletions src/stdlib_sorting.fypp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -336,24 +336,26 @@ module stdlib_sorting
!! non-decreasing data.

#:for k1, t1 in IRS_KINDS_TYPES
module subroutine ${k1}$_ord_sort( array, work )
module subroutine ${k1}$_ord_sort( array, work, reverse )
!! Version: experimental
!!
!! `${k1}$_ord_sort( array )` sorts the input `ARRAY` of type `${t1}$`
!! using a hybrid sort based on the `'Rust" sort` algorithm found in `slice.rs`
${t1}$, intent(inout) :: array(0:)
${t1}$, intent(out), optional :: work(0:)
logical, intent(in), optional :: reverse
end subroutine ${k1}$_ord_sort

#:endfor

module subroutine char_ord_sort( array, work )
module subroutine char_ord_sort( array, work, reverse )
!! Version: experimental
!!
!! `char_ord_sort( array )` sorts the input `ARRAY` of type `CHARACTER(*)`
!! using a hybrid sort based on the `'Rust" sort` algorithm found in `slice.rs`
character(len=*), intent(inout) :: array(0:)
character(len=len(array)), intent(out), optional :: work(0:)
logical, intent(in), optional :: reverse
end subroutine char_ord_sort

end interface ord_sort
Expand All @@ -365,20 +367,21 @@ module stdlib_sorting
!! on the `introsort` of David Musser.

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

#:endfor

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

end interface sort
Expand Down
87 changes: 67 additions & 20 deletions src/stdlib_sorting_ord_sort.fypp
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,11 @@
#:include "common.fypp"
#:set IRS_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + STRING_KINDS_TYPES

#:set SIGN_NAME = ["increase", "decrease"]
#:set SIGN_TYPE = [">", "<"]
#:set SIGN_OPP_TYPE = ["<", ">"]
#:set SIGN_NAME_TYPE = list(zip(SIGN_NAME, SIGN_TYPE, SIGN_OPP_TYPE))

!! Licensing:
!!
!! This file is subjec† both to the Fortran Standard Library license, and
Expand Down Expand Up @@ -57,8 +62,29 @@ submodule(stdlib_sorting) stdlib_sorting_ord_sort
contains

#:for k1, t1 in IRS_KINDS_TYPES
module subroutine ${k1}$_ord_sort( array, work, reverse )
${t1}$, intent(inout) :: array(0:)
${t1}$, intent(out), optional :: work(0:)
logical, intent(in), optional :: reverse

logical :: reverse_

reverse_ = .false.
if(present(reverse)) reverse_ = reverse

if (reverse_) then
call ${k1}$_decrease_ord_sort(array, work)
else
call ${k1}$_increase_ord_sort(array, work)
endif

module subroutine ${k1}$_ord_sort( array, work )
end subroutine ${k1}$_ord_sort
#:endfor

#:for sname, signt, signoppt in SIGN_NAME_TYPE
#:for k1, t1 in IRS_KINDS_TYPES

subroutine ${k1}$_${sname}$_ord_sort( array, work )
! A translation to Fortran 2008, of the `"Rust" sort` algorithm found in
! `slice.rs`
! https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs#L2159
Expand Down Expand Up @@ -92,7 +118,7 @@ contains
! Allocate a buffer to use as scratch memory.
array_size = size( array, kind=int_size )
allocate( buf(0:array_size/2-1), stat=stat )
if ( stat /= 0 ) error stop "${k1}$_ord_sort: Allocation of buffer failed."
if ( stat /= 0 ) error stop "${k1}$_${sname}$_ord_sort: Allocation of buffer failed."
call merge_sort( array, buf )
end if

Expand Down Expand Up @@ -129,7 +155,7 @@ contains
do j=1, size(array, kind=int_size)-1
key = array(j)
i = j - 1
do while( i >= 0 .and. array(i) > key )
do while( i >= 0 .and. array(i) ${signt}$ key )
array(i+1) = array(i)
i = i - 1
end do
Expand Down Expand Up @@ -204,7 +230,7 @@ contains

tmp = array(0)
find_hole: do i=1, size(array, kind=int_size)-1
if ( array(i) >= tmp ) exit find_hole
if ( array(i) ${signt}$= tmp ) exit find_hole
array(i-1) = array(i)
end do find_hole
array(i-1) = tmp
Expand Down Expand Up @@ -263,16 +289,16 @@ contains
start = finish
if ( start > 0 ) then
start = start - 1
if ( array(start+1) < array(start) ) then
if ( array(start+1) ${signoppt}$ array(start) ) then
Descending: do while ( start > 0 )
if ( array(start) >= array(start-1) ) &
if ( array(start) ${signt}$= array(start-1) ) &
exit Descending
start = start - 1
end do Descending
call reverse_segment( array(start:finish) )
else
Ascending: do while( start > 0 )
if ( array(start) < array(start-1) ) exit Ascending
if ( array(start) ${signoppt}$ array(start-1) ) exit Ascending
start = start - 1
end do Ascending
end if
Expand Down Expand Up @@ -338,7 +364,7 @@ contains
i = 0
j = mid
merge_lower: do k = 0, array_len-1
if ( buf(i) <= array(j) ) then
if ( buf(i) ${signoppt}$= array(j) ) then
array(k) = buf(i)
i = i + 1
if ( i >= mid ) exit merge_lower
Expand All @@ -356,7 +382,7 @@ contains
i = mid - 1
j = array_len - mid -1
merge_upper: do k = array_len-1, 0, -1
if ( buf(j) >= array(i) ) then
if ( buf(j) ${signt}$= array(i) ) then
array(k) = buf(j)
j = j - 1
if ( j < 0 ) exit merge_upper
Expand Down Expand Up @@ -392,12 +418,32 @@ contains

end subroutine reverse_segment

end subroutine ${k1}$_ord_sort
end subroutine ${k1}$_${sname}$_ord_sort

#:endfor
#:endfor

module subroutine char_ord_sort( array, work, reverse )
character(len=*), intent(inout) :: array(0:)
character(len=len(array)), intent(out), optional :: work(0:)
logical, intent(in), optional :: reverse

logical :: reverse_

reverse_ = .false.
if(present(reverse)) reverse_ = reverse

if (reverse_) then
call char_decrease_ord_sort(array, work)
else
call char_increase_ord_sort(array, work)
endif

end subroutine char_ord_sort

module subroutine char_ord_sort( array, work )

#:for sname, signt, signoppt in SIGN_NAME_TYPE
subroutine char_${sname}$_ord_sort( array, work )
! A translation to Fortran 2008, of the `"Rust" sort` algorithm found in
! `slice.rs`
! https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs#L2159
Expand Down Expand Up @@ -432,7 +478,7 @@ contains
array_size = size( array, kind=int_size )
allocate( character(len=len(array)) :: buf(0:array_size/2-1), &
stat=stat )
if ( stat /= 0 ) error stop "${k1}$_ord_sort: Allocation of buffer failed."
if ( stat /= 0 ) error stop "${k1}$_${sname}$_ord_sort: Allocation of buffer failed."
call merge_sort( array, buf )
end if

Expand Down Expand Up @@ -469,7 +515,7 @@ contains
do j=1, size(array, kind=int_size)-1
key = array(j)
i = j - 1
do while( i >= 0 .and. array(i) > key )
do while( i >= 0 .and. array(i) ${signt}$ key )
array(i+1) = array(i)
i = i - 1
end do
Expand Down Expand Up @@ -544,7 +590,7 @@ contains

tmp = array(0)
find_hole: do i=1, size(array, kind=int_size)-1
if ( array(i) >= tmp ) exit find_hole
if ( array(i) ${signt}$= tmp ) exit find_hole
array(i-1) = array(i)
end do find_hole
array(i-1) = tmp
Expand Down Expand Up @@ -603,16 +649,16 @@ contains
start = finish
if ( start > 0 ) then
start = start - 1
if ( array(start+1) < array(start) ) then
if ( array(start+1) ${signoppt}$ array(start) ) then
Descending: do while ( start > 0 )
if ( array(start) >= array(start-1) ) &
if ( array(start) ${signt}$= array(start-1) ) &
exit Descending
start = start - 1
end do Descending
call reverse_segment( array(start:finish) )
else
Ascending: do while( start > 0 )
if ( array(start) < array(start-1) ) exit Ascending
if ( array(start) ${signoppt}$ array(start-1) ) exit Ascending
start = start - 1
end do Ascending
end if
Expand Down Expand Up @@ -678,7 +724,7 @@ contains
i = 0
j = mid
merge_lower: do k = 0, array_len-1
if ( buf(i) <= array(j) ) then
if ( buf(i) ${signoppt}$= array(j) ) then
array(k) = buf(i)
i = i + 1
if ( i >= mid ) exit merge_lower
Expand All @@ -696,7 +742,7 @@ contains
i = mid - 1
j = array_len - mid -1
merge_upper: do k = array_len-1, 0, -1
if ( buf(j) >= array(i) ) then
if ( buf(j) ${signt}$= array(i) ) then
array(k) = buf(j)
j = j - 1
if ( j < 0 ) exit merge_upper
Expand Down Expand Up @@ -732,7 +778,8 @@ contains

end subroutine reverse_segment

end subroutine char_ord_sort
end subroutine char_${sname}$_ord_sort
#:endfor

end submodule stdlib_sorting_ord_sort

Loading