ようこそ。睡眠不足なプログラマのチラ裏です。

マルコフ連鎖とビタビアルゴリズム(HMM)を F# で。

プログラミング F# 統計 機械学習 アルゴリズム ネタ


元ネタ

昼食時に店で流れていた、大事MANブラザーズバンド「それが大事」の歌詞が、あまりに繰り返しばかりなので、状態遷移図を作りました。どうぞご利用下さい。
http://youkoseki.com/soregadaiji/


「それが大事」にマルコフ連鎖を適用してみる
https://www.evernote.com/shard/s70/sh/71947f67-ee6c-405f-92a2-1d64fd631639/2d9397138827808cbc21c36c9389f642


マルコフ連鎖で「それが大事」っぽい歌詞を自動生成する
http://vilart.sakura.ne.jp/daijiman.html




自動生成された文字列が違和感なく連鎖するのがいいね！ネタのチョイスが面白くってちょっと書いてみたくなった。大事MANブラザーズバンドの大ヒット曲「それが大事」っぽい歌詞をマルコフ連鎖で自動生成。これを F# でやってみる。形態素解析には .NET で MeCabが簡単に使えるNMeCabを利用させてもらう。


open System
open System.Collections.Generic 
open NMeCab 
open Microsoft.FSharp
open Microsoft.FSharp.Core 

let tagger = MeCabTagger.Create ()
let parse format s = 
  tagger.OutPutFormatType <- format
  tagger.Parse s

let src = @"負けない事・投げ出さない事・逃げ出さない事・信じ抜く事
駄目になりそうな時　それが一番大事
負けない事・投げ出さない事・逃げ出さない事・信じ抜く事
涙見せてもいいよ　それを忘れなければ
Oh

高価な墓石を建てるより　安くても生きてる方がすばらしい
ここにいるだけで　傷ついてる人はいるけど
さんざん我侭言った後　あなたへの想いは　変わらないけど
見えてるやさしさに　時折負けそうになる

ここにあなたがいないのが　淋しいのじゃなくて
ここにあなたがいないと思う事が淋しい(でも)
負けない事・投げ出さない事・逃げ出さない事・信じ抜く事
駄目になりそうな時　それが一番大事

高価なニットをあげるより　下手でも手で編んだ方が美しい
ここに無いものを　信じれるかどうかにある

今は遠くに離れてる　それでも生きていれば　いつかは逢える
でも傷つかぬように　嘘は繰り返される

ここにあなたがいないのが　せつないのじゃなくて
ここにあなたがいないと思う事がせつない

でも
負けない事・投げ出さない事・逃げ出さない事・信じ抜く事
駄目になりそうな時　それが一番大事

負けない事・投げ出さない事・逃げ出さない事・信じ抜く事
駄目になりそうな時　それが一番大事
負けない事・投げ出さない事・逃げ出さない事・信じ抜く事
涙見せてもいいよ　それを忘れなければ

負けない事・投げ出さない事・逃げ出さない事・信じ抜く事
駄目になりそうな時　それが一番大事
負けない事・投げ出さない事・逃げ出さない事・信じ抜く事
涙見せてもいいよ　それを忘れなければ"

// NMeCabで分かち書き
let wakati s = 
  if s = "" then [||] 
  else
    let split separators x = (x:string).Split(separators) 
    let wk = parse "wakati" s 
    split [|' '|] wk |> Array.toList |> List.toArray  

// N階マルコフ
let markov n source = 
  let model = new Dictionary<_,_> ()
  let add k (v:string) = 
    if not <| model.ContainsKey k then 
      model.Add(k,[])
    model.[k] <- model.[k]@[v]

  let mutable p = Array.create n "" |> Array.toList 
  for next in source do
    add (p) next
    p <- (List.tail p) @[next]
  let s = (List.tail p) |> List.reduce (fun x y -> x + y)
  let lst = (s).Replace("\r", "").Replace("\n", "")
  add (p@[lst]) null
  model

// N階マルコフ連鎖で文章生成
let generateMarkovChain n first source =
  let random = new Random ()
  let model = markov n source
  let keyValuePairs = (model.Keys :> seq<_>)
  let generate p = 
    let sentence = fun p -> 
      if model.ContainsKey(p) then 
        let candidate = model.[p]
        let next = candidate.[random.Next (candidate.Length)]
        Some (next,(List.tail p)@[next])
      else
        None
    Seq.unfold sentence p
    |> Seq.fold (fun a b -> a + b) "" 
  first (keyValuePairs) |> generate

wakati src
|> generateMarkovChain 2 (fun keys -> keys |> Seq.head) 
|> fun s -> s.Replace ("\r","\r\n") 
|> printfn "%s"

Console.ReadKey () |> ignore

元ネタと同じことができた。人工無能や twitter の bot を作る時なんかのたたき台くらいにはなりそう。やる予定ぜんぜんないけど。これといって見どころはありませんが、しいて言うなら単純マルコフ過程固定ではなく、N 階マルコフ過程な連鎖を表す関数にしてるところくらいでしょうか。で、好奇心がわいてきたのでなんとなーく関連情報をいろいろ漁っていく。すると、「マルコフ連鎖モンテカルロ法」、「隠れマルコフモデル」、「ビタビアルゴリズム」、「バウム・ウェルチアルゴリズム」などなどいろいろと面白そうなキーワードが出てくる。




マルコフ連鎖モンテカルロ法については、テラモナギさん(@teramonagi)　のスライドがとても面白かった。


マルコフ連鎖モンテカルロ法入門−1
http://d.hatena.ne.jp/teramonagi/20100913/1284387360



マルコフ連鎖モンテカルロ法入門−２
http://d.hatena.ne.jp/teramonagi/20101003/1286079803



統計や機械学習については完全に門外漢であるし、いろいろとわからないことだらけの私だが。面白いものは面白い。




隠れマルコフモデルとビタビアルゴリズム


尤度よりも犬度が。犬度よりも猫度が気になる今日このごろ。



遠くに住んでいる友達が、毎日何をしたかを電話で教えてくれます。友達は「散歩」、「買物」、「掃除」の３つのことにしか関心がありません。友達が住んでいるところの天気の明確な情報は持っていないが、友達が何をするかはその日の天気で決める傾向があることは知っている。たとえば「雨」だったら５０％の確率で「掃除」をするとか、「晴れ」だったら６０％の確率で「散歩」をするなどです。また、天気の状態は「雨」、「晴れ」のいずれかで、たとえば今日が雨だったら明日が晴れの確率は３０％、雨の確率は７０％という具合に、天気は離散マルコフ連鎖に従うとします。このとき、天気の状態は友達がする行動に隠れている(hidden)と見なすことができる。友達はその日の天気に従って「散歩」、「買い物」、「掃除」のいずれか１つだけ行動をとって教えてくれるので、これらは観測(observations)できる対象と見なせる。このとき、これは隠れマルコフモデル (HMM：Hidden Markov Model) 的である、と言う。


天気の傾向と、友達はどのような行動をとるかという傾向を知っているとき。言い換えると、隠れマルコフモデルのパラメータについて知っているということを意味していて、たとえば、友達が初日に散歩をして、２日目に買い物を。３日目に掃除を、というような順番に行動とったとき、その観測結果が得られる確率はいくらか？そして、このような観測結果がえられたとき３日間（とその翌日）の天気はどのようであったか？ということを予測したい。前者は前向きアルゴリズムを。後者はビタビアルゴリズム*1を用いることで求めることができる。



という内容の隠れマルコフモデルの例（コードはPython）がWikipediaに出ている。


隠れマルコフモデル - Wikipedia
http://goo.gl/oDu5k



ビタビアルゴリズム - Wikipedia
http://goo.gl/tbpnO




これを F# で書いてみる。



Program.fs

open HMM

// 状態（ラベル）：雨 | 晴れ
type States = Rainy | Sunny
// 観測されたもの：散歩 | 買い物 | 掃除
type Observations = Walk | Shop | Clean

// 初期確率
let startingProbs = [Rainy, 0.6; Sunny, 0.4] |> Map.ofList

// 状態（ラベル）の遷移確率
let transitionProbs = 
    [(Rainy,Rainy), 0.7; (Rainy,Sunny), 0.3
     (Sunny,Rainy), 0.4; (Sunny,Sunny), 0.6]
    |> Map.ofSeq

// それぞれの観測された行動に対する、状態（ラベル）の出力確率
let emissionProbs =
    [(Rainy, Walk), 0.1; (Rainy, Shop), 0.4;  (Rainy, Clean), 0.5
     (Sunny, Walk), 0.6; (Sunny, Shop), 0.3;  (Sunny, Clean), 0.1]
    |> Map.ofSeq

// 開始確率を取得します。
let startProbability s = startingProbs.[s]
// 遷移確率を取得します。
let transitionProbability spair = transitionProbs.[spair]
// 出力確率を取得します。
let emissionProbability sopair = emissionProbs.[sopair]

let obs = [Walk; Shop; Clean]
let states = [Rainy;Sunny]

let viterbi = Viterbi(obs, states, startProbability, transitionProbability, emissionProbability) 

assert (viterbi.TotalProb = 0.0336)
viterbi.TotalProb |> printfn "%A"
assert (viterbi.ViterbiPath = [Sunny;Rainy;Rainy;Rainy])
viterbi.ViterbiPath |> printfn "%A" 
assert (viterbi.ViterbiProb = 0.009408)
printfn "%A" viterbi.ViterbiProb


Viterbi.fs

namespace HMM
open System

type dict<'a, 'b> = Collections.Generic.Dictionary<'a,'b>

[<AutoOpen>]
module HMM = 
  type Viterbi<'o,'s when 's:equality>
    ( obs : seq<'o>,
      states : seq<'s>,
      sp : 's -> float,
      tp : 's * 's -> float,
      ep : 's * 'o -> float) as this =

    let mutable last = dict<'s, float * float>()
    let mutable current = [dict<'s, float * float>()]
    let viterbiPath = dict<'s,'s list>()

    let initialize (o,states) =
      for state in states do
        last.[state] <- ((sp state), (sp state) * ep(state,o))
        viterbiPath.[state] <- [state]
      current <- [last]

    let nextState f states =
      let next = dict<'s, float * float>()
      let add = fun (target, state, cp, prob) ->
        next.[target] <- (cp, prob)
        viterbiPath.[target] <- target::viterbiPath.[state]

      let junction = fun target ->
        states 
        |> Seq.map (fun state ->
          let _,sp = last.[state]
          let cp, prob = f state target sp
          target,state, cp, prob) 
        |> Seq.maxBy (fun (_,_,_,prob) -> prob)

      states 
      |> Seq.map (junction)
      |> Seq.iter(add)

      last <- next
      current <- next::current

    let lastViterbiState () = current.Head |> Seq.maxBy (fun kv -> kv.Value) 

    do
      this.Execute (obs, states)

    /// ビタビ経路の最後の状態
    member x.LastViterbiState = lastViterbiState ()

    /// 実行
    member private x.Execute(obs, states) =
      let f = fun o state target sp ->
        let cp = ep(target, o)
        cp, sp * cp * tp(state, target) 

      for i,o in (obs |> Seq.mapi (fun i x -> i,x)) do
        if i = 0 then 
          initialize (o, states)
        else
          nextState (f o) states

      let g = fun state target sp ->
        let lastViterbiState = x.LastViterbiState
        let cp = tp(lastViterbiState.Key, target)
        cp,  sp * cp
      // 与えられたパラメータから推察される次の状態
      nextState g states

    /// 与えられたパラメータに対する全体確率
    member x.TotalProb =
      x.ViterbiPathProb ()
      |> List.mapi (fun i (state,(ep,vp)) -> if i = 0 then vp else ep)
      |> Seq.reduce (fun x y -> x * y)

    member private x.ViterbiPathProb () = 
      let lastViterbiState = x.LastViterbiState
      viterbiPath.[lastViterbiState.Key] 
      |> List.mapi (fun i state -> state,current.[i].[state] )
      |> List.rev 

    /// ビタビ経路(最も尤もらしい並び。尤度が最も高い経路。)を取得します。
    member x.ViterbiPath = 
      x.ViterbiPathProb ()
      |> List.map (fun (state,(ep,vp)) -> state)

    /// ビタビ経路の確率
    member x.ViterbiProb = 
      let lastViterbiState = x.LastViterbiState
      let _,vp = current.Head.[lastViterbiState.Key]
      vp

    member x.Path = current

実行結果

0.0336
[Sunny; Rainy; Rainy; Rainy]
0.009408


F#で書いてみましたというだけで、特に面白みはない。
実行結果を見る限りは多分あっているぽい。けど、門外漢が適当に勘で書いたものなので鵜呑みはせぬようよろしくオナシャス。

*1:観測された事象系列を結果として生じる隠された状態の最も尤もらしい並びをビタビ経路と呼ぶ