気がつけば12月も中旬だよ……。
少し前になるけど，「あとで試す」タグをつけといたやつをやってみる。これ↓：
具体的な手順はこっちのページで公開されている。
さて，順にやってみよう。
課題1-1
与えられた文字列のsuffix arrayを作成するプログラムを作成せよ．
import Data.List suffixArray :: String -> [Int] suffixArray xs = map fst $ sort' $ zip [1..] $ init $ tails xs where sort' = sortBy (\a b -> compare (snd a) (snd b))
実行例：
*Main> suffixArray "abcbccab" [7,1,8,2,4,6,3,5]
課題1-2
与えられた文字列に対し，その部分文字列を入力し，部分文字列が出現する全位置を列挙する検索プログラムを作成せよ．（ヒント： suffix array上の2分探索を行う）
二分探索とはいうものの，検索対象の部分文字列の出現箇所すべてを列挙するには，中央の値（suffix）の右か左を単純に無視してしまうわけには行かない。場合によっては左右両方にあるかもしれないから。なので，まずは整理してみる。
- 検索文字列よりも小さい → 左にはない。右を検索。
- 検索文字列と等しい → 当たり。左にはないが，まだ右にはあるかもしれないので検索。
- 検索文字列よりも大きい → これはさらに2ケースに分けられる。
- 検索文字列がプレフィックスになっている → 当たり。さらに左にも右にもあるかもしれないので両方を検索。
- 検索文字列がプレフィックスになっていない → 右にはない。左を検索。
これをコードにするとこうだ：
import Data.List suffixArray :: String -> [Int] suffixArray xs = map fst $ sort' $ zip [1..] $ init $ tails xs where sort' = sortBy (\a b -> compare (snd a) (snd b)) suffixOf :: String -> Int -> String suffixOf s n = drop (n-1) s search :: String -> [Int] -> String -> [Int] search _ [] _ = [] search s ary sb = let n = (length ary) `div` 2 sfx = suffixOf s (ary !! n) in if sfx < sb then search s (drop (n+1) ary) sb else if sfx == sb then (ary !! n) : search s (drop (n+1) ary) sb else if isPrefixOf sb sfx then (search s (take n ary) sb) ++ [ary !! n] ++ (search s (drop (n+1) ary) sb) else search s (take n ary) sb
実行例：
*Main> search "abcbccab" (suffixArray "abcbccab") "ab" [7,1]
課題1-3
指定された1個のHTMLテキストファイルをメモリ中に読み込んで1個の文字列とし，それに対する suffix array をメモリ中に作成し，ユーザから入力された文字列を検索して，入力文字列が出現する全位置を列挙するプログラムを作成せよ．
ファイルを読み込んで，searchを適用して，あとは適当にフォーマットして出力すればいいだけだ。ファイルは課題のページからリンクしてるこのページをダウンロードして使った（ファイル名決めうち）。
module Main where
import Data.List
import System.Environment ( getArgs )
-------------------------------------------------------------------------------
filename = "CodeConvTOC.doc.html"
main :: IO ()
main = do argv <- getArgs
contents <- readFile filename
substring <- return $ head argv
mapM_ (putStrLn . format contents) $ search contents (suffixArray contents) substring
format :: String -> Int -> String
format str pos = show pos ++ ": " ++ take 10 (suffixOf str pos)
-------------------------------------------------------------------------------
suffixArray :: String -> [Int]
suffixArray xs = map fst $ sort' $ zip [1..] $ init $ tails xs
where
sort' = sortBy (\a b -> compare (snd a) (snd b))
suffixOf :: String -> Int -> String
suffixOf s n = drop (n-1) s
search :: String -> [Int] -> String -> [Int]
search _ [] _ = []
search s ary sb = let n = (length ary) `div` 2
sfx = suffixOf s (ary !! n)
in
if sfx < sb then
search s (drop (n+1) ary) sb
else if sfx == sb then
(ary !! n) : search s (drop (n+1) ary) sb
else if isPrefixOf sb sfx then
(search s (take n ary) sb) ++ [ary !! n] ++ (search s (drop (n+1) ary) sb)
else
search s (take n ary) sb
-------------------------------------------------------------------------------実行例：
^o^ >runhaskell suffixArray.hs File 10208: File Examp 1959: File Names 1664: File Names 2250: File Organ 1815: File Suffi 2422: Files</a>
課題1-4
ちょっと時間があいたけど続き。
以下の手順で，複数ファイルに対して全文検索を行うプログラムを作成せよ．
1. 指定された1個以上のm個のファイルをメモリ内で連結した長い文字列を作る．そのときにファイルの境 界に，テキストファイル中には通常は現れない文字（例えばヌル文字'\0'等）を入れ，検索時に複数ファイルを またいだ文字列にマッチしないようにしておく．
2. 1.で作った作った長い文字列中の文字位置から元のファイル名を得られるようにするための表を作る． 例えば，file1.html, file2.html, file3.htmlがそれぞれ100, 200, 300のファイルサイズをもつとき，[("file 1.html", 100), ("file2.html", 200), ("file3.html", 300)]というような表を作る（効率的な方法，プログ ラムしやすい方法を各自工夫せよ）．
3. 課題1-3で作成したプログラムと，1.および2.で作ったデータを用いて，ユーザから入力された文字列を 検索し，入力文字列が出現するファイル名とファイル内の位置（ファイルの先頭から数えた文字数）を全て列 挙するプログラムを作成せよ．
課題1-3から変えたとこだけ：
main :: IO () main = do argv <- getArgs files <- mapM readFile $ tail argv let contents = concat $ intersperse "\0" files let table = makeFileTable (tail argv) $ map length files let substring = head argv mapM_ (putStrLn . format table contents) $ search contents (suffixArray contents) substri ng ------------------------------------------------------------------------------- format :: [(String, Int)] -> String -> Int -> String format t str pos = let (f, p) = filePos t pos in f ++ ": " ++ show p ++ ": " ++ take 15 (suffixOf str pos) ------------------------------------------------------------------------------- makeFileTable :: [String] -> [Int] -> [(String, Int)] makeFileTable fs ls = zip fs $ snd $ mapAccumL (\a x -> (a+x+1, a)) 1 ls filePos :: [(String, Int)] -> Int -> (String, Int) filePos (f:[]) n = (fst f, n - snd f + 1) filePos (f1:f2:fs) n | snd f2 < n = filePos (f2:fs) n | otherwise = (fst f1, n - snd f1 + 1) -------------------------------------------------------------------------------
元ファイルの表はファイル名とその開始位置をタプルにした。
実行例：
^o^ >runhaskell suffixArray.hs Intro CodeConvTOC.doc.html CodeCOnventions.doc.html CodeConvTOC.doc.html: 1063: Introduction</a CodeCOnventions.doc.html: 517: Introduction</h
今日はここまで。続きは明日……やれるといいなぁ。
