Skip to content

Instantly share code, notes, and snippets.

@Chouser Chouser/units.clj
Last active Apr 23, 2018

Embed
What would you like to do?
(ns party.units
(:refer-clojure :exclude [+ - * /])
(:require [clojure.algo.generic.arithmetic :as ari :use [+ - * /]]
[clojure.algo.generic.math-functions :refer [pow]]
[clojure.repl :refer [doc source apropos dir find-doc]]))
(defrecord Measurement [sym factor units]
clojure.lang.IFn
(invoke [a b] (* a b)))
(defn mt
([factor] (Measurement. nil factor {}))
([factor units] (Measurement. nil factor units))
([sym factor units] (Measurement. sym factor units)))
(defmethod print-method Measurement
[{:keys [sym factor units]} w]
(.write w (pr-str (or sym (list 'mt factor (when (seq units) units))))))
(defmethod pow [Long Long] [x p]
(if (neg? p)
(/ (long (Math/pow x (- p))))
(long (Math/pow x p))))
(defmethod pow [Measurement Number] [{:keys [sym factor units] :as m} power]
(if sym
(mt 1 {m power})
(mt (pow factor power) (zipmap (keys units) (map #(* % power) (vals units))))))
(defmacro ^:private def-unit-method [sym]
`(do (defmethod ~sym [Measurement Object] [a# b#] (~sym a# (mt b#)))
(defmethod ~sym [Object Measurement] [a# b#] (~sym (mt a#) b#))))
(def-unit-method *)
(defmethod * [Measurement Measurement] [a b]
(let [{named true, unnamed false} (group-by #(boolean (:sym %)) [a b])]
(mt (apply * (map :factor unnamed))
(apply merge-with + (concat (map :units unnamed)
(for [unit named] {unit 1}))))))
(def-unit-method /)
(defmethod / Measurement [a] (pow a -1))
(defmethod / [Measurement Measurement] [a b] (* a (/ b)))
(defn with-normalized-units
"Returns the given measurement with zero-power units removed. Leaves derived
units untouched and the factour."
[{:keys [sym factor units]}]
(mt sym factor (remove (fn [[_ p]] (zero? p)) units)))
(defn with-base-units
"Returns the given measurement converted to base units. The factor may be
different than given. The sym of the returned measurement will be nil."
[{:keys [factor units] :as m}]
(->> units
(map (fn [[u p]]
(if (symbol? u)
(mt 1 {u p})
(pow (with-base-units u) p))))
(apply * factor)
(with-normalized-units)))
(defn assert-identical-units [a b]
(when-not (= (:units a) (:units b))
(throw (ex-info "Incompatible units"
{:base-units [(:units a) (:units b)]}))))
(defn with-compatible-units
"Returns the given measurements as a vector pair, each converted so that their
units are identical. This may require converting them both of them to base
units."
[a b]
(if (= (:units a) (:units b)) ;; identical units
[a b]
(let [[na nb] (map with-normalized-units [a b])] ;; extra zero powers
(if (= (:units na) (:units nb))
(let [u (apply merge-with #(or %1 %2) (map :units [a b]))]
[(assoc a :units u) (assoc b :units u)])
(let [[ba bb] (map with-base-units [a b])]
(assert-identical-units ba bb)
[ba bb])))))
(def-unit-method +)
(defmethod + [Measurement Measurement] [a b]
(let [[a b] (with-compatible-units a b)]
(mt (+ (:factor a) (:factor b)) (:units a))))
(def-unit-method -)
(defmethod - Measurement [{:keys [factor units]}]
(mt (- factor) units))
(defmethod - [Measurement Measurement] [a b]
(let [[a b] (with-compatible-units a b)]
(mt (- (:factor a) (:factor b)) (:units a))))
(defmacro defunit [name doc & [value]]
(let [full-name (symbol (str (.-name *ns*)) (str name))]
`(def ~(with-meta name {:doc (str doc "\n " (pr-str value))})
(assoc ~(if value
value
`(mt 1 {'~full-name 1}))
:sym '~full-name))))
(defunit m "Standard metric meter, base unit of length")
(defunit cm "Standard metric centimeter" (/ m 100))
(defunit km "Standard metric kilometer" (* m 1000))
(defunit g "Standard metric gram, base unit of mass")
(defunit kg "Standard metric kilogram" (* g 1000))
(defunit t "Standard metric ton" (* kg 1000))
(defunit s "Second, base unit of time")
(defunit minute "Minute" (* 60 s))
(defunit hour "Hour" (* 60 minute))
(defunit G "Gravity on Earth at sea level" (/ (* 9.8 m) s s))
(defn convert [source-measurement target-measurement]
(let [source-base (with-base-units source-measurement)
target-base (with-base-units target-measurement)]
(assert-identical-units source-base target-base)
(mt (/ (:factor source-base) (:factor target-base))
(:units (* 1 target-measurement)))))
(comment
(pow km 2)
(* 5 km)
(with-base-units t)
(convert (/ (* 50 10 km) hour) (/ km hour))
(+ (* 50 km) (* 75 km))
(+ (* 50 km) (* 75 km)) (* 100 (/ km hour))
(convert (/ (+ (* 50 km) (* 75 km)) (* 100 (/ km hour))) hour)
(+ (km 5) (m 10))
(require '[imprecise.core :as imp])
(imp/e 1 0.1)
(+ (* (imp/e 1 0.1) m) (* (imp/e 4 0.1) m))
(/ (* (imp/e 4 0.1) m) (* 10 s))
0)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.