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?))
@ -43,10 +54,10 @@
(define+provide/contract (members-unique? x) (define+provide/contract (members-unique? x)
((or/c list? vector? string?) . -> . boolean?) ((or/c list? vector? string?) . -> . boolean?)
(cond (cond
[(list? x) (= (len (remove-duplicates x)) (len x))] [(list? x) (= (len (remove-duplicates x)) (len x))]
[(vector? x) (->list x)] [(vector? x) (->list x)]
[(string? x) (string->list x)] [(string? x) (string->list x)]
[else (error (format "members-unique? cannot be determined for ~a" x))])) [else (error (format "members-unique? cannot be determined for ~a" x))]))
@ -57,8 +68,8 @@
(let* ([duplicate-keys (filter-not empty? (hash-map (frequency-hash x) (let* ([duplicate-keys (filter-not empty? (hash-map (frequency-hash x)
(λ(k v) (if (> v 1) k '()))))]) (λ(k v) (if (> v 1) k '()))))])
(error (string-append "members-unique? failed because " (if (= (len duplicate-keys) 1) (error (string-append "members-unique? failed because " (if (= (len duplicate-keys) 1)
"item isnt" "item isnt"
"items arent") " unique:") duplicate-keys)) "items arent") " unique:") duplicate-keys))
result)) result))
@ -69,7 +80,7 @@
(define-syntax (when/splice stx) (define-syntax (when/splice stx)
(syntax-case stx () (syntax-case stx ()
[(_ test body) [(_ test body)
#'(if test (list body) '())])) #'(if test (list body) '())]))
(provide values->list) (provide values->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")
@ -141,4 +141,17 @@
(check-true (ends-with? "foobar" "foobar")) (check-true (ends-with? "foobar" "foobar"))
(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