@@ -152,14 +152,14 @@ housekeeping it has slower runtime performance than `ORD_SORT`.
152
152
provided as optional ` work ` and ` iwork ` arguments or allocated
153
153
internally on the stack.
154
154
155
- #### The ` SORT ` subroutines
155
+ #### The ` SORT ` subroutine
156
156
157
157
` SORT ` uses the ` introsort ` sorting algorithm of David Musser.
158
158
` introsort ` is a hybrid unstable comparison algorithm combining
159
159
` quicksort ` , ` insertion sort ` , and ` heap sort ` . While this algorithm's
160
160
runtime performance is always O(N Ln(N)), it is relatively fast on
161
- randomly ordered data, but inconsistent in performance on partly
162
- sorted data.as the official source of the algorithm .
161
+ randomly ordered data, but does not show the improvement in
162
+ performance on partly sorted data found for ` ORD_SORT ` .
163
163
164
164
As with ` introsort ` , ` SORT ` is an unstable hybrid algorithm.
165
165
First it examines the array and estimates the depth of recursion a
@@ -182,14 +182,16 @@ calls `introsort` proper. `introsort` proper then:
182
182
* Calls ` introsort ` proper on the rightmost partition, and then
183
183
returns.
184
184
185
- The resulting algorithm is of order O(N Ln(N)) run time
186
- performance for all inputs. Because it relies on ` quicksort ` , the
187
- coefficient of the O(N Ln(N)) behavior is typically small compared to
188
- other sorting algorithms on random data. On partially sorted data it
189
- can show either slower ` heap sort ` performance, or enhanced
190
- performance by up to a factor of six. Still, even when it shows
191
- enhanced performance, its performance on partially sorted data is
192
- typically an order of magnitude slower than ` ORD_SORT ` .
185
+ The resulting algorithm is of order O(N Ln(N)) run time performance
186
+ for all inputs. Because it relies on ` quicksort ` , the coefficient of
187
+ the O(N Ln(N)) behavior is typically small compared to other sorting
188
+ algorithms on random data. On partially sorted data it can show either
189
+ slower ` heap sort ` performance, or enhanced performance by up to a
190
+ factor of six. Still, even when it shows enhanced performance, its
191
+ performance on partially sorted data is typically an order of
192
+ magnitude slower than ` ORD_SORT ` . Its memory requirements are also
193
+ low, being of order O(Ln(N)), while the memory requirements of
194
+ ` ORD_SORT ` and ` SORT_INDEX ` are of order O(N).
193
195
194
196
### Tentative specifications of the ` stdlib_sorting ` procedures
195
197
@@ -255,9 +257,7 @@ function `LGT`.
255
257
call read_sorted_file( 'dummy_file1', array1 )
256
258
call read_sorted_file( 'dummy_file2', array2 )
257
259
! Concatenate the arrays
258
- allocate( array( size(array1) + size(array2) ) )
259
- array( 1:size(array1) ) = array1(:)
260
- array( size(array1)+1:size(array1)+size(array2) ) = array2(:)
260
+ array = [ array1, array2 ]
261
261
! Sort the resulting array
262
262
call ord_sort( array, work )
263
263
! Process the sorted array
@@ -318,16 +318,17 @@ element of `array` is a `NaN`. Sorting of `CHARACTER(*)` and
318
318
...
319
319
```
320
320
321
- #### ` sort_index ` - creates an array of sorting indices for an input array.
321
+ #### ` sort_index ` - creates an array of sorting indices for an input array, while also sorting the array .
322
322
323
323
##### Status
324
324
325
325
Experimental
326
326
327
327
##### Description
328
328
329
- Returns an integer array whose elements would sort the input array in
330
- the specified direction retaining order stability.
329
+ Returns the input ` array ` sorted in the direction requested while
330
+ retaining order stability, and an integer array whose elements would
331
+ sort the input ` array ` to produce the output ` array ` .
331
332
332
333
##### Syntax
333
334
@@ -381,9 +382,10 @@ replace "scratch" memory that would otherwise be allocated on the
381
382
stack. If ` array ` is of any kind of ` REAL ` the order of the elements in
382
383
` index ` and ` array ` on return are undefined if any element of ` array `
383
384
is a ` NaN ` . Sorting of ` CHARACTER(*) ` and ` STRING_TYPE ` arrays are
384
- based on the operator ` > ` , and not on the function ` LGT ` . It should be
385
- emphasized that the order of ` array ` will typically be different on
386
- return.
385
+ based on the operator ` > ` , and not on the function ` LGT ` .
386
+
387
+ It should be emphasized that the order of ` array ` will typically be
388
+ different on return
387
389
388
390
389
391
##### Examples
@@ -392,15 +394,15 @@ Sorting a related rank one array:
392
394
393
395
``` Fortran
394
396
subroutine sort_related_data( a, b, work, index, iwork )
395
- ! Sort `b` in terms or its related array `a`
397
+ ! Sort `a`, and also sort ` b` to be reorderd the same way as `a`
396
398
integer, intent(inout) :: a(:)
397
399
integer(int32), intent(inout) :: b(:) ! The same size as a
398
400
integer(int32), intent(inout) :: work(:)
399
401
integer(int_size), intent(inout) :: index(:)
400
402
integer(int_size), intent(inout) :: iwork(:)
401
403
! Find the indices to sort a
402
- call sort_index(a, index(1:size(a)),&
403
- work(1:size(a)/2), iwork(1:size(a)/2))
404
+ call sort_index(a, index(1:size(a)),&
405
+ work(1:size(a)/2), iwork(1:size(a)/2))
404
406
! Sort b based on the sorting of a
405
407
b(:) = b( index(1:size(a)) )
406
408
end subroutine sort_related_data
@@ -410,23 +412,23 @@ Sorting a rank 2 array based on the data in a column
410
412
411
413
``` Fortran
412
414
subroutine sort_related_data( array, column, work, index, iwork )
413
- ! Sort `a_data` in terms or its component `a`
414
- integer, intent(inout) :: a (:,:)
415
+ ! Reorder rows of `array` such that `array(:, column)` is sorted
416
+ integer, intent(inout) :: array (:,:)
415
417
integer(int32), intent(in) :: column
416
418
integer(int32), intent(inout) :: work(:)
417
419
integer(int_size), intent(inout) :: index(:)
418
420
integer(int_size), intent(inout) :: iwork(:)
419
421
integer, allocatable :: dummy(:)
420
422
integer :: i
421
- allocate(dummy(size(a , dim=1)))
422
- ! Extract a component of `a_data `
423
- dummy(:) = a (:, column)
423
+ allocate(dummy(size(array , dim=1)))
424
+ ! Extract a column of `array `
425
+ dummy(:) = array (:, column)
424
426
! Find the indices to sort the column
425
427
call sort_index(dummy, index(1:size(dummy)),&
426
428
work(1:size(dummy)/2), iwork(1:size(dummy)/2))
427
429
! Sort a based on the sorting of its column
428
- do i=1, size(a , dim=2)
429
- a (:, i) = a (index(1:size(a , dim=1)), i)
430
+ do i=1, size(array , dim=2)
431
+ array (:, i) = array (index(1:size(array , dim=1)), i)
430
432
end do
431
433
end subroutine sort_related_data
432
434
```
0 commit comments