Programming Praxis

It will be fairly simple to implement the ADFGX cipher because we can steal much code: string-upcase, string-index, range, zip and sort come from the Standard Prelude, and the transposition functions come from the exercise on Double Transposition. Only the conversion to-and-from the polybius square remains. Here’s encryption:

(define (to-adfgx key plain-text)
  (define (p->c p)
    (let ((x (string-index p key)))
      (string
        (string-ref "ADFGX" (quotient x 5))
        (string-ref "ADFGX" (modulo x 5)))))
  (apply string-append
    (map p->c (map char-upcase
      (string->list plain-text)))))

Instead of a square, we represent the key as a single string of twenty-five characters, and index into the string using the quotient and modulo functions. Decryption is almost as simple, but requires a map2 function to read the ciphertext string two letters at a time:

(define (from-adfgx key cipher-text)
  (define (map2 f xs)
    (if (or (null? xs) (null? (cdr xs))) '()
      (cons (f (car xs) (cadr xs)) (map2 f (cddr xs)))))
  (define (c->p c1 c2)
    (string-ref key
      (+ (* (string-index c1 "ADFGX") 5)
            (string-index c2 "ADFGX"))))
  (list->string
    (map2 c->p (map char-upcase
      (string->list cipher-text)))))

Then all that’s left is two wrapper functions that call the polybius square and transposition functions in the right order:

(define (encipher adfgx-key transpose-key plain-text)
  (to-transpose transpose-key (to-adfgx adfgx-key plain-text)))

(define (decipher adfgx-key transpose-key cipher-text)
  (from-adfgx adfgx-key (from-transpose transpose-key cipher-text)))

A sample dialog is shown below:

> (encipher "BTALPDHOZKQFVSNGICUXMREWY" "TULIP" "PROGRAMMINGPRAXIS")
DXAFXGGXAXDAFFDDXXXXAFAAGDGXGFGAAD
> (decipher "BTALPDHOZKQFVSNGICUXMREWY" "TULIP" "DXAFXGGXAXDAFFDDXXXXAFAAGDGXGFGAAD")
PROGRAMMINGPRAXIS

You can run the program at http://programmingpraxis.codepad.org/VwKUjLzk.

Pages: 1 2