|
|
@ -1,13 +1,9 @@
|
|
|
|
#lang racket/base
|
|
|
|
#lang racket/base
|
|
|
|
(require (for-syntax
|
|
|
|
(require (for-syntax racket/base)
|
|
|
|
racket/base)
|
|
|
|
|
|
|
|
racket/list
|
|
|
|
racket/list
|
|
|
|
racket/match
|
|
|
|
racket/match
|
|
|
|
racket/function
|
|
|
|
racket/function
|
|
|
|
"define.rkt")
|
|
|
|
sugar/define)
|
|
|
|
|
|
|
|
|
|
|
|
(define (increasing-nonnegative-list? x)
|
|
|
|
|
|
|
|
(and (list? x) (or (empty? x) (apply < -1 x))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define+provide+safe (trimf xs test-proc)
|
|
|
|
(define+provide+safe (trimf xs test-proc)
|
|
|
|
(list? procedure? . -> . list?)
|
|
|
|
(list? procedure? . -> . list?)
|
|
|
@ -109,18 +105,22 @@
|
|
|
|
(hash-update! counter item add1 0))
|
|
|
|
(hash-update! counter item add1 0))
|
|
|
|
counter)
|
|
|
|
counter)
|
|
|
|
|
|
|
|
|
|
|
|
(define (->list x)
|
|
|
|
(define+provide+safe (->list xs)
|
|
|
|
(match x
|
|
|
|
(sequence? . -> . list?)
|
|
|
|
[(? list? x) x]
|
|
|
|
(unless (sequence? xs)
|
|
|
|
[(? vector?) (vector->list x)]
|
|
|
|
(raise-argument-error '->list "sequence" xs))
|
|
|
|
[(? string?) (string->list x)]
|
|
|
|
(match xs
|
|
|
|
[else (raise-argument-error '->list "item that can be converted to list" x)]))
|
|
|
|
[(? list?) xs]
|
|
|
|
|
|
|
|
[(? vector?) (vector->list xs)]
|
|
|
|
|
|
|
|
[(? string?) (string->list xs)]
|
|
|
|
|
|
|
|
[seq (for/list ([x seq]) x)]))
|
|
|
|
|
|
|
|
|
|
|
|
(define+provide+safe (members-unique? x)
|
|
|
|
(define+provide+safe (members-unique? x)
|
|
|
|
((or/c list? vector? string?) . -> . boolean?)
|
|
|
|
(sequence? . -> . boolean?)
|
|
|
|
(match (->list x)
|
|
|
|
(unless (sequence? x)
|
|
|
|
[(? list? x) (= (length (remove-duplicates x)) (length x))]
|
|
|
|
(raise-argument-error 'members-unique? "sequence" x))
|
|
|
|
[_ (raise-argument-error 'members-unique? "list, vector, or string" x)]))
|
|
|
|
(define all-unique-signal (gensym))
|
|
|
|
|
|
|
|
(eq? (check-duplicates (->list x) #:default all-unique-signal) all-unique-signal))
|
|
|
|
|
|
|
|
|
|
|
|
(define+provide+safe (members-unique?/error x)
|
|
|
|
(define+provide+safe (members-unique?/error x)
|
|
|
|
((or/c list? vector? string?) . -> . boolean?)
|
|
|
|
((or/c list? vector? string?) . -> . boolean?)
|
|
|
@ -138,23 +138,30 @@
|
|
|
|
(syntax-case stx ()
|
|
|
|
(syntax-case stx ()
|
|
|
|
[(_ VALUES-EXPR) #'(call-with-values (λ () VALUES-EXPR) list)]))
|
|
|
|
[(_ VALUES-EXPR) #'(call-with-values (λ () VALUES-EXPR) list)]))
|
|
|
|
|
|
|
|
|
|
|
|
(define+provide+safe (sublist xs i j)
|
|
|
|
(define+provide+safe (sublist seq i j)
|
|
|
|
(list? exact-nonnegative-integer? exact-nonnegative-integer? . -> . list?)
|
|
|
|
(sequence? exact-nonnegative-integer? exact-nonnegative-integer? . -> . list?)
|
|
|
|
(unless (list? xs)
|
|
|
|
(unless (sequence? seq)
|
|
|
|
(raise-argument-error 'sublist "list?" xs))
|
|
|
|
(raise-argument-error 'sublist "sequence?" seq))
|
|
|
|
(cond
|
|
|
|
(define xs (->list seq))
|
|
|
|
[(> j (length xs)) (error 'sublist (format "ending index ~a exceeds length of list" j))]
|
|
|
|
(when (> j (length xs))
|
|
|
|
[(>= j i) (for/list ([(x idx) (in-indexed xs)]
|
|
|
|
(raise-argument-error 'sublist (format "ending index ~a exceeds length of list" j)))
|
|
|
|
|
|
|
|
(when (> i j)
|
|
|
|
|
|
|
|
(raise-argument-error 'sublist (format "starting index larger than ending index" (list i j))))
|
|
|
|
|
|
|
|
(for/list ([(x idx) (in-indexed xs)]
|
|
|
|
#:when (<= i idx (sub1 j)))
|
|
|
|
#:when (<= i idx (sub1 j)))
|
|
|
|
x)]
|
|
|
|
x))
|
|
|
|
[else (raise-argument-error 'sublist (format "starting index larger than ending index" (list i j)))]))
|
|
|
|
|
|
|
|
|
|
|
|
(define (increasing-nonnegative-list? x)
|
|
|
|
|
|
|
|
(or (empty? x) (and (list? x) (apply < -1 x))))
|
|
|
|
|
|
|
|
|
|
|
|
(define+provide+safe (break-at xs bps-in)
|
|
|
|
(define+provide+safe (break-at xs bps-in)
|
|
|
|
(list? any/c . -> . (listof list?))
|
|
|
|
(list? any/c . -> . (listof list?))
|
|
|
|
(unless (list? xs)
|
|
|
|
(unless (list? xs)
|
|
|
|
(raise-argument-error 'break-at "list" xs))
|
|
|
|
(raise-argument-error 'break-at "list" xs))
|
|
|
|
(define bps ((if (list? bps-in) values list) bps-in))
|
|
|
|
(define bps ((if (list? bps-in) values list) bps-in))
|
|
|
|
(when (ormap (λ (bp) (<= (length xs) bp)) bps)
|
|
|
|
(when (let ([lenxs (length xs)])
|
|
|
|
|
|
|
|
(for/or ([bp bps])
|
|
|
|
|
|
|
|
(<= lenxs bp)))
|
|
|
|
(raise-argument-error 'break-at
|
|
|
|
(raise-argument-error 'break-at
|
|
|
|
(format "breakpoints not greater than or equal to input list length = ~a" (length xs)) bps))
|
|
|
|
(format "breakpoints not greater than or equal to input list length = ~a" (length xs)) bps))
|
|
|
|
(unless (increasing-nonnegative-list? bps)
|
|
|
|
(unless (increasing-nonnegative-list? bps)
|
|
|
@ -175,16 +182,16 @@
|
|
|
|
(modulo (abs how-far) (length xs))
|
|
|
|
(modulo (abs how-far) (length xs))
|
|
|
|
(abs how-far)))
|
|
|
|
(abs how-far)))
|
|
|
|
(define (make-fill thing) (if cycle thing (make-list abs-how-far fill-item)))
|
|
|
|
(define (make-fill thing) (if cycle thing (make-list abs-how-far fill-item)))
|
|
|
|
(cond
|
|
|
|
(when (> abs-how-far (length xs))
|
|
|
|
[(> abs-how-far (length xs))
|
|
|
|
|
|
|
|
(raise-argument-error caller
|
|
|
|
(raise-argument-error caller
|
|
|
|
(format "index not larger than list length ~a" (length xs))
|
|
|
|
(format "index not larger than list length ~a" (length xs))
|
|
|
|
(* (if (eq? caller 'shift-left) -1 1) how-far))]
|
|
|
|
(* (if (eq? caller 'shift-left) -1 1) how-far)))
|
|
|
|
[(zero? how-far) xs]
|
|
|
|
(match how-far
|
|
|
|
[(positive? how-far)
|
|
|
|
[0 xs]
|
|
|
|
|
|
|
|
[(? positive?)
|
|
|
|
(match/values (split-at-right xs abs-how-far)
|
|
|
|
(match/values (split-at-right xs abs-how-far)
|
|
|
|
[(head tail) (append (make-fill tail) head)])]
|
|
|
|
[(head tail) (append (make-fill tail) head)])]
|
|
|
|
[else ; how-far is negative
|
|
|
|
[_ ; how-far is negative
|
|
|
|
(match/values (split-at xs abs-how-far)
|
|
|
|
(match/values (split-at xs abs-how-far)
|
|
|
|
[(head tail) (append tail (make-fill head))])]))
|
|
|
|
[(head tail) (append tail (make-fill head))])]))
|
|
|
|
|
|
|
|
|