Add random large trees with different characteristics

generate.fsx

@@ -134,6 +134,51 @@ module Nureg =
             ])
         ])
 
+module Random =
+    let private weightedRandom (values: (float * 'a) array) (random: System.Random) =
+        let cumulative, max = values |> Seq.mapFold (fun cumul (w, _) -> cumul, cumul + w) 0.
+        let cumulative = cumulative |> Seq.toArray
+        fun () -> 
+            let value = random.NextDouble() * max
+            let index = System.Array.BinarySearch(cumulative, value)
+            let index = if index < 0 then ~~~index - 1 else index
+            snd values.[index]
+
+    type [<RequireQualifiedAccess>] private Node = Leaf | And | Or | Vote
+    type private RandomConfig =
+        { Leaf: float; And: float; Or: float; Vote: float; MaxChildren: int; MaxDepth: int }
+
+    let private random config seed =
+        let r = System.Random seed
+        let randomNodeType = weightedRandom [| config.Leaf, Node.Leaf; config.And, Node.And; config.Or, Node.Or; config.Vote, Node.Vote |] r
+        let rec getRandomNode name depth =
+            let node = if depth < config.MaxDepth then randomNodeType () else Node.Leaf
+            match node with
+            | Node.Leaf -> 
+                BasicEvent name
+            | Node.And ->
+                let children = r.Next(1, config.MaxChildren + 1)
+                IntermediateEvent (name, And, [ for i in 1..children -> getRandomNode $"{name}_{i}" (depth + 1) ])
+            | Node.Or ->
+                let children = r.Next(1, config.MaxChildren + 1)
+                IntermediateEvent (name, Or, [ for i in 1..children -> getRandomNode $"{name}_{i}" (depth + 1) ])
+            | Node.Vote ->
+                let children = r.Next(1, config.MaxChildren + 1)
+                let voteCount = r.Next(1, children)
+                IntermediateEvent (name, Vote voteCount, [ for i in 1..children -> getRandomNode $"{name}_{i}" (depth + 1) ])
+        getRandomNode "0" 0
+
+    let private seed = 0
+    let private largeConfig = { Leaf = 1.; And = 1.; Or = 1.; Vote = 1.; MaxChildren = 5; MaxDepth = 7 }
+    let private deepNarrowConfig = { largeConfig with Leaf = 0.6; MaxChildren = 2; MaxDepth = 24 }
+    let private shallowWideConfig = { largeConfig with Leaf = 2.; MaxChildren = 14; MaxDepth = 4 }
+
+    let large = random largeConfig seed
+    let deepNarrow = random deepNarrowConfig seed
+    let shallowWide = random shallowWideConfig seed
+    let largeOnlyAnd = random { largeConfig with And = 3.; Or = 0.; Vote = 0. } seed
+    let largeOnlyOr = random { largeConfig with And = 0.; Or = 3.; Vote = 0. } seed
+
 // Tree Helpers
 ///////////////
 let rec treeMapName f = function
@@ -219,14 +264,21 @@ let writeTreeToDotFile filename tree =
 
 // Write all trees above to a file
 //////////////////////////////////
-Directory.CreateDirectory ("./trees") 
-[ "serversAssignment2_basic", ServersAssignment2.basic
-  "serversAssignment2_withPurpose", ServersAssignment2.withPurpose
-  "safeRoadTrip", safeRoadTrip
-  "ftaOverviewPaper_figure4", FtaOverviewPaper.figure4
-  "ftaOverviewPaper_figure5", FtaOverviewPaper.figure5
-  "nureg_preasureTankRupture", Nureg.preasureTankRupture ]
-|> List.iter (fun (file, tree) -> 
+let sw = System.Diagnostics.Stopwatch.StartNew()
+Directory.CreateDirectory ("./trees")
+seq {
+    "serversAssignment2_basic", ServersAssignment2.basic
+    "serversAssignment2_withPurpose", ServersAssignment2.withPurpose
+    "safeRoadTrip", safeRoadTrip
+    "ftaOverviewPaper_figure4", FtaOverviewPaper.figure4
+    "ftaOverviewPaper_figure5", FtaOverviewPaper.figure5
+    "nureg_preasureTankRupture", Nureg.preasureTankRupture
+    "random_large", Random.large
+    "random_deepNarrow", Random.deepNarrow
+    "random_shallowWide", Random.shallowWide
+    "random_largeOnlyAnd", Random.largeOnlyAnd
+    "random_largeOnlyOr", Random.largeOnlyOr
+} |> Seq.iter (fun (file, tree) ->
     printfn "Writing %s" file
     writeTreeToFile $"./trees/{file}.json" tree
     writeTreeToDotFile $"./trees/{file}.dot" tree