From 566b48ff6223f0aad1f6eaf2e0746ac585c928b5 Mon Sep 17 00:00:00 2001 From: Joel Therrien Date: Wed, 29 May 2019 10:35:13 -0700 Subject: [PATCH] Bug fixes for when die roll is non-integer Also added a reroll function and simplified code greatly --- DESCRIPTION | 3 +- NAMESPACE | 3 ++ R/combineDice.R | 37 ++++++++++++++++++++++ R/disadvantage_advantage.R | 64 ++------------------------------------ R/internal_functions.R | 29 ++--------------- R/operators.R | 2 +- R/reroll.R | 20 ++++++++++++ R/zzz.R | 1 + man/combineDice.Rd | 29 +++++++++++++++++ man/reroll.Rd | 23 ++++++++++++++ 10 files changed, 121 insertions(+), 90 deletions(-) create mode 100644 R/combineDice.R create mode 100644 R/reroll.R create mode 100644 man/combineDice.Rd create mode 100644 man/reroll.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 7dc308d..d92d969 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,5 +10,6 @@ License: What license is it under? Encoding: UTF-8 LazyData: true Imports: - ggplot2 (>= 3.1.0) + ggplot2 (>= 3.1.0), + dplyr (>= 0.8.1) RoxygenNote: 6.1.1 diff --git a/NAMESPACE b/NAMESPACE index aa077f8..4465ca8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,7 @@ S3method(plot,Die) S3method(print,Die) S3method(summary,Die) export(advantage) +export(combineDice) export(d10) export(d12) export(d20) @@ -20,5 +21,7 @@ export(d6) export(d8) export(disadvantage) export(makeDie) +export(reroll) export(roll) +import(dplyr) import(ggplot2) diff --git a/R/combineDice.R b/R/combineDice.R new file mode 100644 index 0000000..3753b4c --- /dev/null +++ b/R/combineDice.R @@ -0,0 +1,37 @@ + + +#' Combine Dice +#' +#' This function is a way to combine two independent dice rolls into a new die. +#' +#' @param x A die +#' @param y A die +#' @param fun A function that takes two vectors containing the possible +#' combinations of die rolls of \code{x} and \code{y}; the output should be of +#' the same length. Example - \code{pmax} is such a function and is used to +#' take the maximum of two rolls. +#' +#' @return A new die with the possible possibilities and their corresponding +#' probabilties +#' @export +#' +#' @examples +#' summed.die <- combineDice(d4, d6, `+`) +#' advantaged.die <- combineDice(d4, d4, pmax) +combineDice <- function(x, y, fun){ + rolls <- expand.grid(x.numbers = x$numbers, y.numbers = y$numbers) + rolls$x.probs <- getProbabilitiy(x, rolls$x.numbers) + rolls$y.probs <- getProbabilitiy(y, rolls$y.numbers) + rolls$combined.prob <- rolls$x.probs*rolls$y.probs + rolls$combined.num <- fun(rolls$x.numbers, rolls$y.numbers) + + new.die.probs <- rolls %>% + group_by(combined.num) %>% + summarize(prob = sum(combined.prob)) %>% + arrange(combined.num) + + new.die <- makeDie(new.die.probs$combined.num, new.die.probs$prob) + + return(new.die) + +} diff --git a/R/disadvantage_advantage.R b/R/disadvantage_advantage.R index d4212b0..b9ab5d2 100644 --- a/R/disadvantage_advantage.R +++ b/R/disadvantage_advantage.R @@ -17,37 +17,7 @@ disadvantage <- function(x, y=NULL){ y = x } - minX = min(x$numbers) - minY = min(y$numbers) - - maxX = max(x$numbers) - maxY = max(y$numbers) - - range_z_min = pmin(minX, minY) - range_z_max = pmin(maxX, maxY) - - z_numbers = c() - probabilities = c() - for(num in range_z_min:range_z_max){ - prob_x_eq_num = getProbabilitiy(x, num) - prob_y_eq_num = getProbabilitiy(y, num) - - y_geq_nums = y$numbers[y$numbers >= num] # >= not a mistake - x_ge_nums = x$numbers[x$numbers > num] - - prob_y_geq_nums = sum(getProbabilitiy(y, y_geq_nums)) - prob_x_ge_nums = sum(getProbabilitiy(x, x_ge_nums)) - - prob_num = prob_x_eq_num*prob_y_geq_nums + prob_x_ge_nums*prob_y_eq_num - if(prob_num > 0){ - z_numbers = c(z_numbers, num) - probabilities = c(probabilities, prob_num) - } - } - - z = makeDie(z_numbers, probabilities) - return(z) - + return(combineDice(x, y, pmin)) } #' @@ -68,35 +38,7 @@ advantage <- function(x, y=NULL){ y = x } - minX = min(x$numbers) - minY = min(y$numbers) - - maxX = max(x$numbers) - maxY = max(y$numbers) - - range_z_min = pmax(minX, minY) - range_z_max = pmax(maxX, maxY) - - z_numbers = c() - probabilities = c() - for(num in range_z_min:range_z_max){ - prob_x_eq_num = getProbabilitiy(x, num) - prob_y_eq_num = getProbabilitiy(y, num) - - y_leq_nums = y$numbers[y$numbers <= num] # <= not a mistake - x_le_nums = x$numbers[x$numbers < num] - - prob_y_leq_nums = sum(getProbabilitiy(y, y_leq_nums)) - prob_x_le_nums = sum(getProbabilitiy(x, x_le_nums)) - - prob_num = prob_x_eq_num*prob_y_leq_nums + prob_x_le_nums*prob_y_eq_num - if(prob_num > 0){ - z_numbers = c(z_numbers, num) - probabilities = c(probabilities, prob_num) - } - } - - z = makeDie(z_numbers, probabilities) - return(z) + return(combineDice(x, y, pmax)) } + diff --git a/R/internal_functions.R b/R/internal_functions.R index 2953faa..dc3e3eb 100644 --- a/R/internal_functions.R +++ b/R/internal_functions.R @@ -8,36 +8,10 @@ getProbabilitiy <- function(x, numbers){ } -sumTwoDie <- function(x, y){ - range_z_min = min(x$numbers) + min(y$numbers) - range_z_max = max(x$numbers) + max(y$numbers) - - z_numbers = c() - probabilities = c() - for(num in range_z_min:range_z_max){ - prob_num = sum(x$probs * getProbabilitiy(y, num - x$numbers)) - if(prob_num > 0){ - z_numbers = c(z_numbers, num) - probabilities = c(probabilities, prob_num) - } - } - - z = makeDie(z_numbers, probabilities) - return(z) -} - # comparerFun(x, y); which both x & y as Die, or one of them as numeric compareDie <- function(x, y, comparerFun){ if(class(x) == "Die" & class(y) == "Die"){ - jointProbs = expand.grid(x$probs, y$probs) - jointProbs = jointProbs[,1]*jointProbs[,2] - - jointNumbers = expand.grid(x$numbers, y$numbers) - matchResults = comparerFun(jointNumbers[,1], jointNumbers[,2]) - probTrue = sum(jointProbs[matchResults]) - - z = makeDie(c(F,T), probs=c(1-probTrue, probTrue)) - return(z) + return(combineDice(x, y, comparerFun)) } if(class(x) %in% c("numeric", "integer")){ @@ -67,3 +41,4 @@ compareDie <- function(x, y, comparerFun){ z = makeDie(c(F,T), probs=c(1-probTrue, probTrue)) } + diff --git a/R/operators.R b/R/operators.R index a216fc0..4ac0c48 100644 --- a/R/operators.R +++ b/R/operators.R @@ -2,7 +2,7 @@ #' @export '+.Die' <- function(x, y){ if(class(x) == "Die" & class(y) == "Die"){ - return(sumTwoDie(x, y)) + return(combineDice(x, y, `+`)) } if(class(x) %in% c("numeric", "integer")){ diff --git a/R/reroll.R b/R/reroll.R new file mode 100644 index 0000000..e2b3e0b --- /dev/null +++ b/R/reroll.R @@ -0,0 +1,20 @@ + +#' Reroll +#' +#' If the die lands on the provided \code{numbers}, then the die is re-rolled +#' once with the output being final. +#' +#' @param x The die to possibly reroll +#' @param numbers The numbers to reroll on +#' +#' @return A new die with updated probabilties +#' @export +#' +#' @examples +#' paladin.greataxe <- reroll(d12, 1:2) +reroll <- function(x, numbers){ + which.die.fun <- function(a, b){ + ifelse(a %in% numbers, b, a) + } + return(combineDice(x, x, which.die.fun)) +} diff --git a/R/zzz.R b/R/zzz.R index d0bfb23..57c87e9 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,2 +1,3 @@ #' @import ggplot2 +#' @import dplyr NULL diff --git a/man/combineDice.Rd b/man/combineDice.Rd new file mode 100644 index 0000000..b03546a --- /dev/null +++ b/man/combineDice.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/combineDice.R +\name{combineDice} +\alias{combineDice} +\title{Combine Dice} +\usage{ +combineDice(x, y, fun) +} +\arguments{ +\item{x}{A die} + +\item{y}{A die} + +\item{fun}{A function that takes two vectors containing the possible +combinations of die rolls of \code{x} and \code{y}; the output should be of +the same length. Example - \code{pmax} is such a function and is used to +take the maximum of two rolls.} +} +\value{ +A new die with the possible possibilities and their corresponding + probabilties +} +\description{ +This function is a way to combine two independent dice rolls into a new die. +} +\examples{ +summed.die <- combineDice(d4, d6, `+`) +advantaged.die <- combineDice(d4, d4, pmax) +} diff --git a/man/reroll.Rd b/man/reroll.Rd new file mode 100644 index 0000000..9f6dce8 --- /dev/null +++ b/man/reroll.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/reroll.R +\name{reroll} +\alias{reroll} +\title{Reroll} +\usage{ +reroll(x, numbers) +} +\arguments{ +\item{x}{The die to possibly reroll} + +\item{numbers}{The numbers to reroll on} +} +\value{ +A new die with updated probabilties +} +\description{ +If the die lands on the provided \code{numbers}, then the die is re-rolled +once with the output being final. +} +\examples{ +paladin.greataxe <- reroll(d12, 1:2) +}