Instantly share code, notes, and snippets.

# ericnormand/00 Consolidate Ranges.md

Last active April 28, 2019 13:45
Star You must be signed in to star a gist

range consolidation (from Rosetta Code)

We can represent a range of numbers as a tuple, like this `[1 4]`. That means all real numbers between 1 and 4, including 1 and 4. The task is to write a function that takes a collection of ranges and consolidates them so that there are no overlapping ranges.

For example, `[1 4]` and `[3 5]` overlap, so they would be consolidated to `[1 5]`. `[10.2 15]` does not overlap, so it doesn't change.

`(consolidate [[1 4] [3 5] [10.2 15]]) ;=> [[1 5] [10.2 15]]`

There can be any number of ranges in that collection, and they could be in any order.

This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (defn- normalize [[a b :as r]] (if (< b a) [b a] r)) (defn- consolidate-2 [[s1 e1 :as a] [s2 e2 :as b]] (if (<= s2 e1) [[(min s1 s2) (max e1 e2)]] [b a])) (defn- merge-result [res acc] (let [in-range? (= 1 (count res)) new-acc (if in-range? (pop acc) acc)] (conj new-acc (first res)))) (defn consolidate [s] (when (seq s) (let [sorted-ranges (sort (map normalize s)) start-acc (vector (first sorted-ranges))] (reduce (fn [acc r] (merge-result (consolidate-2 (peek acc) r) acc)) start-acc (rest sorted-ranges))))) (comment (consolidate []) (consolidate nil) (consolidate [[1 2]]) (consolidate [[1 2] [2 4]]) (consolidate [[2 4] [1 2]]) (consolidate [[1 2] [3 4]]) (consolidate [[1 2] [3 4] [5 6] [7 7]]) (consolidate [[4 6] [1 2] [2 4] [7 8] [8.1 10] [10 12]]) (consolidate [[1 4] [3 5] [10.2 15]]) ;=> [[1 5] [10.2 15]] ;; From Rosetta Code (consolidate [[1.1, 2.2]]) (consolidate [[6.1, 7.2], [7.2, 8.3]]) (consolidate [[4, 3], [2, 1]]) (consolidate [[4, 3], [2, 1], [-1, -2], [3.9, 10]]) (consolidate [[1, 3], [-6, -1], [-4, -5], [8, 2], [-6, -6]]) )
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (ns caioaao.purely-functional.solutions.range-consolidation) (defn ranges->events [vs] (mapcat (fn [[a b]] [[:open a] [:close b]]) vs)) (def type->priority {:open 1 :close 2}) ;; since range includes both ends, `open` events have priority over `close` ;; ones. (defn sorted-events [evts] (sort-by (juxt second (comp type->priority first)) evts)) (defn events->ranges [evts] (let [evts (sorted-events evts)] (assert (= :open (ffirst evts)) "First event should always be opening a range") (loop [result [] range-start (-> evts first second) ranges-open 1 [[evt-type evt-point] & evts] (rest evts)] (cond (not evt-type) (do (assert (zero? ranges-open) "Open-ended ranges are not allowed") result) (= :open evt-type) (recur result (if (zero? ranges-open) evt-point range-start) (inc ranges-open) evts) (and (= :close evt-type) (= 1 ranges-open)) (recur (conj result [range-start evt-point]) nil 0 evts) :default (recur result range-start (dec ranges-open) evts))))) (defn consolidate [vs] (-> vs ranges->events events->ranges)) (comment (consolidate [[1 4] [3 5]]) (consolidate [[1 4] [3 5] [10.2 15]]) (consolidate [[1 4] [4 5]]) (consolidate [[1 4] [5 5]]))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (require '[clojure.test.check :as tc]) (require '[clojure.test.check.generators :as gen]) (require '[clojure.test.check.properties :as prop]) ;; solution (defn normalize [range] (vec (sort range))) (defn consolidate* "Consolidate 2 normalized ranges." [a b] (let [[[a1 a2 :as a] [b1 b2 :as b]] (sort-by first [a b])] (if (>= a2 b1) [[a1 (max a2 b2)]] [a b]))) (defn consolidate [ranges] (loop [ranges (vec (sort-by first (map normalize ranges))) i 0] (if (not (contains? ranges (inc i))) ranges (let [c (consolidate* (get ranges i) (get ranges (inc i)))] (if (= 1 (count c)) (recur (-> (subvec ranges 0 i) (into c) (into (subvec ranges (+ 2 i)))) i) (recur ranges (inc i))))))) ;; property-based testing (def gen-range (gen/tuple gen/int gen/int)) (def gen-ranges (gen/vector gen-range)) (defn ints-in [r] (let [[a b] (normalize r)] (set (range a (inc b))))) (defn union [rs] (set (mapcat ints-in rs))) (def consolidate*-overlap (prop/for-all [a gen-range b gen-range x gen/int] (let [a (normalize a) b (normalize b) cs (consolidate* a b)] (let [containing-ranges (filter #(contains? (ints-in %) x) cs)] (or (= 0 (count containing-ranges)) (= 1 (count containing-ranges))))))) ;; we don't want to lose or add any range (def consolidate*-union (prop/for-all [a gen-range b gen-range] (= (union [a b]) (let [a (normalize a) b (normalize b)] (union (consolidate* a b)))))) (def consolidate*-commutative (prop/for-all [a gen-range b gen-range] (let [a (normalize a) b (normalize b)] (= (consolidate* a b) (consolidate* b a))))) (def consolidate-commutative (prop/for-all [[rs rs-shuffled] (gen/let [rngs gen-ranges rngs-s (gen/shuffle rngs)] [rngs rngs-s])] (= (consolidate rs) (consolidate rs-shuffled)))) ;; we don't want to lose or add any range (def consolidate-union (prop/for-all [rs gen-ranges] (= (union rs) (union (consolidate rs))))) (def consolidate-overlap (prop/for-all [rs gen-ranges x gen/int] (let [containing-ranges (filter #(contains? (ints-in %) x) (consolidate rs))] (or (= 0 (count containing-ranges)) (= 1 (count containing-ranges)))))) (comment (tc/quick-check 100 consolidate*-commutative) (tc/quick-check 100 consolidate*-overlap) (tc/quick-check 100 consolidate*-union) (tc/quick-check 100 consolidate-commutative) (tc/quick-check 100 consolidate-overlap) (tc/quick-check 100 consolidate-union) (consolidate []) (consolidate [[0 1]]) (consolidate [[0 1] [1 2]]) (consolidate [[0 3] [4 10] [0 1]]) )
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (defn consolidate "consolidate overlapping ranges in a colletion of ranges" [rs] (let [[frs & rrs] (sort-by first rs)] (reduce (fn [[[a b] :as rs] [c d :as n]] (if (<= a c b) ;; test for overlap ((fnil merge []) (butlast rs) (apply (juxt min max) (concat (last rs) n))) ;; merge 2 ranges (merge rs n))) [frs] rrs)))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (ns fp-exercise-17.core) (defn condense "Finds the minimum and maximum of a set of overlapping ranges and returns a new range" [ranges] [(apply min (map first ranges)) (apply max (map second ranges))] ) (defn range-overlap? "Returns true if r1 and r2 overlap. It follows that it also returns true when r1 and r2 are identical" [r1 r2] (and (<= (first r2) (second r1)) (>= (second r2) (first r1)))) (defn consolidation-pass [ranges] (loop [input-ranges (set ranges) result #{}] (if (empty? input-ranges) result (let [overlapping-ranges (seq (filter #(range-overlap? % (first input-ranges)) input-ranges))] (recur (clojure.set/difference input-ranges overlapping-ranges) (conj result (condense overlapping-ranges))))))) (defn consolidate "Consolidates a collection of ranges." [ranges] ;; A single 'consolidation-pass' on [[1 4] [3 5] [5 10] [10.2 15]] will yield ;; ([1 4] [3 10] [10.2 15]), ergo it is necessary to do multiple passes until ;; the result is identical to the input. ;; Looking forward to a more elegant solution from another submission! (loop [result (consolidation-pass ranges) prev-result-count (inc (count result))] (if (= (count result) prev-result-count) result (recur (consolidation-pass result) (count result)))))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (defn consolidate [xs] (let [[x & xs] (sort-by first (map sort xs))] (reduce (fn [acc [f2 l2]] (let [[f1 l1] (last acc)] (if (<= f2 l1) (conj (vec (butlast acc)) [f1 (max l1 l2)]) (conj acc [f2 l2])))) [x] xs)))
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 (defn consolidate [rs] (let [bounds (->> rs (mapcat (fn [[l h]] [[l -1] [h 1]])) sort) bounds+n-containing (map vector (->> bounds (map (fn [[x _s]] x))) (->> bounds (map (fn [[_x s]] (- s))) (reductions +)))] (->> bounds+n-containing (into [] (comp (partition-by (fn [[_x n]] (zero? n))) (map ffirst) (partition-all 2))))))