; bifid cipher
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
(reverse ys)
(loop (- n 1) (cdr xs)
(cons (car xs) ys)))))
(define (drop n xs)
(let loop ((n n) (xs xs))
(if (or (zero? n) (null? xs)) xs
(loop (- n 1) (cdr xs)))))
(define (string-index c str)
(let loop ((ss (string->list str)) (k 0))
(cond ((null? ss) #f)
((char=? (car ss) c) k)
(else (loop (cdr ss) (+ k 1))))))
(define key "ABCDEFGHIKLMNOPQRSTUVWXYZ")
; row 1111122222333334444455555
; column 1234512345123451234512345
(define (ltr->rc key c)
(let ((idx (string-index c key)))
(cons (+ (quotient idx 5) 1)
(+ (modulo idx 5) 1))))
(define (rc->ltr key r c)
(let ((idx (+ (* (- r 1) 5) c -1)))
(string-ref key idx)))
(define (prep text)
(define (j->i c)
(if (char-ci=? c #\J) #\I (char-upcase c)))
(let loop ((cs (string->list text)) (ps '()))
(cond ((null? cs) (reverse ps))
((char-alphabetic? (car cs))
(loop (cdr cs) (cons (j->i (car cs)) ps)))
(else (loop (cdr cs) ps)))))
(define (encipher key plain-text)
(let ((rcs (map (lambda (c) (ltr->rc key c)) (prep plain-text))))
(let loop ((xs (append (map car rcs) (map cdr rcs))) (result '()))
(if (null? xs) (list->string (reverse result))
(loop (cddr xs) (cons (rc->ltr key (car xs) (cadr xs)) result))))))
(define (decipher key cipher-text)
(let* ((len (string-length cipher-text))
(xs (let loop ((cs (string->list cipher-text)) (ps '()))
(if (null? cs) (reverse ps)
(let ((x (ltr->rc key (car cs))))
(loop (cdr cs) (cons (cdr x) (cons (car x) ps)))))))
(rs (take len xs)) (cs (drop len xs)))
(let loop ((rs rs) (cs cs) (ps '()))
(if (null? rs) (list->string (reverse ps))
(loop (cdr rs) (cdr cs) (cons (rc->ltr key (car rs) (car cs)) ps))))))
(display (encipher key "PROGRAMMINGPRAXIS")) (newline)
(display (decipher key "OMQNHHQWUIGBIMWCS")) (newline)