SHARE
TWEET

Untitled

a guest May 19th, 2019 53 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (def div (fn [a b] (/ (double a) (double b))))
  2. (def square (fn [a] (* a a)))
  3. (def sqrt (fn [a] (Math/sqrt (Math/abs (double a)))))
  4.  
  5. (defn constructor [ctor prototype]
  6.   (fn [& args]
  7.     (apply ctor (cons {:prototype prototype} args))))
  8.  
  9. (defn proto-get [obj key]
  10.   (cond
  11.     (contains? obj key) (obj key)
  12.     (contains? obj :prototype) (proto-get (obj :prototype) key)
  13.     :else nil))
  14.  
  15. (defn evaluate [expr args]
  16.   ((proto-get expr :evaluate) expr args))
  17.  
  18. (defn toString [expr]
  19.   ((proto-get expr :toString) expr))
  20.  
  21. (defn diff [expr d-var]
  22.   ((proto-get expr :diff) expr d-var))
  23.  
  24. (declare zero)
  25.  
  26. (def Constant
  27.   (constructor
  28.     (fn [this value]
  29.       (assoc this :value value))
  30.     {
  31.      :evaluate (fn [this args] (this :value))
  32.      :toString (fn [this] (str (format "%.1f" (this :value))))
  33.      :diff     (fn [this d-var] zero)}))
  34.  
  35. (def zero (Constant 0.0))
  36. (def one (Constant 1.0))
  37. (def two (Constant 2.0))
  38.  
  39. (def Variable
  40.   (constructor
  41.     (fn [this value]
  42.       (assoc this :value value))
  43.     {
  44.      :evaluate (fn [this args] (args (this :value)))
  45.      :toString (fn [this] (this :value))
  46.      :diff     (fn [this d-var]
  47.                  (if (= d-var (this :value))
  48.                    one
  49.                    zero))}))
  50.  
  51. (defn obj-operation [f id d]
  52.   (constructor
  53.     (fn [this & args]
  54.       (assoc this :args args))
  55.     {
  56.      :evaluate (fn [this args] (apply f (map (fn [operand] (evaluate operand args)) (this :args))))
  57.      :toString (fn [this] (str "(" id " "
  58.                                (clojure.string/join " " (map (fn [fun] (toString fun)) (this :args))) ")"))
  59.      :diff     (fn [this d-var] (d d-var (this :args)))}))
  60.  
  61. (def Add (obj-operation + "+" (fn [arg [a b]]
  62.                                 (Add
  63.                                   (diff a arg)
  64.                                   (diff b arg)))))
  65.  
  66. (def Subtract (obj-operation - "-" (fn [arg [a b]]
  67.                                      (Subtract
  68.                                        (diff a arg)
  69.                                        (diff b arg)))))
  70.  
  71. (def Multiply (obj-operation * "*" (fn [arg [a b]]
  72.                                      (Add
  73.                                        (Multiply
  74.                                          (diff a arg) b)
  75.                                        (Multiply
  76.                                          a
  77.                                          (diff b arg))))))
  78.  
  79. (def Divide (obj-operation div "/" (fn [arg [a b]]
  80.                                      (Divide
  81.                                        (Subtract
  82.                                          (Multiply
  83.                                            (diff a arg)
  84.                                            b)
  85.                                          (Multiply
  86.                                            a
  87.                                            (diff b arg)))
  88.                                        (Multiply
  89.                                          b
  90.                                          b)))))
  91.  
  92. (def Negate (obj-operation - "negate" (fn [arg [a]] (Negate (diff a arg)))))
  93.  
  94. (def Square (obj-operation square "square" (fn [arg [a]]
  95.                                              (Multiply
  96.                                                two
  97.                                                a
  98.                                                (diff a arg)))))
  99.  
  100. (def Sqrt (obj-operation sqrt "sqrt" (fn [arg [a]]
  101.                                        (Divide
  102.                                          (Multiply
  103.                                            (diff a arg) a)
  104.                                          (Multiply
  105.                                            two
  106.                                            (Sqrt
  107.                                              (Multiply
  108.                                                (Square a)
  109.                                                a)))))))
  110.  
  111. (def obj-id {'+ Add, '- Subtract, '* Multiply, '/ Divide, 'negate Negate, 'sqrt Sqrt, 'square Square})
  112.  
  113. (defn parse [expression]
  114.   (cond
  115.     (number? expression) (Constant expression)
  116.     (symbol? expression) (Variable (str expression))
  117.     :else (apply (obj-id (first expression)) (map parse (rest expression)))))
  118.  
  119. (defn parseObject [expression] (parse (read-string expression)))
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top