F#奇妙游（12）：并行编程与π

核越多，越快乐

多核CPU对于计算机程序的开发带来了很大的挑战，但是也带来了很大的机遇。在多核CPU上，程序的性能可以通过并行化来提升，但是并行化的难度也随之提升。本文将介绍多核CPU的基本概念，以及如何在多核CPU上进行并行化编程。

此外，Web应用、GUI应用中广泛存在的响应式编程也代表了系统规模自适应和充分利用多核多CPU来改善体验的一种方式。

在F#的语言介绍中，或者在任何函数式语言的广告词中，都要提到函数式语言的并行化编程能力。这个能力是函数式语言的一个重要特性，也是函数式语言的一个重要优势。但是，这个能力是如何实现的呢？在本文中，我们将介绍函数式语言的并行化编程能力的基本原理，以及如何在F#中使用这个能力。

多核编程概念

什么是异步？什么是并发？这些概念之间有什么区别？

异步涉及到系统无法控制的外部调用，外部和内部同时进行，调用外部的功能并需要外部返回的结果，在等待结果的过程中，还需要继续执行内部的功能。异步的例子包括：网络请求、文件读写、数据库查询、用户输入等等。

并发涉及到系统可以控制的内部调用，内部和内部同时进行，调用内部的功能并需要内部返回的结果，在等待结果的过程中，还需要继续执行内部的功能。并发的例子包括：多线程、多进程等等。所有的内部调用都是系统可以控制的。并且，整个系统运行的结果应该是确定性的，即使是多线程、多进程，从设计的角度来看也应该是确定性的。

	异步	并发
目的	提高响应	加快处理速度
应用	IO	CPU
调用外部	是	否
是否确定	否	是

奇妙游：WPF+F#

多线程模型

这个函数有若干线程。

1. 程序的主线程，也就是通常说的UI线程；
2. 处理数据的线程，采用BackgroundWorker实现；
3. 产生数据的线程，采用async计算表达式来实现。

线程之间的数据传递采用ConcurrentQueue来完成，处理数据的线程中更新UI界面，采用UIElement.Dispatcher.Invoke(fun () -> ...)来实现。

这基本上就涵盖了多线程编程的所有部分。

BackgroundWorker还挺可爱的，可以通过DoWork来注册工作，还能注册处理进度的函数，还能注册完成的函数。

let worker = new BackgroundWorker()
worker.WorkerReportsProgress <- true
worker.DoWork.Add (fun (e: DoWorkEventArgs) -> 
    worker.ReportProgress(......)
 )
worker.ProgressChanged.Add (fun (e: ProgressChangedEventArgs) -> ... 
    match e.UserState with
    | :> (......) ->  ...
    | _ -> ()
)
worker.RunWorkerCompleted.Add (fun (e: RunWorkerCompletedEventArgs) -> ... )
worker.RunWorkerAsync()

方法传递的几个函数中还能携带用户自定义的信息，查看帮助即可知道。在F#中可以很方便的通过math e.UserState with解析得到用户的信息.

ConcurrentQueue的用法也可以很容易查到。

π的低效方法

介绍来介绍去，其实都没什么意思。我们秃子哦不软件工程师就喜欢看到CPU忙起来。

那么我们就整一个效率非常低的π的计算方法，这个计算方法利用的就是圆的面积和正方形的面积的比例关系。产生两个随机数，都属于[-1,1],那么落在单位圆范围内的概率就是π/4。那么我们就可以通过这个概率来计算π的值。

let calPi (q: ConcurrentQueue<float * float * bool>) =
    async {
        let rand = new Random()
        let inline rd () = 2.0 * (rand.NextDouble() - 0.5)

        while true do
            if q.Count >= 500 then
                Thread.Sleep(10)
            else
                let x = rd ()
                let y = rd ()
                let inside = x * x + y * y <= 1.0
                q.Enqueue(x, y, inside)
    }

这个函数产生两个随机数，并把判断的结果和随机数放到一个队列里头（FIFO），这里选择的是并行队列，也就是线程安全的队列。

WPF但是F#

接下来就是搞一个WPF的用户界面。其实WPF的用户界面用起来比WinForm还简单啊。主函数就是这个样子，跟PyQt5简直是一个样子。

[<STAThread>]
[<EntryPoint>]
let main args =
    let app = Application()
    let window = MyWindow()
    app.Run(window) |> ignore
    0

这个主窗口，在F#中又两种实现方法，一种实现方法是搞一个Window的子类，一种方法就是定义一个函数，返回一个Window的实例，代码基本没区别，但是可以看到F#的对象模型和C#的对象模型还是有一些区别的。这里还设了一个ico，WPF只能用ico文件，人家JavaFX和PyQt5都能直接png，jpg啊。如果没有ico，把这句话删了就行。

type MyWindow() as self =
    inherit Window()
    let mutable inside = float 0
    let mutable total = float 0
    let canvas = Canvas()
    let processQueue = new ConcurrentQueue<(float * float * bool)>()

    let worker = new BackgroundWorker()

    do
        self.Content <- canvas
        self.Width <- 800.0
        self.Height <- 800.0
        self.ResizeMode <- ResizeMode.NoResize

    do
        worker.DoWork.Add (fun (e: DoWorkEventArgs) ->
            let mutable tup = (0.0, 0.0, false)

            while true do
                if processQueue.IsEmpty then
                    Thread.Sleep(10)
                else if processQueue.TryDequeue(&tup) then
                    let x, y, isInside = tup

                    let color =
                        if isInside then
                            Brushes.Black
                        else
                            Brushes.Red

                    canvas.Dispatcher.Invoke(fun () -> drawPoint canvas x y 6.0 color)
                    total <- total + 1.0
                    inside <- inside + if isInside then 1.0 else 0.0
                    let pi = 4.0 * float inside / float total

                    self.Dispatcher.Invoke (fun () ->
                        self.Title <- $"Sample(%16.0f{total}/%3d{processQueue.Count}), Pi = %.12f{pi}"))

    do
        [ 1..1 ]
        |> List.map (fun _ -> calPi processQueue)
        |> Async.Parallel
        |> Async.StartAsTask
        |> ignore

    do
        canvas.Background <- Brushes.Black

        canvas.Loaded.Add (fun _ ->
            drawBackground canvas
            // Start update UI worker
            worker.RunWorkerAsync())

函数式的实现更加清晰，反正就是Window中间放一个Canvas。

let makeWindow () =
    let window = Window()
    let canvas = Canvas()

    let mutable inside = float 0
    let mutable total = float 0

    canvas.Background <- Brushes.Black

    let processQueue = ConcurrentQueue<(float * float * bool)>()

    [ 1..3 ]
    |> List.map (fun _ -> calPi processQueue)
    |> Async.Parallel
    |> Async.Ignore
    |> Async.Start



    canvas.Loaded.Add (fun _ ->
        drawBackground canvas

        let worker = new BackgroundWorker()

        worker.DoWork.Add (fun (e: DoWorkEventArgs) ->
            let mutable tup = (0.0, 0.0, false)

            while true do
                if processQueue.IsEmpty then
                    Thread.Sleep(10)
                else if processQueue.TryDequeue(&tup) then
                    let x, y, isInside = tup

                    let color =
                        if isInside then
                            Brushes.Black
                        else
                            Brushes.Red

                    total <- total + 1.0
                    inside <- inside + if isInside then 1.0 else 0.0

                    canvas.Dispatcher.Invoke(fun () -> drawPoint canvas x y 6.0 color)
                    // the following will not work!
                    // drawPoint canvas x y 6.0 color
                    let pi = 4.0 * float inside / float total

                    window.Dispatcher.Invoke (fun () ->
                        window.Title <- $"Sample(%16.0f{total}/%3d{processQueue.Count}), Pi = %.12f{pi}"))
                    // the following will not work!
                    // window.Title <- $"Sample(%10.0f{total}/%6d{processQueue.Count}), Pi = %.12f{pi}")

        worker.RunWorkerAsync())

    window.Content <- canvas
    window.Width <- 800.0
    window.Height <- 800.0
    window.ResizeMode <- ResizeMode.NoResize
    // window.WindowStartupLocation <- WindowStartupLocation.CenterScreen

    window

最后就是工程文件，首先用dotnet new console -lang F# -o pi创建一个工程，然后把文件改吧改吧。

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

    <PropertyGroup>
        <OutputType>WinExe</OutputType>
        <TargetFramework>net7.0-windows</TargetFramework>
        <UseWpf>true</UseWpf>
        <Configuration>Release</Configuration>
        <ApplicationIcon>fsharp.ico</ApplicationIcon>
    </PropertyGroup>

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

</Project>

另外有两个在Canvas上画图的函数。

完整代码

open System
open System.Collections.Concurrent
open System.ComponentModel
open System.Threading
open System.Windows
open System.Windows.Controls
open System.Windows.Media
open System.Windows.Shapes
open Microsoft.FSharp.Control
open Microsoft.FSharp.Core


let drawPoint (c: Canvas) (x: float) (y: float) (d: float) color =
    let w, h = c.ActualWidth, c.ActualHeight
    let r = (min w h) * 0.5

    let myEllipse = new Ellipse()
    myEllipse.Fill <- color
    myEllipse.Width <- d
    myEllipse.Height <- d
    let myPoint = new Point(x * r, y * r)
    Canvas.SetLeft(myEllipse, myPoint.X + w / 2.0 - d / 2.0)
    Canvas.SetTop(myEllipse, myPoint.Y + h / 2.0 - d / 2.0)
    c.Children.Add(myEllipse) |> ignore


let drawBackground (c: Canvas) =
    let w, h = c.ActualWidth, c.ActualHeight
    let myEllipse = new Ellipse()
    myEllipse.Fill <- Brushes.Beige
    let d = min w h
    myEllipse.Width <- d
    myEllipse.Height <- d
    // Canvas.SetZIndex(myEllipse, -1)
    let myPoint = new Point(w / 2.0, h / 2.0)
    Canvas.SetLeft(myEllipse, myPoint.X - d / 2.0)
    Canvas.SetTop(myEllipse, myPoint.Y - d / 2.0)
    c.Children.Add(myEllipse) |> ignore

let calPi (q: ConcurrentQueue<float * float * bool>) =
    async {
        let rand = new Random()
        let inline rd () = 2.0 * (rand.NextDouble() - 0.5)

        while true do
            if q.Count >= 500 then
                Thread.Sleep(10)
            else
                let x = rd ()
                let y = rd ()
                let inside = x * x + y * y <= 1.0
                q.Enqueue(x, y, inside)
    }

let makeWindow () =
    let window = Window()
    let canvas = Canvas()

    let mutable inside = float 0
    let mutable total = float 0

    canvas.Background <- Brushes.Black

    let processQueue = ConcurrentQueue<(float * float * bool)>()

    [ 1..3 ]
    |> List.map (fun _ -> calPi processQueue)
    |> Async.Parallel
    |> Async.Ignore
    |> Async.Start



    canvas.Loaded.Add (fun _ ->
        drawBackground canvas

        let worker = new BackgroundWorker()

        worker.DoWork.Add (fun (e: DoWorkEventArgs) ->
            let mutable tup = (0.0, 0.0, false)

            while true do
                if processQueue.IsEmpty then
                    Thread.Sleep(10)
                else if processQueue.TryDequeue(&tup) then
                    let x, y, isInside = tup

                    let color =
                        if isInside then
                            Brushes.Black
                        else
                            Brushes.Red

                    total <- total + 1.0
                    inside <- inside + if isInside then 1.0 else 0.0

                    canvas.Dispatcher.Invoke(fun () -> drawPoint canvas x y 6.0 color)
                    // the following will not work!
                    // drawPoint canvas x y 6.0 color
                    let pi = 4.0 * float inside / float total

                    window.Dispatcher.Invoke (fun () ->
                        window.Title <- $"Sample(%16.0f{total}/%3d{processQueue.Count}), Pi = %.12f{pi}"))
        // the following will not work!
        // window.Title <- $"Sample(%10.0f{total}/%6d{processQueue.Count}), Pi = %.12f{pi}")

        worker.RunWorkerAsync())

    window.Content <- canvas
    window.Width <- 800.0
    window.Height <- 800.0
    window.ResizeMode <- ResizeMode.NoResize
    // window.WindowStartupLocation <- WindowStartupLocation.CenterScreen

    window

type MyWindow() as self =
    inherit Window()
    let mutable inside = float 0
    let mutable total = float 0
    let canvas = Canvas()
    let processQueue = new ConcurrentQueue<(float * float * bool)>()

    let worker = new BackgroundWorker()

    do
        self.Content <- canvas
        self.Width <- 800.0
        self.Height <- 800.0
        self.ResizeMode <- ResizeMode.NoResize

    do
        worker.DoWork.Add (fun (e: DoWorkEventArgs) ->
            let mutable tup = (0.0, 0.0, false)

            while true do
                if processQueue.IsEmpty then
                    Thread.Sleep(10)
                else if processQueue.TryDequeue(&tup) then
                    let x, y, isInside = tup

                    let color =
                        if isInside then
                            Brushes.Black
                        else
                            Brushes.Red

                    canvas.Dispatcher.Invoke(fun () -> drawPoint canvas x y 6.0 color)
                    total <- total + 1.0
                    inside <- inside + if isInside then 1.0 else 0.0
                    let pi = 4.0 * float inside / float total

                    self.Dispatcher.Invoke (fun () ->
                        self.Title <- $"Sample(%16.0f{total}/%3d{processQueue.Count}), Pi = %.12f{pi}"))

    do
        [ 1..1 ]
        |> List.map (fun _ -> calPi processQueue)
        |> Async.Parallel
        |> Async.StartAsTask
        |> ignore

    do
        canvas.Background <- Brushes.Black

        canvas.Loaded.Add (fun _ ->
            drawBackground canvas
            // Start update UI worker
            worker.RunWorkerAsync())

[<STAThread>]
[<EntryPoint>]
let main args =
    let app = Application()
    let window = MyWindow()
    app.Run(window) |> ignore
    0

运行界面

总结

1. F#中调用WPF同样容易，可能比WinForm还简单，不用XAML其实就是字多一点，也没啥；
2. F#中的多线程功能非常丰富，自己async是很好的工程工具，.NET平台的各个工具也能使用；
3. 要界面有响应，就不要在UI线程外面掉UI代码，应该用UIElement.Dispatcher.Invoke。