DouKaku? 1749 shiro: バイナリの扱いはsrfi-4 unifo...(モノクロ画像の類似検索)

Comment detail

バイナリの扱いはsrfi-4 uniform vectorで。
主なボトルネックはビット数を数えるところ。
Gaucheは組込みのlogcountというのを持っていますが、
多倍長整数にも汎用的に対応してるため思ったより遅いことが判明。
ビットマスクとシフトで数えるのはそこそこ速かったんですが、
富豪的に16ビットごとのテーブル索引がもっと速い。

実行は、Pentium4 2.0GHz / メモリ2GB のマシンで4秒を切るくらい。

gosh> (time (find-closest-pic "pic035" (sys-glob "pic???")))
;(time (find-closest-pic "pic035" (sys-glob "pic???")))
; real   3.946
; user   3.860
; sys    0.060
392118
"pic064"

なお、ファイルの読み込みに1.5秒くらいかかっています。

(use gauche.uvector)
(use gauche.sequence)
(use srfi-42)

(define-constant *image-size* (* 1024 768))

(define-constant *logcount16*
  (let1 cnts (make-vector 65536)
    (do-ec (: i 65536) (set! (ref cnts i) (logcount i)))
    cnts))

(define (find-closest-pic sample pics)
  (define (diff-score! vp vs)
    (u32vector-xor! vp vs)
    (let1 v1 (u32vector-and vp #x0000ffff)
      (u32vector-and! vp #xffff0000)
      (sum-ec (: i (u32vector-length vs))
              (+ (vector-ref *logcount16* (u32vector-ref v1 i))
                 (vector-ref *logcount16* (ash (u32vector-ref vp i) -16))))))
  (define (read-pic! v file)
    (with-input-from-file file (cut read-block! v)))
  (define vs (make-u32vector (/ *image-size* 32)))
  (define vp (make-u32vector (/ *image-size* 32)))

  (read-pic! vs sample)
  (fold2 (lambda (pic score ans)
           (cond [(equal? sample pic) (values score ans)]
                 [else (read-pic! vp pic)
                       (let1 s (diff-score! vp vs)
                         (if (< s score) (values s pic) (values score ans)))]))
         #i1/0 #f pics))

;; (find-closest-pic "pic035" (sys-glob "pic???"))
;;   => 392118 and "pic064"


;;;
;;; test data generation
;;;
(use srfi-27)

(define (generate-random-pics n)
  (do-ec (: k n)
         (let1 v (make-u8vector (/ *image-size* 8))
           (do-ec (: i (/ *image-size* 8))
                  (set! (ref v i) (random-integer 256)))
           (with-output-to-file (format "pic~3,'0d" k) (cut write-block v)))))

> なお、ファイルの読み込みに1.5秒くらいかかっています。

いや、これは計測違いでした。
全部オンメモリで計算してもこんなもの：
gosh> (time (find-closest-pic (ref *vecs* 35) *vecs*) (values))
;(time (find-closest-pic (ref *vecs* 35) *vecs*) (values))
; real   3.618
; user   3.530
; sys    0.080

なのでファイル読み込みのオーバヘッドは0.3秒くらいですね。

むむ。他の動的言語(PnutsやScala)がけっこういけてますね。闘志に火がつきました。

uniform vectorの組込み演算を使って0.87秒 (Pen4 2.0GHz)。オンメモリのデータで。

gosh> (time (find-closest-pic (ref *vecs* 35) *vecs*) )
;(time (find-closest-pic (ref *vecs* 35) *vecs*))
; real   0.873
; user   0.870
; sys    0.000
392016

(use gauche.uvector)
(use gauche.sequence)
(use srfi-42)

(define-constant *image-size* (* 1024 768))

(define (find-closest-pic vs pics)
  (define (diff-score vp vs)
    (let1 vx (u8vector-xor vp vs)
      (+ (u8vector-dot v1 (u8vector-and vx #x01))
         (/ (u8vector-dot v1 (u8vector-and vx #x02)) 2)
         (/ (u8vector-dot v1 (u8vector-and vx #x04)) 4)
         (/ (u8vector-dot v1 (u8vector-and vx #x08)) 8)
         (/ (u8vector-dot v1 (u8vector-and vx #x10)) 16)
         (/ (u8vector-dot v1 (u8vector-and vx #x20)) 32)
         (/ (u8vector-dot v1 (u8vector-and vx #x40)) 64)
         (/ (u8vector-dot v1 (u8vector-and vx #x80)) 128))))
  (define v1 (make-u8vector (/ *image-size* 8) 1))

  (values-ref
   (fold2 (lambda (vp score ans)
            (cond [(eq? vs vp) (values score ans)]
                  [else (let1 s (diff-score vp vs)
                          (if (< s score) (values s vp) (values score ans)))]))
          #i1/0 #f pics)
   0))

;; (find-closest-pic "pic035" (sys-glob "pic???"))
;;   => 392118 and "pic064"

;;;
;;; test data generation
;;;
(use srfi-27)

(define (generate-random-pics n)
  (list-ec (: k n)
           (let1 v (make-u8vector (/ *image-size* 8))
             (do-ec (: i (/ *image-size* 8))
                    (u8vector-set! v i (random-integer (expt 2 8))))
             v)))

(define *vecs* (generate-random-pics 100))

DouKaku?

Comment detail

Index

Feed

Other

Link

Pathtraq