From d7b7ff9dff27a6a74785c92c9393704fe0072e0e Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Thu, 22 Dec 2011 17:26:09 +0100 Subject: ok hmatrix, hmatrix-tests, hmatrix-glpk --- lib/Numeric/Container.hs | 6 +-- lib/Numeric/ContainerBoot.hs | 89 ++------------------------------- lib/Numeric/GSL/Fitting.hs | 2 +- lib/Numeric/LinearAlgebra/Algorithms.hs | 15 +++--- 4 files changed, 12 insertions(+), 100 deletions(-) (limited to 'lib') diff --git a/lib/Numeric/Container.hs b/lib/Numeric/Container.hs index 90155fe..eded19c 100644 --- a/lib/Numeric/Container.hs +++ b/lib/Numeric/Container.hs @@ -59,11 +59,7 @@ module Numeric.Container ( readMatrix, fscanfVector, fprintfVector, freadVector, fwriteVector, -- * Experimental - build', konst', - -- * Deprecated - (.*),(*/),(<|>),(<->), - vectorMax,vectorMin, - vectorMaxIndex, vectorMinIndex + build', konst' ) where import Data.Packed diff --git a/lib/Numeric/ContainerBoot.hs b/lib/Numeric/ContainerBoot.hs index a605545..d913435 100644 --- a/lib/Numeric/ContainerBoot.hs +++ b/lib/Numeric/ContainerBoot.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE PolyKinds #-} ----------------------------------------------------------------------------- -- | @@ -37,11 +38,7 @@ module Numeric.ContainerBoot ( IndexOf, module Data.Complex, -- * Experimental - build', konst', - -- * Deprecated - (.*),(*/),(<|>),(<->), - vectorMax,vectorMin, - vectorMaxIndex, vectorMinIndex + build', konst' ) where import Data.Packed @@ -49,7 +46,7 @@ import Data.Packed.ST as ST import Numeric.Conversion import Data.Packed.Internal import Numeric.GSL.Vector - +import Foreign.C.Types(CInt(..)) import Data.Complex import Control.Monad(ap) @@ -526,86 +523,6 @@ conjugateC :: Vector (Complex Double) -> Vector (Complex Double) conjugateC = conjugateAux c_conjugateC foreign import ccall "conjugateC" c_conjugateC :: TCVCV ----------------------------------------------------- - -{-# DEPRECATED (.*) "use scale a x or scalar a * x" #-} - --- -- | @x .* a = scale x a@ --- (.*) :: (Linear c a) => a -> c a -> c a -infixl 7 .* -a .* x = scale a x - ----------------------------------------------------- - -{-# DEPRECATED (*/) "use scale (recip a) x or x / scalar a" #-} - --- -- | @a *\/ x = scale (recip x) a@ --- (*/) :: (Linear c a) => c a -> a -> c a -infixl 7 */ -v */ x = scale (recip x) v - - ------------------------------------------------- - -{-# DEPRECATED (<|>) "define operator a & b = fromBlocks[[a,b]] and use asRow/asColumn to join vectors" #-} -{-# DEPRECATED (<->) "define operator a // b = fromBlocks[[a],[b]] and use asRow/asColumn to join vectors" #-} - -class Joinable a b where - joinH :: Element t => a t -> b t -> Matrix t - joinV :: Element t => a t -> b t -> Matrix t - -instance Joinable Matrix Matrix where - joinH m1 m2 = fromBlocks [[m1,m2]] - joinV m1 m2 = fromBlocks [[m1],[m2]] - -instance Joinable Matrix Vector where - joinH m v = joinH m (asColumn v) - joinV m v = joinV m (asRow v) - -instance Joinable Vector Matrix where - joinH v m = joinH (asColumn v) m - joinV v m = joinV (asRow v) m - -infixl 4 <|> -infixl 3 <-> - -{-- - | Horizontal concatenation of matrices and vectors: - -@> (ident 3 \<-\> 3 * ident 3) \<|\> fromList [1..6.0] -(6><4) - [ 1.0, 0.0, 0.0, 1.0 - , 0.0, 1.0, 0.0, 2.0 - , 0.0, 0.0, 1.0, 3.0 - , 3.0, 0.0, 0.0, 4.0 - , 0.0, 3.0, 0.0, 5.0 - , 0.0, 0.0, 3.0, 6.0 ]@ --} --- (<|>) :: (Element t, Joinable a b) => a t -> b t -> Matrix t -a <|> b = joinH a b - --- -- | Vertical concatenation of matrices and vectors. --- (<->) :: (Element t, Joinable a b) => a t -> b t -> Matrix t -a <-> b = joinV a b - -------------------------------------------------------------------- - -{-# DEPRECATED vectorMin "use minElement" #-} -vectorMin :: (Container Vector t, Element t) => Vector t -> t -vectorMin = minElement - -{-# DEPRECATED vectorMax "use maxElement" #-} -vectorMax :: (Container Vector t, Element t) => Vector t -> t -vectorMax = maxElement - - -{-# DEPRECATED vectorMaxIndex "use minIndex" #-} -vectorMaxIndex :: Vector Double -> Int -vectorMaxIndex = round . toScalarR MaxIdx - -{-# DEPRECATED vectorMinIndex "use maxIndex" #-} -vectorMinIndex :: Vector Double -> Int -vectorMinIndex = round . toScalarR MinIdx - ----------------------------------------------------- class Build f where diff --git a/lib/Numeric/GSL/Fitting.hs b/lib/Numeric/GSL/Fitting.hs index 337dc6a..da5c0fc 100644 --- a/lib/Numeric/GSL/Fitting.hs +++ b/lib/Numeric/GSL/Fitting.hs @@ -54,7 +54,7 @@ import Numeric.LinearAlgebra import Numeric.GSL.Internal import Foreign.Ptr(FunPtr, freeHaskellFunPtr) -import Foreign.C.Types(CInt) +import Foreign.C.Types(CInt(..)) import System.IO.Unsafe(unsafePerformIO) ------------------------------------------------------------------------- diff --git a/lib/Numeric/LinearAlgebra/Algorithms.hs b/lib/Numeric/LinearAlgebra/Algorithms.hs index bea33ea..9806d6f 100644 --- a/lib/Numeric/LinearAlgebra/Algorithms.hs +++ b/lib/Numeric/LinearAlgebra/Algorithms.hs @@ -3,6 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} + ----------------------------------------------------------------------------- {- | Module : Numeric.LinearAlgebra.Algorithms @@ -82,7 +83,7 @@ import Data.Packed.Matrix import Numeric.LinearAlgebra.LAPACK as LAPACK import Data.List(foldl1') import Data.Array -import Numeric.ContainerBoot hiding ((.*),(*/)) +import Numeric.ContainerBoot {- | Class used to define generic linear algebra computations for both real and complex matrices. Only double precision is supported in this version (we can @@ -567,7 +568,11 @@ epslist = [ (fromIntegral k, golubeps k k) | k <- [1..]] geps delta = head [ k | (k,g) <- epslist, g Matrix t -> Matrix t +expm m = iterate msq f !! j where j = max 0 $ floor $ logBase 2 $ pnorm Infinity m a = m */ fromIntegral ((2::Int)^j) q = geps eps -- 7 steps @@ -587,12 +592,6 @@ expGolub m = iterate msq f !! j (.*) = scale (|+|) = add -{- | Matrix exponential. It uses a direct translation of Algorithm 11.3.1 in Golub & Van Loan, - based on a scaled Pade approximation. --} -expm :: Field t => Matrix t -> Matrix t -expm = expGolub - -------------------------------------------------------------- {- | Matrix square root. Currently it uses a simple iterative algorithm described in Wikipedia. -- cgit v1.2.3