Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
412 PurelyFunctional.tv Newsletter

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.

@steffan-westcott
Copy link

steffan-westcott commented Feb 1, 2021

(defn land-coords [y row]
  (keep-indexed #(when (= 1 %2) [%1 y]) row))

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

(defn perimeter [rows]
  (let [lands (reduce into #{} (map-indexed land-coords rows))]
    (->> lands (mapcat neighbours) (remove lands) count)))

@cloojure
Copy link

cloojure commented Feb 1, 2021

(ns tst.demo.core
  (:use tupelo.core tupelo.test)
  (:require
    [tupelo.array :as arr]))  ; Docs:  https://cljdoc.org/d/tupelo/tupelo/21.01.26b/api/tupelo.array

(defn pad-array
  [x]
  (let [nrows0 (arr/num-rows x)
        zcol   (arr/create nrows0 1 0)
        x1     (arr/glue-horiz zcol x zcol)

        ncols1 (arr/num-cols x1)
        zrow   (arr/create 1 ncols1 0)
        x2     (arr/glue-vert zrow x1 zrow)]
    x2))

(def padded-2x3
  [[0 0 0 0 0]
   [0 1 2 3 0]
   [0 4 5 6 0]
   [0 0 0 0 0]])

(dotest
  (is= padded-2x3
    (pad-array [[1 2 3]
                [4 5 6]])))

(defn count-edges
  [x i j]
  (let [edge-val-count #(if (zero? %) 1 0)
        top            (get-in x [(dec i) j])
        bottom         (get-in x [(inc i) j])
        left           (get-in x [i (dec j)])
        right          (get-in x [i (inc j)])
        edge-counts    (mapv edge-val-count
                         [top bottom left right])
        edges-found    (apply + edge-counts)]
    edges-found))

(dotest
  (is= 2 (count-edges padded-2x3 1 1))
  (is= 1 (count-edges padded-2x3 1 2)))

(defn land?
  [x i j]
  (not (zero? (get-in x [i j]))))

(defn perimeter
  [world-in]
  (let [world  (pad-array world-in)
        nrow   (arr/num-rows world)
        ncol   (arr/num-cols world)

        counts (forv [i (range nrow)
                      j (range ncol)
                      :when (land? world i j)] ; also filters out first/last row & col
                 (count-edges world i j))
        result (apply + 0 counts)]
    result))

(dotest
  (is= 0 (perimeter [[0]]))
  (is= 4 (perimeter [[1]]))
  (is= 6 (perimeter [[1 1]]))

  (is= 8 (perimeter [[1 1]
                     [1 1]]))
  (is= 8 (perimeter
           [[0 0 0 0]
            [0 1 1 0]
            [0 1 1 0]
            [0 0 0 0]]))
  (is= 42 (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]]))

  (is= 16 (perimeter
            [[0 1 0 0]
             [1 1 1 0]
             [0 1 0 0]
             [1 1 0 0]])))

@steffan-westcott
Copy link

steffan-westcott commented Feb 1, 2021

Another solution, this time using partition-by:

(defn parts [xs]
  (->> (concat [0] xs [0]) (partition-by identity) rest))

(defn perimeter [rows]
  (->> rows (apply map vector) (concat rows) (mapcat parts) count))

Note this solution assumes all input rows are the same length i.e. the "world" is rectangular.

@SneakyPeet
Copy link

SneakyPeet commented Feb 2, 2021

(defn count-terrain-changes-for-row [row]
  (loop [[current-cell & cells] row
         previous-cell 0
         total-changes 0]
    (if (nil? current-cell)
      (if (= 1 previous-cell)
        (inc total-changes)
        total-changes)
      (if (= current-cell previous-cell)
        (recur cells current-cell total-changes)
        (recur cells current-cell (inc total-changes))))))

(defn perimeter [terrain]
  (let [cols (apply mapv vector terrain)] ;transpose row->cols
    (->> (into terrain cols)
         (map count-terrain-changes-for-row)
         (reduce +))))

soooooo many if statements... Learn from @steffan-westcott 2nd example how to do this in a more clojure way

@steffan-westcott
Copy link

steffan-westcott commented Feb 2, 2021

...and another solution (also assuming equal length rows), this time using dedupe:

(defn perimeter [rows]
  (->> rows (apply map vector) (concat rows) (transduce (mapcat dedupe) +) (* 2)))

@miner
Copy link

miner commented Feb 2, 2021

(defn perimeter [grid]
  (reduce + 0 (for [i (range (count grid))
                    :let [row (nth grid i)]
                    j (range (count row))
                    :when (pos? (nth row j))]
                (- 4
                   (nth row (inc j) 0)
                   (nth row (dec j) 0)
                   (get-in grid [(dec i) j] 0)
                   (get-in grid [(inc i) j] 0)))))

@bnii
Copy link

bnii commented Feb 2, 2021

(defn changes [v]
  (->>
    (concat [0] v [0])
    (partition 2 1)
    (map (fn [[v1 v2]] (if (= v1 v2) 0 1)))
    (apply +)))


(defn perimeter [rows]
  (let [horizontal (apply + (map changes rows))
        vertical   (apply + (map changes (apply mapv vector rows)))]
    (+ horizontal vertical)))

@charJe
Copy link

charJe commented Feb 2, 2021

Great problem! there is typo

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

Unable to resolve symbol: preimeter in this context

@dfuenzalida
Copy link

dfuenzalida commented Feb 3, 2021

My approach was to generate segments representing the top/left/right/bottom boundaries of each piece of land, remove the duplicate segments and count the remaining ones:

(defn land-segments [x y]
  [[x y (inc x) y] [(inc x) y (inc x) (inc y)]
   [x y x (inc y)] [x (inc y) (inc x) (inc y)]])

(defn grid-segments [lines]
  (let [width  (count (first lines))
        height (count lines)]
    (for [i (range width)
          j (range height)
          :when (= 1 (get-in lines [j i]))]
      (land-segments i j))))

(defn perimeter [lines]
  (let [segments (grid-segments lines)]
    (->> (mapcat seq segments)
         frequencies
         (filter (fn [[_ v]] (= 1 v)))
         count)))

(comment

  (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
  )

@sztamas
Copy link

sztamas commented Feb 4, 2021

(defn neighbour-coords [x y]
  (map (partial map +)
       [[0 -1] [1 0] [0 1] [-1 0]]
       (repeat [x y])))

(defn adjacent-land [land-map x y]
  (->> (neighbour-coords x y)
       (map #(get-in land-map (reverse %) 0))
       (apply +)))

(defn perimeter [land-map]
  (->> (for [y     (range (count land-map))
             x     (range (count (first land-map)))
             :let  [v (get-in land-map [y x])
                    land-around (adjacent-land land-map x y)]
             :when (= v 1)]
         (- 4 land-around))
       (apply +)))

@harto
Copy link

harto commented Feb 4, 2021

(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 +))))

@miner
Copy link

miner commented Feb 5, 2021

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))))

@diavoletto76
Copy link

diavoletto76 commented Feb 5, 2021

(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 +))))

@werand
Copy link

werand commented Feb 6, 2021

(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
  ;;
  )

@chopmo
Copy link

chopmo commented Feb 14, 2021

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 +))))

@RedPenguin101
Copy link

RedPenguin101 commented Feb 16, 2021

(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 +)))

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment