Difference between revisions of "ExcellencyModelling"

Latest revision as of 01:15, 6 April 2010

As the ExcellencyMath page shows, calculating distributions for dice is rather tedious, especially at high pools.

To make this process easier, here is some R code which can be used to calculate success distributions for arbitrary numbers of dice and excellencies. These functions use three state multinomial calculations to generate their distributions, so they can get a little slow at high pools.

For information on R, including how to install and run, visit the R homepage.

All functions return percent chances of generating at least the given number of successes, and assume solar costing. General syntax for functions:

nd(dice, [limit]) - normal heroic roll. dice is number of dice, limit is how high to go.

nond(dice, [limit]) - normal unheroic roll. dice is number of dice, limit is how high to go.

fe(dice, motes, [limit]) - first excellency. dice is base pool, motes is how many motes to sink, limit is how high to go.

se(dice, motes, [limit]) - second excellency. dice is base pool, motes is how many motes to sink, limit is how high to go.

te(dice, [limit]) - third excellency. dice is base pool, limit is how high to go.

compe(dice, motes, [limit]) - compares the previous 5 roll types. dice is base pool, motes is how many motes to sink, limit is how high to go.

## Function to generate states of dice
# Exalted has four dice states, only three of which are relevant
#at any one time:
# 0- A '1'.  In the absence of successes, this generates a botch
# 1- A failure, typically 2-6
# 2- A success, typically 7-9
# 3- A '10'.  For heroic mortals and above, this gives 2 successes.
#
#	As 1s don't interact with 10s, a three state table is sufficient
#to cover all the possible states from any particular roll.

rollstates <- function(dice) {
	tmp<-t(as.matrix(expand.grid(0:dice, 0:dice)))
	tmp<-tmp[, colSums(tmp)<=dice]
	tmp<-rbind(tmp, dice - colSums(tmp))
	dimnames(tmp)<-list(c("f","s","110"),NULL)
	tmp  }


#	Caluculates numbers of successes each state will generate and then returns the
# probability that those states will be generated by some dice.  Can be used for botches
# also, but defaults to successes.
success<- function(successes, dice, cumulative = TRUE, multipliers = c(0,1,2), distribution = c(6,3,1)) {
	states<-rollstates(dice)
	suc<-states*multipliers
	stateset<-if (cumulative) states[, colSums(suc)>=successes] else states[,colSums(suc)==successes]
	round(sum(apply(as.matrix(stateset), 2, function(x) dmultinom(x, prob=distribution)))*100,3) }
	
#Normal rolls
nd<- function(dic, limit=2*dic) {
	#Botch
	X<-success(1,dic,TRUE,c(1,0,-9001), c(1,5,4))
	#Failure
	X<-rbind(X, success(0,dic, FALSE))
	#Success table
	X<-rbind(X, as.matrix(apply(as.matrix(1:limit), 1, function(x) success(x, dic))))
	#Rename
	dimnames(X)<-list(c("Botch","Fail", 1:limit), "Normal")
	X }

#Non-heroic rolls
nond<- function(dic, limit=2*dic) {
	#Botch
	X<-success(1,dic,TRUE,c(1,0,-9001), c(1,5,4))
	#Failure
	X<-rbind(X, success(0,dic, FALSE))
	#Success table
	X<-rbind(X, as.matrix(apply(as.matrix(1:limit), 1, function(x) success(x, dic, TRUE, c(0,1,1), c(6,3,1)))))
	#Rename
	dimnames(X)<-list(c("Botch","Fail", 1:limit), "Unheroic")
	X }
	
	
#First excellency
fe<-function(pool, motes, limit=2*(pool+motes)) {
	X<-nd(pool+motes, limit)
	colnames(X)<-"First"
	X}

#Second excellency
se<-function(pool, motes, limit=2*pool+floor(motes/2)) {
	#Number of successes
	suc<-floor(motes/2)
	if (suc>0) {
		#Botch chance is 0, autosuccesses
		X<-rbind(0,0, as.matrix(rep.int(100, suc)))
		#Normal after that, but no botches
		norm<-nd(pool, limit-suc)
		X<-rbind(X, as.matrix(norm[rownames(norm)!="Botch"&rownames(norm)!="Fail",])) }
		#Otherwise very normal
	else X<-nd(pool,limit)
	dimnames(X)<-list(c("Botch","Fail", 1:limit), "Second")	
	X}

#Rollagain
rollagain<- function (percent, bad)  {
	p<-percent/100
	if (bad) round(100*(p)^2,3)
	else round(100*(p+(1-p)*p), 3) }
	

#Third excellency
te<-function(pool, limit=2*pool) {
	base<-nd(pool, limit)
	#Bad ones first
	third<-as.matrix(rollagain(base[rownames(base)=="Botch",], TRUE))
	third<-rbind(third,as.matrix(rollagain(base[rownames(base)=="Fail",], TRUE)))
	#Then the good ones
third<-rbind(third,as.matrix(apply(as.matrix(base[rownames(base)!="Fail"&rownames(base)!="Botch"],), 1, rollagain, bad=FALSE)))
	dimnames(third)<-list(c("Botch", "Fail", 1:limit),"Third")
	third}
	
#compare 
compe<-function(pool, motes, limit=(pool+motes)*2) {
	cbind(nond(pool, limit),nd(pool, limit), fe(pool, motes, limit), se(pool, motes, limit), te(pool, limit)) }