work on p15.2

p15/p15.part2.org

@@ -0,0 +1,132 @@
+#+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-fuffa")
+      (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))
+
+					   10map-things)))))
+
+  (setq walls (coordinates-of ?#)
+	l-crates (coordinates-of ?[)
+	r-crates (coordinates-of ?])				 
+	robot (car (coordinates-of ?@)))
+#+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) 'crate) (setq crates (-replace from to crates)))
+     (t (setq robot to))))
+
+  (defun try-move (p dir &optional pretend)
+    "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))))))))
+#+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 "O") crates)
+      (plot robot "@")
+      (write-file "test-out")))
+#+end_src
+
+Finally, implement the moves and compute the result for part 1
+#+begin_src emacs-lisp
+  (--map (try-move robot it) commands)
+  (save-pic)
+  (-reduce #'+ (--map (+ (car it) (* 100 (cadr it))) crates))
+#+end_src
+
+#+RESULTS:
+: 1371036