DouKaku? 1755 shiro: むむ。他の動的言語(PnutsやScal...(モノクロ画像の類似検索)

Comment detail

This comment is reply for 1750 shiro: > なお、ファイルの読み込みに1....(モノクロ画像の類似検索). Go to thread root.

むむ。他の動的言語(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