add partition*

dev-refac-2020
Matthew Butterick 5 years ago
parent 0081cdaab8
commit 2fd6367303

@ -1,4 +1,4 @@
#lang racket/base
#lang debug racket/base
(require (for-syntax
racket/base)
racket/list
@ -15,15 +15,29 @@
(raise-argument-error 'trimf "list?" xs))
(dropf-right (dropf xs test-proc) test-proc))
(define (slicef-and-filter-split-helper xs pred [drop-negated? #f])
(let loop ([xs xs][negating? #f][acc empty])
(cond
[(empty? xs) (reverse acc)]
[else
(define loop-pred (if negating? (negate pred) pred))
(define-values (loop-pred-xs other-xs) (splitf-at xs loop-pred))
(define subxs (if (and negating? drop-negated?) empty loop-pred-xs))
(loop other-xs (not negating?) (if (empty? subxs) acc (cons subxs acc)))])))
(define (slicef-and-filter-split-helper xs pred [separate-negated? #f])
(let loop ([xs xs][negating? #f][acc empty][negated-acc empty])
(match xs
[(? empty?) (if separate-negated?
(values (reverse acc) (reverse negated-acc))
(reverse acc))]
[(list* (? (if negating? (negate pred) pred) pred-xs) ... other-xs)
(cond
[(and negating? separate-negated?)
(loop other-xs
(not negating?)
acc
(match pred-xs
[(? empty?) negated-acc]
[_ (cons pred-xs negated-acc)]))]
[else
(loop other-xs
(not negating?)
(match pred-xs
[(? empty?) acc]
[_ (cons pred-xs acc)])
negated-acc)])])))
(define+provide+safe (slicef xs pred)
(list? procedure? . -> . (listof list?))
@ -72,12 +86,19 @@
(match/values (split-at xs len)
[(subxs rest) (loop rest (cons subxs slices))]))))
(define+provide+safe (partition* pred xs)
(predicate/c list? . -> . (values list? list?))
(unless (list? xs)
(raise-argument-error 'partition* "list?" xs))
(slicef-and-filter-split-helper xs pred 'drop-negated))
(define+provide+safe (filter-split xs pred)
(list? predicate/c . -> . (listof list?))
(unless (list? xs)
(raise-argument-error 'filter-split "list?" xs))
;; same idea as slicef, but the negated items are dropped(-
(slicef-and-filter-split-helper xs (negate pred) 'drop-negated))
;; same idea as slicef, but the negated items are dropped
(define-values (negated-pred-xs _) (partition* (negate pred) xs))
negated-pred-xs)
(define+provide+safe (frequency-hash xs)
(list? . -> . hash?)

@ -1,9 +1,9 @@
#lang scribble/manual
@(require scribble/eval (for-label racket sugar))
@(require scribble/eval (for-label racket sugar racket/function))
@(define my-eval (make-base-eval))
@(my-eval `(require sugar racket/list))
@(my-eval `(require sugar racket/list racket/function))
@title{Lists}
@defmodule[#:multi (sugar/list (submod sugar/list safe))]
@ -33,9 +33,20 @@ Like @racket[string-split], but for lists. Drop elements from anywhere in @racke
@examples[#:eval my-eval
(filter-split '(1 a b c 2 d e f 3) integer?)
(filter-split '(1 a b c 2 d e f 3) (compose not 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 '(1 a b c 2 d e f 3) (negate integer?))]
@defproc[
(partition*
[pred procedure?]
[lst list?])
(values list? list?)]
Like @racket[partition], but contiguous groups of elements matching (or not matching) @racket[_pred] are kept together in sublists.
Same as @racket[(values (filter-split _lst _pred) (filter-split _lst (negate _pred)))], but only traverses the list once.
@examples[#:eval my-eval
(partition* integer? '(1 a b c 2 d e f 3))
(partition* (negate integer?) '(1 a b c 2 d e f 3))]
@defproc[
(slice-at

@ -132,7 +132,9 @@
(check-equal? (trimf (list 4 1 2 3 4) even?) '(1 2 3))
(check-equal? (trimf (list 1 3 2 4 5 6 8 9 13) odd?) '(2 4 5 6 8))
(check-equal? (filter-split '(1 2 3 4 5 6) even?) '((1)(3)(5)))
(check-equal? (filter-split '(1 1 2 3 4 4 5 6) even?) '((1 1)(3)(5)))
(check-equal? (let-values ([(preds not-preds) (partition* even? '(1 1 2 3 4 4 5 6))])
(list preds not-preds)) (list '((2)(4 4)(6)) '((1 1)(3)(5))))
(define foo-path-strings '("foo" "foo.txt" "foo.bar" "foo.bar.txt"))
(match-define (list foo-path foo.txt-path foo.bar-path foo.bar.txt-path) (map ->path foo-path-strings))

Loading…
Cancel
Save