add slice-at, slicef-at

list.rkt

@@ -7,14 +7,25 @@
   (list? procedure? . -> . list?)
   (dropf-right (dropf xs test-proc) test-proc))
 
-
-(define+provide/contract (list->slices xs len)
-  (list? integer? . -> . (listof list?))
+(define+provide/contract (slicef-at xs pred [force? #f])
+  ((list? procedure?) (boolean?) . ->* . (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
     [(equal? xs null) null]
-    [(len . > . (length xs)) (list xs)]
-    [else (cons (take xs len) (list->slices (drop xs len) len))]))
+    [(len . > . (length xs)) (if force? null (list xs))]
+    [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)
   (list? predicate/c . -> . (listof list?))
@@ -43,10 +54,10 @@
 (define+provide/contract (members-unique? x)
   ((or/c list? vector? string?) . -> . boolean?)  
   (cond 
-      [(list? x) (= (len (remove-duplicates x)) (len x))]
-      [(vector? x) (->list x)]
-      [(string? x) (string->list x)]
-      [else (error (format "members-unique? cannot be determined for ~a" x))]))
+    [(list? x) (= (len (remove-duplicates x)) (len x))]
+    [(vector? x) (->list x)]
+    [(string? x) (string->list 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) 
                                                           (λ(k v) (if (> v 1) k '()))))])
         (error (string-append "members-unique? failed because " (if (= (len duplicate-keys) 1) 
-                                  "item isn’t"
-                                  "items aren’t") " unique:") duplicate-keys))
+                                                                    "item isn’t"
+                                                                    "items aren’t") " unique:") duplicate-keys))
       result))
 
 
@@ -69,7 +80,7 @@
 (define-syntax (when/splice stx)
   (syntax-case stx ()
     [(_ test body)
-      #'(if test (list body) '())]))
+     #'(if test (list body) '())]))
 
 
 (provide values->list)

scribblings/list.scrbl

@@ -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) (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[
 (frequency-hash

tests.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 
-(require rackunit net/url racket/set)
+(require rackunit net/url racket/set racket/list)
 (require "main.rkt")
 
 (check-equal? (->string "foo") "foo")
@@ -141,4 +141,17 @@
 (check-true (ends-with? "foobar" "foobar"))
 (check-false (ends-with? "foobar" "foobars"))
 (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)))