Skip to content

Commit 53eaa12

Browse files
demoncoder-cryptodemoncoder-crypto
committed
Refactor unique function to resolve circular dependency
1 parent 02ecfc6 commit 53eaa12

File tree

3 files changed

+95
-139
lines changed

3 files changed

+95
-139
lines changed

‎src/stdlib_sorting.fypp‎

Lines changed: 48 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_KINDS))
66
#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=len(array))"], ["char"]))
77
#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_KINDS))
8+
#:set COMPLEX_TYPES_ALT_NAME = list(zip(CMPLX_TYPES, CMPLX_TYPES, CMPLX_KINDS))
89

910
#:set INT_INDEX_TYPES_ALT_NAME = list(zip(["int_index", "int_index_low"], ["integer(int_index)", "integer(int_index_low)"], ["default", "low"]))
1011

@@ -13,6 +14,7 @@
1314
#! This approach allows us to have the same code for all input types.
1415
#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME &
1516
& + BITSET_TYPES_ALT_NAME
17+
#:set IRSC_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME + COMPLEX_TYPES_ALT_NAME
1618

1719
!! Licensing:
1820
!!
@@ -136,15 +138,12 @@ module stdlib_sorting
136138
use stdlib_bitsets, only: bitset_64, bitset_large, &
137139
assignment(=), operator(>), operator(>=), operator(<), operator(<=)
138140

139-
use stdlib_sorting_unique, only: unique
140-
141141
implicit none
142142
private
143143

144144
integer, parameter, public :: int_index = int64 !! Integer kind for indexing
145145
integer, parameter, public :: int_index_low = int32 !! Integer kind for indexing using less than `huge(1_int32)` values
146146

147-
public :: unique
148147

149148
! Constants for use by tim_sort
150149
integer, parameter :: &
@@ -163,6 +162,52 @@ module stdlib_sorting
163162
integer(int_index) :: len = 0
164163
end type run_type
165164

165+
interface unique
166+
!! Version: experimental
167+
!!
168+
!! The generic function implementing the `unique` algorithm to return
169+
!! a new array containing only the unique values from the input array.
170+
!! Its use has the syntax:
171+
!!
172+
!! result = unique(array[, sorted])
173+
!!
174+
!! with the arguments:
175+
!!
176+
!! * array: the rank 1 array from which to extract unique values. It is an `intent(in)`
177+
!! argument of any of the types `integer(int8)`, `integer(int16)`,
178+
!! `integer(int32)`, `integer(int64)`, `real(real32)`, `real(real64)`,
179+
!! `real(real128)`, `complex(real32)`, `complex(real64)`, `complex(real128)`,
180+
!! `character(*)`, or `type(string_type)`.
181+
!!
182+
!! * sorted (optional): shall be a scalar of type default logical. It
183+
!! is an `intent(in)` argument that indicates whether the input array
184+
!! is already sorted. If present with value `.true.`, the function will
185+
!! skip sorting the input, which can save computational time. Default is `.false.`.
186+
!! The output will always have duplicate elements removed and will be in
187+
!! the same order as the input (if sorted) or in sorted order (if not already sorted).
188+
!!
189+
!!#### Example
190+
!!
191+
!!```fortran
192+
!! ...
193+
!! ! Extract unique values from an array
194+
!! integer :: x(5) = [1, 2, 3, 3, 4]
195+
!! integer, allocatable :: y(:)
196+
!!
197+
!! y = unique(x) ! y will be [1, 2, 3, 4]
198+
!!
199+
!! ! Use with optional sorted argument when input is already sorted
200+
!! integer :: z(8) = [1, 2, 2, 3, 5, 5, 7, 8]
201+
!! integer, allocatable :: u(:)
202+
!!
203+
!! u = unique(z, sorted=.true.) ! Skip sorting, u will be [1, 2, 3, 5, 7, 8]
204+
!! ...
205+
!!```
206+
#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME
207+
module procedure ${name1}$_unique
208+
#:endfor
209+
end interface unique
210+
166211
public ord_sort
167212
!! Version: experimental
168213
!!

‎src/stdlib_sorting_unique.fypp‎

Lines changed: 47 additions & 69 deletions
Original file line numberDiff line numberDiff line change
@@ -39,17 +39,7 @@
3939
!! TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
4040
!! SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
4141

42-
module stdlib_sorting_unique
43-
!! This module implements overloaded unique functions that can be used to extract
44-
!! unique values from arrays of various types: integer, real, complex, character,
45-
!! and string_type.
46-
!! ([Specification](../page/specs/stdlib_sorting_unique.html))
47-
!!
48-
!! By default, the output array is not sorted, but this can be changed
49-
!! with the optional parameter `sorted`. When sorted, the output will
50-
!! be in order of increasing value. All functions have worst case
51-
!! run time performance of `O(N Ln(N))` due to the sorting step.
52-
42+
submodule (stdlib_sorting) stdlib_sorting_unique
5343
use stdlib_kinds, only: &
5444
int8, &
5545
int16, &
@@ -60,74 +50,62 @@ module stdlib_sorting_unique
6050
xdp, &
6151
qp, &
6252
lk
63-
64-
use stdlib_sorting, only: sort
65-
6653
use stdlib_optval, only: optval
67-
6854
use stdlib_string_type, only: string_type, assignment(=), operator(==)
69-
7055
implicit none
71-
private
7256

73-
public :: unique
74-
75-
interface unique
76-
!! Version: experimental
77-
!!
78-
!! The generic function implementing the `unique` algorithm to return
79-
!! a new array containing only the unique values from the input array.
80-
!! Its use has the syntax:
81-
!!
82-
!! result = unique(array[, sorted])
83-
!!
84-
!! with the arguments:
85-
!!
86-
!! * array: the rank 1 array from which to extract unique values. It is an `intent(in)`
87-
!! argument of any of the types `integer(int8)`, `integer(int16)`,
88-
!! `integer(int32)`, `integer(int64)`, `real(real32)`, `real(real64)`,
89-
!! `real(real128)`, `complex(real32)`, `complex(real64)`, `complex(real128)`,
90-
!! `character(*)`, or `type(string_type)`.
91-
!!
92-
!! * sorted (optional): shall be a scalar of type default logical. It
93-
!! is an `intent(in)` argument. If present with a value of `.true.` then
94-
!! the returned array will be sorted in order of non-decreasing values.
95-
!! Otherwise the order is unspecified, but generally reflects the order of
96-
!! first appearance of each unique value in the input array.
97-
!!
98-
!!#### Example
99-
!!
100-
!!```fortran
101-
!! ...
102-
!! ! Extract unique values from an array
103-
!! integer :: x(5) = [1, 2, 3, 3, 4]
104-
!! integer, allocatable :: y(:)
105-
!!
106-
!! y = unique(x) ! y will be [1, 2, 3, 4]
107-
!!
108-
!! ! Use with optional sorted argument
109-
!! real :: a(8) = [3.1, 2.5, 7.2, 3.1, 2.5, 8.0, 7.2, 9.5]
110-
!! real, allocatable :: b(:)
111-
!!
112-
!! b = unique(a, sorted=.true.) ! b will be [2.5, 3.1, 7.2, 8.0, 9.5]
113-
!! ...
114-
!!```
57+
contains
11558

11659
#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME
117-
pure module function ${name1}$_unique(array, sorted) result(unique_values)
60+
pure module procedure ${name1}$_unique(array, sorted) result(unique_values)
11861
!! Version: experimental
11962
!!
12063
!! `${name1}$_unique(array, sorted)` returns an array of unique values
12164
!! from the input `array` of type `${t1}$`. If the optional argument `sorted`
122-
!! is present with value `.true.`, the returned array will be sorted.
123-
${t1}$, intent(in) :: array(:)
124-
logical(lk), intent(in), optional :: sorted
125-
${t2}$, allocatable :: unique_values(:)
126-
end function ${name1}$_unique
127-
#:endfor
65+
!! is present with value `.true.`, the function assumes the input is already sorted
66+
!! and skips the sorting step.
67+
${t1}$, intent(in) :: array(:)
68+
logical(lk), intent(in), optional :: sorted
69+
${t2}$, allocatable :: unique_values(:)
12870

129-
end interface unique
71+
${t2}$ :: temp_array(size(array))
72+
logical :: mask(size(array))
73+
integer :: i, n
74+
logical :: is_input_sorted
13075

131-
contains
76+
n = size(array)
77+
78+
! Handle edge cases first
79+
if (n == 0) then
80+
! Return empty array for empty input
81+
allocate(unique_values(0))
82+
return
83+
else if (n == 1) then
84+
! For single-element arrays, return that element directly
85+
allocate(unique_values(1))
86+
unique_values(1) = array(1)
87+
return
88+
endif
89+
90+
! Determine if the input is already sorted
91+
is_input_sorted = optval(sorted, .false.)
92+
93+
! Create a temporary copy and sort it if needed
94+
temp_array = array
95+
if (.not. is_input_sorted) call sort(temp_array)
96+
97+
! Find unique elements using a mask
98+
! Start with first element always marked as unique
99+
mask(1) = .true.
100+
101+
! Compare each element with previous to mark duplicates
102+
do concurrent (i=2:n)
103+
mask(i) = temp_array(i) /= temp_array(i-1)
104+
end do
105+
106+
! Extract unique elements to result array using pack
107+
unique_values = pack(temp_array, mask)
108+
end procedure ${name1}$_unique
109+
#:endfor
132110

133-
end module stdlib_sorting_unique
111+
end submodule stdlib_sorting_unique

‎src/stdlib_sorting_unique_impl.fypp‎

Lines changed: 0 additions & 67 deletions
This file was deleted.

0 commit comments

Comments
 (0)