403 - PurelyFunctional.tv Newsletter

00 Sort by content.md

Sort by content

In this task, we are sorting a heterogeneous list of elements. The elements are either single numbers or sequences of numbers. We should sort them by numeric content, like this:

(sort-by-content [4 5 3 2 1]) ;=> [1 2 3 4 5]
;; we sort sequences by their first element, then by second element, then by third, etc
(sort-by-content [[2 3] [0 9] [-1 3 4] [0 3]]) ;=> [[-1 3 4] [0 3] [0 9] [2 3]]
;; we sort numbers and sequences together as if numbers were sequences of length 1
(sort-by-content [5 [4 5] 3 1 [0 2 3]]) ;=> [[0 2 3] 1 3 [4 5] 5]
;; but numbers sort before sequences when the number is the same as the first element
(sort-by-content [[1] 1]) ;=> [1 [1]]
;; don't sort subsequences
(sort-by-content [[10 3 4 1]]) ;=> [[10 3 4 1]]

Update: Someone asked if you need to sort the numbers in subsequences. You do not. Just sort the top-level values, the mix of numbers and sequences of numbers. I've added an example to clarify.

Thanks to this site for the challenge idea where it is considered Medium level in JavaScript.

Please submit your solutions as comments on this gist.

(defn wrap [x]
  (if (number? x) [x] x))

(defn pad [n xs]
  (vec (take n (concat xs (repeat nil)))))

(defn comp* [x y]
  (let [xs (wrap x)
        ys (wrap y)
        len (max (count xs) (count ys))
        cmp (compare (pad len xs) (pad len ys))]
    (if (zero? cmp)
      (case [(number? x) (number? y)]
        [false false] 0
        [false true] 1
        [true false] -1
        [true true] 0)
      cmp)))

(defn sort-by-content [xs]
  (sort comp* xs))

(defn sort-by-content [xs]
  (let [icompare (fn [a b]
                   (let [a1? (number? a)
                         b1? (number? b)]
                     (cond (and a1? b1?) (compare a b)
                           a1? (if (<= a (first b)) -1 1)
                           b1? (if (< (first a) b) -1 1)
                           :else (loop [a (seq a) b (seq b)]
                                   (let [c (compare (first a) (first b))]
                                     (cond (not (zero? c)) c
                                           (and (empty? a) (empty? b)) 0
                                           :else (recur (rest a) (rest b))))))))]
    (sort icompare xs)))

Revised to avoid infinite loop on multiple equal sequences.

(sort-by-content [[1] [1]])  ;=> [[1] [1]]

(defn comp' [a b]
  (let [ca? (coll? a) cb? (coll? b)
        aa (if ca? a (vector a))
        bb (if cb? b (vector b))
        ts (apply map vector (map vector aa bb))]
    (if (and (= (first aa) (first bb)) (not (and ca? cb?)))
      (if ca? 1 (if cb? -1 0)) (apply compare ts))))

(defn sort-by-content [xs] (sort comp' xs))

@mchampine I think there is an issue with your answer, as these ought to be the same:

(sort-by-content [[1] [1 2]])
=> ([1] [1 2])
(sort-by-content [[1 2] [1]])
=> ([1 2] [1])

@steffan-westcott Ah, I see. That assumes a "missing" element should sort before any existing element. I was interpreting the rule as "sort only when values are present at the same index in both collections". Your interpretation is certainly the more conventional one! If I pad instead of truncate (borrowing your pad function) I get the conventional sorting behavior. Thanks for the sharp eye!

(defn comp' [a b]
  (let [ca? (coll? a) cb? (coll? b)
        aa (if ca? a [a]) bb (if cb? b [b])
        len (max (count aa) (count bb))
        pad (fn [xs] (vec (take len (concat xs (repeat nil)))))]
    (if (and (= (first aa) (first bb)) (not (and ca? cb?)))
      (if ca? 1 (if cb? -1 0)) (compare (pad aa) (pad bb)))))

(defn sort-by-content [xs] (sort comp' xs))

(sort-by-content [[1] [1 2]])
;; => ([1] [1 2])
(sort-by-content [[1 2] [1]])
;; => ([1] [1 2])

(defn content-comparator [x y]
  (let [[a b] (first
                (drop-while
                  (fn [[a b]] (= a b)) (map vector (if (coll? x) x [x]) (if (coll? y) y [y]))))]
    (if a
      (if (< a b) -1 (if (> a b) 1 0))
      (if (coll? x) 1 -1))))

(defn sort-by-content [xs]
  (sort-by identity content-comparator xs))

This is long but emulates a "truth table" format. I also followed the convention adopted by @steffan-westcott and @mchampine, that a collection that is the prefix to another comes first (i.e. ([1] [1 2]) is sorted.)

(defn =result-or-compare [=result x y]
  (if (= x y)
    =result
    (compare x y)))

(defn label [a b]
  (let [tag (fn [xs] 
                (cond 
                  (empty? xs) :_
                  (= 1 (count xs)) :1
                  :else :+))]
    (cond 
      (and (number? a) (number? b)) [:num :num :n :n]
      (number? a) [:num :seq :n (tag b)]
      (number? b) [:seq :num (tag a) :n]
      :else [:seq :seq (tag a) (tag b)])))

(def one-or-more (-> (make-hierarchy) (derive :1 :+)))

(defmulti cmp label :hierarchy #'one-or-more)

;; Dispatch label format: 
;;   [<left-arg :seq or :num>, <right-arg :seq or :num>, 
;;    <left-arg tag>,          <right-arg tag>         ]
;; where a :num tag is always :n, and
;;       a :seq tag is one of
;;                            :_  (empty) 
;;                            :1  (a singleton) 
;;                            :+  (size > 1)

(defmethod cmp [:num :num :n :n] [x y] (compare x y))

(defmethod cmp [:seq :seq :+ :+] [[x & xs] [y & ys]] (if (= x y)
                                                       (cmp xs ys)
                                                       (compare x y)))
(defmethod cmp [:seq :seq :_ :+] [_ _] -1)
(defmethod cmp [:seq :seq :+ :_] [_ _] 1)
(defmethod cmp [:seq :seq :_ :_] [_ _] 0)

(defmethod cmp [:seq :num :_ :n] [_ _] -1)
(defmethod cmp [:seq :num :1 :n] [[x] y] (=result-or-compare 1 x y))
(defmethod cmp [:seq :num :+ :n] [xs y] (cmp xs [y]))

(defmethod cmp [:num :seq :n :_] [_ _] 1)
(defmethod cmp [:num :seq :n :1] [x [y]] (=result-or-compare -1 x y))
(defmethod cmp [:num :seq :n :+] [x ys] (cmp [x] ys))

(defn sort-by-content [xs]
  (sort #(cmp % %2) xs))

Here is another version using core.match:

(require '[core.match :refer [match])

(defn compare-contents [a b]
  (match [a b]
         [([x & xs] :seq) ([y & ys] :seq)] (if (= x y)
                                             (recur xs ys)
                                             (compare x y))
         [(x :guard number?) (([y & ys] :seq) :as yys)] (recur [x] yys)
         [(([x & xs] :seq) :as xxs) (y :guard number?)] (recur xxs [y]) 
         [(x :guard number?) (y :guard number?)] (compare x y)
         [(_ :guard empty?) (_ :guard empty?)] 0
         [(_ :guard empty?) ([_ & _] :seq)] -1
         [([_ & _] :seq) (_ :guard empty?)] 1
         :else (compare a b)))

(defn sort-by-content [xs]
  (sort compare-contents xs))

@KingCode - really interesting alternative approaches!
Btw, if you want syntax highlighting on your code blocks, just add the word clojure after the 3 back-ticks at the start of the block.

Thanks @mchampine! I can't believe I never noticed the syntax highlighting :0, will use it from now on..

Regarding this challenge, for me finding a solution was a tug-of-war b/w brevity and getting a pictorial view of the possible logic paths, but I am not convinced I did well in either ( e.g. I am sure there is a way to avoid using two conds in the label fn, perhaps by using another multi-method or core.match, and the core.match solution is awfully springled with constraints which pollute the pictorial view) - I would love to see suggestions/improvements on the idea!

In any case I enjoyed learning some more about defmulti and core.match!

(defn- compare-nums
  [[x & xs] [y & ys]]
  (if (or (some? x) (some? y))
    (let [res (compare x y)]
      (if (zero? res)
        (compare-nums xs ys)
        res))
    0))

(defn- compare-content
  [x y]
  (let [res (compare-nums (:nums x) (:nums y))]
    (if (zero? res)
      (compare (:priority x) (:priority y))
      res)))

(defn- content-key
  [x]
  (if (coll? x)
    {:priority 1, :nums x}
    {:priority 0, :nums [x]}))

(defn sort-by-content
  [xs]
  (sort-by content-key compare-content xs))