モノクロ画像の類似検索
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))))
|




にしお
#3393()
Rating0/0=0.00
説明のために2*3のサイズで説明します。
この場合、画像1とは4つのピクセルが同じ値なので類似度は4、 画像2との類似度は2、画像3とは上半分の3つと下半分の白2つが一致するので類似度は5、よって一番類似しているのは画像3となります。このお題の趣旨は検索処理の実行速度にあるので、 実行してみて実用的な速度で動くことを確認することを強く推奨します。 可能であればマシンのスペックと実行にかかった時間を書いてもらえると参考になっておもしろいと思います。
なおこのお題はC言語からスクリプト言語への挑戦状です。 スクリプト言語に有利な問題が多すぎるので、この手の問題も大募集します。
[ reply ]