| 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 |||