[Haskell-cafe] more generic class instances?
Nickolay Kudasov
nickolay.kudasov at gmail.com
Sat Nov 2 19:59:49 UTC 2013
I mentioned in my last email that you can do that with extra type parameter.
Apparently, it’s much simpler but my code needs some improvement:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
newtype Constant a = Constant a deriving (Eq, Ord, Num, Enum)
data Linear a = Linear a (Constant a)data Quadratic a =
Quadratic a (Linear a)data Arbitrary a = Arbitrary (forall n. Integral
n => n -> a)
class PartialSum term where
partialSum :: (Integral a, Num b) => a -> term b -> b
instance PartialSum Constant where
partialSum n (Constant c) = fromIntegral n * c
instance PartialSum Linear where
partialSum n (Linear k c) = k * fromIntegral (n * (n + 1) `div` 2) +
partialSum n c
instance PartialSum Quadratic where
partialSum n (Quadratic k l) = k * fromIntegral (n * (n + 1) * (2 *
n + 1) `div` 6) + partialSum n l
instance PartialSum Arbitrary where
partialSum n (Arbitrary f) = sum $ map f [1..n]
This gives you appropriate behavior:
-- integerspartialSum 10 $ Linear 1 0partialSum 10 $ Arbitrary (2^)--
floatspartialSum 10 $ Arbitrary (\n -> 1.5 * fromIntegral n ::
Float)partialSum 10 $ Arbitrary (sqrt . fromIntegral)-- complex (from
Data.Complex)partialSum 10 $ Arbitrary (\n -> fromIntegral n^2 :+
fromIntegral n)
Nick
2013/11/2 Christopher Howard <christopher.howard at frigidcode.com>
> Thanks for the continued help. The only issue with your recently described
> approach is that, as near as I can tell, it requires the terms to be
> integral.
>
>
> data Arbitrary a = Arbitrary (a -> a)
>
> class PartialSum term where
>
> partialSum :: (Integral a) => a -> term a -> a
>
> instance PartialSum Arbitrary where
>
> partialSum n (Arbitrary f) = sum $ map f [1..n]
>
> I cannot, for example, do
>
> h> partialSum 10 (Arbitrary (\x -> 1.5 * x :: Float))
>
> <interactive>:88:1:
>
> No instance for (Integral Float)
>
> arising from a use of `partialSum'
>
> Possible fix: add an instance declaration for (Integral Float)
>
> In the expression:
>
> partialSum 10 (Arbitrary (\ x -> 1.5 * x :: Float))
>
> In an equation for `it':
>
> it = partialSum 10 (Arbitrary (\ x -> 1.5 * x :: Float))
>
> h> partialSum 10 (Arbitrary (\ x -> (1 % 5) * x))
>
> <interactive>:100:1:
>
> No instance for (Integral (Ratio a0))
>
> arising from a use of `partialSum'
>
> Possible fix: add an instance declaration for (Integral (Ratio a0))
>
> In the expression: partialSum 10 (Arbitrary (\ x -> (1 % 5) * x))
>
> In an equation for `it':
>
> it = partialSum 10 (Arbitrary (\ x -> (1 % 5) * x))
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20131102/11aac817/attachment.html>
More information about the Haskell-Cafe
mailing list