2022-05-19 22:24:56 +00:00
|
|
|
open FunctionRegistry_Core
|
|
|
|
|
|
|
|
let impossibleError = "Wrong inputs / Logically impossible"
|
|
|
|
|
|
|
|
module Wrappers = {
|
|
|
|
let symbolic = r => DistributionTypes.Symbolic(r)
|
|
|
|
let evDistribution = r => ReducerInterface_ExpressionValue.EvDistribution(r)
|
|
|
|
let symbolicEvDistribution = r => r->Symbolic->evDistribution
|
|
|
|
}
|
|
|
|
|
|
|
|
module Prepare = {
|
2022-05-21 15:41:12 +00:00
|
|
|
type ts = array<frValue>
|
|
|
|
type err = string
|
2022-05-19 22:24:56 +00:00
|
|
|
|
2022-05-21 15:41:12 +00:00
|
|
|
module ToValueArray = {
|
|
|
|
module Record = {
|
|
|
|
let twoArgs = (inputs: ts): result<ts, err> =>
|
|
|
|
switch inputs {
|
|
|
|
| [FRValueRecord([(_, n1), (_, n2)])] => Ok([n1, n2])
|
|
|
|
| _ => Error(impossibleError)
|
|
|
|
}
|
2022-05-19 22:24:56 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2022-05-21 15:41:12 +00:00
|
|
|
module ToValueTuple = {
|
|
|
|
let twoDistOrNumber = (values: ts): result<(frValueDistOrNumber, frValueDistOrNumber), err> => {
|
|
|
|
switch values {
|
|
|
|
| [FRValueDistOrNumber(a1), FRValueDistOrNumber(a2)] => Ok(a1, a2)
|
|
|
|
| _ => Error(impossibleError)
|
|
|
|
}
|
2022-05-19 22:24:56 +00:00
|
|
|
}
|
|
|
|
|
2022-05-21 15:41:12 +00:00
|
|
|
module Record = {
|
|
|
|
let twoDistOrNumber = (values: ts): result<(frValueDistOrNumber, frValueDistOrNumber), err> =>
|
|
|
|
values->ToValueArray.Record.twoArgs->E.R.bind(twoDistOrNumber)
|
|
|
|
}
|
|
|
|
}
|
2022-05-19 22:24:56 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
module Process = {
|
|
|
|
let twoDistsOrNumbersToDist = (
|
|
|
|
~fn: ((float, float)) => result<DistributionTypes.genericDist, string>,
|
2022-05-21 02:53:53 +00:00
|
|
|
~values: (frValueDistOrNumber, frValueDistOrNumber),
|
2022-05-21 16:18:54 +00:00
|
|
|
~env: DistributionOperation.env,
|
2022-05-21 15:41:12 +00:00
|
|
|
): result<DistributionTypes.genericDist, string> => {
|
2022-05-21 16:18:54 +00:00
|
|
|
let toSampleSet = r => GenericDist.toSampleSetDist(r, env.sampleCount)
|
2022-05-19 22:24:56 +00:00
|
|
|
let mapFnResult = r =>
|
|
|
|
switch r {
|
|
|
|
| Ok(r) => Ok(GenericDist.sample(r))
|
|
|
|
| Error(r) => Error(Operation.Other(r))
|
|
|
|
}
|
|
|
|
|
2022-05-21 15:41:12 +00:00
|
|
|
let singleVarSample = (dist, fn) => {
|
2022-05-21 16:09:49 +00:00
|
|
|
switch toSampleSet(dist) {
|
|
|
|
| Ok(dist) =>
|
|
|
|
switch SampleSetDist.samplesMap(~fn=f => fn(f)->mapFnResult, dist) {
|
|
|
|
| Ok(r) => Ok(DistributionTypes.SampleSet(r))
|
|
|
|
| Error(r) => Error(DistributionTypes.Error.toString(DistributionTypes.SampleSetError(r)))
|
|
|
|
}
|
|
|
|
| Error(r) => Error(DistributionTypes.Error.toString(r))
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
let twoVarSample = (dist1, dist2, fn) => {
|
|
|
|
let altFn = (a, b) => fn((a, b))->mapFnResult
|
|
|
|
switch E.R.merge(toSampleSet(dist1), toSampleSet(dist2)) {
|
|
|
|
| Ok((t1, t2)) =>
|
|
|
|
switch SampleSetDist.map2(~fn=altFn, ~t1, ~t2) {
|
|
|
|
| Ok(r) => Ok(DistributionTypes.SampleSet(r))
|
|
|
|
| Error(r) => Error(Operation.Error.toString(r))
|
|
|
|
}
|
|
|
|
| Error(r) => Error(DistributionTypes.Error.toString(r))
|
|
|
|
}
|
2022-05-19 22:24:56 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
switch values {
|
2022-05-21 15:41:12 +00:00
|
|
|
| (FRValueNumber(a1), FRValueNumber(a2)) => fn((a1, a2))
|
2022-05-21 02:53:53 +00:00
|
|
|
| (FRValueDist(a1), FRValueNumber(a2)) => singleVarSample(a1, r => fn((r, a2)))
|
|
|
|
| (FRValueNumber(a1), FRValueDist(a2)) => singleVarSample(a2, r => fn((a1, r)))
|
2022-05-21 16:09:49 +00:00
|
|
|
| (FRValueDist(a1), FRValueDist(a2)) => twoVarSample(a1, a2, fn)
|
2022-05-19 22:24:56 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
let twoDistsOrNumbersToDistUsingSymbolicDist = (
|
|
|
|
~fn: ((float, float)) => result<SymbolicDistTypes.symbolicDist, string>,
|
|
|
|
~values,
|
|
|
|
) => {
|
2022-05-21 15:41:12 +00:00
|
|
|
let newFn = r => fn(r)->E.R2.fmap(Wrappers.symbolic)
|
|
|
|
twoDistsOrNumbersToDist(~fn=newFn, ~values)
|
2022-05-19 22:24:56 +00:00
|
|
|
}
|
2022-05-20 21:36:40 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
module TwoArgDist = {
|
2022-05-21 16:18:54 +00:00
|
|
|
let process = (~fn, ~env, r) =>
|
2022-05-21 15:41:12 +00:00
|
|
|
r
|
2022-05-21 16:18:54 +00:00
|
|
|
->E.R.bind(Process.twoDistsOrNumbersToDistUsingSymbolicDist(~fn, ~values=_, ~env))
|
2022-05-21 15:41:12 +00:00
|
|
|
->E.R2.fmap(Wrappers.evDistribution)
|
2022-05-20 21:36:40 +00:00
|
|
|
|
|
|
|
let mkRegular = (name, fn) => {
|
2022-05-21 16:18:54 +00:00
|
|
|
FnDefinition.make(~name, ~inputs=[FRTypeDistOrNumber, FRTypeDistOrNumber], ~run=(inputs, env) =>
|
|
|
|
inputs->Prepare.ToValueTuple.twoDistOrNumber->process(~fn, ~env)
|
2022-05-20 21:36:40 +00:00
|
|
|
)
|
|
|
|
}
|
|
|
|
|
|
|
|
let mkDef90th = (name, fn) => {
|
2022-05-21 02:53:53 +00:00
|
|
|
FnDefinition.make(
|
2022-05-20 21:36:40 +00:00
|
|
|
~name,
|
2022-05-21 02:53:53 +00:00
|
|
|
~inputs=[FRTypeRecord([("p5", FRTypeDistOrNumber), ("p95", FRTypeDistOrNumber)])],
|
2022-05-21 16:18:54 +00:00
|
|
|
~run=(inputs, env) => inputs->Prepare.ToValueTuple.Record.twoDistOrNumber->process(~fn, ~env),
|
2022-05-20 21:36:40 +00:00
|
|
|
)
|
|
|
|
}
|
|
|
|
|
|
|
|
let mkDefMeanStdev = (name, fn) => {
|
2022-05-21 02:53:53 +00:00
|
|
|
FnDefinition.make(
|
2022-05-20 21:36:40 +00:00
|
|
|
~name,
|
2022-05-21 02:53:53 +00:00
|
|
|
~inputs=[FRTypeRecord([("mean", FRTypeDistOrNumber), ("stdev", FRTypeDistOrNumber)])],
|
2022-05-21 16:18:54 +00:00
|
|
|
~run=(inputs, env) => inputs->Prepare.ToValueTuple.Record.twoDistOrNumber->process(~fn, ~env),
|
2022-05-20 21:36:40 +00:00
|
|
|
)
|
|
|
|
}
|
2022-05-21 17:52:17 +00:00
|
|
|
|
2022-05-20 21:36:40 +00:00
|
|
|
}
|