diff options
Diffstat (limited to 'packages/hmatrix/src')
-rw-r--r-- | packages/hmatrix/src/Numeric/GSL/Vector.hs | 32 | ||||
-rw-r--r-- | packages/hmatrix/src/Numeric/GSL/gsl-vector.c | 66 |
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) | |||
27 | import Numeric.Vectorized( | 27 | import 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 | ||
49 | toScalarAux fun code v = unsafePerformIO $ do | ||
50 | r <- createVector 1 | ||
51 | app2 (fun (fromei code)) vec v vec r "toScalarAux" | ||
52 | return (r @> 0) | ||
53 | |||
54 | vectorMapAux fun code v = unsafePerformIO $ do | 49 | vectorMapAux 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. | ||
74 | toScalarR :: FunCodeS -> Vector Double -> Double | ||
75 | toScalarR oper = toScalarAux c_toScalarR (fromei oper) | ||
76 | |||
77 | foreign 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. | ||
80 | toScalarF :: FunCodeS -> Vector Float -> Float | ||
81 | toScalarF oper = toScalarAux c_toScalarF (fromei oper) | ||
82 | |||
83 | foreign import ccall unsafe "gsl-aux.h toScalarF" c_toScalarF :: CInt -> TFF | ||
84 | |||
85 | -- | obtains different functions of a vector: only norm1, norm2 | ||
86 | toScalarC :: FunCodeS -> Vector (Complex Double) -> Double | ||
87 | toScalarC oper = toScalarAux c_toScalarC (fromei oper) | ||
88 | |||
89 | foreign import ccall unsafe "gsl-aux.h toScalarC" c_toScalarC :: CInt -> TCVV | ||
90 | |||
91 | -- | obtains different functions of a vector: only norm1, norm2 | ||
92 | toScalarQ :: FunCodeS -> Vector (Complex Float) -> Float | ||
93 | toScalarQ oper = toScalarAux c_toScalarQ (fromei oper) | ||
94 | |||
95 | foreign 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 |
100 | vectorMapR :: FunCodeV -> Vector Double -> Vector Double | 70 | vectorMapR :: 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 | |||
92 | int 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 | |||
110 | int 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 | |||
129 | int 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 | |||
143 | int 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 | ||
158 | inline double sign(double x) { | 92 | inline double sign(double x) { |
159 | if(x>0) { | 93 | if(x>0) { |