Skip to content

Instantly share code, notes, and snippets.

@fogus fogus/units.clj forked from Chouser/units.clj
Created Apr 19, 2018

Embed
What would you like to do?
(ns party.units
(:refer-clojure :exclude [+ - * /])
(:require [clojure.algo.generic.arithmetic :as ari :use [+ - * /]]))
(defrecord Measurement [factor units]
clojure.lang.IFn
(invoke [a b] (* a b)))
(defn ^:private short-name [sym]
(if (= (namespace sym) (namespace `foo))
(symbol (name sym))
sym))
(defn ^:private repeat-pairs [pairs]
(mapcat (fn [[sym power]] (repeat (Math/abs power) (short-name sym))) pairs))
(defn ^:private split-powers [pairs]
(let [{top true, btm false} (group-by #(pos? (val %)) pairs)]
[top btm]))
(defmethod print-method Measurement
[{:keys [factor units]} w]
(.write w
(pr-str
(let [[top btm] (split-powers units)
top-form (list* '* factor (repeat-pairs top))]
(if (empty? btm)
top-form
(list* '/ top-form (repeat-pairs btm)))))))
(defmethod * [Measurement Object] [a b] (* a (Measurement. b {})))
(defmethod * [Object Measurement] [a b] (* (Measurement. a {}) b))
(defmethod * [Measurement Measurement] [a b]
(Measurement. (* (:factor a) (:factor b))
(merge-with + (:units a) (:units b))))
(defmethod / Measurement [a] (/ 1 a))
(defmethod / [Measurement Object] [a b] (/ a (Measurement. b {})))
(defmethod / [Object Measurement] [a b] (/ (Measurement. a {}) b))
(defmethod / [Measurement Measurement] [a b]
(Measurement. (/ (:factor a) (:factor b))
(merge-with + (:units a) (zipmap (keys (:units b))
(map - (vals (:units b)))))))
(defmethod + [Measurement Object] [a b] (+ a (Measurement. b {})))
(defmethod + [Object Measurement] [a b] (+ (Measurement. a {}) b))
(defmethod + [Measurement Measurement] [a b]
(when (not= (:units a) (:units b))
(throw (ex-info "Can't add incompatible units"
{:op (list '+ a b)})))
(Measurement. (+ (:factor a) (:factor b)) (:units a)))
(defmethod - Measurement [{:keys [factor units]}]
(Measurement. (- factor) units))
(defmethod - [Measurement Object] [a b] (- a (Measurement. b {})))
(defmethod - [Object Measurement] [a b] (- (Measurement. a {}) b))
(defmethod - [Measurement Measurement] [a b]
(when (not= (:units a) (:units b))
(throw (ex-info "Can't subtract incompatible units"
{:op (list '- a b)})))
(Measurement. (- (:factor a) (:factor b)) (:units a)))
(def m "Standard metric meter" (Measurement. 1 {`m 1}))
(def cm "Metric centimeter" (/ m 100))
(def km "Metric kilometer" (* m 1000))
(def s (Measurement. 1 {`s 1}))
(def minute (* 60 s))
(def hour (* 60 minute))
(defn in-base-units [{:keys [factor units]}]
(let [expanded (zipmap (map #(deref (or (resolve %) (throw (ex-info "bad" {:unit %}))))
(keys units))
(vals units))
[top btm] (split-powers expanded)]
(apply * factor
(apply / 1 (mapcat (fn [[m p]] (repeat (- p) m)) btm))
(mapcat (fn [[m p]] (repeat p m)) top))))
;; This expects the units in target-measurement to be symbols of non-base units.
;; Weird.
(defn convert-to-measurement [measurement target-measurement]
(let [target (in-base-units target-measurement)]
(when (not= (:units target) (:units measurement))
(throw (ex-info "Can't convert to incompatible units"
{:op (list 'convert-to-measurement measurement target)})))
(Measurement. (/ (:factor measurement) (:factor target))
(:units target-measurement))))
;; (convert-to-measurement (/ (* 50 10 km) hour) (Measurement. 1 `{km 1 hour -1}))
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.