;;; solver.el --- Day 14 -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2022 Óscar Nájera
;;
;; Author: Óscar Nájera <hi@oscarnajera.com>
;; Maintainer: Óscar Nájera <hi@oscarnajera.com>
;; Created: December 16, 2022
;; Modified: December 16, 2022
;;
;;; Commentary:
;;
;;  Day 14
;;
;;; Code:

(require 'seq)
(require 'subr-x)

(defun solver-bounds (str-or-buffer)
  (with-temp-buffer
    (if (stringp str-or-buffer)
        (insert str-or-buffer)
      (insert-buffer-substring str-or-buffer))
    (goto-char (point-min))
    (let ((xmax 0) (ymax 0)
          (xmin 55550) (ymin 55550))
      (while (re-search-forward (rx (group (+ digit)) "," (group (+ digit))) nil t)
        (setq xmax (max xmax (string-to-number (match-string 1))))
        (setq xmin (min xmin (string-to-number (match-string 1))))
        (setq ymax (max ymax (string-to-number (match-string 2))))
        (setq ymin (min ymin (string-to-number (match-string 2)))))
      (list xmax xmin ymax ymin))))

(cl-defstruct (grid (:constructor solver-grid--create)
                    (:copier nil))
  "Represents a snapshot of game of life."
  bounds
  x-len
  y-len
  grid)

(defun solver-grid-create (bounds x-len y-len)
  (solver-grid--create :bounds bounds :x-len x-len :y-len y-len
                       :grid (make-vector (* x-len y-len) 0)))

(defun solver-abyss-grid (bounds)
  (let ((x-len (1+ (- (car bounds) (cadr bounds))))
        (y-len (1+ (elt bounds 2))))
    (solver-grid-create bounds x-len y-len)))

(defun solver-finite-grid (bounds)
  (let* ((y-len (+ 3 (elt bounds 2)))
         (x-len (* 2 y-len)))
    (setcar bounds (+ 500 y-len))
    (setf (elt bounds 1) (- 500 y-len))
    (solver-grid-create bounds x-len y-len)))

(defun solver-point (x y grid)
  (let ((x (- x (cadr (grid-bounds grid)))))
    (when (and (< -1 x (grid-x-len grid))
               (< -1 y (grid-y-len grid)))
      (+ x (* y (grid-x-len grid))))))

(defun solver--wall-line (grid)
  (let (startx starty)
    (while (re-search-forward (rx (group (+ digit)) "," (group (+ digit))) (line-end-position) t)
      (let ((fx (string-to-number (match-string 1)))
            (fy (string-to-number (match-string 2))))
        (unless (null startx)
          (if (= startx fx)
              (cl-loop for y from (min starty fy) to (max starty fy)
                       do (aset (grid-grid grid) (solver-point startx y grid) 1))
            (cl-loop for x from (min startx fx) to (max startx fx)
                     do (aset (grid-grid grid) (solver-point x starty grid) 1))))
        (setq startx fx
              starty fy)))))

(defun solver-walls (str-or-buffer grid &optional finite-grid)
  (with-temp-buffer
    (if (stringp str-or-buffer)
        (insert str-or-buffer)
      (insert-buffer-substring str-or-buffer))
    (goto-char (point-min))
    (while (not (eobp))
      (solver--wall-line grid)
      (forward-line)))
  (when finite-grid
    (cl-loop with yrow = (* (grid-x-len grid) (1- (grid-y-len grid)))
             for x from 0 below (grid-x-len grid)
             do (aset (grid-grid grid) (+ x yrow) 1)))
  grid)

(defun solver-draw-grid (grid)
  (let ((stride (grid-x-len grid)))
    (seq-do-indexed
     (lambda (elt idx)
       (let ((slot (mod idx stride)))
         (when (= 0 slot)
           (insert "\n"))
         (insert (cl-case elt
                   (0 ".")
                   (1 "#")
                   (2 "o")))))
     (grid-grid grid))))

(defun solver-simulate (grid)
  (let ((x 500) (y 0) (drops 0))
    (while
        (ignore-error 'wrong-type-argument ;; went out of grid
          (cond
           ((= 0 (aref (grid-grid grid) (solver-point x (1+ y) grid)))
            (cl-incf y)) ;; check next
           ((= 0 (aref (grid-grid grid) (solver-point (1- x) (1+ y) grid)))
            (cl-incf y)
            (cl-decf x)) ;; check left
           ((= 0 (aref (grid-grid grid) (solver-point (1+ x) (1+ y) grid)))
            (cl-incf y)
            (cl-incf x)) ;; check right
           (t (aset (grid-grid grid) (solver-point x y grid) 2)
              (cl-incf drops)
              (unless (= y 0)
                (setq x 500 y 0))))))
    drops))

(defun solver (instructions grid-type)
  (let* ((bounds (solver-bounds instructions))
        (grid (funcall grid-type bounds)))
    (solver-walls instructions grid (eq #'solver-finite-grid grid-type))
    (solver-simulate grid)))

(ert-deftest test ()
  (should (= 24 (solver "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9" #'solver-abyss-grid)))
  (should (= 665 (solver (find-file-noselect "input") #'solver-abyss-grid)))
  (should (= 93 (solver "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9" #'solver-finite-grid)))
  (should (= 25434 (solver (find-file-noselect "input") #'solver-finite-grid))))