version 1.14, 2017/03/29 01:15:14 |
version 1.16, 2018/03/28 05:27:22 |
|
|
/* $OpenXM: OpenXM_contrib2/asir2000/builtin/bfaux.c,v 1.13 2017/03/09 00:46:44 noro Exp $ */ |
/* $OpenXM: OpenXM_contrib2/asir2000/builtin/bfaux.c,v 1.15 2017/08/31 04:21:48 noro Exp $ */ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
|
|
Line 14 void Prk_ratmat(); |
|
Line 14 void Prk_ratmat(); |
|
void mp_sin(),mp_cos(),mp_tan(),mp_asin(),mp_acos(),mp_atan(); |
void mp_sin(),mp_cos(),mp_tan(),mp_asin(),mp_acos(),mp_atan(); |
void mp_sinh(),mp_cosh(),mp_tanh(),mp_asinh(),mp_acosh(),mp_atanh(); |
void mp_sinh(),mp_cosh(),mp_tanh(),mp_asinh(),mp_acosh(),mp_atanh(); |
void mp_exp(),mp_log(),mp_pow(); |
void mp_exp(),mp_log(),mp_pow(); |
|
void mp_factorial(),mp_abs(); |
|
|
struct ftab bf_tab[] = { |
struct ftab bf_tab[] = { |
{"eval",Peval,-2}, |
{"eval",Peval,-2}, |
Line 58 struct ftab bf_tab[] = { |
|
Line 59 struct ftab bf_tab[] = { |
|
|
|
int mpfr_roundmode = MPFR_RNDN; |
int mpfr_roundmode = MPFR_RNDN; |
|
|
void Ptodouble(NODE arg,Num *rp) |
void todoublen(Num a,Num *rp) |
{ |
{ |
double r,i; |
double r,i; |
Real real,imag; |
Real real,imag; |
Num num; |
|
|
|
asir_assert(ARG0(arg),O_N,"todouble"); |
if ( !a ) { |
num = (Num)ARG0(arg); |
|
if ( !num ) { |
|
*rp = 0; |
*rp = 0; |
return; |
return; |
} |
} |
switch ( NID(num) ) { |
switch ( NID(a) ) { |
case N_R: case N_Q: case N_B: |
case N_R: case N_Q: case N_B: |
r = ToReal(num); |
r = ToReal(a); |
MKReal(r,real); |
MKReal(r,real); |
*rp = (Num)real; |
*rp = (Num)real; |
break; |
break; |
case N_C: |
case N_C: |
r = ToReal(((C)num)->r); |
r = ToReal(((C)a)->r); |
i = ToReal(((C)num)->i); |
i = ToReal(((C)a)->i); |
MKReal(r,real); |
MKReal(r,real); |
MKReal(i,imag); |
MKReal(i,imag); |
reimtocplx((Num)real,(Num)imag,rp); |
reimtocplx((Num)real,(Num)imag,rp); |
break; |
break; |
default: |
default: |
*rp = num; |
*rp = a; |
break; |
break; |
} |
} |
} |
} |
|
|
|
void todoublep(P a,P *rp) |
|
{ |
|
DCP dc,dcr,dcr0; |
|
|
|
if ( !a ) *rp = 0; |
|
else if ( OID(a) == O_N ) todoublen((Num)a,(Num *)rp); |
|
else { |
|
for ( dcr0 = 0, dc = DC(a); dc; dc = NEXT(dc) ) { |
|
NEXTDC(dcr0,dcr); |
|
DEG(dcr) = DEG(dc); |
|
todoublep(COEF(dc),&COEF(dcr)); |
|
} |
|
NEXT(dcr) = 0; |
|
MKP(VR(a),dcr0,*rp); |
|
} |
|
} |
|
|
|
void todoubler(R a,R *rp) |
|
{ |
|
R b; |
|
|
|
if ( !a ) *rp = 0; |
|
else if ( OID(a) <= O_P ) todoublep((P)a,(P *)rp); |
|
else { |
|
NEWR(b); |
|
todoublep(a->nm,&b->nm); |
|
todoublep(a->dn,&b->dn); |
|
*rp = b; |
|
} |
|
} |
|
|
|
void todouble(Obj a,Obj *b) |
|
{ |
|
Obj t; |
|
LIST l; |
|
V v; |
|
int row,col,len; |
|
VECT vect; |
|
MAT mat; |
|
int i,j; |
|
NODE n0,n,nd; |
|
MP m,mp,mp0; |
|
DP d; |
|
|
|
if ( !a ) { |
|
*b = 0; |
|
return; |
|
} |
|
switch ( OID(a) ) { |
|
case O_N: |
|
todoublen((Num)a,(Num *)b); |
|
break; |
|
case O_P: |
|
todoublep((P)a,(P *)b); |
|
break; |
|
case O_R: |
|
todoubler((R)a,(R *)b); |
|
break; |
|
case O_LIST: |
|
n0 = 0; |
|
for ( nd = BDY((LIST)a); nd; nd = NEXT(nd) ) { |
|
NEXTNODE(n0,n); |
|
todouble((Obj)BDY(nd),(Obj *)&BDY(n)); |
|
} |
|
if ( n0 ) |
|
NEXT(n) = 0; |
|
MKLIST(l,n0); |
|
*b = (Obj)l; |
|
break; |
|
case O_VECT: |
|
len = ((VECT)a)->len; |
|
MKVECT(vect,len); |
|
for ( i = 0; i < len; i++ ) { |
|
todouble((Obj)BDY((VECT)a)[i],(Obj *)&BDY(vect)[i]); |
|
} |
|
*b = (Obj)vect; |
|
break; |
|
case O_MAT: |
|
row = ((MAT)a)->row; |
|
col = ((MAT)a)->col; |
|
MKMAT(mat,row,col); |
|
for ( i = 0; i < row; i++ ) |
|
for ( j = 0; j < col; j++ ) { |
|
todouble((Obj)BDY((MAT)a)[i][j],(Obj *)&BDY(mat)[i][j]); |
|
} |
|
*b = (Obj)mat; |
|
break; |
|
case O_DP: |
|
mp0 = 0; |
|
for ( m = BDY((DP)a); m; m = NEXT(m) ) { |
|
todouble(C(m),&t); |
|
if ( t ) { |
|
NEXTMP(mp0,mp); |
|
C(mp) = t; |
|
mp->dl = m->dl; |
|
} |
|
} |
|
if ( mp0 ) { |
|
MKDP(NV((DP)a),mp0,d); |
|
d->sugar = ((DP)a)->sugar; |
|
*b = (Obj)d; |
|
} else |
|
*b = 0; |
|
|
|
break; |
|
default: |
|
error("todouble : invalid argument"); |
|
} |
|
} |
|
|
|
void Ptodouble(NODE arg,Obj *rp) |
|
{ |
|
todouble((Obj)ARG0(arg),rp); |
|
} |
|
|
void Peval(NODE arg,Obj *rp) |
void Peval(NODE arg,Obj *rp) |
{ |
{ |
int prec; |
int prec; |
Line 317 void mp_exp(NODE arg,Num *rp) |
|
Line 430 void mp_exp(NODE arg,Num *rp) |
|
void mp_log(NODE arg,Num *rp) |
void mp_log(NODE arg,Num *rp) |
{ |
{ |
mpfr_or_mpc(arg,mpfr_log,mpc_log,rp); |
mpfr_or_mpc(arg,mpfr_log,mpc_log,rp); |
|
} |
|
|
|
void mp_abs(NODE arg,Num *rp) |
|
{ |
|
mpfr_or_mpc(arg,mpfr_abs,mpc_abs,rp); |
|
} |
|
|
|
void mp_factorial(NODE arg,Num *rp) |
|
{ |
|
struct oNODE arg0; |
|
Num a,a1; |
|
|
|
a = (Num)ARG0(arg); |
|
if ( !a ) *rp = (Num)ONE; |
|
else if ( INT(a) ) Pfac(arg,rp); |
|
else { |
|
addnum(0,a,(Num)ONE,&a1); |
|
arg0.body = (pointer)a1; |
|
arg0.next = arg->next; |
|
Pmpfr_gamma(&arg0,rp); |
|
} |
} |
} |
|
|
void mp_pow(NODE arg,Num *rp) |
void mp_pow(NODE arg,Num *rp) |