microtables/frontend/src/cljs/microtables_frontend/utils.cljs

(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))))))

;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
(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."
  ([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]
  (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))))))