412 PurelyFunctional.tv Newsletter

00 Land perimeter.md

Land perimeter

A grid of 1s and 0s shows the location of land and water. A 1 represents a square full of land, a 0 represents a square full of water. Your job is to calculate the perimeter of the land, both as it touches water and touches the edge.

A grid with a single square filled with land has a perimeter of 4, since there are four sides:

(perimeter [[1]]) ;=> 4

Likewise, a single square filled with water has a perimeter of 0:

(perimeter [[0]]) ;=> 0

Two squares of land next to each other share an edge, which reduces the perimeter:

(perimeter [[1 1]]) ;=> 6

The edge of the grid is like an implicit encircling of water:

(perimeter [[1 1]
            [1 1]]) ;=> 8
(perimeter [[0 0 0 0]
            [0 1 1 0]
            [0 1 1 0]
            [0 0 0 0]]) ;=> 8 (same!)

Here are some other weird shapes:

(perimeter [[1 1 1 1 1 1]
            [1 0 0 0 0 1]
            [1 0 1 1 0 1]
            [1 0 0 0 0 1]
            [1 1 1 1 1 1]]) ;=> 42

(perimeter [[0 1 0 0]
            [1 1 1 0]
            [0 1 0 0]
            [1 1 0 0]]) ;=> 16

Thanks to this site for the challenge idea where it is considered Expert in JavaScript. The problem has been modified from the original.

Please submit your solutions as comments on this gist.

(defn perimeter [grid]
  (letfn [(cell-value [cell x y]
            (if (= 0 cell)
              0
              ;; assume an initial cell perimeter value of 4, then deduct 2 for
              ;; each shared boundary with preceding (i.e. north/west)
              ;; neighbours
              (- 4
                 (* 2 (get-in grid [(dec y) x] 0))
                 (* 2 (get-in grid [y (dec x)] 0)))))]
    (->> grid
         (map-indexed (fn [y row] (map-indexed (fn [x cell] (cell-value cell x y)) row)))
         (apply concat)
         (reduce +))))

Refactoring some other solutions and going for performance...

(defn perimeter [grid]
  (let [width (count (nth grid 0))
        v (persistent! (transduce cat conj! (transient []) grid))]
    (* 2 (transduce (map-indexed (fn [n x]
                                   (cond (zero? x) 0
                                         (zero? (rem n width)) (- 2 (nth v (- n width) 0))
                                         :else (- 2 (nth v (dec n)) (nth v (- n width) 0)))))
                    +
                    v))))

(defn- flip [x]
  (if (= 0 x) 1 0))

(defn x-count [xs]
  (count (first xs)))

(def y-count count)

(defn isolate-h [xs]
  (mapv #(into [] (concat [0] % [0])) xs))

(defn isolate-v [xs]
  (let [x-fill (repeat (x-count xs) 0)]
    (-> (into [] (cons (into [] x-fill) xs))
        (conj (into [] x-fill)))))

(defn isolate [xs]
  (-> xs
      (isolate-v)
      (isolate-h)))

(defn select-cell [xs [x y]]
  (let [x-max (dec (x-count xs))
        y-max (dec (y-count xs))]
    (if (and (>= x 0) 
             (<= x x-max)
             (>= y 0)
             (<= y y-max)) 
      (nth (nth xs y) x)
      0)))

(defn compute [xs x y]
  (if (= 1 (select-cell xs [x y]))
    (->> (list [x (dec y)] [x (inc y)] [(dec x) y] [(inc x) y])
         (map (partial select-cell xs))
         (map flip)
         (reduce +))
    0))

(defn perimeter [board]
  (let [island (isolate board)]
    (->> (for [y (range (y-count island))
               x (range (x-count island))] (compute island x y))
         (reduce +))))

(defn border
  "There is only a border if a and b are not equal"
  [a b]
  (if (not (= a b)) 1 0))

(defn count-line [s]
  (first
   (reduce (fn [[borders-in-line l] n]
             [(+ borders-in-line (border l n)) n])
           [0 0]
           (conj s 0))))

(defn transpose [s] (apply map vector s))

(defn perimeter [s]
  (letfn [(count-borders [s] (reduce + (map count-line s)))]
    (+ (count-borders s)
       (count-borders (transpose s)))))

(comment
  (count-line [0])
  (count-line [1])
  (count-line [1 0 1 0 1 1])

  (transpose [[1 1 1 0]
              [0 1 1 0]
              [0 1 1 0]
              [0 0 0 0]])

  (perimeter [[1]]) ;=> 4

  (perimeter [[0]]) ;=> 0

  (perimeter [[1 1]
              [1 1]]) ;=> 8

  (perimeter [[0 0 0 0]
              [0 1 1 0]
              [0 1 1 0]
              [0 0 0 0]]) ;=> 8 (same!)

  (perimeter [[1 1 1 1 1 1]
              [1 0 0 0 0 1]
              [1 0 1 1 0 1]
              [1 0 0 0 0 1]
              [1 1 1 1 1 1]]) ;=> 42

  (perimeter [[0 1 0 0]
              [1 1 1 0]
              [0 1 0 0]
              [1 1 0 0]]) ;=> 16
  ;;
  )

The perimeter of a single land square is 4 minus the number of surrounding land squares.
The multiplication by the square value works because land/water happens to have values 1/0, but this would be a bit too cute for production code. A simple if would be more readable.
Also, in production code I would split out the helper functions - here I just wanted to keep everything in a single form.

(defn perimeter [grid]
  (let [get-at (fn [[x y]]
                 (-> grid
                     (nth y [])
                     (nth x 0)))

        neighbours (fn [[x y]]
                     [[(dec x) y]
                      [x (inc y)]
                      [(inc x) y]
                      [x (dec y)]])

        perim (fn [loc]
                (* (get-at loc)
                   (- 4 (->> (neighbours loc)
                             (map get-at)
                             (reduce +)))))

        coords (for [x (range (count (first grid)))
                     y (range (count grid))]
                 [x y])]
    (->> coords
         (map perim)
         (reduce +))))

(defn all-coordinates [rows]
  (cartesian-product
   (range (count rows))
   (range (count (first rows)))))

(defn neighbours [[x y]]
  [[(dec x) y] [(inc x) y]
   [x (dec y)] [x (inc y)]])

(defn free-edges [grid coord]
  (->> (neighbours coord)
       (keep #(get-in grid %))
       (reduce +)
       (- 4)))

(defn perimeter [grid]
  (->> (all-coordinates grid)
       (remove #(zero? (get-in grid %)))
       (map #(free-edges grid %))
       (apply +)))