Last active
December 12, 2022 13:01
-
-
Save cloudRoutine/9c62477b91547d9d3523 to your computer and use it in GitHub Desktop.
F# Transducers - they work for the most part
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| open System.Collections.Generic | |
| open Microsoft.FSharp.Collections | |
| [<RequireQualifiedAccess>] | |
| module Folds = | |
| // These are the fast implementations we actually want to use | |
| /// Tail-recursive left fold | |
| let inline foldl (stepfn:'b->'a->'b)(acc:'b)(coll:#seq<'a>) : 'b = | |
| use enumer = coll.GetEnumerator() | |
| let rec loop acc' = | |
| match enumer.MoveNext() with | |
| | false -> acc' | |
| | true -> loop ( stepfn acc' enumer.Current ) | |
| loop acc | |
| let inline foldlpost (stepfn:'b->'a->'b)(postfn:'b->'c)(acc:'b)(coll:#seq<'a>) : 'c = | |
| use enumer = coll.GetEnumerator() | |
| let rec loop acc' = | |
| match enumer.MoveNext() with | |
| | false -> postfn acc' | |
| | true -> loop ( stepfn acc' enumer.Current ) | |
| loop acc | |
| // let inline unfold | |
| // (stepfn)(acc) | |
| // (pred)(mapElm)(inc)(seed) = | |
| // let rec loop acc' state = | |
| // match pred state with | |
| // | false -> acc' | |
| // | true -> loop (stepfn acc' (mapElm state)) (inc state) | |
| // loop acc seed | |
| let inline unfold | |
| (stepfn:'c->'b->'c)(acc:'c) | |
| (pred:'a->bool)(mapElm:'a->'b)(inc:'a->'a)(seed:'a) : 'c = | |
| let rec loop acc' state = | |
| match pred state with | |
| | false -> acc' | |
| | true -> loop (stepfn acc' (mapElm state)) (inc state) | |
| loop acc seed | |
| /// Tail-recursive left unfold | |
| let inline unfoldlsl (pred:'a->bool)(mapElm:'a->'b)(inc:'a->'a)(seed:'a) : 'b list = | |
| let rec loop acc' state = | |
| match pred state with | |
| | false -> acc' | |
| | true -> loop (mapElm state::acc') (inc state) | |
| loop [] seed | |
| let inline unfoldls pred mapElm inc seed = unfoldlsl pred mapElm inc seed |> List.rev | |
| let inline unfoldpost | |
| (stepfn:'c->'b->'c) (acc:'c) | |
| (postfn:'c->'d) | |
| (pred:'a->bool)(mapElm:'a->'b)(inc:'a->'a)(seed:'a): 'd = | |
| let rec loop acc' state = | |
| match pred state with | |
| | false -> postfn acc' | |
| | true -> loop(stepfn acc' (mapElm state)) (inc state) | |
| loop acc seed | |
| // let hyloUnfold h f g = hylo h (f ) (unfold g) | |
| // TODO implement scan | |
| [<RequireQualifiedAccess>] | |
| module Left = | |
| let map ( f :'a->'b ) ( collection:#seq<'a> ) = | |
| foldl ( fun acc elm -> (f elm)::acc) [] collection | |
| let filter (pred:'a -> bool) (collection:#seq<'a>) = | |
| foldl ( fun acc elm -> if pred elm then elm::acc else acc ) [] collection | |
| let collect ( f :'a->'b list ) ( collection:#seq<'a> ) = | |
| let cons xs x = x::xs | |
| foldl ( fun acc elm -> foldl cons acc (f elm)) [] collection | |
| let take num (collection:#seq<'a>) = | |
| match num with | |
| | 0 -> [] | |
| | x when x < 0 -> | |
| invalidArg "num" (sprintf "args for take must be postive, value passed in was %d" num ) | |
| | _ -> | |
| use numer = collection.GetEnumerator() | |
| let rec loop (acc:'a list) (cnt:int) = | |
| match numer.MoveNext(), cnt < num-1 with | |
| | true, true -> loop (numer.Current::acc) (cnt+1) | |
| | _ -> acc | |
| match numer.MoveNext() with | |
| | true -> loop (numer.Current::[]) 0 | |
| | false -> [] | |
| let takeSafe num (collection:#seq<'a>) = | |
| match num with | |
| | x when x <= 0 -> [] | |
| | _ -> | |
| use numer = collection.GetEnumerator() | |
| let rec loop (acc:'a list) (cnt:int) = | |
| match numer.MoveNext(), cnt < num-1 with | |
| | true, true -> loop (numer.Current::acc) (cnt+1) | |
| | _ -> acc | |
| match numer.MoveNext() with | |
| | true -> loop (numer.Current::[]) 0 | |
| | false -> [] | |
| let takeWhile pred (collection:#seq<'a>) = | |
| use numer = collection.GetEnumerator() | |
| let rec loop (acc:'a list) = | |
| match numer.MoveNext(), pred numer.Current with | |
| | true, true -> loop (numer.Current::acc) | |
| | _ -> acc | |
| match numer.MoveNext() with | |
| | true -> loop (numer.Current::[]) | |
| | false -> [] | |
| let skip num (collection:#seq<'a>) = | |
| use numer = collection.GetEnumerator() | |
| let rec takeRest (acc:'a list) = | |
| match numer.MoveNext() with | |
| | true -> takeRest (numer.Current::acc) | |
| | false -> acc | |
| let rec loop (acc:'a list) (cnt:int) = | |
| match numer.MoveNext(), cnt < num-1 with | |
| | true, true -> loop acc (cnt+1) | |
| | _ -> takeRest acc | |
| match numer.MoveNext() with | |
| | true -> loop [] 0 | |
| | false -> [] | |
| let skipWhile pred (collection:#seq<'a>) = | |
| use numer = collection.GetEnumerator() | |
| let rec takeRest (acc:'a list) = | |
| match numer.MoveNext() with | |
| | true -> takeRest (numer.Current::acc) | |
| | false -> acc | |
| let rec loop (acc:'a list) = | |
| match numer.MoveNext(), pred numer.Current with | |
| | true, true -> loop acc | |
| | _ -> takeRest (numer.Current::acc) | |
| match numer.MoveNext() with | |
| | true -> loop [] | |
| | false -> [] | |
| let indexFrom start (collection:#seq<'a>) = | |
| use numer = collection.GetEnumerator() | |
| let rec loop (acc:(int*'a)list) (cnt:int) v = | |
| match numer.MoveNext() with | |
| | true -> loop ((cnt,v)::acc) (cnt+1) (numer.Current) | |
| | false -> (cnt,v)::acc | |
| match numer.MoveNext() with | |
| | true -> loop [] start numer.Current | |
| | false -> [] | |
| let index collection = | |
| indexFrom 0 collection | |
| let partitionAll num (collection:#seq<'a>)= | |
| use numer = collection.GetEnumerator() | |
| let rec addUntil cnt (acc:'a list list) (input:'a) = | |
| match numer.MoveNext() with | |
| | false -> | |
| match acc with | |
| | [] -> [input]::[] | |
| | ahd::atl -> | |
| match cnt < num with | |
| | true -> (input::ahd)::atl | |
| | false -> [input]::(ahd::atl) | |
| | true when cnt < num -> | |
| match acc with | |
| | [] -> addUntil (cnt+1) ([input]::[]) numer.Current | |
| | ahd::atl -> addUntil (cnt+1) ((input::ahd)::atl) numer.Current | |
| | true -> | |
| match acc with | |
| | [] -> [] | |
| | ls -> addUntil 1 ([input]::ls) numer.Current | |
| match numer.MoveNext() with | |
| | true -> addUntil 0 [] numer.Current | |
| | false -> [] | |
| let partition pred (collection:#seq<'a>) = | |
| let sift (accTrue,accFalse) input = | |
| match pred input with | |
| | true -> input::accTrue,accFalse | |
| | false -> accTrue,input::accFalse | |
| foldl sift ([],[]) collection | |
| let private unique (exists:HashSet<_>) hashfn acc input = | |
| match exists.Add (hashfn input) with | |
| | true -> input::acc | |
| | false -> acc | |
| let distinct (collection:#seq<'a>) = | |
| let exists = HashSet<int>() | |
| let unique' acc input = unique exists hash acc input | |
| foldl unique' [] collection | |
| let distinctBy (proj:'a->'key) (collection:#seq<'a>) = | |
| let exists = HashSet<'key>() | |
| let unique' acc input = unique exists proj acc input | |
| foldl unique' [] collection | |
| let distinctFrom (exists:HashSet<int>) (collection:#seq<'a>) = | |
| let unique' acc input = unique exists hash acc input | |
| foldl unique' [] collection | |
| // end of module Left | |
| let map ( f :'a->'b ) ( collection:#seq<'a> ) = | |
| Left.map f collection |> List.rev | |
| let filter (pred:'a -> bool) (collection:#seq<'a>) = | |
| Left.filter pred collection |> List.rev | |
| let collect ( f :'a->'b list ) ( collection:#seq<'a> ) = | |
| Left.collect f collection |> List.rev | |
| let take num (collection:#seq<'a>) = | |
| Left.take num collection |> List.rev | |
| let takeWhile pred (collection:#seq<'a>) = | |
| Left.takeWhile pred collection |> List.rev | |
| let skip num (collection:#seq<'a>) = | |
| Left.skip num collection |> List.rev | |
| let skipWhile pred (collection:#seq<'a>) = | |
| Left.skipWhile pred collection |> List.rev | |
| let index (collection:#seq<'a>) = | |
| Left.index collection |> List.rev | |
| let indexFrom start (collection:#seq<'a>) = | |
| Left.indexFrom start collection |> List.rev | |
| let partition pred (collection:#seq<'a>) = | |
| let accTrue,accFalse = Left.partition pred collection | |
| accTrue |> List.rev, accFalse |> List.rev | |
| let partitionAll num (collection:#seq<'a>)= | |
| use numer = collection.GetEnumerator() | |
| let rec addUntil cnt (acc:'a list list) (input:'a) = | |
| match numer.MoveNext() with | |
| | false -> | |
| match acc with | |
| | [] -> [input]::[] | |
| | hd::tl -> | |
| match cnt < num with | |
| | true -> (input::hd|>List.rev)::tl | |
| | false -> [input]::((hd|>List.rev)::tl) | |
| | true when cnt < num -> | |
| match acc with | |
| | [] -> addUntil (cnt+1) ([input]::[]) numer.Current | |
| | hd::tl -> addUntil (cnt+1) ((input::hd)::tl) numer.Current | |
| | true -> | |
| match acc with | |
| | [] -> [] | |
| | hd::tl -> addUntil 1 ([input]::((hd|>List.rev)::tl)) numer.Current | |
| match numer.MoveNext() with | |
| | true -> addUntil 0 [] numer.Current | |
| | false -> [] | |
| |> List.rev | |
| let distinct (collection:#seq<'a>) = | |
| Left.distinct collection |> List.rev | |
| let distinctBy (proj:'a->'key) (collection:#seq<'a>) = | |
| Left.distinctBy proj collection |> List.rev | |
| let distinctFrom (exists:HashSet<int>) (collection:#seq<'a>) = | |
| Left.distinctFrom exists collection |> List.rev | |
| let inline private findWith func acc input = | |
| match acc with | |
| | Some x -> Some (func x input) | |
| | None -> Some input | |
| let inline private optLoop func (collection:#seq<'a>) = | |
| use numer = collection.GetEnumerator() | |
| let rec loop acc input = | |
| match numer.MoveNext() with | |
| | true -> loop (func acc input) (numer.Current) | |
| | false -> func acc input | |
| match numer.MoveNext() with | |
| | true -> loop None numer.Current | |
| | false -> None | |
| let minOption (collection:#seq<'a>) = | |
| optLoop (findWith min) collection | |
| let maxOption (collection:#seq<'a>) = | |
| optLoop (findWith max) collection | |
| let inline sumOption (collection:#seq< ^T> when ^T : (static member (+) : ^T * ^T -> ^T)) = | |
| optLoop (findWith (+)) collection | |
| let inline avgOption (collection:#seq<'T> when ^T : (static member (+) : ^T * ^T -> ^T)) : float option = | |
| if Option.isNone (sumOption collection) then None else | |
| float (sumOption collection).Value / float (Seq.length collection) |> Some |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| open System | |
| open Microsoft.FSharp.Collections | |
| open Microsoft.FSharp.Core.Printf | |
| open System.Collections.Generic | |
| open System.Collections.Concurrent | |
| open Fusion | |
| [<AutoOpen>] | |
| module Core = | |
| type Transducer<'a,'b> = | |
| /// partial application is the key to the functionality of a transducer | |
| /// transform should take a step function as its argument without and acc | |
| /// or input and then used by a fold or an unfold | |
| abstract transform<'r> : stepfn: ('r->'b->'r) -> acc:'r -> input:'a -> 'r | |
| // TODO Add another member to transducers that transforms the postfn on | |
| // a foldpost | |
| // OR another abstract type STateful transducer, that implements transducer | |
| /// When transducers are composed using this function t1 | |
| /// will execute before t2 | |
| let inline compose (t1:Transducer<'a,'b>) (t2:Transducer<'b,'c>) = | |
| { new Transducer<'a,'c> with | |
| member __.transform stepfn acc input = | |
| ( t2.transform >> t1.transform ) stepfn acc input | |
| } | |
| /// Comp should be used if transducers are being composed in a | |
| /// pipeline with `|>` The transducers will execute from top to | |
| /// bottom | |
| let inline comp (t1:Transducer<_,_>) (t2:Transducer<_,_>) = | |
| compose t2 t1 | |
| /// Forward composition operator | |
| /// When transducers are composed using this operator the left transducer | |
| /// will execute first | |
| let inline (|>>) xf1 xf2 = compose xf1 xf2 | |
| /// When transducers are composed using this operator the right transducer | |
| /// will execute first | |
| let inline (<<|) xf1 xf2 = comp xf1 xf2 | |
| type FoldArgs<'a,'b> = | |
| abstract StepFn : ('b->'a->'b) | |
| abstract Acc : 'b | |
| let inline (|&>) (xf:Transducer<_,_>)(fld:FoldArgs<_,_>) = | |
| { new FoldArgs<_,_> with | |
| member __.StepFn = xf.transform fld.StepFn | |
| member __.Acc = [] | |
| } | |
| let inline (<&|) (fld:FoldArgs<_,_>)(xf:Transducer<_,_>) = | |
| { new FoldArgs<_,_> with | |
| member __.StepFn = xf.transform fld.StepFn | |
| member __.Acc = [] | |
| } | |
| let inline consfn xs x = x::xs | |
| let foldList = | |
| { new FoldArgs<_,_> with | |
| member __.StepFn = consfn | |
| member __.Acc = [] | |
| } | |
| type UnfoldArgs<'a,'b,'c,'d> = | |
| abstract StepFn : ('c->'d->'c) | |
| abstract Acc : 'c | |
| abstract Pred : ('a->bool) | |
| abstract MapElm : ('a->'b) | |
| abstract Inc : ('a->'a) | |
| let inline (|~>) (xf:Transducer<_,_>)(uf:UnfoldArgs<_,_,_,_>) = | |
| { new UnfoldArgs<_,_,_,_> with | |
| member __.StepFn = xf.transform uf.StepFn | |
| member __.Acc = [] | |
| member __.Pred = uf.Pred | |
| member __.MapElm = uf.MapElm | |
| member __.Inc = uf.Inc | |
| } | |
| let inline (<~|) (uf:UnfoldArgs<_,_,_,_>)(xf:Transducer<_,_>) = | |
| { new UnfoldArgs<_,_,_,_> with | |
| member __.StepFn = xf.transform uf.StepFn | |
| member __.Acc = [] | |
| member __.Pred = uf.Pred | |
| member __.MapElm = uf.MapElm | |
| member __.Inc = uf.Inc | |
| } | |
| let inline concat = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| Folds.foldl stepfn acc input | |
| } | |
| let inline collect (func:'a -> #seq<'c>) = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| Folds.foldl stepfn acc (func input) | |
| } | |
| let inline map (func:'a->'b) = | |
| { new Transducer<_,_> with | |
| member __.transform (stepfn:'c->'b->'c) (acc:'c) (input:'a) = | |
| stepfn acc ( func input ) | |
| } | |
| let inline filter pred = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match pred input with | |
| | true -> stepfn acc input | |
| | false -> acc | |
| } | |
| let filterMap (pred:'a -> bool) mapfn = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match pred input with | |
| | true -> stepfn acc (mapfn input) | |
| | false -> acc | |
| } | |
| let filterMapAlt pred funcTrue funcFalse = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match pred input with | |
| | true -> stepfn acc ( funcTrue input ) | |
| | false -> stepfn acc ( funcFalse input ) | |
| } | |
| let mapWhen2 pred1 pred2 mapfn1 mapfn2 = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match pred1 input, pred2 input with | |
| | true, _ -> stepfn acc ( mapfn1 input ) | |
| | _ ,true -> stepfn acc ( mapfn2 input ) | |
| | _ , _ -> acc | |
| } | |
| let choose() = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match Option.isSome input with | |
| | true -> stepfn acc input.Value | |
| | false -> acc | |
| } | |
| /// take throws an invalid argument exception on negative input values | |
| let take num = | |
| let count = ref 0 | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match num with | |
| | x when x < 0 -> | |
| invalidArg "num" (sprintf "args for take must be postive, value passed in was %d" num ) | |
| | 0 -> acc | |
| | _ -> | |
| match !count < num with | |
| | true -> incr count | |
| stepfn acc input | |
| | false -> acc | |
| } | |
| /// negative input value is the same as "take 0" | |
| let takeSafe num = | |
| let count = ref 0 | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match num with | |
| | x when x <= 0 -> acc | |
| | _ -> | |
| match !count < num with | |
| | true -> incr count | |
| stepfn acc input | |
| | false -> acc | |
| } | |
| let takeWhile (pred:'a -> bool) = | |
| let taking = ref true | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| taking := pred input | |
| match !taking with | |
| | true -> stepfn acc input | |
| | false -> acc } | |
| let skip num = | |
| let count = ref 0 | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match num with | |
| | x when x < 0 -> | |
| invalidArg "num" (sprintf "args for skip must be postive, value passed in was %d" num ) | |
| | 0 -> stepfn acc input | |
| | _ -> | |
| match !count >= num with | |
| | true -> stepfn acc input | |
| | false -> incr count | |
| acc } | |
| let skipSafe num = | |
| let count = ref 0 | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match num with | |
| | x when x <= 0 -> stepfn acc input | |
| | _ -> | |
| match !count >= num with | |
| | true -> stepfn acc input | |
| | false -> incr count | |
| acc } | |
| let skipWhile (pred:'a -> bool) = | |
| let skipping = ref true | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| skipping := pred input | |
| match !skipping with | |
| | true -> acc | |
| | false -> stepfn acc input } | |
| let inline slice start finish = | |
| let start' = start-1 | |
| let takeNum = if finish < start' then 0 else finish - start' | |
| let sc = ref 0 // skip count | |
| let tc = ref 0 // take count | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match !sc < start' with | |
| | true -> incr sc; acc | |
| | false -> | |
| match !tc < takeNum with | |
| | true -> incr tc; stepfn acc input | |
| | false -> acc } | |
| let index() = | |
| let counter = ref 0 | |
| let inc (cnt:int ref) input = | |
| let idx = !cnt | |
| incr cnt | |
| idx,input | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc (inc counter input) } | |
| /// Stateful version of index that can execute across a transduction | |
| let indexFrom (start:int) = | |
| let counter = ref start | |
| let inc (cnt:int ref) input = | |
| let idx = !cnt | |
| incr cnt | |
| idx,input | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc (inc counter input) } | |
| /// Stateful version of distinct that can operate across a reduction | |
| /// Should only be used inside of a function that returns a transducer | |
| // distinctS needs to return a transducer due to the value restriction | |
| let inline distinct() = | |
| let exists = HashSet<int>() | |
| let dedupe (input:'a) = | |
| exists.Add (hash input) | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match dedupe input with | |
| | true -> stepfn acc input | |
| | false -> acc } | |
| /// Should only be used inside of a function that returns a transducer | |
| let distinctBy (proj:'a -> 'key) = | |
| let exists = HashSet<'key>() | |
| let dedupe (input:'a) = | |
| exists.Add (proj input) | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match dedupe input with | |
| | true -> stepfn acc input | |
| | false -> acc } | |
| /// Should only be used inside of a function that returns a transducer | |
| let distinctFrom (other:HashSet<int>) = | |
| let exists = HashSet(other) | |
| let dedupe (input:'a) = | |
| exists.Add (hash input) | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| match dedupe input with | |
| | true -> stepfn acc input | |
| | false -> acc } | |
| // TODO - Implement the metamorphism version of Quicksort | |
| /// Create an empty hashset for storing hashes for distinction comparison | |
| let idSet() = HashSet<int>() | |
| let inline logf (msg) = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc (printf msg input; input) } | |
| let inline logfn (msg) = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc (printfn msg input; input) } | |
| // Ninja Logging Operators | |
| let inline ( !?! ) t1 = | |
| (logf ("\n| %A |")) |>> t1 |>> ( logf( "==> %A " )) | |
| let inline ( |?> ) t1 t2 = | |
| t1 |>> ( t2 |>> ( logf( "==> %A " ))) | |
| let inline ( <?| ) t2 t1 = | |
| (logf (" %A =")) <<| t2 <<| (logf ("=> %A ")) <<| t1 | |
| [<AutoOpen>] | |
| module CoreExtensions = | |
| type Transducer<'b,'c> with | |
| member self.Fold stepfn acc = | |
| Folds.foldl (self.transform stepfn) acc | |
| member self.Unfold stepfn (acc:'c) pred mapElm inc : 'a -> 'c = | |
| Folds.unfold (self.transform stepfn) acc pred mapElm inc |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| open System.Collections.Generic | |
| [<RequireQualifiedAccess>] | |
| module XCol = | |
| let map mapfn = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.map mapfn input ) | |
| } | |
| let filter pred = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.filter pred input ) | |
| } | |
| let collect (proj:'a -> 'b list) = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| Folds.foldl stepfn acc ( Folds.map proj input ) | |
| } | |
| /// take the first 'num' elements from a sequence inside a transduction | |
| let take num = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.take num input ) | |
| } | |
| let takeWhile pred = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.takeWhile pred input ) | |
| } | |
| let skip num = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.skip num input ) | |
| } | |
| let skipWhile pred = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.skipWhile pred input ) | |
| } | |
| let index() = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.index input ) | |
| } | |
| let indexFrom start = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.indexFrom start input ) | |
| } | |
| let partition pred = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.partition pred input ) | |
| } | |
| let partitionAll num = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.partitionAll num input ) | |
| } | |
| let distinct() = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.distinct input ) | |
| } | |
| let distinctBy proj = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.distinctBy proj input ) | |
| } | |
| let distinctFrom (exists:HashSet<int>) = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.distinctFrom exists input ) | |
| } | |
| let minOption() = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.minOption input ) | |
| } | |
| let maxOption() = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.maxOption input ) | |
| } | |
| let avgOption() = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.avgOption input ) | |
| } | |
| let sumOption() = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.sumOption input ) | |
| } | |
| let head() = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Seq.head input) | |
| } | |
| let last() = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Seq.last input) | |
| } | |
| let reduce redux = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Seq.reduce redux input) | |
| } | |
| let windowed size = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Seq.windowed size input) | |
| } | |
| let scan folder state = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Seq.scan folder state input) | |
| } | |
| let slice start finish = | |
| let start' = start-1 | |
| let takeNum = if finish < start' then 0 else finish - start' | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc | |
| ( Folds.skip start' input | |
| |> Folds.take takeNum ) | |
| } | |
| let compareWith comparer = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( let s1,s2 = input | |
| Seq.compareWith comparer s1 s2 ) | |
| } | |
| let contains pred = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Seq.exists pred input) | |
| } | |
| let groupBy projection = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Seq.groupBy projection input) | |
| } | |
| let iterOver func = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Seq.iter func input; input ) | |
| } | |
| [<RequireQualifiedAccess>] | |
| module Left = | |
| /// take the first 'num' elements from a sequence inside a transduction | |
| let take num = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.Left.take num input ) | |
| } | |
| let takeWhile pred = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.Left.takeWhile pred input ) | |
| } | |
| let skip num = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.Left.skip num input ) | |
| } | |
| let skipWhile pred = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.Left.skipWhile pred input ) | |
| } | |
| let index() = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.Left.indexFrom 0 input ) | |
| } | |
| let indexFrom start = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.Left.indexFrom start input) | |
| } | |
| let partition pred = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.Left.partition pred input ) | |
| } | |
| let partitionAll num = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.Left.partitionAll num input ) | |
| } | |
| let distinct() = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.Left.distinct input ) | |
| } | |
| let distinctBy proj = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.Left.distinctBy proj input ) | |
| } | |
| let distinctFrom (exists:HashSet<int>) = | |
| { new Transducer<_,_> with | |
| member __.transform stepfn acc input = | |
| stepfn acc ( Folds.Left.distinctFrom exists input ) | |
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| open System.Collections | |
| open System.Collections.Generic | |
| open System.Collections.Concurrent | |
| [<AutoOpen>] | |
| module Collections = | |
| // Pour the transducer into a particular form | |
| let inline private consfn xs x = x::xs | |
| let inline intoList2 (tdx:Transducer<'a,'b>) (collection:#seq<'a>) = | |
| consfn |> tdx.transform |> Folds.foldl |> fun fld -> fld [] collection | |
| //Folds.foldl (tdx.transform consReduc) [] collection |> List.rev | |
| let inline intoList (tdx:Transducer<'a,'b>) (collection:#seq<'a>) = | |
| Folds.foldl (tdx.transform consfn) [] collection |> List.rev | |
| let inline intoArray (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| collection |> intoList tdx |> Array.ofList | |
| let inline intoSeq (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| collection |> intoList tdx :> seq<_> | |
| type GenericList<'a> = System.Collections.Generic.List<'a> | |
| let inline intoGenericList (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| GenericList<_>( intoList tdx collection ) | |
| let inline intoLinkedList (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| LinkedList( intoList tdx collection ) | |
| let inline intoMap (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| let addelem (map:Map<_,_>) input = map.Add input | |
| Folds.foldl (tdx.transform addelem) (Map<_,_>([])) collection | |
| let inline intoSet (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| let addelem (set:Set<_>) input = set.Add input | |
| Folds.foldl (tdx.transform addelem) (Set<_>([])) collection | |
| let inline intoHashSet (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| let addelem (hs:HashSet<_>) input = hs.Add input |> ignore; hs | |
| Folds.foldl (tdx.transform addelem) (HashSet<_>()) collection | |
| type Dictionary<'K,'V> with | |
| member self.TryAdd(key,value) : bool = | |
| try self.Add(key,value); true | |
| with | _ -> false | |
| let inline intoDictionary (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| let addelem (dict:Dictionary<_,_>) input = dict.TryAdd input |> ignore; dict | |
| Folds.foldl (tdx.transform addelem) (Dictionary<_,_>()) collection | |
| let inline intoQueue (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| Queue<_>(intoList tdx collection) | |
| let inline intoStack (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| Stack<_>(intoList tdx collection) | |
| let inline intoConcurrentDictionary (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| let addelem (dict:ConcurrentDictionary<_,_>) input = dict.TryAdd input |> ignore; dict | |
| Folds.foldl (tdx.transform addelem) (ConcurrentDictionary<_,_>()) collection | |
| let inline intoConcurrentQueue (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| ConcurrentQueue<_>(intoList tdx collection) | |
| let inline intoConcurrentStack (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| ConcurrentStack<_>(intoList tdx collection) | |
| let inline intoConcurrentBag (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| ConcurrentBag<_>(intoList tdx collection) | |
| // need to change to transform.into (to:list, tdx:transducer, from:#seq<_> ) | |
| type transduce = | |
| static member inline into (tdx:Transducer<_,_> , list: _ list ) = intoList tdx list | |
| static member inline into (tdx:Transducer<_,_> , list: _ [] ) = intoArray tdx list | |
| static member inline into (tdx:Transducer<_,_> , seqs:seq<_> ) = intoSeq tdx seqs | |
| static member inline into (tdx:Transducer<_,_> , list:GenericList<_> ) = intoGenericList tdx list | |
| static member inline into (tdx:Transducer<_,_> , list:LinkedList<_> ) = intoLinkedList tdx list | |
| static member inline into (tdx:Transducer<_,_> , hashset:HashSet<_> ) = intoHashSet tdx hashset | |
| static member inline into (tdx:Transducer<_,_> , map:Map<_,_> ) = intoMap tdx map | |
| static member inline into (tdx:Transducer<_,_> , set:Set<_> ) = intoSet tdx set | |
| static member inline into (tdx:Transducer<_,_> , dict:Dictionary<_,_> ) = intoDictionary tdx dict | |
| static member inline into (tdx:Transducer<_,_> , queue:Queue<_> ) = intoQueue tdx queue | |
| static member inline into (tdx:Transducer<_,_> , stack:Stack<_> ) = intoStack tdx stack | |
| static member inline into (tdx:Transducer<_,_> , dict:ConcurrentDictionary<_,_>) = intoConcurrentDictionary tdx dict | |
| static member inline into (tdx:Transducer<_,_> , queue:ConcurrentQueue<_> ) = intoConcurrentQueue tdx queue | |
| static member inline into (tdx:Transducer<_,_> , stack:ConcurrentStack<_> ) = intoConcurrentStack tdx stack | |
| static member inline into (tdx:Transducer<_,_> , bag:ConcurrentBag<_> ) = intoConcurrentBag tdx bag | |
| [<RequireQualifiedAccess>] | |
| module Left = | |
| // Pour the transducer into a particular form | |
| let inline private consReduc xs x = x::xs | |
| let inline intoList (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| Folds.foldl (tdx.transform consReduc) [] collection | |
| let inline intoArray (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| collection |> intoList tdx |> Array.ofList | |
| let inline intoSeq (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| collection |> intoList tdx :> seq<_> | |
| let inline intoGenericList (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| System.Collections.Generic.List<_>( intoList tdx collection ) | |
| let inline intoLinkedList (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| LinkedList( intoList tdx collection ) | |
| let inline intoQueue (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| Queue<_>(intoList tdx collection) | |
| let inline intoStack (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| Stack<_>(intoList tdx collection) | |
| let inline intoConcurrentQueue (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| ConcurrentQueue<_>(intoList tdx collection) | |
| let inline intoConcurrentStack (tdx:Transducer<_,_>) (collection:#seq<_>) = | |
| ConcurrentStack<_>(intoList tdx collection) | |
| // need to change to transform.into (to:list, tdx:transducer, from:#seq<_> ) | |
| type transduce = | |
| static member inline into (tdx:Transducer<_,_> , list: _ list ) = intoList tdx list | |
| static member inline into (tdx:Transducer<_,_> , list: _ [] ) = intoArray tdx list | |
| static member inline into (tdx:Transducer<_,_> , seqs:seq<_> ) = intoSeq tdx seqs | |
| static member inline into (tdx:Transducer<_,_> , list:GenericList<_> ) = intoGenericList tdx list | |
| static member inline into (tdx:Transducer<_,_> , list:LinkedList<_> ) = intoLinkedList tdx list | |
| static member inline into (tdx:Transducer<_,_> , queue:Queue<_> ) = intoQueue tdx queue | |
| static member inline into (tdx:Transducer<_,_> , stack:Stack<_> ) = intoStack tdx stack | |
| static member inline into (tdx:Transducer<_,_> , queue:ConcurrentQueue<_> ) = intoConcurrentQueue tdx queue | |
| static member inline into (tdx:Transducer<_,_> , stack:ConcurrentStack<_> ) = intoConcurrentStack tdx stack |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| open System | |
| open System.Collections | |
| open System.Collections.Generic | |
| open System.Collections.Concurrent | |
| open Microsoft.FSharp.Collections | |
| open Microsoft.FSharp.Control | |
| open System.Runtime.CompilerServices | |
| [<RequireQualifiedAccess>] | |
| module Seq = | |
| let inline transduce (tdz:Transducer<_,_>) (collection:#seq<_>) = | |
| intoSeq tdz collection | |
| let inline transduceL (tdz:Transducer<_,_>) (collection:#seq<_>) = | |
| Left.intoSeq tdz collection | |
| module Extensions = | |
| type List<'a> with | |
| /// Execute a trasduction across a list from the end to the start | |
| static member inline TransduceL (tdz:Transducer<_,_>) (ls:'a list) = | |
| Left.intoList tdz ls | |
| /// Execute a trasduction across this list from the end to the start | |
| member inline self.transduceL (tdz:Transducer<_,_>) = | |
| Left.intoList tdz self | |
| /// Execute a trasduction across this list from the start to the end | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoList tdz self | |
| /// Execute a trasduction across a list from the end to the start | |
| static member inline Transduce (tdz:Transducer<_,_>) (ls:'a list) = | |
| intoList tdz ls | |
| type IEnumerable<'a> with | |
| member inline self.transduceL (tdz:Transducer<_,_>) = | |
| Left.intoList tdz self :> seq<_> | |
| /// Execute a trasduction across this list from the start to the end | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoList tdz self :> seq<_> | |
| type System.Collections.Generic.List<'T> with | |
| static member inline TransduceL (tdz:Transducer<_,_>) | |
| (ls:System.Collections.Generic.List<'T>) = | |
| Left.intoGenericList tdz ls | |
| member inline self.transduceL (tdz:Transducer<_,_>) = | |
| Left.intoGenericList tdz self | |
| /// Execute a trasduction across this list from the start to the end | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoGenericList tdz self | |
| /// Execute a trasduction across a list from the end to the start | |
| static member inline Transduce (tdz:Transducer<_,_>) | |
| (ls:System.Collections.Generic.List<_>) = | |
| intoGenericList tdz ls | |
| type LinkedList<'T> with | |
| static member inline Transduce (tdz:Transducer<_,_>) (linkls:LinkedList<'T>) = | |
| intoLinkedList tdz linkls | |
| static member inline TransduceL (tdz:Transducer<_,_>) (linkls:LinkedList<'T>) = | |
| Left.intoLinkedList tdz linkls | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoLinkedList tdz self | |
| member inline self.transduceL (tdz:Transducer<_,_>) = | |
| Left.intoLinkedList tdz self | |
| type ``[]``<'a> with | |
| /// Execute a trasduction across an array from the end to the start | |
| static member inline TransduceL (tdz:Transducer<_,_>) (arr:'a []) = | |
| Left.intoArray tdz arr | |
| /// Execute a trasduction across this array from the end to the start | |
| member inline self.transduceL (tdz:Transducer<_,_>) = | |
| Left.intoArray tdz self | |
| /// Execute a trasduction across this array from the start to the end | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoArray tdz self | |
| /// Execute a trasduction across an array from the start to the end | |
| static member inline Transduce (tdz:Transducer<_,_>) (arr:'a []) = | |
| intoArray tdz arr | |
| type HashSet<'a> with | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoHashSet tdz self | |
| static member inline Transduce (tdz:Transducer<_,_>) (hashset:HashSet<_>) = | |
| intoHashSet tdz hashset | |
| type Dictionary<'K,'V> with | |
| static member inline Transduce (tdz:Transducer<_,_>) (dict:Dictionary<_,_>) = | |
| intoDictionary tdz dict | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoDictionary tdz self | |
| type Map<'Key, 'Value when 'Key : comparison> with | |
| static member inline Transduce (tdz:Transducer<_,_>) (map:Map<_,_>) = | |
| intoMap tdz map | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoMap tdz self | |
| type Set<'a when 'a : comparison> with | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoSet tdz self | |
| static member inline Transduce (tdz:Transducer<_,_>) (set:Set<_>) = | |
| intoSet tdz set | |
| type Queue<'T> with | |
| static member inline Transduce (tdz:Transducer<_,_>) (queue:Queue<'T>) = | |
| intoQueue tdz queue | |
| static member inline TransduceL (tdz:Transducer<_,_>) (queue:Queue<'T>) = | |
| Left.intoQueue tdz queue | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoQueue tdz self | |
| member inline self.transduceL (tdz:Transducer<_,_>) = | |
| Left.intoQueue tdz self | |
| type Stack<'T> with | |
| static member inline Transduce (tdz:Transducer<_,_>) (stack:Stack<'T>) = | |
| intoStack tdz stack | |
| static member inline TransduceL (tdz:Transducer<_,_>) (stack:Stack<'T>) = | |
| Left.intoStack tdz stack | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoStack tdz self | |
| member inline self.transduceL (tdz:Transducer<_,_>) = | |
| Left.intoStack tdz self | |
| type ConcurrentDictionary<'K,'V> with | |
| static member inline Transduce (tdz:Transducer<_,_>) (dict:ConcurrentDictionary<_,_>) = | |
| intoConcurrentDictionary tdz dict | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoConcurrentDictionary tdz self | |
| type ConcurrentBag<'T> with | |
| static member inline Transduce (tdz:Transducer<_,_>) (bag:ConcurrentBag<_>) = | |
| intoConcurrentBag tdz bag | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoConcurrentBag tdz self | |
| type ConcurrentQueue<'T> with | |
| static member inline Transduce (tdz:Transducer<_,_>) (queue:ConcurrentQueue<'T>) = | |
| intoConcurrentQueue tdz queue | |
| static member inline TransduceL (tdz:Transducer<_,_>) (queue:ConcurrentQueue<'T>) = | |
| Left.intoConcurrentQueue tdz queue | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoConcurrentQueue tdz self | |
| member inline self.transduceL (tdz:Transducer<_,_>) = | |
| Left.intoConcurrentQueue tdz self | |
| type ConcurrentStack<'T> with | |
| static member inline Transduce (tdz:Transducer<_,_>) (stack:ConcurrentStack<'T>) = | |
| intoConcurrentStack tdz stack | |
| static member inline TransduceL (tdz:Transducer<_,_>) (stack:ConcurrentStack<'T>) = | |
| Left.intoConcurrentStack tdz stack | |
| member inline self.transduce (tdz:Transducer<_,_>) = | |
| intoConcurrentStack tdz self | |
| member inline self.transduceL (tdz:Transducer<_,_>) = | |
| Left.intoConcurrentStack tdz self |
Is there some transducer implementation as a consumable NuGet library for F#?
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Interested in making this a library?