A20 - LCS

入出力

1
2
3
let S = stdin.ReadLine()
let T = stdin.ReadLine()
solve S T |> stdout.WriteLine

方針

やはりこれも動的計画法で対処する典型的な問題です. 改めて書くと最長の部分文字列を見つけるためには全探索が必要です. それをパターンにはめて書くのがポイントです. さらに文字を積んでいくだけの簡単な修正で最長の部分文字列も取れます. このコードも簡単に紹介します.

命令型的なふつうのコードでも十分に読みやすく書きやすいため, 今回もメインは命令型的なコードです. 関数プログラミングだとどう書くのかと思い, Haskellのコードを漁ってみたところ, 今の私の腕では読みやすくも書きやすくもない状態です. さらにいまの私の腕で対応できるHaskellコードの直移植だとF#ではパフォーマンスも出ません. 念のため関数型コードも紹介しますが, とりあえずは命令型的なコードが読み書きできれば十分です.

解説: 命令型コード

文字列長だけ

大枠

今回は二重配列で状態を管理します. 大枠は次のように書けます.

1
2
3
4
5
6
7
  let sLen = String.length S
  let tLen = String.length T
  (Array2D.create (sLen+1) (tLen+1) 0, [|0..sLen-1|])
  ||> Array.fold (fun dp i ->
    // 何かしらの処理
    dp)
  |> fun dp -> dp.[sLen,tLen]

あとはfoldの内部を考えます.

fold

それぞれの文字列の長さの配列を作り, ループの添字を(i,j)としましょう. もしS.[i] = T.[j]になったら値を足せばよいです. そうでない場合は値が大きい方を適切に取ります.

文章よりもコードを読んだ方が簡単です. 具体的には次のように書きます.

1
2
3
4
5
6
  (Array2D.create (sLen+1) (tLen+1) 0, [|0..sLen-1|])
  ||> Array.fold (fun dp i ->
    [|0..tLen-1|] |> Array.iter (fun j ->
      if S.[i]=T.[j] then dp.[i+1,j+1] <- dp.[i,j]+1
      else dp.[i+1,j+1] <- max dp.[i,j+1] dp.[i+1,j])
    dp)

どうせ破壊的に配列を変更するなら[|0..tLen-1|]も無理にArray.foldにせず, Array.iterで最後にdpを返す方が読み書きしやすいです.

まとめ

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
let solve S T =
  let sLen = String.length S
  let tLen = String.length T
  (Array2D.create (sLen+1) (tLen+1) 0, [|0..sLen-1|])
  ||> Array.fold (fun dp i ->
    [|0..tLen-1|] |> Array.iter (fun j ->
      if S.[i]=T.[j] then dp.[i+1,j+1] <- dp.[i,j]+1
      else dp.[i+1,j+1] <- max dp.[i,j+1] dp.[i+1,j])
    dp)
  |> fun dp -> dp.[sLen,tLen]

let S = stdin.ReadLine()
let T = stdin.ReadLine()
solve S T |> stdout.WriteLine

部分文字列も取る

積む値を整数と文字のリストのタプルに変えます. こちらは簡素に結論だけにしましょう.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
let solveWithSubString S T =
  let sLen = String.length S
  let tLen = String.length T
  (Array2D.init (sLen+1) (tLen+1) (fun _ _ -> 0,([]:char list)), [|0..sLen-1|])
  ||> Array.fold (fun dp i ->
    [|0..tLen-1|] |> Array.iter (fun j ->
      if S.[i]=T.[j] then dp.[i+1,j+1] <- (1+fst dp.[i,j], (S.[i]::snd dp.[i,j]))
      else
        dp.[i+1,j+1] <-
          let (n1,s1),(n2,s2) = dp.[i,j+1],dp.[i+1,j]
          if n1<n2 then (n2,s2) else (n1,s1))
    dp)
  |> fun dp -> dp.[sLen,tLen]

解説: 関数型コード

元にしたのはこのHaskellコードです. 私が味を汲み尽くしきれていない可能性もあります. こちらは文字列長の計算だけ簡潔に紹介します.

関数型コードも本質的には命令型コードと同じです. しかし遅延型リストのHaskellではさっと書ける部分がF#ではもたつきます. Listの代わりにSeqを使えばさっと書ける部分はあるものの, 今度はSeq.consがないためにもたつく部分があります.

補助変数・関数

次の二つを準備します.

1
2
  let sLen = String.length S
  let init xs = if List.length xs <= 1 then [] else xs.[0..(List.length xs-2)]

後者はF#のList.initではなくHaskellのData.List.initの移植で, リストの最後の項を除いたリストを返します.

大枠

次のように書きます.

1
2
3
4
  let lcs Ss Ts =
    (Ts, List.replicate (1+sLen) 0)
    ||> List.foldBack (fun y dp -> "適切な処理")
  lcs (S |> Seq.toList) (T |> Seq.toList)

ここでメインがfoldBackになっているのがポイントです. 少なくとも以下で解説する書き方をfoldで書くと, 例えばS = "bceae"とT = "eddce"の組で適切な値2ではなく3が得られてしまいます. なぜかというとS.[1..2] = "ce"とT.[3..4] = "ce"のマッチが最長である一方, 処理の途中でS.[4] = 'e'とT.[4] = 'e'のマッチが入って3が返ってきてしまうからです. これを避けるために右からマッチさせるべくfoldBackを使っています.

左から順に処理する命令型的なコードと違い, 右から処理するfoldBackを使わなければいけないのも関数型コードの難しい点です.

fold

次のように書きます.

1
2
3
4
5
6
7
  let lcs Ss Ts =
    (Ts, List.replicate (1+sLen) 0)
    ||> List.foldBack (fun y dp ->
      let l3 = List.zip3 Ss (init dp) (List.tail dp)
      (l3, [0]) ||> List.foldBack (fun (x,n1,n2) dp ->
        if x=y then (1+n2)::dp else max n1 (List.head dp) :: dp))
    |> List.head

F#でもたつく部分がl3です. Haskellではinit dpは単にdpと書けます. あとは命令型コードと比較すると意図は明確でしょう. 命令型dp.[sLen,tLen]と違い, こちらはリストのconsで前に最長の値を積んでいるため, 最後に値を取得する部分はList.headで取ります. リスト処理で値が取りやすいようにしている点にも注意してください.

まとめ

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
let solve S T =
  let sLen = String.length S
  let init xs = if List.length xs <= 1 then [] else xs.[0..(List.length xs-2)]
  let lcs Ss Ts =
    (Ts, List.replicate (1+sLen) 0)
    ||> List.foldBack (fun y dp ->
      let l3 = List.zip3 Ss (init dp) (List.tail dp)
      (l3, [0]) ||> List.foldBack (fun (x,n1,n2) dp ->
        if x=y then (1+n2)::dp else max n1 (List.head dp) :: dp))
    |> List.head
  lcs (S |> Seq.toList) (T |> Seq.toList)

let S = stdin.ReadLine()
let T = stdin.ReadLine()
solve S T |> stdout.WriteLine