[plt-scheme] Code review: garden fence encryption

Marek Kubica wrote:
> Hi,
> 
> I don't know whether this is the correct list, but of all Scheme
> communities this one seemed to be the best fit for this mail.

Hi Marek,

I think you're in the right place.

> Anyway, I had the idea of implementing a simple encryption algorithm
> that even children can use, as a kind of exercise in writing functional
> code in Scheme.
> 
> Attached is a version of that script as it is quite long. I tried to
> write enough documentation so that both the garden fence algorithm as
> well as my implementation are understandable.
> 
> It would be good if some more experienced Schemers could take a look at
> the code and give me some tips on how I could improve it. I usually
> learn quite a lot from such reviews and value the input of other people.

I'm giving a "review" in the form of an alternative implementation.  You 
can contrast your solution with mine if you'd like.  It was a fun 
exercise; thanks for sending it!

My solution is shorter than yours and exploits a symmetry in encrypting 
and decrypting that yours missed.  It is not functional, but it could 
easily be re-written to be so.  I suspect it would only make the code 
less clear.

The insight for me came from your decryption diagram (it's quite good!). 
  Notice it does not depend on the string contents at all, but generates 
a permutation based on the width and height of the fence.  This 
permutation can be used both to encrypt and decrypt.  My `fence' 
procedure implements this permutation generation.  Encrypt and decrypt 
simply permute and unpermute, respectively, according to the fence.

David

#lang scheme
(require htdp/testing)

;; Nat Nat -> [Listof Nat]
;; Generate a fence permutation of the given
;; height (> 1) for strings of length len.
(define (fence 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 bot) (loop n (add1 bot) add1)]
             [(> 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 text height)
   (permute text (fence height (string-length text))))

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

;; 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)))))
                   (loop (add1 i)
                         (rest p))]))))

;; [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))))

;; Test cases
(check-expect (encrypt "" 5) "")
(check-expect (encrypt "diesisteinklartext" 2)
               "deitikatxissenlret")
(check-expect (encrypt "diesisteinklartext" 6)
               "dkinleiasertittxse")
(check-expect (encrypt "diesisteinklartext" 18)
               "diesisteinklartext")

(check-expect (decrypt "" 5) "")
(check-expect (decrypt "deitikatxissenlret" 2)
               "diesisteinklartext")
(check-expect (decrypt "dkinleiasertittxse" 6)
               "diesisteinklartext")
(check-expect (decrypt "diesisteinklartext" 18)
               "diesisteinklartext")

(generate-report)