Bacon cipher: Difference between revisions

Line 1,013:

1. Note

~~Masks~~ are stored in association lists.

Codes are stored in association lists.

<pre>#\x -> assoc -> ~~mask~~ -> rassoc -> #\x</pre>

<pre>#\x -> assoc -> code -> rassoc -> #\x</pre>

For instance.

<pre>(cdr (assoc #\a +~~abc~~+)) = (A A A A A) (car (rassoc '(A A A A A) +~~abc~~+) = #\a </pre>

<pre>(cdr (assoc #\a +codes+)) = (A A A A A) (car (rassoc '(A A A A A) +codes+) = #\a </pre>

2. Program

Line 1,025:

<lang lisp>;; 22.06.14

(defconstant +~~abc~~+

(defconstant +codes+

'((#\a . (A A A A A)) (#\b . (A A A A B)) (#\c . (A A A B A))

(#\d . (A A A B B)) (#\e . (A A B A A)) (#\f . (A A B A B))

Line 1,036:

(#\y . (B B A A A)) (#\z . (B B A A B)) (#\space . (B B B A A))))

(defun encode (~~txt~~ ~~msg~~)

(defun encode (text message)

(let (cipher ~~mask~~)

(let (cipher code)

(setf msg (string-downcase ~~msg~~))

(setf msg (string-downcase message))

(loop for c across ~~msg~~ do

(loop for c across message do

(setf ~~mask~~ (append ~~mask~~ (cdr (assoc c +~~abc~~+)))))

(setf code (append code (cdr (assoc c +codes+)))))

(setf ~~txt~~ (string-downcase ~~txt~~))

(setf text (string-downcase text))

(loop for c across ~~txt~~ always ~~mask~~ do

(loop for c across text always code do

(when (alpha-char-p c)

(when (eq (car ~~mask~~) 'B)

(when (eq (car code) 'B)

(setf c (char-upcase c)))

(setf ~~mask~~ (cdr ~~mask~~)))

(setf code (cdr code)))

(setf cipher (append cipher (list c))))

(return-from encode (coerce cipher 'string)))))

(defun decode (~~txt~~)

(defun decode (text)

(let (key ~~mask~~)

(let (key code)

(setf ~~txt~~ (remove-if-not 'alpha-char-p ~~txt~~))

(setf text (remove-if-not 'alpha-char-p text))

(loop for c across ~~txt~~ do

(loop for c across text do

(if (lower-case-p c)

(setf ~~mask~~ (append ~~mask~~ '(A)))

(setf code (append code '(A)))

(setf mask (append ~~mask~~ '(B))))

(setf mask (append code '(B))))

(when (= (length ~~mask~~) 5)

(when (= (length code) 5)

(setf key (append key (list (car (rassoc ~~mask~~ +~~abc~~+ :test #'equal)))))

(setf key (append key (list (car (rassoc code +codes+ :test #'equal)))))

(setf ~~mask~~ nil)))

(setf code nil)))

(return-from decode (coerce key 'string))))</lang>