Skip to content

Instantly share code, notes, and snippets.

@michalmarczyk michalmarczyk/shipping-puzzle.clj Secret

Last active Nov 3, 2018
What would you like to do?
O(n log n) solution to the "shipping puzzle" of
;; See 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]
(fn [^long i] (aget i->city i))
(compare [_ x y]
(.compareTo ^String x y)))
(into []
(filter (fn [i]
(== day-long (aget i->day i))))
(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)]
(neg? c) (recur (inc d) o)
(pos? c) (recur d (inc o))
(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)
(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
You can’t perform that action at this time.