VBAとImageMagickを使って画像の同一性を調べるプログラム

MS Accessで画像を扱っているのですが、MD5によるサムチェックでは保存方法をわずかに変更しただけで別の画像と判定されるなど問題点も多く、画像の同一性チェックをする方法が無いか調べていたところ、Perceptual Hashという手法があると知りました。Perceptual Hashにはいくつか手法があり、本格的なものであれば離散コサイン変換などが必要ですが、簡易的なものであれば、解説のページなどを見てやろうと思えば出来そうと思えるましたので実験してみました。

# 比較検討した手法

## aHASH法
1. 画像を極小サイズ（8～16px四方）＆グレースケール変換をしたコピー画像を作成する。
2. 画像の色の平均値を算出
3. 各ピクセルの濃淡を算出。平均値よりも濃い場合には1、薄い場合には0とする。
4. その結果を結合しハッシュ値とする

## dHASH法
1. aHASH法と同じように極小サイズのグレースケール画像を作成
2. ピクセルaと一つ隣のピクセルbと比較しaがbより暗ければ1、明るければ0とする。
3. その結果を結合しハッシュ値とする

[*その他の手法については参照サイトを参照すること](http://q.hatena.ne.jp/1441524172)

最初はVBAのGetPixel関数でピクセル値を取り出すことを考慮しましたが
1. ネットに書かれてあるGetPixelの実装例が解りづらい、
2. ImageMagickのコマンドからピクセル値が取り出せること
3. VBAを用いた色の平均値の算定のサンプルが見つけられなかったこと

さまざまな状況や実現可能な技術スキルなどを考慮し**ImageMagickを使用したdHASH法を採用**することとしました。

# ImageMagickについて
## 導入方法

このプログラムに必要なのはImageMagickがインストールされていること前提なので、あらかじめImageMagickをインストールする必要があります。それについてはいくつかのサイトがありますので詳細はそのサイトをご参照戴きたく思います。

- [[DEV:003-01] ImageMagickをVBAから使う](https://sites.google.com/site/torimemoforwork/vba/dll/imagemagick)
- [【画像処理、ImageMagickをエクセルVBAから使う】](http://dukicco.hatenadiary.jp/entry/2016/06/07/072058)

リンク先にも記載がありますがインストール時の注意点として、
1. バイナリリリースの選択時にOSのビット数では無くOfficeのビット数を選ぶこと
2. インストール時に、「Install ImageMagickObject OLE Control for VBScript, Visual Basic, and WSH」にチェックを入れておくこと。
3. 事前にVBAの開発画面から参照設定を入れておくこと
があげられます。ただし、2.についてはコマンドプロント経由で以下の設定を行えば後付けの設定が可能であるようです。

>コマンドプロンプトを「管理者として実行」
登録する場合
regsvr32 /c <ImageMagickObject.dll までのフルパス>
登録解除の場合
regsvr32 /u <ImageMagickObject.dll までのフルパス>
成功すると、「DLLRegisterServerは成功しました」と表示される。
失敗した場合は、[1] 管理者として実行ができているか、パスは正しいかなどを確認する
[[DEV:003-01] ImageMagickをVBAから使う
](https://sites.google.com/site/torimemoforwork/vba/dll/imagemagick) より引用

##コーティング例
以下に200x200の画像を出力するときのコードを例示します。

```vb:Imgtest
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関数で情報を取り出しています。

```vb:dHashFileTrim
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で正方形になるように指定をして出力します。

```vb:MainCode
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　より引用

今回は、今回は下記のようなテストコードを作成しました。

```vb:dHashTestCode
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) |
|:---:|:---:|
|![Lena.jpg](https://qiita-image-store.s3.amazonaws.com/0/304395/f596ba70-375f-5982-5902-3cf3073184ea.jpeg)|![Parrots.jpg](https://qiita-image-store.s3.amazonaws.com/0/304395/922b0d9f-36b6-3431-e30e-08837f471452.jpeg)||
| 27F1659938DAAC3A|792C8569191A5878 | 

この二枚のハミング距離は29となり、違うファイルであることが判定されました。

## 似たファイルの場合
![2.jpg](https://qiita-image-store.s3.amazonaws.com/0/304395/4480407d-1ca5-827b-ddb9-d089b3e3432c.jpeg)

続いて上の写真ファイルのオリジナル版（4608x3456)と縮小版（640x480)と、超縮小版（240x180・本稿に掲載)のハッシュ値比較しました。

| オリジナル版 | 縮小版 | 超縮小版 |
|:---:|:---:|:---:|
| C5D3F3AE1D19324A | C5D3F3AE1D19324A | C5DBF38A1D1D3A48 |

これによると、オリジナル版と縮小版ではハミング距離が0で、縮小版（オリジナル版）と超縮小版のハミング距離は6とほぼ同一のファイルとみなされました。

一方で写真でもピンボケなどの為にまったく同じ構図で取り直した写真が、ハミング距離が10以下を示したり、アニメイラストでは、同じ作者が似た構図で違うキャラクターを描くことがしばしばありますが、そうしたファイルもハミング距離が10以下となり閾値次第では意図しない結果を生み出す可能性もあります。

# まとめ
画像処理はPythonを使用するのが定石で、Perceptual Hashの計算を行うライブラリであるimagehashもありますが、あえてVBAとImageMagickで画像の類似度を調べましたが、予想以上に信頼性が高いプログラムとなりました。しかし、誤検知の頻度など未だに読めていない点も多々ありこれからの課題で有ると思います。

# 参考サイト
- [Perceptual Hashを使って画像の類似度を計算してみる](https://tech.unifa-e.com/entry/2017/11/27/111546)
- [ImageMagickで画像を座標＋RGB値のテキストに変換する、またその逆](https://qiita.com/hachisukansw/items/31facab9691fa356880d)
- [簡単な画像の類似度計算手法「Average Hash」](http://www.toyamaguchi.com/blog/archives/20120731_average_hash/)
- [類似画像検索について簡単にまとめてみた](https://qiita.com/hurutoriya/items/88a16d36bafa8d6360e2)

##　追記（2018/10/31）
ハミング値が当初のままでは正確に測定されないバグ（小さめに測定される傾向があり、また状況によって小さめにでる傾向がある）がありましたので考察とソースコードを修正しました。