Skip to content

Commit 11650c3

Browse files
committed
Add sorting function
Added a function to sort the list of strings (implementation inspired by the alternative set-up of a long string with indices)
1 parent 4e4bda4 commit 11650c3

File tree

2 files changed

+111
-1
lines changed

2 files changed

+111
-1
lines changed

Diff for: src/stdlib_stringlist.f90

+102-1
Original file line numberDiff line numberDiff line change
@@ -27,10 +27,48 @@ module stdlib_stringlists
2727
procedure :: insert => insert_string
2828
procedure :: get => get_string
2929
procedure :: length => length_list
30+
procedure :: sort => sort_list
3031
end type t_stringlist
3132

33+
34+
interface operator(<)
35+
module procedure string_lower
36+
end interface
37+
38+
interface operator(>)
39+
module procedure string_greater
40+
end interface
41+
42+
interface operator(==)
43+
module procedure string_equal
44+
end interface
45+
3246
contains
3347

48+
! compare t_string derived types
49+
! Required by sorting functions
50+
!
51+
elemental logical function string_lower( string1, string2 )
52+
type(t_string), intent(in) :: string1
53+
type(t_string), intent(in) :: string2
54+
55+
string_lower = string1%value < string2%value
56+
end function string_lower
57+
58+
elemental logical function string_greater( string1, string2 )
59+
type(t_string), intent(in) :: string1
60+
type(t_string), intent(in) :: string2
61+
62+
string_greater = string1%value > string2%value
63+
end function string_greater
64+
65+
elemental logical function string_equal( string1, string2 )
66+
type(t_string), intent(in) :: string1
67+
type(t_string), intent(in) :: string2
68+
69+
string_equal = string1%value == string2%value
70+
end function string_equal
71+
3472
! length_list --
3573
! Return the size (length) of the list
3674
!
@@ -119,7 +157,6 @@ function get_string( list, idx )
119157
character(len=:), allocatable :: get_string
120158

121159
integer :: idxnew
122-
type(t_string) :: new_element
123160

124161
!
125162
! Examine the actual index:
@@ -145,4 +182,68 @@ function get_string( list, idx )
145182
endif
146183
end function get_string
147184

185+
! sort_list --
186+
! Sort the list and return the result as a new list
187+
!
188+
! Arguments:
189+
! list The list of strings to retrieve the string from
190+
! ascending Whether to sort as ascending (true) or not (false)
191+
!
192+
function sort_list( list, ascending )
193+
class(t_stringlist), intent(in) :: list
194+
logical, intent(in) :: ascending
195+
196+
integer :: i
197+
integer, dimension(:), allocatable :: idx
198+
class(t_stringlist), allocatable :: sort_list
199+
200+
!
201+
! Allocate and fill the index array, then sort the indices
202+
! based on the strings
203+
!
204+
idx = [ (i ,i=1,list%size) ]
205+
206+
if ( ascending ) then
207+
idx = sort_ascending( idx )
208+
else
209+
idx = sort_descending( idx )
210+
endif
211+
212+
allocate( sort_list )
213+
allocate( sort_list%string(list%size) )
214+
215+
do i = 1,list%size
216+
sort_list%string(i) = list%string(idx(i))
217+
enddo
218+
sort_list%size = list%size
219+
220+
contains
221+
recursive function sort_ascending( idx ) result(idxnew)
222+
integer, dimension(:) :: idx
223+
integer, dimension(size(idx)) :: idxnew
224+
225+
if ( size(idx) > 1 ) then
226+
idxnew = [ sort_ascending( pack( idx, list%string(idx) < list%string(idx(1)) ) ), &
227+
pack( idx, list%string(idx) == list%string(idx(1)) ) , &
228+
sort_ascending( pack( idx, list%string(idx) > list%string(idx(1)) ) ) ]
229+
else
230+
idxnew = idx
231+
endif
232+
end function sort_ascending
233+
234+
recursive function sort_descending( idx ) result(idxnew)
235+
integer, dimension(:) :: idx
236+
integer, dimension(size(idx)) :: idxnew
237+
238+
if ( size(idx) > 1 ) then
239+
idxnew = [ sort_descending( pack( idx, list%string(idx) > list%string(idx(1)) ) ), &
240+
pack( idx, list%string(idx) == list%string(idx(1)) ) , &
241+
sort_descending( pack( idx, list%string(idx) < list%string(idx(1)) ) ) ]
242+
else
243+
idxnew = idx
244+
endif
245+
end function sort_descending
246+
247+
end function sort_list
248+
148249
end module stdlib_stringlists

Diff for: src/tests/stringlist/test_stringlist.f90

+9
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ program test_stringlists
99
implicit none
1010

1111
type(t_stringlist) :: list
12+
type(t_stringlist) :: list_sorted
1213
integer :: i
1314

1415
!
@@ -60,4 +61,12 @@ program test_stringlists
6061
write(*,*) '41', '>', list%get(41), '<'
6162
write(*,*) list%length()
6263

64+
!
65+
! Sort the list and print the result
66+
!
67+
list_sorted = list%sort( .false. )
68+
do i = 1,list_sorted%length()
69+
write(*,*) i, '>', list_sorted%get(i), '<'
70+
enddo
71+
6372
end program test_stringlists

0 commit comments

Comments
 (0)