summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--packages/base/src/C/lapack-aux.c60
-rw-r--r--packages/base/src/C/vector-aux.c90
2 files changed, 118 insertions, 32 deletions
diff --git a/packages/base/src/C/lapack-aux.c b/packages/base/src/C/lapack-aux.c
index 72f2382..af515ca 100644
--- a/packages/base/src/C/lapack-aux.c
+++ b/packages/base/src/C/lapack-aux.c
@@ -1556,26 +1556,28 @@ int stepI(KIVEC(x),IVEC(y)) {
1556 1556
1557//////////////////// cond ///////////////////////// 1557//////////////////// cond /////////////////////////
1558 1558
1559int compareF(KFVEC(x),KFVEC(y),IVEC(r)) { 1559#define COMPARE_IMP \
1560 REQUIRES(xn==yn && xn==rn ,BAD_SIZE); 1560 REQUIRES(xn==yn && xn==rn ,BAD_SIZE); \
1561 DEBUGMSG("compareF") 1561 int k; \
1562 int k; 1562 for(k=0;k<xn;k++) { \
1563 for(k=0;k<xn;k++) { 1563 rp[k] = xp[k]<yp[k]?-1:(xp[k]>yp[k]?1:0); \
1564 rp[k] = xp[k]<yp[k]?-1:(xp[k]>yp[k]?1:0); 1564 } \
1565 }
1566 OK 1565 OK
1566
1567
1568int compareF(KFVEC(x),KFVEC(y),IVEC(r)) {
1569 COMPARE_IMP
1567} 1570}
1568 1571
1569int compareD(KDVEC(x),KDVEC(y),IVEC(r)) { 1572int compareD(KDVEC(x),KDVEC(y),IVEC(r)) {
1570 REQUIRES(xn==yn && xn==rn ,BAD_SIZE); 1573 COMPARE_IMP
1571 DEBUGMSG("compareD") 1574}
1572 int k; 1575
1573 for(k=0;k<xn;k++) { 1576int compareI(KIVEC(x),KIVEC(y),IVEC(r)) {
1574 rp[k] = xp[k]<yp[k]?-1:(xp[k]>yp[k]?1:0); 1577 COMPARE_IMP
1575 }
1576 OK
1577} 1578}
1578 1579
1580
1579#define COND_IMP \ 1581#define COND_IMP \
1580 REQUIRES(xn==yn && xn==ltn && xn==eqn && xn==gtn && xn==rn ,BAD_SIZE); \ 1582 REQUIRES(xn==yn && xn==ltn && xn==eqn && xn==gtn && xn==rn ,BAD_SIZE); \
1581 int k; \ 1583 int k; \
@@ -1597,27 +1599,27 @@ int condI(KIVEC(x),KIVEC(y),KIVEC(lt),KIVEC(eq),KIVEC(gt),IVEC(r)) {
1597} 1599}
1598 1600
1599 1601
1600int chooseF(KIVEC(cond),KFVEC(lt),KFVEC(eq),KFVEC(gt),FVEC(r)) { 1602#define CHOOSE_IMP \
1601 REQUIRES(condn==ltn && ltn==eqn && ltn==gtn && ltn==rn ,BAD_SIZE); 1603 REQUIRES(condn==ltn && ltn==eqn && ltn==gtn && ltn==rn ,BAD_SIZE); \
1602 DEBUGMSG("chooseF") 1604 int k; \
1603 int k; 1605 for(k=0;k<condn;k++) { \
1604 for(k=0;k<condn;k++) { 1606 rp[k] = condp[k]<0?ltp[k]:(condp[k]>0?gtp[k]:eqp[k]); \
1605 rp[k] = condp[k]<0?ltp[k]:(condp[k]>0?gtp[k]:eqp[k]); 1607 } \
1606 }
1607 OK 1608 OK
1608}
1609 1609
1610int chooseF(KIVEC(cond),KFVEC(lt),KFVEC(eq),KFVEC(gt),FVEC(r)) {
1611 CHOOSE_IMP
1612}
1610 1613
1611int chooseD(KIVEC(cond),KDVEC(lt),KDVEC(eq),KDVEC(gt),DVEC(r)) { 1614int chooseD(KIVEC(cond),KDVEC(lt),KDVEC(eq),KDVEC(gt),DVEC(r)) {
1612 REQUIRES(condn==ltn && ltn==eqn && ltn==gtn && ltn==rn ,BAD_SIZE); 1615 CHOOSE_IMP
1613 DEBUGMSG("chooseD")
1614 int k;
1615 for(k=0;k<condn;k++) {
1616 rp[k] = condp[k]<0?ltp[k]:(condp[k]>0?gtp[k]:eqp[k]);
1617 }
1618 OK
1619} 1616}
1620 1617
1618int chooseI(KIVEC(cond),KIVEC(lt),KIVEC(eq),KIVEC(gt),IVEC(r)) {
1619 CHOOSE_IMP
1620}
1621
1622
1621//////////////////////// extract ///////////////////////////////// 1623//////////////////////// extract /////////////////////////////////
1622 1624
1623#define EXTRACT_IMP \ 1625#define EXTRACT_IMP \
diff --git a/packages/base/src/C/vector-aux.c b/packages/base/src/C/vector-aux.c
index 134ca7a..5662697 100644
--- a/packages/base/src/C/vector-aux.c
+++ b/packages/base/src/C/vector-aux.c
@@ -615,6 +615,15 @@ int mapValF(int code, float* pval, KFVEC(x), FVEC(r)) {
615 } 615 }
616} 616}
617 617
618int mod (int a, int b) {
619 int m = a % b;
620 if (b>0) {
621 return m >=0 ? m : m+b;
622 } else {
623 return m <=0 ? m : m+b;
624 }
625}
626
618int mapValI(int code, int* pval, KIVEC(x), IVEC(r)) { 627int mapValI(int code, int* pval, KIVEC(x), IVEC(r)) {
619 int k; 628 int k;
620 int val = *pval; 629 int val = *pval;
@@ -625,8 +634,8 @@ int mapValI(int code, int* pval, KIVEC(x), IVEC(r)) {
625 OPV(1,val/xp[k]) 634 OPV(1,val/xp[k])
626 OPV(2,val+xp[k]) 635 OPV(2,val+xp[k])
627 OPV(3,val-xp[k]) 636 OPV(3,val-xp[k])
628 OPV(6,val%xp[k]) 637 OPV(6,mod(val,xp[k]))
629 OPV(7,xp[k]%val) 638 OPV(7,mod(xp[k],val))
630 default: ERROR(BAD_CODE); 639 default: ERROR(BAD_CODE);
631 } 640 }
632} 641}
@@ -997,12 +1006,87 @@ compare_doubles (const void *a, const void *b) {
997 return *(double*)a > *(double*)b; 1006 return *(double*)a > *(double*)b;
998} 1007}
999 1008
1000int sort_values(KDVEC(v),DVEC(r)) { 1009int sort_valuesD(KDVEC(v),DVEC(r)) {
1001 memcpy(rp,vp,vn*sizeof(double)); 1010 memcpy(rp,vp,vn*sizeof(double));
1002 qsort(rp,rn,sizeof(double),compare_doubles); 1011 qsort(rp,rn,sizeof(double),compare_doubles);
1003 OK 1012 OK
1004} 1013}
1005 1014
1015int
1016compare_floats (const void *a, const void *b) {
1017 return *(float*)a > *(float*)b;
1018}
1019
1020int sort_valuesF(KFVEC(v),FVEC(r)) {
1021 memcpy(rp,vp,vn*sizeof(float));
1022 qsort(rp,rn,sizeof(float),compare_floats);
1023 OK
1024}
1025
1026int
1027compare_ints(const void *a, const void *b) {
1028 return *(int*)a > *(int*)b;
1029}
1030
1031int sort_valuesI(KIVEC(v),IVEC(r)) {
1032 memcpy(rp,vp,vn*sizeof(int));
1033 qsort(rp,rn,sizeof(int),compare_ints);
1034 OK
1035}
1036
1037////////////////////////////////////////
1038
1039
1040#define SORTIDX_IMP(T,C) \
1041 T* x = (T*)malloc(sizeof(T)*vn); \
1042 int k; \
1043 for (k=0;k<vn;k++) { \
1044 x[k].pos = k; \
1045 x[k].val = vp[k]; \
1046 } \
1047 \
1048 qsort(x,vn,sizeof(T),C); \
1049 \
1050 for (k=0;k<vn;k++) { \
1051 rp[k] = x[k].pos; \
1052 } \
1053 free(x); \
1054 OK
1055
1056
1057typedef struct SDI { int pos; double val;} DI;
1058
1059int compare_doubles_i (const void *a, const void *b) {
1060 return ((DI*)a)->val > ((DI*)b)->val;
1061}
1062
1063int sort_indexD(KDVEC(v),IVEC(r)) {
1064 SORTIDX_IMP(DI,compare_doubles_i)
1065}
1066
1067
1068typedef struct FI { int pos; float val;} FI;
1069
1070int compare_floats_i (const void *a, const void *b) {
1071 return ((FI*)a)->val > ((FI*)b)->val;
1072}
1073
1074int sort_indexF(KFVEC(v),IVEC(r)) {
1075 SORTIDX_IMP(FI,compare_floats_i)
1076}
1077
1078
1079typedef struct II { int pos; int val;} II;
1080
1081int compare_ints_i (const void *a, const void *b) {
1082 return ((II*)a)->val > ((II*)b)->val;
1083}
1084
1085int sort_indexI(KIVEC(v),IVEC(r)) {
1086 SORTIDX_IMP(II,compare_ints_i)
1087}
1088
1089
1006//////////////////////////////////////////////////////////////////////////////// 1090////////////////////////////////////////////////////////////////////////////////
1007 1091
1008int round_vector(KDVEC(v),DVEC(r)) { 1092int round_vector(KDVEC(v),DVEC(r)) {