challenge モノクロ画像の類似検索

1024 * 768のサイズのモノクロ二値画像が100枚あるとします。 その中の一枚を指定したときに、その画像以外で一番その画像に似ている画像を見つけるコードを書いてください。 なお、同じ位置のピクセルが同じ値であるほど「似ている」とします。

説明のために2*3のサイズで説明します。

画像1
■■■
■■■

画像2
□□□
□□□

画像3
■■■
□□□

指定された画像
■■■
■□□
この場合、画像1とは4つのピクセルが同じ値なので類似度は4、 画像2との類似度は2、画像3とは上半分の3つと下半分の白2つが一致するので類似度は5、よって一番類似しているのは画像3となります。

このお題の趣旨は検索処理の実行速度にあるので、 実行してみて実用的な速度で動くことを確認することを強く推奨します。 可能であればマシンのスペックと実行にかかった時間を書いてもらえると参考になっておもしろいと思います。

なおこのお題はC言語からスクリプト言語への挑戦状です。 スクリプト言語に有利な問題が多すぎるので、この手の問題も大募集します。

Posted feedbacks - Common Lisp

これってXOR使えばいいんだよね。 テストデータがいいかげんすぎて…。誰かがテストデータを提供してくれればいいんだけど。 SBCL on Pentium4 2.66GHz / MEM 1GB / Debian GNU/Linuxにて4.5秒。 画像は0からの番号(index)で指定。
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
(defpackage most-similar-image
  (:use common-lisp iterate))
(in-package :most-similar-image)

(defparameter *images*
  '(#786432*101010101010101101011001010 ;taget
    #786432*101010001010101101011001010 ;most similar
    #786432*101111101010101101011001010
    #786432*101010001010000001011001010
    #786432*101111101010101101011001010
    #786432*101010000000000000001001010
    #786432*101011111111111111111111111
    #786432*101010001010100000000001010
    #786432*000000000000000000000001010
    #786432*101010000000101101011001010
    #786432*101000000010101101011000010
    #786432*101010001000000001011001010
    #786432*101010001010101000000001010
    #786432*101000000000000101011001010
    #786432*101010001010101000000000010
    #786432*101010000000101101011001010
    #786432*101010001010000000011001010
    #786432*101010001010101101011001010
    #786432*101000000000001101011001010
    #786432*000000000000000000000001010
    #786432*101010001000000000000000010
    #786432*101010001010100101011001000
    #786432*100000000000000001011001010
    #786432*000000000010101000001001010
    #786432*101010001000000000011001010
    #786432*101010001010101101000000010
    #786432*101000000000001101011001010
    #786432*101010001010100000001001010
    #786432*101010001010101101000000000
    #786432*101010000000000000011001010
    #786432*101010001010101101000000010
    #786432*000000001010101101011001010
    #786432*101010000000101101011001010
    #786432*101010001010000001011001010
    #786432*101010001010101100000000010
    #786432*101010001000111000000111111
    #786432*111111111111111111111111110
    #786432*101010001010101101000000000
    #786432*000000000000001101011001010
    #786432*101010001010100000000001010
    #786432*101010001010101101011000000
    #786432*000000000010000000011001010
    #786432*101010001010101101000000010
    #786432*101010001010100001011001000
    #786432*101010001010101101011001010
    #786432*000000000000000100000000000
    #786432*001000001010101100010001000
    #786432*101000000000001101000000000
    #786432*101000000000101101001001010
    #786432*101010001010101000000000010
    #786432*100010001000001101011001000
    #786432*101010001000000100001001010
    #786432*101010001010000001000000010
    #786432*101000000010101100001001000
    #786432*100000000010101100000001010
    #786432*101000000000000000010001000
    #786432*000001011010010001100100010
    #786432*010010001011010010010011101
    #786432*111010100010111000001111111
    #786432*101000110000001111011100111
    #786432*010101100001011110111011010
    #786432*000011111000111010010001011
    #786432*110001000111100010101001001
    #786432*000100000111111100010010011
    #786432*101010101110001100101100111
    #786432*011111100011110111111101000
    #786432*010000111111111110010101110
    #786432*100111110100101101110010010
    #786432*000010011011011001001111011
    #786432*100101000111111000011011011
    #786432*101111110001110100001000110
    #786432*110000100110100011111110001
    #786432*110111110010000010100011001
    #786432*011001010010011001111101000
    #786432*011100101100100010000010110
    #786432*011101011111000100000010111
    #786432*100010010100011001000100101
    #786432*111011111000010000100100110
    #786432*011001110110010010100011010
    #786432*111011001110101011000100100
    #786432*000001011111101000011101011
    #786432*001110101010110011110001111
    #786432*111101111000101001100100110
    #786432*101101011011111110100111100
    #786432*101111110011010110111100111
    #786432*010001001010001111000111011
    #786432*001011101000011010111000110
    #786432*011000101000011010011110001
    #786432*010111010011001110001101100
    #786432*100110101011100010000010001
    #786432*111010100111000111000100111
    #786432*110111001011011010010100110
    #786432*010011001011011000100010010
    #786432*010110101110111011100011011
    #786432*000101001001011000010110010
    #786432*100000101101000000110010110
    #786432*011010101101011000011010100
    #786432*010011001010100110010101011
    #786432*101100110110101110000011010
    #786432*011100001100101011011000000

))
    

(defun most-similar-image (image-num images)
  (let ((image-n (elt images image-num)))
    (iter (for image in images)
          (for i from 0)
          (if (/= i image-num)
              (finding i maximizing (similarity image-n image))))))

(defun similarity (img1 img2)
  (if (= (length img1) (length img2))
      (count 0 (bit-xor img1 img2))
      0))
(time (most-similar-image 0 *images*))  ; => 1
;; Evaluation took:
;;   4.5 seconds of real time
;;   4.406379 seconds of user run time
;;   0.023332 seconds of system run time
;;   [Run times include 0.01 seconds GC run time.]
;;   0 calls to %EVAL
;;   0 page faults and
;;   9,736,984 bytes consed.

Pentium 4 3GHz, 1G RAM で以下の結果でした。32bit データを consing 無しで扱えるような 64bit 環境だともっとはやいかも。 画像のロード: 94 msec で、画像のロード+探索: 391 msec => 313 msec (型指定) => 297 msec (ビットカウントをマクロに) くらいであきらめました。 まぁ、今見直すと同じ名前なら類似度計算するの無駄とかありますね…
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
(defpackage :doukaku-37 (:use :cl))
(in-package :doukaku-37)

(declaim (optimize (speed 3) (space 0) (debug 0) (safety 0)))

(defconstant +width+ 1024)
(defconstant +height+ 768)
(defconstant +max-score+ (* +width+ +height+))
;; 32bit マシンで実行するので、16bit 幅にしておく。fixnum の範囲を超えると consing で遅くなる
(defconstant +shorts+ (/ (* +width+ +height+) 16))

(defun make-random-image ()
  (let ((vec (make-array +shorts+ :element-type '(unsigned-byte 16))))
    (loop for i from 0 below +shorts+ do (setf (aref vec i) (random #xFFFF)))
    vec))

(defun generate-images ()
  (loop for i from 1 to 100
        for name = (format nil "image.~A" i) do
        (with-open-file (s name :direction :output :if-exists :supersede
                                :element-type '(unsigned-byte 16))
          (write-sequence (make-random-image) s))))

(defun load-image (name &aux (bytes (make-array +shorts+ :element-type '(unsigned-byte 16))))
  (with-open-file (s name :direction :input :element-type '(unsigned-byte 16))
    (read-sequence bytes s)
    bytes))

(defun load-all-images ()
  (loop for i from 1 to 100
        for name  = (format nil "image.~A" i)
        for image = (load-image name)
        collect (list :name name :image image :score 0)))

;; 最適化 1: of-type unsigned-byte 16 を追加。 logxor が xor 命令に展開されてちょっとはやい
;; 最適化 2: logcount -> logcount16 マクロへ (気休め)
(defun similarity (image-1 image-2)
  (loop for byte-1 of-type (unsigned-byte 16) across image-1 
        for byte-2 of-type (unsigned-byte 16) across image-2
        summing (logcount16 (logxor byte-1 byte-2))))

(defmacro logcount16 (num)
  `(let ((x (the (unsigned-byte 16) ,num)))
     (declare (type (unsigned-byte 16) x))
     (setf x (+ (logand (ash x -1) #x5555) (logand x #x5555))
           x (+ (logand (ash x -2) #x3333) (logand x #x3333))
           x (+ (logand (ash x -4) #x0F0F) (logand x #x0F0F))
           x (+ (logand (ash x -8) #x00FF) (logand x #x00FF)))))

(defun find-similar-image (name)
  (let ((image (load-image name))
        (data  (load-all-images)))
    (loop with result = (list :name nil :score +max-score+)
          for x in data
          for score = (similarity image (getf x :image))
          do (when (and (<= score (getf result :score)) (not (equal name (getf x :name))))
               (setf result x))
             (setf (getf x :score) score)
          finally (return (getf result :name)))))

logcount => 313msec, logcount16 => 297msec, defconstant + svref => 281msec でした。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
(defconstant +bits+
  (let ((vec (make-sequence 'simple-vector 65536)))
    (dotimes (i 65536)
      (setf (svref vec i) (logcount16 i)))
    vec))

(defun similarity (image-1 image-2)
  (loop for byte-1 of-type (unsigned-byte 16) across image-1 
        for byte-2 of-type (unsigned-byte 16) across image-2
        summing (svref +bits+ (logxor byte-1 byte-2))))

Index

Feed

Other

Link

Pathtraq

loading...