Skip to content

Instantly share code, notes, and snippets.

@ericnormand
Last active April 28, 2019 13:45
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ericnormand/46c90e4f79836a30777e38b1e1e0c113 to your computer and use it in GitHub Desktop.
Save ericnormand/46c90e4f79836a30777e38b1e1e0c113 to your computer and use it in GitHub Desktop.

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.

(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]])
)
(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]]))
(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]])
)
(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)))
(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)))))
(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)))
(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))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment