[Haskell-cafe] Instantiation problem
Henning Thielemann
schlepptop at henning-thielemann.de
Sun Jan 30 20:43:00 CET 2011
Patrick Browne schrieb:
> On 29/01/2011 20:56, Henning Thielemann wrote:
>> Is there a reason why you use an individual type for every unit?
>> The existing implementations of typed physical units only encode the
>> physical dimension in types and leave the unit factors to the value
>> level. I found this to be the most natural way.
>
> I am studying type classes using examples from the literature [1].
> There is no particular intension to implement anything.
>
> I am confused about the unit function in the code below.
> My understanding is:
> The signature of the unit function is defined in the MetricDescription
> class.
> Any valid instantce of MetricDescription will respect the functional
> dependency (FD):
> The FD | description -> unit is exactly the signature of the unit function.
>
> My confusions
> I do not understand the definitions of unit in the instances.
> I do not know how the constant 1 can be equated with a *type*, Where did
> 1 come from?
I do not see a constant 1 that is equated with a type.
> I do not know how the constant 1 can be equated with *two distinct*
> definitions of the function uint and still produce the following correct
> results
Where is the constant 1 equated with two distinct definitions of 'unit'?
> Ok, modules loaded: A.
> *A> unit (LengthInMetres 7)
> Metre
> *A> unit (LengthInCentimetres 7)
> Centimetre
> *A>
'unit' is a method of the class MetricDescription. The particular
implementation of 'unit' is chosen by the compiler according to the type
of the actual parameter and result of 'unit'.
> module A where
>
> -- Each member of the Unit class has one operator convertFactorToBaseUnit
> -- that takes a measurement unit (say metre) and returns a conversion
> factor for that unit of measurement
> class Unit unit where
> convertFactorToBaseUnit :: unit -> Double
>
>
>
> class (Unit unit) => MetricDescription description unit | description ->
> unit where
> unit :: description -> unit
> valueInUnit :: description -> Double
> valueInBaseUnit :: description -> Double
Since valueInUnit and valueInBaseUnit do not need the 'unit' type, I
would put them in a separate class.
> valueInBaseUnit d = (convertFactorToBaseUnit(unit d)) * (valueInUnit d)
>
> data Dog = Dog deriving Show
> data Metre = Metre deriving Show
> data Centimetre = Centimetre deriving Show
>
>
> -- An instance for metres, where the convert factor is 1.0
> instance Unit Metre where
> convertFactorToBaseUnit Metre = 1.0
>
> -- An instance for centimetres, where the convert factor is 0.1
> instance Unit Centimetre where
> convertFactorToBaseUnit Centimetre = 0.1
I assumed that 0.01m = 1cm
> data LengthInMetres = LengthInMetres Double deriving Show
> data LengthInCentimetres = LengthInCentimetres Double deriving Show
>
> instance MetricDescription LengthInMetres Metre where
> valueInUnit (LengthInMetres d) = d
> unit l = Metre
If you enable compiler warnings, then the compiler will warn you, that
'l' is not used. You can also write
unit _ = Metre
> instance MetricDescription LengthInCentimetres Centimetre where
> valueInUnit (LengthInCentimetres d) = d
> unit l = Centimetre
More information about the Haskell-Cafe
mailing list