diff options
-rw-r--r-- | lib/Data/Packed/Internal/Matrix.hs | 9 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/Vector.hs | 47 | ||||
-rw-r--r-- | lib/Data/Packed/Vector.hs | 6 | ||||
-rw-r--r-- | lib/Graphics/Plot.hs | 6 | ||||
-rw-r--r-- | lib/Numeric/GSL/gsl-aux.c | 54 | ||||
-rw-r--r-- | lib/Numeric/GSL/gsl-aux.h | 40 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra.hs | 2 |
7 files changed, 103 insertions, 61 deletions
diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index ccc652a..01d2ccf 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs | |||
@@ -22,7 +22,6 @@ import Data.Packed.Internal.Vector | |||
22 | 22 | ||
23 | import Foreign hiding (xor) | 23 | import Foreign hiding (xor) |
24 | import Complex | 24 | import Complex |
25 | import Foreign.C.String | ||
26 | import Foreign.C.Types | 25 | import Foreign.C.Types |
27 | 26 | ||
28 | ----------------------------------------------------------------- | 27 | ----------------------------------------------------------------- |
@@ -353,10 +352,4 @@ fromComplex z = (r,i) where | |||
353 | 352 | ||
354 | -- | loads a matrix from an ASCII file (the number of rows and columns must be known in advance). | 353 | -- | loads a matrix from an ASCII file (the number of rows and columns must be known in advance). |
355 | fromFile :: FilePath -> (Int,Int) -> IO (Matrix Double) | 354 | fromFile :: FilePath -> (Int,Int) -> IO (Matrix Double) |
356 | fromFile filename (r,c) = do | 355 | fromFile filename (r,c) = reshape c `fmap` fscanfVector filename (r*c) |
357 | charname <- newCString filename | ||
358 | res <- createMatrix RowMajor r c | ||
359 | app1 (c_gslReadMatrix charname) mat res "gslReadMatrix" | ||
360 | free charname | ||
361 | return res | ||
362 | foreign import ccall "matrix_fscanf" c_gslReadMatrix:: Ptr CChar -> TM | ||
diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs index 1b572a5..5784861 100644 --- a/lib/Data/Packed/Internal/Vector.hs +++ b/lib/Data/Packed/Internal/Vector.hs | |||
@@ -18,7 +18,8 @@ module Data.Packed.Internal.Vector where | |||
18 | 18 | ||
19 | import Data.Packed.Internal.Common | 19 | import Data.Packed.Internal.Common |
20 | import Foreign | 20 | import Foreign |
21 | import Foreign.C.Types(CInt) | 21 | import Foreign.C.String |
22 | import Foreign.C.Types(CInt,CChar) | ||
22 | import Complex | 23 | import Complex |
23 | import Control.Monad(when) | 24 | import Control.Monad(when) |
24 | 25 | ||
@@ -255,3 +256,47 @@ foldVectorG f s0 v = foldLoop g s0 (dim v) | |||
255 | where g !k !s = f k (at' v) s | 256 | where g !k !s = f k (at' v) s |
256 | {-# INLINE g #-} -- Thanks to Ryan Ingram (http://permalink.gmane.org/gmane.comp.lang.haskell.cafe/46479) | 257 | {-# INLINE g #-} -- Thanks to Ryan Ingram (http://permalink.gmane.org/gmane.comp.lang.haskell.cafe/46479) |
257 | {-# INLINE foldVectorG #-} | 258 | {-# INLINE foldVectorG #-} |
259 | |||
260 | ------------------------------------------------------------------- | ||
261 | |||
262 | -- | Loads a vector from an ASCII file (the number of elements must be known in advance). | ||
263 | fscanfVector :: FilePath -> Int -> IO (Vector Double) | ||
264 | fscanfVector filename n = do | ||
265 | charname <- newCString filename | ||
266 | res <- createVector n | ||
267 | app1 (gsl_vector_fscanf charname) vec res "gsl_vector_fscanf" | ||
268 | free charname | ||
269 | return res | ||
270 | |||
271 | foreign import ccall "vector_fscanf" gsl_vector_fscanf:: Ptr CChar -> TV | ||
272 | |||
273 | -- | Saves the elements of a vector, with a given format (%f, %e, %g), to an ASCII file. | ||
274 | fprintfVector :: FilePath -> String -> Vector Double -> IO () | ||
275 | fprintfVector filename fmt v = do | ||
276 | charname <- newCString filename | ||
277 | charfmt <- newCString fmt | ||
278 | app1 (gsl_vector_fprintf charname charfmt) vec v "gsl_vector_fprintf" | ||
279 | free charname | ||
280 | free charfmt | ||
281 | |||
282 | foreign import ccall "vector_fprintf" gsl_vector_fprintf :: Ptr CChar -> Ptr CChar -> TV | ||
283 | |||
284 | -- | Loads a vector from a binary file (the number of elements must be known in advance). | ||
285 | freadVector :: FilePath -> Int -> IO (Vector Double) | ||
286 | freadVector filename n = do | ||
287 | charname <- newCString filename | ||
288 | res <- createVector n | ||
289 | app1 (gsl_vector_fread charname) vec res "gsl_vector_fread" | ||
290 | free charname | ||
291 | return res | ||
292 | |||
293 | foreign import ccall "vector_fread" gsl_vector_fread:: Ptr CChar -> TV | ||
294 | |||
295 | -- | Saves the elements of a vector to a binary file. | ||
296 | fwriteVector :: FilePath -> Vector Double -> IO () | ||
297 | fwriteVector filename v = do | ||
298 | charname <- newCString filename | ||
299 | app1 (gsl_vector_fwrite charname) vec v "gsl_vector_fwrite" | ||
300 | free charname | ||
301 | |||
302 | foreign import ccall "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV | ||
diff --git a/lib/Data/Packed/Vector.hs b/lib/Data/Packed/Vector.hs index e53d455..c657e10 100644 --- a/lib/Data/Packed/Vector.hs +++ b/lib/Data/Packed/Vector.hs | |||
@@ -8,7 +8,7 @@ | |||
8 | -- Stability : provisional | 8 | -- Stability : provisional |
9 | -- Portability : portable | 9 | -- Portability : portable |
10 | -- | 10 | -- |
11 | -- A representation of 1D arrays suitable for numeric computations using external libraries. | 11 | -- 1D arrays suitable for numeric computations using external libraries. |
12 | -- | 12 | -- |
13 | ----------------------------------------------------------------------------- | 13 | ----------------------------------------------------------------------------- |
14 | 14 | ||
@@ -19,8 +19,10 @@ module Data.Packed.Vector ( | |||
19 | subVector, join, | 19 | subVector, join, |
20 | constant, linspace, | 20 | constant, linspace, |
21 | vectorMax, vectorMin, vectorMaxIndex, vectorMinIndex, | 21 | vectorMax, vectorMin, vectorMaxIndex, vectorMinIndex, |
22 | mapVector, zipVector, | ||
23 | fscanfVector, fprintfVector, freadVector, fwriteVector, | ||
22 | liftVector, liftVector2, | 24 | liftVector, liftVector2, |
23 | foldLoop, foldVector, foldVectorG, mapVector, zipVector | 25 | foldLoop, foldVector, foldVectorG |
24 | ) where | 26 | ) where |
25 | 27 | ||
26 | import Data.Packed.Internal | 28 | import Data.Packed.Internal |
diff --git a/lib/Graphics/Plot.hs b/lib/Graphics/Plot.hs index 9b64a1d..e6a9098 100644 --- a/lib/Graphics/Plot.hs +++ b/lib/Graphics/Plot.hs | |||
@@ -40,8 +40,8 @@ size = dim | |||
40 | --fromFile filename = readFile filename >>= return . readMatrix read | 40 | --fromFile filename = readFile filename >>= return . readMatrix read |
41 | 41 | ||
42 | -- | Saves a real matrix to a formatted ascii text file | 42 | -- | Saves a real matrix to a formatted ascii text file |
43 | toFile :: FilePath -> Matrix Double -> IO () | 43 | toFile' :: FilePath -> Matrix Double -> IO () |
44 | toFile filename matrix = writeFile filename (unlines . map unwords. map (map show) . toLists $ matrix) | 44 | toFile' filename matrix = writeFile filename (unlines . map unwords. map (map show) . toLists $ matrix) |
45 | 45 | ||
46 | ------------------------------------------------------------------------ | 46 | ------------------------------------------------------------------------ |
47 | 47 | ||
@@ -74,7 +74,7 @@ mesh m = gnuplotX (command++dat) where | |||
74 | mesh' :: Matrix Double -> IO () | 74 | mesh' :: Matrix Double -> IO () |
75 | mesh' m = do | 75 | mesh' m = do |
76 | writeFile "splot-gnu-command" "splot \"splot-tmp.txt\" matrix with lines; pause -1"; | 76 | writeFile "splot-gnu-command" "splot \"splot-tmp.txt\" matrix with lines; pause -1"; |
77 | toFile "splot-tmp.txt" m | 77 | toFile' "splot-tmp.txt" m |
78 | putStr "Press [Return] to close the graphic and continue... " | 78 | putStr "Press [Return] to close the graphic and continue... " |
79 | system "gnuplot -persist splot-gnu-command" | 79 | system "gnuplot -persist splot-gnu-command" |
80 | system "rm splot-tmp.txt splot-gnu-command" | 80 | system "rm splot-tmp.txt splot-gnu-command" |
diff --git a/lib/Numeric/GSL/gsl-aux.c b/lib/Numeric/GSL/gsl-aux.c index 0904a67..b3b524d 100644 --- a/lib/Numeric/GSL/gsl-aux.c +++ b/lib/Numeric/GSL/gsl-aux.c | |||
@@ -1,4 +1,15 @@ | |||
1 | #include "gsl-aux.h" | 1 | #include <gsl/gsl_complex.h> |
2 | |||
3 | #define RVEC(A) int A##n, double*A##p | ||
4 | #define RMAT(A) int A##r, int A##c, double* A##p | ||
5 | #define KRVEC(A) int A##n, const double*A##p | ||
6 | #define KRMAT(A) int A##r, int A##c, const double* A##p | ||
7 | |||
8 | #define CVEC(A) int A##n, gsl_complex*A##p | ||
9 | #define CMAT(A) int A##r, int A##c, gsl_complex* A##p | ||
10 | #define KCVEC(A) int A##n, const gsl_complex*A##p | ||
11 | #define KCMAT(A) int A##r, int A##c, const gsl_complex* A##p | ||
12 | |||
2 | #include <gsl/gsl_blas.h> | 13 | #include <gsl/gsl_blas.h> |
3 | #include <gsl/gsl_math.h> | 14 | #include <gsl/gsl_math.h> |
4 | #include <gsl/gsl_errno.h> | 15 | #include <gsl/gsl_errno.h> |
@@ -8,7 +19,6 @@ | |||
8 | #include <gsl/gsl_poly.h> | 19 | #include <gsl/gsl_poly.h> |
9 | #include <gsl/gsl_multimin.h> | 20 | #include <gsl/gsl_multimin.h> |
10 | #include <gsl/gsl_multiroots.h> | 21 | #include <gsl/gsl_multiroots.h> |
11 | #include <gsl/gsl_complex.h> | ||
12 | #include <gsl/gsl_complex_math.h> | 22 | #include <gsl/gsl_complex_math.h> |
13 | #include <string.h> | 23 | #include <string.h> |
14 | #include <stdio.h> | 24 | #include <stdio.h> |
@@ -340,13 +350,45 @@ int polySolve(KRVEC(a), CVEC(z)) { | |||
340 | OK; | 350 | OK; |
341 | } | 351 | } |
342 | 352 | ||
343 | int matrix_fscanf(char*filename, RMAT(a)) { | 353 | int vector_fscanf(char*filename, RVEC(a)) { |
344 | DEBUGMSG("gsl_matrix_fscanf"); | 354 | DEBUGMSG("gsl_matrix_fscanf"); |
345 | //printf(filename); printf("\n"); | 355 | DVVIEW(a); |
346 | DMVIEW(a); | ||
347 | FILE * f = fopen(filename,"r"); | 356 | FILE * f = fopen(filename,"r"); |
348 | CHECK(!f,BAD_FILE); | 357 | CHECK(!f,BAD_FILE); |
349 | int res = gsl_matrix_fscanf(f, M(a)); | 358 | int res = gsl_vector_fscanf(f,V(a)); |
359 | CHECK(res,res); | ||
360 | fclose (f); | ||
361 | OK | ||
362 | } | ||
363 | |||
364 | int vector_fprintf(char*filename, char*fmt, RVEC(a)) { | ||
365 | DEBUGMSG("gsl_vector_fprintf"); | ||
366 | DVVIEW(a); | ||
367 | FILE * f = fopen(filename,"w"); | ||
368 | CHECK(!f,BAD_FILE); | ||
369 | int res = gsl_vector_fprintf(f,V(a),fmt); | ||
370 | CHECK(res,res); | ||
371 | fclose (f); | ||
372 | OK | ||
373 | } | ||
374 | |||
375 | int vector_fread(char*filename, RVEC(a)) { | ||
376 | DEBUGMSG("gsl_matrix_fscanf"); | ||
377 | DVVIEW(a); | ||
378 | FILE * f = fopen(filename,"r"); | ||
379 | CHECK(!f,BAD_FILE); | ||
380 | int res = gsl_vector_fread(f,V(a)); | ||
381 | CHECK(res,res); | ||
382 | fclose (f); | ||
383 | OK | ||
384 | } | ||
385 | |||
386 | int vector_fwrite(char*filename, RVEC(a)) { | ||
387 | DEBUGMSG("gsl_vector_fprintf"); | ||
388 | DVVIEW(a); | ||
389 | FILE * f = fopen(filename,"w"); | ||
390 | CHECK(!f,BAD_FILE); | ||
391 | int res = gsl_vector_fwrite(f,V(a)); | ||
350 | CHECK(res,res); | 392 | CHECK(res,res); |
351 | fclose (f); | 393 | fclose (f); |
352 | OK | 394 | OK |
diff --git a/lib/Numeric/GSL/gsl-aux.h b/lib/Numeric/GSL/gsl-aux.h deleted file mode 100644 index 881d0d0..0000000 --- a/lib/Numeric/GSL/gsl-aux.h +++ /dev/null | |||
@@ -1,40 +0,0 @@ | |||
1 | #include <gsl/gsl_complex.h> | ||
2 | |||
3 | #define RVEC(A) int A##n, double*A##p | ||
4 | #define RMAT(A) int A##r, int A##c, double* A##p | ||
5 | #define KRVEC(A) int A##n, const double*A##p | ||
6 | #define KRMAT(A) int A##r, int A##c, const double* A##p | ||
7 | |||
8 | #define CVEC(A) int A##n, gsl_complex*A##p | ||
9 | #define CMAT(A) int A##r, int A##c, gsl_complex* A##p | ||
10 | #define KCVEC(A) int A##n, const gsl_complex*A##p | ||
11 | #define KCMAT(A) int A##r, int A##c, const gsl_complex* A##p | ||
12 | |||
13 | void no_abort_on_error(); | ||
14 | |||
15 | int toScalarR(int code, KRVEC(x), RVEC(r)); | ||
16 | /* norm2, absdif, maximum, posmax, etc. */ | ||
17 | |||
18 | int mapR(int code, KRVEC(x), RVEC(r)); | ||
19 | int mapC(int code, KCVEC(x), CVEC(r)); | ||
20 | /* sin cos tan etc. */ | ||
21 | |||
22 | int mapValR(int code, double*, KRVEC(x), RVEC(r)); | ||
23 | int mapValC(int code, gsl_complex*, KCVEC(x), CVEC(r)); | ||
24 | |||
25 | int zipR(int code, KRVEC(a), KRVEC(b), RVEC(r)); | ||
26 | int zipC(int code, KCVEC(a), KCVEC(b), CVEC(r)); | ||
27 | |||
28 | |||
29 | int fft(int code, KCVEC(a), CVEC(b)); | ||
30 | |||
31 | int deriv(int code, double f(double, void*), double x, double h, double * result, double * abserr); | ||
32 | |||
33 | int integrate_qng(double f(double, void*), double a, double b, double prec, | ||
34 | double *result, double*error); | ||
35 | |||
36 | int integrate_qags(double f(double,void*), double a, double b, double prec, int w, | ||
37 | double *result, double* error); | ||
38 | |||
39 | int polySolve(KRVEC(a), CVEC(z)); | ||
40 | |||
diff --git a/lib/Numeric/LinearAlgebra.hs b/lib/Numeric/LinearAlgebra.hs index b8fd01e..f92c40d 100644 --- a/lib/Numeric/LinearAlgebra.hs +++ b/lib/Numeric/LinearAlgebra.hs | |||
@@ -10,7 +10,7 @@ Portability : uses ffi | |||
10 | 10 | ||
11 | Basic matrix computations implemented by BLAS, LAPACK and GSL. | 11 | Basic matrix computations implemented by BLAS, LAPACK and GSL. |
12 | 12 | ||
13 | This is module reexports the most comon functions (including "Numeric.LinearAlgebra.Instances"). | 13 | This module reexports the most comon functions (including "Numeric.LinearAlgebra.Instances"). |
14 | 14 | ||
15 | -} | 15 | -} |
16 | ----------------------------------------------------------------------------- | 16 | ----------------------------------------------------------------------------- |