From f424eeabcf91bcb1ed59c2363d8d683d6c6918b1 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Wed, 15 Mar 2023 12:59:48 -0400 Subject: [PATCH 1/7] AMap deltaA implementation --- .../AdaptiveHashMap/AdaptiveHashMap.fs | 93 ++++++++++++++++++- .../AdaptiveHashMap/AdaptiveHashMap.fsi | 4 +- src/Test/FSharp.Data.Adaptive.Tests/AMap.fs | 33 +++++++ 3 files changed, 128 insertions(+), 2 deletions(-) diff --git a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs index 07daee5..cb3208b 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs +++ b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs @@ -755,7 +755,85 @@ module AdaptiveHashMapImplementation = changes <- HashMap.add i (Set v) changes HashMapDelta.ofHashMap changes - + + /// Reader for deltaA operations. + [] + type DeltaAReader<'k, 'a, 'b>(input : amap<'k, 'a>, mapping : HashMap<'k,'a> -> HashMap<'k, aval<'b>>) = + inherit AbstractReader>(HashMapDelta.empty) + + let reader = input.GetReader() + do reader.Tag <- "input" + let cacheLock = obj() + let mutable cache: HashMap<'k, aval<'b>> = HashMap.Empty + let mutable targets = MultiSetMap.empty, 'k> + let mutable dirty = HashMap.empty<'k, aval<'b>> + + let consumeDirty() = + lock cacheLock (fun () -> + let d = dirty + dirty <- HashMap.empty + d + ) + + override x.InputChangedObject(t, o) = + #if FABLE_COMPILER + if isNull o.Tag then + let o = unbox> o + for i in MultiSetMap.find o targets do + dirty <- HashMap.add i o dirty + #else + match o with + | :? aval<'b> as o -> + lock cacheLock (fun () -> + for i in MultiSetMap.find o targets do + dirty <- HashMap.add i o dirty + ) + | _ -> + () + #endif + + override x.Compute t = + let mutable dirty = consumeDirty() + let old = reader.State + let ops = reader.GetChanges t |> HashMapDelta.toHashMap + + let setOps, removeOps = + ((HashMap.empty, HashMap.empty), ops) + ||> HashMap.fold(fun (sets, rems) i op -> + dirty <- HashMap.remove i dirty + cache <- + match HashMap.tryRemove i cache with + | Some (o, remaingCache) -> + let rem, rest = MultiSetMap.remove o i targets + targets <- rest + if rem then o.Outputs.Remove x |> ignore + remaingCache + | None -> cache + match op with + | Set v -> + HashMap.add i v sets, rems + | Remove -> + 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 + ) + + + for i, d in dirty do + let v = d.GetValue t + changes <- HashMap.add i (Set v) changes + + HashMap.union removeOps changes + |> HashMapDelta + /// Reader for chooseA operations. [] type ChooseAReader<'k, 'a, 'b>(input : amap<'k, 'a>, mapping : 'k -> 'a -> aval>) = @@ -1333,6 +1411,19 @@ 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>) = + 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)) + else + create (fun () -> DeltaAReader(map, mapping)) + + /// Adaptively chooses all elements returned by mapping. let chooseA (mapping: 'K ->'T1 -> aval>) (map: amap<'K, 'T1>) = if map.IsConstant then diff --git a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi index 0a1613c..050c564 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi +++ b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi @@ -102,10 +102,12 @@ module AMap = /// Adaptively intersects the two maps. val intersectV : amap<'Key, 'Value1> -> amap<'Key, 'Value2> -> amap<'Key, struct('Value1 * 'Value2)> - /// Adaptively applies the given mapping function to all elements and returns a new amap containing the results. 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> + /// Adaptively chooses all elements returned by mapping. val chooseA : mapping: ('K -> 'V -> aval>) -> map: amap<'K, 'V> -> amap<'K, 'T> diff --git a/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs b/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs index bcf4988..8b2732b 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs +++ b/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs @@ -638,4 +638,37 @@ let ``[AMap] mapA``() = flag.Value <- true ) + res |> AMap.force |> should equal (HashMap.ofList ["A", 2; "B", 4; "C", 6]) + + + +[] +let ``[AMap] deltaA``() = + let map = cmap ["A", 1; "B", 2; "C", 3] + let flag = cval true + + let res = + map |> AMap.deltaA (fun d -> + d + |> HashMap.map(fun _ v -> flag |> AVal.map (function true -> v | false -> -1)) + ) + + res |> AMap.force |> should equal (HashMap.ofList ["A", 1; "B", 2; "C", 3]) + + transact (fun () -> + flag.Value <- false + ) + + 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) + ) + + res |> AMap.force |> should equal (HashMap.ofList ["A", -1; "B", -1; "C", -1]) + + transact (fun () -> + flag.Value <- true + ) + res |> AMap.force |> should equal (HashMap.ofList ["A", 2; "B", 4; "C", 6]) \ No newline at end of file From 1124556127ebc7cc70b7a2a8d0e136e8a4e70ff9 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Thu, 16 Mar 2023 23:03:37 -0400 Subject: [PATCH 2/7] BatchRecalcDirty --- .../AdaptiveHashMap/AdaptiveHashMap.fs | 38 +++--- .../AdaptiveHashMap/AdaptiveHashMap.fsi | 2 +- src/Test/FSharp.Data.Adaptive.Tests/AMap.fs | 120 +++++++++++++++--- 3 files changed, 121 insertions(+), 39 deletions(-) diff --git a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs index cb3208b..540e804 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs +++ b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs @@ -756,9 +756,9 @@ module AdaptiveHashMapImplementation = HashMapDelta.ofHashMap changes - /// Reader for deltaA operations. + /// Reader for batchRecalc operations. [] - 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.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. diff --git a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi index 050c564..c2acf8b 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi +++ b/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>) -> map: amap<'K, 'V> -> amap<'K, 'T> diff --git a/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs b/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs index 8b2732b..42145fb 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs +++ b/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 [ |]); Timeout(60000)>] let ``[AMap] reference impl``() ({ mreal = real; mref = ref; mexpression = str; mchanges = changes } : VMap) = @@ -641,34 +643,110 @@ let ``[AMap] mapA``() = res |> AMap.force |> should equal (HashMap.ofList ["A", 2; "B", 4; "C", 6]) - -[] -let ``[AMap] deltaA``() = - let map = cmap ["A", 1; "B", 2; "C", 3] - let flag = cval true +/// +/// Calls a mapping function which creates additional dependencies to be tracked. +/// +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<_> + +[] +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]) \ No newline at end of file + 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]) + + () \ No newline at end of file From eae4a56960235ce01f35e53a7f8ed9160dd69af9 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Fri, 17 Mar 2023 07:19:32 -0400 Subject: [PATCH 3/7] refining batch operation --- .../AdaptiveHashMap/AdaptiveHashMap.fs | 4 +- src/Test/FSharp.Data.Adaptive.Tests/AMap.fs | 81 ++++++++++++------- 2 files changed, 56 insertions(+), 29 deletions(-) diff --git a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs index 540e804..1400f64 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs +++ b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs @@ -821,7 +821,7 @@ module AdaptiveHashMapImplementation = let mutable changes = HashMap.empty let setOps = (setOps, dirty) - ||> HashMap.fold(fun s k v -> + ||> HashMap.fold(fun s k _ -> match HashMap.tryFind k old with | Some v -> HashMap.add k v s @@ -1416,7 +1416,7 @@ module AMap = create (fun () -> MapAReader(map, mapping)) /// 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>) = + 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 diff --git a/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs b/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs index 42145fb..ed3eedb 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs +++ b/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs @@ -643,36 +643,47 @@ let ``[AMap] mapA``() = res |> AMap.force |> should equal (HashMap.ofList ["A", 2; "B", 4; "C", 6]) +module AVal = -/// -/// Calls a mapping function which creates additional dependencies to be tracked. -/// -let mapWithAdditionalDependenies (mapping: 'a -> 'b * #seq<#IAdaptiveValue>) (value: aval<'a>) : aval<'b> = - let mutable lastDeps = HashSet.empty + /// + /// Calls a mapping function which creates additional dependencies to be tracked. + /// + 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 + { 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 + // 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 + // 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 + 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 + lastDeps <- newDeps + + result } + :> aval<_> + +module AMap = + let mapWithAdditionalDependenies (mapping: HashMap<'K, 'T1> -> HashMap<'K, 'T2 * #seq<#IAdaptiveValue>>) (map: amap<'K, 'T1>) = + let mapping = + mapping + >> HashMap.map(fun _ v -> + AVal.constant v |> AVal.mapWithAdditionalDependenies (id) + ) + AMap.batchRecalcDirty mapping map - result } - :> aval<_> [] let ``[AMap] batchRecalcDirty``() = @@ -687,7 +698,7 @@ let ``[AMap] batchRecalcDirty``() = let file3Cval = cval 3 let file3DepCval = cval 1 - let m = Map [file1, file1DepCval; file2, file2DepCval; file3, file3DepCval] + let dependencies = Map [file1, file1DepCval; file2, file2DepCval; file3, file3DepCval] let projs = [ @@ -701,11 +712,11 @@ let ``[AMap] batchRecalcDirty``() = let mutable lastBatch = Unchecked.defaultof<_> let res = projs - |> AMap.batchRecalcDirty(fun d -> + |> AMap.mapWithAdditionalDependenies(fun d -> lastBatch <- d HashMap.ofList [ for k,v in d do - k, (AVal.constant <| Guid.NewGuid()) |> mapWithAdditionalDependenies(fun a -> a, [m.[k]]) + k, (Guid.NewGuid(), [dependencies.[k]]) ] ) let firstResult = res |> AMap.force @@ -739,14 +750,30 @@ let ``[AMap] batchRecalcDirty``() = lastBatch |> should haveCount 1 thirdResult.[file1] |> should not' (equal fourthResult.[file1]) + thirdResult.[file2] |> should equal fourthResult.[file2] + thirdResult.[file3] |> should equal fourthResult.[file3] transact(fun () -> file1DepCval.Value <- file1DepCval.Value + 1 - file1Cval.Value <- file1Cval.Value) + file1Cval.Value <- file1Cval.Value + 1) let fifthResult = res |> AMap.force lastBatch |> should haveCount 1 fourthResult.[file1] |> should not' (equal fifthResult.[file1]) + fourthResult.[file2] |> should equal fifthResult.[file2] + fourthResult.[file3] |> should equal fifthResult.[file3] + + + transact(fun () -> + file2DepCval.Value <- file2DepCval.Value + 1 + file3Cval.Value <- file3Cval.Value + 1) + + let sixthResult = res |> AMap.force + lastBatch |> should haveCount 2 + + fifthResult.[file1] |> should equal sixthResult.[file1] + fifthResult.[file2] |> should not' (equal sixthResult.[file2]) + fifthResult.[file3] |> should not' (equal sixthResult.[file3]) () \ No newline at end of file From 9c82dbc053b94b1c6b109a7ec2f566547d832d8a Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 19 Mar 2023 12:28:32 -0400 Subject: [PATCH 4/7] Adds mapWithAdditionalDependencies --- .../AdaptiveValue/AdaptiveValue.fs | 37 +++++++++++ .../AdaptiveValue/AdaptiveValue.fsi | 10 +++ src/Test/FSharp.Data.Adaptive.Tests/AMap.fs | 37 +---------- src/Test/FSharp.Data.Adaptive.Tests/AVal.fs | 65 ++++++++++++++++++- 4 files changed, 113 insertions(+), 36 deletions(-) diff --git a/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs b/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs index 61dceff..7b2493e 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs +++ b/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs @@ -399,6 +399,43 @@ module AVal = inner <- ValueSome (struct (va, vb, vc, res)) res.GetValue token + + /// + /// Calls a mapping function which creates additional dependencies to be tracked. + /// + /// + /// Usecase for this is when a file, such as a .fsproj file changes, it needs to be reloaded in msbuild. + /// Additionally fsproj files have dependencies, such as project.assets.json, that can't be determined until loaded with msbuild + /// but should be reloaded if those dependent files change. + /// + let mapWithAdditionalDependencies (mapping: 'a -> 'b * seq<#IAdaptiveValue>) (value: aval<'a>) : aval<'b> = + let mutable lastDeps = HashSet.empty + + { new 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<_> + + /// Aval for custom computations [] type CustomVal<'T>(compute: AdaptiveToken -> 'T) = diff --git a/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fsi b/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fsi index 3cd554f..f78e5c1 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fsi +++ b/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fsi @@ -108,6 +108,16 @@ module AVal = /// adaptive inputs. val map3 : mapping : ('T1 -> 'T2 -> 'T3 -> 'T4) -> value1 : aval<'T1> -> value2 : aval<'T2> -> value3 : aval<'T3> -> aval<'T4> + /// + /// Calls a mapping function which creates additional dependencies to be tracked. + /// + /// + /// Usecase for this is when a file, such as a .fsproj file changes, it needs to be reloaded in msbuild. + /// Additionally fsproj files have dependencies, such as project.assets.json, that can't be determined until loaded with msbuild + /// but should be reloaded if those dependent files change. + /// + val mapWithAdditionalDependencies : mapping :( 'T1 -> 'T2 * seq<#IAdaptiveValue>) -> value: aval<'T1> -> aval<'T2> + /// Returns a new adaptive value that adaptively applies the mapping function to the given /// input and adaptively depends on the resulting adaptive value. /// The resulting adaptive value will hold the latest value of the aval<_> returned by mapping. diff --git a/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs b/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs index ed3eedb..2cdb401 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs +++ b/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs @@ -643,44 +643,13 @@ let ``[AMap] mapA``() = res |> AMap.force |> should equal (HashMap.ofList ["A", 2; "B", 4; "C", 6]) -module AVal = - - /// - /// Calls a mapping function which creates additional dependencies to be tracked. - /// - 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<_> module AMap = - let mapWithAdditionalDependenies (mapping: HashMap<'K, 'T1> -> HashMap<'K, 'T2 * #seq<#IAdaptiveValue>>) (map: amap<'K, 'T1>) = + let mapWithAdditionalDependencies (mapping: HashMap<'K, 'T1> -> HashMap<'K, 'T2 * #seq<#IAdaptiveValue>>) (map: amap<'K, 'T1>) = let mapping = mapping >> HashMap.map(fun _ v -> - AVal.constant v |> AVal.mapWithAdditionalDependenies (id) + AVal.constant v |> AVal.mapWithAdditionalDependencies (id) ) AMap.batchRecalcDirty mapping map @@ -712,7 +681,7 @@ let ``[AMap] batchRecalcDirty``() = let mutable lastBatch = Unchecked.defaultof<_> let res = projs - |> AMap.mapWithAdditionalDependenies(fun d -> + |> AMap.mapWithAdditionalDependencies(fun d -> lastBatch <- d HashMap.ofList [ for k,v in d do diff --git a/src/Test/FSharp.Data.Adaptive.Tests/AVal.fs b/src/Test/FSharp.Data.Adaptive.Tests/AVal.fs index dd080a2..2bd49f6 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/AVal.fs +++ b/src/Test/FSharp.Data.Adaptive.Tests/AVal.fs @@ -275,8 +275,6 @@ let ``[AVal] mapNonAdaptive GC correct``() = transact (fun () -> v.Value <- 100) test |> AVal.force |> should equal 101 - - [] let ``[AVal] multi map non-adaptive and bind``() = let v = AVal.init true @@ -289,3 +287,66 @@ let ``[AVal] multi map non-adaptive and bind``() = transact (fun () -> v.Value <- false) output |> AVal.force |> should equal 1 + + + +[] +let ``[AVal] mapWithAdditionalDependencies``() = + let v = cval 1 + let incrDep (dep : cval<_>) = + dep.Value <- dep.Value + 1 + let mutable dependency1 = Unchecked.defaultof<_> + let newDep1 () = + dependency1 <- cval 2 + dependency1 + let mutable dependency2 = Unchecked.defaultof<_> + let newDep2 () = + dependency2 <- cval 3 + dependency2 + let mutable mappingCalls = 0 + let incrMapping () = + mappingCalls <- mappingCalls + 1 + + let mapping (i : int) = + incrMapping () + // dependencies aren't known until mapping time + i * 2, [newDep1(); newDep2()] + + let output = v |> AVal.mapWithAdditionalDependencies mapping + + output |> AVal.force |> should equal 2 + mappingCalls |> should equal 1 + + transact (fun () -> v.Value <- 2) + output |> AVal.force |> should equal 4 + mappingCalls |> should equal 2 + + transact (fun () -> incrDep dependency1) + output |> AVal.force |> should equal 4 + mappingCalls |> should equal 3 + + + transact (fun () -> incrDep dependency1) + output |> AVal.force |> should equal 4 + mappingCalls |> should equal 4 + + transact (fun () -> v.Value <- 2) + output |> AVal.force |> should equal 4 + mappingCalls |> should equal 4 + + + transact (fun () -> v.Value <- 1) + output |> AVal.force |> should equal 2 + mappingCalls |> should equal 5 + + transact (fun () -> + v.Value <- 1 + incrDep dependency1) + output |> AVal.force |> should equal 2 + mappingCalls |> should equal 6 + + transact (fun () -> + incrDep dependency2 + incrDep dependency1) + output |> AVal.force |> should equal 2 + mappingCalls |> should equal 7 \ No newline at end of file From 3cab26d8e94e7486513e5ef58170fe563149a7b7 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 19 Mar 2023 18:46:33 -0400 Subject: [PATCH 5/7] renamed to batchMap --- .../AdaptiveHashMap/AdaptiveHashMap.fs | 12 ++++++------ .../AdaptiveHashMap/AdaptiveHashMap.fsi | 4 ++-- .../AdaptiveValue/AdaptiveValue.fs | 2 +- .../AdaptiveValue/AdaptiveValue.fsi | 2 +- src/Test/FSharp.Data.Adaptive.Tests/AMap.fs | 4 ++-- 5 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs index 1400f64..7a55cb3 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs +++ b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs @@ -756,9 +756,9 @@ module AdaptiveHashMapImplementation = HashMapDelta.ofHashMap changes - /// Reader for batchRecalc operations. + /// Reader for batchMap operations. [] - type BatchRecalculateDirty<'k, 'a, 'b>(input : amap<'k, 'a>, mapping : HashMap<'k,'a> -> HashMap<'k, aval<'b>>) = + type BatchMap<'k, 'a, 'b>(input : amap<'k, 'a>, mapping : HashMap<'k,'a> -> HashMap<'k, aval<'b>>) = inherit AbstractReader>(HashMapDelta.empty) let reader = input.GetReader() @@ -1415,17 +1415,17 @@ module AMap = else create (fun () -> MapAReader(map, mapping)) - /// 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>) = + /// Adaptively applies the given mapping to batches of all changes and reapplies mapping on dirty outputs + let batchMap (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 () -> BatchRecalculateDirty(ofHashMap map, id)) + create (fun () -> BatchMap(ofHashMap map, id)) else - create (fun () -> BatchRecalculateDirty(map, mapping)) + create (fun () -> BatchMap(map, mapping)) /// Adaptively chooses all elements returned by mapping. diff --git a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi index c2acf8b..b5dc74b 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi +++ b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi @@ -105,8 +105,8 @@ module AMap = /// Adaptively applies the given mapping function to all elements and returns a new amap containing the results. val mapA : mapping: ('K -> 'V -> aval<'T>) -> map: amap<'K, 'V> -> amap<'K, 'T> - /// Adaptively applies the given mapping to all changes. - val batchRecalcDirty : mapping: (HashMap<'K,'T1> -> HashMap<'K,aval<'T2>>) -> map: amap<'K, 'T1> -> amap<'K, 'T2> + /// Adaptively applies the given mapping to batches of all changes and reapplies mapping on dirty outputs + val batchMap : 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>) -> map: amap<'K, 'V> -> amap<'K, 'T> diff --git a/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs b/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs index 7b2493e..6ce56e6 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs +++ b/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs @@ -408,7 +408,7 @@ module AVal = /// Additionally fsproj files have dependencies, such as project.assets.json, that can't be determined until loaded with msbuild /// but should be reloaded if those dependent files change. /// - let mapWithAdditionalDependencies (mapping: 'a -> 'b * seq<#IAdaptiveValue>) (value: aval<'a>) : aval<'b> = + let mapWithAdditionalDependencies (mapping: 'a -> 'b * #seq<#IAdaptiveValue>) (value: aval<'a>) : aval<'b> = let mutable lastDeps = HashSet.empty { new AbstractVal<'b>() with diff --git a/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fsi b/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fsi index f78e5c1..0918ebd 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fsi +++ b/src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fsi @@ -116,7 +116,7 @@ module AVal = /// Additionally fsproj files have dependencies, such as project.assets.json, that can't be determined until loaded with msbuild /// but should be reloaded if those dependent files change. /// - val mapWithAdditionalDependencies : mapping :( 'T1 -> 'T2 * seq<#IAdaptiveValue>) -> value: aval<'T1> -> aval<'T2> + val mapWithAdditionalDependencies : mapping :( 'T1 -> 'T2 * #seq<#IAdaptiveValue>) -> value: aval<'T1> -> aval<'T2> /// Returns a new adaptive value that adaptively applies the mapping function to the given /// input and adaptively depends on the resulting adaptive value. diff --git a/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs b/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs index 2cdb401..b22703e 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs +++ b/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs @@ -651,11 +651,11 @@ module AMap = >> HashMap.map(fun _ v -> AVal.constant v |> AVal.mapWithAdditionalDependencies (id) ) - AMap.batchRecalcDirty mapping map + AMap.batchMap mapping map [] -let ``[AMap] batchRecalcDirty``() = +let ``[AMap] batchMap``() = let file1 = "File1.fs" let file1Cval = cval 1 From 6a14d8be2f1332ea7f5e73ec8213d3c8413d0db9 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Mon, 20 Mar 2023 22:07:56 -0400 Subject: [PATCH 6/7] moves batchMapWithAdditionalDependencies to AdaptiveHashMap --- .../AdaptiveHashMap/AdaptiveHashMap.fs | 13 ++- .../AdaptiveHashMap/AdaptiveHashMap.fsi | 7 +- src/Test/FSharp.Data.Adaptive.Tests/AMap.fs | 106 ++++++++++++++++-- 3 files changed, 112 insertions(+), 14 deletions(-) diff --git a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs index 7a55cb3..0043c43 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs +++ b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fs @@ -1415,7 +1415,7 @@ module AMap = else create (fun () -> MapAReader(map, mapping)) - /// Adaptively applies the given mapping to batches of all changes and reapplies mapping on dirty outputs + /// Adaptively applies the given mapping to batches of all changes and e-executes the mapping on dirty outputs let batchMap (mapping: HashMap<'K, 'T1> -> HashMap<'K, aval<'T2>>) (map: amap<'K, 'T1>) = if map.IsConstant then let map = force map |> mapping @@ -1427,6 +1427,17 @@ module AMap = else create (fun () -> BatchMap(map, mapping)) + /// + /// Adaptively applies the given mapping to batches of all changes, re-executes the mapping on dirty outputs, including the additional dependencies to be tracked. + /// + let batchMapWithAdditionalDependencies (mapping: HashMap<'K, 'T1> -> HashMap<'K, 'T2 * #seq<#IAdaptiveValue>>) (map: amap<'K, 'T1>) = + let mapping = + mapping + >> HashMap.map(fun _ v -> + AVal.constant v |> AVal.mapWithAdditionalDependencies (id) + ) + batchMap mapping map + /// Adaptively chooses all elements returned by mapping. let chooseA (mapping: 'K ->'T1 -> aval>) (map: amap<'K, 'T1>) = diff --git a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi index b5dc74b..bde4120 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi +++ b/src/FSharp.Data.Adaptive/AdaptiveHashMap/AdaptiveHashMap.fsi @@ -105,9 +105,14 @@ module AMap = /// Adaptively applies the given mapping function to all elements and returns a new amap containing the results. val mapA : mapping: ('K -> 'V -> aval<'T>) -> map: amap<'K, 'V> -> amap<'K, 'T> - /// Adaptively applies the given mapping to batches of all changes and reapplies mapping on dirty outputs + /// Adaptively applies the given mapping to batches of all changes and e-executes the mapping on dirty outputs val batchMap : mapping: (HashMap<'K,'T1> -> HashMap<'K,aval<'T2>>) -> map: amap<'K, 'T1> -> amap<'K, 'T2> + /// + /// Adaptively applies the given mapping to batches of all changes, re-executes the mapping on dirty outputs, including the additional dependencies to be tracked. + /// + val batchMapWithAdditionalDependencies : mapping: (HashMap<'K, 'T1> -> HashMap<'K, 'T2 * #seq<#IAdaptiveValue>>) -> map: amap<'K, 'T1> -> amap<'K, 'T2> + /// Adaptively chooses all elements returned by mapping. val chooseA : mapping: ('K -> 'V -> aval>) -> map: amap<'K, 'V> -> amap<'K, 'T> diff --git a/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs b/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs index b22703e..e3a1295 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs +++ b/src/Test/FSharp.Data.Adaptive.Tests/AMap.fs @@ -644,19 +644,101 @@ let ``[AMap] mapA``() = -module AMap = - let mapWithAdditionalDependencies (mapping: HashMap<'K, 'T1> -> HashMap<'K, 'T2 * #seq<#IAdaptiveValue>>) (map: amap<'K, 'T1>) = - let mapping = - mapping - >> HashMap.map(fun _ v -> - AVal.constant v |> AVal.mapWithAdditionalDependencies (id) - ) - AMap.batchMap mapping map - [] let ``[AMap] batchMap``() = + let file1 = "File1.fs" + let file1Cval = cval 1 + let file1DepCval = cval DateTime.UtcNow + let file2 = "File2.fs" + let file2Cval = cval 2 + let file2DepCval = cval DateTime.UtcNow + let file3 = "File3.fs" + let file3Cval = cval 3 + let file3DepCval = cval DateTime.UtcNow + + let file4 = "File4.fs" + let file4Cval = cval 3 + let file4DepCval = cval DateTime.UtcNow + + let dependencies = Map [file1, file1DepCval; file2, file2DepCval; file3, file3DepCval; file4, file4DepCval] + + let filesCmap = + cmap + [ + file1, file1Cval + file2, file2Cval + file3, file3Cval + // file4 added later + ] + let files = + filesCmap + |> AMap.mapA(fun _ v -> v) + + let mutable lastBatch = Unchecked.defaultof<_> + let res = + files + |> AMap.batchMap(fun d -> + lastBatch <- d + HashMap.ofList [ + for k,v in d do + k, (dependencies.[k] :> aval<_>) + ] + ) + + let firstResult = res |> AMap.force + lastBatch |> should haveCount 3 + + transact(fun () -> file1Cval.Value <- file1Cval.Value + 1) + + let secondResult = res |> AMap.force + lastBatch |> should haveCount 1 + + firstResult.[file1] |> should equal secondResult.[file1] + firstResult.[file2] |> should equal secondResult.[file2] + firstResult.[file3] |> should equal secondResult.[file3] + + transact(fun () -> file1DepCval.Value <- DateTime.UtcNow) + + let thirdResult = res |> AMap.force + lastBatch |> should haveCount 1 + + secondResult.[file1] |> should not' (equal thirdResult.[file1]) + secondResult.[file2] |> should equal thirdResult.[file2] + secondResult.[file3] |> should equal thirdResult.[file3] + + transact(fun () -> + file1DepCval.Value <- DateTime.UtcNow + file2Cval.Value <- file2Cval.Value + 1 + ) + + let fourthResult = res |> AMap.force + lastBatch |> should haveCount 2 + + thirdResult.[file1] |> should not' (equal fourthResult.[file1]) + thirdResult.[file2] |> should equal fourthResult.[file2] + thirdResult.[file3] |> should equal fourthResult.[file3] + + transact(fun () -> + file1Cval.Value <- file1Cval.Value + 1 + file2DepCval.Value <- DateTime.UtcNow + filesCmap.Add(file4, file4Cval) |> ignore + ) + + let fifthResult = res |> AMap.force + lastBatch |> should haveCount 3 + + fourthResult.[file1] |> should equal fifthResult.[file1] + fourthResult.[file2] |> should not' (equal fifthResult.[file2]) + fourthResult.[file3] |> should equal fifthResult.[file3] + fifthResult.[file4] |> should equal file4DepCval.Value + + + +[] +let ``[AMap] batchMapWithAdditionalDependencies``() = + let file1 = "File1.fs" let file1Cval = cval 1 let file1DepCval = cval 1 @@ -669,7 +751,7 @@ let ``[AMap] batchMap``() = let dependencies = Map [file1, file1DepCval; file2, file2DepCval; file3, file3DepCval] - let projs = + let files = [ file1, file1Cval file2, file2Cval @@ -680,8 +762,8 @@ let ``[AMap] batchMap``() = let mutable lastBatch = Unchecked.defaultof<_> let res = - projs - |> AMap.mapWithAdditionalDependencies(fun d -> + files + |> AMap.batchMapWithAdditionalDependencies(fun d -> lastBatch <- d HashMap.ofList [ for k,v in d do From 607aea40745d7537f782f2b538a94503323464c2 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Mon, 20 Mar 2023 23:13:00 -0400 Subject: [PATCH 7/7] AList.batchMapA --- .../AdaptiveIndexList/AdaptiveIndexList.fs | 95 ++++++++++++++++++- .../AdaptiveIndexList/AdaptiveIndexList.fsi | 2 + src/Test/FSharp.Data.Adaptive.Tests/AList.fs | 94 +++++++++++++++++- 3 files changed, 189 insertions(+), 2 deletions(-) diff --git a/src/FSharp.Data.Adaptive/AdaptiveIndexList/AdaptiveIndexList.fs b/src/FSharp.Data.Adaptive/AdaptiveIndexList/AdaptiveIndexList.fs index 71e809e..70b6357 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveIndexList/AdaptiveIndexList.fs +++ b/src/FSharp.Data.Adaptive/AdaptiveIndexList/AdaptiveIndexList.fs @@ -669,7 +669,88 @@ module internal AdaptiveIndexListImplementation = ) changes - + + + /// Reader for mapA operations. + [] + type BatchMapReader<'a, 'b>(input : alist<'a>, mapping : IndexList<'a> -> IndexList>) = + inherit AbstractReader>(IndexListDelta.empty) + + let reader = input.GetReader() + do reader.Tag <- "input" + + let cacheLock = obj() + let mutable cache = IndexList.empty> + let mutable targets = MultiSetMap.empty, Index> + let mutable dirty = IndexList.empty> + + let consumeDirty() = + lock cacheLock (fun () -> + let d = dirty + dirty <- IndexList.empty + d + ) + + override x.InputChangedObject(t, o) = + #if FABLE_COMPILER + if isNull o.Tag then + let o = unbox> o + for i in MultiSetMap.find o targets do + dirty <- IndexList.set i o dirty + #else + match o with + | :? aval<'b> as o -> + lock cacheLock (fun () -> + for i in MultiSetMap.find o targets do + dirty <- IndexList.set i o dirty + ) + | _ -> + () + #endif + + override x.Compute t = + let mutable dirty = consumeDirty() + let old = reader.State + let ops = reader.GetChanges t + let mutable setOps, changes = IndexList.empty, IndexListDelta.empty + + for (i, op) in ops do + dirty <- IndexList.remove i dirty + cache <- + match IndexList.tryRemove i cache with + | Some (o, remainingCache) -> + let rem, rest = MultiSetMap.remove o i targets + targets <- rest + if rem then o.Outputs.Remove x |> ignore + remainingCache + | None -> cache + match op with + | Set v -> + setOps <- IndexList.set i v setOps + | Remove -> + changes <- IndexListDelta.add i Remove changes + + dirty + |> IndexList.iteri(fun i _ -> + match IndexList.tryGet i old with + | Some v -> + setOps <- IndexList.set i v setOps + | None -> + () + ) + + mapping setOps + |> IndexList.iteri(fun i k -> + cache <- IndexList.set i k cache + let v = k.GetValue t + targets <- MultiSetMap.add k i targets + changes <- IndexListDelta.add i (Set v) changes + + ) + + changes + + /// Reader for chooseA operations. [] type ChooseAReader<'a, 'b>(input : alist<'a>, mapping : Index -> 'a -> aval>) = @@ -1461,6 +1542,18 @@ module AList = let mapA (mapping: 'T1 -> aval<'T2>) (list: alist<'T1>) = mapAi (fun _ v -> mapping v) list + /// Adaptively applies the given mapping to batches of all changes and e-executes the mapping on dirty outputs + let batchMap (mapping: IndexList<'T1> -> IndexList>) (list: alist<'T1>) = + if list.IsConstant then + let map = force list |> mapping + if map |> Seq.forall (fun v -> v.IsConstant) then + constant (fun () -> map |> IndexList.map (fun v -> AVal.force v)) + else + // TODO better impl possible + ofReader (fun () -> BatchMapReader(ofIndexList map, id)) + else + ofReader (fun () -> BatchMapReader(list, mapping)) + /// Adaptively chooses all elements returned by mapping. let chooseAi (mapping: Index ->'T1 -> aval>) (list: alist<'T1>) = if list.IsConstant then diff --git a/src/FSharp.Data.Adaptive/AdaptiveIndexList/AdaptiveIndexList.fsi b/src/FSharp.Data.Adaptive/AdaptiveIndexList/AdaptiveIndexList.fsi index b4ee4f2..71646a1 100644 --- a/src/FSharp.Data.Adaptive/AdaptiveIndexList/AdaptiveIndexList.fsi +++ b/src/FSharp.Data.Adaptive/AdaptiveIndexList/AdaptiveIndexList.fsi @@ -96,6 +96,8 @@ module AList = /// Adaptively applies the given mapping function to all elements and returns a new alist containing the results. val mapA : mapping: ('T1 -> aval<'T2>) -> list: alist<'T1> -> alist<'T2> + val batchMap : mapping: (IndexList<'T1> -> IndexList>) -> list: alist<'T1> -> alist<'T2> + /// Adaptively chooses all elements returned by mapping. val chooseAi : mapping: (Index -> 'T1 -> aval>) -> list: alist<'T1> -> alist<'T2> diff --git a/src/Test/FSharp.Data.Adaptive.Tests/AList.fs b/src/Test/FSharp.Data.Adaptive.Tests/AList.fs index b428177..9851f82 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/AList.fs +++ b/src/Test/FSharp.Data.Adaptive.Tests/AList.fs @@ -8,6 +8,7 @@ open FsUnit open FsCheck.NUnit open FSharp.Data open Generators +open System [ |]); Timeout(60000)>] let ``[AList] reference impl``() ({ lreal = real; lref = ref; lexpression = str; lchanges = changes } : VList) = @@ -1161,4 +1162,95 @@ let ``[AList] mapA inner change``() = ) r.GetChanges AdaptiveToken.Top |> ignore - r.State |> should equal (IndexList.ofSeqIndexed [a, 2; b, -1; c, 6; d, 8; e, 10]) \ No newline at end of file + r.State |> should equal (IndexList.ofSeqIndexed [a, 2; b, -1; c, 6; d, 8; e, 10]) + + +[] +let ``[AList] batchMap``() = + + let file1 = "File1.fs" + let file1Cval = cval 1 + let file1DepCval = cval DateTime.UtcNow + let file2 = "File2.fs" + let file2Cval = cval 2 + let file2DepCval = cval DateTime.UtcNow + let file3 = "File3.fs" + let file3Cval = cval 3 + let file3DepCval = cval DateTime.UtcNow + + let file4 = "File4.fs" + let file4Cval = cval 3 + let file4DepCval = cval DateTime.UtcNow + + let dependencies = Map [file1, file1DepCval; file2, file2DepCval; file3, file3DepCval; file4, file4DepCval] + + let filesCmap = + clist + [ + file1,file1Cval + file2,file2Cval + file3,file3Cval + // file4 added later + ] + let files = + filesCmap + |> AList.mapA(fun (k, v) -> v |> AVal.map(fun v -> k,v)) + + let mutable lastBatch = Unchecked.defaultof<_> + let res = + files + |> AList.batchMap(fun d -> + lastBatch <- d + d + |> IndexList.mapi(fun k (file,_) -> + printfn "k -> %A" k + (dependencies.[file] :> aval<_> + ) + )) + let firstResult = res |> AList.force + lastBatch |> should haveCount 3 + + transact(fun () -> file1Cval.Value <- file1Cval.Value + 1) + + let secondResult = res |> AList.force + lastBatch |> should haveCount 1 + + firstResult.[0] |> should equal secondResult.[0] + firstResult.[1] |> should equal secondResult.[1] + firstResult.[2] |> should equal secondResult.[2] + + transact(fun () -> file1DepCval.Value <- DateTime.UtcNow) + + let thirdResult = res |> AList.force + lastBatch |> should haveCount 1 + + secondResult.[0] |> should not' (equal thirdResult.[0]) + secondResult.[1] |> should equal thirdResult.[1] + secondResult.[2] |> should equal thirdResult.[2] + + transact(fun () -> + file1DepCval.Value <- DateTime.UtcNow + file3Cval.Value <- file3Cval.Value + 1 + ) + + let fourthResult = res |> AList.force + lastBatch |> should haveCount 2 + + thirdResult.[0] |> should not' (equal fourthResult.[0]) + thirdResult.[1] |> should equal fourthResult.[1] + thirdResult.[2] |> should equal fourthResult.[2] + + transact(fun () -> + file1Cval.Value <- file1Cval.Value + 1 + file2DepCval.Value <- DateTime.UtcNow + filesCmap.Add(file4, file4Cval) |> ignore + ) + + let fifthResult = res |> AList.force + lastBatch |> should haveCount 3 + + fourthResult.[0] |> should equal fifthResult.[0] + fourthResult.[1] |> should not' (equal fifthResult.[1]) + fourthResult.[2] |> should equal fifthResult.[2] + fifthResult.[3] |> should equal file4DepCval.Value +