Gauche:クラスとレコード型

Gauche:クラスとレコード型

クラスとレコード型

(use gauche.time)
(use gauche.record)

;; ***** class *****
(define-class <point-A> ()
  ((x   :init-value 0)
   (y   :init-value 0)
   (sum :init-value 0)
   ))
(define-method set-data-A-1 ((p <point-A>) (x <real>) (y <real>))
  (slot-set! p 'x   x)
  (slot-set! p 'y   y)
  (slot-set! p 'sum (+ (slot-ref p 'x) (slot-ref p 'y))))
(define (set-data-A-2 p x y)
  (slot-set! p 'x   x)
  (slot-set! p 'y   y)
  (slot-set! p 'sum (+ (slot-ref p 'x) (slot-ref p 'y))))
(define-method set-data-A-3 ((p <point-A>) (x <real>) (y <real>))
  (set! (~ p 'x)    x)
  (set! (~ p 'y)    y)
  (set! (~ p 'sum)  (+ (~ p 'x) (~ p 'y))))
(define (set-data-A-4 p x y)
  (set! (~ p 'x)    x)
  (set! (~ p 'y)    y)
  (set! (~ p 'sum)  (+ (~ p 'x) (~ p 'y))))

;; ***** record type *****
(define-record-type point-B #t #t
  (x) (y) (sum))
(define-method set-data-B-1 ((p point-B) (x <real>) (y <real>))
  (point-B-x-set!   p x)
  (point-B-y-set!   p y)
  (point-B-sum-set! p (+ (point-B-x p) (point-B-y p))))
(define (set-data-B-2 p x y)
  (point-B-x-set!   p x)
  (point-B-y-set!   p y)
  (point-B-sum-set! p (+ (point-B-x p) (point-B-y p))))
(define-method set-data-B-3 ((p point-B) (x <real>) (y <real>))
  (set! (~ p 'x)    x)
  (set! (~ p 'y)    y)
  (set! (~ p 'sum)  (+ (~ p 'x) (~ p 'y))))
(define (set-data-B-4 p x y)
  (set! (~ p 'x)    x)
  (set! (~ p 'y)    y)
  (set! (~ p 'sum)  (+ (~ p 'x) (~ p 'y))))

;; ***** pseudo record type *****
(define-record-type (point-C (pseudo-rtd <vector>)) #t #t
  (x) (y) (sum))
(define-method set-data-C-1 ((p <vector>) (x <real>) (y <real>))
  (point-C-x-set!   p x)
  (point-C-y-set!   p y)
  (point-C-sum-set! p (+ (point-C-x p) (point-C-y p))))
(define (set-data-C-2 p x y)
  (point-C-x-set!   p x)
  (point-C-y-set!   p y)
  (point-C-sum-set! p (+ (point-C-x p) (point-C-y p))))

;; ***** test *****
(define n 1000000)
(define p-A (make <point-A>))
(define p-B (make-point-B 0 0 0))
(define p-C (make-point-C 0 0 0))
(print "cls-method : " (time-this n (lambda () (set-data-A-1 p-A 1 2))))
(print "rcd-method : " (time-this n (lambda () (set-data-B-1 p-B 1 2))))
(print "psd-method : " (time-this n (lambda () (set-data-C-1 p-C 1 2))))
(print)
(print "cls-proc   : " (time-this n (lambda () (set-data-A-2 p-A 1 2))))
(print "rcd-proc   : " (time-this n (lambda () (set-data-B-2 p-B 1 2))))
(print "psd-proc   : " (time-this n (lambda () (set-data-C-2 p-C 1 2))))
(print)
(print "cls-method~: " (time-this n (lambda () (set-data-A-3 p-A 1 2))))
(print "rcd-method~: " (time-this n (lambda () (set-data-B-3 p-B 1 2))))
(print)
(print "cls-proc~  : " (time-this n (lambda () (set-data-A-4 p-A 1 2))))
(print "rcd-proc~  : " (time-this n (lambda () (set-data-B-4 p-B 1 2))))
(print)
(print "cls-make   : " (time-this n (lambda () (set! p-A (make <point-A>)))))
(print "rcd-make   : " (time-this n (lambda () (set! p-B (make-point-B 0 0 0)))))
(print "psd-make   : " (time-this n (lambda () (set! p-C (make-point-C 0 0 0)))))

cls-method : #<time-result 1000000 times/  0.438 real/  0.438 user/  0.000 sys>
rcd-method : #<time-result 1000000 times/  0.656 real/  0.655 user/  0.000 sys>
psd-method : #<time-result 1000000 times/  0.344 real/  0.344 user/  0.000 sys>

cls-proc   : #<time-result 1000000 times/  0.375 real/  0.375 user/  0.000 sys>
rcd-proc   : #<time-result 1000000 times/  0.641 real/  0.640 user/  0.000 sys>
psd-proc   : #<time-result 1000000 times/  0.297 real/  0.297 user/  0.000 sys>

cls-method~: #<time-result 1000000 times/  1.813 real/  2.000 user/  0.047 sys>
rcd-method~: #<time-result 1000000 times/  1.797 real/  1.827 user/  0.062 sys>

cls-proc~  : #<time-result 1000000 times/  1.750 real/  1.764 user/  0.078 sys>
rcd-proc~  : #<time-result 1000000 times/  1.734 real/  1.844 user/  0.031 sys>

cls-make   : #<time-result 1000000 times/  1.266 real/  1.500 user/  0.297 sys>
rcd-make   : #<time-result 1000000 times/  0.234 real/  0.282 user/  0.047 sys>
psd-make   : #<time-result 1000000 times/  0.187 real/  0.235 user/  0.047 sys>
cls-method : #<time-result 1000000 times/  0.984 real/  1.282 user/  0.203 sys>
rcd-method : #<time-result 1000000 times/  1.281 real/  1.547 user/  0.141 sys>
psd-method : #<time-result 1000000 times/  0.939 real/  0.969 user/  0.203 sys>

cls-proc   : #<time-result 1000000 times/  0.375 real/  0.374 user/  0.000 sys>
rcd-proc   : #<time-result 1000000 times/  0.797 real/  0.750 user/  0.047 sys>
psd-proc   : #<time-result 1000000 times/  0.484 real/  0.485 user/  0.000 sys>

cls-method~: #<time-result 1000000 times/  4.328 real/  4.858 user/  0.906 sys>
rcd-method~: #<time-result 1000000 times/  4.313 real/  4.953 user/  0.891 sys>

cls-proc~  : #<time-result 1000000 times/  3.859 real/  4.298 user/  0.687 sys>
rcd-proc~  : #<time-result 1000000 times/  3.813 real/  4.172 user/  0.828 sys>

cls-make   : #<time-result 1000000 times/  1.797 real/  2.124 user/  0.438 sys>
rcd-make   : #<time-result 1000000 times/  0.250 real/  0.219 user/  0.078 sys>
psd-make   : #<time-result 1000000 times/  0.203 real/  0.250 user/  0.047 sys>

hamayama(2018/06/05 13:27:34 UTC)(2018/06/05 14:25:10 UTC)
(2018/06/05 15:05:45 UTC)(2018/06/06 12:05:13 UTC)
(2018/06/06 23:01:58 UTC)(2018/06/08 02:38:21 UTC)
(2018/06/17 13:35:30 UTC)(2018/06/20 13:47:31 UTC)

hamayama(2018/06/06 12:05:13 UTC): テストの内容を少し見直しました(random-real と atan を削除しました)。
結果の傾向は、ほぼ同じです。
また、make のテストを追加してみました。
こちらは、クラスが一番時間がかかるようでした。

More ...