summaryrefslogtreecommitdiff
path: root/packages/gsl/src/Numeric/GSL
diff options
context:
space:
mode:
Diffstat (limited to 'packages/gsl/src/Numeric/GSL')
-rw-r--r--packages/gsl/src/Numeric/GSL/Fitting.hs2
-rw-r--r--packages/gsl/src/Numeric/GSL/Fourier.hs5
-rw-r--r--packages/gsl/src/Numeric/GSL/Internal.hs20
-rw-r--r--packages/gsl/src/Numeric/GSL/LinearAlgebra.hs12
-rw-r--r--packages/gsl/src/Numeric/GSL/Minimization.hs2
-rw-r--r--packages/gsl/src/Numeric/GSL/Polynomials.hs2
-rw-r--r--packages/gsl/src/Numeric/GSL/SimulatedAnnealing.hs1
-rw-r--r--packages/gsl/src/Numeric/GSL/Vector.hs12
8 files changed, 35 insertions, 21 deletions
diff --git a/packages/gsl/src/Numeric/GSL/Fitting.hs b/packages/gsl/src/Numeric/GSL/Fitting.hs
index db9d82f..8eb93a7 100644
--- a/packages/gsl/src/Numeric/GSL/Fitting.hs
+++ b/packages/gsl/src/Numeric/GSL/Fitting.hs
@@ -87,7 +87,7 @@ nlFitGen m f jac xiv epsabs epsrel maxit = unsafePerformIO $ do
87 fp <- mkVecVecfun (aux_vTov (checkdim1 n p . f)) 87 fp <- mkVecVecfun (aux_vTov (checkdim1 n p . f))
88 jp <- mkVecMatfun (aux_vTom (checkdim2 n p . jac)) 88 jp <- mkVecMatfun (aux_vTom (checkdim2 n p . jac))
89 rawpath <- createMatrix RowMajor maxit (2+p) 89 rawpath <- createMatrix RowMajor maxit (2+p)
90 app2 (c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n)) vec xiv mat rawpath "c_nlfit" 90 c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n) # xiv # rawpath #|"c_nlfit"
91 let it = round (rawpath `atIndex` (maxit-1,0)) 91 let it = round (rawpath `atIndex` (maxit-1,0))
92 path = takeRows it rawpath 92 path = takeRows it rawpath
93 [sol] = toRows $ dropRows (it-1) path 93 [sol] = toRows $ dropRows (it-1) path
diff --git a/packages/gsl/src/Numeric/GSL/Fourier.hs b/packages/gsl/src/Numeric/GSL/Fourier.hs
index d824b4f..1c2c053 100644
--- a/packages/gsl/src/Numeric/GSL/Fourier.hs
+++ b/packages/gsl/src/Numeric/GSL/Fourier.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE TypeFamilies #-}
2
1{- | 3{- |
2Module : Numeric.GSL.Fourier 4Module : Numeric.GSL.Fourier
3Copyright : (c) Alberto Ruiz 2006 5Copyright : (c) Alberto Ruiz 2006
@@ -23,7 +25,7 @@ import System.IO.Unsafe (unsafePerformIO)
23 25
24genfft code v = unsafePerformIO $ do 26genfft code v = unsafePerformIO $ do
25 r <- createVector (size v) 27 r <- createVector (size v)
26 app2 (c_fft code) vec v vec r "fft" 28 c_fft code # v # r #|"fft"
27 return r 29 return r
28 30
29foreign import ccall unsafe "gsl-aux.h fft" c_fft :: CInt -> TCV (TCV Res) 31foreign import ccall unsafe "gsl-aux.h fft" c_fft :: CInt -> TCV (TCV Res)
@@ -41,3 +43,4 @@ fft = genfft 0
41-- | The inverse of 'fft', using /gsl_fft_complex_inverse/. 43-- | The inverse of 'fft', using /gsl_fft_complex_inverse/.
42ifft :: Vector (Complex Double) -> Vector (Complex Double) 44ifft :: Vector (Complex Double) -> Vector (Complex Double)
43ifft = genfft 1 45ifft = genfft 1
46
diff --git a/packages/gsl/src/Numeric/GSL/Internal.hs b/packages/gsl/src/Numeric/GSL/Internal.hs
index a269224..dcd3bc4 100644
--- a/packages/gsl/src/Numeric/GSL/Internal.hs
+++ b/packages/gsl/src/Numeric/GSL/Internal.hs
@@ -23,7 +23,7 @@ module Numeric.GSL.Internal(
23 createV, 23 createV,
24 createMIO, 24 createMIO,
25 module Numeric.LinearAlgebra.Devel, 25 module Numeric.LinearAlgebra.Devel,
26 check, 26 check,(#),vec, ww2,
27 Res,TV,TM,TCV,TCM 27 Res,TV,TM,TCV,TCM
28) where 28) where
29 29
@@ -35,7 +35,7 @@ import Foreign.Ptr(Ptr, FunPtr)
35import Foreign.C.Types 35import Foreign.C.Types
36import Foreign.C.String(peekCString) 36import Foreign.C.String(peekCString)
37import System.IO.Unsafe(unsafePerformIO) 37import System.IO.Unsafe(unsafePerformIO)
38import Data.Vector.Storable(unsafeWith) 38import Data.Vector.Storable as V (unsafeWith,length)
39import Control.Monad(when) 39import Control.Monad(when)
40 40
41iv :: (Vector Double -> Double) -> (CInt -> Ptr Double -> Double) 41iv :: (Vector Double -> Double) -> (CInt -> Ptr Double -> Double)
@@ -86,12 +86,12 @@ aux_vTom f n p rr cr r = g where
86 86
87createV n fun msg = unsafePerformIO $ do 87createV n fun msg = unsafePerformIO $ do
88 r <- createVector n 88 r <- createVector n
89 app1 fun vec r msg 89 fun # r #| msg
90 return r 90 return r
91 91
92createMIO r c fun msg = do 92createMIO r c fun msg = do
93 res <- createMatrix RowMajor r c 93 res <- createMatrix RowMajor r c
94 app1 fun mat res msg 94 fun # res #| msg
95 return res 95 return res
96 96
97-------------------------------------------------------------------------------- 97--------------------------------------------------------------------------------
@@ -123,3 +123,15 @@ type TCM x = CInt -> CInt -> PC -> x
123type TVV = TV (TV Res) 123type TVV = TV (TV Res)
124type TVM = TV (TM Res) 124type TVM = TV (TM Res)
125 125
126ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2
127
128vec x f = unsafeWith x $ \p -> do
129 let v g = do
130 g (fi $ V.length x) p
131 f v
132{-# INLINE vec #-}
133
134infixl 1 #
135a # b = applyRaw a b
136{-# INLINE (#) #-}
137
diff --git a/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs b/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs
index cb78bf4..6ffe306 100644
--- a/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs
+++ b/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs
@@ -40,7 +40,7 @@ randomVector :: Int -- ^ seed
40 -> Vector Double 40 -> Vector Double
41randomVector seed dist n = unsafePerformIO $ do 41randomVector seed dist n = unsafePerformIO $ do
42 r <- createVector n 42 r <- createVector n
43 app1 (c_random_vector (fi seed) ((fi.fromEnum) dist)) vec r "randomVector" 43 c_random_vector (fi seed) ((fi.fromEnum) dist) # r #|"randomVector"
44 return r 44 return r
45 45
46foreign import ccall unsafe "random_vector" c_random_vector :: CInt -> CInt -> TV 46foreign import ccall unsafe "random_vector" c_random_vector :: CInt -> CInt -> TV
@@ -56,7 +56,7 @@ saveMatrix filename fmt m = do
56 charname <- newCString filename 56 charname <- newCString filename
57 charfmt <- newCString fmt 57 charfmt <- newCString fmt
58 let o = if orderOf m == RowMajor then 1 else 0 58 let o = if orderOf m == RowMajor then 1 else 0
59 app1 (matrix_fprintf charname charfmt o) mat m "matrix_fprintf" 59 matrix_fprintf charname charfmt o # m #|"matrix_fprintf"
60 free charname 60 free charname
61 free charfmt 61 free charfmt
62 62
@@ -69,7 +69,7 @@ fscanfVector :: FilePath -> Int -> IO (Vector Double)
69fscanfVector filename n = do 69fscanfVector filename n = do
70 charname <- newCString filename 70 charname <- newCString filename
71 res <- createVector n 71 res <- createVector n
72 app1 (gsl_vector_fscanf charname) vec res "gsl_vector_fscanf" 72 gsl_vector_fscanf charname # res #|"gsl_vector_fscanf"
73 free charname 73 free charname
74 return res 74 return res
75 75
@@ -80,7 +80,7 @@ fprintfVector :: FilePath -> String -> Vector Double -> IO ()
80fprintfVector filename fmt v = do 80fprintfVector filename fmt v = do
81 charname <- newCString filename 81 charname <- newCString filename
82 charfmt <- newCString fmt 82 charfmt <- newCString fmt
83 app1 (gsl_vector_fprintf charname charfmt) vec v "gsl_vector_fprintf" 83 gsl_vector_fprintf charname charfmt # v #|"gsl_vector_fprintf"
84 free charname 84 free charname
85 free charfmt 85 free charfmt
86 86
@@ -91,7 +91,7 @@ freadVector :: FilePath -> Int -> IO (Vector Double)
91freadVector filename n = do 91freadVector filename n = do
92 charname <- newCString filename 92 charname <- newCString filename
93 res <- createVector n 93 res <- createVector n
94 app1 (gsl_vector_fread charname) vec res "gsl_vector_fread" 94 gsl_vector_fread charname # res #| "gsl_vector_fread"
95 free charname 95 free charname
96 return res 96 return res
97 97
@@ -101,7 +101,7 @@ foreign import ccall unsafe "vector_fread" gsl_vector_fread:: Ptr CChar -> TV
101fwriteVector :: FilePath -> Vector Double -> IO () 101fwriteVector :: FilePath -> Vector Double -> IO ()
102fwriteVector filename v = do 102fwriteVector filename v = do
103 charname <- newCString filename 103 charname <- newCString filename
104 app1 (gsl_vector_fwrite charname) vec v "gsl_vector_fwrite" 104 gsl_vector_fwrite charname # v #|"gsl_vector_fwrite"
105 free charname 105 free charname
106 106
107foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV 107foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV
diff --git a/packages/gsl/src/Numeric/GSL/Minimization.hs b/packages/gsl/src/Numeric/GSL/Minimization.hs
index 00e0619..a0e5306 100644
--- a/packages/gsl/src/Numeric/GSL/Minimization.hs
+++ b/packages/gsl/src/Numeric/GSL/Minimization.hs
@@ -137,7 +137,7 @@ minimizeV :: MinimizeMethod
137minimize method eps maxit sz f xi = v2l $ minimizeV method eps maxit (fromList sz) (f.toList) (fromList xi) 137minimize method eps maxit sz f xi = v2l $ minimizeV method eps maxit (fromList sz) (f.toList) (fromList xi)
138 where v2l (v,m) = (toList v, m) 138 where v2l (v,m) = (toList v, m)
139 139
140ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2 140
141 141
142minimizeV method eps maxit szv f xiv = unsafePerformIO $ do 142minimizeV method eps maxit szv f xiv = unsafePerformIO $ do
143 let n = size xiv 143 let n = size xiv
diff --git a/packages/gsl/src/Numeric/GSL/Polynomials.hs b/packages/gsl/src/Numeric/GSL/Polynomials.hs
index 246e301..8890f8f 100644
--- a/packages/gsl/src/Numeric/GSL/Polynomials.hs
+++ b/packages/gsl/src/Numeric/GSL/Polynomials.hs
@@ -48,7 +48,7 @@ polySolve = toList . polySolve' . fromList
48polySolve' :: Vector Double -> Vector (Complex Double) 48polySolve' :: Vector Double -> Vector (Complex Double)
49polySolve' v | size v > 1 = unsafePerformIO $ do 49polySolve' v | size v > 1 = unsafePerformIO $ do
50 r <- createVector (size v-1) 50 r <- createVector (size v-1)
51 app2 c_polySolve vec v vec r "polySolve" 51 c_polySolve # v # r #| "polySolve"
52 return r 52 return r
53 | otherwise = error "polySolve on a polynomial of degree zero" 53 | otherwise = error "polySolve on a polynomial of degree zero"
54 54
diff --git a/packages/gsl/src/Numeric/GSL/SimulatedAnnealing.hs b/packages/gsl/src/Numeric/GSL/SimulatedAnnealing.hs
index 9f9ed97..11b22d3 100644
--- a/packages/gsl/src/Numeric/GSL/SimulatedAnnealing.hs
+++ b/packages/gsl/src/Numeric/GSL/SimulatedAnnealing.hs
@@ -55,7 +55,6 @@ import Foreign.Ptr(Ptr, FunPtr, nullFunPtr)
55import Foreign.StablePtr(StablePtr, newStablePtr, deRefStablePtr, freeStablePtr) 55import Foreign.StablePtr(StablePtr, newStablePtr, deRefStablePtr, freeStablePtr)
56import Foreign.C.Types 56import Foreign.C.Types
57import System.IO.Unsafe(unsafePerformIO) 57import System.IO.Unsafe(unsafePerformIO)
58import Control.Applicative ((<*>), (<$>))
59 58
60import System.IO (hFlush, stdout) 59import System.IO (hFlush, stdout)
61 60
diff --git a/packages/gsl/src/Numeric/GSL/Vector.hs b/packages/gsl/src/Numeric/GSL/Vector.hs
index 0cd99eb..fb982c5 100644
--- a/packages/gsl/src/Numeric/GSL/Vector.hs
+++ b/packages/gsl/src/Numeric/GSL/Vector.hs
@@ -34,7 +34,7 @@ randomVector :: Int -- ^ seed
34 -> Vector Double 34 -> Vector Double
35randomVector seed dist n = unsafePerformIO $ do 35randomVector seed dist n = unsafePerformIO $ do
36 r <- createVector n 36 r <- createVector n
37 app1 (c_random_vector_GSL (fi seed) ((fi.fromEnum) dist)) vec r "randomVectorGSL" 37 c_random_vector_GSL (fi seed) ((fi.fromEnum) dist) # r #|"randomVectorGSL"
38 return r 38 return r
39 39
40foreign import ccall unsafe "random_vector_GSL" c_random_vector_GSL :: CInt -> CInt -> TV 40foreign import ccall unsafe "random_vector_GSL" c_random_vector_GSL :: CInt -> CInt -> TV
@@ -50,7 +50,7 @@ saveMatrix filename fmt m = do
50 charname <- newCString filename 50 charname <- newCString filename
51 charfmt <- newCString fmt 51 charfmt <- newCString fmt
52 let o = if orderOf m == RowMajor then 1 else 0 52 let o = if orderOf m == RowMajor then 1 else 0
53 app1 (matrix_fprintf charname charfmt o) mat m "matrix_fprintf" 53 matrix_fprintf charname charfmt o # m #|"matrix_fprintf"
54 free charname 54 free charname
55 free charfmt 55 free charfmt
56 56
@@ -63,7 +63,7 @@ fscanfVector :: FilePath -> Int -> IO (Vector Double)
63fscanfVector filename n = do 63fscanfVector filename n = do
64 charname <- newCString filename 64 charname <- newCString filename
65 res <- createVector n 65 res <- createVector n
66 app1 (gsl_vector_fscanf charname) vec res "gsl_vector_fscanf" 66 gsl_vector_fscanf charname # res #|"gsl_vector_fscanf"
67 free charname 67 free charname
68 return res 68 return res
69 69
@@ -74,7 +74,7 @@ fprintfVector :: FilePath -> String -> Vector Double -> IO ()
74fprintfVector filename fmt v = do 74fprintfVector filename fmt v = do
75 charname <- newCString filename 75 charname <- newCString filename
76 charfmt <- newCString fmt 76 charfmt <- newCString fmt
77 app1 (gsl_vector_fprintf charname charfmt) vec v "gsl_vector_fprintf" 77 gsl_vector_fprintf charname charfmt # v #|"gsl_vector_fprintf"
78 free charname 78 free charname
79 free charfmt 79 free charfmt
80 80
@@ -85,7 +85,7 @@ freadVector :: FilePath -> Int -> IO (Vector Double)
85freadVector filename n = do 85freadVector filename n = do
86 charname <- newCString filename 86 charname <- newCString filename
87 res <- createVector n 87 res <- createVector n
88 app1 (gsl_vector_fread charname) vec res "gsl_vector_fread" 88 gsl_vector_fread charname # res #|"gsl_vector_fread"
89 free charname 89 free charname
90 return res 90 return res
91 91
@@ -95,7 +95,7 @@ foreign import ccall unsafe "vector_fread" gsl_vector_fread:: Ptr CChar -> TV
95fwriteVector :: FilePath -> Vector Double -> IO () 95fwriteVector :: FilePath -> Vector Double -> IO ()
96fwriteVector filename v = do 96fwriteVector filename v = do
97 charname <- newCString filename 97 charname <- newCString filename
98 app1 (gsl_vector_fwrite charname) vec v "gsl_vector_fwrite" 98 gsl_vector_fwrite charname # v #|"gsl_vector_fwrite"
99 free charname 99 free charname
100 100
101foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV 101foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV