summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Data/Packed/Internal/Common.hs4
-rw-r--r--lib/GSL/Differentiation.hs79
-rw-r--r--lib/GSL/Integration.hs90
-rw-r--r--lib/GSL/Special.hs101
-rw-r--r--lib/GSL/Vector.hs14
5 files changed, 287 insertions, 1 deletions
diff --git a/lib/Data/Packed/Internal/Common.hs b/lib/Data/Packed/Internal/Common.hs
index dddd269..acefe92 100644
--- a/lib/Data/Packed/Internal/Common.hs
+++ b/lib/Data/Packed/Internal/Common.hs
@@ -82,3 +82,7 @@ isComp w x = typeOf (undefined :: Complex Double) == typeOf (w x)
82 82
83scast :: forall a . forall b . (Typeable a, Typeable b) => a -> b 83scast :: forall a . forall b . (Typeable a, Typeable b) => a -> b
84scast = fromJust . cast 84scast = fromJust . cast
85
86{- | conversion of Haskell functions into function pointers that can be used in the C side
87-}
88foreign import ccall "wrapper" mkfun:: (Double -> Ptr() -> Double) -> IO( FunPtr (Double -> Ptr() -> Double))
diff --git a/lib/GSL/Differentiation.hs b/lib/GSL/Differentiation.hs
new file mode 100644
index 0000000..6fd7565
--- /dev/null
+++ b/lib/GSL/Differentiation.hs
@@ -0,0 +1,79 @@
1{-# OPTIONS #-}
2-----------------------------------------------------------------------------
3{- |
4Module : GSL.Differentiation
5Copyright : (c) Alberto Ruiz 2006
6License : GPL-style
7
8Maintainer : Alberto Ruiz (aruiz at um dot es)
9Stability : provisional
10Portability : uses ffi
11
12Numerical differentiation.
13
14<http://www.gnu.org/software/gsl/manual/html_node/Numerical-Differentiation.html#Numerical-Differentiation>
15
16From the GSL manual: \"The functions described in this chapter compute numerical derivatives by finite differencing. An adaptive algorithm is used to find the best choice of finite difference and to estimate the error in the derivative.\"
17-}
18-----------------------------------------------------------------------------
19module GSL.Differentiation (
20 derivCentral,
21 derivForward,
22 derivBackward
23) where
24
25import Foreign
26import Data.Packed.Internal.Common(mkfun,check,(//))
27
28derivGen ::
29 Int -- ^ type: 0 central, 1 forward, 2 backward
30 -> Double -- ^ initial step size
31 -> (Double -> Double) -- ^ function
32 -> Double -- ^ point where the derivative is taken
33 -> (Double, Double) -- ^ result and error
34derivGen c h f x = unsafePerformIO $ do
35 r <- malloc
36 e <- malloc
37 fp <- mkfun (\x _ -> f x)
38 c_deriv c fp x h r e // check "deriv" []
39 vr <- peek r
40 ve <- peek e
41 let result = (vr,ve)
42 free r
43 free e
44 freeHaskellFunPtr fp
45 return result
46
47foreign import ccall "gsl-aux.h deriv"
48 c_deriv :: Int -> FunPtr (Double -> Ptr () -> Double) -> Double -> Double
49 -> Ptr Double -> Ptr Double -> IO Int
50
51
52{- | Adaptive central difference algorithm, /gsl_deriv_central/. For example:
53
54> > let deriv = derivCentral 0.01
55> > deriv sin (pi/4)
56>(0.7071067812000676,1.0600063101654055e-10)
57> > cos (pi/4)
58>0.7071067811865476
59
60-}
61derivCentral :: Double -- ^ initial step size
62 -> (Double -> Double) -- ^ function
63 -> Double -- ^ point where the derivative is taken
64 -> (Double, Double) -- ^ result and absolute error
65derivCentral = derivGen 0
66
67-- | Adaptive forward difference algorithm, /gsl_deriv_forward/. The function is evaluated only at points greater than x, and never at x itself. The derivative is returned in result and an estimate of its absolute error is returned in abserr. This function should be used if f(x) has a discontinuity at x, or is undefined for values less than x. A backward derivative can be obtained using a negative step.
68derivForward :: Double -- ^ initial step size
69 -> (Double -> Double) -- ^ function
70 -> Double -- ^ point where the derivative is taken
71 -> (Double, Double) -- ^ result and absolute error
72derivForward = derivGen 1
73
74-- | Adaptive backward difference algorithm, /gsl_deriv_backward/.
75derivBackward ::Double -- ^ initial step size
76 -> (Double -> Double) -- ^ function
77 -> Double -- ^ point where the derivative is taken
78 -> (Double, Double) -- ^ result and absolute error
79derivBackward = derivGen 2
diff --git a/lib/GSL/Integration.hs b/lib/GSL/Integration.hs
new file mode 100644
index 0000000..dd76be8
--- /dev/null
+++ b/lib/GSL/Integration.hs
@@ -0,0 +1,90 @@
1{-# OPTIONS #-}
2-----------------------------------------------------------------------------
3{- |
4Module : GSL.Integration
5Copyright : (c) Alberto Ruiz 2006
6License : GPL-style
7
8Maintainer : Alberto Ruiz (aruiz at um dot es)
9Stability : provisional
10Portability : uses ffi
11
12Numerical integration routines.
13
14<http://www.gnu.org/software/gsl/manual/html_node/Numerical-Integration.html#Numerical-Integration>
15-}
16-----------------------------------------------------------------------------
17
18module GSL.Integration (
19 integrateQNG,
20 integrateQAGS
21) where
22
23import Foreign
24import Data.Packed.Internal.Common(mkfun,check,(//))
25
26
27--------------------------------------------------------------------
28{- | Numerical integration using /gsl_integration_qags/ (adaptive integration with singularities). For example:
29
30@\> let quad = integrateQAGS 1E-9 1000
31\> let f a x = x**(-0.5) * log (a*x)
32\> quad (f 1) 0 1
33(-3.999999999999974,4.871658632055187e-13)@
34
35-}
36
37integrateQAGS :: Double -- ^ precision (e.g. 1E-9)
38 -> Int -- ^ size of auxiliary workspace (e.g. 1000)
39 -> (Double -> Double) -- ^ function to be integrated on the interval (a,b)
40 -> Double -- ^ a
41 -> Double -- ^ b
42 -> (Double, Double) -- ^ result of the integration and error
43integrateQAGS prec n f a b = unsafePerformIO $ do
44 r <- malloc
45 e <- malloc
46 fp <- mkfun (\x _ -> f x)
47 c_integrate_qags fp a b prec n r e // check "integrate_qags" []
48 vr <- peek r
49 ve <- peek e
50 let result = (vr,ve)
51 free r
52 free e
53 freeHaskellFunPtr fp
54 return result
55
56foreign import ccall "gsl-aux.h integrate_qags"
57 c_integrate_qags :: FunPtr (Double-> Ptr() -> Double) -> Double -> Double -> Double -> Int
58 -> Ptr Double -> Ptr Double -> IO Int
59
60-----------------------------------------------------------------
61{- | Numerical integration using /gsl_integration_qng/ (useful for fast integration of smooth functions). For example:
62
63@\> let quad = integrateQNG 1E-6
64\> quad (\\x -> 4\/(1+x*x)) 0 1
65(3.141592653589793,3.487868498008632e-14)@
66
67-}
68
69integrateQNG :: Double -- ^ precision (e.g. 1E-9)
70 -> (Double -> Double) -- ^ function to be integrated on the interval (a,b)
71 -> Double -- ^ a
72 -> Double -- ^ b
73 -> (Double, Double) -- ^ result of the integration and error
74integrateQNG prec f a b = unsafePerformIO $ do
75 r <- malloc
76 e <- malloc
77 fp <- mkfun (\x _ -> f x)
78 c_integrate_qng fp a b prec r e // check "integrate_qng" []
79 vr <- peek r
80 ve <- peek e
81 let result = (vr,ve)
82 free r
83 free e
84 freeHaskellFunPtr fp
85 return result
86
87foreign import ccall "gsl-aux.h integrate_qng"
88 c_integrate_qng :: FunPtr (Double-> Ptr() -> Double) -> Double -> Double -> Double
89 -> Ptr Double -> Ptr Double -> IO Int
90
diff --git a/lib/GSL/Special.hs b/lib/GSL/Special.hs
new file mode 100644
index 0000000..643c499
--- /dev/null
+++ b/lib/GSL/Special.hs
@@ -0,0 +1,101 @@
1{-# OPTIONS #-}
2-----------------------------------------------------------------------------
3{- |
4Module : GSL.Special
5Copyright : (c) Alberto Ruiz 2006
6License : GPL-style
7
8Maintainer : Alberto Ruiz (aruiz at um dot es)
9Stability : provisional
10Portability : uses ffi
11
12Special functions.
13
14<http://www.gnu.org/software/gsl/manual/html_node/Special-Functions.html#Special-Functions>
15-}
16-----------------------------------------------------------------------------
17
18module GSL.Special (
19 erf,
20 erf_Z,
21 bessel_J0_e,
22 exp_e10_e
23)
24where
25
26import Foreign
27import Data.Packed.Internal.Common(check,(//))
28
29----------------------------------------------------------------
30-------------------- simple functions --------------------------
31
32{- | The error function (/gsl_sf_erf/), defined as 2\/ \\sqrt \\pi * \int\_0\^t \\exp -t\^2 dt.
33
34@> erf 1.5
350.9661051464753108@
36
37-}
38foreign import ccall "gsl-aux.h gsl_sf_erf" erf :: Double -> Double
39
40{- | The Gaussian probability density function (/gsl_sf_erf_Z/), defined as (1\/\\sqrt\{2\\pi\}) \\exp(-x\^2\/2).
41
42>> erf_Z 1.5
43>0.12951759566589172
44
45-}
46foreign import ccall "gsl-aux.h gsl_sf_erf_Z" erf_Z :: Double -> Double
47
48----------------------------------------------------------------
49-- the sf_result struct is equivalent to an array of two doubles
50
51createSFR s f = unsafePerformIO $ do
52 p <- mallocArray 2
53 f p // check "createSFR" []
54 [val,err] <- peekArray 2 p
55 free p
56 return (val,err)
57
58-------------------- functions returning sf_result -------------
59
60{- | The regular cylindrical Bessel function of zeroth order, J_0(x). This is
61 the example in the GSL manual, returning the value of the function and
62 the error term:
63
64@\> bessel_J0_e 5.0
65(-0.1775967713143383,1.9302109579684196e-16)@
66
67-}
68bessel_J0_e :: Double -> (Double,Double)
69bessel_J0_e x = createSFR "bessel_J0_e" (gsl_sf_bessel_J0_e x)
70foreign import ccall "gsl-aux.h gsl_sf_bessel_J0_e" gsl_sf_bessel_J0_e :: Double -> Ptr Double -> IO Int
71
72---------------------------------------------------------------------
73-- the sf_result_e10 contains two doubles and the exponent
74
75createSFR_E10 s f = unsafePerformIO $ do
76 let sd = sizeOf (0::Double)
77 let si = sizeOf (0::Int)
78 p <- mallocBytes (2*sd + si)
79 f p // check "createSFR_E10" []
80 val <- peekByteOff p 0
81 err <- peekByteOff p sd
82 expo <- peekByteOff p (2*sd)
83 free p
84 return (val,expo,err)
85
86-------------------- functions returning sf_result_e10 -------------
87
88{- | (From the GSL manual) \"This function computes the exponential \exp(x) using the @gsl_sf_result_e10@ type to return a result with extended range. This function may be useful if the value of \exp(x) would overflow the numeric range of double\".
89
90For example:
91
92@\> exp_e10_e 30.0
93(1.0686474581524432,1.4711818964275088e-14,13)@
94
95@\> exp 30.0
961.0686474581524463e13@
97
98-}
99exp_e10_e :: Double -> (Double,Int,Double)
100exp_e10_e x = createSFR_E10 "exp_e10_e" (gsl_sf_exp_e10_e x)
101foreign import ccall "gsl-aux.h gsl_sf_exp_e10_e" gsl_sf_exp_e10_e :: Double -> Ptr Double -> IO Int
diff --git a/lib/GSL/Vector.hs b/lib/GSL/Vector.hs
index e538b7e..3225139 100644
--- a/lib/GSL/Vector.hs
+++ b/lib/GSL/Vector.hs
@@ -18,7 +18,7 @@ module GSL.Vector (
18 FunCodeV(..), vectorMapR, vectorMapC, 18 FunCodeV(..), vectorMapR, vectorMapC,
19 FunCodeSV(..), vectorMapValR, vectorMapValC, 19 FunCodeSV(..), vectorMapValR, vectorMapValC,
20 FunCodeVV(..), vectorZipR, vectorZipC, 20 FunCodeVV(..), vectorZipR, vectorZipC,
21 scale, addConstant 21 scale, addConstant, add, mul,
22) where 22) where
23 23
24import Data.Packed.Internal 24import Data.Packed.Internal
@@ -79,6 +79,18 @@ addConstant x v | isReal baseOf v = scast $ vectorMapValR AddConstant (scast x)
79 | isComp baseOf v = scast $ vectorMapValC AddConstant (scast x) (scast v) 79 | isComp baseOf v = scast $ vectorMapValC AddConstant (scast x) (scast v)
80 | otherwise = fromList $ map (*x) $ toList v 80 | otherwise = fromList $ map (*x) $ toList v
81 81
82add :: (Num a, Field a) => Vector a -> Vector a -> Vector a
83add u v | isReal baseOf v = scast $ vectorZipR Add (scast u) (scast v)
84 | isComp baseOf v = scast $ vectorZipC Add (scast u) (scast v)
85 | otherwise = fromList $ zipWith (+) (toList u) (toList v)
86
87mul :: (Num a, Field a) => Vector a -> Vector a -> Vector a
88mul u v | isReal baseOf v = scast $ vectorZipR Mul (scast u) (scast v)
89 | isComp baseOf v = scast $ vectorZipC Mul (scast u) (scast v)
90 | otherwise = fromList $ zipWith (*) (toList u) (toList v)
91
92
93
82------------------------------------------------------------------ 94------------------------------------------------------------------
83 95
84toScalarAux fun code v = unsafePerformIO $ do 96toScalarAux fun code v = unsafePerformIO $ do