@@ -0,0 +1,123 @@
(ns ordering )
; ;We want to pack some information along with
; ;our functions so that when our interpreter picks them
; ;up, we can determine if the function should be applied
; ;directly as a comparator, or if we need to "lift"
; ;it into the comparator domain.
(defn ordering? [x] (get (meta x) :ordering ))
; ;convenience macro to help us create functions with
; ;ordering specified in meta
(defmacro ord-fn [[l r] & body]
`(vary-meta (fn [~l ~r] ~@body) assoc :ordering true ))
; ;Comparison combinator.
; ;defines an ordering function from one or more functions. If more
; ;than one ordering criteria is supplied, the resulting comparison
; ;will occur from "left to right" in the order of inputs.
; ;If a function satisfies ordering?, then we leave it as-is. If it's
; ;otherwise a clojure IFn, then we lift it into the comparator space
; ;by defining an ordering function, which uses the function as its
; ;comparison key (similar to sort-by, but composable).
; ; (ordering o1 o2 f3) ;;more or less imples...
; ; ^{:ordering true} (fn [l r]
; ; (let [res1 (o1 l r)]
; ; (if-not (zero? res)
; ; res
; ; (let [res2 (o2 l r)]
; ; (if-not (zero? res)
; ; res
; ; (let [res3 (compare (f3 l) (f3 r))]
; ; res3))))))
; ;The result is itself an ordering function, which can again
; ;be composed via ordering in other sorting criteria.
(defn ordering
([f] (if (ordering? f) f (ord-fn [l r] (compare (f l) (f r)))))
([f & fs]
(let [fs (into [f] fs)]
(ord-fn [l r]
(reduce (fn [acc f]
(let [res (if (ordering? f) (f l r)
(compare (f l) (f r)))]
(if (not (zero? res))
(reduced res)
acc))) 0 fs)))))
; ;convenience wrapper to allow us to encode
; ;orderings as keywords, functions, and vectors.
(defn eval-order [xs]
(cond (or (fn? xs) (keyword? xs)) (ordering xs)
(vector? xs) (apply ordering
(reduce (fn [acc f]
(conj acc (eval-order f))) [] xs))
(nil? xs) nil
:else (throw (Exception. (str " Unknown ordering expression: "
; ;Convenience function to flip or invert the ordering criteria
(defn flip [f]
(if (keyword? f)
(ord-fn [l r] (compare (f r) (f l)))
(ord-fn [l r] (f r l))))
; ;descending order is synonymouse with flipping the inputs
; ;to an ordering.
(def descending flip )
(comment
; ;testing
(def xs [{:first " Bilbo" :last " Baggins" :age 900 , :looks 45 , :index 0 :class :even }
{:first " James" :last " Kirk" :age 50 , :looks 50 , :index 1 :class :odd }
{:first " Benjamin" :last " Button" :age 2 , :looks 70 , :index 2 :class :even }
{:first " Benjamin" :last " Franklin" :age 70 , :looks 100 , :index 3 :class :odd }
{:first " James" :last " John" :age 50 :looks 50 :index 4 :class :even }
{:first " James" :last " Jamison" :age 50 :looks 50 :index 4 :class :odd }])
(sort (eval-order :age ) xs)
(sort (eval-order [:age :looks ]) xs)
(sort (eval-order [:first :last (descending :age )]) xs)
; ;we can alternately store rules in named functions and compose
; ;them. This is particularly useful if we define macros to flesh out
; ;our rules for us, e.g. min-age, max-age, etc.
(def youngest (eval-order :age ))
(def age-then-looks (eval-order [:age :looks ]))
(def first-last-oldest (eval-order [first last (descending :age )]))
(sort (eval-order [youngest (descending :looks ) :index ]) xs)
(sort (eval-order [:class first-last-oldest]) xs)
; ;also just inject arbitrary function, use the length of the
; ;last name
(def last-count (comp count :last ))
(sort (eval-order [:class :first last-count]) xs)
(sort (eval-order [:class :first (comp - last-count)]) xs)
; ;define some string comparing functions
(def history
{" Benjamin" " Franklin"
(def trek
{" James" " Kirk"
(def fantasy
{" Bilbo" " Baggins"
(defn matches [db m k1 k2]
(= (some-> k1 m db)
(some-> k2 m)))
(def famous (eval-order [#(matches history % :first :last )
#(matches trek % :first :last )
#(matches fantasy % :first :last )]))
(sort (eval-order [(flip famous) first-last-oldest]) xs)
)
joinr created this gist