add `shift` and `shift/values`

pull/2/head
Matthew Butterick 10 years ago
parent 9ed2c1dcd1
commit dcff7418bf

@ -1,6 +1,6 @@
#lang racket/base
(require (for-syntax racket/base))
(require racket/list racket/set)
(require racket/list racket/set racket/function)
(require "define.rkt" "len.rkt" "coerce.rkt")
(define+provide/contract (trimf xs test-proc)
@ -106,4 +106,34 @@
(if (= (car bps) 0)
(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))))))))
(cons tail (loop head (cdr bps))))))))
(define (integers? x)
(and (list? x) (andmap integer? x)))
(define+provide/contract (shift xs shift-amount-or-amounts [fill-item #f] [cycle? #f])
((list? (or/c integer? integers?)) (any/c boolean?) . ->* . list?)
(define (do-shift xs how-far)
(define abs-how-far (abs how-far))
(cond
[(> abs-how-far (length xs)) (error 'shift "index is too large for list\nindex: ~a\nlist: ~v" how-far xs)]
[(= how-far 0) xs]
[(positive? how-far) (append (make-list abs-how-far fill-item) (drop-right xs abs-how-far))]
;; otherwise how-far is negative
[else (append (drop xs abs-how-far) (make-list abs-how-far fill-item))]))
(if (list? shift-amount-or-amounts)
(map (curry do-shift xs) shift-amount-or-amounts)
(do-shift xs shift-amount-or-amounts)))
(define+provide/contract (shift/values xs shift-amount-or-amounts [fill-item #f])
((list? (or/c integer? integers?)) (any/c) . ->* . any)
(apply (if (list? shift-amount-or-amounts)
values
(λ xs xs))
(shift xs shift-amount-or-amounts fill-item)))

@ -143,7 +143,7 @@ Return a sublist of the @racket[_lst] starting with item @racket[_start-idx] and
@defproc[
(break-at
[lst list?]
[indexes (or/c integer? (listof? integer?))])
[indexes (or/c integer? (listof integer?))])
(listof list?)]
Break @racket[_lst] into smaller lists at the index positions in @racket[_indexes]. If a single integer value is given for @racket[_indexes], it's treated as a one-element list. Errors will arise if a breakpoint index exceeds the length of the list, or if the breakpoints are not increasing.
@ -153,5 +153,36 @@ Break @racket[_lst] into smaller lists at the index positions in @racket[_indexe
(break-at '(0 1 2 3 4 5 6 7 8) '(3 6))
(break-at '(0 1 2 3 4 5 6 7 8) '(3 6 8))
(break-at '(0 1 2 3 4 5 6 7 8) '(3 6 8 10))
]
@defproc[
(shift
[lst list?]
[how-far (or/c integer? (listof integer?))]
[fill-item any/c #f])
(or/c list? (listof list?))]
Move the items in @racket[_lst] to the right (if @racket[_how-far] is positive) or left (if negative). Vacated spaces in the list are filled with @racket[_fill-item], so the result list is always the same length as the input list. (If you don't care about the lengths being the same, you probably want @racket[take] or @racket[drop] instead.) If @racket[_how-far] is a list rather than a single value, return a list of lists shifted by the designated amounts. If @racket[_how-far] is 0, return the original list. If @racket[_how-far] is bigger than the length of @racket[_lst], raise an error.
@examples[#:eval my-eval
(define xs (range 5))
(shift xs 2)
(shift xs -2 0)
(shift xs '(-1 0 1) 'boing)
(shift xs 0)
(shift xs 42)
]
@defproc[
(shift/values
[lst list?]
[how-far (or/c integer? (listof integer?))]
[fill-item any/c #f])
any]
Same as @racket[shift], except that when @racket[_how-far] is a list, the resulting lists are returned as multiple values rather than as a list of lists.
@examples[#:eval my-eval
(define xs (range 5))
(shift xs '(-1 0 1))
(shift/values xs '(-1 0 1))
]
]

@ -167,4 +167,11 @@
(check-equal? (break-at '(5 6 7 8) '(1 2 3)) '((5) (6) (7) (8)))
(check-equal? (break-at '(5 6 7 8) '(1 3)) '((5) (6 7) (8)))
(check-equal? (break-at '(5 6 7 8) '(1)) (break-at '(5 6 7 8) 1))
(define xs (range 5))
(check-equal? (map (λ(a b c) (list a b c)) (shift xs -1) (shift xs 0) (shift xs 1)) '((1 0 #f) (2 1 0) (3 2 1) (4 3 2) (#f 4 3)))
(check-equal? (shift xs '(-1 0 1) 'boing) `((1 2 3 4 boing) ,xs (boing 0 1 2 3)))
(check-equal? (shift xs 5 0) (make-list 5 0))
(check-exn exn:fail? (λ() (shift xs -10)))
(check-equal? (values->list (shift/values xs '(-1 0 1) 'boing)) `((1 2 3 4 boing) ,xs (boing 0 1 2 3)))

Loading…
Cancel
Save