|
|
@@ -1,122 +1,12 @@
|
|
|
(ns microtables-frontend.evaluation
|
|
|
(:require
|
|
|
- ["mathjs" :as mathjs]
|
|
|
- [clojure.set :refer [intersection]]
|
|
|
- [clojure.string :as string]
|
|
|
- [microtables-frontend.utils.coordinates :as coords]))
|
|
|
+ [microtables-frontend.evaluation.impl :as impl]
|
|
|
+ [microtables-frontend.utils.data :as data-utils]))
|
|
|
|
|
|
; to add an npm package to shadow-cljs:
|
|
|
; https://clojureverse.org/t/guide-on-how-to-use-import-npm-modules-packages-in-clojurescript/2298
|
|
|
; https://shadow-cljs.github.io/docs/UsersGuide.html#npm
|
|
|
|
|
|
-(def range->commalist
|
|
|
- "Converts a range in \"A1:B2\" notation to a comma-separated list of cells: \"A1,A2,B1,B2\"."
|
|
|
- (memoize (fn [range-string]
|
|
|
- (let [cell-list (coords/parse-range range-string)
|
|
|
- strings (map #(str (:col %) (:row %)) cell-list)]
|
|
|
- (str "(" (string/join "," strings) ")")))))
|
|
|
-
|
|
|
-(def replace-ranges-in-expression
|
|
|
- "Receives an expression string, and replaces all ranges in colon notation (\"A1:B2\") into a comma-separated list of cells (\"A1,A2,B1,B2\")."
|
|
|
- (memoize (fn [expression]
|
|
|
- (string/replace expression #"\(\s*[A-Z]+[0-9]+\s*:\s*[A-Z]+[0-9]+\s*\)" range->commalist))))
|
|
|
-
|
|
|
-(defn- formula?
|
|
|
- "Determines if a value is a fomula.
|
|
|
- If it is, it returns it (without the leading equals sign).
|
|
|
- If not, it returns nil."
|
|
|
- [value]
|
|
|
- (if (= (first value) "=")
|
|
|
- (subs value 1)
|
|
|
- nil))
|
|
|
-
|
|
|
-(def parse-variables (memoize (fn [expression]
|
|
|
- (as-> (js->clj (.parse mathjs (replace-ranges-in-expression expression))) $
|
|
|
- (.filter $ #(true? (.-isSymbolNode %)))
|
|
|
- (map #(.-name %) $)
|
|
|
- (map #(.toUpperCase %) $)
|
|
|
- (filter #(re-matches #"[A-Z]+[0-9]+" %) $)))))
|
|
|
-
|
|
|
-(def str->rc (memoize (fn [s]
|
|
|
- (let [c (re-find #"^[A-Z]+" s)
|
|
|
- r (.parseInt js/window (re-find #"[0-9]+$" s))]
|
|
|
- {:row r :col c}))))
|
|
|
-
|
|
|
-; leave in the :inbound references, since they probably have not have changed
|
|
|
-(defn- add-references
|
|
|
- "Parses the expression in the value of a datum, and adds refs as necessary"
|
|
|
- [datum]
|
|
|
- (let [formula (formula? (:value datum))]
|
|
|
- (if formula
|
|
|
- (let [vars (parse-variables formula)
|
|
|
- refs (map str->rc vars)]
|
|
|
- (-> datum
|
|
|
- (assoc :refs refs)
|
|
|
- (dissoc :error)))
|
|
|
- (-> datum
|
|
|
- (dissoc :refs)
|
|
|
- (dissoc :display)
|
|
|
- (dissoc :error)))))
|
|
|
-
|
|
|
-; the references in the data are a set of disconnected, doubly-linked trees
|
|
|
-;TODO: rather than denotify all, then re-notify all, maybe use a diff? maybe on small scales it's not worth it?
|
|
|
-(defn- denotify-references
|
|
|
- "Remove references in all cells formerly referenced by this cell"
|
|
|
- [data origin refs]
|
|
|
- (if (empty? refs)
|
|
|
- data
|
|
|
- (let [target (first refs)
|
|
|
- de-notified (update-in data [(:col target) (:row target) :inbound] (partial filter #(not= % origin)))]
|
|
|
- (recur de-notified origin (rest refs)))))
|
|
|
-
|
|
|
-(defn- notify-references
|
|
|
- "Update references in all cells referenced by this cell"
|
|
|
- [data origin refs]
|
|
|
- (if (empty? refs)
|
|
|
- data
|
|
|
- (let [target (first refs)
|
|
|
- notified (update-in data [(:col target) (:row target) :inbound] conj origin)]
|
|
|
- (recur notified origin (rest refs)))))
|
|
|
-
|
|
|
-(defn create-all-references
|
|
|
- "Starting from a clean slate, add in all references.
|
|
|
- This wipes any references that may have been present."
|
|
|
- [data]
|
|
|
- (reduce-kv
|
|
|
- (fn [columns c curr-column]
|
|
|
- (assoc columns c (reduce-kv
|
|
|
- (fn [rows r datum]
|
|
|
- (assoc rows r (add-references (dissoc (dissoc datum :refs) :inbound))))
|
|
|
- {}
|
|
|
- curr-column)))
|
|
|
- {}
|
|
|
- data))
|
|
|
-
|
|
|
-;TODO: re-write create-all-references to use walk-modify-data instead
|
|
|
-(defn walk-modify-data
|
|
|
- "Walks through the data map and updates each datum by applying f (a function accepting col, row, datum)."
|
|
|
- [data f]
|
|
|
- (reduce-kv
|
|
|
- (fn [columns c curr-column]
|
|
|
- (assoc columns c (reduce-kv
|
|
|
- (fn [rows r datum]
|
|
|
- (assoc rows r (f c r datum)))
|
|
|
- {}
|
|
|
- curr-column)))
|
|
|
- {}
|
|
|
- data))
|
|
|
-
|
|
|
-(defn- walk-get-refs
|
|
|
- "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)."
|
|
|
- [data pred]
|
|
|
- (reduce-kv (fn [l c column]
|
|
|
- (->> column
|
|
|
- (filter (fn [[r datum]] (pred c r datum)))
|
|
|
- (map (fn [[r _]] {:col c :row r}))
|
|
|
- (concat l)))
|
|
|
- '()
|
|
|
- data))
|
|
|
-
|
|
|
; proposed alternative (the beginning of one) to walk-get-refs
|
|
|
;(defn col-map? [m] (and (map? m) (every? #(and (string? %) (re-matches #"[A-Z]+" %)) (keys m))))
|
|
|
;(defn row-map? [m] (and (map? m) (every? #(and (integer? %) (pos? %)) (keys m))))
|
|
|
@@ -126,136 +16,28 @@
|
|
|
"Assuming all references have been added, insert all back references."
|
|
|
[data]
|
|
|
(loop [data data
|
|
|
- formulas (walk-get-refs data #(formula? (:value %3)))]
|
|
|
+ formulas (data-utils/walk-get-refs data #(data-utils/formula? (:value %3)))]
|
|
|
(if (empty? formulas)
|
|
|
data
|
|
|
(let [origin (first formulas)
|
|
|
refs (get-in data [(:col origin) (:row origin) :refs])
|
|
|
- updated-one (notify-references data origin refs)]
|
|
|
+ updated-one (impl/notify-references data origin refs)]
|
|
|
(recur updated-one (rest formulas))))))
|
|
|
|
|
|
-(defn- set-dirty-flags
|
|
|
- "Sets the target cell to \"dirty\" and recursively repeat with its back-references all the way up.
|
|
|
- Returns the new data set."
|
|
|
- ([data c r]
|
|
|
- (set-dirty-flags data (list {:col c :row r})))
|
|
|
- ([data queue]
|
|
|
- (if (empty? queue)
|
|
|
- data
|
|
|
- (let [cur (first queue)
|
|
|
- c (:col cur)
|
|
|
- r (:row cur)
|
|
|
- datum (get-in data [c r])]
|
|
|
- (if (true? (:dirty datum))
|
|
|
- (recur data (rest queue))
|
|
|
- (let [new-data (assoc-in data [c r :dirty] true)
|
|
|
- new-queue (concat (rest queue) (:inbound datum))]
|
|
|
- (recur new-data new-queue)))))))
|
|
|
-
|
|
|
-(defn change-datum-value
|
|
|
- "Modify the value of a datum in the table, and update all applicable references"
|
|
|
- [data c r value]
|
|
|
- (let [datum (get-in data [c r])
|
|
|
- updated (assoc datum :value value)]
|
|
|
- (-> data
|
|
|
- (assoc-in [c r :value] value)
|
|
|
- (set-dirty-flags c r))))
|
|
|
-
|
|
|
(defn reset-references
|
|
|
"If there has been a change to which cells are referenced by this cell, then change the necessary back-references to this cell."
|
|
|
[data c r]
|
|
|
(let [datum (get-in data [c r])
|
|
|
- parsed (add-references datum)]
|
|
|
+ parsed (data-utils/add-references datum)]
|
|
|
(if (= (:refs datum) (:refs parsed))
|
|
|
data
|
|
|
(-> data
|
|
|
(assoc-in [c r] parsed)
|
|
|
- (denotify-references {:col c :row r} (:refs datum))
|
|
|
- (notify-references {:col c :row r} (:refs parsed))))))
|
|
|
-
|
|
|
-(defn- remove-valueless-range-elements
|
|
|
- "Remove nil values specifically from ranges (to solve issues with some functions like average)."
|
|
|
- [variables var-list]
|
|
|
- (let [l (string/split (string/replace (first var-list) #"[()]" "") #",")
|
|
|
- has-values (filter #(not (nil? (variables %))) l)]
|
|
|
- (str "(" (string/join "," has-values) ")")))
|
|
|
-
|
|
|
-(defn- preprocess-expression
|
|
|
- "Handle range cases, rename certain functions (to work with math.js), prepare expression and variables for processing."
|
|
|
- [expression variables]
|
|
|
- (let [renamed-expression (string/replace expression #"\baverage\(" "mean(")
|
|
|
- new-expression (string/replace renamed-expression
|
|
|
- #"\(([A-Z]+[0-9]+,)*[A-Z]+[0-9]+\)"
|
|
|
- (partial remove-valueless-range-elements variables))
|
|
|
- new-variables (reduce-kv #(assoc %1 %2 (if (nil? %3) "0" %3)) {} variables)]
|
|
|
- (println "PREPROCESS" {:expression new-expression :variables new-variables})
|
|
|
- {:expression new-expression
|
|
|
- :variables new-variables}))
|
|
|
-
|
|
|
-(def evaluate-expression
|
|
|
- "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."
|
|
|
- (memoize (fn [expression variables]
|
|
|
- (let [range-replaced (replace-ranges-in-expression expression)
|
|
|
- {ready-expression :expression
|
|
|
- ready-variables :variables} (preprocess-expression range-replaced variables)]
|
|
|
- (try
|
|
|
- (.evaluate mathjs ready-expression (clj->js ready-variables))
|
|
|
- (catch js/Error e
|
|
|
- (println "mathjs evaluation error" (.-message e) e)
|
|
|
- :calc-error))))))
|
|
|
+ (impl/denotify-references {:col c :row r} (:refs datum))
|
|
|
+ (impl/notify-references {:col c :row r} (:refs parsed))))))
|
|
|
|
|
|
;TODO: deal with lowercase cell references
|
|
|
|
|
|
-;TODO: memoize dynamically? probably not worth memoizing directly, and could take up too much memory over time
|
|
|
-; https://stackoverflow.com/a/13123571/8172807
|
|
|
-(defn- find-cycle
|
|
|
- "Accepts the data and a datum, and peforms a depth-first search to find reference cycles, following back-references."
|
|
|
- ([data c r] (find-cycle data c r #{}))
|
|
|
- ([data c r ancest]
|
|
|
- (let [datum (get-in data [c r])
|
|
|
- current {:col c :row r}
|
|
|
- this-and-above (conj ancest current)
|
|
|
- inbound (:inbound datum)
|
|
|
- found-repeat (not (empty? (intersection this-and-above (set inbound))))]
|
|
|
- (if found-repeat
|
|
|
- :cycle-error
|
|
|
- (some #(find-cycle data (:col %) (:row %) this-and-above) inbound)))))
|
|
|
-
|
|
|
-(defn- gather-variables-and-evaluate-cell
|
|
|
- "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."
|
|
|
- [data c r]
|
|
|
- (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)
|
|
|
- refs (:refs datum)
|
|
|
- value (:value datum)
|
|
|
- formula (formula? value)
|
|
|
- resolved-refs (map #(merge % (get-in data [(:col %) (:row %)])) refs)
|
|
|
- evaluated-refs (map #(if (formula? (:value %)) (:display %) (:value %)) resolved-refs)
|
|
|
- invalid-refs (some nil? resolved-refs)
|
|
|
- dirty-refs (some :dirty resolved-refs)
|
|
|
- error-refs (some #(= (:display %) :error) resolved-refs)
|
|
|
- ;unevaluated-refs (some nil? evaluated-refs)
|
|
|
- cycle-refs (some #(= (:display %) :cycle-error) resolved-refs)
|
|
|
- disqualified? (or invalid-refs dirty-refs error-refs)]
|
|
|
- (cond
|
|
|
- (not formula) (assoc-in data [c r] datum) ; if it's not a formula, then return as is (with the dirty flag removed)
|
|
|
- cycle-refs (-> data ; if one of its references has a reference cycle, then this one is "poisoned" as well
|
|
|
- (assoc-in [c r] datum)
|
|
|
- (assoc-in [c r :display] :cycle-error))
|
|
|
- ;unevaluated-refs (assoc-in data [c r :display] :insufficient-data) ; do not un-mark as "dirty", since it has not been evaluated yet
|
|
|
- disqualified? (-> data ; some other error is present
|
|
|
- (assoc-in [c r] datum)
|
|
|
- (assoc-in [c r :display] :error))
|
|
|
- (empty? refs) (-> data
|
|
|
- (assoc-in [c r] datum)
|
|
|
- (assoc-in [c r :display] (evaluate-expression (subs value 1) {})))
|
|
|
- :else (let [variables (zipmap (map #(str (:col %) (:row %)) refs) evaluated-refs)
|
|
|
- evaluated-value (evaluate-expression (subs value 1) variables)
|
|
|
- new-datum (assoc datum :display evaluated-value)]
|
|
|
- (assoc-in data [c r] new-datum)))))
|
|
|
-
|
|
|
; THE NEW EVALUATE FUNCTION
|
|
|
; - 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)
|
|
|
; - 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)
|
|
|
@@ -267,12 +49,12 @@
|
|
|
(defn evaluate-from-cell
|
|
|
"Evaluate the final value of a cell, and recursively re-evaluate all the cells that reference it."
|
|
|
[data c r]
|
|
|
- (let [cycles? (find-cycle data c r)
|
|
|
+ (let [cycles? (impl/find-cycle data c r)
|
|
|
new-data (if cycles?
|
|
|
(-> 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
|
|
|
(update-in [c r] dissoc :dirty)
|
|
|
(assoc-in [c r :display] :cycle-error))
|
|
|
- (gather-variables-and-evaluate-cell data c r))] ; if there are no cycles, evaluate the cell
|
|
|
+ (impl/gather-variables-and-evaluate-cell data c r))] ; if there are no cycles, evaluate the cell
|
|
|
(loop [data new-data
|
|
|
queue (get-in new-data [c r :inbound])]
|
|
|
(if (empty? queue)
|
|
|
@@ -282,7 +64,7 @@
|
|
|
cr (:row current)
|
|
|
dirty? (get-in data [cc cr :dirty])
|
|
|
re-evaluated-data (if dirty?
|
|
|
- (gather-variables-and-evaluate-cell data cc cr)
|
|
|
+ (impl/gather-variables-and-evaluate-cell data cc cr)
|
|
|
data)
|
|
|
sufficient? (not= (get-in re-evaluated-data [cc cr :display]) :insufficient-data)
|
|
|
new-queue (if dirty?
|
|
|
@@ -297,7 +79,7 @@
|
|
|
"Evaluates all cells marked as \"dirty\".
|
|
|
Generally reserved for the initialization."
|
|
|
([data]
|
|
|
- (evaluate-all data (walk-get-refs data #(:dirty %3))))
|
|
|
+ (evaluate-all data (data-utils/walk-get-refs data #(:dirty %3))))
|
|
|
([data queue]
|
|
|
(if (empty? queue)
|
|
|
data
|
Brandon Wong