Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
98 lines (77 sloc) 2.4 KB
(add-cflag "-O3")
(use-all Array Set)
; Set.filter impl that returns the first viable thing
(defmodule Set
(defn filter [f s]
(let-do [a &(zero)]
(for [i 0 @(n-buckets s)]
(let [bucket (Array.nth (buckets s) i)
len (Array.length (SetBucket.entries bucket))
entries (SetBucket.entries bucket)]
(for [j 0 len]
(let [e (Array.nth entries j)]
(when (f e)
(set! a e)
(deftype Leg [day Char start String end String])
(defmodule Leg
; N.B. we’re throwing away the ID for now
(defn from-string [s]
(let [arr (words s)]
(Leg.init (head (nth &arr 3)) @(nth &arr 1) @(nth &arr 2))))
(def days [\M \T \W \R \F])
(defn next-day [d]
(let [i (index-of &days d)]
(if (< i 5)
@(nth &days ( i))
(deftype Route [identifier Int legs (Array Leg)])
(defmodule Route
(def ID 0)
(defn zero []
(Route.init 0 []))
(defn singleton [l]
(set! ID ( ID))
(Route.init ID [@l])))
(defn viable? [d r s]
(let [ls (legs r)
l (nth ls (Int.dec (length ls)))]
(and (= (next-day @( l)) d) (= s (Leg.end l)))))
(defn add-leg [r l]
(Route.update-legs r (fn [legs] (push-back legs @l))))
(defn hash [r]
@(identifier r))
(defn = [r1 r2]
(= (identifier r1) (identifier r2)))
(defn prn [r]
(str r))
(defn legs-for [legs d]
(filter (fn [leg] (= ( leg) d)) @legs))
(defn solve-leg [d routes leg]
(let [viable (Set.filter (fn [r] (Route.viable? @d r (Leg.start leg))) &routes)]
(if (= &viable &(zero))
(put routes &(Route.singleton leg))
(put (remove routes &viable) &(Route.add-leg viable leg)))))
(defn solve-on [d routes legs]
(reduce (fn [routes leg] (solve-leg d routes leg)) routes &legs))
(defn solve [legs]
(let-do [res (Set.create)]
(for [i 0 (length &days)]
(let [day (nth &days i)]
(set! res (solve-on day res (legs-for &legs day)))))
(defn make-legs [ls]
(copy-map Leg.from-string &(filter (fn [s] (not (String.empty? s))) ls)))
(defn main []
(let-do [ls (lines &( "legs.txt"))
legs (make-legs ls)
then (System.nanotime)
(IO.println &(str (length &(solve @&legs))))
(println* "Solving took " (/ (- (System.nanotime) then) 1000000l) " milliseconds")))