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)