459 PurelyFunctional.tv Newsletter

00 Paul cipher.md

Paul Cipher

Here's an interesting cipher.

• Treat all letters as uppercase, and convert them to uppercase if needed.
• The first alphabetical character of the string will not change.
• All subsequent alphabetical characters are shifted toward Z by the alphabetical position of the preceding alphabetical character.
• Non-alphabetical characters are left as-is.

Your task is to write an encoder and decoder for this cipher

Examples

(encode "") ;=> ""
(encode "a") ;=> "A"
(encode "hello") ;=> "HMQXA"
(encode "newsletter") ;=> "NSBPEQYNYW"
(encode "1 hug") ;=> "1 HCB"

(decode "") ;=> ""
(decode "1") ;=> "1"
(decode "HMQXA") ;=> "HELLO"

Note that you should always be able to decode a string that was encoded and get back the original string uppercased.

Thanks to this site for the problem idea, where it is rated Very Hard in Java. The problem has been modified.

Please submit your solutions as comments on this gist.

To subscribe: https://purelyfunctional.tv/newsletter/

(defn process [f s]
  (let [b (StringBuilder. s)]
    (transduce (comp (map int)
                     (keep-indexed #(if (Character/isAlphabetic %2) [%1 (- (int (Character/toUpperCase %2)) 65)])))
               (completing (fn [key [at x]]
                             (let [[diff y] (f key x)]
                               (.setCharAt b at (char (+ 65 (mod y 26))))
                               (inc diff)))) 0 s)
    (str b)))

(def encode (partial process #(vector %2 (+ %1 %2))))
(def decode (partial process (comp #(vector % %) - -)))

(defn alnum [c]
  (case c
    \A 1 \B 2 \C 3 \D 4 \E 5 \F 6 \G 7 \H 8 \I 9 \J 10
    \K 11 \L 12 \M 13 \N 14 \O 15 \P 16 \Q 17 \R 18 \S 19 \T 20
    \U 21 \V 22 \W 23 \X 24 \Y 25 \Z 26
    nil))

;; assumes c is A-Z
(defn rotaten [c n]
  (char (+ (int \A) (mod (+ (- (int c) (int \A)) n) 26))))

(defn encode [s]
  (-> (reduce (fn [r c]
                (if-let [alph (alnum c)]
                  (conj (pop r) (rotaten c (peek r)) alph)
                  (conj (pop r) c (peek r))))
              [0]
              (clojure.string/upper-case s))
      pop
      clojure.string/join))

(defn decode [s]
  (-> (reduce (fn [r c]
                (if (alnum c)
                  (let [cc (rotaten c (peek r))]
                    (conj (pop r) cc (- (alnum cc))))
                  (conj (pop r) c (peek r))))
              [0]
              (clojure.string/upper-case s))
      pop
      clojure.string/join))

(def alphas "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
(def a->i (into {} (map vector alphas (map inc (range)))))
(def i->a (into {} (map vector (map #(- % 25) (range)) (concat alphas alphas alphas))))

(defn enc* [a b]
  (if (nil? a)
    (Character/toUpperCase b)
    (-> (a->i (Character/toUpperCase a) 0)
        (+ (a->i (Character/toUpperCase b)))
        i->a)))

(defn dec* [a b]
  (if (nil? a)
    (Character/toUpperCase b)
    (-> (a->i (Character/toUpperCase b))
        (- (a->i (Character/toUpperCase a) 0))
        i->a)))

(defn encode [string]
  (let [ret (StringBuilder.)]
    (loop [[c & cs] string lc nil]
      (cond
        (nil? c) ;; end of string
        (str ret)

        (not (Character/isAlphabetic (int c)))
        (do
          (.append ret c)
          (recur cs lc))

        :else
        (do
          (.append ret (enc* lc c))
          (recur cs c))))))

(defn decode [string]
  (let [ret (StringBuilder.)]
    (loop [[c & cs] string lc nil]
      (cond
        (nil? c) ;; end of string
        (str ret)

        (not (Character/isAlphabetic (int c)))
        (do
          (.append ret c)
          (recur cs lc))

        :else
        (let [c (dec* lc c)]
          (.append ret c)
          (recur cs c))))))

The more interesting part consisted (for me) of separating the 'glue code' from the specifics of calculating indexes
and choosing translation targets.

(def alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
(def getpos (->> (range) (map vector alphabet) (into {})))
(def getchar (->> getpos (map #(-> % reverse vec)) (into {})))

(defn perhaps-translate1 [prv c f]
  (let [ppos (getpos prv)
        cpos (getpos c)]
    (if (and ppos cpos)
      (f (inc ppos) cpos)
      c)))

(defn translate [msg translator choose]
  (->> msg 
       (partition 2 1)
       (reduce (fn [[acc [prvt :as memo]] [prv c]]
                 (let [c' (perhaps-translate1 
                           (choose [prvt prv])
                           c translator)]
                   [(conj acc c') (conj memo c')]))
               [[(first msg)] (list (first msg))])
       first
       (apply str)))

(defn encode1 [offset cpos]
  (-> offset (+ cpos) (rem 26) getchar))

(defn decode1 [offset cpos]
  (-> 26 (- offset) (+ cpos) (rem 26) getchar))

(defn encode [msg]
  (-> msg clojure.string/upper-case
      (translate encode1 last)))

(defn decode [txt]
  (translate txt decode1 first))