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);
}
void init_random(int seed)
{
if (!seed)
osrand((int) time(NULL));
else
osrand(seed);
}
static NODE *unary(NODE *args, int fcn)
{
float fval;
long ival;
NODE *arg;
arg = xlarg(&args);
xllastarg(args);
if (((arg) && (arg)->n_type == 5)) {
ival = ((arg)->n_info.n_xint.xi_int);
switch (fcn) {
case '~': ival = ~ival; break;
case 'A': ival = ((ival) < 0 ? -(ival) : (ival)); break;
case '+': ival++; break;
case '-': ival--; break;
case 'I': break;
case 'F': return (cvflonum((float)ival));
case 'R': ival = (long)osrand((int)ival); break;
default: badiop();
}
return (cvfixnum(ival));
}
else if (((arg) && (arg)->n_type == 9)) {
fval = ((arg)->n_info.n_xfloat.xf_float);
switch (fcn) {
case 'A': fval = ((fval) < 0.0 ? -(fval) : (fval)); break;
case '+': fval += 1.0; break;
case '-': fval -= 1.0; break;
case 'S': fval = sin(fval); break;
case 'C': fval = cos(fval); break;
case 'T': fval = tan(fval); break;
case 'E': fval = exp(fval); break;
case 'R': checkfneg(fval); fval = sqrt(fval); break;
case 'I': return (cvfixnum((long)fval));
case 'F': break;
default: badfop();
}
return (cvflonum(fval));
}
else
xlerror("bad argument type",arg);
}
