(asdf:load-system :adventofcode2020)
(in-package #:adventofcode2020)
(named-readtables:in-readtable fn-reader)

(defun parse-layout (layout)
  (make-array (list (length layout) (length (car layout)))
              :initial-contents layout))

(defun get-surr (game)
  (lambda (i j)
    (if (char= #\. (aref game i j)) -1
      (->>
        (map-product λ(list (funcall _0 i) (funcall _1 j))
                     (list #'identity #'1+ #'1-)
                     (list #'identity #'1+ #'1-)) 
        (remove-if-not λ(apply #'array-in-bounds-p game _)) 
        (mapcar λ(apply #'aref game _))
        (count #\#)))))

(defun get-sightlines (game)
  (let ((functions (map-product #'list
                    (list #'identity #'1+ #'1-)
                    (list #'identity #'1+ #'1-))))
    (lambda (i j)
      (if (char= #\. (aref game i j)) -1
          (loop for (f g) in functions
                counting 
                 (do ((fi (funcall f i) (funcall f fi))
                      (gj (funcall g j) (funcall g gj)))
                     ((or (not (array-in-bounds-p game fi gj))
                          (not (char= #\. (aref game fi gj)))
                          (and (= i fi) (= j gj)))
                      (when (array-in-bounds-p game fi gj)
                        (char= #\# (aref game fi gj))))))))))

(defun step-game (game &key (surr #'get-surr))
  (destructuring-bind (row col) (array-dimensions game)
    (let* ((get-surr (funcall surr game))
           (seat-limit (if (eq surr #'get-surr) 5 6))
           (calc-next (lambda (i j)
                        (let ((occ (funcall get-surr i j))
                              (val (aref game i j))) 
                          (cond ((=  occ 0) #\#) 
                                ((>= occ seat-limit) #\L)
                                (t val))))))
      (->> 
        (loop for i below row collecting 
              (loop for j below col collecting (list i j)))
        (mapcar λ(mapcar (curry #'apply calc-next) _)) 
        (parse-layout)))))

(defun fixed-point (game &key (surr #'get-surr))
  (let ((step (step-game game :surr surr)))
    (if (equalp game step) game
        (fixed-point step :surr surr))))

(defun count-occupied (game)
  (loop for i below (array-dimension game 0)
        summing (loop for j below (array-dimension game 1)
                      counting (char= #\# (aref game i j)))))

(day 11 input
  (let ((game (parse-layout (list-from input))))
    (part1 (count-occupied (fixed-point game :surr #'get-surr)))
    (part2 (count-occupied (fixed-point game :surr #'get-sightlines)))))

(def-suite day11)
(in-suite day11)

(defvar *simple-layout*
  '("L.LL.LL.LL"
    "LLLLLLL.LL"
    "L.L.L..L.."
    "LLLL.LL.LL"
    "L.LL.LL.LL"
    "L.LLLLL.LL"
    "..L.L....."
    "LLLLLLLLLL"
    "L.LLLLLL.L" 
    "L.LLLLL.LL"))

(test get-sightlines
  (is (equal 8 (funcall (get-sightlines 
                          (parse-layout '(".......#."
                                          "...#....."
                                          ".#......."
                                          "........."
                                          "..#L....#"
                                          "....#...."
                                          "........."
                                          "#........"
                                          "...#....."))) 4 3)))
  (is (equal 0 (funcall (get-sightlines 
                          (parse-layout '("............."
                                          ".L.L.#.#.#.#."
                                          "............."))) 1 1)))
  (is (equal 0 (funcall (get-sightlines 
                          (parse-layout '(".##.##."
                                          "#.#.#.#"
                                          "##...##"
                                          "...L..."
                                          "##...##"
                                          "#.#.#.#"
                                          ".##.##."))) 3 3))))

(test step-game
  (is (equalp
        (parse-layout '("#.LL.L#.##"
                        "#LLLLLL.L#"
                        "L.L.L..L.."
                        "#LLL.LL.L#"
                        "#.LL.LL.LL"
                        "#.LLLL#.##"
                        "..L.L....."
                        "#LLLLLLLL#"
                        "#.LLLLLL.L"
                        "#.#LLLL.##"))
        (step-game (step-game (parse-layout *simple-layout*)))))
  (is (equalp
        (parse-layout '("#.LL.LL.L#"
                        "#LLLLLL.LL"
                        "L.L.L..L.."
                        "LLLL.LL.LL"
                        "L.LL.LL.LL"
                        "L.LLLLL.LL"
                        "..L.L....."
                        "LLLLLLLLL#"
                        "#.LLLLLL.L"
                        "#.LLLLL.L#"))
        (step-game (step-game (parse-layout *simple-layout*) 
                              :surr #'get-sightlines) 
                   :surr #'get-sightlines))))

(test fix
  (is (equalp
        (parse-layout '("#.#L.L#.##"
                        "#LLL#LL.L#"
                        "L.#.L..#.."
                        "#L##.##.L#"
                        "#.#L.LL.LL"
                        "#.#L#L#.##"
                        "..L.L....."
                        "#L#L##L#L#"
                        "#.LLLLLL.L"
                        "#.#L#L#.##"))
        (fixed-point (parse-layout *simple-layout*))))
  (is (equalp
        (parse-layout '("#.L#.L#.L#"
                        "#LLLLLL.LL"
                        "L.L.L..#.."
                        "##L#.#L.L#"
                        "L.L#.LL.L#"
                        "#.LLLL#.LL"
                        "..#.L....."
                        "LLL###LLL#"
                        "#.LLLLL#.L"
                        "#.L#LL#.L#"))
        (fixed-point (parse-layout *simple-layout*)
                     :surr #'get-sightlines))))


(run! 'day11)