Fixing seqn-count

This commit is contained in:
Jay McCarthy 2010-08-13 15:00:42 -06:00
parent 7853c5c893
commit 58b9c7a6e4
3 changed files with 17 additions and 10 deletions

View File

@ -222,11 +222,15 @@
(λ _ #t)
(λ _ #t)))))
(define (seqn-count s)
(define (seqn-count f s)
(unless (procedure? f)
(error 'seqn-count "expects a procedure as the first argument, given ~e" f))
(define-values (more? next) (sequence-generate s))
(let loop ([n 0])
(if (more?)
(begin (next) (loop (add1 n)))
(if (call-with-values next f)
(loop (add1 n))
(loop n))
n)))
(provide empty-seqn

View File

@ -149,9 +149,9 @@ then operations on this sequence will not terminate during that infinite sub-seq
sequence?]{
Returns a sequence whose elements are the elements of @scheme[s] except in between each is @scheme[e]. The new sequence is constructed lazily. }
@defproc[(seqn-count [s sequence?])
@defproc[(seqn-count [f procedure?] [s sequence?])
exact-nonnegative-integer?]{
Returns the number of elements in @scheme[s]. If @scheme[s] is infinite, this function does not terminate. }
Returns the number of elements in @scheme[s] for which @scheme[f] returns a true result. If @scheme[s] is infinite, this function does not terminate. }
@defproc*[([(in-range [end number?]) sequence?]
[(in-range [start number?] [end number?] [step number? 1]) sequence?])]{

View File

@ -385,11 +385,14 @@
(test 1 'seqn-add-between (seqn-ref (seqn-add-between (in-naturals) #t) 2))
(test #t 'seqn-add-between (seqn-ref (seqn-add-between (in-naturals) #t) 3))
(arity-test seqn-count 1 1)
(test 0 'seqn-count (seqn-count empty-seqn))
(test 1 'seqn-count (seqn-count (in-range 1)))
(test 10 'seqn-count (seqn-count (in-range 10)))
(let ([r (random 100)])
(test r 'seqn-count (seqn-count (in-range r))))
(arity-test seqn-count 2 2)
(test 0 'seqn-count (seqn-count even? empty-seqn))
(test 1 'seqn-count (seqn-count even? (in-range 1)))
(test 5 'seqn-count (seqn-count even? (in-range 10)))
(let* ([r (random 100)]
[a (if (even? r)
(/ r 2)
(ceiling (/ r 2)))])
(test a 'seqn-count (seqn-count even? (in-range r))))
(report-errs)