407 - PurelyFunctional.tv Newsletter

00 overlapping rectangles.md

Area of overlapping rectangles

Write a function that takes two rectangles and returns the area of the overlap. Sometimes the overlap is zero!

(overlap-area [{:top-left {:x 0 :y 0}
                :bottom-right {:x 10 :y 10}}
               {:top-left {:x 5 :y 5}
                :bottom-right {:x 15 :y 15}}]) ;=> 25

;; 2 identical rectangles
(overlap-area [{:top-left {:x 0 :y 0}
                :bottom-right {:x 1 :y 1}}
               {:top-left {:x 0 :y 0}
                :bottom-right {:x 1 :y 1}}]) ;=> 25

;; no overlap
(overlap-area [{:top-left {:x 0 :y 0}
                :bottom-right {:x 1 :y 1}}
               {:top-left {:x 6 :y 6}
                :bottom-right {:x 8 :y 8}}]) ;=> 0

;; enclosing rectangles
(overlap-area [{:top-left {:x 0 :y 0}
                :bottom-right {:x 1 :y 1}}
               {:top-left {:x -1 :y -1}
                :bottom-right {:x 2 :y 2}}]) ;=> 1

Thanks to this site for the challenge idea where it is considered Very Hard in JavaScript.

Please submit your solutions as comments on this gist.

(defn interval [rect axis]
  (map #(get-in rect [% axis]) [:top-left :bottom-right]))

(defn overlap-length [[min1 max1] [min2 max2]]
  (max 0 (- (min max1 max2) (max min1 min2))))

(defn overlap-area [[rect1 rect2]]
  (apply * (map #(overlap-length (interval rect1 %) (interval rect2 %)) [:x :y])))

(defn overlap-area [[r1 r2]]
  (let [ho (- (min (:x (:bottom-right r1)) (:x (:bottom-right r2)))
              (max (:x (:top-left r1)) (:x (:top-left r2))))
        vo (-  (min (:y (:bottom-right r1)) (:y (:bottom-right r2)))
               (max (:y (:top-left r1)) (:y (:top-left r2))))]
    (if (or (neg? ho) (neg? vo)) 0 (* ho vo))))

Just for fun, here's a (slightly golfed) generalised version which accepts any number of rectangles:

(defn overlap-area [rects]
  (letfn [(overlap-length [axis]
    (max 0 (- (reduce min (map (comp axis :bottom-right) rects))
              (reduce max (map (comp axis :top-left) rects)))))]
    (* (overlap-length :x) (overlap-length :y))))

Implementation for 0..n rectangles:

(defn xs [r]
  [(get-in r [:top-left :x]) (get-in r [:bottom-right :x])])

(defn ys [r]
  [(get-in r [:top-left :y]) (get-in r [:bottom-right :y])])

(def length (comp (partial apply -) reverse xs))
(def height (comp (partial apply -) reverse ys))

(defn rect-intersect [rects]
  (when (seq rects)
    (let [r {:top-left
             (->> rects
                  (map :top-left)
                  (apply merge-with max))
             :bottom-right
             (->> rects
                  (map :bottom-right)
                  (apply merge-with min))}]
      (when (and (apply < (xs r))
                 (apply < (ys r)))
        r))))

(defn overlap-area [rects]
  (if-let [rect (rect-intersect rects)]
    (* (length rect) (height rect))
    0))

Inspired by @sztamas using merge-with:

(defn overlap-area [rects]
  (let [{left :x top :y} (apply merge-with max (map :top-left rects))
        {right :x bottom :y} (apply merge-with min (map :bottom-right rects))]
    (* (max 0 (- right left)) (max 0 (- bottom top)))))

@steffan-westcott That's nice, I like it!

Neat challenge...I had to do some serious editing to

• fix a bug (when comparing line segments a multi-level sort is necessary) and
• provide for multiple rectangles, as exampled above.

In doing so, I realized that simply taking the smallest area wasn't working when dealing with many rectangles, as one has to keep track of the smallest rectangle instead - for lack of better insight:

(defn sort-segs [& segs]
  (sort (map #(vec (sort %)) segs)))

(defn intersect [seg1 seg2]
  (let [[[start-1 end-1] [start-2 end-2]] 
        (sort-segs seg1 seg2)]
    (when (< start-2 end-1)
      [start-2 (min end-1 end-2)])))

(defn overlap-rectangle [[[r1x1 r1y1] [r1x2 r1y2] :as r1] 
                         [[r2x1 r2y1] [r2x2 r2y2] :as r2]]
  (when (and r1 r2)
    (let [[x1 x2 :as xs] (intersect [r1x1 r1x2] [r2x1 r2x2])
          [y1 y2 :as ys] (intersect [r1y1 r1y2] [r2y1 r2y2])] 
      (when (and xs ys)
        [[x1 y1] [x2 y2]]))))

(defn area [[[x1 y1] [x2 y2] :as r]]
  (if r
    (* (- x2 x1) (- y2 y1))
    0))

(defn unwrap [rect]
  [[(-> rect :top-left :x), (-> rect :top-left :y)],
   [(-> rect :bottom-right :x), (-> rect :bottom-right :y)]])

(defn overlap-area 
  ([rects]
   (let [[[[r1 r2 :as part1]] parts] 
         (->> rects (map unwrap) (partition 2 1) (split-at 1))]
     (when (seq part1)
       (->> parts
            (reduce (fn [acc [r1 r2]]
                      (if-not acc
                        (reduced nil)
                        (-> (overlap-rectangle r1 r2) 
                            (overlap-rectangle acc))))
                    (overlap-rectangle r1 r2))
            area)))))

Here's an intentionally longer solution inspired by the theme of the recent newsletters: timeless truths. It tries to establish some truths about lines and rectangles, then builds up a solution around those truths.

(defn clamp
  "Constrains a number between two others."
  [num minimum maximum]
  (cond
    (< num minimum) minimum
    (< maximum num) maximum
    :else           num))

(defn line-length
  "The length of a line (possibly zero)."
  [[start end]]
  (- end start))

(defn lines-overlap
  "The line covered by both provided lines.

  Always returns a line, though will return a zero-length line if and only if
  the lines do not overlap."
  [[a-start a-end] [b-start b-end]]
  [(clamp a-start b-start b-end)
   (clamp a-end b-start b-end)])

(defn rect-t-line
  "The (possibly zero-length) line on the top side of the rectangle."
  [{:keys [top-left bottom-right]}]
  [(:x top-left) (:x bottom-right)])

(defn rect-l-line
  "The (possibly zero-length) line on the left side of the rectangle."
  [{:keys [top-left bottom-right]}]
  [(:y top-left) (:y bottom-right)])

(defn rect-area
  "The area of the rectangle `rect`. Will be zero if and only if either of the
  sides are zero-length."
  [rect]
  (* (line-length (rect-t-line rect))
     (line-length (rect-l-line rect))))

(defn rects-overlap
  "A rectangle representing the region covered by both (possibly zero-area)
  rectangles `a` and `b`.

  Always returns a rectangle, though the rectangle will be zero-area if and only
  if `a` and `b` do not overlap."
  [a b]
  (let [[tl-x br-x] (lines-overlap (rect-t-line a) (rect-t-line b))
        [tl-y br-y] (lines-overlap (rect-l-line a) (rect-l-line b))]
    {:top-left     {:x tl-x :y tl-y}
     :bottom-right {:x br-x :y br-y}}))

(defn overlap-area
  "The area of the region covered by all the (possibly zero-area) rectangles."
  [rects]
  (rect-area (reduce rects-overlap rects)))

@ericnormand, the comment after the second example says the area should be 25, but I think that's a typo.

Here are some unit tests I have been using in case it may be useful - feel free to correct me if I missed something.

Since this is a non-trivial challenge, it would probably be a good application for generative testing at least for the "timeless truths". However I think this a case where both unit and generative testing can complement each other, since identifying a numerical result from generated input would probably require using another non-trivial solution (or having that extra insight I don't have).

(require '[clojure.test :refer [deftest testing are]])

(defn wrap 
  ([x1 y1 x2 y2 & rects]
   (cons (wrap x1 y1 x2 y2) 
         (->> rects (partition 4)
              (map #(apply wrap %)))))
  ([top-x top-y bot-x bot-y]
   {:top-left {:x top-x :y top-y}
    :bottom-right {:x bot-x :y bot-y}}))

(deftest overlap-area-test 
  (are [rects exp] 
      (= exp (overlap-area (apply wrap rects)))
    ;; overlapping
    [0 0 10 10, 5 5 15 15]
    25
    ;; switch coordinates
    ;; [0 10 10 0, 5 5 15 15] 
    ;; 25
    ;; also switch order
    ;; [5 15 15 5, 0 10 10 0]
    ;; 25
    [0 0 1 1, -1 -1 2 2]
    1
    [0 0 1 1, 0 0 1 1]
    1
    [2 -9 13 -4, 5 -11 7 -2]
    10
    ;; [2 -4 13 -9, 5 -2 7 -11]
    ;; 10
    [-8 -7 -4 0, -5 -9 -1 -2]
    5
    [-11 2 -1 6, -8 2 -4 9] 
    16
    [-4 -6 1 1, -2 -2 3 4]
    9
    [-3 -3 3 3, -1 -1 1 1]
    4
    [5 -11 7 -2, 6 -6 15 -3]
    3

    ;; non-overlapping
    [1 1 4 4, 4 4 6 6]
    0
    [1 1 4 3, 4 4 6 6]
    0
    [0 0 1 1, 6 6 8 8]
    0))

(deftest overlap-area-many-test
  (are [rects exp] (= exp (overlap-area (apply wrap rects)))
    ;; overlapping
    [1 1 4 4, 1 1 2 2]
    1
    [1 1 4 4, 1 1 2 2, 1 1 3 3]
    1
    [0 0 3 3, 1 1 4 5, -1 2 10 20]
    2
    [2 -9 13 -4, 5 -11 7 -2, 6 -6 15 -3]
    2
    [2 -9 13 -4, 6 -6 15 -3, 5 -11 7 -2]
    2

    ;; non-overlapping
    [1 1 4 4, 4 4 6 6, 1 1 2 2] 
    0))

EDIT: I commented out the tests which swap corners within a rectangle, as e.g. :top-left has semantic meaning which some solutions depend on.

@sztamas @steffan-westcott and @mainej, nice multi-rectangle enabled solutions!

@sztamas and @steffan-westcott that is really nice insight, using the natural ordering of :top-left and :bottom-right together with the use of merge-with to keep track of the smallest common rectangles, for a super compact solution - I wish I had though of that 👍

Way late to the party, but I found the challenge recently and couldn't stop thinking about it. So here is my solution with an attempt to optimise for readability:

(defn- overlap-axis [l1 l2]
  (let [[[a1 a2] [b1 b2]] (sort-by first [l1 l2])]
    (cond
      ;; a1   a2
      ;; |----|  b1   b2
      ;;         |----|
      (>= b1 a2) 0

      ;; |---------------|
      ;;         |----|
      (>= a2 b2) (- b2 b1)

      ;; |----------|
      ;;         |----|
      :else      (- a2 b1))))

(defn overlap-area
  [[r1 r2]]
  (* (overlap-axis (map :x (vals r1))
                   (map :x (vals r2)))
     (overlap-axis (map :y (vals r1))
                   (map :y (vals r2)))))

A version that uses sets and works on any number of rectangles.

(require '[clojure.set :as set])

(defn spots [rect]
  (let [startx (:x (:top-left rect))
        starty (:y (:top-left rect))
        endx (:x (:bottom-right rect))
        endy (:y (:bottom-right rect))]
    (flatten
     (map (fn [x]
            (map (fn [y]
                   (symbol (str x "," y)))
                 (range starty endy)))
          (range startx endx)))))

(defn overlap-area [rectangles]
  (->>
   rectangles
   (map spots)
   (map set)
   (reduce set/intersection)
   (count)))