2005-07-22 23:48:02 +02:00
|
|
|
/* Simplify factorials
|
|
|
|
|
2005-07-25 20:13:22 +02:00
|
|
|
The following script
|
2005-07-22 23:48:02 +02:00
|
|
|
|
|
|
|
F(n,k) = k binomial(n,k)
|
2005-07-25 20:13:22 +02:00
|
|
|
(F(n,k) + F(n,k-1)) / F(n+1,k)
|
2005-07-22 23:48:02 +02:00
|
|
|
|
2005-07-25 20:13:22 +02:00
|
|
|
generates
|
2005-07-22 23:48:02 +02:00
|
|
|
|
|
|
|
k! n! n! (1 - k + n)! k! n!
|
|
|
|
-------------------- + -------------------- - ----------------------
|
|
|
|
(-1 + k)! (1 + n)! (1 + n)! (-k + n)! k (-1 + k)! (1 + n)!
|
|
|
|
|
2005-07-25 20:13:22 +02:00
|
|
|
Simplify each term to get
|
2005-07-22 23:48:02 +02:00
|
|
|
|
|
|
|
k 1 - k + n 1
|
|
|
|
------- + ----------- - -------
|
|
|
|
1 + n 1 + n 1 + n
|
|
|
|
|
2005-07-25 20:13:22 +02:00
|
|
|
Then simplify the sum to get
|
2005-07-22 23:48:02 +02:00
|
|
|
|
|
|
|
n
|
|
|
|
-------
|
|
|
|
1 + n
|
|
|
|
|
|
|
|
*/
|
2005-07-22 00:41:09 +02:00
|
|
|
|
|
|
|
#include "stdafx.h"
|
|
|
|
#include "defs.h"
|
2005-07-31 18:39:53 +02:00
|
|
|
void simfac(void);
|
2005-07-22 23:48:02 +02:00
|
|
|
static void simfac_term(void);
|
2005-07-22 00:41:09 +02:00
|
|
|
static int yysimfac(int);
|
|
|
|
|
2005-07-25 20:13:22 +02:00
|
|
|
// simplify factorials term-by-term
|
|
|
|
|
2005-07-22 00:41:09 +02:00
|
|
|
void
|
2005-07-25 20:13:22 +02:00
|
|
|
eval_simfac(void)
|
|
|
|
{
|
|
|
|
push(cadr(p1));
|
|
|
|
eval();
|
|
|
|
simfac();
|
|
|
|
}
|
|
|
|
|
|
|
|
#if 1
|
|
|
|
|
2005-07-31 18:39:53 +02:00
|
|
|
void
|
2005-07-22 00:41:09 +02:00
|
|
|
simfac(void)
|
|
|
|
{
|
2005-07-22 23:48:02 +02:00
|
|
|
int h;
|
2005-07-22 00:41:09 +02:00
|
|
|
save();
|
2005-07-22 23:48:02 +02:00
|
|
|
p1 = pop();
|
2005-07-25 20:13:22 +02:00
|
|
|
if (car(p1) == symbol(ADD)) {
|
|
|
|
h = tos;
|
|
|
|
p1 = cdr(p1);
|
2006-01-16 20:37:31 +01:00
|
|
|
while (p1 != symbol(NIL)) {
|
2005-07-25 20:13:22 +02:00
|
|
|
push(car(p1));
|
|
|
|
simfac_term();
|
|
|
|
p1 = cdr(p1);
|
|
|
|
}
|
2006-08-23 16:42:43 +02:00
|
|
|
add_all(tos - h);
|
2005-07-25 20:13:22 +02:00
|
|
|
} else {
|
|
|
|
push(p1);
|
|
|
|
simfac_term();
|
|
|
|
}
|
|
|
|
restore();
|
|
|
|
}
|
|
|
|
|
|
|
|
#else
|
2005-07-22 23:48:02 +02:00
|
|
|
|
2005-07-25 20:13:22 +02:00
|
|
|
void
|
|
|
|
simfac(void)
|
|
|
|
{
|
|
|
|
int h;
|
|
|
|
save();
|
|
|
|
p1 = pop();
|
2005-07-22 23:48:02 +02:00
|
|
|
if (car(p1) == symbol(ADD)) {
|
|
|
|
h = tos;
|
|
|
|
p1 = cdr(p1);
|
2006-01-16 20:37:31 +01:00
|
|
|
while (p1 != symbol(NIL)) {
|
2005-07-22 23:48:02 +02:00
|
|
|
push(car(p1));
|
|
|
|
simfac_term();
|
|
|
|
p1 = cdr(p1);
|
|
|
|
}
|
|
|
|
addk(tos - h);
|
|
|
|
p1 = pop();
|
|
|
|
if (find(p1, symbol(FACTORIAL))) {
|
|
|
|
push(p1);
|
|
|
|
if (car(p1) == symbol(ADD)) {
|
2006-01-15 00:55:11 +01:00
|
|
|
Condense();
|
2005-07-22 23:48:02 +02:00
|
|
|
simfac_term();
|
|
|
|
}
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
push(p1);
|
|
|
|
simfac_term();
|
|
|
|
}
|
2005-07-22 00:41:09 +02:00
|
|
|
restore();
|
|
|
|
}
|
|
|
|
|
2005-07-25 20:13:22 +02:00
|
|
|
#endif
|
|
|
|
|
2005-07-22 00:41:09 +02:00
|
|
|
static void
|
2005-07-22 23:48:02 +02:00
|
|
|
simfac_term(void)
|
2005-07-22 00:41:09 +02:00
|
|
|
{
|
|
|
|
int h;
|
|
|
|
|
2005-07-22 23:48:02 +02:00
|
|
|
save();
|
2005-07-22 00:41:09 +02:00
|
|
|
|
2005-07-22 23:48:02 +02:00
|
|
|
p1 = pop();
|
2005-07-22 00:41:09 +02:00
|
|
|
|
|
|
|
// if not a product of factors then done
|
|
|
|
|
|
|
|
if (car(p1) != symbol(MULTIPLY)) {
|
|
|
|
push(p1);
|
2005-07-22 23:48:02 +02:00
|
|
|
restore();
|
2005-07-22 00:41:09 +02:00
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
// push all factors
|
|
|
|
|
|
|
|
h = tos;
|
|
|
|
p1 = cdr(p1);
|
2006-01-16 20:37:31 +01:00
|
|
|
while (p1 != symbol(NIL)) {
|
2005-07-22 00:41:09 +02:00
|
|
|
push(car(p1));
|
|
|
|
p1 = cdr(p1);
|
|
|
|
}
|
|
|
|
|
2005-07-22 02:39:11 +02:00
|
|
|
// keep trying until no more to do
|
2005-07-22 01:23:51 +02:00
|
|
|
|
2005-07-22 00:41:09 +02:00
|
|
|
while (yysimfac(h))
|
|
|
|
;
|
|
|
|
|
2005-07-22 02:39:11 +02:00
|
|
|
multiply_all_noexpand(tos - h);
|
2005-07-22 23:48:02 +02:00
|
|
|
|
|
|
|
restore();
|
2005-07-22 00:41:09 +02:00
|
|
|
}
|
|
|
|
|
2005-07-22 01:23:51 +02:00
|
|
|
// try all pairs of factors
|
|
|
|
|
2005-07-22 00:41:09 +02:00
|
|
|
static int
|
|
|
|
yysimfac(int h)
|
|
|
|
{
|
|
|
|
int i, j;
|
|
|
|
|
|
|
|
for (i = h; i < tos; i++) {
|
|
|
|
p1 = stack[i];
|
|
|
|
for (j = h; j < tos; j++) {
|
2005-07-22 01:23:51 +02:00
|
|
|
if (i == j)
|
|
|
|
continue;
|
2005-07-22 00:41:09 +02:00
|
|
|
p2 = stack[j];
|
|
|
|
|
|
|
|
// n! / n -> (n - 1)!
|
|
|
|
|
|
|
|
if (car(p1) == symbol(FACTORIAL)
|
|
|
|
&& car(p2) == symbol(POWER)
|
|
|
|
&& isminusone(caddr(p2))
|
|
|
|
&& equal(cadr(p1), cadr(p2))) {
|
|
|
|
push(cadr(p1));
|
|
|
|
push(one);
|
|
|
|
subtract();
|
|
|
|
factorial();
|
|
|
|
stack[i] = pop();
|
|
|
|
stack[j] = one;
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
|
|
|
|
// n / n! -> 1 / (n - 1)!
|
|
|
|
|
|
|
|
if (car(p2) == symbol(POWER)
|
|
|
|
&& isminusone(caddr(p2))
|
|
|
|
&& caadr(p2) == symbol(FACTORIAL)
|
|
|
|
&& equal(p1, cadadr(p2))) {
|
|
|
|
push(p1);
|
2005-07-25 20:13:22 +02:00
|
|
|
push_integer(-1);
|
|
|
|
add();
|
2005-07-22 00:41:09 +02:00
|
|
|
factorial();
|
|
|
|
reciprocate();
|
|
|
|
stack[i] = pop();
|
|
|
|
stack[j] = one;
|
|
|
|
return 1;
|
|
|
|
}
|
2005-07-22 01:23:51 +02:00
|
|
|
|
|
|
|
// (n + 1) n! -> (n + 1)!
|
|
|
|
|
|
|
|
if (car(p2) == symbol(FACTORIAL)) {
|
|
|
|
push(p1);
|
|
|
|
push(cadr(p2));
|
|
|
|
subtract();
|
|
|
|
p3 = pop();
|
|
|
|
if (isplusone(p3)) {
|
|
|
|
push(p1);
|
|
|
|
factorial();
|
|
|
|
stack[i] = pop();
|
|
|
|
stack[j] = one;
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
}
|
2005-07-22 02:11:02 +02:00
|
|
|
|
|
|
|
// 1 / ((n + 1) n!) -> 1 / (n + 1)!
|
|
|
|
|
|
|
|
if (car(p1) == symbol(POWER)
|
|
|
|
&& isminusone(caddr(p1))
|
|
|
|
&& car(p2) == symbol(POWER)
|
|
|
|
&& isminusone(caddr(p2))
|
|
|
|
&& caadr(p2) == symbol(FACTORIAL)) {
|
|
|
|
push(cadr(p1));
|
2005-07-22 02:22:44 +02:00
|
|
|
push(cadr(cadr(p2)));
|
2005-07-22 02:11:02 +02:00
|
|
|
subtract();
|
|
|
|
p3 = pop();
|
|
|
|
if (isplusone(p3)) {
|
|
|
|
push(cadr(p1));
|
|
|
|
factorial();
|
|
|
|
reciprocate();
|
|
|
|
stack[i] = pop();
|
|
|
|
stack[j] = one;
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
}
|
2005-07-22 02:22:44 +02:00
|
|
|
|
|
|
|
// (n + 1)! / n! -> n + 1
|
|
|
|
|
|
|
|
// n! / (n + 1)! -> 1 / (n + 1)
|
|
|
|
|
|
|
|
if (car(p1) == symbol(FACTORIAL)
|
|
|
|
&& car(p2) == symbol(POWER)
|
|
|
|
&& isminusone(caddr(p2))
|
|
|
|
&& caadr(p2) == symbol(FACTORIAL)) {
|
|
|
|
push(cadr(p1));
|
|
|
|
push(cadr(cadr(p2)));
|
|
|
|
subtract();
|
|
|
|
p3 = pop();
|
|
|
|
if (isplusone(p3)) {
|
|
|
|
stack[i] = cadr(p1);
|
|
|
|
stack[j] = one;
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
if (isminusone(p3)) {
|
|
|
|
push(cadr(cadr(p2)));
|
|
|
|
reciprocate();
|
|
|
|
stack[i] = pop();
|
|
|
|
stack[j] = one;
|
|
|
|
return 1;
|
|
|
|
}
|
2005-07-25 20:13:22 +02:00
|
|
|
if (equaln(p3, 2)) {
|
|
|
|
stack[i] = cadr(p1);
|
|
|
|
push(cadr(p1));
|
|
|
|
push_integer(-1);
|
|
|
|
add();
|
|
|
|
stack[j] = pop();
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
if (equaln(p3, -2)) {
|
|
|
|
push(cadr(cadr(p2)));
|
|
|
|
reciprocate();
|
|
|
|
stack[i] = pop();
|
|
|
|
push(cadr(cadr(p2)));
|
|
|
|
push_integer(-1);
|
|
|
|
add();
|
|
|
|
reciprocate();
|
|
|
|
stack[j] = pop();
|
|
|
|
return 1;
|
|
|
|
}
|
2005-07-22 02:22:44 +02:00
|
|
|
}
|
2005-07-22 00:41:09 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return 0;
|
|
|
|
}
|