The Computer Language
24.09 Benchmarks Game

fannkuch-redux F# .NET #5 program

source code

(* The Computer Language Benchmarks Game
   https://salsa.debian.org/benchmarksgame-team/benchmarksgame/

   - contributed by Vassil Keremidchiev, Otto Bommer's Scala program 
   - modified by Peter Kese
*)

open System.Threading

let F = // factorials up to 20
    let mutable last = int64 1
    let next = function | 0 -> int64 1 | i -> last <- last * (int64 i); last 
    Array.init 21 next

let fannkuch n task chunk =
    let p = Array.init n id
    let pp = Array.create n 0
    let count = Array.create n 0
    let mutable flips = 0
    let mutable cksum = 0

    let rec direct idx i =
        if i > 0 then
            let d = int (idx / F.[i])
            count.[i] <- d
            for j = 0 to d-1 do pp.[j] <- p.[j]
            for j = 0 to i-d do p.[j] <- p.[j+d]
            for j = 0 to d-1 do p.[j+i+1-d] <- pp.[j]
            direct (idx % F.[i]) (i-1)

    let inline permute () =
        let mutable first = p.[1]
        p.[1] <- p.[0]
        p.[0] <- first

        let mutable i = 1
        count.[i] <- count.[i] + 1
        while count.[i] > i do
            count.[i] <- 0
            i <- i + 1
            let next = p.[1]
            p.[0] <- next
            for j = 1 to i-1 do p.[j] <- p.[j+1]
            p.[i] <- first
            first <- next
            count.[i] <- count.[i] + 1

    let inline fcount () =
        let mutable flips = 1
        let mutable first = p.[0]

        if p.[first] <> 0 then
            for i = 0 to n-1 do pp.[i] <- p.[i]

            while pp.[first] <> 0 do
                flips <- flips + 1

                let mutable lo = 1
                let mutable hi = first - 1
                while lo < hi do
                    let t = pp.[lo]
                    pp.[lo] <- pp.[hi]
                    pp.[hi] <- t

                    lo <- lo + 1
                    hi <- hi - 1
                let t = pp.[first]
                pp.[first] <- first
                first <- t
        flips

    let lo = int64(task) * chunk
    let hi = min F.[n] (lo+chunk)

    direct lo (p.Length - 1)

    let last = int(hi - lo - 1L)
    for j = 0 to last do
        if p.[0] <> 0 then
            let f = fcount()
            flips <- max flips f
            cksum <- cksum + if (int64(j)+lo) % 2L = 0L then f else -f
        if j < last then permute()

    (cksum, flips)


let nthreads = System.Environment.ProcessorCount
let n = try int((System.Environment.GetCommandLineArgs()).[1]) with _ -> 7
let split (i:int64) = (F.[n] + i - 1L) / i
let chunk  = split (int64(nthreads * n))
let ntasks = int(split chunk)

let (c, fl) = 
    [0..ntasks] 
        |> Seq.map (fun i -> async { return fannkuch n i chunk } )
        |> Async.Parallel |> Async.RunSynchronously
        |> Array.fold (fun (_cksum, _flips) (cksum, flips) -> (_cksum + cksum, max _flips flips)) (0,0)

printfn "%d\nPfannkuchen(%d) = %d" c n fl
    

notes, command-line, and program output

NOTES:
64-bit Ubuntu quad core
.NET SDK 8.0.301
Host Version: 8.0.6
Commit: 3b8b000a0e
<ServerGarbageCollection>true
F# 8.0

<OutputType>Exe
<TargetFramework>net8.0
<ImplicitUsings>enable
<Nullable>enable
<AllowUnsafeBlocks>true
<ServerGarbageCollection>true
<ConcurrentGarbageCollection>true
<PublishAot>false


 Tue, 04 Jun 2024 04:36:22 GMT

MAKE:
cp fannkuchredux.fsharpcore-5.fsharpcore Program.fs
cp Include/fsharpcore/program.fsproj .
mkdir obj
cp Include/fsharpcore/project.assets.json ./obj
~/dotnet/dotnet build -c Release --use-current-runtime  	
  Determining projects to restore...
/home/dunham/all-benchmarksgame/benchmarksgame_i53330/fannkuchredux/tmp/program.fsproj : warning NU1900: Error occurred while getting package vulnerability data: Unable to load the service index for source https://api.nuget.org/v3/index.json.
  Restored /home/dunham/all-benchmarksgame/benchmarksgame_i53330/fannkuchredux/tmp/program.fsproj (in 6.35 sec).
/home/dunham/all-benchmarksgame/benchmarksgame_i53330/fannkuchredux/tmp/program.fsproj : warning NU1900: Error occurred while getting package vulnerability data: Unable to load the service index for source https://api.nuget.org/v3/index.json.
  program -> /home/dunham/all-benchmarksgame/benchmarksgame_i53330/fannkuchredux/tmp/bin/Release/net8.0/linux-x64/program.dll

Build succeeded.

/home/dunham/all-benchmarksgame/benchmarksgame_i53330/fannkuchredux/tmp/program.fsproj : warning NU1900: Error occurred while getting package vulnerability data: Unable to load the service index for source https://api.nuget.org/v3/index.json.
/home/dunham/all-benchmarksgame/benchmarksgame_i53330/fannkuchredux/tmp/program.fsproj : warning NU1900: Error occurred while getting package vulnerability data: Unable to load the service index for source https://api.nuget.org/v3/index.json.
    2 Warning(s)
    0 Error(s)

Time Elapsed 00:00:14.61

16.76s to complete and log all make actions

COMMAND LINE:
 ./bin/Release/net8.0/linux-x64/program 12

PROGRAM OUTPUT:
3968050
Pfannkuchen(12) = 65