The Computer Language
Benchmarks Game

fannkuch-redux F# .NET Core #6 program

// The Computer Language Benchmarks Game
// http://benchmarksgame.alioth.debian.org/
//
// ported from C# version adding native by Anthony Lloyd

#nowarn "9"

open System
open System.Threading
open Microsoft.FSharp.NativeInterop

[<EntryPoint>]
let main args =
    let n = if args.Length=0 then 7 else int args.[0]
    let fact = Array.zeroCreate (n+1)
    fact.[0] <- 1
    let mutable factn = 1
    for i = 1 to n do
        factn <- factn * i
        Array.set fact i factn

    let inline firstPermutation p pp count idx =
        for i = 0 to n-1 do NativePtr.set p i i
        let rec loop i idx =
            if i>0 then
                let d = idx/Array.get fact i
                NativePtr.set count i d
                loop (i-1) <|
                    if d=0 then idx
                    else
                        for j = 0 to i do
                            NativePtr.get p j
                            |> NativePtr.set pp j
                        for j = 0 to i do
                            NativePtr.get pp ((j+d) % (i+1))
                            |> NativePtr.set p j
                        idx % fact.[i]
        loop (n-1) idx

    let inline nextPermutation p count =
        let mutable first = NativePtr.get p 1
        NativePtr.get p 0 |> NativePtr.set p 1
        NativePtr.set p 0 first
        let mutable i = 1
        while let c =NativePtr.get count i+1 in NativePtr.set count i c; c>i do
            NativePtr.set count i 0
            i <- i+1
            let next = NativePtr.get p 1
            NativePtr.set p 0 next
            for j = 1 to i-1 do NativePtr.get p (j+1) |> NativePtr.set p j
            NativePtr.set p i first
            first <- next
        first

    let inline countFlips first p pp =
        if first=0 then 0
        elif NativePtr.get p first=0 then 1
        else
            for i = 0 to n-1 do NativePtr.get p i |> NativePtr.set pp i
            let rec loop flips first =
                let rec swap lo hi =
                    if lo<hi then
                        let t = NativePtr.get pp lo
                        NativePtr.get pp hi |> NativePtr.set pp lo
                        NativePtr.set pp hi t
                        swap (lo+1) (hi-1)
                swap 1 (first-1)
                let tp = NativePtr.get pp first
                if NativePtr.get pp tp=0 then flips
                else
                    NativePtr.set pp first first
                    loop (flips+1) tp
            loop 2 first

    let chkSums = Array.zeroCreate Environment.ProcessorCount
    let maxFlips = Array.zeroCreate Environment.ProcessorCount

    let run n taskId taskSize =
        use p = fixed &(Array.zeroCreate n).[0]
        use pp = fixed &(Array.zeroCreate n).[0]
        use count = fixed &(Array.zeroCreate n).[0]
        firstPermutation p pp count (taskId*taskSize)
        let rec loop i chksum maxflips =
            if i=0 then chksum, maxflips
            else
                let flips = countFlips (nextPermutation p count) p pp
                loop (i-1) (chksum + (1-(i%2)*2) * flips) (max flips maxflips)
        let flips = countFlips (NativePtr.get p 0) p pp
        let chksum, maxflips = loop (taskSize-1) flips flips
        chkSums.[taskId] <- chksum
        maxFlips.[taskId] <- maxflips

    let taskSize = factn / Environment.ProcessorCount
    let threads = Array.zeroCreate Environment.ProcessorCount

    for i = 1 to Environment.ProcessorCount-1 do
        let thread = Thread(fun () -> run n i taskSize)
        thread.Start()
        threads.[i] <- thread
    run n 0 taskSize

    let rec loop i chksum maxflips =
        if i=threads.Length then chksum, maxflips
        else
            threads.[i].Join()
            loop (i+1) (chksum+chkSums.[i]) (max maxflips maxFlips.[i])
    let chksum, maxflips = loop 1 chkSums.[0] maxFlips.[0]

    string chksum+"\nPfannkuchen("+string n+") = "+string maxflips
    |> stdout.WriteLine

    exit 0
    

NOTES:
64-bit Ubuntu quad core
2.0.2 a04b4bf512
"System.GC.Server": true


Wed, 22 Nov 2017 02:55:36 GMT

MAKE:
cp fannkuchredux.fsharpcore-6.fsharpcore Program.fs
cp Include/fsharpcore/tmp.fsproj .
cp Include/fsharpcore/runtimeconfig.template.json .
mkdir obj
cp Include/fsharpcore/project.assets.json ./obj
cp Include/fsharpcore/tmp.fsproj.nuget.g.props ./obj
cp Include/fsharpcore/tmp.fsproj.nuget.g.targets ./obj
/usr/bin/dotnet build -c Release --no-restore
Microsoft (R) Build Engine version 15.4.8.50001 for .NET Core
Copyright (C) Microsoft Corporation. All rights reserved.

  tmp -> /home/dunham/benchmarksgame_quadcore/fannkuchredux/tmp/bin/Release/netcoreapp2.0/tmp.dll

Build succeeded.
    0 Warning(s)
    0 Error(s)

Time Elapsed 00:00:15.35

18.07s to complete and log all make actions

COMMAND LINE:
/usr/bin/dotnet ./bin/Release/netcoreapp2.0/tmp.dll 12

PROGRAM OUTPUT:
3968050
Pfannkuchen(12) = 65