utils.cljs 5.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131
  1. (ns microtables-frontend.utils
  2. (:require
  3. ["mathjs" :as mathjs]))
  4. ; to add an npm package to shadow-cljs:
  5. ; https://clojureverse.org/t/guide-on-how-to-use-import-npm-modules-packages-in-clojurescript/2298
  6. ; https://shadow-cljs.github.io/docs/UsersGuide.html#npm
  7. (defn highest [dir data] (apply max (map dir data)))
  8. (defn increment-letter-code [s]
  9. (let [l (last s)]
  10. (cond
  11. (empty? s) [65]
  12. (= l 90) (conj (increment-letter-code (subvec s 0 (dec (count s)))) 65)
  13. :else (conj (subvec s 0 (dec (count s))) (inc l)))))
  14. (defn next-letter [lc]
  15. (apply str (map char (increment-letter-code (mapv #(.charCodeAt % 0) lc)))))
  16. (def col-letters (iterate next-letter "A"))
  17. (defn get-datum [data c r]
  18. (some #(if (and (= c (:col %)) (= r (:row %))) %) data))
  19. (def parse-variables (memoize (fn [expression]
  20. (as-> (js->clj (.parse mathjs expression)) $
  21. (.filter $ #(true? (.-isSymbolNode %)))
  22. (map #(.-name %) $)
  23. (map #(.toUpperCase %) $)
  24. (filter #(re-matches #"[A-Z]+[0-9]+" %) $)))))
  25. (def str->rc (memoize (fn [s]
  26. (let [c (re-find #"^[A-Z]+" s)
  27. r (.parseInt js/window (re-find #"[0-9]+$" s))]
  28. {:row r :col c}))))
  29. (defn add-parsed-variables [datum]
  30. (if (= (first (:value datum)) "=")
  31. (let [vars (parse-variables (subs (:value datum) 1))
  32. refs (map str->rc vars)]
  33. (-> datum (assoc :vars vars) (assoc :refs refs) (dissoc :error)))
  34. (-> datum (dissoc :vars) (dissoc :refs) (dissoc :display) (dissoc :error))))
  35. (defn add-parsed-variables-to-specific-datum
  36. "Parse variables from the value of a datum and add in :vars and :refs (for swap! data-atom).
  37. If the value does not contain a fomula, remove any :vars and :refs that may have been there."
  38. [c r data] (map #(if (and (= (:col %) c) (= (:row %) r))
  39. (add-parsed-variables %)
  40. %) data))
  41. (def evaluate-expression (memoize (fn [expression variables]
  42. (try
  43. (.evaluate mathjs expression (clj->js variables))
  44. (catch js/Error e
  45. (println "mathjs evaluation error" (.-message e) e)
  46. :calc-error)))))
  47. ;TODO: deal with lowercase cell references
  48. (defn find-cell [data c r]
  49. (some #(if (and (= (:col %) c) (= (:row %) r)) %) data))
  50. (defn find-ref [data cell-ref]
  51. (some (fn [{:keys [row col] :as datum}] (if (and (= row (:row cell-ref)) (= col (:col cell-ref))) datum)) data))
  52. (defn copy-display-values [data display-values]
  53. (let [original (map #(dissoc % :dirty) data)
  54. removed (map #(-> % (dissoc :found) (dissoc :inputs) (dissoc :dirty)) display-values)]
  55. (into original removed)))
  56. ;TODO: memoize dynamically? probably not worth memoizing directly, and could take up too much memory over time
  57. ; https://stackoverflow.com/a/13123571/8172807
  58. (defn find-cycle
  59. ([data datum] (find-cycle data datum #{}))
  60. ([data datum ances]
  61. (let [cur {:row (:row datum) :col (:col datum)}
  62. this-and-above (conj ances cur)
  63. refs (:refs datum)
  64. found (not (empty? (clojure.set/intersection this-and-above (set refs))))]
  65. (if found
  66. :cycle-error
  67. (some (fn [cell]
  68. (find-cycle data (find-ref data cell) this-and-above)) refs)))))
  69. (defn find-val [data c r]
  70. (let [l (find-cell data c r)
  71. v (get l :display (get l :value))
  72. formula? (and (string? v) (= (first v) "="))]
  73. (cond
  74. (nil? v) 0
  75. ;(contains? l :error) :ref-error
  76. formula? :not-yet
  77. :else v)))
  78. ;TODO: ADD DOCSTRINGS TO ALL CONNECTED FUNCTIONS AND RENAME VARIABLES WHERE NEEDED
  79. ;TODO: figure out how to re-evaluate only when the cell modified affects other cells
  80. (defn re-evaluate [data]
  81. (println "re-evaluating" data)
  82. (let [{has-formula true original-values false} (group-by #(= (first (:value %)) "=") data)
  83. found-cycles (map #(let [found (find-cycle data %)] (if found (assoc % :error found) %)) has-formula)
  84. {eligible true ineligible false} (group-by #(not (contains? % :error)) found-cycles)]
  85. ;
  86. (loop [values (into original-values ineligible)
  87. mapped-cell-keys eligible]
  88. (let [search-values (map (fn [datum]
  89. (assoc datum :found (map #(find-val
  90. (concat values mapped-cell-keys)
  91. (:col %)
  92. (:row %))
  93. (:refs datum))))
  94. mapped-cell-keys)
  95. {not-ready true ready nil} (group-by (fn [datum]
  96. (some #(= :not-yet %) (:found datum)))
  97. search-values)
  98. prepped-for-eval (map (fn [datum]
  99. (let [hash-map-of-vars-to-vals (apply hash-map (interleave (:vars datum) (:found datum)))]
  100. (assoc datum :inputs hash-map-of-vars-to-vals)))
  101. ready)
  102. evaluated (map (fn [datum]
  103. (assoc datum :display (evaluate-expression
  104. (subs (:value datum) 1)
  105. (:inputs datum))))
  106. prepped-for-eval)
  107. updated-values (copy-display-values values evaluated)]
  108. (println "EVALUATED" evaluated)
  109. (if (nil? not-ready)
  110. updated-values
  111. (recur updated-values not-ready))))))