BatchRecalcDirty

Author: TheAngryByrd

src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs

@@ -756,9 +756,9 @@ module AdaptiveHashMapImplementation =
 
             HashMapDelta.ofHashMap changes
 
-    /// Reader for deltaA operations.
+    /// Reader for batchRecalc operations.
     [<Sealed>]
-    type DeltaAReader<'k, 'a, 'b>(input : amap<'k, 'a>, mapping : HashMap<'k,'a> -> HashMap<'k, aval<'b>>) =
+    type BatchRecalculateDirty<'k, 'a, 'b>(input : amap<'k, 'a>, mapping : HashMap<'k,'a> -> HashMap<'k, aval<'b>>) =
         inherit AbstractReader<HashMapDelta<'k, 'b>>(HashMapDelta.empty)
 
         let reader = input.GetReader()
@@ -787,6 +787,7 @@ module AdaptiveHashMapImplementation =
                 lock cacheLock (fun () ->
                     for i in MultiSetMap.find o targets do
                         dirty <- HashMap.add i o dirty
+                    
                 )
             | _ ->
                 ()
@@ -816,19 +817,22 @@ module AdaptiveHashMapImplementation =
                         sets, HashMap.add i Remove rems
                 )
 
-            let mutable changes =
-                setOps
-                |> mapping
-                |> HashMap.map(fun i k ->
-                    cache <- HashMap.add i k cache
-                    let v = k.GetValue t
-                    targets <- MultiSetMap.add k i targets
-                    Set v
-                )
 
+            let mutable changes = HashMap.empty
+            let setOps =
+                (setOps, dirty)
+                ||> HashMap.fold(fun s k v -> 
+                    match HashMap.tryFind k old with
+                    | Some v ->
+                        HashMap.add k v s
+                    | None ->
+                        s
+                )
 
-            for i, d in dirty do
-                let v = d.GetValue t
+            for i, k in mapping setOps   do
+                cache <- HashMap.add i k cache
+                let v = k.GetValue t
+                targets <- MultiSetMap.add k i targets
                 changes <- HashMap.add i (Set v) changes
 
             HashMap.union removeOps changes
@@ -1411,17 +1415,17 @@ module AMap =
         else
             create (fun () -> MapAReader(map, mapping))
 
-    /// Adaptively applies the given mapping to all changes.
-    let deltaA (mapping: HashMap<'K,'T1> -> HashMap<'K,aval<'T2>>) (map: amap<'K, 'T1>) =
+    /// Adaptively applies the given mapping to all changes and reapplies mapping on dirty outputs
+    let batchRecalcDirty (mapping: HashMap<'K,'T1> -> HashMap<'K,aval<'T2>>) (map: amap<'K, 'T1>) =
         if map.IsConstant then
             let map = force map |> mapping
             if map |> HashMap.forall (fun _ v -> v.IsConstant) then
                 constant (fun () -> map |> HashMap.map (fun _ v -> AVal.force v))
             else
                 // TODO better impl possible
-                create (fun () -> MapAReader(ofHashMap map, fun _ v -> v))
+                create (fun () -> BatchRecalculateDirty(ofHashMap map, id))
         else
-            create (fun () -> DeltaAReader(map, mapping))
+            create (fun () -> BatchRecalculateDirty(map, mapping))
 
 
     /// Adaptively chooses all elements returned by mapping.  

src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi

@@ -106,7 +106,7 @@ module AMap =
     val mapA : mapping: ('K -> 'V -> aval<'T>) -> map: amap<'K, 'V> -> amap<'K, 'T>
 
     /// Adaptively applies the given mapping to all changes.
-    val deltaA : mapping: (HashMap<'K,'T1> -> HashMap<'K,aval<'T2>>) -> map: amap<'K, 'T1> -> amap<'K, 'T2>
+    val batchRecalcDirty : mapping: (HashMap<'K,'T1> -> HashMap<'K,aval<'T2>>) -> map: amap<'K, 'T1> -> amap<'K, 'T2>
 
     /// Adaptively chooses all elements returned by mapping.  
     val chooseA : mapping: ('K -> 'V -> aval<option<'T>>) -> map: amap<'K, 'V> -> amap<'K, 'T>

src/Test/FSharp.Data.Adaptive.Tests/AMap.fs

@@ -8,6 +8,8 @@ open FsUnit
 open FsCheck.NUnit
 open FSharp.Data
 open Generators
+open System.IO
+open System
 
 [<Property(MaxTest = 500, Arbitrary = [| typeof<Generators.AdaptiveGenerators> |]); Timeout(60000)>]
 let ``[AMap] reference impl``() ({ mreal = real; mref = ref; mexpression = str; mchanges = changes } : VMap<int, int>) =
@@ -641,34 +643,110 @@ let ``[AMap] mapA``() =
     res |> AMap.force |> should equal (HashMap.ofList ["A", 2; "B", 4; "C", 6])
 
 
-    
-[<Test>]
-let ``[AMap] deltaA``() =
-    let map = cmap ["A", 1; "B", 2; "C", 3]
-    let flag = cval true
 
+/// <summary>
+/// Calls a mapping function which creates additional dependencies to be tracked.
+/// </summary>
+let mapWithAdditionalDependenies (mapping: 'a -> 'b * #seq<#IAdaptiveValue>) (value: aval<'a>) : aval<'b> =
+    let mutable lastDeps = HashSet.empty
+
+    { new AVal.AbstractVal<'b>() with
+        member x.Compute(token: AdaptiveToken) =
+          let input = value.GetValue token
+
+          // re-evaluate the mapping based on the (possibly new input)
+          let result, deps = mapping input
+
+          // compute the change in the additional dependencies and adjust the graph accordingly
+          let newDeps = HashSet.ofSeq deps
+
+          for op in HashSet.computeDelta lastDeps newDeps do
+            match op with
+            | Add(_, d) ->
+              // the new dependency needs to be evaluated with our token, s.t. we depend on it in the future
+              d.GetValueUntyped token |> ignore
+            | Rem(_, d) ->
+              // we no longer need to depend on the old dependency so we can remove ourselves from its outputs
+              lock d.Outputs (fun () -> d.Outputs.Remove x) |> ignore
+
+          lastDeps <- newDeps
+
+          result }
+    :> aval<_>
+
+[<Test>]
+let ``[AMap] batchRecalcDirty``() =
+
+    let file1 = "File1.fs"
+    let file1Cval = cval 1
+    let file1DepCval = cval 1
+    let file2 = "File2.fs"
+    let file2Cval = cval 2
+    let file2DepCval = cval 1
+    let file3 = "File3.fs"
+    let file3Cval = cval 3
+    let file3DepCval = cval 1
+
+    let m = Map [file1, file1DepCval; file2, file2DepCval; file3, file3DepCval]
+
+    let projs = 
+        [
+            file1, file1Cval
+            file2, file2Cval
+            file3, file3Cval
+        ] 
+        |> AMap.ofList
+        |> AMap.mapA(fun _ v -> v)
+
+    let mutable lastBatch = Unchecked.defaultof<_>
     let res =
-        map |> AMap.deltaA (fun d ->
-            d
-            |> HashMap.map(fun _ v -> flag |> AVal.map (function true -> v | false -> -1))
+        projs
+        |> AMap.batchRecalcDirty(fun d ->
+            lastBatch <- d
+            HashMap.ofList [
+                for k,v in d do
+                    k, (AVal.constant <| Guid.NewGuid()) |> mapWithAdditionalDependenies(fun a -> a, [m.[k]])
+            ]
         )
+    let firstResult = res |> AMap.force
+    lastBatch |> should haveCount 3
 
-    res |> AMap.force |> should equal (HashMap.ofList ["A", 1; "B", 2; "C", 3])
+    transact(fun () -> file1Cval.Value <- file1Cval.Value + 1)
 
-    transact (fun () ->
-        flag.Value <- false
-    )
+    let secondResult = res |> AMap.force
+    lastBatch |> should haveCount 1
+    
+    firstResult.[file1] |> should not' (equal secondResult.[file1])
+    firstResult.[file2] |> should equal secondResult.[file2]
+    firstResult.[file3] |> should equal secondResult.[file3]
 
-    res |> AMap.force |> should equal (HashMap.ofList ["A", -1; "B", -1; "C", -1])
 
-    transact (fun () ->
-        map.Value <- map.Value |> HashMap.map (fun _ v -> v * 2)
-    )
+    transact(fun () -> 
+        file1Cval.Value <- file1Cval.Value + 1
+        file3Cval.Value <- file3Cval.Value + 1)
+    
+    let thirdResult = res |> AMap.force
+    lastBatch |> should haveCount 2
 
-    res |> AMap.force |> should equal (HashMap.ofList ["A", -1; "B", -1; "C", -1])
+    secondResult.[file1] |> should not' (equal thirdResult.[file1])
+    secondResult.[file2] |> should equal thirdResult.[file2]
+    secondResult.[file3] |> should not' (equal thirdResult.[file3])
 
-    transact (fun () ->
-        flag.Value <- true
-    )
 
-    res |> AMap.force |> should equal (HashMap.ofList ["A", 2; "B", 4; "C", 6])
+    transact(fun () -> file1DepCval.Value <- file1DepCval.Value + 1)
+
+    let fourthResult = res |> AMap.force
+    lastBatch |> should haveCount 1
+    
+    thirdResult.[file1] |> should not' (equal fourthResult.[file1])
+
+    transact(fun () -> 
+        file1DepCval.Value <- file1DepCval.Value + 1
+        file1Cval.Value <- file1Cval.Value)
+
+    let fifthResult = res |> AMap.force
+    lastBatch |> should haveCount 1
+    
+    fourthResult.[file1] |> should not' (equal fifthResult.[file1])
+
+    ()