add slice-at, slicef-at

pull/2/head
Matthew Butterick 10 years ago
parent 50880f0866
commit b6cd43bb88

File diff suppressed because one or more lines are too long

@ -7,14 +7,25 @@
(list? procedure? . -> . list?) (list? procedure? . -> . list?)
(dropf-right (dropf xs test-proc) test-proc)) (dropf-right (dropf xs test-proc) test-proc))
(define+provide/contract (slicef-at xs pred [force? #f])
(define+provide/contract (list->slices xs len) ((list? procedure?) (boolean?) . ->* . (listof list?))
(list? integer? . -> . (listof list?)) (cond
[(null? xs) null]
[force? (slicef-at (dropf xs (compose1 not pred)) pred)]
[else
(define-values (car-match others) (splitf-at xs pred))
(define-values (head tail) (splitf-at others (compose1 not pred)))
(cons (append (or car-match null) head) (slicef-at tail pred force?))]))
(require sugar/debug)
(define+provide/contract (slice-at xs len [force? #f])
((list? (and/c integer? positive?)) (boolean?) . ->* . (listof list?))
(cond (cond
[(equal? xs null) null] [(equal? xs null) null]
[(len . > . (length xs)) (list xs)] [(len . > . (length xs)) (if force? null (list xs))]
[else (cons (take xs len) (list->slices (drop xs len) len))])) [else (cons (take xs len) (slice-at (drop xs len) len force?))]))
(define list->slices slice-at) ; backward compatibility
(define+provide/contract (filter-split xs split-test) (define+provide/contract (filter-split xs split-test)
(list? predicate/c . -> . (listof list?)) (list? predicate/c . -> . (listof list?))

@ -36,6 +36,37 @@ Like @racket[string-split], but for lists. Drop elements from anywhere in @racke
(filter-split '(a b c 1 2 3 d e f) integer?) (filter-split '(a b c 1 2 3 d e f) integer?)
(filter-split '(a b c 1 2 3 d e f) (compose not integer?))] (filter-split '(a b c 1 2 3 d e f) (compose not integer?))]
@defproc[
(slice-at
[lst list?]
[len (and/c integer? positive?)]
[force? boolean? #f])
(listof list?)]
Divide @racket[_lst] into sublists of length @racket[_len]. If @racket[_lst] cannot be divided evenly by @racket[_len], the last sublist will be shorter. If this displeases you, set @racket[_force?] to @racket[#t] and a stumpy final sublist will be ignored.
@examples[#:eval my-eval
(slice-at (range 5) 1)
(slice-at (range 5) 2)
(slice-at (range 5) 2 #t)
(slice-at (range 5) 3)
(slice-at (range 5) 5)
(slice-at (range 5) 5 #t)
(slice-at (range 5) 100000)
(slice-at (range 5) 100000 #t)]
@defproc[
(slicef-at
[lst list?]
[pred procedure?]
[force? boolean? #f])
(listof list?)]
Divide @racket[_lst] into sublists starting with elements matching @racket[_pred]. The first element of the first sublist may not match @racket[_pred]. Or, if you really & truly want only the sublists starting with an element matching @racket[_pred], set @racket[_force?] to @racket[#t].
@examples[#:eval my-eval
(slicef-at (range 5) even?)
(slicef-at (range 5) odd?)
(slicef-at (range 5) odd? #t)]
@defproc[ @defproc[
(frequency-hash (frequency-hash

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require rackunit net/url racket/set) (require rackunit net/url racket/set racket/list)
(require "main.rkt") (require "main.rkt")
(check-equal? (->string "foo") "foo") (check-equal? (->string "foo") "foo")
@ -142,3 +142,16 @@
(check-false (ends-with? "foobar" "foobars")) (check-false (ends-with? "foobar" "foobars"))
(check-true (capitalized? "Brennan")) (check-true (capitalized? "Brennan"))
(check-false (capitalized? "foobar")) (check-false (capitalized? "foobar"))
(check-equal? (slice-at (range 5) 1) '((0) (1) (2) (3) (4)))
(check-equal? (slice-at (range 5) 2) '((0 1) (2 3) (4)))
(check-equal? (slice-at (range 5) 2 #t) '((0 1) (2 3)))
(check-equal? (slice-at (range 5) 3) '((0 1 2) (3 4)))
(check-equal? (slice-at (range 5) 3 #t) '((0 1 2)))
(check-exn exn:fail:contract? (λ() (slice-at (range 5) 0)))
(check-equal? (slicef-at (range 5) even?) '((0 1) (2 3) (4)))
(check-equal? (slicef-at (range 5) odd?) '((0) (1 2) (3 4)))
(check-equal? (slicef-at (range 5) odd? #t) '((1 2) (3 4)))
(check-equal? (slicef-at (range 5) procedure?) '((0 1 2 3 4)))
(check-exn exn:fail:contract? (λ() (slicef-at (range 5) 3)))

Loading…
Cancel
Save