Pastebin is 300% more awesome when you are logged in. Sign Up, it's FREE!
Guest

Luis Sergio Oliveira

By: a guest on May 17th, 2009  |  syntax: Lisp  |  size: 2.87 KB  |  hits: 1,028  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. ;;; Solution by Luis Sergio Oliveira for the Rail-Fence Cipher exercise from
  2. ;;; Programming Praxis
  3. ;;; See http://programmingpraxis.wordpress.com/2009/03/31/rail-fence-cipher/
  4.  
  5. (defun make-cipher-indexes (key)
  6.   (let ((indexes-list (list)))
  7.     (dotimes (i (- (* key 2) 2))
  8.       (let ((x (if (>= i key)
  9.                    (- (- (* key 2) 2) i)
  10.                  i)))
  11.         (push x indexes-list)))
  12.     (setf indexes-list (nreverse indexes-list))
  13.     (setf (cdr (last indexes-list)) indexes-list)
  14.     indexes-list))
  15.  
  16. (defun valid-keyp (key)
  17.   (and (typep key 'integer)
  18.        (>= key 1)))
  19.  
  20. (defun handle-invalid-key (key)
  21.   (assert (valid-keyp key) (key)
  22.           "Invalid key: ~a. It must be an integer >= 1." key))
  23.  
  24. (defun cipher (text key)
  25.   (handle-invalid-key key)
  26.   (if (= 1 key)
  27.       text
  28.       (let ((new-strings (make-list key :initial-element "")))
  29.         (map 'vector (lambda (char index)
  30.                        (setf (nth index new-strings)
  31.                              (concatenate 'string (nth index new-strings)
  32.                                           (list char))))
  33.              text (subseq (make-cipher-indexes key) 0 (length text)))
  34.         (apply #'concatenate 'string new-strings))))
  35.  
  36. (defun positions (item seq &key (start 0))
  37.   (let ((position (position item seq :start start)))
  38.     (when position
  39.       (cons position
  40.             (positions item seq :start (1+ position))))))
  41.  
  42. (defun uncipher (ciphered-text key)
  43.   (handle-invalid-key key)
  44.   (if (= 1 key)
  45.       text
  46.       (let ((cipher-indexes (subseq (make-cipher-indexes key)
  47.                                     0 (length ciphered-text)))
  48.             (positions (list))
  49.             (unciphered-text (copy-seq ciphered-text)))
  50.         (dotimes (i key)
  51.           (setf positions (append positions (positions i cipher-indexes))))
  52.         (dotimes (i (length ciphered-text))
  53.           (setf (elt unciphered-text (elt positions i))
  54.                 (elt ciphered-text i)))
  55.         unciphered-text)))
  56.  
  57. (defmacro assert-rail-fence-cipher-operation (fn text-to-operate key expected)
  58.   (let ((actual-name (gensym))
  59.         (expected-name (gensym)))
  60.     `(let  ((,actual-name (funcall ,fn ,text-to-operate ,key))
  61.             (,expected-name ,expected))
  62.        (assert (string= ,actual-name ,expected-name) ()
  63.                "Got \"~a\" expected \"~a\"." ,actual-name ,expected-name))))
  64.  
  65. ;;; the exercise test case:
  66. (defconstant +original-text+ "PROGRAMMING PRAXIS")
  67. (defconstant +ciphered-text+ "PMPRAM RSORIGAIGNX")
  68. (defconstant +key+ 4)
  69.  
  70. (assert-rail-fence-cipher-operation #'cipher +original-text+
  71.                                     +key+ +ciphered-text+)
  72.  
  73. (assert-rail-fence-cipher-operation #'uncipher +ciphered-text+
  74.                                     +key+ +original-text+)
  75.  
  76. ;;; text "abcde"
  77. ;;; key 2
  78. ;;; a c e = ace
  79. ;;;  b d  = bd
  80. ;;; ciphered-text "acebd"
  81. ;;;
  82. ;;; 0 0 0 -> (0 1 0 1 0) -> indexes (0) -> (0 2 4)
  83. ;;;  1 1  -> (0 1 0 1 0) -> indexes (1) -> (1 3)
  84. ;;;
  85. ;;; acebd -> a c e b d
  86. ;;;          0 2 4 1 3
  87. ;;;          a b c d e
  88. (assert-rail-fence-cipher-operation #'cipher "abcde" 2 "acebd")
  89.  
  90. (assert-rail-fence-cipher-operation #'uncipher "acebd" 2 "abcde")