#lang racket/base (require (for-syntax racket/base)) (require racket/list racket/set) (require "define.rkt" "len.rkt" "coerce.rkt") (define+provide/contract (trimf xs test-proc) (list? procedure? . -> . list?) (dropf-right (dropf xs test-proc) test-proc)) (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)) (if force? null (list xs))] [else (cons (take xs len) (slice-at (drop xs len) len force?))])) (define+provide/contract (filter-split xs split-test) (list? predicate/c . -> . (listof list?)) (let loop ([xs (trimf xs split-test)] [acc '()]) (if (empty? xs) (reverse acc) ; because accumulation is happening backward (let-values ([(item rest) ;; drop matching elements from front ;; then split on nonmatching ;; = nonmatching item + other elements (which will start with matching) (splitf-at (dropf xs split-test) (compose1 not split-test))]) (loop rest (cons item acc)))))) (define+provide/contract (frequency-hash x) (list? . -> . hash?) (define counter (make-hash)) (for ([item (in-list (flatten x))]) (hash-set! counter item (add1 (hash-ref counter item 0)))) counter) (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))])) (define+provide/contract (members-unique?/error x) (any/c . -> . boolean?) (define result (members-unique? x)) (if (not result) (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)) result)) ;; for use inside quasiquote ;; instead of ,(when ...) use ,@(when/splice ...) ;; to avoid voids (provide when/splice) (define-syntax (when/splice stx) (syntax-case stx () [(_ test body) #'(if test (list body) '())])) (provide values->list) (define-syntax (values->list stx) (syntax-case stx () [(_ values-expr) #'(call-with-values (λ () values-expr) list)])) (define+provide/contract (sublist xs i j) (list? (and/c integer? (not/c negative?)) (and/c integer? (not/c negative?)) . -> . list?) (cond [(> j (length xs)) (error 'sublist (format "ending index ~a exceeds length of list" j))] [(>= j i) (take (drop xs i) (- j i))] [else (error 'sublist (format "starting index ~a is larger than ending index ~a" i j))])) (define increasing-positive? (λ(xs) (apply < 0 xs))) (define increasing-positive-list? (and/c list? increasing-positive?)) (define+provide/contract (break-at xs bps) (list? (and/c coerce/list? increasing-positive-list?) . -> . (listof list?)) (when (ormap (λ(bp) (>= bp (length xs))) bps) (error 'break-at (format "breakpoint in ~v is greater than or equal to input list length = ~a" bps (length xs)))) ;; easier to do back to front, because then the list index for each item won't change during the recursion (reverse (let loop ([xs xs][bps (reverse bps)]) (if (empty? bps) (cons xs null) ; return whatever's left, because no more splits are possible (let-values ([(head tail) (split-at xs (car bps))]) (cons tail (loop head (cdr bps))))))))