(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)) (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))))))) (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))))) ; 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)))))) ;TODO: does this need a cycle check? (defn evaluate-all "Evaluates all cells marked as \"dirty\". Generally reserved for the initialization." ([data] (evaluate-all data (walk-get-refs data #(:dirty %3)))) ([data queue] (if (empty? queue) data (let [cur (first queue) cc (:col cur) cr (:row cur) dirty? (get-in data [cc cr :dirty])] (if dirty? (let [evaluated (evaluate-from-cell data (:col cur) (:row cur)) result (get-in evaluated [cc cr :display])] (if (= result :insufficient-data) (recur data (concat (rest queue) (list cur))) (recur evaluated (rest queue)))) (recur data (rest queue))))))) (evaluate-all (walk-modify-data (:alt-table-data microtables-frontend.db/default-db) (fn [c r datum] (if (= (first (:value datum)) "=") (assoc datum :dirty true) datum)))) #_(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))) (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))))))