Bug fixes for when die roll is non-integer
Also added a reroll function and simplified code greatly
This commit is contained in:
parent
6ec0094fb4
commit
566b48ff62
10 changed files with 121 additions and 90 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
37
R/combineDice.R
Normal file
37
R/combineDice.R
Normal file
|
@ -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)
|
||||
|
||||
}
|
|
@ -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))
|
||||
|
||||
}
|
||||
|
||||
|
|
|
@ -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))
|
||||
}
|
||||
|
||||
|
|
|
@ -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")){
|
||||
|
|
20
R/reroll.R
Normal file
20
R/reroll.R
Normal file
|
@ -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))
|
||||
}
|
1
R/zzz.R
1
R/zzz.R
|
@ -1,2 +1,3 @@
|
|||
#' @import ggplot2
|
||||
#' @import dplyr
|
||||
NULL
|
||||
|
|
29
man/combineDice.Rd
Normal file
29
man/combineDice.Rd
Normal file
|
@ -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)
|
||||
}
|
23
man/reroll.Rd
Normal file
23
man/reroll.Rd
Normal file
|
@ -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)
|
||||
}
|
Loading…
Reference in a new issue