Skip to content

Commit 230a85c

Browse files
jvdp1jvdp1
committed
sort_index: call of sort_adj
1 parent 5f79d2e commit 230a85c

File tree

4 files changed

+147
-4
lines changed

4 files changed

+147
-4
lines changed

‎src/CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ set(fppFiles
3838
stdlib_sorting.fypp
3939
stdlib_sorting_ord_sort.fypp
4040
stdlib_sorting_sort.fypp
41+
stdlib_sorting_sort_adj.fypp
4142
stdlib_sorting_sort_index.fypp
4243
stdlib_specialfunctions_gamma.fypp
4344
stdlib_stats.fypp

‎src/stdlib_sorting.fypp

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -505,6 +505,44 @@ module stdlib_sorting
505505

506506
end interface sort
507507

508+
509+
interface sort_adj
510+
!! Version: experimental
511+
!!
512+
!! The generic subroutine interface implementing the `SORT_ADJ` algorithm,
513+
!! based on the `"Rust" sort` algorithm found in `slice.rs`
514+
!! https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs#L2159
515+
!! but modified to return an array of indices that would provide a stable
516+
!! sort of the rank one `ARRAY` input.
517+
!! ([Specification](../page/specs/stdlib_sorting.html#sort_adj-creates-an-array-of-sorting-indices-for-an-input-array-while-also-sorting-the-array))
518+
!!
519+
!! The indices by default correspond to a
520+
!! non-decreasing sort, but if the optional argument `REVERSE` is present
521+
!! with a value of `.TRUE.` the indices correspond to a non-increasing sort.
522+
523+
#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME
524+
#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME
525+
module subroutine ${name1}$_sort_adj_${namei}$( array, index, work, iwork, &
526+
reverse )
527+
!! Version: experimental
528+
!!
529+
!! `${name1}$_sort_adj_${namei}$( array, index[, work, iwork, reverse] )` sorts
530+
!! an input `ARRAY` of type `${t1}$`
531+
!! using a hybrid sort based on the `"Rust" sort` algorithm found in `slice.rs`
532+
!! and returns the sorted `ARRAY` and an array `INDEX` of indices in the
533+
!! order that would sort the input `ARRAY` in the desired direction.
534+
${t1}$, intent(inout) :: array(0:)
535+
${ti}$, intent(out) :: index(0:)
536+
${t2}$, intent(out), optional :: work(0:)
537+
${ti}$, intent(out), optional :: iwork(0:)
538+
logical, intent(in), optional :: reverse
539+
end subroutine ${name1}$_sort_adj_${namei}$
540+
541+
#:endfor
542+
#:endfor
543+
544+
end interface sort_adj
545+
508546
interface sort_index
509547
!! Version: experimental
510548
!!

‎src/stdlib_sorting_sort_adj.fypp

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -62,7 +62,7 @@
6262
!! of modified versions of the code in the Fortran Standard Library under
6363
!! the MIT license.
6464

65-
submodule(stdlib_sorting) stdlib_sorting_sort_index
65+
submodule(stdlib_sorting) stdlib_sorting_sort_adj
6666

6767
implicit none
6868

@@ -71,7 +71,7 @@ contains
7171
#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME
7272
#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME
7373

74-
module subroutine ${name1}$_sort_index_${namei}$( array, index, work, iwork, reverse )
74+
module subroutine ${name1}$_sort_adj_${namei}$( array, index, work, iwork, reverse )
7575
! A modification of `${name1}$_ord_sort` to return an array of indices that
7676
! would perform a stable sort of the `ARRAY` as input, and also sort `ARRAY`
7777
! as desired. The indices by default
@@ -494,9 +494,9 @@ contains
494494

495495
end subroutine reverse_segment
496496

497-
end subroutine ${name1}$_sort_index_${namei}$
497+
end subroutine ${name1}$_sort_adj_${namei}$
498498

499499
#:endfor
500500
#:endfor
501501

502-
end submodule stdlib_sorting_sort_index
502+
end submodule stdlib_sorting_sort_adj

‎src/stdlib_sorting_sort_index.fypp

Lines changed: 104 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,104 @@
1+
#:include "common.fypp"
2+
#:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_TYPES, INT_KINDS))
3+
#:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS))
4+
#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_TYPES, STRING_KINDS))
5+
#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=:)"], ["character(len=len(array))"], ["char"]))
6+
#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_TYPES, BITSET_KINDS))
7+
8+
#:set INT_INDEX_TYPES_ALT_NAME = list(zip(["int_index", "int_index_low"], ["integer(int_index)", "integer(int_index_low)"], ["default", "low"]))
9+
10+
#! For better code reuse in fypp, make lists that contain the input types,
11+
#! with each having output types and a separate name prefix for subroutines
12+
#! This approach allows us to have the same code for all input types.
13+
#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME &
14+
& + BITSET_TYPES_ALT_NAME
15+
16+
!! Licensing:
17+
!!
18+
!! This file is subjec† both to the Fortran Standard Library license, and
19+
!! to additional licensing requirements as it contains translations of
20+
!! other software.
21+
!!
22+
!! The Fortran Standard Library, including this file, is distributed under
23+
!! the MIT license that should be included with the library's distribution.
24+
!!
25+
!! Copyright (c) 2021 Fortran stdlib developers
26+
!!
27+
!! Permission is hereby granted, free of charge, to any person obtaining a
28+
!! copy of this software and associated documentation files (the
29+
!! "Software"), to deal in the Software without restriction, including
30+
!! without limitation the rights to use, copy, modify, merge, publish,
31+
!! distribute, sublicense, and/or sellcopies of the Software, and to permit
32+
!! persons to whom the Software is furnished to do so, subject to the
33+
!! following conditions:
34+
!!
35+
!! The above copyright notice and this permission notice shall be included
36+
!! in all copies or substantial portions of the Software.
37+
!!
38+
!! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
39+
!! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
40+
!! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
41+
!! IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
42+
!! CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
43+
!! TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
44+
!! SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
45+
!!
46+
!! The generic subroutine, `SORT_INDEX`, is substantially a translation to
47+
!! Fortran 2008 of the `"Rust" sort` sorting routines in
48+
!! [`slice.rs`](https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs)
49+
!! The `rust sort` implementation is distributed with the header:
50+
!!
51+
!! Copyright 2012-2015 The Rust Project Developers. See the COPYRIGHT
52+
!! file at the top-level directory of this distribution and at
53+
!! http://rust-lang.org/COPYRIGHT.
54+
!!
55+
!! Licensed under the Apache License, Version 2.0 <LICENSE-APACHE or
56+
!! http://www.apache.org/licenses/LICENSE-2.0> or the MIT license
57+
!! <LICENSE-MIT or http://opensource.org/licenses/MIT>, at your
58+
!! option. This file may not be copied, modified, or distributed
59+
!! except according to those terms.
60+
!!
61+
!! so the license for the original`slice.rs` code is compatible with the use
62+
!! of modified versions of the code in the Fortran Standard Library under
63+
!! the MIT license.
64+
65+
submodule(stdlib_sorting) stdlib_sorting_sort_index
66+
67+
implicit none
68+
69+
contains
70+
71+
#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME
72+
#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME
73+
74+
module subroutine ${name1}$_sort_index_${namei}$( array, index, work, iwork, reverse )
75+
${t1}$, intent(inout) :: array(0:)
76+
${ti}$, intent(out) :: index(0:)
77+
${t3}$, intent(out), optional :: work(0:)
78+
${ti}$, intent(out), optional :: iwork(0:)
79+
logical, intent(in), optional :: reverse
80+
81+
integer(int_index) :: array_size, i, stat
82+
83+
array_size = size(array, kind=int_index)
84+
85+
if ( array_size > huge(index)) then
86+
error stop "Too many entries for the kind of index."
87+
end if
88+
89+
if ( array_size > size(index, kind=int_index) ) then
90+
error stop "Too many entries for the size of index."
91+
end if
92+
93+
do i = 0, array_size-1
94+
index(i) = int(i+1, kind=${ki}$)
95+
end do
96+
97+
call sort_adj(array, index, work, iwork, reverse)
98+
99+
end subroutine ${name1}$_sort_index_${namei}$
100+
101+
#:endfor
102+
#:endfor
103+
104+
end submodule stdlib_sorting_sort_index

0 commit comments

Comments
 (0)