;;; Solution by Luis Sergio Oliveira for the Rail-Fence Cipher exercise from
;;; Programming Praxis
;;; See http://programmingpraxis.wordpress.com/2009/03/31/rail-fence-cipher/
(defun make-cipher-indexes (key)
(let ((indexes-list (list)))
(dotimes (i (- (* key 2) 2))
(let ((x (if (>= i key)
(- (- (* key 2) 2) i)
i)))
(push x indexes-list)))
(setf indexes-list (nreverse indexes-list))
(setf (cdr (last indexes-list)) indexes-list)
indexes-list))
(defun valid-keyp (key)
(and (typep key 'integer)
(>= key 1)))
(defun handle-invalid-key (key)
(assert (valid-keyp key) (key)
"Invalid key: ~a. It must be an integer >= 1." key))
(defun cipher (text key)
(handle-invalid-key key)
(if (= 1 key)
text
(let ((new-strings (make-list key :initial-element "")))
(map 'vector (lambda (char index)
(setf (nth index new-strings)
(concatenate 'string (nth index new-strings)
(list char))))
text (subseq (make-cipher-indexes key) 0 (length text)))
(apply #'concatenate 'string new-strings))))
(defun positions (item seq &key (start 0))
(let ((position (position item seq :start start)))
(when position
(cons position
(positions item seq :start (1+ position))))))
(defun uncipher (ciphered-text key)
(handle-invalid-key key)
(if (= 1 key)
text
(let ((cipher-indexes (subseq (make-cipher-indexes key)
0 (length ciphered-text)))
(positions (list))
(unciphered-text (copy-seq ciphered-text)))
(dotimes (i key)
(setf positions (append positions (positions i cipher-indexes))))
(dotimes (i (length ciphered-text))
(setf (elt unciphered-text (elt positions i))
(elt ciphered-text i)))
unciphered-text)))
(defmacro assert-rail-fence-cipher-operation (fn text-to-operate key expected)
(let ((actual-name (gensym))
(expected-name (gensym)))
`(let ((,actual-name (funcall ,fn ,text-to-operate ,key))
(,expected-name ,expected))
(assert (string= ,actual-name ,expected-name) ()
"Got \"~a\" expected \"~a\"." ,actual-name ,expected-name))))
;;; the exercise test case:
(defconstant +original-text+ "PROGRAMMING PRAXIS")
(defconstant +ciphered-text+ "PMPRAM RSORIGAIGNX")
(defconstant +key+ 4)
(assert-rail-fence-cipher-operation #'cipher +original-text+
+key+ +ciphered-text+)
(assert-rail-fence-cipher-operation #'uncipher +ciphered-text+
+key+ +original-text+)
;;; text "abcde"
;;; key 2
;;; a c e = ace
;;; b d = bd
;;; ciphered-text "acebd"
;;;
;;; 0 0 0 -> (0 1 0 1 0) -> indexes (0) -> (0 2 4)
;;; 1 1 -> (0 1 0 1 0) -> indexes (1) -> (1 3)
;;;
;;; acebd -> a c e b d
;;; 0 2 4 1 3
;;; a b c d e
(assert-rail-fence-cipher-operation #'cipher "abcde" 2 "acebd")
(assert-rail-fence-cipher-operation #'uncipher "acebd" 2 "abcde")