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

旧时模样 提交于 2020-01-01 03:37:15

问题


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?


回答1:


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)



回答2:


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


来源:https://stackoverflow.com/questions/21984769/can-you-formulate-the-insertion-sort-as-a-monoid-in-clojure

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!