program demo_package
use M_orderpack__mrgref, only : mrgref
use M_orderpack, only : rank_basic
use M_orderpack__mrgrnk, only : mrgrnk
use M_orderpack, only : rank
use M_orderpack__inssor, only : inssor
use M_orderpack, only : Sort_special
use M_orderpack__refsor, only : refsor
use M_orderpack, only : Sort
use M_orderpack__rinpar, only : rinpar
use M_orderpack, only : prank_special
use M_orderpack__refpar, only : refpar
use M_orderpack, only : prank_basic
use M_orderpack__rapknr, only : rapknr
use M_orderpack, only : prank_decreasing
use M_orderpack__rnkpar, only : rnkpar
use M_orderpack, only : prank
use M_orderpack__inspar, only : inspar
use M_orderpack, only : psort
implicit none
character(len=*),parameter :: g='(a,*(i3,1x))'
integer,parameter :: isz=30 ! number of random numbers
integer :: mx=13 ! maxval(abs(ii)), biggest magnitude of random values, < isz to likely get duplicates
integer,parameter :: par=8 ! order of partial sort
integer :: ii(isz), jj(isz)
integer :: indx(isz)
real :: rr(isz)
!===================================================================================================================================
call random_seed()
call random_number(rr)
rr=rr-0.50
ii=floor(rr*mx)
write(*,g)'Original ',ii
write(*,g)'mrgref - [RANK] produces a sorted ranking index array of input array (basic merge-sort)'
indx=-99
call mrgref(ii,indx)
write(*,g)' ',indx
write(*,g)' ',ii(indx)
write(*,g)'rank_basic - [RANK] produces a sorted ranking index array of input array (basic merge-sort)'
indx=-99
call rank_basic(ii,indx)
write(*,g)' ',indx
write(*,g)' ',ii(indx)
!===================================================================================================================================
write(*,g)'mrgrnk - [RANK] produces a sorted ranking index array of input array (optimized merge-sort)'
indx=-99
call mrgrnk(ii,indx)
write(*,g)' ',indx
write(*,g)' ',ii(indx)
write(*,g)'rank - [RANK] produces a sorted ranking index array of input array (optimized merge-sort)'
indx=-99
call rank(ii,indx)
write(*,g)' ',indx
write(*,g)' ',ii(indx)
!===================================================================================================================================
write(*,g)'inssor - [SORT] Sorts array into ascending order (Insertion sort, generally for small or nearly sorted arrays)'
jj=ii
call inssor(jj)
write(*,g)' ',jj
write(*,g)'Sort_special - [SORT] Sorts array into ascending order (Insertion sort, generally for small or nearly sorted arrays)'
jj=ii
call Sort_special(jj)
write(*,g)' ',jj
!===================================================================================================================================
write(*,g)'refsor - [SORT] Sorts array into ascending order (Quicksort)'
jj=ii
call refsor(jj)
write(*,g)' ',jj
write(*,g)'Sort - [SORT] Sorts array into ascending order (Quicksort)'
jj=ii
call Sort(jj)
write(*,g)' ',jj
!===================================================================================================================================
write(*,g)'inspar - [SORT:PARTIAL] partially sorts an array, bringing the N lowest values to the beginning of the array'
jj=ii
call inspar(jj,par)
! note the remainder of the data is perturbed
write(*,g)' ',jj
write(*,g)' ',jj(1:par)
write(*,g)'psort - [SORT:PARTIAL] partially sorts an array, bringing the N lowest values to the beginning of the array'
jj=ii
call psort(jj,par)
! note the remainder of the data is perturbed
write(*,g)' ',jj
write(*,g)' ',jj(1:par)
!===================================================================================================================================
write(*,g)'rinpar - [RANK:PARTIAL] creates partial rank index of N lowest values in an array'
indx=-99
call rinpar(ii,indx,par)
write(*,g)' ',indx
write(*,g)' ',ii(indx(1:par))
write(*,g)'prank_special - [RANK:PARTIAL] creates partial rank index of N lowest values in an array'
indx=-99
call prank_special(ii,indx,par)
write(*,g)' ',indx
write(*,g)' ',ii(indx(1:par))
!===================================================================================================================================
write(*,g)'refpar - [RANK:PARTIAL] partially rank array up to specified number of elements (QuickSort-like)'
indx=-99
call refpar(ii,indx,par)
write(*,g)' ',indx
write(*,g)' ',ii(indx(1:par))
write(*,g)'prank_basic - [RANK:PARTIAL] partially rank array up to specified number of elements (QuickSort-like)'
indx=-99
call prank_basic(ii,indx,par)
write(*,g)' ',indx
write(*,g)' ',ii(indx(1:par))
!===================================================================================================================================
write(*,g)'rapknr - [RANK:PARTIAL] partially ranks an array up to a specified number of values, in DECREASING order.'
indx=-99
call rapknr(ii,indx,par)
write(*,g)' ',indx
write(*,g)' ',ii(indx(1:par))
write(*,g)'prank_decreasing - [RANK:PARTIAL] partially ranks an array up to a specified number of values, in DECREASING order.'
indx=-99
call prank_decreasing(ii,indx,par)
write(*,g)' ',indx
write(*,g)' ',ii(indx(1:par))
!===================================================================================================================================
write(*,g)'rnkpar - [RANK:PARTIAL] partially rank array, up to order N (N number of sorted elements to return) (QuickSort-like)'
indx=-99
call rnkpar(ii,indx,par)
write(*,g)' ',indx
write(*,g)' ',ii(indx(1:par))
write(*,g)'prank - [RANK:PARTIAL] partially rank array, up to order N (N number of sorted elements to return) (QuickSort-like)'
indx=-99
call prank(ii,indx,par)
write(*,g)' ',indx
write(*,g)' ',ii(indx(1:par))
!===================================================================================================================================
write(*,g)'unipar - [RANK:PARTIAL:UNIQUE] partially rank an array removing duplicates'
write(*,g)'prank_unique - [RANK:PARTIAL:UNIQUE] partially rank an array removing duplicates'
!===================================================================================================================================
write(*,g)'uniinv - [RANK:UNIQUE] a MergeSort inverse ranking of an array, with duplicate entries assigned the same rank.'
write(*,g)'rank_orders - [RANK:UNIQUE] a MergeSort inverse ranking of an array, with duplicate entries assigned the same rank.'
!===================================================================================================================================
write(*,g)'unirnk - [RANK:UNIQUE] performs a MergeSort ranking of an array, with removal of duplicate entries.'
write(*,g)'rank_unique - [RANK:UNIQUE] performs a MergeSort ranking of an array, with removal of duplicate entries.'
!===================================================================================================================================
write(*,g)'unista - [UNIQUE] (Stable unique) Removes duplicates from an array otherwise retaining original order'
write(*,g)'unique - [UNIQUE] (Stable unique) Removes duplicates from an array otherwise retaining original order'
!===================================================================================================================================
write(*,g)'fndnth - [FRACTILE] Return Nth lowest value of an array (InsertSort-like)'
write(*,g)'orderval_special - [FRACTILE] Return Nth lowest value of an array (InsertSort-like)'
!===================================================================================================================================
write(*,g)'indnth - [FRACTILE] Return INDEX of Nth value of array, i.e fractile of order N/SIZE(array) (QuickSort-like)'
write(*,g)'orderloc - [FRACTILE] Return INDEX of Nth value of array, i.e fractile of order N/SIZE(array) (QuickSort-like)'
!===================================================================================================================================
write(*,g)'valnth - [FRACTILE] Return VALUE of Nth lowest value of array, i.e fractile of order N/SIZE(array) (QuickSort-like)'
write(*,g)'orderval - [FRACTILE] Return VALUE of Nth lowest value of array, i.e fractile of order N/SIZE(array) (QuickSort-like)'
!===================================================================================================================================
write(*,g)'valmed - [MEDIAN] finds the median of an array'
write(*,g)'medianval - [MEDIAN] finds the median of an array'
!===================================================================================================================================
write(*,g)'median - [MEDIAN] Return median value of array. If number of data is even, return average of the two "medians".'
write(*,g)'median - [MEDIAN] Return median value of array. If number of data is even, return average of the two "medians".'
!===================================================================================================================================
write(*,g)'indmed - [MEDIAN] Returns INDEX of median value of an array.'
write(*,g)'medianloc - [MEDIAN] Returns INDEX of median value of an array.'
!===================================================================================================================================
write(*,g)'ctrper - [PERMUTATION] generate a random permutation of an array leaving elements close to initial locations'
write(*,g)'perturb - [PERMUTATION] generate a random permutation of an array leaving elements close to initial locations'
!===================================================================================================================================
write(*,g)'mulcnt - [MULTIPLICITY] Give the multiplicity for each array value (number of times that it appears in the array)'
write(*,g)'occurrences - [MULTIPLICITY] Give the multiplicity for each array value (number of times that it appears in the array)'
!===================================================================================================================================
end program demo_package