diff options
Diffstat (limited to 'packages/base/src')
-rw-r--r-- | packages/base/src/C/lapack-aux.c | 53 | ||||
-rw-r--r-- | packages/base/src/Data/Packed/Internal/Numeric.hs | 14 | ||||
-rw-r--r-- | packages/base/src/Data/Packed/Internal/Vector.hs | 38 | ||||
-rw-r--r-- | packages/base/src/Numeric/Conversion.hs | 4 |
4 files changed, 56 insertions, 53 deletions
diff --git a/packages/base/src/C/lapack-aux.c b/packages/base/src/C/lapack-aux.c index c2cdc62..72f2382 100644 --- a/packages/base/src/C/lapack-aux.c +++ b/packages/base/src/C/lapack-aux.c | |||
@@ -1535,24 +1535,24 @@ int conjugateC(KCVEC(x),CVEC(t)) { | |||
1535 | 1535 | ||
1536 | //////////////////// step ///////////////////////// | 1536 | //////////////////// step ///////////////////////// |
1537 | 1537 | ||
1538 | int stepF(FVEC(x),FVEC(y)) { | 1538 | #define STEP_IMP \ |
1539 | DEBUGMSG("stepF") | 1539 | int k; \ |
1540 | int k; | 1540 | for(k=0;k<xn;k++) { \ |
1541 | for(k=0;k<xn;k++) { | 1541 | yp[k]=xp[k]>0; \ |
1542 | yp[k]=xp[k]>0; | 1542 | } \ |
1543 | } | ||
1544 | OK | 1543 | OK |
1544 | |||
1545 | int stepF(KFVEC(x),FVEC(y)) { | ||
1546 | STEP_IMP | ||
1545 | } | 1547 | } |
1546 | 1548 | ||
1547 | int stepD(DVEC(x),DVEC(y)) { | 1549 | int stepD(KDVEC(x),DVEC(y)) { |
1548 | DEBUGMSG("stepD") | 1550 | STEP_IMP |
1549 | int k; | ||
1550 | for(k=0;k<xn;k++) { | ||
1551 | yp[k]=xp[k]>0; | ||
1552 | } | ||
1553 | OK | ||
1554 | } | 1551 | } |
1555 | 1552 | ||
1553 | int stepI(KIVEC(x),IVEC(y)) { | ||
1554 | STEP_IMP | ||
1555 | } | ||
1556 | 1556 | ||
1557 | //////////////////// cond ///////////////////////// | 1557 | //////////////////// cond ///////////////////////// |
1558 | 1558 | ||
@@ -1576,25 +1576,24 @@ int compareD(KDVEC(x),KDVEC(y),IVEC(r)) { | |||
1576 | OK | 1576 | OK |
1577 | } | 1577 | } |
1578 | 1578 | ||
1579 | #define COND_IMP \ | ||
1580 | REQUIRES(xn==yn && xn==ltn && xn==eqn && xn==gtn && xn==rn ,BAD_SIZE); \ | ||
1581 | int k; \ | ||
1582 | for(k=0;k<xn;k++) { \ | ||
1583 | rp[k] = xp[k]<yp[k]?ltp[k]:(xp[k]>yp[k]?gtp[k]:eqp[k]); \ | ||
1584 | } \ | ||
1585 | OK | ||
1579 | 1586 | ||
1580 | int condF(FVEC(x),FVEC(y),FVEC(lt),FVEC(eq),FVEC(gt),FVEC(r)) { | 1587 | int condF(FVEC(x),FVEC(y),FVEC(lt),FVEC(eq),FVEC(gt),FVEC(r)) { |
1581 | REQUIRES(xn==yn && xn==ltn && xn==eqn && xn==gtn && xn==rn ,BAD_SIZE); | 1588 | COND_IMP |
1582 | DEBUGMSG("condF") | ||
1583 | int k; | ||
1584 | for(k=0;k<xn;k++) { | ||
1585 | rp[k] = xp[k]<yp[k]?ltp[k]:(xp[k]>yp[k]?gtp[k]:eqp[k]); | ||
1586 | } | ||
1587 | OK | ||
1588 | } | 1589 | } |
1589 | 1590 | ||
1590 | int condD(DVEC(x),DVEC(y),DVEC(lt),DVEC(eq),DVEC(gt),DVEC(r)) { | 1591 | int condD(DVEC(x),DVEC(y),DVEC(lt),DVEC(eq),DVEC(gt),DVEC(r)) { |
1591 | REQUIRES(xn==yn && xn==ltn && xn==eqn && xn==gtn && xn==rn ,BAD_SIZE); | 1592 | COND_IMP |
1592 | DEBUGMSG("condD") | 1593 | } |
1593 | int k; | 1594 | |
1594 | for(k=0;k<xn;k++) { | 1595 | int condI(KIVEC(x),KIVEC(y),KIVEC(lt),KIVEC(eq),KIVEC(gt),IVEC(r)) { |
1595 | rp[k] = xp[k]<yp[k]?ltp[k]:(xp[k]>yp[k]?gtp[k]:eqp[k]); | 1596 | COND_IMP |
1596 | } | ||
1597 | OK | ||
1598 | } | 1597 | } |
1599 | 1598 | ||
1600 | 1599 | ||
diff --git a/packages/base/src/Data/Packed/Internal/Numeric.hs b/packages/base/src/Data/Packed/Internal/Numeric.hs index 353877a..e6fcd31 100644 --- a/packages/base/src/Data/Packed/Internal/Numeric.hs +++ b/packages/base/src/Data/Packed/Internal/Numeric.hs | |||
@@ -49,10 +49,8 @@ import Numeric.Conversion | |||
49 | import Data.Packed.Development | 49 | import Data.Packed.Development |
50 | import Numeric.Vectorized | 50 | import Numeric.Vectorized |
51 | import Data.Complex | 51 | import Data.Complex |
52 | |||
53 | import Numeric.LinearAlgebra.LAPACK(multiplyR,multiplyC,multiplyF,multiplyQ,multiplyI) | 52 | import Numeric.LinearAlgebra.LAPACK(multiplyR,multiplyC,multiplyF,multiplyQ,multiplyI) |
54 | import Data.Packed.Internal | 53 | import Data.Packed.Internal |
55 | import Foreign.C.Types(CInt) | ||
56 | import Text.Printf(printf) | 54 | import Text.Printf(printf) |
57 | 55 | ||
58 | ------------------------------------------------------------------- | 56 | ------------------------------------------------------------------- |
@@ -153,8 +151,8 @@ class Element e => Container c e | |||
153 | maxElement' :: c e -> e | 151 | maxElement' :: c e -> e |
154 | sumElements' :: c e -> e | 152 | sumElements' :: c e -> e |
155 | prodElements' :: c e -> e | 153 | prodElements' :: c e -> e |
156 | step' :: RealElement e => c e -> c e | 154 | step' :: Ord e => c e -> c e |
157 | cond' :: RealElement e | 155 | cond' :: Ord e |
158 | => c e -- ^ a | 156 | => c e -- ^ a |
159 | -> c e -- ^ b | 157 | -> c e -- ^ b |
160 | -> c e -- ^ l | 158 | -> c e -- ^ l |
@@ -205,11 +203,11 @@ instance Container Vector CInt | |||
205 | -- maxElement' = emptyErrorV "maxElement" (toScalarF Max) | 203 | -- maxElement' = emptyErrorV "maxElement" (toScalarF Max) |
206 | -- sumElements' = sumF | 204 | -- sumElements' = sumF |
207 | -- prodElements' = prodF | 205 | -- prodElements' = prodF |
208 | -- step' = stepF | 206 | step' = stepI |
209 | find' = findV | 207 | find' = findV |
210 | assoc' = assocV | 208 | assoc' = assocV |
211 | accum' = accumV | 209 | accum' = accumV |
212 | -- cond' = condV condI | 210 | cond' = condV condI |
213 | scaleRecip = undefined -- cannot match | 211 | scaleRecip = undefined -- cannot match |
214 | divide = undefined | 212 | divide = undefined |
215 | arctan2' = undefined | 213 | arctan2' = undefined |
@@ -443,7 +441,7 @@ prodElements = prodElements' | |||
443 | -- 5 |> [0.0,0.0,0.0,1.0,1.0] | 441 | -- 5 |> [0.0,0.0,0.0,1.0,1.0] |
444 | -- | 442 | -- |
445 | step | 443 | step |
446 | :: (RealElement e, Container c e) | 444 | :: (Ord e, Container c e) |
447 | => c e | 445 | => c e |
448 | -> c e | 446 | -> c e |
449 | step = step' | 447 | step = step' |
@@ -460,7 +458,7 @@ step = step' | |||
460 | -- , 0.0, 0.0, 100.0, 12.0 ] | 458 | -- , 0.0, 0.0, 100.0, 12.0 ] |
461 | -- | 459 | -- |
462 | cond | 460 | cond |
463 | :: (RealElement e, Container c e) | 461 | :: (Ord e, Container c e) |
464 | => c e -- ^ a | 462 | => c e -- ^ a |
465 | -> c e -- ^ b | 463 | -> c e -- ^ b |
466 | -> c e -- ^ l | 464 | -> c e -- ^ l |
diff --git a/packages/base/src/Data/Packed/Internal/Vector.hs b/packages/base/src/Data/Packed/Internal/Vector.hs index 2a6ed2c..7b0df64 100644 --- a/packages/base/src/Data/Packed/Internal/Vector.hs +++ b/packages/base/src/Data/Packed/Internal/Vector.hs | |||
@@ -19,13 +19,13 @@ module Data.Packed.Internal.Vector ( | |||
19 | foldVector, foldVectorG, foldLoop, foldVectorWithIndex, | 19 | foldVector, foldVectorG, foldLoop, foldVectorWithIndex, |
20 | createVector, vec, | 20 | createVector, vec, |
21 | asComplex, asReal, float2DoubleV, double2FloatV, | 21 | asComplex, asReal, float2DoubleV, double2FloatV, |
22 | stepF, stepD, condF, condD, | 22 | stepF, stepD, stepI, condF, condD, condI, |
23 | conjugateQ, conjugateC, | 23 | conjugateQ, conjugateC, |
24 | cloneVector, | 24 | cloneVector, |
25 | unsafeToForeignPtr, | 25 | unsafeToForeignPtr, |
26 | unsafeFromForeignPtr, | 26 | unsafeFromForeignPtr, |
27 | unsafeWith, | 27 | unsafeWith, |
28 | Idxs | 28 | CInt,Idxs |
29 | ) where | 29 | ) where |
30 | 30 | ||
31 | import Data.Packed.Internal.Common | 31 | import Data.Packed.Internal.Common |
@@ -249,37 +249,45 @@ foreign import ccall unsafe "double2float" c_double2float:: TVF | |||
249 | 249 | ||
250 | --------------------------------------------------------------- | 250 | --------------------------------------------------------------- |
251 | 251 | ||
252 | stepF :: Vector Float -> Vector Float | 252 | step f v = unsafePerformIO $ do |
253 | stepF v = unsafePerformIO $ do | ||
254 | r <- createVector (dim v) | 253 | r <- createVector (dim v) |
255 | app2 c_stepF vec v vec r "stepF" | 254 | app2 f vec v vec r "step" |
256 | return r | 255 | return r |
257 | 256 | ||
258 | stepD :: Vector Double -> Vector Double | 257 | stepD :: Vector Double -> Vector Double |
259 | stepD v = unsafePerformIO $ do | 258 | stepD = step c_stepD |
260 | r <- createVector (dim v) | 259 | |
261 | app2 c_stepD vec v vec r "stepD" | 260 | stepF :: Vector Float -> Vector Float |
262 | return r | 261 | stepF = step c_stepF |
262 | |||
263 | stepI :: Vector CInt -> Vector CInt | ||
264 | stepI = step c_stepI | ||
263 | 265 | ||
264 | foreign import ccall unsafe "stepF" c_stepF :: TFF | 266 | foreign import ccall unsafe "stepF" c_stepF :: TFF |
265 | foreign import ccall unsafe "stepD" c_stepD :: TVV | 267 | foreign import ccall unsafe "stepD" c_stepD :: TVV |
268 | foreign import ccall unsafe "stepI" c_stepI :: CV CInt (CV CInt (IO CInt)) | ||
266 | 269 | ||
267 | --------------------------------------------------------------- | 270 | --------------------------------------------------------------- |
268 | 271 | ||
269 | condF :: Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float | 272 | condF :: Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float |
270 | condF x y l e g = unsafePerformIO $ do | 273 | condF = condg c_condF |
271 | r <- createVector (dim x) | ||
272 | app6 c_condF vec x vec y vec l vec e vec g vec r "condF" | ||
273 | return r | ||
274 | 274 | ||
275 | condD :: Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double | 275 | condD :: Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double |
276 | condD x y l e g = unsafePerformIO $ do | 276 | condD = condg c_condD |
277 | |||
278 | condI :: Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt | ||
279 | condI = condg c_condI | ||
280 | |||
281 | |||
282 | condg f x y l e g = unsafePerformIO $ do | ||
277 | r <- createVector (dim x) | 283 | r <- createVector (dim x) |
278 | app6 c_condD vec x vec y vec l vec e vec g vec r "condD" | 284 | app6 f vec x vec y vec l vec e vec g vec r "cond" |
279 | return r | 285 | return r |
280 | 286 | ||
287 | |||
281 | foreign import ccall unsafe "condF" c_condF :: CInt -> PF -> CInt -> PF -> CInt -> PF -> TFFF | 288 | foreign import ccall unsafe "condF" c_condF :: CInt -> PF -> CInt -> PF -> CInt -> PF -> TFFF |
282 | foreign import ccall unsafe "condD" c_condD :: CInt -> PD -> CInt -> PD -> CInt -> PD -> TVVV | 289 | foreign import ccall unsafe "condD" c_condD :: CInt -> PD -> CInt -> PD -> CInt -> PD -> TVVV |
290 | foreign import ccall unsafe "condI" c_condI :: CV CInt (CV CInt (CV CInt (CV CInt (CV CInt (CV CInt (IO CInt)))))) | ||
283 | 291 | ||
284 | -------------------------------------------------------------------------------- | 292 | -------------------------------------------------------------------------------- |
285 | 293 | ||
diff --git a/packages/base/src/Numeric/Conversion.hs b/packages/base/src/Numeric/Conversion.hs index a1f9385..2334e9d 100644 --- a/packages/base/src/Numeric/Conversion.hs +++ b/packages/base/src/Numeric/Conversion.hs | |||
@@ -45,9 +45,7 @@ instance Precision (Complex Float) (Complex Double) where | |||
45 | float2DoubleG = asComplex . float2DoubleV . asReal | 45 | float2DoubleG = asComplex . float2DoubleV . asReal |
46 | 46 | ||
47 | -- | Supported real types | 47 | -- | Supported real types |
48 | class (Element t, Element (Complex t), RealFloat t | 48 | class (Element t, Element (Complex t), RealFloat t) |
49 | -- , RealOf t ~ t, RealOf (Complex t) ~ t | ||
50 | ) | ||
51 | => RealElement t | 49 | => RealElement t |
52 | 50 | ||
53 | instance RealElement Double | 51 | instance RealElement Double |