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