[Haskell-cafe] powering of new types
slemi
0slemi0 at gmail.com
Tue Dec 22 12:03:44 EST 2009
hey there and thanks for the replies to my earlier question, here is the next
one:
i have defined both the (*) and (/) operators for my new type
data Matrix a = Matr {unMatr :: [[a]]} | Scalar a
deriving (Show, Eq)
(*) being matrix multiplication and
(/) being multiplication with inverse
i also defined them for scalars
this allows me to use the (^^) powering operator, which works fine with
non-zero exponents.
however to my surprise when i try (^^ 0) the answer is (Scalar 1), and not
the identity matrix as expected.
does this mean that (a ^^ 0) is not defined as (a ^^ 1 * a ^^ (-1)) (or
better yet (a / a)) in the prelude?
if so, can i redefine it so that it gives the right answer?
i am also very interested in how ghci got the answer (Scalar 1), it seems
quite magical:)
here are my operator definitions:
instance RealFrac a => Num (Matrix a) where
(Matr as) * (Matr bs) = Matr $ timesH as bs
(Scalar a) * (Matr b) = Matr $ timesSH a b
(Matr a) * (Scalar b) = Matr $ timesSH b a
(Scalar a) * (Scalar b) = Scalar (a * b)
instance RealFrac a => Fractional (Matrix a) where
(Scalar a) / (Scalar b) = Scalar (a / b)
(Matr a) / (Scalar b) = Matr $ map (map (/ b)) a
a / b
| a == b = idM a
| otherwise = a * (inv b)
liftMatr = (Matr .) . (. unMatr)
transH = foldr (zipWith (:)) (repeat [])
timesH :: RealFrac a => [[a]] -> [[a]] -> [[a]]
timesH as bs = map (\p -> map (foldr1 (+) . zipWith (*) p) (transH bs)) as
timesSH :: RealFrac a => a -> [[a]] -> [[a]]
timesSH a = map (map (a *))
idM :: RealFrac a => Matrix a -> Matrix a
idM = liftMatr idMH
idMH :: RealFrac a => [[a]] -> [[a]]
idMH as = let n = length as in take n . map (take n) . iterate (0 :) $ 1
:repeat 0
--
View this message in context: http://old.nabble.com/powering-of-new-types-tp26891202p26891202.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
More information about the Haskell-Cafe
mailing list