Gauche:rangeの作成
- Racket にある range を実装してみました。これは、
(range 0 5 1) ==> '(0 1 2 3 4)
のように start, end, step の3引数を指定して、リストを生成するものです。
- 実装方法がいくつか考えられたため、range1 から range5 の 5通り作成してみました。
range1 は cons と reverse を使ったものです。
range2 は iota を使ったものです。
range3 は list-tabulate を使ったものです。
range4 は grange を使ったものです。
range5 は list-ec を使ったものです。
- Racket の range は、引数を1つだけ指定すると end を指定したことになります。
今回は、同じ仕様にしました。
(Gauche の grange や lrange では、start を指定したことになるため、仕様が異なります)
- Racket の range で step に 0 を指定すると、メモリを使いはたしてPCごと固まりました。
今回は、step に 0 を指定した場合には、空リストを返すようにしました。
- また、start と end が等しい場合や、step の符号が逆で end に向かわない場合についても、
空リストを返すようにしました。
(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)
- Gauche 0.9.8 での実行時間は、以下のようになりました。(OS: Windows 8.1 (64bit))
rangeX-time1 が引数に正確数を指定した場合で、rangeX-time2 が引数に不正確数を指定した場合です。
range2 の iota 版が 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>
- 補足: Gauche の grange や lrange は、負の step に対応していないようです。
このため、range4 も負の step に対しては、空リストが返ります。
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)
- hamayama(2019/07/13 13:27:48 UTC): すいません lrange は勘違いでした。
grange も HEAD で対応されていることを確認できました。
Shiro(2019/07/14 08:34:23 UTC): あと、Racketがrangeで引数ひとつの時にend指定とみなすのは、 eagerなrangeでendを指定しないのは意味が無いからだと思います。計算が終わらないので。 一方、grangeやlrangeはlazyなので、逆に無限に続く数列の方が使い勝手が良く、Gauche ではそちらをデフォルトにしています。もしGaucheにrangeを入れるとしたら、startとend 両方必須にすると思います。