fork download
copy 
  1. ; array rotation, timing tests
  2.  
  3. (define (range . args)
  4.   (case (length args)
  5.     ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
  6.     ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
  7.     ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
  8.            (let loop ((x(car args)) (xs '()))
  9.              (if (le? (cadr args) x)
  10.                  (reverse xs)
  11.                  (loop (+ x (caddr args)) (cons x xs))))))
  12.     (else (error 'range "unrecognized arguments"))))
  13.  
  14. (define (juggling vec dist)
  15.   (let ((len (vector-length vec)))
  16.     (do ((idx 0 (+ idx 1)))
  17.         ((= idx (gcd dist len)) vec)
  18.       (let ((temp (vector-ref vec idx)))
  19.         (do ((lo idx hi)
  20.              (hi (modulo (+ idx dist) len)
  21.                  (modulo (+ hi dist) len)))
  22.             ((= hi idx) (vector-set! vec lo temp))
  23.           (vector-set! vec lo (vector-ref vec hi)))))))
  24.  
  25. (define (block-swap vec dist)
  26.   (define (swap a b m)
  27.     (do ((i 0 (+ i 1))) ((= i m) vec)
  28.       (let ((t (vector-ref vec (+ a i))))
  29.         (vector-set! vec (+ a i)
  30.           (vector-ref vec (+ b i)))
  31.         (vector-set! vec (+ b i) t))))
  32.   (let ((len (vector-length vec)))
  33.     (let loop ((i dist) (j (- len dist)))
  34.       (cond ((< i j) (swap (- dist i) (+ dist j (- i)) i)
  35.                      (loop i (- j i)))
  36.             ((< j i) (swap (- dist i) dist j)
  37.                      (loop (- i j) j))
  38.             (else (swap (- dist i) dist i) vec)))))
  39.  
  40. (define (reversal vec dist)
  41.   (define (swap i j)
  42.     (let ((t (vector-ref vec i)))
  43.       (vector-set! vec i
  44.         (vector-ref vec j))
  45.       (vector-set! vec j t)))
  46.   (define (reverse lo hi)
  47.     (when (< lo hi)
  48.       (swap lo hi)
  49.       (reverse (+ lo 1) (- hi 1))))
  50.   (let ((len (vector-length vec)))
  51.     (reverse 0 (- dist 1))
  52.     (reverse dist (- len 1))
  53.     (reverse 0 (- len 1)))
  54.     vec)
  55.  
  56. (define (timing rotate vec dist)
  57.   (let ((start (get-internal-run-time)))
  58.     (rotate vec dist)
  59.     (- (get-internal-run-time) start)))
  60.  
  61. (display
  62.   (let ((vec (list->vector (range 50000))))
  63.     (map (lambda (x) (timing juggling vec 100)) (range 5)))) (newline)
  64.  
  65. (display
  66.   (let ((vec (list->vector (range 50000))))
  67.     (map (lambda (x) (timing block-swap vec 100)) (range 5)))) (newline)
  68.  
  69. (display
  70.   (let ((vec (list->vector (range 50000))))
  71.     (map (lambda (x) (timing reversal vec 100)) (range 5)))) (newline)
Success #stdin #stdout 12.37s 14020KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(502757073 501899724 509116506 499308659 494677067)
(909052400 910506187 906024778 906550728 904369742)
(815318489 814522483 817100540 817984240 822767242)
https://ideone.com/DQLleZ
language:
Scheme (guile 2.2.4)
created:
6 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!