;;
;; 111004 Railroads
;;

(defun partition-with (pred l)
  (loop
   with head = nil
   for r on l
   if (funcall pred (first r))
   return (list (reverse head) r)
   else do (push (first r) head)
   finally return (list (reverse head) nil)))

(defun dijkstra (g &optional v-start)
  (let* ((max-v (length edges))
         (in-tree (make-bool-vector max-v nil))
         (parents (make-vector max-v nil))
         (distances (make-vector max-v most-positive-fixnum)))
    (aset distances (or v-start 0) 0)
    (loop
     with v = 0
     while (not (aref in-tree v))
     do (aset in-tree v t)
     do (dolist (e (elt g v))
          (when (> (elt distances (car e)) (+ (elt distances v) (cdr e)))
            (aset distances (car e) (+ (elt distances v) (cdr e)))
            (aset parents (car e) v)))
     do (loop
         with d = most-positive-fixnum
         for i from 0 to (1- max-v)
         do (when (and
                   (not (elt in-tree i))
                   (> d (elt distances i)))
              (setq d (elt distances i))
              (setq v i))))
    (list distances parents)))

(defun solve (names start goal lines)
  (let* ((max-v (apply '+ (mapcar 'length lines)))
         (labels nil)
         (edges (make-vector max-v nil))
         (timetables (make-vector max-v nil)))
    (cl-labels (
                (add-vertex (val)
                            (let ((v (length labels)))
                              (setq labels (nconc labels (list val)))
                              v))
                (add-edge (v1 v2 w)
                          (push (cons v2 w) (elt edges v1)))
                (add-to-timetable (v)
                                  (let ((v-label (elt labels v)))
                                    (aset timetables (car v-label)
                                          (let ((earlier-later (partition-with (lambda (time-vertex)
                                                                                 (> (car time-vertex) (cdr v-label)))
                                                                               (aref timetables (car v-label)))))
                                            (nconc (first earlier-later) (list (cons (cdr (elt labels v)) v)) (second earlier-later)))))
                                  v)
                (get-station-stop-create (s)
                                         (destructuring-bind (n h m) s
                                           (let ((i (position n names :test 'equal))
                                                 (time (+ m (* 60 h))))
                                             (or
                                              (cdr (assoc time (aref timetables i)))
                                              (add-to-timetable (add-vertex (cons i time))))))))
      (get-station-stop-create start)
      (dolist (path (mapcar (lambda (l)
                              (mapcar (lambda (x) (get-station-stop-create x)) l))
                            lines))
        (loop
         for p on path
         until (null (second p))
         do (add-edge
             (first p)
             (second p)
             (- (cdr (elt labels (second p))) (cdr (elt labels (first p)))))))
      (loop
       for city across timetables
       do (loop
           for time-vertex on city
           until (null (second time-vertex))
           do (add-edge
               (cdr (first time-vertex))
               (cdr (second time-vertex))
               (- (car (second time-vertex)) (car (first time-vertex))))))
      (destructuring-bind (distances parents) (dijkstra edges 0)
        (loop
         with earliest-arrival = nil
         with time = most-positive-fixnum
         for v from 0 to (1- max-v)
         for city-time in labels
         for d across distances
         if (and
             (not (null d))
             (= (position goal names :test 'equal) (car city-time))
             (< d time))
         do
         (setq time d)
         (setq earliest-arrival v)
         finally return (when earliest-arrival
                          (let ((departure (elt labels (loop
                                                        with v = earliest-arrival
                                                        until (= 0 (elt parents v))
                                                        finally return v
                                                        do (setq v (elt parents v))))))
                            (list
                             (elt names (car departure))
                             (/ (cdr departure) 60)
                             (mod (cdr departure) 60)))))))))

(should (equal (solve
                '("Hamburg" "Frankfurt" "Darmstadt")
                '("Hamburg" 8 0)
                "Frankfurt"
                '(
                  (("Hamburg" 8 0))
                  (("Hamburg" 9 49)
                   ("Frankfurt" 10 6))
                  (("Hamburg" 13 25)
                   ("Darmstadt" 15 50))
                  (("Frankfurt" 12 5)
                   ("Darmstadt" 14 11))))
               '("Hamburg" 9 49)))