(defstruct problem
  time
  dist)

(defun parse-integers (string &key (start 0))
  (loop for i = start then (cadr o)
        as o = (multiple-value-list (parse-integer string :start i :junk-allowed t))
        as n = (car o)
        while n
        collect n))

(defun parse-integers-after (string item)
  (parse-integers string :start (1+ (position item string))))

(defun parse-problem (f)
  (with-open-file (s f)
    (let* ((time (parse-integers-after (read-line s) #\:))
           (dist (parse-integers-after (read-line s) #\:)))
      (make-problem :time time
                    :dist dist))))

;; Assumes answer cannot be 0
(defun ways-to-win-race (time dist)
  (labels ((compute-dist (i)
             (* (- time i) i))
           (upper-bound (l r)
             (let ((m (ash (+ l r) -1)))
               (if (= l r)
                   l
                   (if (> (compute-dist m) dist)
                       (upper-bound l m)
                       (upper-bound (1+ m) r))))))
    (let ((l (upper-bound 0 (ash time -1))))
      (- (1+ time) (ash l 1)))))

(defun solve1(f)
  (let ((problem (parse-problem f)))
    (reduce #'* (loop for time in (problem-time problem)
                      for dist in (problem-dist problem)
                      collect (ways-to-win-race time dist))
            :initial-value 1)))

(defun parse-problem2 (f)
  (with-open-file (s f)
    (let* ((time (parse-integers-after (remove #\Space (read-line s)) #\:))
           (dist (parse-integers-after (remove #\Space (read-line s)) #\:)))
      (make-problem :time time
                    :dist dist))))

(defun solve2(f)
  (let* ((problem (parse-problem2 f))
         (time (car (problem-time problem)))
         (dist (car (problem-dist problem))))
    (ways-to-win-race time dist)))

(print (solve1 "data/06/example.txt")) ;; 288
(print (solve1 "data/06/input.txt"))   ;; 1731600
(print (solve2 "data/06/example.txt")) ;; 71503
(print (solve2 "data/06/input.txt"))   ;; 40087680