codepad

Language:

; chaocipher

(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 (shift first past offset str)
  (define (cycle str offset)
    (append (drop offset str) (take offset str)))
  (let ((str (string->list str)))
    (list->string (append
      (take first str)
      (cycle (take (- past first) (drop first str)) offset)
      (drop past str)))))

(define (shift-left n str)
  (shift 1 14 1
    (shift 0 26 n str)))

(define (shift-right n str)
  (shift 2 14 1
    (shift 0 26 1
      (shift 0 26 n str))))

(define (cipher left right enciphering? str)
  (let loop ((old (string->list str))
             (left left) (right right) (new '()))
    (if (null? old)
        (list->string (reverse new))
        (let ((n (string-index (car old) (if enciphering? right left))))
          (loop (cdr old) (shift-left n left) (shift-right n right)
                (cons (string-ref (if enciphering? left right) n) new))))))

(define (encipher left right str) (cipher left right #t str))
(define (decipher left right str) (cipher left right #f str))

(define ct "HXUCZVAMDSLKPEFJRIGTWOBNYQ")
(define pt "PTLNBQDEOYSFAVZKGJRIHWXUMC")

(display (encipher ct pt "WELLDONEISBETTERTHANWELLSAID")) (newline)
(display (decipher ct pt "OAHQHCNYNXTSZJRRHJBYHQKSOUJY")) (newline)

Private [?]

Run code