2006-08-26 16:06:05 +02:00
|
|
|
/* Symbolic addition
|
|
|
|
|
2008-05-10 00:47:18 +02:00
|
|
|
Terms in a sum are combined if they are identical modulo rational
|
2006-08-26 16:25:33 +02:00
|
|
|
coefficients.
|
2006-08-26 16:06:05 +02:00
|
|
|
|
|
|
|
For example, A + 2A becomes 3A.
|
|
|
|
|
|
|
|
However, the sum A + sqrt(2) A is not modified.
|
|
|
|
|
|
|
|
Combining terms can lead to second-order effects.
|
|
|
|
|
|
|
|
For example, consider the case of
|
|
|
|
|
|
|
|
1/sqrt(2) A + 3/sqrt(2) A + sqrt(2) A
|
|
|
|
|
|
|
|
The first two terms are combined to yield 2 sqrt(2) A.
|
|
|
|
|
|
|
|
This result can now be combined with the third term to yield
|
|
|
|
|
|
|
|
3 sqrt(2) A
|
|
|
|
*/
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2004-08-28 00:38:58 +02:00
|
|
|
#include "stdafx.h"
|
2004-03-03 21:24:06 +01:00
|
|
|
#include "defs.h"
|
|
|
|
|
2006-08-23 16:31:31 +02:00
|
|
|
static int flag;
|
|
|
|
|
2006-08-23 01:55:20 +02:00
|
|
|
void
|
|
|
|
eval_add(void)
|
|
|
|
{
|
|
|
|
int h = tos;
|
|
|
|
p1 = cdr(p1);
|
|
|
|
while (iscons(p1)) {
|
|
|
|
push(car(p1));
|
|
|
|
eval();
|
|
|
|
p2 = pop();
|
|
|
|
push_terms(p2);
|
|
|
|
p1 = cdr(p1);
|
|
|
|
}
|
2006-08-23 16:42:43 +02:00
|
|
|
add_terms(tos - h);
|
2006-08-23 01:55:20 +02:00
|
|
|
}
|
|
|
|
|
2006-08-23 16:31:31 +02:00
|
|
|
/* Add n terms, returns one expression on the stack. */
|
|
|
|
|
|
|
|
void
|
2006-08-23 16:42:43 +02:00
|
|
|
add_terms(int n)
|
2006-08-23 16:31:31 +02:00
|
|
|
{
|
|
|
|
int i, h;
|
|
|
|
U **s;
|
|
|
|
|
|
|
|
h = tos - n;
|
|
|
|
|
|
|
|
s = stack + h;
|
|
|
|
|
|
|
|
/* ensure no infinite loop, use "for" */
|
|
|
|
|
|
|
|
for (i = 0; i < 10; i++) {
|
|
|
|
|
|
|
|
if (n < 2)
|
|
|
|
break;
|
|
|
|
|
|
|
|
flag = 0;
|
|
|
|
|
|
|
|
qsort(s, n, sizeof (U *), cmp_terms);
|
|
|
|
|
|
|
|
if (flag == 0)
|
|
|
|
break;
|
|
|
|
|
|
|
|
n = combine_terms(s, n);
|
|
|
|
}
|
|
|
|
|
|
|
|
tos = h + n;
|
|
|
|
|
|
|
|
switch (n) {
|
|
|
|
case 0:
|
|
|
|
push_integer(0);
|
|
|
|
break;
|
|
|
|
case 1:
|
|
|
|
break;
|
|
|
|
default:
|
|
|
|
list(n);
|
2006-08-23 01:37:52 +02:00
|
|
|
p1 = pop();
|
2006-08-23 16:31:31 +02:00
|
|
|
push_symbol(ADD);
|
|
|
|
push(p1);
|
|
|
|
cons();
|
|
|
|
break;
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
/* Compare terms for order, clobbers p1 and p2. */
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-08-23 16:31:31 +02:00
|
|
|
int
|
|
|
|
cmp_terms(const void *q1, const void *q2)
|
2006-08-23 01:37:52 +02:00
|
|
|
{
|
|
|
|
int i, t;
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
p1 = *((U **) q1);
|
|
|
|
p2 = *((U **) q2);
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
/* numbers can be combined */
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
if (isnum(p1) && isnum(p2)) {
|
|
|
|
flag = 1;
|
|
|
|
return 0;
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
/* congruent tensors can be combined */
|
|
|
|
|
|
|
|
if (istensor(p1) && istensor(p2)) {
|
|
|
|
if (p1->u.tensor->ndim < p2->u.tensor->ndim)
|
|
|
|
return -1;
|
|
|
|
if (p1->u.tensor->ndim > p2->u.tensor->ndim)
|
|
|
|
return 1;
|
|
|
|
for (i = 0; i < p1->u.tensor->ndim; i++) {
|
|
|
|
if (p1->u.tensor->dim[i] < p2->u.tensor->dim[i])
|
|
|
|
return -1;
|
|
|
|
if (p1->u.tensor->dim[i] > p2->u.tensor->dim[i])
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
flag = 1;
|
|
|
|
return 0;
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
if (car(p1) == symbol(MULTIPLY)) {
|
2004-03-03 21:24:06 +01:00
|
|
|
p1 = cdr(p1);
|
2006-08-23 01:37:52 +02:00
|
|
|
if (isnum(car(p1))) {
|
|
|
|
p1 = cdr(p1);
|
|
|
|
if (cdr(p1) == symbol(NIL))
|
|
|
|
p1 = car(p1);
|
|
|
|
}
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
if (car(p2) == symbol(MULTIPLY)) {
|
2004-03-03 21:24:06 +01:00
|
|
|
p2 = cdr(p2);
|
2006-08-23 01:37:52 +02:00
|
|
|
if (isnum(car(p2))) {
|
|
|
|
p2 = cdr(p2);
|
|
|
|
if (cdr(p2) == symbol(NIL))
|
|
|
|
p2 = car(p2);
|
|
|
|
}
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
t = cmp_expr(p1, p2);
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
if (t == 0)
|
|
|
|
flag = 1;
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
return t;
|
|
|
|
}
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
/* Compare adjacent terms in s[] and combine if possible.
|
|
|
|
|
|
|
|
Returns the number of terms remaining in s[].
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
n number of terms in s[] initially
|
|
|
|
*/
|
|
|
|
|
|
|
|
int
|
|
|
|
combine_terms(U **s, int n)
|
2004-03-03 21:24:06 +01:00
|
|
|
{
|
2006-08-23 01:37:52 +02:00
|
|
|
int i, j, t;
|
|
|
|
|
|
|
|
for (i = 0; i < n - 1; i++) {
|
2006-10-09 21:13:45 +02:00
|
|
|
check_esc_flag();
|
2006-08-23 01:37:52 +02:00
|
|
|
|
|
|
|
p3 = s[i];
|
|
|
|
p4 = s[i + 1];
|
|
|
|
|
|
|
|
if (istensor(p3) && istensor(p4)) {
|
2004-03-03 21:24:06 +01:00
|
|
|
push(p3);
|
2006-08-23 01:37:52 +02:00
|
|
|
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;
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
if (istensor(p3) || istensor(p4))
|
|
|
|
continue;
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
if (isnum(p3) && isnum(p4)) {
|
|
|
|
push(p3);
|
2004-03-03 21:24:06 +01:00
|
|
|
push(p4);
|
2006-08-23 01:37:52 +02:00
|
|
|
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;
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
|
|
|
|
2006-08-23 01:37:52 +02:00
|
|
|
if (isnum(p3) || isnum(p4))
|
|
|
|
continue;
|
|
|
|
|
|
|
|
p1 = one;
|
|
|
|
p2 = one;
|
|
|
|
|
2006-08-26 16:08:56 +02:00
|
|
|
t = 0;
|
2006-08-23 01:37:52 +02:00
|
|
|
|
|
|
|
if (car(p3) == symbol(MULTIPLY)) {
|
|
|
|
p3 = cdr(p3);
|
2006-08-26 16:11:24 +02:00
|
|
|
t = 1; /* p3 is now denormal */
|
2006-08-23 01:37:52 +02:00
|
|
|
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--;
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
2006-08-23 01:37:52 +02:00
|
|
|
|
|
|
|
return n;
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
|
|
|
|
2006-08-26 16:06:05 +02:00
|
|
|
void
|
|
|
|
push_terms(U *p)
|
|
|
|
{
|
|
|
|
if (car(p) == symbol(ADD)) {
|
|
|
|
p = cdr(p);
|
|
|
|
while (iscons(p)) {
|
|
|
|
push(car(p));
|
|
|
|
p = cdr(p);
|
|
|
|
}
|
|
|
|
} else if (!iszero(p))
|
|
|
|
push(p);
|
|
|
|
}
|
|
|
|
|
|
|
|
/* add two expressions */
|
|
|
|
|
|
|
|
void
|
|
|
|
add()
|
|
|
|
{
|
|
|
|
int h;
|
|
|
|
save();
|
|
|
|
p2 = pop();
|
|
|
|
p1 = pop();
|
|
|
|
h = tos;
|
|
|
|
push_terms(p1);
|
|
|
|
push_terms(p2);
|
|
|
|
add_terms(tos - h);
|
|
|
|
restore();
|
|
|
|
}
|
|
|
|
|
2004-03-03 21:24:06 +01:00
|
|
|
void
|
2006-08-23 16:42:43 +02:00
|
|
|
add_all(int k)
|
2004-03-03 21:24:06 +01:00
|
|
|
{
|
|
|
|
int h, i;
|
2006-08-23 01:37:52 +02:00
|
|
|
U **s;
|
|
|
|
save();
|
|
|
|
s = stack + tos - k;
|
|
|
|
h = tos;
|
|
|
|
for (i = 0; i < k; i++)
|
|
|
|
push_terms(s[i]);
|
2006-08-23 16:42:43 +02:00
|
|
|
add_terms(tos - h);
|
2006-08-23 01:37:52 +02:00
|
|
|
p1 = pop();
|
|
|
|
tos -= k;
|
|
|
|
push(p1);
|
|
|
|
restore();
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
void
|
|
|
|
subtract(void)
|
|
|
|
{
|
2006-08-23 16:31:31 +02:00
|
|
|
negate();
|
|
|
|
add();
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|