(ql:quickload '(fiveam uiop arrows))

(defun elf-coordinates (filename)
  (let ((coord (make-hash-table :test #'equal)))
    (with-open-file (input filename)
      (loop for line = (read-line input nil nil)
            and y from 0
            while line
            do (loop for point across line
                     and x from 0
                     when (eq point #\#)
                       do (setf (gethash (cons x y) coord) t))))
    coord))

(defun bounding-box (elf-coordinates)
  (loop for k being the hash-key of elf-coordinates
        minimize (car k) into minx
        minimize (cdr k) into miny
        maximize (car k) into maxx
        maximize (cdr k) into maxy
        finally (return (list minx miny maxx maxy))))

(defparameter *moves*
  (vector (vector (cons -1 -1) (cons  0 -1) (cons  1 -1))   ;; North
          (vector (cons -1  1) (cons  0  1) (cons  1  1))   ;; South
          (vector (cons -1 -1) (cons -1  0) (cons -1  1))   ;; West
          (vector (cons  1 -1) (cons  1  0) (cons  1  1)))) ;; East

(defun draw (elves)
  (with-output-to-string (out)
    (destructuring-bind (minx miny maxx maxy) (bounding-box elves)
      (loop for y from miny to maxy
            do (princ #\Newline out)
               (loop for x from minx to maxx
                     do (princ (if (gethash (cons x y) elves)
                                   #\# #\.) out))))))

(defun pair-add (a b)
  (cons (+ (car a) (car b))
        (+ (cdr a) (cdr b))))

(defun test-move (dir elf others)
  (loop for next-dir across dir
        never (gethash (pair-add elf next-dir) others)))

(defun all-moves (step elves)
  (let ((next-places (make-hash-table :test #'equal)))
    (loop for elf being the hash-key of elves
          do
             (let ((options (loop for dirs below 4
                                  collect (arrows:-> (aref *moves* (mod (+ dirs step) 4))
                                                     (test-move elf elves)))))
               (unless (or (notany #'null options) ;; all free don't move
                           (every #'null options)) ;; all blocked don't move
                 (let ((prop
                         (arrows:->
                          (aref *moves* (mod (+ (position t options) step) 4))
                          (aref 1)
                          (pair-add elf))))
                   (setf (gethash prop next-places)
                         (cons elf (gethash prop next-places)))))))
    next-places))

(defun move-elves! (next-places elves)
  (loop for target being the hash-key of next-places using (hash-value source)
        when (null (cdr source)) ;; no conflicts on target
          do (remhash (car source) elves)
             (setf (gethash target elves) t)))

(defun empty-ground (elves)
  (destructuring-bind (minx miny maxx maxy) (bounding-box elves)
    (- (* (1+ (- maxx minx))
          (1+ (- maxy miny)))
       (hash-table-count elves))))

(defun solver (elves limit)
  (loop for step from 0 below limit
        for moves = (all-moves step elves)
        while (plusp (hash-table-count moves))
        do (move-elves! moves elves)
        finally (return step)))

(defun part1 (filename)
  (let ((elves (elf-coordinates filename)))
    (solver elves 10)
    (empty-ground elves)))

(fiveam:test solutions
  (fiveam:is (= 110  (part1 "eg-in")))
  (fiveam:is (= 4052 (part1 "input")))
  (fiveam:is (= 20 (1+ (solver (elf-coordinates "eg-in") 1000))))
  (fiveam:is (= 978 (1+ (solver (elf-coordinates "input") 1000)))))