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);
}
LVAL xlc_seq_get(void)
{
seq_type arg1 = getseq(xlgaseq());
long arg2 = 0;
long arg3 = 0;
long arg4 = 0;
long arg5 = 0;
long arg6 = 0;
long arg7 = 0;
long arg8 = 0;
LVAL result;
xllastarg();
seq_get(arg1, &arg2, &arg3, &arg4, &arg5, &arg6, &arg7, &arg8);
{ LVAL *next = &getvalue(RSLT_sym);
*next = cons(NIL, NIL);
car(*next) = cvfixnum(arg2); next = &cdr(*next);
*next = cons(NIL, NIL);
car(*next) = cvfixnum(arg3); next = &cdr(*next);
*next = cons(NIL, NIL);
car(*next) = cvfixnum(arg4); next = &cdr(*next);
*next = cons(NIL, NIL);
car(*next) = cvfixnum(arg5); next = &cdr(*next);
*next = cons(NIL, NIL);
car(*next) = cvfixnum(arg6); next = &cdr(*next);
*next = cons(NIL, NIL);
car(*next) = cvfixnum(arg7); next = &cdr(*next);
*next = cons(NIL, NIL);
car(*next) = cvfixnum(arg8);
}
result = getvalue(RSLT_sym);
return result;
}
LVAL xssample(V)
{
LVAL x, result, temp, elem;
int n, N, replace, i, j;
x = xlgaseq();
n = getfixnum(xlgafixnum());
N = seqlen(x);
replace = (moreargs()) ? (xlgetarg() != NIL) : FALSE;
xllastarg();
if (! replace && n > N) n = N;
xlstkcheck(4);
xlprotect(x);
xlsave(result);
xlsave(elem);
xlsave(temp);
x = (listp(x)) ? coerce_to_tvec(x, s_true) : copyvector(x);
result = NIL;
if (N > 0 && n > 0) {
for (i = 0; i < n; i++) {
j = (replace) ? osrand(N) : i + osrand(N - i);
elem = gettvecelement(x, j);
result = cons(elem, result);
if (! replace) { /* swap elements i and j */
temp = gettvecelement(x, i);
settvecelement(x, i, elem);
settvecelement(x, j, temp);
}
}
}
xlpopn(4);
return(result);
}
LVAL xsfft(V)
{
LVAL data, result, x, work;
int n, isign;
data = xlgaseq();
isign = (moreargs() && xlgetarg() != NIL) ? -1.0 : 1.0;
xllastarg();
/* check and convert the data */
n = seqlen(data);
if (n <= 0)
xlfail("not enough data");
xlstkcheck(2);
xlsave(x);
xlsave(work);
x = gen2linalg(data, n, 1, s_c_dcomplex, FALSE);
work = mktvec(4 * n + 15, s_c_double);
cfft(n, REDAT(x), REDAT(work), isign);
result = listp(x) ? coerce_to_list(x) : coerce_to_tvec(x, s_true);
xlpopn(2);
return result;
}
LVAL xlc_seq_reset(void)
{
seq_type arg1 = getseq(xlgaseq());
xllastarg();
seq_reset(arg1);
return NIL;
}
LVAL xlc_seq_write_smf(void)
{
seq_type arg1 = getseq(xlgaseq());
FILE * arg2 = getfile(xlgastream());
xllastarg();
seq_write_smf(arg1, arg2);
return NIL;
}
LVAL xlc_seq_next(void)
{
seq_type arg1 = getseq(xlgaseq());
boolean result;
xllastarg();
result = seq_next(arg1);
return cvboolean(result);
}
LVAL xlc_seq_copy(void)
{
seq_type arg1 = getseq(xlgaseq());
seq_type result;
xllastarg();
result = seq_copy(arg1);
return cvseq(result);
}
LVAL xlc_seq_write(void)
{
seq_type arg1 = getseq(xlgaseq());
FILE * arg2 = getfile(xlgastream());
int arg3 = getboolean(xlgetarg());
xllastarg();
seq_write(arg1, arg2, arg3);
return NIL;
}
LVAL xssurface_contour(V)
{
LVAL s1, s2, mat, result;
LVAL x, y, z;
double *dx, *dy, *dz;
double v;
int i, j, n, m;
s1 = xlgaseq();
s2 = xlgaseq();
mat = xlgamatrix();
v = makefloat(xlgetarg());
xllastarg();
n = seqlen(s1);
m = seqlen(s2);
if (n != numrows(mat) || m != numcols(mat))
xlfail("dimensions do not match");
xlstkcheck(4);
xlsave(x);
xlsave(y);
xlsave(z);
xlsave(result);
x = gen2linalg(s1, n, 1, s_c_double, FALSE); dx = REDAT(x);
y = gen2linalg(s2, m, 1, s_c_double, FALSE); dy = REDAT(y);
z = gen2linalg(mat, n, m, s_c_double, FALSE); dz = REDAT(z);
result = NIL;
for (i = 0; i < n - 1; i++) {
for (j = 0; j < m - 1; j++) {
result = add_contour_point(m, i, j, i, j+1, dx, dy, dz, v, result);
result = add_contour_point(m, i, j+1, i+1, j+1, dx, dy, dz, v, result);
result = add_contour_point(m, i+1, j+1, i+1, j, dx, dy, dz, v, result);
result = add_contour_point(m, i+1, j, i, j, dx, dy, dz, v, result);
}
}
xlpopn(4);
return(result);
}
LVAL xlc_seq_insert_macctrl(void)
{
seq_type arg1 = getseq(xlgaseq());
long arg2 = getfixnum(xlgafixnum());
long arg3 = getfixnum(xlgafixnum());
long arg4 = getfixnum(xlgafixnum());
long arg5 = getfixnum(xlgafixnum());
long arg6 = getfixnum(xlgafixnum());
xllastarg();
insert_macctrl(arg1, arg2, arg3, arg4, arg5, arg6);
return NIL;
}
LVAL xlc_seq_insert_ramp(void)
{
seq_type arg1 = getseq(xlgaseq());
long arg2 = getfixnum(xlgafixnum());
long arg3 = getfixnum(xlgafixnum());
long arg4 = getfixnum(xlgafixnum());
long arg5 = getfixnum(xlgafixnum());
long arg6 = getfixnum(xlgafixnum());
long arg7 = getfixnum(xlgafixnum());
long arg8 = getfixnum(xlgafixnum());
long arg9 = getfixnum(xlgafixnum());
xllastarg();
insert_ctrlramp(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
return NIL;
}
LVAL xsgetsmdata(V)
{
LVAL s1, s2, arg;
LVAL x, y, xs, ys;
int n, ns, i, supplied, is_reg;
double xmin, xmax, *dx, *dxs;
s1 = xlgaseq();
s2 = xlgetarg();
arg = xlgetarg();
is_reg = ! null(xlgetarg());
xllastarg();
if (is_reg && ! seqp(s2))
xlbadtype(s2);
if (! seqp(arg) && ! fixp(arg))
xlbadtype(arg);
ns = (fixp(arg)) ? getfixnum(arg) : seqlen(arg);
supplied = (seqp(arg) && ns >= 1) ? TRUE : FALSE;
if (ns < 1) ns = NS_DEFAULT;
n = seqlen(s1);
if (n <= 0)
xlfail("sequence too short");
if (is_reg && seqlen(s2) != n)
xlfail("sequences not the same length");
xlstkcheck(4);
xlsave(x);
xlsave(y);
xlsave(xs);
xlsave(ys);
x = gen2linalg(s1, n, 1, s_c_double, FALSE);
y = is_reg ? gen2linalg(s2, n, 1, s_c_double, FALSE) : NIL;
xs = supplied ?
gen2linalg(arg, ns, 1, s_c_double, FALSE) : mktvec(ns, s_c_double);
ys = mktvec(ns, s_c_double);
if (! supplied) {
dx = REDAT(x);
dxs = REDAT(xs);
for (xmax = xmin = dx[0], i = 1; i < n; i++) {
if (dx[i] > xmax) xmax = dx[i];
if (dx[i] < xmin) xmin = dx[i];
}
for (i = 0; i < ns; i++)
dxs[i] = xmin + (xmax - xmin) * ((double) i) / ((double) (ns - 1));
}
xlnumresults = 0;
xlresults[xlnumresults++] = cvfixnum((FIXTYPE) n);
xlresults[xlnumresults++] = x;
xlresults[xlnumresults++] = y;
xlresults[xlnumresults++] = cvfixnum((FIXTYPE) ns);
xlresults[xlnumresults++] = xs;
xlresults[xlnumresults++] = ys;
xlpopn(4);
return xlresults[0];
}
