I would like to construct a type to handle simple error propagation.
My type is:
data Measurement a = Measurement !a !a
One argument represents the value of the measurement and the other the error.
I want to make it an instance of Num, but I want it to have this behaviour:
– If I add it to a Num type, I only want the value to be added to the first argument
k = Measurement 3.0 0.1
k + 3.0 -- should give Measurement 6.0 0.1
– if I add it to a Measurement, I want the sum of every argument
k = Measurement 3.0 0.1
j = Measurement 4.0 0.2
k + j -- Measurement 7.0 0.3
I don’t understand how to do this, in julia I should simply overload the operator (+) to handle all possible cases.
Suggestions?
You don’t have to do any fancy overloading. That property falls out naturally:
instance Num a => Num (Measurement a) where
fromInteger n = Measurement (fromInteger n) 0
Measurement a b + Measurement c d = Measurement (a + c) (b + d)
ghci> k = Measurement 3.0 0.1
ghci> k + 3
Measurement 6.0 0.1
ghci> j = Measurement 4.0 0.2
ghci> k + j
Measurement 7.0 0.30000000000000004
If you encounter any other cases where you really want a form of addition where the two operands have different types, then you need to define a new operator. E.g.:
(+.) :: Measurement -> Double -> Measurement
Measurement x y +. z = Measurement (x + z) y
Note that this isn’t really how you should think about addition in Haskell. Addition in Haskell is always adding two things of the same type: (+) :: Num a => a -> a -> a.
It was not giving me the expected results, in fact I had mistaken the fromInteger function. I also thought I had to overload the operators for all Num types, so I made a second post. You are right, I should have continued there, I apologize.
I have more questions related to this example:
– Why does Floating require the definition of pi? Why should pi be special and not 0 or 1?
– I tried to define Measurement as a Floating instance like this
import Numeric.AD
----
instance Floating a => Floating (Measurement a) where
pi = Measurement pi 0
exp (Measurement a b) = Measurement (exp a) (sqrt ((b**2) * diff exp a ** 2))
log (Measurement a b) = Measurement (log a) (sqrt ((b**2) * diff log a ** 2))
sqrt (Measurement a b) = Measurement (sqrt a) (sqrt ((b**2) * diff sqrt a **2))
sin (Measurement a b) = Measurement (sin a) (sqrt ((b**2) * diff sin a ** 2))
cos (Measurement a b) = Measurement (cos a) (sqrt ((b**2) * diff cos a ** 2))
asin (Measurement a b) = Measurement (asin a) (sqrt ((b**2) * diff asin a ** 2))
acos (Measurement a b) = Measurement (acos a) (sqrt ((b**2) * diff acos a ** 2))
atan (Measurement a b) = Measurement (atan a) (sqrt ((b**2) * diff atan a ** 2))
sinh (Measurement a b) = Measurement (sinh a) (sqrt ((b**2) * diff sinh a ** 2))
cosh (Measurement a b) = Measurement (cosh a) (sqrt ((b**2) * diff cosh a ** 2))
asinh (Measurement a b) = Measurement (asinh a) (sqrt ((b**2) * diff asinh a ** 2))
acosh (Measurement a b) = Measurement (acosh a) (sqrt ((b**2) * diff acosh a ** 2))
atanh (Measurement a b) = Measurement (atanh a) (sqrt ((b**2) * diff atanh a ** 2))
There is a pattern, which could be rewritten in one of two ways:
sqrtDiff f a b = sqrt ((b**2) * diff f a ** 2)
newMeasurement f (Measurement c d) = Measurement (f c) (sqrtDiff f c d)
or
instance Functor Measurement where
fmap f (Measurement a b) = Measurement (f a) (sqrt ((b**2) * diff f a ** 2))
The first works if you provide an explicit type signature for f
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Numeric.AD
data Measurement a = Measurement !a !a
sqrtDiff (f :: forall a. Num a => a -> a) a b =
sqrt ((b**2) * diff f a ** 2)
newMeasurement (f :: forall a. Num a => a -> a) (Measurement c d) =
Measurement (f c) (sqrtDiff f c d)
The second doesn’t work because the fmap f of a Functor instance needs to work for f of an unrestricted type a -> b. In newMeasurement you are restricting f to forall a. Num a => a -> a.
Are there ways to replace every function that has Measurement as its argument with newMeasurement?
example:
w x = sin x * 5 + x ^ 2 + tan x + 12 --myfunction
a = Measurement 10 0.1
-- if I want (w a) I need to call newMeasurement
correctResult = newMeasurement w a -- (109.92825527301224 ± 1.7225014117201172)
wrongResult = w a -- (109.92825527301224 ± 1.4791137150045124)
But I don’t want to have to redefine all the functions I need by hand.
And the problem with newMeasurement is that if I should forget it once I would silently get wrong results
I would just drop the Num instance for Measurement. It doesn’t look like you actually need it any more! ad seems to take care of whatever you wanted to do with it.
If I remove Num I can no longer handle a+a, a-a, etc.
Now my code is:
data Measurement a = Measurement !a !a
instance Show a => Show (Measurement a) where
show (Measurement v e) = "(" ++ show v ++ " ± " ++ show e ++ ")"
instance Floating a => Num (Measurement a) where
fromInteger n = Measurement (fromInteger n) 0
Measurement a b + Measurement c d = Measurement (a + c) (sqrt (b**2 + d**2))
Measurement a b - Measurement c d = Measurement (a - c) (sqrt (b**2 + d**2))
Measurement a b * Measurement c d = Measurement z (z * sqrt ((b/a)**2+(d/c)**2)) where z = a * c
abs (Measurement a b) = Measurement (abs a) b
signum (Measurement a b) = Measurement (signum a) (signum b)
instance Floating a => Fractional (Measurement a) where
Measurement a b / Measurement c d = Measurement z (z * sqrt ((b/a)**2+(d/c)**2)) where z = a / c
fromRational k = Measurement (fromRational k) 0
instance Floating a => Floating (Measurement a) where
pi = Measurement pi 0
exp = newMeasurement exp
log = newMeasurement log
sqrt = newMeasurement sqrt
sin = newMeasurement sin
cos = newMeasurement cos
asin = newMeasurement asin
acos = newMeasurement acos
atan = newMeasurement atan
sinh = newMeasurement sinh
cosh = newMeasurement cosh
asinh = newMeasurement asinh
acosh = newMeasurement acosh
atanh = newMeasurement atanh
sqrtDiff :: Floating a => (forall a1. Floating a1 => a1 -> a1) -> a -> a -> a
sqrtDiff f a b = sqrt ((b**2) * diff f a ** 2)
newMeasurement :: Floating a => (forall a1. Floating a1 => a1 -> a1) -> Measurement a -> Measurement a
newMeasurement f (Measurement c d) = Measurement (f c) (sqrtDiff f c d)
Sure, but you won’t do those any more. You’ll write a polymorphic function of type forall a. Num a => a -> a (in which you can use +, - etc.) and then just run newMeasurement at the top level.