正規表現推論

正規表現にマッチする語の例(正例)とマッチしない語の例(負例)が与えられた時、正規表現を推論しましょうという問題。とりあえず、効率とか何も考えず、原理的に可能だということを示すだけのコードを書いてみた。極めて非効率的なので、実用性は皆無

[説明]
例は(無限に続きうるけど)有限個なので、正例と矛盾する負例がない限り、正例p1,p2,...,p_nがあったら、p1|p2...|p_nは一つの答えになってしまうわけだけど、"a","aa","aaa"と正例があったら、"a*"とか"a+"を推論して欲しい。勿論、その後で、"aaaa"にはマッチしないということが判明するかもしれないので、その場合は、適当に巻き戻って推論をやり直すことになる。

推論アルゴリズムが"よい"かどうかの判定基準としては、極限同定という概念がある(Gold,1967)けど、極限同定の定義はどーでもよくて、今の場合極限同定する最も単純なアルゴリズムというのは、(アルファベット集合を与えた時)正規表現の全体は枚挙可能なので、正規表現を枚挙していって、正しい答えを順に探しましょうという、ただのbrute force。当然これは非効率的過ぎる。負例にマッチしてしまう正規表現より"強い"(元の正規表現にマッチする全ての例にマッチするという意味)正規表現は試す価値がない。同様に、正例にマッチしない正規表現より"弱い"正規表現も試す価値がない。というわけで、単純に枚挙するのでなく、分岐による非決定性と順序構造による方向性を持たせた枚挙を構成して、枝刈りすることで無駄を減らすという、よくあるパターンに辿り着く

具体的に、以下のコードでは、regenum関数が非決定的な枚挙関数。返り値がリストであるけれども、気持ちとしては、非決定性を示す。regenumは以下の2条件を満たすようになっている(はず。なってなかったらバグ)。この条件を満たすなら、regenum関数は、何でもいい
・regenumは、与えられた正規表現より"強い"正規表現を(非決定的に)返す
・正規表現eにregenumを繰り返し適用していけば、eより強い全ての正規表現が、"いつか必ず"得られる(実際に実行して値を返すかどうかでなく、非決定性関数の返り値の候補に含まれる)

非決定性関数はCurryで書いたほうが分かりやすいと思うけど、regenumの実装例はCurryで大体こんな感じ(多分

-- chooseは、Munster Curry compilerでは、Success moduleにある
choose (x:xs) = choosep x xs
  where choosep x [] = x
        choosep x (_:_) = x
        choosep _ (x:xs) = choosep x xs


-- Concat [Const[],Const[]]とかRepeat (Const [])とか無駄なのが結構出る。重複も起きる
regenum :: (Eq w) => [w]-> RegEx w -> RegEx w
regenum tokens r = Select [r,r]
regenum tokens r = Repeat r
regenum tokens r = Concat [Const [], r]
regenum tokens r = Concat [r , Const []]
regenum tokens (Const []) = Const (choose tokens)
regenum tokens (Const (r:rs)) = Concat [Const [r] , regenum tokens (Const rs)]
regenum tokens (Const (r:rs)) = Concat [regenum tokens (Const [r]) , Const rs]
regenum tokens (Concat [r1,r2]) = Concat [regenum tokens r1 , r2]
regenum tokens (Concat [r1,r2]) = Concat [r1 , regenum tokens r2]
regenum tokens (Repeat r) = Repeat (regenum tokens r)
regenum tokens (Select [r1,r2]) = Select [regenum tokens r1 , r2]
regenum tokens (Select [r1,r2]) = Select [r1 , regenum tokens r2]

regenumの第一引数は、正規表現のアルファベットの集合。実用的には、例えばChar型全ての値とか、そんなものになるはず

で、regenumを使って、φないし、どれか正例にregenumを適用していって、正例全てにマッチしつつ、負例にはマッチしない正規表現を探す。具体的には
・負例にマッチしてしまった場合は、それより強い正規表現を探索することは無駄なので、適当にバックトラックしてやり直し
・負例にはマッチしないけど、マッチしない正例がある場合は、regenumを適用していって、より強い正規表現を探す
・全ての正例にマッチして、かつ負例にはマッチしない正規表現が得られたら、それを返す(当然、有限の例しか与えられない場合は、一意に決まるわけではないので、一般には非決定的。けど、十分に多くの例が与えられれば、アルゴリズムは正しい解に収束して、正規表現の書き方の不定性を除けば、答えは一意になるはず)

非決定的なアルゴリズムの常として、実行効率は、なるべくバックトラックを起こさないようにできるかに依存する。直感的には、どう足掻いても、ワーストケースでは酷いことになる気がするので、実用的な問題を効率的に解けるかという話にしかならなそう(実際、NP-完全らしい。別の発想として、推論の成功基準を確率的にして、近似的に同定するというようなのもあるらしい)。このアルゴリズムの手続きは、人間がやってることと大差ない気もする。人間が考える場合は、正規表現や語を適切に分割して、間違ってる部分だけを修正するという手続きを取っていると思う。あと、実用上は、"a|b|c|d|e|....|z|A|...|Z|0|...|9"とか馬鹿げているので、[:alpha:]とか[:digit:]みたいなクラスも扱えるようにする必要がある

多分、人間が手で正規表現を書く場合に、想定している例というのは、そんなに多くはない(せいぜい数百とか数千とか)気がするので、効率的に解く方法があってもよい気はする。正規表現を超えて、文脈自由文法とかの推論となると、人間でも結構大変というか、人間の限界超えることも結構ある気がする(正規表現でも、メールアドレスの話とかあるので、まあ、複雑な例になると、ダメかもしれない)。そして、ゆくゆくは、テストからのプログラム生成が...

[参考文献]
帰納論理プログラミングの基礎理論とその展開
http://ci.nii.ac.jp/naid/110008016700

計算論的学習理論の米国における現状と動向
http://ci.nii.ac.jp/naid/110002762442

{-# OPTIONS_GHC -Wall #-}
import List

data RegEx w = 
    Const [w]
  | Concat [RegEx w]
  | Select [RegEx w]
  | Repeat (RegEx w) deriving Show

-- 適当なマッチング関数
regmatch :: (Eq w) => RegEx w -> [w] -> Bool
regmatch r s = ([] `elem` (regmatch' r [s]))
  where
    regmatch' (Const []) rest = rest
    regmatch' (Const (c:cs)) rest = regmatch' (Const cs) [tail xs | xs<-rest , length xs /= 0 , head xs==c]
    regmatch' (Concat []) rest = rest
    regmatch' (Concat (r:rs)) rest =regmatch' (Concat rs) (regmatch' r rest)
    regmatch' (Select rs) rest = concat [regmatch' r rest | r<-rs]
    regmatch' (Repeat r) rest = regrepeat r rest rest
    regrepeat r [] rest' = rest'
    regrepeat r rest rest' = 
       regrepeat r ((regmatch' r rest) \\ rest') (union rest rest')


regenum :: (Eq w) => [w]-> RegEx w -> [RegEx w]
regenum tokens r = case r of
   Const [] -> [Select [Const [],Const []] , Concat [Const [],Const []] , Repeat (Const []) ] ++ 
               [Const [c] |c <- tokens]
   Const x ->  [Concat [Const [] , Const x] ,Select [Const x,Const x] , Repeat (Const x)]
   Repeat r -> [Concat [Const [] , Repeat r] , Select [Repeat r,Repeat r]] ++ 
               [Repeat r'| r'<-regenum tokens r]
   Select rs -> [Concat [Const [] ,Select rs] , Repeat (Select rs) , Select[Select rs,Select rs]] ++
                [ Select r'|r'<-pchange (regenum tokens) rs]
   Concat rs -> [Select [Concat rs,Concat rs] , Repeat(Concat rs)] ++ 
                [ Concat r'|r'<-pchange (regenum tokens) rs]
  where
    pchange nextfn [] = []
    pchange nextfn (x:xs) = [x':xs | x'<-nextfn x] ++ [x:xs' | xs'<-pchange nextfn xs]


{-
推論アルゴリズム本体
examplesは、正例/負例で、本来無限に続くべき
-}
regtest :: (Eq w) => [([w],Bool)] -> RegEx w
regtest examples = 
  case [ex | (ex,np)<-examples , np] of
    [] -> Const []
    (e:_) -> regtest' tokens examples [Concat [Const [c]|c<-e]]
  where
    tokens = foldr union [] ([ex| (ex,np)<-examples])
    negatives = [ex | (ex,np)<-examples, not np]
    positives = [ex | (ex,np)<-examples , np]
    regtest' tokens examples rs =
       regtest'' tokens examples [r | r<-rs , all (\x->not (regmatch r x)) negatives]
    regtest'' tokens examples rs = 
       case [r | r<-rs , all (\x->regmatch r x) positives] of
         [] -> regtest' tokens examples (concatMap (regenum tokens) rs)
         (r:_) -> r


main = print $ regtest [("abc" , True) , ("abcabc" , True)]