Skip to content

Instantly share code, notes, and snippets.

@ericnormand
Created January 17, 2022 23:59
Show Gist options
  • Save ericnormand/3154b336534ec8de911b0e99501584ab to your computer and use it in GitHub Desktop.
Save ericnormand/3154b336534ec8de911b0e99501584ab to your computer and use it in GitHub Desktop.
459 PurelyFunctional.tv Newsletter

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/

@mchampine
Copy link

mchampine commented Jan 18, 2022

More challenging than it looked at first glance.

(defn shifter [direction sc c]
  (letfn [(cpos [c] (- (int c) (int \A)))]
    (if (<= (int \A) (int sc) (int \Z))
      (char (+ (int \A) (mod (direction (cpos c) (inc (cpos sc))) 26)))
      c)))

(defn encode [s]
  (let [us (str/upper-case s)]
    (apply str (first us) (map (partial shifter +) us (rest us)))))

(defn decode [s]
  (apply str (reductions (partial shifter -) (first s) (rest s))))

@jonasseglare
Copy link

jonasseglare commented Jan 18, 2022

(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 % %) - -)))

@miner
Copy link

miner commented Jan 22, 2022

(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))

@ericnormand
Copy link
Author

(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))))))

@KingCode
Copy link

KingCode commented May 28, 2022

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))

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment