From e0528e1a1e9ada67a39a0494f7dfccc2b6aefcad Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Sat, 15 Sep 2007 17:55:50 +0000 Subject: code refactoring --- lib/GSLHaskell.hs | 158 ++---------------------------------------------------- 1 file changed, 4 insertions(+), 154 deletions(-) (limited to 'lib/GSLHaskell.hs') diff --git a/lib/GSLHaskell.hs b/lib/GSLHaskell.hs index 3158458..254a957 100644 --- a/lib/GSLHaskell.hs +++ b/lib/GSLHaskell.hs @@ -9,7 +9,7 @@ Maintainer : Alberto Ruiz (aruiz at um dot es) Stability : provisional Portability : uses -fffi and -fglasgow-exts -GSLHaskell interface, with reasonable numeric instances for Vectors and Matrices. In the context of the standard numeric operators, one-component vectors and matrices automatically expand to match the dimensions of the other operand. +Old GSLHaskell interface. -} ----------------------------------------------------------------------------- @@ -46,7 +46,6 @@ import GSL.Special(setErrorHandlerOff, bessel_J0_e, exp_e10_e, gamma) ---import Data.Packed.Internal hiding (dsp,comp) import Data.Packed.Vector import Data.Packed.Matrix import Data.Packed.Matrix hiding ((><)) @@ -55,163 +54,14 @@ import qualified LinearAlgebra.Algorithms import LAPACK import GSL.Matrix import LinearAlgebra.Algorithms hiding (pnorm) -import LinearAlgebra.Linear +import LinearAlgebra.Linear hiding (Mul,(<>)) +import Data.Packed.Internal.Matrix(multiply) import Complex import Numeric(showGFloat) import Data.List(transpose,intersperse) import Foreign(Storable) import Data.Array - - -adaptScalar f1 f2 f3 x y - | dim x == 1 = f1 (x@>0) y - | dim y == 1 = f3 x (y@>0) - | otherwise = f2 x y - -liftMatrix2' :: (Field t, Field a, Field b) => (Vector a -> Vector b -> Vector t) -> Matrix a -> Matrix b -> Matrix t -liftMatrix2' f m1 m2 | compat' m1 m2 = reshape (max (cols m1) (cols m2)) (f (flatten m1) (flatten m2)) - | otherwise = error "nonconformant matrices in liftMatrix2'" - -compat' :: Matrix a -> Matrix b -> Bool -compat' m1 m2 = rows m1 == 1 && cols m1 == 1 - || rows m2 == 1 && cols m2 == 1 - || rows m1 == rows m2 && cols m1 == cols m2 - -instance (Eq a, Field a) => Eq (Vector a) where - a == b = dim a == dim b && toList a == toList b - -instance (Linear Vector a) => Num (Vector a) where - (+) = adaptScalar addConstant add (flip addConstant) - negate = scale (-1) - (*) = adaptScalar scale mul (flip scale) - signum = liftVector signum - abs = liftVector abs - fromInteger = fromList . return . fromInteger - -instance (Eq a, Field a) => Eq (Matrix a) where - a == b = cols a == cols b && flatten a == flatten b - -instance (Field a, Linear Vector a) => Num (Matrix a) where - (+) = liftMatrix2' (+) - (-) = liftMatrix2' (-) - negate = liftMatrix negate - (*) = liftMatrix2' (*) - signum = liftMatrix signum - abs = liftMatrix abs - fromInteger = (1><1) . return . fromInteger - ---------------------------------------------------- - -instance Fractional (Vector Double) where - fromRational n = fromList [fromRational n] - (/) = adaptScalar f (vectorZipR Div) g where - r `f` v = vectorMapValR Recip r v - v `g` r = scale (recip r) v - -------------------------------------------------------- - -instance Fractional (Vector (Complex Double)) where - fromRational n = fromList [fromRational n] - (/) = adaptScalar f (vectorZipC Div) g where - r `f` v = vectorMapValC Recip r v - v `g` r = scale (recip r) v - ------------------------------------------------------- - -instance Fractional (Matrix Double) where - fromRational n = (1><1) [fromRational n] - (/) = liftMatrix2' (/) - -------------------------------------------------------- - -instance Fractional (Matrix (Complex Double)) where - fromRational n = (1><1) [fromRational n] - (/) = liftMatrix2' (/) - ---------------------------------------------------------- - -instance Floating (Vector Double) where - sin = vectorMapR Sin - cos = vectorMapR Cos - tan = vectorMapR Tan - asin = vectorMapR ASin - acos = vectorMapR ACos - atan = vectorMapR ATan - sinh = vectorMapR Sinh - cosh = vectorMapR Cosh - tanh = vectorMapR Tanh - asinh = vectorMapR ASinh - acosh = vectorMapR ACosh - atanh = vectorMapR ATanh - exp = vectorMapR Exp - log = vectorMapR Log - sqrt = vectorMapR Sqrt - (**) = adaptScalar (vectorMapValR PowSV) (vectorZipR Pow) (flip (vectorMapValR PowVS)) - pi = fromList [pi] - ------------------------------------------------------------ - -instance Floating (Matrix Double) where - sin = liftMatrix sin - cos = liftMatrix cos - tan = liftMatrix tan - asin = liftMatrix asin - acos = liftMatrix acos - atan = liftMatrix atan - sinh = liftMatrix sinh - cosh = liftMatrix cosh - tanh = liftMatrix tanh - asinh = liftMatrix asinh - acosh = liftMatrix acosh - atanh = liftMatrix atanh - exp = liftMatrix exp - log = liftMatrix log - (**) = liftMatrix2' (**) - sqrt = liftMatrix sqrt - pi = (1><1) [pi] -------------------------------------------------------------- - -instance Floating (Vector (Complex Double)) where - sin = vectorMapC Sin - cos = vectorMapC Cos - tan = vectorMapC Tan - asin = vectorMapC ASin - acos = vectorMapC ACos - atan = vectorMapC ATan - sinh = vectorMapC Sinh - cosh = vectorMapC Cosh - tanh = vectorMapC Tanh - asinh = vectorMapC ASinh - acosh = vectorMapC ACosh - atanh = vectorMapC ATanh - exp = vectorMapC Exp - log = vectorMapC Log - sqrt = vectorMapC Sqrt - (**) = adaptScalar (vectorMapValC PowSV) (vectorZipC Pow) (flip (vectorMapValC PowVS)) - pi = fromList [pi] - ---------------------------------------------------------------- - -instance Floating (Matrix (Complex Double)) where - sin = liftMatrix sin - cos = liftMatrix cos - tan = liftMatrix tan - asin = liftMatrix asin - acos = liftMatrix acos - atan = liftMatrix atan - sinh = liftMatrix sinh - cosh = liftMatrix cosh - tanh = liftMatrix tanh - asinh = liftMatrix asinh - acosh = liftMatrix acosh - atanh = liftMatrix atanh - exp = liftMatrix exp - log = liftMatrix log - (**) = liftMatrix2' (**) - sqrt = liftMatrix sqrt - pi = (1><1) [pi] - ---------------------------------------------------------------- +import LinearAlgebra.Instances class Mul a b c | a b -> c where -- cgit v1.2.3