diff --git a/p15/p15.part2.org b/p15/p15.part2.org index 0e55f8f..3fcf16a 100644 --- a/p15/p15.part2.org +++ b/p15/p15.part2.org @@ -5,18 +5,18 @@ 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-fuffa") + (insert-file-contents "input") (goto-char (point-min)) (replace-regexp "^\\(#.*#\\)$" "\"\\1\"") (goto-char (point-min)) (replace-regexp "#" "##") (goto-char (point-min)) - (replace-regexp "\\." "..") + (replace-regexp "\\." "..") (goto-char (point-min)) (replace-regexp "O" "[]") (goto-char (point-min)) (replace-regexp "@" "@.") - (goto-char (point-min)) + (goto-char (point-min)) (insert "(setq map '(") (goto-char (point-min)) (replace-regexp "^$" ")\n commands '(") @@ -37,25 +37,31 @@ 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))) + (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)) + (--filter (eq (car it) e) + (-mapcat #'identity + (-map-indexed (lambda (y l) + (-map-indexed (lambda (x el) (list el (list x y))) l)) - 10map-things))))) + map-things))))) (setq walls (coordinates-of ?#) - l-crates (coordinates-of ?[) - r-crates (coordinates-of ?]) - robot (car (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 @@ -69,36 +75,36 @@ be pushed. ((equal p robot) 'robot) ((-contains-p walls p) 'wall) ((-contains-p l-crates p) 'l-crate) - ((-contains-p r-crates p) 'r-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)))) + (+ (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) 'crate) (setq crates (-replace from to crates))) + ((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) + (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) - ((eq thing 'r-crate) - (let ((dest (neighbour p dir)) - (buddy (neighbour p ' (-1 0))) ) ;got here - (when (try-move dest dir pretend) - (or pretend (do-move p dest))))) - (t (let ((dest (neighbour p dir))) - (when (try-move dest dir pretend) - (or pretend (do-move p dest)))))))) + (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 @@ -116,17 +122,18 @@ This is just to make pretty pictures of the current state (with-temp-buffer (make-bg) (--map (plot it "#") walls); should use --each - (--map (plot it "O") crates) + (--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 1 +Finally, implement the moves and compute the result for part 2 #+begin_src emacs-lisp - (--map (try-move robot it) commands) - (save-pic) - (-reduce #'+ (--map (+ (car it) (* 100 (cadr it))) crates)) + (--map (and (try-move robot it t) (try-move robot it)) commands) + (-reduce #'+ (--map (+ (car it) (* 100 (cadr it))) l-crates)) #+end_src #+RESULTS: -: 1371036 +: 1392847