Skip to content

Instantly share code, notes, and snippets.

/core.clj

Created December 18, 2012 08:07
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save anonymous/4326031 to your computer and use it in GitHub Desktop.
Save anonymous/4326031 to your computer and use it in GitHub Desktop.
Download ZIP
Swing/Seesaw app that rolls dice for SW:EotE, using their custom "weird dice." It runs out of memory trying to calculate the probability with analyze-prob of 8 dice.
Raw
core.clj
(ns dicer.core
(:use seesaw.core
[clojure.string :only [join trim split]]
)
(:import org.pushingpixels.substance.api.SubstanceLookAndFeel
)
(:import org.pushingpixels.substance.api.SubstanceConstants$FocusKind)
(:gen-class))
(require ['clojure.algo.monads :as 'm])
(native!)
(def f (frame :title "Dice Roller" :on-close :exit :size [600 :by 600]))
(defn display [content]
(config! f :content content)
content)
(defn acquire [kw] (select (to-root f) kw))
; blue black green purple yellow red force
(def the-dice {:blue [[] [] [:a :a] [:a] [:a :s] [:s]]
:black [[] [] [:t] [:t] [:f] [:f]]
:green [[] [:s] [:s] [:s :s] [:a] [:a] [:a :s] [:a :a]]
:purple [[] [:f] [:f :f] [:t] [:t] [:t] [:t :t] [:t :f]]
:yellow [[] [:s] [:s] [:s :s] [:s :s] [:a] [:a :a] [:a :a] [:a :s] [:a :s] [:a :s] [:YEAH]]
:red [[] [:f] [:f] [:f :f] [:f :f] [:t] [:t] [:f :t] [:f :t] [:t :t] [:t :t] [:NO]]
:force [[:dark] [:dark] [:dark] [:dark] [:dark] [:dark] [:dark :dark]
[:light] [:light] [:light :light] [:light :light] [:light :light]]
})
(defn analyze-prob [blue black green purple yellow red force]
(let [
all-res
(m/with-monad m/sequence-m (m/m-seq (concat
(repeat blue (:blue the-dice))
(repeat black (:black the-dice))
(repeat green (:green the-dice))
(repeat purple (:purple the-dice))
(repeat yellow (:yellow the-dice))
(repeat red (:red the-dice))
(repeat force (:force the-dice))
)))
freqs (frequencies all-res)
kf (keys freqs)
num-rolls (count all-res)
success (reduce + (map #(* (count (filter (fn [c] (= :s c)) (flatten %))) (/ (get freqs %) num-rolls )) kf))
failure (reduce + (map #(* (count (filter (fn [c] (= :f c)) (flatten %))) (/ (get freqs %) num-rolls )) kf))
advantage (reduce + (map #(* (count (filter (fn [c] (= :a c)) (flatten %))) (/ (get freqs %) num-rolls )) kf))
threat (reduce + (map #(* (count (filter (fn [c] (= :t c)) (flatten %))) (/ (get freqs %) num-rolls )) kf))
triumph (reduce + (map #(* (count (filter (fn [c] (= :YEAH c)) (flatten %))) (/ (get freqs %) num-rolls )) kf))
despair (reduce + (map #(* (count (filter (fn [c] (= :NO c)) (flatten %))) (/ (get freqs %) num-rolls )) kf))
light (reduce + (map #(* (count (filter (fn [c] (= :light c)) (flatten %))) (/ (get freqs %) num-rolls )) kf))
dark (reduce + (map #(* (count (filter (fn [c] (= :dark c)) (flatten %))) (/ (get freqs %) num-rolls )) kf))
winner (reduce + (map #(* (if (>= (- (+
(count (filter (fn [c] (= :YEAH c)) (flatten %)))
(count (filter (fn [c] (= :s c)) (flatten %)))
)
(count (filter (fn [c] (= :NO c)) (flatten %)))
(count (filter (fn [c] (= :f c)) (flatten %)))
) 1) 1 0)
(/ (get freqs %) num-rolls )) kf)) ; (if (>= (- (+ triumph successes) despair failures) 0) 1 0)
total-success (reduce + (map #(* (- (+
(count (filter (fn [c] (= :YEAH c)) (flatten %)))
(count (filter (fn [c] (= :s c)) (flatten %)))
)
(count (filter (fn [c] (= :NO c)) (flatten %)))
(count (filter (fn [c] (= :f c)) (flatten %)))
)
(/ (get freqs %) num-rolls )) kf))
total-advantage (reduce + (map #(* (- (+
(count (filter (fn [c] (= :YEAH c)) (flatten %)))
(count (filter (fn [c] (= :a c)) (flatten %)))
)
(count (filter (fn [c] (= :NO c)) (flatten %)))
(count (filter (fn [c] (= :t c)) (flatten %)))
)
(/ (get freqs %) num-rolls )) kf))
]
(prn success )
(prn failure )
(prn advantage )
(prn threat )
(prn triumph )
(prn despair )
(prn light )
(prn dark )
{:success success
:failure failure
:advantage advantage
:threat threat
:triumph triumph
:despair despair
:light light
:dark dark
:winner winner
:total-success total-success
:total-advantage total-advantage
}))
(defn calc-dice [blue black green purple yellow red force]
(let [repeated [(map (fn [ah] (rand-nth (:blue the-dice))) (repeat blue []))
(map (fn [ah] (rand-nth (:black the-dice))) (repeat black []))
(map (fn [ah] (rand-nth (:green the-dice))) (repeat green []))
(map (fn [ah] (rand-nth (:purple the-dice))) (repeat purple []))
(map (fn [ah] (rand-nth (:yellow the-dice))) (repeat yellow []))
(map (fn [ah] (rand-nth (:red the-dice))) (repeat red []))
(map (fn [ah] (rand-nth (:force the-dice))) (repeat force []))]
successes (count (filter #(= :s %) (flatten repeated)))
failures (count (filter #(= :f %) (flatten repeated)))
advantage (count (filter #(= :a %) (flatten repeated)))
threat (count (filter #(= :t %) (flatten repeated)))
triumph (count (filter #(= :YEAH %) (flatten repeated)))
despair (count (filter #(= :NO %) (flatten repeated)))
light (count (filter #(= :light %) (flatten repeated)))
dark (count (filter #(= :dark %) (flatten repeated)))]
{:success successes
:failure failures
:advantage advantage
:threat threat
:triumph triumph
:despair despair
:light light
:dark dark
:total-success (- (+ triumph successes) despair failures)
:total-advantage (- (+ triumph advantage) despair failures)
:winner (if (>= (- (+ triumph successes) despair failures) 0) 1 0)
}))
(defn calc-prob [calc-fn blue black green purple yellow red force]
(with-precision 5 (let [num-rolls 20000M
repeated (map (fn [ah] (calc-fn blue black green purple yellow red force)) (repeat num-rolls {}))
freqs (frequencies repeated)
kf (keys freqs)
success (bigdec (/ (int (* 1000 (reduce + (map #(* 1.0 (:success %) (/ (get freqs %) num-rolls )) kf)))) 1000))
failure (bigdec (/ (int (* 1000 (reduce + (map #(* 1.0 (:failure %) (/ (get freqs %) num-rolls )) kf)))) 1000))
advantage (bigdec (/ (int (* 1000 (reduce + (map #(* 1.0 (:advantage %) (/ (get freqs %) num-rolls )) kf)))) 1000))
threat (bigdec (/ (int (* 1000 (reduce + (map #(* 1.0 (:threat %) (/ (get freqs %) num-rolls )) kf)))) 1000))
triumph (bigdec (/ (int (* 1000 (reduce + (map #(* 1.0 (:triumph %) (/ (get freqs %) num-rolls )) kf)))) 1000))
despair (bigdec (/ (int (* 1000 (reduce + (map #(* 1.0 (:despair %) (/ (get freqs %) num-rolls )) kf)))) 1000))
light (bigdec (/ (int (* 1000 (reduce + (map #(* 1.0 (:light %) (/ (get freqs %) num-rolls )) kf)))) 1000))
dark (bigdec (/ (int (* 1000 (reduce + (map #(* 1.0 (:dark %) (/ (get freqs %) num-rolls )) kf)))) 1000))
winner (bigdec (/ (int (* 1000 (reduce + (map #(* 1.0 (:winner %) (/ (get freqs %) num-rolls )) kf)))) 1000))
total-success (bigdec (/ (int (* 1000 (reduce + (map #(* 1.0 (:total-success %) (/ (get freqs %) num-rolls )) kf)))) 1000))
total-advantage (bigdec (/ (int (* 1000 (reduce + (map #(* 1.0 (:total-advantage %) (/ (get freqs %) num-rolls )) kf)))) 1000))
]
(prn success )
(prn failure )
(prn advantage )
(prn threat )
(prn triumph )
(prn despair )
(prn light )
(prn dark )
{:success success
:failure failure
:advantage advantage
:threat threat
:triumph triumph
:despair despair
:light light
:dark dark
:winner winner
:total-success total-success
:total-advantage total-advantage
})))
(defn calc-altered [blue black green purple yellow red force]
(let [repeated {:blue (map (fn [ah] (inc (rand-int 20))) (repeat blue 0))
:black (map (fn [ah] (inc (rand-int 20))) (repeat black 0))
:green (map (fn [ah] (inc (rand-int 20))) (repeat green 0))
:purple (map (fn [ah] (inc (rand-int 20))) (repeat purple 0))
:yellow (map (fn [ah] (inc (rand-int 20))) (repeat yellow 0))
:red (map (fn [ah] (inc (rand-int 20))) (repeat red 0))
:force (map (fn [ah] (inc (rand-int 20))) (repeat force 0))}
best-hit (- (first (sort > (concat [0] (:blue repeated) (:green repeated) (:yellow repeated)))) red )
best-miss (- (first (sort > (concat [0] (:black repeated) (:purple repeated) (:red repeated)))) yellow)
advantage (count (filter #(< 15 % ) (concat [0] (:blue repeated) (:green repeated) (:yellow repeated)))) ; (- 15 blue yellow)
threat (count (filter #(< 15 % ) (concat [0] (:black repeated) (:purple repeated) (:red repeated)))) ; (- 15 black red )
triumph (count (filter #(< 19 % ) (concat (:blue repeated) (:green repeated) (:yellow repeated)))) ; (- 20 yellow)
despair (count (filter #(< 19 % ) (concat (:black repeated) (:purple repeated) (:red repeated)))) ; (- 20 red )
light (+ (count (filter #(> % 10) (:force repeated))) (count (filter #(> % 15) (:force repeated))))
dark (+ (count (filter #(<= % 10) (:force repeated))) (count (filter #(<= % 5) (:force repeated))))]
; (prn repeated)
{:success best-hit
:failure best-miss
:advantage advantage
:threat threat
:triumph triumph
:despair despair
:light light
:dark dark
:original-map repeated
:total-success (- best-hit best-miss)
:total-advantage (- advantage threat)
:winner (if (>= (- best-hit best-miss) 0) 1 0)
}))
(defn calc-altered-simple [blue black green purple yellow red force]
(let [repeated {:blue (map (fn [ah] (inc (rand-int 8 ))) (repeat blue 0))
:black (map (fn [ah] (inc (rand-int 8 ))) (repeat black 0))
:green (map (fn [ah] (inc (rand-int 10))) (repeat green 0))
:purple (map (fn [ah] (inc (rand-int 10))) (repeat purple 0))
:yellow (map (fn [ah] (inc (rand-int 12))) (repeat yellow 0))
:red (map (fn [ah] (inc (rand-int 12))) (repeat red 0))
:force (map (fn [ah] (inc (rand-int 12))) (repeat force 0))}
best-hit (first (sort > (concat [0] (:blue repeated) (:green repeated) (:yellow repeated))))
best-miss (first (sort > (concat [0] (:black repeated) (:purple repeated) (:red repeated))))
advantage (count (filter #(< 5 % ) (concat [0] (:blue repeated) (:green repeated) (:yellow repeated))))
threat (count (filter #(< 5 % ) (concat [0] (:black repeated) (:purple repeated) (:red repeated))))
triumph (count (filter #(= 12 % ) (:yellow repeated)))
despair (count (filter #(= 12 % ) (:red repeated)))
light (+ (count (filter #(> % 6) (:force repeated))) (count (filter #(> % 10) (:force repeated))))
dark (+ (count (filter #(<= % 6) (:force repeated))) (count (filter #(<= % 2) (:force repeated))))]
; (prn repeated)
{:success best-hit
:failure best-miss
:advantage advantage
:threat threat
:triumph triumph
:despair despair
:light light
:dark dark
:original-map repeated
:total-success (- best-hit best-miss)
:total-advantage (- advantage threat)
:winner (if (>= (- best-hit best-miss) 0) 1 0)
}))
(defn calc-altered-2d20 [blue black green purple yellow red force]
(let [repeated {:blue (map (fn [ah] (inc (rand-int 8 ))) (repeat blue 0))
:black (map (fn [ah] (inc (rand-int 8 ))) (repeat black 0))
:green (map (fn [ah] (inc (rand-int 10))) (repeat green 0))
:purple (map (fn [ah] (inc (rand-int 10))) (repeat purple 0))
:yellow (map (fn [ah] (inc (rand-int 12))) (repeat yellow 0))
:red (map (fn [ah] (inc (rand-int 12))) (repeat red 0))
:force (map (fn [ah] (inc (rand-int 12))) (repeat force 0))}
best-hit (first (sort > (concat [0] (:blue repeated) (:green repeated) (:yellow repeated))))
best-miss (first (sort > (concat [0] (:black repeated) (:purple repeated) (:red repeated))))
advantage (count (filter #(< 5 % ) (concat [0] (:blue repeated) (:green repeated) (:yellow repeated))))
threat (count (filter #(< 5 % ) (concat [0] (:black repeated) (:purple repeated) (:red repeated))))
triumph (count (filter #(= 12 % ) (:yellow repeated)))
despair (count (filter #(= 12 % ) (:red repeated)))
light (+ (count (filter #(> % 6) (:force repeated))) (count (filter #(> % 10) (:force repeated))))
dark (+ (count (filter #(<= % 6) (:force repeated))) (count (filter #(<= % 2) (:force repeated))))]
; (prn repeated)
{:success best-hit
:failure best-miss
:advantage advantage
:threat threat
:triumph triumph
:despair despair
:light light
:dark dark
:original-map repeated
:total-success (- best-hit best-miss)
:total-advantage (- advantage threat)
:winner (if (>= (- best-hit best-miss) 0) 1 0)
}))
(defn prime []
(display (border-panel
:id :brdr
:vgap 5 :hgap 5 :border 5
:center (vertical-panel :items [
(horizontal-panel :items [
(label :text "Blue Boost Dice: " :background "#99F")
(spinner :id :blue-tbr :model (spinner-model 0 :from 0 :to 99 :by 1))
])
(horizontal-panel :items [
(label :text "Black Setback Dice: " :background "#333")
(spinner :id :black-tbr :model (spinner-model 0 :from 0 :to 99 :by 1))
])
(horizontal-panel :items [
(label :text "Green Ability Dice: " :background "#4F2")
(spinner :id :green-tbr :model (spinner-model 0 :from 0 :to 99 :by 1))
])
(horizontal-panel :items [
(label :text "Purple Difficulty Dice: " :background "#606")
(spinner :id :purple-tbr :model (spinner-model 0 :from 0 :to 99 :by 1))
])
(horizontal-panel :items [
(label :text "Yellow Proficiency Dice: " :background "#FF8")
(spinner :id :yellow-tbr :model (spinner-model 0 :from 0 :to 99 :by 1))
])
(horizontal-panel :items [
(label :text "Red Challenge Dice: " :background "#F00")
(spinner :id :red-tbr :model (spinner-model 0 :from 0 :to 99 :by 1))
])
(horizontal-panel :items [
(label :text "Force Dice: " :background "#AAA")
(spinner :id :force-tbr :model (spinner-model 0 :from 0 :to 99 :by 1))
])
])
:south (vertical-panel :items [
(horizontal-panel :items [
(button :text "Roll! " :listen [:action (fn [e] (let [res
(calc-dice
(selection (acquire [:#blue-tbr]))
(selection (acquire [:#black-tbr]))
(selection (acquire [:#green-tbr]))
(selection (acquire [:#purple-tbr]))
(selection (acquire [:#yellow-tbr]))
(selection (acquire [:#red-tbr]))
(selection (acquire [:#force-tbr])))
]
(alert (str "Success/Failure: " (- (:success res) (:failure res))
"\nAdvantage/Threat: " (- (:advantage res) (:threat res))
"\nTriumph! " (:triumph res)
"\nDESPAIR! " (:despair res)
"\nLight Force: " (:light res)
"\nDark Force: " (:dark res)))))])
(button :text "Statistics! " :listen [:action (fn [e] (let [res
(calc-prob calc-dice
(selection (acquire [:#blue-tbr]))
(selection (acquire [:#black-tbr]))
(selection (acquire [:#green-tbr]))
(selection (acquire [:#purple-tbr]))
(selection (acquire [:#yellow-tbr]))
(selection (acquire [:#red-tbr]))
(selection (acquire [:#force-tbr])))
]
(alert (str
"\nSuccess/Failure: " (:total-success res) ;(- (:success res) (:failure res))
"\nAdvantage/Threat: " (:total-advantage res);(- (:advantage res) (:threat res))
"\nTriumph! " (:triumph res)
"\nDESPAIR! " (:despair res)
"\nLight Force: " (:light res)
"\nDark Force: " (:dark res)
"\nWin percentage: " (* (:winner res) 100) "%"))))])
(button :text "ANALYZE! " :listen [:action (fn [e] (let [res
(analyze-prob
(selection (acquire [:#blue-tbr]))
(selection (acquire [:#black-tbr]))
(selection (acquire [:#green-tbr]))
(selection (acquire [:#purple-tbr]))
(selection (acquire [:#yellow-tbr]))
(selection (acquire [:#red-tbr]))
(selection (acquire [:#force-tbr])))
]
(with-precision 5 (alert (str
"\nSuccess/Failure: " (:total-success res) ;(- (:success res) (:failure res))
"\nAdvantage/Threat: " (:total-advantage res);(- (:advantage res) (:threat res))
"\nTriumph! " (:triumph res)
"\nDESPAIR! " (:despair res)
"\nLight Force: " (:light res)
"\nDark Force: " (:dark res)
"\nWin percentage: " (* 100M (bigdec (:winner res))) "%")))))])])
(horizontal-panel :items [
(button :text "Alt Roll" :listen [:action (fn [e] (let [res
(calc-altered
(selection (acquire [:#blue-tbr]))
(selection (acquire [:#black-tbr]))
(selection (acquire [:#green-tbr]))
(selection (acquire [:#purple-tbr]))
(selection (acquire [:#yellow-tbr]))
(selection (acquire [:#red-tbr]))
(selection (acquire [:#force-tbr])))
]
(alert (str "ALTERED RESULTS:"
"\nBest Hit Die: " (:success res)
"\nAll Hit Dice: [" (join ", " (concat (:green (:original-map res)) (:yellow (:original-map res)))) "]"
"\nBest Miss Die: " (:failure res)
"\nAll Miss Dice: [" (join ", " (concat (:purple (:original-map res)) (:red (:original-map res)))) "]"
"\nSuccess/Failure: " (- (:success res) (:failure res))
"\nAdvantage/Threat: " (- (:advantage res) (:threat res))
"\nTriumph! " (:triumph res)
"\nDESPAIR! " (:despair res)
"\nLight Force: " (:light res)
"\nDark Force: " (:dark res)))))])
(button :text "Alt Statistics! " :listen [:action (fn [e] (let [res
(calc-prob calc-altered
(selection (acquire [:#blue-tbr]))
(selection (acquire [:#black-tbr]))
(selection (acquire [:#green-tbr]))
(selection (acquire [:#purple-tbr]))
(selection (acquire [:#yellow-tbr]))
(selection (acquire [:#red-tbr]))
(selection (acquire [:#force-tbr])))
]
(alert (str
"\nSuccess/Failure: " (:total-success res)
"\nAdvantage/Threat: " (:total-advantage res)
"\nTriumph! " (:triumph res)
"\nDESPAIR! " (:despair res)
"\nLight Force: " (:light res)
"\nDark Force: " (:dark res)
"\nWin percentage: " (* (:winner res) 100) "%"))))])])
(horizontal-panel :items [(button :text "Simple Alt Roll" :listen [:action (fn [e] (let [res
(calc-altered-simple
(selection (acquire [:#blue-tbr]))
(selection (acquire [:#black-tbr]))
(selection (acquire [:#green-tbr]))
(selection (acquire [:#purple-tbr]))
(selection (acquire [:#yellow-tbr]))
(selection (acquire [:#red-tbr]))
(selection (acquire [:#force-tbr])))
]
(alert (str "ALTERED RESULTS:"
"\nBest Hit Die: " (:success res)
"\nAll Hit Dice: [" (join ", " (concat (:blue (:original-map res)) (:green (:original-map res)) (:yellow (:original-map res)))) "]"
"\nBest Miss Die: " (:failure res)
"\nAll Miss Dice: [" (join ", " (concat (:black (:original-map res)) (:purple (:original-map res)) (:red (:original-map res)))) "]"
"\nSuccess/Failure: " (- (:success res) (:failure res))
"\nAdvantage/Threat: " (- (:advantage res) (:threat res))
"\nTriumph! " (:triumph res)
"\nDESPAIR! " (:despair res)
"\nLight Force: " (:light res)
"\nDark Force: " (:dark res)))))])
(button :text "Simple Alt Statistics! " :listen [:action (fn [e] (let [res
(calc-prob calc-altered-simple
(selection (acquire [:#blue-tbr]))
(selection (acquire [:#black-tbr]))
(selection (acquire [:#green-tbr]))
(selection (acquire [:#purple-tbr]))
(selection (acquire [:#yellow-tbr]))
(selection (acquire [:#red-tbr]))
(selection (acquire [:#force-tbr])))
]
(alert (str
"\nSuccess/Failure: " (:total-success res)
"\nAdvantage/Threat: " (:total-advantage res)
"\nTriumph! " (:triumph res)
"\nDESPAIR! " (:despair res)
"\nLight Force: " (:light res)
"\nDark Force: " (:dark res)
"\nWin percentage: " (* (:winner res) 100) "%"))))])])
])))
(-> f pack! show!))
(defn -main [& args]
(invoke-later
(javax.swing.UIManager/setLookAndFeel "org.pushingpixels.substance.api.skin.SubstanceGraphiteLookAndFeel")
(javax.swing.UIManager/put SubstanceLookAndFeel/FOCUS_KIND SubstanceConstants$FocusKind/NONE)
(prime)
))
Raw
project.clj
(defproject dicer "1.0.0-SNAPSHOT"
:description "Ascendant Force, a non-graphical tactical RPG"
:dependencies [
[org.clojure/clojure "1.3.0"]
[seesaw "1.4.1"]
[com.github.insubstantial/substance "7.1"]
[org.clojure/algo.monads "0.1.0"]
]
:dev-dependencies [
[lein-eclipse "1.0.0"]
]
:aot [dicer.core]
:main dicer.core
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment