mappings.clj

(ns mappings.core)

(def alphabet " -=qwertyuiop[]asdfghjkl;'zxcvbnm,./_+QWERTYUIOP{}ASDFGHJKL:\"ZXCVBNM<>?")

(def dvorak
  {\space \space, \A \A, \a \a, \" \_, \B \X, \b \x, \C \J, \c \j, \D \E, \d \e, \E \>, \e \., \F \U, \f \u, \' \-, \G \I, \g \i, \H \D, \h \d, \I \C, \i \c, \J \H, \j \h, \+ \}, \K \T, \k \t, \, \w, \L \N, \l \n, \- \[, \M \M, \m \m, \. \v, \N \B, \n \b, \/ \z, \O \R, \o \r, \P \L, \p \l, \Q \", \q \', \R \P, \r \p, \S \O, \s \o, \T \Y, \t \y, \U \G, \u \g, \V \K, \v \k, \W \<, \w \,, \X \Q, \x \q, \Y \F, \y \f, \: \S, \Z \:, \z \;, \; \s, \[ \/, \{ \?, \< \W, \= \], \] \=, \} \+, \> \V, \? \Z, \_ \{})

(def colemak
  ;; TODO!
  )

(defn cycles [permutation alphabet]
  (when-let [[char & _] (seq alphabet)]
    (let [cycle (->> (iterate permutation char)
                     rest
                     (take-while (partial not= char))
                     (cons char))]
      (cons cycle
            (cycles permutation
                    (remove (set cycle) alphabet))))))

(defn gcd [a b]
  (if (zero? b) a (recur b (mod a b))))

(defn lcm
  ([a]
     a)
  ([a b]
     (/ (* a b) (gcd a b)))
  ([a b & more]
     (if (seq more)
       (lcm (lcm a b)
            (apply lcm more))
       (lcm a b))))

(defn order [permutation alphabet]
  (let [alphabet-cycles (cycles permutation alphabet)]
    (fn [s]
      (->> alphabet-cycles
           (filter (partial some (set s)))
           (map count)
           (apply lcm)))))

(def dvorak-order (order dvorak alphabet))

#_(dvorak-order "tom")