123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370 |
- (ns microtables-frontend.utils
- (:require
- ["mathjs" :as mathjs]))
- ; 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
- (defn highest [dir data] (apply max (map dir data)))
- (defn highest-col
- "Return the highest column (letter) for which there is a non-empty cell"
- [data]
- ; choose the "max" (alphabetical order) value among the longest keys
- (apply max (val (apply max-key key (group-by #(.-length %) (keys data))))))
- (defn highest-row
- "Return the highest row (number) for which there is a non-empty cell"
- [data]
- ; get all the row keys from all the column objects (and flatten), then pick the max
- (apply max (flatten (map keys (vals data)))))
- (defn increment-letter-code [s]
- (let [l (last s)]
- (cond
- (empty? s) [65]
- (= l 90) (conj (increment-letter-code (subvec s 0 (dec (count s)))) 65)
- :else (conj (subvec s 0 (dec (count s))) (inc l)))))
- (defn next-letter [lc]
- (apply str (map char (increment-letter-code (mapv #(.charCodeAt % 0) lc)))))
- (def col-letters (iterate next-letter "A"))
- (defn get-datum [data c r]
- (some #(if (and (= c (:col %)) (= r (:row %))) %) data))
- (def parse-variables (memoize (fn [expression]
- (as-> (js->clj (.parse mathjs 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}))))
- (defn add-parsed-variables [datum]
- (if (= (first (:value datum)) "=")
- (let [vars (parse-variables (subs (:value datum) 1))
- refs (map str->rc vars)]
- (-> datum (assoc :vars vars) (assoc :refs refs) (dissoc :error)))
- (-> datum (dissoc :vars) (dissoc :refs) (dissoc :display) (dissoc :error))))
- ; 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 vars and refs as necessary"
- [datum]
- (if (= (first (:value datum)) "=")
- (let [vars (parse-variables (subs (:value datum) 1))
- refs (map str->rc vars)]
- (-> datum
- (assoc :vars vars)
- (assoc :refs refs)
- (dissoc :error)))
- (-> datum
- (dissoc :vars)
- (dissoc :refs)
- (dissoc :display)
- (dissoc :error))))
- (defn add-parsed-variables-to-specific-datum
- "Parse variables from the value of a datum and add in :vars and :refs (for swap! data-atom).
- If the value does not contain a fomula, remove any :vars and :refs that may have been there."
- [c r data] (map #(if (and (= (:col %) c) (= (:row %) r))
- (add-parsed-variables %)
- %) data))
- ; 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))
- ;(create-all-back-references (create-all-references {"A" {1 {:value "=B2"}} "B" {2 {:value "=B3"} 3 {:value "=A1"}}}))
- ;(= (walk-modify-data (:alt-table-data microtables-frontend.db/default-db) #(-> %3 (dissoc :refs) (dissoc :inbound) (add-references))) (walk-modify-data (:alt-table-data microtables-frontend.db/default-db) #(add-references (dissoc (dissoc %3 :refs) :inbound))) (create-all-references (:alt-table-data microtables-frontend.db/default-db)))
- (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] (concat l (map (fn [[r _]] {:col c :row r}) (filter (fn [[r datum]] (pred c r datum)) column)))) '() data))
- (defn create-all-back-references
- "Assuming all references have been added, insert all back references."
- [data]
- (loop [data data
- formulas (walk-get-refs data #(= (first (: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)]
- (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)))))))
- ;(walk-get-refs (set-dirty-flags (create-all-back-references (create-all-references (:alt-table-data microtables-frontend.db/default-db))) "C" 5) #(true? (:dirty %3)))
- (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)]
- (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))))))
- (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]
- (try
- (.evaluate mathjs expression (clj->js variables))
- (catch js/Error e
- (println "mathjs evaluation error" (.-message e) e)
- :calc-error)))))
- ;TODO: deal with lowercase cell references
- (defn find-cell [data c r]
- (some #(if (and (= (:col %) c) (= (:row %) r)) %) data))
- (defn find-ref [data cell-ref]
- (some (fn [{:keys [row col] :as datum}] (if (and (= row (:row cell-ref)) (= col (:col cell-ref))) datum)) data))
- (defn copy-display-values [data display-values]
- (let [original (map #(dissoc % :dirty) data)
- removed (map #(-> % (dissoc :found) (dissoc :inputs) (dissoc :dirty)) display-values)]
- (into original removed)))
- ;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
- ([data datum] (find-cycle data datum #{}))
- ([data datum ances]
- (let [cur {:row (:row datum) :col (:col datum)}
- this-and-above (conj ances cur)
- refs (:refs datum)
- found (not (empty? (clojure.set/intersection this-and-above (set refs))))]
- (if found
- :cycle-error
- (some (fn [cell]
- (find-cycle data (find-ref data cell) this-and-above)) refs)))))
- (defn alt-find-cycle
- "Accepts the data and a datum, and peforms a depth-first search to find reference cycles, following back-references."
- ([data c r] (alt-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? (clojure.set/intersection this-and-above (set inbound))))]
- (if found-repeat
- :cycle-error
- (some #(alt-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? (= (first value) "=")
- resolved-refs (map #(merge % (get-in data [(:col %) (:row %)])) refs)
- evaluated-refs (map #(if (= (first (:value %)) "=") (:display %) (:value % "0")) 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
- (false? 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)))))
- ;(time (gather-variables-and-evaluate-cell {"A" {1 {:value "=A2 + 4" :refs '({:col "A" :row 2})} 2 {:value "2"}}} "A" 1))
- ;(time (gather-variables-and-evaluate-cell (create-all-back-references (create-all-references (:alt-table-data microtables-frontend.db/default-db))) "B" 7))
- ;(time (set-dirty-flags (create-all-back-references (create-all-references (:alt-table-data microtables-frontend.db/default-db))) "B" 7))
- ;(zipmap (map #(str (:col %) (:row %)) (list {:col "A" :row 1} {:col "A" :row 2} {:col "A" :row 3} {:col "A" :row 4})) (list 1 3 5 7))
- ; 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)
- ; - evaluate (using forward references if necessary)
- ; - add all back-references to the queue
- ; - recurse
- ; - TODO: consider initialization case
- ; - TODO: consider multiple cells modified simultaneously
- (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? (alt-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
- (loop [data new-data
- queue (get-in new-data [c r :inbound])]
- (if (empty? queue)
- data ; if the queue is empty, we're done
- (let [current (first queue)
- cc (:col current)
- cr (:row current)
- dirty? (get-in data [cc cr :dirty])
- re-evaluated-data (if dirty?
- (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?
- (if sufficient?
- (concat (rest queue) (get-in re-evaluated-data [cc cr :inbound])) ; if all is well, then add the back-references onto the queue
- (concat (rest queue) (list current))) ; if the current cell's dependencies are not satisfied, re-add to the end of the queue
- (rest queue))] ; if the current cell is not marked as dirty, then it has already been processed
- (recur re-evaluated-data new-queue))))))
- (defn alt-re-evaluate
- "Evaluate the values of cells that contain formulae, following reference chains if applicable."
- [data]
- (let [non-empty-cells (flatten (map (fn [[c v]] (map (fn [[r _]] {:col c :row r}) v)) data))
- {has-formula true original-values false} (group-by #(= (first (get-in data [(:col %) (:row %) :value])) "=") non-empty-cells)
- found-cycles (map #(let [found (alt-find-cycle data (:col %) (:row %))]
- (if found (assoc % :error found) %)) has-formula)]
- non-empty-cells))
- (defn find-val [data c r]
- (let [l (find-cell data c r)
- v (get l :display (get l :value))
- formula? (and (string? v) (= (first v) "="))]
- (cond
- (nil? v) 0
- ;(contains? l :error) :ref-error
- formula? :not-yet
- :else v)))
- ;TODO: ADD DOCSTRINGS TO ALL CONNECTED FUNCTIONS AND RENAME VARIABLES WHERE NEEDED
- ;TODO: figure out how to re-evaluate only when the cell modified affects other cells
- (defn re-evaluate [data]
- (println "re-evaluating" data)
- (let [{has-formula true original-values false} (group-by #(= (first (:value %)) "=") data)
- found-cycles (map #(let [found (find-cycle data %)] (if found (assoc % :error found) %)) has-formula)
- {eligible true ineligible false} (group-by #(not (contains? % :error)) found-cycles)]
- ;
- (loop [values (into original-values ineligible)
- mapped-cell-keys eligible]
- (let [search-values (map (fn [datum]
- (assoc datum :found (map #(find-val
- (concat values mapped-cell-keys)
- (:col %)
- (:row %))
- (:refs datum))))
- mapped-cell-keys)
- {not-ready true ready nil} (group-by (fn [datum]
- (some #(= :not-yet %) (:found datum)))
- search-values)
- prepped-for-eval (map (fn [datum]
- (let [hash-map-of-vars-to-vals (apply hash-map (interleave (:vars datum) (:found datum)))]
- (assoc datum :inputs hash-map-of-vars-to-vals)))
- ready)
- evaluated (map (fn [datum]
- (assoc datum :display (evaluate-expression
- (subs (:value datum) 1)
- (:inputs datum))))
- prepped-for-eval)
- updated-values (copy-display-values values evaluated)]
- (println "EVALUATED" evaluated)
- (if (nil? not-ready)
- updated-values
- (recur updated-values not-ready))))))
|