Merge branch 'master' into acm-docs1

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"

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

src/Bristlecone/Library.fs

@@ -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
 

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.

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)
+
 [<RequireQualifiedAccess>]
 module Map =
 

tests/Bristlecone.Tests/Bristlecone.Tests.fsproj

@@ -8,6 +8,7 @@
   </PropertyGroup>
   <ItemGroup>
     <ProjectReference Include="../../src/Bristlecone/Bristlecone.fsproj" />
+    <Compile Include="Config.fs" />
     <Compile Include="Time.fs" />
     <Compile Include="Parameter.fs" />
     <Compile Include="Optimisation.fs" />

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<Time.TimeSeries.TimeSeries<float>> =
-                            [ (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<Time.TimeSeries.TimeSeries<float>> =
+                                [ (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 (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 = 
+                                [ (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 engine defaultEndCon data (testModel b1 b2))
+                                    "Errored when should be OK"
+
+                            Expect.equal
+                                inOptimMin
+                                (min (log(b1)) (log(b2)))
+                                "The lower bound was not transformed inside the optimiser" ]
 
               ]