|
@@ -6,7 +6,20 @@
|
|
|
; 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)]
|
|
@@ -44,87 +57,241 @@
|
|
|
(-> 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))
|
|
|
+; 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))))
|
|
|
+
|
|
|
+; 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))
|
|
|
|
|
|
|
|
|
-(def evaluate-expression (memoize (fn [expression variables]
|
|
|
- (try
|
|
|
- (.evaluate mathjs expression (clj->js variables))
|
|
|
- (catch js/Error e
|
|
|
- (println "mathjs evaluation error" (.-message e) e)
|
|
|
- :calc-error)))))
|
|
|
+(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
|
|
|
+ "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? (clojure.set/intersection this-and-above (set inbound))))]
|
|
|
+ (if found-repeat
|
|
|
:cycle-error
|
|
|
- (some (fn [cell]
|
|
|
- (find-cycle data (find-ref data cell) this-and-above)) refs)))))
|
|
|
+ (some #(find-cycle data (:col %) (:row %) this-and-above) inbound)))))
|
|
|
|
|
|
-(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) "="))]
|
|
|
+
|
|
|
+(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
|
|
|
- (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))))))
|
|
|
+ (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? (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)))))))
|
|
|
+
|
|
|
|