Skip to content

Instantly share code, notes, and snippets.

@michalmarczyk michalmarczyk/shipping-puzzle.clj Secret
Last active Nov 3, 2018

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
You can’t perform that action at this time.