2 people like it.

An Associative Fold

A prototype of an associative fold operation when the function passed in arguments is a Semigroup(*) Operation. (*) Semigroup from Abstract Algebra.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 

open Microsoft.FSharp.Core 
open System

//Microsoft.FSharp.Core.OptimizedClosures
//https://msdn.microsoft.com/en-us/library/ee340450.aspx

//https://github.com/fsharp/fsharp/blob/master/src/fsharp/FSharp.Core/array.fs#L25
let inline checkNonNull argName arg =  
    match box arg with  
    | null -> nullArg argName  
    | _ -> ()

let inline checkArrayNonZeroLen argName arg =
    match (Array.length arg) with
    | 0 -> failwith (argName + " can't be zero length")
    | _ -> ()

//https://github.com/fsharp/fsharp/blob/master/src/fsharp/FSharp.Core/array.fs#L698
[<CompiledName("MyFold")>] 
let myfold<'T,'State> (f : 'State -> 'T -> 'State) (acc: 'State) (array:'T[]) = 
    checkNonNull "array" array 
    let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) 
    let mutable state = acc  
    let len = array.Length 
    for i = 0 to len - 1 do  
        state <- f.Invoke(state,array.[i]) 
    state 

let xs = [|10; 3; 17; 8; 2; 5; 1; 20; 9|]

printfn "min(%A) = %d" xs (xs |> myfold (fun acc x -> Math.Min(acc, x)) Int32.MaxValue)
printfn "sum(%A) = %d" xs (xs |> myfold (fun acc x -> acc + x) 0)

[<CompiledName("MyFoldAssociative")>]
//f : SemigroupOperation
let myfoldAssociative<'T> (f : 'T -> 'T -> 'T) (array:'T[]) = 
    checkNonNull "array" array
    checkArrayNonZeroLen "array" array
    let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)
    let THRESHOLD = 2 //for demonstration purpose    
    let rec myfoldAssociativeRec (array2:'T[]) =
        let n = Array.length array2
        if (n >= THRESHOLD) then
            let lhs, rhs = array2 |> Array.splitAt (n / 2)
            //divide
            let a = myfoldAssociativeRec lhs //potential parallelism here (*)
            let b = myfoldAssociativeRec rhs //(*)
            //combine
            f.Invoke(a, b)
        else
            let mutable acc = array2.[0]
            for i = 1 to n - 1 do  
                acc <- f.Invoke(acc,array2.[i]) 
            acc
    myfoldAssociativeRec array

printfn "min(%A) = %d" xs (xs |> myfoldAssociative (fun x y -> Math.Min(x, y)))
printfn "sum(%A) = %d" xs (xs |> myfoldAssociative (fun acc x -> acc + x))

(*
    min([|10; 3; 17; 8; 2; 5; 1; 20; 9|]) = 1
    sum([|10; 3; 17; 8; 2; 5; 1; 20; 9|]) = 75
    min([|10; 3; 17; 8; 2; 5; 1; 20; 9|]) = 1
    sum([|10; 3; 17; 8; 2; 5; 1; 20; 9|]) = 75
*)
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Core
namespace System
val checkNonNull : argName:string -> arg:'a -> unit

Full name: Script.checkNonNull
val argName : string
val arg : 'a
val box : value:'T -> obj

Full name: Microsoft.FSharp.Core.Operators.box
val nullArg : argumentName:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.nullArg
val checkArrayNonZeroLen : argName:string -> arg:'a [] -> unit

Full name: Script.checkArrayNonZeroLen
val arg : 'a []
type Array =
  member Clone : unit -> obj
  member CopyTo : array:Array * index:int -> unit + 1 overload
  member GetEnumerator : unit -> IEnumerator
  member GetLength : dimension:int -> int
  member GetLongLength : dimension:int -> int64
  member GetLowerBound : dimension:int -> int
  member GetUpperBound : dimension:int -> int
  member GetValue : [<ParamArray>] indices:int[] -> obj + 7 overloads
  member Initialize : unit -> unit
  member IsFixedSize : bool
  ...

Full name: System.Array
val length : array:'T [] -> int

Full name: Microsoft.FSharp.Collections.Array.length
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
Multiple items
type CompiledNameAttribute =
  inherit Attribute
  new : compiledName:string -> CompiledNameAttribute
  member CompiledName : string

Full name: Microsoft.FSharp.Core.CompiledNameAttribute

--------------------
new : compiledName:string -> CompiledNameAttribute
val myfold : f:('State -> 'T -> 'State) -> acc:'State -> array:'T [] -> 'State

Full name: Script.myfold
val f : ('State -> 'T -> 'State)
val acc : 'State
Multiple items
val array : 'T []

--------------------
type 'T array = 'T []

Full name: Microsoft.FSharp.Core.array<_>
val f : OptimizedClosures.FSharpFunc<'State,'T,'State>
module OptimizedClosures

from Microsoft.FSharp.Core
Multiple items
type FSharpFunc<'T1,'T2,'U> =
  inherit FSharpFunc<'T1,('T2 -> 'U)>
  new : unit -> FSharpFunc<'T1,'T2,'U>
  abstract member Invoke : arg1:'T1 * arg2:'T2 -> 'U
  static member Adapt : func:('T1 -> 'T2 -> 'U) -> FSharpFunc<'T1,'T2,'U>

Full name: Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc<_,_,_>

--------------------
type FSharpFunc<'T1,'T2,'T3,'U> =
  inherit FSharpFunc<'T1,('T2 -> 'T3 -> 'U)>
  new : unit -> FSharpFunc<'T1,'T2,'T3,'U>
  abstract member Invoke : arg1:'T1 * arg2:'T2 * arg3:'T3 -> 'U
  static member Adapt : func:('T1 -> 'T2 -> 'T3 -> 'U) -> FSharpFunc<'T1,'T2,'T3,'U>

Full name: Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc<_,_,_,_>

--------------------
type FSharpFunc<'T1,'T2,'T3,'T4,'U> =
  inherit FSharpFunc<'T1,('T2 -> 'T3 -> 'T4 -> 'U)>
  new : unit -> FSharpFunc<'T1,'T2,'T3,'T4,'U>
  abstract member Invoke : arg1:'T1 * arg2:'T2 * arg3:'T3 * arg4:'T4 -> 'U
  static member Adapt : func:('T1 -> 'T2 -> 'T3 -> 'T4 -> 'U) -> FSharpFunc<'T1,'T2,'T3,'T4,'U>

Full name: Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc<_,_,_,_,_>

--------------------
type FSharpFunc<'T1,'T2,'T3,'T4,'T5,'U> =
  inherit FSharpFunc<'T1,('T2 -> 'T3 -> 'T4 -> 'T5 -> 'U)>
  new : unit -> FSharpFunc<'T1,'T2,'T3,'T4,'T5,'U>
  abstract member Invoke : arg1:'T1 * arg2:'T2 * arg3:'T3 * arg4:'T4 * arg5:'T5 -> 'U
  static member Adapt : func:('T1 -> 'T2 -> 'T3 -> 'T4 -> 'T5 -> 'U) -> FSharpFunc<'T1,'T2,'T3,'T4,'T5,'U>

Full name: Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc<_,_,_,_,_,_>

--------------------
new : unit -> OptimizedClosures.FSharpFunc<'T1,'T2,'U>

--------------------
new : unit -> OptimizedClosures.FSharpFunc<'T1,'T2,'T3,'U>

--------------------
new : unit -> OptimizedClosures.FSharpFunc<'T1,'T2,'T3,'T4,'U>

--------------------
new : unit -> OptimizedClosures.FSharpFunc<'T1,'T2,'T3,'T4,'T5,'U>
val mutable state : 'State
val len : int
property Array.Length: int
val i : int
abstract member FSharpFunc.Invoke : func:'T -> 'U
abstract member OptimizedClosures.FSharpFunc.Invoke : arg1:'T1 * arg2:'T2 -> 'U
val xs : int []

Full name: Script.xs
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val acc : int
val x : int
type Math =
  static val PI : float
  static val E : float
  static member Abs : value:sbyte -> sbyte + 6 overloads
  static member Acos : d:float -> float
  static member Asin : d:float -> float
  static member Atan : d:float -> float
  static member Atan2 : y:float * x:float -> float
  static member BigMul : a:int * b:int -> int64
  static member Ceiling : d:decimal -> decimal + 1 overload
  static member Cos : d:float -> float
  ...

Full name: System.Math
Math.Min(val1: decimal, val2: decimal) : decimal
   (+0 other overloads)
Math.Min(val1: float, val2: float) : float
   (+0 other overloads)
Math.Min(val1: float32, val2: float32) : float32
   (+0 other overloads)
Math.Min(val1: uint64, val2: uint64) : uint64
   (+0 other overloads)
Math.Min(val1: int64, val2: int64) : int64
   (+0 other overloads)
Math.Min(val1: uint32, val2: uint32) : uint32
   (+0 other overloads)
Math.Min(val1: int, val2: int) : int
   (+0 other overloads)
Math.Min(val1: uint16, val2: uint16) : uint16
   (+0 other overloads)
Math.Min(val1: int16, val2: int16) : int16
   (+0 other overloads)
Math.Min(val1: byte, val2: byte) : byte
   (+0 other overloads)
type Int32 =
  struct
    member CompareTo : value:obj -> int + 1 overload
    member Equals : obj:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member GetTypeCode : unit -> TypeCode
    member ToString : unit -> string + 3 overloads
    static val MaxValue : int
    static val MinValue : int
    static member Parse : s:string -> int + 3 overloads
    static member TryParse : s:string * result:int -> bool + 1 overload
  end

Full name: System.Int32
field int.MaxValue = 2147483647
val myfoldAssociative : f:('T -> 'T -> 'T) -> array:'T [] -> 'T

Full name: Script.myfoldAssociative
val f : ('T -> 'T -> 'T)
val f : OptimizedClosures.FSharpFunc<'T,'T,'T>
val THRESHOLD : int
val myfoldAssociativeRec : ('T [] -> 'T)
val array2 : 'T []
val n : int
val lhs : 'T []
val rhs : 'T []
val splitAt : index:int -> array:'T [] -> 'T [] * 'T []

Full name: Microsoft.FSharp.Collections.Array.splitAt
val a : 'T
val b : 'T
val mutable acc : 'T
val y : int
Raw view Test code New version

More information

Link:http://fssnip.net/7OM
Posted:8 years ago
Author:Fabio Galuppo
Tags: fold , folding

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.