正規表現

Haskell

自前Monadic Parser Combinatorsを使って正規表現を実装してみた。本当のことを言うと正規表現を実装するためにParser Combinatorsを書いたんだけどね。というか，Parser Combinatorsをああ書けば正規表現を簡単に実装できるのではないかと思っただけというのが真相かな。まあ，それはそれとして，簡単に実行時間を比較してみた。
比較対象は，grep, Ruby, Gauche。時間計測に使用したのはもちろんtimeコマンド（楽だからね）。評価環境はMacOSX 10.5.6。とりあえず，RubyとGaucheでは以下のようなgrep -c（マッチした行をカウント）と同じようなことをするプログラムを作成。

if (ARGV.length < 2)
	exit(1)
end

f = File.open(ARGV[1], "r")
rx = Regexp.new(ARGV[0])
n=0
f.each_line {|line|
	s = line.match rx
	if s != nil
		n+=1
	end
}

p n

(define main
  (lambda (args)
    (if (< (length args) 2)
      1
      (begin (print (f (string->regexp (cadr args))
		       (open-input-file (caddr args))))
	     0))))

(define f
  (lambda (re p)
    (let ((line (read-line p)))
      (if (eof-object? line)
	(begin (close-input-port p)
	       0)
	(if (rxmatch re line)
	  (+ 1 (f re p))
	  (f re p))))))

どちらの言語でももっと良い書き方があると思うが，そこはアレだ，ハンデってやつだ。
入力ファイルはプロジェクト・グーテンベルクから持ってきたJoyceの"A Portrait of the Artist as a Young Man"。

$ wc prtrt11.txt 
   10320   87243  488825 prtrt11.txt

まずは，moonまたはstarを含む行を数えてみる（意味は特になし）。
とりあえず，わたくし作のやつを計測。

$ time ./Main "moon|star" prtrt11.txt
57

real	0m0.441s
user	0m0.423s
sys	0m0.015s

grep。

$ grep --version
grep (GNU grep) 2.5.1

Copyright 1988, 1992-1999, 2000, 2001 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
$ time grep -c "moon\|star" prtrt11.txt
57

real	0m0.066s
user	0m0.051s
sys	0m0.012s

Ruby。

$ ruby --version
ruby 1.8.6 (2008-03-03 patchlevel 114) [universal-darwin9.0]
$ time ./grep.rb "moon|star" prtrt11.txt 
57

real	0m0.035s
user	0m0.030s
sys	0m0.005s

Gauche。

$ gosh -V
Gauche scheme interpreter, version 0.8.13 [utf-8,pthreads]
$ time ./grep.scm "moon|star" prtrt11.txt 
57

real	0m0.180s
user	0m0.166s
sys	0m0.012s

Ruby < grep << Gauche <<<< わたくしの（実行時間），といったところか。
つぎに，２文字目以降にxを含む単語がある行をカウントしてみる。

$ time ./Main "\w+x" prtrt11.txt
364

real	0m2.901s
user	0m2.850s
sys	0m0.038s

$ time grep -c "\w\+x" prtrt11.txt
364

real	0m0.006s
user	0m0.003s
sys	0m0.003s

$ time ./grep.rb "\w+x" prtrt11.txt 
364

real	0m0.035s
user	0m0.028s
sys	0m0.006s

$ time ./grep.scm "\w+x" prtrt11.txt 
364

real	0m0.192s
user	0m0.178s
sys	0m0.009s

grep < Ruby << Gauche <<< 越えられない壁 <<< わたくしの。。。
遅い。実用にはほど遠いな。理由はなんとなくわかる。マッチする可能性がないときでも愚直に処理を行っているからだろう。例えば，"earthquake"という単語はxを含まないのでマッチしない。私が書いたのは，マッチしない場合は先頭の文字を取った文字列とマッチを試みるのだが，"arthquake"も当然マッチしない。これを文字列がすべて消費されるまで行うので効率が悪いと思われる。
アレ！？ここまで書いて（プログラムではなく日記を）気づいたけど，オレ，正規表現の実装方法についてなんにも知らないや。だから，RubyやGaucheが中でどんなことをやっているかもわからない。。。
とりあえず，課題がわかったのでよしとしよう。

正規表現。"[]"は実装途中。ParserはMonadic Parser Combinators - cadrの日記に書いたやつ。

module RegExp where

import Data.Char
import Data.List
import Parser

type RegExp = Parser Char [String]

regexp :: String -> Parser Char [String]
regexp rs = head (runParser rexp rs)

match :: Parser Char [String] -> String -> [String]
match re [] = []
match re ss = let xs = runParser re ss 
              in case xs of
                   [] -> match re (tail ss)
                   (x:_) -> x
                  
infix 4 =~
(=~) :: Parser Char [String] -> String -> [String]
(=~) = match

rexp :: Parser Char (Parser Char [String])
rexp = do { e0 <- rexp'
          ; Parser.char '|'
          ; e1 <- rexp
          ; return (e0 <|> e1)
          }
   <|> rexp'

rexp' :: Parser Char (Parser Char [String])
rexp' = do { t <- term
           ; r <- RegExp.rpt
           ; e <- rexp'
           ; return ( do { x <- r t
                         ; (xs:xss) <- e
                         ; return ((x++xs):xss)
                         } )
           }
    <|> do { Parser.char '('
           ; v <- rexp
           ; Parser.char ')'
           ; r <- rpt
           ; e <- rexp'
           ; return ( do { x <- r v
                         ; (xs:xss) <- e
                         ; let x' = concat (map head x)
                           in if x' == []
                                then return (xs:"":xss)
                                else return ((x'++xs):(head $ head x):xss)
                         } )
           }
    <|> return (empty [""])

term :: Parser Char (Parser Char Char)
term = do { c <- Parser.satisfy isAlpha
          ; return (Parser.char c)
          }
   <|> do { Parser.char '\\'
          ; Parser.char 'd'
          ; return Parser.digit
          }
   <|> do { Parser.char '\\'
          ; Parser.char 'w'
          ; return (Parser.alphaNum <|> Parser.char '_')
          }
   <|> do { Parser.char '\\'
          ; Parser.char 's'
          ; return Parser.space
          }
   <|> do { Parser.char '['
          ; s <- many letter
          ; Parser.char ']'
          ; return (oneOf s)
          }

rpt :: Parser Char (Parser a b -> Parser a [b])
rpt = do { Parser.char '*'
         ; return many
         }
  <|> do { Parser.char '+'
         ; return many1
         }
  <|> do { Parser.char '?'
         ; return (bound (0,1))
         }
  <|> do { Parser.char '{'
         ; n <- Parser.int
         ; Parser.char '}'
         ; return (n `times`)
         }
  <|> do { Parser.char '{'
         ; from <- Parser.int
         ; Parser.char ','
         ; to <- Parser.int
         ; Parser.char '}'
         ; return (bound (from,to))
         }
  <|> return (1 `times`)

letter :: Parser Char Char
letter = Parser.alphaNum

grep -cみたなことをやるためのMainプログラム。

module Main where

import System.Environment
import Parser
import RegExp

main :: IO ()
main = do { args <- getArgs
          ; case args of
              [rs,fs] -> do { s <- readFile fs
                            --; sequence_ (map (showLine (regexp rs)) (lines s))
                            ; putStrLn $ show (countLine (regexp rs) (lines s))
                            }
              _ -> return ()
          }

showLine :: RegExp -> String -> IO ()
showLine re line
  = case match re line of
      [] -> return ()
      _ -> putStrLn line

countLine :: RegExp -> [String] -> Int
countLine re [] = 0
countLine re (l:ls)
  = case match re l of
      [] -> countLine re ls
      _ -> 1 + countLine re ls