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

; 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

;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
  "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 #(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? (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)))))))