Skip to content

Commit

Permalink
fixed ASet.ofSetTree/ofListTree: ignore nested dirty updates
Browse files Browse the repository at this point in the history
  • Loading branch information
luithefirst committed Feb 21, 2025
1 parent 1b6d265 commit 297000f
Show file tree
Hide file tree
Showing 4 changed files with 123 additions and 23 deletions.
3 changes: 3 additions & 0 deletions RELEASE_NOTES.md
Original file line number Diff line number Diff line change
@@ -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
Expand Down
65 changes: 44 additions & 21 deletions src/FSharp.Data.Adaptive/CollectionExtensions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 ->
Expand All @@ -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


Expand All @@ -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))
Expand All @@ -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
Expand All @@ -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


Expand Down
74 changes: 73 additions & 1 deletion src/Test/FSharp.Data.Adaptive.Tests/ASet.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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

()
4 changes: 3 additions & 1 deletion src/Test/FSharp.Data.Adaptive.Tests/Program.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 297000f

Please sign in to comment.