fixed ASet.ofSetTree/ofListTree: ignore nested dirty updates

Author: luithefirst

RELEASE_NOTES.md

@@ -1,3 +1,6 @@
+### 1.2.21
+- fixed ASet.ofSetTree/ofListTree: ignore nested dirty updates
+
 ### 1.2.20
 - added ASet.ofListTree and ASet.ofSetTree
 - added AList.mapToASet

src/FSharp.Data.Adaptive/CollectionExtensions.fs

@@ -291,6 +291,7 @@ module CollectionExtensions =
             let mutable initial = true
             let reader = list.GetReader() // NOTE: need to be held, otherwise it will be collected and no updates can be consumed
             let cache = System.Collections.Generic.Dictionary<struct(IIndexListReader<'T> * FSharp.Data.Adaptive.Index), struct('T * IIndexListReader<'T>)>() // TODO: refcounting
+            let removedDirty = DefaultHashSet.create<IIndexListReader<'T>>()
 
             member x.Invoke(token : AdaptiveToken, r : IIndexListReader<'T>, i : FSharp.Data.Adaptive.Index, n : 'T) =
                 let mutable delta = HashSetDelta.empty
@@ -316,8 +317,15 @@ module CollectionExtensions =
                 let mutable delta = HashSetDelta.empty
                 match cache.TryGetValue (struct(r, i)) with
                 | (true, struct(n, subReader)) -> 
-                    cache.Remove (struct(r, i)) |> ignore
-                    subReader.Outputs.Remove x |> ignore
+                    if not (cache.Remove (struct(r, i))) then
+                        unexpected()
+
+                    // if subReader is outOfDate it is expected to be also included in "dirty" inputs
+                    //  -> prevent updates to be included in delta computation
+                    if subReader.OutOfDate then
+                        removedDirty.Add(subReader) |> ignore
+                    elif not (subReader.Outputs.Remove x) then
+                        unexpected()
 
                     delta <- delta.Add (Rem n)
                     subReader.State |> IndexList.iteri (fun i old ->
@@ -338,12 +346,15 @@ module CollectionExtensions =
                         | _ -> unexpected()
 
                 for d in dirty do
-                    let inner = d.GetChanges token
-                    for c in inner do
-                        match c with
-                        | (i, Set n) -> delta <- delta.Combine (x.Invoke(token, d, i, n))
-                        | (i, Remove) -> delta <- delta.Combine (x.Revoke(d, i))
+                    if not (removedDirty.Contains d) then
+                        let inner = d.GetChanges token
+                        for c in inner do
+                            match c with
+                            | (i, Set n) -> delta <- delta.Combine (x.Invoke(token, d, i, n))
+                            | (i, Remove) -> delta <- delta.Combine (x.Revoke(d, i))
 
+                removedDirty.Clear()
+
                 delta
 
 
@@ -355,18 +366,19 @@ module CollectionExtensions =
             let mutable initial = true
             let reader = set.GetReader() // NOTE: need to be held, otherwise it will be collected and no updates can be consumed
             let cache = DefaultDictionary.create<'T, struct(IHashSetReader<'T> * ref<int>)>()
+            let removedDirty = DefaultHashSet.create<IHashSetReader<'T>>()
 
             member x.Invoke(token : AdaptiveToken, n : 'T) =
                 let mutable delta = HashSetDelta.empty
                 match cache.TryGetValue n with
                 | (true, (_, refCount)) -> refCount.Value <- refCount.Value + 1
                 | _ ->
                     let subNodes = getChildren n
-                    let reader = subNodes.GetReader()
-                    cache[n] <- (reader, ref 1)
+                    let subReader = subNodes.GetReader()
+                    cache[n] <- (subReader, ref 1)
 
                     delta <- delta.Add (Add n)
-                    let content = reader.GetChanges token
+                    let content = subReader.GetChanges token
                     for c in content do
                         if c.Count <> 1 then unexpected()
                         delta <- delta.Combine (x.Invoke(token, c.Value))
@@ -376,13 +388,20 @@ module CollectionExtensions =
             member x.Revoke(n : 'T) =
                 let mutable delta = HashSetDelta.empty
                 match cache.TryGetValue n with
-                | (true, (reader, refCount)) -> 
+                | (true, (subReader, refCount)) -> 
                     if refCount.Value = 1 then
-                        cache.Remove n |> ignore
-                        reader.Outputs.Remove x |> ignore
+                        if not (cache.Remove n) then
+                            unexpected()
+
+                        // if subReader is outOfDate it is expected to be also included in "dirty" inputs
+                        //  -> prevent updates to be included in delta computation
+                        if subReader.OutOfDate then
+                            removedDirty.Add(subReader) |> ignore
+                        elif not (subReader.Outputs.Remove x) then
+                            unexpected()
 
                         delta <- delta.Add (Rem n)
-                        for old in reader.State do
+                        for old in subReader.State do
                             delta <- delta.Combine (x.Revoke(old))
                     else
                         refCount.Value <- refCount.Value - 1
@@ -404,13 +423,17 @@ module CollectionExtensions =
                         HashSetDelta.empty
 
                 for d in dirty do
-                    let inner = d.GetChanges token |> HashSetDelta.collect (fun d ->
-                            let n = d.Value
-                            if d.Count = 1 then x.Invoke(token, n)
-                            elif d.Count = -1 then x.Revoke(n)
-                            else unexpected()
-                        )
-                    deltas <- deltas.Combine inner
+                    if not (removedDirty.Contains d) then
+                        let inner = d.GetChanges token |> HashSetDelta.collect (fun d ->
+                                let n = d.Value
+                                if d.Count = 1 then x.Invoke(token, n)
+                                elif d.Count = -1 then x.Revoke(n)
+                                else unexpected()
+                            )
+                        deltas <- deltas.Combine inner
+
+                removedDirty.Clear()
+
                 deltas
 
 

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

@@ -784,4 +784,76 @@ let ``[ASet] filterA``() =
         takeEven.Value <- true
         )
 
-    filtered |> ASet.force |> should setequal [0; 1; 2; 3; 4]
+    filtered |> ASet.force |> should setequal [0; 1; 2; 3; 4]
+
+type SetTreeNode = 
+    { 
+        value : int
+        nodes : cset<SetTreeNode> 
+    }
+    override this.ToString() = sprintf "Node %d" this.value
+
+[<Test>]
+let ``[ASet] ofSetTree``() =
+    
+    let roots = cset<SetTreeNode>()
+
+    let filter = AVal.init(0)
+    let set = roots |> ASet.filterA (fun n -> filter |> AVal.map(fun f -> (n.value % 2) = f)) |> ASet.ofSetTree (fun n -> n.nodes |> ASet.filterA (fun n -> filter |> AVal.map(fun f -> (n.value % 2) = f)))
+        
+    let rec cnt (nodes : cset<SetTreeNode>) (filter : int) =
+        let mutable sum = 0
+        for sn in nodes do
+            if (sn.value % 2) = filter then
+                sum <- sum + (cnt sn.nodes filter) + 1
+        sum
+
+    let nodes = System.Collections.Generic.List<SetTreeNode>()
+    
+    let rnd = System.Random(2225)
+    for i in 0..10000 do
+        transact (fun () ->
+            if rnd.NextDouble() < 0.1 then
+                let newFilter = if filter.Value = 0 then 1 else 0
+                //printfn "%d: toggle filter %d" i newFilter
+                filter.Value <- newFilter
+            else
+                if roots.Count = 0 || rnd.NextDouble() < 0.45 then
+                    let nv = rnd.Next()
+                    let n = { value = nv; nodes = cset<SetTreeNode>() }
+                    if roots.Count = 0 || rnd.NextDouble() < 0.25 then
+                        roots.Add n |> ignore
+                        //printfn "%d: add root node %d" i nv
+                    else
+                        let index = rnd.Next(nodes.Count)   
+                        nodes.[index].nodes.Add(n) |> ignore
+                        //printfn "%d: add node %d to %d" i nv (nodes.[index].value)
+                    nodes.Add n |> ignore
+                else
+                    if rnd.NextDouble() < 0.2 then
+                        let index = rnd.Next(roots.Count)
+                        let n = roots |> Seq.skip(index) |> Seq.head
+                        nodes.Remove(n) |> ignore
+                        roots.Remove(n) |> ignore
+                        //printfn "%d: rem root node %d" i n.value
+                    else
+                        let index = rnd.Next(nodes.Count)
+                        let n = nodes.[index]
+                        if n.nodes.Count > 0 then
+                            let indexRem = rnd.Next(n.nodes.Count)
+                            let nr = n.nodes |> Seq.skip(indexRem) |> Seq.head
+                            nodes.Remove(nr) |> ignore
+                            n.nodes.Remove(nr) |> ignore
+                            //printfn "%d: rem node %d from %d" i nr.value n.value
+            )
+
+
+        let refCnt = cnt roots (filter |> AVal.force)
+        let setCnt = (set |> ASet.force).Count 
+
+        if refCnt <> setCnt then
+            printfn "fail: refCnt=%d setCnt=%d" refCnt setCnt
+                
+        should equal setCnt refCnt
+
+    ()

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

@@ -54,6 +54,8 @@ let main _args =
 
     //``[AList] sub``();
 
+    ASet.``[ASet] ofSetTree``();
+
 
     //let a = cval [1;2;3;4]
     //let b = AVal.cast<seq<int>> a
@@ -92,7 +94,7 @@ let main _args =
     //BenchmarkRunner.Run<Benchmarks.HashSetDeltaBench>() |> ignore
     //BenchmarkRunner.Run<Benchmarks.IndexListBenchmarks>() |> ignore
     //BenchmarkRunner.Run<Benchmarks.IndexEqualsBenchmarks>() |> ignore
-    BenchmarkRunner.Run<Benchmarks.IndexGarbageBenchmarks>() |> ignore
+    //BenchmarkRunner.Run<Benchmarks.IndexGarbageBenchmarks>() |> ignore
 
     //let x = Benchmarks.IndexGarbageBenchmarks()
     //x.ListCount <- 100