code refactoring

1 files changed, 4 insertions, 154 deletions

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