O(n log n) solution to the "shipping puzzle" of https://kevinlynagh.com/notes/shipping-puzzle/

shipping-puzzle.clj

;; See https://gist.github.com/michalmarczyk/d3a156bae5945ad3ab058d1b7b6c8d72 for proof of optimality

(set! *warn-on-reflection* true)
(set! *unchecked-math* :warn-on-boxed)


(defn day->long
  ^long [day]
  (case day
    "M" 1
    "T" 2
    "W" 3
    "R" 4
    "F" 5))


(defn parse
  [^String input-string]
  (let [legs (.split input-string "\n")
        n (alength legs)
        n+1 (inc n)
        ^objects i->origin (make-array String n+1)
        ^objects i->destination (make-array String n+1)
        i->day (long-array n+1)]
    (dotimes [i-1 n]
      (let [i (inc i-1)
            [_ origin destination day] (.split ^String (aget legs i-1) " ")]
        (aset i->origin i origin)
        (aset i->destination i destination)
        (aset i->day i (day->long day))))
    {:i->origin i->origin
     :i->destination i->destination
     :i->day i->day}))


(defn sort*
  [rng ^longs i->day ^long day-long ^objects i->city]
  (long-array
    (sort-by
      (fn [^long i] (aget i->city i))
      (reify
        java.util.Comparator
        (compare [_ x y]
          (.compareTo ^String x y)))
      (into []
        (filter (fn [i]
                  (== day-long (aget i->day i))))
        rng))))


(defn solve
  [{:keys [^objects i->origin
           ^objects i->destination
           ^longs i->day]}]
  (let [n+1 (alength i->origin)
        n (dec n+1)
        rng (range 1 n+1)
        sort** (fn [^long day-long i->city]
                 (sort* rng i->day day-long i->city))
        monday-destination (sort** 1 i->destination) #_(sort* rng i->day 1 i->destination)
        tuesday-origin (sort** 2 i->origin) #_(sort* rng i->day 2 i->origin)
        tuesday-destination (sort** 2 i->destination) #_(sort* rng i->day 2 i->destination)
        wednesday-origin (sort** 3 i->origin) #_(sort* rng i->day 3 i->origin)
        wednesday-destination (sort** 3 i->destination) #_(sort* rng i->day 3 i->destination)
        thursday-origin (sort** 4 i->origin) #_(sort* rng i->day 4 i->origin)
        thursday-destination (sort** 4 i->destination) #_(sort* rng i->day 4 i->destination)
        friday-origin (sort** 5 i->origin) #_(sort* rng i->day 5 i->origin)
        i->j (long-array n+1)
        i->skip? (boolean-array n+1)]
    (loop [day 1]
      (if (< day 5)
        (let [[^longs destination
               ^longs origin]
              (case day
                1 [monday-destination tuesday-origin]
                2 [tuesday-destination wednesday-origin]
                3 [wednesday-destination thursday-origin]
                4 [thursday-destination friday-origin])
              dlen (alength destination)
              olen (alength origin)]
          (loop [d 0
                 o 0]
            (if (and (< d dlen)
                     (< o olen))
              (let [di (aget destination d)
                    oi (aget origin o)
                    dcity (aget i->destination di)
                    ocity (aget i->origin oi)
                    c (.compareTo ^String dcity ocity)]
                (cond
                  (neg? c) (recur (inc d) o)
                  (pos? c) (recur d (inc o))
                  :else
                  (do
                    (aset i->j di oi)
                    (aset i->skip? oi true)
                    (recur (inc d) (inc o)))))
              ))
          (recur (inc day)))
        #_(count (filter false? (next i->skip?)))
        (loop [result []
               i 1]
          (if (== i n+1)
            (count result)
            (recur (cond-> result
                     (not (aget i->skip? i))
                     (conj (loop [i i leg [i]]
                             (let [j (aget i->j i)]
                               (if (zero? j)
                                 leg
                                 (recur j (conj leg j)))))))
                   (inc i))))))))