I'm thinking of calling it rescript-parsec?

This commit is contained in:
Quinn Dougherty 2022-04-21 20:49:48 -04:00
parent e49772ef00
commit 6f9d083993
13 changed files with 528 additions and 1 deletions

3
examples/basic.squiggle Normal file
View File

@ -0,0 +1,3 @@
xY1 = 99
aBa3 = xY1 * 2 + 1
aBa3 * xY1 + aBa3

20
examples/decay.squiggle Normal file
View File

@ -0,0 +1,20 @@
# The following code was provided by Nuño Sempere, it comes directly from the post https://www.lesswrong.com/s/rDe8QE5NvXcZYzgZ3/p/j8o6sgRerE3tqNWdj
## Initial setup
yearly_probability_max = 0.95
yearly_probability_min = 0.66
period_probability_function(epsilon, yearly_probability) = 1 - (1 - yearly_probability) ^ (1 / epsilon)
probability_decayed(t, time_periods, period_probability) = 1 - (1 - period_probability) ^ (time_periods - t)
## Monthly decomposition
months_in_a_year=12
monthly_probability_min = period_probability_function(months_in_a_year, yearly_probability_min)
monthly_probability_max = period_probability_function(months_in_a_year, yearly_probability_max)
probability_decayed_monthly_min(t) = probability_decayed(t, months_in_a_year, monthly_probability_min)
probability_decayed_monthly_max(t) = probability_decayed(t, months_in_a_year, monthly_probability_max)
probability_decayed_monthly(t) = probability_decayed_monthly_min(t) to probability_decayed_monthly_max(t)
probability_decayed_monthly
## probability_decayed_monthly(6)
## mean(probability_decayed_monthly(6))

View File

@ -0,0 +1,38 @@
# This is a cost effectiveness analysis of givedirectly, originally done by givewell, and translated into Squiggle by Sam Nolan
donation_size = 10000
proportion_of_funding_available = beta(10, 2)
total_funding_available = donation_size * proportion_of_funding_available
household_size = 3.7 to 5.7
size_of_transfer = 800 to 1200
size_of_transfer_per_person = size_of_transfer / household_size
portion_invested = 0.3 to 0.5
amount_invested = portion_invested * size_of_transfer_per_person
amount_consumed = (1 - portion_invested) * size_of_transfer_per_person
return_on_investment = 0.08 to 0.12
increase_in_consumption_from_investments = return_on_investment * amount_invested
baseline_consumption = 200 to 350
log_increase_in_consumption = log(amount_consumed + baseline_consumption) + log(baseline_consumption)
log_increase_in_consumption_from_investment = log(increase_in_consumption_from_investments + baseline_consumption) + log(baseline_consumption)
investment_duration = 8 to 12
discount_rate = beta(1.004, 20)
present_value_excluding_last_year = log_increase_in_consumption_from_investment * (1 - (1 + discount_rate) ^ (-investment_duration)) / (log(1 + discount_rate))
percent_of_investment_returned = 0.15 to 0.25
pv_consumption_last_year = (log(baseline_consumption + amount_invested * (return_on_investment + percent_of_investment_returned)) - log(baseline_consumption)) / (1 + discount_rate)^investment_duration
total_pv_of_cash_transfer = pv_consumption_last_year + present_value_excluding_last_year + log_increase_in_consumption
discount_negative_spoiler = 0.03 to 0.07
value_discounting_spoiler = discount_negative_spoiler * total_pv_of_cash_transfer
consumption_increase_per_household = value_discounting_spoiler * household_size
amount_of_transfers_made = total_funding_available / size_of_transfer
total_increase_in_ln_consumption = amount_of_transfers_made * consumption_increase_per_household
total_increase_in_ln_consumption

View File

@ -0,0 +1 @@
I wrote some tests in rescript-mocha I just have to translate them to rescript-jest

View File

@ -0,0 +1,12 @@
open Jest
open Expect
let {eval} = module(Parser_Squiggle)
describe("expressions of normal distributions:", () => {
test("sum of two", () => {
expect(eval(" normal (5 , 2 ) + normal(0,2)")) -> toEqual({mean: 5.0 +. 0.0, stdev: Js.Math.sqrt(2.0 ** 2.0 +. 2.0 ** 2.0)} -> #Normal -> Symbolic -> EvDistribution -> Ok -> Some)
})
test("difference of two", () => {
expect(eval("normal(5,3)-normal(2,1)")) -> toEqual({mean: 5.0 -. 2.0, stdev: Js.Math.sqrt(3.0 ** 2.0 +. 1.0 ** 2.0)} -> #Normal -> Symbolic -> EvDistribution -> Ok -> Some)
})
})

View File

@ -0,0 +1,51 @@
open RescriptMocha
open Mocha
open Parsec
describe("expressions of plus and times", () => {
let rec expr: lazy_t<t<int>> = lazy(bind(
Lazy.force(term),
t => choice(
bind(Primitive.symbol("+"), _ => bind(
Lazy.force(expr),
e => returnP(t + e)
)),
returnP(t)
)
))
and term: lazy_t<t<int>> = lazy(bind(
Lazy.force(factor),
f => choice(
bind(Primitive.symbol("*"), _ => bind(
Lazy.force(term), t => returnP(f * t)
)),
returnP(f)
)
))
and factor: lazy_t<t<int>> = lazy(choice(bind(Primitive.symbol("("), _ => bind(
Lazy.force(expr), e => bind(Primitive.symbol(")"), _ => returnP(e))
)), Primitive.natural))
let eval: string => int = xs => switch parse(Lazy.force(expr), xs) {
| list{(n, "")} => n
| list{(_, out)} => raise(Wrongo(`unconsumed input ${out}`))
| list{} => raise(Wrongo("invalid input"))
| _ => raise(Wrongo(wrongoMessage))
}
it("equals 3 at 1 + 2", () => {
Assert.deep_equal(eval("1 + 2"), 3)
})
it("equals 10 at 2 * 3 + 4", () => {
Assert.deep_equal(eval("2 \n * 3 \t +4"), 10)
})
it("equals 14 at 2 *(3 + 4)", () => {
Assert.deep_equal(eval("2 *(3 + 4)"), 14)
})
// it("raises Wrongo(unconsumed input -4) at 2*3-4", () => {
// Assert.throws(() => eval("2*3-4"), Js.Exn.asJsExn(Wrongo("unconsumed input -4")))
// })
// it("raises Wrongo(invalid input) at -1", () => {
// Assert.throws(() => eval("-1"), Js.Exn.asJsExn(Wrongo("invalid input")))
// })
})

View File

@ -0,0 +1,128 @@
open RescriptMocha
open Mocha
open Parsec
describe("rudimentary combinators (ParserBase)", () => {
it("should return (1, abc)", () => {
// could be property test
Assert.deep_equal(parse(returnP(1), "abc"), list{(1, "abc")})
})
it("should return (a, bc)", () => {
// should be property test
Assert.deep_equal(parse(item, "abc"), list{('a', "bc")})
})
it("should return empty list", () => {
// should be property test
Assert.deep_equal(parse(failure, "abc"), list{})
})
it("should return empty list", () => {
// covered in a conditional of the property test
Assert.deep_equal(parse(item, ""), list{})
})
})
describe("Primitive", () => {
it("digit: should return (1, 23)", () => {
Assert.deep_equal(parse(Primitive.digit, "123"), list{('1', "23")})
})
it("digit: should return empty list", () => {
Assert.deep_equal(parse(Primitive.digit, "abc"), list{})
})
it("checkchar: should return empty list", () => {
Assert.deep_equal(parse(Primitive.checkchar('a'), "123"), list{})
})
it("checkstring: should split abcdef into (abc, def)", () => {
Assert.deep_equal(parse(Primitive.checkstring("abc"), "abcdef"), list{("abc", "def")})
})
it("checkstring: should return empty list", () => {
Assert.deep_equal(parse(Primitive.checkstring("abc"), "ab1234"), list{})
})
let manyRun: (t<char>, string) => list<(string, string)> = (p, str) => {
parse(Primitive.many(fmap(x => String.make(1, x), p)), str)
}
let many1Run: (t<char>, string) => list<(string, string)> = (p, str) => {
parse(Primitive.many1(fmap(x => String.make(1, x), p)), str)
}
it("many: should return (123,abc)", () => {
Assert.deep_equal(
manyRun(Primitive.digit, "123abc"),
list{("123", "abc")},
)
})
it("many (without run helper): should return (123, abc)", () => {
Assert.deep_equal(
parse(Primitive.many(Primitive.digitString), "123abc"),
list{("123", "abc")}
)
})
it("many: should return (<empt>, abcdef)", () => {
Assert.deep_equal(
manyRun(Primitive.digit, "abcdef"),
list{("", "abcdef")},
)
})
it("many1: should return empty list", () => {
Assert.deep_equal(
many1Run(Primitive.digit, "abcdef"),
list{}
)
})
it("many1: should return abcdef", () => {
Assert.deep_equal(
parse(Primitive.many1(Primitive.lowerString), "abcdef"),
list{("abcdef", "")}
)
})
it("many1: should return (abc, Def)", () => {
Assert.deep_equal(
parse(Primitive.many1(Primitive.lowerString), "abcDef"),
list{("abc", "Def")}
)
})
it("many: should return (abc, Def)", () => {
Assert.deep_equal(
parse(Primitive.many(Primitive.lowerString), "abcDef"),
list{("abc", "Def")}
)
})
it("nat: should return (123, _abc)", () => {
Assert.deep_equal(
parse(Primitive.nat, "123 abc"),
list{(123, " abc")}
)
})
})
describe("whitespace-insensitive lists", () => {
let ident: t<string> = bind(
Primitive.lower,
x => bind(
Primitive.many(Primitive.alphanumString),
xs => returnP(Js.String2.concat(String.make(1, x), xs))))
let identifier: t<string> = Primitive.token(ident)
describe("of strings (identifier)", () => {
let listStringParser: t<list<string>> = {
bind(
Primitive.symbol("list{"),
_ => {
bind(
identifier,
n => bind(
Primitive.many(bind(Primitive.symbol(","), _ => identifier)),
ns => bind(Primitive.symbol("}"), _ => returnP(list{n, ns}))
)
)
}
)
}
it("returns list{ab, cd, ef} (with newline) THIS TEST IS WRONG", () => {
Assert.deep_equal(
parse(listStringParser, " list{ ab \n, cd, ef } "),
list{(list{"ab", "cdef"}, "")}
)
})
})
})

View File

@ -0,0 +1,33 @@
open RescriptMocha
open Mocha
describe("CharPredicates", () => {
describe("isDigit", () => {
it("should identify '3'", () => {
Assert.deep_equal(Utility.CharPredicates.isDigit('3'), true)
})
it("should identify '7'", () => {
Assert.deep_equal(Utility.CharPredicates.isDigit('7'), true)
})
it("should not identify 'a'", () => {
Assert.deep_equal(Utility.CharPredicates.isDigit('a'), false)
})
})
describe("isSpace", () => {
it("should identify newline", () => {
Assert.deep_equal(Utility.CharPredicates.isSpace('\n'), true)
})
it("should identify tab", () => {
Assert.deep_equal(Utility.CharPredicates.isSpace('\t'), true)
})
})
})
describe("other utilities", () => {
it("listStringFlattenTuple1 works", () => {
Assert.deep_equal(Utility.listStringFlattenTuple1((list{"abc", "def", "ghi"}, 1)), ("abcdefghi", 1))
})
it("listStringFlatten works", () => {
Assert.deep_equal(Utility.listStringFlatten(list{"abc", "def", "ghi"}), "abcdefghi")
})
})

View File

@ -0,0 +1,116 @@
module ParserBase = {
type t<'a> = string => list<('a, string)>
let returnP: 'a => t<'a> = (v, inp) => list{(v, inp)}
let failure: t<'a> = _ => list{}
exception Wrongo(string)
let wrongoMessage = "The semantics, by convention, are that singleton list indicates success and empty list indicates failure. This will be refactored into option later."
let item: t<char> = inp => {
if String.length(inp) == 0 {
list{}
} else {
let x = Js.String2.charAt(inp, 0)
let xs = Js.String2.sliceToEnd(inp, ~from=1)
list{(String.get(x, 0), xs)}
}
}
let parse: (t<'a>, string) => list<('a, string)> = (p, inp) => p(inp)
let choice: (t<'a>, t<'a>) => t<'a> = (p, q) => {
inp => {
switch parse(p, inp) {
| list{} => parse(q, inp)
| list{(v, out)} => list{(v, out)}
| _ => raise(Wrongo(wrongoMessage))
}
}
}
}
include ParserBase
module ParserMonad = Rationale.Monad.MakeBasic({
type t<'a> = ParserBase.t<'a>
let {parse, returnP} = module(ParserBase)
let bind = (x: t<'a>, f: 'a => t<'b>): t<'b> => {
inp => {
switch parse(x, inp) {
| list{} => list{}
| list{(v, out)} => parse(f(v), out)
| _ => raise(Wrongo(wrongoMessage))
}
}
}
let return = returnP
let fmap = #DefineWithBind
})
let {bind, fmap} = module(ParserMonad)
let satisf: (char => bool) => t<char> = p => {
bind(item, x =>
if p(x) {
returnP(x)
} else {
failure
}
)
}
let parserCharToParserString: t<char> => t<string> = fmap(x => String.make(1, x))
// module LazyP = {
// let parseL: lazy_t<t<'a>> =
// }
module Primitive = {
open Parser_Utility.CharPredicates
let digit: t<char> = satisf(isDigit)
let lower: t<char> = satisf(isLower)
let upper: t<char> = satisf(isUpper)
let letter: t<char> = satisf(isAlpha)
let alphanum: t<char> = satisf(isAlphaNum)
let checkchar: char => t<char> = x => satisf(c => c == x)
let space: t<char> = satisf(isSpace)
let digitString: t<string> = parserCharToParserString(digit)
let spaceString: t<string> = parserCharToParserString(space)
let alphanumString: t<string> = parserCharToParserString(alphanum)
let lowerString: t<string> = parserCharToParserString(lower)
let rec checkstring: string => t<string> = inp => {
if String.length(inp) == 0 {
returnP(inp)
} else {
let x = Js.String2.charAt(inp, 0)
let xs = Js.String2.sliceToEnd(inp, ~from=1)
bind(bind(checkchar(String.get(x, 0)), _ => checkstring(xs)), _ =>
returnP(Js.String2.concat(x, xs))
)
}
}
let rec many_: t<'a> => t<list<'a>> = p => choice(many1_(p), returnP(list{}))
and many1_: t<'a> => t<list<'a>> = p =>
bind(p, v =>
bind(many_(p), vs =>
returnP(list{
Js.String2.concat(v, Js.List.foldLeft((. a, b) => Js.String2.concat(a, b), "", vs)),
})
)
)
let many: t<'a> => t<'a> = p => fmap(Parser_Utility.listStringFlatten, many_(p))
let many1: t<'a> => t<'a> = p => fmap(Parser_Utility.listStringFlatten, many1_(p))
let nat: t<int> = bind(many1(digitString), xs =>
returnP(Belt.Float.toInt(Js.Float.fromString(xs)))
)
let whitespace: t<unit> = bind(many(spaceString), _ => returnP())
let token: t<'a> => t<'a> = p =>
bind(whitespace, _ => bind(p, v => bind(whitespace, _ => returnP(v))))
let natural: t<int> = token(nat)
let symbol: string => t<string> = xs => xs->checkstring->token
}
module Symbols = {
let normalNode: t<string> = Primitive.symbol("normal")
let openParen: t<string> = Primitive.symbol("(")
let closeParen: t<string> = Primitive.symbol(")")
let comma: t<string> = Primitive.symbol(",")
}

View File

@ -0,0 +1,90 @@
open Parser_Combinators
let {dispatch} = module(ReducerInterface_GenericDistribution)
type expressionValue = ReducerInterface_ExpressionValue.expressionValue
module Grammar = {
type expressionValueOR = option<
result<ReducerInterface_ExpressionValue.expressionValue, Reducer_ErrorValue.errorValue>,
>
let normalDist: t<expressionValueOR> = bind(Symbols.normalNode, _ =>
bind(Symbols.openParen, _ =>
bind(Primitive.natural, mean =>
bind(Symbols.comma, _ =>
bind(Primitive.natural, stdev =>
bind(Symbols.closeParen, _ =>
returnP(
dispatch((
"normal",
[mean->Belt.Float.fromInt->EvNumber, stdev->Belt.Float.fromInt->EvNumber],
)),
)
)
)
)
)
)
)
let number: t<expressionValueOR> = bind(Primitive.natural, x =>
returnP(dispatch(("float", [x->Belt.Float.fromInt->EvNumber])))
)
let evNormalDistribution: t<expressionValueOR> = Primitive.token(normalDist)
let evNatural: t<expressionValueOR> = Primitive.token(number)
let retGenericDistOrRaise: expressionValueOR => GenericDist_Types.genericDist = etf => {
switch etf {
| Some(Ok(EvDistribution(dist))) => dist
| Some(_) => raise(Wrongo("something bad happened"))
| None => raise(Wrongo("something bad happened"))
}
}
let rec expr: lazy_t<t<expressionValueOR>> = lazy bind(Lazy.force(term), t =>
choice(
bind(Primitive.symbol("+"), _ =>
bind(Lazy.force(expr), e => {
let t' = retGenericDistOrRaise(t)
let e' = retGenericDistOrRaise(e)
returnP(dispatch(("add", [EvDistribution(t'), EvDistribution(e')])))
})
),
choice(
bind(Primitive.symbol("-"), _ =>
bind(Lazy.force(expr), e => {
let t' = retGenericDistOrRaise(t)
let e' = retGenericDistOrRaise(e)
returnP(dispatch(("subtract", [EvDistribution(t'), EvDistribution(e')])))
})
),
returnP(t),
),
)
)
and term: lazy_t<t<expressionValueOR>> = lazy bind(Lazy.force(factor), f =>
choice(
bind(
Primitive.symbol("*"),
_ =>
bind(Lazy.force(term), t => {
let f' = retGenericDistOrRaise(f)
let t' = retGenericDistOrRaise(t)
returnP(dispatch(("multiply", [EvDistribution(f'), EvDistribution(t')])))
})),
returnP(f),
),
)
and factor: lazy_t<t<expressionValueOR>> = lazy choice(
bind(Symbols.openParen, _ =>
bind(Lazy.force(expr), e => bind(Symbols.closeParen, _ => returnP(e)))
),
evNormalDistribution,
)
}
let eval: string => Grammar.expressionValueOR = xs =>
switch parse(Lazy.force(Grammar.expr), xs) {
| list{(n, "")} => n
| list{(_, out)} => raise(Wrongo(`unconsumed input ${out}`))
| list{} => raise(Wrongo("invalid input"))
| _ => raise(Wrongo(wrongoMessage))
}
let foo = eval(" normal(5, 2) + normal(0, 2) * normal ( 10, 1 ) - normal (5 , \n 1)")

View File

@ -0,0 +1,33 @@
module CharPredicates = {
let isDigit: char => bool = x => {
let xString = String.make(1, x)
Js.String2.includes("0123456789", xString)
}
let isLower: char => bool = x => {
let xString = String.make(1, x)
Js.String2.includes("abcdefghijklmnopqrstuvwxyz", xString)
}
let isUpper: char => bool = x => {
let xString = String.make(1, x)
Js.String2.includes("ABCDEFGHIJKLMNOPQRSTUVWXYZ", xString)
}
let isAlpha: char => bool = x => {
isUpper(x) || isLower(x)
}
let isAlphaNum: char => bool = x => {
isAlpha(x) || isDigit(x)
}
let isSpace: char => bool = x => {
let xString = String.make(1, x)
Js.String2.includes(" \t\n", xString)
}
}
let listStringFlatten: list<string> => string = xs => {
Js.String2.concatMany("", Belt.List.toArray(xs))
}
let listStringFlattenTuple1: ((list<string>, 'a)) => (string, 'a) = tup => {
let (xs, y) = tup
let xs' = Belt.List.toArray(xs)
(Js.String2.concatMany("", xs'), y)
}

View File

@ -0,0 +1 @@
Based on chapter 8 of Programming in Haskell by Graham Hutton 1st edition

View File

@ -140,6 +140,7 @@ module SymbolicConstructors = {
let oneFloat = name => let oneFloat = name =>
switch name { switch name {
| "exponential" => Ok(SymbolicDist.Exponential.make) | "exponential" => Ok(SymbolicDist.Exponential.make)
| "float" => Ok(x => Ok(SymbolicDist.Float.make(x)))
| _ => Error("Unreachable state") | _ => Error("Unreachable state")
} }
@ -178,7 +179,7 @@ let dispatchToGenericOutput = (call: ExpressionValue.functionCall): option<
> => { > => {
let (fnName, args) = call let (fnName, args) = call
switch (fnName, args) { switch (fnName, args) {
| ("exponential" as fnName, [EvNumber(f1)]) => | (("exponential" | "float") as fnName, [EvNumber(f1)]) =>
SymbolicConstructors.oneFloat(fnName) SymbolicConstructors.oneFloat(fnName)
->E.R.bind(r => r(f1)) ->E.R.bind(r => r(f1))
->SymbolicConstructors.symbolicResultToOutput ->SymbolicConstructors.symbolicResultToOutput