diff options
author | Alberto Ruiz <aruiz@um.es> | 2014-05-14 20:25:30 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2014-05-14 20:25:30 +0200 |
commit | bdd718066eeb1dffc790d7f48398f24b9201c6ea (patch) | |
tree | 4a342f01ce372659c0e7757cecd821de157d411b /packages/hmatrix | |
parent | ce03cbdf416db2af2830b4b3b7d1722bb26f6546 (diff) |
moved prod
Diffstat (limited to 'packages/hmatrix')
-rw-r--r-- | packages/hmatrix/src/Numeric/GSL/Vector.hs | 36 | ||||
-rw-r--r-- | packages/hmatrix/src/Numeric/GSL/gsl-vector.c | 54 |
2 files changed, 1 insertions, 89 deletions
diff --git a/packages/hmatrix/src/Numeric/GSL/Vector.hs b/packages/hmatrix/src/Numeric/GSL/Vector.hs index 33bd778..38c138b 100644 --- a/packages/hmatrix/src/Numeric/GSL/Vector.hs +++ b/packages/hmatrix/src/Numeric/GSL/Vector.hs | |||
@@ -26,6 +26,7 @@ import Data.Packed | |||
26 | import Numeric.GSL.Internal hiding (TV,TM,TCV,TCM) | 26 | 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 | FunCodeS(..), | 30 | FunCodeS(..), |
30 | FunCodeV(..), | 31 | FunCodeV(..), |
31 | FunCodeSV(..), | 32 | FunCodeSV(..), |
@@ -45,41 +46,6 @@ fromei x = fromIntegral (fromEnum x) :: CInt | |||
45 | 46 | ||
46 | ------------------------------------------------------------------ | 47 | ------------------------------------------------------------------ |
47 | 48 | ||
48 | -- | product of elements | ||
49 | prodF :: Vector Float -> Float | ||
50 | prodF x = unsafePerformIO $ do | ||
51 | r <- createVector 1 | ||
52 | app2 c_prodF vec x vec r "prodF" | ||
53 | return $ r @> 0 | ||
54 | |||
55 | -- | product of elements | ||
56 | prodR :: Vector Double -> Double | ||
57 | prodR x = unsafePerformIO $ do | ||
58 | r <- createVector 1 | ||
59 | app2 c_prodR vec x vec r "prodR" | ||
60 | return $ r @> 0 | ||
61 | |||
62 | -- | product of elements | ||
63 | prodQ :: Vector (Complex Float) -> Complex Float | ||
64 | prodQ x = unsafePerformIO $ do | ||
65 | r <- createVector 1 | ||
66 | app2 c_prodQ vec x vec r "prodQ" | ||
67 | return $ r @> 0 | ||
68 | |||
69 | -- | product of elements | ||
70 | prodC :: Vector (Complex Double) -> Complex Double | ||
71 | prodC x = unsafePerformIO $ do | ||
72 | r <- createVector 1 | ||
73 | app2 c_prodC vec x vec r "prodC" | ||
74 | return $ r @> 0 | ||
75 | |||
76 | foreign import ccall unsafe "gsl-aux.h prodF" c_prodF :: TFF | ||
77 | foreign import ccall unsafe "gsl-aux.h prodR" c_prodR :: TVV | ||
78 | foreign import ccall unsafe "gsl-aux.h prodQ" c_prodQ :: TQVQV | ||
79 | foreign import ccall unsafe "gsl-aux.h prodC" c_prodC :: TCVCV | ||
80 | |||
81 | ------------------------------------------------------------------ | ||
82 | |||
83 | toScalarAux fun code v = unsafePerformIO $ do | 49 | toScalarAux fun code v = unsafePerformIO $ do |
84 | r <- createVector 1 | 50 | r <- createVector 1 |
85 | app2 (fun (fromei code)) vec v vec r "toScalarAux" | 51 | app2 (fun (fromei code)) vec v vec r "toScalarAux" |
diff --git a/packages/hmatrix/src/Numeric/GSL/gsl-vector.c b/packages/hmatrix/src/Numeric/GSL/gsl-vector.c index 3c2db4d..7e3c548 100644 --- a/packages/hmatrix/src/Numeric/GSL/gsl-vector.c +++ b/packages/hmatrix/src/Numeric/GSL/gsl-vector.c | |||
@@ -88,60 +88,6 @@ | |||
88 | #define BAD_FILE 2003 | 88 | #define BAD_FILE 2003 |
89 | 89 | ||
90 | 90 | ||
91 | int prodF(KFVEC(x),FVEC(r)) { | ||
92 | DEBUGMSG("prodF"); | ||
93 | REQUIRES(rn==1,BAD_SIZE); | ||
94 | int i; | ||
95 | float res = 1; | ||
96 | for (i = 0; i < xn; i++) res *= xp[i]; | ||
97 | rp[0] = res; | ||
98 | OK | ||
99 | } | ||
100 | |||
101 | int prodR(KRVEC(x),RVEC(r)) { | ||
102 | DEBUGMSG("prodR"); | ||
103 | REQUIRES(rn==1,BAD_SIZE); | ||
104 | int i; | ||
105 | double res = 1; | ||
106 | for (i = 0; i < xn; i++) res *= xp[i]; | ||
107 | rp[0] = res; | ||
108 | OK | ||
109 | } | ||
110 | |||
111 | int prodQ(KQVEC(x),QVEC(r)) { | ||
112 | DEBUGMSG("prodQ"); | ||
113 | REQUIRES(rn==1,BAD_SIZE); | ||
114 | int i; | ||
115 | gsl_complex_float res; | ||
116 | float temp; | ||
117 | res.dat[0] = 1; | ||
118 | res.dat[1] = 0; | ||
119 | for (i = 0; i < xn; i++) { | ||
120 | temp = res.dat[0] * xp[i].dat[0] - res.dat[1] * xp[i].dat[1]; | ||
121 | res.dat[1] = res.dat[0] * xp[i].dat[1] + res.dat[1] * xp[i].dat[0]; | ||
122 | res.dat[0] = temp; | ||
123 | } | ||
124 | rp[0] = res; | ||
125 | OK | ||
126 | } | ||
127 | |||
128 | int prodC(KCVEC(x),CVEC(r)) { | ||
129 | DEBUGMSG("prodC"); | ||
130 | REQUIRES(rn==1,BAD_SIZE); | ||
131 | int i; | ||
132 | gsl_complex res; | ||
133 | double temp; | ||
134 | res.dat[0] = 1; | ||
135 | res.dat[1] = 0; | ||
136 | for (i = 0; i < xn; i++) { | ||
137 | temp = res.dat[0] * xp[i].dat[0] - res.dat[1] * xp[i].dat[1]; | ||
138 | res.dat[1] = res.dat[0] * xp[i].dat[1] + res.dat[1] * xp[i].dat[0]; | ||
139 | res.dat[0] = temp; | ||
140 | } | ||
141 | rp[0] = res; | ||
142 | OK | ||
143 | } | ||
144 | |||
145 | 91 | ||
146 | int toScalarR(int code, KRVEC(x), RVEC(r)) { | 92 | int toScalarR(int code, KRVEC(x), RVEC(r)) { |
147 | REQUIRES(rn==1,BAD_SIZE); | 93 | REQUIRES(rn==1,BAD_SIZE); |