benchmarks/garden-fence.ss
```#lang scheme
(provide run-garden-fence-benchmark)

;; Garden fence encryption benchmark
;; http://list.cs.brown.edu/pipermail/plt-scheme/2009-March/031313.html

;; ----------------------------------------------------
;; Shared

;; String [Listof Nat] -> String
;; Permute the string according to the given permutation.
(define (permute str perm)
(permuter str perm
(lambda (i j) (list i j))))

;; String [Listof Nat] -> String
;; Unpermute the string according to the given permutation.
(define (unpermute str perm)
(permuter str perm
(lambda (i j) (list j i))))

;; String [Listof Nat] [Nat Nat -> [List Nat Nat]] -> String
;; Abstraction of permute/unpermute.
(define (permuter str perm f)
(let ([ans (string-copy str)])
(let loop ([i 0] [p perm])
(cond [(= i (string-length str)) ans]
[else (string-set! ans
(first (f i (first p)))
(string-ref str
(second (f i (first p)))))
(rest p))]))))

;; ----------------------------------------------------
;; Imperative vector solution

;; [Vectorof [Listof X]] Nat X -> Void
;; Set v[i] to (cons x v[i]).
(define (vector-cons! v i x)
(vector-set! v i (cons x (vector-ref v i))))

;; Nat Nat -> [Listof Nat]
;; Generate a fence permutation of the given
;; height (> 1) for strings of length len.
(define (fence-vec height len)
(let ([bot 0]
[top (sub1 height)]
[vec (make-vector height empty)])

(let loop ([n 0] [level 0] [move add1])
(cond [(= n len) (void)]
[(> level top) (loop n (sub1 top) sub1)]
[else
(vector-cons! vec level n)
(loop (add1 n) (move level) move)]))

(apply append (map reverse (vector->list vec)))))

;; String Nat -> String
(define (encrypt-vec text height)
(permute text (fence-vec height (string-length text))))

;; String Nat -> String
(define (decrypt-vec text height)
(unpermute text (fence-vec height (string-length text))))

;; ----------------------------------------------------
;; Functional random access list solution

(require (planet cce/scheme:4:1/planet)
(prefix-in ra: (this-package-in main)))

;; Nat Nat -> [Listof Nat]
;; Generate a fence permutation of the given
;; height (> 1) for strings of length len.
(define (fence-ra height len)
(let ([bot 0]
[top (sub1 height)])
(let loop ([n 0] [level 0] [move add1] [rls (ra:make-list height empty)])
(cond [(= n len)
(apply append (ra:foldr (lambda (ls r) (cons (reverse ls) r))
empty
rls))]
[(> level top) (loop n (sub1 top) sub1 rls)]
[else
(move level)
move
(ra:list-update rls level (lambda (ls) (cons n ls))))]))))

;; String Nat -> String
(define (encrypt-ra text height)
(permute text (fence-ra height (string-length text))))

;; String Nat -> String
(define (decrypt-ra text height)
(unpermute text (fence-ra height (string-length text))))

;; Benchmark setup
(define (do size)
(define str (build-string size (lambda (i) #\x)))

(write `(define str (build-string ,size (lambda (i) #\x))))
(newline)
(newline)

(display '(encrypt str 20))
(newline)
(display "ra : ")
(collect-garbage)
(time (void (encrypt-ra str 20)))
(display "vec: ")
(collect-garbage)
(time (void (encrypt-vec str 20)))

(newline)
(display '(decrypt str 20))
(newline)
(display "ra : ")
(collect-garbage)
(time (void (decrypt-ra str 20)))
(display "vec: ")
(collect-garbage)
(time (void (decrypt-vec str 20)))
(newline))

(define (run-garden-fence-benchmark)
(printf "Garden fence encryption benchmark~n")
(printf "=================================~n")
(printf "http://list.cs.brown.edu/pipermail/plt-scheme/2009-March/031313.html~n")
(do 10000)
(do 100000)
(do 1000000))

```