void
adj(void)
{
int i, j, n;
save();
p1 = pop();
if (istensor(p1) && p1->u.tensor->ndim == 2 && p1->u.tensor->dim[0] == p1->u.tensor->dim[1])
;
else
stop("adj: square matrix expected");
n = p1->u.tensor->dim[0];
p2 = alloc_tensor(n * n);
p2->u.tensor->ndim = 2;
p2->u.tensor->dim[0] = n;
p2->u.tensor->dim[1] = n;
for (i = 0; i < n; i++)
for (j = 0; j < n; j++) {
cofactor(p1, n, i, j);
p2->u.tensor->elem[n * j + i] = pop(); /* transpose */
}
push(p2);
restore();
}
void
expand_get_A(void)
{
int h, i, n;
if (!istensor(C)) {
push(A);
reciprocate();
A = pop();
return;
}
h = tos;
if (car(A) == symbol(MULTIPLY)) {
T = cdr(A);
while (iscons(T)) {
F = car(T);
expand_get_AF();
T = cdr(T);
}
} else {
F = A;
expand_get_AF();
}
n = tos - h;
T = alloc_tensor(n);
T->u.tensor->ndim = 1;
T->u.tensor->dim[0] = n;
for (i = 0; i < n; i++)
T->u.tensor->elem[i] = stack[h + i];
tos = h;
A = T;
}
void
untag(U *p)
{
int i;
if (iscons(p)) {
do {
if (p->tag == 0)
return;
p->tag = 0;
untag(p->u.cons.car);
p = p->u.cons.cdr;
} while (iscons(p));
untag(p);
return;
}
if (p->tag) {
p->tag = 0;
if (istensor(p)) {
for (i = 0; i < p->u.tensor->nelem; i++)
untag(p->u.tensor->elem[i]);
}
}
}
void
check_for_parametric_draw(void)
{
eval_f(tmin);
p1 = pop();
if (!istensor(p1)) {
tmin = xmin;
tmax = xmax;
}
}
void
derivative(void)
{
save();
p2 = pop();
p1 = pop();
if (isnum(p2))
stop("undefined function");
if (istensor(p1))
if (istensor(p2))
d_tensor_tensor();
else
d_tensor_scalar();
else if (istensor(p2))
d_scalar_tensor();
else
d_scalar_scalar();
restore();
}
void
setup_trange_f(void)
{
// default range is (-pi, pi)
tmin = -M_PI;
tmax = M_PI;
p1 = usr_symbol("trange");
if (!issymbol(p1))
return;
p1 = get_binding(p1);
// must be two element vector
if (!istensor(p1) || p1->u.tensor->ndim != 1 || p1->u.tensor->nelem != 2)
return;
push(p1->u.tensor->elem[0]);
eval();
yyfloat();
eval();
p2 = pop();
push(p1->u.tensor->elem[1]);
eval();
yyfloat();
eval();
p3 = pop();
if (!isnum(p2) || !isnum(p3))
return;
push(p2);
tmin = pop_double();
push(p3);
tmax = pop_double();
if (tmin == tmax)
stop("draw: trange is zero");
}
void
setup_yrange_f(void)
{
// default range is (-10,10)
ymin = -10.0;
ymax = 10.0;
p1 = usr_symbol("yrange");
if (!issymbol(p1))
return;
p1 = get_binding(p1);
// must be two element vector
if (!istensor(p1) || p1->u.tensor->ndim != 1 || p1->u.tensor->nelem != 2)
return;
push(p1->u.tensor->elem[0]);
eval();
yyfloat();
eval();
p2 = pop();
push(p1->u.tensor->elem[1]);
eval();
yyfloat();
eval();
p3 = pop();
if (!isnum(p2) || !isnum(p3))
return;
push(p2);
ymin = pop_double();
push(p3);
ymax = pop_double();
if (ymin == ymax)
stop("draw: yrange is zero");
}
void
subst(void)
{
int i;
save();
p3 = pop(); // new expr
p2 = pop(); // old expr
if (p2 == symbol(NIL) || p3 == symbol(NIL)) {
restore();
return;
}
p1 = pop(); // expr
if (istensor(p1)) {
p4 = alloc_tensor(p1->u.tensor->nelem);
p4->u.tensor->ndim = p1->u.tensor->ndim;
for (i = 0; i < p1->u.tensor->ndim; i++)
p4->u.tensor->dim[i] = p1->u.tensor->dim[i];
for (i = 0; i < p1->u.tensor->nelem; i++) {
push(p1->u.tensor->elem[i]);
push(p2);
push(p3);
subst();
p4->u.tensor->elem[i] = pop();
}
push(p4);
} else if (equal(p1, p2))
push(p3);
else if (iscons(p1)) {
push(car(p1));
push(p2);
push(p3);
subst();
push(cdr(p1));
push(p2);
push(p3);
subst();
cons();
} else
push(p1);
restore();
}
void
get_xy(double t)
{
eval_f(t);
p1 = pop();
if (istensor(p1)) {
if (p1->u.tensor->nelem >= 2) {
XT = p1->u.tensor->elem[0];
YT = p1->u.tensor->elem[1];
} else {
XT = symbol(NIL);
YT = symbol(NIL);
}
return;
}
push_double(t);
XT = pop();
YT = p1;
}
void
expand_get_B(void)
{
int i, n;
if (!istensor(C))
return;
n = C->u.tensor->dim[0];
T = alloc_tensor(n);
T->u.tensor->ndim = 1;
T->u.tensor->dim[0] = n;
for (i = 0; i < n; i++) {
push(B);
push(X);
push_integer(i);
power();
divide();
push(X);
filter();
T->u.tensor->elem[i] = pop();
}
B = T;
}
void
eval_cofactor(void)
{
int i, j, n;
push(cadr(p1));
eval();
p2 = pop();
if (istensor(p2) && p2->u.tensor->ndim == 2 && p2->u.tensor->dim[0] == p2->u.tensor->dim[1])
;
else
stop("cofactor: 1st arg: square matrix expected");
n = p2->u.tensor->dim[0];
push(caddr(p1));
eval();
i = pop_integer();
if (i < 1 || i > n)
stop("cofactor: 2nd arg: row index expected");
push(cadddr(p1));
eval();
j = pop_integer();
if (j < 1 || j > n)
stop("cofactor: 3rd arg: column index expected");
cofactor(p2, n, i - 1, j - 1);
}
void
set_component(int n)
{
int i, k, m, ndim, t;
U **s;
save();
if (n < 3)
stop("error in indexed assign");
s = stack + tos - n;
RVALUE = s[0];
LVALUE = s[1];
if (!istensor(LVALUE))
stop("error in indexed assign");
ndim = LVALUE->u.tensor->ndim;
m = n - 2;
if (m > ndim)
stop("error in indexed assign");
k = 0;
for (i = 0; i < m; i++) {
push(s[i + 2]);
t = pop_integer();
if (t < 1 || t > LVALUE->u.tensor->dim[i])
stop("error in indexed assign\n");
k = k * p1->u.tensor->dim[i] + t - 1;
}
for (i = m; i < ndim; i++)
k = k * p1->u.tensor->dim[i] + 0;
// copy
TMP = alloc_tensor(LVALUE->u.tensor->nelem);
TMP->u.tensor->ndim = LVALUE->u.tensor->ndim;
for (i = 0; i < p1->u.tensor->ndim; i++)
TMP->u.tensor->dim[i] = LVALUE->u.tensor->dim[i];
for (i = 0; i < p1->u.tensor->nelem; i++)
TMP->u.tensor->elem[i] = LVALUE->u.tensor->elem[i];
LVALUE = TMP;
if (ndim == m) {
if (istensor(RVALUE))
stop("error in indexed assign");
LVALUE->u.tensor->elem[k] = RVALUE;
tos -= n;
push(LVALUE);
restore();
return;
}
// see if the rvalue matches
if (!istensor(RVALUE))
stop("error in indexed assign");
if (ndim - m != RVALUE->u.tensor->ndim)
stop("error in indexed assign");
for (i = 0; i < RVALUE->u.tensor->ndim; i++)
if (LVALUE->u.tensor->dim[m + i] != RVALUE->u.tensor->dim[i])
stop("error in indexed assign");
// copy rvalue
for (i = 0; i < RVALUE->u.tensor->nelem; i++)
LVALUE->u.tensor->elem[k + i] = RVALUE->u.tensor->elem[i];
tos -= n;
push(LVALUE);
restore();
}
int
combine_terms(U **s, int n)
{
int i, j, t;
for (i = 0; i < n - 1; i++) {
check_esc_flag();
p3 = s[i];
p4 = s[i + 1];
if (istensor(p3) && istensor(p4)) {
push(p3);
push(p4);
tensor_plus_tensor();
p1 = pop();
if (p1 != symbol(NIL)) {
s[i] = p1;
for (j = i + 1; j < n - 1; j++)
s[j] = s[j + 1];
n--;
i--;
}
continue;
}
if (istensor(p3) || istensor(p4))
continue;
if (isnum(p3) && isnum(p4)) {
push(p3);
push(p4);
add_numbers();
p1 = pop();
if (iszero(p1)) {
for (j = i; j < n - 2; j++)
s[j] = s[j + 2];
n -= 2;
} else {
s[i] = p1;
for (j = i + 1; j < n - 1; j++)
s[j] = s[j + 1];
n--;
}
i--;
continue;
}
if (isnum(p3) || isnum(p4))
continue;
p1 = one;
p2 = one;
t = 0;
if (car(p3) == symbol(MULTIPLY)) {
p3 = cdr(p3);
t = 1; /* p3 is now denormal */
if (isnum(car(p3))) {
p1 = car(p3);
p3 = cdr(p3);
if (cdr(p3) == symbol(NIL)) {
p3 = car(p3);
t = 0;
}
}
}
if (car(p4) == symbol(MULTIPLY)) {
p4 = cdr(p4);
if (isnum(car(p4))) {
p2 = car(p4);
p4 = cdr(p4);
if (cdr(p4) == symbol(NIL))
p4 = car(p4);
}
}
if (!equal(p3, p4))
continue;
push(p1);
push(p2);
add_numbers();
p1 = pop();
if (iszero(p1)) {
for (j = i; j < n - 2; j++)
s[j] = s[j + 2];
n -= 2;
i--;
continue;
}
push(p1);
if (t) {
push(symbol(MULTIPLY));
push(p3);
cons();
} else
push(p3);
multiply();
s[i] = pop();
for (j = i + 1; j < n - 1; j++)
s[j] = s[j + 1];
n--;
i--;
}
return n;
}
int
cmp_terms(const void *q1, const void *q2)
{
int i, t;
cmp_terms_count++;
if (cmp_terms_count == 52)
printf("stop here");
p1 = *((U **) q1);
p2 = *((U **) q2);
/* numbers can be combined */
if (isnum(p1) && isnum(p2)) {
flag = 1;
//printf("cmp_terms #%d returns 0\n", cmp_terms_count);
return 0;
}
/* congruent tensors can be combined */
if (istensor(p1) && istensor(p2)) {
if (p1->u.tensor->ndim < p2->u.tensor->ndim){
//printf("cmp_terms #%d returns -1\n", cmp_terms_count);
return -1;
}
if (p1->u.tensor->ndim > p2->u.tensor->ndim){
//printf("cmp_terms #%d returns 1\n", cmp_terms_count);
return 1;
}
for (i = 0; i < p1->u.tensor->ndim; i++) {
if (p1->u.tensor->dim[i] < p2->u.tensor->dim[i]){
//printf("cmp_terms #%d returns -1\n", cmp_terms_count);
return -1;
}
if (p1->u.tensor->dim[i] > p2->u.tensor->dim[i]){
//printf("cmp_terms #%d returns 1\n", cmp_terms_count);
return 1;
}
}
flag = 1;
////printf("cmp_terms #%d returns 0");
return 0;
}
if (car(p1) == symbol(MULTIPLY)) {
p1 = cdr(p1);
if (isnum(car(p1))) {
p1 = cdr(p1);
if (cdr(p1) == symbol(NIL))
p1 = car(p1);
}
}
if (car(p2) == symbol(MULTIPLY)) {
p2 = cdr(p2);
if (isnum(car(p2))) {
p2 = cdr(p2);
if (cdr(p2) == symbol(NIL))
p2 = car(p2);
}
}
t = cmp_expr(p1, p2);
if (t == 0)
flag = 1;
//printf("cmp_terms #%d returns %d\n", cmp_terms_count, t);
return t;
}
void
yypower(void)
{
int n;
p2 = pop();
p1 = pop();
// both base and exponent are rational numbers?
if (isrational(p1) && isrational(p2)) {
push(p1);
push(p2);
qpow();
return;
}
// both base and exponent are either rational or double?
if (isnum(p1) && isnum(p2)) {
push(p1);
push(p2);
dpow();
return;
}
if (istensor(p1)) {
power_tensor();
return;
}
if (p1 == symbol(E) && car(p2) == symbol(LOG)) {
push(cadr(p2));
return;
}
if (p1 == symbol(E) && isdouble(p2)) {
push_double(exp(p2->u.d));
return;
}
// 1 ^ a -> 1
// a ^ 0 -> 1
if (equal(p1, one) || iszero(p2)) {
push(one);
return;
}
// a ^ 1 -> a
if (equal(p2, one)) {
push(p1);
return;
}
// (a * b) ^ c -> (a ^ c) * (b ^ c)
if (car(p1) == symbol(MULTIPLY)) {
p1 = cdr(p1);
push(car(p1));
push(p2);
power();
p1 = cdr(p1);
while (iscons(p1)) {
push(car(p1));
push(p2);
power();
multiply();
p1 = cdr(p1);
}
return;
}
// (a ^ b) ^ c -> a ^ (b * c)
if (car(p1) == symbol(POWER)) {
push(cadr(p1));
push(caddr(p1));
push(p2);
multiply();
power();
return;
}
// (a + b) ^ n -> (a + b) * (a + b) ...
if (expanding && isadd(p1) && isnum(p2)) {
push(p2);
n = pop_integer();
// this && n != 0x80000000 added by DDC
// as it's not always the case that 0x80000000
// is negative
if (n > 1 && n != 0x80000000) {
power_sum(n);
return;
}
}
// sin(x) ^ 2n -> (1 - cos(x) ^ 2) ^ n
if (trigmode == 1 && car(p1) == symbol(SIN) && iseveninteger(p2)) {
push_integer(1);
push(cadr(p1));
cosine();
push_integer(2);
power();
subtract();
push(p2);
push_rational(1, 2);
multiply();
power();
return;
}
// cos(x) ^ 2n -> (1 - sin(x) ^ 2) ^ n
if (trigmode == 2 && car(p1) == symbol(COS) && iseveninteger(p2)) {
push_integer(1);
push(cadr(p1));
sine();
push_integer(2);
power();
subtract();
push(p2);
push_rational(1, 2);
multiply();
power();
return;
}
// complex number? (just number, not expression)
if (iscomplexnumber(p1)) {
// integer power?
// n will be negative here, positive n already handled
if (isinteger(p2)) {
// / \ n
// -n | a - ib |
// (a + ib) = | -------- |
// | 2 2 |
// \ a + b /
push(p1);
conjugate();
p3 = pop();
push(p3);
push(p3);
push(p1);
multiply();
divide();
push(p2);
negate();
power();
return;
}
// noninteger or floating power?
if (isnum(p2)) {
#if 1 // use polar form
push(p1);
mag();
push(p2);
power();
push_integer(-1);
push(p1);
arg();
push(p2);
multiply();
push(symbol(PI));
divide();
power();
multiply();
#else // use exponential form
push(p1);
mag();
push(p2);
power();
push(symbol(E));
push(p1);
arg();
push(p2);
multiply();
push(imaginaryunit);
multiply();
power();
multiply();
#endif
return;
}
}
if (simplify_polar())
return;
push_symbol(POWER);
push(p1);
push(p2);
list(3);
}
static void
ytranspose(void)
{
int i, j, k, l, m, ndim, nelem, t;
int ai[MAXDIM], an[MAXDIM];
U **a, **b;
p3 = pop();
p2 = pop();
p1 = pop();
if (!istensor(p1)) {
if (!iszero(p1))
stop("transpose: tensor expected, 1st arg is not a tensor");
push(zero);
return;
}
ndim = p1->u.tensor->ndim;
nelem = p1->u.tensor->nelem;
// vector?
if (ndim == 1) {
push(p1);
return;
}
push(p2);
l = pop_integer();
push(p3);
m = pop_integer();
if (l < 1 || l > ndim || m < 1 || m > ndim)
stop("transpose: index out of range");
l--;
m--;
p2 = alloc_tensor(nelem);
p2->u.tensor->ndim = ndim;
for (i = 0; i < ndim; i++)
p2->u.tensor->dim[i] = p1->u.tensor->dim[i];
p2->u.tensor->dim[l] = p1->u.tensor->dim[m];
p2->u.tensor->dim[m] = p1->u.tensor->dim[l];
a = p1->u.tensor->elem;
b = p2->u.tensor->elem;
for (i = 0; i < ndim; i++) {
ai[i] = 0;
an[i] = p1->u.tensor->dim[i];
}
// copy components from a to b
for (i = 0; i < nelem; i++) {
t = ai[l]; ai[l] = ai[m]; ai[m] = t;
t = an[l]; an[l] = an[m]; an[m] = t;
k = 0;
for (j = 0; j < ndim; j++)
k = (k * an[j]) + ai[j];
t = ai[l]; ai[l] = ai[m]; ai[m] = t;
t = an[l]; an[l] = an[m]; an[m] = t;
b[k] = a[i];
for (j = ndim - 1; j >= 0; j--) {
if (++ai[j] < an[j])
break;
ai[j] = 0;
}
}
push(p2);
return;
}
int
cmp_expr(U *p1, U *p2)
{
int n;
if (p1 == p2)
return 0;
if (p1 == symbol(NIL))
return -1;
if (p2 == symbol(NIL))
return 1;
if (isnum(p1) && isnum(p2))
return sign(compare_numbers(p1, p2));
if (isnum(p1))
return -1;
if (isnum(p2))
return 1;
if (isstr(p1) && isstr(p2))
return sign(strcmp(p1->u.str, p2->u.str));
if (isstr(p1))
return -1;
if (isstr(p2))
return 1;
if (issymbol(p1) && issymbol(p2))
return sign(strcmp(get_printname(p1), get_printname(p2)));
if (issymbol(p1))
return -1;
if (issymbol(p2))
return 1;
if (istensor(p1) && istensor(p2))
return compare_tensors(p1, p2);
if (istensor(p1))
return -1;
if (istensor(p2))
return 1;
while (iscons(p1) && iscons(p2)) {
n = cmp_expr(car(p1), car(p2));
if (n != 0)
return n;
p1 = cdr(p1);
p2 = cdr(p2);
}
if (iscons(p2))
return -1;
if (iscons(p1))
return 1;
return 0;
}
void
index_function(int n)
{
int i, k, m, ndim, nelem, t;
U **s;
save();
s = stack + tos - n;
p1 = s[0];
// index of scalar ok
if (!istensor(p1)) {
tos -= n;
push(p1);
restore();
return;
}
ndim = p1->u.tensor->ndim;
m = n - 1;
if (m > ndim)
stop("too many indices for tensor");
k = 0;
for (i = 0; i < m; i++) {
push(s[i + 1]);
t = pop_integer();
if (t < 1 || t > p1->u.tensor->dim[i])
stop("index out of range");
k = k * p1->u.tensor->dim[i] + t - 1;
}
if (ndim == m) {
tos -= n;
push(p1->u.tensor->elem[k]);
restore();
return;
}
for (i = m; i < ndim; i++)
k = k * p1->u.tensor->dim[i] + 0;
nelem = 1;
for (i = m; i < ndim; i++)
nelem *= p1->u.tensor->dim[i];
p2 = alloc_tensor(nelem);
p2->u.tensor->ndim = ndim - m;
for (i = m; i < ndim; i++)
p2->u.tensor->dim[i - m] = p1->u.tensor->dim[i];
for (i = 0; i < nelem; i++)
p2->u.tensor->elem[i] = p1->u.tensor->elem[k + i];
tos -= n;
push(p2);
restore();
}
void
expand(void)
{
save();
X = pop();
F = pop();
if (istensor(F)) {
expand_tensor();
restore();
return;
}
// if sum of terms then sum over the expansion of each term
if (car(F) == symbol(ADD)) {
push_integer(0);
p1 = cdr(F);
while (iscons(p1)) {
push(car(p1));
push(X);
expand();
add();
p1 = cdr(p1);
}
restore();
return;
}
// B = numerator
push(F);
numerator();
B = pop();
// A = denominator
push(F);
denominator();
A = pop();
remove_negative_exponents();
// Q = quotient
push(B);
push(A);
push(X);
divpoly();
Q = pop();
// remainder B = B - A * Q
push(B);
push(A);
push(Q);
multiply();
subtract();
B = pop();
// if the remainder is zero then we're done
if (iszero(B)) {
push(Q);
restore();
return;
}
// A = factor(A)
push(A);
push(X);
factorpoly();
A = pop();
expand_get_C();
expand_get_B();
expand_get_A();
if (istensor(C)) {
push(C);
inv();
push(B);
inner();
push(A);
inner();
} else {
push(B);
push(C);
divide();
push(A);
multiply();
}
push(Q);
add();
restore();
}
void
absval(void)
{
int h;
save();
p1 = pop();
if (istensor(p1)) {
absval_tensor();
restore();
return;
}
if (isnum(p1)) {
push(p1);
if (isnegativenumber(p1))
negate();
restore();
return;
}
if (iscomplexnumber(p1)) {
push(p1);
push(p1);
conjugate();
multiply();
push_rational(1, 2);
power();
restore();
return;
}
// abs(1/a) evaluates to 1/abs(a)
if (car(p1) == symbol(POWER) && isnegativeterm(caddr(p1))) {
push(p1);
reciprocate();
absval();
reciprocate();
restore();
return;
}
// abs(a*b) evaluates to abs(a)*abs(b)
if (car(p1) == symbol(MULTIPLY)) {
h = tos;
p1 = cdr(p1);
while (iscons(p1)) {
push(car(p1));
absval();
p1 = cdr(p1);
}
multiply_all(tos - h);
restore();
return;
}
if (isnegativeterm(p1) || (car(p1) == symbol(ADD) && isnegativeterm(cadr(p1)))) {
push(p1);
negate();
p1 = pop();
}
push_symbol(ABS);
push(p1);
list(2);
restore();
}
