diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Data/Packed/Internal/Common.hs | 4 | ||||
-rw-r--r-- | lib/GSL/Differentiation.hs | 79 | ||||
-rw-r--r-- | lib/GSL/Integration.hs | 90 | ||||
-rw-r--r-- | lib/GSL/Special.hs | 101 | ||||
-rw-r--r-- | lib/GSL/Vector.hs | 14 |
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 | ||
83 | scast :: forall a . forall b . (Typeable a, Typeable b) => a -> b | 83 | scast :: forall a . forall b . (Typeable a, Typeable b) => a -> b |
84 | scast = fromJust . cast | 84 | scast = fromJust . cast |
85 | |||
86 | {- | conversion of Haskell functions into function pointers that can be used in the C side | ||
87 | -} | ||
88 | foreign 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 | {- | | ||
4 | Module : GSL.Differentiation | ||
5 | Copyright : (c) Alberto Ruiz 2006 | ||
6 | License : GPL-style | ||
7 | |||
8 | Maintainer : Alberto Ruiz (aruiz at um dot es) | ||
9 | Stability : provisional | ||
10 | Portability : uses ffi | ||
11 | |||
12 | Numerical differentiation. | ||
13 | |||
14 | <http://www.gnu.org/software/gsl/manual/html_node/Numerical-Differentiation.html#Numerical-Differentiation> | ||
15 | |||
16 | From 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 | ----------------------------------------------------------------------------- | ||
19 | module GSL.Differentiation ( | ||
20 | derivCentral, | ||
21 | derivForward, | ||
22 | derivBackward | ||
23 | ) where | ||
24 | |||
25 | import Foreign | ||
26 | import Data.Packed.Internal.Common(mkfun,check,(//)) | ||
27 | |||
28 | derivGen :: | ||
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 | ||
34 | derivGen 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 | |||
47 | foreign 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 | -} | ||
61 | derivCentral :: Double -- ^ initial step size | ||
62 | -> (Double -> Double) -- ^ function | ||
63 | -> Double -- ^ point where the derivative is taken | ||
64 | -> (Double, Double) -- ^ result and absolute error | ||
65 | derivCentral = 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. | ||
68 | derivForward :: Double -- ^ initial step size | ||
69 | -> (Double -> Double) -- ^ function | ||
70 | -> Double -- ^ point where the derivative is taken | ||
71 | -> (Double, Double) -- ^ result and absolute error | ||
72 | derivForward = derivGen 1 | ||
73 | |||
74 | -- | Adaptive backward difference algorithm, /gsl_deriv_backward/. | ||
75 | derivBackward ::Double -- ^ initial step size | ||
76 | -> (Double -> Double) -- ^ function | ||
77 | -> Double -- ^ point where the derivative is taken | ||
78 | -> (Double, Double) -- ^ result and absolute error | ||
79 | derivBackward = 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 | {- | | ||
4 | Module : GSL.Integration | ||
5 | Copyright : (c) Alberto Ruiz 2006 | ||
6 | License : GPL-style | ||
7 | |||
8 | Maintainer : Alberto Ruiz (aruiz at um dot es) | ||
9 | Stability : provisional | ||
10 | Portability : uses ffi | ||
11 | |||
12 | Numerical integration routines. | ||
13 | |||
14 | <http://www.gnu.org/software/gsl/manual/html_node/Numerical-Integration.html#Numerical-Integration> | ||
15 | -} | ||
16 | ----------------------------------------------------------------------------- | ||
17 | |||
18 | module GSL.Integration ( | ||
19 | integrateQNG, | ||
20 | integrateQAGS | ||
21 | ) where | ||
22 | |||
23 | import Foreign | ||
24 | import 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 | |||
37 | integrateQAGS :: 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 | ||
43 | integrateQAGS 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 | |||
56 | foreign 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 | |||
69 | integrateQNG :: 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 | ||
74 | integrateQNG 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 | |||
87 | foreign 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 | {- | | ||
4 | Module : GSL.Special | ||
5 | Copyright : (c) Alberto Ruiz 2006 | ||
6 | License : GPL-style | ||
7 | |||
8 | Maintainer : Alberto Ruiz (aruiz at um dot es) | ||
9 | Stability : provisional | ||
10 | Portability : uses ffi | ||
11 | |||
12 | Special functions. | ||
13 | |||
14 | <http://www.gnu.org/software/gsl/manual/html_node/Special-Functions.html#Special-Functions> | ||
15 | -} | ||
16 | ----------------------------------------------------------------------------- | ||
17 | |||
18 | module GSL.Special ( | ||
19 | erf, | ||
20 | erf_Z, | ||
21 | bessel_J0_e, | ||
22 | exp_e10_e | ||
23 | ) | ||
24 | where | ||
25 | |||
26 | import Foreign | ||
27 | import 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 | ||
35 | 0.9661051464753108@ | ||
36 | |||
37 | -} | ||
38 | foreign 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 | -} | ||
46 | foreign 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 | |||
51 | createSFR 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 | -} | ||
68 | bessel_J0_e :: Double -> (Double,Double) | ||
69 | bessel_J0_e x = createSFR "bessel_J0_e" (gsl_sf_bessel_J0_e x) | ||
70 | foreign 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 | |||
75 | createSFR_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 | |||
90 | For example: | ||
91 | |||
92 | @\> exp_e10_e 30.0 | ||
93 | (1.0686474581524432,1.4711818964275088e-14,13)@ | ||
94 | |||
95 | @\> exp 30.0 | ||
96 | 1.0686474581524463e13@ | ||
97 | |||
98 | -} | ||
99 | exp_e10_e :: Double -> (Double,Int,Double) | ||
100 | exp_e10_e x = createSFR_E10 "exp_e10_e" (gsl_sf_exp_e10_e x) | ||
101 | foreign 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 | ||
24 | import Data.Packed.Internal | 24 | import 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 | ||
82 | add :: (Num a, Field a) => Vector a -> Vector a -> Vector a | ||
83 | add 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 | |||
87 | mul :: (Num a, Field a) => Vector a -> Vector a -> Vector a | ||
88 | mul 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 | ||
84 | toScalarAux fun code v = unsafePerformIO $ do | 96 | toScalarAux fun code v = unsafePerformIO $ do |