void
yyhermite2(int n)
{
int i;
push_integer(1);
push_integer(0);
Y1 = pop();
for (i = 0; i < n; i++) {
Y0 = Y1;
Y1 = pop();
push(X);
push(Y1);
multiply();
push_integer(i);
push(Y0);
multiply();
subtract();
push_integer(2);
multiply();
}
}
int
simplify_polar(void)
{
int n;
n = isquarterturn(p2);
switch(n) {
case 0:
break;
case 1:
push_integer(1);
return 1;
case 2:
push_integer(-1);
return 1;
case 3:
push(imaginaryunit);
return 1;
case 4:
push(imaginaryunit);
negate();
return 1;
}
if (car(p2) == symbol(ADD)) {
p3 = cdr(p2);
while (iscons(p3)) {
n = isquarterturn(car(p3));
if (n)
break;
p3 = cdr(p3);
}
switch (n) {
case 0:
return 0;
case 1:
push_integer(1);
break;
case 2:
push_integer(-1);
break;
case 3:
push(imaginaryunit);
break;
case 4:
push(imaginaryunit);
negate();
break;
}
push(p2);
push(car(p3));
subtract();
exponential();
multiply();
return 1;
}
return 0;
}
void
expand_get_AF(void)
{ int d, i, j, n = 1;
if (!find(F, X))
return;
if (car(F) == symbol(POWER)) {
push(caddr(F));
n = pop_integer();
F = cadr(F);
}
push(F);
push(X);
degree();
d = pop_integer();
for (i = n; i > 0; i--) {
for (j = 0; j < d; j++) {
push(F);
push_integer(i);
power();
reciprocate();
push(X);
push_integer(j);
power();
multiply();
}
}
}
void
expand_get_CF(void)
{ int d, i, j, n;
if (!find(F, X))
return;
trivial_divide();
if (car(F) == symbol(POWER)) {
push(caddr(F));
n = pop_integer();
P = cadr(F);
} else {
n = 1;
P = F;
}
push(P);
push(X);
degree();
d = pop_integer();
for (i = 0; i < n; i++) {
for (j = 0; j < d; j++) {
push(T);
push(P);
push_integer(i);
power();
multiply();
push(X);
push_integer(j);
power();
multiply();
}
}
}
static int pos_of(lua_State * L) {
int nargs = lua_gettop(L);
pos_info pos;
if (nargs == 1)
pos = gparser.pos_of(to_expr(L, 1));
else
pos = gparser.pos_of(to_expr(L, 1), pos_info(lua_tointeger(L, 2), lua_tointeger(L, 3)));
push_integer(L, pos.first);
push_integer(L, pos.second);
return 2;
}
void
darctanh(void)
{
push(cadr(p1));
push(p2);
derivative();
push_integer(1);
push(cadr(p1));
push_integer(2);
power();
subtract();
inverse();
multiply();
}
void
remove_negative_exponents(void)
{
int h, i, j, k, n;
h = tos;
factors(A);
factors(B);
n = tos - h;
// find the smallest exponent
j = 0;
for (i = 0; i < n; i++) {
p1 = stack[h + i];
if (car(p1) != symbol(POWER))
continue;
if (cadr(p1) != X)
continue;
push(caddr(p1));
k = pop_integer();
if (k == (int) 0x80000000)
continue;
if (k < j)
j = k;
}
tos = h;
if (j == 0)
return;
// A = A / X^j
push(A);
push(X);
push_integer(-j);
power();
multiply();
A = pop();
// B = B / X^j
push(B);
push(X);
push_integer(-j);
power();
multiply();
B = pop();
}
void
eval_product(void)
{
int i, j, k;
// 1st arg (quoted)
X = cadr(p1);
if (!issymbol(X))
stop("product: 1st arg?");
// 2nd arg
push(caddr(p1));
eval();
j = pop_integer();
if (j == (int) 0x80000000)
stop("product: 2nd arg?");
// 3rd arg
push(cadddr(p1));
eval();
k = pop_integer();
if (k == (int) 0x80000000)
stop("product: 3rd arg?");
// 4th arg
// fix
p1 = cddddr(p1);
p1 = car(p1);
B = get_binding(X);
A = get_arglist(X);
push_integer(1);
for (i = j; i <= k; i++) {
push_integer(i);
I = pop();
set_binding(X, I);
push(p1);
eval();
multiply();
}
set_binding_and_arglist(X, B, A);
}
void
darcsin(void)
{
push(cadr(p1));
push(p2);
derivative();
push_integer(1);
push(cadr(p1));
push_integer(2);
power();
subtract();
push_rational(-1, 2);
power();
multiply();
}
void
darctan(void)
{
push(cadr(p1));
push(p2);
derivative();
push_integer(1);
push(cadr(p1));
push_integer(2);
power();
add();
inverse();
multiply();
simplify();
}
void
darccosh(void)
{
push(cadr(p1));
push(p2);
derivative();
push(cadr(p1));
push_integer(2);
power();
push_integer(-1);
add();
push_rational(-1, 2);
power();
multiply();
}
void
yymag(void)
{
save();
p1 = pop();
if (isnegativenumber(p1)) {
push(p1);
negate();
} else if (car(p1) == symbol(POWER) && equaln(cadr(p1), -1))
// -1 to a power
push_integer(1);
else if (car(p1) == symbol(POWER) && cadr(p1) == symbol(E)) {
// exponential
push(caddr(p1));
real();
exponential();
} else if (car(p1) == symbol(MULTIPLY)) {
// product
push_integer(1);
p1 = cdr(p1);
while (iscons(p1)) {
push(car(p1));
mag();
multiply();
p1 = cdr(p1);
}
} else if (car(p1) == symbol(ADD)) {
// sum
push(p1);
rect(); // convert polar terms, if any
p1 = pop();
push(p1);
real();
push_integer(2);
power();
push(p1);
imag();
push_integer(2);
power();
add();
push_rational(1, 2);
power();
simplify_trig();
} else
// default (all real)
push(p1);
restore();
}
void
multinomial_sum(int k, int n, int *a, int i, int m)
{
int j;
if (i < k - 1) {
for (j = 0; j <= m; j++) {
a[i] = j;
multinomial_sum(k, n, a, i + 1, m - j);
}
return;
}
a[i] = m;
// coefficient
push(p1);
for (j = 0; j < k; j++) {
push_integer(a[j]);
factorial();
divide();
}
// factors
for (j = 0; j < k; j++) {
push(A(j, a[j]));
multiply();
}
add();
}
void
eval_transpose(void)
{
push(cadr(p1));
eval();
if (cddr(p1) == symbol(NIL)) {
push_integer(1);
push_integer(2);
} else {
push(caddr(p1));
eval();
push(cadddr(p1));
eval();
}
transpose();
}
void
partition(void)
{
save();
p2 = pop();
p1 = pop();
push_integer(1);
p3 = pop();
p4 = p3;
p1 = cdr(p1);
while (iscons(p1)) {
if (find(car(p1), p2)) {
push(p4);
push(car(p1));
multiply();
p4 = pop();
} else {
push(p3);
push(car(p1));
multiply();
p3 = pop();
}
p1 = cdr(p1);
}
push(p3);
push(p4);
restore();
}
void
dhermite(void)
{
push(cadr(p1));
push(p2);
derivative();
push_integer(2);
push(caddr(p1));
multiply();
multiply();
push(cadr(p1));
push(caddr(p1));
push_integer(-1);
add();
hermite();
multiply();
}
void
power_sum(int n)
{
int *a, i, j, k;
// number of terms in the sum
k = length(p1) - 1;
// local frame
push_frame(k * (n + 1));
// array of powers
p1 = cdr(p1);
for (i = 0; i < k; i++) {
for (j = 0; j <= n; j++) {
push(car(p1));
push_integer(j);
power();
A(i, j) = pop();
}
p1 = cdr(p1);
}
push_integer(n);
factorial();
p1 = pop();
a = (int *) malloc(k * sizeof (int));
if (a == NULL)
stop("malloc failure");
push(zero);
multinomial_sum(k, n, a, 0, n);
free(a);
pop_frame(k * (n + 1));
}
void
factor_small_number(void)
{
int d, expo, i, n;
save();
n = pop_integer();
if (n == (int) 0x80000000)
stop("number too big to factor");
if (n < 0)
n = -n;
for (i = 0; i < MAXPRIMETAB; i++) {
d = primetab[i];
if (d > n / d)
break;
expo = 0;
while (n % d == 0) {
n /= d;
expo++;
}
if (expo) {
push_integer(d);
push_integer(expo);
}
}
if (n > 1) {
push_integer(n);
push_integer(1);
}
restore();
}
void
sgn(void)
{
save();
p1 = pop();
if (!isnum(p1)) {
push_symbol(SGN);
push(p1);
list(2);
} else if (iszero(p1))
push_integer(0);
else if (isnegativenumber(p1))
push_integer(-1);
else
push_integer(1);
restore();
}
static int value_of(lua_State * L) {
auto it = value_of(to_token_table(L, 1));
if (it) {
push_boolean(L, it->is_command());
push_name(L, it->value());
push_integer(L, it->expr_precedence());
return 3;
} else {
push_nil(L);
return 1;
}
}
void
derfc(void)
{
push(cadr(p1));
push_integer(2);
power();
push_integer(-1);
multiply();
exponential();
push_symbol(PI);
push_rational(-1,2);
power();
multiply();
push_integer(-2);
multiply();
push(cadr(p1));
push(p2);
derivative();
multiply();
}
void
dsgn(void)
{
push(cadr(p1));
push(p2);
derivative();
push(cadr(p1));
dirac();
multiply();
push_integer(2);
multiply();
}
void
dtanh(void)
{
push(cadr(p1));
push(p2);
derivative();
push(cadr(p1));
ycosh();
push_integer(-2);
power();
multiply();
}
void
imag(void)
{
save();
rect();
p1 = pop();
push(p1);
push(p1);
conjugate();
subtract();
push_integer(2);
divide();
push(imaginaryunit);
divide();
restore();
}
void
trivial_divide(void)
{
int h;
if (car(A) == symbol(MULTIPLY)) {
h = tos;
p0 = cdr(A);
while (iscons(p0)) {
if (!equal(car(p0), F)) {
push(car(p0));
eval(); // force expansion of (x+1)^2, f.e.
}
p0 = cdr(p0);
}
multiply_all(tos - h);
} else
push_integer(1);
T = pop();
}
void
expand_get_C(void)
{
int h, i, j, n;
U **a;
h = tos;
if (car(A) == symbol(MULTIPLY)) {
p1 = cdr(A);
while (iscons(p1)) {
F = car(p1);
expand_get_CF();
p1 = cdr(p1);
}
} else {
F = A;
expand_get_CF();
}
n = tos - h;
if (n == 1) {
C = pop();
return;
}
C = alloc_tensor(n * n);
C->u.tensor->ndim = 2;
C->u.tensor->dim[0] = n;
C->u.tensor->dim[1] = n;
a = stack + h;
for (i = 0; i < n; i++) {
for (j = 0; j < n; j++) {
push(a[j]);
push(X);
push_integer(i);
power();
divide();
push(X);
filter();
C->u.tensor->elem[n * i + j] = pop();
}
}
tos -= n;
}
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
yybessely(void)
{
double d;
int n;
N = pop();
X = pop();
push(N);
n = pop_integer();
if (isdouble(X) && n != (int) 0x80000000) {
d = yn(n, X->u.d);
push_double(d);
return;
}
if (isnegativeterm(N)) {
push_integer(-1);
push(N);
power();
push_symbol(BESSELY);
push(X);
push(N);
negate();
list(3);
multiply();
return;
}
push_symbol(BESSELY);
push(X);
push(N);
list(3);
return;
}
void
yyfloor(void)
{
double d;
p1 = pop();
if (!isnum(p1)) {
push_symbol(FLOOR);
push(p1);
list(2);
return;
}
if (isdouble(p1)) {
d = floor(p1->u.d);
push_double(d);
return;
}
if (isinteger(p1)) {
push(p1);
return;
}
p3 = alloc();
p3->k = NUM;
p3->u.q.a = mdiv(p1->u.q.a, p1->u.q.b);
p3->u.q.b = mint(1);
push(p3);
if (isnegativenumber(p1)) {
push_integer(-1);
add();
}
}
void
add_terms(int n)
{
stackAddsCounts++;
int i, h;
U **s;
h = tos - n;
s = stack + h;
printf("stack before adding terms #%d\n", stackAddsCounts);
if (stackAddsCounts == 137)
printf("stop here");
for (i = 0; i < tos; i++) {
print1(stack[i]);
printstr("\n");
}
/* 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);
p1 = pop();
push_symbol(ADD);
push(p1);
cons();
break;
}
printf("stack after adding terms #%d\n", stackAddsCounts);
if (stackAddsCounts == 5)
printf("stop here");
for (i = 0; i < tos; i++) {
print1(stack[i]);
printstr("\n");
}
}