; array rotation, timing tests

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
    ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
    ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
           (let loop ((x(car args)) (xs '()))
             (if (le? (cadr args) x)
                 (reverse xs)
                 (loop (+ x (caddr args)) (cons x xs))))))
    (else (error 'range "unrecognized arguments"))))

(define (juggling vec dist)
  (let ((len (vector-length vec)))
    (do ((idx 0 (+ idx 1)))
        ((= idx (gcd dist len)) vec)
      (let ((temp (vector-ref vec idx)))
        (do ((lo idx hi)
             (hi (modulo (+ idx dist) len)
                 (modulo (+ hi dist) len)))
            ((= hi idx) (vector-set! vec lo temp))
          (vector-set! vec lo (vector-ref vec hi)))))))

(define (block-swap vec dist)
  (define (swap a b m)
    (do ((i 0 (+ i 1))) ((= i m) vec)
      (let ((t (vector-ref vec (+ a i))))
        (vector-set! vec (+ a i)
          (vector-ref vec (+ b i)))
        (vector-set! vec (+ b i) t))))
  (let ((len (vector-length vec)))
    (let loop ((i dist) (j (- len dist)))
      (cond ((< i j) (swap (- dist i) (+ dist j (- i)) i)
                     (loop i (- j i)))
            ((< j i) (swap (- dist i) dist j)
                     (loop (- i j) j))
            (else (swap (- dist i) dist i) vec)))))

(define (reversal vec dist)
  (define (swap i j)
    (let ((t (vector-ref vec i)))
      (vector-set! vec i
        (vector-ref vec j))
      (vector-set! vec j t)))
  (define (reverse lo hi)
    (when (< lo hi)
      (swap lo hi)
      (reverse (+ lo 1) (- hi 1))))
  (let ((len (vector-length vec)))
    (reverse 0 (- dist 1))
    (reverse dist (- len 1))
    (reverse 0 (- len 1)))
    vec)

(define (timing rotate vec dist)
  (let ((start (get-internal-run-time)))
    (rotate vec dist)
    (- (get-internal-run-time) start)))

(display
  (let ((vec (list->vector (range 50000))))
    (map (lambda (x) (timing juggling vec 100)) (range 5)))) (newline)

(display
  (let ((vec (list->vector (range 50000))))
    (map (lambda (x) (timing block-swap vec 100)) (range 5)))) (newline)

(display
  (let ((vec (list->vector (range 50000))))
    (map (lambda (x) (timing reversal vec 100)) (range 5)))) (newline)