Haskellでいってみよう

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

同一画像検索(1):仕様と外枠作り

前回からかなり時間が空いてしまったが…気を取り直して進めよう。

作りたいのは複数の画像ファイルの中から同じ画像を抽出するプログラムだった。 基本的な仕様は次の通りとする。

  • 引数で調査したいディレクトリを指定する
  • ディレクトリ内にあるJPEGファイルを取り出し、それぞれを比較して 「同一の」画像ファイルかどうか確認する
  • 「同一の」画像ファイルが見つかったらそのファイル名を出力する

ここで「同一の」としたが、何をもって同一とするかという話がある。 難しい画像比較のアルゴリズムとか、「同じような画像」を見つけ出す とか言い出すと大変なので、「同一の」というのは、解像度は異なって いるかもしれないが同じ対象物が描画されているもの、とする。 本当のところは、多少サイドがクリッピングされていたり、コントラスト や色調をいじっていたりするものは「同一」とみなしたいが、大変 そうなので割愛する。

この前提で、どうやって「同一の」画像かどうか判断するかについては 外部プログラム(ImageMagick)の力を借りることにする。

  • まず、対象の画像を4x4の解像度の画像に変換し、各点の色の値 (256階調x3色)を取り出す。(48 bytesのデータになる)
  • この48 bytesが全く同じ画像をグルーピングして、同一画像の候補とする。
  • さらに詳細を見るために16x16の解像度の画像に変換し、各点の 色の値を取り出す。
  • 元画像の解像度が異なると、16x16に落としても各点の値が微妙に 異なる可能性があるので、各点の比較時に差を取り一定の範囲内で あれば同じとみなす。

上記を踏まえ、プログラムの骨格は以下のようになるだろう。

  1. 引数に指定されたディレクトリからJPEG画像ファイルのListを取得する

    ["image1.jpg", "image2.jpg", ..., "imagen.jpg"]

  2. 画像を相互に比較し、同一画像とみなされるものを一組のListとし、 結果はそのListのListとする

    [["image3.jpg", "image6.jpg"], ["image5.jpg", "image10.jpg", "image14.jpg"], ...]

  3. 同一画像の組ごとに、結果を画面に出力する

    probably same: image3.jpg, image6.jpg
    probably same: image5.jpg, image10.jpg, image14.jpg
    :

ということで、このプログラムの主体は2の部分なのだが、外堀から埋める つもりで1と3の部分を作ってみる。2の部分は適当なListを返すダミー関数で 誤魔化すことにする。

前回開発環境について記載したが、それに基づき src/ ディレクトリ以下に ファイルを作成していく。まずはメイン。

Main.hs
module Main where

import System.Directory
import System.Environment
import Data.List.Split
import Data.Char
import Finder

picext = "JPG"
delimiter = "/"

main :: IO ()
main = do
  ds <- getArgs
  fs <- mapM getFileLists ds
  putGroups $ findSame $ concat fs

getFileLists :: FilePath -> IO [String]
getFileLists d = do
  fs <- getDirectoryContents d
  return $ map (\ x -> d ++ delimiter ++ x) (filter isJpeg fs)

isJpeg :: String -> Bool
isJpeg f = if ext == picext then True else False
  where
  ext = map toUpper (last $ splitOn "." f)

putGroups :: [[String]] -> IO ()
putGroups [] = putStr ""
putGroups (p:ps) = do
  putStrLn ("probably same: " ++ showGroup p)
  putGroups ps

showGroup :: [String] -> String
showGroup [] = ""
showGroup (f:[]) = f
showGroup (f:fs) = f ++ ", " ++ showGroup fs

mainにおいて、骨格のうち1は最初の二行と3行目の後ろのconcatで実現 している。この例では、引数に複数のディレクトリを指定できるように してあるため少々ややこしいが、結局は画像ファイル名のListを作っている だけである。最後の行の findSame が骨格の2にあたるが、これは後述の Finderモジュールで定義する。最後に putGroups が骨格の3で、結果を 整形して出力する処理である。

今回、findSame は本来の処理ではなくとりあえずファイル名のListの Listを返すだけのダミー関数とした。

Finder.hs
module Finder where

findSame :: [String] -> [[String]]
findSame fs = map toPair fs

toPair :: String -> [String]
toPair f = [f, f]

コンパイルはmainの入っているファイルのみ指定すれば、あとは勝手に呼び 出されているモジュールのソースファイルも合わせてコンパイルしてリンク してくれる。

$ ghc -o picf Main.hs
[1 of 2] Compiling Finder           ( Finder.hs, Finder.o )
[2 of 2] Compiling Main             ( Main.hs, Main.o )
Linking picf ...

実行してみる。

$ ./picf work
probably same: work/image1.JPG, work/image1.JPG
probably same: work/image2.jpg, work/image2.jpg
probably same: work/image3.jpg, work/image3.jpg
probably same: work/image4.jpg, work/image4.jpg

一応「外堀」はできた。あとは肝心のfindSameを定義するだけ。 これが大変そうだが、、、それは次回にしよう。