F#でコマンドライン引数

コマンドライン引数をパースするライブラリはすでにいくつも存在しますが、今回は簡単なものを実装してみました。

簡単のため、ロング名のみ、値は=での指定のみに対応します。

some.exe --enable --value=10

今回実装したものの利用例

コマンドライン引数用のレコード型とデフォルト値を準備し、parse関数で引数を解析します。

オプションの名前、説明、指定された時の挙動を渡して解析を行います。

type CommandLineOption =
    { Enabled : bool
      Name    : string
      Value   : int
    }

let defaultOption =
    { Enabled = false
      Name    = ""
      Value   = 0
    }

let commandOption =
    CommandLine.perse 
        [ CommandLine.noValue "enb" "enable something" 
            (fun s -> { s with Enabled = true })

          CommandLine.value "name" "set name"
            (fun s x -> Ok { s with Name = x })

          CommandLine.value "value" "set int value"
            (fun s x -> 
                String.parseInt32 x |> Result.ofOption (x + " is not int")
                |> Result.map (fun x -> { s with Value = x })
            )
        ]
        defaultOption
        (argv |> Array.toList)

parse関数

引数の解析を行い、OptionDefinition(後述)に基づいて入力レコードを更新していきます。

--helpオプションが指定された場合は、オプションの一覧を出力します。

オプションが重複して指定された場合や、オプションが存在しない場合はErrorを返します。

type PerseResult<'a> =
    | HelpPrinted
    | Persed of 'a

let perse (options : OptionDefinition<'a> list) (initialValue : 'a) (args : string list) : Result<PerseResult<'a>, string> =
    if args = [ "--help" ] then
        options |> List.iter (fun x -> printf "--%s %s\n" x.Name x.Description)
        Ok HelpPrinted
    else
        let optionMap = options |> List.map (fun x -> x.Name, x) |> Map.ofList
        parseArgs args
        |> Result.bind
            (List.foldResult
                (fun (state, processed) (name, value) ->
                    if processed |> Set.contains name then 
                        Error ("--" + name + " is set multiple times")
                    else if not (Map.containsKey name optionMap) then
                        Error ("invalid option --" + name)
                    else
                        optionMap.[name].ParseValue state value
                        |> Result.map (fun x -> x, processed |> Set.add name)
                )
                (initialValue, Set<string>([]))
            )
        |> Result.map (fun (state, _) -> Persed state)

OptionDefinition

ユーザーがオプションの定義をするのに利用する関数は下記の様に定義してあります。

type OptionDefinition<'a> =
    { Name        : string
      Description : string
      ParseValue  : 'a -> string -> Result<'a, string>
    }

let value name description (f : 'a -> string -> Result<'a, string>) : OptionDefinition<'a> = 
    { Name        = name 
      Description = description
      ParseValue  = 
        fun state x ->
            if x = "" then Error ("--" + name + " must have a value")
            else           f state x
    }

let noValue name description (f : 'a -> 'a) : OptionDefinition<'a> =
    { Name        = name
      Description = description
      ParseValue  = 
        fun state x ->  
            if x = "" then Ok (f state)
            else           Error ("--" + name + " can not have a value")
    }

parseArgs

parse内で利用されているparseArgsは下記の様に定義しています。

let (|Regex|_|) pattern str = 
   let result = Regex.Match(str, pattern)
   if result.Success then Some (List.tail [ for x in result.Groups -> x.Value ])
   else                   None

let parseArgs (args : string list) : Result<(string * string) list, string> =
    args |> List.mapResult
        (function
         | Regex "--(..+?)=(.+)" [ x; y ] -> Ok (x, y)
         | Regex "--(..+)"       [ x ]    -> Ok (x, "")
         | x                              -> Error ("invalid argument " + x)
        )

F# Result型 便利関数

F#4.1で導入されたResult型ですが、導入しやすくするよう幾つか便利関数を定義してみました。

随時更新予定です。

Optionから変換

let ofOption (errorValue : 'error) (option : 'a option) : Result<'a, 'error> =
    if option.IsSome then Ok option.Value else Error errorValue

Sequence (Result list -> list Result)

Errorの値はlist化するようにしています。

let sequence (results : Result<'a, 'error> list) : Result<'a list, 'error list> =
    let folder x state =
        match x, state with
        | Ok h,    Ok t    -> Ok (h::t)
        | Ok _,    Error t -> Error t
        | Error h, Ok _    -> Error [ h ]
        | Error h, Error t -> Error (h::t)            
    List.foldBack folder results (Ok [])

ちなみにOptionだと下記のようになります。

let sequence (options : 'a option list) : 'a list option =
    List.foldBack (Option.map2 (fun x y -> x::y)) options (Some [])

mapResult

Result型にmapした後に上記のsequenceを適用すれば、listのmapが全て成功したかどうかが判定できます。

しかし途中でErrorとなった場合は以降のmapをする必要がない場合があります。

その時用にmapResultというものを定義してみました。

let mapResult (f : 'a -> Result<'b, 'error>) (list : 'a list) : Result<'b list, 'error> =
    List.fold
        (fun state item -> Result.bind (fun xs -> f item |> Result.map (fun x -> x::xs)) state)
        (Ok [])
        list
    |> Result.map List.rev

foldResult

foldの途中でErrorが存在すればErrorとなる、foldResultを作成してみました。

let foldResult (f : 'b -> 'a -> Result<'b, 'error>) (initialValue : 'b) (list : 'a list) : Result<'b, 'error> =
    List.fold (fun state x -> Result.bind (fun y -> f y x) state) (Ok initialValue) list

ResultBuilder

Resultをコンピュテーション式に対応させてみます。

Option型と全く同じ内容となっています。

type ResultBuilder() =
    member this.Bind(x, f)    = Result.bind f x
    member this.Return(x)     = Ok x
    member this.ReturnFrom(x) = x

let result = ResultBuilder()

下記のように利用できます。

let divide x y =
    if y = 0.0 then Error "zero div"
    else            Ok (x / y)

let x =
    result {
        let! a = divide 100.0 2.0
        let! b = divide a 2.0
        let! c = divide b 0.0
        let! d = divide c 2.0
        return d
    }
    // Error "zero div"

レコード型のフィールド隠蔽（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で下記のパッケージを取得します。

データベース準備

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を取得します。

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))