(use srfi-1) ; for list-tabulate (use gauche.generator) ; for grange (use srfi-42) ; for list-ec (use gauche.test) (use gauche.time) ;; ***** range ***** ;; (range end) : start=0, step=1 ;; (range start end) : step=1 ;; (range start end step) : ;; when step>0 ;; ==> '(start start+step start+step*2 ... end1) : end1<end ;; when step<0 ;; ==> '(start start+step start+step*2 ... end1) : end1>end ;; when step=0 ;; ==> '() ;; (define-macro (define-range-macro name core-logic) `(define-syntax ,name (syntax-rules () [(_ end) (,name 0 end 1)] [(_ start end) (,name start end 1)] [(_ start end step) (if (or (= start end) (= step 0) (and (< start end) (< step 0)) (and (> start end) (> step 0))) '() ,core-logic)]))) ;; range1 - using cons and reverse ;; (for inexact numbers, we use multiplication to avoid error accumulation) (define-range-macro range1 (if (and (exact? start) (exact? step)) (let ([op (if (< step 0) > <)]) (let loop ([r '()] [v start]) (if (op v end) (loop (cons v r) (+ v step)) (reverse r)))) (let ([s (inexact start)] [op (if (< step 0) > <)]) (let loop ([r '()] [v s] [i 1]) (if (op v end) (loop (cons v r) (+ s (* i step)) (+ i 1)) (reverse r)))))) ;; range2 - using iota (define-range-macro range2 (iota (ceiling (/ (- end start) step)) start step)) ;; range3 - using list-tabulate (define-range-macro range3 (list-tabulate (ceiling (/ (- end start) step)) (lambda (i) (+ start (* step i))))) ;; range4 - using grange (define-range-macro range4 (generator->list (grange start end step))) ;; range5 - using list-ec ;; (%range5 is used to avoid macro expansion error) (define (%range5 start end step) (list-ec (: v start end step) v)) (define-range-macro range5 (%range5 start end step)) ;; ***** test ***** (define approx=? (if (global-variable-bound? 'gauche 'approx=?) (with-module gauche approx=?) ;; for Gauche v0.9.7 (^[x y :optional (rel-tol 1e-12) (abs-tol 0)] (cond [(eqv? x y) #t] [(or (not (finite? x)) (not (finite? y))) #f] [else (<= (abs (- x y)) (max (* (max (abs x) (abs y)) rel-tol) abs-tol))])))) (define (test-group-1 name proc check) (define (test-name str) (string-append name "-" str)) `(begin (test* ,(test-name "test1") '(0 1 2 3 4) (,proc 5) ,check) (test* ,(test-name "test2") '(0 1 2 3 4) (,proc 0 5) ,check) (test* ,(test-name "test3") '(0 1 2 3 4) (,proc 0 5 1) ,check) (test* ,(test-name "test4") '(0 -1 -2 -3 -4) (,proc 0 -5 -1) ,check) (test* ,(test-name "test5") '(0 3 6 9) (,proc 0 10 3) ,check) (test* ,(test-name "test6") '(0 -3 -6 -9) (,proc 0 -10 -3) ,check) (test* ,(test-name "test7") '(0.0 1.0 2.0 3.0 4.0) (,proc 5.0) ,check) (test* ,(test-name "test8") '(0.0 1.0 2.0 3.0 4.0) (,proc 0.0 5.0) ,check) (test* ,(test-name "test9") '(0.0 1.0 2.0 3.0 4.0) (,proc 0.0 5.0 1.0) ,check) (test* ,(test-name "test10") '(0.0 -1.0 -2.0 -3.0 -4.0) (,proc 0.0 -5.0 -1.0) ,check) (test* ,(test-name "test11") '(0.0 0.2 0.4 0.6 0.8) (,proc 0.0 1.0 0.2) ,check) (test* ,(test-name "test12") '(0.0 -0.2 -0.4 -0.6 -0.8) (,proc 0.0 -1.0 -0.2) ,check) (test* ,(test-name "test13") '() (,proc 10 10 0) ,check) (test* ,(test-name "test14") '() (,proc 0 10 0) ,check) (test* ,(test-name "test15") '() (,proc 0 10 -1) ,check) (test* ,(test-name "test16") '() (,proc 0 -10 1) ,check) (newline))) (define-macro (test-group check) (reverse (fold (^[proc ret] (cons (test-group-1 (x->string proc) proc check) ret)) '(begin) '(range1 range2 range3 range4 range5)))) (test-group (^[a b] (list= approx=? a b))) ;; ***** time ***** (define (time-group-1 name proc no n start end step) `(print ,name "-time" ,no ": " (time-this ,n (^[] (,proc ,start ,end ,step))))) (define-macro (time-group no n start end step) (reverse (fold (^[proc ret] (cons (time-group-1 (x->string proc) proc no n start end step) ret)) '(begin) '(range1 range2 range3 range4 range5)) '((newline)))) (time-group 1 10000 0 1000 1) (time-group 2 10000 0.0 100.0 0.1)
range1-time1: #<time-result 10000 times/ 1.469 real/ 1.719 user/ 0.250 sys> range2-time1: #<time-result 10000 times/ 0.859 real/ 1.016 user/ 0.078 sys> range3-time1: #<time-result 10000 times/ 1.188 real/ 1.438 user/ 0.063 sys> range4-time1: #<time-result 10000 times/ 1.734 real/ 2.032 user/ 0.218 sys> range5-time1: #<time-result 10000 times/ 2.071 real/ 2.328 user/ 0.250 sys> range1-time2: #<time-result 10000 times/ 2.226 real/ 2.672 user/ 0.188 sys> range2-time2: #<time-result 10000 times/ 1.594 real/ 1.812 user/ 0.250 sys> range3-time2: #<time-result 10000 times/ 1.863 real/ 1.516 user/ 0.391 sys> range4-time2: #<time-result 10000 times/ 2.404 real/ 2.938 user/ 0.343 sys> range5-time2: #<time-result 10000 times/ 2.883 real/ 3.281 user/ 0.360 sys>
hamayama(2019/07/13 06:09:48 UTC)(2019/07/13 13:27:48 UTC)
(2019/07/14 04:52:18 UTC)
Shiro(2019/07/13 10:25:55 UTC): lrangeは負のステップに対応してます。grangeが対応してないのは見落としっぽい。
gosh> (lrange 10 1 -1) (10 9 8 7 6 5 4 3 2)
Shiro(2019/07/14 08:34:23 UTC): あと、Racketがrangeで引数ひとつの時にend指定とみなすのは、 eagerなrangeでendを指定しないのは意味が無いからだと思います。計算が終わらないので。 一方、grangeやlrangeはlazyなので、逆に無限に続く数列の方が使い勝手が良く、Gauche ではそちらをデフォルトにしています。もしGaucheにrangeを入れるとしたら、startとend 両方必須にすると思います。