0 people like it.

Fast Fibonacci numbers calculation

This snippet based on Binet's formula combined with fast power algorithm. Four multiplications run in parallel, thus processor with four cores recommended. Bitwise operators improve divisions and multiplications by pow of 2.

 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: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
//Binet's formula F(n) = ( (1 + sqrt(5))^n/2^n) - (1 - sqrt(5))^n/2^n))/sqrt(5)
//(a+b sqrt(5)) <=> (a,b)

type Fpair (a:bigint,b:bigint) =
  //private Map-Reduce functions 
  static let mapReduce arg mappers reducers = 
     //mapping
     let pMap arg mappers = mappers
                                   |> List.map (fun mapper -> async {return arg |> mapper }) 
                                   |> Async.Parallel 
                                   |> Async.RunSynchronously
     //reducing
     let reduce mapResult reducers = reducers |> List.map ((|>) mapResult) 
     
     //map, reduce
     let mapRes = mappers |> pMap arg in          //do parallel mapping first with mappers
     reducers |> reduce mapRes                    //and then reduce with reducers

  member this.a=a
  member this.b=b
  //Alt constructor
  new(L:bigint list) = Fpair(L.Item 0,L.Item 1)

  //Fpair multiplication
  static member (.*) (left:Fpair,right:Fpair) = 
      //make 4 mapping tasks
      let mappers = [ 
                      fun ((l:Fpair), (r:Fpair)) -> let bb = l.b*r.b in bb + (bb <<< 2)
                      fun ((l:Fpair), (r:Fpair)) -> l.a*r.a
                      fun ((l:Fpair), (r:Fpair)) -> l.b*r.a
                      fun ((l:Fpair), (r:Fpair)) -> l.a*r.b
                    ]
      //make 2 reducing tasks
      let reducers = [ 
                       fun (a:bigint array) -> a.[0] + a.[1]
                       fun (a:bigint array) -> a.[2] + a.[3]
                     ]      
      //reduce to new Fpair
      mapReduce (left,right) mappers reducers |> Fpair 

  //square Fpair (a + b sqrt(5))^2 = a^2 + 5b^2 + 2(ab)sqrt(5)
  static member (~+) (arg:Fpair) =
      //make 3 mapping tasks
      let mappers = [ 
                      fun (arg:Fpair) -> let bb = arg.b*arg.b in bb + (bb <<< 2) //5b^2
                      fun (arg:Fpair) -> arg.a*arg.a                             //a^2
                      fun (arg:Fpair) -> arg.a*arg.b <<< 1                       //2ab
                    ]
     
     //make 2 reducing tasks
      let reducers = [ 
                       fun (a:bigint array) -> a.[0] + a.[1]
                       fun (a:bigint array) -> a.[2] 
                     ]   
      //reduce to new Fpair
      mapReduce arg mappers reducers |> Fpair

  //Fpair division by pow of 2
  static member (./) (left:int,right:Fpair) =
    Fpair(right.a >>> left,right.b >>> left)

  //First Fpair 1 + sqrt(5)
  static member one = Fpair(1I,1I)

let fastFib (n:int) =
   let ans = new System.Collections.BitArray([|n|]) 
            |> Seq.cast<bool>                     //convert binary array to seq of booleans
            |> Seq.rev
            |> Seq.skipWhile (fun x -> not x)     //skip all false bits
            |> Seq.skip 1                         //skip one true bit
            |> Seq.fold (
                 fun a x -> if x then             //if true bit
                              + a |> (.*) Fpair.one |> (./) 2   //squaring and then multiplying  
                            else                  //if false bit
                              + a |> (./) 1)                    //only squaring
                 Fpair.one
   ans.b   //second component of Fpair is the result F[n]
Multiple items
type Fpair =
  new : L:bigint list -> Fpair
  new : a:bigint * b:bigint -> Fpair
  member a : bigint
  member b : bigint
  static member one : Fpair
  static member ( ./ ) : left:int * right:Fpair -> Fpair
  static member ( .* ) : left:Fpair * right:Fpair -> Fpair
  static member ( ~+ ) : arg:Fpair -> Fpair

Full name: Script.Fpair

--------------------
new : L:bigint list -> Fpair
new : a:bigint * b:bigint -> Fpair
val a : bigint
type bigint = System.Numerics.BigInteger

Full name: Microsoft.FSharp.Core.bigint
val b : bigint
val mapReduce : ('a -> ('a -> 'b) list -> ('b [] -> 'c) list -> 'c list)
val arg : 'a
val mappers : ('a -> 'b) list
val reducers : ('b [] -> 'c) list
val pMap : ('d -> ('d -> 'e) list -> 'e [])
val arg : 'd
val mappers : ('d -> 'e) list
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member GetSlice : startIndex:int option * endIndex:int option -> 'T list
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
val mapper : ('d -> 'e)
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
Multiple items
type Async
static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
static member AwaitTask : task:Task -> Async<unit>
static member AwaitTask : task:Task<'T> -> Async<'T>
static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
static member CancelDefaultToken : unit -> unit
static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
static member Ignore : computation:Async<'T> -> Async<unit>
static member OnCancel : interruption:(unit -> unit) -> Async<IDisposable>
static member Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
static member Sleep : millisecondsDueTime:int -> Async<unit>
static member Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T>
static member StartChild : computation:Async<'T> * ?millisecondsTimeout:int -> Async<Async<'T>>
static member StartChildAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions -> Async<Task<'T>>
static member StartImmediate : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartWithContinuations : computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken -> unit
static member SwitchToContext : syncContext:SynchronizationContext -> Async<unit>
static member SwitchToNewThread : unit -> Async<unit>
static member SwitchToThreadPool : unit -> Async<unit>
static member TryCancelled : computation:Async<'T> * compensation:(OperationCanceledException -> unit) -> Async<'T>
static member CancellationToken : Async<CancellationToken>
static member DefaultCancellationToken : CancellationToken

Full name: Microsoft.FSharp.Control.Async

--------------------
type Async<'T>

Full name: Microsoft.FSharp.Control.Async<_>
static member Async.Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member Async.RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:System.Threading.CancellationToken -> 'T
val reduce : ('d -> ('d -> 'e) list -> 'e list)
val mapResult : 'd
val reducers : ('d -> 'e) list
val mapRes : 'b []
val this : Fpair
member Fpair.a : bigint

Full name: Script.Fpair.a
member Fpair.b : bigint

Full name: Script.Fpair.b
val L : bigint list
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
property List.Item: int -> bigint
val left : Fpair
val right : Fpair
val mappers : (Fpair * Fpair -> System.Numerics.BigInteger) list
val l : Fpair
val r : Fpair
val bb : System.Numerics.BigInteger
property Fpair.b: bigint
property Fpair.a: bigint
val reducers : (bigint array -> System.Numerics.BigInteger) list
val a : bigint array
type 'T array = 'T []

Full name: Microsoft.FSharp.Core.array<_>
val arg : Fpair
val mappers : (Fpair -> System.Numerics.BigInteger) list
val left : int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
static member Fpair.one : Fpair

Full name: Script.Fpair.one
val fastFib : n:int -> bigint

Full name: Script.fastFib
val n : int
val ans : Fpair
namespace System
namespace System.Collections
Multiple items
type BitArray =
  new : length:int -> BitArray + 5 overloads
  member And : value:BitArray -> BitArray
  member Clone : unit -> obj
  member CopyTo : array:Array * index:int -> unit
  member Count : int
  member Get : index:int -> bool
  member GetEnumerator : unit -> IEnumerator
  member IsReadOnly : bool
  member IsSynchronized : bool
  member Item : int -> bool with get, set
  ...

Full name: System.Collections.BitArray

--------------------
System.Collections.BitArray(length: int) : unit
System.Collections.BitArray(bytes: byte []) : unit
System.Collections.BitArray(values: bool []) : unit
System.Collections.BitArray(values: int []) : unit
System.Collections.BitArray(bits: System.Collections.BitArray) : unit
System.Collections.BitArray(length: int, defaultValue: bool) : unit
module Seq

from Microsoft.FSharp.Collections
val cast : source:System.Collections.IEnumerable -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.cast
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool
val rev : source:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.rev
val skipWhile : predicate:('T -> bool) -> source:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.skipWhile
val x : bool
val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not
val skip : count:int -> source:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.skip
val fold : folder:('State -> 'T -> 'State) -> state:'State -> source:seq<'T> -> 'State

Full name: Microsoft.FSharp.Collections.Seq.fold
val a : Fpair
property Fpair.one: Fpair

More information

Link:http://fssnip.net/7Xd
Posted:5 years ago
Author:Pavel Tatarintsev
Tags: fibonacci , fold , operator overloading , parallel , mapreduce , code reuse