[ create a new paste ] login | about

Link: http://codepad.org/rvI0TxI7    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Sep 29:
; 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)


Output:
1
2
OMQNHHQWUIGBIMWCS
PROGRAMMINGPRAXIS


Create a new paste based on this one


Comments: