[Haskell-cafe] Annotating calculations

robert dockins robdockins at fastmail.fm
Wed Jun 15 14:09:37 EDT 2005


Here is an idea I slammed out.  Maybe it will help you.

The basic idea is to create two types -- one which supports annotations 
and one which ignores them.  Only write your calculations once, with 
annotations.  Uses typeclasses to ignore the annotations when you don't 
want them.

Rene de Visser wrote:

> Hello,
> 
> I have a somewhat complicated calculation programmed in Haskell.
> This calculation is coded without using monads.
> 
> I want to also produce a report describing the details of this 
> calculation for each particular set of inputs.
> e.g. Number of hours worked = 100. Gross pay per hour = 50. Total gross 
> = 100 * 50 = 500.
> etc.
> But about 20 times more complicated than the above.
> 
> Naturally I need to write functions to produce the above 
> description/report as it should be well presented. Only showing the 
> important parts of the calculation in a sensible order.
> 
> But I am wondering how to combine the generation of the report with the 
> calculation together.
> 
> I think if I add the report generating functions into the calculation 
> functions, it will make them twice as messy, and they are already 
> complicated enough.
> 
> On the other hand replicating the calculation source code twice, once 
> without reporting and once without seems bad.
> 
> Any suggestions on how to handle this?
> 
> Rene.
> 
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
-------------- next part --------------
> {-# OPTIONS -fglasgow-exts #-}
>
> data Annotation a
>   = TotalGrossCalc a a a
>   | SumCalculation [a] a
>   | SomeCalculation a
>   | AbsCalc a
>   | SignumCalc a
>  deriving Show
 
 add a different Show instance here for meaningful reporting
 
> class (Show a,Num a,Num x) => Annotatable a x | a -> x where
>     mkAnnotatible :: x -> a
>     annotate :: a -> Annotation a -> a
>
> newtype Num a => JustCalc a = JustCalc a deriving (Eq,Num)
> data AnnotateCalc a = AnnotateCalc a [Annotation (AnnotateCalc a)]

ignore annotations for JustCalc

> instance Num a => Annotatable (JustCalc a) a where 
>    mkAnnotatible x = JustCalc x
>    annotate x _ = x

keep hold of them for AnnotateCalc

> instance Num a => Annotatable (AnnotateCalc a) a where
>     mkAnnotatible x = AnnotateCalc x []
>     annotate (AnnotateCalc x messages) msg = AnnotateCalc x (msg:messages)

some boilerplate...

> instance Eq a => Eq (AnnotateCalc a) where
>	(AnnotateCalc x _ ) == (AnnotateCalc y _ ) = x == y
>
> instance Num a => Num (AnnotateCalc a) where
>     (AnnotateCalc x x_msg) + (AnnotateCalc y y_msg) =
>           AnnotateCalc (x+y) (x_msg++y_msg)
>     (AnnotateCalc x x_msg) * (AnnotateCalc y y_msg) =
>           AnnotateCalc (x*y) (x_msg++y_msg)
>     fromInteger x = (AnnotateCalc (fromInteger x) []) 
>     abs z@(AnnotateCalc x x_msg) = 
>	AnnotateCalc (abs x) ((AbsCalc z):x_msg)
>     signum z@(AnnotateCalc x x_msg) =
>       AnnotateCalc (signum x) ((SignumCalc z):x_msg)

> instance Show a => Show (AnnotateCalc a) where
>      show (AnnotateCalc x _ ) = show x
>
> instance (Show a,Num a) => Show (JustCalc a) where
>      show (JustCalc x) = show x

now some calculations

> sumOfHours :: Annotatable a x => [a] -> a
> sumOfHours xs = annotate result (SumCalculation xs result)
>    where result = sum xs

> grossTotal :: Annotatable a x => a -> a -> a
> grossTotal hoursWorked payRate = annotate result (TotalGrossCalc hoursWorked payRate result)
>       where result = hoursWorked * payRate

> someCalculation :: Annotatable a x => [a] -> a -> a
> someCalculation hrs rate = annotate result (SomeCalculation result)
>       where result = grossTotal (sumOfHours hrs) rate
>
> printAnnotations (AnnotateCalc _ annotations) = sequence $ map (putStrLn . show) (reverse annotations)
>
> sample :: Annotatable a x => a
> sample = someCalculation (map mkAnnotatible [12,34,23,31]) (mkAnnotatible 50)
>
> main = do let sample1 = sample :: JustCalc Integer
>               sample2 = sample :: AnnotateCalc Integer
>           putStrLn $ show sample1
>           putStrLn $ show sample2
>           printAnnotations sample2


More information about the Haskell-Cafe mailing list