diff options
Diffstat (limited to 'packages')
-rw-r--r-- | packages/base/src/C/lapack-aux.c | 60 | ||||
-rw-r--r-- | packages/base/src/C/vector-aux.c | 90 |
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 | ||
1559 | int 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 | |||
1568 | int compareF(KFVEC(x),KFVEC(y),IVEC(r)) { | ||
1569 | COMPARE_IMP | ||
1567 | } | 1570 | } |
1568 | 1571 | ||
1569 | int compareD(KDVEC(x),KDVEC(y),IVEC(r)) { | 1572 | int 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++) { | 1576 | int 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 | ||
1600 | int 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 | ||
1610 | int chooseF(KIVEC(cond),KFVEC(lt),KFVEC(eq),KFVEC(gt),FVEC(r)) { | ||
1611 | CHOOSE_IMP | ||
1612 | } | ||
1610 | 1613 | ||
1611 | int chooseD(KIVEC(cond),KDVEC(lt),KDVEC(eq),KDVEC(gt),DVEC(r)) { | 1614 | int 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 | ||
1618 | int 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 | ||
618 | int 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 | |||
618 | int mapValI(int code, int* pval, KIVEC(x), IVEC(r)) { | 627 | int 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 | ||
1000 | int sort_values(KDVEC(v),DVEC(r)) { | 1009 | int 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 | ||
1015 | int | ||
1016 | compare_floats (const void *a, const void *b) { | ||
1017 | return *(float*)a > *(float*)b; | ||
1018 | } | ||
1019 | |||
1020 | int 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 | |||
1026 | int | ||
1027 | compare_ints(const void *a, const void *b) { | ||
1028 | return *(int*)a > *(int*)b; | ||
1029 | } | ||
1030 | |||
1031 | int 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 | |||
1057 | typedef struct SDI { int pos; double val;} DI; | ||
1058 | |||
1059 | int compare_doubles_i (const void *a, const void *b) { | ||
1060 | return ((DI*)a)->val > ((DI*)b)->val; | ||
1061 | } | ||
1062 | |||
1063 | int sort_indexD(KDVEC(v),IVEC(r)) { | ||
1064 | SORTIDX_IMP(DI,compare_doubles_i) | ||
1065 | } | ||
1066 | |||
1067 | |||
1068 | typedef struct FI { int pos; float val;} FI; | ||
1069 | |||
1070 | int compare_floats_i (const void *a, const void *b) { | ||
1071 | return ((FI*)a)->val > ((FI*)b)->val; | ||
1072 | } | ||
1073 | |||
1074 | int sort_indexF(KFVEC(v),IVEC(r)) { | ||
1075 | SORTIDX_IMP(FI,compare_floats_i) | ||
1076 | } | ||
1077 | |||
1078 | |||
1079 | typedef struct II { int pos; int val;} II; | ||
1080 | |||
1081 | int compare_ints_i (const void *a, const void *b) { | ||
1082 | return ((II*)a)->val > ((II*)b)->val; | ||
1083 | } | ||
1084 | |||
1085 | int sort_indexI(KIVEC(v),IVEC(r)) { | ||
1086 | SORTIDX_IMP(II,compare_ints_i) | ||
1087 | } | ||
1088 | |||
1089 | |||
1006 | //////////////////////////////////////////////////////////////////////////////// | 1090 | //////////////////////////////////////////////////////////////////////////////// |
1007 | 1091 | ||
1008 | int round_vector(KDVEC(v),DVEC(r)) { | 1092 | int round_vector(KDVEC(v),DVEC(r)) { |