Sorting Routine

From Gwen Morse's Wiki
Jump to: navigation, search

;;; Posted to the Tinyfugue mailing list by Eerikki Matias Aula
;;; original source lost/undocumented

;;;; /qsort
;;; usage:  /qsort comparison-function item...
;;; Echoes the sorted items.
;;; "comparison-function" is the name of a function that compares %1 and %2,
;;; and returns <0, 0, or >0.  "item..." is a series of words to be sorted.

; Using %R instead of %1 has little effect on random input, but is much
; more efficient on sorted or nearly-sorted input.

/def qsort = \
    /if ({#} <= 2) \
        /_echo %{-1}%; \
    /else \
        /let compare=%{1}%;\
        /shift%;\
;       /let key=%{R}%;\
        /let key=%{1}%;\
        /let same=%;\
        /let small=%;\
        /let large=%;\
        /let diff=%;\
        /while ({#}) \
            /test diff:=%compare({1}, key)%;\
            /if (!diff) \
                /let same=%same %1%; \
            /elseif (diff < 0) \
                /let small=%small %1%; \
            /else \
                /let large=%large %1%; \
            /endif%; \
            /shift%; \
        /done%; \
        /_echo $(/qsort %compare %small) %same $(/qsort %compare %large)%; \
    /endif


;;;; /qnsort
;;; usage:  /qnsort F comparison-function item...
;;; Echoes the first F sorted items, instead of all N, much more efficiently
;;; than /first_n $(/qsort ...).  If F < 0, it is ignored.
;;; "comparison-function" is the name of a function that compares %1 and %2,
;;; and returns <0, 0, or >0.  "item..." is a series of words to be sorted.

/def qnsort = \
    /if ({#} <= 2) \
        /_echo %{-1}%; \
    /else \
        /let F=%{1}%; \
        /let cmp=%{2}%;\
        /shift 2%;\
        /if (F >= {#} | F < 0) /qsort %cmp %*%; /return {?}%; /endif%; \
;       /let key=%{R}%;\
        /let key=%{1}%;\
        /let same=%;\
        /let small=%;\
        /let large=%;\
        /let nsame=0%;\
        /let nsmall=0%;\
        /let nlarge=0%;\
        /let diff=%;\
        /while ({#}) \
            /test diff:=%cmp({1}, key)%;\
            /if (!diff) \
                /let same=%same %1%; \
                /test ++nsame%; \
            /elseif (diff < 0) \
                /let small=%small %1%; \
                /test ++nsmall%; \
            /else \
                /let large=%large %1%; \
                /test ++nlarge%; \
            /endif%; \
            /shift%; \
        /done%; \
        /if (F <= nsmall) \
            /_echo $(/qnsort %F %cmp %small)%; \
        /elseif (F <= nsmall + nsame) \
            /_echo $(/qsort %cmp %small) $(/first_n $[F-nsmall] %same)%; \
        /else \
            /_echo $(/qsort %cmp %small) %same \
                $(/qnsort $[F - nsmall - nsame] %cmp %large)%; \
        /endif%; \
    /endif


;;; useful comparison functions

/def intcmp        = /test {1} - {2}
/def strcasecmp = /test strcmp(tolower({1}), tolower({2}))