You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
139 lines
4.4 KiB
139 lines
4.4 KiB
#+title: Solution to p15 part 2 |
|
Rather than modifying the other file it makes sense to create a new one this time |
|
|
|
Process the input file to create the maps and the sequence of moves |
|
#+begin_src emacs-lisp :results none |
|
(require 'dash) |
|
(with-temp-buffer |
|
(insert-file-contents "input") |
|
(goto-char (point-min)) |
|
(replace-regexp "^\\(#.*#\\)$" "\"\\1\"") |
|
(goto-char (point-min)) |
|
(replace-regexp "#" "##") |
|
(goto-char (point-min)) |
|
(replace-regexp "\\." "..") |
|
(goto-char (point-min)) |
|
(replace-regexp "O" "[]") |
|
(goto-char (point-min)) |
|
(replace-regexp "@" "@.") |
|
(goto-char (point-min)) |
|
(insert "(setq map '(") |
|
(goto-char (point-min)) |
|
(replace-regexp "^$" ")\n commands '(") |
|
(goto-char (point-min)) |
|
(replace-regexp "<" "( -1 0)") |
|
(goto-char (point-min)) |
|
(replace-regexp ">" "( 1 0)") |
|
(goto-char (point-min)) |
|
(replace-regexp "v" "( 0 1)") |
|
(goto-char (point-min)) |
|
(replace-regexp "\\^" "( 0 -1)") |
|
(goto-char (point-max)) |
|
(insert "))") |
|
(eval-buffer)) |
|
#+end_src |
|
|
|
Read and parse the map to extract the positions of the various |
|
elements |
|
#+begin_src emacs-lisp :results none |
|
(setq map-things (-map |
|
(lambda (str) (-map #'string-to-char (split-string |
|
str "\\|.+" t))) |
|
map) |
|
height (length map-things) |
|
width (length (car map-things))) |
|
|
|
(defun coordinates-of (e) |
|
(-map #'cadr |
|
(--filter (eq (car it) e) |
|
(-mapcat #'identity |
|
(-map-indexed (lambda (y l) |
|
(-map-indexed (lambda (x el) (list el (list x y))) l)) |
|
|
|
map-things))))) |
|
|
|
(setq walls (coordinates-of ?#) |
|
l-crates (coordinates-of ?[) |
|
r-crates (coordinates-of ?]) |
|
robot (car (coordinates-of ?@))) |
|
|
|
(setq buddies-alist '((l-crate . (1 0)) |
|
(r-crate . (-1 0)) |
|
(robot . nil))) |
|
|
|
|
|
#+end_src |
|
|
|
Implement the move logic. The key function is try-move: it tries to |
|
move stuff in some direction and push anything it can along the way by |
|
calling itself recursively to see if whatever is on the way can itself |
|
be pushed. |
|
#+begin_src emacs-lisp :results none |
|
(defun thing-at (p) |
|
"Returns which object (if any) is present at position P" |
|
(cond |
|
((equal p robot) 'robot) |
|
((-contains-p walls p) 'wall) |
|
((-contains-p l-crates p) 'l-crate) |
|
((-contains-p r-crates p) 'r-crate) |
|
(t nil))) |
|
|
|
(defun neighbour (p dir) |
|
"Returns the neighbour to P in the direction DIR" |
|
(list (+ (car p) (car dir)) |
|
(+ (cadr p) (cadr dir)))) |
|
|
|
(defun do-move (from to) |
|
"Updates the content of the warehouse by moving whatever is at |
|
FROM to the position TO" |
|
(cond |
|
((eq (thing-at from) 'l-crate) (setq l-crates (-replace from to l-crates))) |
|
((eq (thing-at from) 'r-crate) (setq r-crates (-replace from to r-crates))) |
|
(t (setq robot to)))) |
|
|
|
(defun try-move (p dir &optional pretend no-buddy-check) |
|
"Try to move the object at P in the direction DIR. This moves |
|
both halves of a crate together. just pretend to move if PRETEND is non-nil" |
|
(let ((thing (thing-at p))) |
|
(cond |
|
((not thing) t) |
|
((eq thing 'wall) nil) |
|
(t (let* ((dest (neighbour p dir)) |
|
(buddy-dir (when (eq 0 (car dir)) |
|
(cdr (assoc thing buddies-alist)))) |
|
(buddy (when buddy-dir (neighbour p buddy-dir)))) |
|
(when (and (try-move dest dir pretend) |
|
(or no-buddy-check (try-move buddy dir pretend t))) |
|
(or pretend (do-move p dest)))))))) |
|
#+end_src |
|
|
|
This is just to make pretty pictures of the current state |
|
#+begin_src emacs-lisp :results none |
|
(defun make-bg () |
|
(insert (apply #'concat (-repeat height (concat (concat (-repeat width ?. )) "\n"))))) |
|
|
|
(defun plot (p s) |
|
(goto-line (+ (cadr p) 1)) |
|
(move-to-column (car p)) |
|
(insert s) |
|
(delete-char 1)) |
|
|
|
(defun save-pic () |
|
(with-temp-buffer |
|
(make-bg) |
|
(--map (plot it "#") walls); should use --each |
|
(--map (plot it "[") l-crates) |
|
(--map (plot it "]") r-crates) |
|
|
|
(plot robot "@") |
|
(write-file "test-out"))) |
|
#+end_src |
|
|
|
Finally, implement the moves and compute the result for part 2 |
|
#+begin_src emacs-lisp |
|
(--map (and (try-move robot it t) (try-move robot it)) commands) |
|
(-reduce #'+ (--map (+ (car it) (* 100 (cadr it))) l-crates)) |
|
#+end_src |
|
|
|
#+RESULTS: |
|
: 1392847
|
|
|