MS Accessで画像を扱っているのですが、MD5によるサムチェックでは保存方法をわずかに変更しただけで別の画像と判定されるなど問題点も多く、画像の同一性チェックをする方法が無いか調べていたところ、Perceptual Hashという手法があると知りました。Perceptual Hashにはいくつか手法があり、本格的なものであれば離散コサイン変換などが必要ですが、簡易的なものであれば、解説のページなどを見てやろうと思えば出来そうと思えるましたので実験してみました。
比較検討した手法
aHASH法
- 画像を極小サイズ（8～16px四方）＆グレースケール変換をしたコピー画像を作成する。
- 画像の色の平均値を算出
- 各ピクセルの濃淡を算出。平均値よりも濃い場合には1、薄い場合には0とする。
- その結果を結合しハッシュ値とする
dHASH法
- aHASH法と同じように極小サイズのグレースケール画像を作成
- ピクセルaと一つ隣のピクセルbと比較しaがbより暗ければ1、明るければ0とする。
- その結果を結合しハッシュ値とする
最初はVBAのGetPixel関数でピクセル値を取り出すことを考慮しましたが
- ネットに書かれてあるGetPixelの実装例が解りづらい、
- ImageMagickのコマンドからピクセル値が取り出せること
- VBAを用いた色の平均値の算定のサンプルが見つけられなかったこと
さまざまな状況や実現可能な技術スキルなどを考慮しImageMagickを使用したdHASH法を採用することとしました。
ImageMagickについて
導入方法
このプログラムに必要なのはImageMagickがインストールされていること前提なので、あらかじめImageMagickをインストールする必要があります。それについてはいくつかのサイトがありますので詳細はそのサイトをご参照戴きたく思います。
リンク先にも記載がありますがインストール時の注意点として、
- バイナリリリースの選択時にOSのビット数では無くOfficeのビット数を選ぶこと
- インストール時に、「Install ImageMagickObject OLE Control for VBScript, Visual Basic, and WSH」にチェックを入れておくこと。
- 事前にVBAの開発画面から参照設定を入れておくこと
があげられます。ただし、2.についてはコマンドプロント経由で以下の設定を行えば後付けの設定が可能であるようです。
コマンドプロンプトを「管理者として実行」
登録する場合
regsvr32 /c
登録解除の場合
regsvr32 /u
成功すると、「DLLRegisterServerは成功しました」と表示される。
失敗した場合は、[1] 管理者として実行ができているか、パスは正しいかなどを確認する
[DEV:003-01] ImageMagickをVBAから使う
より引用
コーティング例
以下に200x200の画像を出力するときのコードを例示します。
Sub ImgTest()
Const Oldfile As String = C:\a.jpg '入力画像のパス
Const NewFile As String = C:\b.jpg '出力画像のパス
Dim img as object
Set Img = New ImageMagickObject.MagickImage
Img.Convert _
"-define", "jpeg:size=200x200", _
"-resize", "200x200", _
"-interlace", "jpeg", _
"-quality", "70", _
Oldfile, NewFile
Set Img = Nothing
End Sub
- "jpeg:size=200x200" とあるのはJPEG限定の高速化のおまじない。
- "-interlace", "jpeg"でインターレースJPEGになる。大きい画像なら少し軽くなる（らしい）
- "-resize", "200x200", はサイズの指定。通常はアスペクト比に比例するが、"-resize", "200x200!"とするとアスペクト比が関係無くなる（後述の通り、この項目で重要になる）
ピクセル情報の取り出し方
2行目より以下のような形でアウトプットされます
0,0: (65021) #FDFDFD gray(253)
1,0: (61937) #F1F1F1 gray(241)
最初の0,0は位置の情報で、あとは色に関する情報なのですが、これを元にカンマ区切りに整形する関数に入れて以下のような形に整形してからSplit関数で情報を取り出しています。
Private Function dHashFileTrim(str As String) As String
Dim elm As Variant
Dim arrWrd() As Variant
arrWrd = Array(": (", ") ", " gray(")
'入力されたキーワード通りに整形する
For Each elm In arrWrd
str = Replace(str, elm, ",")
Next elm
'末尾の)を消す
str = Replace(str, ")", "")
dHashFileTrim = str
End Function
上記のプログラムを実行すると下記のようなカンマ区切りに整形されます。
1,0,61937,#F1F1F1,241
メインプログラム
dHash法の考え方は、自らの一つ右隣のピクセルと値を比較し、右隣より小さければ「1」を、同じか大きければ「0」をセットし、1ピクセルの結果を1bitとし64ピクセル分の結果を統合し整数を算出するというのが基本的な考えとなります。ただし最後の行は比較対象がないので比較をしません。評価用画像は9x8なのでほぼ正方形ですが、画像はほぼ正方形なのでImageMagickで正方形になるように指定をして出力します。
Function pHashCal(strOrigFile As String) As String
Dim Img As Object
Dim buf As String
Dim strAns As String
Dim tmp As Variant
Dim i As Long
Dim y As Long
Dim strInfo(8, 7) As String
Dim strHashAss(1) As String
'ImageMagickのオブジェクトを設定
Set Img = New ImageMagickObject.MagickImage
'評価用画像ファイルを指定
strHashAss(0) = "C:\dHash_p.png"
'評価用テキストファイルを指定
strHashAss(1) = "C:\dHash_t.txt"
'グレースケールの評価用画像に変換
Img.Convert _
"-define", "jpeg:size=9x8", _
"-resize", "9x8!", _
"-type", "GrayScale", _
strOrigFile, strHashAss(0)
'テキストファイルに書き出す
Img.Convert strHashAss(0), strHashAss(1)
'テキストファイルを読み込む
Open strHashAss(1) For Input As #1
Do Until EOF(1)
Line Input #1, buf
i = i + 1
If i <> 1 Then '2行目から読みだす
tmp = Split(dHashFileTrim(buf), ",") '得られた情報を分離する
strInfo(tmp(0), tmp(1)) = tmp(4) '色情報を配列に格納する
End If
Loop
Close #1
'画像を比較する
For i = 0 To 8
For y = 0 To 7
If y <> 7 Then '最後のビットであれば比較をしない
If strInfo(i, y) > strInfo(i, y + 1) Then
strAns = strAns & 0 '前のビットの方が大きければ0とする
Else
strAns = strAns & 1 '後のビットの方が大きければ1とする
End If
End If
Next y
Next i
pHashCal = strAns
Set Img = Nothing
'一時ファイルの削除
For i = 0 To 1
Kill strHashAss(i)
Next i
End Function
考察
全く別のファイルの場合
Perceptual Hashの距離はハミング距離によって求めることが出来ます。dHashの場合は･･･
（引用者注：ハミング値が）「0」ならば同じ画像、「10」を超えたら違う画像、
「1〜10」の間では潜在的に似ている可能性がある画像と記載されています。
https://tech.unifa-e.com/entry/2017/11/27/111546 より引用
今回は、今回は下記のようなテストコードを作成しました。
Private Sub HashTestCode()
Dim a As String
Dim b As String
Dim ancer As Long
a = pHashCal("C:\1.jpg")
b = pHashCal("C:\2.jpg")
ancer = HummingDis(a, b)
Debug.Print "画像aのハッシュ値: " & Bin_2_Hex(a)
Debug.Print "画像bのハッシュ値: " & Bin_2_Hex(b)
If ancer > 10 Then
Debug.Print "ハミング距離=" & ancer & " 違うファイルです"
Else
Debug.Print "ハミング距離=" & ancer & " 同一のファイルです"
End If
End Sub
'ハミング距離を計測
Private Function HummingDis(strA As String, strB As String) As Long
Dim i As Long
Dim tmpA As String
Dim tmpB As String
For i = 1 To Len(strA)
'Byteに変換し格納する
tmpA = Mid(strA, i, 1)
tmpB = Mid(strB, i, 1)
'AとBを比較し、値が異なれば加算する
If tmpA <> tmpB Then HummingDis = HummingDis + 1
Next i
End Function
'2進から16進に変換
Private Function Bin_2_Hex(strBin As String) As String
Dim i As Long
Dim y As Long
Dim tmp As String
Dim lngByte As Long
Dim strAns As String
Dim varBinary As Variant
varBinary = VBA.Array(8&, 4&, 2&, 1&)
For i = 1 To Len(strBin) Step 4
lngByte = 0 '変数の初期化
tmp = Mid(strBin, i, 4) '値を取り出す
For y = 0 To 3
'数を取り出しフラグが立っていると足す
If Mid(tmp, y + 1, 1) = "1" Then
lngByte = lngByte + varBinary(y)
End If
Next y
strAns = strAns & Hex(lngByte) '答えを格納する
Next i
Bin_2_Hex = strAns
End Function
下に2枚の画像のハッシュ値を示します。
| 画像A(Lena) | 画像B（Parrots) |
|---|---|
 |
 |
| 27F1659938DAAC3A | 792C8569191A5878 |
この二枚のハミング距離は29となり、違うファイルであることが判定されました。
似たファイルの場合
続いて上の写真ファイルのオリジナル版（4608x3456)と縮小版（640x480)と、超縮小版（240x180・本稿に掲載)のハッシュ値比較しました。
| オリジナル版 | 縮小版 | 超縮小版 |
|---|---|---|
| C5D3F3AE1D19324A | C5D3F3AE1D19324A | C5DBF38A1D1D3A48 |
これによると、オリジナル版と縮小版ではハミング距離が0で、縮小版（オリジナル版）と超縮小版のハミング距離は6とほぼ同一のファイルとみなされました。
一方で写真でもピンボケなどの為にまったく同じ構図で取り直した写真が、ハミング距離が10以下を示したり、アニメイラストでは、同じ作者が似た構図で違うキャラクターを描くことがしばしばありますが、そうしたファイルもハミング距離が10以下となり閾値次第では意図しない結果を生み出す可能性もあります。
まとめ
画像処理はPythonを使用するのが定石で、Perceptual Hashの計算を行うライブラリであるimagehashもありますが、あえてVBAとImageMagickで画像の類似度を調べましたが、予想以上に信頼性が高いプログラムとなりました。しかし、誤検知の頻度など未だに読めていない点も多々ありこれからの課題で有ると思います。
参考サイト
- Perceptual Hashを使って画像の類似度を計算してみる
- ImageMagickで画像を座標＋RGB値のテキストに変換する、またその逆
- 簡単な画像の類似度計算手法「Average Hash」
- 類似画像検索について簡単にまとめてみた
追記（2018/10/31）
ハミング値が当初のままでは正確に測定されないバグ（小さめに測定される傾向があり、また状況によって小さめにでる傾向がある）がありましたので考察とソースコードを修正しました。