In a recent article I described some prototype F# code for defining runtime units of measure with similar functionality to F#’s compile time units of measure feature. The following code extends this prototype to provide auto-conversion when adding or multiplying unit values. Note that as unit conversion is done at runtime this implementation is also usable from C#. This allows for example the following calculations to succeed:
1km + 200m = 1200m
(1m/s) / 500milliseconds = 2m
To achieve this a new Measure type introduces Base Unit types and Measure multiples.
Base Unit type examples - length
- mass
- time
Measure multiple examples - Kilometres (1000)
- Metres (1)
- Millimetres (0.001)
Defining measure types:
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)
Measure type definition:
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 Kilo (m:Measure) =
Measure("k"+m.Name,Multiple(m,1000.0))
static member Milli (m:Measure) =
Measure("m"+m.Name,Multiple(m,0.001))
static member ( * ) (v:ValueType,m:Measure) = UnitValue(v,Unit(m,1))
The add and multiply operations on a UnitValue now convert to the base unit if a dimensional unit mismatch exits (see Units conversion by factor-label):
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
static member ToBaseUnit x =
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 x
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 = UnitValue.ToBaseUnit lhs
let x2 = UnitValue.ToBaseUnit rhs
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 = UnitValue.ToBaseUnit lhs
let rhs = UnitValue.ToBaseUnit rhs
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 = UnitValue.ToBaseUnit lhs
let rhs = UnitValue.ToBaseUnit rhs
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)
The only change to the Unit type is that it references a Measure type instead of a literal string signifying the measure:
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
Known issues
- Operator precedence means 10 * m / 2 * s = 5 m s instead of 5 m /s
- As a workaround use brackets, i.e. (10 * m) / (2 * s)
- Conversions requiring constant difference like degrees to kelvins are not supported
UnitType.fs (7.17 kb)
2d716d22-2e2f-4371-9423-5d20fca81c1f|0|.0