suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

sequence & list: add in-inclusive-range and inclusive-range

Browse Source 
Currently, a common way to generate an inclusive range is to
use `in-range`, but users need to figure out an appropriate
upper bound, which (1) is error-prone and (2) obscures the intention.
As an example, https://docs.racket-lang.org/pict/Animation_Helpers.html
uses `(in-range 0 1.2 0.2)` to generate `'(0 0.2 0.4 0.6 0.8 1.0)`.
It is also quite common to use `(in-range 1 (add1 n))` to generate
`(list 1 2 ... n)`. Both examples are subpar.

This PR adds `in-inclusive-range` as a counterpart to `in-range`, and
`inclusive-range` as a counterpart to `range`, to make inclusive range
construction easier.

An alternative API is to modify `in-range` to accept a keyword argument
like `#:inclusive? #t`, but this is more verbose and no other sequence
generating function accepts keyword arguments.
Therefore, I think `(in-)inclusive-range` is more appropriate.
This commit is contained in:
sorawee 2021-04-05 21:02:36 +07:00 committed by GitHub
parent b7078dc272
commit e8f857cc19
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 185 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
pkgs/racket-doc/scribblings/reference/pairs.scrbl
View File

@ -1338,6 +1338,29 @@ performance when it appears directly in a @racket[for] clause.
way that @racket[in-range] does.}]}
@defproc[(inclusive-range [start real?] [end real?] [step real? 1]) list?]{
Similar to @racket[in-inclusive-range], but returns lists.
The resulting list holds numbers starting at @racket[start] and whose
successive elements are computed by adding @racket[step] to their
predecessor until @racket[end] (included) is reached.
If no @racket[step] argument is provided, @racket[1] is used.
Like @racket[in-inclusive-range], a @racket[inclusive-range] application can provide better
performance when it appears directly in a @racket[for] clause.
@mz-examples[#:eval list-eval
(inclusive-range 10 20)
(inclusive-range 20 40 2)
(inclusive-range 20 10 -1)
(inclusive-range 10 15 1.5)]
@history[#:added "8.0.0.13"]
}
@defproc[(append-map [proc procedure?] [lst list?] ...+)
list?]{

14
pkgs/racket-doc/scribblings/reference/sequences.scrbl
View File

@ -189,6 +189,20 @@ each element in the sequence.
floating-point numbers.
}
@defproc[(in-inclusive-range [start real?] [end real?] [step real? 1]) stream?]{
Similar to @racket[in-range], but the sequence stopping condition is changed so that
the last element is allowed to be equal to @racket[end]. @speed[in-inclusive-range "number"]
@examples[#:eval sequence-evaluator
(sequence->list (in-inclusive-range 7 11))
(sequence->list (in-inclusive-range 7 11 2))
(sequence->list (in-inclusive-range 7 10 2))
]
@history[#:added "8.0.0.13"]
}
@defproc[(in-naturals [start exact-nonnegative-integer? 0]) stream?]{
Returns an infinite sequence (that is also a @tech{stream}) of exact

26
pkgs/racket-test-core/tests/racket/for.rktl
View File

@ -5,6 +5,17 @@
(require "for-util.rkt")
;; These are copied from
;; https://github.com/racket/r6rs/blob/master/r6rs-lib/rnrs/arithmetic/fixnums-6.rkt
(define CS? (eq? 'chez-scheme (system-type 'vm)))
(define 64-bit? (fixnum? (expt 2 33)))
(define (least-fixnum) (if CS?
(if 64-bit? (- (expt 2 60)) -536870912)
(if 64-bit? (- (expt 2 62)) -1073741824)))
(define (greatest-fixnum) (if CS?
(if 64-bit? (- (expt 2 60) 1) +536870911)
(if 64-bit? (- (expt 2 62) 1) +1073741823)))
(test-sequence [(0 1 2)] 3)
(test-sequence [(0 1 2)] (in-range 3))
(test-sequence [(3 4 5)] (in-range 3 6))
@ -12,8 +23,23 @@
(test-sequence [(3.0 4.0 5.0)] (in-range 3.0 6.0))
(test-sequence [(3.0 3.5 4.0 4.5 5.0 5.5)] (in-range 3.0 6.0 0.5))
(test-sequence [(3.0 3.1 3.2)] (in-range 3.0 3.3 0.1))
(test-sequence [(6 7)] (in-inclusive-range 6 7))
(test-sequence [(3 4 5 6)] (in-inclusive-range 3 6))
(test-sequence [(7 6 5 4)] (in-inclusive-range 7 4 -1))
(test-sequence [(3.0 4.0 5.0 6.0)] (in-inclusive-range 3.0 6.0))
(test-sequence [(3.0 3.5 4.0 4.5 5.0 5.5 6.0)] (in-inclusive-range 3.0 6.0 0.5))
(test-sequence [(#e3.0 #e3.1 #e3.2 #e3.3)] (in-inclusive-range #e3.0 #e3.3 #e0.1))
(test-sequence [(,(least-fixnum)
,(+ (least-fixnum) 1))]
(in-inclusive-range (least-fixnum)
(+ (least-fixnum) 1)))
(test-sequence [(,(- (greatest-fixnum) 1)
,(greatest-fixnum))]
(in-inclusive-range (- (greatest-fixnum) 1)
(greatest-fixnum)))
(err/rt-test (for/list ([x (in-range)]) x))
(err/rt-test (in-range))
(err/rt-test (for/list ([x (in-inclusive-range 1)]) x))
(err/rt-test (for/list ([x (in-naturals 0 1)]) x))
(err/rt-test (in-naturals 0 1))

16
pkgs/racket-test-core/tests/racket/list.rktl
View File

@ -600,6 +600,22 @@
(test '(20 19 18 17 16 15 14 13 12 11) range 20 10 -1)
(test '(10 11.5 13.0 14.5) range 10 15 1.5))
;; ---------- inclusive-range ----------
(let ()
(test '() inclusive-range 3 2)
(test '(3) inclusive-range 3 3)
(test '(3 2) inclusive-range 3 2 -1)
(test '(3 4 5 6 7 8 9) inclusive-range 3 9)
(test '(3 5 7 9) inclusive-range 3 9 2)
(test '(3 5 7) inclusive-range 3 8 2)
(test '(3 3.5 4.0 4.5 5.0 5.5 6.0 6.5 7.0 7.5 8.0 8.5 9.0) inclusive-range 3 9 0.5)
(test '(9 7 5 3) inclusive-range 9 3 -2)
(test '(10 11 12 13 14 15 16 17 18 19 20) inclusive-range 10 20)
(test '(20 22 24 26 28 30 32 34 36 38 40) inclusive-range 20 40 2)
(test '(20 19 18 17 16 15 14 13 12 11 10) inclusive-range 20 10 -1)
(test '(10 11.5 13.0 14.5) inclusive-range 10 15 1.5))
;; ---------- group-by ----------
(test '((1) (4) (2 2) (56) (3)) group-by values '(1 4 2 56 2 3))

18
racket/collects/racket/list.rkt
View File

@ -47,6 +47,7 @@
;; convenience
range
inclusive-range
append-map
filter-not
shuffle
@ -573,6 +574,15 @@
[(start end step) (for/list ([i (in-range start end step)]) i)]))
range))
(define inclusive-range-proc
(let ()
; make sure range has the right runtime name
(define inclusive-range
(case-lambda
[(start end) (for/list ([i (in-inclusive-range start end)]) i)]
[(start end step) (for/list ([i (in-inclusive-range start end step)]) i)]))
inclusive-range))
(define-sequence-syntax range
(λ () #'range-proc)
(λ (stx)
@ -582,6 +592,14 @@
[[(n) (_ start end step)] #'[(n) (in-range start end step)]]
[[ids range-expr] #'[ids (#%expression range-expr)]])))
(define-sequence-syntax inclusive-range
(λ () #'inclusive-range-proc)
(λ (stx)
(syntax-case stx ()
[[(n) (_ start end)] #'[(n) (in-inclusive-range start end)]]
[[(n) (_ start end step)] #'[(n) (in-inclusive-range start end step)]]
[[ids range-expr] #'[ids (#%expression range-expr)]])))
(define append-map
(case-lambda [(f l) (apply append (map f l))]
[(f l1 l2) (apply append (map f l1 l2))]

126
racket/collects/racket/private/for.rkt
View File

@ -40,6 +40,7 @@
(for-syntax (rename expand-clause expand-for-clause))
(rename *in-range in-range)
(rename *in-inclusive-range in-inclusive-range)
(rename *in-naturals in-naturals)
(rename *in-list in-list)
(rename *in-mlist in-mlist)
@ -634,10 +635,13 @@
#f))))))
(define (check-range a b step)
(unless (real? a) (raise-argument-error 'in-range "real?" a))
(unless (real? b) (raise-argument-error 'in-range "real?" b))
(unless (real? step) (raise-argument-error 'in-range "real?" step)))
(check-range-generic 'in-range a b step))
(define (check-range-generic who a b step)
(unless (real? a) (raise-argument-error who "real?" a))
(unless (real? b) (raise-argument-error who "real?" b))
(unless (real? step) (raise-argument-error who "real?" step)))
(define in-range
(case-lambda
[(b) (in-range 0 b 1)]
@ -650,6 +654,17 @@
[inc (lambda (x) (+ x step))])
(make-range a inc cont?))]))
(define in-inclusive-range
(case-lambda
[(a b) (in-inclusive-range a b 1)]
[(a b step)
(check-range-generic 'in-inclusive-range a b step)
(let* ([cont? (if (step . >= . 0)
(lambda (x) (<= x b))
(lambda (x) (>= x b)))]
[inc (lambda (x) (+ x step))])
(make-range a inc cont?))]))
(define (:integer-gen v)
(values values #f add1 0 (lambda (i) (i . < . v)) #f #f))
@ -2091,50 +2106,85 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; specific sequences
(define-for-syntax (generate-for-clause-for-in-range-like
id a b step
all-fx? check
unsafe-fx< unsafe-fx> < >)
(with-syntax ([id id]
[a a]
[b b]
[step step]
[(check ...) check]
[unsafe-fx< unsafe-fx<]
[unsafe-fx> unsafe-fx>]
[< <]
[> >])
(for-clause-syntax-protect
#`[(id)
(:do-in
;; outer bindings:
([(start) a] [(end) b] [(inc) step])
;; outer check:
;; let `check' report the error:
(unless-unsafe (check ... start end inc))
;; loop bindings:
([pos start])
;; pos check
#,(cond [all-fx?
;; Special case, can use unsafe ops:
(if ((syntax-e #'step) . >= . 0)
#'(unsafe-fx< pos end)
#'(unsafe-fx> pos end))]
;; General cases:
[(not (number? (syntax-e #'step)))
#'(if (step . >= . 0) (< pos end) (> pos end))]
[((syntax-e #'step) . >= . 0)
#'(< pos end)]
[else
#'(> pos end)])
;; inner bindings
([(id) pos])
;; pre guard
#t
;; post guard
#t
;; loop args
((#,(if all-fx? #'unsafe-fx+ #'+) pos inc)))])))
(define-sequence-syntax *in-range
(lambda () #'in-range)
(lambda (stx)
(let loop ([stx stx])
(syntax-case stx ()
[[(id) (_ a b step)]
(let ([all-fx? (and (fixnum? (syntax-e #'a))
(fixnum? (syntax-e #'b))
(memq (syntax-e #'step) '(1 -1)))])
(for-clause-syntax-protect
#`[(id)
(:do-in
;; outer bindings:
([(start) a] [(end) b] [(inc) step])
;; outer check:
;; let `check-range' report the error:
(unless-unsafe (check-range start end inc))
;; loop bindings:
([pos start])
;; pos check
#,(cond [all-fx?
;; Special case, can use unsafe ops:
(if ((syntax-e #'step) . >= . 0)
#'(unsafe-fx< pos end)
#'(unsafe-fx> pos end))]
;; General cases:
[(not (number? (syntax-e #'step)))
#`(if (step . >= . 0) (< pos end) (> pos end))]
[((syntax-e #'step) . >= . 0)
#'(< pos end)]
[else
#'(> pos end)])
;; inner bindings
([(id) pos])
;; pre guard
#t
;; post guard
#t
;; loop args
((#,(if all-fx? #'unsafe-fx+ #'+) pos inc)))]))]
(generate-for-clause-for-in-range-like
#'id #'a #'b #'step
(and (memq (syntax-e #'step) '(1 -1))
(fixnum? (syntax-e #'a))
(fixnum? (syntax-e #'b)))
#'(check-range)
#'unsafe-fx< #'unsafe-fx> #'< #'>)]
[[(id) (_ a b)] (loop #'[(id) (_ a b 1)])]
[[(id) (_ b)] (loop #'[(id) (_ 0 b 1)])]
[_ #f]))))
(define-sequence-syntax *in-inclusive-range
(lambda () #'in-inclusive-range)
(lambda (stx)
(let loop ([stx stx])
(syntax-case stx ()
[[(id) (_ a b step)]
(generate-for-clause-for-in-range-like
#'id #'a #'b #'step
(and (memq (syntax-e #'step) '(1 -1))
(fixnum? (syntax-e #'a))
(fixnum? ((if (eq? (syntax-e #'step) 1) add1 sub1)
(syntax-e #'b))))
#'(check-range-generic 'in-inclusive-range)
#'unsafe-fx<= #'unsafe-fx>= #'<= #'>=)]
[[(id) (_ a b)] (loop #'[(id) (_ a b 1)])]
[_ #f]))))
(define-sequence-syntax *in-naturals
(lambda () #'in-naturals)
(lambda (stx)