4 Commits b192e77a4d ... 8c5a4e369c

Author SHA1 Message Date
  Brandon Wong 8c5a4e369c removed old list-based data table and associated functions 4 years ago
  Brandon Wong 95e2c100c5 added initialization evaluation step 4 years ago
  Brandon Wong 9085ec55ab restored basic cell evaluation with simple references 4 years ago
  Brandon Wong 74e21b7631 WIP: attempting to refactor the table data (and all associated functions) to a map structure 4 years ago

+ 14 - 16
frontend/src/cljs/microtables_frontend/db.cljs

@@ -5,20 +5,18 @@
    ;TODO: add "start" and "end" corners as selection
    :position {:cursor nil
               :selection nil}
-   :table-data [{:row 1 :col "A" :value "59"}
-                {:row 5 :col "C" :value "269"}
-                {:row 4 :col "B" :value "7893"}
-                {:row 2 :col "F" :value "8650"}
-                {:row 6 :col "D" :value "4065"}
-                {:row 7 :col "F" :value "5316"}
-                {:row 12 :col "A" :value "2405"}
-                {:row 5 :col "B" :value "7863"}
-                {:row 9 :col "E" :value "3144"}
-                {:row 10 :col "D" :value "8272"}
-                {:row 11 :col "D" :value "2495"}
-                {:row 15 :col "E" :value "8968"}
-                {:row 7 :col "B" :value "=C5 + D6"}
-                {:row 8 :col "B" :value "=B7 * 2"}
-                {:row 7 :col "C" :value "=D1"}
-                {:row 12 :col "B" :value "=C12"}]})
+   :table-data {"A" {1 {:value "59"}
+                     12 {:value "2405"}}
+                "B" {4 {:value "7893"}
+                     5 {:value "7863"}
+                     7 {:value "=C5 + D6"}
+                     8 {:value "=B7 * 2"}
+                     12 {:value "=C12"}}
+                "C" {7 {:value "=D1"}
+                     5 {:value "269"}}
+                "D" {6 {:value "4065"}
+                     10 {:value "8272"}
+                     11 {:value "2495"}}
+                "F" {2 {:value "8650"}
+                     7 {:value "5316"}}}})
 

+ 12 - 17
frontend/src/cljs/microtables_frontend/events.cljs

@@ -12,8 +12,10 @@
  (fn [_ _]
    (println "initializing db")
    (-> db/default-db
-       (update-in [:table-data] (partial map utils/add-parsed-variables))
-       (update-in [:table-data] utils/re-evaluate))))
+       (update-in [:table-data] #(utils/walk-modify-data % (fn [c r datum] (if (= (first (:value datum)) "=") (assoc datum :dirty true) datum))))
+       (update-in [:table-data] utils/create-all-references)
+       (update-in [:table-data] utils/create-all-back-references)
+       (update-in [:table-data] utils/evaluate-all))))
 
 
 (re-frame/reg-event-db
@@ -23,28 +25,21 @@
     (assoc-in db [:position :cursor] {:col c :row r})))
 
 
-(defn re-evaluate-if-dirty [db dirty]
-  (if dirty
-    (update-in db [:table-data] utils/re-evaluate)
-    db))
 
 (re-frame/reg-event-db
   ::movement-leave-cell
   (fn [db [_ c r]]
-    (let [datum (utils/get-datum (:table-data db) c r)]
-      (println "::movement-leave-cell" c r (if (:dirty datum) "- dirty" ""))
-      (-> db
-          (assoc-in [:position :cursor] nil)
-          (assoc-in [:position :selection] nil)
-          (update-in [:table-data] (partial utils/add-parsed-variables-to-specific-datum c r))
-          (re-evaluate-if-dirty (:dirty datum))))))
+    (println "::movement-leave-cell" c r)
+    (-> db
+        (assoc-in [:position :cursor] nil)
+        (assoc-in [:position :selection] nil)
+        (update-in [:table-data] #(utils/reset-references % c r))
+        (update-in [:table-data] #(utils/evaluate-from-cell % c r)))))
 
 
 (re-frame/reg-event-db
   ::edit-cell-value
-  (fn [db [_ c r existing-datum value]]
+  (fn [db [_ c r value]]
     (println "::edit-cell-value" c r value)
-    (if (nil? existing-datum)
-      (assoc db :table-data (conj (:table-data db) {:row r :col c :value value :dirty true}))
-      (assoc db :table-data (map #(if (and (= r (:row %)) (= c (:col %))) (assoc (assoc % :dirty true) :value value) %) (:table-data db))))))
+    (update-in db [:table-data] #(utils/change-datum-value % c r value))))
 

+ 1 - 5
frontend/src/cljs/microtables_frontend/subs.cljs

@@ -11,11 +11,7 @@
     (let [data (:table-data db)
           cursor (get-in db [:position :cursor])]
       (if cursor
-        (map #(if (and
-                    (= (:row cursor) (:row %))
-                    (= (:col cursor) (:col %)))
-                (assoc % :view :value)
-                %) data)
+        (assoc-in data [(:col cursor) (:row cursor) :view] :value)
         data))))
 
 

+ 240 - 73
frontend/src/cljs/microtables_frontend/utils.cljs

@@ -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)))))))
+
 

+ 6 - 11
frontend/src/cljs/microtables_frontend/views.cljs

@@ -9,22 +9,21 @@
 ;; TABLE COMPONENTS
 
 (defn cell [c r data]
-  (let [datum (utils/get-datum data c r)]
+  (let [datum (get-in data [c r])]
     ^{:key (str c r)} [:td
                        [:input {:id (str c r)
                                 :value (if (= (get datum :view nil) :value)
                                          (get datum :value "")
                                          (get datum :error (get datum :display (get datum :value ""))));TODO: add "highlight" display mode (possibly just a css class)
-                                :on-change #(re-frame/dispatch [::events/edit-cell-value c r datum (.. % -target -value)])
+                                :on-change #(re-frame/dispatch [::events/edit-cell-value c r (.. % -target -value)])
                                 :on-focus #(re-frame/dispatch [::events/movement-enter-cell c r])
-                                ;TODO: add "dirty" value to pass to on-blur (maybe not necessary??)
                                 :on-blur #(re-frame/dispatch [::events/movement-leave-cell c r])}]]))
 
 (defn row [r cols data]
   ^{:key (str "row-" r)} [:tr
                           (cons
-                            ^{:key (str "row-head-" r)} [:th (str r)]
-                            (map #(cell % r data) cols))])
+                           ^{:key (str "row-head-" r)} [:th (str r)]
+                           (map #(cell % r data) cols))])
 
 (defn header-row [cols]
   ^{:key "header"} [:tr
@@ -34,17 +33,13 @@
 
 (defn sheet [data]
   [:table [:tbody
-           (let [maxrow (utils/highest :row data)
-                 cols (take-while (partial not= (utils/next-letter (utils/highest :col data))) utils/col-letters)]
+           (let [maxrow (utils/highest-row data)
+                 cols (take-while (partial not= (utils/next-letter (utils/highest-col data))) utils/col-letters)]
              (cons
                (header-row cols)
                (map #(row % cols data) (range 1 (inc maxrow)))))]])
 
 
-
-
-
-
 (defn main-panel []
   (let [data (re-frame/subscribe [::subs/table-data])]
     [:div