Created
July 24, 2017 14:25
-
-
Save bcachet/c24af5cda242a861d18a5621bb87bb82 to your computer and use it in GitHub Desktop.
Unit of Measure at RunTime (http://www.trelford.com/blog/post/Units-of-measure-auto-conversion.aspx)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
namespace Units | |
type MeasureType = | |
| BaseUnit of string | |
| Multiple of Measure * ValueType | |
with | |
member this.BaseUnitName = | |
let rec traverse = function | |
| BaseUnit s -> s | |
| Multiple(Measure(_,m),_) -> traverse m | |
traverse this | |
and Measure = Measure of string * MeasureType with | |
member this.Name = match this with Measure(s,_) -> s | |
member this.Type = match this with Measure(_,t) -> t | |
static member Giga (m:Measure) = | |
Measure("G"+m.Name,Multiple(m,1000000000.0)) | |
static member Mega (m:Measure) = | |
Measure("M"+m.Name,Multiple(m,1000000.0)) | |
static member Kilo (m:Measure) = | |
Measure("k"+m.Name,Multiple(m,1000.0)) | |
static member Deci (m:Measure) = | |
Measure("d"+m.Name,Multiple(m,0.1)) | |
static member Centi (m:Measure) = | |
Measure("c"+m.Name,Multiple(m,0.01)) | |
static member Milli (m:Measure) = | |
Measure("m"+m.Name,Multiple(m,0.001)) | |
static member Micro (m:Measure) = | |
Measure("µ"+m.Name,Multiple(m,0.0001)) | |
static member ( * ) (v:ValueType,m:Measure) = UnitValue(v,Unit(m,1)) | |
and UnitType = | |
| Unit of Measure * int | |
| CompositeUnit of UnitType list | |
static member Create(m) = Unit(m,1) | |
override this.ToString() = | |
let exponent = function | |
| Unit(_,n) -> n | |
| CompositeUnit(_) -> | |
raise (new System.InvalidOperationException()) | |
let rec toString = function | |
| Unit(s,n) when n=0 -> "" | |
| Unit(Measure(s,_),n) when n=1 -> s | |
| Unit(Measure(s,_),n) -> s + " ^ " + n.ToString() | |
| CompositeUnit(us) -> | |
let ps, ns = | |
us |> List.partition (fun u -> exponent u >= 0) | |
let join xs = | |
let s = xs |> List.map toString |> List.toArray | |
System.String.Join(" ",s) | |
match ps,ns with | |
| ps, [] -> join ps | |
| ps, ns -> | |
let ns = ns |> List.map UnitType.Reciprocal | |
join ps + " / " + join ns | |
match this with | |
| Unit(_,n) when n < 0 -> " / " + toString this | |
| _ -> toString this | |
static member ( * ) (v:ValueType,u:UnitType) = UnitValue(v,u) | |
static member ( * ) (lhs:UnitType,rhs:UnitType) = | |
let text = function | |
| Unit(Measure(s,_),_) -> s | |
| CompositeUnit(us) -> us.ToString() | |
let normalize us u = | |
let t = text u | |
match us |> List.tryFind (fun x -> text x = t), u with | |
| Some(Unit(s,n) as v), Unit(_,n') -> | |
us |> List.map (fun x -> if x = v then Unit(s,n+n') else x) | |
| Some(_), _ -> raise (new System.NotImplementedException()) | |
| None, _ -> us@[u] | |
let normalize' us us' = | |
us' |> List.fold (fun (acc) x -> normalize acc x) us | |
match lhs,rhs with | |
| Unit(u1,p1), Unit(u2,p2) when u1 = u2 -> | |
Unit(u1,p1+p2) | |
| Unit(u1,p1), Unit(u2,p2) -> | |
CompositeUnit([lhs;rhs]) | |
| CompositeUnit(us), Unit(_,_) -> | |
CompositeUnit(normalize us rhs) | |
| Unit(_,_), CompositeUnit(us) -> | |
CompositeUnit(normalize' [lhs] us) | |
| CompositeUnit(us), CompositeUnit(us') -> | |
CompositeUnit(normalize' us us') | |
| _,_ -> raise (new System.NotImplementedException()) | |
static member Reciprocal x = | |
let rec reciprocal = function | |
| Unit(s,n) -> Unit(s,-n) | |
| CompositeUnit(us) -> CompositeUnit(us |> List.map reciprocal) | |
reciprocal x | |
static member ( / ) (lhs:UnitType,rhs:UnitType) = | |
lhs * (UnitType.Reciprocal rhs) | |
static member ( + ) (lhs:UnitType,rhs:UnitType) = | |
if lhs = rhs then lhs | |
else raise (new System.InvalidOperationException()) | |
and ValueType = float | |
and UnitValue = UnitValue of ValueType * UnitType with | |
member this.Value = match this with UnitValue(v,_) -> v | |
member this.Unit = match this with UnitValue(_,u) -> u | |
override this.ToString() = sprintf "%O %O" this.Value this.Unit | |
member this.ToBaseUnit() = | |
let rec toBaseUnit = function | |
| UnitValue(v,(Unit(Measure(_,BaseUnit(_)),_))) as x -> | |
x | |
| UnitValue(v,Unit(Measure(_,Multiple(quantity,coefficient)),p)) -> | |
toBaseUnit (UnitValue(v*coefficient, Unit(quantity,p))) | |
| UnitValue(v,(CompositeUnit(xs))) -> | |
let v, ys = | |
(v,[]) |> List.foldBack (fun x (v,ys) -> | |
let x = toBaseUnit (UnitValue(v,x)) | |
x.Value, x.Unit::ys | |
) xs | |
UnitValue(v, CompositeUnit(ys)) | |
toBaseUnit this | |
static member private DoesDimensionalUnitMismatchExist lhs rhs = | |
let rec measures = function | |
| Unit(m,_) -> Set.singleton (m) | |
| CompositeUnit(us) -> | |
us |> List.map measures |> Set.unionMany | |
measures lhs |> Set.exists (fun x -> | |
measures rhs |> Set.exists (fun y -> | |
y.Type.BaseUnitName = x.Type.BaseUnitName | |
&& not (x = y) | |
) | |
) | |
static member (+) (lhs:UnitValue,rhs:UnitValue) = | |
if lhs.Unit = rhs.Unit then | |
UnitValue(lhs.Value+rhs.Value, lhs.Unit+rhs.Unit) | |
else | |
let x1 = lhs.ToBaseUnit() | |
let x2 = rhs.ToBaseUnit() | |
if x1.Unit = x2.Unit then | |
UnitValue(x1.Value+x2.Value,x1.Unit+x2.Unit) | |
else | |
raise (new System.InvalidOperationException()) | |
static member (*) (lhs:UnitValue,rhs:UnitValue) = | |
if UnitValue.DoesDimensionalUnitMismatchExist lhs.Unit rhs.Unit then | |
let lhs = lhs.ToBaseUnit() | |
let rhs = rhs.ToBaseUnit() | |
UnitValue(lhs.Value*rhs.Value,lhs.Unit*rhs.Unit) | |
else | |
UnitValue(lhs.Value*rhs.Value,lhs.Unit*rhs.Unit) | |
static member (*) (lhs:UnitValue,rhs:ValueType) = | |
UnitValue(lhs.Value*rhs,lhs.Unit) | |
static member (/) (lhs:UnitValue,rhs:UnitValue) = | |
if UnitValue.DoesDimensionalUnitMismatchExist lhs.Unit rhs.Unit then | |
let lhs = lhs.ToBaseUnit() | |
let rhs = rhs.ToBaseUnit() | |
UnitValue(lhs.Value/rhs.Value,lhs.Unit/rhs.Unit) | |
else | |
UnitValue(lhs.Value/rhs.Value,lhs.Unit/rhs.Unit) | |
static member (/) (lhs:UnitValue,rhs:ValueType) = | |
UnitValue(lhs.Value/rhs,lhs.Unit) | |
module SI = | |
let length = "length" | |
let time = "time" | |
let m = Measure("m", BaseUnit(length)) | |
let km = Measure.Kilo(m) | |
let s = Measure("s", BaseUnit(time)) | |
let milliseconds = Measure.Milli(s) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment