[plt-scheme] Code review: garden fence encryption

Marek, here is an improved version of the code. I meant to send it  
last night, plus a Typed Scheme version, but that effort turned into  
a large distraction. You may want to compare these drafts by putting  
them next to each other to see how I refactor and improve the code.  
-- Matthias

P.S. The most pleasurable part was to see a generative mutual  
recursion in a form that I had never encountered before in a  
practical setting.

#lang scheme

(require srfi/1 htdp/testing)

;;;;
;;;; An example:
;;;;
;;;; 1. d         k         = (d k)     = "dk"
;;;; 2.  i       n l        = (i n l)   = "inl"
;;;; 3.   e     i   a       = (e i a)   = "eia"
;;;; 4.    s   e     r   t  = (s e r t) = "sert"
;;;; 5.     i t       t x   = (i t t x) = "ittx"
;;;; 6.      s         e    = (s e)     = "se"
;;;;
;;;; Then the resulting encrypted text is "dkinleiasertittxse",
;;;; which results in appending the characters from all lines, starting
;;;; with the first.
;;;;
;;;; More details (in german) on the web:
;;;; <http://www.webplain.de/foren/read.php?1,8094>

;;; Decrypts an encrypted text using the given height as key
;;; works by constructing a zigzag structure but not containing the
;;; letters but rather the positions in the original string
;;; the positions get mapped to letters to reconstruct the plaintext
;;;
;;; Using the example from the header, the fence with numbers looks
;;; like this
;;;
;;; 1. 0         10                = (0 10)
;;; 2.  1       9  11              = (1 9 11)
;;; 3.   2     8     12            = (2 8 12)
;;; 4.    3   7        13      17  = (3 7 13 17)
;;; 5.     4 6           14  16    = (4 6 14 16)
;;; 6.      5              15      = (5 15)
;;;
;;; The resulting lists get flattened and are used to map the
;;; characters back to their original, plaintext position.

;; String Nat -> String
;; encrypt according to fence shape

(check-expect (encrypt "diesisteinklartext" 6) "dkinleiasertittxse")

(define (encrypt str h)
   (list->string (fence (string->list str) h)))

;; String Nat -> String
;; decrypt according to fence shape

(check-expect (decrypt (encrypt "diesisteinklartext" 6) 6)  
"diesisteinklartext")

(define (decrypt str h)
   (local ((define e (fence (build-list (string-length str) (lambda  
(i) i)) h))
           (define x (map list e (string->list str)))
           (define y (sort x (lambda (i j) (<= (first i) (first j)))))
           (define z (map second y)))
     (list->string z)))

;; [Listof X] -> [Listof X]

;; 1   5    9
;;  2 4 6  8 10
;;   3   7    11 ...

(check-expect (fence '(1 2 3 4 5 6) 3) '(1 5 2 4 6 3))
(check-expect (fence '(1 2 3 4 5 6 7 8 9 10 11) 3) '(1 5 9 2 4 6 8 10  
3 7 11))

(define (fence lox h)
   (local ((define a (apply append (transpose (waves lox h)))))
     (filter (lambda (e) (not (eq? X e))) a)))

(define X '_) ;; a unique tag for padding the data structure

;; [Listof X] Nat -> [Listof [Listof (U X Char)]]
;; chop the list into up and down waves (reversed from diagram)
;;   pad the down waves at beginning and end
;;

(check-expect (waves '(d i e s i s t e i n k l a r t e x t) 6)
               '((d i e s i s) (_ n i e t _) (k l a r t e) (_ _ _ t x  
_)))
(check-expect (waves '(d i e s i) 3) '((d i e) (_ s _) (i _ _)))

(define (waves str h)
   (local ((define (down str)
             (cond
               [(>= h (length str)) (list (fill h str))]
               [else (cons (take str h) (up (drop str h)))]))
           (define (up str)
             (cond
               [(>= (- h 2) (length str)) (list (pad (fill (- h 2)  
str)))]
               [else (cons (pad (take str (- h 2))) (down (drop str  
(- h 2))))]))
           (define (pad str) (append (list X) (reverse str) (list X)))
           (define (fill h str) (append str (make-list (- h (length  
str)) X))))
     (down str)))

;; [Listof [Listof X]] -> [Listof [Listof X]]
;; transpose the matrix

(check-expect
  (transpose '((d i e s i s) (_ n i e t _) (k l a r t e) (_ _ _ t x _)))
  '((d _ k _) (i n l _) (e i a _) (s e r t) (i t t x) (s _ e _)))

(define (transpose m)
   (cond
     [(empty? (first m)) '()]
     [else (cons (map first m) (transpose (map rest m)))]))

(test)