From a8656a88e3a80caa10f07d1a99d539ef592da89b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 15 Dec 2016 23:16:39 -0800 Subject: [PATCH] add `shift-left`, `shift-cycle`, `shift-left-cycle` --- info.rkt | 2 +- sugar/list.rkt | 41 +++++++++++++++++++++++------- sugar/scribblings/list.scrbl | 48 +++++++++++++++++++++++++++++++++++- sugar/test/main.rkt | 9 +++++++ 4 files changed, 89 insertions(+), 11 deletions(-) diff --git a/info.rkt b/info.rkt index e4110a4..bc62223 100644 --- a/info.rkt +++ b/info.rkt @@ -1,5 +1,5 @@ #lang info (define collection 'multi) -(define version "0.2") +(define version "0.3") (define deps '("base")) (define build-deps '("scribble-lib" "racket-doc" "rackunit-lib")) diff --git a/sugar/list.rkt b/sugar/list.rkt index 56846d0..100980a 100644 --- a/sugar/list.rkt +++ b/sugar/list.rkt @@ -164,24 +164,47 @@ (cons tail (loop head (cdr bps))))))))) -(define+provide+safe (shift xs how-far [fill-item #f] [cycle #f]) - ((list? integer?) (any/c boolean?) . ->* . list?) +(define (shift-base xs how-far fill-item cycle caller) (unless (list? xs) - (raise-argument-error 'shift "list?" xs)) - (define abs-how-far (abs how-far)) + (raise-argument-error caller "list?" xs)) + (define abs-how-far (if cycle + (modulo (abs how-far) (length xs)) + (abs how-far))) (cond - [(> abs-how-far (length xs)) (error 'shift "index is too large for list\nindex: ~a\nlist: ~v" how-far xs)] + [(> abs-how-far (length xs)) (error caller "index is too large for list\nindex: ~a\nlist: ~v" how-far xs)] [(= how-far 0) xs] [(positive? how-far) + (define-values (head tail) (split-at-right xs abs-how-far)) (define filler (if cycle - (take-right xs abs-how-far) + tail (make-list abs-how-far fill-item))) - (append filler (drop-right xs abs-how-far))] + (append filler head)] [else ; how-far is negative + (define-values (head tail) (split-at xs abs-how-far)) (define filler (if cycle - (take xs abs-how-far) + head (make-list abs-how-far fill-item))) - (append (drop xs abs-how-far) filler)])) + (append tail filler)])) + + +(define+provide+safe (shift xs how-far [fill-item #f] [cycle #f]) + ((list? integer?) (any/c boolean?) . ->* . list?) + (shift-base xs how-far fill-item cycle 'shift)) + + +(define+provide+safe (shift-left xs how-far [fill-item #f] [cycle #f]) + ((list? integer?) (any/c boolean?) . ->* . list?) + (shift-base xs (- how-far) fill-item cycle 'shift-left)) + + +(define+provide+safe (shift-cycle xs how-far) + (list? integer? . -> . list?) + (shift-base xs how-far #f #t 'shift-cycle)) + + +(define+provide+safe (shift-left-cycle xs how-far) + (list? integer? . -> . list?) + (shift-base xs (- how-far) #f #t 'shift-left-cycle)) (define+provide+safe (shifts xs how-fars [fill-item #f] [cycle #f]) diff --git a/sugar/scribblings/list.scrbl b/sugar/scribblings/list.scrbl index b99ea70..3982201 100644 --- a/sugar/scribblings/list.scrbl +++ b/sugar/scribblings/list.scrbl @@ -183,7 +183,7 @@ Break @racket[_lst] into smaller lists at the index positions in @racket[_indexe [fill-item any/c #f] [cycle? boolean? #f]) list?] -Move the items in @racket[_lst] to the right (if @racket[_how-far] is positive) or left (if @racket[_how-far] is negative). By default, vacated spaces in the list are filled with @racket[_fill-item]. But if @racket[_cycle?] is true, elements of the list wrap around (and @racket[_fill-item] is ignored). Either way, 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 0, return the original list. If @racket[_how-far] is bigger than the length of @racket[_lst], raise an error. +Move the items in @racket[_lst] to the right (if @racket[_how-far] is positive) or left (if @racket[_how-far] is negative). By default, vacated spaces in the list are filled with @racket[_fill-item]. But if @racket[_cycle?] is true, elements of the list wrap around (and @racket[_fill-item] is ignored). Either way, 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 0, return the original list. If @racket[_how-far] is bigger than the length of @racket[_lst], and @racket[_cycle] is not true, raise an error. @examples[#:eval my-eval (define xs (range 5)) @@ -195,6 +195,52 @@ Move the items in @racket[_lst] to the right (if @racket[_how-far] is positive) (shift xs 42) ] +@defproc[ +(shift-left +[lst list?] +[how-far integer?] +[fill-item any/c #f] +[cycle? boolean? #f]) +list?] +Like @racket[shift], but the list is shifted left when @racket[_how-far] is positive, and right when it's negative. Otherwise identical. + +@examples[#:eval my-eval +(define xs (range 5)) +(shift-left xs 2) +(shift-left xs -2 0) +(shift-left xs 2 'boing) +(shift-left xs 2 'boing #t) +(shift-left xs 0) +(shift-left xs 42) +] + +@deftogether[( +@defproc[ +(shift-cycle +[lst list?] +[how-far integer?]) +list?] +@defproc[ +(shift-left-cycle +[lst list?] +[how-far integer?]) +list?] +)] +Like @racket[shift] and @racket[shift-left], but automatically invokes cycle mode. @racket[_how-far] can be any size. + +@examples[#:eval my-eval +(define xs (range 5)) +(shift-cycle xs 2) +(shift-cycle xs -2) +(shift-cycle xs 0) +(shift-cycle xs 42) +(shift-left-cycle xs 2) +(shift-left-cycle xs -2) +(shift-left-cycle xs 0) +(shift-left-cycle xs 42) +] + + @defproc[ (shifts [lst list?] diff --git a/sugar/test/main.rkt b/sugar/test/main.rkt index 0af68ae..976743f 100644 --- a/sugar/test/main.rkt +++ b/sugar/test/main.rkt @@ -215,6 +215,15 @@ (check-equal? (shifts xs '(-1 0 1) 'boing #t) `((1 2 3 4 0) ,xs (4 0 1 2 3))) (check-equal? (shift xs 5 0) (make-list 5 0)) (check-exn exn:fail? (λ() (shift xs -10))) + + (check-equal? (map (λ(a b c) (list a b c)) (shift-left xs -1) (shift-left xs 0) (shift-left xs 1)) (map reverse '((1 0 #f) (2 1 0) (3 2 1) (4 3 2) (#f 4 3)))) + + (check-equal? (shift-cycle xs 2) '(3 4 0 1 2)) + (check-equal? (shift-left-cycle xs 2) '(2 3 4 0 1)) + (check-equal? (shift-cycle xs 7) '(3 4 0 1 2)) + (check-equal? (shift-left-cycle xs 7) '(2 3 4 0 1)) + (check-equal? (shift-cycle xs 107) '(3 4 0 1 2)) + (check-equal? (shift-left-cycle xs 107) '(2 3 4 0 1)) (check-true (urlish? (->path "/Users/MB/home.html"))) (check-true (urlish? "/Users/MB/home.html?foo=bar"))