И решение Рулля, и второе решение Литвински используют iterate в весьма анаморфной c манере (особенно во втором). Давайте определим unfold с помощью iterate (обычно делается наоборот) и напишем явно анаморфное решение c:
(defn unfold [f s]
(->> s
(list nil)
(iterate (comp f second))
rest
(take-while some?)
(map first)))
(defn merge-sorted [s]
(->> s
(filter seq)
(unfold
(fn [s]
(if (seq s)
(loop [[[mf & mn :as m] & s] s, r ()]
(if-let [[[xf :as x] & s] s]
(let [[m x] (if (< xf mf) [x m] [m x])]
(recur (cons m s) (cons x r)))
(list mf (if mn (cons mn r) r)))))))))
ОБНОВЛЕНИЕ
Вот версия merge-sorted, которая использует reduce вместо loop и recur:
(defn merge-sorted [s]
(->> s
(filter seq)
(unfold
(fn [s]
(if (seq s)
(let [[[mf & mn] r]
(reduce
(fn [[m r] x]
(if (< (first x) (first m))
[x (cons m r)]
[m (cons x r)]))
[(first s) ()]
(rest s))]
(list mf (if mn (cons mn r) r))))))))
UPDATE '
Впечатленный эффективностью решения А. Уэбба после редактирования и считая эту проблему интересной и относительно важной, я просмотрел статьи в Википедии о объединении и k-way merge алгоритмов и этой статьи . Я обнаружил, что есть много возможностей для анализа / экспериментов / улучшений, и решил (пере) реализовать и протестировать несколько алгоритмов. Вот они, упакованные в карту, которым предшествуют некоторые вспомогательные функции, а за ними следуют некоторые функции, полезные для тестирования:
(require ['clojure.core.reducers :as 'reducers])
(defn mapmap [f m]
(reduce #(update %1 %2 f) m (keys m)))
(defn unfold [f s]
(->> s
(list nil)
(iterate (comp f second))
rest
(take-while some?)
(map first)))
(defn foldh [f s]
((fn rec [v]
(f (if (> (count v) 2)
(let [h (quot (count v) 2)]
(map rec [(subvec v 0 h) (subvec v h)]))
v)))
(vec s)))
(defn fold2 [f s]
(loop [s s]
(if (nnext s)
(recur (map f (partition-all 2 s)))
(f s))))
(def merge-sorted
(merge
;direct lazy algorithms
(mapmap
(fn [[prepare choose insert]]
(fn [s]
(->> s
(filter seq)
prepare
(unfold
(fn [s]
(if (seq s)
(let [[[xf & xn] s] (choose s)]
[xf (if xn (insert s xn) s)])))))))
{:min
[identity
(fn [s]
(reduce
(fn [[x s] y]
(if (< (first x) (first y))
[x (cons y s)]
[y (cons x s)]))
[(first s) ()]
(rest s)))
conj]
:sort
[(partial sort-by first)
(juxt first rest)
(fn [s [xf :as x]]
(let [[a b] (loop [a () b (seq s)]
(if-let [[bf & bn] b]
(if (< (first bf) xf)
(recur (cons bf a) bn)
[a b])
[a b]))]
(into (cons x b) a)))]
:lsort
[(partial sort-by first)
(juxt first rest)
(fn [s [xf :as x]]
((fn rec [s]
(lazy-seq
(if-let [[sf] (seq s)]
(if (< (first sf) xf)
(cons sf (rec (rest s)))
(cons x s))
(list x))))
s))]
:heap
[(fn [s]
(let [h (java.util.PriorityQueue.
(count s)
#(< (first %1) (first %2)))]
(run! #(.add h %) s)
h))
(fn [h] [(.poll h) h])
(fn [h x] (.add h x) h)]})
;folding lazy algorithms
(mapmap
(letfn [(merge2 [s]
(lazy-seq
(if-let [[x & s] (seq (filter seq s))]
(if-let [[y] s]
((fn rec [x y]
(lazy-seq
(let [[[xf & xn] y]
(if (< (first x) (first y))
[x y]
[y x])]
(cons xf (if xn (rec xn y) y)))))
x y)
x))))]
(fn [fold] (partial fold merge2)))
{:foldl #(reduce (comp %1 list) %2)
:foldh foldh
:fold2 fold2})
;folding eager algorithms
(mapmap
(letfn [(merge2 [s]
(if-let [[x & s] (seq (filter seq s))]
(if-let [[y] s]
(loop [x x y y acc ()]
(let [[[xf & xn] y]
(if (< (first x) (first y))
[x y]
[y x])
acc (conj acc xf)]
(if xn
(recur xn y acc)
(into y acc))))
x)
()))]
(fn [fold] (partial fold merge2)))
{:efoldp #(reducers/fold 2 (comp %1 list) (comp %1 list) (vec %2))
:efoldh foldh
:efold2 fold2})))
(defn gen-inp [m n]
(->> 0
(repeat m)
(map
(comp
doall
(partial take n)
rest
(partial iterate #(+ % (rand-int 100)))))
doall))
(defn test-merge-sorted [m n & algs]
(->> (or algs (sort (keys merge-sorted)))
(map (juxt name merge-sorted))
(run!
(let [inp (gen-inp m n)]
(fn [[id alg]]
(println id)
;(java.lang.System/gc)
(try
(time (doall (alg inp)))
(catch java.lang.StackOverflowError _
(prn "Stack overflow"))))))))
Прямые ленивые алгоритмы следуют общей схеме, параметризованной тем, как выполняются следующие действия:
- предварительная обработка входа
- вычисление одной выбранной последовательности и остальных
- вставка хвоста выбранной последовательности в остальные
:min похоже на мое первое решение, которое вычисляет минимум на каждой итерации.
:sort похоже на решение Rulle, которое сначала сортирует последовательности и выполняет сортировку-вставку на каждой итерации.
:lsort похоже на :sort, но с ленивой вставкой. Это может вызвать переполнение стека из-за вложенных ленивых последовательностей.
:heap - это простая, но неоптимальная реализация слияния кучи с использованием Java s PriorityQueue s.
Складывание lazy Алгоритмы следуют общей схеме, параметризованной тем, как <=2 -арное слияние расширяется до произвольных арностей.
:foldl похоже на решение А. Уэбба перед редактированием, которое выполняет свертывание влево с использованием reduce. Это может вызвать переполнение стека из-за вложенных ленивых последовательностей.
:foldh - это реализация слияния «разделяй и властвуй», которое складывается путем разделения пополам.
:fold2 похоже на Решение А. Уэбба после редактирования, которое складывается путем разбиения на пары.
Алгоритмы стремительного сворачивания следуют схеме, аналогичной схеме ленивых, но с использованием активного <=2 -арного слияния. *:efoldp - это параллельная реализация слияния «разделяй и властвуй» с использованием clojure.core.reducers/fold, которое выполняет различные <=2 -арные слияния одновременно и, возможно, параллельно, «разветвляясь» каждый раз, когда разделяется пополам.
:efoldh и :efold2 похожи на :foldh и :fold2, но стремятся.
Вкратце о производительности я бы сказал, что для быстрого ленивого слияния один из :foldh, Следует выбрать :fold2 или, возможно, :heap. Что касается активного слияния, то в зависимости от способности оборудования к параллелизму и формы ввода :efoldp может быть быстрее остальных. Для получения дополнительной информации см. Связанные статьи.