同一画像検索(2):Finder moduleのための確認
前回はダミーのFinderモジュールで、とりあえず外側を作ったので、 今回からFinderの作成をすすめたい。ただ、その前に幾つか基本的な ところを確認しておきたい。
同一の画像を見つけるやり方は前回も書いた通り解像度4x4に変換して その情報が同じものをグルーピングすることにした。 まずはこの部分を実現するために、次の2つを確認しておく。
- 画像ファイルを解像度4x4に変換して48 bytesのデータを取り出す。
- キーが同じファイルを集めてリストにする。
画像ファイルの変換
まず最初の方について検討する。画像ファイルの変換処理は書いてられない のでImageMagickを使って変換してみよう。最終的に、各画素の色情報 (256段階x3色)が欲しいので、PPM(バイナリ)形式にして後ろから48 bytesを 切り出す。前回も書いたが48 bytesなのは 4x4ドットx色3 bytesだから。 今後、このように画像ファイルを小さく変換して得られるデータを fingerprintと 表記する。今回は48 bytesのfingerprintということだ。なお、ImageMagickの convertコマンドの詳細はここでは割愛する。
$ convert -define jpeg:size=4x4 -filter Cubic -resize 4x4! test.jpg test.ppm
test.ppmの中身は次の通り。
$ tail -c 48 test.ppm > test.out argent-2:work eiji$ od -x test.out 0000000 aecd c17e 7fa9 7e95 8567 6672 ccf2 df9b 0000020 8dba 97b5 a57d 7d8e cfe4 dbba a5bf bed7 0000040 e1a9 c6d3 c0d5 d7b1 a7bc c2db e6ad cdd8 0000060
これを踏まえ、Haskellでconvertコマンドを実行する処理を考える。
外部コマンドを実行するにはSystem.Processモジュール
を使うらしいので、それらしいものを探す。実行したいコマンドは、パイプを使って
必要な部分だけ切り取り、それをプログラムで取り出したいので
runInteractiveCommand
が相当しそうだ。
こことか
ここ
とかを参考に書いてみた。
Main-t0.hs
module Main where import System.IO import System.Process reso = 4 getFingerPrint :: String -> IO String getFingerPrint f = do (sin, sout, serr, ph) <- runInteractiveCommand command waitForProcess ph hGetLine sout where geo = (show reso) ++ "x" ++ (show reso) size = reso * reso * 3 command = "convert -define jpeg:size=" ++ geo ++ " -filter Cubic -resize " ++ geo ++ "! " ++ f ++ " PPM:- | tail -c " ++ (show size) main :: IO () main = do putStr =<< getFingerPrint "~/work/test1.jpg"
コンパイルして実行してみる。
$ ghc -o t0 Main-t1.hs $ ./t0 > /tmp/out.dat rcom: fd:5: hGetLine: invalid argument (invalid byte sequence)
出力結果を取り出すところでしくじっているらしい。ググってもよくわからな かったが、色情報は単なるバイト列なので「文字」にならないバイトも多い。 ということで、ByteStringに変えてみた。
Main-t0.hs (2)
module Main where import Data.ByteString.Char8 as BS import System.IO import System.Process reso = 4 getFingerPrint :: String -> IO ByteString getFingerPrint f = do (sin, sout, serr, ph) <- runInteractiveCommand command waitForProcess ph BS.hGetLine sout where geo = (show reso) ++ "x" ++ (show reso) size = reso * reso * 3 command = "convert -define jpeg:size=" ++ geo ++ " -filter Cubic -resize " ++ geo ++ "! " ++ f ++ " PPM:- | tail -c " ++ (show size) main :: IO () main = do s <- getFingerPrint "~/work/test1.jpg" BS.putStr s
こんどはうまくいった。
$ ./t0 > /tmp/out.dat $ od -x /tmp/out.dat 0000000 aecd c17e 7fa9 7e95 8567 6672 ccf2 df9b 0000020 8dba 97b5 a57d 7d8e cfe4 dbba a5bf bed7 0000040 e1a9 c6d3 c0d5 d7b1 a7bc c2db e6ad cdd8 0000060
最初にハンドでコマンドを流したときと同じ出力が得られている。
同一キーのファイルを集める
画像から同じfingerprintを得られたとして、それらを同一とみなす方法が必要である。 簡単に実現しようとすると、連想配列を用いてキーが同じものをまとめてしまえばよい。 Haskellでは連想配列を扱うにはData.Mapを使うらしい。
ここでは入力はキー(文字列)とファイル名の組のListとし、結果は各キーに対しファイル名の Listが対応するMapとしたい。入力がListなので、変換する関数のシグネチャは
[(String, String)] -> Map String [String]
になるだろう。ただ、再帰で処理させることを考えると、処理済みのMapも引数に与えて
[(String, String)] -> Map String [String] -> Map String [String]
となるだろう。あとはこれに合うように再帰関数を書けば良い。とはいえHaskellの
再帰処理はよくわかっていないので、少々こんがらがったが最終的に下記のような関数
tomap
に落ち着いた。
tomap :: [(String, String)] -> Map String [String] -> Map String [String] tomap (x:xs) m = tomap xs (Map.insert k l m) where k = fst x l = tolist x (Map.lookup k m) tolist :: (String, String) -> Maybe [String] -> [String] tolist x Nothing = [snd x] tolist x (Just l) = (snd x:l)
ちなみに、tolist
はすでに同じキーで登録されているもの(List)があればそれを取り出して
新しい要素をそのListに追加し、なければ新しく要素一つのListを作って返す関数。
なお、tomap
の定義ではMapの初期値が現れてきていない。これについてはtomap
を最初に
呼び出すときに引数としてMap.emptyを与えている。これが綺麗なやり方かどうかは不明。
てきとうに動くプログラムに仕立てて処理した結果は次の通り。
(input) [("a", "apache"), ("e", "emacs"), ("a", "ant"), ("c", "ceph")] (output) [["ant","apache"],["ceph"],["emacs"]]
キーが"a"のものについては結果のListに複数の要素が入っている。
次回は、上記の確認を踏まえて同一画像を判定する簡易な関数を作ってみる。
同一画像検索(1):仕様と外枠作り
前回からかなり時間が空いてしまったが…気を取り直して進めよう。
作りたいのは複数の画像ファイルの中から同じ画像を抽出するプログラムだった。 基本的な仕様は次の通りとする。
- 引数で調査したいディレクトリを指定する
- ディレクトリ内にあるJPEGファイルを取り出し、それぞれを比較して 「同一の」画像ファイルかどうか確認する
- 「同一の」画像ファイルが見つかったらそのファイル名を出力する
ここで「同一の」としたが、何をもって同一とするかという話がある。 難しい画像比較のアルゴリズムとか、「同じような画像」を見つけ出す とか言い出すと大変なので、「同一の」というのは、解像度は異なって いるかもしれないが同じ対象物が描画されているもの、とする。 本当のところは、多少サイドがクリッピングされていたり、コントラスト や色調をいじっていたりするものは「同一」とみなしたいが、大変 そうなので割愛する。
この前提で、どうやって「同一の」画像かどうか判断するかについては 外部プログラム(ImageMagick)の力を借りることにする。
- まず、対象の画像を4x4の解像度の画像に変換し、各点の色の値 (256階調x3色)を取り出す。(48 bytesのデータになる)
- この48 bytesが全く同じ画像をグルーピングして、同一画像の候補とする。
- さらに詳細を見るために16x16の解像度の画像に変換し、各点の 色の値を取り出す。
- 元画像の解像度が異なると、16x16に落としても各点の値が微妙に 異なる可能性があるので、各点の比較時に差を取り一定の範囲内で あれば同じとみなす。
上記を踏まえ、プログラムの骨格は以下のようになるだろう。
- 引数に指定されたディレクトリからJPEG画像ファイルのListを取得する
["image1.jpg", "image2.jpg", ..., "imagen.jpg"]
- 画像を相互に比較し、同一画像とみなされるものを一組のListとし、
結果はそのListのListとする
[["image3.jpg", "image6.jpg"], ["image5.jpg", "image10.jpg", "image14.jpg"], ...]
- 同一画像の組ごとに、結果を画面に出力する
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を定義するだけ。 これが大変そうだが、、、それは次回にしよう。
開発環境の整備とプロジェクトディレクトリ
ちゃんとしたプロダクトを作るにあたり、まずは開発環境を整えないといけない。 ソース管理は当然なので、今ならgithubが妥当だろう。早速ユーザ登録して、 新規リポジトリを開始する。この辺の詳しいところは、以下の書籍を参考にした。
GitHub実践入門 ~Pull Requestによる開発の変革 (WEB+DB PRESS plus)
- 作者: 大塚弘記
- 出版社/メーカー: 技術評論社
- 発売日: 2014/03/20
- メディア: 単行本(ソフトカバー)
- この商品を含むブログ (13件) を見る
コラボレーションするようなモノではないので少々オーバースペックな感じはするが、 自宅でバージョン管理システムを運用するのは大変面倒くさいのでやはりクラウド サービスが楽だ。
新しく、"picfinder"というリポジトリを作ったので、これをローカルにcloneしてくる。
$ git clone https://github.com/eijian/picfinder.git
簡単そうなところで、指定したディレクトリ内に存在するJPEGファイルの中で、同じ 画像であるものを探し出してレポートしてくれるプログラムを作ってみようと思う。 さて、Haskellでビルドやテストを繰り返し行うには、Cabalというのを使うと良さそう。 この辺は以下の書籍を参考にした。
関数プログラミング実践入門 ──簡潔で、正しいコードを書くために (WEB+DB PRESS plus)
- 作者: 大川徳之
- 出版社/メーカー: 技術評論社
- 発売日: 2014/11/14
- メディア: 単行本(ソフトカバー)
- この商品を含むブログ (1件) を見る
まずは初期化をする必要があるらしい。
$ cabal init Package name? [default: picfinder] picfinder Package version? [default: 0.1.0.0] 0.1.0.0 Please choose a license: : 8) BSD3 : Your choice? [default: (none)] 8
とりあえずプロダクト名、初期バージョン、そしてライセンスを選ぶ。 Cabal(かHaskell界)のしきたりなのか、バージョンは4つの数字で表す ようにする、と先の[関数プログラミング…]に書いてある。まずは、 0.1.0.0で始めておく。
名前とかを入力した後、今回のプログラムは画像関係なのでカテゴリは Graphicsを、また実行プログラムとしておく。
Project category: : 10) Graphics : Your choice? [default: (none)] 10 What does the package build: 1) Library 2) Executable Your choice? 2
あとはmainが入るソースファイル名やHaskellのバージョンなどを聞かれたが よくわからないのでデフォルトのままで。とりあえず最後まで進んだので良しとする。
Generating LICENSE... Warning: LICENSE already exists, backing up old version in LICENSE.save0 Generating Setup.hs... Generating picfinder.cabal... You may want to edit the .cabal file and add a Description field.
あと、ソースツリーをどうするか考えないといけないがルートにバラバラいろんな ファイルやディレクトリが散らかっているのは嫌いなので、ソースとテストと文書用に 3つだけ作った。トップディレクトリは次のようになった。
.git <= gitが勝手に作った? .gitignore <= github登録時に指定 LICENSE <= githubで登録時に選択すると作られるがCabalが作った方を採用 README.md <= githubで登録した時に作られた Setup.hs <= Cabalが生成 doc/ picfinder.cabal <= Cabalが生成 src/ test/
次回からは少しずつプログラムを作ってみる。
簡易cat (2)
ファイル内容を表示するだけでは寂しいので、コマンドラインに オプションを追加してみる。ややこしいのは大変なので、先頭に 行番号を表示する -n モドキだけ。
-n オプションがある場合は各行の表示をする時に番号を付加する。 行番号はいわゆる「無限リスト」を各行とzipで組にしてみた。
Cat4.hs
-- -- Cat4 -- module Main ( main ) where import System.Environment main :: IO () main = do xs <- getArgs putFiles $ checkArgs xs checkArgs :: [String] -> (Bool, [String]) checkArgs [] = (False, []) checkArgs (x:xs) | x == "-n" = (True, xs) | otherwise = (False, (x:xs)) putFiles :: (Bool, [String]) -> IO () putFiles (_, []) = putStr "" putFiles (b, (x:xs)) = do cs <- readFile x putStr (decorate b cs) putFiles (b, xs) decorate :: Bool -> String -> String decorate False cs = cs decorate True cs = unlines $ map tr (zip [1..] $ lines cs) tr :: (Int, String) -> String tr (n, l) = (show n) ++ "\t" ++ l
単に最初の引数が"-n"かどうかをチェックしているだけなのに 結構邪魔くさいことになっている。 doブロック内でできることできないことについて、下記ではまった。
putFiles (b, (x:xs)) = do cs <- readFile x putStr (decorate b cs)
putStrのところ、今回は短いのでいいが、一旦変数にバインドしようとして 単に代入文を書いたらコンパイルエラーになった。
cs' = decorate b cs
putStr cs'
しょうがないのでputStr一行にまとめてしまったが、あとで試したらletを 使えば大丈夫そう。
let cs' = decorate b cs putStr cs'
一方で where句ではエラーになった。csがスコープにないと怒られたので where句の中に"cs <- readFile x"を書いてもエラーになってしまう。
putStr cs' where cs' = decorate b cs
letとwhereの違いを確認しておこう。
次回は使えそうなプログラムを作ってみる。
簡易cat - コマンドライン引数
はじめに、このブログはHaskellの入門記事でも何でもないので、その辺りはご期待には添えないのであらかじめお断りしておくことにする。単に、私がHaskellで何かしらソフトウェアを作るということのモチベーションを維持するためであり、またその過程を記録するものである。記述が大雑把なのもご容赦願いたい。ただせっかく稚拙で恥ずかしいソースを晒すので、願わくば「高位のHaskell使い」の方からHaskellらしからぬところ、より的確な関数/ライブラリなど、改善につながるご助言をいただければ幸いである。
さて、実用的なアプリケーションを作るにはコマンドライン引数を扱えないと話にならない(と考えた)ので、その辺を確認しておく。サンプルとして超簡易的なcatコマンドを作成する。
STEP 1
引数に指定したファイルを単に表示するだけのcatを作ってみる。まずは、最初の引数のファイルだけを表示する仕様とする。二番目以降の引数は無視。ちなみに、これではcatとは名ばかりである…。
Cat1.hs
module Main ( main ) where import System.Environment main :: IO () main = do (x:xs) <- getArgs putFile x putFile :: String -> IO () putFile f = do cs <- readFile f putStr cs
実行してみる。
$ ghc -o cat1 Cat1.hs $ ./cat1 Cat1.hs module Main ( : putStr cs
一応動いた。getArgsはリストを返すので最初の要素だけを取り出してみた。ファイルの読み出しと標準出力への書き出しはとても簡単。readFileで読んでputStrするだけ。ちなみにこの辺のテキスト処理的な簡易コマンドの書き方については、この本を参考にした。関数プログラミングの解説書として云々という評価はあるが、私的にはHaskellで実用アプリを作るという事ではなかなかいいアプローチで説明もわかりやすいと思う。ただしAmazonではもう新品は売ってないのかな?
ふつうのHaskellプログラミング ふつうのプログラマのための関数型言語入門
- 作者: 青木峰郎,山下伸夫
- 出版社/メーカー: ソフトバンククリエイティブ
- 発売日: 2006/06/01
- メディア: 単行本
- 購入: 25人 クリック: 314回
- この商品を含むブログ (328件) を見る
STEP 2
次に複数のファイル名を与えてそれらを順に表示させる事にする。これで一応catを名乗ることができる? 複数のファイル名はリストで渡されるので、リストの各要素に対し同じ処理を実行するには map というのがいいらしい。なので先ほどのプログラムにちょっとmapを付けてみる。
Cat2.hs
module Main ( main ) where import System.Environment main :: IO () main = do xs <- getArgs map putFile xs putFile :: String -> IO () putFile f = do cs <- readFile f putStr cs
コンパイルすると…
$ ghc -o cat2 Cat2a : Cat2a.hs:14:3: Couldn't match type ‘[]’ with ‘IO’ Expected type: IO () Actual type: [()] :
怒られた。確かに map の型は「(a -> b) -> [a] -> [b]」なのでmainの型と合わない。さすがに"純粋な" map をここで使う事に無理があるのか?あきらめて再帰関数に変えてみた。
Cat3.hs
module Main ( main ) where import System.Environment main :: IO () main = do xs <- getArgs putFiles xs putFiles :: [String] -> IO () putFiles [] = do putStr "" putFiles (x:xs) = do putFile x putFiles xs putFile :: String -> IO () putFile f = do cs <- readFile f putStr cs
うまく行った!(実行結果は割愛)
ちなみに最初は再帰の底(putFiles [] = do のところ)を書いていなかったので実行時に怒られた。この辺、慣れが必要か。でも 'putStr ""' という処理が適切かどうかはわからない。
続きは次回。
まずは "Hello, World!" から
実用的なプログラムを作ることが目的なので、実行ファイルを
作成できなくては始まらない。Haskellの本だと対話環境を使った
リスト操作や再起などの説明が多いが、そうではなくてまずは
コンパイルしてみる。お決まりの"Hello, World!"でも書いてみる。
(Greeting.hs) main = putStrLn "Hello, World!"
Rubyほど短くないが、かなり簡潔に書ける方だと思う。Javaだと
いろいろ修飾が大変、というのもHaskellに流れてきた理由の一つ。
コンパイルする。
$ ghc Greeting
これで、"Greeting"という実行ファイルができる。簡単だ。
出力ファイルの名前指定(-o オプション)や最適化(-O, -O2)も
OK。(前は"--make"をつけていたが今は要らないらしい)
http://d.hatena.ne.jp/kazu-yamamoto/20140206/1391666962
$ ghc -o gre -O2 Greeting
大きなプログラムになるとモジュール分割とか出てくるので、
その辺も書いておく。mainの型も。
(Greeting2.hs) module Main ( main ) where main :: IO () main = putStrLn "Hello, World!"
最初、モジュール名は何でもいいと思ってJavaみたいにファイル名と
同じにしてたら失敗した。ghcは「Mainモジュールの"main"」がないと
実行ファイルを作ってくれないみたい。最初の例ではモジュール名を
書かなかったので勝手にMainとして処置してくれたらしい。
Mainの後ろの括弧内に外部へ公開したい名前を羅列するそうだ
(カプセル化みたいに?)。
最後に、画面から名前を入力させてあいさつさせてみる。
(Greeting3.hs) module Main ( main ) where main :: IO () main = do putStrLn "What's your name? " name <- getLine putStrLn ("Hello, " ++ name ++ ". Nice to meet you!")
実行するとこんな感じ。
$ ghc -o gre Greeting3 : $ ./gre What's your name? Taro <= 入力 Hello, Taro. Nice to meet you!
できた。
Haskellコンパイラを入れる
どうやらHaskellのコンパイラとしてはGHCがメジャーということらしい。もろもろライブラリも使いたいのでHaskell Platformを入れるのがよいそうで。自宅はMacで、パッケージ管理はHomebrewを使っている。
$ brew install haskell-platform Warning: haskell-platform-2013.2.0.0 already installed
ああ、前に分けもわからず入れたんだった。ということでHomebrewの更新もやってしまおう。
$ brew update Cloning into '/usr/local/Library/Taps/homebrew-dupes'... : ==> Deleted Formulae : catdoc haskell-platform mpio texmacs :
あれ?もう一度インストールを試すと
$ brew install haskell-platform Error: No available formula for haskell-platform We no longer package haskell-platform. Consider installing ghc and cabal-install instead: brew install ghc cabal-install :
どうも"haskell-platform"という名前ではパッケージをインストールできなくなってしまっている。。。
指示通り、ghcとcabal-installを入れてみる。
$ brew install ghc cabal-install Error: ghc-7.6.3 already installed To install this version, first `brew unlink ghc' ==> Installing dependencies for cabal-install: gmp, ghc ==> Installing cabal-install dependency: gmp ==> Downloading https://downloads.sf.net/project/machomebrew/Bottles/gmp-6.0.0a. ######################################################################## 100.0% ==> Pouring gmp-6.0.0a.mavericks.bottle.tar.gz 🍺 /usr/local/Cellar/gmp/6.0.0a: 15 files, 3.2M ==> Installing cabal-install dependency: ghc ==> Downloading https://downloads.sf.net/project/machomebrew/Bottles/ghc-7.8.3.m ######################################################################## 100.0% ==> Pouring ghc-7.8.3.mavericks.bottle.1.tar.gz 🍺 /usr/local/Cellar/ghc/7.8.3: 5742 files, 724M ==> Installing cabal-install ==> Downloading https://downloads.sf.net/project/machomebrew/Bottles/cabal-insta ######################################################################## 100.0% ==> Pouring cabal-install-1.20.0.3_1.mavericks.bottle.1.tar.gz ==> Caveats Bash completion has been installed to: /usr/local/etc/bash_completion.d Error: The `brew link` step did not complete successfully The formula built, but is not symlinked into /usr/local Could not symlink bin/cabal Target /usr/local/bin/cabal is a symlink belonging to haskell-platform. You can unlink it: brew unlink haskell-platform To force the link and overwrite all conflicting files: brew link --overwrite cabal-install To list all files that would be deleted: brew link --overwrite --dry-run cabal-install Possible conflicting files are: /usr/local/bin/cabal -> /usr/local/Cellar/haskell-platform/2013.2.0.0/bin/cabal ==> Summary 🍺 /usr/local/Cellar/cabal-install/1.20.0.3_1: 5 files, 18M $ ghc -v Glasgow Haskell Compiler, Version 7.8.3, stage 2 booted by GHC version 7.8.3 :
何とか入ったらしい。でも、本当にこの手順で良かったのか?