[Haskell-cafe] more generic class instances?
Nickolay Kudasov
nickolay.kudasov at gmail.com
Sat Nov 2 12:27:44 UTC 2013
Okay, I think I got what you are trying to accomplish.
With separate data types for each term type this could be done like that:
newtype Constant a = Constant a deriving (Eq, Show, Enum, Num)
data Linear a = Linear a (Constant a)data Quadratic a =
Quadratic a (Linear a) data Arbitrary a = Arbitrary (a -> a)
class PartialSum term where
partialSum :: (Integral a) => a -> term a -> a
instance PartialSum Constant where
partialSum n (Constant c) = n * c
instance PartialSum Linear where
partialSum n (Linear k c) = k * n * (n + 1) `div` 2 + partialSum n c
instance PartialSum Quadratic where
partialSum n (Quadratic k l) = k * n * (n + 1) * (2 * n + 1) `div` 6
+ partialSum n l
instance PartialSum Arbitrary where
partialSum n (Arbitrary f) = sum $ map f [1..n]
Now you can calculate partialSum effectively like that:
partialSum 10 $ Quadratic 1 $ Linear 2 1 -- sum = 505, a_n = n^2 +
2n + 1partialSum 10 $ Linear 3 (-1) -- sum = 155, a_n =
3n - 1partialSum 10 $ Arbitrary (2^) -- sum = 2046, a_n =
2^n
Note that I didn’t use any of FunctionalDependencies or
TypeFamiliesextensions. Instead I made terms accept a type parameter.
You can easily
make types of a_n and n different using 2 type parameters, but I kept them
the same for simplicity.
The problem with this implementation is that you can’t compose different
terms. E.g. if you have term1 :: Linear Int and term2 :: Quadratic Int, you
can’t write term1 + term2. If you’d like to do that, you can make a single
data structure representing all kinds of terms:
data Term a
= Constant a
| Linear a a
| Quadratic a a a
| Arbitrary (a -> a)
Now you could implement a Num instance on that:
instance Num a => Num (Term a) where
fromInteger = Constant ∘ fromInteger
Constant c + Linear k c' = Linear k (c + c')
Constant c + Quadratic a k c' = Quadratic a k (c + c')
Linear k c + Quadratic a k' c' = Quadratic a (k + k') (c + c')
-- ...
x + y = y + x
Constant c * Linear k c' = Linear (c * k) (c * c')
Constant c * Quadratic a b c' = Quadratic (c * a) (c * b) (c * c')
-- ...
x * y = y * x
negate (Constant c) = Constant (negate c)
negate (Linear k b) = Linear (negate k) (negate b)
negate (Quadratic a b c) = Quadratic (negate a) (negate b) (negate c)
-- ...
as well as partialSum:
partialSum :: (Integral a) => a -> Term a -> apartialSum n (Constant
c) = n * cpartialSum n (Linear k b) = k * n * (n + 1) `div`
2 + partialSum n (Constant b)partialSum n (Quadratic a b c) = a * n *
(n + 1) * (2 * n + 1) `div` 6 + partialSum n (Linear b c)partialSum n
(Arbitrary f) = sum $ map f [1..n]
Note that we don’t have to use typeclasses for that!
Finally, you could make some useful aliases:
n :: Integral a => Term an = Linear 1 0
n2 :: Integral a => Term an2 = Quadratic 1 0 0
And go on calculating what you want:
partialSum 10 $ 3 * n2 - 5 * n + 10 -- sum = 980
Hope that helps,
Nick
2013/11/2 Christopher Howard <christopher.howard at frigidcode.com>
> On 11/01/2013 11:14 PM, Nickolay Kudasov wrote:
>
> Hi Christopher,
>
> What you want is to make b (and a) depend on f. This can be done in
> several ways.
>
> With functional dependencies:
>
> class (Integral a, Num b) => PartialSum a b f | f -> a b where
> partialSum :: f -> a -> b
> instance (Integral a, Num b) => PartialSum a b (a -> b) where
> partialSum f n = foldl (\u v -> u + f v) 0 [1..n]
>
> With type families:
>
> class PartialSum f where
> type End f
> type Res f
> partialSum' :: f -> End f -> Res f
> instance (Integral a, Num b) => PartialSum (a -> b) where
> type End (a -> b) = a
> type Res (a -> b) = b
> partialSum f n = foldl (\u v -> u + f v) 0 [1..n]
>
> I can’t see though what you’re trying to achieve. Could you provide some
> more use cases for that class?
>
>
> Thanks for the response. I'll have to read up more on functional
> dependencies and type families. Which do you think is more appropriate?
>
> This little class is mostly just a test case for me to use in exploring
> the specialization idea. Partial sums are something mentioned in my math
> class. Generically, you can calculate any partial sum by adding up the
> terms (a_1 + a_2 + a_3 + ... + a_n). However, when the terms are in certain
> forms, you can use shortcut formulas. E.g., if the term is just n, then you
> can just plug n into n*(n+1)/2.
>
> So, the idea was to have a partialSum function that can calculate the
> partial sum with any function passed to it (the long and slow way) but can
> use a shortcut method when the function is of a particular form. Say, a
> term of this type:
>
> data LinearTerm f = LinearTerm f -- constructor not exported
> linearTerm coefficient = LinearTerm (\x -> coefficient * x)
>
> If my toy case is silly, I'm sure there are plenty of better examples that
> could be given. For example, sorting functions that can "choose" better
> algorithms depending on the type. (Say, the generic function uses a
> comparison sort, but a type with a small number of possible values would be
> better suited for a pigeon hole algorithm.)
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20131102/4d37d982/attachment.html>
More information about the Haskell-Cafe
mailing list