[plt-scheme] Code review: garden fence encryption

decrypting was nearly trivial thanks to your diagram. Actually all I  
needed from the diagram was the "positioning" part.

Definitely assignable as a project.

-- 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 (encrypt "diesisteinklartext" 6) "dkinleiasertittxse")

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

;; [Listof X] -> [Listof X]
(define (fence lox h)
   (local ((define a (apply append (transpose (waves lox h))))
           (define r (filter (lambda (e) (not (eq? X e))) a)))
     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)))]))


;;; 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.

(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)))

;; some demonstration code
(define e (encrypt "diesisteinklartext" 6))
(check-expect (decrypt e 6) "diesisteinklartext")

(test)