| Sorting functions | 
| Sun.Jun,20160612 | First maintaining script in an ' R script |

| Building on Helmar Wodtke ' hsort | 
| as discussed in  Algorithm for "grade" :
|  https://groups.google.com/d/msg/comp.lang.apl/xe4JCfhqELk/cbpspL1hBwAJ

| \/ | Copied C:/4thCoSy/lib/alg/hsort | \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ | 
| vim: ft=reva :
| Helmar Wodke's sort

| mark forgetsort

." | Sort fns start |  " 

| Comparator function: is the cell pointed to by 'a1' less than the one pointed
| to by 'a2'?  | default for sorting integer cells 

 defer compare  ( a1 a2 -- flag ) ' < is compare

| /\ | This is the essence | /\ |  


: le'      cell-
: le       2dup + ;
: (sort)   over if >r le' @ r@
             compare 0if le dup @ r> rot ! else r> then
           (sort) ;then nip nip ; 
| ~

: hsort ( buf size -- )
	cells
	: (hsort)
           ?dup if 2dup le' @ (sort) >r le' r> swap !
           (hsort) ;then drop ;
| pop~

0 [IF]
def: hsort
stack: buf size --
ctx: ~
desc: =
	Sort the buffer "buf" of "size" cells, using the Heapsort algorithm.
=
[THEN]

|/\| | Copied C:/4thCoSy/lib/alg/hsort |/\| |/\| |/\| |/\| |/\| |/\| |/\| |/\|


: trimin 1p> ['] rho 'm ,/ ['] mini across^ R@ swap ['] take eachleft 1P> ; 
| Chops end of all lists in a list to length of shortest . 
| renamed to avoid conflict w ` Furniture.f ` trim | 20200530 |

| : strGt 1p> trimin flip ['] ,/ 'm { dup 0 i@ swap 1 i@ swap > } f?m R@ rho =i 1P> ;
| /\ | very APLish approach but unconsionably inefficient . See ' strCmpr 
| --

: sort. ( lst -- ) { cells/ hsort } onvan ;  | sort cells in place

: hsorti rep_ dup van cells/ hsort ;  

: sorti  ' < is compare  rep_ dup van cells/ hsort ; 	| sort integer list

| sort list of strings 
	: cmprStr_ strCmpr >_ 0 < ; 	| version for use w ' hsort  
: sortstr ' cmprStr_ is compare  .. rep_ dup van cells/ hsort ;  
|  not work ? | : sortstr .. { strCmpr >_ 0 < } is compare van cells/ hsort ; 


| These ` psort verbs supply the equivalent of APL's ` grade functions . 
| But because I see no way to get the permutation vector for the sort w/o doing the sort ,
| they return both as a sorted list of `( item originalIndex )` pairs .
| Thus the grade itself is given by , eg: 
| | intList psorti flip 1th ,/ |
| It does appear that the permutation creaed by Helmar' sort is not order preserving for equals .


| ` permute & sort integer . Returns list of items and their index ( grade )in original | 20210331 |
	: pcmpri_ { dsc >_ } on2 < ;
: psorti >a> # iota a> swap ,L flip ' pcmpri_ is compare rep dup van cells/ hsort ;

| ` permute & sort strings . list of items and their index ( grade ) in original | 20210331 |
| Returns sorted items with permutation index as 2nd item in list of `( item index )`
: pcmprstr_ ' dsc on2 cmprStr_ ; 	| 
: psortstr >a> # iota a> swap ,L flip ' pcmprstr_ is compare rep dup van cells/ hsort ;
: psortstrp psortstr flip 1th ,/ ; 	| just the grade permutation | 20210628 |

 ( table idx -- table sorted on col idx )
: _tsortc _i : tsortc  swap >a> swap at psortstrp a> swap ' at 'L ; | 20210628 |


."  | Sort fns end | " cr

|||


