Breaks the vigenere Cipher (for german)

VigenereBreaker.clj

(ns informatik-krams.core
  (:gen-class))

(import java.lang.Character)

(defn- seq->pos-table [coll]
  (map-indexed #(assoc {} :position %1 :letter %2) coll))

(defn char-range [start end]
  (map char (range (int start) (inc (int end)))))

(def used-chars (char-range \a \z))

(defn int->char-in-alphabet
  [n alphabet]
  (get (vec alphabet) n))

(defn increase-char
  ([c i alphabet]
   (if (>= (+ (.indexOf alphabet c) i) (count alphabet))
     (char (- (+ (int c) i) (count alphabet)))
     (char (+ (int c) i))))
  ([c i] (increase-char c i used-chars)))

(defn decrease-char [c i alphabet]
  (if (<= (- (.indexOf alphabet c) i) 0)
    (char (- ))))


(defn reduce-char-to-index
  [n chars-at-index [current-char index-in-text]]
  (let [result-index (mod index-in-text n)]
    (assoc chars-at-index
           result-index
           (conj (get chars-at-index result-index (vector)) current-char))))

(defn group-by-key-index
  "Entspricht Schritt eins"
  [s n]
  (->> (seq s)
       ;; Mappt das Zeichen zu seiner Position im Text
       (map-indexed #(vector %2 %1))
       ;; Mappt alle Zeichen die von dem Zeichen am gleichen Punkt im
       ;; Schlüssel verschlüsselt worden sind zu der Position dieses Zeichens im Schlüssel
       (reduce #(reduce-char-to-index n %1 %2) {})))

(defn analyse-text
  "Entspricht Schritt 2"
  ([s n alphabet]
   ;; Führt Schritt 1 durch
   (let [grouped-text (group-by-key-index s n)]
     (map (fn [[index coll]]
            ;; Zählt die Zeichen
            (let [counted-chars (frequencies coll)]
              (assoc {} :index index :probabilities
                   (->> alphabet
                        ;; Berechnet für jedes Zeichen im Alphabet die Häufigkeit
                        (reduce (fn [propabilities used-char]
                                  (conj propabilities
                                        (assoc {} :letter used-char :percentage
                                               (/ (get counted-chars used-char 0) (count coll) ))))
                                [])
                        ;; Sortiert nach absteinder Häufigkeit
                        (sort-by #(- 1 (:percentage %)))
                        ;; Mapt die Häufigkeiten zu ihrer Position
                        (map-indexed #(assoc %2 :position %1))))))
          grouped-text)))
  ([s n] (analyse-text s n used-chars)))

(def char-order #(map :letter %))

(defn swap [vector i1 i2]
  (assoc vector i1 (vector i2) i2 (vector i1) ))

(defn bubble
  "Vergleicht alle benachbarten Felder von links nach rechts und tauscht sie wenn cf wahr zurück gibt"
  ([cf coll index counter]
   (let [nd-index (inc index)]
     ;; nimmt erstes und zweites element, falls der Vektor zu klein ist, wird abgebrochen
     (if-let [x (get coll index) ]
       (if-let [y (get coll nd-index)]
         (if (cf x y)
           (recur cf (swap coll index nd-index) nd-index (inc counter))
           (recur cf coll nd-index counter))
        (assoc {} :coll coll :counter counter)))))
  ([cf coll] (bubble cf coll 0 0)))

(defn bubble-sort
  ([cf counter coll]
   ((fn [counter sorted-coll]
      ;; führt solange bubble aus bis keine Veränderung mehr erreicht wird
      (let [{newcount :counter, new-coll :coll} (bubble cf sorted-coll)]
        (if(= sorted-coll new-coll)
          (assoc {} :counter counter :coll sorted-coll )
          ;; Addiert die swap-operationen
          (recur (+ counter newcount) new-coll))))
    0 (vec coll)))
  ([cf coll] (bubble-sort cf 0 coll)))

(defn- position-in-table [letter table]
  (:position (first (filter #(= (:letter %) letter) table))))

(defn compare-propability
  "Gibt non-nil zurück wenn das erste Zeichen weiter vorne in der gegebenen Tabelle steht (sollte als Spalten :letter und :position haben)"
  ([x y table cf]
   (let [position #(position-in-table % table)]
     (cf (position x) (position y))))
  ([x y table] (compare-propability x y table >)))

(defn kendall-tau-distance
  "Berechnet die Kendall-Tau Distanz für eine Zeichenkette zu einer Verteilung wie german-probabilities hin"
  [ordered-alphabet char-seq]
  (:counter (bubble-sort #(compare-propability %1 %2 ordered-alphabet) char-seq)))

(defn kendall-tau-distances
  [ordered-alphabet char-seq-of-text]
  (reduce (fn [result i]
            (->> char-seq-of-text
                 ;; Jedes zeichen wird um i im alphabet zurückgesetzt
                 (map #(increase-char % (- (count ordered-alphabet) i) used-chars))
                 ;; Die Kendall-tau Distanz wird zu i gemappt
                 (kendall-tau-distance ordered-alphabet)
                 (assoc {} :increment i :distance)
                 (conj result)))
          []
          ;; Führt dies für die länge des alphabets aus
          (range (count ordered-alphabet))))

(defn minimal-distances
  [analysis ordered-alphabet]
  (->> analysis
       (map (fn [{index :index probabilities :probabilities}]
              (->> probabilities
                   ;; wandelt den Vektor von Maps in eine Liste aus Chars um 
                   (char-order)
                   (kendall-tau-distances ordered-alphabet)
                   (sort-by :distance)
                   ;; wandelt :increment zu dem entsprechenden Zeichem im Alphabet um
                   (map (fn [{increment :increment distance :distance }]
                          (assoc {}
                                 :char-inc (int->char-in-alphabet increment used-chars)
                                 :distance distance))) 
                   (sort-by :distance)
                   (assoc {} :index index :distances))))))

(defn most-likey
  "Setzt die Wahrscheinlichsten Ergbenisse von minimal-distances zu einer Liste zusammen"
  [distances]
  (map (comp :char-inc first :distances) distances))

(def german-probabilities (seq->pos-table (seq "enisratdhulcgmobwfkzpvjyxq")))

(defn remove-non-alphabetical [s]
  (filter #(Character/isAlphabetic (int %)) (seq s)))

(defn -main
  [& args]
  (let [[n filename] args]
    (-> filename
        (slurp)
        (clojure.string/lower-case)
        (clojure.string/join)
        (remove-non-alphabetical)
        (analyse-text n used-chars)
        (minimal-distances german-probabilities)
        (most-likey)
        (#(apply str %))
        (print))))