summaryrefslogtreecommitdiff
path: root/packages/hmatrix/src/Numeric/GSL
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2014-05-14 20:54:03 +0200
committerAlberto Ruiz <aruiz@um.es>2014-05-14 20:54:03 +0200
commit5eda17c87d1feb20455f3012f98afbba4d3f2cb4 (patch)
tree635cab680e1fba1c03a03b4195ec75fae477539a /packages/hmatrix/src/Numeric/GSL
parenteb315f1aad7771cb5be9ce6892aee4a05205c35e (diff)
moved toScalar
Diffstat (limited to 'packages/hmatrix/src/Numeric/GSL')
-rw-r--r--packages/hmatrix/src/Numeric/GSL/Vector.hs32
-rw-r--r--packages/hmatrix/src/Numeric/GSL/gsl-vector.c66
2 files changed, 1 insertions, 97 deletions
diff --git a/packages/hmatrix/src/Numeric/GSL/Vector.hs b/packages/hmatrix/src/Numeric/GSL/Vector.hs
index 38c138b..27db6ae 100644
--- a/packages/hmatrix/src/Numeric/GSL/Vector.hs
+++ b/packages/hmatrix/src/Numeric/GSL/Vector.hs
@@ -27,7 +27,7 @@ import Numeric.GSL.Internal hiding (TV,TM,TCV,TCM)
27import Numeric.Vectorized( 27import Numeric.Vectorized(
28 sumF, sumR, sumQ, sumC, 28 sumF, sumR, sumQ, sumC,
29 prodF, prodR, prodQ, prodC, 29 prodF, prodR, prodQ, prodC,
30 FunCodeS(..), 30 FunCodeS(..), toScalarR, toScalarF, toScalarC, toScalarQ,
31 FunCodeV(..), 31 FunCodeV(..),
32 FunCodeSV(..), 32 FunCodeSV(..),
33 FunCodeVV(..) 33 FunCodeVV(..)
@@ -46,11 +46,6 @@ fromei x = fromIntegral (fromEnum x) :: CInt
46 46
47------------------------------------------------------------------ 47------------------------------------------------------------------
48 48
49toScalarAux fun code v = unsafePerformIO $ do
50 r <- createVector 1
51 app2 (fun (fromei code)) vec v vec r "toScalarAux"
52 return (r @> 0)
53
54vectorMapAux fun code v = unsafePerformIO $ do 49vectorMapAux fun code v = unsafePerformIO $ do
55 r <- createVector (dim v) 50 r <- createVector (dim v)
56 app2 (fun (fromei code)) vec v vec r "vectorMapAux" 51 app2 (fun (fromei code)) vec v vec r "vectorMapAux"
@@ -70,31 +65,6 @@ vectorZipAux fun code u v = unsafePerformIO $ do
70 65
71--------------------------------------------------------------------- 66---------------------------------------------------------------------
72 67
73-- | obtains different functions of a vector: norm1, norm2, max, min, posmax, posmin, etc.
74toScalarR :: FunCodeS -> Vector Double -> Double
75toScalarR oper = toScalarAux c_toScalarR (fromei oper)
76
77foreign import ccall unsafe "gsl-aux.h toScalarR" c_toScalarR :: CInt -> TVV
78
79-- | obtains different functions of a vector: norm1, norm2, max, min, posmax, posmin, etc.
80toScalarF :: FunCodeS -> Vector Float -> Float
81toScalarF oper = toScalarAux c_toScalarF (fromei oper)
82
83foreign import ccall unsafe "gsl-aux.h toScalarF" c_toScalarF :: CInt -> TFF
84
85-- | obtains different functions of a vector: only norm1, norm2
86toScalarC :: FunCodeS -> Vector (Complex Double) -> Double
87toScalarC oper = toScalarAux c_toScalarC (fromei oper)
88
89foreign import ccall unsafe "gsl-aux.h toScalarC" c_toScalarC :: CInt -> TCVV
90
91-- | obtains different functions of a vector: only norm1, norm2
92toScalarQ :: FunCodeS -> Vector (Complex Float) -> Float
93toScalarQ oper = toScalarAux c_toScalarQ (fromei oper)
94
95foreign import ccall unsafe "gsl-aux.h toScalarQ" c_toScalarQ :: CInt -> TQVF
96
97------------------------------------------------------------------
98 68
99-- | map of real vectors with given function 69-- | map of real vectors with given function
100vectorMapR :: FunCodeV -> Vector Double -> Vector Double 70vectorMapR :: FunCodeV -> Vector Double -> Vector Double
diff --git a/packages/hmatrix/src/Numeric/GSL/gsl-vector.c b/packages/hmatrix/src/Numeric/GSL/gsl-vector.c
index 7e3c548..1eaf66c 100644
--- a/packages/hmatrix/src/Numeric/GSL/gsl-vector.c
+++ b/packages/hmatrix/src/Numeric/GSL/gsl-vector.c
@@ -88,72 +88,6 @@
88#define BAD_FILE 2003 88#define BAD_FILE 2003
89 89
90 90
91
92int toScalarR(int code, KRVEC(x), RVEC(r)) {
93 REQUIRES(rn==1,BAD_SIZE);
94 DEBUGMSG("toScalarR");
95 KDVVIEW(x);
96 double res;
97 switch(code) {
98 case 0: { res = gsl_blas_dnrm2(V(x)); break; }
99 case 1: { res = gsl_blas_dasum(V(x)); break; }
100 case 2: { res = gsl_vector_max_index(V(x)); break; }
101 case 3: { res = gsl_vector_max(V(x)); break; }
102 case 4: { res = gsl_vector_min_index(V(x)); break; }
103 case 5: { res = gsl_vector_min(V(x)); break; }
104 default: ERROR(BAD_CODE);
105 }
106 rp[0] = res;
107 OK
108}
109
110int toScalarF(int code, KFVEC(x), FVEC(r)) {
111 REQUIRES(rn==1,BAD_SIZE);
112 DEBUGMSG("toScalarF");
113 KFVVIEW(x);
114 float res;
115 switch(code) {
116 case 0: { res = gsl_blas_snrm2(V(x)); break; }
117 case 1: { res = gsl_blas_sasum(V(x)); break; }
118 case 2: { res = gsl_vector_float_max_index(V(x)); break; }
119 case 3: { res = gsl_vector_float_max(V(x)); break; }
120 case 4: { res = gsl_vector_float_min_index(V(x)); break; }
121 case 5: { res = gsl_vector_float_min(V(x)); break; }
122 default: ERROR(BAD_CODE);
123 }
124 rp[0] = res;
125 OK
126}
127
128
129int toScalarC(int code, KCVEC(x), RVEC(r)) {
130 REQUIRES(rn==1,BAD_SIZE);
131 DEBUGMSG("toScalarC");
132 KCVVIEW(x);
133 double res;
134 switch(code) {
135 case 0: { res = gsl_blas_dznrm2(V(x)); break; }
136 case 1: { res = gsl_blas_dzasum(V(x)); break; }
137 default: ERROR(BAD_CODE);
138 }
139 rp[0] = res;
140 OK
141}
142
143int toScalarQ(int code, KQVEC(x), FVEC(r)) {
144 REQUIRES(rn==1,BAD_SIZE);
145 DEBUGMSG("toScalarQ");
146 KQVVIEW(x);
147 float res;
148 switch(code) {
149 case 0: { res = gsl_blas_scnrm2(V(x)); break; }
150 case 1: { res = gsl_blas_scasum(V(x)); break; }
151 default: ERROR(BAD_CODE);
152 }
153 rp[0] = res;
154 OK
155}
156
157 91
158inline double sign(double x) { 92inline double sign(double x) {
159 if(x>0) { 93 if(x>0) {