add `shift-left`, `shift-cycle`, `shift-left-cycle`

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"))

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])

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?]

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"))