On this page:
4.1 Part 1
4.2 Part 2
4.3 Complete implementation
9.0

4 Day 4: Printing Department🔗

4.1 Part 1🔗

Oh, a graph problem. We are given a 2D grid with items (paper rolls) scattered around. The items are showed as @ letters in the input:

..@@.@@@@.

@@@.@.@.@@

@@@@@.@.@@

@.@@@@..@.

@@.@@@@.@@

.@@@@@@@.@

.@.@.@.@@@

@.@@@.@@@@

.@@@@@@@@.

@.@.@@@.@.

We are asked to count how many items have less the 4 items around. The vincinity is defined as the 8 neighbouring spots, so including diagonals. Let’s start by writing some utilities to look around:

(define (add-pairs x y)
  (cons (+ (car x) (car y))
        (+ (cdr x) (cdr y))))
 
(define directions
  (for*/list ([i (in-inclusive-range -1 1)]
              [j (in-inclusive-range -1 1)]
              #:when (not (and (= i 0) (= j 0))))
    (cons i j)))

That way I’ll be able to add up two positions (actually, one positions and a delta) and use "direction" to look around any position.

Since the problem is just graph lookup, not traversal or anything, I’ll use a set of pairs to store the items’ positions.

Lost way too many Hit Points because I mistakenly used "for/list" instead of "for*/list".

The former will move all the iterators at once, while the latter will properly emulate a nested loop.

(define (input->positions input)
  (for*/list ([(line i) (in-indexed input)]
              [(cell j) (in-indexed (in-string line))]
              #:when (equal? cell #\@))
    (cons i j)))
 
 
(define positions (list->set (input->positions input)))

Then I just need to count, for every items in the room, if it has fewer than 4 other items around.

(define (count-adjacent positions start)
  (for/sum ([m directions])
    (if (set-member? positions (add-pairs start m)) 1 0)))
 
(for/sum ([p (in-set positions)]
          #:when (< (count-adjacent positions p) 4)) 1)

And done!

4.2 Part 2🔗

Now we need to iteratively remove items that we set aside in part 1 (with less than 4 other items around), until we can’t remove anything. The result will be the total number of items removed over all iterations.

No major difficulty here, we can leverage on what we did earlier. A small recursion should do the thick:

(define (part2 positions)
  (let ([removed
         (for/set ([pos (in-set positions)]
                   #:when (< (count-adjacent positions pos) 4)) pos)])
    (cond
      [(set-empty? removed) 0]
      [else (+
             (set-count removed)
             (part2 (set-subtract positions removed)))])))
(part2 positions)

Maybe I could directly partition the set to avoid doing a set filter followed by a set difference, but I don’t think it will make that big of a difference. And the solution is not terribly slow either…

4.3 Complete implementation🔗

#lang racket
 
(define input
  (if (file-exists? "inputs/day4.txt")
      (file->lines "inputs/day4.txt")
      (begin
        (println "Warning: 'inputs/day4.txt' is not found, using 'samples/day4.txt' instead.")
        (file->lines "samples/day4.txt"))))
 
 
(define (input->positions input)
  (for*/list ([(line i) (in-indexed input)]
              [(cell j) (in-indexed (in-string line))]
              #:when (equal? cell #\@))
    (cons i j)))
 
 
(define positions (list->set (input->positions input)))
 
(define (add-pairs x y)
  (cons (+ (car x) (car y))
        (+ (cdr x) (cdr y))))
 
(define directions
  (for*/list ([i (in-inclusive-range -1 1)]
              [j (in-inclusive-range -1 1)]
              #:when (not (and (= i 0) (= j 0))))
    (cons i j)))
 
(define (count-adjacent positions start)
  (for/sum ([m directions])
    (if (set-member? positions (add-pairs start m)) 1 0)))
 
; -----------------------------------------------------------------------------
; PART 1
 
(define (part1 positions)
  (for/sum ([p (in-set positions)]
            #:when (< (count-adjacent positions p) 4))
    1))
 
(define solution1 (part1 positions))
(printf "Part 1: ~a~n" solution1)
 
; -----------------------------------------------------------------------------
; PART 2
 
(define (part2 positions)
  (let ([removed
         (for/set ([pos (in-set positions)]
                   #:when (< (count-adjacent positions pos) 4)) pos)])
    (cond
      [(set-empty? removed) 0]
      [else (+
             (set-count removed)
             (part2 (set-subtract positions removed)))])))
 
(define solution2 (part2 positions))
(printf "Part 2: ~a~n" solution2)