utils.cljs 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363
  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-col
  8. "Return the highest column (letter) for which there is a non-empty cell"
  9. [data]
  10. ; choose the "max" (alphabetical order) value among the longest keys
  11. (apply max (val (apply max-key key (group-by #(.-length %) (keys data))))))
  12. (defn highest-row
  13. "Return the highest row (number) for which there is a non-empty cell"
  14. [data]
  15. ; get all the row keys from all the column objects (and flatten), then pick the max
  16. (apply max (flatten (map keys (vals data)))))
  17. (defn increment-letter-code [s]
  18. (let [l (last s)]
  19. (cond
  20. (empty? s) [65]
  21. (= l 90) (conj (increment-letter-code (subvec s 0 (dec (count s)))) 65)
  22. :else (conj (subvec s 0 (dec (count s))) (inc l)))))
  23. (defn next-letter [lc]
  24. (apply str (map char (increment-letter-code (mapv #(.charCodeAt % 0) lc)))))
  25. (def col-letters (iterate next-letter "A"))
  26. (defn order-two-cols
  27. "Accepts two column names (letters) and returns them in order."
  28. [col1 col2]
  29. (cond
  30. (> (.-length col1) (.-length col2)) [col2 col1]
  31. (> (.-length col2) (.-length col1)) [col1 col2]
  32. (= (max col1 col2) col1) [col2 col1]
  33. :else [col1 col2]))
  34. (defn range->list
  35. "Converts two cells (accepting four coordinates) into a list of all the cells in the range between them (inclusively)."
  36. [col1 row1 col2 row2]
  37. (let [[start-col end-col] (order-two-cols col1 col2)
  38. start-row (min row1 row2)
  39. end-row (max row1 row2)]
  40. (for [col (take-while #(not= (next-letter end-col) %) (iterate next-letter start-col))
  41. row (range start-row (inc end-row))]
  42. {:col col :row row})))
  43. ; the order goes top to bottom, then left to right - that makes the most sense to me
  44. ; I don't know why a different order would be important, or even in what situation order is important at all
  45. (defn parse-range
  46. "Converts a range in \"A1:B2\" notation to a list of col/row cells: {:col \"A\" :row 1}, etc."
  47. [range-string]
  48. (let [col1 (second (re-find #"\(\s*([A-Z]+)" range-string))
  49. col2 (second (re-find #":\s*([A-Z]+)" range-string))
  50. row1 (.parseInt js/window (second (re-find #"([0-9]+)\s*:" range-string)))
  51. row2 (.parseInt js/window (second (re-find #"([0-9]+)\s*\)" range-string)))]
  52. (range->list col1 row1 col2 row2)))
  53. (def range->commalist
  54. "Converts a range in \"A1:B2\" notation to a comma-separated list of cells: \"A1,A2,B1,B2\"."
  55. (memoize (fn [range-string]
  56. (let [cell-list (parse-range range-string)
  57. strings (map #(str (:col %) (:row %)) cell-list)]
  58. (str "(" (clojure.string/join "," strings) ")")))))
  59. (def replace-ranges-in-expression
  60. "Receives an expression string, and replaces all ranges in colon notation (\"A1:B2\") into a comma-separated list of cells (\"A1,A2,B1,B2\")."
  61. (memoize (fn [expression]
  62. (clojure.string/replace expression #"\(\s*[A-Z]+[0-9]+\s*:\s*[A-Z]+[0-9]+\s*\)" range->commalist))))
  63. (defn formula?
  64. "Determines if a value is a fomula. If it is, it returns it (without the leading equals sign. If not, it returns nil."
  65. [value]
  66. (if (= (first value) "=")
  67. (subs value 1)
  68. nil))
  69. (def parse-variables (memoize (fn [expression]
  70. (as-> (js->clj (.parse mathjs (replace-ranges-in-expression expression))) $
  71. (.filter $ #(true? (.-isSymbolNode %)))
  72. (map #(.-name %) $)
  73. (map #(.toUpperCase %) $)
  74. (filter #(re-matches #"[A-Z]+[0-9]+" %) $)))))
  75. (def str->rc (memoize (fn [s]
  76. (let [c (re-find #"^[A-Z]+" s)
  77. r (.parseInt js/window (re-find #"[0-9]+$" s))]
  78. {:row r :col c}))))
  79. ; leave in the :inbound references, since they probably have not have changed
  80. (defn add-references
  81. "Parses the expression in the value of a datum, and adds refs as necessary"
  82. [datum]
  83. (let [formula (formula? (:value datum))]
  84. (if formula
  85. (let [vars (parse-variables formula)
  86. refs (map str->rc vars)]
  87. (-> datum
  88. (assoc :refs refs)
  89. (dissoc :error)))
  90. (-> datum
  91. (dissoc :refs)
  92. (dissoc :display)
  93. (dissoc :error)))))
  94. ; the references in the data are a set of disconnected, doubly-linked trees
  95. ;TODO: rather than denotify all, then re-notify all, maybe use a diff? maybe on small scales it's not worth it?
  96. (defn denotify-references
  97. "Remove references in all cells formerly referenced by this cell"
  98. [data origin refs]
  99. (if (empty? refs)
  100. data
  101. (let [target (first refs)
  102. de-notified (update-in data [(:col target) (:row target) :inbound] (partial filter #(not= % origin)))]
  103. (recur de-notified origin (rest refs)))))
  104. (defn notify-references
  105. "Update references in all cells referenced by this cell"
  106. [data origin refs]
  107. (if (empty? refs)
  108. data
  109. (let [target (first refs)
  110. notified (update-in data [(:col target) (:row target) :inbound] conj origin)]
  111. (recur notified origin (rest refs)))))
  112. (defn create-all-references
  113. "Starting from a clean slate, add in all references. This wipes any references that may have been present."
  114. [data]
  115. (reduce-kv
  116. (fn [columns c curr-column]
  117. (assoc columns c (reduce-kv
  118. (fn [rows r datum]
  119. (assoc rows r (add-references (dissoc (dissoc datum :refs) :inbound))))
  120. {}
  121. curr-column)))
  122. {}
  123. data))
  124. ;TODO: re-write create-all-references to use walk-modify-data instead
  125. (defn walk-modify-data
  126. "Walks through the data map and updates each datum by applying f (a function accepting col, row, datum)."
  127. [data f]
  128. (reduce-kv
  129. (fn [columns c curr-column]
  130. (assoc columns c (reduce-kv
  131. (fn [rows r datum]
  132. (assoc rows r (f c r datum)))
  133. {}
  134. curr-column)))
  135. {}
  136. data))
  137. (defn walk-get-refs
  138. "Walks through the data map and returns a list of :col/:row maps for each cell which satisfies the predicate (a function accepting col, row, datum)."
  139. [data pred]
  140. (reduce-kv (fn [l c column] (concat l (map (fn [[r _]] {:col c :row r}) (filter (fn [[r datum]] (pred c r datum)) column)))) '() data))
  141. ; proposed alternative (the beginning of one) to walk-get-refs
  142. ;(defn col-map? [m] (and (map? m) (every? #(and (string? %) (re-matches #"[A-Z]+" %)) (keys m))))
  143. ;(defn row-map? [m] (and (map? m) (every? #(and (integer? %) (pos? %)) (keys m))))
  144. ;(defn get-all-cells [data] (filter #(not (or (col-map? %) (row-map? %))) (tree-seq #(and (map? %) (or (col-map? %) (row-map? %))) vals data)))
  145. (defn create-all-back-references
  146. "Assuming all references have been added, insert all back references."
  147. [data]
  148. (loop [data data
  149. formulas (walk-get-refs data #(formula? (:value %3)))]
  150. (if (empty? formulas)
  151. data
  152. (let [origin (first formulas)
  153. refs (get-in data [(:col origin) (:row origin) :refs])
  154. updated-one (notify-references data origin refs)]
  155. (recur updated-one (rest formulas))))))
  156. (defn set-dirty-flags
  157. "Sets the target cell to \"dirty\" and recursively repeat with its back-references all the way up. Returns the new data set."
  158. ([data c r]
  159. (set-dirty-flags data (list {:col c :row r})))
  160. ([data queue]
  161. (if (empty? queue)
  162. data
  163. (let [cur (first queue)
  164. c (:col cur)
  165. r (:row cur)
  166. datum (get-in data [c r])]
  167. (if (true? (:dirty datum))
  168. (recur data (rest queue))
  169. (let [new-data (assoc-in data [c r :dirty] true)
  170. new-queue (concat (rest queue) (:inbound datum))]
  171. (recur new-data new-queue)))))))
  172. (defn change-datum-value
  173. "Modify the value of a datum in the table, and update all applicable references"
  174. [data c r value]
  175. (let [datum (get-in data [c r])
  176. updated (assoc datum :value value)]
  177. (-> data
  178. (assoc-in [c r :value] value)
  179. (set-dirty-flags c r))))
  180. (defn reset-references
  181. "If there has been a change to which cells are referenced by this cell, then change the necessary back-references to this cell."
  182. [data c r]
  183. (let [datum (get-in data [c r])
  184. parsed (add-references datum)]
  185. (if (= (:refs datum) (:refs parsed))
  186. data
  187. (-> data
  188. (assoc-in [c r] parsed)
  189. (denotify-references {:col c :row r} (:refs datum))
  190. (notify-references {:col c :row r} (:refs parsed))))))
  191. (defn remove-valueless-range-elements
  192. "Remove nil values specifically from ranges (to solve issues with some functions like average)."
  193. [variables var-list]
  194. (let [l (clojure.string/split (clojure.string/replace (first var-list) #"[()]" "") #",")
  195. has-values (filter #(not (nil? (variables %))) l)]
  196. (str "(" (clojure.string/join "," has-values) ")")))
  197. (defn preprocess-expression
  198. "Handle range cases, rename certain functions (to work with math.js), prepare expression and variables for processing."
  199. [expression variables]
  200. (let [renamed-expression (clojure.string/replace expression #"\baverage\(" "mean(")
  201. new-expression (clojure.string/replace renamed-expression #"\(([A-Z]+[0-9]+,)*[A-Z]+[0-9]+\)" (partial remove-valueless-range-elements variables))
  202. new-variables (reduce-kv #(assoc %1 %2 (if (nil? %3) "0" %3)) {} variables)]
  203. (println "PREPROCESS" {:expression new-expression :variables new-variables})
  204. {:expression new-expression
  205. :variables new-variables}))
  206. (def evaluate-expression
  207. "Convert (via mathjs) an expression string to a final answer (also a string). A map of variables must also be provided. If there is an error, it will return :calc-error."
  208. (memoize (fn [expression variables]
  209. (let [range-replaced (replace-ranges-in-expression expression)
  210. {ready-expression :expression ready-variables :variables} (preprocess-expression range-replaced variables)]
  211. (try
  212. (.evaluate mathjs ready-expression (clj->js ready-variables))
  213. (catch js/Error e
  214. (println "mathjs evaluation error" (.-message e) e)
  215. :calc-error))))))
  216. ;TODO: deal with lowercase cell references
  217. ;TODO: memoize dynamically? probably not worth memoizing directly, and could take up too much memory over time
  218. ; https://stackoverflow.com/a/13123571/8172807
  219. (defn find-cycle
  220. "Accepts the data and a datum, and peforms a depth-first search to find reference cycles, following back-references."
  221. ([data c r] (find-cycle data c r #{}))
  222. ([data c r ancest]
  223. (let [datum (get-in data [c r])
  224. current {:col c :row r}
  225. this-and-above (conj ancest current)
  226. inbound (:inbound datum)
  227. found-repeat (not (empty? (clojure.set/intersection this-and-above (set inbound))))]
  228. (if found-repeat
  229. :cycle-error
  230. (some #(find-cycle data (:col %) (:row %) this-and-above) inbound)))))
  231. (defn gather-variables-and-evaluate-cell
  232. "Assumes that all the cell's immediate references have been resolved. Collects the final values from them, then evaluates the current cell's expression. Returns the new data map."
  233. [data c r]
  234. (let [datum (dissoc (dissoc (get-in data [c r]) :dirty) :display) ; get rid of the dirty flag right away (it must be included with the returned data to have effect)
  235. refs (:refs datum)
  236. value (:value datum)
  237. formula (formula? value)
  238. resolved-refs (map #(merge % (get-in data [(:col %) (:row %)])) refs)
  239. evaluated-refs (map #(if (formula? (:value %)) (:display %) (:value %)) resolved-refs)
  240. invalid-refs (some nil? resolved-refs)
  241. dirty-refs (some :dirty resolved-refs)
  242. error-refs (some #(= (:display %) :error) resolved-refs)
  243. ;unevaluated-refs (some nil? evaluated-refs)
  244. cycle-refs (some #(= (:display %) :cycle-error) resolved-refs)
  245. disqualified? (or invalid-refs dirty-refs error-refs)]
  246. (cond
  247. (not formula) (assoc-in data [c r] datum) ; if it's not a formula, then return as is (with the dirty flag removed)
  248. cycle-refs (-> data ; if one of its references has a reference cycle, then this one is "poisoned" as well
  249. (assoc-in [c r] datum)
  250. (assoc-in [c r :display] :cycle-error))
  251. ;unevaluated-refs (assoc-in data [c r :display] :insufficient-data) ; do not un-mark as "dirty", since it has not been evaluated yet
  252. disqualified? (-> data ; some other error is present
  253. (assoc-in [c r] datum)
  254. (assoc-in [c r :display] :error))
  255. (empty? refs) (-> data
  256. (assoc-in [c r] datum)
  257. (assoc-in [c r :display] (evaluate-expression (subs value 1) {})))
  258. :else (let [variables (zipmap (map #(str (:col %) (:row %)) refs) evaluated-refs)
  259. evaluated-value (evaluate-expression (subs value 1) variables)
  260. new-datum (assoc datum :display evaluated-value)]
  261. (assoc-in data [c r] new-datum)))))
  262. ; THE NEW EVALUATE FUNCTION
  263. ; - check for cycles in the back references, starting from the target cell (if any, use another function to mark it and its back references with :cycle-error and remove :dirty)
  264. ; - if any of the forward references are dirty, mark the cell (and recurse up) with an error (and set a TODO to think about this further)
  265. ; - evaluate (using forward references if necessary)
  266. ; - add all back-references to the queue
  267. ; - recurse
  268. ; - TODO: consider initialization case
  269. ; - TODO: consider multiple cells modified simultaneously
  270. (defn evaluate-from-cell
  271. "Evaluate the final value of a cell, and recursively re-evaluate all the cells that reference it."
  272. [data c r]
  273. (let [cycles? (find-cycle data c r)
  274. new-data (if cycles?
  275. (-> data ; if there are cycles, mark :cycle-error and remove :dirty (rathan than evaluate) - still need to recurse up the tree to mark dependents with :cycle-error
  276. (update-in [c r] dissoc :dirty)
  277. (assoc-in [c r :display] :cycle-error))
  278. (gather-variables-and-evaluate-cell data c r))] ; if there are no cycles, evaluate the cell
  279. (loop [data new-data
  280. queue (get-in new-data [c r :inbound])]
  281. (if (empty? queue)
  282. data ; if the queue is empty, we're done
  283. (let [current (first queue)
  284. cc (:col current)
  285. cr (:row current)
  286. dirty? (get-in data [cc cr :dirty])
  287. re-evaluated-data (if dirty?
  288. (gather-variables-and-evaluate-cell data cc cr)
  289. data)
  290. sufficient? (not= (get-in re-evaluated-data [cc cr :display]) :insufficient-data)
  291. new-queue (if dirty?
  292. (if sufficient?
  293. (concat (rest queue) (get-in re-evaluated-data [cc cr :inbound])) ; if all is well, then add the back-references onto the queue
  294. (concat (rest queue) (list current))) ; if the current cell's dependencies are not satisfied, re-add to the end of the queue
  295. (rest queue))] ; if the current cell is not marked as dirty, then it has already been processed
  296. (recur re-evaluated-data new-queue))))))
  297. ;TODO: does this need a cycle check?
  298. (defn evaluate-all
  299. "Evaluates all cells marked as \"dirty\". Generally reserved for the initialization."
  300. ([data]
  301. (evaluate-all data (walk-get-refs data #(:dirty %3))))
  302. ([data queue]
  303. (if (empty? queue)
  304. data
  305. (let [cur (first queue)
  306. cc (:col cur)
  307. cr (:row cur)
  308. dirty? (get-in data [cc cr :dirty])]
  309. (if dirty?
  310. (let [evaluated (evaluate-from-cell data (:col cur) (:row cur))
  311. result (get-in evaluated [cc cr :display])]
  312. (if (= result :insufficient-data)
  313. (recur data (concat (rest queue) (list cur)))
  314. (recur evaluated (rest queue))))
  315. (recur data (rest queue)))))))