読者です 読者をやめる 読者になる 読者になる

Haskellでいってみよう

日曜プログラマにも満たないレベルでもHaskellで何かソフトウェアを作りたい!

同一画像検索(6): 改良して完成

graphics

このネタの最後に幾つか確認と改良をして完成させよう。

総当たり処理を少し改善

roundRobin再帰で定義しているが、場合分けが格好悪い。isSameの 戻り値がBoolなところが問題か。

roundRobin x (y:ys)
  | isSame x y == False = roundRobin x ys
  | otherwise           = (snd y):(roundRobin x ys)

同一ならyのFilePathを、そうでなければ空リストを返せばよさそう。 ついでに、前回isSame内で同一かどうかを判定するのにfindを使った のをanyに変えておこう。「同一」かどうかBoolで返してくれれば よいのでfindである必要はない。(単にanyを知らなかっただけ)

roundRobin x (y:ys) = isSame x y ++ roundRobin x ys                       

isSame :: Image -> Image -> [FilePath]                                 
isSame x y = if any differ (zip (fst x) (fst y)) then [] else [snd y]         
  where                                                                         
    differ :: (Word8, Word8) -> Bool                                            
    differ (a, b) = (if a > b then a - b else b - a) > threshold                        

これでだいぶすっきりした。

重複した出力を取り除く

前回の出力結果を再掲する。

probably same: work/IMG_0309-2.jpg, work/IMG_0309-3.jpg, work/IMG_0309-4.jpg, work/IMG_0309.jpg                                                                
probably same: work/IMG_0309-3.jpg, work/IMG_0309-4.jpg, work/IMG_0309.jpg      
probably same: work/IMG_0309-4.jpg, work/IMG_0309.jpg                           
probably same: work/sample1.jpg, work/sample7.jpg                               
probably same: work/sample2.jpg, work/sample5.jpg                               

2行目、3行目は1行目の部分集合であることがわかる。部分集合かどうかを 調べるのはHaskellなら簡単にできそう。 Webを検索したらやはり、Data.List の中にそのものズバリisInfixOfがあった!matchImageから返って くるリストについて、ある要素が他のすべての要素と比較してどれの 部分集合でもなければ自身を返すようにすればよいだろう。 findSameの中でmatchImageの結果を渡すようにする。

findSame fs = do                                                            
  fps <- mapM (getFingerPrint 4) fs                                             
  let ps = matchImage $ zip fps fs                             
  return $ deduplicate ps ps                                                    

deduplicate :: [[FilePath]] -> [[FilePath]] -> [[FilePath]]                     
deduplicate _ [] = []                                                           
deduplicate xs (y:ys)                                                           
  | any (y `isInfixOf`) xs = deduplicate xs ys                                   
  | otherwise              = y:deduplicate xs ys                                 

動かしてみると。。。だめだ、一件も同じ画像とみなされなくなった!? ここで30分ほどハマった。確認したいのは自分が「他の要素に」 含まれているかどうかだ。しかし上記のxsには「自分自身も」含まれている! これでは自分自身にマッチしてしまって全要素が消える。自分以外で という条件をつけよう。

deduplicate xs (y:ys)                                                           
  | any isProperSubset xs = deduplicate xs ys                                   
  | otherwise             = y:deduplicate xs ys                                 
  where                                                                         
    isProperSubset :: [FilePath] -> Bool                                        
    isProperSubset x = x /= y && y `isInfixOf` x                                

簡潔に書く方法がよく分からないのでちょっと面倒くさくなってしまったが、 とりあえず無駄な要素は除去できた!

probably same: work/IMG_0309-2.jpg, work/IMG_0309-3.jpg, work/IMG_0309-4.jpg, work/IMG_0309.jpg                                                                
probably same: work/sample1.jpg, work/sample7.jpg                               
probably same: work/sample2.jpg, work/sample5.jpg                               

パラメータを引数で与える

ここまでのところ、ソース中に2つの定数が埋め込まれている。fingerprintの 解像度と画像比較時の差の閾値だ。何度か試して適した値を埋め込んでおく のも良いが、試すためにもコマンド実行時にいろいろ変えて与えたい。 そこで、"-p"オプションをサポートしよう。ただし、細かいエラーチェックは 面倒なので割愛する。第一引数が"-p"で始まっていたらオプションが指定された とし、そうでなければ第一引数も処理対象のディレクトリとみなす。 オプションは"-pR,T"で、Rが解像度、Tが閾値。 両パラメータとも正整数である前提だ。よって、変な引数を与えたときの動作は保証されない。

まず、オプションをちゃんと理解できたと仮定して、その後の処理ができる ように改造しよう。両パラメータともfindSameに渡す必要があるので 関数定義を変更する。

findSame :: Int -> Int -> [FilePath] -> IO [[FilePath]]                         
findSame r t fs = do                                                            
  fps <- mapM (getFingerPrint r) fs                                             
  let ps = matchImage (fromIntegral t) $ zip fps fs                             

第一引数が解像度、第二が閾値だ。解像度をgetFingerPrintの引数に そのまま渡せば良い。閾値は初お目見えなのでmatchImageに渡して 最終的にはisSameで条件判定に使われるようにしておく。 (ソースはこちら)

なおfromIntegral tとしているのはisSame内ではWord8として 比較しているからIntのまま渡せないため。

下準備ができたところで引数処理に移ろう。引数全部を渡してオプションの 有無、両パラメータを処理するparseOptを定義する。戻り値は 解像度、閾値、処理対象ディレクトリのリスト、の3つ。

parseOpt :: [String] -> (Int, Int, [FilePath])                                  
parseOpt (d:ds)                                                                 
  | "-p" `isPrefixOf` d = (r, t, ds)                                            
  | otherwise           = (8, 8, d:ds)                                          
  where                                                                         
    [r, t] = map (read :: String -> Int) (splitOn "," (drop 2 d))               

当初、どうしたら引数の有無やパラメータを取り出せるかだいぶ悩んだが、 まずは第一引数が"-p"で始まっていなければ、与えられたリスト(=d:dsだ)を そのまま、パラメータはデフォルト値(両方とも8とした)を 返せば良いとした(otherwiseの行)。"-p"で始まるかどうかは、先に "部分集合"の判定を考えていた時にisPrefixOfもチェックしていたので それが使えると判断。あとはそう難しくない。最初の二文字(="-p")を 除き、","(カンマ)で分割、それぞれの文字列を「正整数と仮定」して Intに変換すればよい。最後の変換のところ、ちょっと立ち止まったが、 最終的には上記の通りread関数でなんとかなった。 (エラー処理を無視すれば)

$ ghc -o picf Main.hs
$ ./picf -p16,4 ~/work
    :

ちゃんと動く!パラメータを変えると条件がきつくなって同一と表示 されなくなる。スバラシイ。

cabalでコンパイル

この件の最初の回でcabalを使う準備をしていながら最後まで何も使わない のはもったいないので、本プログラムをcabalでコンパイルしてみる。 cabalを使った一連の流れはここを参考にした。cabal buildとすれば よいらしい。cabalファイルはプロジェクトディレクトリのトップに あるのでそこで実行する・・・と、エラーが出た。

$ cabal build
./picfinder.cabal has been changed. Re-configuring with most recently used
options. If this fails, please run configure manually.
Warning: The package list for 'hackage.haskell.org' is 103 days old.
Run 'cabal update' to get the latest list of available packages.
Resolving dependencies...
Configuring picfinder-0.1.0.0...
Building picfinder-0.1.0.0...
Preprocessing executable 'picfinder' for picfinder-0.1.0.0...
cabal: can't find source for Main in .

ソースが見つからないだと。指定していないから当たり前だ。 hs-source-dirsで指定するらしい。気を取り直して。

$ cabal build
./picfinder.cabal has been changed. Re-configuring with most recently used

(中略)

Preprocessing executable 'picfinder' for picfinder-0.1.0.0...

src/Finder.hs:7:8:
    Could not find module ‘Data.ByteString’
    It is a member of the hidden package ‘bytestring-0.10.4.0’.
    Perhaps you need to add ‘bytestring’ to the build-depends in your .cabal file.
    Use -v to see a list of the files searched for.

(以下略)

よくわからないがbuild-dependsにXXXXを足せとある。 今度は成功した!

$ cabal build
./picfinder.cabal has been changed. Re-configuring with most recently used

(中略)

Resolving dependencies...
Configuring picfinder-0.1.0.0...
Building picfinder-0.1.0.0...
Preprocessing executable 'picfinder' for picfinder-0.1.0.0...

実行ファイルはdist/build/picfinder/picfinderとしてできている らしい。実行してみる。

$ dist/build/picfinder/picfinder -p4,4 ~/work
probably same: work/IMG_0309-2.jpg, work/IMG_0309-3.jpg, work/IMG_0309-4.jpg, work/IMG_0309.jpg
  :

やっとここまでたどり着いた。最終回ということで詰め込みすぎた感は あるがよしとしよう。

次は何をしようか。