Almost about to give up on this

main
Jacopo De Simoi 11 months ago
parent 5a37b49104
commit c2632418ba
  1. 37
      p16/p16.org

@ -77,7 +77,12 @@ associated scores;
For debugging, print the map
#+begin_src emacs-lisp
(defun plot (p s)
(setq dir-alist '( ((1 0) . ?→)
((-1 0). ?←)
((0 -1). ?↑)
((0 1) . ?↓)))
(defun plot (p s)
(goto-line (+ (cadr p) 1))
(move-to-column (car p))
(insert s)
@ -86,11 +91,11 @@ For debugging, print the map
(defun print-map (&optional p)
(with-temp-buffer
(-each data (lambda (x) (insert x) (insert "\n")))
(insert (format "min-score: %d" (caddr (car start-list))))
(-each book (lambda (x) (plot x ?X)))
(-each start-list (lambda (x) (plot (car x) (cdr (assoc (cadr x) dir-alist)))))
(when p (plot p ?@))
(write-file "tmp")) )
#+end_src
#+RESULTS:
@ -110,38 +115,34 @@ we stop at each turn
(setq start-vector (list start '(1 0) 0)) ; starting point, direction and score
(defun ortho-dirs (dir)
(--filter (= (dot it dir) 0) '((0 1) (0 -1) (-1 0) (1 0))))
(--filter (= (dot it dir) 0) '((0 1) (0 -1) (-1 0) (1 0))))
(defun acceptable-p (p dir)
(and (not (eq (thing-at (neighbour p dir)) 'wall))
(not (-contains-p book (neighbour p dir)))))
(not (-contains-p book (neighbour p dir)))))
(defun sort-vecs (a b)
(< (caddr a) (caddr b)))
(defun explore (start-vect)
(if (eq (thing-at (car start-vect)) 'end) (progn (push (caddr start-vect) scores) nil)
(let* ((p (car start-vect))
(dir (cadr start-vect))
(score (caddr start-vect))
(acceptable-ortho-dirs (--filter (acceptable-p p it) (ortho-dirs dir))))
(push p book)
(-concat (--map (list (neighbour p it) it (+ score 1001)) acceptable-ortho-dirs)
(when (acceptable-p p dir) (list (list (neighbour p dir) dir (1+ score))))))))
(let* ((p (car start-vect))
(dir (cadr start-vect))
(score (caddr start-vect))
(acceptable-ortho-dirs (--filter (acceptable-p p it) (ortho-dirs dir))))
(push p book)
(-concat (--map (list (neighbour p it) it (+ score 1001)) acceptable-ortho-dirs)
(when (acceptable-p p dir) (list (list (neighbour p dir) dir (1+ score))))))))
(setq book nil
scores nil)
scores nil)
(setq start-list (list start-vector))
(while (setq start-list (-concat (explore (car start-list)) (cdr start-list)))
(setq start-list (-sort #'sort-vecs start-list))
)
(print-map)
scores
(setq start-list (-sort #'sort-vecs start-list)))
#+end_src
#+results:
| 81448 | 72432 |
#+RESULTS:
| 81448 | 72432 |

Loading…
Cancel
Save