summaryrefslogtreecommitdiff
path: root/packages/base
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2015-05-24 13:20:44 +0200
committerAlberto Ruiz <aruiz@um.es>2015-05-24 13:20:44 +0200
commit250cbbff42667efeafcf704594c88a626754c1ac (patch)
tree5f43d85c9edf31aa6cf266b7ef0b6db254554115 /packages/base
parent8ede2ed162f3d00172ee3fa4835e3ee2184bcd99 (diff)
step and cond CInt
Diffstat (limited to 'packages/base')
-rw-r--r--packages/base/src/C/lapack-aux.c53
-rw-r--r--packages/base/src/Data/Packed/Internal/Numeric.hs14
-rw-r--r--packages/base/src/Data/Packed/Internal/Vector.hs38
-rw-r--r--packages/base/src/Numeric/Conversion.hs4
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
1538int 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
1545int stepF(KFVEC(x),FVEC(y)) {
1546 STEP_IMP
1545} 1547}
1546 1548
1547int stepD(DVEC(x),DVEC(y)) { 1549int 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
1553int 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
1580int condF(FVEC(x),FVEC(y),FVEC(lt),FVEC(eq),FVEC(gt),FVEC(r)) { 1587int 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
1590int condD(DVEC(x),DVEC(y),DVEC(lt),DVEC(eq),DVEC(gt),DVEC(r)) { 1591int 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++) { 1595int 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
49import Data.Packed.Development 49import Data.Packed.Development
50import Numeric.Vectorized 50import Numeric.Vectorized
51import Data.Complex 51import Data.Complex
52
53import Numeric.LinearAlgebra.LAPACK(multiplyR,multiplyC,multiplyF,multiplyQ,multiplyI) 52import Numeric.LinearAlgebra.LAPACK(multiplyR,multiplyC,multiplyF,multiplyQ,multiplyI)
54import Data.Packed.Internal 53import Data.Packed.Internal
55import Foreign.C.Types(CInt)
56import Text.Printf(printf) 54import 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--
445step 443step
446 :: (RealElement e, Container c e) 444 :: (Ord e, Container c e)
447 => c e 445 => c e
448 -> c e 446 -> c e
449step = step' 447step = 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--
462cond 460cond
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
31import Data.Packed.Internal.Common 31import Data.Packed.Internal.Common
@@ -249,37 +249,45 @@ foreign import ccall unsafe "double2float" c_double2float:: TVF
249 249
250--------------------------------------------------------------- 250---------------------------------------------------------------
251 251
252stepF :: Vector Float -> Vector Float 252step f v = unsafePerformIO $ do
253stepF 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
258stepD :: Vector Double -> Vector Double 257stepD :: Vector Double -> Vector Double
259stepD v = unsafePerformIO $ do 258stepD = step c_stepD
260 r <- createVector (dim v) 259
261 app2 c_stepD vec v vec r "stepD" 260stepF :: Vector Float -> Vector Float
262 return r 261stepF = step c_stepF
262
263stepI :: Vector CInt -> Vector CInt
264stepI = step c_stepI
263 265
264foreign import ccall unsafe "stepF" c_stepF :: TFF 266foreign import ccall unsafe "stepF" c_stepF :: TFF
265foreign import ccall unsafe "stepD" c_stepD :: TVV 267foreign import ccall unsafe "stepD" c_stepD :: TVV
268foreign import ccall unsafe "stepI" c_stepI :: CV CInt (CV CInt (IO CInt))
266 269
267--------------------------------------------------------------- 270---------------------------------------------------------------
268 271
269condF :: Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float 272condF :: Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float
270condF x y l e g = unsafePerformIO $ do 273condF = 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
275condD :: Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double 275condD :: Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double
276condD x y l e g = unsafePerformIO $ do 276condD = condg c_condD
277
278condI :: Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt
279condI = condg c_condI
280
281
282condg 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
281foreign import ccall unsafe "condF" c_condF :: CInt -> PF -> CInt -> PF -> CInt -> PF -> TFFF 288foreign import ccall unsafe "condF" c_condF :: CInt -> PF -> CInt -> PF -> CInt -> PF -> TFFF
282foreign import ccall unsafe "condD" c_condD :: CInt -> PD -> CInt -> PD -> CInt -> PD -> TVVV 289foreign import ccall unsafe "condD" c_condD :: CInt -> PD -> CInt -> PD -> CInt -> PD -> TVVV
290foreign 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
48class (Element t, Element (Complex t), RealFloat t 48class (Element t, Element (Complex t), RealFloat t)
49-- , RealOf t ~ t, RealOf (Complex t) ~ t
50 )
51 => RealElement t 49 => RealElement t
52 50
53instance RealElement Double 51instance RealElement Double