(def div (fn [a b] (/ (double a) (double b))))
(def square (fn [a] (* a a)))
(def sqrt (fn [a] (Math/sqrt (Math/abs (double a)))))

(defn constructor [ctor prototype]
  (fn [& args]
    (apply ctor (cons {:prototype prototype} args))))

(defn proto-get [obj key]
  (cond
    (contains? obj key) (obj key)
    (contains? obj :prototype) (proto-get (obj :prototype) key)
    :else nil))

(defn evaluate [expr args]
  ((proto-get expr :evaluate) expr args))

(defn toString [expr]
  ((proto-get expr :toString) expr))

(defn diff [expr d-var]
  ((proto-get expr :diff) expr d-var))

(declare zero)

(def Constant
  (constructor
    (fn [this value]
      (assoc this :value value))
    {
     :evaluate (fn [this args] (this :value))
     :toString (fn [this] (str (format "%.1f" (this :value))))
     :diff     (fn [this d-var] zero)}))

(def zero (Constant 0.0))
(def one (Constant 1.0))
(def two (Constant 2.0))

(def Variable
  (constructor
    (fn [this value]
      (assoc this :value value))
    {
     :evaluate (fn [this args] (args (this :value)))
     :toString (fn [this] (this :value))
     :diff     (fn [this d-var]
                 (if (= d-var (this :value))
                   one
                   zero))}))

(defn obj-operation [f id d]
  (constructor
    (fn [this & args]
      (assoc this :args args))
    {
     :evaluate (fn [this args] (apply f (map (fn [operand] (evaluate operand args)) (this :args))))
     :toString (fn [this] (str "(" id " "
                               (clojure.string/join " " (map (fn [fun] (toString fun)) (this :args))) ")"))
     :diff     (fn [this d-var] (d d-var (this :args)))}))

(def Add (obj-operation + "+" (fn [arg [a b]]
                                (Add
                                  (diff a arg)
                                  (diff b arg)))))

(def Subtract (obj-operation - "-" (fn [arg [a b]]
                                     (Subtract
                                       (diff a arg)
                                       (diff b arg)))))

(def Multiply (obj-operation * "*" (fn [arg [a b]]
                                     (Add
                                       (Multiply
                                         (diff a arg) b)
                                       (Multiply
                                         a
                                         (diff b arg))))))

(def Divide (obj-operation div "/" (fn [arg [a b]]
                                     (Divide
                                       (Subtract
                                         (Multiply
                                           (diff a arg)
                                           b)
                                         (Multiply
                                           a
                                           (diff b arg)))
                                       (Multiply
                                         b
                                         b)))))

(def Negate (obj-operation - "negate" (fn [arg [a]] (Negate (diff a arg)))))

(def Square (obj-operation square "square" (fn [arg [a]]
                                             (Multiply
                                               two
                                               a
                                               (diff a arg)))))

(def Sqrt (obj-operation sqrt "sqrt" (fn [arg [a]]
                                       (Divide
                                         (Multiply
                                           (diff a arg) a)
                                         (Multiply
                                           two
                                           (Sqrt
                                             (Multiply
                                               (Square a)
                                               a)))))))

(def obj-id {'+ Add, '- Subtract, '* Multiply, '/ Divide, 'negate Negate, 'sqrt Sqrt, 'square Square})

(defn parse [expression]
  (cond
    (number? expression) (Constant expression)
    (symbol? expression) (Variable (str expression))
    :else (apply (obj-id (first expression)) (map parse (rest expression)))))

(defn parseObject [expression] (parse (read-string expression)))