[plt-scheme] Code review: garden fence encryption

Marek, like Dave, I have tried to write it from scratch, though I  
based it on your image of the fence. (I know very little about  
encrypting and decrypting.) I wanted to see whether our freshmen  
could do it, possibly with some hints, so I wrote it in intermediate  
+ lambda + take/drop (which they can write). No decrypting yet :-]

-- Matthias


#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>

;; String Nat -> String
;; encode according to fence

(define X '_)

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

(define (fence str h)
   (local ((define a (apply append (transpose (waves (string->list  
str) h))))
           (define r (filter (lambda (e) (not (eq? e X))) a)))
     (list->string r)))


;; [Listof X] Nat -> [Listof [Listof (U X Char)]]
;; chop the list into as many pieces of length h, plus padding of the  
last one

(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 (append str (fill h str)))]
               [else (cons (take str h) (up (drop str h)))]))
           (define (up str)
             (cond
               [(>= (- h 2) (length str))
                (list (append (fill (- h 1) str) (reverse (cons X  
str))))]
               [else (cons (cons X (reverse (cons X (take str (- h  
2)))))
                           (down (drop str (- h 2))))]))
           (define (fill h str) (build-list (- h (length str))  
(lambda (i) 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)