diff --git a/list.rkt b/list.rkt index 5c1462a..1580097 100644 --- a/list.rkt +++ b/list.rkt @@ -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)))))))) \ No newline at end of file + (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))) + + diff --git a/scribblings/list.scrbl b/scribblings/list.scrbl index 6563fe7..54b6a52 100644 --- a/scribblings/list.scrbl +++ b/scribblings/list.scrbl @@ -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)) +] -] \ No newline at end of file diff --git a/tests.rkt b/tests.rkt index a39fc8c..2536a34 100644 --- a/tests.rkt +++ b/tests.rkt @@ -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)))