Instantly share code, notes, and snippets.

Embed
What would you like to do?
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