F# Benchmarking: Folders structure walked in parallel

Folders.fsproj

<Project Sdk="Microsoft.NET.Sdk">

  <PropertyGroup>
    <OutputType>Exe</OutputType>
    <TargetFramework>netcoreapp3.1</TargetFramework>
  </PropertyGroup>

  <ItemGroup>
    <Compile Include="Program.fs" />
  </ItemGroup>

  <ItemGroup>
    <PackageReference Include="BenchmarkDotNet" Version="0.12.1" />
    <PackageReference Include="Hopac" Version="0.4.1" />
  </ItemGroup>

</Project>

Program.fs

open System
open System.Threading.Tasks
open System.IO
open System.Linq
open System.Collections.Concurrent
open BenchmarkDotNet.Attributes
open BenchmarkDotNet.Running
open BenchmarkDotNet.Order
open Hopac

type IOError =
    | Unkwnown of IOException
    | UnauthorizedAccess of UnauthorizedAccessException
    | InvalidPath of ArgumentException
    | NullPath of ArgumentNullException
    | PathTooLong of PathTooLongException
    | DirectoryNotFound of DirectoryNotFoundException

[<Struct>]
type ReadFiles =
    | ReadFiles of files: string []
    | FilesError of error: IOError

[<Struct>]
type ReadDirectories =
    | ReadDirectories of dirs: string []
    | DirectoriesError of error: IOError

let readIO success error getter path =
    try
        success <| getter path
    with
        | :? UnauthorizedAccessException as ex -> error <| UnauthorizedAccess ex
        | :? ArgumentNullException       as ex -> error <| NullPath ex
        | :? ArgumentException           as ex -> error <| InvalidPath ex
        | :? PathTooLongException        as ex -> error <| PathTooLong ex
        | :? DirectoryNotFoundException  as ex -> error <| DirectoryNotFound ex
        | :? IOException                 as ex -> error <| Unkwnown ex    

let readFiles = readIO ReadFiles FilesError (fun path -> Directory.GetFiles path)
let readDirectories = readIO ReadDirectories DirectoriesError (fun path -> Directory.GetDirectories path)

let maxDepth = Math.Log (float Environment.ProcessorCount, 2.) + 4. |> int

let rec traverseSync path =
    let files = readFiles path
    match readDirectories path with
    | DirectoriesError _ ->
        [(path, files)]
    | ReadDirectories dirs ->
        match dirs with
        | [||] -> 
            [(path, files)]
        | directories -> 
            directories
            |> Array.fold
                (fun res cur -> res @ traverseSync cur) []

// CPS (Continuation passing style) version
let rec traverseSyncCPS onGetFiles path =
    match readFiles path with
    | ReadFiles files -> onGetFiles path files
    | FilesError _ -> onGetFiles path [||]

    match readDirectories path with
    | DirectoriesError _ -> ()
    | ReadDirectories dirs ->
        match dirs with
        | [||] -> ()
        | directories -> 
            directories
            |> Array.iter
                (fun cur -> traverseSyncCPS onGetFiles cur)

let rec traversePLINQ path =
    let files = readFiles path
    match readDirectories path with
    | DirectoriesError _ ->
        []
    | ReadDirectories dirs ->
        match dirs with
        | [||] -> 
            [(path, files)]
        | directories -> 
            directories
                .AsParallel()
                .Select(fun dir -> traversePLINQ dir)
                .Aggregate([], fun res cur -> res @ cur)

let rec traversePLINQPartitioner path =
    let files = readFiles path
    match readDirectories path with
    | DirectoriesError _ ->
        []
    | ReadDirectories dirs ->
        match dirs with
        | [||] -> 
            [(path, files)]
        | directories ->
            Partitioner.Create(directories, true)
                .AsParallel()
                .WithExecutionMode(ParallelExecutionMode.ForceParallelism)
                .Select(fun dir -> traversePLINQPartitioner dir)
                .Aggregate([], fun res cur -> res @ cur)

let rec traverseTask onGetFiles path =
    match readFiles path with
    | ReadFiles files -> onGetFiles path files
    | FilesError _ -> onGetFiles path [||]

    match readDirectories path with
    | DirectoriesError _ -> 
        Task.CompletedTask
    | ReadDirectories dirs ->
        match dirs with
        | [||] ->
            Task.CompletedTask
        | directories -> 
            directories
            |> Array.map (fun dir -> Task.Run(fun () -> traverseTask onGetFiles dir))
            |> Task.WhenAll

let rec traverseTaskWithDepth onGetFiles depth path =
    match readFiles path with
    | ReadFiles files -> onGetFiles path files
    | FilesError _ -> onGetFiles path [||]

    match readDirectories path with
    | DirectoriesError _ ->
        Task.CompletedTask
    | ReadDirectories dirs ->
        match dirs with
        | [||] ->
            Task.CompletedTask
        | directories -> 
            directories
            |> Array.map (fun dir ->
                if depth < 0 then
                    traverseTaskWithDepth onGetFiles -1 dir
                else
                    Task.Run(fun () -> traverseTaskWithDepth onGetFiles (depth - 1) dir))
            |> Task.WhenAll

let rec traverseAsync onGetFiles path = 
    async {
        match readFiles path with
        | ReadFiles files -> onGetFiles path files
        | FilesError _ -> onGetFiles path [||]

        match readDirectories path with
        | DirectoriesError _ -> ()
        | ReadDirectories dirs ->
            match dirs with
            | [||] -> ()
            | directories -> 
                return! directories
                    |> Array.map (fun dir -> async { do! traverseAsync onGetFiles dir }) 
                    |> Async.Parallel
                    |> Async.Ignore
    }

let rec traverseJob onGetFiles path = 
    job {
        match readFiles path with
        | ReadFiles files -> onGetFiles path files
        | FilesError _ -> onGetFiles path [||]

        match readDirectories path with
        | DirectoriesError _ -> ()
        | ReadDirectories dirs ->
            match dirs with
            | [||] -> ()
            | directories -> 
                return! directories
                    |> Array.map (fun dir -> job { do! traverseJob onGetFiles dir }) 
                    |> Job.conIgnore
    }

let rec traverseParallel onGetFiles path =
    match readFiles path with
    | ReadFiles files -> onGetFiles path files
    | FilesError _ -> onGetFiles path [||]

    match readDirectories path with
    | DirectoriesError _ -> ()
    | ReadDirectories dirs ->
        match dirs with
        | [||] -> ()
        | directories -> 
            let p = Partitioner.Create(directories, true)
            Parallel.ForEach(p, fun dir _ _ -> traverseParallel onGetFiles dir) |> ignore

type TranverseResult () =
    let cd = new ConcurrentDictionary<string, string[]>()
    member _.OnGetFiles path files = cd.TryAdd (path, files) |> ignore

[<Orderer(SummaryOrderPolicy.FastestToSlowest)>]
type TraverseBench() =
    let taskResult = new TranverseResult()
    let taskDepthResult = new TranverseResult()
    let asyncResult = new TranverseResult()
    let jobResult = new TranverseResult()
    let parallelResult = new TranverseResult()

    let initPath = "C:\\Program files"

    [<Benchmark>]
    member _.TraverseSync() =
        traverseSync initPath

    [<Benchmark>]
    member _.TraverseSyncCPS() =
        traverseSync initPath

    [<Benchmark>]
    member _.TraversePLINQ() =
        traversePLINQ initPath

    [<Benchmark>]
    member _.TraversePLINQPartitioner() =
        traversePLINQPartitioner initPath

    [<Benchmark>]
    member _.TraverseTask() =
        let t = traverseTask taskResult.OnGetFiles initPath
        t.Wait()

    [<Benchmark>]
    member _.TraverseTaskWithDepth() =
        let t = traverseTaskWithDepth taskDepthResult.OnGetFiles maxDepth initPath
        t.Wait() 

    [<Benchmark>]
    member _.TraverseAsync() =
        traverseAsync asyncResult.OnGetFiles initPath
        |> Async.RunSynchronously

    [<Benchmark>]
    member _.TraverseJob() =
        traverseJob jobResult.OnGetFiles initPath
        |> run

    [<Benchmark>]
    member _.TraverseParallel() =
        traverseParallel parallelResult.OnGetFiles initPath

let defaultSwitch () = BenchmarkSwitcher [| typeof<TraverseBench> |]

[<EntryPoint>]
let Main args =
    defaultSwitch().Run args |> ignore
    0

summary.txt

BenchmarkDotNet=v0.12.1, OS=Windows 10.0.18363.778 (1909/November2018Update/19H2)
Intel Core i5-3570 CPU 3.40GHz (Ivy Bridge), 1 CPU, 4 logical and 4 physical cores
.NET Core SDK=3.1.201
  [Host]     : .NET Core 3.1.3 (CoreCLR 4.700.20.11803, CoreFX 4.700.20.12001), X64 RyuJIT DEBUG
  DefaultJob : .NET Core 3.1.3 (CoreCLR 4.700.20.11803, CoreFX 4.700.20.12001), X64 RyuJIT


|                   Method |     Mean |   Error |   StdDev | Completed Work Items | Lock Contentions |      Gen 0 |     Gen 1 |     Gen 2 | Allocated |
|------------------------- |---------:|--------:|---------:|---------------------:|-----------------:|-----------:|----------:|----------:|----------:|
|              TraverseJob | 164.1 ms | 0.42 ms |  0.39 ms |               0.6667 |                - |  7000.0000 |  333.3333 |         - |  21.19 MB |
|             TraverseTask | 167.9 ms | 0.47 ms |  0.44 ms |            5558.6667 |                - |  5666.6667 | 2000.0000 |         - |  20.93 MB |
|         TraverseParallel | 170.8 ms | 1.29 ms |  1.14 ms |            1518.5000 |                - |  6500.0000 |  500.0000 |         - |  21.91 MB |
|            TraverseAsync | 183.1 ms | 0.51 ms |  0.47 ms |            5558.6667 |                - |  6333.3333 | 2000.0000 |         - |  27.88 MB |
| TraversePLINQPartitioner | 237.0 ms | 4.25 ms |  5.38 ms |            7152.0000 |           9.0000 | 17000.0000 | 4000.0000 | 1000.0000 |  62.17 MB |
|            TraversePLINQ | 240.1 ms | 4.24 ms |  3.31 ms |            7152.0000 |          14.0000 | 15000.0000 | 3000.0000 |         - |  62.72 MB |
|    TraverseTaskWithDepth | 278.9 ms | 5.52 ms | 12.24 ms |            2391.0000 |                - |  6000.0000 | 1000.0000 |         - |  20.22 MB |
|             TraverseSync | 622.7 ms | 2.19 ms |  1.71 ms |               2.0000 |                - |  7000.0000 | 2000.0000 |         - |  33.31 MB |
|          TraverseSyncCPS | 647.3 ms | 5.91 ms |  5.53 ms |               2.0000 |                - |  7000.0000 | 2000.0000 |         - |  33.31 MB |