core.cljs 8.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186
  1. (ns microtables-frontend.core
  2. (:require
  3. [reagent.core :as r]
  4. ["mathjs" :as mathjs]))
  5. ; to generate random values
  6. ;for(let i = 0, s = new Set(); i < 10; i++){ let r = Math.floor(Math.random() * 15)+1, c = a[Math.floor(Math.random() * a.length)], k = `${c}${r}`; if(s.has(k)){ i--; continue; } s.add(k); v.push(`{:row ${r} :col "${c}" :value "${Math.floor(Math.random() * 10000)}"}`); }
  7. (def sample-data [{:row 1 :col "A" :value "59" :view :display}
  8. {:row 5 :col "C" :value "269" :view :display}
  9. {:row 4 :col "B" :value "7893" :view :display}
  10. {:row 2 :col "F" :value "8650" :view :display}
  11. {:row 6 :col "D" :value "4065" :view :display}
  12. {:row 7 :col "F" :value "5316" :view :display}
  13. {:row 12 :col "A" :value "2405" :view :display}
  14. {:row 5 :col "B" :value "7863" :view :display}
  15. {:row 9 :col "E" :value "3144" :view :display}
  16. {:row 10 :col "D" :value "8272" :view :display}
  17. {:row 11 :col "D" :value "2495" :view :display}
  18. {:row 15 :col "E" :value "8968" :view :display}
  19. {:row 7 :col "B" :value "=C5 + D6" :view :display}
  20. {:row 8 :col "B" :value "=B7 * 2" :view :display}
  21. {:row 7 :col "C" :value "=D1" :view :display}
  22. {:row 12 :col "B" :value "=C12" :view :display}])
  23. (defonce data-atom (r/atom sample-data))
  24. (defn highest [dir data] (apply max (map dir data)))
  25. ; COLUMN NAMES
  26. (defn upgrade-letter-code [s]
  27. (let [l (last s)]
  28. (cond
  29. (empty? s) [65]
  30. (= l 90) (conj (upgrade-letter-code (subvec s 0 (dec (count s)))) 65)
  31. :else (conj (subvec s 0 (dec (count s))) (inc l)))))
  32. (defn next-letter [lc]
  33. (apply str (map char (upgrade-letter-code (mapv #(.charCodeAt % 0) lc)))))
  34. (def col-letters (iterate next-letter "A"))
  35. ; CHANGE VALUE FUNCTIONS
  36. (defn update-value [c r existing-datum value]
  37. (if (nil? existing-datum)
  38. (swap! data-atom conj {:row r :col c :value value :dirty true})
  39. (swap! data-atom (partial map #(if (and (= r (:row %)) (= c (:col %))) (assoc (assoc % :dirty true) :value value) %)))))
  40. ;TODO: consider changing this for a single "view" atom which points to zero or one cells, which will determine whether to show the formula or evaluation
  41. (defn toggle-display [data c r view-mode]
  42. (println (str " toggling " c r " to " view-mode))
  43. (map #(if (and (= r (:row %)) (= c (:col %))) (assoc % :view view-mode) %) data))
  44. ; CALCULATION / FORMULA EVALUATION FUNCTIONS
  45. (def parse-variables (memoize (fn [expression]
  46. (js->clj (.getVariables mathjs expression)))))
  47. (def evaluate-expression (memoize (fn [expression variables]
  48. (.evaluate mathjs expression (clj->js variables)))))
  49. (def str->rc (memoize (fn [s]
  50. (let [c (re-find #"^[A-Z]+" s)
  51. r (.parseInt js/window (re-find #"[0-9]+$" s))]
  52. {:row r :col c}))))
  53. ;TODO: deal with lowercase cell references
  54. (defn find-cell [data c r]
  55. (some #(if (and (= (:col %) c) (= (:row %) r)) %) data))
  56. (defn find-ref [data cell-ref]
  57. (some (fn [{:keys [row col] :as datum}] (if (and (= row (:row cell-ref)) (= col (:col cell-ref))) datum)) data))
  58. (defn copy-display-values [data display-values]
  59. (let [original (map #(dissoc % :dirty) data)
  60. removed (map #(-> % (dissoc :found) (dissoc :inputs) (dissoc :dirty)) display-values)]
  61. (into original removed)))
  62. ;TODO: memoize dynamically? probably not worth memoizing directly, and could take up too much memory over time
  63. ; https://stackoverflow.com/a/13123571/8172807
  64. (defn find-cycle
  65. ([data datum] (find-cycle data datum #{}))
  66. ([data datum ances]
  67. (let [cur {:row (:row datum) :col (:col datum)}
  68. this-and-above (conj ances cur)
  69. refs (:refs datum)
  70. found (not (empty? (clojure.set/intersection this-and-above (set refs))))]
  71. (if found
  72. :cycle-error
  73. (some (fn [cell]
  74. (find-cycle data (find-ref data cell) this-and-above)) refs)))))
  75. (defn find-val [data c r]
  76. (let [l (find-cell data c r)
  77. v (get l :display (get l :value))
  78. formula? (and (string? v) (= (first v) "="))]
  79. (cond
  80. (nil? v) 0
  81. ;(contains? l :error) :ref-error
  82. formula? :not-yet
  83. :else v)))
  84. ;TODO: figure out how to re-evaluate only when the cell modified affects other cells
  85. (defn re-evaluate [data]
  86. (let [{has-formula true original-values false} (group-by #(= (first (:value %)) "=") data)
  87. found-cycles (map #(let [found (find-cycle data %)] (if found (assoc % :error found) %)) has-formula)
  88. {eligible true ineligible false} (group-by #(not (contains? % :error)) found-cycles)]
  89. (loop [values (into original-values ineligible) mapped-cell-keys eligible]
  90. (let [search-values (map (fn [datum] (assoc datum :found (map #(find-val (concat values mapped-cell-keys) (:col %) (:row %)) (:refs datum)))) mapped-cell-keys)
  91. {not-ready true ready nil} (group-by (fn [datum] (some #(= :not-yet %) (:found datum))) search-values)
  92. prepped-for-eval (map (fn [datum] (assoc datum :inputs (apply hash-map (interleave (:vars datum) (:found datum))))) ready)
  93. evaluated (map (fn [datum] (assoc datum :display (evaluate-expression (subs (:value datum) 1) (:inputs datum)))) prepped-for-eval)
  94. updated-values (copy-display-values values evaluated)]
  95. (if (nil? not-ready)
  96. updated-values
  97. (recur updated-values not-ready))))))
  98. (defn add-parsed-variables [datum]
  99. (if (= (first (:value datum)) "=")
  100. (let [vars (parse-variables (subs (:value datum) 1))
  101. refs (map str->rc vars)]
  102. (-> datum (assoc :vars vars) (assoc :refs refs) (dissoc :error)))
  103. (-> datum (dissoc :vars) (dissoc :refs) (dissoc :display) (dissoc :error))))
  104. (defn add-parsed-variables-to-specific-datum
  105. "Parse variables from the value of a datum and add in :vars and :refs (for swap! data-atom).
  106. If the value does not contain a fomula, remove any :vars and :refs that may have been there."
  107. [c r data] (map #(if (and (= (:col %) c) (= (:row %) r))
  108. (add-parsed-variables %)
  109. %) data))
  110. (defn on-enter-cell [c r e]
  111. (println (str "entering cell " c r))
  112. (swap! data-atom #(toggle-display % c r :value)))
  113. (defn on-leave-cell [c r e]
  114. (println (str "leaving cell " c r))
  115. (swap! data-atom #(as-> % data
  116. (toggle-display data c r :display)
  117. (add-parsed-variables-to-specific-datum c r data)
  118. (re-evaluate data))))
  119. ;; -------------------------
  120. ;; Views
  121. (defn cell [c r data]
  122. (let [datum (some #(if (and (= c (:col %)) (= r (:row %))) %) data)]
  123. ^{:key (str c r)} [:td [:input {:value (if (= (get datum :view nil) :value)
  124. (get datum :value "")
  125. (get datum :error (get datum :display (get datum :value ""))))
  126. :on-change #(update-value c r datum (.. % -target -value))
  127. :on-blur (partial on-leave-cell c r)
  128. :on-focus (partial on-enter-cell c r)}]]))
  129. (defn row [r cols data]
  130. ^{:key (str "row-" r)} [:tr
  131. (cons
  132. ^{:key (str "row-head-" r)} [:th (str r)]
  133. (map #(cell % r data) cols))])
  134. (defn header-row [cols]
  135. ^{:key "header"} [:tr
  136. (cons
  137. ^{:key "corner"} [:th]
  138. (map (fn [c] ^{:key (str "col-head-" c)} [:th c]) cols))])
  139. (defn sheet [data]
  140. [:table [:tbody
  141. (let [maxrow (highest :row data)
  142. cols (take-while (partial not= (next-letter (highest :col data))) col-letters)]
  143. (cons
  144. (header-row cols)
  145. (map #(row % cols data) (range 1 (inc maxrow)))))]])
  146. (defn app []
  147. [:div
  148. [:h3 "Microtables"]
  149. [sheet @data-atom]])
  150. ;; -------------------------
  151. ;; Initialize app
  152. (swap! data-atom #(->> % (map add-parsed-variables) (re-evaluate))) ; evalutate any formulas the first time
  153. (defn mount-root []
  154. (r/render [app] (.getElementById js/document "app")))
  155. (defn init! []
  156. (mount-root))