367 - PurelyFunctional.tv Newsletter https://purelyfunctional.tv/issues/purelyfunctional-tv-newsletter-367-what-about-errors/

00 Caesar cipher.md

Caesar's Cipher

Julius Caesar had many secrets. He used a simple form of encryption to hide his secrets from his enemies. The cipher was easy: shift the alphabet over by a number of letters and replace each letter with the shifted version.

For instance, if you shift the alphabet by two, you get:

a b c d e f g h i j k l m n o p q r s t u v w x y z
c d e f g h i j k l m n o p q r s t u v w x y z a b

When encrypting a string, we replace instances of the top letter with the lower letter. m becomes o. And notice that the alphabet wraps around.

This was cutting edge technology back in those times! You can get this as a prize in a Cracker Jack box :)

Anyway, write a function that will encrypt a string. It should take the shift number and the string. Leave non-letters alone and keep caps in place. You only have to deal with regular ASCII letters for simplicity.

Bonus: make it so to decrypt it you can pass in a negative number.

Thanks to this site for the idea.

Alan Thompson.clj

(ns tst.demo.core
  (:use tupelo.core tupelo.test)
  (:require
    [schema.core :as s]
    [tupelo.chars :as chars]
    [clojure.string :as str])
  (:import [java.lang Character]))

(def alphabet-lower (vec chars/lowercase))
(def alphabet-len (count alphabet-lower))
(def char->index (zipmap alphabet-lower (range)))

(s/defn encipher-char :- Character
  "Implements a Ceasar cipher with shift N (N=0 => noop)"
  [shift :- s/Int
   char-in :- Character]
  (if-not (chars/alpha? char-in)
    char-in
    (let [idx-plain  (char->index (chars/->lowercase char-in))
          idx-cipher (mod (+ idx-plain shift) alphabet-len)
          char-out   (cond-it-> (nth alphabet-lower idx-cipher)
                       (chars/uppercase? char-in) (chars/->uppercase it))]
      char-out)))

(s/defn encipher :- s/Str
  "Implements a Ceasar cipher with shift N (N=0 => noop)"
  [shift :- s/Int
   msg :- s/Str]
  (let [chars-plain  (str->chars msg)
        chars-cipher (forv [char-plain chars-plain]
                       (encipher-char shift char-plain))
        msg-out      (str/join chars-cipher)]
    msg-out))

(s/defn decipher :- s/Str
  "Deciphers a Ceasar cipher with shift N (N=0 => noop)"
  [shift :- s/Int
   msg :- s/Str]
  (encipher (- shift) msg))

(dotest
  (let [vv (vec (range 6))]
    ; like Python indexing:  https://cljdoc.org/d/tupelo/tupelo/0.9.193/api/tupelo.core#idx
    (is= (idx vv 1) 1)
    (is= (idx vv -1) 5)))

(dotest
  (is= (encipher-char 0 \a) \a)
  (is= (encipher-char 1 \a) \b)
  (is= (encipher-char -1 \a) \z)

  (is= (encipher-char 0 \A) \A)
  (is= (encipher-char 1 \A) \B)
  (is= (encipher-char -1 \A) \Z)
  )

(dotest
  (is= (encipher 1 "Hello") "Ifmmp")
  (is= (encipher 0 "Hello") "Hello")
  (is= (encipher 1 "Hello") "Ifmmp")
  (is= "Hello" (it-> "Hello"
                 (encipher 1 it)
                 (encipher -1 it)))
  (is= "Hello" (it-> "Hello"
                 (encipher 1 it)
                 (decipher 1 it)))

  (let [msg-plain       "James Bond will attack SPECTRE at dawn!"
        cipher-expected "Wnzrf Obaq jvyy nggnpx FCRPGER ng qnja!"
        msg-cipher      (encipher 13 msg-plain)]
    (is= msg-cipher cipher-expected)
    (is= msg-plain (it-> msg-plain
                     (encipher 17 it)
                     (decipher 17 it)))))

Eric Normand.clj

(def lower (clojure.string/lower-case "abcdefghijklmnopqrstuvwxyz"))
(def upper (clojure.string/upper-case "abcdefghijklmnopqrstuvwxyz"))

(defn rotate [n letters]
  (->> letters
       (cycle)
       (drop (mod n (count letters)))
       (zipmap letters)))

(defn ->ring [n]
  (merge (rotate n lower) (rotate n upper)))

(defn encrypt [n s]
  (let [ring (->ring n)]
    (->> s
         (map #(get ring % %))
         (clojure.string/join))))

Eric.clj

(ns caesar-cipher

  (:require [clojure.test :refer :all]))



(def capital-floor 65)

(def capital-ceiling 90)

(def lowercase-floor 97)

(def lowercase-ceiling 122)



(defmulti wrap :letter-type)



(defmethod wrap :upper [{:keys [value]}]

  (if (> value capital-ceiling)

    (+ capital-floor (dec (mod value capital-ceiling)))

    value))



(defmethod wrap :lower [{:keys [value]}]

  (if (> value lowercase-ceiling)

    (+ lowercase-floor (dec (mod value lowercase-ceiling)))

    value))



(defn- ascii-letter-type [c]

  (cond

    (and (>= c capital-floor) (<= c capital-ceiling)) :upper

    (and (>= c lowercase-floor) (<= c lowercase-ceiling)) :lower))



(defn- shift-char [c n]

  (if-let [letter-type (ascii-letter-type (int c))]

    (char (wrap {:value       (+ (int c) n)

                 :letter-type letter-type}))

    (char c)))



(defn shuffle-message

  "Accepts a message and shift value and produces a shuffled version of the message.

      :message  string to shuffle

      :shift    integer indicating the number of letters to shift"

  [message shift]

  (if (empty? message)

    message

    (let [reduced-shift (mod shift 26)

          chars (seq message)]

      (apply str (map #(shift-char % reduced-shift) chars)))))



;; TESTS

(deftest shuffle-test

  (is (= "Khoor" (shuffle-message "Hello" 3)))

  (is (= "Hello" (shuffle-message "Khoor" -3)))

  (is (= "Uryyb" (shuffle-message "Hello" -13)))

  (is (= "Hello" (shuffle-message "Hello" 104)))

  (is (= "Hello" (shuffle-message "Gdkkn" -51)))

  (is (= "Kh110#Z0u1g!" (shuffle-message "He110#W0r1d!" 3)))

  (is (= "" (shuffle-message "" 0)))

  (is (nil? (shuffle-message nil 0))))



;; PERFORMANCE TEST

;; O(n) complexity

;; 400-600ms execution time for 1,000,000 chars

(time (shuffle-message (take 1000000 (repeatedly #(char (+ 65 (rand-int 26))))) 3))

Florian Kluck.clj

(defn encode [x step]
  "Encode string x with step size step"
  (letfn [(encode [i step]
           (+ (mod (+ (- i (int \a)) step) 26) (int \a)))]
    (apply str (map (comp char #(encode % step) int) x))))

James Davidson.clj

(defn encrypt [n s]
 (let [offset (mod n 26)
       alphabet1 (map char (range 97 123))
       alphabet2 (concat (drop offset alphabet1) (take offset alphabet1))
       encryptor (zipmap alphabet1 alphabet2)]
  (apply str (map #(get encryptor % %) s))))

Jeroen van Wijgerden.clj

(ns jvw.caesar-cipher
  (:require [clojure.string :refer [upper-case]]
            [clojure.test :refer [deftest testing is]]))

(defn shift
  "Returns an cycle of `coll`, shifted by `n`.
  `n` can be negative."
  [n coll]
  (cond->> (cycle coll)
    (seq coll) (drop (mod n (count coll)))))

(defn cipher [n coll]
  (zipmap coll (shift n coll)))

(defn encrypt
  "Returns an encryption of the string `s` by applying a Caesar cipher of `n` rotations.
  `n` can be negative: (encrypt -n s) is the inverse of (encrypt n s)."
  [n s]
  (let [az "abcdefghijklmnopqrstuvwxyz"
        ciph (merge (cipher n az)
                    (cipher n (upper-case az)))]
    (apply str (map #(if-let [c (ciph %)]
                       c
                       %)
                    s))))

(deftest shift-test
  (testing "empty collection"
    (is (empty? (shift 0 [])))
    (is (empty? (shift 1 [])))
    (is (empty? (shift -1 []))))
 
  (testing "non-empty collection"
    (is (= [1 2 3 4] (take 4 (shift 0 [1 2 3 4]))))
    (is (= [3 4 1 2] (take 4 (shift 2 [1 2 3 4]))))
    (is (= [4 5 1 2 3] (take 5 (shift -2 [1 2 3 4 5]))))))

(deftest cipher-test
  (testing "empty collection"
    (is (= {} (cipher 0 []))))
 
  (testing "non-empty collection"
    (is (= {1 2
            2 3
            3 1}
           (cipher 1 [1 2 3])))
    (is (= {1 2
            2 3
            3 1}
           (cipher -2 [1 2 3])))))

(deftest encrypt-test
  (testing "empty string"
    (is (= "" (encrypt 1 ""))))
 
  (testing "no shift"
    (is (= "abc" (encrypt 0 "abc"))))
 
  (testing "some shift"
    (is (= "ya" (encrypt 24 "ac")))
    (is (= "ya" (encrypt -2 "ac"))))
 
  (testing "capital preservation"
    (is (= "aBc" (encrypt 0 "aBc")))
    (is (= "bCd" (encrypt 1 "aBc"))))
 
  (testing "non-letters"
    (is (= "a-b-c" (encrypt 0 "a-b-c")))
    (is (= "b-c-d" (encrypt 1 "a-b-c")))
    (let [non-letters "!@#$%^&*()_+"]
      (is (= non-letters (encrypt 123 non-letters))))))

Mark Champine.clj

(defn caesar-encrypt
  [k s]
  (letfn [(ctoi [c] (- (int c) (int \a)))  ; char to int
          (itoc [i] (char (+ i (int \a)))) ; int to char
          (shift [i c] (itoc (mod (+ i (ctoi c)) 26) ))] ; shift char c by i
    (apply str (mapv (partial shift k) s))))

;; standard caeasr (offset 3)
(def caesar (partial caesar-encrypt 3))
(def uncaesar (partial caesar-encrypt -3))

(uncaesar (caesar "thisisatest"))
;; "thisisatest"

Neil McCallum.clj

(defn encode
  [cleartext shift]
  {:pre [(<= (Math/abs shift) 26)]}
  (let [abc "abcdefghijklmnopqrstuvwxyz"
        ABC (clojure.string/upper-case abc)
        rshift (if (< shift 0)
                 (+ shift (count abc))
                 shift)
        coder (apply merge
                     (for [run [abc ABC]]
                       (zipmap
                        run
                        (concat
                         (drop rshift run)
                         (take rshift run)))))]
    (apply str (map #(get coder %1 %1) cleartext))))

Steve Miner.clj

;; `rfstr` is a "reducing step function" for transduce, no arg for init, expects
;; chars, returns final result string

(defn rfstr
  ([] (StringBuilder.))
  ([sb] (.toString ^StringBuilder sb))
  ([sb ch] (.append ^StringBuilder sb ^char ch)))

(defn caesar
  ([message] (caesar message 13))
  ([message offset]
   (let [rotch (fn [ch]
                 (let [ic (long ch)
                       ia (long \a)
                       iz (long \z)
                       iA (long \A)
                       iZ (long \Z)]
                   (cond (<= ia ic iz)  (char (+ ia (mod (+ (- ic ia) offset) 26)))
                         (<= iA ic iZ)  (char (+ iA (mod (+ (- ic iA) offset) 26)))
                         :else ch)))]
     (transduce (map rotch) rfstr message))))

Viktor P.clj

(ns purelyfunctional-newsletters.issue-367
  (:require [clojure.string :as str]
            [clojure.test :refer :all]))


(def lower-ascii-letters
  (vec (for [ch (range (int \a) (inc (int \z)))]
         (char ch))))
 
(defn caesar-map [alphabet shift ch]
  (let [char-idx (.indexOf alphabet ch)]
    (if (= -1 char-idx)
      ch
      (let [new-char-idx (+ char-idx shift)
            new-char-idx (mod new-char-idx (count alphabet))]
        (get alphabet new-char-idx)))))

(defn caesar-crypt [shift msg]
  (str/join
   (map #(caesar-map lower-ascii-letters shift %) msg)))


(deftest caesar-cipher
  (is (= "" (caesar-crypt 2 nil)))
  (is (= "" (caesar-crypt 2 "")))
  (is (= "a" (caesar-crypt 0 "a")))
  (is (= "z" (caesar-crypt 25 "a")))
  (is (= "z" (caesar-crypt -1 "a")))
  (is (= "a" (caesar-crypt 1 "z")))
  
  ;; from the newsletter test
  (is (= "c d e f g h i j k l m n o p q r s t u v w x y z a b"
         (caesar-crypt 2 "a b c d e f g h i j k l m n o p q r s t u v w x y z")))

  ;; encrypt-decrypt test
  (is (=  "Hello World!" (->> "Hello World!"
                              (caesar-crypt 2)
                              (caesar-crypt -2)))))