|
@@ -8,6 +8,21 @@
|
|
|
|
|
|
(defn highest [dir data] (apply max (map dir data)))
|
|
(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]
|
|
(defn increment-letter-code [s]
|
|
(let [l (last s)]
|
|
(let [l (last s)]
|
|
(cond
|
|
(cond
|
|
@@ -44,6 +59,16 @@
|
|
(-> datum (assoc :vars vars) (assoc :refs refs) (dissoc :error)))
|
|
(-> datum (assoc :vars vars) (assoc :refs refs) (dissoc :error)))
|
|
(-> datum (dissoc :vars) (dissoc :refs) (dissoc :display) (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
|
|
(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).
|
|
"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."
|
|
If the value does not contain a fomula, remove any :vars and :refs that may have been there."
|
|
@@ -51,13 +76,104 @@
|
|
(add-parsed-variables %)
|
|
(add-parsed-variables %)
|
|
%) data))
|
|
%) 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))
|
|
|
|
|
|
-(def evaluate-expression (memoize (fn [expression variables]
|
|
+
|
|
- (try
|
|
+(defn create-all-back-references
|
|
- (.evaluate mathjs expression (clj->js variables))
|
|
+ "Assuming all references have been added, insert all back references."
|
|
- (catch js/Error e
|
|
+ [data]
|
|
- (println "mathjs evaluation error" (.-message e) e)
|
|
+ (loop [data data
|
|
- :calc-error)))))
|
|
+ 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))))))
|
|
|
|
+
|
|
|
|
+;TODO: change to recursive queue-based tree search
|
|
|
|
+(defn set-dirty-flag
|
|
|
|
+ "Determines if a datum needs to be marked as \"dirty\", based on value and inbound references. Returns datum with :dirty flag present or absent."
|
|
|
|
+ [datum]
|
|
|
|
+ (let [formula? (= (first (:value datum)) "=")
|
|
|
|
+ back-refs (:inbound datum)
|
|
|
|
+ back-refs? (not (empty? back-refs))]
|
|
|
|
+ (if (or formula? back-refs?)
|
|
|
|
+ (assoc datum :dirty true)
|
|
|
|
+ (dissoc datum :dirty))))
|
|
|
|
+
|
|
|
|
+(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)
|
|
|
|
+ parsed (add-references updated)]
|
|
|
|
+ (-> data
|
|
|
|
+ (assoc-in [c r :value] value)
|
|
|
|
+ (update-in [c r] set-dirty-flag)
|
|
|
|
+ (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
|
|
;TODO: deal with lowercase cell references
|
|
(defn find-cell [data c r]
|
|
(defn find-cell [data c r]
|
|
@@ -83,6 +199,47 @@
|
|
(some (fn [cell]
|
|
(some (fn [cell]
|
|
(find-cycle data (find-ref data cell) this-and-above)) refs)))))
|
|
(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."
|
|
|
|
+ ([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)
|
|
|
|
+ refs (:refs datum)
|
|
|
|
+ found-repeat (not (empty? (clojure.set/intersection this-and-above (set refs))))]
|
|
|
|
+ (if found-repeat
|
|
|
|
+ :cycle-error
|
|
|
|
+ (some #(alt-find-cycle data (:col %) (:row %) this-and-above) refs)))))
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+; THE NEW EVALUATE FUNCTION
|
|
|
|
+;TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO
|
|
|
|
+; - 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)
|
|
|
|
+; - TODO: modify alt-find-cycle to use back-references instead of forward references
|
|
|
|
+; - 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
|
|
|
|
+; - TODO: comment the code well
|
|
|
|
+#_(defn evaluate-from-cell
|
|
|
|
+ "Evaluate the final value of a cell, and recursively re-evaluate all the cells that reference it."
|
|
|
|
+ [data c r])
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+(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]
|
|
(defn find-val [data c r]
|
|
(let [l (find-cell data c r)
|
|
(let [l (find-cell data c r)
|
|
v (get l :display (get l :value))
|
|
v (get l :display (get l :value))
|