diff options
author | Alberto Ruiz <aruiz@um.es> | 2016-11-02 18:55:09 +0100 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2016-11-02 18:55:09 +0100 |
commit | fc88b36a3067269aa0cd74d5aa56b46edb7bd129 (patch) | |
tree | 6e40684c1769c6e00d6e6ef92d017812bb2b0a20 /packages/gsl | |
parent | 155cac879362d2672a5504ba134728512b314c60 (diff) |
use new wrappers in gsl functions
Diffstat (limited to 'packages/gsl')
-rw-r--r-- | packages/gsl/src/Numeric/GSL/Fitting.hs | 2 | ||||
-rw-r--r-- | packages/gsl/src/Numeric/GSL/Fourier.hs | 2 | ||||
-rw-r--r-- | packages/gsl/src/Numeric/GSL/Internal.hs | 15 | ||||
-rw-r--r-- | packages/gsl/src/Numeric/GSL/LinearAlgebra.hs | 12 | ||||
-rw-r--r-- | packages/gsl/src/Numeric/GSL/Polynomials.hs | 2 | ||||
-rw-r--r-- | packages/gsl/src/Numeric/GSL/Vector.hs | 12 |
6 files changed, 27 insertions, 18 deletions
diff --git a/packages/gsl/src/Numeric/GSL/Fitting.hs b/packages/gsl/src/Numeric/GSL/Fitting.hs index 8eb93a7..9a2f665 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 | c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n) # xiv # rawpath #|"c_nlfit" | 90 | (xiv `applyRaw` (rawpath `applyRaw` id)) (c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n)) #|"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 1c2c053..bffab87 100644 --- a/packages/gsl/src/Numeric/GSL/Fourier.hs +++ b/packages/gsl/src/Numeric/GSL/Fourier.hs | |||
@@ -25,7 +25,7 @@ import System.IO.Unsafe (unsafePerformIO) | |||
25 | 25 | ||
26 | genfft code v = unsafePerformIO $ do | 26 | genfft code v = unsafePerformIO $ do |
27 | r <- createVector (size v) | 27 | r <- createVector (size v) |
28 | c_fft code # v # r #|"fft" | 28 | (v `applyRaw` (r `applyRaw` id)) (c_fft code) #|"fft" |
29 | return r | 29 | return r |
30 | 30 | ||
31 | foreign import ccall unsafe "gsl-aux.h fft" c_fft :: CInt -> TCV (TCV Res) | 31 | foreign import ccall unsafe "gsl-aux.h fft" c_fft :: CInt -> TCV (TCV Res) |
diff --git a/packages/gsl/src/Numeric/GSL/Internal.hs b/packages/gsl/src/Numeric/GSL/Internal.hs index dcd3bc4..f70e167 100644 --- a/packages/gsl/src/Numeric/GSL/Internal.hs +++ b/packages/gsl/src/Numeric/GSL/Internal.hs | |||
@@ -1,3 +1,5 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
2 | |||
1 | -- | | 3 | -- | |
2 | -- Module : Numeric.GSL.Internal | 4 | -- Module : Numeric.GSL.Internal |
3 | -- Copyright : (c) Alberto Ruiz 2009 | 5 | -- Copyright : (c) Alberto Ruiz 2009 |
@@ -23,7 +25,7 @@ module Numeric.GSL.Internal( | |||
23 | createV, | 25 | createV, |
24 | createMIO, | 26 | createMIO, |
25 | module Numeric.LinearAlgebra.Devel, | 27 | module Numeric.LinearAlgebra.Devel, |
26 | check,(#),vec, ww2, | 28 | check,(#),(#!),vec, ww2, |
27 | Res,TV,TM,TCV,TCM | 29 | Res,TV,TM,TCV,TCM |
28 | ) where | 30 | ) where |
29 | 31 | ||
@@ -86,12 +88,12 @@ aux_vTom f n p rr cr r = g where | |||
86 | 88 | ||
87 | createV n fun msg = unsafePerformIO $ do | 89 | createV n fun msg = unsafePerformIO $ do |
88 | r <- createVector n | 90 | r <- createVector n |
89 | fun # r #| msg | 91 | (r # id) fun #| msg |
90 | return r | 92 | return r |
91 | 93 | ||
92 | createMIO r c fun msg = do | 94 | createMIO r c fun msg = do |
93 | res <- createMatrix RowMajor r c | 95 | res <- createMatrix RowMajor r c |
94 | fun # res #| msg | 96 | (res # id) fun #| msg |
95 | return res | 97 | return res |
96 | 98 | ||
97 | -------------------------------------------------------------------------------- | 99 | -------------------------------------------------------------------------------- |
@@ -135,3 +137,10 @@ infixl 1 # | |||
135 | a # b = applyRaw a b | 137 | a # b = applyRaw a b |
136 | {-# INLINE (#) #-} | 138 | {-# INLINE (#) #-} |
137 | 139 | ||
140 | --infixr 1 # | ||
141 | --a # b = apply a b | ||
142 | --{-# INLINE (#) #-} | ||
143 | |||
144 | a #! b = a # b # id | ||
145 | {-# INLINE (#!) #-} | ||
146 | |||
diff --git a/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs b/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs index 6ffe306..1bf357b 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 |
41 | randomVector seed dist n = unsafePerformIO $ do | 41 | randomVector seed dist n = unsafePerformIO $ do |
42 | r <- createVector n | 42 | r <- createVector n |
43 | c_random_vector (fi seed) ((fi.fromEnum) dist) # r #|"randomVector" | 43 | (r `applyRaw` id) (c_random_vector (fi seed) ((fi.fromEnum) dist)) #|"randomVector" |
44 | return r | 44 | return r |
45 | 45 | ||
46 | foreign import ccall unsafe "random_vector" c_random_vector :: CInt -> CInt -> TV | 46 | foreign 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 | matrix_fprintf charname charfmt o # m #|"matrix_fprintf" | 59 | (m `applyRaw` id) (matrix_fprintf charname charfmt o) #|"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) | |||
69 | fscanfVector filename n = do | 69 | fscanfVector filename n = do |
70 | charname <- newCString filename | 70 | charname <- newCString filename |
71 | res <- createVector n | 71 | res <- createVector n |
72 | gsl_vector_fscanf charname # res #|"gsl_vector_fscanf" | 72 | (res `applyRaw` id) (gsl_vector_fscanf charname) #|"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 () | |||
80 | fprintfVector filename fmt v = do | 80 | fprintfVector filename fmt v = do |
81 | charname <- newCString filename | 81 | charname <- newCString filename |
82 | charfmt <- newCString fmt | 82 | charfmt <- newCString fmt |
83 | gsl_vector_fprintf charname charfmt # v #|"gsl_vector_fprintf" | 83 | (v `applyRaw` id) (gsl_vector_fprintf charname charfmt) #|"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) | |||
91 | freadVector filename n = do | 91 | freadVector filename n = do |
92 | charname <- newCString filename | 92 | charname <- newCString filename |
93 | res <- createVector n | 93 | res <- createVector n |
94 | gsl_vector_fread charname # res #| "gsl_vector_fread" | 94 | (res `applyRaw` id) (gsl_vector_fread charname) #| "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 | |||
101 | fwriteVector :: FilePath -> Vector Double -> IO () | 101 | fwriteVector :: FilePath -> Vector Double -> IO () |
102 | fwriteVector filename v = do | 102 | fwriteVector filename v = do |
103 | charname <- newCString filename | 103 | charname <- newCString filename |
104 | gsl_vector_fwrite charname # v #|"gsl_vector_fwrite" | 104 | (v `applyRaw` id) (gsl_vector_fwrite charname) #|"gsl_vector_fwrite" |
105 | free charname | 105 | free charname |
106 | 106 | ||
107 | foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV | 107 | foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV |
diff --git a/packages/gsl/src/Numeric/GSL/Polynomials.hs b/packages/gsl/src/Numeric/GSL/Polynomials.hs index 46a31f3..7bd9404 100644 --- a/packages/gsl/src/Numeric/GSL/Polynomials.hs +++ b/packages/gsl/src/Numeric/GSL/Polynomials.hs | |||
@@ -49,7 +49,7 @@ polySolve = toList . polySolve' . fromList | |||
49 | polySolve' :: Vector Double -> Vector (Complex Double) | 49 | polySolve' :: Vector Double -> Vector (Complex Double) |
50 | polySolve' v | size v > 1 = unsafePerformIO $ do | 50 | polySolve' v | size v > 1 = unsafePerformIO $ do |
51 | r <- createVector (size v-1) | 51 | r <- createVector (size v-1) |
52 | c_polySolve # v # r #| "polySolve" | 52 | (v `applyRaw` (r `applyRaw` id)) c_polySolve #| "polySolve" |
53 | return r | 53 | return r |
54 | | otherwise = error "polySolve on a polynomial of degree zero" | 54 | | otherwise = error "polySolve on a polynomial of degree zero" |
55 | 55 | ||
diff --git a/packages/gsl/src/Numeric/GSL/Vector.hs b/packages/gsl/src/Numeric/GSL/Vector.hs index fb982c5..b1c0106 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 |
35 | randomVector seed dist n = unsafePerformIO $ do | 35 | randomVector seed dist n = unsafePerformIO $ do |
36 | r <- createVector n | 36 | r <- createVector n |
37 | c_random_vector_GSL (fi seed) ((fi.fromEnum) dist) # r #|"randomVectorGSL" | 37 | (r `applyRaw` id) (c_random_vector_GSL (fi seed) ((fi.fromEnum) dist)) #|"randomVectorGSL" |
38 | return r | 38 | return r |
39 | 39 | ||
40 | foreign import ccall unsafe "random_vector_GSL" c_random_vector_GSL :: CInt -> CInt -> TV | 40 | foreign 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 | matrix_fprintf charname charfmt o # m #|"matrix_fprintf" | 53 | (m `applyRaw` id) (matrix_fprintf charname charfmt o) #|"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) | |||
63 | fscanfVector filename n = do | 63 | fscanfVector filename n = do |
64 | charname <- newCString filename | 64 | charname <- newCString filename |
65 | res <- createVector n | 65 | res <- createVector n |
66 | gsl_vector_fscanf charname # res #|"gsl_vector_fscanf" | 66 | (res `applyRaw` id) (gsl_vector_fscanf charname) #|"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 () | |||
74 | fprintfVector filename fmt v = do | 74 | fprintfVector filename fmt v = do |
75 | charname <- newCString filename | 75 | charname <- newCString filename |
76 | charfmt <- newCString fmt | 76 | charfmt <- newCString fmt |
77 | gsl_vector_fprintf charname charfmt # v #|"gsl_vector_fprintf" | 77 | (v `applyRaw` id) (gsl_vector_fprintf charname charfmt) #|"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) | |||
85 | freadVector filename n = do | 85 | freadVector filename n = do |
86 | charname <- newCString filename | 86 | charname <- newCString filename |
87 | res <- createVector n | 87 | res <- createVector n |
88 | gsl_vector_fread charname # res #|"gsl_vector_fread" | 88 | (res `applyRaw` id) (gsl_vector_fread charname) #|"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 | |||
95 | fwriteVector :: FilePath -> Vector Double -> IO () | 95 | fwriteVector :: FilePath -> Vector Double -> IO () |
96 | fwriteVector filename v = do | 96 | fwriteVector filename v = do |
97 | charname <- newCString filename | 97 | charname <- newCString filename |
98 | gsl_vector_fwrite charname # v #|"gsl_vector_fwrite" | 98 | (v `applyRaw` id) (gsl_vector_fwrite charname) #|"gsl_vector_fwrite" |
99 | free charname | 99 | free charname |
100 | 100 | ||
101 | foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV | 101 | foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV |