vormen.clj

(ns vormen
  (:require [clojure.string :as str]))

[:+ [:* 25 'a]]

(defn dice [n d]
  (apply + (map (fn [_] (inc (rand-int d)))
                (range n))))

(defn basisvorm []
  (case (rand-int 4)
    0 [:num (inc (rand-int 15))]
    (1 2 3) (into [:term (inc (rand-int 15))]
                  (comp (map (fn [_] (rand-nth '[a b c d])))
                        (distinct))
                  (range (inc (rand-int 2))))
    ))

(defn plus-vorm0 []
  (into [:+] (map (fn [_] (basisvorm))) (range (+ 2 (rand-int 3)))))

(defn maal-vorm0 []
  (into [:*] (map (fn [_] (plus-vorm0))) (range (+ 2 (rand-int 1)))))

(defn maal-vorm1 []
  (into [:*] (map (fn [_] (rand-nth [(plus-vorm0)
                                     (basisvorm)
                                     (basisvorm)]))) (range (+ 2 (rand-int 1)))))
(defn vorm []
  (case (rand-int 3)
    0 (plus-vorm0)
    1 (maal-vorm0)
    2 (maal-vorm1)))



(defn superscript [n]
  (char
   (case n
     1 0x00B9
     2 0x00B2
     3 0x00B3
     (+ 0x2070 n))))

(defmulti -render first)

(defn render [x]
  (if (vector? x)
    (-render x)
    (str x)))

(defmethod -render :num [[_ n]]
  (str n))

(defmethod -render :term [[_ n & letters]]

  (apply str n (map (fn [[l ls]]
                      (if (= (count ls) 1)
                        l
                        (str l (superscript (count ls)))))
                    (sort-by key (group-by identity letters)))))

(defmethod -render :+ [[_ & terms]]
  (str/join " + " (map -render terms)))

(defmethod -render :* [[_ & terms]]
  (str/join "⋅" (map (fn [s]
                       (if (re-find #"\+" s)
                         (str "(" s ")")
                         s))
                     (map -render terms))))

(defn compat-term? [[xt xn & xl :as xx] [yt yn & yl :as yy]]
  (and (= :term xt) (= :term yt) (= (sort xl) (sort yl))))

(defmulti multiply (fn [[this] [that]] [this that]))
(defmethod multiply :default [& args] (into [:unimplemented/multiply] args))

(defmethod multiply [:num :num] [[_ x] [_ y]] [:num (* x y)])
(defmethod multiply [:term :term] [[_ x & lx] [_ y & ly]] (into [:term (* x y)] (sort (concat lx ly))))

(defmethod multiply [:num :term] [[_ x] [_ y & letters]] (into [:term (* x y)] letters))
(defmethod multiply [:term :num] [a b] (multiply b a))

(defmethod multiply [:num :+] [n [_ & factors]]
  (into [:+] (map #(multiply n %) factors)))

(defmethod multiply [:+ :num] [a b] (multiply b a))

(defmethod multiply [:term :+] [a [_ & b]] (into [:+] (map #(multiply a %)) b))
(defmethod multiply [:+ :term] [a b] (multiply b a))

(declare evaluate)

(defmethod multiply [:+ :+] [[_ & as] [_ & bs]]
  (evaluate (into [:+] (for [a as b bs] [:* a b]))))

(defmulti add (fn [[this] [that]] [this that]))
(defmethod add :default [& args] (into [:unimplemented/add] args))
(defmethod add [:term :term] [[_ x & lx :as xt] [_ y & ly :as yt]]
  (if (= (sort lx) (sort ly))
    (into [:term (+ x y)] (sort lx))
    [:+ xt yt]))

(defmethod add [:num :num] [[_ a] [_ b]] [:num (+ a b)])

(defn split-first-match [pred coll]
  (loop [[x & xs :as xss] coll
         before []
         match nil
         after []]
    (if-not (seq xss)
      [[before match after]]
      (cond
        (some? match)
        (recur xs before match (conj after x))
        (pred x)
        (recur xs before x after)
        :else
        (recur xs (conj before x) nil after)))))

(defmethod add [:+ :term] [[_ & xs :as xt] [_ y & ly :as yt]]
  (let [[before match after] (split-first-match #(compat-term? yt %) xs)]
    (if (some? match)
      (into (conj (into [:+] before) (add match yt)) after)
      (conj xt yt))))

(defmethod add [:term :+] [a b] (add b a))

(defmethod add [:num :term] [a b] [:+ a b])
(defmethod add [:term :num] [a b] (add b a))

(defmethod add [:num :+] [n [_ & ps]]
  (let [[before match after] (split-first-match #(= :num (first %)) ps)]
    (if (some? match)
      (into (conj (into [:+] before) (add n match)) after)
      (into [:+ n] ps))))

(defmethod add [:+ :num] [a b] (add b a))

(defn evaluate [[t & rest :as i]]
  (case t
    :num i
    :term i
    :* (let [res (reduce multiply (map evaluate rest))]
         (if (and (vector? res)
                  (= :* (first res))
                  (= 2 (count res)))
           (second res)
           res))
    :+ (let [{:keys [num rest] :as groups} (group-by (fn [[t n & ts]]
                                                       (case t
                                                         :term (sort ts)
                                                         :num :num
                                                         :rest))
                                                     (map evaluate rest))
             res (into (into (cond-> [:+ ] (seq num) (conj (reduce add num)))
                             (map (partial reduce add))
                             (vals (dissoc groups :num :rest))) rest)]
         (if (= 2 (count res))
           (second res)
           res))))


(def vormen
  (->> vorm
       repeatedly
       (map (juxt (comp -render identity)
                  (comp -render evaluate)))
       (remove (fn [[a b]]
                 (<= (count a) (count b))))
       (map (fn [[a b]] (str a " = " b)))

       (filter #(<= 17 (count %) 38))
       (take 50)
       (sort-by count)
       (map-indexed (fn [idx x]
                      (str (inc idx) ")\t" x)))
       ))

(run! println
      (map #(str/replace % #"=.*" "= ")
           vormen))

(println)

(run! println
      vormen)

#_
(map -render (take 100 (repeatedly vorm)))

;; (let [termen (inc (rand-int 3))]
;;   )