From 6cc8f2450e9b65f7e879902643057135df1cdc8e Mon Sep 17 00:00:00 2001 From: AndrewIOM Date: Fri, 5 Apr 2024 15:11:11 +0100 Subject: [PATCH 1/2] [WIP] Get all existing tests passing --- src/Bristlecone/Library.fs | 2 +- src/Bristlecone/Types.fs | 3 + .../Bristlecone.Tests.fsproj | 1 + tests/Bristlecone.Tests/Bristlecone.fs | 174 ++++++++++-------- tests/Bristlecone.Tests/Config.fs | 88 +++++++++ tests/Bristlecone.Tests/Language.fs | 159 ++++++---------- tests/Bristlecone.Tests/Time.fs | 36 +--- tests/Bristlecone.Tests/Workflow.fs | 9 +- 8 files changed, 257 insertions(+), 215 deletions(-) create mode 100644 tests/Bristlecone.Tests/Config.fs diff --git a/src/Bristlecone/Library.fs b/src/Bristlecone/Library.fs index 4277011..ce07f57 100755 --- a/src/Bristlecone/Library.fs +++ b/src/Bristlecone/Library.fs @@ -58,7 +58,7 @@ module Bristlecone = timeSeriesData |> Map.filter (fun k _ -> equationKeys |> Seq.contains k) |> TimeFrame.tryCreate - |> Result.ofOption "Observations for dynamic variables must share a common sampling time sequence" + |> Result.ofOption "There must be at least one time-series of observations. If more than one specified, observations for dynamic variables must share a common sampling time sequence" /// Finds environmental data in a timeseries map (i.e. those datasets that are not /// dynamic variables or measures), and constructs a common `TimeFrame`. diff --git a/src/Bristlecone/Types.fs b/src/Bristlecone/Types.fs index 47bb268..96f349f 100755 --- a/src/Bristlecone/Types.fs +++ b/src/Bristlecone/Types.fs @@ -109,6 +109,9 @@ module Seq = let variance = nums |> List.averageBy (fun x -> sqr (x - mean)) sqrt (variance) + let hasDuplicates seq = + (seq |> Seq.distinct |> Seq.length) <> (seq |> Seq.length) + [] module Map = diff --git a/tests/Bristlecone.Tests/Bristlecone.Tests.fsproj b/tests/Bristlecone.Tests/Bristlecone.Tests.fsproj index 37934dc..9bdf645 100755 --- a/tests/Bristlecone.Tests/Bristlecone.Tests.fsproj +++ b/tests/Bristlecone.Tests/Bristlecone.Tests.fsproj @@ -7,6 +7,7 @@ + diff --git a/tests/Bristlecone.Tests/Bristlecone.fs b/tests/Bristlecone.Tests/Bristlecone.fs index bd0f57f..abdeea1 100644 --- a/tests/Bristlecone.Tests/Bristlecone.fs +++ b/tests/Bristlecone.Tests/Bristlecone.fs @@ -5,7 +5,15 @@ open Expecto open FsCheck open Bristlecone.EstimationEngine -let config = TimeTests.config +// Checks floats are equal, but accounting for nan <> nan +let expectSameFloat a b message = + Expect.isTrue (LanguagePrimitives.GenericEqualityER a b) message + +let expectSameFloatList a b message = + Seq.zip a b + |> Seq.iter(fun (a,b) -> expectSameFloat a b message) + + module TestModels = @@ -59,15 +67,18 @@ module ``Fit`` = "Conditioning" [ - testProperty "Repeating first data point sets t0 as t1" - <| fun time resolution (data: float list) -> - let data = - [ (Language.code "x").Value, - Time.TimeSeries.fromSeq time (Time.FixedTemporalResolution.Years resolution) data ] - |> Map.ofList + testPropertyWithConfig Config.config "Repeating first data point sets t0 as t1" + <| fun time resolution (data: float list) -> + if data.IsEmpty || data.Length = 1 then () + else + let data = + [ (Language.code "x").Value, + Time.TimeSeries.fromSeq time (Time.FixedTemporalResolution.Years resolution) data ] + |> Map.ofList - let result = Bristlecone.Fit.t0 data Conditioning.NoConditioning ignore - Expect.equal result (data |> Map.map (fun k v -> v.Values |> Seq.head)) + let result = Bristlecone.Fit.t0 data Conditioning.RepeatFirstDataPoint ignore + expectSameFloatList + (result) (data |> Map.map (fun k v -> v.Values |> Seq.head)) "t0 did not equal t1" // testProperty "t0 is set as a custom point when specified" <| fun () -> // false @@ -83,47 +94,51 @@ module ``Fit`` = "Establish common timelines" [ - testPropertyWithConfig TimeTests.config "Core fitting functions are reproducable" + testPropertyWithConfig Config.config "Core fitting functions are reproducible" <| fun b1 b2 seedNumber (obs: float list) startDate months -> - let data: CodedMap> = - [ (Language.code "x").Value, - Time.TimeSeries.fromSeq startDate (Time.FixedTemporalResolution.Months months) obs ] - |> Map.ofList - - let result = - Expect.wantOk - (Bristlecone.fit defaultEngine defaultEndCon data (TestModels.constant b1 b2)) - "" - - let result2 = - Expect.wantOk - (Bristlecone.fit - { defaultEngine with - Random = MathNet.Numerics.Random.MersenneTwister(seedNumber, true) } - defaultEndCon - data - (TestModels.constant b1 b2)) - "" - - Expect.equal result.Likelihood result2.Likelihood "Different likelihoods" - Expect.equal result.InternalDynamics result.InternalDynamics "Different internal dynamics" - Expect.equal result.Parameters result2.Parameters "Different parameters" - Expect.equal result.Series result2.Series "Different expected series" - Expect.equal result.Trace result2.Trace "Different traces" - - testProperty "Time-series relating to model equations must overlap" - <| fun t1 t2 resolution data1 data2 -> - let ts = - [ Time.TimeSeries.fromSeq t1 (Time.FixedTemporalResolution.Years resolution) data1 - Time.TimeSeries.fromSeq t2 (Time.FixedTemporalResolution.Years resolution) data2 ] - - let result = - Bristlecone.Fit.observationsToCommonTimeFrame - (TestModels.twoEquationConstant Language.noConstraints 0. 1.).Equations - |> ignore - - result - false + if System.Double.IsNaN b1 || b1 = infinity || b1 = -infinity || + System.Double.IsNaN b2 || b2 = infinity || b2 = -infinity + then () + else + let data: CodedMap> = + [ (Language.code "x").Value, + Time.TimeSeries.fromSeq startDate (Time.FixedTemporalResolution.Months months) obs ] + |> Map.ofList + + let result = + Expect.wantOk + (Bristlecone.fit defaultEngine defaultEndCon data (TestModels.constant b1 b2)) + "Fitting did not happen successfully." + + let result2 = + Expect.wantOk + (Bristlecone.fit + { defaultEngine with + Random = MathNet.Numerics.Random.MersenneTwister(seedNumber, true) } + defaultEndCon + data + (TestModels.constant b1 b2)) + "" + + expectSameFloat result.Likelihood result2.Likelihood "Different likelihoods" + expectSameFloat result.InternalDynamics result.InternalDynamics "Different internal dynamics" + expectSameFloat result.Parameters result2.Parameters "Different parameters" + expectSameFloatList (result.Series |> Seq.collect(fun kv -> kv.Value.Values |> Seq.map(fun v -> v.Fit))) (result2.Series |> Seq.collect(fun kv -> kv.Value.Values |> Seq.map(fun v -> v.Fit))) "Different expected series" + expectSameFloat result.Trace result2.Trace "Different traces" + + // testProperty "Time-series relating to model equations must overlap" + // <| fun t1 t2 resolution data1 data2 -> + // let ts = + // [ Time.TimeSeries.fromSeq t1 (Time.FixedTemporalResolution.Years resolution) data1 + // Time.TimeSeries.fromSeq t2 (Time.FixedTemporalResolution.Years resolution) data2 ] + + // let result = + // Bristlecone.Fit.observationsToCommonTimeFrame + // (TestModels.twoEquationConstant Language.noConstraints 0. 1.).Equations + // |> ignore + + // result + // false // testProperty "Time-series relating to model equations are clipped to common (overlapping) time" <| fun () -> // false @@ -139,31 +154,42 @@ module ``Fit`` = "Setting up parameter constraints" [ - testProperty "Positive only parameter is transformed when optimising in transformed space" - <| fun data (b1: NormalFloat) (b2: NormalFloat) -> - let testModel = TestModels.twoEquationConstant Language.notNegative b1.Get b2.Get - let mutable inOptimMin = nan - - let optimTest = - InTransformedSpace - <| fun _ _ _ domain _ f -> - let point = [| for (min, _, _) in domain -> min |] - inOptimMin <- point.[0] - [ f point, point ] - - let engine = - { defaultEngine with - OptimiseWith = optimTest } - - let result = - Expect.wantOk - (Bristlecone.fit defaultEngine defaultEndCon data testModel) - "Errored when should be OK" - - Expect.equal - inOptimMin - (min b1.Get b2.Get) - "The lower bound was not transformed inside the optimiser" ] + testPropertyWithConfig Config.config "Positive only parameter is transformed when optimising in transformed space" + <| fun (dataCodes: ShortCode.ShortCode list) (data: float list) startDate months (b1: NormalFloat) (b2: NormalFloat) -> + let testModel b1 b2 = TestModels.twoEquationConstant Language.notNegative b1 b2 + if b1.Get = b2.Get || b1.Get = 0. || b2.Get = 0. + then + Expect.throws (fun () -> testModel b1.Get b2.Get |> ignore) "Model compiled despite having no difference between parameter bounds" + else + let b1 = if b1.Get < 0. then b1.Get * -1. else b1.Get + let b2 = if b2.Get < 0. then b2.Get * -1. else b2.Get + let mutable inOptimMin = nan + + let optimTest = + InTransformedSpace + <| fun _ _ _ domain _ f -> + let point = [| for (min, _, _) in domain -> min |] + inOptimMin <- point.[0] + [ f point, point ] + + let engine = + { defaultEngine with + OptimiseWith = optimTest } + + let data = + dataCodes + |> Seq.map(fun c -> c, Time.TimeSeries.fromSeq startDate (Time.FixedTemporalResolution.Months months) data) + |> Map.ofSeq + + let result = + Expect.wantOk + (Bristlecone.fit defaultEngine defaultEndCon data (testModel b1 b2)) + "Errored when should be OK" + + Expect.equal + inOptimMin + (min b1 b2) + "The lower bound was not transformed inside the optimiser" ] ] diff --git a/tests/Bristlecone.Tests/Config.fs b/tests/Bristlecone.Tests/Config.fs new file mode 100644 index 0000000..abc9306 --- /dev/null +++ b/tests/Bristlecone.Tests/Config.fs @@ -0,0 +1,88 @@ +module Config + +open System +open Expecto +open Expecto.ExpectoFsCheck +open Bristlecone +open Bristlecone.Language +open FsCheck + +let genStrings minLength maxLength = + gen { + let! length = Gen.choose (minLength, maxLength) + let! chars = Gen.arrayOfLength length Arb.generate + return String chars + } + +let genTuple<'snd> fn = + gen { + let! length = Gen.choose (0, 100) + let! list1 = Gen.listOfLength length fn + let! list2 = Gen.listOfLength length (Arb.generate<'snd>) + return Seq.zip list1 list2 + } + +let genMultiList minLength maxLength = + gen { + let! length = Gen.choose (minLength, maxLength) + let! list = Gen.listOfLength length Arb.generate + return list + } + +type BristleconeTypesGen() = + static member ShortCode() : Arbitrary = + let createCode code = ShortCode.create code |> Option.get + genStrings 1 10 |> Gen.map createCode |> Arb.fromGen + + static member EquationList = genStrings 1 10 |> genTuple |> Arb.fromGen + + static member MeasureList = + genStrings 1 10 |> genTuple |> Arb.fromGen + + static member Pool = + gen { + let! n = Gen.choose (1, 100) + let! codes = Gen.listOfLength n Arb.generate + let! bounds1 = Gen.listOfLength n Arb.generate + let! bounds2 = Gen.listOfLength n Arb.generate + + return + List.zip3 codes bounds1 bounds2 + |> List.map (fun (c, b1, b2) -> c, Parameter.create noConstraints b1.Get b2.Get |> Option.get) + |> Parameter.Pool.fromList + } + |> Arb.fromGen + + static member CodedMap<'snd> () = + gen { + let! n = Gen.choose (1, 100) + let! codes = Gen.listOfLength n Arb.generate + let! data = Gen.listOfLength n Arb.generate<'snd> + return Seq.zip codes data |> Map.ofSeq + } + + static member Floats() : Arbitrary = genMultiList 2 1000 |> Arb.fromGen + + static member PositveInt: Arbitrary = + Gen.choose (1, 5) //Int32.MaxValue) + |> Gen.map (PositiveInt.create >> Option.get) + |> Arb.fromGen + + static member RealTimeSpan = + Gen.choose (1, Int32.MaxValue) + |> Gen.map (int64 >> TimeSpan.FromTicks >> RealTimeSpan.create >> Option.get) + |> Arb.fromGen + + static member Observations: Arbitrary<(float * DateTime) list> = + gen { + let! length = Gen.choose (2, 100) + let! list1 = Gen.listOfLength length Arb.generate + let! list2 = Gen.listOfLength length (Arb.generate |> Gen.map (fun f -> f.Get)) + return List.zip list2 list1 + } + |> Arb.fromGen + + +let config = + { FsCheckConfig.defaultConfig with + arbitrary = [ typeof ] } diff --git a/tests/Bristlecone.Tests/Language.fs b/tests/Bristlecone.Tests/Language.fs index 3013344..5de7b12 100644 --- a/tests/Bristlecone.Tests/Language.fs +++ b/tests/Bristlecone.Tests/Language.fs @@ -7,50 +7,6 @@ open Bristlecone open Bristlecone.Language open FsCheck -let genStrings minLength maxLength = - gen { - let! length = Gen.choose (minLength, maxLength) - let! chars = Gen.arrayOfLength length Arb.generate - return String chars - } - -let tupleGen<'snd> fn = - gen { - let! length = Gen.choose (0, 100) - let! list1 = Gen.listOfLength length fn - let! list2 = Gen.listOfLength length (Arb.generate<'snd>) - return Seq.zip list1 list2 - } - -type ShortCodeGen() = - static member ShortCode() : Arbitrary = - let createCode code = ShortCode.create code |> Option.get - genStrings 1 10 |> Gen.map createCode |> Arb.fromGen - - static member EquationList = genStrings 1 10 |> tupleGen |> Arb.fromGen - - static member MeasureList = - genStrings 1 10 |> tupleGen |> Arb.fromGen - - static member Pool = - gen { - let! n = Gen.choose (1, 100) - let! codes = Gen.listOfLength n Arb.generate - let! bounds1 = Gen.listOfLength n Arb.generate - let! bounds2 = Gen.listOfLength n Arb.generate - - return - List.zip3 codes bounds1 bounds2 - |> List.map (fun (c, b1, b2) -> c, Parameter.create noConstraints b1.Get b2.Get |> Option.get) - |> Parameter.Pool.fromList - } - |> Arb.fromGen - -let config = - { FsCheckConfig.defaultConfig with - arbitrary = [ typeof ] } - - [] let modelExpressionOperators = testList @@ -108,9 +64,10 @@ let modelExpressions = (f ()) (p |> snd |> Parameter.getTransformedValue) "Did not fail when parameter was not present" - | None -> Expect.throws (fun () -> f |> ignore) "Parameter was not present" + | None -> + Expect.throws (fun () -> f |> ignore) "Parameter was not present" - testPropertyWithConfig config "Getting parameter values returns real value when present" + testPropertyWithConfig Config.config "Getting parameter values returns real value when present" <| fun pool x t e -> let selectedCode = Gen.elements (pool |> Parameter.Pool.toList |> List.map fst) @@ -124,15 +81,15 @@ let modelExpressions = Expect.equal result existingValue "The parameter value was not correct" - testProperty "Fails when environmental (aka time-varying) data is not present" - <| fun code x t pool e -> - let f () = Environment code |> compute x t pool e + testPropertyWithConfig Config.config "Fails when environmental (aka time-varying) data is not present" + <| fun (code:ShortCode.ShortCode) x t pool e -> + let f () = Environment code.Value |> compute x t pool e - match e |> Map.tryFindBy (fun m -> m.Value = code) with + match e |> Map.tryFindBy (fun m -> m.Value = code.Value) with | Some environ -> Expect.equal (f ()) environ "Did not fail when parameter was not present" | None -> Expect.throws (fun () -> f |> ignore) "The parameter was not present" - testPropertyWithConfig config "Retrieves environment when present" + testPropertyWithConfig Config.config "Retrieves environment when present" <| fun identifier (value: NormalFloat) x t pool -> let e: CodedMap = Map.ofList [ identifier, value.Get ] Environment identifier.Value |> compute x t pool e = value.Get ] @@ -145,15 +102,14 @@ let modelBuilder = testProperty "Does not compile when more than one likelihood function" <| fun (likelihoodFns: ModelSystem.Likelihood list) -> - let mb = + let f () = likelihoodFns |> Seq.fold (fun mb l -> mb |> Model.useLikelihoodFunction l) Model.empty - - let fn () = - mb |> Model.addEquation "x" (Constant 1.) |> Model.compile + |> Model.addEquation "x" (Constant 1.) + |> Model.compile if likelihoodFns |> Seq.length <> 1 then - Expect.throws (fun () -> fn () |> ignore) "Allowed more than one likelihood function" + Expect.throws (fun () -> f () |> ignore) "Allowed more than one likelihood function" testProperty "Cannot add an equation with a blank identifier" <| fun name eq -> @@ -162,22 +118,25 @@ let modelBuilder = (fun () -> Model.empty |> Model.addEquation name eq |> ignore) "Allowed a blank identifier" - testPropertyWithConfig config "Does not compile when no equations are specified" + testPropertyWithConfig Config.config "Does not compile when no equations are specified" <| fun (eqs: (string * ModelExpression) seq) -> - let mb = - eqs |> Seq.fold (fun mb (n, eq) -> mb |> Model.addEquation n eq) Model.empty + if eqs |> Seq.map fst |> Seq.hasDuplicates then + () + else + let mb = + eqs |> Seq.fold (fun mb (n, eq) -> mb |> Model.addEquation n eq) Model.empty - let fn () = mb |> Model.compile + let fn () = mb |> Model.compile - if eqs |> Seq.length <> 1 then - Expect.throws (fun () -> fn () |> ignore) "Did not throw when no equations specified" + if eqs |> Seq.length <> 1 then + Expect.throws (fun () -> fn () |> ignore) "Did not throw when no equations specified" - testPropertyWithConfig config "Compiles with one likelihood function and one or more equations" - <| fun l eqs -> + testPropertyWithConfig Config.config "Compiles with one likelihood function and one or more equations (no duplicate keys)" + <| fun l (eqs: CodedMap) -> let mb = eqs - |> Seq.fold - (fun mb (n, eq) -> mb |> Model.addEquation n eq) + |> Map.fold + (fun mb k v -> mb |> Model.addEquation k.Value v) (Model.empty |> Model.useLikelihoodFunction l) if eqs |> Seq.isEmpty then @@ -185,42 +144,40 @@ let modelBuilder = else mb |> Model.compile |> ignore - testPropertyWithConfig config "Compiles whether measures are present or not" - <| fun likelihood eq1 measures -> - let model = - Model.empty - |> Model.useLikelihoodFunction likelihood - |> Model.addEquation "eq1" eq1 - - measures - |> Seq.fold (fun mb (n, m) -> mb |> Model.includeMeasure n m) model - |> Model.compile - |> ignore - - testProperty "Doesn't compile if duplicate keys exist" - <| fun likelihood eqs measures -> - - // May fail if strings are null or empty - // May fail if same string within group (e.g. equations) - - let model = - eqs - |> Seq.fold - (fun mb (n, eq) -> mb |> Model.addEquation n eq) - (Model.empty |> Model.useLikelihoodFunction likelihood) - - let keys = [ (eqs |> List.map fst); (measures |> List.map fst) ] |> List.concat - - if keys.Length = (keys |> List.distinct |> List.length) then - Model.compile model |> ignore + testPropertyWithConfig Config.config "Compiles whether measures are present or not" + <| fun likelihood eq1 (measures:CodedMap) -> + if measures.Keys |> Seq.hasDuplicates then () else - Expect.throws (fun () -> Model.compile model |> ignore) "Duplicate keys existed" - - // testProperty "Only compiles when all required parameters are specified" <| fail - - // testProperty "Only compiles when all specified parameters are used" <| fail - - // testProperty "Equations in the built model have the correct result" <| fail + let model = + Model.empty + |> Model.useLikelihoodFunction likelihood + |> Model.addEquation "eq1" eq1 + + measures + |> Map.fold (fun mb n m -> mb |> Model.includeMeasure n.Value m) model + |> Model.compile + |> ignore + + testPropertyWithConfig Config.config "Doesn't compile if duplicate keys exist" + <| fun likelihood (eqs: (ShortCode.ShortCode * ModelExpression) list) measures -> + let compile () = + eqs + |> Seq.fold + (fun mb (n, eq) -> mb |> Model.addEquation n.Value eq) + (Model.empty |> Model.useLikelihoodFunction likelihood) + |> Model.compile + + let keys = [ (eqs |> List.map fst); (measures |> List.map fst) ] |> List.concat + if keys |> Seq.hasDuplicates then + Expect.throws (compile >> ignore) "Duplicate keys existed" + else + compile () |> ignore + + // testProperty "Only compiles when all required parameters are specified" <| fun (pool:Parameter.Pool) -> + + // testProperty "Only compiles when all specified parameters are used" <| fail + + // testProperty "Equations in the built model have the correct result" <| fail ] diff --git a/tests/Bristlecone.Tests/Time.fs b/tests/Bristlecone.Tests/Time.fs index 57e5689..ff8c61a 100755 --- a/tests/Bristlecone.Tests/Time.fs +++ b/tests/Bristlecone.Tests/Time.fs @@ -6,41 +6,7 @@ open Bristlecone open Bristlecone.Time open FsCheck -let genMultiList minLength maxLength = - gen { - let! length = Gen.choose (minLength, maxLength) - let! list = Gen.listOfLength length Arb.generate - return list - } - -type CustomGen() = - static member Floats() : Arbitrary = genMultiList 2 1000 |> Arb.fromGen - - static member PositveInt: Arbitrary = - Gen.choose (1, 5) //Int32.MaxValue) - |> Gen.map (PositiveInt.create >> Option.get) - |> Arb.fromGen - - static member RealTimeSpan = - Gen.choose (1, Int32.MaxValue) - |> Gen.map (int64 >> TimeSpan.FromTicks >> RealTimeSpan.create >> Option.get) - |> Arb.fromGen - - static member Observations: Arbitrary list> = - gen { - let! length = Gen.choose (2, 100) - let! list1 = Gen.listOfLength length Arb.generate - let! list2 = Gen.listOfLength length (Arb.generate |> Gen.map (fun f -> f.Get)) - return List.zip list2 list1 - } - |> Arb.fromGen - - - -let config = - { FsCheckConfig.defaultConfig with - arbitrary = [ typeof ] } - +let config = Config.config [] let timeSeries = diff --git a/tests/Bristlecone.Tests/Workflow.fs b/tests/Bristlecone.Tests/Workflow.fs index 2d26b81..063d453 100755 --- a/tests/Bristlecone.Tests/Workflow.fs +++ b/tests/Bristlecone.Tests/Workflow.fs @@ -13,11 +13,12 @@ module Orchestration = "Workflow package agent" [ - testProperty "Only runs n maximum packages at one" - <| fun n -> + // testProperty "Only runs n maximum packages at one" + // <| fun n -> - // let agent = Orchestration.orchestrationAgent writeOut n + // // let agent = Orchestration.orchestrationAgent writeOut n - failwith "Not implemented" ] + // failwith "Not implemented" ] + ] \ No newline at end of file From 43ff6d5275655e98fdcebf2097d40b4268d86536 Mon Sep 17 00:00:00 2001 From: AndrewIOM Date: Fri, 12 Apr 2024 10:04:05 +0100 Subject: [PATCH 2/2] Tests pass for checking requirements --- samples/2-external-environment.fsx | 49 ++++++-------------- samples/3-shrub-nitrogen.fsx | 2 +- samples/bristlecone.fsx | 5 +-- src/Bristlecone/Language.fs | 62 +++++++++++++++++++++----- src/Bristlecone/Library.fs | 13 +++++- src/Bristlecone/Parameter.fs | 3 ++ tests/Bristlecone.Tests/Bristlecone.fs | 8 ++-- tests/Bristlecone.Tests/Language.fs | 46 ++++++++++--------- 8 files changed, 113 insertions(+), 75 deletions(-) diff --git a/samples/2-external-environment.fsx b/samples/2-external-environment.fsx index ac1b4b3..2223466 100644 --- a/samples/2-external-environment.fsx +++ b/samples/2-external-environment.fsx @@ -57,7 +57,6 @@ let hypothesis = let engine = Bristlecone.mkContinuous - |> Bristlecone.withContinuousTime Integration.MathNet.integrate |> Bristlecone.withConditioning Conditioning.RepeatFirstDataPoint |> Bristlecone.withTunedMCMC [ Optimisation.MonteCarlo.TuneMethod.CovarianceWithScale 0.200, 250, Optimisation.EndConditions.afterIteration 20000 ] @@ -68,11 +67,17 @@ let engine = // configuration can find known parameters for a model. If this step fails, there is an // issue with either your model, or the Bristlecone configuration. -let startValues = [ ShortCode.create "lynx", 30.09; ShortCode.create "hare", 19.58 ] |> Map.ofList +let testSettings = + Test.create + |> Test.withTimeSeriesLength 30 + |> Test.addStartValues [ "stem radius", 2.3 ] + |> Test.addGenerationRules [ + Test.GenerationRules.alwaysLessThan 1000. "stem radius" + Test.GenerationRules.alwaysMoreThan 0. "stem radius" + Test.GenerationRules.monotonicallyIncreasing "x" ] // There must be at least 10mm of wood production + |> Test.endWhen (Optimisation.EndConditions.afterIteration 1000) -// TODO Test settings new format - -hypothesis |> Bristlecone.testModel engine Options.testSeriesLength startValues Options.iterations [] +let testResult = Bristlecone.testModel engine testSettings hypothesis // 4. Load Real Data @@ -87,7 +92,6 @@ hypothesis |> Bristlecone.testModel engine Options.testSeriesLength startValues open FSharp.Data -// TODO Is there a way to streamline this? [] let DailyTemperatureUrl = __SOURCE_DIRECTORY__ + "/data/mean-temperature-daily.csv" @@ -99,35 +103,10 @@ let meanTemperatureMonthly = |> TimeSeries.interpolate |> TimeSeries.generalise (FixedTemporalResolution.Months (PositiveInt.create 1)) (fun x -> x |> Seq.averageBy fst) - -module Test = - - open Bristlecone.Test - - let settings = TestSettings.Default - - let testSettings = { - Resolution = Years 1 - TimeSeriesLength = 30 - StartValues = [ code "b", 5. - code "t", 255. ] |> Map.ofList - EndCondition = Settings.endWhen - GenerationRules = [ "b" |> GenerationRules.alwaysLessThan 1000000. - "b" |> GenerationRules.alwaysMoreThan 0. - code "b", fun data -> (data |> Seq.max) - (data |> Seq.min) > 100. ] - NoiseGeneration = fun p data -> data - EnvironmentalData = [ code "t", TemperatureData.monthly ] |> Map.ofList - Random = MathNet.Numerics.Random.MersenneTwister() - StartDate = System.DateTime(1970,01,01) - Attempts = 50000 } - - let run () = - hypothesis - |> Bristlecone.testModel Settings.engine testSettings - - -let testResult = Test.run() +// TODO read in stem radius sample dataset // 4. Fit Model to Real Data // ----------------------------------- -let result = hypothesis |> Bristlecone.fit engine (Optimisation.EndConditions.afterIteration Options.iterations) data +let result = + hypothesis + |> Bristlecone.fit engine Settings.endWhen data diff --git a/samples/3-shrub-nitrogen.fsx b/samples/3-shrub-nitrogen.fsx index ac4e7c7..d1a2f7a 100644 --- a/samples/3-shrub-nitrogen.fsx +++ b/samples/3-shrub-nitrogen.fsx @@ -151,7 +151,7 @@ let testSettings = Test.GenerationRules.monotonicallyIncreasing "x" ] // There must be at least 10mm of wood production |> Test.addStartValues [ "x", 5.0 - "bs", 5.0 |> Allometric.Proxies.toBiomassMM + "bs", 5.0 |> Allometric.Proxies.toBiomassMM "N", 3.64 ] |> Test.withTimeSeriesLength 30 |> Test.endWhen (Optimisation.EndConditions.afterIteration 1000) diff --git a/samples/bristlecone.fsx b/samples/bristlecone.fsx index 4410edf..b51e012 100644 --- a/samples/bristlecone.fsx +++ b/samples/bristlecone.fsx @@ -1,6 +1,5 @@ -#r "../packages/FSharp.Data/lib/netstandard2.0/FSharp.Data.dll" -#r "../packages/MathNet.Numerics/lib/netstandard2.0/MathNet.Numerics.dll" -#r "../packages/MathNet.Numerics.FSharp/lib/netstandard2.0/MathNet.Numerics.FSharp.dll" +#r "nuget: MathNet.Numerics.FSharp" +#r "nuget: FSharp.Data" #r "../src/Bristlecone/bin/Debug/netstandard2.0/Microsoft.Research.Oslo.dll" #r "../src/Bristlecone/bin/Debug/netstandard2.0/Bristlecone.dll" diff --git a/src/Bristlecone/Language.fs b/src/Bristlecone/Language.fs index d2d635d..8aa4c43 100644 --- a/src/Bristlecone/Language.fs +++ b/src/Bristlecone/Language.fs @@ -150,6 +150,39 @@ module Language = | Invalid -> bind ((), "invalid model") | Conditional _ -> bind ((), "conditional element") // TODO + type Requirement = + | ParameterRequirement of string + | EnvironmentRequirement of string + + /// Determines the parameter and environmental data requirements of the defined model expression. + let rec requirements ex reqs = + match ex with + | This -> reqs + | Time -> reqs + | Environment name -> EnvironmentRequirement name :: reqs + | Parameter name -> ParameterRequirement name :: reqs + | Constant _ -> reqs + | Add list + | Multiply list -> + list + |> List.collect(fun l -> requirements l reqs) + |> List.append reqs + | Divide(l, r) + | Subtract(l, r) -> + [ requirements l reqs; requirements r reqs; reqs ] |> List.concat + | Arbitrary(fn, r) -> + r + |> List.map(fun r -> + match r with + | ArbitraryEnvironment e -> EnvironmentRequirement e + | ArbitraryParameter p -> ParameterRequirement p) + |> List.append reqs + | Mod(e, _) -> requirements e reqs + | Exponent(e, _) -> requirements e reqs + | Invalid -> reqs + | Conditional _ -> reqs + + /// Allows common F# functions to use Bristlecone model expressions. module ComputableFragment = @@ -257,17 +290,24 @@ module Language = |> Seq.choose id |> Map.ofSeq - // let requirements = - // equations - // |> Map.map (fun k v -> ExpressionParser.describe v |> Writer.run |> snd) - - // 1. Check all requirements are met (equations, measures, likelihood fn) - - // 2. Check that all estimatable parameters are used. - - - // 3. Summarise each equation: - // > Print if mass / time is required. + if Seq.hasDuplicates (Seq.concat [ Map.keys measures; Map.keys equations ]) + then failwith "Duplicate keys were used within equation and measures. These must be unique." + + if equations.IsEmpty then failwith "No equations specified. You must state at least one model equation." + + equations + |> Map.map (fun _ v -> ExpressionParser.requirements v []) + |> Map.toList + |> List.map snd + |> List.collect id + |> List.distinct + |> List.iter(fun req -> + match req with + | ExpressionParser.ParameterRequirement p -> + match parameters |> Parameter.Pool.hasParameter p with + | Some p -> () + | None -> failwithf "The specified model requires the parameter '%s' but this has not been set up." p + | ExpressionParser.EnvironmentRequirement _ -> ()) { Likelihood = likelihoods |> Seq.head Parameters = parameters diff --git a/src/Bristlecone/Library.fs b/src/Bristlecone/Library.fs index ce07f57..ab0d214 100755 --- a/src/Bristlecone/Library.fs +++ b/src/Bristlecone/Library.fs @@ -58,7 +58,7 @@ module Bristlecone = timeSeriesData |> Map.filter (fun k _ -> equationKeys |> Seq.contains k) |> TimeFrame.tryCreate - |> Result.ofOption "There must be at least one time-series of observations. If more than one specified, observations for dynamic variables must share a common sampling time sequence" + |> Result.ofOption "Observations for dynamic variables must share a common sampling time sequence" /// Finds environmental data in a timeseries map (i.e. those datasets that are not /// dynamic variables or measures), and constructs a common `TimeFrame`. @@ -130,10 +130,21 @@ module Bristlecone = // A. Setup initial time point values based on conditioning method. let t0 = Fit.t0 timeSeriesData engine.Conditioning engine.LogTo + // Check there is time-series data actually included and corresponding to correct equations. + let hasRequiredData = + if timeSeriesData.IsEmpty then Error "No time-series data was specified" + else + if Set.isSubset (model.Equations |> Map.keys |> set) (timeSeriesData |> Map.keys |> set) + then Ok timeSeriesData + else Error (sprintf "Required time-series data were missing. Need: %A" (model.Equations |> Map.keys |> Seq.map (fun k -> k.Value) |> String.concat " + ")) + // B. Create a continuous-time that outputs float[] // containing only the values for the dynamic variable resolution. let continuousSolver = result { + + let! timeSeriesData = hasRequiredData + // 1. Set time-series into common timeline let! commonDynamicTimeFrame = Fit.observationsToCommonTimeFrame model.Equations timeSeriesData diff --git a/src/Bristlecone/Parameter.fs b/src/Bristlecone/Parameter.fs index b8e5cb3..70f4f03 100755 --- a/src/Bristlecone/Parameter.fs +++ b/src/Bristlecone/Parameter.fs @@ -127,6 +127,9 @@ module Parameter = let toList pool = (pool |> unwrap) |> Map.toList + let hasParameter name pool = + pool |> unwrap |> Map.tryFindBy(fun k -> k.Value = name) + /// Returns Some value if a parameter with the `key` /// exists in the Pool. The value returned is transformed /// for an unconstrained parameter space. diff --git a/tests/Bristlecone.Tests/Bristlecone.fs b/tests/Bristlecone.Tests/Bristlecone.fs index abdeea1..ed43c17 100644 --- a/tests/Bristlecone.Tests/Bristlecone.fs +++ b/tests/Bristlecone.Tests/Bristlecone.fs @@ -155,7 +155,7 @@ module ``Fit`` = [ testPropertyWithConfig Config.config "Positive only parameter is transformed when optimising in transformed space" - <| fun (dataCodes: ShortCode.ShortCode list) (data: float list) startDate months (b1: NormalFloat) (b2: NormalFloat) -> + <| fun (data: float list) startDate months (b1: NormalFloat) (b2: NormalFloat) -> let testModel b1 b2 = TestModels.twoEquationConstant Language.notNegative b1 b2 if b1.Get = b2.Get || b1.Get = 0. || b2.Get = 0. then @@ -177,18 +177,18 @@ module ``Fit`` = OptimiseWith = optimTest } let data = - dataCodes + [ (ShortCode.create "x").Value; (ShortCode.create "y").Value ] |> Seq.map(fun c -> c, Time.TimeSeries.fromSeq startDate (Time.FixedTemporalResolution.Months months) data) |> Map.ofSeq let result = Expect.wantOk - (Bristlecone.fit defaultEngine defaultEndCon data (testModel b1 b2)) + (Bristlecone.fit engine defaultEndCon data (testModel b1 b2)) "Errored when should be OK" Expect.equal inOptimMin - (min b1 b2) + (min (log(b1)) (log(b2))) "The lower bound was not transformed inside the optimiser" ] ] diff --git a/tests/Bristlecone.Tests/Language.fs b/tests/Bristlecone.Tests/Language.fs index 5de7b12..1914d24 100644 --- a/tests/Bristlecone.Tests/Language.fs +++ b/tests/Bristlecone.Tests/Language.fs @@ -54,18 +54,18 @@ let modelExpressions = testProperty "A constant is purely represented" <| fun (c: NormalFloat) x t pool env -> Constant c.Get |> compute x t pool env = c.Get - testProperty "Getting parameter value fails when parameter not present" - <| fun code x t pool e -> - let f () = Parameter code |> compute x t pool e + testPropertyWithConfig Config.config "Getting parameter value fails when parameter not present" + <| fun (code:ShortCode.ShortCode) x t pool e -> + let f () = Parameter code.Value |> compute x t pool e - match pool |> Parameter.Pool.toList |> List.tryFind (fun (k, v) -> k.Value = code) with + match pool |> Parameter.Pool.toList |> List.tryFind (fun (k, _) -> k.Value = code.Value) with | Some p -> Expect.equal (f ()) (p |> snd |> Parameter.getTransformedValue) "Did not fail when parameter was not present" | None -> - Expect.throws (fun () -> f |> ignore) "Parameter was not present" + Expect.throws (fun () -> f () |> ignore) "Parameter was not present" testPropertyWithConfig Config.config "Getting parameter values returns real value when present" <| fun pool x t e -> @@ -86,8 +86,8 @@ let modelExpressions = let f () = Environment code.Value |> compute x t pool e match e |> Map.tryFindBy (fun m -> m.Value = code.Value) with - | Some environ -> Expect.equal (f ()) environ "Did not fail when parameter was not present" - | None -> Expect.throws (fun () -> f |> ignore) "The parameter was not present" + | Some environ -> Expect.equal (f ()) environ "Did not fail when environment data was not present" + | None -> Expect.throws (fun () -> f () |> ignore) "Environmental data was not present" testPropertyWithConfig Config.config "Retrieves environment when present" <| fun identifier (value: NormalFloat) x t pool -> @@ -132,26 +132,28 @@ let modelBuilder = Expect.throws (fun () -> fn () |> ignore) "Did not throw when no equations specified" testPropertyWithConfig Config.config "Compiles with one likelihood function and one or more equations (no duplicate keys)" - <| fun l (eqs: CodedMap) -> - let mb = - eqs - |> Map.fold - (fun mb k v -> mb |> Model.addEquation k.Value v) - (Model.empty |> Model.useLikelihoodFunction l) - - if eqs |> Seq.isEmpty then - Expect.throws (fun () -> mb |> Model.compile |> ignore) "Did not error when no equations specified" + <| fun l (eqs: ShortCode.ShortCode list) -> + if eqs |> Seq.hasDuplicates then () else - mb |> Model.compile |> ignore + let mb = + eqs + |> List.fold + (fun mb k -> mb |> Model.addEquation k.Value (Constant 1.)) + (Model.empty |> Model.useLikelihoodFunction l) + + if eqs |> Seq.isEmpty then + Expect.throws (fun () -> mb |> Model.compile |> ignore) "Did not error when no equations specified" + else + mb |> Model.compile |> ignore testPropertyWithConfig Config.config "Compiles whether measures are present or not" - <| fun likelihood eq1 (measures:CodedMap) -> + <| fun likelihood (measures:CodedMap) -> if measures.Keys |> Seq.hasDuplicates then () else let model = Model.empty |> Model.useLikelihoodFunction likelihood - |> Model.addEquation "eq1" eq1 + |> Model.addEquation "eq1" (Constant 1.) measures |> Map.fold (fun mb n m -> mb |> Model.includeMeasure n.Value m) model @@ -159,12 +161,16 @@ let modelBuilder = |> ignore testPropertyWithConfig Config.config "Doesn't compile if duplicate keys exist" - <| fun likelihood (eqs: (ShortCode.ShortCode * ModelExpression) list) measures -> + <| fun likelihood (eqs: (ShortCode.ShortCode * ModelExpression) list) (measures: (ShortCode.ShortCode * ModelSystem.MeasureEquation) list) -> let compile () = eqs |> Seq.fold (fun mb (n, eq) -> mb |> Model.addEquation n.Value eq) (Model.empty |> Model.useLikelihoodFunction likelihood) + |> fun mb -> + Seq.fold + (fun mb (n: ShortCode.ShortCode, eq) -> mb |> Model.includeMeasure n.Value eq) + mb measures |> Model.compile let keys = [ (eqs |> List.map fst); (measures |> List.map fst) ] |> List.concat