Gauche:ベクタと万能アクセサ

ベクタと万能アクセサ

• Gauche で、ベクタと万能アクセサ(~)の組み合わせには、けっこうオーバーヘッドがあるようです。
  これは、万能アクセサ(~)が、ジェネリックファンクションを使用しているためと思われます。
  (もちろんジェネリックファンクションには、様々なクラスに統一的なアクセスが可能になるというメリットがあります)

• そこで、万能アクセサ(~)のように使えて、かつ、オーバーヘッドの少ない方法を考えてみました。

• 作成したものが、下記の va~ と va-set! というマクロになります。

• (va~ v index) や (va-set! (va~ v index) val) のように記述すると、
  vector-ref/vector-set! に展開されます。

• また、多次元のベクタ (例えば (define v (vector (vector 1 2 3) (vector 4 5 6))) 等) の場合にも、
  万能アクセサ(~)と同様に (va~ v index1 index2 ...) や (va-set! (va~ v index1 index2 ...) val) という記述が可能です。

• ただし、欠点として、ベクタ以外のクラスには使用することができません。
  また、一般化された set! にも使用することはできません。

(use gauche.time)
(use gauche.generator)

;; vector array accessor
(define-syntax va~
  (syntax-rules ()
    ((_ va index)
     (vector-ref va index))
    ((_ va index1 index2 ...)
     (va~ (vector-ref va index1) index2 ...))))

;; vector array setting
(define-syntax va-set!
  (syntax-rules ()
    ((_ (va~ va index) value)
     (vector-set! va index value))
    ((_ (va~ va index1 index2 ...) value)
     (va-set! (va~ (vector-ref va index1) index2 ...) value))))

;; make vector array
;;   (make-va '(2 3)) ; ==> #(#(0 0 0) #(0 0 0))
(define (make-va shape :optional (fill/gen 0))
  (define fill (if (procedure? fill/gen) 0  fill/gen))
  (define gen  (if (procedure? fill/gen) fill/gen #f))
  (define (%make-va shape fill)
    (let ((vlen (car shape))
          (rest (cdr shape)))
      (rlet1 va (make-vector vlen fill)
        (unless (null? rest)
          (dotimes (i vlen)
            (vector-set! va i (%make-va rest fill)))))))
  (define (%va-fill! va gen)
    (vector-for-each-with-index
     (lambda (i x)
       (if (vector? x)
         (%va-fill! x gen)
         (vector-set! va i (gen))))
     va))
  (when (or (not (list? shape)) (null? shape))
    (error "invalid shape" shape))
  (rlet1 va (%make-va shape fill)
    (if gen (%va-fill! va gen))))

;; print time
(define-syntax print-time
  (syntax-rules ()
    ((_ msg n body ...)
     (print msg (time-this n (lambda () body ...))))))

;; nested dotimes
(define-syntax dotimes*
  (syntax-rules ()
    ((_ ((x ...)) body ...)
     (dotimes (x ...) body ...))
    ((_ ((x ...) (y ...) ...) body ...)
     (dotimes (x ...) (dotimes* ((y ...) ...) body ...)))))

;; ***** test *****
(define n        100)
(define v1lenA 10000)
(define v1         (make-va `(,v1lenA) (giota)))
(define v2lenA  1000)
(define v2lenB    10)
(define v2         (make-va `(,v2lenA ,v2lenB) (giota)))
(define v3lenA   100)
(define v3lenB    10)
(define v3lenC    10)
(define v3         (make-va `(,v3lenA ,v3lenB ,v3lenC) (giota)))

;; vector array 1D
(print-time "v1:~        : " n (dotimes (i v1lenA) (~ v1 i)))
(print-time "v1:va~      : " n (dotimes (i v1lenA) (va~ v1 i)))
(print-time "v1:vec-ref  : " n (dotimes (i v1lenA) (vector-ref v1 i)))
(print-time "v1:set!     : " n (dotimes (i v1lenA) (set! (~ v1 i) (+ i 1))))
(print-time "v1:va-set!  : " n (dotimes (i v1lenA) (va-set! (va~ v1 i) (+ i 1))))
(print-time "v1:vec-set! : " n (dotimes (i v1lenA) (vector-set! v1 i (+ i 1))))
(print)

;; vector array 2D
(print-time "v2:~        : " n (dotimes* ((i v2lenA) (j v2lenB)) (~ v2 i j)))
(print-time "v2:va~      : " n (dotimes* ((i v2lenA) (j v2lenB)) (va~ v2 i j)))
(print-time "v2:vec-ref  : " n (dotimes* ((i v2lenA) (j v2lenB)) (vector-ref (vector-ref v2 i) j)))
(print-time "v2:set!     : " n (let1 c 1 (dotimes* ((i v2lenA) (j v2lenB)) (set! (~ v2 i j) c) (inc! c))))
(print-time "v2:va-set!  : " n (let1 c 1 (dotimes* ((i v2lenA) (j v2lenB)) (va-set! (va~ v2 i j) c) (inc! c))))
(print-time "v2:vec-set! : " n (let1 c 1 (dotimes* ((i v2lenA) (j v2lenB)) (vector-set! (vector-ref v2 i) j c) (inc! c))))
(print)

;; vector array 3D
(print-time "v3:~        : " n (dotimes* ((i v3lenA) (j v3lenB) (k v3lenC)) (~ v3 i j k)))
(print-time "v3:va~      : " n (dotimes* ((i v3lenA) (j v3lenB) (k v3lenC)) (va~ v3 i j k)))
(print-time "v3:vec-ref  : " n (dotimes* ((i v3lenA) (j v3lenB) (k v3lenC)) (vector-ref (vector-ref (vector-ref v3 i) j) k)))
(print-time "v3:set!     : " n (let1 c 1 (dotimes* ((i v3lenA) (j v3lenB) (k v3lenC)) (set! (~ v3 i j k) c) (inc! c))))
(print-time "v3:va-set!  : " n (let1 c 1 (dotimes* ((i v3lenA) (j v3lenB) (k v3lenC)) (va-set! (va~ v3 i j k) c) (inc! c))))
(print-time "v3:vec-set! : " n (let1 c 1 (dotimes* ((i v3lenA) (j v3lenB) (k v3lenC)) (vector-set! (vector-ref (vector-ref v3 i) j) k c) (inc! c))))
(print)

• Gauche 0.9.6_pre7 での実行結果 (OS: Windows 8.1 (64bit))

v1:~        : #<time-result 100 times/  0.525 real/  0.516 user/  0.047 sys>
v1:va~      : #<time-result 100 times/  0.047 real/  0.047 user/  0.000 sys>
v1:vec-ref  : #<time-result 100 times/  0.031 real/  0.031 user/  0.000 sys>
v1:set!     : #<time-result 100 times/  0.531 real/  0.719 user/  0.047 sys>
v1:va-set!  : #<time-result 100 times/  0.047 real/  0.046 user/  0.000 sys>
v1:vec-set! : #<time-result 100 times/  0.047 real/  0.047 user/  0.000 sys>

v2:~        : #<time-result 100 times/  1.158 real/  1.375 user/  0.094 sys>
v2:va~      : #<time-result 100 times/  0.062 real/  0.063 user/  0.000 sys>
v2:vec-ref  : #<time-result 100 times/  0.063 real/  0.062 user/  0.000 sys>
v2:set!     : #<time-result 100 times/  1.203 real/  1.360 user/  0.125 sys>
v2:va-set!  : #<time-result 100 times/  0.094 real/  0.094 user/  0.000 sys>
v2:vec-set! : #<time-result 100 times/  0.094 real/  0.094 user/  0.000 sys>

v3:~        : #<time-result 100 times/  2.266 real/  2.766 user/  0.281 sys>
v3:va~      : #<time-result 100 times/  0.062 real/  0.063 user/  0.000 sys>
v3:vec-ref  : #<time-result 100 times/  0.063 real/  0.062 user/  0.000 sys>
v3:set!     : #<time-result 100 times/  2.453 real/  3.063 user/  0.328 sys>
v3:va-set!  : #<time-result 100 times/  0.094 real/  0.094 user/  0.000 sys>
v3:vec-set! : #<time-result 100 times/  0.094 real/  0.094 user/  0.000 sys>

• Gauche 0.9.5 での実行結果 (OS: Windows 8.1 (64bit))

v1:~        : #<time-result 100 times/  0.906 real/  1.047 user/  0.156 sys>
v1:va~      : #<time-result 100 times/  0.031 real/  0.032 user/  0.000 sys>
v1:vec-ref  : #<time-result 100 times/  0.047 real/  0.047 user/  0.000 sys>
v1:set!     : #<time-result 100 times/  0.828 real/  0.968 user/  0.157 sys>
v1:va-set!  : #<time-result 100 times/  0.047 real/  0.047 user/  0.000 sys>
v1:vec-set! : #<time-result 100 times/  0.047 real/  0.047 user/  0.000 sys>

v2:~        : #<time-result 100 times/  2.000 real/  2.265 user/  0.516 sys>
v2:va~      : #<time-result 100 times/  0.062 real/  0.063 user/  0.000 sys>
v2:vec-ref  : #<time-result 100 times/  0.062 real/  0.062 user/  0.000 sys>
v2:set!     : #<time-result 100 times/  1.688 real/  1.781 user/  0.390 sys>
v2:va-set!  : #<time-result 100 times/  0.078 real/  0.078 user/  0.000 sys>
v2:vec-set! : #<time-result 100 times/  0.094 real/  0.094 user/  0.000 sys>

v3:~        : #<time-result 100 times/  3.609 real/  4.235 user/  0.828 sys>
v3:va~      : #<time-result 100 times/  0.063 real/  0.063 user/  0.000 sys>
v3:vec-ref  : #<time-result 100 times/  0.063 real/  0.062 user/  0.000 sys>
v3:set!     : #<time-result 100 times/  3.156 real/  3.671 user/  0.718 sys>
v3:va-set!  : #<time-result 100 times/  0.094 real/  0.094 user/  0.000 sys>
v3:vec-set! : #<time-result 100 times/  0.094 real/  0.094 user/  0.000 sys>

• 結果として、万能アクセサ(~)に比べて、10～30倍程度の高速化になりました。
  また、vector-ref/vector-set! を直接使う場合に比べて、若干すっきり書けたと思います。
  (特に多次元のベクタの場合)
  ただし、ここがボトルネックになるとは限りませんし、また、多次元配列を扱うケースでも、
  バックエンドでは一次元のベクタ(もしくはuvector等)でデータを保持した方が、
  処理の最適化が行いやすいかもしれません。。。

hamayama(2018/06/20 15:34:09 UTC)(2018/06/21 03:00:47 UTC)
(2018/06/22 11:43:22 UTC)(2018/06/23 13:21:06 UTC)