Can you formulate the insertion sort as a monoid in Clojure?

Question

This is the code for an insertion sort in Clojure:

(defn in-sort! [data]
  (letfn [(insert ([raw x](insert [] raw x))
          ([sorted [y & raw] x]
             (if (nil? y) (conj sorted x)
             (if (<= x y ) (concat sorted [x,y] raw)
                 (recur (conj sorted y)  raw x )))))]   
    (reduce insert [] data)))
;Usage:(in-sort! [6,8,5,9,3,2,1,4,7])
;Returns: [1 2 3 4 5 6 7 8 9]

This is the insertion sort formulated as a monoid in Haskell:

newtype OL x = OL [x]
instance Ord x => Monoid (OL x) where
  mempty = OL []
  mappend (OL xs) (OL ys) = OL (merge xs ys) where
    merge [] ys = ys
    merge xs [] = xs
    merge xs@(x : xs') ys@(y : ys')
       | x <= y = x : merge xs' ys
       | otherwise = y : merge xs ys'

isort :: Ord x => [x] -> OL x
isort = foldMap (OL . pure)

This is how to write a monoid in Clojure:

(def  mempty (+)) ;; 0
(def  mappend +)
(defn mconcat [ms]
    (reduce mappend mempty ms))

(mappend 3 4) ;; 7

(mconcat [2 3 4]) ;; 9

My question is: Can you formulate the insertion sort as a monoid in Clojure?

Answer 1

Here is my attempt, might not be the best one though :)

It's quite a direct translation of the Haskell monoid. Since we don't have auto-currying in Clojure, I needed to make a special comp-2 function.

(defn comp-2 [f g]
  (fn [x y] (f (g x) (g y))))

(defn pure-list [x]
  (cond
   (sequential? x) (if (empty? x) '() (seq x))
   :else (list x)))

(def OL-mempty (list))
(defn OL-mappend [xs ys]
  (letfn [(merge [xs ys]
            (cond
             (empty? xs) ys
             (empty? ys) xs
             :else (let [[x & xs'] xs
                         [y & ys'] ys]
                     (if (<= x y) 
                       (cons x (lazy-seq (merge xs' ys)))
                       (cons y (lazy-seq (merge xs ys')))))))]
    (doall (merge xs ys))))

(defn foldmap [mempty mappend l]
  (reduce mappend mempty l))

(def i-sort (partial foldmap OL-mempty (comp-2 OL-mappend pure-list)))
(i-sort (list 5 3 4 1 2 6)) ;; (1 2 3 4 5 6)

Here is a link to a very nice paper about morphisms in sorts.

Compatibility with reducers

If we want to go with Reducers style monoid then we could embed "mempty" in our "mappend" as a zero-arity branch. Once we do that, we can make our monoid fit right away in the Reducers library:

(require '[clojure.core.reducers :as re])

(defn pure-list [x]
  (cond
   (sequential? x) (if (empty? x) '() (seq x))
   :else (list x)))

(defn sort-monoid 
  ([] '())      ;; mempty
  ([xs ys]      ;; mappend
     (letfn [(merge [xs ys]
               (cond
                (empty? xs) ys
                (empty? ys) xs
                :else (let [[x & xs'] xs
                            [y & ys'] ys]
                        (if (<= x y) 
                          (cons x (lazy-seq (merge xs' ys)))
                          (cons y (lazy-seq (merge xs ys')))))))]
       (doall (merge (pure-list xs) (pure-list ys))))))

(re/reduce sort-monoid (list 2 4 1 2 5))

Answer 2

Here, for reference, is another version which turns the tail recursion modulo cons into tail recursion with an accumulator. For the sake of variety, here is also one way to partially simulate the absent type-classes.

(defprotocol Monoid 
  (mempty [_] ) 
  (mappend [_ xs ys]))

(defn fold-map
  [monoid f xs]
  (reduce (partial mappend monoid) (mempty monoid) (map f xs)))

---

(defn- ord-mappend* 
  [[x & rx :as xs] [y & ry :as ys] a] 
  (cond
    (empty? xs) (concat a ys)
    (empty? ys) (concat a xs)
    :else (if (< x y) 
             (recur rx ys (conj a x))
             (recur xs ry (conj a y)))))

(def Ord 
  (reify Monoid 
    (mempty [_] (list))
    (mappend [_ xs ys] (ord-mappend* xs ys []))))

---

(defn isort [xs] (fold-map Ord list xs))

(defn is-sorted? [xs] (apply < xs))

(is-sorted? (isort (shuffle (range 10000))))
;=> true (sometime later)