適当に考えた言語での受理について

先日twitterに

このようなことを書きました．

若干数反応を頂けたのですが，その時は何も考えてなかったのでうんともすんとも言えなかったのです．どうせCFL程度だろとかは思っていたのですが．
しかし，研究室に持ち込んでなんか上手い証明方法とかあるんですかねーなど尋ねたところ，いやこれCFLではないでしょうというヒントを貰ったのでニコニコ動画みながらグダグダ書いたのを取りあえずメモ代わりに書いておきます．

まずDCFLでない例

ウィキピディア（http://en.wikipedia.org/wiki/Deterministic_context-free_language）によると，

For example, the language of even-length palindromes on the alphabet of 0 and 1 has the simple, unambiguous grammar S → 0S0 | 1S1 | ε, but it cannot be parsed by a deterministic push down automaton.

とまぁそうなっているので実際にこの例を受理出来ればよいという話で．

type stack = Bottom | Push of (char * stack)

let stack_from_list l =
  List.fold_right (fun e acc -> Push (e , acc)) l (Push ('Z',Bottom))

let entire = ref (stack_from_list ['a';'b';'a';'a'])

let pop () =
  match !entire with
    | Push (c ,rest) -> entire := rest

let push c = entire := Push (c , !entire)

let top () =
  match !entire with
    | Push (c,_) -> c

let other = function
  | 'a' -> 'b'
  | 'b' -> 'a'

(*
  stackの底の印Zのすぐ上に c があればそれを削除
  もしc以外が存在すれば yabai
  底の印Zが最初から見えていても yabai
*)
let rec del_char (c:char) =
  if top () = 'Z'
  then failwith "yabai"
  else if top () = c
  then
    begin
      pop ();
      if top () <> 'Z'
      then begin
	del_char c;
	push c
      end
      else () (* 1つ先読みして底が見えればそれだけが取り除かれ再構築される *)
    end
  else if top () = other c
  then
    begin
      pop ();
      del_char c;
      push (other c)
    end

let del_a () = del_char 'a'
let del_b () = del_char 'b'

let rec f () =
  if top () = 'a'
  then
    begin
      pop ();
      del_a ();
      f ();
    end
  else if top () = 'b'
  then
    begin
      pop ();
      del_b ();
      f ();
    end
  else if top () = 'Z'
  then ()
  else failwith "yabasugi"

なんかまぁデロデロとこんな感じで書けました．別に証明とかはしてないですが，fを実行すると偶数長回文になっている時だけに，終了後スタックが空（底目印Zだけが積まれている）状況になる気がします．

やっていることは簡単で，スタックトップからボトムに向かって下って行くわけですが，その下る時に，スタックトップの文字と同じ文字がボトム（底Zのすぐ上）に在れば削り，無ければその時点で例外を投げちゃう．
削った後にトップをポップして，底目印Zが見えてくるまでこれを続ける…という具合でうまく行きそう．

CFLでない例

次にCFLでない例として有名な言語{a^n b^n c^n}を受理させます．

type stack = Bottom | Push of (char * stack)

let stack_from_list l =
  List.fold_right (fun e acc -> Push (e , acc)) l (Push ('Z',Bottom))

let entire = ref (stack_from_list ['a';'a';'b';'b';'c';'c'])

let pop () =
  match !entire with
    | Push (c ,rest) -> entire := rest

let push c = entire := Push (c , !entire)

let top () =
  match !entire with
    | Push (c,_) -> c

(*
  スタックトップからみて行って，c2に一致するアルファベットがあれば
  それをc1で置き換える
*)
let rec replace_char c1 c2 =
  if top () = c2
  then begin
    pop ();
    push c1;
  end
  else
    let a = top () in
    pop ();
    replace_char c1 c2;
    push a

(*
  fでは，スタックトップからaの連続している間，底に向かう．
  その間，aをpopしつつ，最も近くにあるbをyで置き換える．
*)
let rec f () =
  if top () = 'a'
  then begin
    pop ();
    replace_char 'y' 'b';
    f ();
  end
  else ()

(*
  yとして置き換わっていないbがあるかどうか調べる．
  これがあるということは，aの連続している長さよりも
  多い数bが存在しているので，例外を投げる
*)
let rec check_b () =
  if top () = 'b'
  then failwith "check_b find b"
  else if top () = 'Z'
  then ()
  else
    let a = top () in
    pop ();
    check_b ();
    push a

(*
  スタックに残っている物が，y^n c^nの形になっているかを
  調べるだけ．
*)
let rec g () =
  if top () = 'y'
  then begin
    pop ();
    g () ;
    if top () = 'c'
    then pop ()
    else failwith "fail in g"
  end
  else if top () = 'c'
  then ()
  else failwith "fail in g"

let main () =
  f ();
  check_b ();
  g ();
  if top () = 'Z'
  then print_endline "accept"
  else print_endline "reject"

やることというのは，a^n b^nというのがスタックのトップ側に出て来ているかを調べて，ボトム側にb^n c^nがあるかどうかを調べるという2段構えのようなものになっています．雰囲気としては{a^n b^n c^m}と{a^n b^m c^m}のintersectionを取る感じなのかなー．それはともかく．

まず関数fでスタックトップからボトムにaが連続する間くだっていくわけですが，その際に最もトップ側にあるbをアルファベットyで置き換えるようにします．
次に，check_b関数でスタックにbが残っているか，つまりyに置き換わっていないbが存在するかを調べます．これはまぁaの連続する出現長とbの出現長が一致しているかを調べているわけです．
で，その後はy^m c^mがスタックトップ側に残っているかどうかを関数gで調べるという手筈です．

すごい適当に書いたので

あとで書き直そう