diff src/lying.clj @ 0:307a81e46071 tip

initial committ
author Robert McIntyre <rlm@mit.edu>
date Tue, 18 Oct 2011 01:17:49 -0700
parents
children
line wrap: on
line diff
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/lying.clj	Tue Oct 18 01:17:49 2011 -0700
     1.3 @@ -0,0 +1,88 @@
     1.4 +(ns coderloop.lying
     1.5 +  (:use [clojure.contrib
     1.6 +	 [duck-streams :only [read-lines]]
     1.7 +	 [seq :only [find-first]]
     1.8 +	 [str-utils :only [re-gsub]]])
     1.9 +  (:use rlm.shell-inspect)
    1.10 +  (:use rlm.map-utils)
    1.11 +  (:use [clojure [string :only [split trim]]]))
    1.12 +
    1.13 +
    1.14 +
    1.15 +(comment
    1.16 +6
    1.17 +JohnDoe   -  1
    1.18 +MisterBlanko
    1.19 +JohnTitor -  2
    1.20 +DirkWhatever
    1.21 +BrunoJoeConner
    1.22 +DirkWhatever -  1
    1.23 +FooBar
    1.24 +BrunoJoeConner -  2
    1.25 +JohnTitor
    1.26 +MisterBlanko
    1.27 +MisterBlanko   -    1
    1.28 +DirkWhatever
    1.29 +FooBar - 3
    1.30 +DirkWhatever
    1.31 +BrunoJoeConner
    1.32 +JohnDoe
    1.33 +)
    1.34 +
    1.35 +
    1.36 +(def witnesses
    1.37 +     {:john-doe         [:mister-blanco]
    1.38 +      :john-tator       [:dirk-whatever :bruno-joe-conner]
    1.39 +      :dirk-whatever    [:foo-bar]
    1.40 +      :bruno-joe-conner [:john-tator :mister-blanco]
    1.41 +      :mister-blanco    [:dirk-whatever]
    1.42 +      :foo-bar          [:dirk-whatever :bruno-joe-conner :john-doe]})
    1.43 +
    1.44 +(def t "/home/r/coderloop-test/test.txt")
    1.45 +(def a "/home/r/coderloop-test/cluedo-a.in")
    1.46 +
    1.47 +(defn parse-file [f]
    1.48 +  (let [lines (map clojure.string/trim (rest (read-lines f)))]
    1.49 +    (map-keys
    1.50 +     (comp (partial re-gsub #"\W*:\W*\d*\W*" "") first)
    1.51 +     (apply hash-map
    1.52 +	    (partition-by #(re-matches #".*:.*" %) lines)))))
    1.53 +     
    1.54 +
    1.55 +(defrecord verdict [good bad])
    1.56 +
    1.57 +(def initial-verdict (verdict. #{} #{}))
    1.58 +
    1.59 +(defn valid-verdict? [num verdict]
    1.60 +  (and
    1.61 +   (>= num (+ (count (:good verdict)) (count (:bad verdict))))
    1.62 +   (not (reduce #(or %1 %2)
    1.63 +	   (map (:good verdict) (:bad verdict))))))
    1.64 +
    1.65 +(defn expand-verdict [judgements [person accuse]]
    1.66 +  (let [y (flatten
    1.67 +	   (for [record judgements]
    1.68 +	     [(verdict. (into (:good record) (vector person))
    1.69 +			(into (:bad  record) accuse))
    1.70 +	      (verdict. (into (:good record) accuse)
    1.71 +			(into (:bad  record) (vector person)))]))]
    1.72 +;;    (println (count y))
    1.73 +;;    (dorun (map println y))
    1.74 +    y))
    1.75 +
    1.76 +(defn determine-guilt [witnesses]
    1.77 +  (let [valid? (partial valid-verdict? (count witnesses))]
    1.78 +    (filter valid?
    1.79 +	    (reduce (comp
    1.80 +		     (partial filter valid?)
    1.81 +		     expand-verdict)
    1.82 +		    [initial-verdict] witnesses))))
    1.83 +
    1.84 +(defn print-soln [witnesses]
    1.85 +  (let [verdict  (first (determine-guilt witnesses))
    1.86 +	group-nums (sort [(count (:good verdict)) (count (:bad verdict))])]
    1.87 +    (println (str (first group-nums) \: (second group-nums)))))
    1.88 +
    1.89 +
    1.90 +(if (command-line?)
    1.91 +  (print-soln (parse-file (first *command-line-args*))))