diff --git a/src/FSharp.Data.Adaptive.Experimental/AdaptiveArray/Arr.fs b/src/FSharp.Data.Adaptive.Experimental/AdaptiveArray/Arr.fs index 3cee013..4622c42 100644 --- a/src/FSharp.Data.Adaptive.Experimental/AdaptiveArray/Arr.fs +++ b/src/FSharp.Data.Adaptive.Experimental/AdaptiveArray/Arr.fs @@ -644,343 +644,343 @@ module ArrNodeImplementationAggregate = printfn "out of bounds" - -open FSharp.Data.Traceable -type IArrayReader<'a> = IOpReader, arrdelta<'a>> - -type IAdaptiveArray<'a> = - abstract IsConstant : bool - abstract Content : aval> - abstract History : option, arrdelta<'a>>> - abstract GetReader : unit -> IArrayReader<'a> - -and aarr<'a> = IAdaptiveArray<'a> - - -/// Changeable adaptive list that allows mutation by user-code and implements alist. -[] -type ChangeableArray<'T>(elements: arr<'T>) = - let history = - let h = History(Arr.trace) - h.Perform(Arr.trace.tcomputeDelta Arr.empty elements) |> ignore - h - - let perform (op : ArrOperation<'T>) = - history.Perform (ArrDelta.single op) - - override x.ToString() = - history.State |> Seq.map (sprintf "%A") |> String.concat "; " |> sprintf "carr [%s]" - - /// is the list currently empty? - member x.IsEmpty = history.State.IsEmpty - - /// the number of elements currently in the list. - member x.Length = history.State.Length - - member x.Value - with get() = history.State - and set v = history.Perform (Arr.trace.tcomputeDelta history.State v) |> ignore - - member x.Add(value : 'T) = - perform { Index = history.State.Length; Count = 0; Elements = Arr.single value } |> ignore - - member x.Prepend(value : 'T) = - perform { Index = 0; Count = 0; Elements = Arr.single value } |> ignore - - member x.Insert(index : int, value : 'T) = - if index < 0 || index > history.State.Length then raise <| IndexOutOfRangeException() - perform { Index = index; Count = 0; Elements = Arr.single value } |> ignore - - member x.Remove(index : int) = - if index < 0 || index >= history.State.Length then raise <| IndexOutOfRangeException() - perform { Index = index; Count = 1; Elements = Arr.empty } |> ignore - - interface IAdaptiveArray<'T> with - member x.GetReader() = history.NewReader() - member x.Content = history :> aval<_> - member x.IsConstant = false - member x.History = Some history - - -module AArr = - module Readers = - /// Efficient implementation for a constant adaptive array. - [] - type ConstantArray<'T>(content : Lazy>) = - let value = AVal.delay (fun () -> content.Value) - - member x.Content = value - - member x.GetReader() = - History.Readers.ConstantReader<_,_>( - Arr.trace, - lazy (Arr.computeDelta DefaultEquality.equals Arr.empty content.Value), - content - ) :> IArrayReader<_> - - interface IAdaptiveArray<'T> with - member x.IsConstant = true - member x.GetReader() = x.GetReader() - member x.Content = x.Content - member x.History = None - - /// Core implementation for a dependent array. - [] - type AdaptiveArrayImpl<'T>(createReader : unit -> IOpReader>) = - let history = History(createReader, Arr.trace) - - /// Gets a new reader to the set. - member x.GetReader() : IArrayReader<'T> = - history.NewReader() - - /// Current content of the set as aval. - member x.Content = - history :> aval<_> - - interface IAdaptiveArray<'T> with - member x.IsConstant = false - member x.GetReader() = x.GetReader() - member x.Content = x.Content - member x.History = Some history - - /// Efficient implementation for an empty adaptive array. - [] - type EmptyArray<'T> private() = - static let instance = EmptyArray<'T>() :> aarr<_> - let content = AVal.constant Arr.empty - let reader = History.Readers.EmptyReader, arrdelta<'T>>(Arr.trace) :> IArrayReader<'T> - static member Instance = instance - - member x.Content = content - member x.GetReader() = reader - - interface IAdaptiveArray<'T> with - member x.IsConstant = true - member x.GetReader() = x.GetReader() - member x.Content = x.Content - member x.History = None +module Old = + open FSharp.Data.Traceable + type IArrayReader<'a> = IOpReader, arrdelta<'a>> + + type IAdaptiveArray<'a> = + abstract IsConstant : bool + abstract Content : aval> + abstract History : option, arrdelta<'a>>> + abstract GetReader : unit -> IArrayReader<'a> + + and aarr<'a> = IAdaptiveArray<'a> + + + /// Changeable adaptive list that allows mutation by user-code and implements alist. + [] + type ChangeableArray<'T>(elements: arr<'T>) = + let history = + let h = History(Arr.trace) + h.Perform(Arr.trace.tcomputeDelta Arr.empty elements) |> ignore + h + + let perform (op : ArrOperation<'T>) = + history.Perform (ArrDelta.single op) + + override x.ToString() = + history.State |> Seq.map (sprintf "%A") |> String.concat "; " |> sprintf "carr [%s]" + + /// is the list currently empty? + member x.IsEmpty = history.State.IsEmpty + + /// the number of elements currently in the list. + member x.Length = history.State.Length + + member x.Value + with get() = history.State + and set v = history.Perform (Arr.trace.tcomputeDelta history.State v) |> ignore + + member x.Add(value : 'T) = + perform { Index = history.State.Length; Count = 0; Elements = Arr.single value } |> ignore + + member x.Prepend(value : 'T) = + perform { Index = 0; Count = 0; Elements = Arr.single value } |> ignore + + member x.Insert(index : int, value : 'T) = + if index < 0 || index > history.State.Length then raise <| IndexOutOfRangeException() + perform { Index = index; Count = 0; Elements = Arr.single value } |> ignore + + member x.Remove(index : int) = + if index < 0 || index >= history.State.Length then raise <| IndexOutOfRangeException() + perform { Index = index; Count = 1; Elements = Arr.empty } |> ignore + + interface IAdaptiveArray<'T> with + member x.GetReader() = history.NewReader() + member x.Content = history :> aval<_> + member x.IsConstant = false + member x.History = Some history + + + module AArr = + module Readers = + /// Efficient implementation for a constant adaptive array. + [] + type ConstantArray<'T>(content : Lazy>) = + let value = AVal.delay (fun () -> content.Value) + + member x.Content = value + + member x.GetReader() = + History.Readers.ConstantReader<_,_>( + Arr.trace, + lazy (Arr.computeDelta DefaultEqualityComparer.Instance Arr.empty content.Value), + content + ) :> IArrayReader<_> + + interface IAdaptiveArray<'T> with + member x.IsConstant = true + member x.GetReader() = x.GetReader() + member x.Content = x.Content + member x.History = None + + /// Core implementation for a dependent array. + [] + type AdaptiveArrayImpl<'T>(createReader : unit -> IOpReader>) = + let history = History(createReader, Arr.trace) + + /// Gets a new reader to the set. + member x.GetReader() : IArrayReader<'T> = + history.NewReader() + + /// Current content of the set as aval. + member x.Content = + history :> aval<_> + + interface IAdaptiveArray<'T> with + member x.IsConstant = false + member x.GetReader() = x.GetReader() + member x.Content = x.Content + member x.History = Some history + + /// Efficient implementation for an empty adaptive array. + [] + type EmptyArray<'T> private() = + static let instance = EmptyArray<'T>() :> aarr<_> + let content = AVal.constant Arr.empty + let reader = History.Readers.EmptyReader, arrdelta<'T>>(Arr.trace) :> IArrayReader<'T> + static member Instance = instance + + member x.Content = content + member x.GetReader() = reader + + interface IAdaptiveArray<'T> with + member x.IsConstant = true + member x.GetReader() = x.GetReader() + member x.Content = x.Content + member x.History = None - - type MapReader<'a, 'b>(input : IArrayReader<'a>, mapping : 'a -> 'b) = - inherit AbstractReader>(ArrDelta.empty) - - override x.Compute(t : AdaptiveToken) = - let ops = input.GetChanges t - ops |> ArrDelta.map mapping - - type CollectReader<'a, 'b>(input : IArrayReader<'a>, mapping : 'a -> aarr<'b>) = - inherit AbstractReader>(ArrDelta.empty) - - static let aggregate = - { - ArrNodeImplementationAggregate.Zero = 0 - ArrNodeImplementationAggregate.Add = OptimizedClosures.FSharpFunc<_,_,_>.Adapt((+)) - ArrNodeImplementationAggregate.View = fun (v : arr<'b>) -> v.Length - } + + type MapReader<'a, 'b>(input : IArrayReader<'a>, mapping : 'a -> 'b) = + inherit AbstractReader>(ArrDelta.empty) + + override x.Compute(t : AdaptiveToken) = + let ops = input.GetChanges t + ops |> ArrDelta.map mapping - let mutable readers = IndexList.empty> - let mutable prefix = ArrNodeImplementationAggregate.AggregateArr(aggregate, null) - let dirtyLock = obj() - let mutable dirtyReaders = IndexList.empty> - - override x.InputChangedObject(_, o) = - match o with - | :? IArrayReader<'b> as o -> - match o.Tag with - | :? FSharp.Data.Adaptive.Index as i -> - lock dirtyLock (fun () -> - dirtyReaders <- IndexList.set i o dirtyReaders - ) + type CollectReader<'a, 'b>(input : IArrayReader<'a>, mapping : 'a -> aarr<'b>) = + inherit AbstractReader>(ArrDelta.empty) + + static let aggregate = + { + ArrNodeImplementationAggregate.Zero = 0 + ArrNodeImplementationAggregate.Add = OptimizedClosures.FSharpFunc<_,_,_>.Adapt((+)) + ArrNodeImplementationAggregate.View = fun (v : arr<'b>) -> v.Length + } + + let mutable readers = IndexList.empty> + let mutable prefix = ArrNodeImplementationAggregate.AggregateArr(aggregate, null) + let dirtyLock = obj() + let mutable dirtyReaders = IndexList.empty> + + override x.InputChangedObject(_, o) = + match o with + | :? IArrayReader<'b> as o -> + match o.Tag with + | :? FSharp.Data.Adaptive.Index as i -> + lock dirtyLock (fun () -> + dirtyReaders <- IndexList.set i o dirtyReaders + ) + | _ -> + () | _ -> () - | _ -> - () - - - override x.Compute(t : AdaptiveToken) = - let ops = input.GetChanges t - let ops = - ops |> ArrDelta.map (fun op -> - mapping(op).GetReader() - ) - - let mutable res = ArrDelta.empty - - let emit (op : ArrOperation<_>) = - res <- ArrDelta.combine res (arrdelta (Arr.single op)) - - let emitArr (op : arr>) = - for e in op do emit e - - - let mutable dirtyReaders = - lock dirtyLock (fun () -> - let v = dirtyReaders - dirtyReaders <- IndexList.empty - v - ) - + + override x.Compute(t : AdaptiveToken) = + let ops = input.GetChanges t - for o in ops do - for r in 1 .. o.Count do - match readers.TryGetIndex o.Index with - | Some idx -> - match readers.TryRemove idx with - | Some (reader, rest) -> - lock reader.Outputs (fun () -> reader.Outputs.Remove x |> ignore) - readers <- rest - dirtyReaders <- IndexList.remove idx dirtyReaders - - match prefix.TryGetAggregateAtExcl o.Index with - | Some offset -> - match prefix.TryRemove(o.Index) with - | Some (rest, removed) -> - prefix <- rest - let cnt = removed.Length - emit { Index = offset; Count = cnt; Elements = Arr.empty } + let ops = + ops |> ArrDelta.map (fun op -> + mapping(op).GetReader() + ) + + let mutable res = ArrDelta.empty + + let emit (op : ArrOperation<_>) = + res <- ArrDelta.combine res (arrdelta (Arr.single op)) + + let emitArr (op : arr>) = + for e in op do emit e + + + let mutable dirtyReaders = + lock dirtyLock (fun () -> + let v = dirtyReaders + dirtyReaders <- IndexList.empty + v + ) + + + for o in ops do + for r in 1 .. o.Count do + match readers.TryGetIndex o.Index with + | Some idx -> + match readers.TryRemove idx with + | Some (reader, rest) -> + lock reader.Outputs (fun () -> reader.Outputs.Remove x |> ignore) + readers <- rest + dirtyReaders <- IndexList.remove idx dirtyReaders + + match prefix.TryGetAggregateAtExcl o.Index with + | Some offset -> + match prefix.TryRemove(o.Index) with + | Some (rest, removed) -> + prefix <- rest + let cnt = removed.Length + emit { Index = offset; Count = cnt; Elements = Arr.empty } + | None -> + () | None -> () + | None -> - () + printfn "ERROR: reader must exist" + | None -> + printfn "ERROR: reader at %d must exist" o.Index + + let mutable index = o.Index + for newReader in o.Elements do + let before = + match readers.TryGetIndex (index - 1) with + | Some idx -> idx + | None -> Index.zero + + let idx = readers.NewIndexAfter before + newReader.Tag <- idx + readers <- IndexList.set idx newReader readers + prefix <- prefix.InsertAt(index, Arr.empty) + dirtyReaders <- IndexList.set idx newReader dirtyReaders + index <- index + 1 + + for ridx, reader in IndexList.toSeqIndexed dirtyReaders do + + let ri = readers.IndexOf ridx + + if ri >= 0 && ri < prefix.Length then + match prefix.TryGetAggregateAtExcl ri with + | Some offset -> + let op = reader.GetChanges t + op.ToArr() + |> Arr.map (fun op -> { op with Index = op.Index + offset }) + |> emitArr + + prefix <- prefix.Set(ri, reader.State) + + | None -> - printfn "ERROR: reader must exist" - | None -> - printfn "ERROR: reader at %d must exist" o.Index - - let mutable index = o.Index - for newReader in o.Elements do - let before = - match readers.TryGetIndex (index - 1) with - | Some idx -> idx - | None -> Index.zero + printfn "ERROR: no offset" + else + printfn "ERROR: no reader for index" - let idx = readers.NewIndexAfter before - newReader.Tag <- idx - readers <- IndexList.set idx newReader readers - prefix <- prefix.InsertAt(index, Arr.empty) - dirtyReaders <- IndexList.set idx newReader dirtyReaders - index <- index + 1 - - for ridx, reader in IndexList.toSeqIndexed dirtyReaders do + res - let ri = readers.IndexOf ridx - if ri >= 0 && ri < prefix.Length then - match prefix.TryGetAggregateAtExcl ri with - | Some offset -> - let op = reader.GetChanges t - op.ToArr() - |> Arr.map (fun op -> { op with Index = op.Index + offset }) - |> emitArr - - prefix <- prefix.Set(ri, reader.State) - - - - | None -> - printfn "ERROR: no offset" - else - printfn "ERROR: no reader for index" + + + + /// Creates a constant set using the creation function. + let constant (value : unit -> arr<'T>) = + Readers.ConstantArray(lazy value()) :> aarr<_> + + /// Creates an aset using the given reader-creator. + let ofReader (create : unit -> #IOpReader>) = + Readers.AdaptiveArrayImpl(fun () -> create() :> IOpReader<_>) :> aarr<_> + + /// The empty aset. + [] + let empty<'T> : aarr<'T> = + Readers.EmptyArray<'T>.Instance + + /// A constant aset holding a single value. + let single (value : 'T) = + constant (fun () -> Arr.single value) + + /// Creates an aset holding the given values. + let ofSeq (elements : seq<'T>) = + constant (fun () -> Arr.ofSeq elements) + + /// Creates an aset holding the given values. + let ofList (elements : list<'T>) = + constant (fun () -> Arr.ofList elements) + + /// Creates an aset holding the given values. + let ofArray (elements : 'T[]) = + constant (fun () -> Arr.ofArray elements) + + /// Creates an aval providing access to the current content of the set. + let toAVal (set : aarr<'T>) = + set.Content + + let map (mapping : 'a -> 'b) (a : aarr<'a>) = + if a.IsConstant then + constant( fun () -> Arr.map mapping (AVal.force a.Content)) + else + ofReader <| fun () -> + Readers.MapReader(a.GetReader(), mapping) - res - + let collect (mapping : 'a -> aarr<'b>) (a : aarr<'a>) = + if false && a.IsConstant then + failwith "TODO" + else + ofReader <| fun () -> + Readers.CollectReader(a.GetReader(), mapping) + + + + module AArrTest = + let run() = + let a = ChangeableArray(Arr.ofList [1;2;6;8;3;4]) + let even = ChangeableArray(Arr.ofList [2]) + let odd = ChangeableArray(Arr.ofList [1]) + + let result = + a |> AArr.collect (fun v -> + if v % 2 = 0 then even + else odd + ) + + let r = result.GetReader() + + let print() = + let ops = r.GetChanges AdaptiveToken.Top + let state = r.State - - - - /// Creates a constant set using the creation function. - let constant (value : unit -> arr<'T>) = - Readers.ConstantArray(lazy value()) :> aarr<_> - - /// Creates an aset using the given reader-creator. - let ofReader (create : unit -> #IOpReader>) = - Readers.AdaptiveArrayImpl(fun () -> create() :> IOpReader<_>) :> aarr<_> - - /// The empty aset. - [] - let empty<'T> : aarr<'T> = - Readers.EmptyArray<'T>.Instance - - /// A constant aset holding a single value. - let single (value : 'T) = - constant (fun () -> Arr.single value) - - /// Creates an aset holding the given values. - let ofSeq (elements : seq<'T>) = - constant (fun () -> Arr.ofSeq elements) - - /// Creates an aset holding the given values. - let ofList (elements : list<'T>) = - constant (fun () -> Arr.ofList elements) - - /// Creates an aset holding the given values. - let ofArray (elements : 'T[]) = - constant (fun () -> Arr.ofArray elements) - - /// Creates an aval providing access to the current content of the set. - let toAVal (set : aarr<'T>) = - set.Content - - let map (mapping : 'a -> 'b) (a : aarr<'a>) = - if a.IsConstant then - constant( fun () -> Arr.map mapping (AVal.force a.Content)) - else - ofReader <| fun () -> - Readers.MapReader(a.GetReader(), mapping) + printfn " %A" ops + printfn " %A" state - let collect (mapping : 'a -> aarr<'b>) (a : aarr<'a>) = - if false && a.IsConstant then - failwith "TODO" - else - ofReader <| fun () -> - Readers.CollectReader(a.GetReader(), mapping) - - - -module AArrTest = - let run() = - let a = ChangeableArray(Arr.ofList [1;2;6;8;3;4]) - let even = ChangeableArray(Arr.ofList [2]) - let odd = ChangeableArray(Arr.ofList [1]) - - let result = - a |> AArr.collect (fun v -> - if v % 2 = 0 then even - else odd + printfn "initial" + print() + + transact (fun () -> + a.Value <- Arr.add 5 a.Value ) - - let r = result.GetReader() - - let print() = - let ops = r.GetChanges AdaptiveToken.Top - let state = r.State + printfn "add(5)" + print() - printfn " %A" ops - printfn " %A" state + transact (fun () -> + even.Value <- Arr.ofList [4;4] + ) + printfn "even <- [|4;4|]" + print() + + transact (fun () -> + even.Remove 0 + ) + printfn "even.Remove 0" + print() - printfn "initial" - print() - - transact (fun () -> - a.Value <- Arr.add 5 a.Value - ) - printfn "add(5)" - print() - - transact (fun () -> - even.Value <- Arr.ofList [4;4] - ) - printfn "even <- [|4;4|]" - print() - - transact (fun () -> - even.Remove 0 - ) - printfn "even.Remove 0" - print() - diff --git a/src/FSharp.Data.Adaptive/AdaptiveArray/AdaptiveArray.fs b/src/FSharp.Data.Adaptive/AdaptiveArray/AdaptiveArray.fs new file mode 100644 index 0000000..df2c99a --- /dev/null +++ b/src/FSharp.Data.Adaptive/AdaptiveArray/AdaptiveArray.fs @@ -0,0 +1,133 @@ +namespace FSharp.Data.Adaptive + +open System +open FSharp.Data.Traceable +open FSharp.Data.Adaptive + +/// An adaptive reader for aarr that allows to pull operations and exposes its current state. +type IArrayReader<'T> = + IOpReader, arrdelta<'T>> + +/// Adaptive array datastructure. +[] +type IAdaptiveArray<'T> = + /// Is the array constant? + abstract member IsConstant : bool + + /// The current content of the array as aval. + abstract member Content : aval> + + /// Gets a new reader to the array. + abstract member GetReader : unit -> IArrayReader<'T> + + /// Gets the underlying History instance for the alist (if any) + abstract member History : option, arrdelta<'T>>> + +/// Adaptive list datastructure. +type aarr<'T> = IAdaptiveArray<'T> + + +/// Functional operators for the alist<_> type. +[] +module AArr = + /// Efficient implementation for a constant adaptive array. + [] + type ConstantArray<'T>(content : Lazy>) = + let value = AVal.delay (fun () -> content.Value) + + member x.Content = value + + member x.GetReader() = + History.Readers.ConstantReader<_,_>( + Arr.trace, + lazy (Arr.computeDelta DefaultEqualityComparer.Instance Arr.empty content.Value), + content + ) :> IArrayReader<_> + + interface IAdaptiveArray<'T> with + member x.IsConstant = true + member x.GetReader() = x.GetReader() + member x.Content = x.Content + member x.History = None + + /// Core implementation for a dependent array. + [] + type AdaptiveArray<'T>(createReader : unit -> IOpReader>) = + let history = History(createReader, Arr.trace) + + /// Gets a new reader to the set. + member x.GetReader() : IArrayReader<'T> = + history.NewReader() + + /// Current content of the set as aval. + member x.Content = + history :> aval<_> + + interface IAdaptiveArray<'T> with + member x.IsConstant = false + member x.GetReader() = x.GetReader() + member x.Content = x.Content + member x.History = Some history + + /// Efficient implementation for an empty adaptive array. + [] + type EmptyArray<'T> private() = + static let instance = EmptyArray<'T>() :> aarr<_> + let content = AVal.constant Arr.empty + let reader = History.Readers.EmptyReader, arrdelta<'T>>(Arr.trace) :> IArrayReader<'T> + static member Instance = instance + + member x.Content = content + member x.GetReader() = reader + + interface IAdaptiveArray<'T> with + member x.IsConstant = true + member x.GetReader() = x.GetReader() + member x.Content = x.Content + member x.History = None + + module Readers = + type MapReader<'T1, 'T2>(input : aarr<'T1>, mapping : 'T1 -> 'T2) = + inherit AbstractReader>(ArrDelta.empty) + + let reader = input.GetReader() + + override x.Compute(token : AdaptiveToken) = + let delta = reader.GetChanges(token) + ArrDelta.map mapping delta + + /// The empty aarr. + [] + let empty<'T> : aarr<'T> = + EmptyArray<'T>.Instance + + /// A constant aarr holding a single value. + let single (value : 'T) : aarr<'T> = + ConstantArray(Lazy<_>.CreateFromValue(Arr.single value)) :> aarr<_> + + /// Creates an aarr holding the given values. + let ofSeq (elements: seq<'T>) : aarr<'T> = + ConstantArray(Lazy<_>.CreateFromValue(Arr.ofSeq elements)) :> aarr<_> + + + /// Creates an aarr holding the given values. + let ofList (elements: list<'T>) : aarr<'T> = + ConstantArray(Lazy<_>.CreateFromValue(Arr.ofList elements)) :> aarr<_> + + /// Creates an aarr holding the given values. + let ofArray (elements: 'T[]) : aarr<'T> = + ConstantArray(Lazy<_>.CreateFromValue(Arr.ofArray elements)) :> aarr<_> + + /// Creates an aarr holding the given values. + let ofArr (elements: arr<'T>) : aarr<'T> = + ConstantArray(Lazy<_>.CreateFromValue(elements)) :> aarr<_> + + /// Creates an aarr using the given reader-creator. + let ofReader (create : (unit -> #IOpReader>)) : aarr<'T> = + AdaptiveArray<'T>(fun () -> create() :> IOpReader>) :> aarr<'T> + + /// Adaptively applies the given mapping function to all elements and returns a new aarr containing the results. + let map (mapping : 'T1 -> 'T2) (input : aarr<'T1>) : aarr<'T2> = + ofReader <| fun () -> + Readers.MapReader(input, mapping) + \ No newline at end of file diff --git a/src/FSharp.Data.Adaptive/AdaptiveArray/AdaptiveArray.fsi b/src/FSharp.Data.Adaptive/AdaptiveArray/AdaptiveArray.fsi new file mode 100644 index 0000000..bbbab48 --- /dev/null +++ b/src/FSharp.Data.Adaptive/AdaptiveArray/AdaptiveArray.fsi @@ -0,0 +1,57 @@ +namespace FSharp.Data.Adaptive + +open System +open FSharp.Data.Traceable +open FSharp.Data.Adaptive + +/// An adaptive reader for aarr that allows to pull operations and exposes its current state. +type IArrayReader<'T> = + IOpReader, arrdelta<'T>> + +/// Adaptive array datastructure. +[] +type IAdaptiveArray<'T> = + /// Is the array constant? + abstract member IsConstant : bool + + /// The current content of the array as aval. + abstract member Content : aval> + + /// Gets a new reader to the array. + abstract member GetReader : unit -> IArrayReader<'T> + + /// Gets the underlying History instance for the alist (if any) + abstract member History : option, arrdelta<'T>>> + +/// Adaptive list datastructure. +type aarr<'T> = IAdaptiveArray<'T> + + +/// Functional operators for the alist<_> type. +[] +module AArr = + + /// The empty aarr. + [] + val empty<'T> : aarr<'T> + + /// A constant aarr holding a single value. + val single : value: 'T -> aarr<'T> + + /// Creates an aarr holding the given values. + val ofSeq : elements: seq<'T> -> aarr<'T> + + /// Creates an aarr holding the given values. + val ofList : elements: list<'T> -> aarr<'T> + + /// Creates an aarr holding the given values. + val ofArray : elements: 'T[] -> aarr<'T> + + /// Creates an aarr holding the given values. + val ofArr : elements: arr<'T> -> aarr<'T> + + /// Creates an aarr using the given reader-creator. + val ofReader : create: (unit -> #IOpReader>) -> aarr<'T> + + /// Adaptively applies the given mapping function to all elements and returns a new aarr containing the results. + val map : mapping: ('T1 -> 'T2) -> input: aarr<'T1> -> aarr<'T2> diff --git a/src/FSharp.Data.Adaptive/AdaptiveArray/ChangeableArray.fs b/src/FSharp.Data.Adaptive/AdaptiveArray/ChangeableArray.fs new file mode 100644 index 0000000..f9c2313 --- /dev/null +++ b/src/FSharp.Data.Adaptive/AdaptiveArray/ChangeableArray.fs @@ -0,0 +1,96 @@ +namespace FSharp.Data.Adaptive + +open System.Collections.Generic +open FSharp.Data.Traceable + +/// Changeable adaptive array that allows mutation by user-code and implements aarr. +[] +type ChangeableArray<'T>(state : arr<'T>) = + let history = History, arrdelta<'T>>(Arr.trace) + + do history.Perform (ArrDelta.single { Index = 0; Count = 0; Elements = state }) |> ignore + + /// is the array currently empty? + member x.IsEmpty = history.State.IsEmpty + + /// the number of elements currently in the array. + member x.Length = history.State.Length + + /// Gets or sets the value for the array. + member x.Value + with get() = + history.State + and set (v : arr<'T>) = + let delta = Arr.computeDelta DefaultEqualityComparer.Instance history.State v + history.Perform delta |> ignore + + member x.Clear() = + let delta = ArrDelta.single { Index = 0; Count = history.State.Length; Elements = Arr.empty } + history.Perform delta |> ignore + + member x.Add (item : 'T) = + let delta = ArrDelta.single { Index = history.State.Length; Count = 0; Elements = Arr.single item } + history.Perform delta |> ignore + + member x.Insert (index : int, value : 'T) = + if index < 0 || index > history.State.Length then raise <| System.IndexOutOfRangeException() + let delta = ArrDelta.single { Index = index; Count = 0; Elements = Arr.single value } + history.Perform delta |> ignore + + member x.RemoveAt(index : int) = + if index < 0 || index >= history.State.Length then raise <| System.IndexOutOfRangeException() + let delta = ArrDelta.single { Index = index; Count = 1; Elements = Arr.empty } + history.Perform delta |> ignore + + member x.CopyTo(array, arrayIndex) = history.State.CopyTo(array, arrayIndex) + + member x.Item + with get (index : int) = + history.State.[index] + and set (index : int) (value : 'T) = + let delta = ArrDelta.single { Index = index; Count = 1; Elements = Arr.single value } + history.Perform delta |> ignore + + new(elements : seq<'T>) = ChangeableArray<'T>(Arr.ofSeq elements) + new() = ChangeableArray<'T>(Arr.empty) + + member x.GetEnumerator() = history.State.GetEnumerator() + + interface System.Collections.IEnumerable with + member x.GetEnumerator() = history.State.GetEnumerator() + + interface System.Collections.Generic.IEnumerable<'T> with + member x.GetEnumerator() = history.State.GetEnumerator() + + interface System.Collections.Generic.ICollection<'T> with + member x.Add(item) = x.Add item + member x.Clear() = x.Clear() + member x.Contains(item) = history.State |> Arr.exists (fun v -> DefaultEquality.equals v item) + member x.CopyTo(array, arrayIndex) = x.CopyTo(array, arrayIndex) + member x.Remove(item) = + match Arr.tryFindIndex (fun v -> DefaultEquality.equals v item) history.State with + | Some index -> x.RemoveAt index; true + | None -> false + member x.Count = x.Length + member x.IsReadOnly = false + + interface System.Collections.Generic.IList<'T> with + member x.IndexOf(item) = + match Arr.tryFindIndex (fun v -> DefaultEquality.equals v item) history.State with + | Some index -> index + | None -> -1 + member x.Insert(index,item) = x.Insert(index, item) + member x.RemoveAt(index) = x.RemoveAt(index) + member x.Item + with get(i : int) = x.[i] + and set (i : int) (value : 'T) = x.[i] <- value + + interface IAdaptiveArray<'T> with + member x.IsConstant = false + member x.GetReader() = history.NewReader() + member x.Content = history :> aval<_> + member x.History = Some history + + +/// Changeable adaptive array that allows mutation by user-code and implements aarr. +type carr<'T> = ChangeableArray<'T> \ No newline at end of file diff --git a/src/FSharp.Data.Adaptive/AdaptiveArray/ChangeableArray.fsi b/src/FSharp.Data.Adaptive/AdaptiveArray/ChangeableArray.fsi new file mode 100644 index 0000000..91467bb --- /dev/null +++ b/src/FSharp.Data.Adaptive/AdaptiveArray/ChangeableArray.fsi @@ -0,0 +1,33 @@ +namespace FSharp.Data.Adaptive + +open System.Collections.Generic +open FSharp.Data.Traceable + +/// Changeable adaptive array that allows mutation by user-code and implements aarr. +[] +type ChangeableArray<'T> = + interface IAdaptiveArray<'T> + interface System.Collections.Generic.IEnumerable<'T> + interface System.Collections.Generic.ICollection<'T> + interface System.Collections.Generic.IList<'T> + + /// is the array currently empty? + member IsEmpty : bool + + /// the number of elements currently in the array. + member Length : int + + /// Gets or sets the value for the array. + member Value : arr<'T> with get, set + + member Clear : unit -> unit + member Add : 'T -> unit + member Insert : index: int * value: 'T -> unit + member Item : int -> 'T with get, set + + new : unit -> ChangeableArray<'T> + new : arr<'T> -> ChangeableArray<'T> + new : seq<'T> -> ChangeableArray<'T> + +/// Changeable adaptive array that allows mutation by user-code and implements aarr. +type carr<'T> = ChangeableArray<'T> \ No newline at end of file diff --git a/src/FSharp.Data.Adaptive/Datastructures/ArrDelta.fs b/src/FSharp.Data.Adaptive/Datastructures/ArrDelta.fs index a654450..ef8b5b1 100644 --- a/src/FSharp.Data.Adaptive/Datastructures/ArrDelta.fs +++ b/src/FSharp.Data.Adaptive/Datastructures/ArrDelta.fs @@ -407,11 +407,13 @@ module ArrDelta = module ``ArrDelta Extensions`` = module Arr = - let computeDelta (equal : 'a -> 'a -> bool) (src : arr<'a>) (dst : arr<'a>) : arrdelta<'a> = + let computeDelta (cmp : System.Collections.Generic.IEqualityComparer<'a>) (src : arr<'a>) (dst : arr<'a>) : arrdelta<'a> = let srcArr = Arr.toArray src let dstArr = Arr.toArray dst - let mutable steps = DeltaOperationList.ofArrayMyers equal srcArr dstArr + let mutable steps = + if srcArr.Length = 0 && dstArr.Length = 0 then DeltaOperationList.DeltaOperationList.Empty + else DeltaOperationList.ofArrayMyersComparer cmp srcArr dstArr let mutable si = 0 let mutable di = 0 @@ -457,15 +459,14 @@ module ``ArrDelta Extensions`` = arrdelta delta - - let applyDeltaAndGetEffective (equal : 'a -> 'a -> bool) (state : arr<'a>) (delta : arrdelta<'a>) = + let applyDeltaAndGetEffective (cmp : System.Collections.Generic.IEqualityComparer<'a>) (state : arr<'a>) (delta : arrdelta<'a>) = let mutable effective = ArrDelta.empty let mutable res = state for op in delta do res <- res.UpdateRange(op.Index, op.Count, fun old -> let real = - computeDelta equal old op.Elements + computeDelta cmp old op.Elements |> ArrDelta.mapOp (fun oo -> { oo with Index = oo.Index + op.Index }) effective <- ArrDelta.combine effective real op.Elements diff --git a/src/FSharp.Data.Adaptive/Datastructures/Deltas.fs b/src/FSharp.Data.Adaptive/Datastructures/Deltas.fs index 9fc3663..31a51e1 100644 --- a/src/FSharp.Data.Adaptive/Datastructures/Deltas.fs +++ b/src/FSharp.Data.Adaptive/Datastructures/Deltas.fs @@ -144,6 +144,80 @@ module ComputeListDeltaHelpers = result + /// inspired by this [paper](https://neil.fraser.name/writing/diff/myers.pdf) + let ofArrayMyersComparer (cmp : System.Collections.Generic.IEqualityComparer<'a>) (src : 'a[]) (dst : 'a[]) : DeltaOperationList = + let max = src.Length + dst.Length + let vs = Array.zeroCreate (2 * max + 1) + let ps = Array.zeroCreate vs.Length + + let inline setv (k : int) value = + vs.[k + max] <- value + + let inline getv (k : int) = + vs.[k + max] + + let inline setp (k : int) value = + ps.[k + max] <- value + + let inline getp (k : int) = + ps.[k + max] + + let mutable x = 0 + let mutable y = 0 + let mutable d = 0 + let mutable result = Unchecked.defaultof<_> + + let eSrc = src.Length - 1 + let eDst = dst.Length - 1 + + let inline equal x y = + // reversed arrays + cmp.Equals(src.[eSrc - x], dst.[eDst - y]) + + while d <= max do + let mutable k = -d + while k <= d do + let down = k = -d || (k <> d && getv (k-1) < getv (k+1)) + + let mutable p = Unchecked.defaultof<_> + if down then + x <- getv (k+1) + p <- getp (k+1) + else + x <- getv(k-1) + 1 + p <- getp(k-1) + + y <- x - k + let kPrev = if down then k + 1 else k - 1 + + let xStart = getv kPrev + let yStart = xStart - kPrev + + let xMid = if down then xStart else xStart + 1 + let yMid = xMid - k + + if xStart >= 0 && xMid <> xStart then p <- p.Prepend DeltaOperation.Remove + elif yStart >= 0 && yMid <> yStart then p <- p.Prepend DeltaOperation.Add + + while x < src.Length && y < dst.Length && equal x y do + x <- x + 1 + y <- y + 1 + p <- p.Prepend DeltaOperation.Equal + + setv k x + setp k p + if x >= src.Length && y >= dst.Length then + // terminate + result <- p + d <- max + k <- max + + k <- k + 2 + d <- d + 1 + + result + + /// Differentiation extensions for several immutable datastructures. diff --git a/src/FSharp.Data.Adaptive/FSharp.Data.Adaptive.fsproj b/src/FSharp.Data.Adaptive/FSharp.Data.Adaptive.fsproj index 75bd860..98404f1 100644 --- a/src/FSharp.Data.Adaptive/FSharp.Data.Adaptive.fsproj +++ b/src/FSharp.Data.Adaptive/FSharp.Data.Adaptive.fsproj @@ -76,6 +76,10 @@ + + + + diff --git a/src/FSharp.Data.Adaptive/Traceable/Instances.fs b/src/FSharp.Data.Adaptive/Traceable/Instances.fs index fa53a53..1e152e9 100644 --- a/src/FSharp.Data.Adaptive/Traceable/Instances.fs +++ b/src/FSharp.Data.Adaptive/Traceable/Instances.fs @@ -124,8 +124,8 @@ module Arr = static let trace : Traceable, arrdelta<'T>> = { tempty = Arr.empty - tcomputeDelta = Arr.computeDelta Unchecked.equals - tapplyDelta = fun m d -> Arr.applyDelta m d, d + tcomputeDelta = Arr.computeDelta DefaultEqualityComparer.Instance + tapplyDelta = Arr.applyDeltaAndGetEffective DefaultEqualityComparer.Instance tmonoid = ArrDelta.monoid tsize = fun _ -> 0 tprune = None @@ -136,4 +136,28 @@ module Arr = [] let trace<'a> = Traceable<'a>.Instance + let private traceCache = System.Collections.Generic.Dictionary() + + let getTrace (cmp : System.Collections.Generic.IEqualityComparer<'T>) = + lock traceCache (fun () -> + match traceCache.TryGetValue cmp with + | (true, (:? Traceable, arrdelta<'T>> as traceable)) -> + traceable + | _ -> + let traceable = + { + tempty = Arr.empty + tcomputeDelta = Arr.computeDelta cmp + tapplyDelta = fun m d -> Arr.applyDeltaAndGetEffective cmp m d + tmonoid = ArrDelta.monoid + tsize = fun _ -> 0 + tprune = None + } + traceCache.[cmp] <- traceable + traceable + ) + + + + diff --git a/src/Test/FSharp.Data.Adaptive.Reference/AdaptiveArray.fs b/src/Test/FSharp.Data.Adaptive.Reference/AdaptiveArray.fs new file mode 100644 index 0000000..644870a --- /dev/null +++ b/src/Test/FSharp.Data.Adaptive.Reference/AdaptiveArray.fs @@ -0,0 +1,95 @@ +namespace FSharp.Data.Adaptive.Reference + +open FSharp.Data.Adaptive +open FSharp.Data.Adaptive.Reference + +/// The reference implementation for IIndexListReader. +type IArrayReader<'T> = FSharp.Data.Adaptive.Reference.IOpReader, arrdelta<'T>> + +/// The reference implementation for alist. +type IAdaptiveArray<'T> = + abstract member GetReader: unit -> IArrayReader<'T> + abstract member Content: FSharp.Data.Adaptive.Reference.aval> + +and aarr<'T> = IAdaptiveArray<'T> + +/// A simple reader using computeDelta for getting deltas. +type internal AArrReader<'T>(list: aarr<'T>) = + + let mutable last = Arr.empty + + member x.State = + last + + member x.GetChanges(t : FSharp.Data.Adaptive.Reference.AdaptiveToken) = + let c = list.Content.GetValue t + let ops = Arr.computeDelta DefaultEqualityComparer.Instance last c + last <- c + ops + + interface IOpReader> with + member x.GetChanges t = x.GetChanges t + + interface IOpReader, arrdelta<'T>> with + member x.State = x.State + + +/// A reference implementation for clist. +type ChangeableArray<'T>(value: arr<'T>) = + let mutable content = value + + // the current content as aval<_> + let contentRef = + { new aval> with + member x.GetValue _ = content + } + + /// Gets or sets the current immutable state of the set. + member x.Value + with get() = content + and set v = content <- v + + interface IAdaptiveArray<'T> with + member x.Content = contentRef + member x.GetReader() = AArrReader(x) :> IArrayReader<_> + + /// Creates a new empty cset. + new() = carr<'T>(IndexList.empty) + + /// Creates a new cset with all the given values. + new(es: seq<'T>) = carr(IndexList.ofSeq es) + +and carr<'T> = ChangeableArray<'T> + + +/// Functional operators for the alist reference-implementation. +module AArr = + + /// Creates an alist from the given aval. + let internal ofRef (r: aval>) = + { new aarr<'T> with + member x.Content = r + member x.GetReader() = AArrReader(x) :> IArrayReader<_> + } + + /// The empty alist. + let empty<'T> = ofRef (AVal.constant Arr.empty<'T>) + + /// A constant alist containing a single value + let single (value: 'T) = ofRef (AVal.constant (Arr.single value)) + + /// Creates a constant alist from the given values. + let ofSeq (values: seq<'T>) = ofRef (AVal.constant (Arr.ofSeq values)) + + /// Creates a constant alist from the given values. + let ofList (values: list<'T>) = ofRef (AVal.constant (Arr.ofList values)) + + /// Creates a constant alist from the given values. + let ofArray (values: array<'T>) = ofRef (AVal.constant (Arr.ofArray values)) + + /// Creates a constant alist from the given values. + let ofArr (values: arr<'T>) = ofRef (AVal.constant values) + + let map (mapping: 'T1 -> 'T2) (list: aarr<'T1>) = + list.Content |> AVal.map (Arr.map mapping) |> ofRef + \ No newline at end of file diff --git a/src/Test/FSharp.Data.Adaptive.Reference/FSharp.Data.Adaptive.Reference.fsproj b/src/Test/FSharp.Data.Adaptive.Reference/FSharp.Data.Adaptive.Reference.fsproj index 3c379bb..628e644 100644 --- a/src/Test/FSharp.Data.Adaptive.Reference/FSharp.Data.Adaptive.Reference.fsproj +++ b/src/Test/FSharp.Data.Adaptive.Reference/FSharp.Data.Adaptive.Reference.fsproj @@ -16,6 +16,7 @@ + diff --git a/src/Test/FSharp.Data.Adaptive.Tests/AArr.fs b/src/Test/FSharp.Data.Adaptive.Tests/AArr.fs new file mode 100644 index 0000000..07ecb70 --- /dev/null +++ b/src/Test/FSharp.Data.Adaptive.Tests/AArr.fs @@ -0,0 +1,118 @@ +module AArr + +open NUnit.Framework +open FsCheck +open FSharp.Data.Adaptive +open FSharp.Data.Traceable +open FsUnit +open FsCheck.NUnit +open FSharp.Data +open Generators + + +[ |]); Timeout(60000)>] +let ``[AArr] reference impl``() ({ areal = real; aref = ref; aexpression = str; achanges = changes } : VArr) = + printfn "VALIDATE" + + + let str b = + let m, str = str b + String.concat "\r\n" [ + for (k,v) in Map.toSeq m do + yield sprintf "let %s = %s" k v + yield str + ] + + printfn "%s" (Generators.Generators.indent (Generators.Generators.indent (str false))) + let r = real.GetReader() + + let check (beforeChangeStr : string) (beforeChange : list) (latestChanges : list) = + r.GetChanges AdaptiveToken.Top |> ignore + let vReal = real.Content.GetValue AdaptiveToken.Top + let vRef = ref.Content.GetValue Reference.AdaptiveToken.Top + + let lReal = Arr.toArray vReal + let lRef = Arr.toArray vRef + + let equal = + lReal.Length = lRef.Length && + (lReal, lRef) ||> Array.forall2 (=) + + if equal then + vRef + else + let real = vReal |> Seq.map string |> String.concat "; " |> sprintf "[%s]" + let ref = vRef |> Seq.map string |> String.concat "; " |> sprintf "[%s]" + + let inputs = changes() |> List.map (fun i -> i.cell) + + let message = + String.concat "\r\n" [ + yield "ERROR" + yield "BEFORE" + //yield! beforeChangeStr.Split("\r\n") |> Array.map Generators.indent + + yield "CURRENT" + yield! (str true).Split([|"\r\n"|], System.StringSplitOptions.None) |> Array.map Generators.indent + + yield sprintf "real: %s" real + yield sprintf "ref: %s" ref + + yield "before" + for i in beforeChange do + yield sprintf " %A" i + + //yield "inputs" + //for i in inputs do + // yield sprintf " %A" i + + //yield "latest changes" + //for c in latestChanges do + // yield " " + c + ] + failwith message + //printfn " VALUE => %A" vRef + + let mutable lastValue = check "" [] [] + + let run = + gen { + let mutable effective = 0 + + while effective < 20 do + let all = changes() + match all with + | [] -> + effective <- System.Int32.MaxValue + | _ -> + let! some = + all + |> List.map (fun g -> g.change) + |> Gen.subListOf + |> Gen.filter (List.isEmpty >> not) + + let beforeChange = + all |> List.map (fun c -> c.cell |> string) + + let beforeChangeStr = str true + let! changeAll = Gen.collect id some + let latestChange = + transact (fun () -> + changeAll |> List.map (fun c -> c()) + ) + let v = check beforeChangeStr beforeChange latestChange + if not (DefaultEquality.equals v lastValue) then + + printfn " change %d => %A" effective v + lastValue <- v + + + + effective <- effective + 1 + } + + Gen.eval 15 (Random.newSeed()) run + +[] +let ``[AArr] map`` () = + () diff --git a/src/Test/FSharp.Data.Adaptive.Tests/Arr.fs b/src/Test/FSharp.Data.Adaptive.Tests/Arr.fs index 7e90805..c82f469 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/Arr.fs +++ b/src/Test/FSharp.Data.Adaptive.Tests/Arr.fs @@ -638,8 +638,8 @@ let ``[ArrOperation] TryMerge`` (NonEmptyArray (a : int[])) (NonEmptyArray (b : let a = Arr.ofArray a let b = Arr.ofArray b let c = Arr.ofArray c - let ab = Arr.computeDelta (=) a b - let bc = Arr.computeDelta (=) b c + let ab = Arr.computeDelta DefaultEqualityComparer.Instance a b + let bc = Arr.computeDelta DefaultEqualityComparer.Instance b c match Seq.tryHead ab with | Some ab0 -> @@ -697,8 +697,8 @@ let ``[ArrDelta] combine minimal`` (NonEmptyArray (a : int[])) (NonEmptyArray (b let b = Arr.ofArray b let c = Arr.ofArray c - let ab = Arr.computeDelta (=) a b - let bc = Arr.computeDelta (=) b c + let ab = Arr.computeDelta DefaultEqualityComparer.Instance a b + let bc = Arr.computeDelta DefaultEqualityComparer.Instance b c let abc = ArrDelta.combine ab bc let abc1 = minimize abc @@ -711,8 +711,8 @@ let ``[ArrDelta] combine sorted`` (NonEmptyArray (a : int[])) (NonEmptyArray (b let b = Arr.ofArray b let c = Arr.ofArray c - let ab = Arr.computeDelta (=) a b - let bc = Arr.computeDelta (=) b c + let ab = Arr.computeDelta DefaultEqualityComparer.Instance a b + let bc = Arr.computeDelta DefaultEqualityComparer.Instance b c let abc = ArrDelta.combine ab bc @@ -740,9 +740,9 @@ let ``[ArrDelta] combine correct`` (NonEmptyArray (a : int[])) (NonEmptyArray (b let b = Arr.ofArray b let c = Arr.ofArray c - let ab = Arr.computeDelta (=) a b - let bc = Arr.computeDelta (=) b c - let ac = Arr.computeDelta (=) a c + let ab = Arr.computeDelta DefaultEqualityComparer.Instance a b + let bc = Arr.computeDelta DefaultEqualityComparer.Instance b c + let ac = Arr.computeDelta DefaultEqualityComparer.Instance a c let abc = ArrDelta.combine ab bc @@ -754,8 +754,8 @@ let ``[Arr] apply/computeDelta`` (NonEmptyArray (a : int[])) (NonEmptyArray (b : let a = Arr.ofArray a let b = Arr.ofArray b - let d = Arr.computeDelta (=) a b - let b1, d1 = Arr.applyDeltaAndGetEffective (=) a d + let d = Arr.computeDelta DefaultEqualityComparer.Instance a b + let b1, d1 = Arr.applyDeltaAndGetEffective DefaultEqualityComparer.Instance a d let b2 = Arr.applyDelta a d b1 |> should equal b @@ -768,7 +768,7 @@ let ``[Arr] applyDeltaAndGetEffective cancellation`` (NonEmptyArray (a : int[])) let a = Arr.ofArray a let op = ArrDelta.single { Index = 0; Count = a.Length; Elements = a } - let a1, d = Arr.applyDeltaAndGetEffective (=) a op + let a1, d = Arr.applyDeltaAndGetEffective DefaultEqualityComparer.Instance a op a1 |> should equal a d |> should equal ArrDelta.empty @@ -780,8 +780,8 @@ let ``[Arr] applyDeltaAndGetEffective preserves effective`` (NonEmptyArray (a : let a = Arr.ofArray a let b = Arr.ofArray b - let op = Arr.computeDelta (=) a b - let a1, d = Arr.applyDeltaAndGetEffective (=) a op + let op = Arr.computeDelta DefaultEqualityComparer.Instance a b + let a1, d = Arr.applyDeltaAndGetEffective DefaultEqualityComparer.Instance a op a1 |> should equal b d |> should equal op diff --git a/src/Test/FSharp.Data.Adaptive.Tests/FSharp.Data.Adaptive.Tests.fsproj b/src/Test/FSharp.Data.Adaptive.Tests/FSharp.Data.Adaptive.Tests.fsproj index 0b21950..21ed311 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/FSharp.Data.Adaptive.Tests.fsproj +++ b/src/Test/FSharp.Data.Adaptive.Tests/FSharp.Data.Adaptive.Tests.fsproj @@ -41,6 +41,7 @@ + diff --git a/src/Test/FSharp.Data.Adaptive.Tests/Program.fs b/src/Test/FSharp.Data.Adaptive.Tests/Program.fs index 21ffe20..a42bf8d 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/Program.fs +++ b/src/Test/FSharp.Data.Adaptive.Tests/Program.fs @@ -47,7 +47,6 @@ let ``[AList] sub``() = [] let main _args = - Arr.``[Arr] applyDeltaAndGetEffective preserves effective`` (NonEmptyArray [| 0; -1 |]) //Arr.``[ArrDelta] combine sorted`` (NonEmptyArray [|1|]) (NonEmptyArray [|0; 1; 0|]) (NonEmptyArray [|0|]) //Arr.``[ArrOperation] TryMerge`` (NonEmptyArray [|-4; 0|]) (NonEmptyArray [|-4; 1|]) (NonEmptyArray [|0|]) //Arr.``[ArrDelta] combine correct`` (NonEmptyArray [|0; 0|]) (NonEmptyArray [|0; 3; 0; 1|]) (NonEmptyArray [|3|]) diff --git a/src/Test/FSharp.Data.Adaptive.Tests/Utilities/Generators.fs b/src/Test/FSharp.Data.Adaptive.Tests/Utilities/Generators.fs index b1b0fed..7a08840 100644 --- a/src/Test/FSharp.Data.Adaptive.Tests/Utilities/Generators.fs +++ b/src/Test/FSharp.Data.Adaptive.Tests/Utilities/Generators.fs @@ -100,6 +100,8 @@ type refmap<'a, 'b> = Reference.amap<'a, 'b> type realmap<'a, 'b> = Adaptive.amap<'a, 'b> type reflist<'a> = Reference.alist<'a> type reallist<'a> = Adaptive.alist<'a> +type refarr<'a> = Reference.aarr<'a> +type realarr<'a> = Adaptive.aarr<'a> type ChangeGen = @@ -140,6 +142,14 @@ type VList<'a> = lchanges : unit -> list } +type VArr<'a> = + { + areal : realarr<'a> + aref : refarr<'a> + aexpression : bool -> Map * string + achanges : unit -> list + } + module Generators = let rand = Random() @@ -1616,6 +1626,118 @@ module Generators = list.lchanges } + module Arr = + let mutable cid = 0 + + let create a b s c = + { + areal = a + aref = b + aexpression = s + achanges = c + } + + + + let init<'a>() = + gen { + let id = System.Threading.Interlocked.Increment(&cid) + let! value = Arb.generate> + + let real = Adaptive.carr value + let ref = Reference.carr value + + let change = + { + cell = (real, id) :> obj + change = + gen { + let! newValue = Arb.generate> + return fun () -> + real.Value <- newValue + ref.Value <- newValue + sprintf "C%d <- %A" id newValue + + } + } + + return + create + (real :> Adaptive.aarr<_>) + (ref :> Reference.aarr<_>) + (function + | false -> + Map.empty, sprintf "c%d" id + | true -> + let c = real.Value |> Seq.map (sprintf "%A") |> String.concat "; " + let m = Map.ofList [sprintf "c%d" id, sprintf "carr [%s]" c] + m, sprintf "c%d" id + ) + (fun () -> [change]) + } + + let constant<'a>() = + gen { + let! value = Arb.generate> + let id = System.Threading.Interlocked.Increment(&cid) + + return + create + (Adaptive.AArr.ofArr value) + (Reference.AArr.ofArr value) + (function + | false -> Map.empty, sprintf "%A" value + | true -> + let m = Map.ofList [sprintf "v%d" id, sprintf "AArr.ofList [%s]" (value |> Seq.map (sprintf "%A") |> String.concat "; ")] + m, sprintf "v%d" id + ) + (fun () -> []) + } + + // let ofAVal<'a> () = + // gen { + // let! a = Arb.generate>> |> Gen.scaleSize (fun v -> 0) + // return + // create + // (a.real |> Adaptive.AArr.ofAVal) + // (a.ref |> Reference.AArr.ofRef) + // (fun _ -> Map.empty, sprintf "ofAVal\r\n%s" (indent a.expression)) + // (fun () -> a.changes()) + // } + + + let map<'a, 'b>() = + gen { + let mySize = ref 0 + let! value = Arb.generate<_> |> Gen.scaleSize (fun s -> mySize := s; s - 2) + //let! f = Arb.generate<'a -> 'b> |> Gen.scaleSize (fun _ -> 50) + let table, f = randomFunction<'a, 'b> (!mySize / 2) + + let mapping v = f(v) + + return + create + (Adaptive.AArr.map mapping value.areal) + (Reference.AArr.map mapping value.aref) + (function + | false -> + let m, v = value.aexpression false + m, sprintf "map (\r\n%s\r\n)" (indent v) + | true -> + let realContent = value.aref.Content |> Reference.AVal.force + let mi, input = value.aexpression true + + let table = + realContent + |> Seq.map (fun v -> sprintf "| %A -> %A" v (mapping v)) + |> String.concat "\r\n" + + mi, sprintf "%s\r\n|> AArr.map (\r\n function\r\n%s\r\n)" (indent input) (indent table) + ) + value.achanges + } + + [] type StupidHash(v : int) = @@ -1673,6 +1795,15 @@ type AdaptiveGenerators() = Seq.empty } + + static member FSharpArr<'a>() = + { new Arbitrary>() with + member x.Generator = + Arb.generate> |> Gen.map Arr.ofList + member x.Shrinker _ = + Seq.empty + } + static member Val<'a>() = { new Arbitrary>() with member x.Generator = @@ -1943,6 +2074,44 @@ type AdaptiveGenerators() = Seq.empty } + + static member Arr<'a>() = + { new Arbitrary>() with + member x.Generator = + Gen.sized (fun size -> + gen { + let! kind = + if size = 0 then + Gen.frequency [ + 1, Gen.constant "constant" + 5, Gen.constant "carr" + ] + else + Gen.frequency [ + yield 1, Gen.constant "constant" + yield 3, Gen.constant "carr" + yield 3, Gen.constant "map" + ] + match kind with + | "constant" -> + return! Generators.Arr.constant<'a>() + | "carr" -> + return! Generators.Arr.init<'a>() + | "map" -> + let! t = Gen.elements relevantTypes + return! + t |> visit { new TypeVisitor<_> with + member __.Accept<'z>() = Generators.Arr.map<'z, 'a>() + } + | kind -> + return failwithf "unknown operation: %s" kind + } + ) + member x.Shrinker _ = + Seq.empty + } + + static member Map<'a, 'b>() = { new Arbitrary>() with member x.Generator =