パーサコンビネータを使って簡単なNGワードフィルタリング機能を作る

昔、 RSpec の入門とその一歩先へ - t-wadaの日記 を読んで「自分だったらどうつくるかなー」と考えていた。

そして時が経ち、パーサコンビネータを知った今となっては、簡単なものであればこれでいいんじゃないかと思っている。

というわけで、以下は F# の ParsecClone というライブラリを使った例。

フィルタリング対象の文字列を発見する

利用者が指定したワードにマッチするようにすればよい。

// cutting : string -> string
// word: NGワード
let dirtyToTurn cutting word = matchStr word |>> cutting

マッチしたら伏せ字に入れ替える関数を適用すれば、それらしいものになる。

NGワードを複数登録できるようにする

NGワードリスト内のどれかにマッチするようにする。

// words: NGワードリスト
let dirtyToTurn cutting words = anyOf matchStr word |>> cutting

それ以外の文字列

任意の文字列にマッチすれば良い。ParsecClone の場合は any 関数が合致する。

文章を構成する

文章は、NGワードとそれ以外の文字列が0個以上組み合わさっている、と考えられる。

let parser cutting dirtyWords =
  many (dirtyToTurn cutting dirtyWords <|> aby) >>= foldStrings

foldStrings は ParsecClone に存在する関数で、parse した文字列のリストを連結してくれる Parser。

NGワードが含まれているか判定したい

巷のパーサコンビネータライブラリは状態を持つことができるような仕組みを提供していることが多い。ParsecClone にも存在する。

let dirtyToTurn cutting words =
  anyOf matchStr word |>> cutting .>> setUserState true

let parser cutting dirtyWords =
  many (dirtyToTurn cutting dirtyWords <|> aby)
  >>= foldStrings
  .>>. getUserState

これで、最終結果としてNGワードが存在するかどうかとフィルタリング結果が取得できるようになる。

他にも色々やりたい

全角半角を区別せずにフィルタリングしたいとか、でもフィルタリング対象以外の文字列はきちんと復元されてほしいとか色々あるなら、もう少し実装を考える必要がある。

ソースコード

今回のコードは以下においている。

https://github.com/pocketberserker/Harvester

名前の由来はそのうち書く。

他の言語でできるの?

経験から、少なくとも Boost.Spirit(Qi, Karma)はこの手法で実装できる。 あと、割りと新顔の ParsecClone でもできるので、他のライブラリでもできるのではないかなとは思っている。

F# 用非公式 MessagePack ライブラリを作ってみている

F# 特化型です。

ソースコード

公式

公式は CLI 向けの msgpack-cli が存在します。

なぜ作ったの?

公式のものが F# 向きかと言われるとうーんと思い、なら勉強がてら趣味開発に利用しようというのと、公式の F#ラッパーを書く体力がなかったことが発端です。品質などを考えると、公式をラップしたほうが良いというのはわかっているのですが…。

現状

  • pack するためには MsgPackValue<'T when 'T :> comparison> という判別共用体に落としこむ必要あり
  • comparison なのは Map の影響
  • ext を任意の型にしたい場合は packExt<'T when 'T :> IPackable, comparison>, unpackExt<'T when 'T :> comparison>
  • ext を byte [] のまま保持するなら pack, unpack
  • 任意の型にしない場合、もしくは ext を使わない場合は MsgPackValue 型を用いる
  • tyep MsgPackValue = MsgPackValue;; (pack の関係で Unitが使えなかった…)
  • MsgPackValue を簡単に生成するための Limited モジュール
  • 旧仕様は OldSpec モジュールで提供
  • テストは基本的に FsCheck (array32 と map32 の重さに耐えられなかったけど!)
  • unpack の内部実装は PasecClone
  • 実行速度は後で考える

そのうちやりたい

  • 性能検査
  • シグネチャ調整
  • README含むドキュメント整備
  • Type Provider実装
  • Mono 対応 (Mono 3.2.7 だと F# 3.0 にバージョンを下げないといけない…etc)
  • Xamarin 系対応
  • パフォーマンス・チューニング
  • NuGet公開

「御託はいいからさっさと NuGet に公開しろ!」とか言われたら、最優先で対処します。

他にこれほしい、というものあれば twitter なり issue なり pull request なりでお願いします。ユーザ自分しかいなさそうですけどっ!

F# プロジェクトが利用できそうな外部CIサービスについてのメモ

タイトル通りだけど無料版っぽいものがあるもののみ対象。候補は4つ。

Travis

http://travis-ci.com/

みんな大好き Travis ちゃん。 どうやって動かすのかと思いきや、なんとLinux系ならapt-get、Macならmonoをwgetしてインストールするという荒業を使う。以下Macな環境を対象とした .travis.yml の例。

language: objective-c

env:
  matrix:
    - MONO_VERSION="3.2.7"

install:
  - wget "http://download.xamarin.com/MonoFrameworkMDK/Macx86/MonoFramework-MDK-${MONO_VERSION}.macos10.xamarin.x86.pkg"
  - sudo installer -pkg "MonoFramework-MDK-${MONO_VERSION}.macos10.xamarin.x86.pkg" -target /

script:
  - お好みにあわせて記述

Monoでテストが通るか試せるのは大きいけど、いいのかこれ…? mono 3.2.7 だとまだ FSharp.Core 4.3.1.0 は同梱されていないんじゃないかなー。あと色々面倒くさいので FAKE を併用したほうがよさげ。 FAKE 使いたくないのだけどなー。

利用実績

TeamCity

http://www.jetbrains.com/teamcity/

最初に"無料版っぽいもの"と書いた理由がこの人。 活発でウェブサイトを持っている、活動が活発なコミュニティの、フリーで非営利な開発プロジェクトについて(このあたり英訳あやしいので間違っていたらすみません)Open Source Licenseがあったりする。あくまでコミュニティ用。 使ったことがないのでこれ以上の言及は避ける。

利用実績

  • fsharp

AppVeyor

[2014/03/18 URL修正]

http://www.appveyor.com/

.NETに特化したようなCIサービス。特化しているだけあって、準備がラクダ。 ほとんど設定せずとも F# 3.1 で VS2013 なプロジェクトがビルド & テストできる。試してないけどデプロイもできるようだ。

利用実績

[2014/03/19 Visual F# Power Toolsを追加. id:bleis-tift さん、情報提供ありがとうございます。]

Visual Studio Online

http://www.visualstudio.com/products/visual-studio-online-basic-vs

コラボレーション(?)サービスなので、正確にはCIサービスではないけど一応。BasicだとExpressも対象に含められる。 "Basic プランでの最初の 5 人のユーザーと、資格のあるすべての MSDN サブスクライバー (Visual Studio Professional with MSDN 以上) "という記述の通りである。 F# 3.1 は試したことがないけど、たぶん大丈夫なのではー。

利用実績

自作ライブラリで試したことくらいしかないので、実績求む。

感想

用途にあわせて選べば良いかと。

F# でCPS版List.foldを作ってみよう

自分用メモ。

まず fold を作る

よく知られる List.fold の定義は、わかりやすいものであれば以下の様な形。

let rec fold' f acc = function
| [] -> acc
| x::xs -> fold' f (f acc x) xs

これをCPS(継続渡しスタイル)に書き換えると

// ('a -> 'b) -> (('a -> 'b) -> 'a -> 'c -> 'b) -> 'a -> 'c list -> 'b
let rec foldk k f acc = function
| [] -> k acc
| x::xs -> f (fun v -> foldk k f v xs) acc x

おそらくこんな感じ。使ってみる。

> foldk id (fun k acc x -> acc + x |> k) 0 [1..5];;
val it : int = 15

> foldk id (fun k acc x -> acc * x |> k) 1 [1..10];;
val it : int = 3628800

一番目の処理を展開してみよう。

foldk id (fun k acc x -> acc + x |> k) 0 [1..5]
(fun k acc x -> acc + x |> k) (fun v -> foldk id (fun k acc x -> acc + x |> k) v [2..5]) 0 1
0 + 1 |> (fun v -> foldk id (fun k acc x -> acc + x |> k) v [2..5])
foldk id (fun k acc x -> acc + x |> k) 1 [2..5]
(fun k acc x -> acc + x |> k) (fun v -> foldk id (fun k acc x -> acc + x |> k) v [3..5]) 1 2
1 + 2 |> (fun v -> foldk id (fun k acc x -> acc + x |> k) v [3..5])
foldk id (fun k acc x -> acc + x |> k) 3 [3..5]
(fun k acc x -> acc + x |> k) (fun v -> foldk id (fun k acc x -> acc + x |> k) v [4..5]) 3 3
3 + 3 |> (fun v -> foldk id (fun k acc x -> acc + x |> k) v [4..5])
foldk id (fun k acc x -> acc + x |> k) 6 [4..5]
(fun k acc x -> acc + x |> k) (fun v -> foldk id (fun k acc x -> acc + x |> k) v [5]) 6 4
6 + 4 |> (fun v -> foldk id (fun k acc x -> acc + x |> k) v [5])
foldk id (fun k acc x -> acc + x |> k) 10 [5]
(fun k acc x -> acc + x |> k) (fun v -> foldk id (fun k acc x -> acc + x |> k) v []) 10 5
10 + 5 |> (fun v -> foldk id (fun k acc x -> acc + x |> k) v [])
foldk id (fun k acc x -> acc + x |> k) 15 []
id 15
15

うん、良い感じ。ただ、継続が最後の引数になるようにしたほうがよいかもしれないと思ったり。

他の関数を定義してみる

簡単な sum から。

let sum k xs = foldk k (fun k x y -> x + y |> k) 0 xs

> sum id [1;2;3];;
val it : int = 6

> sum (~-) [1;2;3];;
val it : int = -6

次に map

let map k f xs = foldk k (fun k xs x -> seq { yield! xs; yield f x } |> Seq.toList |> k) [] xs

> map id ((*) 2) [1..5];;
val it : int list = [2; 4; 6; 8; 10]

続きはまたそのうち。

継続渡しスタイルを使ってListコンピュテーション式を実装する

引き続き、コンピュテーション式を継続渡しスタイルで実装する編です。 今回は、

コンピュテーション式におけるreturnとyield - ぐるぐる~

で定義されているListコンピュテーション式を、継続渡しスタイルで実装してみましょう。 なお、Using や Whileなど省略しているメソッドは、型以外同じ(型推論に任せればまったく同じ)実装になるため省略します。

実装

type ListBuilder internal () =
  member this.Zero() = fun k -> k []
  member this.Return(x) = fun _ -> [x]
  member this.ReturnFrom(xs: _ list) = fun _ -> xs
  member this.Yield(x) = fun k -> k [x]
  member this.YieldFrom(xs: _ list) = fun k -> k xs
  member this.Bind(xs, f) =
    let rec fold acc = function
    | [] -> this.Zero()
    | [x] -> acc x
    | x::xs -> fold (fun y k -> acc x (fun l -> List.append l (f y k))) xs
    fold f xs
  member this.Combine(f, rest) =
    fun k -> f (fun xs -> rest () k |> List.append xs)
  member this.Delay(f) = f
  member this.Run(f) = f () id

Bind が今までとは少し毛色が異なるので、解説しておきます。

Bind

第一引数は 'a list、第二引数は 'a -> ('a list -> 'b list) -> 'b list) であればよいことは、変換規則を考慮するとすぐに思い至ります。

空リストに関しては、 Zero の結果を使えば事足ります。要素が一つの場合は、第二引数の関数を適用すればよいことも難しくはないでしょう。

複数要素が存在する場合は fold に似た動きをさせることで解決しました。アキュムレータとして渡されるものが関数という点を除けば、そんなに難しいものでもないです。単純に List.fold にできないのは、戻り値の型が 'a -> ('a list -> 'b list) -> 'b list) になってしまうからですね。

List.append を使った影響でパフォーマンス悪化が懸念として残っていますが、それはおいおい性能調査していくつもりです。

2014/02/10 追記:Seq ベースにする

id:bleis-tift さんと相談して、 Seq ベースにしてみました。

2014/02/12追記: CPS版 Seq.fold を定義すればより簡潔になるので変更。ついでに一部メソッドで Seq モジュールの関数を使うように修正。

type ListBuilder internal () =
  member this.Zero() = fun k -> k Seq.empty
  member this.Return(x) = fun _ -> Seq.singleton x
  member this.ReturnFrom(xs: _ list) = fun _ -> Seq.ofList xs
  member this.Yield(x) = fun k -> Seq.singleton x |> k
  member this.YieldFrom(xs: _ list) = fun (k: _ seq -> _) -> k xs
  member this.Bind(xs, f) =
    // Seq.fold の CPSlet rec fold f acc xs k =
      if Seq.length xs = 0 then k acc
      else f (fun v -> fold f v (Seq.skip 1 xs) k) acc (Seq.head xs)
    fold (fun k acc x -> seq { yield! acc; yield! f x k; }) Seq.empty xs
  member this.Combine(f, rest) =
    fun k -> f (fun xs -> rest () k |> Seq.append xs)
  member this.Delay(f) = f
  member this.Run(f) = f () id |> Seq.toList

いくつかの部分に、 'a list'a seq と認識させるための仕込みを入れている以外は、List ベースのものとほとんど変わりません。

おわりに

継続渡しスタイルを使えば、コンピュテーション式の制御をわりと楽に行えて便利ですね。そのかわり、ラップして使用するには継続渡しスタイルを知っていなければなりませんが…。

継続を使ってOptionコンピュテーション式を実装する

前提

下記記事を読んでいることが前提となります。

コンピュテーション式の実装にStateを用いる - pocketberserkerの爆走

注意事項

  • 継続に関する解説はしません
  • この記事のコードが理解できなくてもコンピュテーション式は使うことができます

継続、しませんか

そもそもこの話は、コンピュテーション式のキーワードによって計算を継続するかどうか切り替えたい、というのが元々のお話でした。そして継続というと、この界隈にいれば一度は単語を聞いたことがあるだろう、継続モナドが真っ先に思いつくのが自然ですよね。

というわけで、件の OptionBuilder を、継続の概念を用いて実装してみましょう。

定義

先に実装を掲載しておきます。なお、 TryWith, TryFinally, While, For は既存と変更はないため、省略します。

type Cps<'T, 'R> = | Cps of (('T -> 'R) -> 'R)

type OptionBuilder internal () =
  member this.Zero() = Cps (fun k -> k None)
  member this.Return(x) = Cps (fun _ -> Some x)
  member this.ReturnFrom(x: _ option) = Cps (fun _ -> x)
  member this.Bind(x: _ option, f: _  -> Cps<_ option, _>) =
    match x with
    | Some x -> f x
    | None -> this.Zero()
  member this.Using(x: #IDisposable, f: #IDisposable -> Cps<_ option, _>) =
    try f x
    finally match box x with null -> () | notNull -> x.Dispose()
  member this.Combine(x, rest) =
    Cps (fun k -> match x with | Cps f -> f (fun value -> match rest () with | Cps g -> g k))
  member this.Delay(f) = f
  member this.Run(f) = match f () with | Cps x -> x id

Cps

わかりやすく(?)するために導入しています。

Zero

引数として受け取った関数に計算結果を適用するラムダ式を返します。

Return, ReturnFrom

引数の関数は使わずそのまま値を返します。こうすることで、後続の計算をすべて破棄しています。

Bind

渡された option が Some であれば Cps に束縛します。None の場合は Zero メソッドに依存します。今回は継続する形にしました。

Using

型が異なること以外は Bind と大した差はありません。

Combine

x, rest, 渡された引数の順に計算を行うラムダ式Cps でくるんで返します。

return などでは、引数として渡される関数は破棄しているので、後続の処理がひたすら破棄されるのがわかると思います。

Run

最終的に Option コンピュテーション式は Option を返したいので、 型を取り外して返します。

このコンピュテーション式は今まで通りの式をかけるのか?

少なくとも Basis.Core.OptionBuilder 用のテストは、テスト側は一切修正せずとも全件パスしたので、その範囲においては動作すると思われます。

継続渡しスタイルで

ここまでくると型いらないだろう、ということで。

type OptionBuilder internal () =
    member this.Zero() = fun k -> k None
    member this.Return(x) = fun _ -> Some x
    member this.ReturnFrom(x: _ option) = fun _ -> x
    member this.Bind(x, f) = x |> Option.map f |> getOrElse this.Zero
    member this.Using(x: #IDisposable, f) =
      try f x
      finally match box x with null -> () | notNull -> x.Dispose()
    member this.Combine(f, rest) = fun k -> f (fun _ -> rest () k)
    member this.Delay(f) = f
    member this.Run(f) = f () id

見た目はシンプルですが、シグネチャがすごいことになっています。が、定義する側としてはこちらのほうが楽ですね。

終わりに

というわけで、継続渡しスタイルはこういうところで使えるよ、という例でした。

Listコンピュテーション式にyield breakもどきを作れないかあがいてみた

コンピュテーション式におけるreturnとyieldにも書かれている通り、カスタムオペレーターで yield break を実装することはできません。では、型の力をつかってどうにかできないか、とあがいてみました。

Builder の定義

前述の記事で掲載されている ListBuilder の定義を少し変更します。なお、下記コードでは変更のない部分を省略しています。

module Control =
    type YieldControl<'a> = Break | Return of 'a

open System
open Control // オープンする順序で Break の優先順位を決める
open Basis.Core.ComputationExpr

type ListBuilder internal () =

  ...

  member this.YieldFrom(x) =
    match x with
    | YieldControl.Break -> (this.Zero() |> fst, Break)
    | YieldControl.Return x -> this.Return(x)

  ...

すると、

open Control

list {
  for x in [1; 2; 3; 4; 0; 5; 6] do
    if x = 0 then
      yield! Return -1
    yield x
  return 10
} // equal [1; 2; 3; 4; -1]

list {
  for x in [1; 2; 3; 4; 0; 5; 6] do
    if x = 0 then
      yield! Break
    yield x
  return 10
} // equal [1; 2; 3; 4]

と、ちょっと残念な形で yield break (ついでに yield return)もどきを記述できます。

Yield メソッドを使えない理由

既存の Yield は 'a -> 'a list * FlowControl です。仮に YieldControl<_> -> 'a list * FlowControl を定義したとしても、呼び出し側でどちらを呼べばいいかの型注釈をつける必要がでてきます。

YieldFrom は list を受け取るメソッドしか存在しないため、どのメソッドを呼び出せばよいか判別できます。なので型注釈も必要ありません。

結論

定義が複雑になるくらいなら、素直に return! [] を使ったほうがよさそうですね。