afiw/AOC
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compare commits

base: afiw:7930532c7de23bf8538f4c06708747ad9eeac5df
Branches Tags
afiw:mistress
..
compare: afiw:ac4275315dc904f6c55b60b942069a1d42f70cb4
Branches Tags
afiw:mistress

No commits in common. "7930532c7de23bf8538f4c06708747ad9eeac5df" and "ac4275315dc904f6c55b60b942069a1d42f70cb4" have entirely different histories.
7930532c7d ... ac4275315d

4 changed files with 1 additions and 120 deletions
Download patch file Download diff file Expand all files Collapse all files

1
3/main.scm
View file

@ -1,5 +1,6 @@
(import (scheme base)
(scheme char)
(scheme cxr)
(scheme file)
(scheme process-context)
(scheme write))

2
4/GNUmakefile
View file

@ -1,2 +0,0 @@
# -*- makefile-gmake -*-
include ../gnu.mk

116
4/main.scm
View file

@ -1,116 +0,0 @@
(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)))

2
4/makefile
View file

@ -1,2 +0,0 @@
# -*- makefile-bsdmake -*-
.include "../common.mk"