ericnormand/00 Consolidate Ranges.md

## 00 Consolidate Ranges.md

      
    Raw
  

              00 Consolidate Ranges.md
            
          
    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.

  
## Andreas Werner.clj
(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]])
   )

## Caio Oliveira.clj
(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]]))

## Eric Normand.clj
(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]])
  )

## Mark Champine.clj
(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)))

## Paul Klinkenberg.clj
(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)))))

## Peter Wilkins.clj
(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)))

## Valentin Waeselynck.clj
(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))))))
	(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))))))