Last active
December 9, 2015 21:48
-
-
Save tommyettinger/4333237 to your computer and use it in GitHub Desktop.
Dice roller for SW:EotE's weird dice. Put project.clj in the project's root folder, put core.clj in src/dicer/ relative to that root, run `lein deps`, then `lein run`.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns dicer.core | |
(:use seesaw.core | |
[clojure.string :only [join trim split]] | |
dicer.prob) | |
(:import org.pushingpixels.substance.api.SubstanceLookAndFeel | |
) | |
(:import org.pushingpixels.substance.api.SubstanceConstants$FocusKind) | |
(:gen-class)) | |
(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]] | |
}) | |
(def dice-values { | |
:blue [[0 0 0 0] [0 0 0 0] [0 1/3 0 0] [0 1/6 0 0] [1/6 1/6 0 0] [1/6 0 0 0]], | |
:black [[0 0 0 0] [0 0 0 0] [0 -1/6 0 0] [0 -1/6 0 0] [-1/6 0 0 0] [-1/6 0 0 0]], | |
:green [[0 0 0 0] [1/8 0 0 0] [1/8 0 0 0] [1/4 0 0 0] [0 1/8 0 0] [0 1/8 0 0] [1/8 1/8 0 0] [0 1/4 0 0]], | |
:purple [[0 0 0 0] [-1/8 0 0 0] [-1/4 0 0 0] [0 -1/8 0 0] [0 -1/8 0 0] [0 -1/8 0 0] [0 -1/4 0 0] [-1/8 -1/8 0 0]], | |
:yellow [[0 0 0 0] [1/12 0 0 0] [1/12 0 0 0] [1/6 0 0 0] [1/6 0 0 0] [0 1/12 0 0] [0 1/6 0 0] [0 1/6 0 0] [1/12 1/12 0 0] [1/12 1/12 0 0] [1/12 1/12 0 0] [1/12 1/12 1/12 0]], | |
:red [[0 0 0 0] [-1/12 0 0 0] [-1/12 0 0 0] [-1/6 0 0 0] [-1/6 0 0 0] [0 -1/12 0 0] [0 -1/12 0 0] [-1/12 -1/12 0 0] [-1/12 -1/12 0 0] [0 -1/6 0 0] [0 -1/6 0 0] [-1/12 -1/12 0 -1/12]] | |
}) | |
(defn analyze-prob [blue black green purple yellow red force] | |
(let [ repeated (apply concat (concat | |
(repeat blue (:blue dice-values)) | |
(repeat black (:black dice-values)) | |
(repeat green (:green dice-values)) | |
(repeat purple (:purple dice-values)) | |
(repeat yellow (:yellow dice-values)) | |
(repeat red (:red dice-values)) | |
[])) | |
reduced (reduce (fn [c1 c2] [(+ (nth c1 0)(nth c2 0)) (+ (nth c1 1)(nth c2 1))(+ (nth c1 2)(nth c2 2))(+ (nth c1 3)(nth c2 3))]) repeated) | |
triumph (nth reduced 2) | |
despair (nth reduced 3) | |
light (* 2/3 force) | |
dark (* 2/3 force) | |
winner 1/2 | |
total-success (nth reduced 0) | |
total-advantage (nth reduced 1) | |
] | |
; (prn repeated) | |
{ | |
: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) | |
)) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defproject dicer "1.0.0-SNAPSHOT" | |
:description "Dice roller and probability analysis tool" | |
:dependencies [ | |
[org.clojure/clojure "1.3.0"] | |
[seesaw "1.4.1"] | |
[com.github.insubstantial/substance "7.1"] | |
] | |
: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