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

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

ベクタと万能アクセサ

(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)

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>
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>

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)

More ...