import Data.Ratio
import Numeric
-- Standard combinatorics functions:
factorial 0 = 1
factorial n = n * factorial (n - 1)
choose n r = (factorial n) `div` (factorial r) `div` (factorial (n - r))
-- Probability of exactly r probability-p outcomes over n trials:
exactly p n r | n >= r = (choose n r) % 1 * (p ^ r) * ((1 - p) ^ (n - r))
| otherwise = 0
-- Probability of exactly rp probability-p outcomes and rq probability-q outcomes over n trials, the outcomes being disjoint:
exactly2 p q n rp rq = (exactly p n rp) * (exactly (q / (1 - p)) (n - rp) rq)
-- Probability of more probability-p outcomes than probability-q outcomes over n trials, the outcomes being disjoint:
more p q n = sum $ map (uncurry $ exactly2 p q n) $ concatMap under [0 .. n] where under i = map ((,) i) [0 .. (i - 1)]
-- Probability of fumbling under the old mechanic (rolling no successes and at least two 1s on d10s) with n dice and target t:
old_fumble t n = (((t - 1) % 10) ^ n) * (sum $ map (exactly (1 % (t - 1)) n) $ [2 .. n])
-- Probability of succeeding under the old mechanic (roll at least one success on d10s) with n dice and target t:
old_succeed t n = 1 - (((t - 1) % 10) ^ n)
-- Probability of fumbling under the new mechanic (roll no "R"s and more "F"s than successes on d12s) with n dice and target t:
new_fumble t n = ((11 % 12) ^ n) * (more (1 % 11) ((11 - t) % 11) n)
-- Probability of succeeding under the new mechanic (roll an "R" or else more successes than "F"s on d12s) with n dice and target t:
new_succeed t n = (1 - no_rs) + no_rs * (more ((11 - t) % 11) (1 % 11) n) where no_rs = ((11 % 12) ^ n)
-- Table Ranges and Headings:
targets = [5 .. 10]
pool_sizes = [2 .. 10]
row_headings = map format targets where format target = "Target " ++ (showInt target "")
column_headings = map format pool_sizes where format pool_size = "Pool of " ++ (showInt pool_size "")
-- Formatting:
tabulate strings = (concatMap tab strings) ++ "\n" where tab string = string ++ "\t"
prettify p = showFFloat (Just 4) (fromRational p) "\t"
prettify_row heading row = tabulate $ [heading] ++ map prettify row
prettify_grid row_headings column_headings grid = (tabulate column_headings) ++ (concatMap (uncurry prettify_row) $ zip row_headings grid)
prettify_results title function = prettify_grid row_headings ([title] ++ column_headings) $ map f targets where f target = map (function target) pool_sizes
main = do
putStrLn $ prettify_results "Fumble (Old)" old_fumble
putStrLn $ prettify_results "Fumble (New)" new_fumble
putStrLn $ prettify_results "Succeed (Old)" old_succeed
putStrLn $ prettify_results "Succeed (New)" new_succeed