レコード型のフィールド隠蔽(F#)

例えば下記のようなCounterクラスを考えます。

type Counter() =
    let mutable count = 0
    member this.CountUp()   = count <- count + 1
    member this.CountDown() = count <- count - 1
    member this.Count       = count


これをレコード型を用いて実装すると下記のようになります。

privateを付加することで、外側からフィールドにアクセスできなくなります。

[<AutoOpen>]
module CounterModule =
    type Counter = private { mutable Count : int }
       
    module Counter =
        let create    ()      = { Count = 0 }
        let countUp   counter = counter.Count <- counter.Count + 1
        let countDown counter = counter.Count <- counter.Count - 1
        let count     counter = counter.Count


どちらを利用するか

レコード型を利用したほうが、利用時にF#っぽい記述ができるため、書き方に一貫性が保たれます。

しかしフィールドにmutableが含まれる場合、クラス型のほうを利用したほうが、副作用の場所が差別化され判断しやすくなります。

ほとんどの場合はフィールドがmutableだと考えられる(immutableであれば、ただの変換関数でOKなはず)ので、クラス型の方を利用したほうがよい気がします。





F#のMailboxProcessorで選択的受信

F#にはアクターモデルを実現できるMailboxProcessorクラスが用意されています。

基本的にはキューに積まれたメッセージを順に処理していくものですが、たまに特定のメッセージを先に処理したいときがあります。

今回はMailboxProcessorで選択的に受信するよう実装してみたいと思います。

Erlangでの選択的受信

after 0 を利用して下記の様に記述されます。

important() ->
    receive
        {Priority, Message} when Priority > 10 ->
            [Message | important()]
    after 0 ->
        normal()
    end.
 
normal() ->
    receive
        {_, Message} ->
            [Message | normal()]
    after 0 ->
        []
    end.


Erlangをまねて実装

TryScanでTimeoutを0に設定することにより、たまったキューの中身を確認しています。

Importantがキューに積まれていた場合は優先的に処理されます。

type Message =
    | Important
    | Normal

let processor =
    MailboxProcessor<Message>.Start
        (fun inbox ->
            let rec loop() = 
                async {
                    let! importantProcessed = 
                        inbox.TryScan
                            ( function
                              | Important -> Some (async { printf "Important\n" })
                              | _         -> None
                            , 0
                            )
                    if  importantProcessed.IsNone then
                        let! msg = inbox.Receive()
                        match msg with
                        | Important -> printf "Important\n"
                        | Normal    -> printf "Normal\n"

                    do! Async.Sleep 1000

                    return! loop()
                }
            loop()
        )

下記の様にPostすると、
Normal
Important
Important
Normal
Normal
の順に処理されます。

processor.Post(Normal)
System.Threading.Thread.Sleep(100)

processor.Post(Normal)
processor.Post(Important)
processor.Post(Important)
processor.Post(Normal)


終了をWaitできるよう実装

おまけで、終了メッセージを送信し、処理が終わるまでWaitできるよう実装してみました。

AsyncReplyChannelとPostAndReplyを利用してWaitを実現しています。

type Message =
    | Post
    | Exit of AsyncReplyChannel<unit>

let processor =
    MailboxProcessor<Message>.Start
        (fun inbox ->
            let rec loop() = 
                async {
                    let! exited = 
                        inbox.TryScan
                            ( function
                              | Exit replyChannel -> 
                                async { 
                                    printf "exit\n"
                                    replyChannel.Reply() 
                                }                                
                                |> Some
                              | _  -> None
                            , 0
                            )
                    if exited.IsNone then
                        let! msg = inbox.Receive()
                        match msg with
                        | Exit replyChannel -> 
                            printf "exit\n"
                            replyChannel.Reply()
                        | Post -> 
                            printf "post\n"
                            do! Async.Sleep 1000
                            return! loop()
                }
            loop()
        )

下記のようにPostすると、
post
exit
exited
の順にコンソールに出力されます。

processor.Post(Post)
processor.Post(Post)
processor.Post(Post)
System.Threading.Thread.Sleep(100)
processor.PostAndReply(fun x -> Exit x)
printf "exited\n"


実際の利用

TryScanのたびにキューを全部確認しており、またF#ではTaskなどが利用できるため、実際には独自でスレッドとキューを用意したほうが速くてわかりやすいと思います。





C++でImmutableクラス

C++のクラスは、下記のように普通の書き方をするとmutableなものになります。

struct Person {
    std::string Name;
    int Age;
};

今回はこのクラスをImmutableなものにしてみます。

メンバーをconstに

下記のようにメンバーをconstにすると、コンストラクタの初期化構文でのみセットでき、代入でセットすることができなくなります。

struct Person {
    const std::string Name;
    const int Age;
    Person(std::string name, int age) : Name(name), Age(age) {}
};

Person p("Pieter", 10);
p.Age = 20; // NG


With関数を定義してみる

メンバーの数が多くなってくると、あるメンバーだけを変更したオブジェクトの生成が面倒になります。

例えばF#だと下記のようにwith構文が存在します。

{ p with Age = 20 }

C++で特殊構文は作成できないので、メンバーそれぞれのWith関数を定義してみます。

struct Person {
    const std::string Name;
    const int Age;
    Person(std::string name, int age) : Name(name), Age(age) {}
    Person WithName(std::string x) { return Person(x, Age); }
    Person WithAge(int x) { return Person(Name, x); }
};

Person p("Pieter", 10);
Person p2 = p.WithAge(20);


右辺値用のWith関数

現状、メンバー数が多くWith関数が続いてしまうような場合、途中でオブジェクトがたくさん生成されて効率があまりよくありません。

そこで右辺値の場合は自身のメンバを変更して返すようにしてみます。(残念ですがconstを外す以外の方法が思いつきませんでした。)

Person&& WithAge(int x) && {
    *(int*)&Age = x;
    return std::move(*this);
}

// 左辺値用
Person WithAge(int x) const & { return Person(Name, x); }

これにより、下記の記述でも最初のコンストラクトと最後のムーブコンストラクトの二回しかオブジェクトを生成しません。

auto p = Person("Pieter", 10).WithAge(20).WithAge(30).WithAge(40);


実際に利用する場合

C++では変数をconstにする機能があるため、メンバーまでconstにする必要はあまりないと思われます。

ですので下記で十分だと思います。

struct Person {
    std::string Name;
    int Age;
    Person(std::string name, int age) : Name(name), Age(age) {}

    Person WithAge(int x) const & {
        auto copied = *this;
        copied.Age = x;
        return copied;
    }
    Person&& WithAge(int x) && {
        Age = x;
        return std::move(*this);
    }

    // WithNameは省略
};

With関係はマクロにするとこんな感じになります。(変数のセットもmoveにしておきました。)

#define WITH(name)                                         \
    decltype(auto) With##name(decltype(name) x) const & {  \
        auto copied = *this;                               \
        copied.name = std::move(x);                        \
        return copied;                                     \
    }                                                      \
    decltype(auto) With##name(decltype(name) x) && {       \
        name = std::move(x);                               \
        return std::move(*this);                           \
    }

struct Person {
    std::string Name;
    int Age;
    Person(std::string name, int age) : Name(name), Age(age) {}
    WITH(Name)
    WITH(Age)   
};

コンストラクタもマクロにしたい場合は下記を参照してみてください。
Boost Preprocessorでコンストラクタ生成 - 何でもプログラミング






F#でSQLite

今回はF#でSQLiteを利用してみたいと思います。

System.Data.SQLite入手

NuGetで下記のパッケージを取得します。
f:id:any-programming:20180226162251p:plain

データベース準備

sample.sqliteファイルに、下記のテーブルを定義しています。

作成は「DB Browser for SQLite」や、IDEに付属のツール、上記のdllを利用してプログラミング等で行えます。

personテーブル

id INTEGER PRIMARY KEY AUTOINCREMENT
name TEXT
age INTEGER


System.Data.SQLite単体で利用

生のSQL文を作成して実行しています。

望んだままのSQLを発行することが可能です。

DataSourceにはsample.sqliteのパスを指定してください。

let connectionString = SQLiteConnectionStringBuilder(DataSource = "sample.sqlite").ToString()
use connection = new SQLiteConnection(connectionString)
connection.Open()

// レコード追加
using (connection.CreateCommand())
    (fun command ->
        command.CommandText <- "INSERT INTO person (name, age) VALUES (@name, @age)"
        [ SQLiteParameter("@name", "Jerald")
          SQLiteParameter("@age",  40)
        ]
        |> List.iter (command.Parameters.Add >> ignore)
        command.ExecuteNonQuery() |> ignore
    )

// クエリ
using (connection.CreateCommand())
    (fun command ->
        command.CommandText <- "SELECT * FROM person WHERE 10 < age"
        use reader = command.ExecuteReader()
        while reader.Read() do
            printf "id:%A name:%A age:%A\n" reader.["id"] reader.["name"] reader.["age"]
    )    
connection.Close()    


LINQ to SQLを利用

SQL文の作成に、IQueryableを利用します。

これによりSQL文の間違いをコンパイル時に見つけやすくなります。

参照にSystem.Data.Linq.dll、System.Data.dll、System.Transactions.dllを追加してください。

AUTOINCREMENTを利用できるよう、IDはNullableで定義してあります。

[<Table>]
type Person() =
    [<Column(IsPrimaryKey = true)>]
    member val ID = Nullable<int>() with get, set
    [<Column>]
    member val Name = "" with get, set
    [<Column>]
    member val Age = 0 with get, set

let connectionString = SQLiteConnectionStringBuilder(DataSource = "sample.sqlite").ToString()
use connection = new SQLiteConnection(connectionString)
use context = new DataContext(connection)
    
// レコード追加
context.GetTable<Person>().InsertOnSubmit(Person(Name = "Jerald", Age = 40))
context.SubmitChanges()
    
// クエリ
query
    { for person in context.GetTable<Person>() do
        where (10 < person.Age)
    }
|> Seq.iter (fun x -> printf "id:%A name:%A age:%A\n" x.ID.Value x.Name x.Age)


SQLProvider利用

テーブルクラスの生成を、TypeProviderを利用して行うようにしてみます。

下記NuGetを取得します。
f:id:any-programming:20180226164225p:plain

SqlDataProviderに、自動生成対象のデータベースのパスを指定します。

[<Literal>]
let connectionStringCompileTime = "Data Source=sample.sqlite;Version=3"
type Database =
    SqlDataProvider<
        DatabaseVendor = Common.DatabaseProviderTypes.SQLITE,
        ConnectionString = connectionStringCompileTime
    >

let connectionString = SQLiteConnectionStringBuilder(DataSource = "sample.sqlite").ToString()
let context = Database.GetDataContext(connectionString)
        
// レコード追加
let person = context.Main.Person.Create()
person.Name <- "Jerald"
person.Age  <- 40L
context.SubmitUpdates()

// クエリ
query 
    { for person in context.Main.Person do
        where (person.Age > 10L) // 10L < person.Age では動作しない…
    }
|> Seq.iter (fun x -> printf "id:%A name:%A age:%A\n" x.Id x.Name x.Age)






F#で逆誤差伝播法(ミニバッチ対応版)

下記記事にて逆誤差伝播法をF#で実装してみました。
F#で逆誤差伝播法 - 何でもプログラミング

1データ/教師データ毎にネットワークを更新していましたが、今回はある程度の数学習してその変位の平均でネットワークを更新する、ミニバッチ法に対応してみたいと思います。

前回のものを流用して、ネットワーク更新の時にAffine層の平均を計算するのでもよいのですが、今回はそもそも入力でMatrix(列方向に複数データが入る)を受け取れるよう実装してみます。

特に記載のないものは、上記記事を参照してみてください。

伝播&逆伝播関数

let forward (input : Matrix<double>) (layer : Layer) : Matrix<double> =
    match layer with
    | Affine(weight, bias) -> 
        input * weight |> Matrix.mapRows (fun _ x -> x + bias)            
    | ReLU ->
        input |> Matrix.map (max 0.0)

let forwardAndCreateBackward 
    (rate : double) (input : Matrix<double>) (layer : Layer) 
    : (Matrix<double> -> Layer * Matrix<double>) * Matrix<double> =
    let output = forward input layer
    let backward =
        match layer with
        | Affine(weight, bias) ->
            (fun (dy : Matrix<double>) ->
                let dx = dy * weight.Transpose()
                let dw = input.Transpose() * dy                    
                Affine(weight - rate * dw, bias - rate * (Matrix.sumCols dy)), dx
            )
        | ReLU ->
            (fun (dy : Matrix<double>) ->
                let dx = dy |> Matrix.mapi (fun i j dy -> if output.[i, j] = 0.0 then 0.0 else dy)
                layer, dx
            )
    backward, output


学習関数

let softmaxRows (x : Matrix<double>) : Matrix<double> =            
    x |> Matrix.mapRows (fun _ x -> softmax x)

let learn (rate : double) (network : Network) (input : Matrix<double>) (teacher : Matrix<double>) : Network =
    let backwards, y = network.Layers |> Array.mapFold (forwardAndCreateBackward rate) input
    let dy = 
        match network.LastLayer with
        | SoftmaxCrossEntropy -> 
            ((softmaxRows y) - teacher) / (double y.RowCount)
    let layers, _ = backwards |> Array.rev |> Array.mapFold (|>) dy
    { network with Layers = layers |> Array.rev }


評価関数

let predict (network : Network) (input : Matrix<double>) : Matrix<double> =
    let y = network.Layers |> Array.fold forward input
    match network.LastLayer with
    | SoftmaxCrossEntropy -> softmaxRows y        

let accuracy (network : Network) (input : Matrix<double>) (teacher : Matrix<double>) : double =
    let output = predict network input
    Seq.map2 
        (=) 
        (output  |> Matrix.toRowSeq |> Seq.map Vector.maxIndex)
        (teacher |> Matrix.toRowSeq |> Seq.map Vector.maxIndex)
    |> Seq.averageBy (fun x -> if x then 1.0 else 0.0)


MNISTを学習

10000データ学習ごとの正答率は下記のように推移しました。
[ 0.0947, 0.8723, 0.8893, 0.9092, 0.9154, 0.9154, 0.9183 ]

let shuffle (ary : 'a[]) : 'a[] =
    let random = System.Random()
    ary |> Array.sortBy (fun _ -> random.Next())

let trainImages = Mnist.loadImageVectors "train-images.idx3-ubyte"
let trainLabels = Mnist.loadLabelVectors "train-labels.idx1-ubyte"
let testImages  = Mnist.loadImageVectors "t10k-images.idx3-ubyte" |> Matrix.Build.DenseOfRowVectors
let testLabels  = Mnist.loadLabelVectors "t10k-labels.idx1-ubyte" |> Matrix.Build.DenseOfRowVectors

let initialNetwork =
    { Layers =
        [| createAffineHe 784 50
            ReLU
            createAffineHe 50 10
        |]
        LastLayer = SoftmaxCrossEntropy
    }

let batchSize = 100
seq { 1..trainImages.Length / batchSize }
|> Seq.scan
    (fun net i -> 
        let indices = [| 0..trainImages.Length - 1 |] |> shuffle |> Array.take batchSize
        let images = indices |> Array.map (fun i -> trainImages.[i]) |> Matrix.Build.DenseOfRowVectors
        let labels = indices |> Array.map (fun i -> trainLabels.[i]) |> Matrix.Build.DenseOfRowVectors
        learn 0.1 net images labels 
    )
    initialNetwork
|> Seq.iter (fun network -> printf "accuracy %f\n" (accuracy network testImages testLabels))






F#で逆誤差伝播法

今回はニューラルネットワークで利用される、逆誤差伝播法をF#で実装してみたいと思います。

実装をするに際し、Math.NETライブラリを利用しています。

レイヤーの定義

今回は、全結合のAffine層、ReLU活性化層、Softmax最終活性化層を定義しました。

その他の層が欲しい場合は、ここに定義を追加していく形となります。

またAffine層の初期化として、He初期値を利用する関数も定義しました。

type Layer =
    | Affine of weight : Matrix<double> * bias : Vector<double>
    | ReLU

type LastLayer =
    | SoftmaxCrossEntropy        

type Network =
    { Layers    : Layer[]
      LastLayer : LastLayer
    }

let createAffineHe (inputCount : int) (outputCount : int) : Layer =
    let weight = Matrix<double>.Build.Random(inputCount, outputCount) * (sqrt (2.0 / double inputCount))
    let bias   = Vector<double>.Build.Dense(outputCount)
    Affine(weight, bias)


伝播&逆伝播関数

純粋な伝播を定義するforward関数と、伝播しながら逆伝播関数を生成するforwardAndCreateBackward関数を定義します。

let forward (input : Vector<double>) (layer : Layer) : Vector<double> =
    match layer with
    | Affine(weight, bias) -> 
        input * weight + bias            
    | ReLU ->
        input |> Vector.map (max 0.0)

let forwardAndCreateBackward 
    (rate : double) (input : Vector<double>) (layer : Layer) 
    : (Vector<double> -> Layer * Vector<double>) * Vector<double> =
    let output = forward input layer
    let backward =
        match layer with
        | Affine(weight, bias) ->
            (fun (dy : Vector<double>) ->
                let dx = dy * weight.Transpose()
                let dw = input.ToColumnMatrix() * dy.ToRowMatrix()
                Affine(weight - rate * dw, bias - rate * dy), dx
            )
        | ReLU ->
            (fun dy ->
                let dx = Vector.map2 (fun y dy -> if y = 0.0 then 0.0 else dy) output dy
                layer, dx
            )
    backward, output


学習関数

順伝播しながら逆伝播関数を生成し、最終層から逆伝播させ、更新された新しいNetworkを生成しています。

let softmax (x : Vector<double>) : Vector<double> =
    let c = Vector.max x
    let e = x |> Vector.map (fun x -> exp (x - c))
    e / (Vector.sum e)

let learn (rate : double) (network : Network) (input : Vector<double>) (teacher : Vector<double>) : Network =
    let backwards, y = network.Layers |> Array.mapFold (forwardAndCreateBackward rate) input
    let dy = 
        match network.LastLayer with
        | SoftmaxCrossEntropy -> (softmax y) - teacher
    let layers, _ = backwards |> Array.rev |> Array.mapFold (|>) dy
    { network with Layers = layers |> Array.rev }


評価関数

入力と教師データから正答率を算出しています。(教師データは、どれか一つの値が活性化するものと想定しています。)

let predict (network : Network) (input : Vector<double>) : Vector<double> =
    let y = network.Layers |> Array.fold forward input
    match network.LastLayer with
    | SoftmaxCrossEntropy -> softmax y        

let accuracy (network : Network) (inputs : Vector<double>[]) (teachers : Vector<double>[]) : double =
    let outputs = inputs |> Array.map (predict network)
    Seq.map2
        (=)
        (outputs  |> Seq.map Vector.maxIndex)
        (teachers |> Seq.map Vector.maxIndex)
    |> Seq.averageBy (fun x -> if x then 1.0 else 0.0)


MNISTを学習してみる

MNISTの読み込みに関しては、下記記事を参照してみてください。
MNISTの読み込み(F#) - 何でもプログラミング

10000データ学習ごとの正答率は下記のように推移しました。
[ 0.0931, 0.913, 0.9321, 0.9297, 0.9441, 0.9471, 0.9488 ]

let trainImages = Mnist.loadImageVectors "train-images.idx3-ubyte"
let trainLabels = Mnist.loadLabelVectors "train-labels.idx1-ubyte"
let testImages  = Mnist.loadImageVectors "t10k-images.idx3-ubyte"
let testLabels  = Mnist.loadLabelVectors "t10k-labels.idx1-ubyte"

let initialNetwork =
    { Layers =
        [| createAffineHe 784 50
            ReLU
            createAffineHe 50 10
        |]
        LastLayer = SoftmaxCrossEntropy
    }

Seq.zip trainImages trainLabels
|> Seq.scan (fun network (image, label) -> learn 0.01 network image label) initialNetwork
|> Seq.indexed
|> Seq.iter 
    (fun (i, network) -> 
        if i % 10000 = 0 then 
            printf "accuracy %f\n" (accuracy network testImages testLabels)
    )






MNISTの読み込み(F#)

機械学習のデータとして、手書き数字の画像がまとめられた下記のサイトを利用することがあります。
MNIST handwritten digit database, Yann LeCun, Corinna Cortes and Chris Burges

訓練データとして60000画像、テストデータとして10000画像用意されています。

今回はこのデータをF#で利用できるようパースしてみたいと思います。(フォーマットは上記サイトに記載されています。)

読み込み関数

データはbig endianで保存されています。

let readInt32BigEndian (reader : BinaryReader) : int =
    BitConverter.ToInt32(reader.ReadBytes(4) |> Array.rev, 0)

let loadLabels (path : string) : byte[] =
    use reader = new BinaryReader(File.OpenRead(path))
    assert (readInt32BigEndian reader = 2049)
    let count = readInt32BigEndian reader
    reader.ReadBytes(count)

let loadImages (path : string) : byte[][] =
    use reader = new BinaryReader(File.OpenRead(path))
    assert (readInt32BigEndian reader = 2051)
    let count  = readInt32BigEndian reader
    let height = readInt32BigEndian reader
    let width  = readInt32BigEndian reader
    [| 1..count |] |> Array.map (fun _ -> reader.ReadBytes(width * height))


動作確認

実際にpngで保存してみて中身を確認してみます。

let savePng8 (width : int) (height : int) (pixels : byte[]) (path : string) : unit =
   use stream = new FileStream(path, FileMode.Create)
   let encoder = PngBitmapEncoder()
   let bmp = BitmapSource.Create(width, height, 96.0, 96.0, PixelFormats.Gray8, null, pixels, width)
   encoder.Frames.Add(BitmapFrame.Create(bmp))
   encoder.Save(stream)

let main argv = 
    let images = loadImages "train-images.idx3-ubyte"
    let labels = loadLabels "train-labels.idx1-ubyte"

    Array.iteri2
        (fun i image label ->
            let path = sprintf "image%d(%d).png" i label
            File1.savePng8 28 28 image path
        )
        (images |> Array.take 3)
        (labels |> Array.take 3)
f:id:any-programming:20180219125849p:plain f:id:any-programming:20180219125852p:plain f:id:any-programming:20180219125854p:plain
5 0 4


学習用に変形

実際にデータを利用する際には、数学ライブラリのデータで取得したほうが便利です。

今回はMath.NETのVector形式に変換してみます。
f:id:any-programming:20180219131050p:plain

また、画像データを255で割って正規化し、ラベルデータを10要素のVectorに変換します。(例:3 → [0, 0, 0, 1, 0, 0, 0, 0, 0, 0])

open MathNet.Numerics.LinearAlgebra

let loadLabelVectors (path : string) : Vector<double>[] =
    loadLabels path
    |> Array.map 
        (fun label -> 
            [| 0uy..9uy |] 
            |> Array.map (fun x -> if x = label then 1.0 else 0.0) 
            |> Vector.Build.Dense
        )

let loadImageVectors (path : string) : Vector<double>[] =
    loadImages path
    |> Array.map (Array.map (fun x -> (double x) / 255.0) >> Vector.Build.Dense)