eigenmath/carac.cpp

142 lines
2.0 KiB
C++

//-----------------------------------------------------------------------------
//
// Author : philippe.billet@noos.fr
//
// Characteristic set function carac(x,a,b)
//
//
//-----------------------------------------------------------------------------
#include "stdafx.h"
#include "defs.h"
static int exp_flag;
void
eval_carac(void)
{
push(cadr(p1));
eval();
push(caddr(p1));
eval();
push(cadddr(p1));
eval();
carac();
}
void
carac(void)
{
save();
yycarac();
restore();
}
#define X p1
#define A p2
#define B p3
void
yycarac(void)
{
B = pop();
A = pop();
X = pop();
if (isdouble(X) && isdouble(A) && isdouble(B)) {
if (X->u.d > B->u.d && X->u.d < A->u.d)
{push_integer(1);
return;}
else
if (X->u.d == B->u.d || X->u.d == A->u.d)
{push_rational(1, 2);
return;}
else
{push_integer(0);
return;}
}
if (isrational(X) && isrational(A) && isrational(B)) {
if (MSIGN(msub(mmul(X->u.q.b,A->u.q.a),mmul(X->u.q.a,A->u.q.b))) == -1
&&
MSIGN(msub(mmul(X->u.q.a,B->u.q.b),mmul(X->u.q.b,B->u.q.a))) == -1)
{push_integer(1);
return;}
else
if (MZERO(msub(mmul(X->u.q.b,A->u.q.a),mmul(X->u.q.a,A->u.q.b)))
||
MZERO(msub(mmul(X->u.q.a,B->u.q.b),mmul(X->u.q.b,B->u.q.a))))
{push_rational(1, 2);
return;}
else
{push_integer(0);
return;}
}
if (exp_flag) {
push(X);
push_integer(-1);
push(A);
multiply();
add();
heaviside();
push(X);
push_integer(-1);
push(B);
multiply();
add();
heaviside();
push_integer(-1);
multiply();
add();
return;
}
if (isnegativeterm(X)) {
push_symbol(CARAC);
push(X);
negate();
push(A);
push(B);
list(4);
return;
}
push_symbol(CARAC);
push(X);
push(A);
push(B);
list(4);
}
#if SELFTEST
static char *s[] = {
"carac(-2,-1,1)",
"0",
"carac(-1,-1,1)",
"1/2",
"carac(0,-1,1)",
"1",
"carac(1,-1,1)",
"1/2",
"carac(2,-1,1)",
"0",
};
void
test_carac(void)
{
test(__FILE__, s, sizeof s / sizeof (char *));
}
#endif