examples of composeable ordering functions

ordering.clj

(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: " xs)))))


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

  
)