@@ -27,10 +27,48 @@ module stdlib_stringlists
27
27
procedure :: insert = > insert_string
28
28
procedure :: get = > get_string
29
29
procedure :: length = > length_list
30
+ procedure :: sort = > sort_list
30
31
end type t_stringlist
31
32
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
+
32
46
contains
33
47
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
+
34
72
! length_list --
35
73
! Return the size (length) of the list
36
74
!
@@ -119,7 +157,6 @@ function get_string( list, idx )
119
157
character (len= :), allocatable :: get_string
120
158
121
159
integer :: idxnew
122
- type (t_string) :: new_element
123
160
124
161
!
125
162
! Examine the actual index:
@@ -145,4 +182,68 @@ function get_string( list, idx )
145
182
endif
146
183
end function get_string
147
184
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
+
148
249
end module stdlib_stringlists
0 commit comments