summaryrefslogtreecommitdiff
path: root/packages/base
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2014-05-20 17:35:40 +0200
committerAlberto Ruiz <aruiz@um.es>2014-05-20 17:35:40 +0200
commitd0fc6c7192badfa6f03baf0e02e0cf2a73c3906b (patch)
tree0a2ea2c5e39933db2e131d4e58136967a96144e4 /packages/base
parentc5c6983a1970592c101e76411c3428a301a6a8e3 (diff)
loadMatrix, saveMatrix
Diffstat (limited to 'packages/base')
-rw-r--r--packages/base/src/C/vector-aux.c46
-rw-r--r--packages/base/src/Data/Packed/IO.hs18
-rw-r--r--packages/base/src/Numeric/LinearAlgebra/Data.hs7
-rw-r--r--packages/base/src/Numeric/Vectorized.hs53
4 files changed, 117 insertions, 7 deletions
diff --git a/packages/base/src/C/vector-aux.c b/packages/base/src/C/vector-aux.c
index 7cdc750..f1bb371 100644
--- a/packages/base/src/C/vector-aux.c
+++ b/packages/base/src/C/vector-aux.c
@@ -12,6 +12,7 @@ typedef float complex TCF;
12#include <string.h> 12#include <string.h>
13#include <math.h> 13#include <math.h>
14#include <stdio.h> 14#include <stdio.h>
15#include <stdlib.h>
15 16
16#define MACRO(B) do {B} while (0) 17#define MACRO(B) do {B} while (0)
17#define ERROR(CODE) MACRO(return CODE;) 18#define ERROR(CODE) MACRO(return CODE;)
@@ -648,4 +649,49 @@ int zipQ(int code, KQVEC(a), KQVEC(b), QVEC(r)) {
648 } 649 }
649} 650}
650 651
652////////////////////////////////////////////////////////////////////////////////
653
654int vectorScan(char * file, int* n, double**pp){
655 FILE * fp;
656 fp = fopen (file, "r");
657 int nbuf = 100*100;
658 double * p = (double*)malloc(nbuf*sizeof(double));
659 int k=0;
660 double d;
661 int ok;
662 for (;;) {
663 ok = fscanf(fp,"%lf",&d);
664 if (ok<1) {
665 break;
666 }
667 if (k==nbuf) {
668 nbuf = nbuf * 2;
669 p = (double*)realloc(p,nbuf*sizeof(double));
670 //printf("R\n");
671 }
672 p[k++] = d;
673 }
674 *n = k;
675 *pp = p;
676 fclose(fp);
677 OK
678}
679
680int saveMatrix(char * file, char * format, KDMAT(a)){
681 FILE * fp;
682 fp = fopen (file, "w");
683 int r, c;
684 for (r=0;r<ar; r++) {
685 for (c=0; c<ac; c++) {
686 fprintf(fp,format,ap[r*ac+c]);
687 if (c<ac-1) {
688 fprintf(fp," ");
689 } else {
690 fprintf(fp,"\n");
691 }
692 }
693 }
694 fclose(fp);
695 OK
696}
651 697
diff --git a/packages/base/src/Data/Packed/IO.hs b/packages/base/src/Data/Packed/IO.hs
index dbb2943..db03d5f 100644
--- a/packages/base/src/Data/Packed/IO.hs
+++ b/packages/base/src/Data/Packed/IO.hs
@@ -14,7 +14,7 @@
14 14
15module Data.Packed.IO ( 15module Data.Packed.IO (
16 dispf, disps, dispcf, vecdisp, latexFormat, format, 16 dispf, disps, dispcf, vecdisp, latexFormat, format,
17 readMatrix, fromArray2D 17 readMatrix, fromArray2D, loadMatrix, saveMatrix
18) where 18) where
19 19
20import Data.Packed 20import Data.Packed
@@ -22,6 +22,8 @@ import Data.Packed.Development
22import Text.Printf(printf) 22import Text.Printf(printf)
23import Data.List(intersperse) 23import Data.List(intersperse)
24import Data.Complex 24import Data.Complex
25import Numeric.Vectorized(vectorScan,saveMatrix)
26import Control.Applicative((<$>))
25 27
26{- | Creates a string from a matrix given a separator and a function to show each entry. Using 28{- | Creates a string from a matrix given a separator and a function to show each entry. Using
27this function the user can easily define any desired display function: 29this function the user can easily define any desired display function:
@@ -139,3 +141,17 @@ dispcf d m = sdims m ++ "\n" ++ format " " (showComplex d) m
139readMatrix :: String -> Matrix Double 141readMatrix :: String -> Matrix Double
140readMatrix = fromLists . map (map read). map words . filter (not.null) . lines 142readMatrix = fromLists . map (map read). map words . filter (not.null) . lines
141 143
144--------------------------------------------------------------------------------
145
146apparentCols :: FilePath -> IO Int
147apparentCols s = f . dropWhile null . map words . lines <$> readFile s
148 where
149 f [] = 0
150 f (x:_) = length x
151
152loadMatrix :: FilePath -> IO (Matrix Double)
153loadMatrix f = do
154 v <- vectorScan f
155 c <- apparentCols f
156 return (reshape c v)
157
diff --git a/packages/base/src/Numeric/LinearAlgebra/Data.hs b/packages/base/src/Numeric/LinearAlgebra/Data.hs
index 2754576..45fc00c 100644
--- a/packages/base/src/Numeric/LinearAlgebra/Data.hs
+++ b/packages/base/src/Numeric/LinearAlgebra/Data.hs
@@ -43,9 +43,10 @@ module Numeric.LinearAlgebra.Data(
43 find, maxIndex, minIndex, maxElement, minElement, atIndex, 43 find, maxIndex, minIndex, maxElement, minElement, atIndex,
44 44
45 -- * IO 45 -- * IO
46 disp, dispf, disps, dispcf, latexFormat, format, readMatrix, 46 disp,
47 47 loadMatrix, saveMatrix,
48 -- | loadMatrix, saveMatrix, fromFile, fileDimensions, fscanfVector, fprintfVector, freadVector, fwriteVector 48 latexFormat,
49 dispf, disps, dispcf, format,
49 50
50-- * Conversion 51-- * Conversion
51 Convert(..), 52 Convert(..),
diff --git a/packages/base/src/Numeric/Vectorized.hs b/packages/base/src/Numeric/Vectorized.hs
index 3814579..a2d7f70 100644
--- a/packages/base/src/Numeric/Vectorized.hs
+++ b/packages/base/src/Numeric/Vectorized.hs
@@ -16,20 +16,29 @@ module Numeric.Vectorized (
16 FunCodeS(..), toScalarR, toScalarF, toScalarC, toScalarQ, 16 FunCodeS(..), toScalarR, toScalarF, toScalarC, toScalarQ,
17 FunCodeV(..), vectorMapR, vectorMapC, vectorMapF, vectorMapQ, 17 FunCodeV(..), vectorMapR, vectorMapC, vectorMapF, vectorMapQ,
18 FunCodeSV(..), vectorMapValR, vectorMapValC, vectorMapValF, vectorMapValQ, 18 FunCodeSV(..), vectorMapValR, vectorMapValC, vectorMapValF, vectorMapValQ,
19 FunCodeVV(..), vectorZipR, vectorZipC, vectorZipF, vectorZipQ 19 FunCodeVV(..), vectorZipR, vectorZipC, vectorZipF, vectorZipQ,
20 vectorScan, saveMatrix
20) where 21) where
21 22
22import Data.Packed.Internal.Common 23import Data.Packed.Internal.Common
23import Data.Packed.Internal.Signatures 24import Data.Packed.Internal.Signatures
24import Data.Packed.Internal.Vector 25import Data.Packed.Internal.Vector
26import Data.Packed.Internal.Matrix
25 27
26import Data.Complex 28import Data.Complex
27import Foreign.Marshal.Alloc(free) 29import Foreign.Marshal.Alloc(free,malloc)
28import Foreign.Marshal.Array(newArray) 30import Foreign.Marshal.Array(newArray,copyArray)
29import Foreign.Ptr(Ptr) 31import Foreign.Ptr(Ptr)
32import Foreign.Storable(peek)
30import Foreign.C.Types 33import Foreign.C.Types
34import Foreign.C.String
31import System.IO.Unsafe(unsafePerformIO) 35import System.IO.Unsafe(unsafePerformIO)
32 36
37import Control.Monad(when)
38import Control.Applicative((<$>))
39
40
41
33fromei x = fromIntegral (fromEnum x) :: CInt 42fromei x = fromIntegral (fromEnum x) :: CInt
34 43
35data FunCodeV = Sin 44data FunCodeV = Sin
@@ -271,3 +280,41 @@ vectorZipQ = vectorZipAux c_vectorZipQ
271 280
272foreign import ccall unsafe "zipQ" c_vectorZipQ :: CInt -> TQVQVQV 281foreign import ccall unsafe "zipQ" c_vectorZipQ :: CInt -> TQVQVQV
273 282
283--------------------------------------------------------------------------------
284
285foreign import ccall unsafe "vectorScan" c_vectorScan
286 :: CString -> Ptr CInt -> Ptr (Ptr Double) -> IO CInt
287
288vectorScan :: FilePath -> IO (Vector Double)
289vectorScan s = do
290 pp <- malloc
291 pn <- malloc
292 cs <- newCString s
293 ok <- c_vectorScan cs pn pp
294 when (not (ok == 0)) $
295 error ("vectorScan \"" ++ s ++"\"")
296 n <- fromIntegral <$> peek pn
297 p <- peek pp
298 v <- createVector n
299 free pn
300 free cs
301 unsafeWith v $ \pv -> copyArray pv p n
302 free p
303 free pp
304 return v
305
306--------------------------------------------------------------------------------
307
308foreign import ccall unsafe "saveMatrix" c_saveMatrix
309 :: CString -> CString -> TM
310
311saveMatrix :: FilePath -> String -> Matrix Double -> IO ()
312saveMatrix name format m = do
313 cname <- newCString name
314 cformat <- newCString format
315 app1 (c_saveMatrix cname cformat) mat m "saveMatrix"
316 free cname
317 free cformat
318 return ()
319
320