LVAL xsaxpy(V)
{
LVAL result, next, tx, a, x, y;
int i, j, m, n, start, end, lower;
double val;
a = getdarraydata(xlgamatrix());
x = xlgaseq();
y = xlgaseq();
lower = (moreargs() && xlgetarg() != NIL) ? TRUE : FALSE;
n = seqlen(x);
m = seqlen(y);
if (lower && m != n)
xlfail("dimensions do not match");
xlsave1(result);
result = mklist(m, NIL);
for (i = 0, start = 0, next = result;
i < m;
i++, start += n, next = cdr(next)) {
val = makefloat(getnextelement(&y, i));
end = (lower) ? i +1 : n;
for (j = 0, tx = x; j < end; j++) {
val += makefloat(getnextelement(&tx, j))
* makefloat(gettvecelement(a, start + j));
}
rplaca(next, cvflonum((FLOTYPE) val));
}
xlpop();
return(result);
}
/*
sorting function - this function should work completely abstracted from the data type to sort
//*/
void* sort(void** first)
{
void* tmp = *first;
char done = 0;
while(!done){
done = 1;
tmp = *first;
// while there is a next compare "tmp" and "tmp->next", in case swap
while(!islastelement(tmp)){
if(compare(tmp, getnextelement(tmp))){
swap((void*) &tmp, getnextelement(tmp));
done = 0;
}
tmp = iterate(tmp, first);
}
}
return NULL;
}
/*
iterates to the following element
//*/
void* iterate(void* arg, void** first)
{
element_t* tmp = (element_t*) arg;
// check for first element and set first
if(isfirstelement(tmp)){
*first = tmp;
}
// return the following element
if(islastelement(tmp)){
return *first;
}else{
return getnextelement(tmp);
}
}
static VOID set_internal_transformation P3C(int, vars, LVAL, m, LVAL, b)
{
int i, j, k, rows, cols;
LVAL data;
if (vars <= 0) return;
if (vars > maxvars) {
maxvars = 0;
StFree(transformdata);
StFree(transform);
StFree(inbasis);
transformdata = (double *) StCalloc(vars * vars, sizeof(double));
transform = (double **) StCalloc(vars, sizeof(double *));
for (i = 0; i < vars; i++) transform[i] = transformdata + vars * i;
inbasis = (int *) StCalloc(vars, sizeof(double));
maxvars = vars;
}
if (! matrixp(m)) xlerror("not a matrix", m);
rows = numrows(m);
cols = numcols(m);
if (rows > vars) rows = vars;
if (cols > vars) cols = vars;
if (rows != cols) xlerror("bad transformation matrix", m);
/* fill in upper left corner of transform from m; rest is identity */
data = getdarraydata(m);
for (i = 0, k = 0; i < rows; i++) {
for (j = 0; j < cols; j++, k++)
transform[i][j] = makefloat(gettvecelement(data, k));
for (j = cols; j < vars; j++)
transform[i][j] = (i == j) ? 1.0 : 0.0;
}
for (i = rows; i < vars; i++)
for (j = 0; j < vars; j++)
transform[i][j] = (i == j) ? 1.0 : 0.0;
/* figure out basis elements using b and size of m */
if (b != NIL) {
if (! seqp(b)) xlerror("not a sequence", b);
if (seqlen(b) != rows) xlerror("wrong length for basis", b);
for (i = 0; i < rows; i++)
inbasis[i] = (getnextelement(&b, i) != NIL) ? TRUE : FALSE;
}
else for (i = 0; i < rows; i++) inbasis[i] = TRUE;
for (i = rows; i < vars; i++) inbasis[i] = FALSE;
}
/*
sorting
calls the recursive function
//*/
void sort(void** first)
{
// checks
if(NULL == first) return;
if(isfirstelement(*first) && islastelement(*first)) return;
// inits
void* first_elem = *first;
void* last_elem = first_elem;
while( !islastelement(last_elem)){
last_elem = getnextelement(last_elem);
}
// actual sort (recursive)
quicksort(first_elem, last_elem);
// reset *first to the new first;
while(!isfirstelement(first_elem)){
first_elem = getprevelement(first_elem);
}
*first = first_elem;
}
static VOID base_mean P3C(int *, count, Number *, mean, LVAL, x)
{
LVAL y;
Number num;
double c, p, q;
int i, n;
if (! compoundp(x)) {
c = *count; p = c / (c + 1.0); q = 1.0 - p;
make_number(&num, x);
mean->real = p * mean->real + q * num.real;
mean->complex = mean->complex || num.complex;
if (mean->complex) mean->imag = p * mean->imag + q * num.imag;
(*count)++;
}
else {
x = compounddataseq(x);
n = seqlen(x);
for (i = 0; i < n; i++) {
y = getnextelement(&x, i);
base_mean(count, mean, y);
}
}
}
/*
part of the recursive approach of a quicksort implementation
iterate thru bottom half and push higher elements to upper half (before pivot) - multithreading possible
//*/
void quicksort(void* first, void* last)
{
// checks
if(NULL == first) return;
if(NULL == last) return;
if(isfirstelement(last)) return;
if(islastelement(first)) return;
if(first == last) return;
// ok, init
void* smaller = first;
void* pivot = last;
void* greater = getprevelement(pivot);
if(smaller == greater) return;
// freeze the pointers to the position
int freeze_greater = 0;
int freeze_smaller = 0;
while(1){
if(!freeze_smaller){
// compare: pivot < smaller
if(0 < compare(smaller, pivot)){
// freeze
freeze_smaller = 1;
}else{
smaller = getnextelement(smaller);
}
}
if(!freeze_greater){
// compare: pivot > greater
if(0 < compare(pivot, greater)){
// freeze
freeze_greater = 1;
}else{
greater = getprevelement(greater);
}
}
// break out
if(smaller == greater) break;
if(smaller == getnextelement(greater)) break;
if(greater == getprevelement(smaller)) break;
// both are frozen - interchange
if(freeze_smaller && freeze_greater){
if(smaller == first) first = greater; // set new first
if(0 > interchange(&smaller, &greater)){
perror("something in the queue was NULL?!"); // this is impossible if the implementation is ok!
return;
}
smaller = getnextelement(smaller);
greater = getprevelement(greater);
freeze_smaller = 0;
freeze_greater = 0;
}
}
// swap pivot with smaller
if(freeze_greater && (0 > compare(pivot, greater))){
if(0 > interchange(&pivot, &greater)) return;
last = pivot; // set the new last
pivot = greater; // set the new pivot
}else{
if(0 == compare(smaller, pivot)){
smaller = getnextelement(smaller);
}
if(smaller == first) first = pivot; // set the new pivot
if(0 > interchange(&smaller, &pivot)) return;
last = pivot; // set the new last
pivot = smaller; // set the new pivot
}
// split into: first - (pivot-1) and pivot - last
// everything already ordered
if(pivot == last) return;
// call for lower half
quicksort(first, getprevelement(pivot));
// call for upper half
quicksort(pivot, last);
}
