Playfair_Encode, Common Lisp

Language: Layout:

(setf alphabet '(A B C D E F G H I K L M N O P Q R S T U V W X Y Z))
(setf alphabetSrt '("A" "B" "C" "D" "E" "F" "G" "H" "I" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"))

(defun f1 (el lst)
	(cond
		((null lst) '())
		((equal el (car lst)) (f1 el (cdr lst)))
		(t (cons (car lst) (f1 el (cdr lst))))))

(defun f2 (lst)
	(cond
		((null lst) '() )
		(t (cons (car lst)  (f2 (f1 (car lst) (cdr lst)))))))

(defun searchPl (el lst)
    (cond 
        ((null lst) 0)
        ((equal el (car lst)) 1)
        (t (+ 1 (searchPl el (cdr lst))))))

(defun y_x (el lst)
    (let
        ((a (searchPl el lst))
         (b (TRUNCATE (searchPl el lst) 5)))
              (list 
                  (if (equal (mod a 5) 0) 
                      (- b 1)
                      b)
                   (if (equal (mod a 5) 0) 
                      (- (- a (* 5 (- b 1))) 1) 
                      (- (- a (* 5 b)) 1)))))

(defun searchLetter (el lst)
    (cond
        ((null lst) '())
        ((equal el 0) (car lst))
        (t (searchLetter (- el 1) (cdr lst)))))

(defun searchPlChar (el str)
    (cond 
        ((equal (length str) 0) 0)
        ((equal el (car str)) 0)
        (t (+ 1 (searchPlChar el (cdr str))))))

(defun searchLetterChar (el str)
    (cond
        ((equal (length str) 0) '())
        ((equal el 0) (subseq str 0 1))
        (t (searchLetterChar (- el 1) (subseq str 1)))))

(defun letter (lstxy lst) 
    (let ((a (car lstxy))
          (b (cadr lstxy)))
             ;(+ (+ (* a 5) b) 1)
             (searchLetter (- (+ (+ (* a 5) b) 1) 1) lst)
             ))

(defun plfin (lst keyPl)
    (let ((key (f2 keyPl)))
         (cond
             ((null lst) '())
             (t (append (list(y_x (car lst) key)) (plfin (cdr lst) key)) ))))

(defun cryptPlf (lst keyPl)
    (let ((a (car lst))
          (b (cadr lst)))
         (cond 
              ((null lst) '())
              ((null b) (cryptPlf (append lst (list (y_x 'X (f2 keyPl)))) keyPl))
              ((equal a b) (cryptPlf(append (list a (y_x 'X (f2 keyPl)) b ) (cddr lst)) keyPl) ) 
              ((equal (car a) (car b)) (append (list (list (car a) (if 
                                                    (equal (cadr a) 4)
                                                    0 
                                                    (+ (cadr a) 1)))
                                              (list (car b) (if 
                                                    (equal (cadr b) 4)
                                                    0 
                                                    (+ (cadr b) 1)))) (cryptPlf (cddr lst) keyPl)) )  
              ((equal (cadr a) (cadr b)) (append (list (list (if 
                                                    (equal (car a) 4)
                                                    0 
                                                    (+ (car a) 1)) (cadr a) )
                                                       (list (if 
                                                    (equal (car b) 4)
                                                    0 
                                                    (+ (car b) 1)) (cadr b) )) (cryptPlf (cddr lst) keyPl)) )
              (t (append (list (list (car a) (cadr b)) (list (car b) (cadr a))) (cryptPlf (cddr lst) keyPl))))))

(defun plfout (lst keyPl)
    (let ((key (f2 keyPl)))
         (cond
             ((null lst) '())
             (t (append (list (letter (car lst) key) (letter (cadr lst) key)) (plfout (cddr lst) key))))))

(defun strToList (str)
    (cond 
        ((equal (length str) 0) '())
        ((equal (subseq str 0 1) " ") (strToList (subseq str 1)))
        ((equal (subseq str 0 1) ".") (strToList (subseq str 1)))
        ((equal (subseq str 0 1) ",") (strToList (subseq str 1)))
        ((equal (subseq str 0 1) "!") (strToList (subseq str 1)))
        ((equal (subseq str 0 1) "?") (strToList (subseq str 1)))
        ((equal (subseq str 0 1) "–") (strToList (subseq str 1)))
        ((equal (subseq str 0 1) "J") (append (searchLetterChar (searchPlChar "I" alphabetSrt) alphabet) (strToList (subseq str 1))))
        (t (append (searchLetterChar (searchPlChar (subseq str 0 1) alphabetSrt) alphabet) (strToList (subseq str 1))))))

(let ((keyPl (append (strToList(string-upcase "Player")) alphabet))
      (textPl (strToList(string-upcase "Bogdan ahuenen"))))
    (print 
         (plfout(cryptPlf (plfin textPl keyPl) keyPl) keyPl) 
    )
)

[ + ] Show input
Absolute running time: 0.21 sec, cpu time: 0.04 sec, memory peak: 7 Mb, absolute service time: 0,33 sec