Compare commits

...

5 Commits

Author SHA1 Message Date
Quinn Dougherty
b253aadc52 fixed webpack 2022-04-07 21:57:23 -04:00
Quinn Dougherty
fc09fed0e0 lognormal 2022-04-07 21:51:16 -04:00
Quinn Dougherty
9fe6637c4f removed a comment 2022-04-07 21:16:31 -04:00
Quinn Dougherty
ba4ee1212d intermediary commit while I check out something else 2022-04-07 21:00:06 -04:00
Quinn Dougherty
a99f52d781 safe constructors 2022-04-07 21:00:06 -04:00
3 changed files with 277 additions and 1 deletions

View File

@ -81,7 +81,7 @@ module Triangular = {
low < medium && medium < high
? Ok(#Triangular({low: low, medium: medium, high: high}))
: Error("Triangular values must be increasing order.")
let pdf = (x, t: t) => Jstat.Triangular.pdf(x, t.low, t.high, t.medium) // not obvious in jstat docs that high comes before medium?
let pdf = (x, t: t) => Jstat.Triangular.pdf(x, t.low, t.high, t.medium)
let cdf = (x, t: t) => Jstat.Triangular.cdf(x, t.low, t.high, t.medium)
let inv = (p, t: t) => Jstat.Triangular.inv(p, t.low, t.high, t.medium)
let sample = (t: t) => Jstat.Triangular.sample(t.low, t.high, t.medium)

View File

@ -0,0 +1,151 @@
open SymbolicDistTypes
module type ValidNormal = {
let params: normal
let distribution: validated<symbolicDist>
}
let normalFrom90PercentCI = (low, high) => {
let mean = E.A.Floats.mean([low, high])
let stdev = (high -. low) /. (2.0 *. 1.644854)
(mean, stdev)
}
module Normal = (Validated: ValidNormal) => {
let pdf = x => Jstat.Normal.pdf(x, Validated.params.mean, Validated.params.stdev)
let cdf = x => Jstat.Normal.cdf(x, Validated.params.mean, Validated.params.stdev)
let from90PercentCI = (low, high) => {
let (mean, stdev) = normalFrom90PercentCI(low, high)
normalConstr({mean: mean, stdev: stdev})
}
let inv = p => Jstat.Normal.inv(p, Validated.params.mean, Validated.params.stdev)
let sample = Jstat.Normal.sample(Validated.params.mean, Validated.params.stdev)
let mean = Jstat.Normal.mean(Validated.params.mean, Validated.params.stdev)
let toString = j`Normal(${Js.Float.toString(Validated.params.mean)},${Js.Float.toString(Validated.params.stdev)})`
}
module NormalBinOps = (N1: ValidNormal, N2: ValidNormal) => {
let add = {
let mean = N1.params.mean +. N2.params.mean
let stdev = sqrt(N1.params.stdev ** 2.0 +. N2.params.stdev ** 2.0)
normalConstr({mean: mean, stdev: stdev})
}
let subtract = {
let mean = N1.params.mean -. N2.params.mean
let stdev = sqrt(N1.params.stdev ** 2.0 +. N2.params.stdev ** 2.0)
normalConstr({mean: mean, stdev: stdev})
}
let operate: Operation.Algebraic.t => option<validated<symbolicDist>> = operation => {
switch operation {
| #Add => Some(add)
| #Subtract => Some(subtract)
| _ => None
}
}
}
module type ValidLognormal = {
let params: lognormal
let distribution: validated<symbolicDist>
}
let lognormalFrom90PercentCI = (low, high) => {
let logLow = log(low)
let logHigh = log(high)
let mu = E.A.Floats.mean([logLow, logHigh])
let sigma = (logHigh -. logLow) /. (2.0 *. 1.645)
(mu, sigma)
}
let lognormalFromMeanAndStdev = (mean, stdev) => {
let variance = Js.Math.pow_float(~base=stdev, ~exp=2.0)
let meanSquared = Js.Math.pow_float(~base=mean, ~exp=2.0)
let mu = Js.Math.log(mean) -. 0.5 *. Js.Math.log(variance /. meanSquared +. 1.0)
let sigma = Js.Math.pow_float(~base=Js.Math.log(variance /. meanSquared +. 1.0), ~exp=0.5)
(mu, sigma)
}
module Lognormal = (Validated: ValidLognormal) => {
let pdf = x => Jstat.Lognormal.pdf(x, Validated.params.mu, Validated.params.sigma)
let cdf = x => Jstat.Lognormal.cdf(x, Validated.params.mu, Validated.params.sigma)
let inv = p => Jstat.Lognormal.inv(p, Validated.params.mu, Validated.params.sigma)
let mean = Jstat.Lognormal.mean(Validated.params.mu, Validated.params.sigma)
let sample = Jstat.Lognormal.sample(Validated.params.mu, Validated.params.sigma)
let toString = j`Lognormal(${Js.Float.toString(Validated.params.sigma)},${Js.Float.toString(Validated.params.sigma)})`
let from90PercentCI = (low, high) => {
let (mu, sigma) = lognormalFrom90PercentCI(low, high)
lognormalConstr({mu: mu, sigma: sigma})
}
let fromMeanAndStdev = (mean, stdev) => {
let (mu, sigma) = lognormalFromMeanAndStdev(mean, stdev)
lognormalConstr({mu: mu, sigma: sigma})
}
}
module LognormalBinOp = (LN1: ValidLognormal, LN2: ValidLognormal) => {
let multiply = {
let mu = LN1.params.mu +. LN2.params.mu
let sigma = LN1.params.sigma +. LN2.params.sigma
lognormalConstr({mu: mu, sigma: sigma})
}
let divide = {
let mu = LN1.params.mu -. LN2.params.mu
let sigma = LN1.params.sigma +. LN2.params.sigma
lognormalConstr({mu: mu, sigma: sigma})
}
let operate = (operation: Operation.Algebraic.t) => {
switch operation {
| #Multiply => Some(multiply)
| #Divide => Some(divide)
| _ => None
}
}
}
module From90thPercentile = {
let make: (float, float) => validated<symbolicDist> = (low, high) => {
let (mean, stdev) = normalFrom90PercentCI(low, high)
module NormalValueValidated: ValidNormal = {
let params = {mean: mean, stdev: stdev}
let distribution = normalConstr(params)
}
module NormalValue = Normal(NormalValueValidated)
NormalValue.from90PercentCI(low, high)
}
}
module T = {
let minCdfValue = 1e-4
let maxCdfValue = 1.0 -. 1e-4
let pdf = (x, dist) => {
switch dist {
| #Normal(_params) => {
module NormalValueValidated: ValidNormal = {
let params = _params
let distribution = normalConstr(params)
}
module NormalValue = Normal(NormalValueValidated)
switch NormalValueValidated.distribution {
| Ok(symbdist) => NormalValue.pdf(x)
| Error(invalidNormal) => -1e0 // dummy value till we decide if results are gonna propagate through everything.
}
}
| #Lognormal(_params) => {
module LognormalValueValidated: ValidLognormal = {
let params = _params
let distribution = lognormalConstr(params)
}
module LognormalValue = Lognormal(LognormalValueValidated)
switch LognormalValueValidated.distribution {
| Ok(symbdist) => LognormalValue.pdf(x)
| Error(invalidLognormal) => -1e0 // dummy value till we decide how results propagate up
}
}
}
}
}

View File

@ -31,6 +31,84 @@ type triangular = {
high: float,
}
type symbolicValidationError =
| InvalidNormal(string)
| InvalidLognormal(string)
| InvalidUniform(string)
| InvalidBeta(string)
| InvalidExponential(string)
| InvalidCauchy(string)
| InvalidTriangular(string)
type validated<'a> = result<'a, symbolicValidationError>
let valiNormal: normal => validated<normal> = t => {
if t.stdev <= 0.0 {
Error(InvalidNormal("Stdev must be strictly greater than 0"))
} else {
Ok(t)
}
}
let valiExponential: exponential => validated<exponential> = t => {
if t.rate <= 0.0 {
Error(InvalidExponential("Exponential distribtion rate must be larger than 0"))
} else {
Ok(t)
}
}
let valiCauchy: cauchy => validated<cauchy> = t => {
Ok(t)
}
let valiTriangular: triangular => validated<triangular> = t => {
if t.low >= t.medium || t.medium >= t.high {
Error(InvalidTriangular("Triangular values must be in increasing order"))
} else {
Ok(t)
}
}
let valiBeta: beta => validated<beta> = t => {
if t.alpha <= 0.0 || t.beta <= 0.0 {
Error(InvalidBeta("Beta distribution parameters must be strictly positive"))
} else {
Ok(t)
}
}
let valiLognormal: lognormal => validated<lognormal> = t => {
if t.sigma <= 0.0 {
Error(InvalidLognormal("Lognormal standard deviation must be strictly positive"))
} else {
Ok(t)
}
}
let valiUniform: uniform => validated<uniform> = t => {
if t.low >= t.high {
Error(InvalidUniform("High must be strictly greater than low"))
} else {
Ok(t)
}
}
let valiFloat: float => validated<float> = t => {
Ok(t)
}
type symbolicDistR = [
| #NormalR(validated<normal>)
| #BetaR(validated<beta>)
| #LognormalR(validated<lognormal>)
| #UniformR(validated<uniform>)
| #ExponentialR(validated<exponential>)
| #CauchyR(validated<cauchy>)
| #TriangularR(validated<triangular>)
| #FloatR(validated<float>)
]
@genType
type symbolicDist = [
| #Normal(normal)
@ -48,3 +126,50 @@ type analyticalSimplificationResult = [
| #Error(string)
| #NoSolution
]
// I feel like this should be something in `E.R.`...
let f: symbolicDistR => validated<symbolicDist> = x => {
switch x {
| #NormalR(vNormal) => switch vNormal {
| Ok(t) => Ok(#Normal(t))
| Error(t) => Error(t)
}
| #BetaR(vBeta) => switch vBeta {
| Ok(t) => Ok(#Beta(t))
| Error(t) => Error(t)
}
| #LognormalR(vLognormal) => switch vLognormal {
| Ok(t) => Ok(#Lognormal(t))
| Error(t) => Error(t)
}
| #UniformR(vUniform) => switch vUniform {
| Ok(t) => Ok(#Uniform(t))
| Error(t) => Error(t)
}
| #ExponentialR(vExponential) => switch vExponential {
| Ok(t) => Ok(#Exponential(t))
| Error(t) => Error(t)
}
| #CauchyR(vExponential) => switch vExponential {
| Ok(t) => Ok(#Cauchy(t))
| Error(t) => Error(t)
}
| #TriangularR(vExponential) => switch vExponential {
| Ok(t) => Ok(#Triangular(t))
| Error(t) => Error(t)
}
| #FloatR(vExponential) => switch vExponential {
| Ok(t) => Ok(#Float(t))
| Error(t) => Error(t)
}
}
}
let normalConstr: normal => validated<symbolicDist> = t => t -> valiNormal -> #NormalR -> f
let exponentialConstr: exponential => validated<symbolicDist> = t => t -> valiExponential -> #ExponentialR -> f
let cauchyConstr: cauchy => validated<symbolicDist> = t => t -> valiCauchy -> #CauchyR -> f
let triangularConstr: triangular => validated<symbolicDist> = t => t -> valiTriangular -> #TriangularR -> f
let betaConstr: beta => validated<symbolicDist> = t => t -> valiBeta -> #BetaR -> f
let lognormalConstr: lognormal => validated<symbolicDist> = t => t -> valiLognormal -> #LognormalR -> f
let uniformConstr: uniform => validated<symbolicDist> = t => t -> valiUniform -> #UniformR -> f
let floatConstr: float => validated<symbolicDist> = t => t -> valiFloat -> #FloatR -> f