O(n log n) solution to the "shipping puzzle" of https://kevinlynagh.com/notes/shipping-puzzle/
;; 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)))))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment