Permalink
Cannot retrieve contributors at this time
(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) | |
(do | |
(set! a e) | |
(break))))))) | |
@a)) | |
) | |
(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 (Int.inc i)) | |
\X))) | |
(deftype Route [identifier Int legs (Array Leg)]) | |
(defmodule Route | |
(def ID 0) | |
(defn zero [] | |
(Route.init 0 [])) | |
(defn singleton [l] | |
(do | |
(set! ID (Int.inc ID)) | |
(Route.init ID [@l]))) | |
(defn viable? [d r s] | |
(let [ls (legs r) | |
l (nth ls (Int.dec (length ls)))] | |
(and (= (next-day @(Leg.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.day 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))))) | |
res)) | |
(defn make-legs [ls] | |
(copy-map Leg.from-string &(filter (fn [s] (not (String.empty? s))) ls))) | |
(defn main [] | |
(let-do [ls (lines &(IO.read-file "legs.txt")) | |
legs (make-legs ls) | |
then (System.nanotime) | |
] | |
(IO.println &(str (length &(solve @&legs)))) | |
(println* "Solving took " (/ (- (System.nanotime) then) 1000000l) " milliseconds"))) |