blog.PanicBlanket.com

気がつけば12月も中旬だよ……。

少し前になるけど，「あとで試す」タグをつけといたやつをやってみる。これ↓：

cf. 簡単なWebサーチエンジンの作り方 – 加藤 和彦のブログ

具体的な手順はこっちのページで公開されている。

cf. http://www.osss.cs.tsukuba.ac.jp/kato/wiki/kato/index.php?Jikken-search-engine

さて，順にやってみよう。

課題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）の右か左を単純に無視してしまうわけには行かない。場合によっては左右両方にあるかもしれないから。なので，まずは整理してみる。

1. 検索文字列よりも小さい → 左にはない。右を検索。
2. 検索文字列と等しい → 当たり。左にはないが，まだ右にはあるかもしれないので検索。
3. 検索文字列よりも大きい → これはさらに2ケースに分けられる。
   1. 検索文字列がプレフィックスになっている → 当たり。さらに左にも右にもあるかもしれないので両方を検索。
   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を適用して，あとは適当にフォーマットして出力すればいいだけだ。ファイルは課題のページからリンクしてるこのページをダウンロードして使った（ファイル名決めうち）。

• CodeConvTOC.doc.html

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) substring 

-------------------------------------------------------------------------------

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

今日はここまで。続きは明日……やれるといいなぁ。

import List

steep xs = and $ zipWith (>) xs $ map sum $ tail $ tails xs

$ が多くてうっとうしいからがんばって無くしてみた。ついでに引数もなくなった。

import List

steep2 = and . s (zipWith (>)) sums
  where
    s f g x = f x (g x)
    sums = map sum . tail . tails

なんかかえって解りにくいかも。

実行結果：

*Main> steep2 [32,16,8,4,2,1]
True
*Main> steep2 [31,16,8,4,2,1]
False