Commit 8f117b0b authored by Joachim Schunk's avatar Joachim Schunk

fix calculation-check

parent e078833e
Pipeline #47604 failed with stages
in 2 minutes and 20 seconds
(ns lernmeister.components.exercise-types.calculation.check
(:require [clojure.string :as string]
(:require [lernmeister.components.exercise-types.calculation.migrate-answer
[answer-scheme-version migrate-answer]]
[lernmeister.components.exercise-types.check :as e-check]
[ :as edn]
[lernmeister.components.helper :refer [math-abs]]))
(def prefix-mapping {"Y" 24
"Z" 21
"E" 18
"P" 15
"T" 12
"G" 9
"M" 6
"k" 3
"h" 2
"d" -1
"c" -2
"m" -3
"µ" -6
"n" -9
"p" -12
"f" -15
"a" -18
"z" -21
"y" -24
"" 0
nil 0})
(def si-unit-mapping {"m" [{:factor 1 :oom 0 :unit "m" :expo 1}]
"g" [{:factor 1 :oom -3 :unit "kg" :expo 1}]
"s" [{:factor 1 :oom 0 :unit "s" :expo 1}]
"A" [{:factor 1 :oom 0 :unit "A" :expo 1}]
"K" [{:factor 1 :oom 0 :unit "K" :expo 1}]
"mol" [{:factor 1 :oom 0 :unit "mol" :expo 1}]
"cd" [{:factor 1 :oom 0 :unit "cd" :expo 1}]
"rad" []
"sr" []
"Hz" [{:factor 1 :oom 0 :unit "s" :expo -1}]
"N" [{:factor 1 :oom 0 :unit "m" :expo 1}
{:factor 1 :oom 0 :unit "kg" :expo 1}
{:factor 1 :oom 0 :unit "s" :expo -2}]
"Pa" [{:factor 1 :oom 0 :unit "m" :expo -1}
{:factor 1 :oom 0 :unit "kg" :expo 1}
{:factor 1 :oom 0 :unit "s" :expo -2}]
"J" [{:factor 1 :oom 0 :unit "m" :expo 2}
{:factor 1 :oom 0 :unit "kg" :expo 1}
{:factor 1 :oom 0 :unit "s" :expo -2}]
"W" [{:factor 1 :oom 0 :unit "m" :expo 2}
{:factor 1 :oom 0 :unit "kg" :expo 1}
{:factor 1 :oom 0 :unit "s" :expo -3}]
"C" [{:factor 1 :oom 0 :unit "s" :expo 1}
{:factor 1 :oom 0 :unit "A" :expo 1}]
"V" [{:factor 1 :oom 0 :unit "m" :expo 2}
{:factor 1 :oom 0 :unit "kg" :expo 1}
{:factor 1 :oom 0 :unit "s" :expo -3}
{:factor 1 :oom 0 :unit "A" :expo -1}]
"F" [{:factor 1 :oom 0 :unit "m" :expo -2}
{:factor 1 :oom 0 :unit "kg" :expo -1}
{:factor 1 :oom 0 :unit "s" :expo 4}
{:factor 1 :oom 0 :unit "A" :expo 2}]
"Ω" [{:factor 1 :oom 0 :unit "m" :expo 2}
{:factor 1 :oom 0 :unit "kg" :expo 1}
{:factor 1 :oom 0 :unit "s" :expo -3}
{:factor 1 :oom 0 :unit "A" :expo -2}]
"S" [{:factor 1 :oom 0 :unit "m" :expo -2}
{:factor 1 :oom 0 :unit "kg" :expo -1}
{:factor 1 :oom 0 :unit "s" :expo 3}
{:factor 1 :oom 0 :unit "A" :expo 2}]
"Wb" [{:factor 1 :oom 0 :unit "m" :expo 2}
{:factor 1 :oom 0 :unit "kg" :expo 1}
{:factor 1 :oom 0 :unit "s" :expo -2}
{:factor 1 :oom 0 :unit "A" :expo -2}]
"T" [{:factor 1 :oom 0 :unit "kg" :expo 1}
{:factor 1 :oom 0 :unit "s" :expo -2}
{:factor 1 :oom 0 :unit "A" :expo -1}]
"H" [{:factor 1 :oom 0 :unit "m" :expo 2}
{:factor 1 :oom 0 :unit "kg" :expo 1}
{:factor 1 :oom 0 :unit "s" :expo -2}
{:factor 1 :oom 0 :unit "A" :expo -2}]
"lm" [{:factor 1 :oom 0 :unit "cd" :expo 1}]
"lx" [{:factor 1 :oom 0 :unit "m" :expo -2}
{:factor 1 :oom 0 :unit "cd" :expo 1}]
"Bq" [{:factor 1 :oom 0 :unit "s" :expo -1}]
"Gy" [{:factor 1 :oom 0 :unit "m" :expo 2}
{:factor 1 :oom 0 :unit "s" :expo -2}]
"Sv" [{:factor 1 :oom 0 :unit "m" :expo 2}
{:factor 1 :oom 0 :unit "s" :expo -2}]
"kat" [{:factor 1 :oom 0 :unit "s" :expo -1}
{:factor 1 :oom 0 :unit "mol" :expo 1}]
"h" [{:factor 3.6 :oom 3 :unit "s" :expo 1}]
"d" [{:factor 8.64 :oom 4 :unit "s" :expo 1}]
"l" [{:factor 1 :oom -1 :unit "m" :expo 3}]})
(def additional-unit-mappings {"B" [{:factor 1 :oom 1 :unit "dB" :expo 1}]
"°" [{:factor 1 :oom 0 :unit "°" :expo 1}]})
(def base-unit-set #{"m" "kg" "s" "A" "K" "mol" "cd" "dB" "°"})
(def unit-replace-map {"kg" {:unit "g" :prefix "k"}
"dB" {:unit "B" :prefix "d"}})
(def unit-replace-set (set (keys unit-replace-map)))
(def base-unit-map (reduce (fn [res-map base-unit] (assoc res-map (keyword base-unit) 0)) {} base-unit-set))
(def unit-mapping (merge si-unit-mapping additional-unit-mappings))
(def prefix-set (set (keys prefix-mapping)))
(def unit-set (set (keys unit-mapping)))
(defn not-empty-or-minus [number]
((every-pred #((complement empty?) %) #(not= "-" %)) number))
(defn get-number-part [{:keys [number order-of-magnitude]} with-oom target result]
(when (not-empty-or-minus number)
(let [parsed-number (edn/read-string (string/replace number "," "."))]
(if with-oom
(when (not-empty-or-minus order-of-magnitude)
(let [parsed-oom (edn/read-string order-of-magnitude)]
(assoc result target {:number parsed-number :oom parsed-oom})))
(assoc result target {:number parsed-number :oom 0})))))
(defn reduce-to-base-units [outer-multiplier result base-unit]
(let [multiplier (* outer-multiplier (:expo base-unit))
unit-key (keyword (:unit base-unit))
unit-factor (:factor base-unit)
unit-oom (:oom base-unit)]
(-> result
(update unit-key + multiplier)
(update :factor * (Math/pow unit-factor multiplier))
(update :oom + (* multiplier unit-oom)))))
(defn reduce-unit-mapping [result-map unit]
(let [parsed-expo (edn/read-string (:expo unit))
prefix-oom (get prefix-mapping (:prefix unit))
calculated-oom (* parsed-expo prefix-oom)]
(let [reduce-fn (fn [result base-unit]
((partial reduce-to-base-units parsed-expo) result base-unit))]
(reduce reduce-fn
(update result-map :oom + calculated-oom)
(get unit-mapping (:unit unit))))))
(defn reduce-units [units]
(let [result-map (merge base-unit-map {:factor 1 :oom 0})]
(reduce reduce-unit-mapping
(defn get-units-part [units with-units target result]
(if with-units
(let [reduced-units (reduce-units units)
base-units (select-keys reduced-units
(reduce (fn [res base-unit] (conj res (keyword base-unit))) [] base-unit-set))
units-factor (:factor reduced-units)
units-oom (:oom reduced-units)]
(update result target merge {:base-units base-units :units-factor units-factor :units-oom units-oom}))
(defn compare-base-units [with-units result]
(if with-units
(let [calc-units (get-in result [:calc :base-units])
ans-units (get-in result [:ans :base-units])]
(when (= calc-units ans-units)
[check-phys-vals tolerable-error?]]
[lernmeister.components.helper :refer [migrate-if-necessary]]))
(defn no-negative-points [result]
(if (neg? (:points result))
(assoc result :points 0)
(defn compare-numbers [with-oom with-units error-factor result]
(let [get-combined-number (fn [oom-key]
(let [number (get-in result [oom-key :number])]
(if with-units
(let [units-factor (get-in result [oom-key :units-factor])]
(* number units-factor))
get-combined-oom (fn [oom-key]
(let [units-oom (get-in result [oom-key :units-oom] 0)]
(if with-oom
(let [oom (get-in result [oom-key :oom])]
(+ oom units-oom))
(let [calc-number (get-combined-number :calc)
ans-number (get-combined-number :ans)
calc-oom (get-combined-oom :calc)
ans-oom (get-combined-oom :ans)
oom-difference (- calc-oom ans-oom)
calc-multiplier (Math/pow 10 oom-difference)]
(when (<= (math-abs (- ans-number (* calc-multiplier calc-number)))
(math-abs (* error-factor ans-number)))
(defn check-answer [cur-calc cur-ans & {:keys [with-oom with-units]}]
(let [error-factor (/ (:error-relative cur-calc 1) 100)] ;;is it okay to keep this as ratio-datatype?
(some->> {}
(get-number-part cur-calc with-oom :calc)
(get-number-part cur-ans with-oom :ans)
(get-units-part (:units cur-calc) with-units :calc)
(get-units-part (:units cur-ans) with-units :ans)
(compare-base-units with-units)
(compare-numbers with-oom with-units error-factor))))
(defn check-calculation [id ans-obj ex-obj res-map with-oom with-units]
(let [phys-val-check-res (check-phys-vals ex-obj ans-obj :with-oom with-oom :with-units with-units)
is-correct? (tolerable-error? (:calculation-error phys-val-check-res) (int (:error-relative ex-obj)))]
(assoc res-map id {:correct is-correct?
:points (if is-correct? (:correct-points ex-obj) (:incorrect-points ex-obj))
:points-max (:correct-points ex-obj)})))
(defn calculation-check [exercise answer callback]
(let [no-negative-points (fn [result]
(if (neg? (:points result))
(assoc result :points 0)
(let [core (:core exercise)
calculations (:calculations core)
with-oom (:with-oom core)
with-units (:with-units core)]
(fn [calculation]
(let [cur-correct-points (:correct-points calculation)
cur-incorrect-points (:incorrect-points calculation)
cur-id (:id calculation)
cur-answer (get answer cur-id)]
(if (and
(check-answer calculation cur-answer :with-oom with-oom :with-units with-units))
{:points cur-correct-points :points-max cur-correct-points :correct-id cur-id}
{:points cur-incorrect-points :points-max cur-correct-points})))
(fn [result cur-result]
(let [update-correct-calculations (fn [result]
(if (contains? cur-result :correct-id)
(update result :correct-calculations conj (:correct-id cur-result))
(update :points + (:points cur-result))
(update :points-max + (:points-max cur-result))
{:points 0 :points-max 0 :correct-calculations #{}})
(let [answer-calculations (:calculations answer)
calculations (get-in exercise [:core :calculations])
with-oom (get-in exercise [:core :with-oom])
with-units (get-in exercise [:core :with-units])
res-map (reduce (fn [r-map calculation]
(let [id (:id calculation)
answer (get answer-calculations id)]
(check-calculation id answer calculation r-map with-oom with-units)))
{} calculations)
update-correct-calcs (fn [result id calculation-check]
(if (:correct calculation-check)
(update result :correct-calculations conj id)
(->> res-map
(reduce-kv (fn [result k v] (-> result
(update :points + (:points v))
(update :points-max + (:points-max v))
(update-correct-calcs k v)))
{:points 0 :points-max 0 :correct-calculations #{}})
(defmethod e-check/check-answer :calculation [exercise answer callback]
(calculation-check exercise answer callback))
(let [migrated-answer (migrate-if-necessary answer :answer-scheme "calculation"
answer-scheme-version migrate-answer)]
(calculation-check exercise migrated-answer callback)))
(ns lernmeister.components.exercise-types.calculation.spec
(:require #?(:cljs [cljs.spec.alpha :as s]
:clj [clojure.spec.alpha :as s])
[lernmeister.components.exercise-types.calculation.check :refer [prefix-set unit-set]]))
[lernmeister.components.exercise-types.multistep-calculation.check :refer [prefix-set unit-set]]))
(s/def :calculation/name (s/and string? #(not (empty? %))))
(s/def :calculation/number (s/and string? #(re-matches #"^\-?((((0\,)|([1-9]\d*\,?))\d*)|0)$" %)))
......@@ -27,4 +27,3 @@
:exercise/task-description :exercise/shuffled]))
(s/def ::calculation-question (s/keys :req-un [:calculation-question/core]))
(ns lernmeister.components.exercise-types.calculation.views.helper
(:require [clojure.string :refer [trim replace join]]
:refer [prefix-mapping prefix-set unit-set not-empty-or-minus]]
[reagent.core :as reagent]
[reagent.dom :as rdom]
[lernmeister.components.ui :as ui]
[lernmeister.components.helper :refer [vec-remove]]))
(defn parse-unit [string]
(when (string? string)
(when-let [matched-string (re-matches #"^[a-zA-ZΩ°]*" string)]
(replace (subs matched-string 0 3) #"Ohm|ohm" "Ω"))))
(defn parse-prefix [string]
(when (string? string)
(when-let [replaced-string (replace string "u" "µ")]
(let [last-char (or (last replaced-string) "")]
(when (contains? prefix-set last-char) last-char)))))
(defn parse-float [string]
(when (string? string)
(when-let [[match sign int-part float-part] (re-matches #"^(\-?)(\d*)([\.|,]?\d*)$" string)]
(if-let [[match stripped-int-part] (re-matches #"^0*(\d+)$" int-part)]
(str sign stripped-int-part (replace float-part "." ","))
(if (= float-part "") sign (str sign "0" (replace float-part "." ",")))))))
(defn parse-int [string]
(when (string? string)
(when-let [[match sign int-part] (re-matches #"^(\-?)(\d*)$" string)]
(if-let [[match stripped-int-part] (re-matches #"^0*(\d+)$" int-part)]
(str sign stripped-int-part)
(str sign)))))
(defn append-to-string-vec [arg append-string]
(update arg :string-vec conj append-string))
(defn add-number [arg]
(let [number (:number arg)]
(when (not-empty-or-minus number)
(if (re-matches #"^\-?0,?0*$" number)
(-> arg
(assoc :number "0")
(append-to-string-vec "0"))
(append-to-string-vec arg (-> number
(replace #",$" "")
(replace "," "{,}")))))))
(defn add-oom [arg]
(let [number (:number arg)
oom (:order-of-magnitude arg)
with-oom (:with-oom arg)]
(if with-oom
(when (not-empty-or-minus oom)
(letfn [(build-oom-string [oom number] (if (or (= "0" number) (re-matches #"^\-?0?$" oom))
(str "\\cdot 10^{" oom "}")))]
(append-to-string-vec arg (build-oom-string oom number))))
(append-to-string-vec arg ""))))
(defn append-unit-str [frac-map position unit expo]
(update frac-map position conj (if (= "1" expo) unit (str unit "^{" expo "}"))))
(defn join-with-sep [fraction-map map-key]
(join "{\\cdot}" (map-key fraction-map)))
(defn latex-replace-unit [unit]
(-> unit
(replace "Ω" "\\Omega ")
(replace "°" "\\degree ")))
(defn build-fraction-map [unit-list]
(fn [res-map unit-map]
(let [prefix (replace (:prefix unit-map) "µ" "\\mu ")
unit (latex-replace-unit (:unit unit-map))
combined-unit (str prefix unit)
expo (:expo unit-map)]
(if (= "-" (first expo))
(append-unit-str res-map :denominator combined-unit (subs expo 1))
(append-unit-str res-map :numerator combined-unit expo))))
{:numerator [] :denominator []} unit-list))
(defn add-units [arg]
(if ((every-pred :with-units #(not-empty (:units %))) arg)
(let [fraction-map (build-fraction-map (:units arg))
numerator-str (join-with-sep fraction-map :numerator)
num-str-mod (if (empty? numerator-str) "1" numerator-str)
denominator-str (join-with-sep fraction-map :denominator)]
(if (empty? denominator-str)
(append-to-string-vec arg numerator-str)
(append-to-string-vec arg (str "\\dfrac{" num-str-mod "}{" denominator-str "}"))))
(append-to-string-vec arg "")))
(defn build-units-latex-string [arg]
(if (and (vector? arg) (not-empty arg))
(-> (add-units (assoc {:with-units true :string-vec []} :units arg))
(defn join-string-vec [arg]
(let [string-vec (:string-vec arg)
reduced-vec [(join (subvec string-vec 0 2)) (last string-vec)]
separator (if (empty? (last reduced-vec)) "" "\\,")]
(join separator reduced-vec)))
(defn build-latex-string [{:keys [:number :order-of-magnitude :units :with-oom :with-units]}]
(if-let [latex-string (some-> {:number number
:order-of-magnitude order-of-magnitude
:units units
:with-oom with-oom
:with-units with-units
:string-vec []}
(defn latex-span [latex-string]
(letfn [(katex-render [element]
(let [node (rdom/dom-node element)
latexstring (first (reagent/children element))]
(when-not (= nil latexstring)
(js/katex.render latexstring node)
(catch js/Object e (js/console.warn e.message))))))]
(fn [latex-string]
#(katex-render %)
#(katex-render %)})))
(defn input-text-inline [answer & {:keys [value width label class disabled on-change]}]
(fn [answer & {:keys [value width label class disabled on-change]}]
[ui/field {:label label}
{:type "text"
:label label
:class class
:value value
:size width
:disabled disabled
:on-change #(on-change answer %)}
[:input {:type "text"
:class class
:value value
:size width
:disabled disabled
:on-change #(on-change answer (-> % .-target .-value))}]
[ label]]))
......@@ -124,7 +124,7 @@
:answer answer
:change-fn change-fn}]
(when result
[ [point-result result]])]]
[ [point-result {:result result}]])]]
{:state (reagent/cursor modal-state-atom [:modal-visible?])
(ns lernmeister.components.exercise-types.calculation.views.unit-input
(:require [reagent.core :as reagent]
[lernmeister.components.content-elements.core :as content-manager]
[ :as ce-ex]
[lernmeister.components.content-elements.exercise.task-description :refer [default-task-description]]
[lernmeister.components.common :as common]
[lernmeister.components.ui :as ui]
[clojure.string :refer [trim replace join]]
[lernmeister.components.helper :refer [vec-remove]]
:refer [prefix-mapping prefix-set unit-set not-empty-or-minus unit-replace-map unit-replace-set]]
[lernmeister.components.exercise-types.calculation.views.helper :refer [input-text-inline parse-int
parse-prefix parse-unit]]))
(defn update-units [units & {:keys [prefix unit expo]}]
(let [units-new (conj units {:prefix prefix :unit unit :expo expo})]
(if-let [index (first (keep-indexed (fn [idx unit-map] (when (= unit (:unit unit-map)) idx)) units))]
(vec-remove units-new index)
(defn check-and-replace-expo [unit-map]
(let [expo (:expo unit-map)]
(when (not (#{"-" "0" "-0"} expo))
(if (contains? #{nil ""} expo) (assoc unit-map :expo "1") unit-map))))
(defn check-and-replace-unit [unit-map]
(when (not (and (unit-replace-set (:unit unit-map)) (not-empty (:prefix unit-map))))
(let [replaced-map (if-let [unit-mapping (get unit-replace-map (:unit unit-map))]
(-> unit-map
(assoc :unit (:unit unit-mapping))
(assoc :prefix (:prefix unit-mapping)))
(when (unit-set (:unit replaced-map)) replaced-map))))
(defn check-and-replace-prefix [unit-map]
(let [replaced-map (assoc unit-map :prefix (or (:prefix unit-map) ""))]
(when (prefix-set (:prefix replaced-map)) replaced-map)))
(defn check-unit [unit-map]
(some-> unit-map
(defn unit-chip [& {:keys [:prefix :unit :expo :answer :on-change]}]
(fn [& {:keys [:prefix :unit :expo :answer :on-change-fn]}]
(str prefix unit)
(when-not (= "1" expo) [:sup expo])
[:button.delete {:on-click #(on-change answer)}]]))
(defn units-builder [id & {:keys [answer on-change-fn]}]
(let [cur-unit (reagent/atom {:prefix nil :unit nil :expo nil})
prefixes (sort-by second > (remove (comp nil? first) prefix-mapping))
unit-options (apply (into sorted-set) (conj unit-set "Ohm" "kg" "dB"))
add-unit? (reagent/atom nil)]
(fn [id & {:keys [answer on-change-fn]}]
(let [units (get-in answer [id :units])]
[:div ;; intended to be "[:<>"
[:b "Einheit: "]
(if (pos? (count units))
[latex-span (build-units-latex-string units)]
[:p "Bitte definieren Sie mindestens einen Einheitenbestandteil"])]]
[:b "Bestandtteile:"]
(fn [index unit-entry]
(let [prefix (:prefix unit-entry)
unit (:unit unit-entry)
expo (:expo unit-entry)]
^{:key index}
:prefix prefix
:unit unit
:expo expo
:answer answer
:on-change (fn [answer]