116 lines
4.7 KiB
Scheme
116 lines
4.7 KiB
Scheme
(import (scheme base)
|
|
(scheme cxr)
|
|
(scheme file)
|
|
(scheme process-context)
|
|
(scheme write))
|
|
|
|
(define (pad item lst)
|
|
(cons item (reverse (cons item (reverse lst)))))
|
|
|
|
(define (make-list len fill)
|
|
(let loop ((len len)
|
|
(acc '()))
|
|
(if (zero? len)
|
|
acc
|
|
(loop (- len 1) (cons fill acc)))))
|
|
|
|
(define (get-cell lol row col)
|
|
(list-ref (list-ref lol row) col))
|
|
|
|
(define (get-reachables table wid hgh)
|
|
(let loop ((row 1)
|
|
(col 1)
|
|
(sum 0))
|
|
(if (> row hgh)
|
|
sum
|
|
(if (> col wid)
|
|
(loop (+ row 1) 0 sum)
|
|
(begin
|
|
(let ((cell (get-cell table row col)))
|
|
(if (zero? cell)
|
|
(loop row (+ col 1) sum)
|
|
(let ((nbors (+ (get-cell table (- row 1) (- col 1))
|
|
(get-cell table (- row 1) col)
|
|
(get-cell table (- row 1) (+ col 1))
|
|
(get-cell table row (- col 1))
|
|
(get-cell table row (+ col 1))
|
|
(get-cell table (+ row 1) (- col 1))
|
|
(get-cell table (+ row 1) col)
|
|
(get-cell table (+ row 1) (+ col 1)))))
|
|
(if (< nbors 4)
|
|
(begin
|
|
(loop row (+ col 1) (+ sum 1)))
|
|
(loop row (+ col 1) sum))))))))))
|
|
|
|
(define (get-reachables/mark-for-deletion table wid hgh)
|
|
(let loop ((row 1)
|
|
(col 1)
|
|
(sum 0)
|
|
(newtbl '())
|
|
(newcurrow '()))
|
|
(if (> row hgh)
|
|
(values sum (pad (make-list (+ wid 2) 0) (reverse (map (lambda (row) (pad 0 row)) newtbl))))
|
|
(if (> col wid)
|
|
(loop (+ row 1) 1 sum (cons (reverse newcurrow) newtbl) '())
|
|
(begin
|
|
(let ((cell (get-cell table row col)))
|
|
(if (zero? cell)
|
|
(loop row (+ col 1) sum newtbl (cons cell newcurrow))
|
|
(let ((nbors (+ (get-cell table (- row 1) (- col 1))
|
|
(get-cell table (- row 1) col)
|
|
(get-cell table (- row 1) (+ col 1))
|
|
(get-cell table row (- col 1))
|
|
(get-cell table row (+ col 1))
|
|
(get-cell table (+ row 1) (- col 1))
|
|
(get-cell table (+ row 1) col)
|
|
(get-cell table (+ row 1) (+ col 1)))))
|
|
(if (< nbors 4)
|
|
(loop row (+ col 1) (+ sum 1) newtbl (cons 0 newcurrow))
|
|
(loop row (+ col 1) sum newtbl (cons 1 newcurrow)))))))))))
|
|
|
|
(define (part1 file)
|
|
(with-input-from-file file
|
|
(lambda ()
|
|
(let* ((char->one-or-zero (lambda (char) (if (char=? char #\@) 1 0)))
|
|
(lines (let loop ((lines '()))
|
|
(let ((line (read-line)))
|
|
(if (eof-object? line)
|
|
(reverse lines)
|
|
(loop (cons line lines))))))
|
|
(padded-lines (map (lambda (line)
|
|
(pad 0 (map char->one-or-zero (string->list line))))
|
|
lines))
|
|
(len (length (car padded-lines)))
|
|
(wid (- len 2))
|
|
(hgh (length padded-lines))
|
|
(table (pad (make-list len 0) padded-lines)))
|
|
(display (number->string (get-reachables table wid hgh)))
|
|
(newline)))))
|
|
|
|
(define (part2 file)
|
|
(with-input-from-file file
|
|
(lambda ()
|
|
(let* ((char->one-or-zero (lambda (char) (if (char=? char #\@) 1 0)))
|
|
(lines (let loop ((lines '()))
|
|
(let ((line (read-line)))
|
|
(if (eof-object? line)
|
|
(reverse lines)
|
|
(loop (cons line lines))))))
|
|
(padded-lines (map (lambda (line)
|
|
(pad 0 (map char->one-or-zero (string->list line))))
|
|
lines))
|
|
(len (length (car padded-lines)))
|
|
(wid (- len 2))
|
|
(hgh (length padded-lines))
|
|
(table (pad (make-list len 0) padded-lines)))
|
|
(let loop ((tbl table)
|
|
(sum 0))
|
|
(let-values (((removed newtbl) (get-reachables/mark-for-deletion tbl wid hgh)))
|
|
(if (zero? removed)
|
|
(begin
|
|
(display sum)
|
|
(newline))
|
|
(loop newtbl (+ removed sum)))))))))
|
|
|
|
(for-each part1 (cdr (command-line)))
|
|
(for-each part2 (cdr (command-line)))
|