;;;; AoC 2020

;;; Day 1

(defun read-1 (file)
  (with-open-file (stream file)
    (loop for line = (read-line stream nil)
	  while line
	  collect (parse-integer line))))

(defvar *input-1-0* nil)
(setf *input-1-0* (read-1 "inputs/1-0"))
(defvar *input-1-1* nil)
(setf *input-1-1* (read-1 "inputs/1-1.txt"))

(defun solve-1-1 (data target)
  (let ((deficits (map 'list (lambda (n) (- target n)) data)))
    (reduce #'* (intersection data deficits))))

(defun make-deficits (list difference)
  (map 'list (lambda (n) (- difference n)) list))


(defun solve-1-2 (data target)
  (let ((first-deficits (make-deficits data target)))
    (reduce #'*
	    (remove-duplicates
	     (mapcan (lambda (n)
		       (intersection (make-deficits data n) data))
		     first-deficits)))))

(defun solve-1 (data target)
  (time (progn
	  (print (solve-1-1 data target))
	  (print (solve-1-2 data target)))))

;;; Day 2

(defstruct password
  (pchar)
  (prange)
  (word))

(defun read-2 (file)
  (with-open-file (stream file)
    (loop for line = (read-line stream nil)
	  while line
	  collect (let* ((pwlist (split-sequence:split-sequence #\space line))
			 (range (multiple-value-bind (n index)
				    (parse-integer (first pwlist) :junk-allowed t)
				  (list n (parse-integer (first pwlist) :start (1+ index))))))
		    (make-password
		     :pchar (char (second pwlist) 0)
		     :prange range
		     :word (third pwlist))))))

(defun %solve-2-1 (pw)
  (let ((n (count (password-pchar pw) (password-word pw))))
    (and (not (> (first (password-prange pw)) n))
	 (not (< (second (password-prange pw)) n)))))

(defun %solve-2-2 (pw)
  (let ((valid 0))
    (loop for index in (password-prange pw)
	  do (if (eq (password-pchar pw) (elt (password-word pw) (1- index)))
		 (incf valid)))
    (= valid 1)))

(defun %solve-2 (data test)
  (let ((pn 0))
    (loop for p in data
	  do (if (funcall test p)
		 (incf pn)))
    pn))

(defun solve-2 (file)
  (let ((data (read-2 file)))
    (time (progn (print (%solve-2 data #'%solve-2-1))
		 (print (%solve-2 data #'%solve-2-2))))))

;;; Day 3

(defun read-3 (file)
  (with-open-file (stream file)
    (let ((temp-map (loop for line = (read-line stream nil)
			  while line
			  collect line)))
      (make-array (list (length temp-map) (length (first temp-map)))
		  :initial-contents temp-map
		  :element-type 'character))))

(defun step-slope (position direction map)
  (let* ((temp-position (map 'list #'+ direction position))
	 (overflow (map 'list #'> temp-position (array-dimensions map))))
    (cond ((first overflow) :bottom)
	  ((second overflow)
	   (progn (decf (second temp-position) (second (array-dimensions map)))
		  temp-position))
	  (t temp-position))))

(defun solve-3-1 (direction map)
  (let ((tree-count 0))
    (labels ((rec (position)
	       (let ((zero-pos (map 'list #'1- position))
		     (new-pos (step-slope position direction map)))
		 (if (char= (aref map (first zero-pos) (second zero-pos))
			    #\#)
		     (incf tree-count))
		 (unless (eq new-pos :bottom)
		   (rec new-pos)))))
      (rec '(1 1))
      tree-count)))

;; (height width)

(defun solve-3-2 (slopes map)
  (reduce #'* (loop for slope in slopes
		    collecting (solve-3-1 slope map))))

(defun solve-3 (map)
  (time (let ((data (read-3 map)))
	  (print (solve-3-1 '(1 3) data))
	  (print (solve-3-2 '((1 1) (1 3) (1 5) (1 7) (2 1)) data)))))

;;; Day 4

(defvar *passport-fields* (list "byr" "iyr" "eyr" "hgt" "hcl" "ecl" "pid" "cid"))
(defvar *passport-rules-broken* (list nil nil nil nil nil nil nil (lambda (n) (declare (ignore n)) t)))
(defvar *passport-rules* nil)
(setf *passport-rules*
      (list (lambda (n) (and n (let ((nn (ignore-errors (parse-integer n))))
				 (and nn (>= nn 1920) (<= nn 2002)))))
	    (lambda (n) (and n (let ((nn (ignore-errors (parse-integer n))))
				 (and nn (>= nn 2010) (<= nn 2020)))))
	    (lambda (n) (and n (let ((nn (ignore-errors (parse-integer n))))
				 (and nn (>= nn 2020) (<= nn 2030)))))
	    (lambda (h) (and h (multiple-value-bind (n offset) (parse-integer h :junk-allowed t)
				 (let ((unit (subseq h offset)))
				   (cond ((string= unit "cm")
					  (and (>= n 150) (<= n 193)))
					 ((string= unit "in")
					  (and (>= n 59) (<= n 76))))))))
	    (lambda (c) (and c
			     (= (length c) 7)
			     (char= (elt c 0) #\#)
			     (parse-integer (subseq c 1) :radix 16)))
	    (lambda (c) (and c (member c '("amb" "blu" "brn" "gry" "grn" "hzl" "oth") :test #'equal)))
	    (lambda (pid)  (and pid
				(= 9
				   (length pid)
				   (length (remove-if (lambda (n) (not (digit-char-p n))) pid)))))
	    (lambda (cid) (declare (ignore cid)) t)))

(defun read-passport (stream)
  (let ((passport-list
	  (apply #'concatenate 'list 
		 (loop for line = (read-line stream nil)
		       while (and line (not (string= line "")))
		       collect (split-sequence:split-sequence #\space line))))
	(current-passport (make-hash-table :test 'equal)))
    (loop for key in passport-list
	  do (setf (gethash (subseq key 0 3) current-passport)
		   (subseq key 4)))
    current-passport))

(defun read-4 (file)
  (with-open-file (stream file)
    (loop while (peek-char nil stream nil)
	  collect (read-passport stream))))

(defun %solve-4 (data tests)
  (let ((valid-count 0))
    (loop for passport in data
	  do (unless (member 'nil
			      (map 'list (lambda (field test)
					   (if test
					       (funcall test (gethash field passport))
					       (gethash field passport)))
				   *passport-fields* tests))
	       (incf valid-count)))
    valid-count))

(defun solve-4 (file)
  (let ((data (read-4 file)))
    (time (progn (print (%solve-4 data *passport-rules-broken*))
		 (print (%solve-4 data *passport-rules*))))))

(defun binarize (string bits)
  (parse-integer (substitute
		  #\1 (elt bits 1)
		  (substitute
		   #\0 (elt bits 0) string))
		 :radix 2))

;;; Day 5

(defun read-5 (file)
  (with-open-file (stream file)
    (loop for line = (read-line stream nil)
	  while line
	  collect (map 'list #'binarize (list (subseq line 0 7) (subseq line 7)) '("FB" "LR")))))

(defun boarding-ids (data)
  (map 'list (lambda (seat) (+ (* 8 (first seat)) (second seat))) data))

(defun solve-5-1 (data)
  (first (sort (boarding-ids data) #'>)))

(defvar p1-answer)

(defun report-significant-difference (x y)
  (if (not (= (- x y) 1))
      (setf p1-answer (1- x)))
  y)

(defun solve-5-2 (data)
  (reduce #'report-significant-difference (sort (boarding-ids data) #'>)))

(defun solve-5 (file)
  (declare (special p1-answer))  (let ((data (read-5 file))
	(p1-answer nil))
    (time (progn (print (solve-5-1 (copy-seq data)))
		 (solve-5-2 data)
		 (print p1-answer)))))

;;; Day 6

(defun read-forms (stream)
  (loop for line = (read-line stream nil)
	while (and line (not (string= line "")))
	collect line))

(defun read-6 (file)
  (with-open-file (stream file)
    (loop while (peek-char nil stream nil)
	  collect (read-forms stream))))

(defun solve-6-1 (data)
  (reduce (lambda (x y) (+  (if (consp x) (length x) x) (length y)))
	  (map 'list (lambda (form) (remove-duplicates (apply #'concatenate 'list form))) data)))

(defun solve-6-2 (data)
  (length (mapcan (lambda (entry)
		    (reduce #'intersection (map 'list (lambda (l) (coerce l 'list)) entry)))
		  data)))

(defun solve-6 (file)
  (let ((data (read-6 file)))
    (time (progn (print (solve-6-1 data))
		 (print (solve-6-2 data))))))

;;; day 7

(defun read-bag (line)
  (let ((key-bound (search "bags" line)))
    (list (subseq line 0  (1- key-bound))
	  (map 'list (lambda (r)
		       (multiple-value-bind (n index) (parse-integer r :junk-allowed t)
			 (unless (search "no other" r)
			   (list (subseq r  (1+ index) (1- (search "bag" r))) n))))
	       (split-sequence:split-sequence
		#\, (subseq line (+ 1 (length "bags contain") key-bound)))))))

(defun read-7 (file)
  (with-open-file (stream file)
    (loop for line = (read-line stream nil)
	  while line
	  collect (read-bag line))))

(defun build-graph (data)
  (map 'list (lambda (entry)
	       (set  (intern (first entry))
		     (if (null (first (second entry)))
			 nil
			 (map 'list (lambda (r) (cons (intern (first r)) (second r)))
			      (second entry)))))
       (copy-seq data)))

(defun recursive-search (node symbol)
  (cond ((eq node nil)                          nil)
	((member symbol (map 'list #'car node))   t)
	(t (or (recursive-search (eval (caar node)) symbol)
	       (recursive-search  (cdr node) symbol)))))

(defun solve-7-1 (data target)
  (length (remove-if #'null
		     (map 'list (lambda (sym)
				  (recursive-search (eval sym) target))
			  (map 'list (lambda (entry) (intern (first entry))) data)))))

(defun count-bags (node &optional cheat)
  (let* ((node (if (symbolp node) (eval node) node))
	 (bag-multiplier-up (or (cdar node) 0))
	 (bags-up (caar node))
	 (bags-right (cdr node)))
    (cond (cheat        1)
	  ((null node)  0)
	  ((not (null (eval (caar node))))
	   (+ (* bag-multiplier-up (count-bags bags-up))
	      (count-bags bags-right)
	      bag-multiplier-up))
	  (t (+ (* bag-multiplier-up (count-bags bags-up (if (null (eval bags-up)) t)))
	        (count-bags bags-right))))))

(defun solve-7-2 (node)
  (1- (count-bags (list (cons node 1)))))

(defun solve-7 (file target-bag)
  (let ((data (read-7 file))
	(symbol (intern target-bag)))
    (time (progn (build-graph data)
		 (print (solve-7-1 data symbol))
		 (print (solve-7-2 symbol))))))

;;; day 8
;;; intcode again

(defun read-8 (file)
  (let ((data (with-open-file (stream file)
		(loop for line = (read-line stream nil)
		      while line
		      collect (let ((seq (split-sequence:split-sequence #\space line)))
				(list (first seq) (parse-integer (second seq))))))))
    (make-array (length data) :initial-contents data)))

(defun %solve-8 (data &optional alter)
  (let* ((accumulator  0)
	 (position     0)
	 (ht (make-hash-table))
	 (lambdas (list (cons "nop" (lambda (n) (declare (ignore n)) (incf position)))
			(cons "acc" (lambda (n) (incf position) (incf accumulator n)))
			(cons "jmp" (lambda (n) (incf position n))))))
    (labels ((rec (fiddle-ins)
    	       (cond ((gethash position ht)
		      (unless alter accumulator))
		     ((>= position (length data))
		      (values accumulator "EOF"))
		     (t (progn (setf (gethash position ht) (first (aref data position)))
			       (funcall (cdr (assoc
					      (or (if (eql position fiddle-ins)
						      (if (string= (first (aref data position))
								   "nop")
							  "jmp" "nop")
						      nil)
						  (first (aref data position)))
					      lambdas :test #'equal))
					(second (aref data position)))
			       (rec fiddle-ins))))))
      (let ((p1 (rec nil))
	    (index-list nil))
	(if alter
	    (progn
	      (maphash (lambda (k v) (if (or (string= v "nop") (string= v "jmp"))
					 (push k index-list)))
		       ht)
	      (first (remove-if #'null (map 'list (lambda (n)
						    (setf accumulator 0
							  position 0
							  ht (make-hash-table))
						    (rec n))
					    index-list))))
	    p1)))))

(defun solve-8 (file)
  (let ((data (read-8 file)))
    (time (progn (print (%solve-8 data))
		 (print (%solve-8 data t))))))

;;; Day 9

(defun read-9 (file)
  (apply #'vector
    (with-open-file (stream file)
      (loop for line = (read-line stream nil)
	    while line
	    collect (parse-integer line)))))

(defun step-xmas (seed-size data &optional (index 0))
  (let* ((target      (aref data (+ seed-size index)))
	 (window-list (coerce (subseq data index (+ index seed-size)) 'list))
	 (deficits    (map 'list (lambda (n) (- target n)) window-list))
	 (pairs       (intersection deficits window-list)))
    ;; (format t "~a, ~a, ~a ~%" target window-list deficits)
    (if (< 1 (length pairs))
	pairs target)))

(defun walk-xmas (seed-size data)
  (loop for index from 0 to (- (length data) 1 seed-size)
	collecting (step-xmas seed-size data index)))

(defun solve-9-1 (seed-size data)
  (first (remove-if #'consp (walk-xmas seed-size data))))

(defun caterpillar (data target tail head)
  (let ((range-sum (reduce #'+ (subseq data tail head))))
    (cond ((> target range-sum)
	   (caterpillar data target tail (1+ head)))
	  ((< target range-sum)
	   (caterpillar data target (1+ tail) head))
	  (t (subseq data tail head)))))

(defun solve-9-2 (data target)
  (let ((range (sort (caterpillar data target 0 1) #'>)))
    (+ (aref range 0) (aref range (1- (length range))))))

(defun solve-9 (file &optional (step-size 25))
  (time (let* ((data (read-9 file))
	       (p1 (solve-9-1 step-size data)))
	  (print  p1)
	  (print (solve-9-2 data p1)))))

;;; Day 10

(defun read-10 (file)
  (read-9 file))

(defun solve-10-1 (data)
  (let ((data (sort data #'<))
	(steps (list 1 0 1)))
    (reduce (lambda (x y)
	      (let ((difference (- y x)))
		(incf (nth (1- difference) steps))
		y))
	    data)
    (* (first steps) (third steps))))

(let ((ht (make-hash-table)))
  (defun recurse-adapters (data)
    (if (gethash (car data) ht)
	(gethash (car data) ht)
	(setf (gethash (car data) ht)
	      (%recurse-adapters data)))))

(defun %recurse-adapters (data)
  (if (null (cdr data))
      1
      (let ((ceiling (+ 3 (first data))))
	(reduce #'+ (map 'list #'recurse-adapters
			 (remove-if-not
			  #'consp
			  (list (and (cdr data) (>= ceiling (cadr data)) (cdr data))
				(and (cddr data) (>= ceiling (caddr data)) (cddr data))
				(and (cdddr data) (>= ceiling (cadddr data)) (cdddr data)))))))))

(defun solve-10-2 (data)
  (let* ((data (cons 0 (coerce (sort data #'<) 'list))))
    (recurse-adapters data)))

(defun solve-10 (file)
  (let ((data (read-10 file)))
    (time (progn (print (solve-10-1 data))
		 (print (solve-10-2 data))))))