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); }