1 // -*- mode:C++ ; compile-command: "g++-3.4 -I.. -I../include -g -c usual.cc -Wall -D_I386_ -DHAVE_CONFIG_H -DIN_GIAC -msse" -*- 2 #include "giacPCH.h" 3 4 /* 5 * Copyright (C) 2000,14 B. Parisse, Institut Fourier, 38402 St Martin d'Heres 6 * 7 * This program is free software; you can redistribute it and/or modify 8 * it under the terms of the GNU General Public License as published by 9 * the Free Software Foundation; either version 3 of the License, or 10 * (at your option) any later version. 11 * 12 * This program is distributed in the hope that it will be useful, 13 * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 * GNU General Public License for more details. 16 * 17 * You should have received a copy of the GNU General Public License 18 * along with this program. If not, see <http://www.gnu.org/licenses/>. 19 */ 20 using namespace std; 21 #include <stdexcept> 22 #include <cmath> 23 #include <cstdlib> 24 #if !defined GIAC_HAS_STO_38 && !defined NSPIRE && !defined FXCG && !defined POCKETCAS 25 #include <fstream> 26 #endif 27 #include "gen.h" 28 #include "identificateur.h" 29 #include "symbolic.h" 30 #include "poly.h" 31 #include "usual.h" 32 #include "series.h" 33 #include "modpoly.h" 34 #include "sym2poly.h" 35 #include "moyal.h" 36 #include "subst.h" 37 #include "gausspol.h" 38 #include "identificateur.h" 39 #include "ifactor.h" 40 #include "prog.h" 41 #include "rpn.h" 42 #include "plot.h" 43 #include "pari.h" 44 #include "tex.h" 45 #include "unary.h" 46 #include "intg.h" 47 #include "ti89.h" 48 #include "solve.h" 49 #include "alg_ext.h" 50 #include "lin.h" 51 #include "derive.h" 52 #include "series.h" 53 #include "misc.h" 54 #include "sparse.h" 55 #include "input_parser.h" 56 #include "giacintl.h" 57 #ifdef VISUALC 58 #include <float.h> 59 #endif 60 #ifdef HAVE_LIBGSL 61 #include <gsl/gsl_math.h> 62 #include <gsl/gsl_sf_gamma.h> 63 #include <gsl/gsl_sf_psi.h> 64 #include <gsl/gsl_sf_zeta.h> 65 #include <gsl/gsl_errno.h> 66 #include <gsl/gsl_sf_erf.h> 67 #include <gsl/gsl_sf_expint.h> 68 #endif 69 //#ifdef TARGET_OS_IPHONE 70 //#include "psi.h" 71 //#endif 72 #ifdef USE_GMP_REPLACEMENTS 73 #undef HAVE_GMPXX_H 74 #undef HAVE_LIBMPFR 75 #undef HAVE_LIBPARI 76 #endif 77 #ifdef HAVE_UNISTD_H 78 #include <unistd.h> 79 #endif 80 81 #ifndef NO_NAMESPACE_GIAC 82 namespace giac { 83 #endif // ndef NO_NAMESPACE_GIAC 84 85 // must be declared before any function declaration with special handling limit_tractable_functions()86 vector<const unary_function_ptr *> & limit_tractable_functions(){ 87 static vector<const unary_function_ptr *> * ans = 0; 88 if (!ans) ans=new vector<const unary_function_ptr *>; 89 return * ans; 90 } limit_tractable_replace()91 vector<gen_op_context> & limit_tractable_replace(){ 92 static vector<gen_op_context> * ans = 0; 93 if (!ans) ans=new vector<gen_op_context>; 94 return * ans; 95 } 96 #ifdef HAVE_SIGNAL_H_OLD 97 string messages_to_print ; 98 #endif 99 frac_neg_out(const gen & g,GIAC_CONTEXT)100 gen frac_neg_out(const gen & g,GIAC_CONTEXT){ 101 if ( (is_integer(g) && is_strictly_positive(-g,contextptr)) || (g.type==_FRAC && (g._FRACptr->num.type<=_DOUBLE_ || g._FRACptr->num.type==_FLOAT_) && is_strictly_positive(-g._FRACptr->num,contextptr)) ) 102 return symbolic(at_neg,-g); 103 if (g.is_symb_of_sommet(at_prod)){ 104 // count neg 105 gen f=g._SYMBptr->feuille; 106 vecteur fv(gen2vecteur(f)); 107 int count=0,fvs=int(fv.size()); 108 for (int i=0;i<fvs;++i){ 109 gen & fvi = fv[i]; 110 fvi=frac_neg_out(fvi,contextptr); 111 if (fvi.is_symb_of_sommet(at_neg)){ 112 ++count; 113 fvi=fvi._SYMBptr->feuille; 114 } 115 } 116 if (fvs==1) 117 f=fv[0]; 118 else { 119 if (f.type==_VECT && *f._VECTptr==fv) // nothing changed 120 f=g; 121 else 122 f=symbolic(at_prod,fv); 123 } 124 if (count%2) 125 return symbolic(at_neg,f); 126 else 127 return f; 128 } 129 return g; 130 } 131 132 // utilities for trig functions 133 enum { trig_deno=24 }; 134 is_multiple_of_12(const gen & k0,int & l)135 static bool is_multiple_of_12(const gen & k0,int & l){ 136 if (!k0.is_integer()) 137 return false; 138 gen k=smod(k0,trig_deno); 139 if (k.type!=_INT_) 140 return false; 141 l=k.val+trig_deno/2; 142 return true; 143 } 144 //grad is_multiple_of_pi_over_12(const gen & a,int & l,GIAC_CONTEXT)145 static bool is_multiple_of_pi_over_12(const gen & a,int & l,GIAC_CONTEXT){ 146 if (is_zero(a,contextptr)){ 147 l=0; 148 return true; 149 } 150 gen k; 151 if (angle_radian(contextptr)){ 152 if (!contains(a,cst_pi)) 153 return false; 154 k=derive(a,cst_pi,contextptr); 155 if (is_undef(k) || !is_constant_wrt(k,cst_pi,contextptr) || !is_zero(ratnormal(a-k*cst_pi,contextptr))) 156 return false; 157 k=(trig_deno/2)*k; 158 if (k.type==_SYMB) 159 k=ratnormal(k,contextptr); 160 /* 161 gen k1=normal(rdiv(a*gen(trig_deno/2),cst_pi),contextptr); 162 if (k!=k1) 163 setsizeerr(); 164 */ 165 } 166 else if(angle_degree(contextptr)) 167 k=rdiv(a,15,context0); 168 //grad 169 else 170 k=rdiv(a,rdiv(50,3),context0); //50/3 grads, due to 200/12 171 return is_multiple_of_12(k,l); 172 } 173 is_rational(const gen & a,int & n,int & d)174 static bool is_rational(const gen & a,int &n,int &d){ 175 gen num,den; 176 fxnd(a,num,den); 177 if (num.type!=_INT_ || den.type!=_INT_) 178 return false; 179 n=num.val; 180 d=den.val; 181 return true; 182 } 183 // checking utility check_2d_vecteur(const gen & args)184 static bool check_2d_vecteur(const gen & args) { 185 if (args.type!=_VECT) 186 return false; // settypeerr(gettext("check_2d_vecteur")); 187 if (args._VECTptr->size()!=2) 188 return false; // setsizeerr(gettext("check_2d_vecteur")); 189 return true; 190 } 191 192 // zero arg 193 /* 194 unary_function_constant __1(1); 195 unary_function_ptr at_one (&__1); 196 unary_function_constant __0(0); 197 unary_function_ptr at_zero (&__0); 198 */ _constant_one(const gen & args,GIAC_CONTEXT)199 gen _constant_one(const gen & args,GIAC_CONTEXT){ 200 if ( args.type==_STRNG && args.subtype==-1) return args; 201 return 1; 202 } 203 static const char _constant_one_s []="1"; 204 static define_unary_function_eval (__constant_one,&_constant_one,_constant_one_s); 205 define_unary_function_ptr( at_one ,alias_at_one ,&__constant_one); 206 _constant_zero(const gen & args,GIAC_CONTEXT)207 gen _constant_zero(const gen & args,GIAC_CONTEXT){ 208 if ( args.type==_STRNG && args.subtype==-1) return args; 209 return 0; 210 } 211 static const char _constant_zero_s []="0"; 212 static define_unary_function_eval (__constant_zero,&_constant_zero,_constant_zero_s); 213 define_unary_function_ptr( at_zero ,alias_at_zero ,&__constant_zero); 214 _rm_a_z(const gen & args,GIAC_CONTEXT)215 gen _rm_a_z(const gen & args,GIAC_CONTEXT){ 216 if ( args.type==_STRNG && args.subtype==-1) return args; 217 #if 0 // !defined RTOS_THREADX && !defined BESTA_OS && !defined FREERTOS && !defined FXCG 218 if (variables_are_files(contextptr)){ 219 char a_effacer[]="a.cas"; 220 for (;a_effacer[0]<='z';++a_effacer[0]){ 221 unlink(a_effacer); 222 } 223 } 224 #endif 225 for (char c='a';c<='z';c++){ 226 purgenoassume(gen(string(1,c),contextptr),contextptr); 227 } 228 return args; 229 } 230 static const char _rm_a_z_s []="rm_a_z"; 231 static define_unary_function_eval (__rm_a_z,&_rm_a_z,_rm_a_z_s); 232 define_unary_function_ptr5( at_rm_a_z ,alias_at_rm_a_z,&__rm_a_z,0,true); 233 _rm_all_vars(const gen & args,const context * contextptr)234 gen _rm_all_vars(const gen & args,const context * contextptr){ 235 if ( args.type==_STRNG && args.subtype==-1) return args; 236 gen g=_VARS(args,contextptr); 237 if (g.type!=_VECT) 238 return g; 239 vecteur & v=*g._VECTptr; 240 const_iterateur it=v.begin(),itend=v.end(); 241 for (;it!=itend;++it){ 242 gen tmp=*it; 243 if (tmp.is_symb_of_sommet(at_sto)) 244 tmp=tmp._SYMBptr->feuille[1]; 245 if (tmp.type==_IDNT && (tmp!=cst_pi) ) 246 purgenoassume(tmp,contextptr); 247 } 248 return g; 249 } 250 static const char _rm_all_vars_s []="rm_all_vars"; 251 static define_unary_function_eval (__rm_all_vars,&_rm_all_vars,_rm_all_vars_s); 252 define_unary_function_ptr5( at_rm_all_vars ,alias_at_rm_all_vars,&__rm_all_vars,0,true); 253 is_equal(const gen & g)254 bool is_equal(const gen & g){ 255 return (g.type==_SYMB) && (g._SYMBptr->sommet==at_equal || g._SYMBptr->sommet==at_equal2); 256 } 257 apply_to_equal(const gen & g,const gen_op & f)258 gen apply_to_equal(const gen & g,const gen_op & f){ 259 if (g.type!=_SYMB || (g._SYMBptr->sommet!=at_equal && g._SYMBptr->sommet!=at_equal2) || g._SYMBptr->feuille.type!=_VECT) 260 return f(g); 261 vecteur & v=*g._SYMBptr->feuille._VECTptr; 262 if (v.empty()) 263 return gensizeerr(gettext("apply_to_equal")); 264 return symbolic(g._SYMBptr->sommet,gen(makevecteur(f(v.front()),f(v.back())),_SEQ__VECT)); 265 } 266 apply_to_equal(const gen & g,gen (* f)(const gen &,GIAC_CONTEXT),GIAC_CONTEXT)267 gen apply_to_equal(const gen & g,gen (* f) (const gen &, GIAC_CONTEXT),GIAC_CONTEXT){ 268 if (g.type!=_SYMB || (g._SYMBptr->sommet!=at_equal && g._SYMBptr->sommet!=at_equal2) || g._SYMBptr->feuille.type!=_VECT) 269 return f(g,contextptr); 270 vecteur & v=*g._SYMBptr->feuille._VECTptr; 271 if (v.empty()) 272 return gensizeerr(contextptr); 273 return symbolic(g._SYMBptr->sommet,gen(makevecteur(f(v.front(),contextptr),f(v.back(),contextptr)),_SEQ__VECT)); 274 } 275 276 // one arg _id(const gen & args,GIAC_CONTEXT)277 gen _id(const gen & args,GIAC_CONTEXT){ 278 if ( args.type==_STRNG && args.subtype==-1) return args; 279 return args; 280 } 281 define_partial_derivative_onearg_genop(D_at_id,"D_at_id",_constant_one); 282 static const char _id_s []="id"; 283 #ifdef GIAC_HAS_STO_38 284 static define_unary_function_eval3 (__id,&_id,(size_t)&D_at_idunary_function_ptr,_id_s); 285 #else 286 static define_unary_function_eval3 (__id,&_id,D_at_id,_id_s); 287 #endif 288 define_unary_function_ptr5( at_id ,alias_at_id,&__id,0,true); 289 printasnot(const gen & g,const char * s,GIAC_CONTEXT)290 static string printasnot(const gen & g,const char * s,GIAC_CONTEXT){ 291 if (abs_calc_mode(contextptr)==38){ 292 if (is_inequation(g) || g.is_symb_of_sommet(at_and) ||g.is_symb_of_sommet(at_ou)) 293 return "NOT("+g.print(contextptr)+")"; 294 else 295 return "NOT "+g.print(contextptr); 296 } 297 else 298 return "not("+g.print(contextptr)+")"; 299 300 } symb_not(const gen & args)301 symbolic symb_not(const gen & args){ 302 return symbolic(at_not,args); 303 } _not(const gen & args,GIAC_CONTEXT)304 gen _not(const gen & args,GIAC_CONTEXT){ 305 if ( args.type==_STRNG && args.subtype==-1) return args; 306 if (args.type==_VECT || args.type==_MAP){ 307 if (python_compat(contextptr)){ 308 if (args.type==_VECT && args._VECTptr->empty()) 309 return 1; 310 if (args.type==_MAP && args._MAPptr->empty()) 311 return 1; 312 } 313 return apply(args,_not,contextptr); 314 } 315 return !equaltosame(args); 316 } 317 static const char _not_s []="not"; 318 static define_unary_function_eval2_index (64,__not,&_not,_not_s,&printasnot); 319 define_unary_function_ptr( at_not ,alias_at_not ,&__not); 320 321 // static symbolic symb_neg(const gen & args){ return symbolic(at_neg,args); } _neg(const gen & args,GIAC_CONTEXT)322 gen _neg(const gen & args,GIAC_CONTEXT){ 323 if ( args.type==_STRNG && args.subtype==-1) return args; 324 return -args; 325 } 326 define_partial_derivative_onearg_genop( D_at_neg,"D_at_neg",_neg); 327 static const char _neg_s []="-"; 328 #ifdef GIAC_HAS_STO_38 329 static define_unary_function_eval3_index (4,__neg,&_neg,(size_t)&D_at_negunary_function_ptr,_neg_s); 330 #else 331 static define_unary_function_eval3_index (4,__neg,&_neg,D_at_neg,_neg_s); 332 #endif 333 define_unary_function_ptr( at_neg ,alias_at_neg ,&__neg); 334 symb_inv(const gen & a)335 symbolic symb_inv(const gen & a){ 336 return symbolic(at_inv,a); 337 } _inv(const gen & args,GIAC_CONTEXT)338 gen _inv(const gen & args,GIAC_CONTEXT){ 339 if ( args.type==_STRNG && args.subtype==-1) return args; 340 if ((args.type!=_VECT) || ckmatrix(args)) 341 return inv(args,contextptr); 342 if (args.subtype==_SEQ__VECT){ 343 iterateur it=args._VECTptr->begin(), itend=args._VECTptr->end(); 344 gen prod(1); 345 for (;it!=itend;++it) 346 prod = prod * (*it); 347 return inv(prod,contextptr); 348 } 349 return apply(args,_inv,contextptr); 350 } 351 static const char _inv_s []="inv"; 352 static define_unary_function_eval_index (12,__inv,&_inv,_inv_s); 353 define_unary_function_ptr5( at_inv ,alias_at_inv,&__inv,0,true); 354 symb_ln(const gen & e)355 symbolic symb_ln(const gen & e){ 356 return symbolic(at_ln,e); 357 } 358 ln(const gen & e,GIAC_CONTEXT)359 gen ln(const gen & e,GIAC_CONTEXT){ 360 // if (abs_calc_mode(contextptr)==38 && do_lnabs(contextptr) && !complex_mode(contextptr) && (e.type<=_POLY || e.type==_FLOAT_) && !is_positive(e,contextptr)) return gensizeerr(contextptr); 361 if (!escape_real(contextptr) && !complex_mode(contextptr) && (e.type<=_POLY || e.type==_FLOAT_) && !is_positive(e,contextptr)) return gensizeerr(contextptr); 362 if (e.type==_FLOAT_){ 363 #ifdef BCD 364 if (!is_positive(e,contextptr)) 365 return fln(-e._FLOAT_val)+cst_i*cst_pi; 366 return fln(e._FLOAT_val); 367 #else 368 return ln(get_double(e._FLOAT_val),contextptr); 369 #endif 370 } 371 if (e.type==_DOUBLE_){ 372 if (e._DOUBLE_val==0) 373 return minus_inf; 374 if (e._DOUBLE_val>0){ 375 #ifdef _SOFTMATH_H 376 return std::giac_gnuwince_log(e._DOUBLE_val); 377 #else 378 return std::log(e._DOUBLE_val); 379 #endif 380 } 381 else { 382 if (!escape_real(contextptr) && !complex_mode(contextptr)) 383 *logptr(contextptr) << "Taking ln of negative real " << e << '\n'; 384 #ifdef _SOFTMATH_H 385 return M_PI*cst_i+std::giac_gnuwince_log(-e._DOUBLE_val); 386 #else 387 return M_PI*cst_i+std::log(-e._DOUBLE_val); 388 #endif 389 } 390 } 391 if (e.type==_SPOL1){ 392 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 393 if (is_zero(expo)) 394 return series(*e._SPOL1ptr,*at_ln,0,contextptr); 395 } 396 if (e.type==_REAL){ 397 if (is_positive(e,contextptr)) 398 return e._REALptr->log(); 399 else { 400 if (!escape_real(contextptr) && !complex_mode(contextptr)) 401 *logptr(contextptr) << "Taking ln of negative real " << e << '\n'; 402 return (-e)._REALptr->log()+cst_pi*cst_i; 403 } 404 } 405 if (e.type==_CPLX){ 406 if (e.subtype){ 407 #ifdef _SOFTMATH_H 408 return std::giac_gnuwince_log(gen2complex_d(e)); 409 #else 410 return std::log(gen2complex_d(e)); 411 #endif 412 } 413 if (e._CPLXptr->type==_REAL || e._CPLXptr->type==_FLOAT_){ 414 //grad 415 int mode=get_mode_set_radian(contextptr); 416 gen res=ln(abs(e,contextptr),contextptr)+cst_i*arg(e,contextptr); 417 angle_mode(mode,contextptr); 418 419 return res; 420 } 421 if (is_zero(*e._CPLXptr,contextptr)){ 422 if (is_one(*(e._CPLXptr+1))) 423 return cst_i*cst_pi_over_2; 424 if (is_minus_one(*(e._CPLXptr+1))) 425 return -cst_i*cst_pi_over_2; 426 } 427 } 428 if (is_squarematrix(e)) 429 return analytic_apply(at_ln,*e._VECTptr,contextptr); 430 if (e.type==_VECT){ 431 #ifdef NSPIRE 432 if (e.subtype==_SEQ__VECT && e._VECTptr->size()==2) 433 return _logb(e,contextptr); 434 #endif 435 return apply(e,ln,contextptr); 436 } 437 if (is_zero(e,contextptr)) 438 return minus_inf; // calc_mode(contextptr)==1?unsigned_inf:minus_inf; 439 if (is_one(e)) 440 return 0; 441 if (is_minus_one(e)) 442 return cst_i*cst_pi; 443 if (is_integer(e) && is_strictly_positive(-e,contextptr)) 444 return cst_i*cst_pi+ln(-e,contextptr); 445 if (is_undef(e)) 446 return e; 447 if ( (e==unsigned_inf) || (e==plus_inf)) 448 return e; 449 if (e==minus_inf) 450 return unsigned_inf; 451 if (is_equal(e)) 452 return apply_to_equal(e,ln,contextptr); 453 if (e.type==_SYMB){ 454 if (e._SYMBptr->sommet==at_inv && e._SYMBptr->feuille.type!=_VECT) 455 return -ln(e._SYMBptr->feuille,contextptr); 456 if (e._SYMBptr->sommet==at_exp){ 457 if (is_real(e._SYMBptr->feuille,contextptr) ) 458 return e._SYMBptr->feuille; 459 } 460 } 461 if (e.type==_FRAC && e._FRACptr->num==1) 462 return -ln(e._FRACptr->den,contextptr); 463 gen a,b; 464 if (is_algebraic_program(e,a,b)) 465 return symbolic(at_program,gen(makevecteur(a,0,ln(b,contextptr)),_SEQ__VECT)); 466 if (e.is_symb_of_sommet(at_pow) && e._SYMBptr->feuille.type==_VECT && e._SYMBptr->feuille._VECTptr->size()==2){ 467 gen a=e._SYMBptr->feuille._VECTptr->front(); 468 gen b=e._SYMBptr->feuille._VECTptr->back(); 469 // ln(a^b) 470 if (is_positive(a,contextptr)) 471 return b*ln(a,contextptr); 472 } 473 return symb_ln(e); 474 } log(const gen & e,GIAC_CONTEXT)475 gen log(const gen & e,GIAC_CONTEXT){ 476 return ln(e,contextptr); 477 } 478 static const char _ln_s []="ln"; // Using C notation, log works also for natural d_ln(const gen & args,GIAC_CONTEXT)479 static gen d_ln(const gen & args,GIAC_CONTEXT){ 480 return inv(args,contextptr); 481 } 482 define_partial_derivative_onearg_genop( D_at_ln,"D_at_ln",&d_ln); 483 #ifdef GIAC_HAS_STO_38 484 static define_unary_function_eval3_index (18,__ln,&ln,(size_t)&D_at_lnunary_function_ptr,_ln_s); 485 #else 486 static define_unary_function_eval3_index (18,__ln,&ln,D_at_ln,_ln_s); 487 #endif 488 define_unary_function_ptr5( at_ln ,alias_at_ln,&__ln,0,true); 489 log10(const gen & e,GIAC_CONTEXT)490 gen log10(const gen & e,GIAC_CONTEXT){ 491 if (e.type==_FLOAT_) { 492 if (is_positive(e,contextptr)){ 493 #ifdef BCD 494 return flog10(e._FLOAT_val); 495 #else 496 return log10(get_double(e._FLOAT_val),contextptr); 497 #endif 498 } 499 return ln(e,contextptr)/ln(10,contextptr); 500 } 501 if (e.type==_DOUBLE_ && e._DOUBLE_val>=0 ){ 502 #ifdef _SOFTMATH_H 503 return std::giac_gnuwince_log10(e._DOUBLE_val); 504 #else 505 return std::log10(e._DOUBLE_val); 506 #endif 507 } 508 if ( e.type==_DOUBLE_ || (e.type==_CPLX && e.subtype)){ 509 #ifdef _SOFTMATH_H 510 return std::giac_gnuwince_log(gen2complex_d(e))/std::log(10.0); 511 #else 512 return std::log(gen2complex_d(e))/std::log(10.0); 513 #endif 514 } 515 if (e.type==_CPLX && (e._CPLXptr->type==_REAL || e._CPLXptr->type==_FLOAT_)){ 516 return (ln(abs(e,contextptr),contextptr)+cst_i*arg(e,contextptr))/ln(10,contextptr); 517 } 518 if (is_squarematrix(e)) 519 return analytic_apply(at_log10,*e._VECTptr,contextptr); 520 if (e.type==_VECT){ 521 #ifdef NSPIRE 522 if (e.subtype==_SEQ__VECT && e._VECTptr->size()==2) 523 return _logb(e,contextptr); 524 #endif 525 return apply(e,log10,contextptr); 526 } 527 gen a,b; 528 // if (abs_calc_mode(contextptr)==38 && has_evalf(e,a,1,contextptr)) return log10(a,contextptr); 529 if (is_algebraic_program(e,a,b)) 530 return symbolic(at_program,gen(makevecteur(a,0,log10(b,contextptr)),_SEQ__VECT)); 531 int n=0; gen e1(e),q; 532 if (is_integer(e1) && !is_zero(e1)){ 533 while (is_zero(irem(e1,10,q))){ 534 if (q.type==_ZINT) 535 e1=*q._ZINTptr; 536 else 537 e1=q; 538 ++n; 539 } 540 } 541 return rdiv(ln(e1,contextptr),ln(10,contextptr),contextptr)+n; 542 } 543 static const char _log10_s []="log10"; // Using C notation, log for natural d_log10(const gen & args,GIAC_CONTEXT)544 static gen d_log10(const gen & args,GIAC_CONTEXT){ 545 return inv(args*ln(10,contextptr),contextptr); 546 } 547 define_partial_derivative_onearg_genop(D_at_log10,"D_at_log10",&d_log10); 548 #ifdef GIAC_HAS_STO_38 549 static define_unary_function_eval3 (__log10,&log10,(size_t)&D_at_log10unary_function_ptr,_log10_s); 550 #else 551 static define_unary_function_eval3 (__log10,&log10,D_at_log10,_log10_s); 552 #endif 553 define_unary_function_ptr5( at_log10 ,alias_at_log10,&__log10,0,true); 554 alog10(const gen & e,GIAC_CONTEXT)555 gen alog10(const gen & e,GIAC_CONTEXT){ 556 #ifdef BCD 557 if (e.type==_FLOAT_) 558 return falog10(e._FLOAT_val); 559 #endif 560 if (is_squarematrix(e)) 561 return analytic_apply(at_alog10,*e._VECTptr,0); 562 if (e.type==_VECT) 563 return apply(e,contextptr,alog10); 564 if (is_equal(e)) 565 return apply_to_equal(e,alog10,contextptr); 566 gen a,b; 567 if (is_algebraic_program(e,a,b)) 568 return symbolic(at_program,gen(makevecteur(a,0,alog10(b,contextptr)),_SEQ__VECT)); 569 return pow(gen(10),e,contextptr); 570 } 571 static const char _alog10_s []="alog10"; 572 static define_unary_function_eval (__alog10,&alog10,_alog10_s); 573 define_unary_function_ptr5( at_alog10 ,alias_at_alog10,&__alog10,0,true); 574 symb_atan(const gen & e)575 symbolic symb_atan(const gen & e){ 576 return symbolic(at_atan,e); 577 } atanasln(const gen & e,GIAC_CONTEXT)578 static gen atanasln(const gen & e,GIAC_CONTEXT){ 579 return plus_one_half*cst_i*ln(rdiv(cst_i+e,cst_i-e,contextptr),contextptr); 580 } atan(const gen & e0,GIAC_CONTEXT)581 gen atan(const gen & e0,GIAC_CONTEXT){ 582 if (e0.type==_FLOAT_) 583 #ifdef BCD 584 return fatan(e0._FLOAT_val,angle_mode(contextptr)); 585 #else 586 return atan(get_double(e0._FLOAT_val),contextptr); 587 #endif 588 gen e=frac_neg_out(e0,contextptr); 589 if (e.type==_DOUBLE_){ 590 #ifdef _SOFTMATH_H 591 double res=std::giac_gnuwince_atan(e._DOUBLE_val); 592 #else 593 double res=std::atan(e._DOUBLE_val); 594 #endif 595 if (angle_radian(contextptr)) 596 return res; 597 else if(angle_degree(contextptr)) 598 return res*rad2deg_d; 599 else 600 return res*rad2grad_d; 601 } 602 if (e.type==_SPOL1){ 603 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 604 if (is_positive(expo,contextptr)) 605 return series(*e._SPOL1ptr,*at_atan,0,contextptr); 606 } 607 if (e.type==_REAL){ 608 if (angle_radian(contextptr)) 609 return e._REALptr->atan(); 610 else if(angle_degree(contextptr)) 611 return 180*e._REALptr->atan()/cst_pi; 612 //grad 613 else 614 return 200*e._REALptr->atan()/cst_pi; 615 } 616 if ( (e.type==_CPLX) && (e.subtype || e._CPLXptr->type==_REAL || e._CPLXptr->type==_FLOAT_)){ 617 if (angle_radian(contextptr)) 618 return no_context_evalf(atanasln(e,contextptr)); 619 else if(angle_degree(contextptr)) 620 return no_context_evalf(atanasln(e,contextptr))*gen(rad2deg_d); 621 //grad 622 else 623 return no_context_evalf(atanasln(e, contextptr))*gen(rad2grad_d); 624 } 625 if (is_squarematrix(e)) 626 return analytic_apply(at_atan,*e._VECTptr,contextptr); 627 if (e.type==_VECT) 628 return apply(e,atan,contextptr); 629 if (is_zero(e,contextptr)) 630 return e; 631 if (is_one(e)){ 632 if (angle_radian(contextptr)) 633 return rdiv(cst_pi,4,contextptr); 634 else if(angle_degree(contextptr)) 635 return 45; 636 //grad 637 else 638 return 50; 639 } 640 if (is_minus_one(e)){ 641 if (angle_radian(contextptr)) 642 return rdiv(-cst_pi,4,contextptr); 643 else if(angle_degree(contextptr)) 644 return -45; 645 //grad 646 else 647 return -50; 648 } 649 if (e==plus_sqrt3_3){ 650 if (angle_radian(contextptr)) 651 return rdiv(cst_pi,6,contextptr); 652 else if(angle_degree(contextptr)) 653 return 30; 654 //grad 655 else 656 return rdiv(100,3); //100/3 grads 657 } 658 if (e==plus_sqrt3){ 659 if (angle_radian(contextptr)) 660 return rdiv(cst_pi,3,contextptr); 661 else if(angle_degree(contextptr)) 662 return 60; 663 //grad 664 else 665 return rdiv(200,3); //200/3 grads 666 } 667 if (e==plus_inf){ 668 if (angle_radian(contextptr)) 669 return cst_pi_over_2; 670 else if(angle_degree(contextptr)) 671 return 90; 672 //grad 673 else 674 return 100; 675 } 676 if (e==minus_inf){ 677 if (angle_radian(contextptr)) 678 return -cst_pi_over_2; 679 else if(angle_degree(contextptr)) 680 return -90; 681 //grad 682 else 683 return -100; 684 } 685 if (is_undef(e)) 686 return e; 687 if (e==unsigned_inf) 688 return undef; 689 gen a,b; 690 if (is_algebraic_program(e,a,b)) 691 return symbolic(at_program,gen(makevecteur(a,0,atan(b,contextptr)),_SEQ__VECT)); 692 gen tmp=evalf_double(e,0,contextptr); 693 if (tmp.type==_DOUBLE_){ 694 double ed=tmp._DOUBLE_val; 695 // detect if atan is a multiples of pi/10 696 gen edh=horner(makevecteur(-5,60,-126,60,-5),tmp*tmp); 697 if (absdouble(edh._DOUBLE_val)<1e-7 && 698 normal(horner(makevecteur(-5,60,-126,60,-5),e*e),contextptr)==0){ 699 int res=int(std::floor(std::atan(absdouble(ed))*10/M_PI+.5)); 700 if (res%2) 701 return (ed>0?res:-res)*(angle_radian(contextptr)?cst_pi/10:(angle_degree(contextptr)?gen(18):gen(20))); //grad 702 else 703 return (ed>0?res/2:-res/2)*(angle_radian(contextptr)?cst_pi/5:(angle_degree(contextptr)?gen(36):gen(40))); //grad 704 } 705 edh=horner(makevecteur(-3,55,-198,198,-55,3),tmp*tmp); 706 if (absdouble(edh._DOUBLE_val)<1e-7){ 707 int res=int(std::floor(std::atan(absdouble(ed))*12/M_PI+.5)); 708 int den=12; 709 int g=gcd(res,den); 710 res /=g; den /=g; 711 return (ed>0?res:-res)*(angle_radian(contextptr)?cst_pi/den:(angle_degree(contextptr)?gen(15*g):rdiv(50,3)*gen(g))); //grad 50/3*g grads 712 } 713 edh=horner(makevecteur(1,-6,1),ed*ed); 714 if (absdouble(edh._DOUBLE_val)<1e-7 && 715 normal(horner(makevecteur(1,-6,1),e*e),contextptr)==0){ 716 int res=int(std::floor(std::atan(absdouble(ed))*8/M_PI+.5)); 717 return (ed>0?res:-res)*(angle_radian(contextptr)?cst_pi/8:(angle_degree(contextptr)?gen(45)/2:gen(25))); //grad 718 } 719 } 720 if ((e.type==_SYMB) && (e._SYMBptr->sommet==at_neg)) 721 return -atan(e._SYMBptr->feuille,contextptr); 722 if ( (e.type==_INT_) && (e.val<0) ) 723 return -atan(-e,contextptr); 724 if (is_equal(e)) 725 return apply_to_equal(e,atan,contextptr); 726 vecteur v1(loptab(e,sincostan_tab)); 727 if ((series_flags(contextptr)&8)==0 && v1.size()>1){ 728 gen e1=ratnormal(_trigtan(e,contextptr),contextptr); 729 if (loptab(e1,sincostan_tab).size()<=1) 730 return atan(e1,contextptr); 731 } 732 // if (e.is_symb_of_sommet(at_inv)) return sign(e._SYMBptr->feuille,contextptr)*cst_pi/2-atan(e._SYMBptr->feuille,contextptr); 733 if (e.is_symb_of_sommet(at_tan)){ 734 if (atan_tan_no_floor(contextptr)) 735 return e._SYMBptr->feuille; 736 gen tmp=cst_pi; 737 if(!angle_radian(contextptr)) 738 { 739 if(angle_degree(contextptr)) 740 tmp=180; 741 //grad 742 else 743 tmp = 200; 744 } 745 gen tmp2=evalf(e._SYMBptr->feuille,1,contextptr); 746 if (tmp2.type<_IDNT) 747 tmp2=_floor(tmp2/tmp+plus_one_half,contextptr); 748 else 749 tmp2=_floor(e._SYMBptr->feuille/tmp+plus_one_half,contextptr); 750 if (tmp2.type==_FLOAT_) 751 tmp2=get_int(tmp2._FLOAT_val); 752 return operator_minus(e._SYMBptr->feuille,tmp2*tmp,contextptr); 753 } 754 vecteur ve=lvar(e); 755 if (ve.size()==1){ 756 // atan((1+t)/(1-t))=atan((tan(pi/4)+t)/(1-tan(pi/4+t)))=atan(tan(pi/4+atan(t))) 757 gen t=ve.front(); 758 gen test=(1+t)/(1-t); 759 test=ratnormal(e/test,contextptr); 760 if (is_one(test)) 761 return atan(symbolic(at_tan,cst_pi/4+atan(t,contextptr)),contextptr); 762 if (is_minus_one(test)) 763 return -atan(symbolic(at_tan,cst_pi/4+atan(t,contextptr)),contextptr); 764 test=(-1+t)/(1+t); 765 test=ratnormal(e/test,contextptr); 766 if (is_one(test)) 767 return atan(symbolic(at_tan,-cst_pi/4+atan(t,contextptr)),contextptr); 768 if (is_minus_one(test)) 769 return -atan(symbolic(at_tan,-cst_pi/4+atan(t,contextptr)),contextptr); 770 } 771 return symb_atan(e); 772 } d_atan(const gen & args,GIAC_CONTEXT)773 static gen d_atan(const gen & args,GIAC_CONTEXT){ 774 gen g=inv(1+pow(args,2),contextptr); 775 if (angle_radian(contextptr)) 776 return g; 777 else if(angle_degree(contextptr)) 778 return g*rad2deg_e; 779 //grad 780 else 781 return g*rad2grad_e; 782 } 783 define_partial_derivative_onearg_genop( D_at_atan," D_at_atan",&d_atan); taylor_atan(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)784 static gen taylor_atan (const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 785 if (ordre<0) 786 return 0; // no symbolic preprocessing 787 shift_coeff=0; 788 if (!is_inf(lim_point)) 789 return taylor(lim_point,ordre,f,0,shift_coeff,contextptr); 790 vecteur v; 791 identificateur x(" "); 792 taylor(atan(x,contextptr),x,0,ordre,v,contextptr); 793 v=negvecteur(v); 794 v.front()=atan(lim_point,contextptr); 795 return v; 796 } 797 static const char _atan_s []="atan"; 798 #ifdef GIAC_HAS_STO_38 799 static define_unary_function_eval_taylor_index (42,__atan,&atan,(size_t)&D_at_atanunary_function_ptr,&taylor_atan,_atan_s); 800 #else 801 static define_unary_function_eval_taylor_index (42,__atan,&atan,D_at_atan,&taylor_atan,_atan_s); 802 #endif 803 define_unary_function_ptr5( at_atan ,alias_at_atan,&__atan,0,true); 804 symb_exp(const gen & e)805 symbolic symb_exp(const gen & e){ 806 return symbolic(at_exp,e); 807 } numeric_matrix_exp(const gen & e,double eps,GIAC_CONTEXT)808 static gen numeric_matrix_exp(const gen & e,double eps,GIAC_CONTEXT){ 809 gen res=midn(int(e._VECTptr->size())); 810 gen eee(e); 811 for (double j=2;j<max_numexp && linfnorm(eee,contextptr)._DOUBLE_val>eps;++j){ 812 res = res + eee; 813 eee = gen(1/j) * eee * e ; 814 } 815 return res; 816 } 817 exp(const gen & e0,GIAC_CONTEXT)818 gen exp(const gen & e0,GIAC_CONTEXT){ 819 if (e0.type==_FLOAT_){ 820 #ifdef BCD 821 return fexp(e0._FLOAT_val); 822 #else 823 return exp(get_double(e0._FLOAT_val),contextptr); 824 #endif 825 } 826 if (is_integer(e0) && is_strictly_greater(0,e0,contextptr)) 827 return symb_inv(symb_exp(-e0)); 828 gen e=frac_neg_out(e0,contextptr); 829 if (e.type==_SPOL1){ 830 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 831 if (is_positive(expo,contextptr)) 832 return series(*e._SPOL1ptr,*at_exp,0,contextptr); 833 } 834 if (e.type==_DOUBLE_){ 835 #ifdef _SOFTMATH_H 836 return std::giac_gnuwince_exp(e._DOUBLE_val); 837 #else 838 return std::exp(e._DOUBLE_val); 839 #endif 840 } 841 if (e.type==_REAL) 842 return e._REALptr->exp(); 843 if (e.type==_CPLX){ 844 if (e.subtype){ 845 #ifdef _SOFTMATH_H 846 return std::giac_gnuwince_exp(gen2complex_d(e)); 847 #else 848 return std::exp(gen2complex_d(e)); 849 #endif 850 } 851 if (e._CPLXptr->type==_REAL || e._CPLXptr->type==_FLOAT_){ 852 //grad 853 int mode=get_mode_set_radian(contextptr); 854 gen res=exp(*e._CPLXptr,contextptr)*(cos(*(e._CPLXptr+1),contextptr)+cst_i*sin(*(e._CPLXptr+1),contextptr)); 855 angle_mode(mode,contextptr); 856 857 return res; 858 } 859 } 860 if (e.type==_VECT){ 861 if (is_squarematrix(e)){ 862 // check for numeric entries -> numeric exp 863 if (is_fully_numeric(e)) 864 return numeric_matrix_exp(e,epsilon(contextptr),contextptr); 865 return analytic_apply(at_exp,*e._VECTptr,contextptr); 866 } 867 return apply(e,contextptr,exp); 868 } 869 if (is_zero(e,contextptr)) 870 return 1; 871 if (is_undef(e) || e==plus_inf) 872 return e; 873 if (e==unsigned_inf) 874 return undef; 875 if (e==minus_inf) 876 return 0; 877 if (e.type==_SYMB && e._SYMBptr->sommet==at_ln) 878 return e._SYMBptr->feuille; 879 if (e.type==_SYMB && e._SYMBptr->sommet==at_neg && e._SYMBptr->feuille.type==_SYMB && e._SYMBptr->feuille._SYMBptr->sommet==at_ln) 880 return inv(e._SYMBptr->feuille._SYMBptr->feuille,contextptr); 881 gen a,b; 882 if (is_algebraic_program(e,a,b)) 883 return symbolic(at_program,gen(makevecteur(a,0,exp(b,contextptr)),_SEQ__VECT)); 884 int k; 885 if (simplify_sincosexp_pi && contains(e,cst_pi)){ // if (!approx_mode(contextptr)) 886 gen a,b; 887 if (is_linear_wrt(e,cst_pi,a,b,contextptr) && !is_zero(a)){ 888 if (is_multiple_of_12(a*cst_i*gen(trig_deno/2),k)) 889 return (*table_cos[k]+cst_i*(*table_cos[(k+6)%24]))*exp(b,contextptr); 890 else { 891 gen kk; 892 kk=normal(a*cst_i,contextptr); 893 if (is_assumed_integer(kk,contextptr)){ 894 if (is_assumed_integer(normal(rdiv(kk,plus_two,contextptr),contextptr),contextptr)) 895 return exp(b,contextptr); 896 else 897 return pow(minus_one,kk,contextptr)*exp(b,contextptr); 898 } 899 int n,d,q,r; 900 if (is_rational(kk,n,d)){ 901 if (b==0 && (d==5 || d==10) && calc_mode(contextptr)!=1) 902 return cos(kk*cst_pi,contextptr)-cst_i*sin(kk*cst_pi,contextptr); 903 if (d<7){ 904 q=-n/d; 905 r=-n%d; 906 if (q%2) 907 q=-1; 908 else 909 q=1; 910 if (d<0){ r=-r; d=-d; } 911 if (r<0) r += 2*d; 912 if (abs_calc_mode(contextptr)==38 || calc_mode(contextptr)==1) 913 return q*symb_exp(r*(cst_pi*cst_i/d)); 914 // exp(r*i*pi/d) -> use rootof([1,..,0],cyclotomic(2*d)) 915 vecteur vr(r+1); 916 vr[0]=1; 917 vecteur vc(cyclotomic(2*d)); 918 if (!is_undef(vc)) 919 return q*symb_rootof(vr,vc,contextptr)*exp(b,contextptr); 920 // initially it was return q*symb_exp(r*(cst_pi*cst_i/d)); 921 } 922 } 923 } // end else multiple of pi/12 924 } // end is_linear_wrt 925 } // end if contains(e,_IDNT_pi) 926 if (is_equal(e)) 927 return apply_to_equal(e,exp,contextptr); 928 return symb_exp(e); 929 } 930 define_partial_derivative_onearg_genop( D_at_exp,"D_at_exp",exp); taylor_exp(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)931 static gen taylor_exp (const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT){ 932 if (ordre<0) 933 return 0; // no symbolic preprocessing 934 shift_coeff=0; 935 gen image=f(lim_point,contextptr); // should simplify if contains i*pi 936 vecteur v(1,image); 937 if (is_undef(image)) 938 return v; 939 gen factorielle(1); 940 for (int i=1;i<=ordre;++i,factorielle=factorielle*gen(i)) 941 v.push_back(rdiv(image,factorielle,contextptr)); 942 v.push_back(undef); 943 return v; 944 } 945 static const char _exp_s []="exp"; printasexp(const gen & g,const char * s,GIAC_CONTEXT)946 string printasexp(const gen & g,const char * s,GIAC_CONTEXT){ 947 if ( 948 calc_mode(contextptr)==1 || abs_calc_mode(contextptr)==38 949 // xcas_mode(contextptr)==0 950 ){ 951 if (is_one(g)) 952 return calc_mode(contextptr)==1?"ℯ":"e"; 953 if (g.type>_REAL && g.type!=_IDNT) 954 return (calc_mode(contextptr)==1?"ℯ^(":"e^(")+g.print(contextptr)+")"; 955 return (calc_mode(contextptr)==1?"ℯ^":"e^")+g.print(contextptr); 956 } 957 else 958 return "exp("+g.print(contextptr)+")"; 959 } texprintasexp(const gen & g,const char * s,GIAC_CONTEXT)960 static string texprintasexp(const gen & g,const char * s,GIAC_CONTEXT){ 961 return "e^{"+gen2tex(g,contextptr)+"}"; 962 } 963 #ifdef GIAC_HAS_STO_38 964 static define_unary_function_eval_taylor2_index(16,__exp,&exp,(size_t)&D_at_expunary_function_ptr,&taylor_exp,_exp_s,0,&texprintasexp); 965 #else 966 static define_unary_function_eval_taylor2_index(16,__exp,&exp,D_at_exp,&taylor_exp,_exp_s,0,&texprintasexp); 967 #endif 968 define_unary_function_ptr5( at_exp ,alias_at_exp,&__exp,0,true); 969 970 // static symbolic symb_sqrt(const gen & e){ return symbolic(at_sqrt,e); } 971 zint2simpldoublpos(const gen & e,gen & simpl,gen & doubl,bool & pos,int d,GIAC_CONTEXT)972 void zint2simpldoublpos(const gen & e,gen & simpl,gen & doubl,bool & pos,int d,GIAC_CONTEXT){ 973 simpl=1; 974 doubl=1; 975 if (!is_integer(e)){ 976 pos=true; 977 simpl=e; 978 return; 979 } 980 if (is_zero(e)){ 981 simpl=e; 982 return; 983 } 984 gen e_copy; 985 pos=ck_is_positive(e,context0); // ok 986 if (!pos) 987 e_copy=-e; 988 else 989 e_copy=e; 990 vecteur u; 991 #ifdef USE_GMP_REPLACEMENTS 992 bool trial=true; 993 #else 994 bool trial=false; 995 if (e_copy.type==_ZINT && mpz_sizeinbase(*e_copy._ZINTptr,2)>128){ 996 // detect perfect square 997 if (mpz_perfect_power_p(*e_copy._ZINTptr)){ 998 int nbits=mpz_sizeinbase(*e_copy._ZINTptr,2); 999 gen h=accurate_evalf(e_copy,nbits); 1000 h=pow(h,inv(d,contextptr),contextptr); 1001 h=_floor(h,contextptr); 1002 if (pow(h,d,contextptr)==e_copy){ 1003 simpl=1; 1004 doubl=h; 1005 return ; 1006 } 1007 } 1008 // trial division only 1009 trial=true; 1010 } 1011 #endif 1012 if (trial) 1013 u=pfacprem(e_copy,true,contextptr); 1014 else { 1015 #ifdef NO_STDEXCEPT 1016 u=ifactors(e_copy,contextptr); 1017 if (is_undef(u)){ 1018 *logptr(contextptr) << gettext("Unable to factor ") << e << '\n'; 1019 simpl=e; 1020 pos=true; 1021 return; 1022 } 1023 #else 1024 try { 1025 u=ifactors(e_copy,contextptr); 1026 } catch (std::runtime_error & err){ 1027 last_evaled_argptr(contextptr)=NULL; 1028 *logptr(contextptr) << gettext("Unable to factor ") << e << '\n'; 1029 simpl=e; 1030 pos=true; 1031 return; 1032 } 1033 #endif // no_stdexcept 1034 } 1035 // *logptr(contextptr) << u.size() << '\n'; 1036 gen f; 1037 int m,k; 1038 const_iterateur it=u.begin(),itend=u.end(); 1039 for (;it!=itend;++it){ 1040 f=*it; 1041 ++it; 1042 m=it->val; 1043 #ifndef USE_GMP_REPLACEMENTS 1044 if (f.type==_ZINT && mpz_perfect_power_p(*f._ZINTptr)){ 1045 int nbits=mpz_sizeinbase(*f._ZINTptr,2); 1046 gen h=accurate_evalf(f,nbits); 1047 h=pow(h,inv(d,contextptr),contextptr); 1048 h=_floor(h,contextptr); 1049 if (pow(h,d,contextptr)==f){ 1050 f=h; 1051 m=m*d; 1052 } 1053 } 1054 #endif 1055 if (m%d) 1056 simpl = simpl*pow(f,m%d,contextptr); 1057 for (k=0;k<m/d;++k) 1058 doubl = doubl*f; 1059 } 1060 } 1061 1062 // simplified sqrt without taking care of sign sqrt_noabs(const gen & e,GIAC_CONTEXT)1063 gen sqrt_noabs(const gen & e,GIAC_CONTEXT){ 1064 identificateur tmpx(" x"); 1065 vecteur w=solve(tmpx*tmpx-e,tmpx,1,contextptr); 1066 if (lidnt(w).empty()) 1067 w=protect_sort(w,contextptr); 1068 if (w.empty()) 1069 return gensizeerr(gettext("sqrt_noabs of ")+e.print(contextptr)); 1070 return w.back(); 1071 } 1072 fsqrt(float f)1073 static float fsqrt(float f){ 1074 return std::sqrt(f); 1075 } sqrt_mod_pn(const gen & a0,const gen & p,const gen & n,gen & pn,GIAC_CONTEXT)1076 static gen sqrt_mod_pn(const gen & a0,const gen & p,const gen & n,gen & pn,GIAC_CONTEXT){ 1077 pn=pow(p,n,context0); 1078 gen a(a0); 1079 int l=legendre(a,p); 1080 if (l==-1) 1081 return undef; 1082 gen res; 1083 if (n.type!=_INT_ || n.val<1) 1084 return undef; 1085 int N=n.val; 1086 gen pdiv2=1; 1087 if (p==2){ 1088 for (;N>=2 && smod(a,2)==0;pdiv2=2*pdiv2){ 1089 if (smod(a,4)!=0) 1090 return undef; 1091 a=a/4; 1092 N-=2; 1093 } 1094 if (N==1) 1095 return smod(a,2)*pdiv2; 1096 // now a is odd 1097 if (N==2){ 1098 if (is_one(smod(a,4))) 1099 return pdiv2; 1100 return undef; 1101 } 1102 // find x square root of a modulo 8 then Hensel lift 1103 gen x=smod(a,8); 1104 if (x!=1) 1105 return undef; 1106 gen powk=8; 1107 for (int Nn=3;;Nn=2*Nn-1){ 1108 // assume x^2=a mod 2^k, then find y / (x+2^k*y)^2=x^2+2^(k+1)*y*x=a mod 2^(2k) 1109 // => y=[(a-x^2)/2^(k+1)]/x mod 2^(k-1) 1110 gen y=(a-x*x)/powk; 1111 powk=powk/2; 1112 y=y*invmod(x,powk); 1113 x=x+powk*y; 1114 powk=powk*powk; 1115 x=smod(x,powk); 1116 if (Nn>N) 1117 break; 1118 } 1119 return smod(x*pdiv2,pn); 1120 } 1121 if (is_zero(smod(a,p))) 1122 res=0; 1123 else { 1124 if (is_zero(smod(p+1,4))) 1125 res=powmod(smod(a,p),(p+1)/4,p); 1126 else { 1127 // could use Shank-Tonneli algorithm, here use gcd(x^2-a,powmod(x+rand,(p-1)/2,p,x^2-a)-1) to split x^2- in 2 parts with proba 1/2 1128 environment env; 1129 env.moduloon=true; 1130 env.modulo=p; 1131 modpoly A(3),B(2,1),C,D; 1132 A[0]=1; A[2]=-a; 1133 while (true){ 1134 gen r=smod(gen(giac_rand(contextptr)),p); 1135 B[1]=r; 1136 D=powmod(B,(p-1)/2,A,&env); 1137 D.back()=D.back()-1; 1138 if (is_zero(D.front())) 1139 continue; 1140 gcdmodpoly(A,D,&env,C); 1141 if (C.size()==2){ 1142 res=C[1]; 1143 break; 1144 } 1145 } 1146 } 1147 } 1148 if (n.val>1){ 1149 // Hensel lift res mod p^n 1150 pn=p; 1151 gen invmodu=invmod(2*res,p); 1152 for (int i=1;i<n.val;++i){ 1153 res=res+pn*(smod((a-res*res)/pn*invmodu,p)); 1154 pn=pn*p; 1155 } 1156 } 1157 return res; 1158 } sqrt_mod(const gen & a,const gen & b,bool isprime,GIAC_CONTEXT)1159 gen sqrt_mod(const gen & a,const gen & b,bool isprime,GIAC_CONTEXT){ 1160 if (!is_integer(b)) 1161 return gensizeerr(contextptr); 1162 if (is_one(a) || is_zero(a)) 1163 return a; 1164 if (b.type==_INT_){ 1165 int A=smod(a,b).val,p=b.val; 1166 if (A<0) A+=p; 1167 if (A==0 || A==1) return A; 1168 if (isprime && p>1024 && (p+1)%4==0){ 1169 A=powmod(A,(unsigned long)((p+1)/4),p); 1170 if (A>p-A) 1171 A=p-A; 1172 return A; 1173 } 1174 if (p<65536){ 1175 int sq=0,add=1; 1176 for (;add<=p;add+=2){ 1177 sq+=add; 1178 if (sq>=p) 1179 sq-=p; 1180 if (sq==A) 1181 return add/2+1; 1182 } 1183 return undef; 1184 } 1185 } 1186 int l=legendre(a,b); 1187 if (l==-1) 1188 return undef; 1189 vecteur v=ifactors(b,contextptr); 1190 gen oldres(0),pip(1); 1191 for (unsigned i=0;i<v.size()/2;++i){ 1192 gen p=v[2*i],n=v[2*i+1],pn; 1193 gen res=sqrt_mod_pn(a,p,n,pn,contextptr); 1194 if (is_undef(res)) 1195 return res; 1196 // ichinrem step 1197 if (i) 1198 oldres=ichinrem(oldres,res,pip,pn); 1199 else 1200 oldres=res; 1201 pip=pip*pn; 1202 } 1203 if (is_positive(-oldres,contextptr)) 1204 oldres=-oldres; 1205 pip=b-oldres; 1206 if (is_greater(oldres,pip,contextptr)) 1207 oldres=pip; 1208 return oldres; 1209 } 1210 sqrt(const gen & e,GIAC_CONTEXT)1211 gen sqrt(const gen & e,GIAC_CONTEXT){ 1212 // if (abs_calc_mode(contextptr)==38 && do_lnabs(contextptr) &&!complex_mode(contextptr) && (e.type<=_POLY || e.type==_FLOAT_) && !is_positive(e,contextptr)) return gensizeerr(contextptr); 1213 if (!escape_real(contextptr) && !complex_mode(contextptr) && (e.type<=_POLY || e.type==_FLOAT_) && !is_positive(e,contextptr)) return gensizeerr(contextptr); 1214 if (e.type==_FLOAT_){ 1215 if (fsign(e._FLOAT_val)==1) 1216 return fsqrt(e._FLOAT_val); 1217 if (is_zero(e,contextptr)) 1218 return e; 1219 return fsqrt(-e._FLOAT_val)*cst_i; 1220 } 1221 if (e.type==_DOUBLE_){ 1222 if (e._DOUBLE_val>=0){ 1223 #ifdef _SOFTMATH_H 1224 return std::giac_gnuwince_sqrt(e._DOUBLE_val); 1225 #else 1226 return std::sqrt(e._DOUBLE_val); 1227 #endif 1228 } 1229 else 1230 #ifdef _SOFTMATH_H 1231 return gen(0.0,std::giac_gnuwince_sqrt(-e._DOUBLE_val)); 1232 #else 1233 return gen(0.0,std::sqrt(-e._DOUBLE_val)); 1234 #endif 1235 } 1236 if (e.type==_REAL){ 1237 if (is_strictly_positive(-e,contextptr)) 1238 return cst_i*sqrt(-e,contextptr); 1239 return e._REALptr->sqrt(); 1240 } 1241 if (e.type==_USER){ 1242 return e._USERptr->sqrt(contextptr); 1243 } 1244 gen a,b; 1245 if (e.type==_MOD){ 1246 a=*e._MODptr; 1247 b=*(e._MODptr+1); 1248 a=sqrt_mod(a,b,false,contextptr); 1249 if (is_undef(a)) 1250 return a; 1251 if (is_positive(-a,contextptr)) 1252 a=-a; 1253 return makemod(a,b); 1254 } 1255 if (e.type==_CPLX || has_i(e)){ 1256 if (e.type==_CPLX && e.subtype){ 1257 #ifdef _SOFTMATH_H 1258 return std::giac_gnuwince_sqrt(gen2complex_d(e)); 1259 #else 1260 #ifdef EMCC 1261 return std::exp(std::log(gen2complex_d(e))/2.0); 1262 #else 1263 return std::sqrt(gen2complex_d(e)); 1264 #endif 1265 #endif 1266 } 1267 // sqrt of an exact complex number 1268 if (!lop(e,at_exp).empty()) 1269 return pow(e,plus_one_half,contextptr); 1270 a=re(e,contextptr);b=ratnormal(im(e,contextptr),contextptr); 1271 if (a!=e && is_zero(b,contextptr)) 1272 return sqrt(a,contextptr); 1273 if ( has_i(a) || has_i(b) ) 1274 return pow(e,plus_one_half,contextptr); 1275 gen rho=pow(a,2,contextptr)+pow(b,2,contextptr); 1276 rho=ratnormal(rho,contextptr); 1277 if (abs_calc_mode(contextptr)==38 && !lvarfracpow(rho).empty()) 1278 return pow(e,plus_one_half,contextptr); 1279 if (lvar(rho).empty()) rho=eval(rho,1,contextptr); 1280 rho=sqrt(rho,contextptr); 1281 if (abs_calc_mode(contextptr)==38 && rho.type!=_FRAC && rho.type>=_IDNT){ 1282 rho=evalf(rho,1,contextptr); 1283 if (rho.type>=_IDNT) 1284 return pow(e,plus_one_half,contextptr); 1285 *logptr(contextptr) << "Warning converting to approx sqrt"<<'\n'; 1286 } 1287 #ifdef EMCC 1288 if (rho.type>=_IDNT) 1289 rho=evalf(rho,1,contextptr); 1290 #endif 1291 gen realpart=normalize_sqrt(sqrt(2*(a+rho),contextptr),contextptr); 1292 return ratnormal(realpart/2,contextptr)*(1+cst_i*b/(a+rho)); 1293 } 1294 if (e.type==_VECT){ 1295 if (is_squarematrix(e)) 1296 return analytic_apply(at_sqrt,*e._VECTptr,contextptr); 1297 return apply(e,sqrt,contextptr); 1298 } 1299 if ( (is_zero(e) && !e.is_symb_of_sommet(at_unit)) || is_undef(e) || (e==plus_inf) || (e==unsigned_inf)) 1300 return e; 1301 if (is_perfect_square(e)) 1302 return isqrt(e); 1303 if (e.type==_INT_ || e.type==_ZINT){ 1304 // factorization 1305 if (e.type==_INT_ && e.val>0){ 1306 switch (e.val){ 1307 case 2: 1308 return plus_sqrt2; 1309 case 3: 1310 return plus_sqrt3; 1311 case 6: 1312 return plus_sqrt6; 1313 } 1314 } 1315 bool pos=true; 1316 zint2simpldoublpos(e,a,b,pos,2,contextptr); 1317 if (!pos) 1318 return (a==1)?cst_i*b:cst_i*b*symbolic(at_pow,gen(makevecteur(a,plus_one_half),_SEQ__VECT)); 1319 else 1320 return b*symbolic(at_pow,gen(makevecteur(a,plus_one_half),_SEQ__VECT)); 1321 } 1322 if (e.type==_FRAC) 1323 return sqrt(e._FRACptr->num*e._FRACptr->den,contextptr)/abs(e._FRACptr->den,contextptr); 1324 if (is_algebraic_program(e,a,b)) 1325 return symbolic(at_program,gen(makevecteur(a,0,sqrt(b,contextptr)),_SEQ__VECT)); 1326 if (e.is_symb_of_sommet(at_inv)) 1327 return inv(sqrt(e._SYMBptr->feuille,contextptr),contextptr); 1328 if (e.type==_SYMB){ 1329 vecteur v=lvar(e); 1330 if (v.size()==1 && v.front().is_symb_of_sommet(at_pow) && v.front()._SYMBptr->feuille[1]==plus_one_half && is_integer(v.front()._SYMBptr->feuille[0])){ 1331 gen a,b,c=v.front()._SYMBptr->feuille[0]; 1332 if (is_linear_wrt(e,v.front(),b,a,contextptr) && (is_integer(a) ||a.type==_FRAC) && (is_integer(b) || b.type==_FRAC)){ 1333 gen d=a*a-b*b*c; 1334 if (is_positive(d,contextptr)){ 1335 d=sqrt(d,contextptr); 1336 if (is_integer(d) || d.type==_FRAC){ 1337 return sqrt((a+d)/2,contextptr)+sign(b,contextptr)*sqrt((a-d)/2,contextptr); 1338 } 1339 } 1340 } 1341 } 1342 for (unsigned i=0;i<v.size();++i){ 1343 gen vi=v[i]; 1344 if (vi.is_symb_of_sommet(at_cos)){ 1345 gen a,b; 1346 if (is_linear_wrt(e,vi,a,b,contextptr)){ 1347 if (a==b) 1348 return sqrt(2*a,contextptr)*abs(cos(vi._SYMBptr->feuille/2,contextptr),contextptr); 1349 if (a==-b) 1350 return sqrt(-2*a,contextptr)*abs(sin(vi._SYMBptr->feuille/2,contextptr),contextptr); 1351 } 1352 } 1353 if (vi.is_symb_of_sommet(at_sin)){ 1354 gen a,b; 1355 if (is_linear_wrt(e,vi,a,b,contextptr)){ 1356 if (a==b) 1357 return sqrt(2*a,contextptr)*abs(cos(vi._SYMBptr->feuille/2-cst_pi/4,contextptr),contextptr); 1358 if (a==-b) 1359 return sqrt(-2*a,contextptr)*abs(sin(vi._SYMBptr->feuille/2-cst_pi/4,contextptr),contextptr); 1360 } 1361 } 1362 } // end loop on vars 1363 } 1364 return pow(e,plus_one_half,contextptr); 1365 } d_sqrt(const gen & e,GIAC_CONTEXT)1366 static gen d_sqrt(const gen & e,GIAC_CONTEXT){ 1367 return inv(gen(2)*sqrt(e,contextptr),contextptr); 1368 } 1369 define_partial_derivative_onearg_genop( D_at_sqrt," D_at_sqrt",&d_sqrt); 1370 static const char _sqrt_s []="sqrt"; printassqrt(const gen & g,const char * s,GIAC_CONTEXT)1371 static string printassqrt(const gen & g,const char * s,GIAC_CONTEXT){ 1372 bool need=need_parenthesis(g) || g.type==_SYMB; 1373 if (abs_calc_mode(contextptr)==38) 1374 return (need?"√(":"√")+g.print(contextptr)+(need?")":""); 1375 else 1376 return "sqrt("+g.print(contextptr)+")"; 1377 } texprintassqrt(const gen & g,const char * s,GIAC_CONTEXT)1378 static string texprintassqrt(const gen & g,const char * s,GIAC_CONTEXT){ 1379 return "\\sqrt{"+gen2tex(g,contextptr)+"}"; 1380 } 1381 #ifdef GIAC_HAS_STO_38 1382 static define_unary_function_eval5 (__sqrt,&sqrt,(size_t)&D_at_sqrtunary_function_ptr,_sqrt_s,&printassqrt,&texprintassqrt); 1383 #else 1384 static define_unary_function_eval5 (__sqrt,&sqrt,D_at_sqrt,_sqrt_s,&printassqrt,&texprintassqrt); 1385 #endif 1386 define_unary_function_ptr5( at_sqrt ,alias_at_sqrt,&__sqrt,0,true); 1387 _sq(const gen & e,GIAC_CONTEXT)1388 gen _sq(const gen & e,GIAC_CONTEXT){ 1389 if ( e.type==_STRNG && e.subtype==-1) return e; 1390 gen a,b; 1391 if (is_algebraic_program(e,a,b)) 1392 return symbolic(at_program,gen(makevecteur(a,0,_sq(b,contextptr)),_SEQ__VECT)); 1393 return pow(e,2,contextptr); 1394 } d_sq(const gen & e,GIAC_CONTEXT)1395 static gen d_sq(const gen & e,GIAC_CONTEXT){ 1396 return gen(2)*e; 1397 } 1398 define_partial_derivative_onearg_genop( D_at_sq," D_at_sq",&d_sq); 1399 static const char _sq_s []="sq"; 1400 // static string texprintassq(const gen & g,const char * s,GIAC_CONTEXT){ return gen2tex(g,contextptr)+"^2";} 1401 #ifdef GIAC_HAS_STO_38 1402 static define_unary_function_eval3_index (158,__sq,(const gen_op_context)_sq,(size_t)&D_at_squnary_function_ptr,_sq_s); 1403 #else 1404 static define_unary_function_eval3_index (158,__sq,(const gen_op_context)_sq,D_at_sq,_sq_s); 1405 #endif 1406 define_unary_function_ptr5( at_sq ,alias_at_sq,&__sq,0,true); 1407 symb_cos(const gen & e)1408 symbolic symb_cos(const gen & e){ 1409 return symbolic(at_cos,e); 1410 } cos(const gen & e0,GIAC_CONTEXT)1411 gen cos(const gen & e0,GIAC_CONTEXT){ 1412 if (e0.type==_FLOAT_){ 1413 #ifdef BCD 1414 return fcos(e0._FLOAT_val,angle_mode(contextptr)); 1415 #else 1416 return cos(get_double(e0._FLOAT_val),contextptr); 1417 #endif 1418 } 1419 gen e=frac_neg_out(e0,contextptr); 1420 if (e.type==_SPOL1){ 1421 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 1422 if (is_positive(expo,contextptr)) 1423 return series(*e._SPOL1ptr,*at_cos,0,contextptr); 1424 } 1425 if (e.type==_DOUBLE_){ 1426 double d; 1427 if (angle_radian(contextptr)) 1428 d=e._DOUBLE_val; 1429 else if(angle_degree(contextptr)) 1430 d=e._DOUBLE_val*deg2rad_d; 1431 //grad 1432 else 1433 d = e._DOUBLE_val*grad2rad_d; 1434 #ifdef _SOFTMATH_H 1435 return std::giac_gnuwince_cos(d); 1436 #else 1437 return std::cos(d); 1438 #endif 1439 } 1440 if (e.type==_REAL){ 1441 if (angle_radian(contextptr)) 1442 return e._REALptr->cos(); 1443 else if(angle_degree(contextptr)) 1444 return ((e*cst_pi)/180)._REALptr->cos(); 1445 //grad 1446 else 1447 return ((e*cst_pi)/200)._REALptr->cos(); 1448 } 1449 if (e.type==_CPLX){ 1450 if (e.subtype){ 1451 complex_double d; 1452 if (angle_radian(contextptr)) 1453 d=gen2complex_d(e); 1454 else if(angle_degree(contextptr)) 1455 d=gen2complex_d(e)*deg2rad_d; 1456 //grad 1457 else 1458 d=gen2complex_d(e)*grad2rad_d; 1459 #ifdef _SOFTMATH_H 1460 return std::giac_gnuwince_cos(d); 1461 #else 1462 return std::cos(d); 1463 #endif 1464 } 1465 if (e._CPLXptr->type==_REAL || e._CPLXptr->type==_FLOAT_){ 1466 gen e1=e; 1467 if(!angle_radian(contextptr)) 1468 { 1469 //grad 1470 if(angle_degree(contextptr)) 1471 e1=e*deg2rad_g; 1472 else 1473 e1 = e*grad2rad_g; 1474 } 1475 gen e2=im(e1,contextptr); 1476 e1=re(e1,contextptr); 1477 //grad 1478 int mode=get_mode_set_radian(contextptr); 1479 e1= cos(e1,contextptr)*cosh(e2,contextptr)-cst_i*sinh(e2,contextptr)*sin(e1,contextptr); 1480 angle_mode(mode,contextptr); 1481 1482 return e1; 1483 } 1484 } 1485 if (is_squarematrix(e)) 1486 return analytic_apply(at_cos,*e._VECTptr,contextptr); 1487 if (e.type==_VECT) 1488 return apply(e,cos,contextptr); 1489 if (is_zero(e,contextptr)) 1490 return 1; 1491 if ( (e.type==_INT_) && (e.val<0) ) 1492 return cos(-e,contextptr); 1493 if (is_undef(e)) 1494 return e; 1495 if (is_inf(e)) 1496 return undef; 1497 int k; 1498 gen a,b; 1499 if (is_algebraic_program(e,a,b)) 1500 return symbolic(at_program,gen(makevecteur(a,0,cos(b,contextptr)),_SEQ__VECT)); 1501 bool doit=false,est_multiple; 1502 if (angle_radian(contextptr)){ 1503 if (simplify_sincosexp_pi && contains(e,cst_pi) && is_linear_wrt(e,cst_pi,a,b,contextptr)){ 1504 if (is_zero(a)){ 1505 if (is_zero(b)) 1506 return 1; 1507 } else { 1508 if (b==0 && a.type==_FRAC && a._FRACptr->den==10 && a._FRACptr->num.type==_INT_) 1509 return sin(cst_pi/2-e,contextptr); 1510 if (b==0 && a.type==_FRAC && a._FRACptr->den==5 && a._FRACptr->num.type==_INT_){ 1511 int n=a._FRACptr->num.val % 10; 1512 if (n<0) 1513 n += 10; 1514 if (n>=5) 1515 n=10-n; 1516 gen sqrt5=sqrt(5,contextptr); 1517 gen cospi5=(sqrt5+1)/4; 1518 gen cos2pi5=(sqrt5-1)/4; 1519 if (n==1) return cospi5; 1520 if (n==2) return cos2pi5; 1521 if (n==3) return -cos2pi5; 1522 if (n==4) return -cospi5; 1523 } 1524 if (b==0 && a.type==_FRAC && a._FRACptr->den==8 && a._FRACptr->num.type==_INT_){ 1525 int n=a._FRACptr->num.val % 16; 1526 if (n<0) 1527 n += 16; 1528 if (n>=8) 1529 n=16-n; 1530 if (n==1 || n==7){ 1531 gen cospi8=sqrt(2+plus_sqrt2,contextptr)/2; 1532 if (n==1) return cospi8; 1533 if (n==7) return -cospi8; 1534 } 1535 gen cos3pi8=sqrt(2-plus_sqrt2,contextptr)/2; 1536 if (n==3) return cos3pi8; 1537 if (n==5) return -cos3pi8; 1538 } 1539 est_multiple=is_multiple_of_12(a*gen(trig_deno/2),k); 1540 doit=true; 1541 } 1542 } // if (simplify_sincosexp...) 1543 } 1544 else { 1545 est_multiple=is_multiple_of_pi_over_12(e,k,contextptr); 1546 doit=est_multiple; 1547 } 1548 if (doit){ 1549 if (est_multiple){ 1550 if (is_zero(b)) 1551 return *table_cos[k]; 1552 gen C=cos(b,contextptr),S=sin(b,contextptr); 1553 if (k%6==0 || C.type!=_SYMB || S.type!=_SYMB) 1554 return (*table_cos[k])*C+(*table_cos[(k+6)%24])*S; 1555 } 1556 else { 1557 if (is_assumed_integer(a,contextptr)){ 1558 if (is_assumed_integer(normal(rdiv(a,plus_two,contextptr),contextptr),contextptr)) 1559 return cos(b,contextptr); 1560 else 1561 return pow(minus_one,a,contextptr)*cos(b,contextptr); 1562 } 1563 a=expand(a,contextptr); 1564 if (a.is_symb_of_sommet(at_plus) && a._SYMBptr->feuille.type==_VECT){ 1565 vecteur av=*a._SYMBptr->feuille._VECTptr; 1566 vecteur av1; 1567 int neg=0; 1568 for (unsigned i=0;i<av.size();++i){ 1569 if (is_integer(av[i])) 1570 neg += smod(av[i],2).val; 1571 else 1572 av1.push_back(av[i]); 1573 } 1574 if (neg){ 1575 if (av1.empty()) 1576 return (neg%2?-1:1)*cos(b,contextptr); 1577 if (av1.size()==1) 1578 return (neg%2?-1:1)*cos(av1.front()*cst_pi+b,contextptr); 1579 return (neg%2?-1:1)*cos(symbolic(at_plus,gen(av1,_SEQ__VECT))*cst_pi+b,contextptr); 1580 } 1581 } 1582 int n,d,q,r; 1583 if (is_zero(b,contextptr) && is_rational(a,n,d)){ 1584 q=n/d; 1585 r=n%d; 1586 if (r>d/2){ 1587 r -= d; 1588 ++q; 1589 } 1590 if (q%2) 1591 q=-1; 1592 else 1593 q=1; 1594 if (r<0) 1595 r=-r; 1596 if (!(d%2) && d%4){ 1597 d=d/2; // cos(r/(2*d)*pi) = sin(pi/2(1-r/d)) 1598 if (angle_radian(contextptr)) 1599 return -q*sin((r-d)/2*cst_pi/d,contextptr); 1600 else if(angle_degree(contextptr)) 1601 return -q*sin(rdiv((r-d)*90,d,contextptr),contextptr); 1602 //grad 1603 else 1604 return -q*sin(rdiv((r - d) * 100, d, contextptr), contextptr); 1605 } 1606 if (angle_radian(contextptr)) 1607 return q*symb_cos(r*cst_pi/d); 1608 else if(angle_degree(contextptr)) 1609 return q*symb_cos(rdiv(r*180,d,contextptr)); 1610 //grad 1611 else 1612 return q*symb_cos(rdiv(r*200,d,contextptr)); 1613 } 1614 } 1615 } 1616 if (e.type==_SYMB) { 1617 unary_function_ptr u=e._SYMBptr->sommet; 1618 gen f=e._SYMBptr->feuille; 1619 if (u==at_neg) 1620 return cos(f,contextptr); 1621 if (u==at_acos) 1622 return f; 1623 if (u==at_asin) 1624 return sqrt(1-pow(f,2),contextptr); 1625 if (u==at_atan) 1626 return sqrt(inv(pow(f,2)+1,contextptr),contextptr); 1627 } 1628 if (is_equal(e)) 1629 return apply_to_equal(e,cos,contextptr); 1630 return symb_cos(e); 1631 } d_cos(const gen & e,GIAC_CONTEXT)1632 static gen d_cos(const gen & e ,GIAC_CONTEXT){ 1633 if (angle_radian(contextptr)) 1634 return -(sin(e,contextptr)); 1635 else if(angle_degree(contextptr)) 1636 return -deg2rad_e*sin(e,contextptr); 1637 //grad 1638 else 1639 return -grad2rad_e*sin(e,contextptr); 1640 } 1641 define_partial_derivative_onearg_genop( D_at_cos," D_at_cos",d_cos); 1642 static const char _cos_s []="cos"; 1643 #ifdef GIAC_HAS_STO_38 1644 static define_unary_function_eval3_index (34,__cos,&cos,(size_t)&D_at_cosunary_function_ptr,_cos_s); 1645 #else 1646 static define_unary_function_eval3_index (34,__cos,&cos,D_at_cos,_cos_s); 1647 #endif 1648 define_unary_function_ptr5( at_cos ,alias_at_cos,&__cos,0,true); 1649 symb_sin(const gen & e)1650 symbolic symb_sin(const gen & e){ 1651 return symbolic(at_sin,e); 1652 } sin(const gen & e0,GIAC_CONTEXT)1653 gen sin(const gen & e0,GIAC_CONTEXT){ 1654 if (e0.type==_FLOAT_){ 1655 #ifdef BCD 1656 return fsin(e0._FLOAT_val,angle_mode(contextptr)); 1657 #else 1658 return sin(get_double(e0._FLOAT_val),contextptr); 1659 #endif 1660 } 1661 gen e=frac_neg_out(e0,contextptr); 1662 if (e.type==_SPOL1){ 1663 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 1664 if (is_positive(expo,contextptr)) 1665 return series(*e._SPOL1ptr,*at_sin,0,contextptr); 1666 } 1667 if (e.type==_DOUBLE_){ 1668 double d; 1669 if (angle_radian(contextptr)) 1670 d=e._DOUBLE_val; 1671 else if(angle_degree(contextptr)) 1672 d=e._DOUBLE_val*deg2rad_d; 1673 //grad 1674 else 1675 d=e._DOUBLE_val*grad2rad_d; 1676 #ifdef _SOFTMATH_H 1677 return std::giac_gnuwince_sin(d); 1678 #else 1679 return std::sin(d); 1680 #endif 1681 } 1682 if (e.type==_REAL){ 1683 if (angle_radian(contextptr)) 1684 return e._REALptr->sin(); 1685 else if(angle_degree(contextptr)) 1686 return ((e*cst_pi)/180)._REALptr->sin(); 1687 //grad 1688 else 1689 return ((e*cst_pi)/200)._REALptr->sin(); 1690 } 1691 if (e.type==_CPLX){ 1692 if (e.subtype){ 1693 complex_double d; 1694 if (angle_radian(contextptr)) 1695 d=gen2complex_d(e); 1696 else if(angle_degree(contextptr)) 1697 d=gen2complex_d(e)*deg2rad_d; 1698 //grad 1699 else 1700 d=gen2complex_d(e)*grad2rad_d; 1701 #ifdef _SOFTMATH_H 1702 return std::giac_gnuwince_sin(d); 1703 #else 1704 return std::sin(d); 1705 #endif 1706 } 1707 if (e._CPLXptr->type==_REAL || e._CPLXptr->type==_FLOAT_){ 1708 gen e1=e; 1709 if(!angle_radian(contextptr)) 1710 { 1711 if(angle_degree(contextptr)) 1712 e1=e*deg2rad_g; 1713 //grad 1714 else 1715 e1 = e*grad2rad_g; 1716 } 1717 gen e2=im(e1,contextptr); 1718 e1=re(e1,contextptr); 1719 //grad 1720 int mode=get_mode_set_radian(contextptr); 1721 gen res=sin(e1,contextptr)*cosh(e2,contextptr)+cst_i*sinh(e2,contextptr)*cos(e1,contextptr); 1722 angle_mode(mode,contextptr); 1723 1724 return res; 1725 } 1726 } 1727 if (is_squarematrix(e)) 1728 return analytic_apply(at_sin,*e._VECTptr,contextptr); 1729 if (e.type==_VECT) 1730 return apply(e,sin,contextptr); 1731 if (is_zero(e,contextptr)) 1732 return e; 1733 if ( (e.type==_INT_) && (e.val<0) ) 1734 return -sin(-e,contextptr); 1735 if (is_undef(e)) 1736 return e; 1737 if (is_inf(e)) 1738 return undef; 1739 int k; 1740 gen a,b; 1741 if (is_algebraic_program(e,a,b)) 1742 return symbolic(at_program,gen(makevecteur(a,0,sin(b,contextptr)),_SEQ__VECT)); 1743 bool doit=false,est_multiple; 1744 if (angle_radian(contextptr)){ 1745 if (simplify_sincosexp_pi && contains(e,cst_pi) && is_linear_wrt(e,cst_pi,a,b,contextptr)){ 1746 if (is_zero(a)){ 1747 if (is_zero(b)) 1748 return 0; 1749 } else { 1750 if (b==0 && a.type==_FRAC && a._FRACptr->den==10 && a._FRACptr->num.type==_INT_) 1751 return cos(cst_pi/2-e,contextptr); 1752 if (b==0 && a.type==_FRAC && a._FRACptr->den==5 && a._FRACptr->num.type==_INT_){ 1753 int n=a._FRACptr->num.val % 10; 1754 if (n<0) 1755 n+=10; 1756 gen sqrt5=sqrt(5,contextptr); 1757 gen sinpi5=sqrt(-2*sqrt5+10,contextptr)/4; 1758 gen sin2pi5=sqrt(2*sqrt5+10,contextptr)/4; 1759 if (n==1 || n==4) return sinpi5; 1760 if (n==2 || n==3) return sin2pi5; 1761 if (n==6 || n==9) return -sinpi5; 1762 if (n==7 || n==8) return -sin2pi5; 1763 } 1764 if (b==0 && a.type==_FRAC && a._FRACptr->den==8 && a._FRACptr->num.type==_INT_){ 1765 int n=a._FRACptr->num.val % 16; 1766 if (n<0) 1767 n+=16; 1768 gen sinpi8=sqrt(2-plus_sqrt2,contextptr)/2; 1769 gen sin3pi8=sqrt(2+plus_sqrt2,contextptr)/2; 1770 if (n==1 || n==7) return sinpi8; 1771 if (n==3 || n==5) return sin3pi8; 1772 if (n==9 || n==15) return -sinpi8; 1773 if (n==11 || n==13) return -sin3pi8; 1774 } 1775 est_multiple=is_multiple_of_12(a*gen(trig_deno/2),k); 1776 doit=true; 1777 } 1778 } // if (simplify_sincospexp...) 1779 } 1780 else { 1781 est_multiple=is_multiple_of_pi_over_12(e,k,contextptr); 1782 doit=est_multiple; 1783 } 1784 if (doit){ 1785 if (est_multiple){ 1786 if (is_zero(b)) 1787 return *table_cos[(k+18)%24]; 1788 gen C=cos(b,contextptr),S=sin(b,contextptr); 1789 if (k%6==0 || C.type!=_SYMB || S.type!=_SYMB) 1790 return *table_cos[(k+18)%24]*C+(*table_cos[k%24])*S; 1791 } 1792 else { 1793 if (is_assumed_integer(a,contextptr)){ 1794 if (is_assumed_integer(normal(a/2,contextptr),contextptr)) 1795 return sin(b,contextptr); 1796 else 1797 return pow(minus_one,a,contextptr)*sin(b,contextptr); 1798 } 1799 a=expand(a,contextptr); 1800 if (a.is_symb_of_sommet(at_plus) && a._SYMBptr->feuille.type==_VECT){ 1801 vecteur av=*a._SYMBptr->feuille._VECTptr; 1802 vecteur av1; 1803 int neg=0; 1804 for (unsigned i=0;i<av.size();++i){ 1805 if (is_integer(av[i])) 1806 neg += smod(av[i],2).val; 1807 else 1808 av1.push_back(av[i]); 1809 } 1810 if (neg){ 1811 if (av1.empty()) 1812 return (neg%2?-1:1)*sin(b,contextptr); 1813 if (av1.size()==1) 1814 return (neg%2?-1:1)*sin(av1.front()*cst_pi+b,contextptr); 1815 return (neg%2?-1:1)*sin(symbolic(at_plus,gen(av1,_SEQ__VECT))*cst_pi+b,contextptr); 1816 } 1817 } 1818 int n,d,q,r; 1819 if (is_zero(b,contextptr) && is_rational(a,n,d)){ 1820 q=n/d; 1821 r=n%d; 1822 if (r>d/2){ 1823 r -= d; 1824 ++q; 1825 } 1826 if (q%2) 1827 q=-1; 1828 else 1829 q=1; 1830 if (r<0){ 1831 r=-r; 1832 q=-q; 1833 } 1834 if (!(d%2) && d%4){ 1835 d=d/2; // sin(r/(2*d)*pi) = cos(pi/2(1-r/d)) 1836 if (angle_radian(contextptr)) 1837 return q*cos((r-d)/2*cst_pi/d,contextptr); 1838 else if(angle_degree(contextptr)) 1839 return q*cos(rdiv((r-d)*90,d,contextptr),contextptr); 1840 //grad 1841 else 1842 return q*cos(rdiv((r-d)*100,d,contextptr),contextptr); 1843 } 1844 if (angle_radian(contextptr)) 1845 return q*symb_sin(r*cst_pi/d); 1846 else if(angle_degree(contextptr)) 1847 return q*symb_sin(rdiv(r*180,d,contextptr)); 1848 //grad 1849 else 1850 return q*symb_sin(rdiv(r*200,d,contextptr)); 1851 } 1852 } 1853 } 1854 if (e.type==_SYMB) { 1855 unary_function_ptr u=e._SYMBptr->sommet; 1856 gen f=e._SYMBptr->feuille; 1857 if (u==at_neg) 1858 return -sin(f,contextptr); 1859 if (u==at_asin) 1860 return f; 1861 if (u==at_acos) 1862 return sqrt(1-pow(f,2),contextptr); 1863 if (u==at_atan) 1864 return rdiv(f,sqrt(pow(f,2)+1,contextptr),contextptr); 1865 } 1866 if (is_equal(e)) 1867 return apply_to_equal(e,sin,contextptr); 1868 return symb_sin(e); 1869 } d_sin(const gen & g,GIAC_CONTEXT)1870 static gen d_sin(const gen & g,GIAC_CONTEXT){ 1871 if (angle_radian(contextptr)) 1872 return cos(g,contextptr); 1873 else if(angle_degree(contextptr)) 1874 return deg2rad_e*cos(g,contextptr); 1875 //grad 1876 else 1877 return grad2rad_e*cos(g,contextptr); 1878 } 1879 static const char _sin_s []="sin"; 1880 define_partial_derivative_onearg_genop( D_at_sin," D_at_sin",&d_sin); 1881 #ifdef GIAC_HAS_STO_38 1882 static define_unary_function_eval3_index (32,__sin,&sin,(size_t)&D_at_sinunary_function_ptr,_sin_s); 1883 #else 1884 static define_unary_function_eval3_index (32,__sin,&sin,D_at_sin,_sin_s); 1885 #endif 1886 define_unary_function_ptr5( at_sin ,alias_at_sin,&__sin,0,true); 1887 symb_tan(const gen & e)1888 symbolic symb_tan(const gen & e){ 1889 return symbolic(at_tan,e); 1890 } tan(const gen & e0,GIAC_CONTEXT)1891 gen tan(const gen & e0,GIAC_CONTEXT){ 1892 if (e0.type==_FLOAT_){ 1893 #ifdef BCD 1894 return ftan(e0._FLOAT_val,angle_mode(contextptr)); 1895 #else 1896 return tan(get_double(e0._FLOAT_val),contextptr); 1897 #endif 1898 } 1899 gen e=frac_neg_out(e0,contextptr); 1900 if (e.type==_SPOL1){ 1901 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 1902 if (is_positive(expo,contextptr)) 1903 return series(*e._SPOL1ptr,*at_tan,0,contextptr); 1904 } 1905 if (e.type==_DOUBLE_){ 1906 double d; 1907 if (angle_radian(contextptr)) 1908 d=e._DOUBLE_val; 1909 else if(angle_degree(contextptr)) 1910 d=e._DOUBLE_val*deg2rad_d; 1911 //grad 1912 else 1913 d=e._DOUBLE_val*grad2rad_d; 1914 #ifdef _SOFTMATH_H 1915 return std::giac_gnuwince_tan(d); 1916 #else 1917 return std::tan(d); 1918 #endif 1919 } 1920 if (e.type==_REAL){ 1921 if (angle_radian(contextptr)) 1922 return e._REALptr->tan(); 1923 else if(angle_degree(contextptr)) 1924 return ((e*cst_pi)/180)._REALptr->tan(); 1925 //grad 1926 else 1927 return ((e*cst_pi)/200)._REALptr->tan(); 1928 } 1929 if (e.type==_CPLX){ 1930 if (e.subtype){ 1931 complex_double c(gen2complex_d(e)); 1932 if(!angle_radian(contextptr)) 1933 { 1934 //grad 1935 if(angle_degree(contextptr)) 1936 c *= deg2rad_d; 1937 else 1938 c *= grad2rad_d; 1939 } 1940 #ifdef _SOFTMATH_H 1941 return std::giac_gnuwince_tan(c); 1942 #else 1943 return std::sin(c)/std::cos(c); 1944 #endif 1945 } 1946 if (e._CPLXptr->type==_REAL || e._CPLXptr->type==_FLOAT_){ 1947 gen e1=e; 1948 if (!angle_radian(contextptr)) 1949 { 1950 //grad 1951 if(angle_degree(contextptr)) 1952 e1=e*deg2rad_g; 1953 else 1954 e1 = e*grad2rad_g; 1955 } 1956 1957 gen e2=im(e1,contextptr); 1958 e1=re(e1,contextptr); 1959 //grad 1960 int mode=get_mode_set_radian(contextptr); 1961 e1=tan(e1,contextptr); 1962 angle_mode(mode,contextptr); 1963 1964 e2=cst_i*tanh(e2,contextptr); 1965 return (e1+e2)/(1-e1*e2); 1966 } 1967 } 1968 if (is_squarematrix(e)) 1969 return analytic_apply(at_tan,*e._VECTptr,contextptr); 1970 if (e.type==_VECT) 1971 return apply(e,contextptr,tan); 1972 if (is_zero(e,contextptr)) 1973 return e; 1974 if (is_undef(e)) 1975 return e; 1976 if (is_inf(e)) 1977 return undef; 1978 if ( (e.type==_INT_) && (e.val<0) ) 1979 return -tan(-e,contextptr); 1980 gen a,b; 1981 if (is_algebraic_program(e,a,b)) 1982 return symbolic(at_program,gen(makevecteur(a,0,tan(b,contextptr)),_SEQ__VECT)); 1983 int k; 1984 if (angle_radian(contextptr)){ 1985 if (contains(e,cst_pi) && is_linear_wrt(e,cst_pi,a,b,contextptr)){ 1986 if (is_integer(a)){ 1987 if (is_zero(b)) 1988 return 0; 1989 else 1990 if (a!=0) // avoid recursion 1991 return tan(b,contextptr); 1992 } 1993 } 1994 } 1995 if (!approx_mode(contextptr)){ 1996 if (is_multiple_of_pi_over_12(e,k,contextptr)) //grad 1997 return *table_tan[(k%12)]; 1998 if (is_multiple_of_pi_over_12(2*e,k,contextptr)) //grad 1999 return normal(sin(2*e,contextptr)/(1+cos(2*e,contextptr)),contextptr); 2000 else { 2001 gen kk; 2002 if (angle_radian(contextptr)) 2003 kk=normal(rdiv(e,cst_pi,contextptr),contextptr); 2004 else if(angle_degree(contextptr)) 2005 kk=normal(rdiv(e,180,contextptr),contextptr); 2006 //grad 2007 else 2008 kk = normal(rdiv(e, 200, contextptr), contextptr); 2009 if (is_assumed_integer(kk,contextptr)) 2010 return zero; 2011 int n,d; 2012 if (is_rational(kk,n,d)){ 2013 if (d==10) 2014 return inv(tan((angle_radian(contextptr)?cst_pi/2:(angle_degree(contextptr)?90:100))-e,contextptr),contextptr); //grad 2015 if (d==5){ 2016 n %= 5; 2017 if (n<0) 2018 n+=5; 2019 gen sqrt5=sqrt(5,contextptr); 2020 if (n==1 || n==4) 2021 sqrt5=5-2*sqrt5; 2022 else 2023 sqrt5=5+2*sqrt5; 2024 sqrt5=sqrt(sqrt5,contextptr); 2025 return n<=2?sqrt5:-sqrt5; 2026 } 2027 if (d%2==0 && n<d/2 && n>d/4){ 2028 n = d/2-n; gen res; 2029 if (angle_radian(contextptr)) 2030 res=symb_tan((n%d)*inv(d,contextptr)*cst_pi); 2031 else if(angle_degree(contextptr)) 2032 res= symb_tan(rdiv((n%d)*180,d,contextptr)); 2033 else // grad 2034 res= symb_tan(rdiv((n%d)*200,d,contextptr)); 2035 return inv(res,contextptr); 2036 } 2037 if (angle_radian(contextptr)) 2038 return symb_tan((n%d)*inv(d,contextptr)*cst_pi); 2039 else if(angle_degree(contextptr)) 2040 return symb_tan(rdiv((n%d)*180,d,contextptr)); 2041 else // grad 2042 return symb_tan(rdiv((n%d)*200,d,contextptr)); 2043 } 2044 } 2045 } 2046 if (e.type==_SYMB) { 2047 unary_function_ptr u=e._SYMBptr->sommet; 2048 gen f=e._SYMBptr->feuille; 2049 if (u==at_neg) 2050 return -tan(f,contextptr); 2051 if (u==at_atan) 2052 return f; 2053 if (u==at_acos) 2054 return rdiv(sqrt(1-pow(f,2),contextptr),f,contextptr); 2055 if (u==at_asin) 2056 return rdiv(f,sqrt(1-pow(f,2),contextptr),contextptr); 2057 } 2058 if (is_equal(e)) 2059 return apply_to_equal(e,tan,contextptr); 2060 return symb_tan(e); 2061 } d_tan(const gen & e,GIAC_CONTEXT)2062 static gen d_tan(const gen & e,GIAC_CONTEXT){ 2063 if (angle_radian(contextptr)) 2064 return 1+pow(tan(e,contextptr),2); 2065 else if(angle_degree(contextptr)) 2066 return deg2rad_e*(1+pow(tan(e,contextptr),2)); 2067 //grad 2068 else 2069 return grad2rad_e*(1+pow(tan(e,contextptr),2)); 2070 } 2071 define_partial_derivative_onearg_genop( D_at_tan," D_at_tan",&d_tan); 2072 static const char _tan_s []="tan"; 2073 #ifdef GIAC_HAS_STO_38 2074 static define_unary_function_eval3_index (36,__tan,&tan,(size_t)&D_at_tanunary_function_ptr,_tan_s); 2075 #else 2076 static define_unary_function_eval3_index (36,__tan,&tan,D_at_tan,_tan_s); 2077 #endif 2078 define_unary_function_ptr5( at_tan ,alias_at_tan,&__tan,0,true); 2079 symb_asin(const gen & e)2080 symbolic symb_asin(const gen & e){ 2081 return symbolic(at_asin,e); 2082 } asinasln(const gen & x,GIAC_CONTEXT)2083 static gen asinasln(const gen & x,GIAC_CONTEXT){ 2084 return -cst_i*ln(cst_i*x+sqrt(1-x*x,contextptr),contextptr); 2085 // return cst_i*ln(sqrt(x*x-1,contextptr)+x,contextptr)+cst_pi_over_2; 2086 } normal_sin_pi_12_ptr_()2087 gen * normal_sin_pi_12_ptr_(){ 2088 static gen * ans=0; 2089 if (!ans) ans=new gen(normal(sin_pi_12,context0)); 2090 return ans; 2091 } normal_cos_pi_12_ptr_()2092 gen * normal_cos_pi_12_ptr_(){ 2093 static gen * ans=0; 2094 if (!ans) ans=new gen(normal(cos_pi_12,context0)); 2095 return ans; 2096 } asin(const gen & e0,GIAC_CONTEXT)2097 gen asin(const gen & e0,GIAC_CONTEXT){ 2098 if ( (calc_mode(contextptr)==38 || !escape_real(contextptr) ) && !complex_mode(contextptr) && (e0.type<=_POLY || e0.type==_FLOAT_) && (!is_positive(e0+1,contextptr) || !is_positive(1-e0,contextptr))) 2099 return gensizeerr(contextptr); 2100 if (e0.type==_SPOL1){ 2101 gen expo=e0._SPOL1ptr->empty()?undef:e0._SPOL1ptr->front().exponent; 2102 if (is_positive(expo,contextptr)) 2103 return series(*e0._SPOL1ptr,*at_asin,0,contextptr); 2104 } 2105 if (e0.type==_FLOAT_){ 2106 if (!is_positive(e0+1,contextptr) || !is_positive(1-e0,contextptr)) 2107 return asinasln(e0,contextptr)*gen(angle_radian(contextptr)?1.0:(angle_degree(contextptr)?rad2deg_d:rad2grad_d)); //grad // cst_i*ln(sqrt(e0*e0-1,contextptr)+e0,contextptr)+evalf(cst_pi_over_2,1,contextptr); 2108 #ifdef BCD 2109 return fasin(e0._FLOAT_val,angle_mode(contextptr)); 2110 #else 2111 return asin(get_double(e0._FLOAT_val),contextptr); 2112 #endif 2113 } 2114 #ifndef VISUALC 2115 gen * normal_sin_pi_12_ptr=normal_sin_pi_12_ptr_(); 2116 gen * normal_cos_pi_12_ptr=normal_cos_pi_12_ptr_(); 2117 #endif 2118 gen e=frac_neg_out(e0,contextptr); 2119 if (e.type==_DOUBLE_){ 2120 if (e._DOUBLE_val>=-1 && e._DOUBLE_val<=1){ 2121 #ifdef _SOFTMATH_H 2122 double d= std::giac_gnuwince_asin(e._DOUBLE_val); 2123 #else 2124 double d=std::asin(e._DOUBLE_val); 2125 #endif 2126 if (angle_radian(contextptr)) 2127 return d; 2128 else if(angle_degree(contextptr)) 2129 return d*rad2deg_d; 2130 //grad 2131 else 2132 return d*rad2grad_d; 2133 } 2134 } 2135 if (e.type==_REAL){ 2136 if (angle_radian(contextptr)) 2137 return e._REALptr->asin(); 2138 else if(angle_degree(contextptr)) 2139 return 180*e._REALptr->asin()/cst_pi; 2140 //grad 2141 else 2142 return 200*e._REALptr->asin()/cst_pi; 2143 } 2144 if ( e.type==_DOUBLE_ || (e.type==_CPLX && (e.subtype || e._CPLXptr->type==_FLOAT_ || e._CPLXptr->type==_REAL)) ){ 2145 if (angle_radian(contextptr)) 2146 return no_context_evalf(asinasln(e,contextptr)); 2147 else if(angle_degree(contextptr)) 2148 return no_context_evalf(asinasln(e,contextptr))*gen(rad2deg_d); 2149 //grad 2150 else 2151 return no_context_evalf(asinasln(e,contextptr))*gen(rad2grad_d); 2152 } 2153 if (is_squarematrix(e)) 2154 return analytic_apply(at_asin,*e._VECTptr,contextptr); 2155 if (e.type==_VECT) 2156 return apply(e,asin,contextptr); 2157 if (is_zero(e,contextptr)) 2158 return e; 2159 if (is_one(e)){ 2160 if (is_zero(e)) fonction_bidon(); 2161 if (angle_radian(contextptr)) 2162 return cst_pi_over_2; 2163 else if(angle_degree(contextptr)) 2164 return 90; 2165 //grad 2166 else 2167 return 100; 2168 } 2169 if (e==sin_pi_12 2170 #ifndef VISUALC 2171 || e==*normal_sin_pi_12_ptr 2172 #endif 2173 ){ 2174 if (angle_radian(contextptr)) 2175 return rdiv(cst_pi,12,contextptr); 2176 else if(angle_degree(contextptr)) 2177 return 15; 2178 //grad 2179 else 2180 return rdiv(50, 3); //50/3 grads 2181 } 2182 if (e==cos_pi_12 2183 #ifndef VISUALC 2184 || e==*normal_cos_pi_12_ptr 2185 #endif 2186 ){ 2187 if (angle_radian(contextptr)) 2188 return 5*cst_pi/12; 2189 else if(angle_degree(contextptr)) 2190 return 75; 2191 //grad 2192 else 2193 return rdiv(250,3); //250/3 grads 2194 } 2195 if (e==plus_sqrt3_2){ 2196 if (angle_radian(contextptr)) 2197 return rdiv(cst_pi,3,contextptr); 2198 else if(angle_degree(contextptr)) 2199 return 60; 2200 //grad 2201 else 2202 return rdiv(200,3); //200/3 grads 2203 } 2204 if (e==plus_sqrt2_2){ 2205 if (angle_radian(contextptr)) 2206 return rdiv(cst_pi,4,contextptr); 2207 else if(angle_degree(contextptr)) 2208 return 45; 2209 //grad 2210 else 2211 return 50; 2212 } 2213 if (e==plus_one_half){ 2214 if (angle_radian(contextptr)) 2215 return rdiv(cst_pi,6,contextptr); 2216 else if(angle_degree(contextptr)) 2217 return 30; 2218 //grad 2219 else 2220 return rdiv(100,3); //100/3 grads 2221 } 2222 gen edg=evalf_double(e,1,contextptr); 2223 if (edg.type==_DOUBLE_){ 2224 double ed=edg._DOUBLE_val; 2225 // detect if asin is a multiples of pi/10 2226 gen edh=horner(makevecteur(256,-512,336,-80,5),edg*edg); 2227 if (absdouble(edh._DOUBLE_val)<1e-9 && 2228 normal(horner(makevecteur(256,-512,336,-80,5),e*e),contextptr)==0){ 2229 int res=int(std::floor(std::asin(absdouble(ed))*10/M_PI+.5)); 2230 if (res%2) 2231 return (ed>0?res:-res)*(angle_radian(contextptr)?cst_pi/10:(angle_degree(contextptr)?gen(18):gen(20))); //grad 2232 else 2233 return (ed>0?res/2:-res/2)*(angle_radian(contextptr)?cst_pi/5:(angle_degree(contextptr)?gen(36):gen(40))); //grad 2234 } 2235 edh=horner(makevecteur(512,-1280,1152,-448,70,-3),edg*edg); 2236 if (absdouble(edh._DOUBLE_val)<1e-9 && 2237 normal(horner(makevecteur(512,-1280,1152,-448,70,-3),e*e),contextptr)==0){ 2238 int res=int(std::floor(std::asin(absdouble(ed))*12/M_PI+.5)); 2239 int den=12; 2240 int g=gcd(res,den); 2241 res /=g; den /=g; 2242 return (ed>0?res:-res)*(angle_radian(contextptr)?cst_pi/den:(angle_degree(contextptr)?gen(15*g):rdiv(50,3)*gen(g))); //grad 50/3*g grads 2243 } 2244 edh=horner(makevecteur(64,-128,80,-16,1),edg*edg); 2245 if (absdouble(edh._DOUBLE_val)<1e-9 && 2246 normal(horner(makevecteur(64,-128,80,-16,1),e*e),contextptr)==0){ 2247 int res=int(std::floor(std::asin(absdouble(ed))*8/M_PI+.5)); 2248 int den=8; 2249 int g=gcd(res,den); 2250 res /=g; den /=g; 2251 return (ed>0?res:-res)*(angle_radian(contextptr)?cst_pi/den:(angle_degree(contextptr)?gen(45*g)/2:gen(25))); //grad 2252 } 2253 } 2254 if (is_undef(e)) 2255 return e; 2256 gen a,b; 2257 if (is_algebraic_program(e,a,b)) 2258 return symbolic(at_program,gen(makevecteur(a,0,asin(b,contextptr)),_SEQ__VECT)); 2259 if ((e.type==_SYMB) && (e._SYMBptr->sommet==at_neg)) 2260 return -asin(e._SYMBptr->feuille,contextptr); 2261 gen cste=angle_radian(contextptr)?cst_pi:(angle_degree(contextptr)?180:200); 2262 if (e.is_symb_of_sommet(at_cos)) 2263 e=symbolic(at_sin,cste/2-e._SYMBptr->feuille); 2264 if (e.is_symb_of_sommet(at_sin) && has_evalf(e._SYMBptr->feuille,a,1,contextptr)){ 2265 // asin(sin(a))==a-2*k*pi or pi-a-2*k*pi 2266 gen n=_round(a/cste,contextptr); 2267 b=a-n*cste; // in [-pi/2,pi/2] 2268 if (n.type==_INT_ && n.val%2==0) 2269 return e._SYMBptr->feuille-n*cste; 2270 return n*cste-e._SYMBptr->feuille; 2271 } 2272 if (e.is_symb_of_sommet(at_sin)){ 2273 a=e._SYMBptr->feuille; 2274 gen n=_round(a/cste,contextptr); 2275 return symbolic(at_pow,makesequence(-1,n))*(a-n*cste); 2276 } 2277 if ( (e.type==_INT_) && (e.val<0) ) 2278 return -asin(-e,contextptr); 2279 if (is_equal(e)) 2280 return apply_to_equal(e,asin,contextptr); 2281 if (lidnt(e).empty() && is_positive(e*e-1,contextptr)) 2282 return (angle_radian(contextptr)?1:(angle_degree(contextptr)?rad2deg_g:rad2grad_g))*asinasln(e,contextptr); 2283 return symb_asin(e); 2284 } d_asin(const gen & args,GIAC_CONTEXT)2285 static gen d_asin(const gen & args,GIAC_CONTEXT){ 2286 gen g=inv(recursive_normal(sqrt(1-pow(args,2),contextptr),contextptr),contextptr); 2287 if (angle_radian(contextptr)) 2288 return g; 2289 else if(angle_degree(contextptr)) 2290 return g*rad2deg_e; 2291 //grad 2292 else 2293 return g*rad2grad_e; 2294 } taylor_asin(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)2295 static gen taylor_asin (const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 2296 if (ordre<0) 2297 return 0; // no symbolic preprocessing 2298 if (is_one(lim_point)){ 2299 shift_coeff=plus_one_half; 2300 identificateur x(" "); vecteur v; 2301 taylor(pow(2+x,minus_one_half,contextptr),x,0,ordre,v,contextptr); 2302 // integration with shift 2303 v=integrate(v,shift_coeff); 2304 if (!direction) 2305 direction=1; 2306 return normal((gen(-direction)*cst_i)*gen(v),contextptr); 2307 } 2308 if (is_minus_one(lim_point)){ 2309 shift_coeff=plus_one_half; 2310 identificateur x(" "); vecteur v; 2311 taylor(pow(2-x,minus_one_half,contextptr),x,0,ordre,v,contextptr); 2312 // integration with shift 2313 v=integrate(v,shift_coeff); 2314 return v; 2315 } 2316 return taylor(lim_point,ordre,f,direction,shift_coeff,contextptr); 2317 } 2318 define_partial_derivative_onearg_genop( D_at_asin," D_at_asin",&d_asin); 2319 static const char _asin_s []="asin"; 2320 #ifdef GIAC_HAS_STO_38 2321 static define_unary_function_eval_taylor_index( 38,__asin,&asin,(size_t)&D_at_asinunary_function_ptr,&taylor_asin,_asin_s); 2322 #else 2323 static define_unary_function_eval_taylor_index( 38,__asin,&asin,D_at_asin,&taylor_asin,_asin_s); 2324 #endif 2325 define_unary_function_ptr5( at_asin ,alias_at_asin,&__asin,0,true); 2326 symb_acos(const gen & e)2327 static symbolic symb_acos(const gen & e){ 2328 return symbolic(at_acos,e); 2329 } acos(const gen & e0,GIAC_CONTEXT)2330 gen acos(const gen & e0,GIAC_CONTEXT){ 2331 if ( (calc_mode(contextptr)==38 || !escape_real(contextptr) ) && !complex_mode(contextptr) && (e0.type<=_POLY || e0.type==_FLOAT_) && (!is_positive(e0+1,contextptr) || !is_positive(1-e0,contextptr))) 2332 return gensizeerr(contextptr); 2333 if (e0.type==_FLOAT_ && is_positive(e0+1,contextptr) && is_positive(1-e0,contextptr)){ 2334 #ifdef BCD 2335 return facos(e0._FLOAT_val,angle_mode(contextptr)); 2336 #else 2337 return acos(get_double(e0._FLOAT_val),contextptr); 2338 #endif 2339 } 2340 gen e=frac_neg_out(e0,contextptr); 2341 if (e.type==_DOUBLE_){ 2342 if (e._DOUBLE_val>=-1 && e._DOUBLE_val<=1){ 2343 #ifdef _SOFTMATH_H 2344 double d= std::giac_gnuwince_acos(e._DOUBLE_val); 2345 #else 2346 double d=std::acos(e._DOUBLE_val); 2347 #endif 2348 if (angle_radian(contextptr)) 2349 return d; 2350 else if(angle_degree(contextptr)) 2351 return d*rad2deg_d; 2352 //grad 2353 else 2354 return d*rad2grad_d; 2355 } 2356 } 2357 if (e.type==_SPOL1){ 2358 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 2359 if (is_positive(expo,contextptr)) 2360 return series(*e._SPOL1ptr,*at_exp,0,contextptr); 2361 } 2362 if (e.type==_REAL){ 2363 if (angle_radian(contextptr)) 2364 return e._REALptr->acos(); 2365 else if(angle_degree(contextptr)) 2366 return 180*e._REALptr->acos()/cst_pi; 2367 //grad 2368 else 2369 return 200*e._REALptr->acos()/cst_pi; 2370 } 2371 if ( e.type==_DOUBLE_ || (e.type==_CPLX && (e.subtype || e._CPLXptr->type==_FLOAT_ || e._CPLXptr->type==_REAL)) ){ 2372 gen res=cst_pi/2-asinasln(e,contextptr); // -cst_i*no_context_evalf(ln(sqrt(e*e-1,contextptr)+e,contextptr)); 2373 if (angle_radian(contextptr)) 2374 return res; 2375 else if(angle_degree(contextptr)) 2376 return res*gen(rad2deg_d); 2377 //grad 2378 else 2379 return res*gen(rad2grad_d); 2380 } 2381 if (is_squarematrix(e)) 2382 return analytic_apply(at_acos,*e._VECTptr,contextptr); 2383 if (e.type==_VECT) 2384 return apply(e,acos,contextptr); 2385 if (is_equal(e)) 2386 return apply_to_equal(e,acos,contextptr); 2387 gen a,b; 2388 if (is_algebraic_program(e,a,b)) 2389 return symbolic(at_program,gen(makevecteur(a,0,acos(b,contextptr)),_SEQ__VECT)); 2390 gen g=asin(e,contextptr); 2391 if ( (g.type==_SYMB) && (g._SYMBptr->sommet==at_asin) ) 2392 return symb_acos(e); 2393 if (angle_radian(contextptr)) 2394 return normal(cst_pi_over_2-asin(e,contextptr),contextptr); 2395 else if(angle_degree(contextptr)) 2396 return 90-asin(e,contextptr); 2397 //grad 2398 else 2399 return 100-asin(e,contextptr); 2400 } d_acos(const gen & args,GIAC_CONTEXT)2401 static gen d_acos(const gen & args,GIAC_CONTEXT){ 2402 gen g= -inv(recursive_normal(sqrt(1-pow(args,2),contextptr),contextptr),contextptr); 2403 if (angle_radian(contextptr)) 2404 return g; 2405 else if(angle_degree(contextptr)) 2406 return g*rad2deg_e; 2407 //grad 2408 else 2409 return g*rad2grad_e; 2410 } 2411 define_partial_derivative_onearg_genop( D_at_acos," D_at_acos",&d_acos); taylor_acos(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)2412 static gen taylor_acos (const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 2413 if (ordre<0) 2414 return 0; // no symbolic preprocessing 2415 if (is_one(lim_point)){ 2416 shift_coeff=plus_one_half; 2417 identificateur x(" "); vecteur v; 2418 taylor(pow(2+x,minus_one_half,contextptr),x,0,ordre,v,contextptr); 2419 // integration with shift 2420 v=integrate(v,shift_coeff); 2421 if (!direction) 2422 direction=1; 2423 return -normal((gen(-direction)*cst_i)*gen(v),contextptr); 2424 } 2425 if (is_minus_one(lim_point)){ 2426 shift_coeff=plus_one_half; 2427 identificateur x(" "); vecteur v; 2428 taylor(pow(2-x,minus_one_half,contextptr),x,0,ordre,v,contextptr); 2429 // integration with shift 2430 v=integrate(v,shift_coeff); 2431 return -v; 2432 } 2433 return taylor(lim_point,ordre,f,direction,shift_coeff,contextptr); 2434 } 2435 static const char _acos_s []="acos"; 2436 #ifdef GIAC_HAS_STO_38 2437 static define_unary_function_eval_taylor_index( 40,__acos,&acos,(size_t)&D_at_acosunary_function_ptr,&taylor_acos,_acos_s); 2438 #else 2439 static define_unary_function_eval_taylor_index( 40,__acos,&acos,D_at_acos,&taylor_acos,_acos_s); 2440 #endif 2441 define_unary_function_ptr5( at_acos ,alias_at_acos,&__acos,0,true); 2442 symb_sinh(const gen & e)2443 symbolic symb_sinh(const gen & e){ 2444 return symbolic(at_sinh,e); 2445 } sinh(const gen & e0,GIAC_CONTEXT)2446 gen sinh(const gen & e0,GIAC_CONTEXT){ 2447 if (e0.type==_FLOAT_){ 2448 #ifdef BCD 2449 return fsinh(e0._FLOAT_val); 2450 #else 2451 return sinh(get_double(e0._FLOAT_val),contextptr); 2452 #endif 2453 } 2454 gen e=frac_neg_out(e0,contextptr); 2455 if (e.type==_DOUBLE_){ 2456 #ifdef _SOFTMATH_H 2457 return std::giac_gnuwince_sinh(e._DOUBLE_val); 2458 #else 2459 return std::sinh(e._DOUBLE_val); 2460 #endif 2461 } 2462 if (e.type==_SPOL1){ 2463 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 2464 if (is_positive(expo,contextptr)) 2465 return series(*e._SPOL1ptr,*at_sinh,0,contextptr); 2466 } 2467 if (e.type==_REAL) 2468 return e._REALptr->sinh(); 2469 if (e.type==_CPLX){ 2470 if (e.subtype){ 2471 #ifdef _SOFTMATH_H 2472 return std::giac_gnuwince_sinh(gen2complex_d(e)); 2473 #else 2474 return std::sinh(gen2complex_d(e)); 2475 #endif 2476 } 2477 if (e._CPLXptr->type==_REAL || e._CPLXptr->type==_FLOAT_){ 2478 gen g=exp(e,contextptr); 2479 return (g-inv(g,contextptr))/2; 2480 } 2481 } 2482 if (is_squarematrix(e)) 2483 return analytic_apply(at_sinh,*e._VECTptr,contextptr); 2484 if (e.type==_VECT) 2485 return apply(e,sinh,contextptr); 2486 if ( is_zero(e,contextptr) || (is_undef(e)) || (is_inf(e))) 2487 return e; 2488 if (is_equal(e)) 2489 return apply_to_equal(e,sinh,contextptr); 2490 gen a,b; 2491 if (is_algebraic_program(e,a,b)) 2492 return symbolic(at_program,gen(makevecteur(a,0,sinh(b,contextptr)),_SEQ__VECT)); 2493 if (e.is_symb_of_sommet(at_neg)) 2494 return -sinh(e._SYMBptr->feuille,contextptr); 2495 if (e.type==_SYMB && has_i(e)){ 2496 gen ee=simplifier(-cst_i*e,contextptr); 2497 return cst_i*sin(ee,contextptr); 2498 } 2499 return symb_sinh(e); 2500 } d_at_sinh(const gen & e,GIAC_CONTEXT)2501 static gen d_at_sinh(const gen & e,GIAC_CONTEXT){ 2502 return cosh(e,contextptr); 2503 } 2504 define_partial_derivative_onearg_genop( D_at_sinh," D_at_sinh",&d_at_sinh); 2505 static const char _sinh_s []="sinh"; 2506 #ifdef GIAC_HAS_STO_38 2507 static define_unary_function_eval3_index (44,__sinh,&sinh,(size_t)&D_at_sinhunary_function_ptr,_sinh_s); 2508 #else 2509 static define_unary_function_eval3_index (44,__sinh,&sinh,D_at_sinh,_sinh_s); 2510 #endif 2511 define_unary_function_ptr5( at_sinh ,alias_at_sinh,&__sinh,0,true); 2512 symb_cosh(const gen & e)2513 symbolic symb_cosh(const gen & e){ 2514 return symbolic(at_cosh,e); 2515 } cosh(const gen & e0,GIAC_CONTEXT)2516 gen cosh(const gen & e0,GIAC_CONTEXT){ 2517 if (e0.type==_FLOAT_){ 2518 #ifdef BCD 2519 return fcosh(e0._FLOAT_val); 2520 #else 2521 return cosh(get_double(e0._FLOAT_val),contextptr); 2522 #endif 2523 } 2524 gen e=frac_neg_out(e0,contextptr); 2525 if (e.type==_DOUBLE_){ 2526 #ifdef _SOFTMATH_H 2527 return std::giac_gnuwince_cosh(e._DOUBLE_val); 2528 #else 2529 return std::cosh(e._DOUBLE_val); 2530 #endif 2531 } 2532 if (e.type==_SPOL1){ 2533 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 2534 if (is_positive(expo,contextptr)) 2535 return series(*e._SPOL1ptr,*at_cosh,0,contextptr); 2536 } 2537 if (e.type==_REAL) 2538 return e._REALptr->cosh(); 2539 if (e.type==_CPLX){ 2540 if (e.subtype){ 2541 #ifdef _SOFTMATH_H 2542 return std::giac_gnuwince_cosh(gen2complex_d(e)); 2543 #else 2544 return std::cosh(gen2complex_d(e)); 2545 #endif 2546 } 2547 if (e._CPLXptr->type==_REAL || e._CPLXptr->type==_FLOAT_){ 2548 gen g=exp(e,contextptr); 2549 return (g+inv(g,contextptr))/2; 2550 } 2551 } 2552 if (is_squarematrix(e)) 2553 return analytic_apply(at_cosh,*e._VECTptr,contextptr); 2554 if (e.type==_VECT) 2555 return apply(e,cosh,contextptr); 2556 if (is_zero(e,contextptr)) 2557 return 1; 2558 if (is_undef(e)) 2559 return e; 2560 if (is_inf(e)) 2561 return plus_inf; 2562 if (is_equal(e)) 2563 return apply_to_equal(e,cosh,contextptr); 2564 gen a,b; 2565 if (is_algebraic_program(e,a,b)) 2566 return symbolic(at_program,gen(makevecteur(a,0,cosh(b,contextptr)),_SEQ__VECT)); 2567 if (e.is_symb_of_sommet(at_neg)) 2568 return cosh(e._SYMBptr->feuille,contextptr); 2569 if (e.type==_SYMB && has_i(e)){ 2570 gen ee=simplifier(-cst_i*e,contextptr); 2571 return cos(ee,contextptr); 2572 } 2573 return symb_cosh(e); 2574 } 2575 define_partial_derivative_onearg_genop( D_at_cosh,"D_at_cosh",sinh); 2576 static const char _cosh_s []="cosh"; 2577 #ifdef GIAC_HAS_STO_38 2578 static define_unary_function_eval3_index (46,__cosh,&cosh,(size_t)&D_at_coshunary_function_ptr,_cosh_s); 2579 #else 2580 static define_unary_function_eval3_index (46,__cosh,&cosh,D_at_cosh,_cosh_s); 2581 #endif 2582 define_unary_function_ptr5( at_cosh ,alias_at_cosh,&__cosh,0,true); 2583 2584 // static symbolic symb_tanh(const gen & e){ return symbolic(at_tanh,e); } tanh(const gen & e0,GIAC_CONTEXT)2585 gen tanh(const gen & e0,GIAC_CONTEXT){ 2586 if (e0.type==_FLOAT_){ 2587 #ifdef BCD 2588 return ftanh(e0._FLOAT_val); 2589 #else 2590 return tanh(get_double(e0._FLOAT_val),contextptr); 2591 #endif 2592 } 2593 gen e=frac_neg_out(e0,contextptr); 2594 if (e.type==_DOUBLE_){ 2595 #ifdef _SOFTMATH_H 2596 return std::giac_gnuwince_tanh(e._DOUBLE_val); 2597 #else 2598 return std::tanh(e._DOUBLE_val); 2599 #endif 2600 } 2601 if (e.type==_SPOL1){ 2602 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 2603 if (is_positive(expo,contextptr)) 2604 return series(*e._SPOL1ptr,*at_tanh,0,contextptr); 2605 } 2606 if (e.type==_REAL) 2607 return e._REALptr->tanh(); 2608 if (e.type==_CPLX){ 2609 if (e.subtype){ 2610 complex_double c(gen2complex_d(e)); 2611 #ifdef _SOFTMATH_H 2612 return std::giac_gnuwince_tanh(c); 2613 #else 2614 return std::sinh(c)/std::cosh(c); 2615 #endif 2616 } 2617 if (e._CPLXptr->type==_REAL || e._CPLXptr->type==_FLOAT_){ 2618 gen g=exp(2*e,contextptr); 2619 return (g+1)/(g-1); 2620 } 2621 } 2622 if (is_squarematrix(e)) 2623 return analytic_apply(at_tanh,*e._VECTptr,contextptr); 2624 if (e.type==_VECT) 2625 return apply(e,tanh,contextptr); 2626 if (is_zero(e,contextptr)) 2627 return e; 2628 if (is_undef(e) || (e==unsigned_inf)) 2629 return undef; 2630 if (e==plus_inf) 2631 return 1; 2632 if (e==minus_inf) 2633 return -1; 2634 if (is_equal(e)) 2635 return apply_to_equal(e,tanh,contextptr); 2636 gen a,b; 2637 if (is_algebraic_program(e,a,b)) 2638 return symbolic(at_program,gen(makevecteur(a,0,tanh(b,contextptr)),_SEQ__VECT)); 2639 if (e.is_symb_of_sommet(at_neg)) 2640 return -tanh(e._SYMBptr->feuille,contextptr); 2641 if (e.type==_SYMB && has_i(e)){ 2642 gen ee=simplifier(-cst_i*e,contextptr); 2643 return cst_i*tan(ee,contextptr); 2644 } 2645 return symbolic(at_tanh,e); 2646 } d_tanh(const gen & e,GIAC_CONTEXT)2647 static gen d_tanh(const gen & e,GIAC_CONTEXT){ 2648 return 1-pow(tanh(e,contextptr),2); 2649 } 2650 define_partial_derivative_onearg_genop( D_at_tanh," D_at_tanh",&d_tanh); 2651 static const char _tanh_s []="tanh"; 2652 #ifdef GIAC_HAS_STO_38 2653 static define_unary_function_eval3_index (48,__tanh,&tanh,(size_t)&D_at_tanhunary_function_ptr,_tanh_s); 2654 #else 2655 static define_unary_function_eval3_index (48,__tanh,&tanh,D_at_tanh,_tanh_s); 2656 #endif 2657 define_unary_function_ptr5( at_tanh ,alias_at_tanh,&__tanh,0,true); 2658 2659 // static symbolic symb_asinh(const gen & e){ return symbolic(at_asinh,e); } asinhasln(const gen & x,GIAC_CONTEXT)2660 static gen asinhasln(const gen & x,GIAC_CONTEXT){ 2661 return ln(x+sqrt(x*x+1,contextptr),contextptr); 2662 } asinh(const gen & e0,GIAC_CONTEXT)2663 gen asinh(const gen & e0,GIAC_CONTEXT){ 2664 if (e0.type==_FLOAT_){ 2665 #ifdef BCD 2666 return fasinh(e0._FLOAT_val); 2667 #else 2668 return asinh(get_double(e0._FLOAT_val),contextptr); 2669 #endif 2670 } 2671 gen e=frac_neg_out(e0,contextptr); 2672 if (e.type==_DOUBLE_) 2673 return asinhasln(e,contextptr); 2674 if (e.type==_SPOL1){ 2675 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 2676 if (is_positive(expo,contextptr)) 2677 return series(*e._SPOL1ptr,*at_asinh,0,contextptr); 2678 } 2679 if (e.type==_REAL) 2680 return e._REALptr->asinh(); 2681 if ( (e.type==_CPLX) && (e.subtype || e._CPLXptr->type==_REAL)) 2682 return no_context_evalf(asinhasln(e,contextptr)); 2683 if (is_squarematrix(e)){ 2684 context tmp; 2685 return analytic_apply(at_asinh,*e._VECTptr,&tmp); 2686 } 2687 if (e.type==_VECT) 2688 return apply(e,asinh,contextptr); 2689 if (is_zero(e,contextptr) || is_inf(e)) 2690 return e; 2691 if (is_undef(e)) 2692 return e; 2693 if (is_equal(e)) 2694 return apply_to_equal(e,asinh,contextptr); 2695 gen a,b; 2696 if (is_algebraic_program(e,a,b)) 2697 return symbolic(at_program,gen(makevecteur(a,0,asinh(b,contextptr)),_SEQ__VECT)); 2698 if (keep_acosh_asinh(contextptr)) 2699 return symbolic(at_asinh,e); 2700 return ln(e+sqrt(pow(e,2)+1,contextptr),contextptr); 2701 } d_asinh(const gen & args,GIAC_CONTEXT)2702 static gen d_asinh(const gen & args,GIAC_CONTEXT){ 2703 return inv(recursive_normal(sqrt(pow(args,2)+1,contextptr),contextptr),contextptr); 2704 } 2705 define_partial_derivative_onearg_genop( D_at_asinh," D_at_asinh",&d_asinh); 2706 static const char _asinh_s []="asinh"; 2707 #ifdef GIAC_HAS_STO_38 2708 static define_unary_function_eval3_index (50,__asinh,&asinh,(size_t)&D_at_asinhunary_function_ptr,_asinh_s); 2709 #else 2710 static define_unary_function_eval3_index (50,__asinh,&asinh,D_at_asinh,_asinh_s); 2711 #endif 2712 define_unary_function_ptr5( at_asinh ,alias_at_asinh,&__asinh,0,true); 2713 2714 // static symbolic symb_acosh(const gen & e){ return symbolic(at_cosh,e); } acoshasln(const gen & x,GIAC_CONTEXT)2715 static gen acoshasln(const gen & x,GIAC_CONTEXT){ 2716 if (re(x,contextptr)==x) 2717 return ln(x+sqrt(x*x-1,contextptr),contextptr); // avoid multiple sqrt but it's the opposite for example for x non real 2718 return ln(x+sqrt(x+1,contextptr)*sqrt(x-1,contextptr),contextptr); 2719 } acosh(const gen & e0,GIAC_CONTEXT)2720 gen acosh(const gen & e0,GIAC_CONTEXT){ 2721 if (e0.type==_FLOAT_){ 2722 if (is_strictly_greater(1,e0,contextptr)) 2723 return ln(e0+sqrt(pow(e0,2)-1,contextptr),contextptr); 2724 #ifdef BCD 2725 return facosh(e0._FLOAT_val); 2726 #else 2727 return acosh(get_double(e0._FLOAT_val),contextptr); 2728 #endif 2729 } 2730 gen e=frac_neg_out(e0,contextptr); 2731 if (e.type==_DOUBLE_) 2732 return acoshasln(e,contextptr); 2733 if (e.type==_SPOL1){ 2734 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 2735 if (is_positive(expo,contextptr)) 2736 return series(*e._SPOL1ptr,*at_acosh,0,contextptr); 2737 } 2738 if (e.type==_REAL) 2739 return e._REALptr->acosh(); 2740 if ( (e.type==_CPLX) && (e.subtype|| e._CPLXptr->type==_REAL || e._CPLXptr->type==_FLOAT_)) 2741 return no_context_evalf(acoshasln(e,contextptr)); 2742 if (is_squarematrix(e)) 2743 return analytic_apply(at_acosh,*e._VECTptr,0); 2744 if (e.type==_VECT) 2745 return apply(e,acosh,contextptr); 2746 if (is_one(e)) 2747 return 0; 2748 if (e==plus_inf) 2749 return plus_inf; 2750 if (is_undef(e)) 2751 return e; 2752 if (is_equal(e)) 2753 return apply_to_equal(e,acosh,contextptr); 2754 gen a,b; 2755 if (is_algebraic_program(e,a,b)) 2756 return symbolic(at_program,gen(makevecteur(a,0,acosh(b,contextptr)),_SEQ__VECT)); 2757 if (keep_acosh_asinh(contextptr)) 2758 return symbolic(at_acosh,e); 2759 return acoshasln(e,contextptr); 2760 // return ln(e+sqrt(pow(e,2)-1,contextptr),contextptr); 2761 } d_acosh(const gen & args,GIAC_CONTEXT)2762 static gen d_acosh(const gen & args,GIAC_CONTEXT){ 2763 return inv(recursive_normal(sqrt(pow(args,2)-1,contextptr),contextptr),contextptr); 2764 } 2765 define_partial_derivative_onearg_genop( D_at_acosh," D_at_acosh",&d_acosh); 2766 static const char _acosh_s []="acosh"; 2767 #ifdef GIAC_HAS_STO_38 2768 static define_unary_function_eval3_index (52,__acosh,&acosh,(size_t)&D_at_acoshunary_function_ptr,_acosh_s); 2769 #else 2770 static define_unary_function_eval3_index (52,__acosh,&acosh,D_at_acosh,_acosh_s); 2771 #endif 2772 define_unary_function_ptr5( at_acosh ,alias_at_acosh,&__acosh,0,true); 2773 2774 // static symbolic symb_atanh(const gen & e){ return symbolic(at_atanh,e);} atanh(const gen & e0,GIAC_CONTEXT)2775 gen atanh(const gen & e0,GIAC_CONTEXT){ 2776 if (e0.type==_FLOAT_){ 2777 if (is_strictly_greater(e0,1,contextptr) || is_strictly_greater(-1,e0,contextptr)) 2778 return rdiv(ln(rdiv(1+e0,1-e0),contextptr),plus_two,contextptr); 2779 #ifdef BCD 2780 return fatanh(e0._FLOAT_val); 2781 #else 2782 return atanh(get_double(e0._FLOAT_val),contextptr); 2783 #endif 2784 } 2785 gen e=frac_neg_out(e0,contextptr); 2786 if (e.type==_DOUBLE_ && fabs(e._DOUBLE_val)<1){ 2787 #ifdef _SOFTMATH_H 2788 return std::giac_gnuwince_log((1+e._DOUBLE_val)/(1-e._DOUBLE_val))/2; 2789 #else 2790 return std::log((1+e._DOUBLE_val)/(1-e._DOUBLE_val))/2; 2791 #endif 2792 } 2793 if (e.type==_SPOL1){ 2794 gen expo=e._SPOL1ptr->empty()?undef:e._SPOL1ptr->front().exponent; 2795 if (is_positive(expo,contextptr)) 2796 return series(*e._SPOL1ptr,*at_atanh,0,contextptr); 2797 } 2798 if (e.type==_REAL) 2799 return e._REALptr->atanh(); 2800 if ( (e.type==_CPLX) && (e.subtype || e._CPLXptr->type==_REAL)) 2801 return no_context_evalf(rdiv(ln(rdiv(1+e,1-e,contextptr),contextptr),plus_two)); 2802 if (is_squarematrix(e)) 2803 return analytic_apply(at_atanh,*e._VECTptr,0); 2804 if (e.type==_VECT) 2805 return apply(e,atanh,contextptr); 2806 if (is_zero(e,contextptr)) 2807 return e; 2808 if (is_one(e)) 2809 return plus_inf; 2810 if (is_minus_one(e)) 2811 return minus_inf; 2812 if (is_undef(e)) 2813 return e; 2814 if (is_equal(e)) 2815 return apply_to_equal(e,atanh,contextptr); 2816 gen a,b; 2817 if (is_algebraic_program(e,a,b)) 2818 return symbolic(at_program,gen(makevecteur(a,0,atanh(b,contextptr)),_SEQ__VECT)); 2819 return rdiv(ln(rdiv(1+e,1-e,contextptr),contextptr),plus_two); 2820 // return symbolic(at_atanh,e); 2821 } d_atanh(const gen & args,GIAC_CONTEXT)2822 static gen d_atanh(const gen & args,GIAC_CONTEXT){ 2823 return inv(1-pow(args,2),contextptr); 2824 } 2825 define_partial_derivative_onearg_genop( D_at_atanh," D_at_atanh",&d_atanh); 2826 static const char _atanh_s []="atanh"; 2827 #ifdef GIAC_HAS_STO_38 2828 static define_unary_function_eval3_index (54,__atanh,&atanh,(size_t)&D_at_atanhunary_function_ptr,_atanh_s); 2829 #else 2830 static define_unary_function_eval3_index (54,__atanh,&atanh,D_at_atanh,_atanh_s); 2831 #endif 2832 define_unary_function_ptr5( at_atanh ,alias_at_atanh,&__atanh,0,true); 2833 printasquote(const gen & g,const char * s,GIAC_CONTEXT)2834 static string printasquote(const gen & g,const char * s,GIAC_CONTEXT){ 2835 if (calc_mode(contextptr)==38) 2836 return "QUOTE("+g.print(contextptr)+")"; 2837 else 2838 return "'"+g.print(contextptr)+"'"; 2839 } symb_quote(const gen & arg)2840 symbolic symb_quote(const gen & arg){ 2841 return symbolic(at_quote,arg); 2842 } quote(const gen & args,GIAC_CONTEXT)2843 gen quote(const gen & args,GIAC_CONTEXT){ 2844 if (args.type==_VECT && args.subtype==_SEQ__VECT && !args._VECTptr->empty() && args._VECTptr->front().type==_FUNC){ 2845 const unary_function_ptr & u =*args._VECTptr->front()._FUNCptr; 2846 vecteur v=vecteur(args._VECTptr->begin()+1,args._VECTptr->end()); 2847 gen arg=eval(gen(v,_SEQ__VECT),eval_level(contextptr),contextptr); 2848 return symbolic(u,arg); 2849 } 2850 return args; 2851 } 2852 define_partial_derivative_onearg_genop( D_at_quote," D_at_quote","e); 2853 static const char _quote_s []="quote"; 2854 #ifdef GIAC_HAS_STO_38 2855 static define_unary_function_eval5_quoted (__quote,"e,(size_t)&D_at_quoteunary_function_ptr,_quote_s,&printasquote,0); 2856 #else 2857 static define_unary_function_eval5_quoted (__quote,"e,D_at_quote,_quote_s,&printasquote,0); 2858 #endif 2859 define_unary_function_ptr5( at_quote ,alias_at_quote,&__quote,0,true); 2860 2861 // symbolic symb_unquote(const gen & arg){ return symbolic(at_unquote,arg); } unquote(const gen & arg,GIAC_CONTEXT)2862 gen unquote(const gen & arg,GIAC_CONTEXT){ 2863 return eval(arg,1,contextptr); 2864 } 2865 define_partial_derivative_onearg_genop( D_at_unquote," D_at_unquote",(const gen_op_context)unquote); 2866 static const char _unquote_s []="unquote"; 2867 #ifdef GIAC_HAS_STO_38 2868 static define_unary_function_eval3 (__unquote,(const gen_op_context)unquote,(size_t)&D_at_unquoteunary_function_ptr,_unquote_s); 2869 #else 2870 static define_unary_function_eval3 (__unquote,(const gen_op_context)unquote,D_at_unquote,_unquote_s); 2871 #endif 2872 define_unary_function_ptr5( at_unquote ,alias_at_unquote,&__unquote,0,true); 2873 symb_order_size(const gen & e)2874 static symbolic symb_order_size(const gen & e){ 2875 return symbolic(at_order_size,e); 2876 } order_size(const gen & arg,GIAC_CONTEXT)2877 gen order_size(const gen & arg,GIAC_CONTEXT){ 2878 if (arg.type==_SPOL1 && arg._SPOL1ptr->size()==1){ 2879 gen expo=arg._SPOL1ptr->front().exponent; 2880 char sv=series_variable_name(contextptr); 2881 if (expo!=1) 2882 *logptr(contextptr) << "order_size argument should always be the series variable name. This means that O("<<sv<<"^"<<expo << ") should be written "<< sv << "^" << expo <<"*order_size("<< sv << ")" << '\n'; 2883 return sparse_poly1(1,monome(undef,0)); 2884 } 2885 return symb_order_size(arg); 2886 } 2887 define_partial_derivative_onearg_genop( D_at_order_size," D_at_order_size",order_size); 2888 static const char _order_size_s []="order_size"; 2889 #ifdef GIAC_HAS_STO_38 2890 static define_unary_function_eval3 (__order_size,&order_size,(size_t)&D_at_order_sizeunary_function_ptr,_order_size_s); 2891 #else 2892 static define_unary_function_eval3 (__order_size,&order_size,D_at_order_size,_order_size_s); 2893 #endif 2894 define_unary_function_ptr5( at_order_size ,alias_at_order_size,&__order_size,0,true); 2895 re(const gen & a,GIAC_CONTEXT)2896 gen re(const gen & a,GIAC_CONTEXT){ 2897 if (is_equal(a)) 2898 return apply_to_equal(a,re,contextptr); 2899 gen a1,b; 2900 if (is_algebraic_program(a,a1,b)) 2901 return symbolic(at_program,gen(makevecteur(a1,0,symbolic(at_re,b)),_SEQ__VECT)); 2902 return a.re(contextptr); 2903 } 2904 static const char _re_s []="re"; texprintasre(const gen & g,const char * s,GIAC_CONTEXT)2905 static string texprintasre(const gen & g,const char * s,GIAC_CONTEXT){ 2906 return "\\Re("+gen2tex(g,contextptr)+")"; 2907 } 2908 static define_unary_function_eval4 (__re,(const gen_op_context)re,_re_s,0,&texprintasre); 2909 define_unary_function_ptr5( at_re ,alias_at_re,&__re,0,true); 2910 im(const gen & a,GIAC_CONTEXT)2911 gen im(const gen & a,GIAC_CONTEXT){ 2912 if (is_equal(a)) 2913 return apply_to_equal(a,im,contextptr); 2914 gen a1,b; 2915 if (is_algebraic_program(a,a1,b)) 2916 return symbolic(at_program,gen(makevecteur(a1,0,symbolic(at_im,b)),_SEQ__VECT)); 2917 return a.im(contextptr); 2918 } 2919 static const char _im_s []="im"; texprintasim(const gen & g,const char * s,GIAC_CONTEXT)2920 static string texprintasim(const gen & g,const char * s,GIAC_CONTEXT){ 2921 return "\\Im("+gen2tex(g,contextptr)+")"; 2922 } 2923 static define_unary_function_eval4 (__im,(const gen_op_context)im,_im_s,0,&texprintasim); 2924 define_unary_function_ptr5( at_im ,alias_at_im,&__im,0,true); 2925 symb_conj(const gen & e)2926 symbolic symb_conj(const gen & e){ 2927 return symbolic(at_conj,e); 2928 } conj(const gen & a,GIAC_CONTEXT)2929 gen conj(const gen & a,GIAC_CONTEXT){ 2930 if (is_equal(a)) 2931 return apply_to_equal(a,conj,contextptr); 2932 gen a1,b; 2933 if (is_algebraic_program(a,a1,b)) 2934 return symbolic(at_program,gen(makevecteur(a1,0,symbolic(at_conj,b)),_SEQ__VECT)); 2935 return a.conj(contextptr); 2936 } 2937 static const char _conj_s []="conj"; texprintasconj(const gen & g,const char * s,GIAC_CONTEXT)2938 static string texprintasconj(const gen & g,const char * s,GIAC_CONTEXT){ 2939 return "\\overline{"+gen2tex(g,contextptr)+"}"; 2940 } 2941 static define_unary_function_eval4 (__conj,(const gen_op_context)conj,_conj_s,0,&texprintasconj); 2942 define_unary_function_ptr5( at_conj ,alias_at_conj,&__conj,0,true); 2943 taylor_sign(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)2944 static gen taylor_sign (const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 2945 if (ordre<0) 2946 return 0; // no symbolic preprocessing 2947 shift_coeff=0; 2948 if (is_strictly_positive(lim_point,contextptr) || (is_zero(lim_point,contextptr) && direction==1)) 2949 return makevecteur(1); 2950 if (is_strictly_positive(-lim_point,contextptr) || (is_zero(lim_point,contextptr) && direction==-1)) 2951 return makevecteur(-1); 2952 // FIXME? maybe add 2953 if (!is_zero(lim_point)) return makevecteur(symbolic(at_sign,lim_point)); 2954 return gensizeerr(gettext("Taylor sign with unsigned limit")); 2955 } 2956 _sign(const gen & g,GIAC_CONTEXT)2957 gen _sign(const gen & g,GIAC_CONTEXT){ 2958 if ( g.type==_STRNG && g.subtype==-1) return g; 2959 return apply(g,contextptr,sign); 2960 } 2961 // static symbolic symb_sign(const gen & e){ return symbolic(at_sign,e); } 2962 static const char _sign_s []="sign"; 2963 define_partial_derivative_onearg_genop( D_at_sign,"D_at_sign",_constant_zero); 2964 #ifdef GIAC_HAS_STO_38 2965 static define_unary_function_eval_taylor( __sign,_sign,(size_t)&D_at_signunary_function_ptr,&taylor_sign,_sign_s); 2966 #else 2967 static define_unary_function_eval_taylor( __sign,_sign,D_at_sign,&taylor_sign,_sign_s); 2968 #endif 2969 define_unary_function_ptr5( at_sign ,alias_at_sign,&__sign,0,true); 2970 _abs(const gen & args,GIAC_CONTEXT)2971 gen _abs(const gen & args,GIAC_CONTEXT){ 2972 if ( args.type==_STRNG && args.subtype==-1) return args; 2973 if (args.type!=_VECT) 2974 return abs(args,contextptr); 2975 if (ckmatrix(args)) 2976 return _l2norm(args,contextptr); 2977 if (args.subtype==_POINT__VECT || args.subtype==_GGBVECT) 2978 return _l2norm(args,contextptr); 2979 return apply(args,contextptr,abs); 2980 } symb_abs(const gen & e)2981 symbolic symb_abs(const gen & e){ 2982 return symbolic(at_abs,e); 2983 } taylor_abs(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)2984 static gen taylor_abs (const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 2985 if (ordre<0) 2986 return 0; // no symbolic preprocessing 2987 shift_coeff=0; 2988 if (is_strictly_positive(lim_point,contextptr) || (is_zero(lim_point,contextptr) && direction==1)) 2989 return makevecteur(lim_point,1); 2990 if (is_strictly_positive(-lim_point,contextptr) || (is_zero(lim_point,contextptr) && direction==-1)) 2991 return makevecteur(-lim_point,-1); 2992 return gensizeerr(gettext("Taylor abs with unsigned limit")); 2993 } 2994 static const char _abs_s []="abs"; d_abs(const gen & g,GIAC_CONTEXT)2995 static gen d_abs(const gen & g,GIAC_CONTEXT){ 2996 return symbolic(at_abs,g)/g; 2997 } 2998 define_partial_derivative_onearg_genop( D_at_abs,"D_at_abs",d_abs); 2999 #ifdef GIAC_HAS_STO_38 3000 static define_unary_function_eval_taylor_index(20, __abs,&_abs,(size_t)&D_at_absunary_function_ptr,&taylor_abs,_abs_s); 3001 #else 3002 static define_unary_function_eval_taylor_index(20, __abs,&_abs,D_at_abs,&taylor_abs,_abs_s); 3003 #endif 3004 define_unary_function_ptr5( at_abs ,alias_at_abs,&__abs,0,true); 3005 3006 // symbolic symb_arg(const gen & e){ return symbolic(at_arg,e); } 3007 static const char _arg_s []="arg"; 3008 define_unary_function_eval_index (22,__arg,&arg,_arg_s); 3009 define_unary_function_ptr5( at_arg ,alias_at_arg,&__arg,0,true); 3010 symb_cyclotomic(const gen & e)3011 static symbolic symb_cyclotomic(const gen & e){ 3012 return symbolic(at_cyclotomic,e); 3013 } _cyclotomic(const gen & a,GIAC_CONTEXT)3014 gen _cyclotomic(const gen & a,GIAC_CONTEXT){ 3015 if ( a.type==_STRNG && a.subtype==-1) return a; 3016 if (a.type==_VECT && a._VECTptr->size()==2 && a._VECTptr->front().type==_INT_) 3017 return symb_horner(cyclotomic(a._VECTptr->front().val),a._VECTptr->back()); 3018 if (a.type!=_INT_) 3019 return gentypeerr(contextptr); // symb_cyclotomic(a); 3020 return cyclotomic(a.val); 3021 } 3022 static const char _cyclotomic_s []="cyclotomic"; 3023 static define_unary_function_eval (__cyclotomic,&_cyclotomic,_cyclotomic_s); 3024 define_unary_function_ptr5( at_cyclotomic ,alias_at_cyclotomic,&__cyclotomic,0,true); 3025 printassto(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)3026 string printassto(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 3027 if ( (feuille.type!=_VECT) || (feuille._VECTptr->size()!=2) ) 3028 return string(sommetstr)+('('+feuille.print(contextptr)+')'); 3029 vecteur & v=*feuille._VECTptr; 3030 if (feuille.subtype==_SORTED__VECT && feuille._VECTptr->front().is_symb_of_sommet(at_program)){ 3031 gen prog=feuille._VECTptr->front()._SYMBptr->feuille; 3032 if (prog.type==_VECT && prog._VECTptr->size()==3 && (prog._VECTptr->front()!=_VECT || prog._VECTptr->front()._VECTptr->size()==2)){ 3033 gen val=prog._VECTptr->back(); 3034 gen arg=prog._VECTptr->front(); 3035 if (arg.type==_VECT && arg.subtype==_SEQ__VECT && arg._VECTptr->size()==1) 3036 arg=arg._VECTptr->front(); 3037 prog=symbolic(at_of,makesequence(feuille._VECTptr->back(),arg)); 3038 return printassto(gen(makevecteur(val,prog),_SORTED__VECT),sommetstr,contextptr); 3039 } 3040 } 3041 #if 0 3042 if (abs_calc_mode(contextptr)==38 && v.back().type!=_VECT){ 3043 string s=v.back().print(contextptr); 3044 if (s.size()>2 && s[0]=='1' && s[1]=='_') 3045 s=s.substr(1,s.size()-1); 3046 return v.front().print(contextptr)+(calc_mode(contextptr)==38?"\xe2\x96\xba":"=>")+s; 3047 } 3048 #endif 3049 if (xcas_mode(contextptr)==3){ 3050 if ( (v.front().type==_SYMB) && (v.front()._SYMBptr->sommet==at_program)){ 3051 gen & b=v.front()._SYMBptr->feuille._VECTptr->back(); 3052 if (b.type==_VECT || (b.type==_SYMB && (b._SYMBptr->sommet==at_local || b._SYMBptr->sommet==at_bloc))){ 3053 string s(v.front().print(contextptr)); 3054 s=s.substr(10,s.size()-10); 3055 return ":"+v.back().print(contextptr)+s; 3056 } 3057 else { 3058 vecteur & tmpv = *v.front()._SYMBptr->feuille._VECTptr; 3059 if (tmpv[0].type==_VECT && tmpv[0].subtype==_SEQ__VECT && tmpv[0]._VECTptr->size()==1) 3060 return tmpv[2].print(contextptr)+" => "+v.back().print(contextptr)+"("+tmpv[0]._VECTptr->front().print(contextptr)+")"; 3061 else 3062 return tmpv[2].print(contextptr)+" => "+v.back().print(contextptr)+"("+tmpv[0].print(contextptr)+")"; 3063 } 3064 } 3065 else 3066 return v.front().print(contextptr)+" => "+v.back().print(contextptr); 3067 } 3068 string stos=(python_compat(contextptr) && v.back().type!=_FUNC)?"=":":="; 3069 #ifndef GIAC_HAS_STO_38 3070 if (v.back().is_symb_of_sommet(at_of) && feuille.subtype!=_SORTED__VECT){ 3071 gen f=v.back()._SYMBptr->feuille; 3072 if (f.type==_VECT && f._VECTptr->size()==2){ 3073 return f._VECTptr->front().print(contextptr)+"[["+f._VECTptr->back().print(contextptr)+"]] "+stos+" "+ v.front().print(contextptr); 3074 } 3075 } 3076 #endif 3077 string s(v.back().print(contextptr)+stos); 3078 if (v.front().type==_SEQ__VECT) 3079 return s+"("+v.front().print(contextptr)+")"; 3080 else 3081 return s+v.front().print(contextptr); 3082 } texprintassto(const gen & g,const char * sommetstr,GIAC_CONTEXT)3083 static string texprintassto(const gen & g,const char * sommetstr,GIAC_CONTEXT){ 3084 if ( (g.type!=_VECT) || (g._VECTptr->size()!=2) ) 3085 return string(sommetstr)+('('+gen2tex(g,contextptr)+')'); 3086 string s(gen2tex(g._VECTptr->back(),contextptr)+":="); 3087 if (g._VECTptr->front().type==_SEQ__VECT) 3088 return s+"("+gen2tex(g._VECTptr->front(),contextptr)+")"; 3089 else 3090 return s+gen2tex(g._VECTptr->front(),contextptr); 3091 } 3092 _calc_mode(const gen & args,GIAC_CONTEXT)3093 gen _calc_mode(const gen & args,GIAC_CONTEXT){ 3094 if ( args.type==_STRNG && args.subtype==-1) return args; 3095 int & mode=calc_mode(contextptr); 3096 if (args.type==_INT_) 3097 mode=args.val; 3098 if (args.type==_DOUBLE_) 3099 mode=int(args._DOUBLE_val); 3100 if (args.type==_FLOAT_) 3101 mode=get_int(args._FLOAT_val); 3102 return mode; 3103 } 3104 static const char _calc_mode_s []="calc_mode"; 3105 static define_unary_function_eval (__calc_mode,&_calc_mode,_calc_mode_s); 3106 define_unary_function_ptr5( at_calc_mode ,alias_at_calc_mode,&__calc_mode,0,true); 3107 is_numericv(const vecteur & v,int withfracint)3108 bool is_numericv(const vecteur & v, int withfracint){ 3109 const_iterateur it=v.begin(),itend=v.end(); 3110 for (;it!=itend;++it){ 3111 if (it->type==_VECT || !is_fully_numeric(*it, withfracint)) 3112 return false; 3113 } 3114 return true; 3115 } is_numericm(const vecteur & v,int withfracint)3116 bool is_numericm(const vecteur & v, int withfracint){ 3117 const_iterateur it=v.begin(),itend=v.end(); 3118 for (;it!=itend;++it){ 3119 if (it->type!=_VECT || !is_numericv(*it->_VECTptr, withfracint)) 3120 return false; 3121 } 3122 return true; 3123 } 3124 check_vect_38(const string & s)3125 bool check_vect_38(const string & s){ 3126 int ss=int(s.size()); 3127 if (ss!=2) 3128 return false; 3129 char s0=s[0],s1=s[1]; 3130 if (s1<'0' || s1>'9') 3131 return false; 3132 switch (s0){ 3133 case 'M': case 'L': case 'D': case 'C': 3134 return true; 3135 } 3136 return false; 3137 } 3138 // check value type for storing value in s using 38 compatibility mode check_sto_38(gen & value,const char * s)3139 bool check_sto_38(gen & value,const char * s){ 3140 int ss=int(strlen(s)); 3141 if (ss>2 || (ss==2 && s[1]>32 && isalpha(s[1])) ){ 3142 if (s[0]=='G') 3143 return true; 3144 for (int i=0;i<ss;++i){ 3145 const char & ch=s[i]; 3146 if ( (ch>'Z' && ch!='i' && ch!='e')|| ch<'0') 3147 return true; 3148 } 3149 return false; 3150 } 3151 char s0=s[0],s1=s[1]; 3152 // a quick hack for R2(2) where R2 is COS(θ), done to help illustrate an issue 3153 // before hack: R2(2) in HOME gives COS(2); after: -0.416... 3154 // VariableGetFunc for R2(2) passes "(COS(θ))|θ=(2)" to Calc->Parse 3155 // perhaps a temporary variable instead of θ? 3156 // perhaps a move (of this code here) over the fence to Aspen? 3157 // TCalcData::LetterMemory(char const *utf8_name) can identify the names used 3158 if (ss==1 && s0>'Z') return true; 3159 if ( (ss==1 && s0<='Z') || (ss==2 && s0=='\xCE' && s1=='\xB8') ) { 3160 value=evalf(value,1,context0); 3161 return value.type==_DOUBLE_ || value.type==_FLOAT_; 3162 } 3163 if (s1>'9') 3164 return true; 3165 switch (s0){ 3166 case 'C': case 'L': 3167 if (value.type!=_VECT || (s0=='C' && !is_numericv(*value._VECTptr))) 3168 return false; 3169 value.subtype=_LIST__VECT; 3170 break; 3171 case 'F': case 'R': case 'U': case 'X': case 'Y': 3172 // if (!value.is_symb_of_sommet(at_program)) 3173 // return false; 3174 break; 3175 case 'M': 3176 value=evalf(value,1,context0); 3177 value.subtype=0; 3178 return (ckmatrix(value) && is_numericm(*value._VECTptr)) || (value.type==_VECT && is_numericv(*value._VECTptr)); 3179 case 'V': 3180 return false; // remove if V0..V9 is allowed 3181 //value=evalf(value,1,context0); 3182 //value.subtype=0; 3183 //return value.type==_VECT && is_numericv(*value._VECTptr); 3184 case 'Z': 3185 value=evalf(value,1,context0); 3186 return value.type==_DOUBLE_ || value.type==_FLOAT_ || value.type==_CPLX; 3187 } 3188 return true; 3189 } 3190 3191 #ifdef GIAC_HAS_STO_38 3192 bool do_storcl_38(gen & value,const char * name_space,const char * idname,gen indice,bool at_of,GIAC_CONTEXT, gen const *sto,bool OnlyLocal); 3193 bool (*storcl_38)(gen & value,const char * name_space,const char * idname,gen indice,bool at_of,GIAC_CONTEXT, gen const *sto,bool OnlyLocal)=do_storcl_38; 3194 #else 3195 bool (*storcl_38)(gen & value,const char * name_space,const char * idname,gen indice,bool at_of,GIAC_CONTEXT, gen const *sto,bool OnlyLocal)=0; 3196 #endif 3197 gen_op_context * interactive_op_tab = 0; 3198 int (*is_known_name_38)(const char * name_space,const char * idname)=0; // Not used anymore! 3199 gen (*of_pointer_38)(const void * appptr,const void * varptr,const gen & args)=0; 3200 3201 // store a in b 3202 #ifdef HAVE_SIGNAL_H_OLD 3203 bool signal_store=true; 3204 #endif 3205 is_local(const gen & b,GIAC_CONTEXT)3206 bool is_local(const gen & b,GIAC_CONTEXT){ 3207 if (b.type!=_IDNT) 3208 return false; 3209 if (contextptr){ 3210 const context * ptr=contextptr; 3211 for (;ptr->previous && ptr->tabptr;ptr=ptr->previous){ 3212 sym_tab::iterator it=ptr->tabptr->find(b._IDNTptr->id_name),itend=ptr->tabptr->end(); 3213 if (it!=itend) 3214 return true; 3215 } 3216 } 3217 return false; 3218 } 3219 in_stomap(gen_map & m,const gen & indice,const gen & a)3220 static bool in_stomap(gen_map & m,const gen & indice,const gen & a){ 3221 if (indice.is_symb_of_sommet(*at_interval) && indice._SYMBptr->feuille.type==_VECT && indice._SYMBptr->feuille._VECTptr->size()==2){ 3222 gen deb=indice._SYMBptr->feuille._VECTptr->front(); 3223 gen fin=indice._SYMBptr->feuille._VECTptr->back(); 3224 if (!is_integral(deb) || !is_integral(fin) || deb.type!=_INT_ || fin.type!=_INT_) 3225 return false; 3226 if (a.type==_VECT){ 3227 if (a._VECTptr->size()!=fin.val-deb.val+1) 3228 return false; 3229 for (int i=deb.val;i<=fin.val;++i) 3230 m[i]=(*a._VECTptr)[i-deb.val]; 3231 return true; 3232 } 3233 for (int i=deb.val;i<=fin.val;++i) 3234 m[i]=a; 3235 return true; 3236 } 3237 if (indice.type!=_VECT || indice._VECTptr->size()!=2){ 3238 m[indice]=a; 3239 return true; 3240 } 3241 gen ligne=indice._VECTptr->front(),col=indice._VECTptr->back(); 3242 if (ligne.is_symb_of_sommet(*at_interval) && ligne._SYMBptr->feuille.type==_VECT && ligne._SYMBptr->feuille._VECTptr->size()==2){ 3243 gen deb=ligne._SYMBptr->feuille._VECTptr->front(); 3244 gen fin=ligne._SYMBptr->feuille._VECTptr->back(); 3245 if (!is_integral(deb) || !is_integral(fin) || deb.type!=_INT_ || fin.type!=_INT_) 3246 return false; 3247 bool both=col.is_symb_of_sommet(*at_interval)&& col._SYMBptr->feuille.type==_VECT && col._SYMBptr->feuille._VECTptr->size()==2; 3248 int shift=0; 3249 if (both){ 3250 gen coldeb=col._SYMBptr->feuille._VECTptr->front(); 3251 gen colend=col._SYMBptr->feuille._VECTptr->back(); 3252 if (!is_integral(coldeb) || !is_integral(colend) || coldeb.type!=_INT_ || colend.type!=_INT_ || colend.val-coldeb.val!=fin.val-deb.val) 3253 return false; 3254 shift=coldeb.val-deb.val; 3255 } 3256 if (a.type==_VECT){ 3257 if (a._VECTptr->size()!=fin.val-deb.val+1) 3258 return false; 3259 if (both){ 3260 for (int i=deb.val;i<=fin.val;++i) 3261 m[makesequence(i,i+shift)]=(*a._VECTptr)[i-deb.val]; 3262 } 3263 else { 3264 for (int i=deb.val;i<=fin.val;++i) 3265 m[makesequence(i,col)]=(*a._VECTptr)[i-deb.val]; 3266 } 3267 return true; 3268 } 3269 if (both){ 3270 for (int i=deb.val;i<=fin.val;++i) 3271 m[makesequence(i,i+shift)]=a; 3272 } 3273 else { 3274 for (int i=deb.val;i<=fin.val;++i) 3275 m[makesequence(i,col)]=a; 3276 } 3277 return true; 3278 } 3279 if (col.is_symb_of_sommet(*at_interval)&& col._SYMBptr->feuille.type==_VECT && col._SYMBptr->feuille._VECTptr->size()==2){ 3280 gen deb=col._SYMBptr->feuille._VECTptr->front(); 3281 gen fin=col._SYMBptr->feuille._VECTptr->back(); 3282 if (!is_integral(deb) || !is_integral(fin) || deb.type!=_INT_ || fin.type!=_INT_) 3283 return false; 3284 if (a.type==_VECT){ 3285 if (a._VECTptr->size()!=fin.val-deb.val+1) 3286 return false; 3287 for (int i=deb.val;i<=fin.val;++i) 3288 m[makesequence(ligne,i)]=(*a._VECTptr)[i-deb.val]; 3289 return true; 3290 } 3291 for (int i=deb.val;i<=fin.val;++i) 3292 m[makesequence(ligne,i)]=a; 3293 return true; 3294 } 3295 m[indice]=a; 3296 return true; 3297 } 3298 stomap(gen_map & m,const gen & indice,const gen & a)3299 bool stomap(gen_map & m,const gen & indice,const gen & a){ 3300 if (!in_stomap(m,indice,a)) 3301 return false; 3302 if (need_sparse_trim(m)){ 3303 gen_map n; 3304 sparse_trim(m,n); 3305 m.swap(n); 3306 } 3307 return true; 3308 } 3309 sto(const gen & a,const gen & b,const context * contextptr)3310 gen sto(const gen & a,const gen & b,const context * contextptr){ 3311 return sto(a,b,false,contextptr); 3312 } 3313 // in_place==true to store in vector/matrices without making a new copy sto(const gen & a,const gen & b,bool in_place,const context * contextptr_)3314 gen sto(const gen & a,const gen & b,bool in_place,const context * contextptr_){ 3315 if (a.type==_STRNG && is_undef(a)) 3316 return a; 3317 if ( (a.type==_IDNT || a.is_symb_of_sommet(at_at)) && b.is_symb_of_sommet(at_rootof) && contextptr_){ 3318 if (!contextptr_->globalcontextptr->rootofs) 3319 contextptr_->globalcontextptr->rootofs=new vecteur; 3320 gen b_=eval(b,1,contextptr_); 3321 gen Pmin=b_._SYMBptr->feuille; 3322 if (Pmin.type!=_VECT || Pmin._VECTptr->size()!=2 || Pmin._VECTptr->front()!=makevecteur(1,0)) 3323 return gensizeerr(gettext("Bad rootof (in sto)")); 3324 Pmin=Pmin._VECTptr->back(); 3325 vecteur & r =*contextptr_->globalcontextptr->rootofs; 3326 for (unsigned i=0;i<r.size();++i){ 3327 gen ri=r[i]; 3328 if (ri.type==_VECT && ri._VECTptr->size()==2 && Pmin==ri._VECTptr->front()){ 3329 ri._VECTptr->back()=a; 3330 return sto(b,a,in_place,contextptr_); 3331 } 3332 } 3333 r.push_back(makevecteur(Pmin,a)); 3334 return sto(b_,a,in_place,contextptr_); 3335 } 3336 // *logptr(contextptr) << "Sto " << "->" << b << '\n'; 3337 const context * contextptr=contextptr_; 3338 if (contextptr && contextptr->parent) 3339 contextptr=contextptr->parent; 3340 if (b.type==_SYMB){ 3341 if (b.is_symb_of_sommet(at_unit)) 3342 return _convert(gen(makevecteur(a,b),_SEQ__VECT),contextptr); 3343 if (b._SYMBptr->sommet==at_hash && b._SYMBptr->feuille.type==_STRNG) 3344 return sto(a,gen(*b._SYMBptr->feuille._STRNGptr,contextptr),in_place,contextptr); 3345 if (b._SYMBptr->sommet==at_double_deux_points){ 3346 // variable of another named context? 3347 gen a1,bb,error; 3348 if (!check_binary(b._SYMBptr->feuille,a1,bb)) 3349 return a1; 3350 gen ret; 3351 if (storcl_38 && abs_calc_mode(contextptr)==38 && a1.type==_IDNT && bb.type==_IDNT && storcl_38(ret,a1._IDNTptr->id_name,bb._IDNTptr->id_name,undef,false,contextptr,&a,false)){ 3352 return ret; 3353 } 3354 #ifndef RTOS_THREADX 3355 #if !defined BESTA_OS && !defined NSPIRE && !defined FXCG && !defined KHICAS 3356 #ifdef HAVE_LIBPTHREAD 3357 pthread_mutex_lock(&context_list_mutex); 3358 #endif 3359 if (a1.type==_INT_ && a1.subtype==0 && a1.val>=0 && a1.val<(signed)context_list().size()){ 3360 context * ptr =context_list()[a1.val]; 3361 #ifdef HAVE_LIBPTHREAD 3362 pthread_mutex_unlock(&context_list_mutex); 3363 #endif 3364 return sto(a,bb,in_place,ptr); 3365 } 3366 if (context_names){ 3367 map<string,context *>::iterator it=context_names->find(a1.print()),itend=context_names->end(); 3368 if (it!=itend){ 3369 context * ptr = it->second; 3370 #ifdef HAVE_LIBPTHREAD 3371 pthread_mutex_unlock(&context_list_mutex); 3372 #endif 3373 return sto(a,bb,in_place,ptr); 3374 } 3375 } 3376 #ifdef HAVE_LIBPTHREAD 3377 pthread_mutex_unlock(&context_list_mutex); 3378 #endif 3379 #endif 3380 #endif 3381 // TI path 3382 gen ab=a1.eval(eval_level(contextptr),contextptr); 3383 if (ab.type==_VECT){ 3384 vecteur v=*ab._VECTptr; 3385 iterateur it=v.begin(),itend=v.end(); 3386 for (;it!=itend;++it){ 3387 if (it->type!=_VECT || it->_VECTptr->size()!=2) 3388 continue; 3389 vecteur & w=*it->_VECTptr; 3390 if (w[0]==bb) 3391 w[1]=a; 3392 } 3393 if (it==itend) 3394 v.push_back(makevecteur(bb,a)); 3395 return sto(gen(v,_FOLDER__VECT),a1,in_place,contextptr); 3396 } 3397 if (a1.type==_IDNT) 3398 return sto(gen(vecteur(1,makevecteur(bb,a)),_FOLDER__VECT),a1,in_place,contextptr); 3399 } // end TI path 3400 } 3401 if (b.type==_IDNT){ 3402 // typed variable name must end with _d (double) or _i (int) 3403 const char * name=b._IDNTptr->id_name; 3404 int bl=int(strlen(name)); 3405 if (bl==1){ 3406 if (name[0]=='O' && (series_flags(contextptr) & (1<<6)) ) 3407 series_flags(contextptr) ^= (1<<6); 3408 if (name[0]==series_variable_name(contextptr)){ 3409 if (series_flags(contextptr) & (1<<5)) 3410 series_flags(contextptr) ^= (1<<5); 3411 if (series_flags(contextptr) & (1<<6)) 3412 series_flags(contextptr) ^= (1<<6); 3413 } 3414 } 3415 if (bl>=3){ 3416 if (name[bl-2]=='_'){ 3417 switch (name[bl-1]){ 3418 case 'd': 3419 if (a.type!=_INT_ && a.type!=_DOUBLE_ && a.type!=_FRAC) 3420 return gensizeerr(gettext("Unable to convert to float (in sto) ")+a.print(contextptr)); 3421 break; 3422 case 'f': 3423 if (a.type==_FRAC) 3424 break; 3425 case 'i': case 'l': 3426 if (a.type==_DOUBLE_ && a._DOUBLE_val<=RAND_MAX && a._DOUBLE_val>=-RAND_MAX){ 3427 int i=int(a._DOUBLE_val); 3428 if (i!=a._DOUBLE_val) 3429 *logptr(contextptr) << gettext("Converting ") << a._DOUBLE_val << gettext(" to integer ") << i << '\n'; 3430 return sto(i,b,in_place,contextptr); 3431 } 3432 if (a.type!=_INT_){ 3433 if (a.type!=_ZINT || mpz_sizeinbase(*a._ZINTptr,2)>62) 3434 return gensizeerr(gettext("Unable to convert to integer (in sto) ")+a.print(contextptr)); 3435 } 3436 break; 3437 case 'v': 3438 if (a.type!=_VECT) 3439 return gensizeerr(gettext("Unable to convert to vector (in sto) ")+a.print(contextptr)); 3440 break; 3441 case 's': 3442 if (a.type!=_STRNG) 3443 return sto(string2gen(a.print(contextptr),false),b,in_place,contextptr); 3444 break; 3445 } 3446 } 3447 } 3448 if (!contextptr){ 3449 // Remove stale local assignements 3450 #ifdef NO_STDEXCEPT 3451 b._IDNTptr->eval(1,b,contextptr); 3452 #else 3453 try { 3454 b._IDNTptr->eval(1,b,contextptr); 3455 } catch (std::runtime_error & ) { 3456 last_evaled_argptr(contextptr)=NULL; 3457 } 3458 #endif 3459 } 3460 gen aa(a); 3461 if (strcmp(name,string_pi)==0 || strcmp(name,string_infinity)==0 || strcmp(name,string_undef)==0 3462 #ifdef GIAC_HAS_STO_38 3463 || name[0]=='_' 3464 #endif 3465 ) 3466 return gensizeerr(b.print(contextptr)+": reserved word (in sto)"); 3467 if (a.type==_IDNT && a==b) 3468 return purgenoassume(b,contextptr); 3469 gen ans(aa); 3470 if ( (a.type==_SYMB) && (a._SYMBptr->sommet==at_parameter)){ 3471 gen inter=a._SYMBptr->feuille,debut,fin,saut; 3472 bool calc_aa=false; 3473 if (inter.type==_VECT){ 3474 vecteur & interv=*inter._VECTptr; 3475 int inters=int(interv.size()); 3476 if (inters>=3){ 3477 debut=interv[0]; 3478 fin=interv[1]; 3479 if (is_strictly_greater(debut,fin,contextptr)) 3480 swapgen(debut,fin); 3481 aa=interv[2]; 3482 if (is_strictly_greater(aa,fin,contextptr)) 3483 aa=fin; 3484 if (is_strictly_greater(debut,aa,contextptr)) 3485 aa=debut; 3486 if (inters>=4) 3487 saut=interv[3]; 3488 } 3489 if (inters==2){ 3490 aa=interv.back(); 3491 inter=interv.front(); 3492 } 3493 } 3494 else 3495 calc_aa=true; 3496 if ( (inter.type==_SYMB) && (inter._SYMBptr->sommet==at_interval) ){ 3497 debut=inter._SYMBptr->feuille._VECTptr->front(); 3498 fin=inter._SYMBptr->feuille._VECTptr->back(); 3499 } 3500 if (calc_aa) 3501 aa=rdiv(debut+fin,plus_two,contextptr); 3502 if (is_zero(saut,contextptr)) 3503 saut=(fin-debut)/100.; 3504 ans=symbolic(at_parameter,makesequence(b,debut,fin,aa,saut)); 3505 } // end parameter 3506 if (abs_calc_mode(contextptr)==38){ 3507 if (storcl_38 && storcl_38(ans,0,name,undef,false,contextptr,&aa,false) ) 3508 return ans; 3509 } 3510 if (b._IDNTptr->quoted) 3511 *b._IDNTptr->quoted |= 2; // set dirty bit 3512 if (contextptr){ 3513 const context * ptr=contextptr; 3514 bool done=false; 3515 for (;ptr->previous && ptr->tabptr;ptr=ptr->previous){ 3516 sym_tab::iterator it=ptr->tabptr->find(name),itend=ptr->tabptr->end(); 3517 if (it!=itend){ // found in current local context 3518 // check that the current value is a thread pointer 3519 if (it->second.type==_POINTER_ && it->second.subtype==_THREAD_POINTER){ 3520 if (it->second._POINTER_val!=(void *)contextptr_) 3521 return gentypeerr(b.print(contextptr)+gettext(" is locked by thread (in sto) ")+it->second.print(contextptr)); 3522 } 3523 it->second=aa; 3524 done=true; 3525 break; 3526 } 3527 } 3528 if (!done) {// store b globally 3529 if (contains(lidnt(a),b)){ 3530 if (a.is_symb_of_sommet(at_when) || a.is_symb_of_sommet(at_ifte) || a.is_symb_of_sommet(at_program)) 3531 *logptr(contextptr) << b.print(contextptr)+gettext(": recursive definition") << '\n'; 3532 else 3533 return gensizeerr(b.print(contextptr)+gettext(": recursive definition (in sto) ")); 3534 } 3535 sym_tab * symtabptr=contextptr->globalcontextptr?contextptr->globalcontextptr->tabptr:contextptr->tabptr; 3536 sym_tab::iterator it=symtabptr->find(name),itend=symtabptr->end(); 3537 if (it!=itend){ 3538 // check that the current value is a thread pointer 3539 if (it->second.type==_POINTER_ && it->second.subtype==_THREAD_POINTER){ 3540 if (it->second._POINTER_val!=(void *)contextptr_) 3541 return gentypeerr(b.print(contextptr)+gettext(" is locked by thread (in sto) ")+it->second.print(contextptr)); 3542 } 3543 it->second=aa; 3544 } 3545 else 3546 (*symtabptr)[name]=aa; 3547 } 3548 #ifdef HAVE_SIGNAL_H_OLD 3549 if (!child_id && signal_store) 3550 _signal(symb_quote(symbolic(at_sto,gen(makevecteur(aa,b),_SEQ__VECT))),contextptr); 3551 #endif 3552 return ans; 3553 } // end if (contextptr) 3554 if (contains(lidnt(a),b)){ 3555 if (a.is_symb_of_sommet(at_when) || a.is_symb_of_sommet(at_ifte) || a.is_symb_of_sommet(at_program)) 3556 *logptr(contextptr) << b.print(contextptr)+gettext(": recursive definition") << '\n'; 3557 else 3558 return gensizeerr(b.print(contextptr)+gettext(": recursive definition (in sto) ")); 3559 } 3560 if (b._IDNTptr->localvalue && !b._IDNTptr->localvalue->empty() && (b.subtype!=_GLOBAL__EVAL)) 3561 b._IDNTptr->localvalue->back()=aa; 3562 else { 3563 if (current_folder_name.type==_IDNT && current_folder_name._IDNTptr->value && current_folder_name._IDNTptr->value->type==_VECT){ 3564 vecteur v=*current_folder_name._IDNTptr->value->_VECTptr; 3565 iterateur it=v.begin(),itend=v.end(); 3566 for (;it!=itend;++it){ 3567 if (it->type!=_VECT || it->_VECTptr->size()!=2) 3568 continue; 3569 vecteur & w=*it->_VECTptr; 3570 if (w[0]==b){ 3571 w[1]=aa; 3572 break; 3573 } 3574 } 3575 if (it==itend) 3576 v.push_back(makevecteur(b,aa)); 3577 gen gv(v,_FOLDER__VECT); 3578 *current_folder_name._IDNTptr->value=gv; 3579 #ifdef HAVE_SIGNAL_H_OLD 3580 if (!child_id && signal_store) 3581 _signal(symb_quote(symbolic(at_sto,gen(makevecteur(gv,current_folder_name),_SEQ__VECT))),contextptr); 3582 #endif 3583 return ans; 3584 } 3585 else { 3586 if (b._IDNTptr->value) 3587 delete b._IDNTptr->value; 3588 if (b._IDNTptr->ref_count) 3589 b._IDNTptr->value = new gen(aa); 3590 #ifdef HAVE_SIGNAL_H_OLD 3591 if (!child_id && signal_store) 3592 _signal(symb_quote(symbolic(at_sto,gen(makevecteur(aa,b),_SEQ__VECT))),contextptr); 3593 #endif 3594 #if !defined NSPIRE && !defined FXCG && !defined GIAC_HAS_STO_38 3595 if (!secure_run && variables_are_files(contextptr)){ 3596 ofstream a_out((b._IDNTptr->name()+string(cas_suffixe)).c_str()); 3597 a_out << aa << '\n'; 3598 } 3599 #endif 3600 } 3601 } 3602 return ans; 3603 } // end b.type==_IDNT 3604 if (b.type==_VECT){ 3605 if (a.type!=_VECT) 3606 return gentypeerr(contextptr); 3607 return apply(a,b,contextptr,sto); 3608 } 3609 if ( (b.type==_SYMB) && (b._SYMBptr->sommet==at_at || b._SYMBptr->sommet==at_of) ){ 3610 // Store a in a vector or array or map 3611 gen destination=b._SYMBptr->feuille._VECTptr->front(),error; // variable name 3612 if (destination.is_symb_of_sommet(at_at) && b._SYMBptr->sommet==at_at){ 3613 destination=symbolic(at_at,makesequence(destination._SYMBptr->feuille[0],makesequence(destination._SYMBptr->feuille[1],b._SYMBptr->feuille._VECTptr->back()))); 3614 return sto(a,destination,in_place,contextptr); 3615 } 3616 // if (sto_38 && destination.is_symb_of_sommet(at_double_deux_points) && destination._SYMBptr->feuille.type==_VECT && destination._SYMBptr->feuille._VECTptr->size()==2 &&destination._SYMBptr->feuille._VECTptr->front().type==_IDNT && destination._SYMBptr->feuille._VECTptr->back().type==_IDNT && sto_38(a,destination._SYMBptr->feuille._VECTptr->front()._IDNTptr->id_name,destination._SYMBptr->feuille._VECTptr->back()._IDNTptr->id_name,b,error,contextptr)) 3617 // return is_undef(error)?error:a; 3618 gen ret; 3619 if (storcl_38 && destination.type==_IDNT && storcl_38(ret,0,destination._IDNTptr->id_name,b,true,contextptr,&a,false)) 3620 return ret; 3621 if (destination.type==_IDNT && destination._IDNTptr->quoted) 3622 *destination._IDNTptr->quoted |= 2; // set dirty bit 3623 gen valeur; 3624 if (!contextptr && in_place && destination.type==_IDNT && destination._IDNTptr->localvalue && !destination._IDNTptr->localvalue->empty() && local_eval(contextptr) ) 3625 valeur=do_local_eval(*destination._IDNTptr,eval_level(contextptr),false); 3626 else 3627 valeur=destination.eval(in_place?1:eval_level(contextptr),contextptr); 3628 if ( valeur.type==_INT_ && valeur.val==0 && destination.type==_IDNT && destination._IDNTptr->localvalue && !destination._IDNTptr->localvalue->empty() ) 3629 valeur=destination; // non (0) initialized local var 3630 gen indice=b._SYMBptr->feuille._VECTptr->back().eval(eval_level(contextptr),contextptr); 3631 if (indice.type==_VECT && indice.subtype==_SEQ__VECT && indice._VECTptr->size()==1) 3632 indice=indice._VECTptr->front(); 3633 is_integral(indice); 3634 if (b._SYMBptr->sommet==at_of && valeur.type==_VECT && (1 || abs_calc_mode(contextptr)==38)){ // matrices and vector indices in HP38 compatibility mode 3635 if (indice.type==_INT_) 3636 indice -= 1; 3637 if (indice.type==_VECT) 3638 indice = indice - vecteur(indice._VECTptr->size(),1); 3639 } 3640 if ( (destination.type!=_IDNT && !destination.is_symb_of_sommet(at_double_deux_points)) || (valeur.type!=_VECT && valeur.type!=_MAP && valeur.type!=_IDNT && valeur.type!=_STRNG && valeur.type!=_SYMB) ){ 3641 string endstring=" not allowed."; 3642 if (b.is_symb_of_sommet(at_at)) 3643 endstring += " Run purge if you want to create a sparse matrix in "+b[1].print(contextptr)+"."; 3644 return gentypeerr(gettext("sto ")+b.print(contextptr)+ ":="+valeur.print(contextptr)+endstring); 3645 } 3646 if (valeur.type==_IDNT){ 3647 // no previous vector at destination, 3648 // create one in TI mode or create a map 3649 gen g; 3650 if (xcas_mode(contextptr)==3 && indice.type==_INT_ && indice.val>=0 ){ 3651 vecteur v(indice.val+1,zero); 3652 v[indice.val]=a; 3653 g=gen(v,destination.subtype); 3654 } 3655 else { 3656 g=makemap(); 3657 if (!stomap(*g._MAPptr,indice,a)) 3658 return gendimerr(contextptr); // (*g._MAPptr)[indice]=a; 3659 } 3660 return sto(g,destination,in_place,contextptr); 3661 } 3662 if (valeur.type==_STRNG){ 3663 bool indicedeuxpoints=indice.is_symb_of_sommet(*at_deuxpoints); 3664 if ( (indice.is_symb_of_sommet(*at_interval) || indicedeuxpoints)&& indice._SYMBptr->feuille.type==_VECT && indice._SYMBptr->feuille._VECTptr->size()==2){ 3665 gen deb=indice._SYMBptr->feuille._VECTptr->front(); 3666 gen fin=indice._SYMBptr->feuille._VECTptr->back()+(indicedeuxpoints?minus_one:zero); 3667 if (!is_integral(deb) || !is_integral(fin) || deb.type!=_INT_ || fin.type!=_INT_ || a.type!=_STRNG) 3668 return gendimerr(); 3669 int d=deb.val,f=fin.val; 3670 if (!in_place) 3671 valeur=string2gen(*valeur._STRNGptr,false); 3672 string & vs=*valeur._STRNGptr; 3673 string *as=a._STRNGptr; 3674 if (d<0) d+=vs.size(); 3675 if (f<0) f+=vs.size(); 3676 if (d<0 || d>f || f>=vs.size() || f<0 || f-d>=as->size()) 3677 return gendimerr(contextptr); 3678 for (int i=d;i<=f;++i){ 3679 vs[i]=(*as)[i-d]; 3680 } 3681 if (in_place) 3682 return string2gen("Done",false); 3683 return sto(valeur,destination,in_place,contextptr); 3684 } 3685 if (indice.type!=_INT_ || a.type!=_STRNG || a._STRNGptr->empty()) 3686 return gensizeerr(contextptr); 3687 if (indice.val<0) indice+=(int) valeur._STRNGptr->size(); 3688 if (indice.val<0 || indice.val>=(int) valeur._STRNGptr->size()) 3689 return gendimerr(contextptr); 3690 if (in_place){ 3691 (*valeur._STRNGptr)[indice.val]=(*a._STRNGptr)[0]; 3692 return string2gen("Done",false); 3693 } 3694 else { 3695 string m(*valeur._STRNGptr); 3696 m[indice.val]=(*a._STRNGptr)[0]; 3697 return sto(string2gen(m,false),destination,in_place,contextptr); 3698 } 3699 } 3700 if (valeur.type==_SYMB){ 3701 if (indice.type==_VECT){ 3702 gen v(valeur); 3703 vecteur empile; 3704 iterateur it=indice._VECTptr->begin(),itend=indice._VECTptr->end(); 3705 for (;;){ 3706 if (it->type!=_INT_) 3707 return gentypeerr(gettext("Bad index (in sto) ")+indice.print(contextptr)); 3708 empile.push_back(v); 3709 v=v[*it]; 3710 ++it; 3711 if (it==itend) 3712 break; 3713 } 3714 --itend; 3715 v=empile.back(); 3716 if (v.type==_VECT){ 3717 vecteur vv=*v._VECTptr; 3718 if (itend->val>=0&&itend->val<int(vv.size())) // additional check 3719 vv[itend->val]=a; 3720 v=gen(vv,v.subtype); 3721 } 3722 else { 3723 if (v.type==_SYMB){ 3724 if (itend->val==0){ 3725 if (a.type==_FUNC) 3726 v=symbolic(*a._FUNCptr,v._SYMBptr->feuille); 3727 else 3728 v=symbolic(at_of,makesequence(a,v._SYMBptr->feuille)); 3729 } 3730 else { 3731 if (v._SYMBptr->feuille.type!=_VECT) 3732 v=symbolic(v._SYMBptr->sommet,a); 3733 else { 3734 vecteur vv=*v._SYMBptr->feuille._VECTptr; 3735 if (itend->val>0&&itend->val<=int(vv.size())) // additional check 3736 vv[itend->val-1]=a; 3737 v=symbolic(v._SYMBptr->sommet,gen(vv,v._SYMBptr->feuille.subtype)); 3738 } 3739 } 3740 } 3741 else 3742 v=a; 3743 } 3744 gen oldv; 3745 it=indice._VECTptr->begin(); 3746 for (;;){ 3747 if (itend==it) 3748 break; 3749 --itend; 3750 empile.pop_back(); 3751 oldv=empile.back(); 3752 if (oldv.type==_VECT){ 3753 vecteur vv=*oldv._VECTptr; 3754 if (itend->val>=0&&itend->val<int(vv.size())) // additional check 3755 vv[itend->val]=v; 3756 v=gen(vv,oldv.subtype); 3757 } 3758 else { 3759 if (oldv.type==_SYMB){ 3760 if (oldv._SYMBptr->feuille.type!=_VECT) // index should be 1 3761 v=symbolic(oldv._SYMBptr->sommet,v); 3762 else { 3763 vecteur vv=*oldv._SYMBptr->feuille._VECTptr; 3764 if (itend->val>0 && itend->val<=int(vv.size())) // additional check 3765 vv[itend->val-1]=v; 3766 v=symbolic(oldv._SYMBptr->sommet,gen(vv,oldv._SYMBptr->feuille.subtype)); 3767 } 3768 } 3769 } // end else oldv.type==_VECT 3770 } // end for loop 3771 return sto(v,destination,in_place,contextptr); 3772 } 3773 if (indice.type!=_INT_) 3774 return gensizeerr(contextptr); 3775 if (indice.val<0 || indice.val>(int) gen2vecteur(valeur._SYMBptr->feuille).size()) 3776 return gendimerr(contextptr); 3777 gen nvaleur; 3778 if (indice.val==0){ 3779 if (a.type==_FUNC) 3780 nvaleur=symbolic(*a._FUNCptr,valeur._SYMBptr->feuille); 3781 else 3782 nvaleur=symbolic(at_of,makesequence(a,valeur._SYMBptr->feuille)); 3783 } 3784 else { 3785 nvaleur=valeur._SYMBptr->feuille; 3786 if (indice==1 && nvaleur.type!=_VECT) 3787 nvaleur=a; 3788 else { 3789 nvaleur=gen(*nvaleur._VECTptr,nvaleur.subtype); 3790 (*nvaleur._VECTptr)[indice.val-1]=a; 3791 } 3792 nvaleur=symbolic(valeur._SYMBptr->sommet,nvaleur); 3793 } 3794 return sto(nvaleur,destination,in_place,contextptr); 3795 } // end valeur.type==_SYMB 3796 if (valeur.type==_MAP){ 3797 if (valeur.subtype==1){ // array 3798 gen_map::iterator it=valeur._MAPptr->find(indice),itend=valeur._MAPptr->end(); 3799 if (it==itend) 3800 return gendimerr(gettext("Index outside of range (in sto) ")); 3801 if (xcas_mode(contextptr)==1) 3802 in_place=true; 3803 } 3804 if (in_place){ 3805 if (!stomap(*valeur._MAPptr,indice,a)) 3806 return gendimerr(contextptr);// (*valeur._MAPptr)[indice]=a; 3807 return string2gen("Done",false); 3808 } 3809 else { 3810 gen_map m(*valeur._MAPptr); 3811 if (!stomap(m,indice,a)) 3812 return gendimerr(contextptr);// m[indice]=a; 3813 return sto(m,destination,in_place,contextptr); 3814 } 3815 } // valeur.type==_MAP 3816 vecteur * vptr=0; 3817 vecteur v; 3818 if (in_place) 3819 vptr=valeur._VECTptr; 3820 else { 3821 v=*valeur._VECTptr; 3822 vptr=&v; 3823 } 3824 bool indicedeuxpoints=indice.is_symb_of_sommet(*at_deuxpoints); 3825 if ( (indice.is_symb_of_sommet(*at_interval) || indicedeuxpoints)&& indice._SYMBptr->feuille.type==_VECT && indice._SYMBptr->feuille._VECTptr->size()==2){ 3826 gen deb=indice._SYMBptr->feuille._VECTptr->front(); 3827 gen fin=indice._SYMBptr->feuille._VECTptr->back()+(indicedeuxpoints?minus_one:zero); 3828 if (!is_integral(deb) || !is_integral(fin) || deb.type!=_INT_ || fin.type!=_INT_ || fin.val>=LIST_SIZE_LIMIT) 3829 return gendimerr(); 3830 if (deb.val<0) deb.val+=int(vptr->size()); 3831 if (fin.val<0) fin.val+=int(vptr->size()); 3832 if (deb.val<0 || fin.val<0 || deb.val>fin.val) 3833 return gendimerr(); 3834 if (a.type==_VECT && a._VECTptr->size()!=fin.val-deb.val+1) 3835 return gendimerr(contextptr); 3836 int is=int(in_place?vptr->size():v.size()); 3837 for (;is<=fin.val;++is){ 3838 vptr->push_back(zero); 3839 } 3840 if (a.type==_VECT){ 3841 for (int i=deb.val;i<=fin.val;++i) 3842 (*vptr)[i]=(*a._VECTptr)[i-deb.val]; 3843 } 3844 else { 3845 for (int i=deb.val;i<=fin.val;++i) 3846 (*vptr)[i]=a; 3847 } 3848 if (in_place) 3849 return valeur; // string2gen("Done",false); 3850 return sto(gen(v,valeur.subtype),destination,in_place,contextptr); 3851 } 3852 if (indice.type!=_VECT){ 3853 if (indice.type==_INT_ && indice.val<0) 3854 indice += int(vptr->size()); 3855 if (indice.type!=_INT_ || indice.val<0 || indice.val>=LIST_SIZE_LIMIT) 3856 return gentypeerr(gettext("Bad index (in sto) ")+indice.print(contextptr)); 3857 // check size 3858 int is=int(vptr->size()); 3859 for (;is<=indice.val;++is){ 3860 vptr->push_back(zero); 3861 } 3862 // change indice's value 3863 (*vptr)[indice.val]=a; 3864 if (in_place) 3865 return valeur; // string2gen("Done",false); 3866 return sto(gen(v,valeur.subtype),destination,in_place,contextptr); 3867 } 3868 // here indice is of type _VECT, we store inside a matrix 3869 vecteur empile; 3870 iterateur it=indice._VECTptr->begin(),itend=indice._VECTptr->end(); 3871 if (itend-it==2){ 3872 gen i2=*(it+1); 3873 bool itdeuxpoints=it->is_symb_of_sommet(*at_deuxpoints); 3874 if ( (it->is_symb_of_sommet(*at_interval) || itdeuxpoints ) && it->_SYMBptr->feuille.type==_VECT && it->_SYMBptr->feuille._VECTptr->size()==2){ 3875 gen deb=it->_SYMBptr->feuille._VECTptr->front(); 3876 gen fin=it->_SYMBptr->feuille._VECTptr->back()+(itdeuxpoints?minus_one:zero); 3877 if (!is_integral(deb) || !is_integral(fin) || deb.type!=_INT_ || fin.type!=_INT_ ) 3878 return gendimerr(contextptr); 3879 if (deb.val<0) deb.val+=int(vptr->size()); 3880 if (fin.val<0) fin.val+=int(vptr->size()); 3881 if (deb.val<0 || fin.val<0 || deb.val>fin.val || fin.val>LIST_SIZE_LIMIT) 3882 return gendimerr(contextptr); 3883 if (a.type==_VECT && a._VECTptr->size()!=fin.val-deb.val+1) 3884 return gendimerr(contextptr); 3885 if (!ckmatrix(*vptr)) 3886 return gendimerr(contextptr); 3887 gen add=zero*vptr->front(); 3888 int is=int(vptr->size()); 3889 int cols=int(vptr->front()._VECTptr->size()); 3890 for (;is<=fin.val;++is){ 3891 vptr->push_back(add); 3892 } 3893 if (!in_place){ 3894 for (int i=deb.val;i<=fin.val;++i) 3895 (*vptr)[i]=*(*vptr)[i]._VECTptr; 3896 } 3897 bool i2deuxpoints=i2.is_symb_of_sommet(*at_deuxpoints); 3898 if ( (i2.is_symb_of_sommet(*at_interval) || i2deuxpoints) && i2._SYMBptr->feuille.type==_VECT && i2._SYMBptr->feuille._VECTptr->size()==2){ 3899 gen deb2=i2._SYMBptr->feuille._VECTptr->front(); 3900 gen fin2=i2._SYMBptr->feuille._VECTptr->back()+(i2deuxpoints?minus_one:zero); 3901 if (!is_integral(deb2) || !is_integral(fin2) || deb2.type!=_INT_ || fin2.type!=_INT_) 3902 return gendimerr(contextptr); 3903 if (deb2.val<0) deb2.val+=cols; 3904 if (fin2.val<0) fin2.val+=cols; 3905 if (deb2.val<0 || fin2.val<0 || fin2.val>=cols ) 3906 return gendimerr(contextptr); 3907 if (ckmatrix(a)){ 3908 if (fin2.val-deb2.val+1!=a._VECTptr->front()._VECTptr->size()) 3909 return gendimerr(contextptr); 3910 for (int i=deb.val;i<=fin.val;++i){ 3911 vecteur & target=*(*vptr)[i]._VECTptr; 3912 const vecteur & source=*(*a._VECTptr)[i-deb.val]._VECTptr; 3913 if (target.size()<=fin2.val) 3914 target.resize(fin2.val+1); 3915 for (int j=deb2.val;j<=fin2.val;++j){ 3916 target[j]=source[j-deb2.val]; 3917 } 3918 } 3919 if (in_place) 3920 return valeur; // string2gen("Done",false); 3921 return sto(gen(v,valeur.subtype),destination,in_place,contextptr); 3922 } 3923 if (fin2.val-deb2.val!=fin.val-deb.val) 3924 return gendimerr(contextptr); 3925 int shift=deb2.val-deb.val; 3926 if (a.type==_VECT){ 3927 for (int i=deb.val;i<=fin.val;++i) 3928 (*(*vptr)[i]._VECTptr)[i+shift]=(*a._VECTptr)[i-deb.val]; 3929 } 3930 else { 3931 for (int i=deb.val;i<=fin.val;++i) 3932 (*(*vptr)[i]._VECTptr)[i+shift]=a; 3933 } 3934 } 3935 else { 3936 if (i2.type==_INT_ && i2.val<0) i2.val += cols; 3937 if (i2.type!=_INT_ || i2.val<0 || i2.val>=cols) 3938 return gendimerr(contextptr); 3939 if (a.type==_VECT){ 3940 for (int i=deb.val;i<=fin.val;++i) 3941 (*(*vptr)[i]._VECTptr)[i2.val]=(*a._VECTptr)[i-deb.val]; 3942 } 3943 else { 3944 for (int i=deb.val;i<=fin.val;++i) 3945 (*(*vptr)[i]._VECTptr)[i2.val]=a; 3946 } 3947 } 3948 if (in_place) 3949 return valeur; // string2gen("Done",false); 3950 return sto(gen(v,valeur.subtype),destination,in_place,contextptr); 3951 } // end first value interval 3952 if (it->type==_INT_ && it->val<0) it->val += vptr->size(); 3953 if (it->type!=_INT_ || it->val<0) 3954 return gentypeerr(gettext("Bad index (in sto) ")+indice.print(contextptr)); 3955 int i1=it->val; 3956 bool i2deuxpoints=i2.is_symb_of_sommet(*at_deuxpoints); 3957 if ( (i2.is_symb_of_sommet(*at_interval) || i2deuxpoints) && i2._SYMBptr->feuille.type==_VECT && i2._SYMBptr->feuille._VECTptr->size()==2){ 3958 if (!ckmatrix(*vptr)) 3959 return gendimerr(contextptr); 3960 if (!in_place) 3961 (*vptr)[i1]=*(*vptr)[i1]._VECTptr; 3962 gen deb2=i2._SYMBptr->feuille._VECTptr->front(); 3963 gen fin2=i2._SYMBptr->feuille._VECTptr->back()+(i2deuxpoints?minus_one:zero); 3964 if (!is_integral(deb2) || !is_integral(fin2) || deb2.type!=_INT_ || fin2.type!=_INT_ ) 3965 return gendimerr(contextptr); 3966 if (deb2.val<0) deb2.val += int(vptr->front()._VECTptr->size()); 3967 if (fin2.val<0) fin2.val += int(vptr->front()._VECTptr->size()); 3968 if (deb2.val<0 || fin2.val <deb2.val || fin2.val>=int(vptr->front()._VECTptr->size())) 3969 return gendimerr(contextptr); 3970 if (a.type==_VECT){ 3971 for (int i=deb2.val;i<=fin2.val;++i) 3972 (*(*vptr)[i1]._VECTptr)[i]=(*a._VECTptr)[i-deb2.val]; 3973 } 3974 else { 3975 for (int i=deb2.val;i<=fin2.val;++i) 3976 (*(*vptr)[i1]._VECTptr)[i]=a; 3977 } 3978 if (in_place) 3979 return valeur; // string2gen("Done",false); 3980 return sto(gen(v,valeur.subtype),destination,in_place,contextptr); 3981 } 3982 } // end itend-it==2 3983 for (;;){ 3984 if (it->type!=_INT_) 3985 return gentypeerr(gettext("Bad index (in sto) ")+indice.print(contextptr)); 3986 if (!in_place) 3987 empile.push_back(v); 3988 gen tmp; 3989 if (in_place){ 3990 if (it->val<0) it->val += (int)(vptr->size()); 3991 if (it->val<0 || it->val>= (int)(vptr->size()) ) 3992 return gendimerr(contextptr); 3993 tmp=(*vptr)[it->val]; 3994 } 3995 else { 3996 if (it->val<0) it->val += (int)(v.size()); 3997 if ( it->val<0 || it->val>= (int)(v.size()) ) 3998 return gendimerr(contextptr); 3999 tmp=v[it->val]; 4000 } 4001 ++it; 4002 if (it==itend) 4003 break; 4004 if (tmp.type!=_VECT) 4005 return gentypeerr(gettext("Bad index (in sto) ")+indice.print(contextptr)); 4006 if (in_place) 4007 vptr= tmp._VECTptr; 4008 else 4009 v=*tmp._VECTptr; 4010 } 4011 --itend; 4012 if (in_place){ 4013 (*vptr)[itend->val]=a; 4014 return valeur; // string2gen("Done",false); 4015 } 4016 v[itend->val]=a; 4017 vecteur oldv; 4018 it=indice._VECTptr->begin(); 4019 for (;;){ 4020 if (itend==it) 4021 break; 4022 --itend; 4023 empile.pop_back(); 4024 oldv=*(empile.back()._VECTptr); 4025 oldv[itend->val]=v; 4026 v=oldv; 4027 } 4028 return sto(v,destination,in_place,contextptr); 4029 } 4030 if (b.type==_FUNC){ 4031 if (b==at_of || b==at_index){ // shortcut for python_compat(0 or 1): of:=1 or 0 4032 if (a==0) {// index start 0 -> enable python compat 4033 python_compat(1,contextptr); 4034 return string2gen("[] index start 0",false); 4035 } 4036 if (a==1) { // index start 1 -> disable python compat 4037 python_compat(0,contextptr); 4038 return string2gen("[] index start 1",false); 4039 } 4040 } 4041 string errmsg=b.print(contextptr)+ gettext(" is a reserved word, sto not allowed: ")+a.print(contextptr); 4042 if (abs_calc_mode(contextptr)!=38) 4043 *logptr(contextptr) << errmsg << '\n'; 4044 return makevecteur(string2gen(errmsg,false),a); 4045 } 4046 if (a==b) return a; 4047 return gentypeerr(gettext("sto ")+b.print(contextptr)+ gettext(" not allowed!")); 4048 } symb_sto(const gen & a,gen & b,bool in_place)4049 symbolic symb_sto(const gen & a,gen & b,bool in_place){ 4050 if (in_place) 4051 return symbolic(at_array_sto,gen(makevecteur(a,b),_SEQ__VECT)); 4052 return symbolic(at_sto,gen(makevecteur(a,b),_SEQ__VECT)); 4053 } parser_symb_sto(const gen & a_,gen & b,bool in_place)4054 symbolic parser_symb_sto(const gen & a_,gen & b,bool in_place){ 4055 gen a(a_); 4056 if (a.type==_VECT) // create a copy of the vector (avoid self-modif code) 4057 a=symbolic(at_copy,a); 4058 if (in_place) 4059 return symbolic(at_array_sto,gen(makevecteur(a,b),_SEQ__VECT)); 4060 return symbolic(at_sto,gen(makevecteur(a,b),_SEQ__VECT)); 4061 } symb_sto(const gen & e)4062 symbolic symb_sto(const gen & e){ 4063 return symbolic(at_sto,e); 4064 } _sto(const gen & a,const context * contextptr)4065 gen _sto(const gen & a,const context * contextptr){ 4066 if ( a.type==_STRNG && a.subtype==-1) return a; 4067 if (a.type!=_VECT) 4068 return symb_sto(a); 4069 if (rpn_mode(contextptr)){ 4070 if (a._VECTptr->size()<2) 4071 return gentoofewargs("STO"); 4072 gen c=a._VECTptr->back(); 4073 a._VECTptr->pop_back(); 4074 gen b=a._VECTptr->back(); 4075 a._VECTptr->pop_back(); 4076 gen tmpsto=sto(b,c,contextptr); 4077 if (is_undef(tmpsto)) return tmpsto; 4078 return gen(*a._VECTptr,_RPN_STACK__VECT); 4079 } 4080 if (a._VECTptr->size()!=2) 4081 return gentypeerr(contextptr); 4082 return sto(a._VECTptr->front(),a._VECTptr->back(),contextptr); 4083 } 4084 static const char _sto_s []="sto"; 4085 define_unary_function_eval4_index (30,__sto,&_sto,_sto_s,&printassto,&texprintassto); 4086 define_unary_function_ptr5( at_sto ,alias_at_sto,&__sto,0,true); 4087 // NB argument quoting for sto is done in eval in symbolic.cc 4088 _array_sto(const gen & a,const context * contextptr)4089 gen _array_sto(const gen & a,const context * contextptr){ 4090 if ( a.type==_STRNG && a.subtype==-1) return a; 4091 if (a.type!=_VECT ||a._VECTptr->size()!=2) 4092 return gentypeerr(contextptr); 4093 gen value=a._VECTptr->front().eval(eval_level(contextptr),contextptr); 4094 return sto(value,a._VECTptr->back(),true,contextptr); 4095 } 4096 static const char _array_sto_s []="array_sto"; 4097 static define_unary_function_eval_quoted (__array_sto,&_array_sto,_array_sto_s); 4098 define_unary_function_ptr5( at_array_sto ,alias_at_array_sto,&__array_sto,_QUOTE_ARGUMENTS,true); 4099 printasincdec(const gen & feuille,char ch,bool tex,GIAC_CONTEXT)4100 static string printasincdec(const gen & feuille,char ch,bool tex,GIAC_CONTEXT){ 4101 if (feuille.type!=_VECT){ 4102 string s(tex?gen2tex(feuille,contextptr):feuille.print(contextptr)); 4103 return xcas_mode(contextptr)?((s+string(":=")+s+ch)+'1'):((s+ch)+ch); 4104 } 4105 vecteur & v = *feuille._VECTptr; 4106 if (v.size()!=2) 4107 return "printasincdec: bad dimension"; 4108 gen & a=v.front(); 4109 gen & b=v.back(); 4110 string sa((tex?gen2tex(a,contextptr):a.print(contextptr))); 4111 string sb((tex?gen2tex(b,contextptr):b.print(contextptr))); 4112 return xcas_mode(contextptr)?sa+":="+sa+ch+sb:(sa+ch+'='+sb); 4113 } 4114 printasincrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)4115 static string printasincrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 4116 return printasincdec(feuille,'+',false,contextptr); 4117 } 4118 printasdecrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)4119 static string printasdecrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 4120 return printasincdec(feuille,'-',false,contextptr); 4121 } 4122 texprintasincrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)4123 static string texprintasincrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 4124 return printasincdec(feuille,'+',true,contextptr); 4125 } 4126 texprintasdecrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)4127 static string texprintasdecrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 4128 return printasincdec(feuille,'-',true,contextptr); 4129 } 4130 printasmultcrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)4131 static string printasmultcrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 4132 return printasincdec(feuille,'*',false,contextptr); 4133 } 4134 printasdivcrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)4135 static string printasdivcrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 4136 return printasincdec(feuille,'/',false,contextptr); 4137 } 4138 texprintasmultcrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)4139 static string texprintasmultcrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 4140 return printasincdec(feuille,'*',true,contextptr); 4141 } 4142 texprintasdivcrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)4143 static string texprintasdivcrement(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 4144 return printasincdec(feuille,'/',true,contextptr); 4145 } 4146 in_increment3(const gen & prev,const gen & val,const gen & var,int mult,GIAC_CONTEXT)4147 static gen in_increment3(const gen & prev,const gen & val,const gen & var,int mult,GIAC_CONTEXT){ 4148 if (mult==0) 4149 return sto(prev+val,var,true,contextptr); 4150 if (mult==1) 4151 return sto(prev*val,var,true,contextptr); 4152 if (mult==2) 4153 return sto(_iquo(makesequence(prev,val),contextptr),var,true,contextptr); 4154 if (mult==3) 4155 return sto(_irem(makesequence(prev,val),contextptr),var,true,contextptr); 4156 if (mult==4) 4157 return sto(_bitand(makesequence(prev,val),contextptr),var,true,contextptr); 4158 if (mult==5) 4159 return sto(_bitor(makesequence(prev,val),contextptr),var,true,contextptr); 4160 if (mult==6){ 4161 if (python_compat(contextptr)) 4162 return sto(_bitxor(makesequence(prev,val),contextptr),var,true,contextptr); 4163 return sto(_pow(makesequence(prev,val),contextptr),var,true,contextptr); 4164 } 4165 if (mult==7) 4166 return sto(_shift(makesequence(prev,val),contextptr),var,true,contextptr); 4167 if (mult==8) 4168 return sto(_rotate(makesequence(prev,val),contextptr),var,true,contextptr); 4169 if (mult==9) 4170 return sto(_pow(makesequence(prev,val),contextptr),var,true,contextptr); 4171 return gensizeerr(gettext("Increment")); 4172 } 4173 in_increment2(gen & prev,const gen & val,int mult,GIAC_CONTEXT)4174 static gen in_increment2(gen & prev,const gen & val,int mult,GIAC_CONTEXT){ 4175 if (mult==0) 4176 return prev=prev+val; 4177 if (mult==1) 4178 return prev=prev*val; 4179 if (mult==2) 4180 return prev=_iquo(makesequence(prev,val),contextptr); 4181 if (mult==3) 4182 return prev=_irem(makesequence(prev,val),contextptr); 4183 if (mult==4) 4184 return prev=_bitand(makesequence(prev,val),contextptr); 4185 if (mult==5) 4186 return prev=_bitor(makesequence(prev,val),contextptr); 4187 if (mult==6){ 4188 if (python_compat(contextptr)) 4189 return prev=_bitxor(makesequence(prev,val),contextptr); 4190 return prev=_pow(makesequence(prev,val),contextptr); 4191 } 4192 if (mult==7) 4193 return prev=_shift(makesequence(prev,val),contextptr); 4194 if (mult==8) 4195 return prev=_rotate(makesequence(prev,val),contextptr); 4196 if (mult==9) 4197 return prev=_pow(makesequence(prev,val),contextptr); 4198 return gensizeerr(gettext("Increment")); 4199 } 4200 4201 // mult==0 for +/-, mult=1 for * and /, mult==2 for iquo (negatif=false), mult==3 for irem (negatif=false), mult==4 for &=, 5 for |=, 6 for ^=, 7 for != increment(const gen & var,const gen & val_orig,bool negatif,int mult,GIAC_CONTEXT)4202 static gen increment(const gen & var,const gen & val_orig,bool negatif,int mult,GIAC_CONTEXT){ 4203 gen val=val_orig.eval(1,contextptr); 4204 if (negatif) 4205 val=mult==1?inv(val,contextptr):-val; 4206 if (var.type!=_IDNT){ 4207 gen prev=eval(var,1,contextptr); 4208 return in_increment3(prev,val,var,mult,contextptr); 4209 } 4210 if (contextptr){ 4211 sym_tab::iterator it,itend; 4212 const context * cptr=contextptr; 4213 for(;cptr;) { 4214 it=cptr->tabptr->find(var._IDNTptr->id_name); 4215 itend=cptr->tabptr->end(); 4216 if (it!=itend) 4217 break; 4218 if (!cptr->previous){ 4219 it=cptr->globalcontextptr->tabptr->find(var._IDNTptr->id_name); 4220 if (it!=itend) 4221 break; 4222 } 4223 cptr=cptr->previous; 4224 } 4225 if (!cptr){ 4226 gen prev=eval(var,1,contextptr); 4227 return in_increment3(prev,val,var,mult,contextptr); 4228 } 4229 return in_increment2(it->second,val,mult,contextptr); 4230 } 4231 if (!var._IDNTptr->localvalue) 4232 var._IDNTptr->localvalue = new vecteur; 4233 vecteur * w=var._IDNTptr->localvalue; 4234 if (!w->empty() && var.subtype!=_GLOBAL__EVAL) 4235 return w->back()=w->back()+val; 4236 if (!var._IDNTptr->value) 4237 return gensizeerr(gettext("Non assigned variable")); 4238 return in_increment2(*var._IDNTptr->value,val,mult,contextptr); 4239 } _increment(const gen & a,const context * contextptr)4240 gen _increment(const gen & a,const context * contextptr){ 4241 if ( a.type==_STRNG && a.subtype==-1) return a; 4242 if (a.type!=_VECT) 4243 return increment(a,1,false,false,contextptr); 4244 if (a._VECTptr->size()!=2) 4245 return gentypeerr(contextptr); 4246 return increment(a._VECTptr->front(),a._VECTptr->back(),false,0,contextptr); 4247 } 4248 static const char _increment_s []="increment"; 4249 static define_unary_function_eval4_index (151,__increment,&_increment,_increment_s,&printasincrement,&texprintasincrement); 4250 define_unary_function_ptr5( at_increment ,alias_at_increment,&__increment,_QUOTE_ARGUMENTS,true); 4251 _decrement(const gen & a,const context * contextptr)4252 gen _decrement(const gen & a,const context * contextptr){ 4253 if ( a.type==_STRNG && a.subtype==-1) return a; 4254 if (a.type!=_VECT) 4255 return increment(a,1,true,false,contextptr); 4256 if (a._VECTptr->size()!=2) 4257 return gentypeerr(contextptr); 4258 return increment(a._VECTptr->front(),a._VECTptr->back(),true,0,contextptr); 4259 } 4260 static const char _decrement_s []="decrement"; 4261 static define_unary_function_eval4_index (153,__decrement,&_decrement,_decrement_s,&printasdecrement,&texprintasdecrement); 4262 define_unary_function_ptr5( at_decrement ,alias_at_decrement,&__decrement,_QUOTE_ARGUMENTS,true); 4263 _multcrement(const gen & a,const context * contextptr)4264 gen _multcrement(const gen & a,const context * contextptr){ 4265 if ( a.type==_STRNG && a.subtype==-1) return a; 4266 if (a.type!=_VECT) 4267 return increment(a,1,false,true,contextptr); 4268 if (a.type!=_VECT || a._VECTptr->size()!=2) 4269 return gentypeerr(contextptr); 4270 return increment(a._VECTptr->front(),a._VECTptr->back(),false,1,contextptr); 4271 } 4272 static const char _multcrement_s []="multcrement"; 4273 static define_unary_function_eval4_index (155,__multcrement,&_multcrement,_multcrement_s,&printasmultcrement,&texprintasmultcrement); 4274 define_unary_function_ptr5( at_multcrement ,alias_at_multcrement,&__multcrement,_QUOTE_ARGUMENTS,true); 4275 _divcrement(const gen & a,const context * contextptr)4276 gen _divcrement(const gen & a,const context * contextptr){ 4277 if ( a.type==_STRNG && a.subtype==-1) return a; 4278 if (a.type!=_VECT) 4279 return increment(a,1,true,true,contextptr); 4280 if (a._VECTptr->size()!=2) 4281 return gentypeerr(contextptr); 4282 return increment(a._VECTptr->front(),a._VECTptr->back(),true,1,contextptr); 4283 } 4284 static const char _divcrement_s []="divcrement"; 4285 static define_unary_function_eval4_index (157,__divcrement,&_divcrement,_divcrement_s,&printasdivcrement,&texprintasdivcrement); 4286 define_unary_function_ptr5( at_divcrement ,alias_at_divcrement,&__divcrement,_QUOTE_ARGUMENTS,true); 4287 _iquosto(const gen & a,const context * contextptr)4288 gen _iquosto(const gen & a,const context * contextptr){ 4289 if ( a.type==_STRNG && a.subtype==-1) return a; 4290 if (a.type!=_VECT) 4291 return increment(a,1,true,true,contextptr); 4292 if (a._VECTptr->size()!=2) 4293 return gentypeerr(contextptr); 4294 return increment(a._VECTptr->front(),a._VECTptr->back(),false,2,contextptr); 4295 } 4296 static const char _iquosto_s []="iquosto"; 4297 static define_unary_function_eval_quoted (__iquosto,&_iquosto,_iquosto_s); 4298 define_unary_function_ptr5( at_iquosto ,alias_at_iquosto,&__iquosto,_QUOTE_ARGUMENTS,true); 4299 _iremsto(const gen & a,const context * contextptr)4300 gen _iremsto(const gen & a,const context * contextptr){ 4301 if ( a.type==_STRNG && a.subtype==-1) return a; 4302 if (a.type!=_VECT) 4303 return increment(a,1,true,true,contextptr); 4304 if (a._VECTptr->size()!=2) 4305 return gentypeerr(contextptr); 4306 return increment(a._VECTptr->front(),a._VECTptr->back(),false,3,contextptr); 4307 } 4308 static const char _iremsto_s []="iremsto"; 4309 static define_unary_function_eval_quoted (__iremsto,&_iremsto,_iremsto_s); 4310 define_unary_function_ptr5( at_iremsto ,alias_at_iremsto,&__iremsto,_QUOTE_ARGUMENTS,true); 4311 _andsto(const gen & a,const context * contextptr)4312 gen _andsto(const gen & a,const context * contextptr){ 4313 if ( a.type==_STRNG && a.subtype==-1) return a; 4314 if (a.type!=_VECT) 4315 return increment(a,1,true,true,contextptr); 4316 if (a._VECTptr->size()!=2) 4317 return gentypeerr(contextptr); 4318 return increment(a._VECTptr->front(),a._VECTptr->back(),false,4,contextptr); 4319 } 4320 static const char _andsto_s []="andsto"; 4321 static define_unary_function_eval_quoted (__andsto,&_andsto,_andsto_s); 4322 define_unary_function_ptr5( at_andsto ,alias_at_andsto,&__andsto,_QUOTE_ARGUMENTS,true); 4323 _orsto(const gen & a,const context * contextptr)4324 gen _orsto(const gen & a,const context * contextptr){ 4325 if ( a.type==_STRNG && a.subtype==-1) return a; 4326 if (a.type!=_VECT) 4327 return increment(a,1,true,true,contextptr); 4328 if (a._VECTptr->size()!=2) 4329 return gentypeerr(contextptr); 4330 return increment(a._VECTptr->front(),a._VECTptr->back(),false,5,contextptr); 4331 } 4332 static const char _orsto_s []="orsto"; 4333 static define_unary_function_eval_quoted (__orsto,&_orsto,_orsto_s); 4334 define_unary_function_ptr5( at_orsto ,alias_at_orsto,&__orsto,_QUOTE_ARGUMENTS,true); 4335 _xorsto(const gen & a,const context * contextptr)4336 gen _xorsto(const gen & a,const context * contextptr){ 4337 if ( a.type==_STRNG && a.subtype==-1) return a; 4338 if (a.type!=_VECT) 4339 return increment(a,1,true,true,contextptr); 4340 if (a._VECTptr->size()!=2) 4341 return gentypeerr(contextptr); 4342 return increment(a._VECTptr->front(),a._VECTptr->back(),false,6,contextptr); 4343 } 4344 static const char _xorsto_s []="xorsto"; 4345 static define_unary_function_eval_quoted (__xorsto,&_xorsto,_xorsto_s); 4346 define_unary_function_ptr5( at_xorsto ,alias_at_xorsto,&__xorsto,_QUOTE_ARGUMENTS,true); 4347 _shiftsto(const gen & a,const context * contextptr)4348 gen _shiftsto(const gen & a,const context * contextptr){ 4349 if ( a.type==_STRNG && a.subtype==-1) return a; 4350 if (a.type!=_VECT) 4351 return increment(a,1,true,true,contextptr); 4352 if (a._VECTptr->size()!=2) 4353 return gentypeerr(contextptr); 4354 return increment(a._VECTptr->front(),a._VECTptr->back(),false,7,contextptr); 4355 } 4356 static const char _shiftsto_s []="shiftsto"; 4357 static define_unary_function_eval_quoted (__shiftsto,&_shiftsto,_shiftsto_s); 4358 define_unary_function_ptr5( at_shiftsto ,alias_at_shiftsto,&__shiftsto,_QUOTE_ARGUMENTS,true); 4359 _rotatesto(const gen & a,const context * contextptr)4360 gen _rotatesto(const gen & a,const context * contextptr){ 4361 if ( a.type==_STRNG && a.subtype==-1) return a; 4362 if (a.type!=_VECT) 4363 return increment(a,1,true,true,contextptr); 4364 if (a._VECTptr->size()!=2) 4365 return gentypeerr(contextptr); 4366 return increment(a._VECTptr->front(),a._VECTptr->back(),false,8,contextptr); 4367 } 4368 static const char _rotatesto_s []="rotatesto"; 4369 static define_unary_function_eval_quoted (__rotatesto,&_rotatesto,_rotatesto_s); 4370 define_unary_function_ptr5( at_rotatesto ,alias_at_rotatesto,&__rotatesto,_QUOTE_ARGUMENTS,true); 4371 _powsto(const gen & a,const context * contextptr)4372 gen _powsto(const gen & a,const context * contextptr){ 4373 if ( a.type==_STRNG && a.subtype==-1) return a; 4374 if (a.type!=_VECT) 4375 return increment(a,1,true,true,contextptr); 4376 if (a._VECTptr->size()!=2) 4377 return gentypeerr(contextptr); 4378 return increment(a._VECTptr->front(),a._VECTptr->back(),false,9,contextptr); 4379 } 4380 static const char _powsto_s []="powsto"; 4381 static define_unary_function_eval_quoted (__powsto,&_powsto,_powsto_s); 4382 define_unary_function_ptr5( at_powsto ,alias_at_powsto,&__powsto,_QUOTE_ARGUMENTS,true); 4383 is_assumed_real(const gen & g,GIAC_CONTEXT)4384 bool is_assumed_real(const gen & g,GIAC_CONTEXT){ 4385 if (g.type!=_IDNT) 4386 return false; 4387 if (g==cst_euler_gamma || g==cst_pi) 4388 return true; 4389 gen tmp=g._IDNTptr->eval(1,g,contextptr); 4390 if (g.subtype==_GLOBAL__EVAL && contextptr){ 4391 sym_tab::const_iterator it=contextptr->globalcontextptr->tabptr->find(g._IDNTptr->id_name),itend=contextptr->globalcontextptr->tabptr->end(); 4392 if (it!=itend) 4393 tmp=it->second; 4394 } 4395 if (tmp.type==_VECT && tmp.subtype==_ASSUME__VECT){ 4396 vecteur & v = *tmp._VECTptr; 4397 if (!v.empty()){ 4398 if ((v.front()==_INT_ || v.front()==_ZINT || v.front()==_DOUBLE_) ) 4399 return true; 4400 if (v.front()==_CPLX) 4401 return false; 4402 } 4403 } 4404 return !complex_variables(contextptr); 4405 } 4406 is_assumed_integer(const gen & g,GIAC_CONTEXT)4407 bool is_assumed_integer(const gen & g,GIAC_CONTEXT){ 4408 if (is_integer(g)) 4409 return true; 4410 if (g.type==_IDNT) {// FIXME GIAC_CONTEXT 4411 gen tmp=g._IDNTptr->eval(1,g,contextptr); 4412 if (tmp.type==_VECT && tmp.subtype==_ASSUME__VECT){ 4413 vecteur & v = *tmp._VECTptr; 4414 if (!v.empty() && (v.front()==_INT_ || v.front()==_ZINT) ) 4415 return true; 4416 } 4417 return is_integer(tmp); 4418 } 4419 if (g.type!=_SYMB) 4420 return false; 4421 unary_function_ptr & u=g._SYMBptr->sommet; 4422 gen & f=g._SYMBptr->feuille; 4423 if ( (u==at_neg) || (u==at_abs) ) 4424 return is_assumed_integer(f,contextptr); 4425 if ( (u==at_plus) || (u==at_prod) ){ 4426 if (f.type!=_VECT) 4427 return is_assumed_integer(f,contextptr); 4428 const_iterateur it=f._VECTptr->begin(),itend=f._VECTptr->end(); 4429 for (;it!=itend;++it) 4430 if (!is_assumed_integer(*it,contextptr)) 4431 return false; 4432 return true; 4433 } 4434 return false; 4435 } 4436 // v = previous assumptions, a=the real value, direction 4437 // is positive for [a,+inf[, negative for ]-inf,a] 4438 // |direction| = 1 (large) or 2 (strict) doubleassume_and(const vecteur & v,const gen & a,int direction,bool or_assumption,GIAC_CONTEXT)4439 gen doubleassume_and(const vecteur & v,const gen & a,int direction,bool or_assumption,GIAC_CONTEXT){ 4440 vecteur v_intervalle,v_excluded; 4441 if ( (v.size()>=3) && (v[1].type==_VECT) && (v[2].type==_VECT) ){ 4442 v_intervalle=*v[1]._VECTptr; 4443 v_excluded=*v.back()._VECTptr; 4444 } 4445 gen v0=_DOUBLE_; 4446 v0.subtype=1; 4447 if (!v.empty()) 4448 v0=v.front(); 4449 if (!(direction %2) && !equalposcomp(v_excluded,a)) 4450 v_excluded.push_back(a); 4451 if (or_assumption){ 4452 // remove excluded values if they are in the interval we add 4453 vecteur old_v(v_excluded); 4454 v_excluded.clear(); 4455 const_iterateur it=old_v.begin(),itend=old_v.end(); 4456 for (;it!=itend;++it){ 4457 if (direction%2==0 && a==*it){ 4458 v_excluded.push_back(*it); 4459 continue; 4460 } 4461 bool a_greater_sup=ck_is_greater(a,*it,contextptr); 4462 if (a_greater_sup && (direction<0) ) 4463 continue; 4464 if (!a_greater_sup && (direction>0) ) 4465 continue; 4466 v_excluded.push_back(*it); 4467 } 4468 } 4469 if (v_intervalle.empty() || or_assumption){ 4470 if (direction>0) 4471 v_intervalle.push_back(gen(makevecteur(a,plus_inf),_LINE__VECT)); 4472 else 4473 v_intervalle.push_back(gen(makevecteur(minus_inf,a),_LINE__VECT)); 4474 if (or_assumption) 4475 return gen(makevecteur(v0,v_intervalle,v_excluded),_ASSUME__VECT); 4476 } 4477 else { // intersection of [a.+inf[ with every interval from v_intervalle 4478 vecteur old_v(v_intervalle); 4479 v_intervalle.clear(); 4480 const_iterateur it=old_v.begin(),itend=old_v.end(); 4481 for (;it!=itend;++it){ 4482 if ( (it->type!=_VECT) || (it->subtype!=_LINE__VECT) || (it->_VECTptr->size()!= 2) ) 4483 return gensizeerr(contextptr); 4484 gen i_inf(it->_VECTptr->front()),i_sup(it->_VECTptr->back()); 4485 bool a_greater_sup=ck_is_greater(a,i_sup,contextptr); 4486 if (a_greater_sup){ 4487 if (direction<0) 4488 v_intervalle.push_back(*it); 4489 continue; 4490 } 4491 bool a_greater_inf=ck_is_greater(a,i_inf,contextptr); 4492 if (!a_greater_inf){ 4493 if (direction>0) 4494 v_intervalle.push_back(*it); 4495 continue; 4496 } 4497 if (direction>0) 4498 v_intervalle.push_back(gen(makevecteur(a,i_sup),_LINE__VECT)); 4499 else 4500 v_intervalle.push_back(gen(makevecteur(i_inf,a),_LINE__VECT)); 4501 } 4502 } 4503 return gen(makevecteur(v0,v_intervalle,v_excluded),_ASSUME__VECT); 4504 } 4505 // returns the assumed idnt name 4506 // used if assumptions are in OR conjonction assumesymbolic(const gen & a,gen idnt_must_be,GIAC_CONTEXT)4507 gen assumesymbolic(const gen & a,gen idnt_must_be,GIAC_CONTEXT){ 4508 if (a.type==_IDNT) 4509 return a._IDNTptr->eval(eval_level(contextptr),a,contextptr); 4510 if ( (a.type!=_SYMB) || (a._SYMBptr->feuille.type!=_VECT) ) 4511 return gensizeerr(contextptr); 4512 while (idnt_must_be.type==_SYMB){ 4513 idnt_must_be=idnt_must_be._SYMBptr->feuille; 4514 if ( (idnt_must_be.type==_VECT) && !(idnt_must_be._VECTptr->empty()) ) 4515 idnt_must_be=idnt_must_be._VECTptr->front(); 4516 } 4517 unary_function_ptr s(a._SYMBptr->sommet); 4518 vecteur v(*a._SYMBptr->feuille._VECTptr); 4519 int l=int(v.size()); 4520 if (!l) 4521 return gensizeerr(contextptr); 4522 gen arg0(v.front()),arg1(v.back()),hyp(undef); 4523 if (s==at_sto){ 4524 gen tmp(arg0); 4525 arg0=arg1; 4526 arg1=tmp; 4527 } 4528 if (s==at_and || s==at_et){ 4529 gen tmpg=assumesymbolic(arg0,0,contextptr); 4530 if (is_undef(tmpg)) return tmpg; 4531 return assumesymbolic(arg1,0,contextptr); 4532 } 4533 if (s==at_ou || s==at_oufr){ 4534 gen a0(assumesymbolic(arg0,0,contextptr)); 4535 if (is_undef(a0)) return a0; 4536 return assumesymbolic(arg1,a0,contextptr); 4537 } 4538 if (arg0.type!=_IDNT) 4539 arg0=arg0.eval(eval_level(contextptr),contextptr); 4540 if ( (arg0.type!=_IDNT || arg0==cst_pi) && arg1.type==_IDNT){ 4541 gen swapped=gen(makevecteur(arg1,arg0),_SEQ__VECT); 4542 if (s==at_superieur_strict) return assumesymbolic(symbolic(at_inferieur_strict,swapped),idnt_must_be,contextptr); 4543 if (s==at_superieur_egal) return assumesymbolic(symbolic(at_inferieur_egal,swapped),idnt_must_be,contextptr); 4544 if (s==at_inferieur_strict) return assumesymbolic(symbolic(at_superieur_strict,swapped),idnt_must_be,contextptr); 4545 if (s==at_inferieur_egal) return assumesymbolic(symbolic(at_superieur_egal,swapped),idnt_must_be,contextptr); 4546 } 4547 if ( (arg0.type!=_IDNT) || (!is_zero(idnt_must_be,contextptr) && (arg0!=idnt_must_be) ) ) 4548 return gensizeerr(contextptr); 4549 bool or_assumption= !is_zero(idnt_must_be,contextptr) && (arg0==idnt_must_be); 4550 vecteur last_hyp; 4551 arg1=arg0._IDNTptr->eval(eval_level(contextptr),arg0,contextptr); 4552 if ( (arg1.type!=_VECT) || (arg1.subtype!=_ASSUME__VECT) ) 4553 last_hyp=makevecteur(vecteur(0),vecteur(0)); 4554 else 4555 last_hyp=*arg1._VECTptr; 4556 if (l==2){ 4557 if (s==at_sto) 4558 arg1=v[0].eval(eval_level(contextptr),contextptr); 4559 else 4560 arg1=v[1].eval(eval_level(contextptr),contextptr); 4561 gen borne_inf(gnuplot_xmin),borne_sup(gnuplot_xmax),pas; 4562 if ( s==at_equal || s== at_equal2 || s==at_same || s==at_sto ){ 4563 // ex: assume(a=[1.7,1.1,2.3]) 4564 if (arg1.type==_VECT && arg1._VECTptr->size()>=3){ 4565 vecteur vtmp=*arg1._VECTptr; 4566 borne_inf=evalf_double(vtmp[1],eval_level(contextptr),contextptr); 4567 borne_sup=evalf_double(vtmp[2],eval_level(contextptr),contextptr); 4568 pas=(borne_sup-borne_inf)/100; 4569 if (vtmp.size()>3) 4570 pas=evalf_double(vtmp[3],eval_level(contextptr),contextptr); 4571 arg1=evalf_double(vtmp[0],eval_level(contextptr),contextptr); 4572 } 4573 gen tmp=arg1.type; 4574 tmp.subtype=1; 4575 hyp=gen(makevecteur(tmp,arg1),_ASSUME__VECT); 4576 } 4577 if (s==at_inferieur_strict) // ex: assume(a<1.7) 4578 hyp=doubleassume_and(last_hyp,arg1,-2,or_assumption,contextptr); 4579 if (s==at_inferieur_egal) 4580 hyp=doubleassume_and(last_hyp,arg1,-1,or_assumption,contextptr); 4581 if (s==at_superieur_strict) 4582 hyp=doubleassume_and(last_hyp,arg1,2,or_assumption,contextptr); 4583 if (s==at_superieur_egal) 4584 hyp=doubleassume_and(last_hyp,arg1,1,or_assumption,contextptr); 4585 if (!is_undef(hyp)){ 4586 gen tmpsto=sto(hyp,arg0,contextptr); 4587 if (is_undef(tmpsto)) return tmpsto; 4588 if ( s==at_equal || s==at_equal2 || s==at_same || s==at_sto ) 4589 return _parameter(makevecteur(arg0,borne_inf,borne_sup,arg1,pas),contextptr); 4590 return arg0; 4591 } 4592 } 4593 return gensizeerr(contextptr); 4594 } purge_assume(const gen & a,GIAC_CONTEXT)4595 static void purge_assume(const gen & a,GIAC_CONTEXT){ 4596 if (a.type==_SYMB && (a._SYMBptr->sommet==at_and || a._SYMBptr->sommet==at_et || a._SYMBptr->sommet==at_ou || a._SYMBptr->sommet==at_oufr || a._SYMBptr->sommet==at_inferieur_strict || a._SYMBptr->sommet==at_inferieur_egal || a._SYMBptr->sommet==at_superieur_egal || a._SYMBptr->sommet==at_superieur_strict || a._SYMBptr->sommet==at_equal) ){ 4597 purge_assume(a._SYMBptr->feuille,contextptr); 4598 return; 4599 } 4600 if (a.type==_VECT && !a._VECTptr->empty()){ 4601 if (a._VECTptr->back().type==_IDNT && a._VECTptr->front().type!=_IDNT) 4602 purge_assume(a._VECTptr->back(),contextptr); 4603 else 4604 purge_assume(a._VECTptr->front(),contextptr); 4605 } 4606 else 4607 purgenoassume(a,contextptr); 4608 } giac_assume(const gen & a,GIAC_CONTEXT)4609 gen giac_assume(const gen & a,GIAC_CONTEXT){ 4610 if ( (a.type==_VECT) && (a._VECTptr->size()==2) ){ 4611 gen a1(a._VECTptr->front()),a2(a._VECTptr->back()); 4612 if (a2.type==_INT_){ 4613 // assume(a,real) for example 4614 a2.subtype=1; 4615 gen tmpsto=sto(gen(makevecteur(a2),_ASSUME__VECT),a1,contextptr); 4616 if (is_undef(tmpsto)) return tmpsto; 4617 return a2; 4618 } 4619 if (a2==at_real || a2==at_float){ 4620 a2=_DOUBLE_; 4621 a2.subtype=1; 4622 gen tmpsto=sto(gen(makevecteur(a2),_ASSUME__VECT),a1,contextptr); 4623 if (is_undef(tmpsto)) return tmpsto; 4624 return a2; 4625 } 4626 if (a2==at_complex){ 4627 a2=_CPLX; 4628 a2.subtype=1; 4629 gen tmpsto=sto(gen(makevecteur(a2),_ASSUME__VECT),a1,contextptr); 4630 if (is_undef(tmpsto)) return tmpsto; 4631 return a2; 4632 } 4633 if ( (a2.type==_FUNC) && (*a2._FUNCptr==at_ou) ){ 4634 purge_assume(a1,contextptr); 4635 return assumesymbolic(a1,a1,contextptr); 4636 } 4637 if (a2==at_additionally) 4638 return giac_additionally(a1,contextptr); 4639 } 4640 gen a_; 4641 if (a.type==_SYMB){ 4642 if (a._SYMBptr->sommet==at_and || a._SYMBptr->sommet==at_et || a._SYMBptr->sommet==at_ou || a._SYMBptr->sommet==at_oufr || a._SYMBptr->sommet==at_inferieur_strict || a._SYMBptr->sommet==at_inferieur_egal || a._SYMBptr->sommet==at_superieur_egal || a._SYMBptr->sommet==at_superieur_strict || a._SYMBptr->sommet==at_equal) 4643 a_=a; 4644 else 4645 a_=eval(a,1,contextptr); 4646 } 4647 purge_assume(a_,contextptr); 4648 return assumesymbolic(a_,0,contextptr); 4649 } 4650 static const char giac_assume_s []="assume"; 4651 static define_unary_function_eval_quoted (giac__assume,&giac_assume,giac_assume_s); 4652 define_unary_function_ptr5( at_assume ,alias_at_assume,&giac__assume,_QUOTE_ARGUMENTS,true); 4653 giac_additionally(const gen & a,GIAC_CONTEXT)4654 gen giac_additionally(const gen & a,GIAC_CONTEXT){ 4655 if ( (a.type==_VECT) && (a._VECTptr->size()==2) ){ 4656 gen a1(a._VECTptr->front()),a2(a._VECTptr->back()); 4657 if (a1.type!=_IDNT) 4658 return gensizeerr(contextptr); 4659 gen a1val=a1._IDNTptr->eval(1,a1,contextptr); 4660 if (a1val.type==_VECT && a1val.subtype==_ASSUME__VECT && !a1val._VECTptr->empty()){ 4661 if (a2.type==_INT_){ 4662 // assume(a,real) for example 4663 a2.subtype=1; 4664 a1val._VECTptr->front()=a2; 4665 return a2; 4666 } 4667 if (a2==at_real){ 4668 a2=_DOUBLE_; 4669 a2.subtype=1; 4670 a1val._VECTptr->front()=a2; 4671 return a2; 4672 } 4673 } 4674 else { 4675 gen tmp=giac_assume(a,contextptr); 4676 if (is_undef(tmp)) return tmp; 4677 } 4678 } 4679 return assumesymbolic(a,0,contextptr); 4680 } 4681 static const char giac_additionally_s []="additionally"; 4682 static define_unary_function_eval_quoted (giac__additionally,&giac_additionally,giac_additionally_s); 4683 define_unary_function_ptr5( at_additionally ,alias_at_additionally,&giac__additionally,_QUOTE_ARGUMENTS,true); 4684 4685 // multiargs symb_plus(const gen & a,const gen & b)4686 symbolic symb_plus(const gen & a,const gen & b){ 4687 if (a.is_symb_of_sommet(at_plus) && !is_inf(a._SYMBptr->feuille)){ 4688 if (b.is_symb_of_sommet(at_plus) && !is_inf(b._SYMBptr->feuille)) 4689 return symbolic(at_plus,gen(mergevecteur(*(a._SYMBptr->feuille._VECTptr),*(b._SYMBptr->feuille._VECTptr)),_SEQ__VECT)); 4690 else 4691 return symbolic(*a._SYMBptr,b); 4692 } 4693 return symbolic(at_plus,gen(makevecteur(a,b),_SEQ__VECT)); 4694 } 4695 plus_idnt_symb(const gen & a)4696 inline bool plus_idnt_symb(const gen & a){ 4697 return (a.type==_IDNT && strcmp(a._IDNTptr->id_name,"undef") && strcmp(a._IDNTptr->id_name,"infinity")) || (a.type==_SYMB && !is_inf(a) && (a._SYMBptr->sommet==at_prod || a._SYMBptr->sommet==at_pow || a._SYMBptr->sommet==at_neg)); 4698 } 4699 idnt_symb_int(const gen & b)4700 inline bool idnt_symb_int(const gen & b){ 4701 return (b.type==_INT_ && b.val!=0) || b.type==_ZINT || (b.type==_SYMB && !is_inf(b) && b._SYMBptr->sommet!=at_unit && b._SYMBptr->sommet!=at_equal && b._SYMBptr->sommet!=at_equal2 && !equalposcomp(plot_sommets,b._SYMBptr->sommet) && !equalposcomp(inequality_tab,b._SYMBptr->sommet) ) || (b.type==_IDNT && strcmp(b._IDNTptr->id_name,"undef") && strcmp(b._IDNTptr->id_name,"infinity")); 4702 } 4703 _plus(const gen & args,GIAC_CONTEXT)4704 gen _plus(const gen & args,GIAC_CONTEXT){ 4705 if ( args.type==_STRNG && args.subtype==-1) return args; 4706 if (args.type!=_VECT){ 4707 if ((args.type==_IDNT) && !strcmp(args._IDNTptr->id_name,string_infinity)) 4708 return plus_inf; 4709 return args; 4710 } 4711 iterateur it=args._VECTptr->begin(), itend=args._VECTptr->end(); 4712 if (itend-it==2){ 4713 int t1=it->type,t2=(it+1)->type; 4714 if (t1<_IDNT && t2<_IDNT){ 4715 unsigned t=(t1<< _DECALAGE) | t2; 4716 if (!t) 4717 return((longlong) it->val+(it+1)->val); 4718 return operator_plus(*it,*(it+1),t,contextptr); 4719 } 4720 } 4721 if (it==itend) 4722 return zero; 4723 const gen & a=*it; 4724 ++it; 4725 if (itend==it) 4726 return a; 4727 const gen & b=*it; 4728 ++it; 4729 if (it==itend){ 4730 // improve: if a is an idnt/symb and b also do not rebuild the vector 4731 if (idnt_symb_int(b) && plus_idnt_symb(a)){ 4732 if (b.is_symb_of_sommet(at_neg) && a==b._SYMBptr->feuille) 4733 return chkmod(zero,a); 4734 if (a.is_symb_of_sommet(at_neg) && b==a._SYMBptr->feuille) 4735 return chkmod(zero,b); 4736 if (!b.is_symb_of_sommet(at_program) 4737 && !b.is_symb_of_sommet(at_plus) 4738 ) 4739 return new_ref_symbolic(symbolic(at_plus,args)); 4740 } 4741 if (idnt_symb_int(a) && plus_idnt_symb(b)){ 4742 if (b.is_symb_of_sommet(at_neg) && a==b._SYMBptr->feuille) 4743 return chkmod(zero,a); 4744 if (a.is_symb_of_sommet(at_neg) && b==a._SYMBptr->feuille) 4745 return chkmod(zero,b); 4746 if (!a.is_symb_of_sommet(at_program) 4747 && !a.is_symb_of_sommet(at_plus) 4748 ) 4749 return new_ref_symbolic(symbolic(at_plus,args)); 4750 } 4751 return operator_plus(a,b,contextptr); 4752 } 4753 gen sum(operator_plus(a,b,contextptr)); 4754 for (;it!=itend;++it){ 4755 if (sum.type==_SYMB && sum._SYMBptr->sommet==at_plus && sum._SYMBptr->feuille.type==_VECT && sum._SYMBptr->feuille._VECTptr->size()>1 ){ 4756 // Add remaining elements to the symbolic sum, check float/inf/undef 4757 // FIXME should crunch if it->type is _DOUBLE_/_FLOAT_/_REAL e.g. for 1+sqrt(2)+sqrt(3.0) 4758 ref_vecteur * vptr=new ref_vecteur(*sum._SYMBptr->feuille._VECTptr); 4759 vptr->v.reserve(vptr->v.size()+(itend-it)); 4760 for (;it!=itend;++it){ 4761 if (it->type==_SYMB && it->_SYMBptr->sommet==at_plus && it->_SYMBptr->feuille.type==_VECT){ 4762 iterateur jt=it->_SYMBptr->feuille._VECTptr->begin(),jtend=it->_SYMBptr->feuille._VECTptr->end(); 4763 for (;jt!=jtend;++jt){ 4764 vptr->v.push_back(*jt); 4765 } 4766 continue; 4767 } 4768 if (it->type==_USER && vptr->v.front().type==_USER){ 4769 vptr->v.front()=operator_plus(vptr->v.front(),*it,contextptr); 4770 continue; 4771 } 4772 if ( it->type==_DOUBLE_ || (it->type<=_POLY && vptr->v.back().type<=_POLY) ) // N.B. _DOUBLE_ special case bad for f(x):= 6. + 3.*x + 2.*x^2;g(x) := 12. ; expand(f(x)+g(x)); 4773 vptr->v.back()=operator_plus(vptr->v.back(),*it,contextptr); 4774 else { 4775 if (is_inf(*it) || is_undef(*it) || (it->type==_SYMB && it->_SYMBptr->sommet==at_plus)) 4776 break; 4777 if (!is_zero(*it,contextptr)) 4778 vptr->v.push_back(*it); 4779 } 4780 } 4781 if (is_zero(vptr->v.back(),contextptr)) 4782 vptr->v.pop_back(); 4783 if (vptr->v.size()==1){ 4784 sum=vptr->v.front(); 4785 delete vptr; 4786 } 4787 else 4788 sum=symbolic(at_plus,gen(vptr,_SEQ__VECT)); 4789 if (it==itend) 4790 break; 4791 } 4792 operator_plus_eq(sum ,*it,contextptr); 4793 } 4794 return sum; 4795 } 4796 4797 /* derivative of + is handled in derive.cc 4798 static unary_function_ptr _D_at_plus (int i) { 4799 return at_one; 4800 } 4801 const partial_derivative_multiargs D_at_plus(&_D_at_plus); 4802 */ 4803 static const char _plus_s []="+"; 4804 static define_unary_function_eval2_index (2,__plus,&_plus,_plus_s,&printsommetasoperator); 4805 define_unary_function_ptr( at_plus ,alias_at_plus ,&__plus); 4806 pointplus(const gen & a,const gen & b,GIAC_CONTEXT)4807 gen pointplus(const gen &a,const gen &b,GIAC_CONTEXT){ 4808 if (a.type==_VECT && b.type!=_VECT) 4809 return apply1st(a,b,contextptr,pointplus); 4810 if (a.type!=_VECT && b.type==_VECT) 4811 return apply2nd(a,b,contextptr,pointplus); 4812 return operator_plus(a,b,contextptr); 4813 } _pointplus(const gen & args,GIAC_CONTEXT)4814 gen _pointplus(const gen & args,GIAC_CONTEXT){ 4815 if (args.type!=_VECT && args._VECTptr->size()!=2) 4816 return gensizeerr(); 4817 gen a=args._VECTptr->front(),b=args._VECTptr->back(); 4818 return pointplus(a,b,contextptr); 4819 } 4820 static const char _pointplus_s []=".+"; 4821 static define_unary_function_eval2_index (170,__pointplus,&_pointplus,_pointplus_s,&printsommetasoperator); 4822 define_unary_function_ptr( at_pointplus ,alias_at_pointplus ,&__pointplus); 4823 pointminus(const gen & a,const gen & b,GIAC_CONTEXT)4824 gen pointminus(const gen &a,const gen &b,GIAC_CONTEXT){ 4825 if (a.type==_VECT && b.type!=_VECT) 4826 return apply1st(a,b,contextptr,pointminus); 4827 if (a.type!=_VECT && b.type==_VECT) 4828 return apply2nd(a,b,contextptr,pointminus); 4829 return operator_minus(a,b,contextptr); 4830 } _pointminus(const gen & args,GIAC_CONTEXT)4831 gen _pointminus(const gen & args,GIAC_CONTEXT){ 4832 if (args.type!=_VECT && args._VECTptr->size()!=2) 4833 return gensizeerr(); 4834 gen a=args._VECTptr->front(),b=args._VECTptr->back(); 4835 return pointminus(a,b,contextptr); 4836 } 4837 static const char _pointminus_s []=".-"; 4838 static define_unary_function_eval2_index (172,__pointminus,&_pointminus,_pointminus_s,&printsommetasoperator); 4839 define_unary_function_ptr( at_pointminus ,alias_at_pointminus ,&__pointminus); 4840 prod_idnt_symb(const gen & a)4841 inline bool prod_idnt_symb(const gen & a){ 4842 return (a.type==_IDNT && strcmp(a._IDNTptr->id_name,"undef") && strcmp(a._IDNTptr->id_name,"infinity")) || (a.type==_SYMB && !is_inf(a) && (a._SYMBptr->sommet==at_plus || a._SYMBptr->sommet==at_pow || a._SYMBptr->sommet==at_neg)); 4843 } 4844 symb_prod(const gen & a,const gen & b)4845 gen symb_prod(const gen & a,const gen & b){ 4846 if (a.is_symb_of_sommet(at_neg)){ 4847 if (b.is_symb_of_sommet(at_neg)) 4848 return symb_prod(a._SYMBptr->feuille,b._SYMBptr->feuille); 4849 return -symb_prod(a._SYMBptr->feuille,b); 4850 } 4851 if (b.is_symb_of_sommet(at_neg)) 4852 return -symb_prod(a,b._SYMBptr->feuille); 4853 if ((a.type<=_REAL || a.type==_FLOAT_) && is_strictly_positive(-a,context0)) 4854 return -symb_prod(-a,b); 4855 if ((b.type<=_REAL || b.type==_FLOAT_) && is_strictly_positive(-b,context0)) 4856 return -symb_prod(a,-b); 4857 return symbolic(at_prod,gen(makevecteur(a,b),_SEQ__VECT)); 4858 } _prod(const gen & args,GIAC_CONTEXT)4859 gen _prod(const gen & args,GIAC_CONTEXT){ 4860 if ( args.type==_STRNG && args.subtype==-1) return args; 4861 if (args.type!=_VECT) 4862 return args; 4863 iterateur it=args._VECTptr->begin(), itend=args._VECTptr->end(); 4864 if (itend-it==2 && it->type<_IDNT && (it+1)->type<_IDNT) 4865 return operator_times(*it,*(it+1),contextptr); 4866 gen prod(1); 4867 /* 4868 if (it==itend) 4869 return 1; 4870 const gen & a=*it; 4871 ++it; 4872 if (itend==it) 4873 return a; 4874 const gen & b=*it; 4875 ++it; 4876 if (it==itend){ 4877 // improve: if a is an idnt/symb and b also do not rebuild the vector 4878 if (idnt_symb_int(b) && prod_idnt_symb(a)) 4879 return new symbolic(at_prod,args); 4880 if (idnt_symb_int(a) && prod_idnt_symb(b)) 4881 return new symbolic(at_prod,args); 4882 return operator_plus(a,b,contextptr); 4883 } 4884 gen prod(operator_times(a,b,contextptr)); 4885 */ 4886 if (debug_infolevel>3) 4887 CERR << CLOCK() << " begin _prod" << '\n'; 4888 for (;it!=itend;++it){ 4889 if ( (it->type==_SYMB) && (it->_SYMBptr->sommet==at_inv) && (it->_SYMBptr->feuille.type!=_VECT) ) 4890 prod = rdiv(prod,it->_SYMBptr->feuille,contextptr); 4891 else { 4892 if (prod.type==_INT_ && prod.val==1) 4893 prod=*it; 4894 else 4895 prod = operator_times(prod,*it,contextptr); 4896 } 4897 if (debug_infolevel>3) 4898 CERR << CLOCK() << " in _prod" << '\n'; 4899 } 4900 return prod; 4901 } 4902 /* 4903 unary_function_ptr _D_at_prod (int i) { 4904 vector<int> v; 4905 v.push_back(i); 4906 vector<unary_function_ptr> w; 4907 w.push_back(at_prod); 4908 w.push_back(new unary_function_innerprod(v)); 4909 return new unary_function_compose(w); 4910 } 4911 const partial_derivative_multiargs D_at_prod(&_D_at_prod); 4912 static const char _prod_s []="*"; 4913 unary_function_eval __prod(&_prod,D_at_prod,_prod_s,&printsommetasoperator); 4914 unary_function_ptr at_prod (&__prod); 4915 */ 4916 static const char _prod_s []="*"; 4917 static define_unary_function_eval2_index (8,__prod,&_prod,_prod_s,&printsommetasoperator); 4918 define_unary_function_ptr( at_prod ,alias_at_prod ,&__prod); 4919 cprintaspow(const gen & feuille,const char * sommetstr_orig,GIAC_CONTEXT)4920 std::string cprintaspow(const gen & feuille,const char * sommetstr_orig,GIAC_CONTEXT){ 4921 gen f(feuille); 4922 if (f.type==_VECT) 4923 f.subtype=_SEQ__VECT; 4924 return "pow("+f.print(contextptr)+")"; 4925 } symb_pow(const gen & a,const gen & b)4926 symbolic symb_pow(const gen & a,const gen & b){ 4927 return symbolic(at_pow,gen(makevecteur(a,b),_SEQ__VECT)); 4928 } _pow(const gen & args,GIAC_CONTEXT)4929 gen _pow(const gen & args,GIAC_CONTEXT){ 4930 if ( args.type==_STRNG && args.subtype==-1) return args; 4931 if (args.type!=_VECT || is_undef(args)) 4932 return args; 4933 vecteur & v = *args._VECTptr; 4934 if (v.size()==3) 4935 return _powmod(args,contextptr); // Python 3 compat 4936 if (v.size()!=2) 4937 return gensizeerr(gettext("bad pow ")+args.print(contextptr)); 4938 const gen & a =v.front(); 4939 const gen & b =v.back(); 4940 // fast check for monomials, do not recreate the vector 4941 if (b.type==_INT_){ 4942 #ifdef COMPILE_FOR_STABILITY 4943 if (b.val > FACTORIAL_SIZE_LIMIT) 4944 setstabilityerr(contextptr); 4945 #endif 4946 if (b.val==1) 4947 return a; 4948 if (a.type==_IDNT){ 4949 if (a==undef) 4950 return a; 4951 if (a!=unsigned_inf) 4952 return b.val?symbolic(at_pow,args):gen(1); 4953 } 4954 if (a.type==_SYMB && !is_inf(a) && (a._SYMBptr->sommet==at_plus || a._SYMBptr->sommet==at_prod)){ 4955 return b.val?symbolic(at_pow,args):gen(1); 4956 } 4957 } 4958 return pow(a,b,contextptr); 4959 } 4960 /* derivative of ^ is handled in derive.cc 4961 static gen d1_pow(const gen & args,GIAC_CONTEXT){ 4962 if (args.type!=_VECT) 4963 return gensizeerr(contextptr); 4964 vecteur & v=*args._VECTptr; 4965 if (v.size()!=2) 4966 return gensizeerr(gettext("bad pow ")+args.print(contextptr)); 4967 if (v[1].type<=_REAL) 4968 return v[1]*pow(v[0],v[1]-1,contextptr); 4969 else 4970 return v[1]/v[0]*symbolic(at_pow,gen(v,_SEQ__VECT)); 4971 } 4972 static gen d2_pow(const gen & args,GIAC_CONTEXT){ 4973 if (args.type!=_VECT) 4974 return gensizeerr(contextptr); 4975 vecteur & v=*args._VECTptr; 4976 if (v.size()!=2) 4977 return gensizeerr(gettext("bad pow ")+args.print(contextptr)); 4978 return ln(v[0],contextptr)*pow(v[0],v[1],contextptr); 4979 } 4980 static define_unary_function_eval(d1_pow_eval,&d1_pow,"d1_pow"); 4981 define_unary_function_ptr( D1_pow,alias_D1_pow,&d1_pow_eval); 4982 static define_unary_function_eval(d2_pow_eval,&d2_pow,"d2_pow"); 4983 define_unary_function_ptr( D2_pow,alias_D2_pow,&d2_pow_eval); 4984 static unary_function_ptr d_pow(int i){ 4985 if (i==1) 4986 return D1_pow; 4987 if (i==2) 4988 return D2_pow; 4989 return gensizeerr(contextptr); 4990 return 0; 4991 } 4992 static const partial_derivative_multiargs D_pow(&d_pow); 4993 */ 4994 const char _pow_s []="^"; 4995 #ifndef GIAC_HAS_STO_38 4996 #if defined NSPIRE || defined FXCG 4997 define_unary_function_eval2_index (14,__pow,&_pow,_pow_s,&printsommetasoperator); 4998 #else 4999 unary_function_eval __pow(14,&_pow,0,_pow_s,&printsommetasoperator,0); 5000 #endif 5001 #else 5002 Defineunary_function_eval(__pow, 14, &_pow, 0, _pow_s, &printsommetasoperator, 14); 5003 #define __pow (*((unary_function_eval*)&unary__pow)) 5004 #endif 5005 define_unary_function_ptr( at_pow ,alias_at_pow ,&__pow); 5006 5007 // print power like a^b (args==1), pow(a,b) (args==0) or a**b (args==-1) _printpow(const gen & args,GIAC_CONTEXT)5008 static gen _printpow(const gen & args,GIAC_CONTEXT){ 5009 #if defined NSPIRE || defined FXCG 5010 return undef; 5011 #else 5012 if ( args.type==_STRNG && args.subtype==-1) return args; 5013 if (is_zero(args,contextptr)){ 5014 __pow.printsommet=&cprintaspow; 5015 return string2gen("pow",false); 5016 } 5017 else { 5018 __pow.printsommet=&printsommetasoperator; 5019 if (is_minus_one(args)) 5020 __pow.s="**"; 5021 else 5022 __pow.s="^"; 5023 return string2gen(__pow.s,false); 5024 } 5025 #endif 5026 } 5027 static const char _printpow_s []="printpow"; 5028 static define_unary_function_eval (__printpow,&_printpow,_printpow_s); 5029 define_unary_function_ptr5( at_printpow ,alias_at_printpow,&__printpow,0,true); 5030 5031 // static symbolic symb_powmod(const gen & a,const gen & b,const gen & n){ return symbolic(at_powmod,makevecteur(a,b,n)); } symb_powmod(const gen & a)5032 static symbolic symb_powmod(const gen & a){ 5033 return symbolic(at_powmod,a); 5034 } findmod(const gen & g)5035 static gen findmod(const gen & g){ 5036 if (g.type==_MOD) 5037 return *(g._MODptr+1); 5038 if (g.type==_VECT){ 5039 gen res; 5040 const_iterateur it=g._VECTptr->begin(),itend=g._VECTptr->end(); 5041 for (;it!=itend;++it){ 5042 res=findmod(*it); 5043 if (!is_exactly_zero(res)) 5044 return res; 5045 } 5046 } 5047 if (g.type==_SYMB) 5048 return findmod(g._SYMBptr->feuille); 5049 return 0; 5050 } _powmod(const gen & args,GIAC_CONTEXT)5051 gen _powmod(const gen & args,GIAC_CONTEXT){ 5052 if ( args.type==_STRNG && args.subtype==-1) return args; 5053 int s; 5054 if ( args.type!=_VECT || (s=int(args._VECTptr->size()))<3 ) 5055 return symb_powmod(args); 5056 vecteur v = *args._VECTptr; 5057 gen a=v.front(); 5058 is_integral(a); 5059 gen n=v[1]; 5060 if (n.type==_VECT){ 5061 vecteur w =*n._VECTptr; 5062 iterateur it=w.begin(),itend=w.end(); 5063 for (;it!=itend;++it){ 5064 v[1]=*it; 5065 *it=_powmod(gen(v,_SEQ__VECT),contextptr); 5066 } 5067 return gen(w,n.subtype); 5068 } 5069 if (!is_integral(n) || !is_integer(n)) 5070 return symb_powmod(args); 5071 gen m=v[2]; 5072 is_integral(m); 5073 if (s==3 && m.type!=_SYMB) // a^n mod m 5074 return powmod(v.front(),v[1],m); 5075 // powmod(a_x%m,n,p_x) or powmod(a_x,n,m,p_x,x) 5076 // a^n mod p,m or m,p or a^n mod p,m,x or m,p,x wrt var x 5077 gen var(vx_var),p; 5078 bool modafter=false; 5079 p=unmod(m); 5080 m=findmod(m); 5081 if (is_zero(m)){ 5082 // find m inside a 5083 m=findmod(a); 5084 } 5085 modafter=!is_zero(m); 5086 a=unmod(a); 5087 if (modafter && s>3) 5088 var=v[3]; 5089 if (!modafter && s>3){ 5090 m=v[2]; 5091 p=v[3]; 5092 if (is_integer(p)){ 5093 p=v[2]; m=v[3]; 5094 } 5095 } 5096 gen m1=findmod(p); 5097 if (!is_zero(m1)){ 5098 if (is_zero(m)) 5099 m=m1; 5100 else if (m1!=m) 5101 return gensizeerr(contextptr); 5102 } 5103 p=unmod(p); 5104 if (s>=5) 5105 var=v[4]; 5106 vecteur lv(1,var); 5107 lvar(v,lv); 5108 if (lv.size()!=1) 5109 *logptr(contextptr) << gettext("Too many variables ")+gen(lv).print(contextptr) << '\n'; 5110 gen aa=e2r(a,lv,contextptr),aan,aad,bb=e2r(p,lv,contextptr),bbn,bbd; 5111 fxnd(aa,aan,aad); 5112 if ( (aad.type==_POLY) && (aad._POLYptr->lexsorted_degree() ) ) 5113 return gensizeerr(contextptr); 5114 fxnd(bb,bbn,bbd); 5115 if ( (bbd.type==_POLY) && (bbd._POLYptr->lexsorted_degree() ) ) 5116 return gensizeerr(contextptr); 5117 if (bbn.type!=_POLY) 5118 return gensizeerr(contextptr); 5119 modpoly A; 5120 if (aan.type==_POLY) 5121 A=polynome2poly1(*aan._POLYptr); 5122 else 5123 A.push_back(aan); 5124 modpoly B=polynome2poly1(*bbn._POLYptr); 5125 environment env; 5126 if (!is_zero(m)){ 5127 env.moduloon=true; 5128 env.modulo=m; 5129 } 5130 // if (!B.empty() && !is_zero(m)) mulmodpoly(B,invmod(B.front(),m),&env,B); 5131 modpoly res=powmod(A,n,B,&env); 5132 polynome R; 5133 if (lv.size()==1) 5134 R=poly12polynome(res); 5135 else 5136 R=poly12polynome(res,1,int(lv.size())); 5137 if (modafter) 5138 modularize(R,m); 5139 gen Res=r2e(R,lv,contextptr)/pow(r2e(aad,lv,contextptr),n,contextptr); 5140 return Res; 5141 } 5142 static const char _powmod_s []="powmod"; 5143 static define_unary_function_eval (__powmod,&_powmod,_powmod_s); 5144 define_unary_function_ptr5( at_powmod ,alias_at_powmod,&__powmod,0,true); 5145 symb_inferieur_strict(const gen & a,const gen & b)5146 symbolic symb_inferieur_strict(const gen & a,const gen & b){ 5147 return symbolic(at_inferieur_strict,gen(makevecteur(a,b),_SEQ__VECT)); 5148 } symb_inferieur_strict(const gen & a)5149 symbolic symb_inferieur_strict(const gen & a){ 5150 return symbolic(at_inferieur_strict,a); 5151 } _inferieur_strict(const gen & args,GIAC_CONTEXT)5152 gen _inferieur_strict(const gen & args,GIAC_CONTEXT){ 5153 if ( args.type==_STRNG && args.subtype==-1) return args; 5154 if (args.type!=_VECT) 5155 return symb_inferieur_strict(args); 5156 gen res=inferieur_strict(args._VECTptr->front(),args._VECTptr->back(),contextptr); 5157 if (res.type==_INT_ 5158 #ifdef GIAC_HAS_STO_38 5159 && abs_calc_mode(contextptr)!=38 5160 #endif 5161 ) 5162 res.subtype=_INT_BOOLEAN; 5163 return res; 5164 } 5165 static const char _inferieur_strict_s []="<"; 5166 static define_unary_function_eval4_index (70,__inferieur_strict,&_inferieur_strict,_inferieur_strict_s,&printsommetasoperator,&texprintsommetasoperator); 5167 define_unary_function_ptr( at_inferieur_strict ,alias_at_inferieur_strict ,&__inferieur_strict); 5168 symb_inferieur_egal(const gen & a,const gen & b)5169 symbolic symb_inferieur_egal(const gen & a,const gen & b){ 5170 return symbolic(at_inferieur_egal,gen(makevecteur(a,b),_SEQ__VECT)); 5171 } symb_inferieur_egal(const gen & a)5172 symbolic symb_inferieur_egal(const gen & a){ 5173 return symbolic(at_inferieur_egal,a); 5174 } printasinferieur_egal(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)5175 static string printasinferieur_egal(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 5176 if (xcas_mode(contextptr) > 0 || abs_calc_mode(contextptr)!=38) 5177 return printsommetasoperator(feuille,"<=",contextptr); 5178 else 5179 return printsommetasoperator(feuille,"≤",contextptr); 5180 } _inferieur_egal(const gen & args,GIAC_CONTEXT)5181 gen _inferieur_egal(const gen & args,GIAC_CONTEXT){ 5182 if ( args.type==_STRNG && args.subtype==-1) return args; 5183 if (args.type!=_VECT) 5184 return symb_inferieur_egal(args); 5185 gen res=inferieur_egal(args._VECTptr->front(), args._VECTptr->back(),contextptr); 5186 if (res.type==_INT_ && abs_calc_mode(contextptr)!=38) 5187 res.subtype=_INT_BOOLEAN; 5188 return res; 5189 } 5190 static const char _inferieur_egal_s []="<=";//"≤"; texprintasinferieur_egal(const gen & g,const char * s,GIAC_CONTEXT)5191 static string texprintasinferieur_egal(const gen & g,const char * s,GIAC_CONTEXT){ 5192 return texprintsommetasoperator(g,"\\leq ",contextptr); 5193 } 5194 static define_unary_function_eval4_index (72,__inferieur_egal,&_inferieur_egal,_inferieur_egal_s,&printasinferieur_egal,&texprintasinferieur_egal); 5195 define_unary_function_ptr( at_inferieur_egal ,alias_at_inferieur_egal ,&__inferieur_egal); 5196 symb_superieur_strict(const gen & a,const gen & b)5197 symbolic symb_superieur_strict(const gen & a,const gen & b){ 5198 return symbolic(at_superieur_strict,gen(makevecteur(a,b),_SEQ__VECT)); 5199 } symb_superieur_strict(const gen & a)5200 symbolic symb_superieur_strict(const gen & a){ 5201 return symbolic(at_superieur_strict,a); 5202 } _superieur_strict(const gen & args,GIAC_CONTEXT)5203 gen _superieur_strict(const gen & args,GIAC_CONTEXT){ 5204 if ( args.type==_STRNG && args.subtype==-1) return args; 5205 if (args.type!=_VECT) 5206 return symb_superieur_strict(args); 5207 gen res(superieur_strict(args._VECTptr->front(),args._VECTptr->back(),contextptr)); 5208 if (res.type==_INT_ && abs_calc_mode(contextptr)!=38) 5209 res.subtype=_INT_BOOLEAN; 5210 return res; 5211 } 5212 static const char _superieur_strict_s []=">"; 5213 static define_unary_function_eval4_index (74,__superieur_strict,&_superieur_strict,_superieur_strict_s,&printsommetasoperator,&texprintsommetasoperator); 5214 define_unary_function_ptr( at_superieur_strict ,alias_at_superieur_strict ,&__superieur_strict); 5215 printassuperieur_egal(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)5216 static string printassuperieur_egal(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 5217 if (xcas_mode(contextptr) > 0 || abs_calc_mode(contextptr)!=38) 5218 return printsommetasoperator(feuille,">=",contextptr); 5219 else 5220 return printsommetasoperator(feuille,"≥",contextptr); 5221 } 5222 symb_superieur_egal(const gen & a,const gen & b)5223 symbolic symb_superieur_egal(const gen & a,const gen & b){ 5224 return symbolic(at_superieur_egal,gen(makevecteur(a,b),_SEQ__VECT)); 5225 } symb_superieur_egal(const gen & a)5226 symbolic symb_superieur_egal(const gen & a){ 5227 return symbolic(at_superieur_egal,a); 5228 } _superieur_egal(const gen & args,GIAC_CONTEXT)5229 gen _superieur_egal(const gen & args,GIAC_CONTEXT){ 5230 if ( args.type==_STRNG && args.subtype==-1) return args; 5231 if (args.type!=_VECT) 5232 return symb_superieur_egal(args); 5233 gen res=superieur_egal(args._VECTptr->front(), args._VECTptr->back(),contextptr); 5234 if (res.type==_INT_ && abs_calc_mode(contextptr)!=38) 5235 res.subtype=_INT_BOOLEAN; 5236 return res; 5237 } 5238 static const char _superieur_egal_s []=">="; // "≥"; texprintassuperieur_egal(const gen & g,const char * s,GIAC_CONTEXT)5239 static string texprintassuperieur_egal(const gen & g,const char * s,GIAC_CONTEXT){ 5240 return texprintsommetasoperator(g,"\\geq ",contextptr); 5241 } 5242 static define_unary_function_eval4_index (76,__superieur_egal,&_superieur_egal,_superieur_egal_s,&printassuperieur_egal,&texprintassuperieur_egal); 5243 define_unary_function_ptr( at_superieur_egal ,alias_at_superieur_egal ,&__superieur_egal); 5244 printasdifferent(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)5245 static string printasdifferent(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 5246 if (xcas_mode(contextptr) > 0 || abs_calc_mode(contextptr)!=38) 5247 return printsommetasoperator(feuille,python_compat(contextptr)?"!=":"<>",contextptr); 5248 else 5249 return printsommetasoperator(feuille,"≠",contextptr); 5250 } 5251 // static symbolic symb_different(const gen & a,const gen & b){ return symbolic(at_different,makevecteur(a,b)); } symb_different(const gen & a)5252 static symbolic symb_different(const gen & a){ 5253 return symbolic(at_different,a); 5254 } _different(const gen & args,GIAC_CONTEXT)5255 gen _different(const gen & args,GIAC_CONTEXT){ 5256 if ( args.type==_STRNG && args.subtype==-1) return args; 5257 if (args.type!=_VECT) 5258 return symb_different(args); 5259 gen res; 5260 #if 1 5261 res=_same(args,contextptr); 5262 if (res.type==_INT_) 5263 return !res; 5264 #endif 5265 res=args._VECTptr->front() != args._VECTptr->back(); 5266 if (res.type==_INT_ && abs_calc_mode(contextptr)!=38) 5267 res.subtype=_INT_BOOLEAN; 5268 return res; 5269 } 5270 static const char _different_s []="!="; 5271 static define_unary_function_eval2_index (78,__different,&_different,_different_s,&printasdifferent); 5272 define_unary_function_ptr( at_different ,alias_at_different ,&__different); 5273 printasof_(const gen & feuille,const char * sommetstr,int format,GIAC_CONTEXT)5274 static string printasof_(const gen & feuille,const char * sommetstr,int format,GIAC_CONTEXT){ 5275 if ( (feuille.type!=_VECT) || (feuille._VECTptr->size()!=2) ) 5276 return string(sommetstr)+('('+gen2string(feuille,format,contextptr)+')'); 5277 string s=print_with_parenthesis_if_required(feuille._VECTptr->front(),format,contextptr)+'('; 5278 gen & g=feuille._VECTptr->back(); 5279 if (format==0 && g.type==_VECT && g.subtype==_SEQ__VECT) 5280 return s+printinner_VECT(*g._VECTptr,_SEQ__VECT,contextptr)+')'; 5281 else 5282 return s+gen2string(g,format,contextptr)+')'; 5283 } texprintasof(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)5284 static string texprintasof(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 5285 return printasof_(feuille,sommetstr,1,contextptr); 5286 } printasof(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)5287 static string printasof(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 5288 return printasof_(feuille,sommetstr,0,contextptr); 5289 } 5290 // Find the best interpretation of a(b) either as a function of or as a product (implicit *) 5291 warn_implicit(const gen & a,const gen & b,GIAC_CONTEXT)5292 static bool warn_implicit(const gen & a,const gen &b,GIAC_CONTEXT){ 5293 if (abs_calc_mode(contextptr)==38) 5294 return false; 5295 if (contains(lidnt(b),i__IDNT_e)) 5296 *logptr(contextptr) << gettext("Implicit multiplication does not work with complex numbers.")<<'\n'; 5297 else 5298 *logptr(contextptr) << gettext("Warning : using implicit multiplication for (") << a.print(contextptr) << ")(" << b.print(contextptr) << ')' << '\n'; 5299 return true; 5300 } check_symb_of(const gen & a,const gen & b0,GIAC_CONTEXT)5301 gen check_symb_of(const gen& a,const gen & b0,GIAC_CONTEXT){ 5302 if ( (a.type<_IDNT || a.type==_FLOAT_) && b0.type==_VECT && b0._VECTptr->empty()) 5303 return a; 5304 gen b(b0); 5305 if (b0.type==_VECT && b0.subtype==_SEQ__VECT && b0._VECTptr->size()==1) 5306 b=b0._VECTptr->front(); 5307 if (a.type==_INT_ && a.subtype==_INT_MAPLECONVERSION && (a.val==_MAPLE_LIST || a== _SET__VECT)) 5308 return symbolic(at_convert,makesequence(gen2vecteur(b),a)); 5309 if (a.type<_IDNT || a.type==_FLOAT_){ 5310 if (!warn_implicit(a,b,contextptr)) 5311 return gensizeerr("Invalid implicit multiplication for ("+ a.print(contextptr)+")(" + b.print(contextptr)+')'); 5312 return a*b; 5313 } 5314 vecteur va(lvar(a)); 5315 if (va.empty()){ 5316 if (abs_calc_mode(contextptr)==38) 5317 return gensizeerr("Invalid implicit multiplication for ("+ a.print(contextptr)+")(" + b.print(contextptr)+')'); 5318 *logptr(contextptr) << "Warning, input parsed as a constant function " << a << " applied to " << b << '\n'; 5319 } 5320 if (!va.empty() && calc_mode(contextptr)==38){ 5321 // check names in va 5322 bool implicit=false; 5323 const_iterateur it=va.begin(),itend=va.end(); 5324 for (;it!=itend;++it){ 5325 if (it->type!=_IDNT){ 5326 #ifdef CAS38_DISABLED 5327 implicit=true; 5328 #else 5329 implicit=it->type!=_SYMB; 5330 #endif 5331 continue; 5332 } 5333 const char * ch = it->_IDNTptr->id_name; 5334 if (strlen(ch)==2 && (ch[0]=='F' || ch[0]=='R' || ch[0]=='X' || ch[0]=='Y') ) 5335 return symb_of(a,b); 5336 if (strlen(ch)==1 && ch[0]<='a') 5337 implicit=true; 5338 } 5339 if (implicit){ 5340 if (!warn_implicit(a,b,contextptr)) 5341 return gensizeerr("Invalid implicit multiplication for ("+ a.print(contextptr)+")(" + b.print(contextptr)+')'); 5342 return a*b; 5343 } 5344 } 5345 vecteur vb(lvar(b)); 5346 vecteur vab(lvar(makevecteur(a,b))); 5347 if (vab.size()==va.size()+vb.size()){ 5348 vecteur lvarxb; 5349 if (va.size()!=1 || va.front().type!=_IDNT || (lvarxb=lvarx(b,va.front())).empty() || !lop(lvarxb,at_of).empty()) 5350 return symb_of(a,b); 5351 } 5352 if (!warn_implicit(a,b,contextptr)) 5353 return gensizeerr("Invalid implicit multiplication for ("+ a.print(contextptr)+")(" + b.print(contextptr)+')'); 5354 return a*b; 5355 } symb_of(const gen & a,const gen & b)5356 symbolic symb_of(const gen & a,const gen & b){ 5357 if (b.type==_VECT && b.subtype==_SEQ__VECT && b._VECTptr->size()==1) 5358 return symbolic(at_of,gen(makevecteur(a,b._VECTptr->front()),_SEQ__VECT)); 5359 return symbolic(at_of,gen(makevecteur(a,b),_SEQ__VECT)); 5360 } symb_of(const gen & a)5361 symbolic symb_of(const gen & a){ 5362 gen aa(a); 5363 if (aa.type==_VECT) 5364 aa.subtype=_SEQ__VECT; 5365 return symbolic(at_of,aa); 5366 } tri2_(const char * a,const char * b)5367 static bool tri2_(const char * a,const char * b){ 5368 return strcmp(a,b)<0; 5369 } 5370 5371 // Keep alphabetically sorted 5372 static const char * const aspen_quoted_name_tab[]={ 5373 "AREA", 5374 "Do1VStats", 5375 "Do2VStats", 5376 "DoFinance", 5377 "EXTREMUM", 5378 "ISECT", 5379 "RECURSE", 5380 "ROOT", 5381 "SLOPE", 5382 "SOLVE", 5383 "SetDepend", 5384 "SetFreq", 5385 "SetIndep", 5386 "SetSample", 5387 }; 5388 static const char * const * const aspen_quoted_name_tab_end=aspen_quoted_name_tab+sizeof(aspen_quoted_name_tab)/sizeof(char *); eval_except_equal(const gen & b,GIAC_CONTEXT)5389 gen eval_except_equal(const gen & b,GIAC_CONTEXT){ 5390 if (b.is_symb_of_sommet(at_equal)){ 5391 gen &f =b._SYMBptr->feuille; 5392 if (f.type==_VECT && f._VECTptr->size()==2 && f._VECTptr->front().type==_IDNT) 5393 return symb_equal(f._VECTptr->front(),eval_except_equal(f._VECTptr->back(),contextptr)); 5394 } 5395 if (b.type==_VECT){ 5396 vecteur v=*b._VECTptr; 5397 for (int i=0;i<int(v.size());++i) 5398 v[i]=eval_except_equal(v[i],contextptr); 5399 return gen(v,b.subtype); 5400 } 5401 if (approx_mode(contextptr)) 5402 return b.evalf(eval_level(contextptr),contextptr); 5403 else 5404 return b.eval(eval_level(contextptr),contextptr); 5405 } _of(const gen & args,const context * contextptr)5406 gen _of(const gen & args,const context * contextptr){ 5407 gen qf,b,f,value; 5408 // *logptr(contextptr) << &qf << '\n'; 5409 if ( args.type==_STRNG && args.subtype==-1) return args; 5410 if (args.type!=_VECT) 5411 return symb_of(args); 5412 qf=args._VECTptr->front(); 5413 b=args._VECTptr->back(); 5414 bool quoteb=false; 5415 #ifdef GIAC_HAS_STO_38 5416 if (qf.type==_IDNT){ 5417 std::pair<const char * const * const,const char * const * const> pp=equal_range(aspen_quoted_name_tab,aspen_quoted_name_tab_end,qf._IDNTptr->id_name,tri2_); 5418 if (pp.first!=pp.second && !strcmp(*pp.first,qf._IDNTptr->id_name)){ 5419 quoteb=true; 5420 } 5421 } 5422 #endif 5423 if (!quoteb) 5424 b=eval_except_equal(b,contextptr); 5425 /* 5426 if (qf.type!=_IDNT || !(strcmp(qf._IDNTptr->id_name,"RECURSE")==0 || 5427 strcmp(qf._IDNTptr->id_name,"SOLVE")==0 || 5428 strcmp(qf._IDNTptr->id_name,"Do2VStats")==0 || 5429 strcmp(qf._IDNTptr->id_name,"Do1VStats")==0 5430 ) 5431 ) 5432 b=b.eval(eval_level(contextptr),contextptr); 5433 */ 5434 if (storcl_38){ 5435 if (qf.type==_IDNT){ 5436 if (storcl_38(value,0,qf._IDNTptr->id_name,b,true,contextptr,NULL,false)){ 5437 return value; 5438 } 5439 } 5440 if (qf.is_symb_of_sommet(at_double_deux_points)){ 5441 f=qf._SYMBptr->feuille; 5442 if (f.type==_VECT && (*f._VECTptr)[0].type==_IDNT && (*f._VECTptr)[1].type==_IDNT){ 5443 if (storcl_38(value,(*f._VECTptr)[0]._IDNTptr->id_name,(*f._VECTptr)[1]._IDNTptr->id_name,b,true,contextptr,NULL,false)){ 5444 return value; 5445 } 5446 } 5447 } 5448 } 5449 #if 1 5450 vecteur v0(lop(qf,at_derive)); 5451 if (!v0.empty()){ 5452 vecteur v1,v2; 5453 for (int i=0;i<v0.size();++i){ 5454 if (v0[i]._SYMBptr->feuille.type!=_VECT){ 5455 v1.push_back(v0[i]); 5456 v2.push_back(symbolic(at_function_diff,v0[i]._SYMBptr->feuille)); 5457 } 5458 } 5459 if (!v1.empty()) 5460 qf=subst(qf,v1,v2,true,contextptr); 5461 } 5462 #endif 5463 f=qf.eval(eval_level(contextptr),contextptr); 5464 if (f.is_symb_of_sommet(at_struct_dot) && f._SYMBptr->feuille.type==_VECT && f._SYMBptr->feuille._VECTptr->size()==2){ 5465 gen v=f._SYMBptr->feuille._VECTptr->front(),op=f._SYMBptr->feuille._VECTptr->back(); 5466 gen ve=eval(v,eval_level(contextptr),contextptr); 5467 if (b.type==_VECT && b.subtype==_SEQ__VECT && b._VECTptr->empty()) 5468 ; 5469 else 5470 ve=makesuite(ve,b._SYMBptr->feuille); 5471 ve=op(ve,contextptr); 5472 return sto(ve,v,contextptr); 5473 } 5474 if (f.type<=_POLY || f.type==_FRAC || f.type==_FLOAT_) 5475 *logptr(contextptr) << "Warning, constant function " << f << " applied to " << b << '\n'; 5476 if ( f.is_symb_of_sommet(at_program) && qf.type==_IDNT ){ 5477 value=f._SYMBptr->feuille; 5478 if (value.type!=_VECT) 5479 return gensizeerr(contextptr); 5480 value=gen(*value._VECTptr,value.subtype); // clone 5481 #ifdef GIAC_DEFAULT_ARGS 5482 gen v1=(*value._VECTptr)[1]; 5483 vecteur v1v(1,v1); 5484 if (v1.type==_VECT && v1.subtype==_SEQ__VECT) 5485 v1v=*v1._VECTptr; 5486 vecteur bv(1,b); 5487 if (b.type==_VECT && b.subtype==_SEQ__VECT) 5488 bv=*b._VECTptr; 5489 if (bv.size()<v1v.size()) 5490 bv=mergevecteur(bv,vecteur(v1v.begin()+bv.size(),v1v.end())); 5491 if (v1.type!=_VECT && bv.size()==1) 5492 b=bv.front(); 5493 else 5494 b=gen(v1v,v1.subtype); 5495 #endif 5496 (*value._VECTptr)[1]=b; 5497 // vecteur v=(*value._VECTptr); 5498 // v[1]=b; 5499 // value=gen(v,value.subtype); 5500 return _program(value,qf,contextptr); 5501 } 5502 return f(b,contextptr); 5503 } 5504 static const char _of_s []="of"; 5505 static define_unary_function_eval4_index (163,__of,&_of,_of_s,&printasof,&texprintasof); 5506 define_unary_function_ptr5( at_of ,alias_at_of,&__of,_QUOTE_ARGUMENTS,0); 5507 gen2string(const gen & g,int format,GIAC_CONTEXT)5508 string gen2string(const gen & g,int format,GIAC_CONTEXT){ 5509 if (format==1) 5510 return gen2tex(g,contextptr); 5511 else 5512 return g.print(contextptr); 5513 } 5514 print_with_parenthesis_if_required(const gen & g,int format,GIAC_CONTEXT)5515 string print_with_parenthesis_if_required(const gen & g,int format,GIAC_CONTEXT){ 5516 if (g.type==_SYMB || g.type==_FRAC || g.type==_CPLX || (g.type==_VECT && g.subtype==_SEQ__VECT) ) 5517 return '('+gen2string(g,format,contextptr)+')'; 5518 else 5519 return gen2string(g,format,contextptr); 5520 } 5521 printasat_(const gen & feuille,const char * sommetstr,int format,GIAC_CONTEXT)5522 static string printasat_(const gen & feuille,const char * sommetstr,int format,GIAC_CONTEXT){ 5523 if ( (feuille.type!=_VECT) || (feuille._VECTptr->size()!=2) ) 5524 return string(sommetstr)+('('+gen2string(feuille,format,contextptr)+')'); 5525 vecteur & v=*feuille._VECTptr; 5526 if (v.back().type!=_STRNG && array_start(contextptr)){ //(xcas_mode(contextptr) > 0 || abs_calc_mode(contextptr)==38)){ 5527 gen indice; 5528 if (v.back().type==_VECT) 5529 indice=v.back()+vecteur(v.size(),plus_one); 5530 else 5531 indice=v.back()+plus_one; 5532 string s; 5533 return print_with_parenthesis_if_required(v.front(),format,contextptr)+'['+gen2string(indice,format,contextptr)+']'; 5534 } 5535 else 5536 return print_with_parenthesis_if_required(feuille._VECTptr->front(),format,contextptr)+'['+gen2string(feuille._VECTptr->back(),format,contextptr)+']'; 5537 } 5538 printasat(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)5539 static string printasat(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 5540 return printasat_(feuille,sommetstr,0,contextptr); 5541 } texprintasat(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)5542 static string texprintasat(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 5543 return printasat_(feuille,sommetstr,1,contextptr); 5544 } symb_at(const gen & a,const gen & b,GIAC_CONTEXT)5545 symbolic symb_at(const gen & a,const gen & b,GIAC_CONTEXT){ 5546 if (array_start(contextptr)){ //xcas_mode(contextptr) || abs_calc_mode(contextptr)==38){ 5547 gen bb; 5548 if (b.type==_VECT) 5549 bb=b-vecteur(b._VECTptr->size(),plus_one); 5550 else 5551 bb=b-plus_one; 5552 return symbolic(at_at,gen(makevecteur(a,bb),_SEQ__VECT)); 5553 } 5554 else 5555 return symbolic(at_at,gen(makevecteur(a,b),_SEQ__VECT)); 5556 } symb_at(const gen & a)5557 symbolic symb_at(const gen & a){ 5558 gen aa(a); 5559 if (aa.type==_VECT) 5560 aa.subtype=_SEQ__VECT; 5561 return symbolic(at_at,aa); 5562 } _at(const gen & args,GIAC_CONTEXT)5563 gen _at(const gen & args,GIAC_CONTEXT){ 5564 if ( args.type==_STRNG && args.subtype==-1) return args; 5565 if (args.type!=_VECT) 5566 return symb_at(args); 5567 vecteur & v=*args._VECTptr; 5568 if (v.size()!=2) 5569 return gensizeerr(contextptr); 5570 static bool alert_array_start=true; 5571 if (alert_array_start && contextptr && contextptr->globalptr->_python_compat_){ 5572 alert_array_start=false; 5573 #ifdef GIAC_HAS_STO_38 5574 alert(gettext("Python compatibility enabled. List index will start at 0, run index:=1 or of:=1 to disable Python compatibility."),contextptr); 5575 #else 5576 *logptr(contextptr) << gettext("Python compatibility enabled. List index will start at 0, run index:=1 or python_compat(0) to disable Python compatibility.") << '\n'; 5577 #endif 5578 } 5579 if (storcl_38){ 5580 if (v.front().type==_IDNT){ 5581 gen value; 5582 if (storcl_38(value,0,v.front()._IDNTptr->id_name,v.back(),false,contextptr,NULL,false)){ //CdB v.back() is actually never used because the at_of paramter is false. Is that intended? 5583 return value; 5584 } 5585 } 5586 if (v.front().is_symb_of_sommet(at_double_deux_points)){ 5587 gen & f=v.front()._SYMBptr->feuille; 5588 if (f[0].type==_IDNT && f[1].type==_IDNT){ 5589 gen value; 5590 if (storcl_38(value,f[0]._IDNTptr->id_name,f[1]._IDNTptr->id_name,v.back(),false,contextptr,NULL,false)){ //CdB v.back() is actually never used because the at_of paramter is false. Is that intended? 5591 return value; 5592 } 5593 } 5594 } 5595 } 5596 gen a=v.front().eval(eval_level(contextptr),contextptr); 5597 gen b=v.back().eval(eval_level(contextptr),contextptr); 5598 if (a.type==_MAP){ 5599 gen_map::const_iterator it=a._MAPptr->find(b),itend=a._MAPptr->end(); 5600 if (it!=itend) 5601 return it->second; 5602 // if (a.subtype==_SPARSE_MATRIX) 5603 return 0; 5604 //return symb_at(makevecteur(v.front(),b)); 5605 } 5606 return a.operator_at(b,contextptr); 5607 } 5608 static const char _at_s []="at"; 5609 static define_unary_function_eval4_index (165,__at,&_at,_at_s,&printasat,&texprintasat); 5610 define_unary_function_ptr5( at_at ,alias_at_at,&__at,_QUOTE_ARGUMENTS,0); 5611 _table(const gen & arg,GIAC_CONTEXT)5612 gen _table(const gen & arg,GIAC_CONTEXT){ 5613 if ( arg.type==_STRNG && arg.subtype==-1) return arg; 5614 if (ckmatrix(arg)){ 5615 gen_map m; 5616 gen g(m); 5617 convert(*arg._VECTptr,*g._MAPptr); 5618 return g; 5619 } 5620 vecteur v(gen2vecteur(arg)); 5621 const_iterateur it=v.begin(),itend=v.end(); 5622 #if 1 // def NSPIRE 5623 gen_map m; 5624 #else 5625 gen_map m(ptr_fun(islesscomplexthanf)); 5626 #endif 5627 for (;it!=itend;++it){ 5628 if (is_equal(*it) || it->is_symb_of_sommet(at_deuxpoints)){ 5629 gen & f =it->_SYMBptr->feuille; 5630 if (f.type==_VECT && f._VECTptr->size()==2){ 5631 vecteur & w=*f._VECTptr; 5632 gen bb=w.front(); 5633 if (array_start(contextptr)){ //(xcas_mode(contextptr) || abs_calc_mode(contextptr)==38)){ 5634 if (bb.type==_VECT) 5635 bb=bb-vecteur(bb._VECTptr->size(),plus_one); 5636 else 5637 bb=bb-plus_one; 5638 } 5639 m[bb]=w.back(); 5640 } 5641 } 5642 } 5643 return m; 5644 } 5645 static const char _table_s []="table"; 5646 static define_unary_function_eval (__table,&_table,_table_s); 5647 define_unary_function_ptr5( at_table ,alias_at_table,&__table,0,true); 5648 printasand(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)5649 string printasand(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 5650 if (abs_calc_mode(contextptr)==38) 5651 return printsommetasoperator(feuille," AND ",contextptr); 5652 if (calc_mode(contextptr)==1) 5653 return printsommetasoperator(feuille," && ",contextptr); 5654 if (xcas_mode(contextptr) > 0 || python_compat(contextptr)) 5655 return printsommetasoperator(feuille," and ",contextptr); 5656 else 5657 return "("+printsommetasoperator(feuille,sommetstr,contextptr)+")"; 5658 } texprintasand(const gen & g,const char * s,GIAC_CONTEXT)5659 string texprintasand(const gen & g,const char * s,GIAC_CONTEXT){ 5660 return texprintsommetasoperator(g,"\\mbox{ and }",contextptr); 5661 } symb_and(const gen & a,const gen & b)5662 symbolic symb_and(const gen & a,const gen & b){ 5663 return symbolic(at_and,gen(makevecteur(a,b),_SEQ__VECT)); 5664 } and2(const gen & a,const gen & b)5665 gen and2(const gen & a,const gen & b){ 5666 return a && b; 5667 } _and(const gen & arg,GIAC_CONTEXT)5668 gen _and(const gen & arg,GIAC_CONTEXT){ 5669 if ( arg.type==_STRNG && arg.subtype==-1) return arg; 5670 if (arg.type==_VECT && arg.subtype==_SEQ__VECT && arg._VECTptr->size()==2 && arg._VECTptr->front().type==_VECT) 5671 return apply(equaltosame(arg._VECTptr->front()).eval(eval_level(contextptr),contextptr),equaltosame(arg._VECTptr->back()).eval(eval_level(contextptr),contextptr),and2); 5672 gen args=apply(arg,equaltosame); 5673 if (arg.type!=_VECT || arg._VECTptr->empty()) 5674 return equaltosame(arg).eval(eval_level(contextptr),contextptr); 5675 vecteur::const_iterator it=arg._VECTptr->begin(),itend=arg._VECTptr->end(); 5676 gen res(eval(equaltosame(*it),eval_level(contextptr),contextptr)); 5677 ++it; 5678 for (;it!=itend;++it){ 5679 if (res.type==_INT_ && res.val==0) 5680 return res; 5681 res = res && eval(equaltosame(*it),eval_level(contextptr),contextptr); 5682 } 5683 return res; 5684 } 5685 static const char _and_s []="and"; 5686 static define_unary_function_eval4_index (67,__and,&_and,_and_s,&printasand,&texprintasand); 5687 define_unary_function_ptr5( at_and ,alias_at_and,&__and,_QUOTE_ARGUMENTS,T_AND_OP); 5688 texprintasor(const gen & g,const char * s,GIAC_CONTEXT)5689 string texprintasor(const gen & g,const char * s,GIAC_CONTEXT){ 5690 return texprintsommetasoperator(g,"\\mbox{ or }",contextptr); 5691 } printasor(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)5692 string printasor(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 5693 if (abs_calc_mode(contextptr)==38) 5694 return printsommetasoperator(feuille," OR ",contextptr); 5695 if (calc_mode(contextptr)==1) 5696 return printsommetasoperator(feuille," || ",contextptr); 5697 if (xcas_mode(contextptr) > 0 || python_compat(contextptr)) 5698 return printsommetasoperator(feuille," or ",contextptr); 5699 else 5700 return "("+printsommetasoperator(feuille,sommetstr,contextptr)+")"; 5701 } symb_ou(const gen & a,const gen & b)5702 symbolic symb_ou(const gen & a,const gen & b){ 5703 return symbolic(at_ou,gen(makevecteur(a,b),_SEQ__VECT)); 5704 } ou2(const gen & a,const gen & b)5705 gen ou2(const gen & a,const gen & b){ 5706 return a || b; 5707 } _ou(const gen & arg,GIAC_CONTEXT)5708 gen _ou(const gen & arg,GIAC_CONTEXT){ 5709 if ( arg.type==_STRNG && arg.subtype==-1) return arg; 5710 int el=eval_level(contextptr); 5711 if (arg.type==_VECT && arg.subtype==_SEQ__VECT && arg._VECTptr->size()==2 && arg._VECTptr->front().type==_VECT) 5712 return apply(equaltosame(arg._VECTptr->front()).eval(el,contextptr),equaltosame(arg._VECTptr->back()).eval(el,contextptr),ou2); 5713 if (arg.type!=_VECT || arg._VECTptr->empty()) 5714 return eval(equaltosame(arg),el,contextptr); 5715 vecteur::const_iterator it=arg._VECTptr->begin(),itend=arg._VECTptr->end(); 5716 gen res(eval(equaltosame(*it),el,contextptr)); 5717 ++it; 5718 for (;it!=itend;++it){ 5719 if (res.type==_INT_ && res.val) 5720 return res; 5721 res = res || eval(equaltosame(*it),el,contextptr); 5722 } 5723 return res; 5724 } 5725 static const char _ou_s []="or"; 5726 static define_unary_function_eval4_index (69,__ou,&_ou,_ou_s,&printasor,&texprintasor); 5727 define_unary_function_ptr5( at_ou ,alias_at_ou,&__ou,_QUOTE_ARGUMENTS,T_AND_OP); 5728 xor2(const gen & a,const gen & b,GIAC_CONTEXT)5729 gen xor2(const gen & a,const gen & b,GIAC_CONTEXT){ 5730 return is_zero(a,contextptr) ^ is_zero(b,contextptr); 5731 } _xor(const gen & arg,GIAC_CONTEXT)5732 gen _xor(const gen & arg,GIAC_CONTEXT){ 5733 if ( arg.type==_STRNG && arg.subtype==-1) return arg; 5734 if (arg.type==_VECT && arg.subtype==_SEQ__VECT && arg._VECTptr->size()==2) 5735 return apply( 5736 equaltosame(arg._VECTptr->front()).eval(eval_level(contextptr),contextptr), 5737 equaltosame(arg._VECTptr->back()).eval(eval_level(contextptr),contextptr), 5738 contextptr,xor2); 5739 gen args=eval(apply(arg,equaltosame),eval_level(contextptr),contextptr); 5740 if (args.type!=_VECT) 5741 return args; 5742 vecteur::const_iterator it=args._VECTptr->begin(),itend=args._VECTptr->end(); 5743 gen res=*it; 5744 ++it; 5745 for (;it!=itend;++it){ 5746 if (is_zero(res,contextptr)) 5747 res=*it; 5748 else 5749 res = !(*it); 5750 } 5751 return res; 5752 } 5753 #ifdef GIAC_HAS_STO_38 5754 static const char _xor_s []="XOR"; 5755 #else 5756 static const char _xor_s []=" xor "; 5757 #endif 5758 static define_unary_function_eval4_index (117,__xor,&_xor,_xor_s,&printsommetasoperator,&texprintsommetasoperator); 5759 define_unary_function_ptr5( at_xor ,alias_at_xor,&__xor,_QUOTE_ARGUMENTS,0); 5760 symb_min(const gen & a,const gen & b)5761 symbolic symb_min(const gen & a,const gen & b){ 5762 return symbolic(at_min,gen(makevecteur(a,b),_SEQ__VECT)); 5763 } _min(const gen & args,GIAC_CONTEXT)5764 gen _min(const gen & args,GIAC_CONTEXT){ 5765 if ( args.type==_STRNG && args.subtype==-1) return args; 5766 if (args.type!=_VECT) 5767 return args; 5768 if (args.type==_POLY){ 5769 vector< monomial<gen> >::const_iterator it=args._POLYptr->coord.begin(),itend=args._POLYptr->coord.end(); 5770 if (it==itend) 5771 return undef; 5772 gen m(it->value); 5773 for (++it;it!=itend;++it){ 5774 if (is_strictly_greater(m,it->value,contextptr)) 5775 m=it->value; 5776 } 5777 return m; 5778 } 5779 vecteur::const_iterator it=args._VECTptr->begin(),itend=args._VECTptr->end(); 5780 if (it==itend) 5781 return gendimerr(contextptr); 5782 if (ckmatrix(args)){ 5783 gen res=*it; 5784 for (++it;it!=itend;++it){ 5785 res=apply(res,*it,contextptr,min); 5786 } 5787 return res; 5788 } 5789 if (itend-it==2 && it->type==_VECT && (it+1)->type==_VECT ) 5790 return matrix_apply(*it,*(it+1),contextptr,min); 5791 gen res=*it; 5792 ++it; 5793 for (;it!=itend;++it) 5794 res = min(res,*it,contextptr); 5795 return res; 5796 } 5797 static const char _min_s []="min"; 5798 static define_unary_function_eval (giac__min,&_min,_min_s); 5799 define_unary_function_ptr5( at_min ,alias_at_min,&giac__min,0,true); 5800 symb_max(const gen & a,const gen & b)5801 symbolic symb_max(const gen & a,const gen & b){ 5802 return symbolic(at_max,gen(makevecteur(a,b),_SEQ__VECT)); 5803 } _max(const gen & args,GIAC_CONTEXT)5804 gen _max(const gen & args,GIAC_CONTEXT){ 5805 if ( args.type==_STRNG && args.subtype==-1) return args; 5806 if (args.type==_POLY){ 5807 vector< monomial<gen> >::const_iterator it=args._POLYptr->coord.begin(),itend=args._POLYptr->coord.end(); 5808 if (it==itend) 5809 return undef; 5810 gen m(it->value); 5811 for (++it;it!=itend;++it){ 5812 if (is_strictly_greater(it->value,m,contextptr)) 5813 m=it->value; 5814 } 5815 return m; 5816 } 5817 if (args.type!=_VECT) 5818 return args; 5819 vecteur::const_iterator it=args._VECTptr->begin(),itend=args._VECTptr->end(); 5820 if (itend==it) 5821 return undef;//gendimerr(contextptr); 5822 if (itend-it==1) 5823 return _max(*it,contextptr); 5824 if (ckmatrix(args)){ 5825 gen res=*it; 5826 for (++it;it!=itend;++it){ 5827 res=apply(res,*it,contextptr,max); 5828 } 5829 return res; 5830 } 5831 if (itend-it==2 && it->type==_VECT && (it+1)->type==_VECT ) 5832 return matrix_apply(*it,*(it+1),contextptr,max); 5833 gen res=*it; 5834 ++it; 5835 for (;it!=itend;++it) 5836 res = max(res,*it,contextptr); 5837 return res; 5838 } 5839 static const char _max_s []="max"; 5840 static define_unary_function_eval (giac__max,&_max,_max_s); 5841 define_unary_function_ptr5( at_max ,alias_at_max,&giac__max,0,true); 5842 step_gcd(int a,int b,GIAC_CONTEXT)5843 gen step_gcd(int a,int b,GIAC_CONTEXT){ 5844 gprintf("===============",vecteur(0),1,contextptr); 5845 gprintf("Euclide algorithm for %gen and %gen",makevecteur(a,b),1,contextptr); 5846 while (b){ 5847 int r=a%b; 5848 gprintf("%gen mod %gen = %gen",makevecteur(a,b,r),1,contextptr); 5849 a=b; 5850 b=r; 5851 } 5852 gprintf("gcd=%gen",makevecteur(a),1,contextptr); 5853 return a; 5854 } 5855 5856 // static symbolic symb_gcd(const gen & a,const gen & b){ return symbolic(at_gcd,makevecteur(a,b)); } _gcd(const gen & args,GIAC_CONTEXT)5857 gen _gcd(const gen & args,GIAC_CONTEXT){ 5858 if ( args.type==_STRNG && args.subtype==-1) return args; 5859 if (is_integer(args)) 5860 return abs(args,contextptr); 5861 if (args.type!=_VECT) 5862 return args; 5863 if (step_infolevel(contextptr) && args._VECTptr->size()==2 && args._VECTptr->front().type==_INT_ && args._VECTptr->back().type==_INT_) 5864 return step_gcd(args._VECTptr->front().val,args._VECTptr->back().val,contextptr); 5865 if (debug_infolevel>2) 5866 CERR << "gcd begin " << CLOCK() << '\n'; 5867 vecteur::const_iterator it=args._VECTptr->begin(),itend=args._VECTptr->end(); 5868 if (ckmatrix(args) && itend-it==2 && it->subtype!=_POLY1__VECT && (it+1)->subtype!=_POLY1__VECT) 5869 return apply(*it,*(it+1),contextptr,gcd); 5870 gen res(0); 5871 for (;it!=itend;++it) 5872 res=gcd(res,*it,contextptr); 5873 return res; 5874 } 5875 static const char _gcd_s []="gcd"; 5876 static define_unary_function_eval (__gcd,&_gcd,_gcd_s); 5877 define_unary_function_ptr5( at_gcd ,alias_at_gcd,&__gcd,0,true); 5878 5879 // static symbolic symb_lcm(const gen & a,const gen & b){ return symbolic(at_lcm,makevecteur(a,b)); } _lcm(const gen & args,GIAC_CONTEXT)5880 gen _lcm(const gen & args,GIAC_CONTEXT){ 5881 if ( args.type==_STRNG && args.subtype==-1) return args; 5882 if (args.type!=_VECT) 5883 return args; 5884 vecteur::const_iterator it=args._VECTptr->begin(),itend=args._VECTptr->end(); 5885 if (itend==it) 5886 return 1; 5887 if (ckmatrix(args) && itend-it==2 && it->subtype!=_POLY1__VECT && (it+1)->subtype!=_POLY1__VECT) 5888 return apply(*it,*(it+1),lcm); 5889 gen res(*it); 5890 for (++it;it!=itend;++it) 5891 res=lcm(res,*it); 5892 return res; 5893 } 5894 static const char _lcm_s []="lcm"; 5895 static define_unary_function_eval (__lcm,&_lcm,_lcm_s); 5896 define_unary_function_ptr5( at_lcm ,alias_at_lcm,&__lcm,0,true); 5897 5898 // static symbolic symb_egcd(const gen & a,const gen & b){ return symbolic(at_egcd,makevecteur(a,b)); } _egcd(const gen & args,GIAC_CONTEXT)5899 gen _egcd(const gen & args,GIAC_CONTEXT){ 5900 if ( args.type==_STRNG && args.subtype==-1) return args; 5901 if ( (args.type!=_VECT) || args._VECTptr->empty() ) 5902 return gensizeerr(contextptr); 5903 vecteur & a = *args._VECTptr; 5904 if ( (a.front().type==_VECT) && (a.back().type==_VECT) ){ 5905 vecteur u,v,d; 5906 egcd(*a.front()._VECTptr,*a.back()._VECTptr,0,u,v,d,epsilon(contextptr)==0); 5907 return gen(makevecteur(gen(u,_POLY1__VECT),gen(v,_POLY1__VECT),gen(d,_POLY1__VECT))); 5908 } 5909 vecteur lv; 5910 if (a.size()==3) 5911 lv=vecteur(1,vecteur(1,a[2])); 5912 else 5913 lv=vecteur(1,vecteur(1,vx_var)); 5914 alg_lvar(args,lv); 5915 gen aa=e2r(a[0],lv,contextptr),aan,aad,bb=e2r(a[1],lv,contextptr),bbn,bbd; 5916 fxnd(aa,aan,aad); 5917 if ( (aad.type==_POLY) && (aad._POLYptr->lexsorted_degree() ) ) 5918 return gensizeerr(contextptr); 5919 fxnd(bb,bbn,bbd); 5920 if ( (bbd.type==_POLY) && (bbd._POLYptr->lexsorted_degree() ) ) 5921 return gensizeerr(contextptr); 5922 gen u,v,d; 5923 if ( (aan.type==_POLY) && (bbn.type==_POLY) ){ 5924 polynome un(aan._POLYptr->dim),vn(aan._POLYptr->dim),dn(aan._POLYptr->dim); 5925 egcd(*aan._POLYptr,*bbn._POLYptr,un,vn,dn); 5926 u=un; 5927 v=vn; 5928 d=dn; 5929 } 5930 else { 5931 if (aan.type==_POLY){ 5932 u=zero; 5933 v=plus_one; 5934 d=bbn; 5935 } 5936 else { 5937 u=plus_one; 5938 v=zero; 5939 d=aan; 5940 } 5941 } 5942 u=r2e(u*aad,lv,contextptr); 5943 v=r2e(v*bbd,lv,contextptr); 5944 d=r2e(d,lv,contextptr); 5945 return makevecteur(u,v,d); 5946 } 5947 static const char _egcd_s []="egcd"; 5948 static define_unary_function_eval (__egcd,&_egcd,_egcd_s); 5949 define_unary_function_ptr5( at_egcd ,alias_at_egcd,&__egcd,0,true); 5950 5951 // static symbolic symb_iegcd(const gen & a,const gen & b){ return symbolic(at_iegcd,makevecteur(a,b)); } _iegcd(const gen & args,GIAC_CONTEXT)5952 gen _iegcd(const gen & args,GIAC_CONTEXT){ 5953 if ( args.type==_STRNG && args.subtype==-1) return args; 5954 if (!check_2d_vecteur(args)) return gensizeerr(contextptr); 5955 gen a(args._VECTptr->front()),b(args._VECTptr->back()),u,v,d; 5956 if (!is_integral(a) || !is_integral(b)) 5957 return gentypeerr(contextptr); 5958 if (a.type==_INT_ && b.type==_INT_ && step_infolevel(contextptr)) 5959 step_egcd(a.val,b.val,contextptr); 5960 egcd(a,b,u,v,d); 5961 return makevecteur(u,v,d); 5962 } 5963 static const char _iegcd_s []="iegcd"; 5964 static define_unary_function_eval (__iegcd,&_iegcd,_iegcd_s); 5965 define_unary_function_ptr5( at_iegcd ,alias_at_iegcd,&__iegcd,0,true); 5966 5967 static const char _bezout_entiers_s []="bezout_entiers"; 5968 static define_unary_function_eval (__bezout_entiers,&_iegcd,_bezout_entiers_s); 5969 define_unary_function_ptr5( at_bezout_entiers ,alias_at_bezout_entiers,&__bezout_entiers,0,true); 5970 symb_equal(const gen & a,const gen & b)5971 gen symb_equal(const gen & a,const gen & b){ 5972 return symbolic(at_equal,gen(makevecteur(a,b),_SEQ__VECT)); 5973 } printasequal(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)5974 static string printasequal(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 5975 if (python_compat(contextptr)) 5976 return "equal("+feuille.print(contextptr)+")"; 5977 #ifdef GIAC_HAS_STO_38 5978 return printsommetasoperator(feuille," = ",contextptr); 5979 #else 5980 return printsommetasoperator(feuille,"=",contextptr); 5981 #endif 5982 } _equal(const gen & a,GIAC_CONTEXT)5983 gen _equal(const gen & a,GIAC_CONTEXT){ 5984 if ( a.type==_STRNG && a.subtype==-1) return a; 5985 if (a.type!=_VECT || a._VECTptr->size()<2) 5986 return equal(a,gen(vecteur(0),_SEQ__VECT),contextptr); 5987 if (a._VECTptr->size()==2) 5988 return equal( (*(a._VECTptr))[0],(*(a._VECTptr))[1],contextptr ); 5989 if (a.subtype==_SEQ__VECT && calc_mode(contextptr)==1) 5990 return symb_equal(a._VECTptr->front(),gen(vecteur(a._VECTptr->begin()+1,a._VECTptr->end()),a.subtype)); 5991 return equal(gen(vecteur(a._VECTptr->begin(),a._VECTptr->end()-1),a.subtype),a._VECTptr->back(),contextptr); 5992 } 5993 static const char _equal_s []="="; 5994 static define_unary_function_eval4_index (80,__equal,&_equal,_equal_s,&printasequal,&texprintsommetasoperator); 5995 define_unary_function_ptr( at_equal ,alias_at_equal ,&__equal); 5996 _equal2(const gen & a,GIAC_CONTEXT)5997 gen _equal2(const gen & a,GIAC_CONTEXT){ 5998 if ( a.type==_STRNG && a.subtype==-1) return a; 5999 if ((a.type!=_VECT) || (a._VECTptr->size()!=2)) 6000 return equal2(a,gen(vecteur(0),_SEQ__VECT),contextptr); 6001 return equal2( (*(a._VECTptr))[0],(*(a._VECTptr))[1],contextptr); 6002 } 6003 static const char _equal2_s []="%="; 6004 static define_unary_function_eval4_index (168,__equal2,&_equal2,_equal2_s,&printsommetasoperator,&texprintsommetasoperator); 6005 define_unary_function_ptr( at_equal2 ,alias_at_equal2 ,&__equal2); 6006 printassame(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)6007 static string printassame(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 6008 if (xcas_mode(contextptr) > 0) 6009 return printsommetasoperator(feuille," = ",contextptr); 6010 else 6011 return "("+printsommetasoperator(feuille,sommetstr,contextptr)+")"; 6012 } symb_same(const gen & a,const gen & b)6013 symbolic symb_same(const gen & a,const gen & b){ 6014 return symbolic(at_same,gen(makevecteur(a,b),_SEQ__VECT)); 6015 } symb_same(const gen & a)6016 gen symb_same(const gen & a){ 6017 return symbolic(at_same,a); 6018 } 6019 bool same_warning=true; _same(const gen & a,GIAC_CONTEXT)6020 gen _same(const gen & a,GIAC_CONTEXT){ 6021 if ( a.type==_STRNG && a.subtype==-1) return a; 6022 if ((a.type!=_VECT) || (a._VECTptr->size()!=2)) 6023 return symb_same(a); 6024 gen res=undef; 6025 const gen & af=a._VECTptr->front(); 6026 const gen & ab=a._VECTptr->back(); 6027 if (af.type!=_FUNC && ab.type!=_FUNC && (af.type==_SYMB || ab.type==_SYMB)){ 6028 if (!is_inf(af) && !is_undef(af) && !is_inf(ab) && !is_undef(ab) && af.type!=_VECT &&ab.type!=_VECT ){ 6029 if (same_warning){ 6030 string s=autosimplify(contextptr); 6031 if (unlocalize(s)!="'simplify'"){ 6032 *logptr(contextptr) << gettext("Warning, the test a==b is performed by checking\nthat the internal representation of ") << s << gettext("(a-b) is not 0.\nTherefore a==b may return false even if a and b are mathematically equal,\nif they have different internal representations.\nYou can explicitly call a simplification function like simplify(a-b)==0 to avoid this.") << '\n'; 6033 same_warning=false; 6034 } 6035 } 6036 res=add_autosimplify(af-ab,contextptr); 6037 if (res.type==_SYMB) 6038 res=res._SYMBptr->sommet(res._SYMBptr->feuille,contextptr); 6039 res=is_zero(res,contextptr); 6040 } 6041 } 6042 if (is_undef(res)) 6043 res=operator_equal(af,ab,contextptr); 6044 if (res.type==_INT_ && abs_calc_mode(contextptr)!=38) 6045 res.subtype=_INT_BOOLEAN; 6046 return res; 6047 } 6048 static const char _same_s []="=="; 6049 static define_unary_function_eval4_index (148,__same,&_same,_same_s,&printassame,&texprintsommetasoperator); 6050 define_unary_function_ptr( at_same ,alias_at_same ,&__same); 6051 6052 // ****************** 6053 // Arithmetic functions 6054 // ***************** 6055 6056 // symbolic symb_smod(const gen & a,const gen & b){ return symbolic(at_smod,makevecteur(a,b)); } _smod(const gen & args,GIAC_CONTEXT)6057 gen _smod(const gen & args,GIAC_CONTEXT){ 6058 if ( args.type==_STRNG && args.subtype==-1) return args; 6059 if (!check_2d_vecteur(args)) return gensizeerr(contextptr); 6060 vecteur & v=*args._VECTptr; 6061 if (ckmatrix(v)) 6062 return apply(v[0],v[1],smod); 6063 if (!is_cinteger(v.back()) ) 6064 return v.front()-v.back()*_round(v.front()/v.back(),contextptr); 6065 return smod(args._VECTptr->front(),args._VECTptr->back()); 6066 } 6067 static const char _smod_s []="smod"; 6068 static define_unary_function_eval (__smod,&_smod,_smod_s); 6069 define_unary_function_ptr5( at_smod ,alias_at_smod,&__smod,0,true); 6070 6071 // symbolic symb_rdiv(const gen & a,const gen & b){ return symbolic(at_rdiv,makevecteur(a,b)); } _rdiv(const gen & args,GIAC_CONTEXT)6072 gen _rdiv(const gen & args,GIAC_CONTEXT){ 6073 if ( args.type==_STRNG && args.subtype==-1) return args; 6074 if (!check_2d_vecteur(args)) return gensizeerr(contextptr); 6075 return rdiv(args._VECTptr->front(),args._VECTptr->back(),contextptr); 6076 } 6077 static const char _rdiv_s []="rdiv"; 6078 static define_unary_function_eval (__rdiv,&_rdiv,_rdiv_s); 6079 define_unary_function_ptr5( at_rdiv ,alias_at_rdiv,&__rdiv,0,true); 6080 unmod(const gen & g)6081 gen unmod(const gen & g){ 6082 if (g.type==_MOD) 6083 return *g._MODptr; 6084 if (g.type==_VECT) 6085 return apply(g,unmod); 6086 if (g.type==_SYMB){ 6087 if (g._SYMBptr->sommet==at_normalmod) 6088 return g._SYMBptr->feuille[0]; 6089 return symbolic(g._SYMBptr->sommet,unmod(g._SYMBptr->feuille)); 6090 } 6091 return g; 6092 } unmodunprod(const gen & g)6093 gen unmodunprod(const gen & g){ 6094 gen h=unmod(g); 6095 if (h.is_symb_of_sommet(at_prod)) 6096 h=_prod(h._SYMBptr->feuille,context0); // ok 6097 return h; 6098 } 6099 irem(const gen & a,const gen & b)6100 gen irem(const gen & a,const gen & b){ 6101 gen q; 6102 return irem(a,b,q); 6103 } 6104 // symbolic symb_irem(const gen & a,const gen & b){ return symbolic(at_irem,makevecteur(a,b)); } 6105 gen _normalmod(const gen & g,GIAC_CONTEXT); _irem(const gen & args,GIAC_CONTEXT)6106 gen _irem(const gen & args,GIAC_CONTEXT){ 6107 if (args.type==_STRNG && args.subtype==-1) return args; 6108 if (args.type==_VECT && args._VECTptr->size()==2 && args._VECTptr->front().type==_INT_ && args._VECTptr->back().type==_INT_){ 6109 int a=args._VECTptr->front().val,b=args._VECTptr->back().val; 6110 if (b) a %= b ; 6111 a -= (a>>31)*b; 6112 return a; 6113 } 6114 if (args.type==_VECT && args._VECTptr->size()>1 && args._VECTptr->front().type==_STRNG){ 6115 vecteur v=*args._VECTptr; 6116 const char * fmt=v.front()._STRNGptr->c_str(); 6117 char buf[256]; 6118 size_t s=v.size(); 6119 if (s==2){ 6120 switch (v[1].type){ 6121 case _INT_: 6122 sprintf(buf,fmt,v[1].val); 6123 break; 6124 case _DOUBLE_: 6125 sprintf(buf,fmt,v[1]._DOUBLE_val); 6126 break; 6127 case _STRNG: 6128 sprintf(buf,fmt,v[1]._STRNGptr->c_str()); 6129 break; 6130 default: 6131 return gentypeerr(contextptr); 6132 } 6133 return string2gen(buf,false); 6134 } 6135 if (s==3){ 6136 unsigned t=(v[1].type<< _DECALAGE) | v[2].type; 6137 switch (t){ 6138 case _INT___INT_: 6139 sprintf(buf,fmt,v[1].val,v[2].val); 6140 break; 6141 case _INT___DOUBLE_: 6142 sprintf(buf,fmt,v[1].val,v[2]._DOUBLE_val); 6143 break; 6144 case _INT___STRNG: 6145 sprintf(buf,fmt,v[1].val,v[2]._STRNGptr->c_str()); 6146 break; 6147 case _DOUBLE___INT_: 6148 sprintf(buf,fmt,v[1]._DOUBLE_val,v[2].val); 6149 break; 6150 case _DOUBLE___DOUBLE_: 6151 sprintf(buf,fmt,v[1]._DOUBLE_val,v[2]._DOUBLE_val); 6152 break; 6153 case _DOUBLE___STRNG: 6154 sprintf(buf,fmt,v[1]._DOUBLE_val,v[2]._STRNGptr->c_str()); 6155 break; 6156 case _STRNG__INT_: 6157 sprintf(buf,fmt,v[1]._STRNGptr->c_str(),v[2].val); 6158 break; 6159 case _STRNG__DOUBLE_: 6160 sprintf(buf,fmt,v[1]._STRNGptr->c_str(),v[2]._DOUBLE_val); 6161 break; 6162 case _STRNG__STRNG: 6163 sprintf(buf,fmt,v[1]._STRNGptr->c_str(),v[2]._STRNGptr->c_str()); 6164 break; 6165 default: 6166 return gentypeerr(contextptr); 6167 } 6168 return string2gen(buf,false); 6169 } 6170 if (s==4){ 6171 gen v1=evalf_double(v[1],1,contextptr); 6172 if (v1.type!=_DOUBLE_ && v1.type!=_STRNG) return gentypeerr(contextptr); 6173 gen v2=evalf_double(v[2],1,contextptr); 6174 if (v2.type!=_DOUBLE_ && v2.type!=_STRNG) return gentypeerr(contextptr); 6175 gen v3=evalf_double(v[3],1,contextptr); 6176 if (v3.type!=_DOUBLE_ && v3.type!=_STRNG) return gentypeerr(contextptr); 6177 if (v1.type==_DOUBLE_){ 6178 if (v2.type==_DOUBLE_){ 6179 if (v3.type==_DOUBLE_) 6180 sprintf(buf,fmt,v1._DOUBLE_val,v2._DOUBLE_val,v3._DOUBLE_val); 6181 else 6182 sprintf(buf,fmt,v1._DOUBLE_val,v2._DOUBLE_val,v3._STRNGptr->c_str()); 6183 } 6184 else { 6185 if (v3.type==_DOUBLE_) 6186 sprintf(buf,fmt,v1._DOUBLE_val,v2._STRNGptr->c_str(),v3._DOUBLE_val); 6187 else 6188 sprintf(buf,fmt,v1._DOUBLE_val,v2._STRNGptr->c_str(),v3._STRNGptr->c_str()); 6189 } 6190 } else { 6191 if (v2.type==_DOUBLE_){ 6192 if (v3.type==_DOUBLE_) 6193 sprintf(buf,fmt,v1._STRNGptr->c_str(),v2._DOUBLE_val,v3._DOUBLE_val); 6194 else 6195 sprintf(buf,fmt,v1._STRNGptr->c_str(),v2._DOUBLE_val,v3._STRNGptr->c_str()); 6196 } 6197 else { 6198 if (v3.type==_DOUBLE_) 6199 sprintf(buf,fmt,v1._STRNGptr->c_str(),v2._STRNGptr->c_str(),v3._DOUBLE_val); 6200 else 6201 sprintf(buf,fmt,v1._STRNGptr->c_str(),v2._STRNGptr->c_str(),v3._STRNGptr->c_str()); 6202 } 6203 } 6204 return string2gen(buf,false); 6205 } 6206 return gendimerr(contextptr); 6207 } 6208 if (!check_2d_vecteur(args)) return gensizeerr(contextptr); 6209 if (ckmatrix(args)) 6210 return apply(args._VECTptr->front(),args._VECTptr->back(),irem); 6211 gen q; 6212 vecteur & v=*args._VECTptr; 6213 if (v.front().type==_SYMB){ 6214 gen arg=v.front()._SYMBptr->feuille; 6215 if (v.front()._SYMBptr->sommet==at_pow && arg.type==_VECT && arg._VECTptr->size()==2 ){ 6216 if (is_integer(arg._VECTptr->front()) && is_integer(arg._VECTptr->back()) ) 6217 return powmod(_irem(gen(makevecteur(arg._VECTptr->front(),v.back()),_SEQ__VECT),contextptr),arg._VECTptr->back(),v.back()); 6218 return pow(_irem(gen(makevecteur(arg._VECTptr->front(),v.back()),_SEQ__VECT),contextptr),arg._VECTptr->back(),contextptr); 6219 } 6220 if (v.front()._SYMBptr->sommet==at_neg) 6221 return _irem(gen(makevecteur(simplifier((v.back()-1)*arg,contextptr),v.back()),_SEQ__VECT),contextptr); 6222 if (v.front()._SYMBptr->sommet==at_prod || v.front()._SYMBptr->sommet==at_plus){ 6223 return v.front()._SYMBptr->sommet(_irem(gen(makevecteur(arg,v.back()),_SEQ__VECT),contextptr),contextptr); 6224 } 6225 if (v.front()._SYMBptr->sommet==at_inv){ 6226 gen g=invmod(arg,v.back()); 6227 if (is_positive(g,contextptr)) 6228 return g; 6229 else 6230 return g+v.back(); 6231 } 6232 arg=_normalmod(makevecteur(arg,v.back()),contextptr); 6233 return unmod(v.front()._SYMBptr->sommet(arg,contextptr)); 6234 } 6235 if (v.front().type==_FRAC){ 6236 gen g=invmod(v.front()._FRACptr->den,v.back()); 6237 if (!is_positive(g,contextptr)) 6238 g= g+v.back(); 6239 return _irem(gen(makevecteur(v.front()._FRACptr->num*g,v.back()),_SEQ__VECT),contextptr); 6240 } 6241 if (v.front().type==_VECT){ 6242 const_iterateur it=v.front()._VECTptr->begin(),itend=v.front()._VECTptr->end(); 6243 vecteur res; 6244 for (;it!=itend;++it) 6245 res.push_back(_irem(gen(makevecteur(*it,v.back()),_SEQ__VECT),contextptr)); 6246 return gen(res,v.front().subtype); 6247 } 6248 if (v.front().type==_IDNT) 6249 return v.front(); 6250 gen vf(v.front()),vb(v.back()); 6251 if (!is_integral(vf) || !is_integral(vb) ){ 6252 #if 1 6253 return vf-_floor(vf/vb,contextptr)*vb; 6254 #else 6255 if (vf.type==_DOUBLE_ || vb.type==_DOUBLE_) 6256 return gensizeerr(contextptr); 6257 return symbolic(at_irem,args); 6258 #endif 6259 } 6260 gen r=irem(vf,vb,q); 6261 if (is_integer(vb) && is_strictly_positive(-r,contextptr)){ 6262 if (is_strictly_positive(vb,contextptr)){ 6263 r = r + vb; 6264 q=q-1; 6265 } 6266 else { 6267 r = r - vb; 6268 q=q+1; 6269 } 6270 } 6271 return r; 6272 } 6273 static const char _irem_s []="irem"; printasirem(const gen & g,const char * s,GIAC_CONTEXT)6274 static string printasirem(const gen & g,const char * s,GIAC_CONTEXT){ 6275 if (python_compat(contextptr) && g.type==_VECT && g._VECTptr->size()==2) 6276 return g._VECTptr->front().print(contextptr)+" % "+g._VECTptr->back().print(contextptr); 6277 return s+("("+g.print(contextptr)+")"); 6278 } 6279 static define_unary_function_eval2 (__irem,&_irem,_irem_s,printasirem); 6280 define_unary_function_ptr5( at_irem ,alias_at_irem,&__irem,0,true); 6281 6282 static const char _mods_s []="mods"; 6283 static define_unary_function_eval (__mods,&_smod,_mods_s); 6284 define_unary_function_ptr5( at_mods ,alias_at_mods,&__mods,0,true); 6285 _quote_pow(const gen & args,GIAC_CONTEXT)6286 gen _quote_pow(const gen & args,GIAC_CONTEXT){ 6287 if ( args.type==_STRNG && args.subtype==-1) return args; 6288 if (args.type!=_VECT || args._VECTptr->size()!=2) 6289 return gentypeerr(contextptr); 6290 vecteur & v = *args._VECTptr; 6291 if (ckmatrix(v.front())) 6292 return pow(v.front(),v.back(),contextptr); 6293 return symbolic(at_pow,args); 6294 } 6295 static const char _quote_pow_s []="&^"; 6296 static define_unary_function_eval4_index (120,__quote_pow,&_quote_pow,_quote_pow_s,&printsommetasoperator,&texprintsommetasoperator); 6297 define_unary_function_ptr( at_quote_pow ,alias_at_quote_pow ,&__quote_pow); 6298 6299 // symbolic symb_iquo(const gen & a,const gen & b){ return symbolic(at_iquo,makevecteur(a,b)); } is_integral(gen & indice)6300 bool is_integral(gen & indice){ 6301 if (is_cinteger(indice)) 6302 return true; 6303 if (indice.type==_FLOAT_){ 6304 gen tmp=get_int(indice._FLOAT_val); 6305 if (is_zero(tmp-indice)){ 6306 indice=tmp; 6307 return true; 6308 } 6309 } 6310 if (indice.type==_DOUBLE_){ 6311 gen tmp=int(indice._DOUBLE_val); 6312 if (is_zero(tmp-indice)){ 6313 indice=tmp; 6314 return true; 6315 } 6316 } 6317 return false; 6318 } Iquo(const gen & f0,const gen & b0,GIAC_CONTEXT)6319 gen Iquo(const gen & f0,const gen & b0,GIAC_CONTEXT){ 6320 if (f0.type==_VECT) 6321 return apply1st(f0,b0,contextptr,Iquo); 6322 gen f(f0),b(b0); 6323 if (python_compat(contextptr)==0 && (!is_integral(f) || !is_integral(b) )) 6324 return gensizeerr(gettext("Iquo")); // return symbolic(at_iquo,args); 6325 if (is_exactly_zero(b)) 6326 return 0; 6327 return (f-_irem(gen(makevecteur(f,b),_SEQ__VECT),context0))/b; // ok 6328 } _iquo(const gen & args,GIAC_CONTEXT)6329 gen _iquo(const gen & args,GIAC_CONTEXT){ 6330 if ( args.type==_STRNG && args.subtype==-1) return args; 6331 if (!check_2d_vecteur(args)) return gensizeerr(contextptr); 6332 gen & f=args._VECTptr->front(); 6333 gen & b=args._VECTptr->back(); 6334 if (ckmatrix(args)) 6335 return apply(f,b,iquo); 6336 return Iquo(f,b,contextptr); 6337 } 6338 static const char _iquo_s []="iquo"; printasiquo(const gen & g,const char * s,GIAC_CONTEXT)6339 static string printasiquo(const gen & g,const char * s,GIAC_CONTEXT){ 6340 if (python_compat(contextptr) && g.type==_VECT && g._VECTptr->size()==2) 6341 return g._VECTptr->front().print(contextptr)+" // "+g._VECTptr->back().print(contextptr); 6342 return s+("("+g.print(contextptr)+")"); 6343 } 6344 static define_unary_function_eval2 (__iquo,&_iquo,_iquo_s,printasiquo); 6345 define_unary_function_ptr5( at_iquo ,alias_at_iquo,&__iquo,0,true); 6346 iquorem(const gen & a,const gen & b)6347 static vecteur iquorem(const gen & a,const gen & b){ 6348 gen q,r; 6349 //r=irem(a,b,q); 6350 r=_irem(makesequence(a,b),context0); 6351 q=(a-r)/b; 6352 return makevecteur(q,r); 6353 } 6354 // symbolic symb_iquorem(const gen & a,const gen & b){ return symbolic(at_iquorem,makevecteur(a,b)); } _iquorem(const gen & args,GIAC_CONTEXT)6355 gen _iquorem(const gen & args,GIAC_CONTEXT){ 6356 if ( args.type==_STRNG && args.subtype==-1) return args; 6357 if (!check_2d_vecteur(args)) return gensizeerr(contextptr); 6358 vecteur v=*args._VECTptr; 6359 if (!is_integral(v.front()) || !is_integral(v.back()) ) 6360 return gensizeerr(contextptr); // symbolic(at_iquorem,args); 6361 return iquorem(args._VECTptr->front(),args._VECTptr->back()); 6362 } 6363 static const char _iquorem_s []="iquorem"; 6364 static define_unary_function_eval (__iquorem,&_iquorem,_iquorem_s); 6365 define_unary_function_ptr5( at_iquorem ,alias_at_iquorem,&__iquorem,0,true); 6366 _divmod(const gen & args,GIAC_CONTEXT)6367 gen _divmod(const gen & args,GIAC_CONTEXT){ 6368 gen res=_iquorem(args,contextptr); 6369 if (res.type==_VECT) res.subtype=_SEQ__VECT; 6370 return res; 6371 } 6372 static const char _divmod_s []="divmod"; 6373 static define_unary_function_eval (__divmod,&_divmod,_divmod_s); 6374 define_unary_function_ptr5( at_divmod ,alias_at_divmod,&__divmod,0,true); 6375 symb_quorem(const gen & a,const gen & b)6376 static symbolic symb_quorem(const gen & a,const gen & b){ return symbolic(at_quorem,makevecteur(a,b)); } quorem(const gen & a,const gen & b)6377 gen quorem(const gen & a,const gen & b){ 6378 if ((a.type!=_VECT) || (b.type!=_VECT)) 6379 return symb_quorem(a,b); 6380 if (b._VECTptr->empty()) 6381 return gensizeerr(gettext("Division by 0")); 6382 vecteur q,r; 6383 environment * env=new environment; 6384 DivRem(*a._VECTptr,*b._VECTptr,env,q,r,true); 6385 delete env; 6386 return makevecteur(gen(q,_POLY1__VECT),gen(r,_POLY1__VECT)); 6387 } _quorem(const gen & args,GIAC_CONTEXT)6388 gen _quorem(const gen & args,GIAC_CONTEXT){ 6389 if ( args.type==_STRNG && args.subtype==-1) return args; 6390 if ((args.type!=_VECT) || (args._VECTptr->size()<2) ) 6391 return gensizeerr(contextptr); 6392 if (args.type==_VECT && args._VECTptr->size()>=3 && args[2].type==_VECT){ 6393 vecteur v = *args._VECTptr; 6394 v.push_back(at_quo); 6395 return _revlist(_greduce(gen(v,_SEQ__VECT),contextptr),contextptr); 6396 } 6397 vecteur & a =*args._VECTptr; 6398 if ( (a.front().type==_VECT) && (a[1].type==_VECT)) 6399 return quorem(a.front(),a[1]); 6400 if ( (a.front().type==_POLY) && (a[1].type==_POLY)){ 6401 int dim=a.front()._POLYptr->dim; 6402 if (a[1]._POLYptr->dim!=dim) 6403 return gendimerr(contextptr); 6404 // Possible improvement? compute quotient of a and b using heap division 6405 // then a-b*q with array multiplication instead of univariate conversion 6406 if (a.size()==3 && a.back().type==_INT_){ 6407 polynome rem,quo; 6408 if ( !divrem1(*a.front()._POLYptr,*a[1]._POLYptr,quo,rem,args._VECTptr->back().val) ) 6409 return gensizeerr(gettext("Unable to divide, perhaps due to rounding error")+a.front().print(contextptr)+" / "+a.back().print(contextptr)); 6410 return makevecteur(quo,rem); 6411 } 6412 vecteur aa(polynome2poly1(*a.front()._POLYptr,1)); 6413 vecteur bb(polynome2poly1(*a.back()._POLYptr,1)); 6414 vecteur q,r; 6415 DivRem(aa,bb,0,q,r); 6416 return makevecteur(poly12polynome(q,1,dim),poly12polynome(r,1,dim)); 6417 } 6418 vecteur lv; 6419 if (a.size()>=3 && a[2].type!=_INT_) 6420 lv=vecteur(1,unmodunprod(a[2])); 6421 else 6422 lv=vecteur(1,vx_var); 6423 lvar(args,lv); 6424 gen aa=e2r(a[0],lv,contextptr),aan,aad,bb=e2r(a[1],lv,contextptr),bbn,bbd; 6425 fxnd(aa,aan,aad); 6426 if ( (aad.type==_POLY) && (aad._POLYptr->lexsorted_degree() ) ) 6427 return gensizeerr(contextptr); 6428 fxnd(bb,bbn,bbd); 6429 if ( (bbd.type==_POLY) && (bbd._POLYptr->lexsorted_degree() ) ) 6430 return gensizeerr(contextptr); 6431 gen u,v; 6432 gen ad(r2e(aad,lv,contextptr)); 6433 if ( (aan.type==_POLY) && (bbn.type==_POLY) ){ 6434 if (a.size()>=3 && a.back().type==_INT_){ 6435 polynome rem,quo; 6436 if ( !divrem1(*aan._POLYptr,*bbn._POLYptr,quo,rem,args._VECTptr->back().val) ) 6437 return gensizeerr(gettext("Unable to divide, perhaps due to rounding error")+aan.print(contextptr)+" / "+bbn.print(contextptr)); 6438 u=rdiv(r2e(bbd,lv,contextptr),ad,contextptr)*r2e(quo,lv,contextptr); 6439 v=inv(ad,contextptr)*r2e(rem,lv,contextptr); 6440 return makevecteur(u,v); 6441 } 6442 vecteur aav(polynome2poly1(*aan._POLYptr,1)),bbv(polynome2poly1(*bbn._POLYptr,1)),un,vn; 6443 environment env; 6444 DivRem(aav,bbv,&env,un,vn); 6445 vecteur lvprime(lv.begin()+1,lv.end()); 6446 u=rdiv(r2e(bbd,lv,contextptr),ad,contextptr)*symb_horner(*r2e(un,lvprime,contextptr)._VECTptr,lv.front()); 6447 v=inv(ad,contextptr)*symb_horner(*r2e(vn,lvprime,contextptr)._VECTptr,lv.front()); 6448 return makevecteur(u,v); 6449 } 6450 else { 6451 if ( (bbn.type!=_POLY) || !bbn._POLYptr->lexsorted_degree() ){ 6452 u=rdiv(aan,bbn,contextptr); 6453 v=zero; 6454 } 6455 else { 6456 u=zero; 6457 v=aan; 6458 } 6459 } 6460 // aan=u*bbn+v -> aan/aad=u*bbd/aad * bbn/bbd +v/aad 6461 u=r2e(u*bbd,lv,contextptr); 6462 v=r2e(v,lv,contextptr); 6463 return makevecteur(rdiv(u,ad,contextptr),rdiv(v,ad,contextptr)); 6464 } 6465 static const char _quorem_s []="quorem"; 6466 static define_unary_function_eval (__quorem,&_quorem,_quorem_s); 6467 define_unary_function_ptr5( at_quorem ,alias_at_quorem,&__quorem,0,true); 6468 6469 // symbolic symb_quo(const gen & a,const gen & b){ return symbolic(at_quo,makevecteur(a,b)); } _quo(const gen & args,GIAC_CONTEXT)6470 gen _quo(const gen & args,GIAC_CONTEXT){ 6471 if ( args.type==_STRNG && args.subtype==-1) return args; 6472 if (args.type==_VECT && args._VECTptr->size()>=3 && args[2].type==_VECT){ 6473 vecteur v = *args._VECTptr; 6474 v.push_back(at_quo); 6475 return _greduce(gen(v,_SEQ__VECT),contextptr)[1]; 6476 } 6477 return _quorem(args,contextptr)[0]; 6478 } 6479 static const char _quo_s []="quo"; 6480 static define_unary_function_eval (__quo,&_quo,_quo_s); 6481 define_unary_function_ptr5( at_quo ,alias_at_quo,&__quo,0,true); 6482 6483 // symbolic symb_rem(const gen & a,const gen & b){ return symbolic(at_rem,makevecteur(a,b)); } _rem(const gen & args,GIAC_CONTEXT)6484 gen _rem(const gen & args,GIAC_CONTEXT){ 6485 if ( args.type==_STRNG && args.subtype==-1) return args; 6486 if (args.type==_VECT && args._VECTptr->size()>=3 && args[2].type==_VECT){ 6487 vecteur v = *args._VECTptr; 6488 #if 0 6489 gen g(_WITH_COCOA); 6490 g.subtype=_INT_GROEBNER; 6491 v.push_back(symb_equal(g,0)); 6492 #endif 6493 return _greduce(gen(v,_SEQ__VECT),contextptr); 6494 } 6495 return _quorem(args,contextptr)[1]; 6496 } 6497 static const char _rem_s []="rem"; 6498 static define_unary_function_eval (__rem,&_rem,_rem_s); 6499 define_unary_function_ptr5( at_rem ,alias_at_rem,&__rem,0,true); 6500 double2gen(double d)6501 gen double2gen(double d){ 6502 if (my_isinf(d)) 6503 return d; 6504 if (d< (1ULL<<63) && -d < (1ULL<<63)) 6505 return gen(longlong(d)); 6506 #ifdef NSPIRE_NEWLIB 6507 #endif 6508 ref_mpz_t * m= new ref_mpz_t; 6509 mpz_set_d(m->z,d); 6510 return m; 6511 } symb_floor(const gen & a)6512 static symbolic symb_floor(const gen & a){ 6513 return symbolic(at_floor,a); 6514 } apply_unit(const gen & args,const gen_op_context & f,GIAC_CONTEXT)6515 gen apply_unit(const gen & args,const gen_op_context & f,GIAC_CONTEXT){ 6516 return symbolic(at_unit,gen(makevecteur(f(args._SYMBptr->feuille[0],contextptr),args._SYMBptr->feuille[1]),_SEQ__VECT)); 6517 } _floor(const gen & args,GIAC_CONTEXT)6518 gen _floor(const gen & args,GIAC_CONTEXT){ 6519 if ( args.type==_STRNG && args.subtype==-1) return args; 6520 if (is_equal(args)) 6521 return apply_to_equal(args,_floor,contextptr); 6522 if (is_inf(args)||is_undef(args)) 6523 return args; 6524 if (args.is_symb_of_sommet(at_unit)) 6525 return apply_unit(args,_floor,contextptr); 6526 if (args.is_symb_of_sommet(at_floor) || args.is_symb_of_sommet(at_ceil)) 6527 return args; 6528 if (args.type==_VECT || args.type==_MAP) 6529 return apply(args,contextptr,_floor); 6530 if (args.type==_CPLX) 6531 return _floor(*args._CPLXptr,contextptr)+cst_i*_floor(*(args._CPLXptr+1),contextptr); 6532 if ( (args.type==_INT_) || (args.type==_ZINT)) 6533 return args; 6534 if (args.type==_FRAC){ 6535 gen n=args._FRACptr->num,d=args._FRACptr->den; 6536 if (is_cinteger(d) && !is_integer(d)){ 6537 n=n*conj(d,contextptr); 6538 d=d*conj(d,contextptr); 6539 } 6540 if (is_cinteger(n) && is_integer(d)){ 6541 if (is_positive(args,contextptr)) 6542 return iquo(n,d); 6543 if (n.type!=_CPLX) 6544 return iquo(n,d)-1; 6545 gen nr,ni; 6546 reim(n,nr,ni,contextptr); 6547 if (is_positive(nr,contextptr)) 6548 nr=iquo(nr,d); 6549 else 6550 nr=iquo(nr,d)-1; 6551 if (is_positive(ni,contextptr)) 6552 ni=iquo(ni,d); 6553 else 6554 ni=iquo(ni,d)-1; 6555 return nr+ni*cst_i; 6556 } 6557 } 6558 /* old code, changed for floor(sqrt(2)) 6559 vecteur l(lidnt(args)); 6560 vecteur lnew=*evalf(l,1,contextptr)._VECTptr; 6561 gen tmp=subst(args,l,lnew,false,contextptr); 6562 */ 6563 vecteur l(lvar(args)); 6564 gen chk; 6565 if (l.size()==2){ 6566 if (l[0]==cst_pi) 6567 chk=l[1]; 6568 if (l[1]==cst_pi) 6569 chk=l[0]; 6570 } 6571 else { 6572 if (l.size()==1) 6573 chk=l[0]; 6574 } 6575 gen a,b; 6576 if (chk.type==_IDNT && is_linear_wrt(args,chk,a,b,contextptr)){ 6577 gen g2=chk._IDNTptr->eval(1,chk,contextptr); 6578 if ((g2.type==_VECT) && (g2.subtype==_ASSUME__VECT)){ 6579 vecteur v=*g2._VECTptr; 6580 if ( (v.size()==3) && (v.front()==vecteur(0) || v.front()==_DOUBLE_ || v.front()==_ZINT || v.front()==_SYMB || v.front()==0) && (v[1].type==_VECT && v[1]._VECTptr->size()==1 && v[1]._VECTptr->front().type==_VECT) ){ 6581 vecteur v1=*v[1]._VECTptr->front()._VECTptr; 6582 if (v1.size()==2){ 6583 gen A=a*v1[0]+b,B=a*v1[1]+b,Af,Bf; 6584 Af=_floor(A,contextptr); 6585 Bf=_floor(B,contextptr); 6586 if (Af==Bf) 6587 return Af; 6588 if (Af==Bf+1 && is_zero(ratnormal(A-Af,contextptr)) && v[2].type==_VECT && equalposcomp(*v[2]._VECTptr,v1[0])) 6589 return Bf; 6590 if (Bf==Af+1 && is_zero(ratnormal(B-Bf,contextptr)) && v[2].type==_VECT){ 6591 if (equalposcomp(*v[2]._VECTptr,v1[1])) 6592 return Af; 6593 } 6594 } 6595 } 6596 } 6597 } 6598 vecteur lnew(l); 6599 int ls=int(l.size()); 6600 for (int i=0;i<ls;i++){ 6601 if (l[i].type==_IDNT || lidnt(l[i]).empty()){ 6602 lnew[i]=evalf(l[i],1,contextptr); 6603 #ifdef HAVE_LIBMPFR 6604 if (lnew[i].type==_DOUBLE_) 6605 lnew[i]=accurate_evalf(lnew[i],100); 6606 #endif 6607 } 6608 } 6609 gen tmp=subst(args,l,lnew,false,contextptr); 6610 if (tmp.type==_REAL){ 6611 #ifdef HAVE_LIBMPFR 6612 // reeval with the right precision 6613 gen lntmp=ln(abs(tmp,contextptr),contextptr); 6614 if (is_greater(lntmp,40,contextptr)){ 6615 int prec=real2int(lntmp,contextptr).val+30; 6616 int oldprec=decimal_digits(contextptr); 6617 decimal_digits(prec,contextptr); 6618 for (int i=0;i<ls;i++){ 6619 if (l[i].type==_IDNT || lidnt(l[i]).empty()) 6620 lnew[i]=evalf(l[i],1,contextptr); 6621 } 6622 decimal_digits(oldprec,contextptr); 6623 tmp=subst(args,l,lnew,false,contextptr); 6624 } 6625 #endif 6626 gen res=real2int(tmp,contextptr); 6627 if (is_strictly_positive(-tmp,contextptr) && !is_zero(res-tmp,contextptr)) 6628 return res-1; 6629 return res; 6630 } 6631 if (tmp.type==_FLOAT_) 6632 return ffloor(tmp._FLOAT_val); 6633 if (tmp.type!=_DOUBLE_) 6634 return symb_floor(args); 6635 return double2gen(giac_floor(tmp._DOUBLE_val)); 6636 } taylor_floor(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)6637 static gen taylor_floor (const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 6638 if (ordre<0) 6639 return 0; // no symbolic preprocessing 6640 shift_coeff=0; 6641 gen l=_floor(lim_point,contextptr); 6642 if (l==lim_point){ 6643 if (direction==0) 6644 return gensizeerr(gettext("Taylor of floor with unsigned limit")); 6645 if (direction==-1) 6646 l=l-1; 6647 } 6648 return is_zero(l,contextptr)?vecteur(0):makevecteur(l); 6649 } 6650 static const char _floor_s []="floor"; 6651 #ifdef GIAC_HAS_STO_38 6652 static define_unary_function_eval_taylor( __floor,&_floor,(size_t)&D_at_signunary_function_ptr,&taylor_floor,_floor_s); 6653 #else 6654 static define_unary_function_eval_taylor( __floor,&_floor,D_at_sign,&taylor_floor,_floor_s); 6655 #endif 6656 define_unary_function_ptr5( at_floor ,alias_at_floor,&__floor,0,true); 6657 _ceil(const gen & args,GIAC_CONTEXT)6658 gen _ceil(const gen & args,GIAC_CONTEXT){ 6659 if ( args.type==_STRNG && args.subtype==-1) return args; 6660 if (is_inf(args)||is_undef(args)) 6661 return args; 6662 if (args.type==_VECT || args.type==_MAP) 6663 return apply(args,contextptr,_ceil); 6664 if (args.is_symb_of_sommet(at_floor) || args.is_symb_of_sommet(at_ceil)) 6665 return args; 6666 if (args.type==_CPLX) 6667 return _ceil(*args._CPLXptr,contextptr)+cst_i*_ceil(*(args._CPLXptr+1),contextptr); 6668 if ( (args.type==_INT_) || (args.type==_ZINT)) 6669 return args; 6670 #ifdef BCD 6671 if (args.type==_FLOAT_) 6672 return fceil(args._FLOAT_val); 6673 #endif 6674 return -_floor(-args,contextptr); 6675 #if 0 6676 if (args.type==_FRAC){ 6677 gen n=args._FRACptr->num,d=args._FRACptr->den; 6678 if ( ((n.type==_INT_) || (n.type==_ZINT)) && ( (d.type==_INT_) || (d.type==_ZINT)) ) 6679 return Iquo(n,d,contextptr)+1; 6680 } 6681 vecteur l(lidnt(args)); 6682 vecteur lnew=*evalf(l,1,contextptr)._VECTptr; 6683 gen tmp=subst(args,l,lnew,false,contextptr); 6684 if (tmp.type==_REAL || tmp.type==_FLOAT_) 6685 return -_floor(-tmp,contextptr); 6686 if (tmp.type!=_DOUBLE_) 6687 return symb_ceil(args); 6688 return double2gen(giac_ceil(tmp._DOUBLE_val)); 6689 #endif 6690 } taylor_ceil(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)6691 static gen taylor_ceil (const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 6692 if (ordre<0) 6693 return 0; // no symbolic preprocessing 6694 shift_coeff=0; 6695 gen l=_ceil(lim_point,contextptr); 6696 if (l==lim_point){ 6697 if (direction==0) 6698 return gensizeerr(gettext("Taylor of ceil with unsigned limit")); 6699 if (direction==1) 6700 l=l-1; 6701 } 6702 return is_zero(l,contextptr)?vecteur(0):makevecteur(l); 6703 } 6704 static const char _ceil_s []="ceil"; 6705 #ifdef GIAC_HAS_STO_38 6706 static define_unary_function_eval_taylor( __ceil,&_ceil,(size_t)&D_at_signunary_function_ptr,&taylor_ceil,_ceil_s); 6707 #else 6708 static define_unary_function_eval_taylor( __ceil,&_ceil,D_at_sign,&taylor_ceil,_ceil_s); 6709 #endif 6710 define_unary_function_ptr5( at_ceil ,alias_at_ceil,&__ceil,0,true); 6711 ceiltofloor(const gen & g,GIAC_CONTEXT)6712 static gen ceiltofloor(const gen & g,GIAC_CONTEXT){ 6713 return -symbolic(at_floor,-g); 6714 } ceil2floor(const gen & g,GIAC_CONTEXT,bool quotesubst)6715 gen ceil2floor(const gen & g,GIAC_CONTEXT,bool quotesubst){ 6716 const vector< const unary_function_ptr *> ceil_v(1,at_ceil); 6717 const vector< gen_op_context > ceil2floor_v(1,ceiltofloor); 6718 return subst(g,ceil_v,ceil2floor_v,quotesubst,contextptr); 6719 } 6720 6721 // static symbolic symb_round(const gen & a){ return symbolic(at_round,a); } _round(const gen & args,GIAC_CONTEXT)6722 gen _round(const gen & args,GIAC_CONTEXT){ 6723 if ( is_undef(args)) 6724 return args; 6725 if (args.type==_STRNG && args.subtype==-1) return args; 6726 if (is_equal(args)) 6727 return apply_to_equal(args,_round,contextptr); 6728 if (args.is_symb_of_sommet(at_unit)) 6729 return apply_unit(args,_round,contextptr); 6730 if (is_inf(args)||is_undef(args)) 6731 return args; 6732 if (args.type==_VECT && (args.subtype!=_SEQ__VECT || args._VECTptr->size()!=2)) 6733 return apply(args,contextptr,_round); 6734 if (args.type==_VECT && args.subtype==_SEQ__VECT){ 6735 gen b=args._VECTptr->back(); 6736 if (is_integral(b)){ 6737 #ifdef BCD 6738 if (args._VECTptr->front().type==_FLOAT_) 6739 return fround(args._VECTptr->front()._FLOAT_val,b.val); 6740 #endif 6741 /* 6742 #ifdef _SOFTMATH_H 6743 double d=std::giac_gnuwince_pow(10.0,double(b.val)); 6744 #else 6745 double d=std::pow(10.0,double(b.val)); 6746 #endif 6747 */ 6748 gen d=10.0; 6749 if (b.val<0){ 6750 gen gf=_floor(log10(abs(args._VECTptr->front(),contextptr),contextptr),contextptr); 6751 if (gf.type!=_INT_ && gf.type!=_FLOAT_) 6752 return gensizeerr(contextptr); 6753 b=-1-b-gf; 6754 } 6755 if (b.val>14) 6756 d=accurate_evalf(gen(10),int(b.val*3.32192809489+.5)); 6757 d=pow(d,b.val,contextptr); 6758 gen e=_round(d*args._VECTptr->front(),contextptr); 6759 if (b.val>14) 6760 e=accurate_evalf(e,int(b.val*3.32192809489+.5)); 6761 e=rdiv(e,d,contextptr); 6762 return e; 6763 } 6764 } 6765 if (args.type==_CPLX) 6766 return _round(*args._CPLXptr,contextptr)+cst_i*_round(*(args._CPLXptr+1),contextptr); 6767 gen r,i,tmp; 6768 reim(args,r,i,contextptr); 6769 tmp=args+plus_one_half; // *(r.type<_POLY?sign(r,contextptr):1); 6770 if (!is_zero(i)) 6771 tmp=tmp+plus_one_half*cst_i; // *(i.type<_POLY?sign(i,contextptr):plus_one); 6772 if (tmp.type==_VECT) 6773 tmp.subtype=args.subtype; 6774 return _floor(tmp,contextptr); 6775 } taylor_round(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)6776 static gen taylor_round (const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 6777 if (ordre<0) 6778 return 0; // no symbolic preprocessing 6779 shift_coeff=0; 6780 gen l=_round(lim_point,contextptr); 6781 if (is_zero(ratnormal(l-lim_point-plus_one_half,contextptr),contextptr)){ 6782 if (direction==0) 6783 return gensizeerr(gettext("Taylor of round with unsigned limit")); 6784 if (direction==-1) 6785 l=l-1; 6786 } 6787 return is_zero(l,contextptr)?vecteur(0):makevecteur(l); 6788 } 6789 static const char _round_s []="round"; 6790 #ifdef GIAC_HAS_STO_38 6791 static define_unary_function_eval_taylor( __round,&_round,(size_t)&D_at_signunary_function_ptr,&taylor_round,_round_s); 6792 #else 6793 static define_unary_function_eval_taylor( __round,&_round,D_at_sign,&taylor_round,_round_s); 6794 #endif 6795 define_unary_function_ptr5( at_round ,alias_at_round,&__round,0,true); 6796 printasprint(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)6797 static string printasprint(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 6798 if (xcas_mode(contextptr)!=3) 6799 return "print("+feuille.print(contextptr)+")"; 6800 else 6801 return "Disp "+feuille.print(contextptr); 6802 } 6803 // static symbolic symb_print(const gen & a){ return symbolic(at_print,a); } nl_sep(gen & tmp,string & nl,string & sep)6804 bool nl_sep(gen & tmp,string & nl,string & sep){ 6805 if (tmp.type!=_VECT || tmp.subtype!=_SEQ__VECT) 6806 return false; 6807 vecteur v=*tmp._VECTptr; 6808 bool hasnl=false; 6809 for (size_t i=0;i<v.size();++i){ 6810 if (v[i].is_symb_of_sommet(at_equal)){ 6811 gen f=v[i]._SYMBptr->feuille; 6812 if (f.type==_VECT && f._VECTptr->size()==2){ 6813 gen a=f._VECTptr->front(); 6814 gen b=f._VECTptr->back(); 6815 if (b.type==_STRNG && a.type==_IDNT){ 6816 if (strcmp("sep",a._IDNTptr->id_name)==0){ 6817 sep=*b._STRNGptr; 6818 hasnl=true; 6819 v.erase(v.begin()+i); 6820 --i; 6821 } 6822 if (strcmp("endl",a._IDNTptr->id_name)==0){ 6823 nl=*b._STRNGptr; 6824 hasnl=true; 6825 v.erase(v.begin()+i); 6826 --i; 6827 } 6828 } 6829 } 6830 } 6831 } 6832 if (hasnl){ 6833 if (v.size()==1) 6834 tmp=v.front(); 6835 else 6836 tmp=gen(v,tmp.subtype); 6837 } 6838 return hasnl; 6839 } _print(const gen & args,GIAC_CONTEXT)6840 gen _print(const gen & args,GIAC_CONTEXT){ 6841 if ( args.type==_STRNG && args.subtype==-1) return args; 6842 if ( debug_infolevel && (args.type==_IDNT) && args._IDNTptr->localvalue && (!args._IDNTptr->localvalue->empty())) 6843 *logptr(contextptr) << gettext("Local var protected ") << (*args._IDNTptr->localvalue)[args._IDNTptr->localvalue->size()-2].val << '\n'; 6844 gen tmp=args.eval(eval_level(contextptr),contextptr); 6845 string nl("\n"),sep(","); 6846 bool nlsep=nl_sep(tmp,nl,sep); 6847 // If giac used inside a console don't add to messages, since we print 6848 #ifdef HAVE_SIGNAL_H_OLD 6849 if (!child_id){ 6850 if (args.type==_IDNT) 6851 messages_to_print += args.print(contextptr) + ":"; 6852 messages_to_print += tmp.print(contextptr) +'\n'; 6853 // *logptr(contextptr) << "Child " << messages_to_print << '\n'; 6854 } 6855 #endif 6856 if (tmp.type==_VECT && !tmp._VECTptr->empty() && tmp._VECTptr->front()==gen("Unquoted",contextptr)){ 6857 vecteur & v=*tmp._VECTptr; 6858 int s=int(v.size()); 6859 for (int i=1;i<s;++i) 6860 *logptr(contextptr) << (v[i].type==_STRNG?(*v[i]._STRNGptr):unquote(v[i].print(contextptr))); 6861 } 6862 else { 6863 if (!nlsep && !python_compat(contextptr) && args.type==_IDNT) 6864 *logptr(contextptr) << args << ":"; 6865 if (tmp.type==_STRNG) 6866 *logptr(contextptr) << tmp._STRNGptr->c_str() << nl; 6867 else { 6868 if (tmp.type==_VECT && tmp.subtype==_SEQ__VECT){ 6869 const vecteur & v=*tmp._VECTptr; 6870 size_t s=v.size(); 6871 for (size_t i=0;i<s;){ 6872 *logptr(contextptr) << (v[i].type==_STRNG?(*v[i]._STRNGptr):unquote(v[i].print(contextptr))); 6873 ++i; 6874 if (i==s) break; 6875 *logptr(contextptr) << sep; 6876 } 6877 } 6878 else 6879 *logptr(contextptr) << tmp; 6880 *logptr(contextptr) << nl; 6881 } 6882 } 6883 return __interactive.op(symbolic(at_print,tmp),contextptr); 6884 } 6885 static const char _print_s []="print"; 6886 #ifdef RTOS_THREADX 6887 static define_unary_function_eval2(__print,&_print,_print_s,&printasprint); 6888 #else 6889 const unary_function_eval __print(1,&_print,_print_s,&printasprint); 6890 #endif 6891 define_unary_function_ptr5( at_print ,alias_at_print,&__print,_QUOTE_ARGUMENTS,true); 6892 6893 // static symbolic symb_is_prime(const gen & a){ return symbolic(at_is_prime,a); } _is_prime(const gen & args0,GIAC_CONTEXT)6894 gen _is_prime(const gen & args0,GIAC_CONTEXT){ 6895 gen args(args0); 6896 if ( args.type==_STRNG && args.subtype==-1) return args; 6897 int certif=0; 6898 #ifdef HAVE_LIBPARI 6899 if (args0.type==_VECT && args0.subtype==_SEQ__VECT && args0._VECTptr->size()==2 && args0._VECTptr->back().type==_INT_){ 6900 args=args0._VECTptr->front(); 6901 certif=args0._VECTptr->back().val; 6902 } 6903 #endif 6904 if (args.type==_VECT) 6905 return apply(args,_is_prime,contextptr); 6906 if (!is_integral(args)) 6907 return gentypeerr(contextptr); 6908 #ifdef HAVE_LIBPARI 6909 return pari_isprime(args,certif); 6910 #else 6911 return is_probab_prime_p(args); 6912 #endif 6913 } 6914 static const char _is_prime_s []="is_prime"; 6915 static define_unary_function_eval (__is_prime,&_is_prime,_is_prime_s); 6916 define_unary_function_ptr5( at_is_prime ,alias_at_is_prime,&__is_prime,0,true); 6917 _is_pseudoprime(const gen & args,GIAC_CONTEXT)6918 gen _is_pseudoprime(const gen & args,GIAC_CONTEXT){ 6919 if ( args.type==_STRNG && args.subtype==-1) return args; 6920 return is_probab_prime_p(args); 6921 } 6922 static const char _is_pseudoprime_s []="is_pseudoprime"; 6923 static define_unary_function_eval (__is_pseudoprime,&_is_pseudoprime,_is_pseudoprime_s); 6924 define_unary_function_ptr5( at_is_pseudoprime ,alias_at_is_pseudoprime,&__is_pseudoprime,0,true); 6925 nextprime1(const gen & a,GIAC_CONTEXT)6926 gen nextprime1(const gen & a,GIAC_CONTEXT){ 6927 if (is_strictly_greater(2,a,contextptr)) 6928 return 2; 6929 return nextprime(a+1); 6930 } 6931 static const char _nextprime_s []="nextprime"; 6932 static define_unary_function_eval (__nextprime,&nextprime1,_nextprime_s); 6933 define_unary_function_ptr5( at_nextprime ,alias_at_nextprime,&__nextprime,0,true); 6934 prevprime1(const gen & a,GIAC_CONTEXT)6935 gen prevprime1(const gen & a,GIAC_CONTEXT){ 6936 if (is_greater(2,a,contextptr)) 6937 return gensizeerr(contextptr); 6938 return prevprime(a-1); 6939 } 6940 static const char _prevprime_s []="prevprime"; 6941 static define_unary_function_eval (__prevprime,&prevprime1,_prevprime_s); 6942 define_unary_function_ptr5( at_prevprime ,alias_at_prevprime,&__prevprime,0,true); 6943 6944 // static symbolic symb_jacobi_symbol(const gen & a,const gen & b){ return symbolic(at_jacobi_symbol,makevecteur(a,b)); } _jacobi_symbol(const gen & args,GIAC_CONTEXT)6945 gen _jacobi_symbol(const gen & args,GIAC_CONTEXT){ 6946 if ( args.type==_STRNG && args.subtype==-1) return args; 6947 if (!check_2d_vecteur(args)) return gensizeerr(contextptr); 6948 gen a=args._VECTptr->front(),b=args._VECTptr->back(); 6949 a=_irem(args,contextptr); 6950 int res=jacobi(a,b); 6951 if (res==-RAND_MAX) 6952 return gensizeerr(contextptr); 6953 return res; 6954 } 6955 static const char _jacobi_symbol_s []="jacobi_symbol"; 6956 static define_unary_function_eval (__jacobi_symbol,&_jacobi_symbol,_jacobi_symbol_s); 6957 define_unary_function_ptr5( at_jacobi_symbol ,alias_at_jacobi_symbol,&__jacobi_symbol,0,true); 6958 6959 // static symbolic symb_legendre_symbol(const gen & a,const gen & b){ return symbolic(at_legendre_symbol,makevecteur(a,b)); } _legendre_symbol(const gen & args,GIAC_CONTEXT)6960 gen _legendre_symbol(const gen & args,GIAC_CONTEXT){ 6961 if ( args.type==_STRNG && args.subtype==-1) return args; 6962 if (!check_2d_vecteur(args)) return gensizeerr(contextptr); 6963 gen a=args._VECTptr->front(),b=args._VECTptr->back(); 6964 a=_irem(args,contextptr); 6965 return legendre(a,b); 6966 } 6967 static const char _legendre_symbol_s []="legendre_symbol"; 6968 static define_unary_function_eval (__legendre_symbol,&_legendre_symbol,_legendre_symbol_s); 6969 define_unary_function_ptr5( at_legendre_symbol ,alias_at_legendre_symbol,&__legendre_symbol,0,true); 6970 6971 // static symbolic symb_ichinrem(const gen & a,const gen & b){ return symbolic(at_ichinrem,makevecteur(a,b)); } 6972 ichinrem2(const gen & a_orig,const gen & b_orig)6973 gen ichinrem2(const gen & a_orig,const gen & b_orig){ 6974 gen a=a_orig; 6975 gen b=b_orig; 6976 if (a.type==_MOD) 6977 a=makevecteur(*a._MODptr,*(a._MODptr+1)); 6978 if (b.type==_MOD) 6979 b=makevecteur(*b._MODptr,*(b._MODptr+1)); 6980 vecteur l(lidnt(makevecteur(a,b))); 6981 if (l.empty()){ 6982 if (!check_2d_vecteur(a) 6983 || !check_2d_vecteur(b)) 6984 return gensizeerr(gettext("Vector of 2 integer arguments expected")); 6985 vecteur & av=*a._VECTptr; 6986 vecteur & bv=*b._VECTptr; 6987 gen ab=av.back(); 6988 gen bb=bv.back(); 6989 gen aa=av.front(); 6990 gen ba=bv.front(); 6991 if (!is_integral(ab) || !is_integral(bb) || !is_integral(aa) || !is_integral(ba)) 6992 return gentypeerr(gettext("Non integer argument")); 6993 if (is_greater(1,bb,context0) || is_greater(1,ab,context0)) 6994 return gentypeerr(gettext("Bad mod value")); 6995 gen res=ichinrem(aa,ba,ab,bb); 6996 if (is_undef(res)) 6997 return res; 6998 if (a_orig.type==_MOD) 6999 return makemod(res,lcm(ab,bb)); 7000 return makevecteur(res,lcm(ab,bb)); 7001 } 7002 l=lvar(a); lvar(b,l); 7003 gen x=l.front(); 7004 if (a.type!=_VECT || b.type!=_VECT ){ 7005 // a and b are polynomial, must have the same degrees 7006 // build a new polynomial calling ichinrem2 on each element 7007 gen ax=_e2r(makevecteur(a_orig,x),context0),bx=_e2r(makevecteur(b_orig,x),context0); // ok 7008 if (ax.type!=_VECT || bx.type!=_VECT ) 7009 return gensizeerr(gettext("ichinrem2 1")); 7010 int as=int(ax._VECTptr->size()),bs=int(bx._VECTptr->size()); 7011 if (!as || !bs) 7012 return gensizeerr(gettext("Null polynomial")); 7013 while (as<bs){ 7014 ax._VECTptr->insert(ax._VECTptr->begin(),0); 7015 ++as; 7016 } 7017 while (bs<as){ 7018 bx._VECTptr->insert(bx._VECTptr->begin(),0); 7019 ++bs; 7020 } 7021 gen a0=ax._VECTptr->front(),b0=bx._VECTptr->front(),m,n; 7022 if (a0.type==_MOD) 7023 m=*(a0._MODptr+1); 7024 else 7025 return gensizeerr(gettext("Expecting modular coeff")); 7026 if (b0.type==_MOD) 7027 n=*(b0._MODptr+1); 7028 else 7029 return gensizeerr(gettext("Expecting modular coeff")); 7030 gen mn=lcm(m,n); 7031 const_iterateur it=ax._VECTptr->begin(),itend=ax._VECTptr->end(),jt=bx._VECTptr->begin(); 7032 vecteur res; 7033 for (;as>bs;--as,++it){ 7034 res.push_back(makemod(unmod(*it),mn)); 7035 } 7036 for (;bs>as;--bs,++jt){ 7037 res.push_back(makemod(unmod(*jt),mn)); 7038 } 7039 for (;it!=itend;++it,++jt) 7040 res.push_back(ichinrem2(makemod(unmod(*it),m),makemod(unmod(*jt),n))); 7041 return _r2e(gen(makevecteur(res,x),_SEQ__VECT),context0); // ok 7042 } 7043 if (a.type==_VECT && a._VECTptr->size()==2 && b.type==_VECT && b._VECTptr->size()==2 ){ 7044 // ax and bx are the polynomials, 7045 gen ax=_e2r(makevecteur(a._VECTptr->front(),x),context0),bx=_e2r(makevecteur(b._VECTptr->front(),x),context0); // ok 7046 if (ax.type!=_VECT || bx.type!=_VECT ) 7047 return gensizeerr(gettext("ichinrem2 2")); 7048 gen m=a._VECTptr->back(),n=b._VECTptr->back(),mn=lcm(m,n); 7049 int as=int(ax._VECTptr->size()),bs=int(bx._VECTptr->size()); 7050 const_iterateur it=ax._VECTptr->begin(),itend=ax._VECTptr->end(),jt=bx._VECTptr->begin(); 7051 vecteur res; 7052 for (;as>bs;--as,++it){ 7053 gen tmp=ichinrem2(makevecteur(*it,m),makevecteur(0,n)); 7054 if (tmp.type!=_VECT) 7055 return gensizeerr(gettext("ichinrem2 3")); 7056 res.push_back(tmp._VECTptr->front()); 7057 } 7058 for (;bs>as;--bs,++jt){ 7059 gen tmp=ichinrem2(makevecteur(0,m),makevecteur(*jt,n)); 7060 if (tmp.type!=_VECT) 7061 return gensizeerr(gettext("ichinrem2 3")); 7062 res.push_back(tmp._VECTptr->front()); 7063 } 7064 for (;it!=itend;++it,++jt){ 7065 gen tmp=ichinrem2(makevecteur(*it,m),makevecteur(*jt,n)); 7066 if (tmp.type!=_VECT) 7067 return gensizeerr(gettext("ichinrem2 3")); 7068 res.push_back(tmp._VECTptr->front()); 7069 } 7070 if (a_orig.type==_MOD) 7071 return makemod(_r2e(gen(makevecteur(res,x),_SEQ__VECT),context0),mn); // ok 7072 return makevecteur(_r2e(gen(makevecteur(res,x),_SEQ__VECT),context0),m*n); // ok 7073 } 7074 return gensizeerr(gettext("ichinrem2 4")); 7075 } _ichinrem(const gen & args,GIAC_CONTEXT)7076 gen _ichinrem(const gen & args,GIAC_CONTEXT){ 7077 if ( args.type==_STRNG && args.subtype==-1) return args; 7078 if (args.type!=_VECT) 7079 return gentypeerr(gettext("[a % p, b % q,...]")); 7080 vecteur & v = *args._VECTptr; 7081 int s=int(v.size()); 7082 if (s<2) 7083 return gendimerr(contextptr); 7084 if (is_integer(v[0]) && is_integer(v[1])) 7085 return v; 7086 gen res=ichinrem2(v[0],v[1]); 7087 for (int i=2;i<s;++i) 7088 res=ichinrem2(res,v[i]); 7089 if (res.type==_VECT && res._VECTptr->size()==2 && is_integer(res._VECTptr->front()) && is_integer(res._VECTptr->back())) 7090 res._VECTptr->front()=_irem(makesequence(res._VECTptr->front()+res._VECTptr->back(),res._VECTptr->back()),contextptr); 7091 return res; 7092 } 7093 static const char _ichinrem_s []="ichinrem"; 7094 static define_unary_function_eval (__ichinrem,&_ichinrem,_ichinrem_s); 7095 define_unary_function_ptr5( at_ichinrem ,alias_at_ichinrem,&__ichinrem,0,true); 7096 _fracmod(const gen & args,GIAC_CONTEXT)7097 gen _fracmod(const gen & args,GIAC_CONTEXT){ 7098 if ( args.type==_STRNG && args.subtype==-1) return args; 7099 if ( (args.type!=_VECT) || (args._VECTptr->size()!=2)) 7100 return symbolic(at_fracmod,args); 7101 vecteur & v=*args._VECTptr; 7102 return fracmod(v[0],v[1]); 7103 } 7104 static const char _fracmod_s []="fracmod"; 7105 static define_unary_function_eval (__fracmod,&_fracmod,_fracmod_s); 7106 define_unary_function_ptr5( at_fracmod ,alias_at_fracmod,&__fracmod,0,true); 7107 7108 static const char _iratrecon_s []="iratrecon"; // maple name, fracmod takes only 2 arg 7109 static define_unary_function_eval (__iratrecon,&_fracmod,_iratrecon_s); 7110 define_unary_function_ptr5( at_iratrecon ,alias_at_iratrecon,&__iratrecon,0,true); 7111 7112 // static symbolic symb_chinrem(const gen & a,const gen & b){ return symbolic(at_chinrem,makevecteur(a,b)); } polyvect(const gen & a,const vecteur & v)7113 static vecteur polyvect(const gen & a,const vecteur & v){ 7114 if (a.type==_POLY) 7115 return polynome2poly1(*a._POLYptr,1); 7116 return vecteur(1,a); 7117 } _chinrem(const gen & args,GIAC_CONTEXT)7118 gen _chinrem(const gen & args,GIAC_CONTEXT){ 7119 if ( args.type==_STRNG && args.subtype==-1) return args; 7120 if ( (args.type!=_VECT) || (args._VECTptr->size()<2) ) 7121 return gensizeerr(contextptr); 7122 gen a=args._VECTptr->front(); 7123 gen b=(*args._VECTptr)[1]; 7124 if (!check_2d_vecteur(a) || 7125 !check_2d_vecteur(b) ) 7126 return gensizeerr(contextptr); 7127 if ((a._VECTptr->front().type!=_VECT) || (a._VECTptr->back().type!=_VECT) || (b._VECTptr->front().type!=_VECT) || (b._VECTptr->back().type!=_VECT) ){ 7128 vecteur lv; 7129 if (args._VECTptr->size()==3) 7130 lv=vecteur(1,(*args._VECTptr)[2]); 7131 else 7132 lv=vecteur(1,vx_var); 7133 lvar(args,lv); 7134 vecteur lvprime(lv.begin()+1,lv.end()); 7135 gen aa=e2r(a,lv,contextptr),bb=e2r(b,lv,contextptr),aan,aad,bbn,bbd; 7136 fxnd(aa,aan,aad); 7137 if (aad.type==_POLY){ 7138 if (aad._POLYptr->lexsorted_degree() ) 7139 return gensizeerr(contextptr); 7140 else 7141 aad=aad._POLYptr->trunc1(); 7142 } 7143 fxnd(bb,bbn,bbd); 7144 if (bbd.type==_POLY){ 7145 if (bbd._POLYptr->lexsorted_degree() ) 7146 return gensizeerr(contextptr); 7147 else 7148 bbd=bbd._POLYptr->trunc1(); 7149 } 7150 vecteur & aanv=*aan._VECTptr; 7151 vecteur & bbnv=*bbn._VECTptr; 7152 aanv[0]=polyvect(aanv[0],lv)/aad; 7153 aanv[1]=polyvect(aanv[1],lv); 7154 bbnv[0]=polyvect(bbnv[0],lv)/bbd; 7155 bbnv[1]=polyvect(bbnv[1],lv); 7156 gen tmpg=_chinrem(makevecteur(aanv,bbnv),contextptr); 7157 if (is_undef(tmpg)) return tmpg; 7158 vecteur res=*tmpg._VECTptr; 7159 // convert back 7160 res[0]=symb_horner(*r2e(res[0],lvprime,contextptr)._VECTptr,lv.front()); 7161 res[1]=symb_horner(*r2e(res[1],lvprime,contextptr)._VECTptr,lv.front()); 7162 return res; 7163 } 7164 modpoly produit=(*a._VECTptr->back()._VECTptr)**b._VECTptr->back()._VECTptr; 7165 return makevecteur(gen(chinrem(*a._VECTptr->front()._VECTptr,*b._VECTptr->front()._VECTptr,*a._VECTptr->back()._VECTptr,*b._VECTptr->back()._VECTptr,0),_POLY1__VECT),gen(produit,_POLY1__VECT)); 7166 } 7167 static const char _chinrem_s []="chinrem"; 7168 static define_unary_function_eval (__chinrem,&_chinrem,_chinrem_s); 7169 define_unary_function_ptr5( at_chinrem ,alias_at_chinrem,&__chinrem,0,true); 7170 printasfactorial(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)7171 static string printasfactorial(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 7172 if (feuille.type==_IDNT || ((feuille.type<=_DOUBLE_ || feuille.type==_FLOAT_ || feuille.type==_REAL) && is_positive(feuille,contextptr))) 7173 return feuille.print(contextptr)+"!"; 7174 return "("+feuille.print(contextptr)+")!"; 7175 } d_factorial(const gen & args,GIAC_CONTEXT)7176 static gen d_factorial(const gen & args,GIAC_CONTEXT){ 7177 return Psi(args+1,0)*_factorial(args,contextptr); 7178 } 7179 define_partial_derivative_onearg_genop( D_at_factorial," D_at_factorial",&d_factorial); _factorial(const gen & args,GIAC_CONTEXT)7180 gen _factorial(const gen & args,GIAC_CONTEXT){ 7181 if ( args.type==_STRNG && args.subtype==-1) return args; 7182 if (args.type==_VECT) 7183 return apply(args,_factorial,contextptr); 7184 gen tmp=evalf_double(args,1,contextptr); 7185 if (tmp.type>=_IDNT) 7186 return symbolic(at_factorial,args); 7187 if (args.type!=_INT_) 7188 return Gamma(args+1,contextptr); 7189 if (args.val<0) 7190 return unsigned_inf; 7191 return factorial((unsigned long int) args.val); 7192 } 7193 static const char _factorial_s []="factorial"; 7194 static define_unary_function_eval5 (__factorial,&_factorial,D_at_factorial,_factorial_s,&printasfactorial,0); 7195 define_unary_function_ptr5( at_factorial ,alias_at_factorial,&__factorial,0,true); 7196 double_is_int(const gen & g,GIAC_CONTEXT)7197 gen double_is_int(const gen & g,GIAC_CONTEXT){ 7198 gen f=_floor(g,contextptr); 7199 if (f.type==_FLOAT_) 7200 f=get_int(f._FLOAT_val); 7201 gen f1=evalf(g-f,1,contextptr); 7202 if ( (f1.type==_DOUBLE_ && fabs(f1._DOUBLE_val)<epsilon(contextptr)) 7203 || (f1.type==_FLOAT_ && fabs(f1._FLOAT_val)<epsilon(contextptr)) ) 7204 return f; 7205 else 7206 return g; 7207 } comb(const gen & a_orig,const gen & b_orig,GIAC_CONTEXT)7208 gen comb(const gen & a_orig,const gen &b_orig,GIAC_CONTEXT){ 7209 gen a=double_is_int(a_orig,contextptr); 7210 gen b=double_is_int(b_orig,contextptr); 7211 if (a.type!=_INT_ || b.type!=_INT_) 7212 return Gamma(a+1,contextptr)/Gamma(b+1,contextptr)/Gamma(a-b+1,contextptr); 7213 if (a.val<0 || b.val<0){ 7214 *logptr(contextptr) << "comb with negative argument " << a << "," << b <<'\n'; 7215 //return gensizeerr(contextptr); 7216 } 7217 return comb((unsigned long int) a.val,(unsigned long int) b.val); 7218 } _comb(const gen & args,GIAC_CONTEXT)7219 gen _comb(const gen & args,GIAC_CONTEXT){ 7220 if ( args.type==_STRNG && args.subtype==-1) return args; 7221 if (ckmatrix(args)) 7222 return apply(args._VECTptr->front(),args._VECTptr->back(),contextptr,comb); 7223 if ( (args.type!=_VECT) || (args._VECTptr->size()!=2)) 7224 return gentypeerr(contextptr); 7225 vecteur & v=*args._VECTptr; 7226 if (v.front().type!=_INT_ || v.back().type!=_INT_) 7227 return comb(v.front(),v.back(),contextptr); 7228 if (v.front().val<0){ 7229 int n=v.front().val; 7230 int k=v.back().val; 7231 if (k<0) 7232 return gensizeerr(contextptr); 7233 gen res=1; 7234 for (int i=0;i<k;++i){ 7235 res=(n-i)*res; 7236 } 7237 return res/factorial(k); 7238 } 7239 if (v.front().val<v.back().val) 7240 return zero; 7241 return comb((unsigned long int) v.front().val,(unsigned long int) v.back().val); 7242 } 7243 static const char _comb_s []="comb"; 7244 static define_unary_function_eval (__comb,&_comb,_comb_s); 7245 define_unary_function_ptr5( at_comb ,alias_at_comb,&__comb,0,true); 7246 perm(const gen & a,const gen & b)7247 gen perm(const gen & a,const gen &b){ 7248 if (a.type!=_INT_ || b.type!=_INT_) 7249 return symbolic(at_perm,gen(makevecteur(a,b),_SEQ__VECT)); 7250 return perm((unsigned long int) a.val,(unsigned long int) b.val); 7251 } _perm(const gen & args,GIAC_CONTEXT)7252 gen _perm(const gen & args,GIAC_CONTEXT){ 7253 if ( args.type==_STRNG && args.subtype==-1) return args; 7254 if (ckmatrix(args)) 7255 return apply(args._VECTptr->front(),args._VECTptr->back(),perm); 7256 if ( (args.type!=_VECT) || (args._VECTptr->size()!=2)) 7257 return gentypeerr(contextptr); 7258 if ( (args._VECTptr->front().type!=_INT_) || (args._VECTptr->back().type!=_INT_) ) 7259 return _factorial(args._VECTptr->front(),contextptr)/_factorial(args._VECTptr->front()-args._VECTptr->back(),contextptr); 7260 if (args._VECTptr->front().val<args._VECTptr->back().val) 7261 return zero; 7262 if (args._VECTptr->front().val<0) 7263 return undef; 7264 return perm((unsigned long int) args._VECTptr->front().val,(unsigned long int) args._VECTptr->back().val); 7265 } 7266 static const char _perm_s []="perm"; 7267 static define_unary_function_eval (__perm,&_perm,_perm_s); 7268 define_unary_function_ptr5( at_perm ,alias_at_perm,&__perm,0,true); 7269 7270 // ****************** 7271 // Matrix functions 7272 // ***************** 7273 symb_tran(const gen & a)7274 symbolic symb_tran(const gen & a){ 7275 return symbolic(at_tran,a); 7276 } symb_trace(const gen & a)7277 symbolic symb_trace(const gen & a){ 7278 return symbolic(at_trace,a); 7279 } symb_rref(const gen & a)7280 symbolic symb_rref(const gen & a){ 7281 return symbolic(at_rref,a); 7282 } symb_idn(const gen & e)7283 symbolic symb_idn(const gen & e){ 7284 return symbolic(at_idn,e); 7285 } symb_ranm(const gen & e)7286 symbolic symb_ranm(const gen & e){ 7287 return symbolic(at_ranm,e); 7288 } symb_det(const gen & a)7289 symbolic symb_det(const gen & a){ 7290 return symbolic(at_det,a); 7291 } symb_pcar(const gen & a)7292 symbolic symb_pcar(const gen & a){ 7293 return symbolic(at_pcar,a); 7294 } symb_ker(const gen & a)7295 symbolic symb_ker(const gen & a){ 7296 return symbolic(at_ker,a); 7297 } symb_image(const gen & a)7298 symbolic symb_image(const gen & a){ 7299 return symbolic(at_image,a); 7300 } symb_moyal(const gen & a,const gen & b,const gen & vars,const gen & order)7301 symbolic symb_moyal(const gen & a,const gen & b, const gen &vars,const gen & order){ 7302 return symbolic(at_moyal,gen(makevecteur(a,b,vars,order),_SEQ__VECT)); 7303 } 7304 _evalf(const gen & a,int ndigits,GIAC_CONTEXT)7305 gen _evalf(const gen & a,int ndigits,GIAC_CONTEXT){ 7306 int save_decimal_digits=decimal_digits(contextptr); 7307 #ifndef HAVE_LIBMPFR 7308 if (ndigits>14) 7309 return gensizeerr(gettext("Longfloat library not available")); 7310 #endif 7311 set_decimal_digits(ndigits,contextptr); 7312 gen res=a.evalf(1,contextptr); 7313 if (res.type==_REAL || res.type==_CPLX) 7314 res=accurate_evalf(res,digits2bits(ndigits)); 7315 #if 0 7316 if (ndigits<=14 && calc_mode(contextptr)==1 && (res.type==_DOUBLE_ || res.type==_CPLX)){ 7317 int decal=0; 7318 decal=int(std::floor(std::log10(abs(res,contextptr)._DOUBLE_val))); 7319 res=res*pow(10,ndigits-decal-1,contextptr); 7320 res=_floor(re(res,contextptr)+.5,contextptr)+cst_i*_floor(im(res,contextptr)+.5,contextptr); 7321 res=evalf(res,1,contextptr)*pow(10,decal+1-ndigits,contextptr); 7322 } 7323 else { 7324 if (ndigits<=14 && !is_undef(res)){ 7325 res=_round(gen(makevecteur(res,ndigits),_SEQ__VECT),contextptr); 7326 } 7327 } 7328 #else 7329 if (ndigits<=14 && !is_undef(res)) 7330 res=gen(res.print(contextptr),contextptr); 7331 #endif 7332 set_decimal_digits(save_decimal_digits,contextptr); 7333 return res; 7334 } 7335 evalf_nbits(const gen & g,int nbits)7336 gen evalf_nbits(const gen & g,int nbits){ 7337 if (g.type==_REAL) 7338 return real_object(g,nbits); 7339 if (g.type==_CPLX) 7340 return real_object(*g._CPLXptr,nbits)+cst_i*real_object(*(g._CPLXptr+1),nbits); 7341 if (g.type==_VECT){ 7342 vecteur v=*g._VECTptr; 7343 for (unsigned i=0;i<v.size();++i) 7344 v[i]=evalf_nbits(v[i],nbits); 7345 return gen(v,g.subtype); 7346 } 7347 if (g.type==_SYMB) 7348 return symbolic(g._SYMBptr->sommet,evalf_nbits(g._SYMBptr->feuille,nbits)); 7349 return g; 7350 } 7351 need_workaround(const gen & g)7352 bool need_workaround(const gen & g){ 7353 if (g.type==_REAL || (g.type==_CPLX && g._CPLXptr->type==_REAL && (g._CPLXptr+1)->type==_REAL)) 7354 return false; 7355 if (g.type<=_CPLX) 7356 return g!=0 && g/g!=1; 7357 if (is_inf(g) || is_undef(g)) 7358 return true; 7359 if (g.type!=_VECT) 7360 return false; 7361 for (unsigned i=0;i<g._VECTptr->size();++i){ 7362 if (need_workaround((*g._VECTptr)[i])) 7363 return true; 7364 } 7365 return false; 7366 } 7367 _evalf(const gen & a_orig,GIAC_CONTEXT)7368 gen _evalf(const gen & a_orig,GIAC_CONTEXT){ 7369 gen a(a_orig); 7370 if (a.type==_STRNG && a.subtype==-1) return a; 7371 if (is_equal(a) &&a._SYMBptr->feuille.type==_VECT && a._SYMBptr->feuille._VECTptr->size()==2){ 7372 vecteur & v(*a._SYMBptr->feuille._VECTptr); 7373 return symbolic(at_equal,gen(makevecteur(evalf(v.front(),1,contextptr),evalf(v.back(),1,contextptr)),_SEQ__VECT)); 7374 } 7375 gen res; 7376 int ndigits=decimal_digits(contextptr); 7377 if (a.type==_VECT && a.subtype==_SEQ__VECT && a._VECTptr->size()==2 && a._VECTptr->back().type==_INT_){ 7378 ndigits=a._VECTptr->back().val; 7379 a=a._VECTptr->front(); 7380 res=_evalf(a,ndigits,contextptr); 7381 } 7382 else 7383 res=a.evalf(1,contextptr); 7384 #ifdef HAVE_LIBMPFR 7385 if ( ndigits<=14 && need_workaround(res)){ 7386 // evalf again with 30 digits (overflow workaround) 7387 res=_evalf(a,30,contextptr); 7388 // and round to ndigits 7389 int nbits=digits2bits(ndigits); 7390 res=evalf_nbits(res,nbits); 7391 return res; 7392 } 7393 #endif 7394 return res; 7395 } 7396 static const char _evalf_s []="evalf"; 7397 static define_unary_function_eval (__evalf,&_evalf,_evalf_s); 7398 define_unary_function_ptr5( at_evalf ,alias_at_evalf,&__evalf,0,true); symb_evalf(const gen & a)7399 symbolic symb_evalf(const gen & a){ 7400 return symbolic(at_evalf,a); 7401 } 7402 _eval(const gen & a,GIAC_CONTEXT)7403 gen _eval(const gen & a,GIAC_CONTEXT){ 7404 if ( a.type==_STRNG && a.subtype==-1) return a; 7405 if (python_compat(contextptr)){ 7406 gen b=eval(a,1,contextptr); 7407 if (b.type==_STRNG) 7408 return _expr(b,contextptr); 7409 } 7410 if (is_equal(a) &&a._SYMBptr->feuille.type==_VECT && a._SYMBptr->feuille._VECTptr->size()==2){ 7411 vecteur & v(*a._SYMBptr->feuille._VECTptr); 7412 return symbolic(at_equal,gen(makevecteur(eval(v.front(),eval_level(contextptr),contextptr),eval(v.back(),eval_level(contextptr),contextptr)),_SEQ__VECT)); 7413 } 7414 if (a.type==_VECT && a.subtype==_SEQ__VECT && a._VECTptr->size()==2){ 7415 gen a1=a._VECTptr->front(),a2=a._VECTptr->back(); 7416 if (a2.type==_INT_) 7417 return a1.eval(a2.val,contextptr); 7418 return _subst(gen(makevecteur(eval(a1,eval_level(contextptr),contextptr),a2),_SEQ__VECT),contextptr); 7419 } 7420 return a.eval(1,contextptr).eval(eval_level(contextptr),contextptr); 7421 } 7422 static const char _eval_s []="eval"; 7423 static define_unary_function_eval_quoted (__eval,&_eval,_eval_s); 7424 define_unary_function_ptr5( at_eval ,alias_at_eval,&__eval,_QUOTE_ARGUMENTS,true); symb_eval(const gen & a)7425 symbolic symb_eval(const gen & a){ 7426 return symbolic(at_eval,a); 7427 } 7428 7429 static const char _evalm_s []="evalm"; 7430 static define_unary_function_eval (__evalm,&_eval,_evalm_s); 7431 define_unary_function_ptr5( at_evalm ,alias_at_evalm,&__evalm,0,true); 7432 _ampersand_times(const gen & g,GIAC_CONTEXT)7433 gen _ampersand_times(const gen & g,GIAC_CONTEXT){ 7434 if ( g.type==_STRNG && g.subtype==-1) return g; 7435 if (g.type!=_VECT || g._VECTptr->size()!=2) 7436 return gensizeerr(contextptr); 7437 return g._VECTptr->front()*g._VECTptr->back(); 7438 } 7439 static const char _ampersand_times_s []="&*"; 7440 static define_unary_function_eval4_index (108,__ampersand_times,&_ampersand_times,_ampersand_times_s,&printsommetasoperator,&texprintsommetasoperator); 7441 define_unary_function_ptr( at_ampersand_times ,alias_at_ampersand_times ,&__ampersand_times); 7442 7443 static const char _subst_s []="subst"; _subst(const gen & args,GIAC_CONTEXT)7444 gen _subst(const gen & args,GIAC_CONTEXT){ 7445 if ( args.type==_STRNG && args.subtype==-1) return args; 7446 if (args.type!=_VECT) 7447 return gentypeerr(contextptr); 7448 vecteur & v = *args._VECTptr; 7449 int s=int(v.size()); 7450 if (s==2){ 7451 gen e=v.back(); 7452 if (e.type==_VECT){ 7453 vecteur w; 7454 if (ckmatrix(e)) 7455 aplatir(*e._VECTptr,w); 7456 else 7457 w = *e._VECTptr; 7458 vecteur vin,vout; 7459 const_iterateur it=w.begin(),itend=w.end(); 7460 for (;it!=itend;++it){ 7461 if (it->type!=_SYMB) 7462 continue; 7463 if (it->_SYMBptr->sommet!=at_equal && it->_SYMBptr->sommet!=at_equal2 && it->_SYMBptr->sommet!=at_same) 7464 continue; 7465 vin.push_back(it->_SYMBptr->feuille._VECTptr->front()); 7466 vout.push_back(it->_SYMBptr->feuille._VECTptr->back()); 7467 } 7468 gen res=subst(v.front(),vin,vout,false,contextptr); 7469 return res; 7470 } 7471 if (e.type!=_SYMB) 7472 return gentypeerr(contextptr); 7473 if (e._SYMBptr->sommet!=at_equal && e._SYMBptr->sommet!=at_equal2 && e._SYMBptr->sommet!=at_same) 7474 return gensizeerr(contextptr); 7475 return subst(v.front(),e._SYMBptr->feuille._VECTptr->front(),e._SYMBptr->feuille._VECTptr->back(),false,contextptr); 7476 } 7477 if (s<3) 7478 return gentoofewargs(_subst_s); 7479 if (s>3) 7480 return gentoomanyargs(_subst_s); 7481 if (is_equal(v[1])) 7482 return _subst(makevecteur(v.front(),vecteur(v.begin()+1,v.end())),contextptr); 7483 return subst(v.front(),v[1],v.back(),false,contextptr); 7484 } 7485 static define_unary_function_eval (__subst,&_subst,_subst_s); 7486 define_unary_function_ptr5( at_subst ,alias_at_subst,&__subst,0,true); 7487 // static symbolic symb_subst(const gen & a){ return symbolic(at_subst,a); } 7488 printassubs(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)7489 string printassubs(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 7490 if (xcas_mode(contextptr)!=1 || feuille.type!=_VECT || feuille._VECTptr->size()!=2) 7491 return sommetstr+("("+feuille.print(contextptr)+")"); 7492 vecteur & v=*feuille._VECTptr; 7493 vecteur w=mergevecteur(vecteur(1,v.back()),vecteur(v.begin(),v.end()-1)); 7494 return sommetstr+("("+gen(w,_SEQ__VECT).print(contextptr)+")"); 7495 } _subs(const gen & g,GIAC_CONTEXT)7496 gen _subs(const gen & g,GIAC_CONTEXT){ 7497 if ( g.type==_STRNG && g.subtype==-1) return g; 7498 if ( g.type==_STRNG && g.subtype==-1) return g; 7499 return _subst(g,contextptr); 7500 } 7501 static const char _subs_s []="subs"; 7502 static define_unary_function_eval2 (__subs,&_subs,_subs_s,&printassubs); 7503 define_unary_function_ptr( at_subs ,alias_at_subs ,&__subs); 7504 printasmaple_subs(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)7505 string printasmaple_subs(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 7506 if (xcas_mode(contextptr)==1 || feuille.type!=_VECT || feuille._VECTptr->size()<2) 7507 return sommetstr+("("+feuille.print(contextptr)+")"); 7508 vecteur & v=*feuille._VECTptr; 7509 vecteur w=mergevecteur(vecteur(1,v.back()),vecteur(v.begin(),v.end()-1)); 7510 return sommetstr+("("+gen(w,_SEQ__VECT).print(contextptr)+")"); 7511 } _maple_subs(const gen & g,GIAC_CONTEXT)7512 gen _maple_subs(const gen & g,GIAC_CONTEXT){ 7513 if ( g.type==_STRNG && g.subtype==-1) return g; 7514 if (g.type!=_VECT || g._VECTptr->size()<2) 7515 return _subst(g,contextptr); 7516 vecteur &v=*g._VECTptr; 7517 if (v.size()==2) 7518 return _subst(makevecteur(v.back(),v.front()),contextptr); 7519 else 7520 return _subst(makevecteur(v.back(),vecteur(v.begin(),v.end()-1)),contextptr); 7521 } 7522 static const char _maple_subs_s []="subs"; 7523 static define_unary_function_eval2 (__maple_subs,&_maple_subs,_maple_subs_s,&printasmaple_subs); 7524 define_unary_function_ptr( at_maple_subs ,alias_at_maple_subs ,&__maple_subs); 7525 7526 version()7527 string version(){ 7528 return string("giac ")+GIAC_VERSION+string(", (c) B. Parisse and R. De Graeve, Institut Fourier, Universite de Grenoble I"); 7529 } _version(const gen & a,GIAC_CONTEXT)7530 gen _version(const gen & a,GIAC_CONTEXT){ 7531 if ( a.type==_STRNG && a.subtype==-1) return a; 7532 if (abs_calc_mode(contextptr)==38) 7533 return string2gen(gettext("Powered by Giac 1.1.3, B. Parisse and R. De Graeve, Institut Fourier, Universite Grenoble I, France"),false); 7534 return string2gen(version(),false); 7535 } 7536 static const char _version_s []="version"; 7537 static define_unary_function_eval (__version,&_version,_version_s); 7538 define_unary_function_ptr5( at_version ,alias_at_version,&__version,0,true); 7539 prod2frac(const gen & g,vecteur & num,vecteur & den)7540 void prod2frac(const gen & g,vecteur & num,vecteur & den){ 7541 num.clear(); 7542 den.clear(); 7543 if (g.type==_FRAC){ 7544 vecteur num2,den2; 7545 prod2frac(g._FRACptr->num,num,den); 7546 prod2frac(g._FRACptr->den,den2,num2); 7547 num=mergevecteur(num,num2); 7548 den=mergevecteur(den,den2); 7549 return; 7550 } 7551 if (g.is_symb_of_sommet(at_neg)){ 7552 prod2frac(g._SYMBptr->feuille,num,den); 7553 if (!num.empty()){ 7554 num.front()=-num.front(); 7555 return; 7556 } 7557 if (!den.empty()){ 7558 den.front()=-den.front(); 7559 return; 7560 } 7561 } 7562 if ( (g.type!=_SYMB) || (g._SYMBptr->sommet!=at_prod) || (g._SYMBptr->feuille.type!=_VECT)){ 7563 if (g.is_symb_of_sommet(at_division)){ 7564 vecteur num2,den2; 7565 prod2frac(g._SYMBptr->feuille._VECTptr->front(),num,den); 7566 prod2frac(g._SYMBptr->feuille._VECTptr->back(),den2,num2); 7567 num=mergevecteur(num,num2); 7568 den=mergevecteur(den,den2); 7569 return; 7570 } 7571 if (g.is_symb_of_sommet(at_inv)) 7572 prod2frac(g._SYMBptr->feuille,den,num); 7573 else 7574 num=vecteur(1,g); 7575 return; 7576 } 7577 vecteur & v=*g._SYMBptr->feuille._VECTptr; 7578 const_iterateur it=v.begin(),itend=v.end(); 7579 for (;it!=itend;++it){ 7580 if ( (it->type==_SYMB) && (it->_SYMBptr->sommet==at_inv) ) 7581 den.push_back(it->_SYMBptr->feuille); 7582 else 7583 num.push_back(*it); 7584 } 7585 } 7586 vecteur2prod(const vecteur & num)7587 gen vecteur2prod(const vecteur & num){ 7588 if (num.empty()) 7589 return plus_one; 7590 if (num.size()==1) 7591 return num.front(); 7592 return symbolic(at_prod,gen(num,_SEQ__VECT)); 7593 } 7594 need_parenthesis(const gen & g)7595 bool need_parenthesis(const gen & g){ 7596 if (g.type==_INT_ || g.type==_ZINT) 7597 return is_strictly_positive(-g,context0); // ok 7598 if (g.type==_CPLX){ 7599 gen rg=re(-g,context0),ig(im(-g,context0)); // ok 7600 if ( is_exactly_zero(rg)) 7601 return is_strictly_positive(ig,context0); // ok 7602 if (is_exactly_zero(ig) ) 7603 return is_strictly_positive(rg,context0); // ok 7604 return true; 7605 } 7606 if (g.type==_FRAC) 7607 return true; 7608 if (g.type==_SYMB) 7609 return need_parenthesis(g._SYMBptr->sommet); 7610 if (g.type!=_FUNC) 7611 return false; 7612 unary_function_ptr & u=*g._FUNCptr; 7613 if (u==at_pow || u==at_division || u==at_prod) 7614 return false; 7615 if (u==at_neg || u==at_inv || u==at_minus || u==at_and || u==at_et || u==at_ou || u==at_oufr || u==at_xor || u==at_same || u==at_equal || u==at_equal2 || u==at_superieur_egal || u==at_superieur_strict || u==at_inferieur_egal || u==at_inferieur_strict) 7616 return true; 7617 if (!u.ptr()->printsommet) 7618 return false; 7619 return true; 7620 } 7621 _multistring(const gen & args,GIAC_CONTEXT)7622 gen _multistring(const gen & args,GIAC_CONTEXT){ 7623 if ( args.type==_STRNG && args.subtype==-1) return args; 7624 string res; 7625 if (args.type==_VECT){ 7626 const_iterateur it=args._VECTptr->begin(),itend=args._VECTptr->end(); 7627 for (;it!=itend;){ 7628 if (it->type!=_STRNG) 7629 break; 7630 res += *it->_STRNGptr; 7631 ++it; 7632 if (it==itend) 7633 return string2gen(res,false); 7634 res += '\n'; 7635 } 7636 } 7637 else {// newline added, otherwise Eqw_compute_size would fail 7638 if (args.type==_STRNG) 7639 res=*args._STRNGptr; 7640 else 7641 res=args.print(contextptr); 7642 res += '\n'; 7643 } 7644 return string2gen(res,false); 7645 } 7646 static const char _multistring_s []="multistring"; 7647 static define_unary_function_eval (__multistring,&_multistring,_multistring_s); 7648 define_unary_function_ptr( at_multistring ,alias_at_multistring ,&__multistring); 7649 7650 #ifndef HAVE_LONG_DOUBLE 7651 static const double LN_SQRT2PI = 0.9189385332046727418; //log(2*PI)/2 7652 static const double M_PIL=3.141592653589793238462643383279; 7653 static const double LC1 = 0.08333333333333333, 7654 LC2 = -0.002777777777777778, 7655 LC3 = 7.936507936507937E-4, 7656 LC4 = -5.952380952380953E-4; 7657 static const double L9[] = { 7658 0.99999999999980993227684700473478, 7659 676.520368121885098567009190444019, 7660 -1259.13921672240287047156078755283, 7661 771.3234287776530788486528258894, 7662 -176.61502916214059906584551354, 7663 12.507343278686904814458936853, 7664 -0.13857109526572011689554707, 7665 9.984369578019570859563e-6, 7666 1.50563273514931155834e-7 7667 }; 7668 #else 7669 static const long_double LN_SQRT2PI = 0.9189385332046727418L; //log(2*PI)/2 7670 static const long_double M_PIL=3.141592653589793238462643383279L; 7671 static const long_double LC1 = 0.08333333333333333L, 7672 LC2 = -0.002777777777777778L, 7673 LC3 = 7.936507936507937E-4L, 7674 LC4 = -5.952380952380953E-4L; 7675 static const long_double L9[] = { 7676 0.99999999999980993227684700473478L, 7677 676.520368121885098567009190444019L, 7678 -1259.13921672240287047156078755283L, 7679 771.3234287776530788486528258894L, 7680 -176.61502916214059906584551354L, 7681 12.507343278686904814458936853L, 7682 -0.13857109526572011689554707L, 7683 9.984369578019570859563e-6L, 7684 1.50563273514931155834e-7L 7685 }; 7686 #endif 7687 7688 // Stirling/Lanczos approximation for ln(Gamma()) lngamma(double X)7689 double lngamma(double X){ 7690 long_double res,x(X); 7691 if (x<0.5) 7692 #ifndef HAVE_LONG_DOUBLE 7693 res=std::log(M_PIL) -std::log(std::sin(M_PIL*x)) - lngamma(1.-x); 7694 #else 7695 res=std::log(M_PIL) -std::log(std::sin(M_PIL*x)) - lngamma(1.L-x); 7696 #endif 7697 else { 7698 --x; 7699 if (x<20){ 7700 // CdB Loop manually unrolled due to a IAR compiler bug! 7701 long_double a = L9[0] + L9[1]/(x+1.0) + L9[2]/(x+2.0) + L9[3]/(x+3.0) + L9[4]/(x+4.0) + L9[5]/(x+5.0) + L9[6]/(x+6.0) + L9[7]/(x+7.0) + L9[8]/(x+8.0); 7702 // long_double a = L9[0]; 7703 // for (int i = 1; i < 9; ++i) { 7704 // a+= L9[i]/(x+(long_double)(i)); 7705 // } 7706 #ifndef HAVE_LONG_DOUBLE 7707 res= (LN_SQRT2PI + std::log(a) - 7.) + (x+.5)*(std::log(x+7.5)-1.); 7708 #else 7709 res= (LN_SQRT2PI + std::log(a) - 7.L) + (x+.5L)*(std::log(x+7.5L)-1.L); 7710 #endif 7711 } 7712 else { 7713 long_double 7714 #ifndef HAVE_LONG_DOUBLE 7715 r1 = 1./x, 7716 #else 7717 r1 = 1.L/x, 7718 #endif 7719 r2 = r1*r1, 7720 r3 = r1*r2, 7721 r5 = r2*r3, 7722 r7 = r3*r3*r1; 7723 #ifndef HAVE_LONG_DOUBLE 7724 res=(x+.5)*std::log(x) - x + LN_SQRT2PI + LC1*r1 + LC2*r3 + LC3*r5 + LC4*r7; 7725 #else 7726 res=(x+.5L)*std::log(x) - x + LN_SQRT2PI + LC1*r1 + LC2*r3 + LC3*r5 + LC4*r7; 7727 #endif 7728 } 7729 } 7730 return res; 7731 } 7732 lngamma(complex_long_double x)7733 static complex_long_double lngamma(complex_long_double x){ 7734 complex_long_double res; 7735 if (x.real()<0.5){ 7736 #if !defined(HAVE_LONG_DOUBLE) || defined(PNACL) 7737 #ifdef FREERTOS 7738 res=std::log(M_PI) -std::log(complex_long_double(std::sin(M_PI*x.real())*std::cosh(M_PI*x.imag()),std::cos(M_PI*x.real())*std::sinh(M_PI*x.imag()))) - lngamma(1.-x); 7739 #else 7740 res=std::log((double) M_PI) -std::log(std::sin((double)M_PI*x)) - lngamma(1.-x); 7741 #endif 7742 #else 7743 res=std::log(M_PIL) -std::log(std::sin(M_PIL*x)) - lngamma(1.L-x); 7744 #endif 7745 } else { 7746 #if !defined(HAVE_LONG_DOUBLE) || defined(PNACL) 7747 x=x-1.; 7748 #else 7749 x=x-1.L; 7750 #endif 7751 complex_long_double a = L9[0]; 7752 for (int i = 1; i < 9; ++i) { 7753 a+= L9[i]/(x+(long_double)(i)); 7754 } 7755 #if !defined(HAVE_LONG_DOUBLE) || defined(PNACL) 7756 res= (LN_SQRT2PI + std::log(a) - 7.) + (x+.5)*(std::log(x+7.5)-1.); 7757 #else 7758 res= (LN_SQRT2PI + std::log(a) - 7.L) + (x+.5L)*(std::log(x+7.5L)-1.L); 7759 #endif 7760 } 7761 return res; 7762 } 7763 lngamma(const gen & x,GIAC_CONTEXT)7764 gen lngamma(const gen & x,GIAC_CONTEXT){ 7765 gen g(x); 7766 if (g.type==_FLOAT_) 7767 g=evalf_double(g,1,contextptr); 7768 if (g.type==_DOUBLE_){ 7769 if (g._DOUBLE_val<0){ 7770 if (g._DOUBLE_val==int(g._DOUBLE_val)) 7771 return undef; 7772 gen gg(g._DOUBLE_val,0.1); 7773 *(gg._CPLXptr+1)=0.0; // convert to complex 7774 return lngamma(gg,contextptr); 7775 } 7776 return lngamma(g._DOUBLE_val); 7777 } 7778 if (g.type==_CPLX && (g._CPLXptr->type==_DOUBLE_ || (g._CPLXptr+1)->type==_DOUBLE_ || 7779 g._CPLXptr->type==_FLOAT_ || (g._CPLXptr+1)->type==_FLOAT_)){ 7780 g=evalf_double(g,1,contextptr); 7781 complex_long_double z(re(g,contextptr)._DOUBLE_val,im(g,contextptr)._DOUBLE_val); 7782 z=lngamma(z); 7783 return gen(double(z.real()),double(z.imag())); 7784 } 7785 return ln(Gamma(x,contextptr),contextptr); 7786 } 7787 static const char _lgamma_s[]="lgamma"; 7788 static define_unary_function_eval (__lgamma,&lngamma,_lgamma_s); 7789 define_unary_function_ptr5( at_lgamma ,alias_at_lgamma,&__lgamma,0,T_UNARY_OP); 7790 7791 // Gamma function 7792 // lnGamma_minus is ln(Gamma)-(z-1/2)*ln(z)+z which is tractable at +inf taylor_lnGamma_minus(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)7793 static gen taylor_lnGamma_minus(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 7794 if (ordre<0) 7795 return 0; 7796 if (lim_point!=plus_inf) 7797 return gensizeerr(contextptr); 7798 shift_coeff=0; 7799 vecteur v; 7800 // ln(Gamma(z)) = (z-1/2)*ln(z) - z + 7801 // ln(2*pi)/2 + sum(B_2n /((2n)*(2n-1)*z^(2n-1)),n>=1) 7802 v.push_back(symbolic(at_ln,cst_two_pi)/2); 7803 for (int n=1;2*n<=ordre;++n){ 7804 v.push_back(bernoulli(2*n)/(4*n*n-2*n)); 7805 v.push_back(0); 7806 } 7807 v.push_back(undef); 7808 return v; 7809 } 7810 // lnGamma_minus is ln(Gamma)-(z-1/2)*ln(z)+z which is tractable at +inf d_lnGamma_minus(const gen & args,GIAC_CONTEXT)7811 static gen d_lnGamma_minus(const gen & args,GIAC_CONTEXT){ 7812 return Psi(args,0)+1-symbolic(at_ln,args)-(args+minus_one_half)/args; 7813 } 7814 define_partial_derivative_onearg_genop( D_at_lnGamma_minus," D_at_lnGamma_minus",&d_lnGamma_minus); _lnGamma_minus(const gen & g,GIAC_CONTEXT)7815 static gen _lnGamma_minus(const gen & g,GIAC_CONTEXT){ 7816 if ( g.type==_STRNG && g.subtype==-1) return g; 7817 if (is_inf(g)) 7818 return symbolic(at_ln,cst_two_pi)/2; 7819 return symbolic(at_lnGamma_minus,g); 7820 } 7821 static const char _lnGamma_minus_s []="lnGamma_minus"; 7822 #ifdef GIAC_HAS_STO_38 7823 static define_unary_function_eval_taylor( __lnGamma_minus,&_lnGamma_minus,(size_t)&D_at_lnGamma_minusunary_function_ptr,&taylor_lnGamma_minus,_lnGamma_minus_s); 7824 #else 7825 static define_unary_function_eval_taylor( __lnGamma_minus,&_lnGamma_minus,D_at_lnGamma_minus,&taylor_lnGamma_minus,_lnGamma_minus_s); 7826 #endif 7827 define_unary_function_ptr5( at_lnGamma_minus ,alias_at_lnGamma_minus,&__lnGamma_minus,0,true); 7828 // ln(Gamma) = lnGamma_minus + (z-1/2)*ln(z)-z which is tractable at +inf Gamma_replace(const gen & g,GIAC_CONTEXT)7829 static gen Gamma_replace(const gen & g,GIAC_CONTEXT){ 7830 return symbolic(at_exp,(g+minus_one_half)*symbolic(at_ln,g)-g)*symbolic(at_exp,_lnGamma_minus(g,contextptr)); 7831 } taylor_Gamma(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)7832 static gen taylor_Gamma (const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 7833 if (ordre<0){ 7834 return 0; // statically handled now 7835 //limit_tractable_functions().push_back(at_Gamma); 7836 //limit_tractable_replace().push_back(Gamma_replace); 7837 //return 1; 7838 } 7839 shift_coeff=0; 7840 if (!is_integer(lim_point) || is_strictly_positive(lim_point,contextptr)) 7841 return taylor(lim_point,ordre,f,0,shift_coeff,contextptr); 7842 // Laurent series for Gamma 7843 if (lim_point.type!=_INT_) 7844 return gensizeerr(contextptr); 7845 vecteur v; 7846 identificateur x(" "); 7847 int n=-lim_point.val; 7848 gen decal(1); 7849 for (int i=1;i<=n;++i){ 7850 decal = decal/(x-i); 7851 } 7852 taylor(decal,x,zero,ordre,v,contextptr); 7853 gen Psi1=taylor(1,ordre,f,0,shift_coeff,contextptr); 7854 shift_coeff=-1; 7855 if (Psi1.type!=_VECT) 7856 return gensizeerr(contextptr); 7857 v=operator_times(v,*Psi1._VECTptr,0); 7858 v=vecteur(v.begin(),v.begin()+ordre); 7859 v.push_back(undef); 7860 return v; 7861 } d_Gamma(const gen & args,GIAC_CONTEXT)7862 static gen d_Gamma(const gen & args,GIAC_CONTEXT){ 7863 return Psi(args,0)*Gamma(args,contextptr); 7864 } 7865 define_partial_derivative_onearg_genop( D_at_Gamma," D_at_Gamma",&d_Gamma); Gamma(const gen & x,GIAC_CONTEXT)7866 gen Gamma(const gen & x,GIAC_CONTEXT){ 7867 if (x.type==_VECT && x.subtype==_SEQ__VECT && x._VECTptr->size()>=2){ 7868 gen s=x._VECTptr->front(),z=(*x._VECTptr)[1]; 7869 if (s.type==_DOUBLE_) 7870 z=evalf_double(z,1,contextptr); 7871 if (z.type==_DOUBLE_) 7872 s=evalf_double(s,1,contextptr); 7873 if (s.type==_DOUBLE_ && z.type==_DOUBLE_){ 7874 bool regu=x._VECTptr->size()==3?!is_zero(x._VECTptr->back()):false; 7875 gen res=upper_incomplete_gammad(s._DOUBLE_val,z._DOUBLE_val,regu); 7876 if (res==-1){ 7877 return regu?1:Gamma(s._DOUBLE_val,contextptr)-lower_incomplete_gamma(s._DOUBLE_val,z._DOUBLE_val,regu,contextptr); 7878 //return gensizeerr(contextptr); 7879 } 7880 return res; 7881 } 7882 return symbolic(at_Gamma,x); 7883 } 7884 if (x==plus_inf) 7885 return x; 7886 if (is_inf(x)) 7887 return undef; 7888 #ifndef KHICAS 7889 if (x.type==_FLOAT_) 7890 return fgamma(x._FLOAT_val); 7891 #endif 7892 // return Gamma(get_double(x._FLOAT_val),contextptr); 7893 if (x.type==_INT_){ 7894 if (x.val<=0) 7895 return unsigned_inf; 7896 return factorial(x.val-1); 7897 } 7898 if (x.type==_FRAC && x._FRACptr->num.type==_INT_){ 7899 if (x._FRACptr->den==2){ 7900 int n=x._FRACptr->num.val; 7901 // compute Gamma(n/2) 7902 gen factnum=1,factden=1; 7903 for (;n>1;n-=2){ 7904 factnum=(n-2)*factnum; 7905 factden=2*factden; 7906 } 7907 for (;n<1;n+=2){ 7908 factnum=2*factnum; 7909 factden=n*factden; 7910 } 7911 return factnum/factden*sqrt(cst_pi,contextptr); 7912 } 7913 // normalize Gamma(n/d) to fractional part ? 7914 gen xd=evalf_double(x,1,contextptr),X=x; 7915 if (xd.type==_DOUBLE_){ 7916 double d=std::floor(xd._DOUBLE_val); 7917 if (d<GAMMA_LIMIT){ 7918 xd=1; 7919 for (int i=int(d);i>0;--i){ 7920 X-=1; 7921 xd=xd*X; 7922 } 7923 return xd*symbolic(at_Gamma,X); 7924 } 7925 } 7926 // then complement formula if in ]0..1/2[ Gamma(z)=pi/sin(pi*z)/Gamma(1-z) ? 7927 } 7928 #if 0 // def HAVE_LIBGSL 7929 if (x.type==_DOUBLE_) 7930 return gsl_sf_gamma(x._DOUBLE_val); 7931 #endif 7932 #if defined HAVE_LIBMPFI && !defined NO_RTTI 7933 if (x.type==_REAL){ 7934 if (real_interval * ptr=dynamic_cast<real_interval *>(x._REALptr)){ 7935 mpfr_t l,u; mpfi_t res; 7936 int nbits=mpfi_get_prec(ptr->infsup); 7937 mpfr_init2(l,nbits); mpfr_init2(u,nbits); mpfi_init2(res,nbits); 7938 mpfi_get_left(l,ptr->infsup); 7939 mpfi_get_right(u,ptr->infsup); 7940 if (mpfr_cmp_d(l,1.46163214497)>0){ 7941 mpfr_gamma(l,l,GMP_RNDD); 7942 mpfr_gamma(u,u,GMP_RNDU); 7943 mpfi_interv_fr(res,l,u); 7944 gen tmp=real_interval(res); 7945 mpfi_clear(res); mpfr_clear(l); mpfr_clear(u); 7946 return tmp; 7947 } 7948 // l<=min of Gamma on R^+ 7949 if (mpfr_cmp_d(l,0)>=0){ 7950 if (mpfr_cmp_d(u,1.46163214496)<0){ 7951 mpfr_gamma(l,l,GMP_RNDU); 7952 mpfr_gamma(u,u,GMP_RNDD); 7953 mpfi_interv_fr(res,u,l); 7954 gen tmp=real_interval(res); 7955 mpfi_clear(res); mpfr_clear(l); mpfr_clear(u); 7956 return tmp; 7957 } 7958 mpfr_gamma(l,l,GMP_RNDU); 7959 mpfr_gamma(u,u,GMP_RNDU); 7960 if (mpfr_cmp(l,u)>0) 7961 mpfr_set(u,l,GMP_RNDU); 7962 mpfr_set_d(l,0.88560319441088,GMP_RNDD); 7963 mpfi_interv_fr(res,u,l); 7964 gen tmp=real_interval(res); 7965 mpfi_clear(res); mpfr_clear(l); mpfr_clear(u); 7966 return tmp; 7967 } 7968 mpfi_clear(res); mpfr_clear(l); 7969 // l<0 7970 if (mpfr_cmp_d(u,0)>=0){ 7971 mpfr_clear(u); 7972 return gen(makevecteur(minus_inf,plus_inf),_INTERVAL__VECT); 7973 } 7974 mpfr_clear(u); 7975 // if l and u<0 handled by reflection formula 7976 int mode=get_mode_set_radian(contextptr); 7977 gen tmp=cst_pi / (sin(cst_pi*x,contextptr)*Gamma(1-x,contextptr)); 7978 angle_mode(mode,contextptr); 7979 return tmp; 7980 } 7981 } 7982 #endif 7983 #ifdef HAVE_LIBMPFR 7984 if (x.type==_REAL && is_positive(x,contextptr)){ 7985 mpfr_t gam; 7986 int prec=mpfr_get_prec(x._REALptr->inf); 7987 mpfr_init2(gam,prec); 7988 mpfr_gamma(gam,x._REALptr->inf,GMP_RNDN); 7989 real_object res(gam); 7990 mpfr_clear(gam); 7991 return res; 7992 } 7993 #endif 7994 #ifdef HAVE_LIBPARI 7995 if (x.type==_CPLX) 7996 return pari_gamma(x); 7997 #endif 7998 if (x.type==_DOUBLE_ || ( x.type==_CPLX && 7999 (x._CPLXptr->type==_DOUBLE_ || (x._CPLXptr+1)->type==_DOUBLE_ || 8000 x._CPLXptr->type==_FLOAT_ || (x._CPLXptr+1)->type==_FLOAT_) 8001 ) 8002 ) { 8003 #if 1 8004 if (is_strictly_positive(.5-re(x,contextptr),contextptr)){ 8005 //grad 8006 int mode=get_mode_set_radian(contextptr); 8007 gen res=cst_pi / (sin(M_PI*x,contextptr)*Gamma(1-x,contextptr)); 8008 angle_mode(mode,contextptr); 8009 8010 return res; 8011 } 8012 return exp(lngamma(x,contextptr),contextptr); 8013 #else 8014 static const double p[] = { 8015 0.99999999999980993, 676.5203681218851, -1259.1392167224028, 8016 771.32342877765313, -176.61502916214059, 12.507343278686905, 8017 -0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7}; 8018 gen z = x-1; 8019 gen X = p[0]; 8020 int g=7; 8021 for (int i=1;i<g+2;++i) 8022 X += gen(p[i])/(z+i); 8023 gen t = z + g + 0.5; 8024 return sqrt(2*cst_pi,contextptr) * pow(t,z+0.5,contextptr) * exp(-t,contextptr) * X; 8025 #endif 8026 } 8027 #ifdef GIAC_HAS_STO_38 8028 return gammatofactorial(x,contextptr); 8029 #else 8030 // if (x.is_symb_of_sommet(at_plus) && x._SYMBptr->feuille.type==_VECT && !x._SYMBptr->feuille._VECTptr->empty() && is_one(x._SYMBptr->feuille._VECTptr->back())) return gammatofactorial(x,contextptr); 8031 if (is_assumed_integer(x,contextptr)) 8032 return gammatofactorial(x,contextptr); 8033 return symbolic(at_Gamma,x); 8034 #endif 8035 } _Gamma(const gen & args,GIAC_CONTEXT)8036 gen _Gamma(const gen & args,GIAC_CONTEXT) { 8037 if ( args.type==_STRNG && args.subtype==-1) return args; 8038 return Gamma(args,contextptr); 8039 } 8040 static const char _Gamma_s []="Gamma"; 8041 #ifdef GIAC_HAS_STO_38 8042 static define_unary_function_eval_taylor( __Gamma,&_Gamma,(size_t)&D_at_Gammaunary_function_ptr,&taylor_Gamma,_Gamma_s); 8043 #else 8044 static define_unary_function_eval_taylor( __Gamma,&_Gamma,D_at_Gamma,&taylor_Gamma,_Gamma_s); 8045 #endif 8046 define_unary_function_ptr5( at_Gamma ,alias_at_Gamma,&__Gamma,0,true); 8047 upper_incomplete_gammad(double s,double z,bool regularize)8048 double upper_incomplete_gammad(double s,double z,bool regularize){ 8049 // returns -1 if continued fraction expansion is not convergent 8050 // if s is a small integer = poisson_cdf(z,s-1)*Gamma(s) 8051 if (s==int(s) && s>0) 8052 return regularize?poisson_cdf(z,int(s-1)):poisson_cdf(z,int(s-1))*std::exp(lngamma(s)); 8053 #if 0 // not tested 8054 // if z large Gamma(s,z) = z^(s-1)*exp(z)*[1 + (s-1)/z + (s-1)*(s-2)/z^2 +... 8055 if (s>100 && absdouble(z)>1.1*s){ 8056 long_double res=1,pi=1,S=s-1,Z=z; 8057 for (;pi>1e-17;--S){ 8058 pi *= S/Z; 8059 res += pi; 8060 } 8061 return pi*std::exp(z-(s-1)*std::log(z)); 8062 } 8063 #endif 8064 if (z<0){ 8065 double l=lower_incomplete_gamma(s,z,regularize,context0)._DOUBLE_val; 8066 if (regularize) return 1-l; 8067 return std::exp(lngamma(s))-l; 8068 } 8069 // int_z^inf t^(s-1) exp(-t) dt 8070 // Continued fraction expansion: a1/(b1+a2/(b2+...))) 8071 // a1=1, a2=1-s, a3=1, a_{m+2}=a_m+1 8072 // b1=z, b2=1, b_odd=z, b_{even}=1 8073 // P0=0, P1=a1, Q0=1, Q1=b1 8074 // j>=2: Pj=bj*Pj-1+aj*Pj-2, Qj=bj*Qj-1+aj*Qj-2 8075 long_double Pm2=0,Pm1=1,Pm,Qm2=1,Qm1=z,Qm,a2m1=1,a2m=1-s,b2m1=z,b2m=1,pmqm; 8076 long_double deux=9007199254740992.,invdeux=1/deux; 8077 for (long_double m=1;m<200;++m){ 8078 // even term 8079 Pm=b2m*Pm1+a2m*Pm2; 8080 Qm=b2m*Qm1+a2m*Qm2; 8081 Pm2=Pm1; Pm1=Pm; 8082 Qm2=Qm1; Qm1=Qm; 8083 a2m++; 8084 // odd term 8085 Pm=b2m1*Pm1+a2m1*Pm2; 8086 Qm=b2m1*Qm1+a2m1*Qm2; 8087 Pm2=Pm1; Pm1=Pm; 8088 Qm2=Qm1; Qm1=Qm; 8089 a2m1++; 8090 pmqm=Pm/Qm; 8091 if (absdouble(Pm2/Qm2-pmqm)<1e-16){ 8092 long_double coeff=s*std::log(z)-z; 8093 if (regularize) 8094 coeff -= lngamma(s); 8095 return pmqm*std::exp(coeff); 8096 } 8097 // avoid overflow 8098 if (absdouble(Pm)>deux){ 8099 Pm2 *= invdeux; 8100 Qm2 *= invdeux; 8101 Pm1 *= invdeux; 8102 Qm1 *= invdeux; 8103 } 8104 } 8105 // alt a1=1, a2=s-1, a3=2*(s-2), a_{m+1}=m*(s-m) 8106 // b1=1+z-s, b_{m+1}=2+b_{m} 8107 return -1; 8108 } 8109 8110 // lower_incomplete_gamma(a,z)=z^(-a)*gammaetoile(a,z) 8111 // gammaetoile(a,z)=sum(n=0..inf,(-z)^n/(a+n)/n!) gammaetoile(const gen & a,const gen & z,GIAC_CONTEXT)8112 gen gammaetoile(const gen & a,const gen &z,GIAC_CONTEXT){ 8113 gen res=0,resr,resi,znsurfact=1,tmp,tmpr,tmpi; 8114 double eps2=epsilon(contextptr); eps2=eps2*eps2; 8115 if (eps2<=0) 8116 eps2=1e-14; 8117 for (int n=0;;){ 8118 tmp=znsurfact/(a+n); 8119 reim(tmp,tmpr,tmpi,contextptr); 8120 reim(res,resr,resi,contextptr); 8121 if (is_greater(eps2*(resr*resr+resi*resi),tmpr*tmpr+tmpi*tmpi,contextptr)) 8122 break; 8123 res += tmp; 8124 ++n; 8125 znsurfact = znsurfact *(-z)/n; 8126 } 8127 return res; 8128 } 8129 lower_incomplete_gamma(double s,double z,bool regularize,GIAC_CONTEXT)8130 gen lower_incomplete_gamma(double s,double z,bool regularize,GIAC_CONTEXT){ // regularize=true by default 8131 // should be fixed if z is large using upper_incomplete_gamma asymptotics 8132 if (z>0 && -z+s*std::log(z)-lngamma(s+1)<-37) 8133 return regularize?1:std::exp(lngamma(s)); 8134 if (z<0){ 8135 // FIXME: this does not work if z is large with double precision 8136 // example igamma(1/3,-216.) 8137 // multi-precision is required 8138 gen zs=-std::pow(-z,s)*gammaetoile(s,z,contextptr); 8139 return regularize?std::exp(-lngamma(s))*zs:zs; 8140 } 8141 if (z>=s){ 8142 double res=upper_incomplete_gammad(s,z,regularize); 8143 if (res>=0){ 8144 if (regularize) 8145 return 1-res; 8146 else 8147 return Gamma(s,context0)-res; 8148 } 8149 } 8150 // gamma(s,z) = int(t^s*e^(-t),t=0..z) 8151 // Continued fraction expansion: a1/(b1+a2/(b2+...))) 8152 // here a1=1, a2=-s*z, a3=z, then a_{2m}=a_{2m-2}-z and a_{2m+1}=a_{2m-1}+z 8153 // b1=s, b_{n}=s+n-1 8154 // P0=0, P1=a1, Q0=1, Q1=b1 8155 // j>=2: Pj=bj*Pj-1+aj*Pj-2, Qj=bj*Qj-1+aj*Qj-2 8156 // Here bm=1, am=em, etc. 8157 long_double Pm2=0,Pm1=1,Pm,Qm2=1,Qm1=s,Qm,a2m=-(s-1)*z,a2m1=0,bm=s; 8158 long_double deux=9007199254740992.,invdeux=1/deux; 8159 for (long_double m=1;m<100;++m){ 8160 // even term 8161 a2m -= z; 8162 bm++; 8163 Pm=bm*Pm1+a2m*Pm2; 8164 Qm=bm*Qm1+a2m*Qm2; 8165 Pm2=Pm1; Pm1=Pm; 8166 Qm2=Qm1; Qm1=Qm; 8167 // odd term 8168 a2m1 +=z; 8169 bm++; 8170 Pm=bm*Pm1+a2m1*Pm2; 8171 Qm=bm*Qm1+a2m1*Qm2; 8172 // cerr << Pm/Qm << " " << Pm2/Qm2 << '\n'; 8173 if (absdouble(Pm/Qm-Pm2/Qm2)<1e-16){ 8174 double res=Pm/Qm; 8175 if (regularize) 8176 res *= std::exp(-z+s*std::log(z)-lngamma(s)); 8177 else 8178 res *= std::exp(-z+s*std::log(z)); 8179 return res; 8180 } 8181 Pm2=Pm1; Pm1=Pm; 8182 Qm2=Qm1; Qm1=Qm; 8183 // normalize 8184 #if 1 8185 if (absdouble(Pm)>deux){ 8186 Pm2 *= invdeux; Qm2 *= invdeux; Pm1 *= invdeux; Qm1 *= invdeux; 8187 } 8188 #else 8189 Pm=1/std::sqrt(Pm1*Pm1+Qm1*Qm1); 8190 Pm2 *= Pm; Qm2 *= Pm; Pm1 *= Pm; Qm1 *= Pm; 8191 #endif 8192 } 8193 return undef; //error 8194 } 8195 _lower_incomplete_gamma(const gen & args,GIAC_CONTEXT)8196 gen _lower_incomplete_gamma(const gen & args,GIAC_CONTEXT){ 8197 if ( args.type==_STRNG && args.subtype==-1) return args; 8198 if (args.type!=_VECT) 8199 return gensizeerr(contextptr); 8200 vecteur v=*args._VECTptr; 8201 int s=int(v.size()); 8202 if (s>=2 && (v[0].type==_DOUBLE_ || v[1].type==_DOUBLE_)){ 8203 v[0]=evalf_double(v[0],1,contextptr); 8204 v[1]=evalf_double(v[1],1,contextptr); 8205 } 8206 if ( (s==2 || s==3) && v[0].type==_DOUBLE_ && v[1].type==_DOUBLE_ ) 8207 return lower_incomplete_gamma(v[0]._DOUBLE_val,v[1]._DOUBLE_val,s==3?!is_zero(v[2]):false,contextptr); 8208 if (s<2 || s>3) 8209 return gendimerr(contextptr); 8210 if (s==2 && is_zero(v[1],contextptr)) 8211 return 0; 8212 if (s==2 && v[1]==plus_inf) 8213 return Gamma(v[0],contextptr); 8214 if (s==2 && v[0].type==_INT_){ 8215 if (v[0].val<=0) 8216 return undef; 8217 int a=v[0].val-1; 8218 // int(e^(-t)*t^a,t)=-e^(-t)*sum_{b=0}^a(t^b*(a!/(a-b)!)) 8219 gen res=0,t(v[1]),fa(1); 8220 for (int b=a;;--b){ 8221 res += pow(t,b,contextptr)*fa; 8222 if (b==0) 8223 break; 8224 fa=b*fa; 8225 } 8226 res=-exp(-t,contextptr)*res+fa; 8227 return res; 8228 } 8229 if (abs_calc_mode(contextptr)!=38) // check may be removed if ugamma declared 8230 return symbolic(at_lower_incomplete_gamma,args); 8231 if (s==3){ 8232 if (is_zero(v[2])) 8233 return Gamma(v[0],contextptr)-symbolic(at_Gamma,makesequence(v[0],v[1])); 8234 return 1-symbolic(at_Gamma,makesequence(v[0],v[1],1)); 8235 } 8236 return Gamma(v[0],contextptr)-symbolic(at_Gamma,args); 8237 } 8238 static const char _lower_incomplete_gamma_s []="igamma"; // "lower_incomplete_gamma" 8239 static define_unary_function_eval (__lower_incomplete_gamma,&_lower_incomplete_gamma,_lower_incomplete_gamma_s); 8240 define_unary_function_ptr5( at_lower_incomplete_gamma ,alias_at_lower_incomplete_gamma,&__lower_incomplete_gamma,0,true); 8241 _igamma_exp(const gen & args,GIAC_CONTEXT)8242 gen _igamma_exp(const gen & args,GIAC_CONTEXT){ 8243 return symbolic(at_igamma_exp,args); 8244 } 8245 static const char _igamma_exp_s []="igamma_exp"; 8246 static define_unary_function_eval (__igamma_exp,&_igamma_exp,_igamma_exp_s); 8247 define_unary_function_ptr5( at_igamma_exp ,alias_at_igamma_exp,&__igamma_exp,0,true); 8248 igamma_replace(const gen & g,GIAC_CONTEXT)8249 static gen igamma_replace(const gen & g,GIAC_CONTEXT){ 8250 return Gamma(g[0],contextptr)-_igamma_exp(g,contextptr)*exp(-g[1],contextptr); 8251 } 8252 8253 // diGamma function taylor_Psi_minus_ln(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)8254 static gen taylor_Psi_minus_ln(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 8255 if (ordre<0) 8256 return 0; 8257 if (lim_point!=plus_inf) 8258 return gensizeerr(contextptr); 8259 shift_coeff=1; 8260 vecteur v(1,minus_one_half); 8261 // Psi(z)=ln(z)-1/(2*z)-sum(B_2n /(2*n*z^(2n)),n>=1) 8262 for (int n=2;n<=ordre;n+=2){ 8263 v.push_back(-bernoulli(n)/n); 8264 v.push_back(0); 8265 } 8266 v.push_back(undef); 8267 return v; 8268 } d_Psi_minus_ln(const gen & args,GIAC_CONTEXT)8269 static gen d_Psi_minus_ln(const gen & args,GIAC_CONTEXT){ 8270 return inv(args,contextptr)-Psi(args,1,contextptr); 8271 } 8272 define_partial_derivative_onearg_genop( D_at_Psi_minus_ln," D_at_Psi_minus_ln",&d_Psi_minus_ln); _Psi_minus_ln(const gen & g,GIAC_CONTEXT)8273 static gen _Psi_minus_ln(const gen & g,GIAC_CONTEXT){ 8274 if ( g.type==_STRNG && g.subtype==-1) return g; 8275 if (is_inf(g)) 8276 return 0; 8277 return symbolic(at_Psi_minus_ln,g); 8278 } 8279 static const char _Psi_minus_ln_s []="Psi_minus_ln"; 8280 #ifdef GIAC_HAS_STO_38 8281 static define_unary_function_eval_taylor( __Psi_minus_ln,&_Psi_minus_ln,(size_t)&D_at_Psi_minus_lnunary_function_ptr,&taylor_Psi_minus_ln,_Psi_minus_ln_s); 8282 #else 8283 static define_unary_function_eval_taylor( __Psi_minus_ln,&_Psi_minus_ln,D_at_Psi_minus_ln,&taylor_Psi_minus_ln,_Psi_minus_ln_s); 8284 #endif 8285 define_unary_function_ptr5( at_Psi_minus_ln ,alias_at_Psi_minus_ln,&__Psi_minus_ln,0,true); Psi_replace(const gen & g,GIAC_CONTEXT)8286 static gen Psi_replace(const gen & g,GIAC_CONTEXT){ 8287 return symbolic(at_ln,g)+_Psi_minus_ln(g,contextptr); 8288 } taylor_Psi(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)8289 static gen taylor_Psi (const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 8290 if (ordre<0){ 8291 return 0; // statically handled now 8292 //limit_tractable_functions().push_back(at_Psi); 8293 //limit_tractable_replace().push_back(Psi_replace); 8294 //return 1; 8295 } 8296 shift_coeff=0; 8297 if (!is_integer(lim_point) || is_strictly_positive(lim_point,contextptr)) 8298 return taylor(lim_point,ordre,f,0,shift_coeff,contextptr); 8299 // FIXME Laurent series for Psi 8300 if (lim_point.type!=_INT_) 8301 return gensizeerr(contextptr); 8302 vecteur v; 8303 identificateur x(" "); 8304 int n=-lim_point.val; 8305 gen decal; 8306 for (int i=0;i<n;++i){ 8307 decal -= inv(x+i,contextptr); 8308 } 8309 taylor(decal,x,lim_point,ordre,v,contextptr); 8310 gen Psi1=taylor(1,ordre,f,0,shift_coeff,contextptr); 8311 shift_coeff=-1; 8312 if (Psi1.type!=_VECT) 8313 return gensizeerr(contextptr); 8314 v=v+*Psi1._VECTptr; 8315 v.insert(v.begin(),-1); 8316 return v; 8317 } d_Psi(const gen & args,GIAC_CONTEXT)8318 static gen d_Psi(const gen & args,GIAC_CONTEXT){ 8319 vecteur v(gen2vecteur(args)); 8320 if (v.size()==1) 8321 v.push_back(0); 8322 if (v.size()!=2 || v.back().type!=_INT_) 8323 return gendimerr(contextptr); 8324 return Psi(v.front(),v.back().val+1,contextptr); 8325 } 8326 define_partial_derivative_onearg_genop( D_at_Psi," D_at_Psi",&d_Psi); 8327 Psi(const gen & x,GIAC_CONTEXT)8328 gen Psi(const gen & x,GIAC_CONTEXT){ 8329 if (x.type==_FLOAT_) 8330 return Psi(get_double(x._FLOAT_val),contextptr); 8331 if (is_positive(-x,contextptr)){ 8332 if (is_integer(x)) 8333 return unsigned_inf; 8334 if (!is_positive(x,contextptr)) // check added for HP for Σ(1/x,x,a,b) 8335 return Psi(ratnormal(1-x,contextptr),contextptr)-cst_pi/tan(cst_pi*x,contextptr); 8336 } 8337 if (x==plus_inf) 8338 return x; 8339 if (is_undef(x)) 8340 return x; 8341 if (is_inf(x)) 8342 return undef; 8343 if ( (x.type==_INT_) && (x.val<10000) && (x.val>=1)){ 8344 identificateur tt(" t"); 8345 return -cst_euler_gamma+sum_loop(inv(tt,contextptr),tt,1,x.val-1,contextptr); 8346 } 8347 if (x.type==_FRAC){ 8348 // Psi(m/k) for 0<m<k 8349 // Psi(m/k) = -euler_gamma -ln(2k) - pi/2/tan(m*pi/k) + 8350 // + 2 sum( cos(2 *pi*n*m/k)*ln(sin(n*pi/k)), n=1..floor (k-1)/2 ) 8351 gen num=x._FRACptr->num,den=x._FRACptr->den; 8352 if (num.type==_INT_ && den.type==_INT_ && den.val<13){ 8353 int m=num.val,k=den.val; 8354 gen res; 8355 int mk=m/k; 8356 for (int i=mk;i>0;--i){ 8357 m -= k; 8358 res += inv(m,contextptr); 8359 } 8360 res = k*res - cst_euler_gamma - ln(2*k,contextptr) - cst_pi/2/tan(m*cst_pi/k,contextptr); 8361 gen res1 ; 8362 for (int n=1;n<=(k-1)/2;n++){ 8363 res1 += cos(2*n*m*cst_pi/k,contextptr)*ln(sin(n*cst_pi/k,contextptr),contextptr); 8364 } 8365 return res + 2*res1; 8366 } 8367 } 8368 #if 0 // def HAVE_LIBGSL 8369 if (x.type==_DOUBLE_) 8370 return gsl_sf_psi(x._DOUBLE_val); 8371 #endif 8372 //#ifdef TARGET_OS_IPHONE 8373 // if (x.type == _DOUBLE_) 8374 // return psi(x._DOUBLE_val); 8375 //#endif 8376 if (x.type==_DOUBLE_){ 8377 double z=x._DOUBLE_val; 8378 // z<=0 , psi(z)=pi*cotan(pi*z)-psi(1-z) 8379 // z>0, psi(z)=psi(z+1)-1/z 8380 // until x>10, 8381 double res0=0,res1=0,res2=0; 8382 bool sub=false; 8383 if (z<0){ 8384 res0=M_PI/std::tan(M_PI*z); 8385 z=1-z; 8386 sub=true; 8387 } 8388 for (;z<10;z++){ 8389 res1 -= 1/z; 8390 } 8391 // ln(x)-1/2/x-1/12*1/x^2+1/120*1/x^4-1/252*1/x^6+1/240*1/x^8-1/132*1/x^10+691/32760*1/x^12-1/12*1/x^14 8392 res1 += std::log(z); 8393 z=1/z; 8394 res1 -= z/2; 8395 z=z*z; 8396 res2 = -z/12; 8397 res2 *= z; 8398 res2 += 691./32760.; 8399 res2 *= z; 8400 res2 -= 1./132.; 8401 res2 *= z; 8402 res2 += 1./240.; 8403 res2 *= z; 8404 res2 -= 1./252.; 8405 res2 *= z; 8406 res2 += 1./120.; 8407 res2 *= z; 8408 res2 -= 1./12.; 8409 res2 *= z; 8410 res1 += res2; 8411 if (sub) 8412 return res1-res0; 8413 else 8414 return res1; 8415 } 8416 if (x.type==_CPLX){ 8417 gen c=evalf_double(x,1,contextptr); 8418 complex<double> z(c._CPLXptr->_DOUBLE_val,(c._CPLXptr+1)->_DOUBLE_val); 8419 // z<=0 , psi(z)=pi*cotan(pi*z)-psi(1-z) 8420 // z>0, psi(z)=psi(z+1)-1/z 8421 // until x>10, 8422 complex<double> res0=0,res1=0,res2=0; 8423 bool sub=false; 8424 if (c._CPLXptr->_DOUBLE_val<0){ 8425 #ifdef GIAC_HAS_STO_38 8426 res0=(double) M_PI/std::tan((double) M_PI*z); 8427 #else 8428 res0=M_PI/std::tan(M_PI*z); 8429 #endif 8430 z=1.0-z; 8431 sub=true; 8432 } 8433 for (;z.real()<10;z+=1){ 8434 res1 -= 1.0/z; 8435 } 8436 // ln(x)-1/2/x-1/12*1/x^2+1/120*1/x^4-1/252*1/x^6+1/240*1/x^8-1/132*1/x^10+691/32760*1/x^12-1/12*1/x^14 8437 res1 += std::log(z); 8438 z=1.0/z; 8439 res1 -= z/2.0; 8440 z=z*z; 8441 res2 = -z/12.0; 8442 res2 *= z; 8443 res2 += 691./32760.; 8444 res2 *= z; 8445 res2 -= 1./132.; 8446 res2 *= z; 8447 res2 += 1./240.; 8448 res2 *= z; 8449 res2 -= 1./252.; 8450 res2 *= z; 8451 res2 += 1./120.; 8452 res2 *= z; 8453 res2 -= 1./12.; 8454 res2 *= z; 8455 res1 += res2; 8456 if (sub) 8457 return res1-res0; 8458 else 8459 return res1; 8460 } 8461 #ifdef HAVE_LIBPARI 8462 // if (x.type==_CPLX || x.type==_REAL) 8463 if (x.type==_REAL) 8464 return pari_psi(x); 8465 #endif 8466 return symbolic(at_Psi,x); 8467 } 8468 cot_psi_cache(int n,GIAC_CONTEXT)8469 gen cot_psi_cache(int n,GIAC_CONTEXT){ 8470 static vecteur * ptr=0; 8471 if (!ptr) ptr=new vecteur; 8472 vecteur & cot_cache=*ptr; 8473 if (cot_cache.size()>n) 8474 return cot_cache[n]; 8475 if (cot_cache.empty()) 8476 cot_cache.push_back(_cot(cst_pi*vx_var,contextptr)); 8477 while (cot_cache.size()<=n) 8478 cot_cache.push_back(ratnormal(derive(cot_cache.back(),vx_var,contextptr),contextptr)); 8479 return cot_cache[n]; 8480 } 8481 const double bernoulli_tab[]={1.000000000000000,-0.50000000000000000,0.1666666666666667,0.0000000000000000,-0.3333333333333333e-1,0.0000000000000000,0.2380952380952381e-1,0.0000000000000000,-0.3333333333333333e-1,0.0000000000000000,0.7575757575757576e-1,0.0000000000000000,-0.2531135531135531,0.0000000000000000,1.166666666666667,0.0000000000000000,-7.092156862745098,0.0000000000000000,0.5497117794486216e2,0.0000000000000000,-0.5291242424242424e3,0.0000000000000000,0.6192123188405797e4,0.0000000000000000,-0.8658025311355311e5,0.0000000000000000,0.1425517166666667e7,0.0000000000000000,-0.2729823106781609e8,0.0000000000000000,0.6015808739006424e9}; evalf_Psi(const gen & x,int n,GIAC_CONTEXT)8482 gen evalf_Psi(const gen & x,int n,GIAC_CONTEXT){ 8483 if (n==0) 8484 return Psi(x,contextptr); 8485 // |z|<1, Psi(1+z,n)=(-1)^(n+1)*n!*(Zeta(n+1)-(n+1)*Zeta(n+2)*z+(n+1)*(n+2)/2!*Zeta(n+3)*z^2-...) 8486 // or (-1)^(n+1)*n!*sum((z+k)^(-n-1),k,0,inf) 8487 // |z|->inf outside R^-: (-1)^(n+1)*((n-1)!/z^n+n!/2/z^(n+1)+sum(bernoulli(2*k)*(2*k+n-1)!/(2*k)!/z^(2k+n),k,1,inf)) 8488 // recurrence Psi(z,n)=Psi(z+1,n)-(-1)^n*n!*z^(-n-1) 8489 // reflection Psi(1-z,n)+(-1)^(n+1)Psi(z,n)=(-1)^n*pi*cotan(pi*z)^{[n]} 8490 if (x.type==_DOUBLE_){ 8491 double d=x._DOUBLE_val; 8492 if (d<=0){ 8493 if (d==int(d)) 8494 return unsigned_inf; 8495 gen res=evalf_Psi(1-d,n,contextptr); 8496 gen tmp=cot_psi_cache(n,contextptr); 8497 tmp=subst(tmp,vx_var,d,false,contextptr); 8498 if (n%2) 8499 res=-M_PI*tmp-res; 8500 else 8501 res=res-M_PI*tmp; 8502 return res; 8503 } 8504 // d>0 8505 double res=0; 8506 for (;d<10+n;++d){ 8507 res += std::pow(d,-n-1); 8508 } 8509 res = n*res; 8510 double zn=std::pow(d,-n); // (n-1)!/z^n 8511 double tmp=zn; 8512 zn=n*zn/(2*d); 8513 tmp=zn+tmp; 8514 zn=(n+1)*zn/d; 8515 for (int k=1;k<15;++k){ 8516 tmp=tmp+bernoulli_tab[2*k]*zn; 8517 zn=(2*k+n)*(2*k+n+1)/(d*d*(2*k+1)*(2*k+2))*zn; 8518 } 8519 double factn=evalf_double(factorial(n-1),1,contextptr)._DOUBLE_val; 8520 res=factn*(res+tmp); 8521 if (n%2) return res; else return -res; 8522 } 8523 if (x.type==_CPLX){ 8524 gen c=evalf_double(x,1,contextptr); 8525 double d=c._CPLXptr->_DOUBLE_val,i=(c._CPLXptr+1)->_DOUBLE_val; 8526 if (d<=0){ 8527 gen res=evalf_Psi(1-x,n,contextptr); 8528 gen tmp=cot_psi_cache(n,contextptr); 8529 tmp=subst(tmp,vx_var,c,false,contextptr); 8530 if (n%2) 8531 res=-M_PI*tmp-res; 8532 else 8533 res=res-M_PI*tmp; 8534 return res; 8535 } 8536 // Re(x)>0 8537 complex<double> z(d,i),res=0; 8538 for (;d<10+n;++d,z+=1){ 8539 #ifdef FXCG 8540 res += std::pow(z,-n-1.0); 8541 #else 8542 res += std::pow(z,-n-1); 8543 #endif 8544 } 8545 res = double(n)*res; 8546 #ifdef FXCG 8547 complex<double> zn=std::pow(z,double(-n)); // (n-1)!/z^n 8548 #else 8549 complex<double> zn=std::pow(z,-n); // (n-1)!/z^n 8550 #endif 8551 complex<double> tmp=zn; 8552 zn=double(n)*zn/(2.0*z); 8553 tmp=zn+tmp; 8554 zn=(n+1.0)*zn/z; 8555 for (int k=1;k<15;++k){ 8556 tmp=tmp+bernoulli_tab[2*k]*zn; 8557 zn=(2.0*k+n)*(2.0*k+n+1.0)/(z*z*(2.0*k+1.0)*(2.0*k+2.0))*zn; 8558 } 8559 double factn=evalf_double(factorial(n-1),1,contextptr)._DOUBLE_val; 8560 res=factn*(res+tmp); 8561 if (n%2) return res; else return -res; 8562 } 8563 return undef; 8564 } 8565 // n-th derivative of digamma function Psi(const gen & x,int n,GIAC_CONTEXT)8566 gen Psi(const gen & x,int n,GIAC_CONTEXT){ 8567 if (n<-1) 8568 return gensizeerr(contextptr); 8569 if (n==-1) 8570 return Gamma(x,contextptr); 8571 if (n==0) 8572 return Psi(x,contextptr); 8573 if (is_integer(x) && is_positive(-x,contextptr)) 8574 return unsigned_inf; 8575 if (is_one(x)){ 8576 if (n%2) 8577 return Zeta(n+1,contextptr)*factorial(n); 8578 else 8579 return -Zeta(n+1,contextptr)*factorial(n); 8580 } 8581 if (x==plus_one_half && n>=1){ 8582 gen res=factorial(n); 8583 if (n%2==0) 8584 res=-res; 8585 res=res*(pow(2,n+1,contextptr)-1); 8586 return res*Zeta(n+1,contextptr); 8587 } 8588 if (x==plus_inf) 8589 return zero; 8590 if (is_undef(x)) 8591 return x; 8592 if (is_inf(x)) 8593 return undef; 8594 if (!n) 8595 return Psi(x,contextptr); 8596 if ( (x.type==_INT_) && (x.val<10000) ){ 8597 identificateur tt(" t"); 8598 if (n%2) 8599 return factorial(n)*(Zeta(n+1,contextptr)-sum_loop(pow(tt,-n-1),tt,1,x.val-1,contextptr)); 8600 else 8601 return -factorial(n)*(Zeta(n+1,contextptr)-sum_loop(pow(tt,-n-1),tt,1,x.val-1,contextptr)); 8602 } 8603 if (x.type==_DOUBLE_ || x.type==_CPLX){ 8604 gen d=evalf_Psi(x,n,contextptr); 8605 return d; 8606 #if 0 //def HAVE_LIBGSL // for check only 8607 double val=gsl_sf_psi_n(n,x._DOUBLE_val); 8608 CERR << d << " " << val << '\n'; 8609 return d; 8610 #endif 8611 } 8612 return symbolic(at_Psi,gen(makevecteur(x,n),_SEQ__VECT)); 8613 } _Psi(const gen & args,GIAC_CONTEXT)8614 gen _Psi(const gen & args,GIAC_CONTEXT) { 8615 if ( args.type==_STRNG && args.subtype==-1) return args; 8616 if (args.type!=_VECT) 8617 return Psi(args,contextptr); 8618 if ( args._VECTptr->size()!=2 ) 8619 return symbolic(at_Psi,args); 8620 gen x(args._VECTptr->front()),n(args._VECTptr->back()); 8621 if (n.type==_REAL) 8622 n=n.evalf_double(1,contextptr); 8623 if (is_integral(n)) 8624 return Psi(x,n.val,contextptr); 8625 if (is_integral(x)){ 8626 *logptr(contextptr) << "Warning, please use Psi(x,n), not Psi(n,x)" << '\n'; 8627 return Psi(n,x.val,contextptr); 8628 } 8629 return gensizeerr(contextptr); 8630 } 8631 static const char _Psi_s []="Psi"; 8632 #ifdef GIAC_HAS_STO_38 8633 define_unary_function_eval_taylor (__Psi,&_Psi,(size_t)&D_at_Psiunary_function_ptr,&taylor_Psi,_Psi_s); 8634 #else 8635 define_unary_function_eval_taylor (__Psi,&_Psi,D_at_Psi,&taylor_Psi,_Psi_s); 8636 #endif 8637 define_unary_function_ptr5( at_Psi ,alias_at_Psi,&__Psi,0,true); 8638 printsommetasnormalmod(const gen & feuille,const char * sommetstr_orig,GIAC_CONTEXT)8639 string printsommetasnormalmod(const gen & feuille,const char * sommetstr_orig,GIAC_CONTEXT){ 8640 if (python_compat(contextptr)) 8641 return printsommetasoperator(feuille,"mod",contextptr); 8642 return printsommetasoperator(feuille,sommetstr_orig,contextptr); 8643 } _normalmod(const gen & g,GIAC_CONTEXT)8644 gen _normalmod(const gen & g,GIAC_CONTEXT){ 8645 if ( g.type==_STRNG && g.subtype==-1) return g; 8646 if (g.type!=_VECT || g._VECTptr->size()!=2) 8647 return gensizeerr(contextptr); 8648 gen f =g._VECTptr->front(); 8649 if (is_equal(f)) 8650 return symb_equal(_normalmod(makevecteur(f._SYMBptr->feuille[0],g._VECTptr->back()),contextptr), 8651 _normalmod(makevecteur(f._SYMBptr->feuille[1],g._VECTptr->back()),contextptr)); 8652 if (f.type==_VECT){ 8653 vecteur v=*f._VECTptr; 8654 for (unsigned i=0;i<v.size();++i) 8655 v[i]=_normalmod(makevecteur(v[i],g._VECTptr->back()),contextptr); 8656 return gen(v,f.subtype); 8657 } 8658 gen b=g._VECTptr->back(); 8659 static bool warnmod=true; 8660 if (f.type==_MOD){ 8661 if (warnmod){ 8662 *logptr(contextptr) << "// Warning: a % b returns the class of a in Z/bZ. Use irem(a,b) for remainder" << '\n'; 8663 warnmod=false; 8664 } 8665 f=*f._MODptr; 8666 if (b.type==_MOD) 8667 b=*b._MODptr; 8668 if (b==0) return f; 8669 return _irem(makesequence(f,b),contextptr); 8670 } 8671 if (b.type==_MOD){ 8672 if (warnmod){ 8673 *logptr(contextptr) << "// Warning: a % b returns the class of a in Z/bZ. Use irem(a,b) for remainder" << '\n'; 8674 warnmod=false; 8675 } 8676 b=*b._MODptr; 8677 if (b==0) return f; 8678 return _irem(makesequence(f,b),contextptr); 8679 } 8680 gen res=normal(makemodquoted(f,b),contextptr); 8681 if (f.type==_VECT && res.type==_VECT) 8682 res.subtype=f.subtype; 8683 return res; 8684 } 8685 #ifdef GIAC_HAS_STO_38 8686 static const char _normalmod_s []="%%"; 8687 #else 8688 static const char _normalmod_s []="%"; 8689 #endif 8690 static define_unary_function_eval4_index (166,__normalmod,&_normalmod,_normalmod_s,&printsommetasnormalmod,&texprintsommetasoperator); 8691 define_unary_function_ptr( at_normalmod ,alias_at_normalmod ,&__normalmod); 8692 8693 // a=expression, x variable, n=number of terms, 8694 // compute an approx value of sum((-1)^k*a(k),k,0,+infinity) 8695 // using Chebychev polynomials alternate_series(const gen & a,const gen & x,int n,GIAC_CONTEXT)8696 gen alternate_series(const gen & a,const gen & x,int n,GIAC_CONTEXT){ 8697 gen d=normal((pow(3+2*sqrt(2,contextptr),n)+pow(3-2*sqrt(2,contextptr),n))/2,contextptr); 8698 gen p=1; 8699 gen c=d-p; 8700 gen S=subst(a,x,0,false,contextptr)*c; 8701 for (int k=1;k<n;k++) { 8702 p=p*gen(k+n-1)*gen(k-n-1)/gen(k-inv(2,contextptr))/gen(k); 8703 c=-p-c; 8704 S=S+subst(a,x,k,false,contextptr)*c; 8705 } 8706 return S/d; 8707 } 8708 Eta(const gen & s,int ndiff,GIAC_CONTEXT)8709 gen Eta(const gen & s,int ndiff,GIAC_CONTEXT){ 8710 if (s.type==_INT_ && !ndiff){ 8711 if (s==1) 8712 return symbolic(at_ln,2); 8713 if (s%2==0) 8714 return (1-pow(2,1-s,contextptr))*Zeta(s,contextptr); 8715 } 8716 if (s.type==_DOUBLE_ || s.type==_REAL || (s.type==_CPLX)){ 8717 gen rx=re(s,contextptr).evalf_double(1,contextptr); 8718 if (rx._DOUBLE_val<0.5){ 8719 if (ndiff){ 8720 identificateur id(" "); 8721 gen t(id),zeta; 8722 zeta=derive((1-pow(2,1-t,contextptr))*pow(2*cst_pi,t,contextptr)/cst_pi*sin(cst_pi*t/2,contextptr)*symbolic(at_Gamma,1-t)*symbolic(at_Zeta,1-t),t,ndiff,contextptr); 8723 zeta=subst(zeta,t,s,false,contextptr); 8724 return zeta; 8725 } 8726 gen zeta1=Eta(1-s,0,contextptr)/(1-pow(2,s,contextptr)); 8727 gen zetas=pow(2,s,contextptr)*pow(cst_pi,s-1,contextptr)*sin(cst_pi*s/2,contextptr)*Gamma(1-s,contextptr)*zeta1; 8728 return (1-pow(2,1-s,contextptr))*zetas; 8729 } 8730 // find n such that 3*(1+2*|y|)*exp(|y|*pi/2)*10^ndigits < (3+sqrt(8))^n 8731 gen ix=im(s,contextptr).evalf_double(1,contextptr); 8732 if (ix.type!=_DOUBLE_) 8733 return gentypeerr(contextptr); 8734 double y=absdouble(ix._DOUBLE_val); 8735 int ndigits=16; // FIXME? use decimal_digits; 8736 double n=(std::log10(3*(1+2*y)*std::exp(y*M_PI/2))+ndigits)/std::log10(3.+std::sqrt(8.)); 8737 identificateur idx(" "); 8738 gen x(idx); 8739 gen res=alternate_series(inv(pow(idx+1,s,contextptr),contextptr)*pow(-ln(idx+1,contextptr),ndiff,contextptr),idx,int(std::ceil(n)),contextptr); 8740 return res.evalf(1,contextptr); 8741 } 8742 else { 8743 if (ndiff) 8744 return symbolic(at_Eta,gen(makevecteur(s,ndiff),_SEQ__VECT)); 8745 else 8746 return symbolic(at_Eta,s); 8747 } 8748 } 8749 Eta(const gen & s0,GIAC_CONTEXT)8750 gen Eta(const gen & s0,GIAC_CONTEXT){ 8751 gen s=s0; 8752 int ndiff=0; 8753 if (s.type==_VECT){ 8754 if (s._VECTptr->size()!=2) 8755 return gensizeerr(contextptr); 8756 gen n=s._VECTptr->back(); 8757 if (n.type==_REAL) 8758 n=n.evalf_double(1,contextptr); 8759 if (n.type==_DOUBLE_) 8760 n=int(n._DOUBLE_val); 8761 if (n.type!=_INT_) 8762 return gentypeerr(contextptr); 8763 ndiff=n.val; 8764 s=s._VECTptr->front(); 8765 } 8766 return Eta(s,ndiff,contextptr); 8767 } 8768 Zeta(const gen & x,int ndiff,GIAC_CONTEXT)8769 gen Zeta(const gen & x,int ndiff,GIAC_CONTEXT){ 8770 if (!ndiff) 8771 return Zeta(x,contextptr); 8772 if (x.type==_DOUBLE_ || x.type==_REAL || (x.type==_CPLX && x.subtype==_DOUBLE_)){ 8773 gen rex=re(x,contextptr).evalf_double(1,contextptr); 8774 if (rex.type!=_DOUBLE_) 8775 return gensizeerr(contextptr); 8776 identificateur id(" "); 8777 gen t(id),zeta; 8778 if (rex._DOUBLE_val<0.5){ 8779 // Zeta(x)=2^x*pi^(x-1)*sin(pi*x/2)*Gamma(1-x)*zeta(1-x) 8780 zeta=derive(pow(2*cst_pi,t,contextptr)/cst_pi*sin(cst_pi*t/2,contextptr)*symbolic(at_Gamma,1-t)*symbolic(at_Zeta,1-t),t,ndiff,contextptr); 8781 zeta=subst(zeta,t,x,false,contextptr); 8782 } 8783 else { 8784 // Zeta=Eta(x)/(1-2^(1-x)) 8785 zeta=derive(symbolic(at_Eta,t)/(1-pow(2,1-t,contextptr)),t,ndiff,contextptr); 8786 zeta=subst(zeta,t,x,false,contextptr); 8787 } 8788 return zeta; 8789 } 8790 return symbolic(at_Zeta,gen(makevecteur(x,ndiff),_SEQ__VECT)); 8791 } Zeta(const gen & x,GIAC_CONTEXT)8792 gen Zeta(const gen & x,GIAC_CONTEXT){ 8793 if (x.type==_VECT){ 8794 if (x._VECTptr->size()!=2) 8795 return gensizeerr(contextptr); 8796 gen n=x._VECTptr->back(); 8797 if (n.type==_REAL) 8798 n=n.evalf_double(1,contextptr); 8799 if (n.type==_DOUBLE_) 8800 n=int(n._DOUBLE_val); 8801 if (n.type!=_INT_) 8802 return gentypeerr(contextptr); 8803 int ndiff=n.val; 8804 return Zeta(x._VECTptr->front(),ndiff,contextptr); 8805 } 8806 if ( (x.type==_INT_)){ 8807 int n=x.val; 8808 if (!n) 8809 return minus_one_half; 8810 if (n==1) 8811 return plus_inf; 8812 if (n<0){ 8813 if (n%2) 8814 return -rdiv(bernoulli(1-n),(1-n),contextptr) ; 8815 else 8816 return zero; 8817 } 8818 if (n%2) 8819 return symbolic(at_Zeta,x); 8820 else 8821 return pow(cst_pi,n)*ratnormal(abs(bernoulli(x),contextptr)*rdiv(pow(plus_two,n-1),factorial(n),contextptr),contextptr); 8822 } 8823 #ifdef HAVE_LIBGSL 8824 if (x.type==_DOUBLE_) 8825 return gsl_sf_zeta(x._DOUBLE_val); 8826 #endif // HAVE_LIBGSL 8827 #ifdef HAVE_LIBPARI 8828 if (x.type==_CPLX && x.subtype!=3) 8829 return pari_zeta(x); 8830 #endif 8831 #ifdef HAVE_LIBMPFR 8832 if (x.type==_REAL){ 8833 mpfr_t gam; 8834 int prec=mpfr_get_prec(x._REALptr->inf); 8835 mpfr_init2(gam,prec); 8836 mpfr_zeta(gam,x._REALptr->inf,GMP_RNDN); 8837 real_object res(gam); 8838 mpfr_clear(gam); 8839 return res; 8840 } 8841 #endif 8842 if (x.type==_CPLX || x.type==_DOUBLE_ || x.type==_REAL) 8843 return Eta(x,contextptr)/(1-pow(2,1-x,contextptr)); 8844 return symbolic(at_Zeta,x); 8845 } _Zeta(const gen & args,GIAC_CONTEXT)8846 gen _Zeta(const gen & args,GIAC_CONTEXT) { 8847 if ( args.type==_STRNG && args.subtype==-1) return args; 8848 return Zeta(args,contextptr); 8849 } d_Zeta(const gen & args,GIAC_CONTEXT)8850 static gen d_Zeta(const gen & args,GIAC_CONTEXT){ 8851 vecteur v(gen2vecteur(args)); 8852 if (v.size()==1) 8853 v.push_back(0); 8854 if (v.size()!=2 || v.back().type!=_INT_) 8855 return gendimerr(contextptr); 8856 return Zeta(v.front(),v.back().val+1,contextptr); 8857 } taylor_Zeta(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)8858 static gen taylor_Zeta(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 8859 if (ordre<0) 8860 return 0; // no symbolic preprocessing 8861 if (is_one(lim_point)){ 8862 shift_coeff=-1; 8863 identificateur x(" "); vecteur v,w; 8864 taylor(1-pow(2,1-x,contextptr),x,1,ordre+1,w,contextptr); 8865 w.erase(w.begin()); 8866 reverse(w.begin(),w.end()); 8867 if (!w.empty() && is_undef(w.front())) 8868 w.erase(w.begin()); 8869 gen gw=horner(w,x); 8870 sparse_poly1 sp=series__SPOL1(symbolic(at_Eta,x+1)/gw,x,0,ordre,0,contextptr); 8871 sparse_poly1::const_iterator it=sp.begin(),itend=sp.end(); 8872 for (;it!=itend;++it){ 8873 v.push_back(it->coeff); // assumes all coeffs are non zero... 8874 } 8875 return v; 8876 } 8877 return taylor(lim_point,ordre,f,direction,shift_coeff,contextptr); 8878 } 8879 define_partial_derivative_onearg_genop( D_at_Zeta," D_at_Zeta",&d_Zeta); 8880 static const char _Zeta_s []="Zeta"; 8881 #ifdef GIAC_HAS_STO_38 8882 static define_unary_function_eval_taylor( __Zeta,&_Zeta,(size_t)&D_at_Zetaunary_function_ptr,&taylor_Zeta,_Zeta_s); 8883 #else 8884 static define_unary_function_eval_taylor( __Zeta,&_Zeta,D_at_Zeta,&taylor_Zeta,_Zeta_s); 8885 #endif 8886 define_unary_function_ptr5( at_Zeta ,alias_at_Zeta,&__Zeta,0,true); 8887 d_Eta(const gen & args,GIAC_CONTEXT)8888 static gen d_Eta(const gen & args,GIAC_CONTEXT){ 8889 vecteur v(gen2vecteur(args)); 8890 if (v.size()==1) 8891 v.push_back(0); 8892 if (v.size()!=2 || v.back().type!=_INT_) 8893 return gendimerr(contextptr); 8894 return Eta(v.front(),v.back().val+1,contextptr); 8895 } 8896 define_partial_derivative_onearg_genop( D_at_Eta," D_at_Eta",&d_Eta); _Eta(const gen & args,GIAC_CONTEXT)8897 gen _Eta(const gen & args,GIAC_CONTEXT) { 8898 if ( args.type==_STRNG && args.subtype==-1) return args; 8899 return Eta(args,contextptr); 8900 } 8901 static const char _Eta_s []="Eta"; 8902 #ifdef GIAC_HAS_STO_38 8903 static define_unary_function_eval3 (__Eta,&_Eta,(size_t)&D_at_Etaunary_function_ptr,_Eta_s); 8904 #else 8905 static define_unary_function_eval3 (__Eta,&_Eta,D_at_Eta,_Eta_s); 8906 #endif 8907 define_unary_function_ptr5( at_Eta ,alias_at_Eta,&__Eta,0,true); 8908 8909 // error function taylor_erfs(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)8910 static gen taylor_erfs(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 8911 if (ordre<0) 8912 return 0; 8913 if (!is_inf(lim_point)) 8914 return taylor(lim_point,ordre,f,0,shift_coeff,contextptr);//gensizeerr(contextptr); 8915 shift_coeff=1; 8916 // erfs(x)=1/sqrt(pi) * 1/x* sum( (2*k)! / (-4)^k / k! * x^(-2k) ) 8917 gen tmp(1); 8918 vecteur v; 8919 for (int n=0;n<=ordre;){ 8920 v.push_back(tmp); 8921 v.push_back(0); 8922 n +=2 ; 8923 tmp=gen(n-1)/gen(-2)*tmp; 8924 } 8925 v.push_back(undef); 8926 return multvecteur(inv(sqrt(cst_pi,contextptr),contextptr),v); 8927 } 8928 gen _erfs(const gen & g,GIAC_CONTEXT); d_erfs(const gen & args,GIAC_CONTEXT)8929 static gen d_erfs(const gen & args,GIAC_CONTEXT){ 8930 return 2*args*_erfs(args,contextptr)-gen(2)/sqrt(cst_pi,contextptr); 8931 } 8932 define_partial_derivative_onearg_genop( D_at_erfs," D_at_erfs",&d_erfs); _erfs(const gen & g,GIAC_CONTEXT)8933 gen _erfs(const gen & g,GIAC_CONTEXT){ 8934 if ( g.type==_STRNG && g.subtype==-1) return g; 8935 if (is_inf(g)) 8936 return 0; 8937 return symbolic(at_erfs,g); 8938 } 8939 static const char _erfs_s []="erfs"; 8940 #ifdef GIAC_HAS_STO_38 8941 static define_unary_function_eval_taylor( __erfs,&_erfs,(size_t)&D_at_erfsunary_function_ptr,&taylor_erfs,_erfs_s); 8942 #else 8943 static define_unary_function_eval_taylor( __erfs,&_erfs,D_at_erfs,&taylor_erfs,_erfs_s); 8944 #endif 8945 define_unary_function_ptr5( at_erfs ,alias_at_erfs,&__erfs,0,true); erf_replace(const gen & g,GIAC_CONTEXT)8946 static gen erf_replace(const gen & g,GIAC_CONTEXT){ 8947 if (has_i(g)) 8948 return 1-symbolic(at_exp,-ratnormal(g*g,contextptr))*_erfs(g,contextptr); 8949 return symbolic(at_sign,g)*(1-symbolic(at_exp,-g*g)*_erfs(symbolic(at_abs,g),contextptr)); 8950 } taylor_erf(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)8951 static gen taylor_erf (const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 8952 if (ordre<0){ 8953 return 0; // statically handled now 8954 //limit_tractable_functions().push_back(at_erf); 8955 //limit_tractable_replace().push_back(erf_replace); 8956 //return 1; 8957 } 8958 shift_coeff=0; 8959 return taylor(lim_point,ordre,f,0,shift_coeff,contextptr); 8960 } d_erf(const gen & e,GIAC_CONTEXT)8961 static gen d_erf(const gen & e,GIAC_CONTEXT){ 8962 return 2*exp(-pow(e,2),contextptr)/sqrt(cst_pi,contextptr); 8963 } 8964 define_partial_derivative_onearg_genop( D_at_erf," D_at_erf",d_erf); 8965 erf0(const gen & x,gen & erfc,GIAC_CONTEXT)8966 static gen erf0(const gen & x,gen & erfc,GIAC_CONTEXT){ 8967 if (x.type==_REAL && is_strictly_positive(-x,contextptr)) 8968 return -erf0(-x,erfc,contextptr); 8969 if (x.type==_DOUBLE_){ 8970 double absx=absdouble(x._DOUBLE_val); 8971 if (absx<=3){ 8972 // numerical computation of int(exp(-t^2),t=0..x) 8973 // by series expansion at x=0 8974 // x*sum( (-1)^n*(x^2)^n/n!/(2*n+1),n=0..inf) 8975 long_double z=x._DOUBLE_val,z2=z*z,res=0,pi=1; 8976 for (int n=0;;){ 8977 res += pi/(2*n+1); 8978 ++n; 8979 pi = -pi*z2/n; 8980 if (pi<1e-17 && pi>-1e-17) 8981 break; 8982 } 8983 erfc=double(1-2/std::sqrt(M_PI)*z*res); 8984 return 2/std::sqrt(M_PI)*double(z*res); 8985 } 8986 if (absx>=6.5){ 8987 // asymptotic expansion at infinity of int(exp(-t^2),t=x..inf) 8988 // z=1/x 8989 // z*exp(-x^2)*(1/2 - 1/4 z^2 +3/8 z^4-15/16 z^6 + ...) 8990 long_double z=1/absx,z2=z*z/2,res=0,pi=0.5; 8991 for (int n=0;;++n){ 8992 res += pi; 8993 pi = -pi*(2*n+1)*z2; 8994 if (absdouble(pi)<1e-16) 8995 break; 8996 } 8997 erfc=2/std::sqrt(M_PI)*double(std::exp(-1/z/z)*z*res); 8998 gen e=1-erfc; 8999 if (x._DOUBLE_val>=0) 9000 return e; 9001 erfc=2-erfc; 9002 return -e; 9003 } 9004 else { 9005 // erf(x)=2*x*exp(-x^2)/sqrt(pi)*sum(2^j*x^(2j)/1/3/5/.../(2j+1),j=0..inf) 9006 // or continued fraction 9007 // 2*exp(z^2)*int(exp(-t^2),t=z..inf)=1/(z+1/2/(z+1/(z+3/2/(z+...)))) 9008 long_double z=absx,res=0; 9009 for (long_double n=40;n>=1;n--){ 9010 res=n/2/(z+res); 9011 } 9012 res=1/(z+res); 9013 erfc=std::exp(-absx*absx)*double(res)/std::sqrt(M_PI); 9014 gen e=1-erfc; 9015 if (x._DOUBLE_val>=0) 9016 return e; 9017 erfc=2-erfc; 9018 return -e; 9019 } 9020 #if 0 9021 // a:=convert(series(erfc(x)*exp(x^2),x=X,24),polynom):; b:=subst(a,x=X+h):; 9022 if (absx>3 && absx<=5){ 9023 // Digits:=30; evalf(symb2poly(subst(b,X,4),h)) 9024 long_double Zl=absx-4,res=0; 9025 long_double taberf[]={0.9323573505930262336910814663629e-18,-0.5637770672346891132663122366369e-17,0.3373969923698176600796949171416e-16,-0.1997937342757611758805760309387e-15,0.1170311628709846086671746844320e-14,-0.6779078623355796103927587022047e-14,0.3881943235655598141099274338263e-13,-0.2196789805508621713379735090290e-12,0.1228090799753488475137690971599e-11,-0.6779634525816110746734938098109e-11,0.3694326453071165814527058450923e-10,-0.1986203171147991823844885265211e-9,0.1053084120195192127202221248092e-8,-0.5503368542058483880654875851859e-8,0.2833197888944711586737808090450e-7,-0.1435964425391227330876779173688e-6,0.7160456646037012951391007806358e-6,-0.3510366649840828060143659147374e-5,0.1690564925777814684043808381146e-4,-0.7990888030555549397777128848414e-4,0.3703524689955564311420527395424e-3,-0.1681182076746114476323671722330e-2,0.7465433244975570766528102818814e-2,-0.3238350609502145478059791886069e-1,0.1369994576250613898894451230325}; 9026 unsigned N=sizeof(taberf)/sizeof(long_double); 9027 for (unsigned i=0;i<N;i++){ 9028 res *= Zl; 9029 res += taberf[i]; 9030 } 9031 erfc = double(std::exp(-absx*absx)*res); 9032 return sign(x,contextptr)*(1-erfc); 9033 } 9034 if (absx>5 && absx<=6.5){ 9035 // Digits:=30; evalf(symb2poly(subst(b,X,5.75),h)) 9036 long_double Zl=absx-5.75,res=0; 9037 long_double taberf[]={-0.3899077949952308336341205103240e-12,0.2064555746398182434172952813760e-13,-0.7079917646274828801231710613009e-12,-0.2043006626755557967429543230042e-12,-0.2664588032913413248313045028978e-11,-0.3182230691773937386262907009549e-11,-0.4508687162250923186571888867300e-12,-0.2818971742901571639195611759894e-11,-0.4771270499789446447101554995178e-11,0.2345376254096117543212461524786e-11,-0.6529305258174487397807156793042e-11,0.9817004987916722489154147719630e-12,0.2085292084663647123257426988484e-10,-0.1586500138272075839895787048265e-9,0.1056533982771769784560244626854e-8,-0.6964568016562765632682760517056e-8,0.4530411628438409475101496352516e-7,-0.2918364042864784155554051827879e-6,0.1859299481340192895158490699981e-5,-0.1171241494503672776195474661763e-4,0.7292428889065898343608897828825e-4,-0.4485956983428598110336671805311e-3,0.2725273842847326036320664185043e-2,-0.1634321814380709002113440890281e-1,0.9669877816971385564543076482100e-1}; 9038 unsigned N=sizeof(taberf)/sizeof(long_double); 9039 for (unsigned i=0;i<N;i++){ 9040 res *= Zl; 9041 res += taberf[i]; 9042 } 9043 erfc = double(std::exp(-absx*absx)*res); 9044 return sign(x,contextptr)*(1-erfc); 9045 } 9046 #endif 9047 } // end x.type==_DOUBLE_ 9048 gen z=evalf_double(abs(x,contextptr),1,contextptr); 9049 if (x.type==_CPLX && x._CPLXptr->type!=_REAL){ 9050 double absx=z._DOUBLE_val; 9051 complex_long_double z(evalf_double(re(x,contextptr),1,contextptr)._DOUBLE_val, 9052 evalf_double(im(x,contextptr),1,contextptr)._DOUBLE_val); 9053 if (absx<=3){ 9054 // numerical computation of int(exp(-t^2),t=0..x) 9055 // by series expansion at x=0 9056 // x*sum( (-1)^n*(x^2)^n/n!/(2*n+1),n=0..inf) 9057 complex_long_double z2=z*z,res=0,pi=1; 9058 for (long_double n=0;;){ 9059 res += pi/(2*n+1); 9060 ++n; 9061 pi = -pi*z2/n; 9062 if (complex_long_abs(pi)<1e-17) 9063 break; 9064 } 9065 #if !defined(HAVE_LONG_DOUBLE) || defined(PNACL) 9066 res=(2.0/std::sqrt(M_PI))*z*res; 9067 #else 9068 res=(2.0L/std::sqrt(M_PI))*z*res; 9069 #endif 9070 gen e(double(res.real()),double(res.imag())); 9071 erfc=1.0-e; 9072 return e; 9073 } 9074 bool neg=z.real()<0; 9075 if (neg) 9076 z=-z; 9077 if (absx>=6.5){ 9078 // asymptotic expansion at infinity of int(exp(-t^2),t=x..inf) 9079 // z=1/x 9080 // z*exp(-x^2)*(1/2 - 1/4 z^2 +3/8 z^4-15/16 z^6 + ...) 9081 #if !defined(HAVE_LONG_DOUBLE) || defined(PNACL) 9082 z=1.0/z; 9083 complex_long_double z2=z*z/2.0,res=0,pi=0.5; 9084 #else 9085 z=1.0L/z; 9086 complex_long_double z2=z*z/2.0L,res=0,pi=0.5; 9087 #endif 9088 for (long_double n=0;;++n){ 9089 res += pi; 9090 pi = -pi*(2*n+1)*z2; 9091 if (complex_long_abs(pi)<1e-16) 9092 break; 9093 } 9094 #if !defined(HAVE_LONG_DOUBLE) || defined(PNACL) 9095 res=complex_long_double(2.0/std::sqrt(M_PI))*std::exp(-1.0/z/z)*z*res; 9096 #else 9097 res=complex_long_double(2.0/std::sqrt(M_PI))*std::exp(-1.0L/z/z)*z*res; 9098 #endif 9099 erfc=gen(double(res.real()),double(res.imag())); 9100 gen e=1-erfc; 9101 if (!neg) 9102 return e; 9103 erfc=2-erfc; 9104 return -e; 9105 } 9106 else { 9107 // continued fraction 9108 // 2*exp(z^2)*int(exp(-t^2),t=z..inf)=1/(z+1/2/(z+1/(z+3/2/(z+...)))) 9109 complex_long_double res=0; 9110 for (long_double n=40;n>=1;n--){ 9111 res=(n/2)/(z+res); 9112 } 9113 #if !defined(HAVE_LONG_DOUBLE) || defined(PNACL) 9114 res=1.0/(z+res); 9115 #else 9116 res=1.0L/(z+res); 9117 #endif 9118 res=std::exp(-z*z)*res/complex_long_double(std::sqrt(M_PI)); 9119 erfc=gen(double(res.real()),double(res.imag())); 9120 gen e=1-erfc; 9121 if (!neg) 9122 return e; 9123 erfc=2-erfc; 9124 return -e; 9125 } 9126 } // end low precision 9127 // take account of loss of accuracy 9128 int prec=decimal_digits(contextptr); 9129 int newprec,nbitsz=int(z._DOUBLE_val*z._DOUBLE_val/std::log(2.)),prec2=int(prec*std::log(10.0)/std::log(2.0)+.5); 9130 if (nbitsz>prec2){ 9131 // use asymptotic expansion at z=inf 9132 z = accurate_evalf(inv(x,contextptr),prec2); 9133 gen z2=z*z/2,res=0,pi=inv(accurate_evalf(plus_two,prec2),contextptr),eps=accurate_evalf(pow(10,-prec,contextptr),prec2)/2; 9134 for (int n=0;;++n){ 9135 res += pi; 9136 pi = -(2*n+1)*z2*pi; 9137 if (is_greater(eps,abs(pi,contextptr),contextptr)) 9138 break; 9139 } 9140 erfc=evalf(2*inv(sqrt(cst_pi,contextptr),contextptr),1,contextptr)*exp(-inv(z*z,contextptr),contextptr)*z*res; 9141 return 1-erfc; 9142 } 9143 if (z._DOUBLE_val>1) 9144 newprec = prec2+nbitsz+int(std::log(z._DOUBLE_val))+1; 9145 else 9146 newprec = prec2+2; 9147 // numerical computation of int(exp(-t^2),t=0..x) 9148 // by series expansion at x=0 9149 // x*sum( (-1)^n*(x^2)^n/n!/(2*n+1),n=0..inf) 9150 z=accurate_evalf(x,newprec); 9151 gen z2=z*z,res=0,pi=1,eps=accurate_evalf(pow(10,-prec,contextptr),prec2)/2; 9152 for (int n=0;;){ 9153 res += pi/(2*n+1); 9154 ++n; 9155 pi = -pi*z2/n; 9156 if (is_greater(eps,abs(pi,contextptr),contextptr)) 9157 break; 9158 } 9159 res = evalf(2*inv(sqrt(cst_pi,contextptr),contextptr),1,contextptr)*z*res; 9160 erfc=accurate_evalf(1-res,prec2); 9161 return accurate_evalf(res,prec2); 9162 } erf(const gen & x,GIAC_CONTEXT)9163 gen erf(const gen & x,GIAC_CONTEXT){ 9164 if (is_equal(x)) 9165 return apply_to_equal(x,erf,contextptr); 9166 if (x.type==_FLOAT_) 9167 return erf(get_double(x._FLOAT_val),contextptr); 9168 if (x==plus_inf) 9169 return plus_one; 9170 if (x==minus_inf) 9171 return minus_one; 9172 if (is_undef(x)) 9173 return x; 9174 if (is_inf(x)) 9175 return undef; 9176 if (is_zero(x,contextptr)) 9177 return x; 9178 gen erfc_; 9179 if (x.type==_DOUBLE_ || x.type==_CPLX || x.type==_REAL) 9180 return erf0(x,erfc_,contextptr); 9181 #if 0 // def GIAC_HAS_STO_38 9182 return 1-2*symbolic(at_UTPN,x*plus_sqrt2); 9183 #else 9184 return symbolic(at_erf,x); 9185 #endif 9186 #if 0 9187 gen e=x.evalf(1,contextptr); 9188 #ifdef HAVE_LIBGSL 9189 if (e.type==_DOUBLE_) 9190 return gsl_sf_erf(e._DOUBLE_val); 9191 #endif 9192 #ifdef HAVE_LIBMPFR 9193 if (x.type==_REAL){ 9194 mpfr_t gam; 9195 int prec=mpfr_get_prec(x._REALptr->inf); 9196 mpfr_init2(gam,prec); 9197 mpfr_erf(gam,x._REALptr->inf,GMP_RNDN); 9198 real_object res(gam); 9199 mpfr_clear(gam); 9200 return res; 9201 } 9202 #endif 9203 #if 0 // def GIAC_HAS_STO_38 9204 return 1-2*symbolic(at_UTPN,x*plus_sqrt2); 9205 #else 9206 return symbolic(at_erf,x); 9207 #endif 9208 #endif 9209 } _erf(const gen & args,GIAC_CONTEXT)9210 gen _erf(const gen & args,GIAC_CONTEXT){ 9211 if ( args.type==_STRNG && args.subtype==-1) return args; 9212 return apply(args,erf,contextptr); 9213 } 9214 static const char _erf_s []="erf"; 9215 #ifdef GIAC_HAS_STO_38 9216 define_unary_function_eval_taylor( __erf,&_erf,(size_t)&D_at_erfunary_function_ptr,&taylor_erf,_erf_s); 9217 #else 9218 define_unary_function_eval_taylor( __erf,&_erf,D_at_erf,&taylor_erf,_erf_s); 9219 #endif 9220 define_unary_function_ptr5( at_erf ,alias_at_erf,&__erf,0,true); 9221 d_erfc(const gen & e,GIAC_CONTEXT)9222 static gen d_erfc(const gen & e,GIAC_CONTEXT){ 9223 return -d_erf(e,contextptr); 9224 } 9225 define_partial_derivative_onearg_genop( D_at_erfc," D_at_erfc",d_erfc); erfc(const gen & x,GIAC_CONTEXT)9226 gen erfc(const gen & x,GIAC_CONTEXT){ 9227 #if 0 9228 if (x.type==_DOUBLE_ && x._DOUBLE_val<-6){ 9229 double z=-x._DOUBLE_val; 9230 // 2z^2=x^2 9231 // sqrt(pi)*z*exp(z^2)*erfc(z)=1+sum(m>=1,(-1)^m*1*3*...*(2m-1)/(2*z^2)^m) 9232 double res=1,X=1.0/(2*z*z),general=1; 9233 for (int m=1;m<=10;++m){ 9234 general *= -(2*m-1)*X; 9235 res += general; 9236 } 9237 return 1.0/std::sqrt(M_PI)*std::exp(-z*z)/z*res; 9238 } 9239 #endif 9240 if (x.type==_FLOAT_) 9241 return erfc(get_double(x._FLOAT_val),contextptr); 9242 if (is_equal(x)) 9243 return apply_to_equal(x,erfc,contextptr); 9244 gen erfc_; 9245 if (x.type==_DOUBLE_ || x.type==_CPLX || x.type==_REAL){ 9246 erf0(x,erfc_,contextptr); 9247 return erfc_; 9248 } 9249 #if 0 // def GIAC_HAS_STO_38 9250 return 2*symbolic(at_UTPN,x*plus_sqrt2); 9251 #else 9252 return 1-erf(x,contextptr); // 1-symbolic(at_erf,x); 9253 #endif 9254 gen e=x.evalf(1,contextptr); 9255 #ifdef HAVE_LIBGSL 9256 if (e.type==_DOUBLE_) 9257 return gsl_sf_erfc(e._DOUBLE_val); 9258 #endif 9259 #if 0 // def GIAC_HAS_STO_38 9260 return 2*symbolic(at_UTPN,x*plus_sqrt2); 9261 #else 9262 return 1-symbolic(at_erf,x); 9263 #endif 9264 } _erfc(const gen & args,GIAC_CONTEXT)9265 gen _erfc(const gen & args,GIAC_CONTEXT){ 9266 if ( args.type==_STRNG && args.subtype==-1) return args; 9267 return apply(args,erfc,contextptr); 9268 } 9269 static const char _erfc_s []="erfc"; 9270 #ifdef GIAC_HAS_STO_38 9271 static define_unary_function_eval3 (__erfc,&_erfc,(size_t)&D_at_erfcunary_function_ptr,_erfc_s); 9272 #else 9273 static define_unary_function_eval3 (__erfc,&_erfc,D_at_erfc,_erfc_s); 9274 #endif 9275 define_unary_function_ptr5( at_erfc ,alias_at_erfc,&__erfc,0,true); 9276 9277 // assumes z>=1 9278 static const double exp_minus_1_over_4=std::exp(-0.25); sici_fg(double z,double & fz,double & gz)9279 static void sici_fg(double z,double & fz,double & gz){ 9280 // int([u*]exp(-u)/(u^2+z^2),0,inf) 9281 // #nstep=1000 in [0,1], then * e^(-1/4) 9282 double nstep=250,a=0; 9283 fz=0; gz=0; 9284 for (;nstep>0.25;nstep*=exp_minus_1_over_4){ 9285 double Fz=0,Gz=0; 9286 int N=int(nstep+.5); 9287 if (N<1) 9288 N=1; 9289 // Simpson over [a,a+1] 9290 double t=a,tmp,z2=z*z,Ninv=1./N; 9291 t = a+Ninv/2.; 9292 double expt=std::exp(-t),expfact=std::exp(-Ninv); 9293 for (int i=0;i<N;++i){ // middle points 9294 tmp = expt/(t*t+z2); 9295 Fz += tmp; 9296 Gz += t*tmp; 9297 expt *= expfact; 9298 t += Ninv; 9299 } 9300 Fz *= 2; Gz *= 2; 9301 t = a+Ninv; 9302 expt=std::exp(-t); 9303 for (int i=1;i<N;++i){ 9304 tmp = expt/(t*t+z2); // endpoint 9305 Fz += tmp; 9306 Gz += t*tmp; 9307 expt *= expfact; 9308 t += Ninv; 9309 } 9310 Fz *= 2; Gz *= 2; 9311 tmp=std::exp(-a)/(a*a+z*z); // endpoint 9312 Fz += tmp; 9313 Gz += a*tmp; 9314 a++; 9315 tmp=std::exp(-a)/(a*a+z*z); // endpoint 9316 Fz += tmp; 9317 Gz += a*tmp; 9318 fz += Fz/(6*N); 9319 gz += Gz/(6*N); 9320 } 9321 fz *= z; 9322 } 9323 9324 // mode=1 Si only, mode==2 Ci only sici(const gen & z0,gen & siz,gen & ciz,int prec,int mode,GIAC_CONTEXT)9325 static bool sici(const gen & z0,gen & siz,gen & ciz,int prec,int mode,GIAC_CONTEXT){ 9326 gen z=evalf_double(z0,1,contextptr); 9327 if (z0.type==_DOUBLE_ && prec>13) 9328 prec=13; 9329 #ifdef GIAC_HAS_STO_38 9330 if (z.type!=_DOUBLE_) 9331 return false; 9332 prec=13; 9333 #endif 9334 if (z.type==_DOUBLE_ && prec<=13){ 9335 double Z=z._DOUBLE_val,fz,gz; 9336 #if defined HAVE_LIBGSL && 0 9337 if (mode==1){ 9338 siz=gsl_sf_Si(Z); 9339 return true; 9340 } 9341 if (mode==2){ 9342 if (Z<0) 9343 ciz=gen(gsl_sf_Ci(-Z),M_PI); 9344 else 9345 ciz=gsl_sf_Ci(Z); 9346 return true; 9347 } 9348 #endif 9349 if (Z>=40 || Z<=-40){ 9350 // use series expansion at infinity 9351 // Si: 1/2*PI - 1/z*cos(z) - 1/z^2*sin(z) + 2/z^3*cos(z) + 6/z^4*sin(z) - 24/z^5*cos(z) - 120/z^6*sin(z) + 720/z^7*cos(z) + 5040/z^8*sin(z) + O(1/z^9) = 1/z^8( (pi/2*z-cz)*z ...) 9352 // Ci:1/z*sin(z) - 1/z^2*cos(z) - 2/z^3*sin(z) + 6/z^4*cos(z) + 24/z^5*sin(z) - 120/z^6*cos(z) - 720/z^7*sin(z) + 5040/z^8*cos(z) 9353 long_double sz=std::sin(Z); 9354 long_double cz=std::cos(Z); 9355 long_double invZ=1/Z; 9356 long_double pi=invZ; 9357 long_double sizd=Z>0?M_PI/2:-M_PI/2,cizd=0; 9358 for (int n=1;;++n){ 9359 switch (n%4){ 9360 case 1: 9361 sizd -= pi*cz; 9362 cizd += pi*sz; 9363 break; 9364 case 2: 9365 sizd -= pi*sz; 9366 cizd -= pi*cz; 9367 break; 9368 case 3: 9369 sizd += pi*cz; 9370 cizd -= pi*sz; 9371 break; 9372 case 0: 9373 sizd += pi*sz; 9374 cizd += pi*cz; 9375 break; 9376 } 9377 if (pi<1e-16 && pi>-1e-16) 9378 break; 9379 pi *= n*invZ; 9380 } 9381 siz = double(sizd); 9382 ciz = Z>0?double(cizd):gen(double(cizd),M_PI); 9383 /* 9384 double z8=Z*Z; 9385 z8*=z8; 9386 z8*=z8; 9387 siz=((((((((M_PI/2*Z-cz)*Z-sz)*Z+2*cz)*Z+6*sz)*Z-24*cz)*Z-120*sz)*Z+720*cz)*Z+5040)/z8; 9388 ciz=((((((((sz)*Z-cz)*Z-2*sz)*Z+6*cz)*Z+24*sz)*Z-120*cz)*Z-720*sz)*Z+5040)/z8; 9389 */ 9390 return true; 9391 } 9392 bool neg=Z<0; 9393 if (neg) Z=-Z; 9394 if (Z<=8){ 9395 long_double si=1,ci=0,z2=Z*Z,pi=1; 9396 for (long_double n=1;;n++){ 9397 pi = -pi*z2/2/n; 9398 if (absdouble(pi)<1e-15) 9399 break; 9400 ci += pi/(2*n); 9401 pi /= (2*n+1); 9402 si += pi/(2*n+1); 9403 } 9404 siz=double(si*Z); 9405 ciz=double(ci)+std::log(Z)+cst_euler_gamma; 9406 } 9407 // Digits:=30; 9408 // a:=convert(series(Si(x),x=X,24),polynom):; b:=subst(a,x=X+h):; 9409 // c:=convert(series(Ci(x),x=X,24),polynom):; d:=subst(c,x=X+h):; 9410 if (Z>8 && Z<=12){ 9411 long_double Zl=Z-10,ress=0,resc=0; 9412 // evalf(symb2poly(subst(b,X,10),h)) 9413 long_double tabsi[]={-0.1189416530979229549237628888274e-25,0.1535274533580010929112764295251e-23,0.5949595042899632105631168585106e-23,-0.8443813569533766615075729254715e-21,-0.2314493549701736156628360858149e-20,0.3873999840160633357506392314227e-18,0.6314325721978121436699115557946e-18,-0.1454512706077874699091092895960e-15,-0.7966560468972510895796615830931e-16,0.4362654888706402638259447137657e-13,-0.2168961216095219762135154593351e-13,-0.1013156299801104705978428503741e-10,0.1511362807589119975552764377684e-10,0.1746079592768605042057230051441e-8,-0.4215112103088864749315276215891e-8,-0.2100827763936543847478539598343e-6,0.6768578499749603731655034337648e-6,0.1604768832104729109406272571796e-4,-0.6129221770634575410555873017014e-4,-0.6629459359846050378314018176664e-3,0.2619937628043294083259734576549e-2,0.1168258324144788179314042496964e-1,-0.3923347089937577354591945908199e-1,-0.5440211108893698134047476618518e-1,1.658347594218874049330971879387}; 9414 // evalf(symb2poly(subst(d,X,10),h)) 9415 long_double tabci[]={-0.1031363603561483377414206719978e-24,0.1612636587877966055062771505636e-24,0.3224608155602632232346779331477e-22,0.1692359618263088728225313523766e-21,-0.1902123006508838353447776226346e-19,-0.3515542663511577547829464092398e-19,0.7651991655644681341759387392123e-17,0.8949035335940300076443987350711e-17,-0.2601535596364695291068633323882e-14,0.1492297097331336833098183955735e-16,0.6873241144777191906667850002758e-12,-0.6815990267379124633604933192924e-12,-0.1385917806100726110447949877846e-9,0.2729216217490738797188995072400e-9,0.2012042413927794669971423802132e-7,-0.5698511913235728873777759634867e-7,-0.1960205632344228431569991958688e-5,0.6982250568929225912819532196480e-5,0.1127699306487082097807313715561e-3,-0.4465373163022154950275303555869e-3,-0.3158611974102019356519036678335e-2,0.1189143127195082400887895227495e-1,0.3139641318985075293153170283171e-1,-0.8390715290764524522588639478252e-1,-0.4545643300445537263453282995265e-1}; 9416 unsigned N=sizeof(tabsi)/sizeof(long_double); 9417 for (unsigned i=0;i<N;i++){ 9418 ress *= Zl; 9419 ress += tabsi[i]; 9420 resc *= Zl; 9421 resc += tabci[i]; 9422 } 9423 siz = double(ress); 9424 ciz = double(resc); 9425 } 9426 if (Z>12 && Z<=16){ 9427 long_double Zl=Z-14,ress=0,resc=0; 9428 // evalf(symb2poly(subst(b,X,14),h)) 9429 long_double tabsi[]={0.4669904672048171207530336926784e-25,-0.9121786080411940331362079921979e-24,-0.2670914489796227617771058426181e-22,0.5191793400822084981037748064947e-21,0.1272661806026797328866077155393e-19,-0.2467115711789321804079825604360e-18,-0.4949985288801387245191790228644e-17,0.9598983157925822187983801948972e-16,0.1531267131408434243475192526878e-14,-0.2983793513482513341175920391396e-13,-0.3640741847215956508751181538961e-12,0.7178248462975320846576276463699e-11,0.6346880693851116027919629277690e-10,-0.1280755925139665180236732107401e-8,-0.7574841879361234814393864898316e-8,0.1596987755895423889046710494666e-6,0.5558236361973162161308791480329e-6,-0.1276894967030880532682787806556e-4,-0.2074774698099097315147678882137e-4,0.5764575129603710060263581799849e-3,0.2308201450150731015736777254153e-3,-0.1190515482960545313209358846732e-1,0.2356412497996938805126656809673e-2,0.7075766826391930770538248600113e-1,1.556211050077665053703631892805}; 9430 // evalf(symb2poly(subst(d,X,14),h)) 9431 long_double tabci[]={0.3590233410769916717046880365555e-25,0.1141530173081541381259185089975e-23,-0.2223749846955296806257123587014e-22,-0.5971404695883450494036609310213e-21,0.1158813189176036949355044721895e-19,0.2578286744261932540063357506560e-18,-0.4996649806240905822071761629155e-17,-0.8975849912962755765138097664122e-16,0.1743615446376990117868764420851e-14,0.2446425362039524592303128232180e-13,-0.4789979360061655431004102341364e-12,-0.5015267234200784104185754752298e-11,0.9985346701639551763361641926310e-10,0.7310382166844782587890268654904e-9,-0.1502609970889405144661999732289e-7,-0.6957715037844896183079492333545e-7,0.1519752625305293353227780696896e-5,0.3762397782384872898110463611961e-5,-0.9310463095669218193046370118801e-4,-0.8685445941902185669380116006632e-4,0.2944299062831149098901196099828e-2,0.7349281020023392469738413739405e-4,-0.3572765356616331098087728605326e-1,0.9766944157702399589209205476559e-2,0.6939635592758454727438326824349e-1}; 9432 unsigned N=sizeof(tabsi)/sizeof(long_double); 9433 for (unsigned i=0;i<N;i++){ 9434 ress *= Zl; 9435 ress += tabsi[i]; 9436 resc *= Zl; 9437 resc += tabci[i]; 9438 } 9439 siz = double(ress); 9440 ciz = double(resc); 9441 } 9442 if (Z>16 && Z<=20){ 9443 long_double Zl=Z-18,ress=0,resc=0; 9444 // evalf(symb2poly(subst(b,X,18),h)) 9445 long_double tabsi[]={-0.5458114686729331288343465771243e-25,-0.8535297797031477670863377809864e-25,0.3197608273507048053143023106525e-22,0.1246720240695204431925986220740e-22,-0.1566961070193290350813150654958e-19,0.1120194984050557421284180749579e-19,0.6303732529750142701943836944779e-17,-0.1093865529886308098492342051935e-16,-0.2034127294195017035840150503185e-14,0.5391577496552481117289518608625e-14,0.5113326950563000131064845650605e-12,-0.1755022270416406807283368583049e-11,-0.9642855115888351354955178064729e-10,0.3896583006063678015119758986001e-9,0.1297996094042326342264874814159e-7,-0.5741523749720224155210168829004e-7,-0.1165550911079956021485851292181e-5,0.5260587329402175094599529167340e-5,0.6336730653896082851113120333026e-4,-0.2682059741680869878136005839481e-3,-0.1788149401756335521591446074162e-2,0.6231324073036488917300258847156e-2,0.1950106172093382517043203223869e-1,-0.4172151370953756131945311580259e-1,1.536608096861185462361173893885}; 9446 // evalf(symb2poly(subst(d,X,18),h)) 9447 long_double tabci[]={0.4605275954646862944758091918129e-26,-0.1349519299011741936395476560680e-23,-0.1307682310402805091861215069192e-23,0.7246129197780950670155731691447e-21,-0.1246271694903983843859628582537e-21,-0.3225645499768452910431606017148e-18,0.3989357101823634351098507496171e-18,0.1165949042798889880769685702457e-15,-0.2573970823221046721180373208376e-15,-0.3334412559655945734048458981847e-13,0.1020420669194920098922521974402e-12,0.7298982331099322669182907795178e-11,-0.2745289334776461767357052328935e-10,-0.1171271721735576258954174760357e-8,0.4994621772350737506214065546293e-8,0.1300541789133113153488950327832e-6,-0.5864843122180159884437825091296e-6,-0.9221666449442426870101941344121e-5,0.4080390556697611593508057267335e-4,0.3702810510394427353858531043357e-3,-0.1453024604178293371013986047647e-2,-0.6848923209258520415117450659078e-2,0.1984174958896001500414615659760e-1,0.3668426156911556360089444693281e-1,-0.4347510299950100478344114920850e-1}; 9448 unsigned N=sizeof(tabsi)/sizeof(long_double); 9449 for (unsigned i=0;i<N;i++){ 9450 ress *= Zl; 9451 ress += tabsi[i]; 9452 resc *= Zl; 9453 resc += tabci[i]; 9454 } 9455 siz = double(ress); 9456 ciz = double(resc); 9457 } 9458 if (Z>20 && Z<=24){ 9459 long_double Zl=Z-22,ress=0,resc=0; 9460 // evalf(symb2poly(subst(b,X,22),h)) 9461 long_double tabsi[]={0.3374532347188926046754549614410e-25,0.9070719831057349388641148466696e-24,-0.2050470901003743543468128570765e-22,-0.4594235790411492575575248293744e-21,0.1043077621302187913107676015839e-19,0.1910932463670378689024003307389e-18,-0.4360804036884663718921536467101e-17,-0.6379227769542456535760586922387e-16,0.1464704096058402216999762277897e-14,0.1660737164480043388814198356103e-13,-0.3842072518362213364190884929092e-12,-0.3249870299707868231630032306411e-11,0.7591535353403568501001826557431e-10,0.4554066973680817003059315739181e-9,-0.1077692372064168550494073939261e-7,-0.4274452798917825988601610781581e-7,0.1030486252719749122401833140117e-5,0.2434192199039423608811016740448e-5,-0.6042868558775171616279520355687e-4,-0.7128407780774990405916452478794e-4,0.1868111001271415320776084256504e-2,0.7554565401849909491334584321080e-3,-0.2271723850350373234098156405564e-1,-0.4023322404729034509859207643533e-3,1.616083736594366543114431027190}; 9462 // evalf(symb2poly(subst(d,X,22),h)) 9463 long_double tabci[]={-0.3765941636516127667565314425887e-25,0.8496429623966734299562910340895e-24,0.2089658856058364573723209071877e-22,-0.4733667956308362832271784627271e-21,-0.9616010057686047674500629395344e-20,0.2188568968552838678620763986263e-18,0.3594653788547495746845572205294e-17,-0.8227046014999096676822143059749e-16,-0.1063984308386789623300816541173e-14,0.2451691569424535439026086961327e-13,0.2414081477262495987003288682969e-12,-0.5610174912354327213432820922583e-11,-0.4025699100579353159380991679438e-10,0.9460092423484752010231070364358e-9,0.4662816039604651635851886085410e-8,-0.1112697436829371328490149410190e-6,-0.3461508105965530058056263010906e-6,0.8452332929171272742294005025613e-5,0.1452920166854777888625357916022e-4,-0.3688187418989882360609440618036e-3,-0.2737432060552935755550251671918e-3,0.7538061305932840665075723970069e-2,0.1234183502875539666044793790453e-2,-0.4545276483611986938428066996417e-1,0.1640691915737749726680980654224e-2}; 9464 unsigned N=sizeof(tabsi)/sizeof(long_double); 9465 for (unsigned i=0;i<N;i++){ 9466 ress *= Zl; 9467 ress += tabsi[i]; 9468 resc *= Zl; 9469 resc += tabci[i]; 9470 } 9471 siz = double(ress); 9472 ciz = double(resc); 9473 } 9474 if (Z>24 && Z<=28){ 9475 long_double Zl=Z-26,ress=0,resc=0; 9476 // evalf(symb2poly(subst(b,X,26),h)) 9477 long_double tabsi[]={0.1887595283929249736721564257313e-26,-0.1139208683110194949664423805669e-23,0.1279293933254064768731875653817e-24,0.5994732455107313947881755894338e-21,-0.6938324133833276535897299455340e-21,-0.2609102593630429565352138793600e-18,0.5435603049161089391681629274496e-18,0.9202351759037677282055983009108e-16,-0.2642554055043397588710384653172e-15,-0.2565196994817985742348447471878e-13,0.8979673506711721488705329079164e-13,0.5477157384399615846158662911243e-11,-0.2160870416302321163457598611639e-10,-0.8604342982500329851062267981807e-9,0.3594354283136494037733432184009e-8,0.9424490157133423171849887794118e-7,-0.3925808731949007274318185773343e-6,-0.6671455253428628462019837043580e-5,0.2584931618742702225630929467268e-4,0.2717002055000108101387898426941e-3,-0.8869394862544894803875105833456e-3,-0.5192726828102161497754294326711e-2,0.1187673367608361403346165544076e-1,0.2932917117229241298137781896944e-1,1.544868862986338557887737260292}; 9478 // evalf(symb2poly(subst(d,X,26),h)) 9479 long_double tabci[]={0.4649965583842175529710094230187e-25,0.2092492486523365857112019931102e-25,-0.2673016958726137563529919009844e-22,0.1734025691834661144821904431335e-22,0.1282183044327200389255292828905e-19,-0.2098089236197822391981775009963e-19,-0.5037728169303807883904931875640e-17,0.1257389975122490684981594653098e-16,0.1585106167468127577346565423777e-14,-0.5084215538447167537343863000543e-14,-0.3884144934780823340053700189354e-12,0.1455636906316532474122453840240e-11,0.7154603949717881354941340050201e-10,-0.2926061246791173118887623808558e-9,-0.9458827111752210232753218600667e-8,0.3976537604156996965393015686438e-7,0.8424410070112619898093729646951e-6,-0.3418064228754065522708009442873e-5,-0.4606856152608972144114035752184e-4,0.1664083688146614131038736660077e-3,0.1330470954446840977471854832752e-2,-0.3758634727512557357034117912936e-2,-0.1514307620917034875601537686776e-1,0.2488151239725539779697630391881e-1,0.2829515103175713190842112993963e-1}; 9480 unsigned N=sizeof(tabsi)/sizeof(long_double); 9481 for (unsigned i=0;i<N;i++){ 9482 ress *= Zl; 9483 ress += tabsi[i]; 9484 resc *= Zl; 9485 resc += tabci[i]; 9486 } 9487 siz = double(ress); 9488 ciz = double(resc); 9489 } 9490 if (Z>28 && Z<=32){ 9491 long_double Zl=Z-30,ress=0,resc=0; 9492 // evalf(symb2poly(subst(b,X,30),h)) 9493 long_double tabsi[]={-0.3146268636172325352644123013773e-25,0.7254967655706034123075144269188e-24,0.1720174348300531678711926627452e-22,-0.3968569600567226603419285560888e-21,-0.7804624742706385979212734054562e-20,0.1797226284123711388607362992709e-18,0.2882267004838688287625265808775e-17,-0.6604428381371346662942676361200e-16,-0.8462601728339625717076212469620e-15,0.1921641824294710456184856743277e-13,0.1918622280824819669976604364077e-12,-0.4293140602943259867747088385429e-11,-0.3236373134197171392533933286615e-10,0.7078744765376845042933221167302e-9,0.3867645142776632643256131482060e-8,-0.8169087758905646352536906937371e-7,-0.3060269540778692505740670587310e-6,0.6120146081774563343983258719578e-5,0.1450591123346014175404634002192e-4,-0.2651270545919250186145646630982e-3,-0.3497315371034554476595429181296e-3,0.5419736490383548422011597468850e-2,0.3119763955955768506415340725399e-2,-0.3293438746976205966625829690981e-1,1.566756540030351110983731309007}; 9494 // evalf(symb2poly(subst(d,X,30),h)) 9495 long_double tabci[]={-0.2905250884383236235247049545527e-25,-0.7522147039999421611567058749977e-24,0.1735426584530328263231524611399e-22,0.3754699661541031707840824496312e-21,-0.8657191669382300006764470296916e-20,-0.1541017153772568372597216447575e-18,0.3541395808613865455763442962592e-17,0.5090911414277503198761655016250e-16,-0.1161952195659956230574302196387e-14,-0.1318846041657448769184055840206e-13,0.2975305748369348193892361410833e-12,0.2592737707940046163669864700563e-11,-0.5742839188863978180610659896436e-10,-0.3707322050098237760097147226680e-9,0.7983406320009368395835407645496e-8,0.3641426564991240108255042664073e-7,-0.7507713655866267126314943513395e-6,-0.2264698987507883174282691040657e-5,0.4355811042213145491501868952153e-4,0.7862739829137060637224202271609e-4,-0.1341741499597397210639678491289e-2,-0.1220985799040877684843355198131e-2,0.1638149848494348313828544726235e-1,0.5141714996252801690622071553807e-2,-0.3303241728207114377922644096301e-1}; 9496 unsigned N=sizeof(tabsi)/sizeof(long_double); 9497 for (unsigned i=0;i<N;i++){ 9498 ress *= Zl; 9499 ress += tabsi[i]; 9500 resc *= Zl; 9501 resc += tabci[i]; 9502 } 9503 siz = double(ress); 9504 ciz = double(resc); 9505 } 9506 if (Z>32 && Z<=36){ 9507 long_double Zl=Z-34,ress=0,resc=0; 9508 // evalf(symb2poly(subst(b,X,34),h)) 9509 long_double tabsi[]={0.3942701136493758442738611783193e-25,0.2833482488121121562882295508384e-25,-0.2240325735608330926855387141189e-22,0.7077167897405254555239797927716e-23,0.1062083455080499454129483304028e-19,-0.1296740970607253649730617065007e-19,-0.4125642950551060755694922602219e-17,0.8186731227770529065956573976157e-17,0.1284716025190091972930389282765e-14,-0.3331328985339278802607691455602e-14,-0.3121425078659463413394477246734e-12,0.9467354869456215167864364128202e-12,0.5717466510263820214761281907592e-10,-0.1880717150280359445242629986190e-9,-0.7546218335244881072513219000215e-8,0.2525355992897561612710992980882e-7,0.6743126364121930403816188890288e-6,-0.2149417013042573939863424458069e-5,-0.3721263582524267372627099974480e-4,0.1039917503622257770319033100678e-3,0.1091628590022319276482516968274e-2,-0.2344369704089296833875653244402e-2,-0.1270781662145181668046346804335e-1,0.1556125547411834767154373923623e-1,1.595256185182468624967114677624}; 9510 // evalf(symb2poly(subst(d,X,34),h)) 9511 long_double tabci[]={-0.1989238045881366884396486216401e-26,0.9603929081698055330298655453613e-24,0.1785462486600632168852339199134e-24,-0.4994884203374138675491408864852e-21,0.3922698307156298349251565849186e-21,0.2148764364742271875693500554094e-18,-0.3483461372134677428776900288130e-18,-0.7495914823918311062321675163567e-16,0.1730727343462677961269223481865e-15,0.2069644169058104778527335300702e-13,-0.5867510845332297156886886169438e-13,-0.4387405297943553775874545604808e-11,0.1397446669253207042207953256760e-10,0.6866413079078539001893686720856e-9,-0.2296062969528945671977337418042e-8,-0.7526095978772233458886342141369e-7,0.2479954929300904010747076408018e-6,0.5360278479932581967324034110246e-5,-0.1619607535570418039830425866209e-4,-0.2210046023539758078033314699734e-3,0.5534219043710011378918782268888e-3,0.4305022897404827350706361160583e-2,-0.7413599071494898236031397261835e-2,-0.2495794925837074078235212022679e-1,0.1626491643735576698165635194377e-1}; 9512 unsigned N=sizeof(tabsi)/sizeof(long_double); 9513 for (unsigned i=0;i<N;i++){ 9514 ress *= Zl; 9515 ress += tabsi[i]; 9516 resc *= Zl; 9517 resc += tabci[i]; 9518 } 9519 siz = double(ress); 9520 ciz = double(resc); 9521 } 9522 if (Z>36 && Z<=40){ 9523 long_double Zl=Z-38,ress=0,resc=0; 9524 // evalf(symb2poly(subst(b,X,38),h)) 9525 long_double tabsi[]={-0.2392585617788018962646757828598e-25,-0.6575431727115741067484987610228e-24,0.1413726322474858257725781544417e-22,0.3273737185831529184312733883924e-21,-0.6971366411141976840382089119809e-20,-0.1343722941531172977052740901750e-18,0.2818131926670801219167357117818e-17,0.4456155806753828158414772784641e-16,-0.9138685919934995126194762439509e-15,-0.1164855661769990237307373295310e-13,0.2314363358966319503074680596234e-12,0.2327043421113577898681844454632e-11,-0.4423649753121148492913255999601e-10,-0.3413423247744706973417929454576e-9,0.6100985644119355599936971303758e-8,0.3483915381970249998364550866465e-7,-0.5705724285037609250439734410714e-6,-0.2292102947589923998615699771400e-5,0.3301272634561039972744957647445e-4,0.8640908538565720173919303844142e-4,-0.1017258860929286693108579223376e-2,-0.1518531271099188526195110204881e-2,0.1246413777530741664504711921590e-1,0.7799173123931192562955174996028e-2,1.545492937235698740561891130750}; 9526 // evalf(symb2poly(subst(d,X,38),h)) 9527 long_double tabci[]={0.2755791623901057620946655522961e-25,-0.5942947240530035802859253027110e-24,-0.1501343221496874685931095691537e-22,0.3214487908378114008198384990138e-21,0.6802473399014152745014932500302e-20,-0.1438706210063382233790032141791e-18,-0.2516685599977182931504499600334e-17,0.5224619763598943054009172687575e-16,0.7435302907498417390873416469940e-15,-0.1502856747601093160946258165352e-13,-0.1706516669026401836883958369119e-12,0.3322517447592247618873995073660e-11,0.2938003484322757578999393723335e-10,-0.5429671029677216915133045537076e-9,-0.3623244387376009573032456389105e-8,0.6223561267305907587303733846902e-7,0.3003453535122368377351197880341e-6,-0.4643099720179236845576657726334e-5,-0.1523777445337208725039230269865e-4,0.2008948838914583162973945866431e-3,0.4061768073150514090668429199326e-3,-0.4114703864552309315370227396080e-2,-0.4230290732342083420531097274815e-2,0.2513351694861302256806674303698e-1,0.7129761801971379713551376511546e-2}; 9528 unsigned N=sizeof(tabsi)/sizeof(long_double); 9529 for (unsigned i=0;i<N;i++){ 9530 ress *= Zl; 9531 ress += tabsi[i]; 9532 resc *= Zl; 9533 resc += tabci[i]; 9534 } 9535 siz = double(ress); 9536 ciz = double(resc); 9537 } 9538 if (Z>40 && Z<40) { // not used anymore, too slow 9539 sici_fg(Z,fz,gz); 9540 siz=M_PI/2-fz*std::cos(Z)-gz*std::sin(Z); 9541 ciz=fz*std::sin(Z)-gz*std::cos(Z); 9542 } 9543 if (neg){ 9544 siz = -siz; 9545 if (mode!=1) 9546 ciz = gen(ciz,M_PI); 9547 } 9548 return true; 9549 } 9550 z=evalf_double(abs(z0,contextptr),1,contextptr); 9551 if (z.type!=_DOUBLE_) 9552 return false; // gentypeerr(gettext("sici")); 9553 if (prec<13){ 9554 gen z=z0; 9555 bool p=is_positive(re(z0,contextptr),contextptr); 9556 if (!p) 9557 z=-z; 9558 gen a=Ei(cst_i*z,contextptr),b=Ei(-cst_i*z,contextptr); 9559 ciz=(a+b)/2; 9560 if (!p){ 9561 if (is_positive(im(z0,contextptr),contextptr)) 9562 ciz=ciz+cst_i*cst_pi; 9563 else 9564 ciz=ciz-cst_i*cst_pi; 9565 } 9566 siz=(a-b)/2/cst_i-cst_pi_over_2; 9567 if (!p) 9568 siz=-siz; 9569 return true; 9570 } 9571 // find number of digits that must be added to prec 9572 // n^n/n! equivalent to e^n*sqrt(2*pi*n) 9573 int newprec,nbitsz=int(z._DOUBLE_val/std::log(2.)),prec2=int(prec*std::log(10.0)/std::log(2.0)+.5); 9574 if (nbitsz>prec2){ 9575 // use asymptotic expansion at z=inf 9576 z = accurate_evalf(z0,prec2); 9577 gen sinz=sin(z,contextptr),cosz=cos(z,contextptr); 9578 gen invc=1,invs=0,pi=1,eps=accurate_evalf(pow(10,-prec,contextptr),prec2)/2; 9579 for (int n=1;;++n){ 9580 if (is_greater(eps,abs(pi,contextptr),contextptr)) 9581 break; 9582 pi = (n*pi)/z; 9583 if (n%2){ 9584 if (n%4==1) 9585 invs += pi; 9586 else 9587 invs -= pi; 9588 } 9589 else { 9590 if (n%4==0) 9591 invc += pi; 9592 else 9593 invc -= pi; 9594 } 9595 } 9596 siz=m_pi(prec2)/2-cosz/z*invc-sinz/z*invs; 9597 ciz=sinz/z*invc-cosz/z*invs; 9598 return true; 9599 } 9600 // use series expansion at z=0 9601 if (z._DOUBLE_val>1) 9602 newprec = prec2+nbitsz+int(std::log(z._DOUBLE_val)/2)+1; 9603 else 9604 newprec = prec2+2; 9605 z = accurate_evalf(z0,newprec); 9606 gen si=1,ci=0,z2=z*z,pi=1,eps=accurate_evalf(pow(10,-prec,contextptr),newprec)/2; 9607 for (int n=1;;n++){ 9608 pi = pi*z2/(2*n*(2*n-1)); 9609 if (is_greater(eps,abs(pi,contextptr),contextptr)) 9610 break; 9611 if (mode!=1){ 9612 if (n%2) 9613 ci -= pi/(2*n); 9614 else 9615 ci += pi/(2*n); 9616 } 9617 if (mode!=2){ 9618 if (n%2) 9619 si -= pi/((2*n+1)*(2*n+1)); 9620 else 9621 si += pi/((2*n+1)*(2*n+1)); 9622 } 9623 } 9624 if (mode!=2) 9625 siz=si*accurate_evalf(z0,prec2); 9626 if (mode!=1){ 9627 ciz=ci+ln(z,contextptr)+m_gamma(newprec); 9628 ciz=accurate_evalf(ciz,prec2); 9629 } 9630 return true; 9631 } 9632 taylor_SiCi_f(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)9633 static gen taylor_SiCi_f(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 9634 if (ordre<0) 9635 return 0; 9636 if (!is_inf(lim_point)) 9637 return taylor(lim_point,ordre,f,0,shift_coeff,contextptr); 9638 shift_coeff=1; 9639 // f(x)=1/x* sum( +/-(2*k)!*x^(-2k) ) 9640 gen tmp(1); 9641 vecteur v; 9642 for (int n=0;n<=ordre;){ 9643 v.push_back(tmp); 9644 v.push_back(0); 9645 n +=2 ; 9646 tmp=-gen((n-1)*n)*tmp; 9647 } 9648 v.push_back(undef); 9649 return v; 9650 } 9651 gen _SiCi_g(const gen & args,GIAC_CONTEXT); d_SiCi_f(const gen & args,GIAC_CONTEXT)9652 static gen d_SiCi_f(const gen & args,GIAC_CONTEXT){ 9653 return -_SiCi_g(args,contextptr); 9654 } 9655 define_partial_derivative_onearg_genop( D_at_SiCi_f," D_at_SiCi_f",&d_SiCi_f); 9656 gen _Si(const gen & args,GIAC_CONTEXT); 9657 gen _Ci(const gen & args,GIAC_CONTEXT); _SiCi_f(const gen & args,GIAC_CONTEXT)9658 gen _SiCi_f(const gen & args,GIAC_CONTEXT){ 9659 if (args.type==_FLOAT_) 9660 return _SiCi_f(get_double(args._FLOAT_val),contextptr); 9661 if (is_inf(args)) 9662 return 0; 9663 if (is_zero(args,contextptr)) 9664 return unsigned_inf; 9665 if (is_undef(args)) 9666 return args; 9667 if (args.type==_DOUBLE_ || args.type==_REAL) 9668 return _Ci(args,contextptr)*sin(args,contextptr)+(evalf(cst_pi/2,1,contextptr)-_Si(args,contextptr))*cos(args,contextptr); 9669 return symbolic(at_SiCi_f,args); 9670 } 9671 static const char _SiCi_f_s []="SiCi_f"; 9672 #ifdef GIAC_HAS_STO_38 9673 static define_unary_function_eval_taylor( __SiCi_f,&_SiCi_f,(size_t)&D_at_SiCi_funary_function_ptr,&taylor_SiCi_f,_SiCi_f_s); 9674 #else 9675 static define_unary_function_eval_taylor( __SiCi_f,&_SiCi_f,D_at_SiCi_f,&taylor_SiCi_f,_SiCi_f_s); 9676 #endif 9677 define_unary_function_ptr5( at_SiCi_f ,alias_at_SiCi_f,&__SiCi_f,0,true); 9678 taylor_SiCi_g(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)9679 static gen taylor_SiCi_g(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 9680 if (ordre<0) 9681 return 0; 9682 if (!is_inf(lim_point)) 9683 return taylor(lim_point,ordre,f,0,shift_coeff,contextptr); 9684 shift_coeff=2; 9685 // f(x)=sum( +/-(2*k+1)!*x^(-2k+2) ) 9686 gen tmp(1); 9687 vecteur v; 9688 for (int n=1;n<=ordre+1;){ 9689 v.push_back(tmp); 9690 v.push_back(0); 9691 n +=2 ; 9692 tmp=-gen((n-1)*n)*tmp; 9693 } 9694 v.push_back(undef); 9695 return v; 9696 } d_SiCi_g(const gen & args,GIAC_CONTEXT)9697 static gen d_SiCi_g(const gen & args,GIAC_CONTEXT){ 9698 return inv(args,contextptr)+_SiCi_f(args,contextptr); 9699 } 9700 define_partial_derivative_onearg_genop( D_at_SiCi_g," D_at_SiCi_g",&d_SiCi_g); _SiCi_g(const gen & args,GIAC_CONTEXT)9701 gen _SiCi_g(const gen & args,GIAC_CONTEXT){ 9702 if ( args.type==_STRNG && args.subtype==-1) return args; 9703 if (args.type==_FLOAT_) 9704 return _SiCi_g(get_double(args._FLOAT_val),contextptr); 9705 if (is_inf(args)) 9706 return 0; 9707 if (is_zero(args,contextptr)) 9708 return unsigned_inf; 9709 if (is_undef(args)) 9710 return args; 9711 if (args.type==_DOUBLE_ || args.type==_REAL) 9712 return -_Ci(args,contextptr)*cos(args,contextptr)+(evalf(cst_pi/2,1,contextptr)-_Si(args,contextptr))*sin(args,contextptr); 9713 return symbolic(at_SiCi_g,args); 9714 } 9715 static const char _SiCi_g_s []="SiCi_g"; 9716 #ifdef GIAC_HAS_STO_38 9717 static define_unary_function_eval_taylor( __SiCi_g,&_SiCi_g,(size_t)&D_at_SiCi_gunary_function_ptr,&taylor_SiCi_g,_SiCi_g_s); 9718 #else 9719 static define_unary_function_eval_taylor( __SiCi_g,&_SiCi_g,D_at_SiCi_g,&taylor_SiCi_g,_SiCi_g_s); 9720 #endif 9721 define_unary_function_ptr5( at_SiCi_g ,alias_at_SiCi_g,&__SiCi_g,0,true); 9722 Si_replace(const gen & g,GIAC_CONTEXT)9723 static gen Si_replace(const gen & g,GIAC_CONTEXT){ 9724 return cst_pi_over_2-_SiCi_f(g,contextptr)*cos(g,contextptr)-_SiCi_g(g,contextptr)*sin(g,contextptr); 9725 } taylor_Si(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)9726 static gen taylor_Si(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 9727 if (ordre<0){ 9728 return 0; // statically handled now 9729 limit_tractable_functions().push_back(at_Si); 9730 limit_tractable_replace().push_back(Si_replace); 9731 return 1; 9732 } 9733 shift_coeff=0; 9734 if (is_zero(lim_point,contextptr)){ 9735 shift_coeff=1; 9736 vecteur v; 9737 gen pi(1); 9738 for (int i=0;i<=ordre;){ 9739 v.push_back(plus_one/pi/(i+shift_coeff)); 9740 v.push_back(0); 9741 i += 2; 9742 pi = -(i*(i+1))*pi; 9743 } 9744 v.push_back(undef); 9745 return v; 9746 } 9747 if (!is_inf(lim_point)) 9748 return taylor(lim_point,ordre,f,direction,shift_coeff,contextptr); 9749 return gentypeerr(contextptr); 9750 } d_Si(const gen & args,GIAC_CONTEXT)9751 static gen d_Si(const gen & args,GIAC_CONTEXT){ 9752 return sin(args,contextptr)/args; 9753 } 9754 define_partial_derivative_onearg_genop( D_at_Si," D_at_Si",&d_Si); _Si(const gen & args,GIAC_CONTEXT)9755 gen _Si(const gen & args,GIAC_CONTEXT){ 9756 if ( args.type==_STRNG && args.subtype==-1) return args; 9757 if (args.type==_VECT) return apply(args,_Si,contextptr); 9758 if (args.type==_FLOAT_) 9759 return evalf2bcd(_Si(get_double(args._FLOAT_val),contextptr),1,contextptr); 9760 if (is_zero(args,contextptr)) 9761 return args; 9762 if (is_undef(args)) 9763 return args; 9764 if (is_inf(args)){ 9765 if (args==plus_inf) 9766 return cst_pi_over_2; 9767 if (args==minus_inf) 9768 return -cst_pi_over_2; 9769 return undef; 9770 } 9771 if (args.is_symb_of_sommet(at_neg)) 9772 return -_Si(args._SYMBptr->feuille,contextptr); 9773 if (args.type!=_DOUBLE_ && args.type!=_REAL && args.type!=_CPLX) 9774 return symbolic(at_Si,args); 9775 gen si,ci; 9776 if (!sici(args,si,ci,decimal_digits(contextptr),1,contextptr)) 9777 return gensizeerr(contextptr); 9778 return si; 9779 } 9780 static const char _Si_s []="Si"; 9781 #ifdef GIAC_HAS_STO_38 9782 static define_unary_function_eval_taylor( __Si,&_Si,(size_t)&D_at_Siunary_function_ptr,&taylor_Si,_Si_s); 9783 #else 9784 static define_unary_function_eval_taylor( __Si,&_Si,D_at_Si,&taylor_Si,_Si_s); 9785 #endif 9786 define_unary_function_ptr5( at_Si ,alias_at_Si,&__Si,0,true); 9787 Ci_replace(const gen & g,GIAC_CONTEXT)9788 static gen Ci_replace(const gen & g,GIAC_CONTEXT){ 9789 return _SiCi_f(g,contextptr)*sin(g,contextptr)-_SiCi_g(g,contextptr)*cos(g,contextptr); 9790 } 9791 gen _Ci0(const gen &,GIAC_CONTEXT); Ci_replace0(const gen & g,GIAC_CONTEXT)9792 gen Ci_replace0(const gen & g,GIAC_CONTEXT){ 9793 return _Ci0(g,contextptr)+cst_euler_gamma+ln(abs(g,contextptr),contextptr); 9794 } taylor_Ci(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)9795 static gen taylor_Ci(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 9796 if (ordre<0){ 9797 return 0; // statically handled now 9798 //limit_tractable_functions().push_back(at_Ci); 9799 //limit_tractable_replace().push_back(Ci_replace); 9800 //return 1; 9801 } 9802 shift_coeff=0; 9803 if (!is_inf(lim_point)) 9804 return taylor(lim_point,ordre,f,direction,shift_coeff,contextptr); 9805 return gentypeerr(contextptr); 9806 } d_Ci(const gen & args,GIAC_CONTEXT)9807 static gen d_Ci(const gen & args,GIAC_CONTEXT){ 9808 return cos(args,contextptr)/args; 9809 } 9810 define_partial_derivative_onearg_genop( D_at_Ci," D_at_Ci",&d_Ci); _Ci(const gen & args,GIAC_CONTEXT)9811 gen _Ci(const gen & args,GIAC_CONTEXT){ 9812 if ( args.type==_STRNG && args.subtype==-1) return args; 9813 if (args.type==_VECT) return apply(args,_Ci,contextptr); 9814 if (args.type==_FLOAT_) 9815 return evalf2bcd(_Ci(get_double(args._FLOAT_val),contextptr),1,contextptr); 9816 if (is_zero(args,contextptr)) 9817 return minus_inf; 9818 if (is_undef(args)) 9819 return args; 9820 if (is_inf(args)){ 9821 if (args==plus_inf) 9822 return 0; 9823 if (args==minus_inf) 9824 return cst_pi*cst_i; 9825 return undef; 9826 } 9827 if (args.type!=_DOUBLE_ && args.type!=_REAL && args.type!=_CPLX) 9828 return symbolic(at_Ci,args); 9829 gen si,ci; 9830 if (!sici(args,si,ci,decimal_digits(contextptr),2,contextptr)) 9831 return gensizeerr(contextptr); 9832 return ci; 9833 } 9834 static const char _Ci_s []="Ci"; 9835 #ifdef GIAC_HAS_STO_38 9836 define_unary_function_eval_taylor( __Ci,&_Ci,(size_t)&D_at_Ciunary_function_ptr,&taylor_Ci,_Ci_s); 9837 #else 9838 define_unary_function_eval_taylor( __Ci,&_Ci,D_at_Ci,&taylor_Ci,_Ci_s); 9839 #endif 9840 define_unary_function_ptr5( at_Ci ,alias_at_Ci,&__Ci,0,true); 9841 d_Ci0(const gen & args,GIAC_CONTEXT)9842 static gen d_Ci0(const gen & args,GIAC_CONTEXT){ 9843 return (cos(args,contextptr)-1)/args; 9844 } 9845 define_partial_derivative_onearg_genop( D_at_Ci0," D_at_Ci0",&d_Ci0); taylor_Ci0(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)9846 static gen taylor_Ci0(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 9847 if (ordre<0) 9848 return 0; 9849 if (!is_zero(lim_point,contextptr)) 9850 return taylor(lim_point,ordre,f,0,shift_coeff,contextptr); 9851 shift_coeff=2; 9852 // sum( (-1)^k/(2*k)/(2*k)! * x^(2k) ) 9853 gen tmp(1); 9854 vecteur v; 9855 for (int n=0;n<=ordre;){ 9856 n +=2 ; 9857 tmp=-gen((n-1)*n)*tmp; 9858 v.push_back(inv(n*tmp,contextptr)); 9859 v.push_back(0); 9860 } 9861 v.push_back(undef); 9862 return v; 9863 } _Ci0(const gen & args,GIAC_CONTEXT)9864 gen _Ci0(const gen & args,GIAC_CONTEXT){ 9865 if ( args.type==_STRNG && args.subtype==-1) return args; 9866 if (is_zero(args,contextptr)) 9867 return 0; 9868 if (is_undef(args)) 9869 return args; 9870 if (is_inf(args)) 9871 return minus_inf; 9872 if (args.type!=_DOUBLE_ && args.type!=_REAL && args.type!=_CPLX) 9873 return symbolic(at_Ci0,args); 9874 gen si,ci; 9875 if (!sici(args,si,ci,decimal_digits(contextptr),2,contextptr)) 9876 return gensizeerr(contextptr); 9877 return ci-evalf(cst_euler_gamma,1,contextptr)-ln(args,contextptr); 9878 } 9879 static const char _Ci0_s []="Ci0"; 9880 #ifdef GIAC_HAS_STO_38 9881 static define_unary_function_eval_taylor( __Ci0,&_Ci0,(size_t)&D_at_Ci0unary_function_ptr,&taylor_Ci0,_Ci0_s); 9882 #else 9883 static define_unary_function_eval_taylor( __Ci0,&_Ci0,D_at_Ci0,&taylor_Ci0,_Ci0_s); 9884 #endif 9885 define_unary_function_ptr5( at_Ci0 ,alias_at_Ci0,&__Ci0,0,true); /* FIXME should not registered */ 9886 9887 gen _Ei_f(const gen & args,GIAC_CONTEXT); taylor_Ei_f(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)9888 static gen taylor_Ei_f(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 9889 if (ordre<0) 9890 return 0; 9891 if (!is_inf(lim_point)) 9892 return taylor(lim_point,ordre,f,0,shift_coeff,contextptr);//gensizeerr(contextptr); 9893 shift_coeff=1; 9894 // f(x)=1/x* sum( k!/x^(k) ) 9895 gen tmp(1); 9896 vecteur v; 9897 for (int n=1;n<=ordre+1;n++){ 9898 v.push_back(tmp); 9899 tmp=n*tmp; 9900 } 9901 v.push_back(undef); 9902 return v; 9903 } d_Ei_f(const gen & args,GIAC_CONTEXT)9904 static gen d_Ei_f(const gen & args,GIAC_CONTEXT){ 9905 return -_Ei_f(args,contextptr); 9906 } 9907 define_partial_derivative_onearg_genop( D_at_Ei_f," D_at_Ei_f",&d_Ei_f); _Ei_f(const gen & args,GIAC_CONTEXT)9908 gen _Ei_f(const gen & args,GIAC_CONTEXT){ 9909 if ( args.type==_STRNG && args.subtype==-1) return args; 9910 if (is_inf(args)) 9911 return 0; 9912 if (is_zero(args,contextptr)) 9913 return unsigned_inf; 9914 if (is_undef(args)) 9915 return args; 9916 return symbolic(at_Ei_f,args); 9917 } 9918 static const char _Ei_f_s []="Ei_f"; 9919 #ifdef GIAC_HAS_STO_38 9920 static define_unary_function_eval_taylor( __Ei_f,&_Ei_f,(size_t)&D_at_Ei_funary_function_ptr,&taylor_Ei_f,_Ei_f_s); 9921 #else 9922 static define_unary_function_eval_taylor( __Ei_f,&_Ei_f,D_at_Ei_f,&taylor_Ei_f,_Ei_f_s); 9923 #endif 9924 define_unary_function_ptr5( at_Ei_f ,alias_at_Ei_f,&__Ei_f,0,true); Ei_replace(const gen & g,GIAC_CONTEXT)9925 static gen Ei_replace(const gen & g,GIAC_CONTEXT){ 9926 if (has_i(g)){ 9927 *logptr(contextptr) << "Ei with non real argument: "+g.print() << '\n'; 9928 return Ei(g,contextptr); 9929 } 9930 return _Ei_f(g,contextptr)*exp(g,contextptr); 9931 } 9932 gen _Ei0(const gen & args,GIAC_CONTEXT); Ei_replace0(const gen & g,GIAC_CONTEXT)9933 gen Ei_replace0(const gen & g,GIAC_CONTEXT){ 9934 return _Ei0(g,contextptr)+cst_euler_gamma+ln(abs(g,contextptr),contextptr); 9935 } taylor_Ei(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)9936 static gen taylor_Ei(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 9937 if (ordre<0){ 9938 return 0; // statically handled now 9939 //limit_tractable_functions().push_back(at_Ei); 9940 //limit_tractable_replace().push_back(Ei_replace); 9941 //return 1; 9942 } 9943 shift_coeff=0; 9944 if (!is_inf(lim_point)) 9945 return taylor(lim_point,ordre,f,direction,shift_coeff,contextptr); 9946 return gentypeerr(contextptr); 9947 } d_Ei(const gen & args,GIAC_CONTEXT)9948 static gen d_Ei(const gen & args,GIAC_CONTEXT){ 9949 if (args.type!=_VECT) 9950 return exp(args,contextptr)/args; 9951 vecteur v=*args._VECTptr; 9952 if (v.size()==1) 9953 return exp(v.front(),contextptr)/v.front(); 9954 return gendimerr(contextptr); 9955 } 9956 define_partial_derivative_onearg_genop( D_at_Ei," D_at_Ei",&d_Ei); Ei(const gen & args,GIAC_CONTEXT)9957 gen Ei(const gen & args,GIAC_CONTEXT){ 9958 if (args.type==_FLOAT_) 9959 return Ei(get_double(args._FLOAT_val),contextptr); 9960 if (is_zero(args,contextptr)) 9961 return minus_inf; 9962 if (args==plus_inf || is_undef(args)) 9963 return args; 9964 if (args==minus_inf) 9965 return 0; 9966 if (is_inf(args)) 9967 return undef; 9968 if (args.type!=_DOUBLE_ && args.type!=_REAL && args.type!=_CPLX) 9969 return symbolic(at_Ei,args); 9970 gen z=evalf_double(abs(args,contextptr),1,contextptr); 9971 if (z.type!=_DOUBLE_) 9972 return gentypeerr(contextptr); 9973 int prec=decimal_digits(contextptr); 9974 if (args.type==_DOUBLE_ && prec>13) 9975 prec=13; 9976 if (args.type==_DOUBLE_ && prec<=13){ 9977 double z=args._DOUBLE_val; 9978 #if 0 // def HAVE_LIBGSL 9979 return gsl_sf_expint_Ei(z); 9980 #endif 9981 if (z>=40 || z<=-40){ 9982 long_double ei=1,pi=1,Z=z; 9983 for (long_double n=1;;++n){ 9984 if (pi<1e-16 && pi>-1e-16) 9985 break; 9986 pi = (n*pi)/Z; 9987 ei += pi; 9988 } 9989 return double(std::exp(Z)/Z*ei); 9990 } 9991 if (z>=-4.8 && z<=40){ 9992 // ? use __float80 or __float128 9993 /* 9994 #ifdef __SSE__ 9995 #if defined x86_64 && defined __SSE_4_2__ 9996 __float128 ei=0.0q,pi=1.0q; 9997 #else 9998 __float80 ei=0.0w,pi=1.0w; 9999 #endif // __SSE4_2__ 10000 */ 10001 long_double ei=0.0,pi=1.0,Z=z; 10002 for (long_double n=1;;n++){ 10003 pi = pi*Z/n; 10004 if (pi<1e-16 && pi>-1e-16) 10005 break; 10006 ei += pi/n; 10007 } 10008 ei=ei+std::log(absdouble(z))+0.577215664901532860610; 10009 return double(ei); 10010 } 10011 // continued fraction: http://people.math.sfu.ca/~cbm/aands/page_229.htm 10012 long_double x=-z; 10013 long_double result(1); 10014 long_double un(1); 10015 for (long_double n=40;n>=1;--n){ 10016 result = un+n/result; 10017 result = x+n/result; 10018 } 10019 result=-un/result*std::exp(-x); 10020 return gen(double(result)); 10021 #if 0 10022 // a:=convert(series(Ei(x)*exp(-x)*x,x=X,24),polynom):; b:=subst(a,x=X+h):; 10023 if (z>=-6.8 && z<=-4.8){ 10024 // X:=-5.8; evalf(symb2poly(b,h),30) 10025 long_double Z=z+5.8,res=0; 10026 long_double tabei[]={-0.3151760388807517547897224622361e-20,-0.1956623502102099783599191666531e-19,-0.1217520387814662777242246174541e-18,-0.7595047623259136899131074978509e-18,-0.4750592523487122640844934717658e-17,-0.2979985874126626857226335496504e-16,-0.1875104560810577497563994966761e-15,-0.1183827325179695999391747354358e-14,-0.7501052898029529880772284438566e-14,-0.4771568760084635063692127230846e-13,-0.3048290706102002977129135629199e-12,-0.1956495512880190361879173037779e-11,-0.1262184835369108393063770847820e-10,-0.8188615023197271684637356284403e-10,-0.5345588144426140308176155460920e-9,-0.3513748178583494436182263562858e-8,-0.2327416524478792602782072181673e-7,-0.1554886566283128983353292920891e-6,-0.1048823536032497188023815631115e-5,-0.7151898287935501422833421755707e-5,-0.4937247597221480470432894324202e-4,-0.3456479830723309944342902721052e-3,-0.2458903778230241247990734517862e-2,-0.1781701304096371729351217642124e-1,0.8681380405349396412209368563589}; 10027 unsigned N=sizeof(tabei)/sizeof(long_double); 10028 for (unsigned i=0;i<N;i++){ 10029 res *= Z; 10030 res += tabei[i]; 10031 } 10032 return double(res*std::exp(z)/z); 10033 } 10034 if (z>=-10.4 && z<=-6.8){ 10035 // X:=-8.6; evalf(symb2poly(b,h),30) 10036 long_double Z=z+8.6,res=0; 10037 long_double tabei[]={-0.3038274728374471199550377e-24,-0.2779136645187427028874693e-23,-0.3038274728374471199535898278331e-24,-0.2779136645187427028908730164655e-23,-0.2546955934813756337104395625899e-22,-0.2338906925011672805172017690719e-21,-0.2152486734154319991905416359525e-20,-0.1985479703050588294559030935503e-19,-0.1835926261877877389191827053171e-18,-0.1702095774807244266388321827485e-17,-0.1582462980029593441341590109962e-16,-0.1475687715549251315001108783383e-15,-0.1380597694124124865185429282546e-14,-0.1296174167643919255669841368436e-13,-0.1221540406726513790755510762310e-12,-0.1155953021811538418057560238246e-11,-0.1098796276688146853531628645304e-10,-0.1049579707566189469341186813219e-9,-0.1007939580405777662197671844560e-8,-0.9736450265211550752217060575644e-8,-0.9466101382146753511496418259404e-7,-0.9269139557230184816973381023220e-6,-0.9148312509513609827739907179727e-5,-0.9108785014936600974832901874747e-4,-0.9158817613130838424132243282306e-3,-0.9310767919833080253847393582574e-2,0.9041742295948504677274049567506}; 10038 unsigned N=sizeof(tabei)/sizeof(long_double); 10039 for (unsigned i=0;i<N;i++){ 10040 res *= Z; 10041 res += tabei[i]; 10042 } 10043 return double(res*std::exp(z)/z); 10044 } 10045 if (z>=-18 && z<=-10.4){ 10046 // X:=-14.2; evalf(symb2poly(b,h),30) 10047 long_double Z=z+14.2,res=0; 10048 long_double tabei[]={-0.2146565037696152744587246594658e-29,-0.3211304301798548507083223372513e-28,-0.4810676293065620718028423299344e-27,-0.7216859970389437335874447555454e-26,-0.1084277395671112546831370934086e-24,-0.1631614493247996191078695765867e-23,-0.2459334296271721080391164633531e-22,-0.3713482299827011821020880718604e-21,-0.5617631647301656953696071542646e-20,-0.8514935739998273979648471651860e-19,-0.1293355781746933007839041344760e-17,-0.1968884006429264318605910506869e-16,-0.3004345775527340969677228988332e-15,-0.4595950524037171042443121664043e-14,-0.7049704421594200850156215866786e-13,-0.1084472101777504561037738433261e-11,-0.1673430730968429348565586095542e-10,-0.2590825472368919959973457219967e-9,-0.4025494197722650107148738975481e-8,-0.6278735181439544538790456358391e-7,-0.9834030941528033320856991985477e-6,-0.1547201663333347394190105495487e-4,-0.2446158986745476113536605827777e-3,-0.3888037771084034459793304640141e-2,0.9378427721282495585084911135452}; 10049 unsigned N=sizeof(tabei)/sizeof(long_double); 10050 for (unsigned i=0;i<N;i++){ 10051 res *= Z; 10052 res += tabei[i]; 10053 } 10054 return double(res*std::exp(z)/z); 10055 } 10056 if (z>=-28 && z<=-18){ 10057 // X:=-23; evalf(symb2poly(b,h),30) 10058 long_double Z=z+23,res=0; 10059 long_double tabei[]={-0.2146168427075858494404136614850e-34,-0.5148499454995822704300301651629e-33,-0.1236169966295832115713010472045e-31,-0.2970790204951956634218583491140e-30,-0.7146257090942497496926778641796e-29,-0.1720741952629494954062600276217e-27,-0.4147649238148296325602078162016e-26,-0.1000823187587987074490282090878e-24,-0.2417703015904985630926544707734e-23,-0.5847381076193017965725594038649e-22,-0.1415979006710406329134293651920e-20,-0.3433325477996997527365162488189e-19,-0.8336110427404205659872823554255e-18,-0.2026897569209606939865219036707e-16,-0.4935733317936049783947792956182e-15,-0.1203807749521077525537452325013e-13,-0.2940930287406907738614747539418e-12,-0.7197370501359682859646891271814e-11,-0.1764684158114017110045008515596e-9,-0.4335208135324139738484130923065e-8,-0.1067215959531320911498195408991e-6,-0.2632980854624917892922066469020e-5,-0.6511098477481142813714679454527e-4,-0.1614117344014970753628852067852e-2,0.9598801957880143469722276499000}; 10060 unsigned N=sizeof(tabei)/sizeof(long_double); 10061 for (unsigned i=0;i<N;i++){ 10062 res *= Z; 10063 res += tabei[i]; 10064 } 10065 return double(res*std::exp(z)/z); 10066 } 10067 if (z>=-40 && z<=-28){ 10068 // X:=-34; evalf(symb2poly(b,h),30) 10069 long_double Z=z+34,res=0; 10070 long_double tabei[]={-0.1553338170441157171980055301967e-38,-0.6629618584891807480484960239352e-37,-0.2063078177267001621688370383419e-35,-0.7866363363832491801531045634862e-34,-0.2644473347532265615154979481412e-32,-0.9583293463074797094792612009694e-31,-0.3331568830413908327708929748672e-29,-0.1185447458884996131099536033526e-27,-0.4172725550206304813111805693360e-26,-0.1478006485774725675043732714563e-24,-0.5225975670861681162526724856274e-23,-0.1851238198626063152547466792341e-21,-0.6560288456307499178019660543116e-20,-0.2327113628743444723634985600950e-18,-0.8261670399157726998435042888476e-17,-0.2935758096939480075974014556136e-15,-0.1044193898775627537692001439649e-13,-0.3717665504357675255012806230568e-12,-0.1324967081687119761655731034082e-10,-0.4727208926929774019493746342695e-9,-0.1688455962743104637225875947715e-7,-0.6037839002081685958714139659847e-6,-0.2161738491599201737451243010035e-4,-0.7749596600489697701377944551020e-3,0.9721813893840475706338481431853}; 10071 unsigned N=sizeof(tabei)/sizeof(long_double); 10072 for (unsigned i=0;i<N;i++){ 10073 res *= Z; 10074 res += tabei[i]; 10075 } 10076 return double(res*std::exp(z)/z); 10077 } 10078 // not used anymore, too slow 10079 // z<0: int(e^t/t,t,-inf,z)=e^z*int(e^(-u)/(u-z),t,0,inf) 10080 // z>0: Ei(9.)+int(e^t/t,t,9,z) = Ei(9.)-e^z*int(e^(-u)/(u-z),u,0,z-9) 10081 double nstep=400,a=0,fz=0; 10082 for (;nstep>0.25;nstep*=exp_minus_1_over_4){ 10083 double Fz=0; 10084 int N=int(nstep+.5); 10085 if (N<1) 10086 N=1; 10087 double taille=1.0; 10088 if (z>0 && a+1>z-9) 10089 taille=(z-9)-a; 10090 // Simpson over [a,a+taille] 10091 double t=a,tmp,Ninv=taille/N; 10092 t = a+Ninv/2.; 10093 double expt=std::exp(-t),expfact=std::exp(-Ninv); 10094 for (int i=0;i<N;++i){ // middle points 10095 tmp = expt/(t-z); 10096 Fz += tmp; 10097 expt *= expfact; 10098 t += Ninv; 10099 } 10100 Fz *= 2; 10101 t = a+Ninv; 10102 expt=std::exp(-t); 10103 for (int i=1;i<N;++i){ 10104 tmp = expt/(t-z); // endpoint 10105 Fz += tmp; 10106 expt *= expfact; 10107 t += Ninv; 10108 } 10109 Fz *= 2; 10110 tmp=std::exp(-a)/(a-z); // endpoint 10111 Fz += tmp; 10112 a += taille; 10113 tmp=std::exp(-a)/(a-z); // endpoint 10114 Fz += tmp; 10115 fz += Fz*taille/(6*N); 10116 if (z>0 && a>=z-9) 10117 break; 10118 } 10119 fz *= std::exp(z); 10120 if (z<0) 10121 return fz; 10122 return 1037.878290717090-fz; 10123 #endif 10124 } // end real cas 10125 if (prec<=13 && z._DOUBLE_val>=2.5 && z._DOUBLE_val<=40){ 10126 // continued fraction: http://people.math.sfu.ca/~cbm/aands/page_229.htm 10127 complex_long_double x(evalf_double(re(args,contextptr),1,contextptr)._DOUBLE_val, 10128 evalf_double(im(args,contextptr),1,contextptr)._DOUBLE_val); 10129 x=-x; 10130 if (x.real()>0 || absdouble(x.imag()/x.real())>=1){ 10131 complex_long_double result(1); 10132 long_double un(1); 10133 for (long_double n=40;n>=1;--n){ 10134 result = un+n/result; 10135 result = x+n/result; 10136 } 10137 result=-un/result*std::exp(-x); 10138 return gen(double(result.real()),double(result.imag())+M_PI*(x.imag()>0?-1:1)); 10139 } 10140 } 10141 #if 1 // defined(x86_64) || defined(__i386__) // if long_double available use this 10142 gen tmp=evalf_double(args,1,contextptr); 10143 if (tmp.type==_CPLX && prec<=13){ 10144 complex_long_double Z(tmp._CPLXptr->_DOUBLE_val,(tmp._CPLXptr+1)->_DOUBLE_val); 10145 if (z._DOUBLE_val>30){ 10146 // expansion at infinity, order 30, error 1e-13 10147 complex_long_double ei=1.0,pi=1.0; 10148 for (long_double n=1;n<=30;n++){ 10149 pi = (n*pi)/Z; 10150 ei += pi; 10151 } 10152 ei=std::exp(Z)/Z*ei; 10153 gen eig=gen(double(ei.real()),double(ei.imag())); 10154 // if (is_positive(-re(tmp,contextptr),contextptr)) 10155 { 10156 gen pi=im(tmp,contextptr); 10157 if (is_strictly_positive(pi,contextptr)) 10158 return eig+cst_pi*cst_i; 10159 if (is_strictly_positive(-pi,contextptr)) 10160 return eig-cst_pi*cst_i; 10161 } 10162 return eig; 10163 } 10164 else { 10165 // use expansion at 0, 10166 // cancellation for negative re(Z) but already computed with cont frac 10167 complex_long_double ei=0,pi=1; 10168 for (long_double n=1;n<=70;++n){ 10169 pi = pi*Z/n; 10170 ei += pi/n; 10171 } 10172 if (is_zero(im(tmp,contextptr)) && is_positive(-re(tmp,contextptr),contextptr)) 10173 ei=ei+std::log(-Z); 10174 else 10175 ei=ei+std::log(Z); 10176 ei += 0.577215664901532860610L; 10177 gen eig=gen(double(ei.real()),double(ei.imag())); 10178 return eig; 10179 } 10180 } 10181 #endif 10182 // find number of digits that must be added to prec 10183 // n^n/n! equivalent to e^n*sqrt(2*pi*n) 10184 // Note that Ei(z) might be as small as exp(-z) for relative prec 10185 int newprec,nbitsz=int(z._DOUBLE_val/std::log(2.)),prec2=int(prec*std::log(10.0)/std::log(2.0)+.5); 10186 if (nbitsz>prec2){ 10187 // use asymptotic expansion at z=inf 10188 gen ei=1,pi=1,eps=accurate_evalf(pow(10,-prec,contextptr),prec2)/2; 10189 z = accurate_evalf(args,prec2); 10190 for (int n=1;;++n){ 10191 if (is_greater(eps,abs(pi,contextptr),contextptr)) 10192 break; 10193 pi = (n*pi)/z; 10194 ei += pi; 10195 } 10196 ei=exp(z,contextptr)/z*ei; 10197 if (is_positive(-re(z,contextptr),contextptr)){ 10198 pi=im(z,contextptr); 10199 if (is_strictly_positive(pi,contextptr)) 10200 return ei+cst_pi*cst_i; 10201 if (is_strictly_positive(-pi,contextptr)) 10202 return ei-cst_pi*cst_i; 10203 } 10204 return ei; 10205 } 10206 prec2 += nbitsz; 10207 // use series expansion at z=0 10208 if (z._DOUBLE_val>1) 10209 newprec = prec2+nbitsz+int(std::log(z._DOUBLE_val)/2)+2; 10210 else 10211 newprec = prec2+2; 10212 gen ei=0,pi=1,eps=accurate_evalf(pow(10,-2*prec,contextptr)*exp(-2*abs(z,contextptr),contextptr),newprec)/4,r,i; 10213 z = accurate_evalf(args,newprec); 10214 for (int n=1;;n++){ 10215 pi = accurate_evalf(pi*z/n,newprec); 10216 reim(pi,r,i,contextptr); 10217 if (is_greater(eps,r*r+i*i,contextptr)) 10218 break; 10219 ei = accurate_evalf(ei+pi/n,newprec); 10220 } 10221 ei = accurate_evalf(ei,newprec); 10222 if (is_zero(im(z,contextptr)) && is_positive(-re(z,contextptr),contextptr)) 10223 ei=ei+ln(-z,contextptr); 10224 else 10225 ei=ei+ln(z,contextptr); 10226 r = re(ei,contextptr); 10227 r = r+accurate_evalf(m_gamma(newprec),newprec); 10228 r = accurate_evalf(r,prec2-nbitsz); 10229 i = accurate_evalf(im(ei,contextptr),prec2-nbitsz); 10230 ei = r+cst_i*i; 10231 return ei; 10232 } Ei(const gen & args,int n,GIAC_CONTEXT)10233 gen Ei(const gen & args,int n,GIAC_CONTEXT){ 10234 if (n==1) 10235 return -Ei(-args,contextptr); 10236 if (n<2) 10237 return gendimerr(contextptr); 10238 if (is_zero(args,contextptr)){ 10239 if (n==1) 10240 return plus_inf; 10241 return plus_one/gen(n-1); 10242 } 10243 if (args==plus_inf) 10244 return 0; 10245 if (args==minus_inf) 10246 return minus_inf; 10247 if (is_inf(args)|| is_undef(args)) 10248 return undef; 10249 return (exp(-args,contextptr)-args*Ei(args,n-1,contextptr))/gen(n-1); 10250 } _Ei(const gen & args,GIAC_CONTEXT)10251 gen _Ei(const gen & args,GIAC_CONTEXT){ 10252 if ( args.type==_STRNG && args.subtype==-1) return args; 10253 if (args.type==_VECT) return apply(args,_Ei,contextptr); 10254 if (args.type==_FLOAT_) 10255 return evalf2bcd(_Ei(get_double(args._FLOAT_val),contextptr),1,contextptr); 10256 if (args.type!=_VECT){ 10257 return Ei(args,contextptr); 10258 } 10259 if ( args._VECTptr->size()!=2 ){ 10260 return symbolic(at_Ei,args); 10261 } 10262 gen x(args._VECTptr->front()),n(args._VECTptr->back()); 10263 if (n.type==_REAL) 10264 n=n.evalf_double(1,contextptr); 10265 if (n.type==_DOUBLE_) 10266 n=int(n._DOUBLE_val); 10267 if (n.type!=_INT_) 10268 return gensizeerr(contextptr); 10269 if (n==1) 10270 *logptr(contextptr) << gettext("Warning, Ei(x,1) is defined as -Ei(-x), not as Ei(x)") << '\n'; 10271 return Ei(x,n.val,contextptr); 10272 } 10273 static const char _Ei_s []="Ei"; 10274 #ifdef GIAC_HAS_STO_38 10275 static define_unary_function_eval_taylor (__Ei,&_Ei,(size_t)&D_at_Eiunary_function_ptr,&taylor_Ei,_Ei_s); 10276 #else 10277 static define_unary_function_eval_taylor (__Ei,&_Ei,D_at_Ei,&taylor_Ei,_Ei_s); 10278 #endif 10279 define_unary_function_ptr5( at_Ei ,alias_at_Ei,&__Ei,0,true); 10280 d_Ei0(const gen & args,GIAC_CONTEXT)10281 static gen d_Ei0(const gen & args,GIAC_CONTEXT){ 10282 return (exp(args,contextptr)-1)/args; 10283 } 10284 define_partial_derivative_onearg_genop( D_at_Ei0," D_at_Ei0",&d_Ei0); taylor_Ei0(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)10285 static gen taylor_Ei0(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 10286 if (ordre<0) 10287 return 0; 10288 if (!is_zero(lim_point,contextptr)) 10289 return taylor(lim_point,ordre,f,0,shift_coeff,contextptr); 10290 shift_coeff=1; 10291 // sum( 1/(k)/(k)! * x^(k) ) 10292 gen tmp(1); 10293 vecteur v; 10294 for (int n=0;n<=ordre;){ 10295 n++; 10296 tmp=n*tmp; 10297 v.push_back(inv(n*tmp,contextptr)); 10298 } 10299 v.push_back(undef); 10300 return v; 10301 } _Ei0(const gen & args,GIAC_CONTEXT)10302 gen _Ei0(const gen & args,GIAC_CONTEXT){ 10303 if ( args.type==_STRNG && args.subtype==-1) return args; 10304 if (is_zero(args,contextptr)) 10305 return 0; 10306 if (is_undef(args)) 10307 return args; 10308 if (is_inf(args)) 10309 return minus_inf; 10310 if (args.type!=_DOUBLE_ && args.type!=_REAL && args.type!=_CPLX) 10311 return symbolic(at_Ei0,args); 10312 gen si,ci; 10313 if (!sici(args,si,ci,decimal_digits(contextptr),2,contextptr)) 10314 return gensizeerr(contextptr); 10315 return ci-evalf(cst_euler_gamma,1,contextptr)-ln(args,contextptr); 10316 } 10317 static const char _Ei0_s []="Ei0"; 10318 #ifdef GIAC_HAS_STO_38 10319 static define_unary_function_eval_taylor( __Ei0,&_Ei0,(size_t)&D_at_Ei0unary_function_ptr,&taylor_Ei0,_Ei0_s); 10320 #else 10321 static define_unary_function_eval_taylor( __Ei0,&_Ei0,D_at_Ei0,&taylor_Ei0,_Ei0_s); 10322 #endif 10323 define_unary_function_ptr5( at_Ei0 ,alias_at_Ei0,&__Ei0,0,true); /* FIXME should not registered */ 10324 10325 #if 1 10326 // l1:=log(x);l2:=log(l1);ws4:=l1-l2+l2/l1+l2*(-2+l2)/2l1^2+l2*(6-9l2+2l2^2)/6/l1^3+l2*(-12+36l2-22l2^2+3l2^3)/12/l1^4; 10327 // Ws=W(log(x))-ws4 ws4(const gen x,GIAC_CONTEXT)10328 static gen ws4(const gen x,GIAC_CONTEXT){ 10329 gen l1=ln(x,contextptr); 10330 gen l2=ln(l1,contextptr); 10331 return l1-l2+l2/l1+l2*(-2+l2)/2/l1/l1+l2*(6-9*l2+2*l2*l2)/6/l1/l1/l1+l2*(-12+36*l2-22*l2*l2+3*l2*l2*l2)/12/l1/l1/l1/l1; 10332 } taylor_LambertWs(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)10333 static gen taylor_LambertWs(const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 10334 if (ordre<0) 10335 return 0; 10336 if (!is_inf(lim_point)) 10337 return taylor(lim_point,ordre,f,0,shift_coeff,contextptr);//gensizeerr(contextptr); 10338 shift_coeff=5; 10339 if (ordre>5) return undef; 10340 return vecteur(1,0); 10341 } 10342 gen _LambertWs(const gen & g,GIAC_CONTEXT); d_LambertWs(const gen & args,GIAC_CONTEXT)10343 static gen d_LambertWs(const gen & args,GIAC_CONTEXT){ 10344 return derive(_LambertW(exp(args,contextptr),contextptr)-ws4(args,contextptr),args,contextptr); 10345 } 10346 define_partial_derivative_onearg_genop( D_at_LambertWs," D_at_LambertWs",&d_LambertWs); _LambertWs(const gen & g,GIAC_CONTEXT)10347 gen _LambertWs(const gen & g,GIAC_CONTEXT){ 10348 if ( g.type==_STRNG && g.subtype==-1) return g; 10349 if (is_inf(g)) 10350 return 0; 10351 return symbolic(at_LambertWs,g); 10352 } 10353 static const char _LambertWs_s []="LambertWs"; 10354 #ifdef GIAC_HAS_STO_38 10355 static define_unary_function_eval_taylor( __LambertWs,&_LambertWs,(size_t)&D_at_LambertWsunary_function_ptr,&taylor_LambertWs,_LambertWs_s); 10356 #else 10357 static define_unary_function_eval_taylor( __LambertWs,&_LambertWs,D_at_LambertWs,&taylor_LambertWs,_LambertWs_s); 10358 #endif 10359 define_unary_function_ptr5( at_LambertWs ,alias_at_LambertWs,&__LambertWs,0,true); 10360 LambertW_replace(const gen & g,GIAC_CONTEXT)10361 static gen LambertW_replace(const gen & g,GIAC_CONTEXT){ 10362 return symbolic(at_LambertWs,ln(g,contextptr))+ws4(g,contextptr); 10363 } taylor_LambertW(const gen & lim_point,const int ordre,const unary_function_ptr & f,int direction,gen & shift_coeff,GIAC_CONTEXT)10364 static gen taylor_LambertW (const gen & lim_point,const int ordre,const unary_function_ptr & f, int direction,gen & shift_coeff,GIAC_CONTEXT){ 10365 if (ordre<0){ 10366 return 0; // statically handled now 10367 } 10368 if (lim_point==0){ 10369 // sum((-n)^(n-1)/n!*x^n,n,1,inf) 10370 shift_coeff=1; 10371 gen fact=1; 10372 vecteur v; 10373 for (int i=1;i<=ordre;++i){ 10374 fact=gen(i)*fact; 10375 v.push_back(pow(-i,i-1,contextptr)/fact); 10376 } 10377 return v; 10378 } 10379 if (!is_inf(lim_point)) 10380 return taylor(lim_point,ordre,f,0,shift_coeff,contextptr);//gensizeerr(contextptr); 10381 shift_coeff=0; return undef; 10382 } d_LambertW(const gen & args,GIAC_CONTEXT)10383 static gen d_LambertW(const gen & args,GIAC_CONTEXT){ 10384 // W/z/(1+W) or 1/(z+exp(W)) 10385 if (args==0) return 1; 10386 gen w=_LambertW(args,contextptr); 10387 // return inv(args+exp(w,contextptr),contextptr); 10388 return w/args/(1+w); 10389 } 10390 define_partial_derivative_onearg_genop( D_at_LambertW," D_at_LambertW",&d_LambertW); _LambertW(const gen & args,GIAC_CONTEXT)10391 gen _LambertW(const gen & args,GIAC_CONTEXT){ 10392 if (args.type==_VECT && args._VECTptr->size()==2){ 10393 gen x=args._VECTptr->front(),n=args._VECTptr->back(); 10394 if (n.type==_REAL) 10395 n=_floor(n,contextptr); 10396 if (!is_integral(n)) 10397 return gensizeerr(contextptr); 10398 if (x==0 && n!=0) 10399 return minus_inf; 10400 if (x.type==_DOUBLE_) 10401 return LambertW(complex<double>(x._DOUBLE_val,0),n.val); 10402 if (x.type==_CPLX && args.subtype==3) 10403 return LambertW(complex<double>(x._CPLXptr->_DOUBLE_val,(x._CPLXptr+1)->_DOUBLE_val),n.val); 10404 #ifdef HAVE_LIBMPFR 10405 if (x.type==_REAL || (x.type==_CPLX && x._CPLXptr->type==_REAL)) 10406 return LambertW(x,n.val); 10407 #endif 10408 } 10409 if (args.type==_DOUBLE_) return LambertW(args._DOUBLE_val); 10410 if (args.type==_CPLX && args.subtype==3) 10411 return LambertW(complex<double>(args._CPLXptr->_DOUBLE_val,(args._CPLXptr+1)->_DOUBLE_val)); 10412 #ifdef HAVE_LIBMPFR 10413 if (args.type==_REAL || (args.type==_CPLX && args._CPLXptr->type==_REAL)) 10414 return LambertW(args,0); 10415 #endif 10416 if (args==0 || args==plus_inf) return args; 10417 if (args==symbolic(at_exp,1)) return 1; 10418 if (args==2*symb_ln(2) || args==symb_ln(4)) return symb_ln(2); 10419 if (-inv(args,contextptr)==symbolic(at_exp,1)) return -1; 10420 return symbolic(at_LambertW,args); 10421 } 10422 static const char _LambertW_s []="LambertW"; 10423 #ifdef GIAC_HAS_STO_38 10424 define_unary_function_eval_taylor (__LambertW,&_LambertW,(size_t)&D_at_LambertWunary_function_ptr,&taylor_LambertW,_LambertW_s); 10425 #else 10426 define_unary_function_eval_taylor (__LambertW,&_LambertW,D_at_LambertW,&taylor_LambertW,_LambertW_s); 10427 #endif 10428 define_unary_function_ptr5( at_LambertW ,alias_at_LambertW,&__LambertW,0,true); 10429 #endif 10430 _Dirac(const gen & args,GIAC_CONTEXT)10431 gen _Dirac(const gen & args,GIAC_CONTEXT){ 10432 if ( args.type==_STRNG && args.subtype==-1) return args; 10433 if (args.type==_VECT && args.subtype!=_SEQ__VECT) 10434 return apply(args,_Dirac,contextptr); 10435 gen f=args; 10436 if (args.type==_VECT && args.subtype==_SEQ__VECT && !args._VECTptr->empty()) 10437 f=args._VECTptr->front(); 10438 if (is_zero(f,contextptr)) 10439 return unsigned_inf; 10440 if (f.type<_IDNT) 10441 return 0; 10442 return symbolic(at_Dirac,args); 10443 } d_Dirac(const gen & args,GIAC_CONTEXT)10444 static gen d_Dirac(const gen & args,GIAC_CONTEXT){ 10445 vecteur v(gen2vecteur(args)); 10446 if (v.size()==1) 10447 v.push_back(0); 10448 if (v.size()!=2 || v.back().type!=_INT_) 10449 return gendimerr(contextptr); 10450 return _Dirac(gen(makevecteur(v.front(),v.back().val+1),_SEQ__VECT),contextptr); 10451 } 10452 define_partial_derivative_onearg_genop( D_at_Dirac," D_at_Dirac",&d_Dirac); 10453 static const char _Dirac_s []="Dirac"; 10454 #ifdef GIAC_HAS_STO_38 10455 static define_unary_function_eval3 (__Dirac,&_Dirac,(size_t)&D_at_Diracunary_function_ptr,_Dirac_s); 10456 #else 10457 static define_unary_function_eval3 (__Dirac,&_Dirac,D_at_Dirac,_Dirac_s); 10458 #endif 10459 define_unary_function_ptr5( at_Dirac ,alias_at_Dirac,&__Dirac,0,true); 10460 define_partial_derivative_onearg_genop( D_Heaviside," D_Heaviside",&_Dirac); 10461 _Heaviside(const gen & args,GIAC_CONTEXT)10462 gen _Heaviside(const gen & args,GIAC_CONTEXT){ 10463 if ( args.type==_STRNG && args.subtype==-1) return args; 10464 if (args.type==_VECT) 10465 return apply(args,_Heaviside,contextptr); 10466 if (is_zero(args,contextptr)) 10467 return plus_one; 10468 gen tmp=_sign(args,contextptr); 10469 if (tmp.type<=_DOUBLE_) 10470 return (tmp+1)/2; 10471 return symbolic(at_Heaviside,args); 10472 } 10473 static const char _Heaviside_s []="Heaviside"; 10474 #ifdef GIAC_HAS_STO_38 10475 static define_unary_function_eval3 (__Heaviside,&_Heaviside,(size_t)&D_Heavisideunary_function_ptr,_Heaviside_s); 10476 #else 10477 static define_unary_function_eval3 (__Heaviside,&_Heaviside,D_Heaviside,_Heaviside_s); 10478 #endif 10479 define_unary_function_ptr5( at_Heaviside ,alias_at_Heaviside,&__Heaviside,0,true); 10480 10481 const char _sum_s []="sum"; 10482 static define_unary_function_eval_quoted (__sum,&_sum,_sum_s); 10483 define_unary_function_ptr5( at_sum ,alias_at_sum,&__sum,_QUOTE_ARGUMENTS,true); 10484 fast_icontent(const gen & g)10485 gen fast_icontent(const gen & g){ 10486 if (g.type==_VECT){ 10487 gen G(0); 10488 const_iterateur it=g._VECTptr->begin(),itend=g._VECTptr->end(); 10489 for (;it!=itend;++it){ 10490 if (it->type==_REAL || it->type==_DOUBLE_ || (it->type==_CPLX && it->subtype==3) || it->type==_FLOAT_) return 1; 10491 G=gcd(G,fast_icontent(*it),context0); 10492 } 10493 return G; 10494 } 10495 if (g.type!=_SYMB) 10496 return (g.type==_FRAC || (is_integer(g) && g!=0))?abs(g,context0):1; 10497 if (g._SYMBptr->sommet==at_plus || g._SYMBptr->sommet==at_neg) 10498 return fast_icontent(g._SYMBptr->feuille); 10499 if (g._SYMBptr->sommet==at_inv) 10500 return inv(fast_icontent(g._SYMBptr->feuille),context0); 10501 if (g._SYMBptr->sommet==at_prod){ 10502 gen G(1); 10503 const_iterateur it=g._SYMBptr->feuille._VECTptr->begin(),itend=g._SYMBptr->feuille._VECTptr->end(); 10504 for (;it!=itend;++it){ 10505 G=G*fast_icontent(*it); 10506 } 10507 return G; 10508 } 10509 if (g._SYMBptr->sommet==at_pow){ 10510 if (is_integer(g._SYMBptr->feuille[1])) 10511 return pow(fast_icontent(g._SYMBptr->feuille[0]),g._SYMBptr->feuille[1],context0); 10512 } 10513 return 1; 10514 } 10515 fast_divide_by_icontent(const gen & g,const gen & z)10516 gen fast_divide_by_icontent(const gen & g,const gen & z){ 10517 if (g.is_symb_of_sommet(at_inv) && is_integer(g._SYMBptr->feuille)) 10518 return inv(g._SYMBptr->feuille*z,context0); 10519 if (z==1) 10520 return g; 10521 if (g.type==_VECT){ 10522 vecteur v(*g._VECTptr); 10523 iterateur it=v.begin(),itend=v.end(); 10524 for (;it!=itend;++it){ 10525 *it=fast_divide_by_icontent(*it,z); 10526 } 10527 return gen(v,g.subtype); 10528 } 10529 if (g.type!=_SYMB) 10530 return g/z; 10531 if (g._SYMBptr->sommet==at_plus || g._SYMBptr->sommet==at_neg) 10532 return symbolic(g._SYMBptr->sommet,fast_divide_by_icontent(g._SYMBptr->feuille,z)); 10533 if (g._SYMBptr->sommet==at_inv) 10534 return symbolic(g._SYMBptr->sommet,fast_divide_by_icontent(g._SYMBptr->feuille,inv(z,context0))); 10535 if (g._SYMBptr->sommet==at_pow && is_integer(g._SYMBptr->feuille[1])){ 10536 gen z1=fast_icontent(g._SYMBptr->feuille[0]); 10537 gen g1=fast_divide_by_icontent(g._SYMBptr->feuille[0],z1); 10538 return pow(z1,g._SYMBptr->feuille[1],context0)/z*pow(g1,g._SYMBptr->feuille[1],context0); 10539 } 10540 if (g._SYMBptr->sommet==at_prod && g._SYMBptr->feuille.type==_VECT){ 10541 vecteur v(*g._SYMBptr->feuille._VECTptr); 10542 iterateur it=v.begin(),itend=v.end(); 10543 gen zz(z),z2; 10544 for (;it!=itend;++it){ 10545 z2=gcd(fast_icontent(*it),zz,context0); 10546 *it=fast_divide_by_icontent(*it,z2); 10547 zz=zz/z2; 10548 } 10549 return _prod(v,context0)/zz; 10550 } 10551 return g/z; 10552 } 10553 10554 // vector<unary_function_ptr > solve_fcns_v(solve_fcns,solve_fcns+sizeof(solve_fcns)/sizeof(unary_function_ptr)); 10555 10556 // #ifndef GNUWINCE 10557 // #ifndef WIN32 10558 // #endif 10559 #if defined(GIAC_GENERIC_CONSTANTS) // || (defined(VISUALC) && !defined(RTOS_THREADX)) || defined( x86_64) 10560 const gen zero(0); 10561 const gen plus_one(1); 10562 const gen plus_two(2); 10563 const gen plus_three(3); 10564 const gen minus_one(-1); 10565 const gen cst_i(0,1); 10566 #else 10567 const define_alias_gen(alias_zero,_INT_,0,0); 10568 const define_alias_gen(alias_plus_one,_INT_,0,1); 10569 const gen & zero = *(const gen *) & alias_zero; 10570 const gen & plus_one = *(const gen *) & alias_plus_one; 10571 define_alias_ref_complex(cst_i_ref,_INT_,0,0,_INT_,0,1); 10572 const define_alias_gen(alias_cst_i,_CPLX,0,&cst_i_ref); 10573 const gen & cst_i = *(const gen *) & alias_cst_i; 10574 10575 const define_alias_gen(alias_minus_one,_INT_,0,-1); 10576 const gen & minus_one = *(const gen *) & alias_minus_one; 10577 const define_alias_gen(alias_plus_two,_INT_,0,2); 10578 const gen & plus_two = *(const gen *) & alias_plus_two; 10579 const define_alias_gen(alias_plus_three,_INT_,0,3); 10580 const gen & plus_three = *(const gen *) & alias_plus_three; 10581 #endif 10582 10583 //grad 10584 const double rad2deg_d(180/M_PI); 10585 const double deg2rad_d(M_PI/180); 10586 const double rad2grad_d(200 / M_PI); 10587 const double grad2rad_d(M_PI / 200); 10588 #if defined(DOUBLEVAL) || defined(GIAC_GENERIC_CONSTANTS) || defined(VISUALC) || defined(x86_64) 10589 static const gen rad2deg_g_(rad2deg_d); 10590 const gen & rad2deg_g=rad2deg_g_; 10591 static const gen deg2rad_g_(deg2rad_d); 10592 const gen & deg2rad_g=deg2rad_g_; 10593 //grad 10594 static const gen rad2grad_g_(rad2grad_d); 10595 const gen & rad2grad_g = rad2grad_g_; 10596 static const gen grad2rad_g_(grad2rad_d); 10597 const gen & grad2rad_g=grad2rad_g_; 10598 #else 10599 // Warning this does not work on ia64 with -O2 10600 const define_alias_gen(alias_rad2deg_g,_DOUBLE_, (*(ulonglong *)&rad2deg_d) >> 8,(*(ulonglong *)&rad2deg_d)>>16); 10601 const gen & rad2deg_g = *(const gen*) & alias_rad2deg_g; 10602 const define_alias_gen(alias_deg2rad_g,_DOUBLE_, (*(ulonglong *)°2rad_d) >> 8,(*(ulonglong *)°2rad_d)>>16); 10603 const gen & deg2rad_g = *(const gen*) & alias_deg2rad_g; 10604 //grad 10605 const define_alias_gen(alias_rad2grad_g,_DOUBLE_, (*(ulonglong *)&rad2grad_d) >> 8,(*(ulonglong *)&rad2grad_d)>>16); 10606 const gen & rad2grad_g = *(const gen*) & alias_rad2grad_g; 10607 const define_alias_gen(alias_grad2rad_g, _DOUBLE_, (*(ulonglong *)&grad2rad_d) >> 8, (*(ulonglong *)&grad2rad_d) >> 16); 10608 const gen & grad2rad_g = *(const gen*)& alias_grad2rad_g; 10609 #endif 10610 10611 #if defined(GIAC_GENERIC_CONSTANTS) // || (defined(VISUALC) && !defined(RTOS_THREADX)) || defined(x86_64) 10612 gen cst_two_pi(symbolic(at_prod,makevecteur(plus_two,_IDNT_pi()))); 10613 gen cst_pi_over_2(_FRAC2_SYMB(_IDNT_pi(),2)); 10614 gen plus_inf(symbolic(at_plus,_IDNT_infinity())); 10615 gen minus_inf(symbolic(at_neg,_IDNT_infinity())); 10616 gen plus_one_half(fraction(1,2)); 10617 gen minus_one_half(symbolic(at_neg,symb_inv(2))); 10618 gen plus_sqrt3(symbolic(at_pow,gen(makevecteur(3,plus_one_half),_SEQ__VECT))); 10619 gen plus_sqrt2(symbolic(at_pow,gen(makevecteur(2,plus_one_half),_SEQ__VECT))); 10620 gen plus_sqrt6(symbolic(at_pow,gen(makevecteur(6,plus_one_half),_SEQ__VECT))); 10621 gen minus_sqrt6(symbolic(at_neg,plus_sqrt6)); 10622 gen minus_sqrt3(symbolic(at_neg,plus_sqrt3)); 10623 gen minus_sqrt2(symbolic(at_neg,plus_sqrt2)); 10624 gen minus_sqrt3_2(_FRAC2_SYMB(minus_sqrt3,2)); 10625 gen minus_sqrt2_2(_FRAC2_SYMB(minus_sqrt2,2)); 10626 gen minus_sqrt3_3(_FRAC2_SYMB(minus_sqrt3,3)); 10627 gen plus_sqrt3_2(_FRAC2_SYMB(plus_sqrt3,2)); 10628 gen plus_sqrt2_2(_FRAC2_SYMB(plus_sqrt2,2)); 10629 gen plus_sqrt3_3(_FRAC2_SYMB(plus_sqrt3,3)); 10630 gen cos_pi_12(_FRAC2_SYMB( 10631 symbolic(at_plus,gen(makevecteur(plus_sqrt6,plus_sqrt2),_SEQ__VECT)), 10632 4)); 10633 gen minus_cos_pi_12(_FRAC2_SYMB( 10634 symbolic(at_plus,gen(makevecteur(minus_sqrt6,minus_sqrt2),_SEQ__VECT)), 10635 4)); 10636 gen sin_pi_12(_FRAC2_SYMB( 10637 symbolic(at_plus,gen(makevecteur(plus_sqrt6,minus_sqrt2),_SEQ__VECT)), 10638 4)); 10639 gen minus_sin_pi_12(_FRAC2_SYMB( 10640 symbolic(at_plus,gen(makevecteur(plus_sqrt2,minus_sqrt6),_SEQ__VECT)), 10641 4)); 10642 gen tan_pi_12(symbolic(at_plus,gen(makevecteur(2,minus_sqrt3),_SEQ__VECT))); 10643 gen tan_5pi_12(symbolic(at_plus,gen(makevecteur(2,plus_sqrt3),_SEQ__VECT))); 10644 gen minus_tan_pi_12(symbolic(at_neg,tan_pi_12)); 10645 gen minus_tan_5pi_12(symbolic(at_neg,tan_5pi_12)); 10646 gen rad2deg_e(_FRAC2_SYMB(180,_IDNT_pi())); 10647 gen deg2rad_e(_FRAC2_SYMB(_IDNT_pi(),180)); 10648 //grad 10649 gen rad2grad_e(_FRAC2_SYMB(200,_IDNT_pi())); 10650 gen grad2rad_e(_FRAC2_SYMB(_IDNT_pi(),200)); 10651 10652 // 0 = -pi, 12=0, 24=pi 10653 const gen * const table_cos[trig_deno+1]={ 10654 &minus_one,&minus_cos_pi_12,&minus_sqrt3_2,&minus_sqrt2_2,&minus_one_half,&minus_sin_pi_12, 10655 &zero,&sin_pi_12,&plus_one_half,&plus_sqrt2_2,&plus_sqrt3_2,&cos_pi_12, 10656 &plus_one,&cos_pi_12,&plus_sqrt3_2,&plus_sqrt2_2,&plus_one_half,&sin_pi_12, 10657 &zero,&minus_sin_pi_12,&minus_one_half,&minus_sqrt2_2,&minus_sqrt3_2,&minus_cos_pi_12, 10658 &minus_one 10659 }; 10660 const gen * const table_tan[trig_deno/2+1]={ 10661 &zero,&tan_pi_12,&plus_sqrt3_3,&plus_one,&plus_sqrt3,&tan_5pi_12, 10662 &unsigned_inf,&minus_tan_5pi_12,&minus_sqrt3,&minus_one,&minus_sqrt3_3,&minus_tan_pi_12, 10663 &zero 10664 }; 10665 10666 10667 #else 10668 const define_alias_gen(alias_plus_four,_INT_,0,4); 10669 const gen & gen_plus_four = *(const gen *)&alias_plus_four; 10670 const define_alias_gen(alias_plus_six,_INT_,0,6); 10671 const gen & gen_plus_six = *(const gen *)&alias_plus_six; 10672 const define_alias_gen(alias_180,_INT_,0,180); 10673 const gen & gen_180 = *(const gen *)&alias_180; 10674 10675 const define_tab2_alias_gen(alias_cst_two_pi_tab,_INT_,0,2,_IDNT,0,&ref_pi); 10676 const define_alias_ref_vecteur2(cst_two_pi_refv,alias_cst_two_pi_tab); 10677 10678 // static const define_alias_gen(cst_two_pi_V,_VECT,_SEQ__VECT,&cst_two_pi_refv); 10679 const define_alias_ref_symbolic( cst_two_pi_symb ,alias_at_prod,_VECT,_SEQ__VECT,&cst_two_pi_refv); 10680 const define_alias_gen(alias_cst_two_pi,_SYMB,0,&cst_two_pi_symb); 10681 const gen & cst_two_pi = *(const gen *)&alias_cst_two_pi; 10682 10683 const define_alias_ref_symbolic( inv_2_symb,alias_at_inv,_INT_,0,2); 10684 const define_alias_gen(alias_inv_2,_SYMB,0,&inv_2_symb); 10685 const gen & gen_inv_2 = *(const gen *)&alias_inv_2; 10686 10687 const define_alias_ref_symbolic( inv_3_symb,alias_at_inv,_INT_,0,3) 10688 const define_alias_gen(alias_inv_3,_SYMB,0,&inv_3_symb); 10689 const gen & gen_inv_3 = *(const gen *)&alias_inv_3; 10690 10691 const define_alias_ref_symbolic( inv_4_symb,alias_at_inv,_INT_,0,4) 10692 const define_alias_gen(alias_inv_4,_SYMB,0,&inv_4_symb); 10693 const gen & gen_inv_4 = *(const gen *)&alias_inv_4; 10694 10695 const define_tab2_alias_gen(alias_cst_pi_over_2_tab,_IDNT,0,&ref_pi,_SYMB,0,&inv_2_symb); 10696 const define_alias_ref_vecteur2(cst_pi_over_2_refv,alias_cst_pi_over_2_tab); 10697 10698 const define_alias_ref_symbolic( cst_pi_over_2_symb ,alias_at_prod,_VECT,_SEQ__VECT,&cst_pi_over_2_refv); 10699 const define_alias_gen(alias_cst_pi_over_2,_SYMB,0,&cst_pi_over_2_symb); 10700 const gen & cst_pi_over_2 = *(const gen *)&alias_cst_pi_over_2; 10701 10702 const define_alias_ref_symbolic( plus_inf_symb ,alias_at_plus,_IDNT,0,&ref_infinity); 10703 const define_alias_gen(alias_plus_inf,_SYMB,0,&plus_inf_symb); 10704 const gen & plus_inf = *(const gen *)&alias_plus_inf; 10705 const define_alias_ref_symbolic( minus_inf_symb ,alias_at_neg,_IDNT,0,&ref_infinity); 10706 const define_alias_gen(alias_minus_inf,_SYMB,0,&minus_inf_symb); 10707 const gen & minus_inf = *(const gen *)&alias_minus_inf; 10708 10709 const define_alias_ref_fraction(plus_one_half_ref,_INT_,0,1,_INT_,0,2); 10710 const define_alias_gen(alias_plus_one_half,_FRAC,0,&plus_one_half_ref); 10711 const gen & plus_one_half = *(const gen *)&alias_plus_one_half; 10712 const define_alias_ref_symbolic( minus_one_half_symb ,alias_at_neg,_SYMB,0,&inv_2_symb); 10713 const define_alias_gen(alias_minus_one_half,_SYMB,0,&minus_one_half_symb); 10714 const gen & minus_one_half = *(const gen *)&alias_minus_one_half; 10715 10716 const define_tab2_alias_gen(alias_plus_sqrt3_tab,_INT_,0,3,_FRAC,0,&plus_one_half_ref); 10717 const define_alias_ref_vecteur2(plus_sqrt3_refv,alias_plus_sqrt3_tab); 10718 10719 const define_alias_ref_symbolic( plus_sqrt3_symb ,alias_at_pow,_VECT,_SEQ__VECT,&plus_sqrt3_refv); 10720 const define_alias_gen(alias_plus_sqrt3,_SYMB,0,&plus_sqrt3_symb); 10721 const gen & plus_sqrt3 = *(const gen *)&alias_plus_sqrt3; 10722 10723 const define_tab2_alias_gen(alias_plus_sqrt2_tab,_INT_,0,2,_FRAC,0,&plus_one_half_ref); 10724 const define_alias_ref_vecteur2(plus_sqrt2_refv,alias_plus_sqrt2_tab); 10725 const define_alias_ref_symbolic( plus_sqrt2_symb ,alias_at_pow,_VECT,_SEQ__VECT,&plus_sqrt2_refv); 10726 const define_alias_gen(alias_plus_sqrt2,_SYMB,0,&plus_sqrt2_symb); 10727 const gen & plus_sqrt2 = *(const gen *)&alias_plus_sqrt2; 10728 10729 const define_tab2_alias_gen(alias_plus_sqrt6_tab,_INT_,0,6,_FRAC,0,&plus_one_half_ref); 10730 const define_alias_ref_vecteur2(plus_sqrt6_refv,alias_plus_sqrt6_tab); 10731 const define_alias_ref_symbolic( plus_sqrt6_symb ,alias_at_pow,_VECT,_SEQ__VECT,&plus_sqrt6_refv); 10732 const define_alias_gen(alias_plus_sqrt6,_SYMB,0,&plus_sqrt6_symb); 10733 const gen & plus_sqrt6 = *(const gen *)&alias_plus_sqrt6; 10734 10735 const define_alias_ref_symbolic( minus_sqrt2_symb ,alias_at_neg,_SYMB,0,&plus_sqrt2_symb); 10736 const define_alias_gen(alias_minus_sqrt2,_SYMB,0,&minus_sqrt2_symb); 10737 const gen & minus_sqrt2 = *(const gen *)&alias_minus_sqrt2; 10738 10739 const define_alias_ref_symbolic( minus_sqrt3_symb ,alias_at_neg,_SYMB,0,&plus_sqrt3_symb); 10740 const define_alias_gen(alias_minus_sqrt3,_SYMB,0,&minus_sqrt3_symb); 10741 const gen & minus_sqrt3 = *(const gen *)&alias_minus_sqrt3; 10742 10743 const define_alias_ref_symbolic( minus_sqrt6_symb ,alias_at_neg,_SYMB,0,&plus_sqrt6_symb); 10744 const define_alias_gen(alias_minus_sqrt6,_SYMB,0,&minus_sqrt6_symb); 10745 const gen & minus_sqrt6 = *(const gen *)&alias_minus_sqrt6; 10746 10747 const define_tab2_alias_gen(alias_minus_sqrt3_2_tab,_SYMB,0,&minus_sqrt3_symb,_SYMB,0,&inv_2_symb); 10748 const define_alias_ref_vecteur2(minus_sqrt3_2_refv,alias_minus_sqrt3_2_tab); 10749 const define_alias_ref_symbolic( minus_sqrt3_2_symb ,alias_at_prod,_VECT,_SEQ__VECT,&minus_sqrt3_2_refv); 10750 const define_alias_gen(alias_minus_sqrt3_2,_SYMB,0,&minus_sqrt3_2_symb); 10751 const gen & minus_sqrt3_2 = *(const gen *)&alias_minus_sqrt3_2; 10752 10753 const define_tab2_alias_gen(alias_minus_sqrt2_2_tab,_SYMB,0,&minus_sqrt2_symb,_SYMB,0,&inv_2_symb); 10754 const define_alias_ref_vecteur2(minus_sqrt2_2_refv,alias_minus_sqrt2_2_tab); 10755 const define_alias_ref_symbolic( minus_sqrt2_2_symb ,alias_at_prod,_VECT,_SEQ__VECT,&minus_sqrt2_2_refv); 10756 const define_alias_gen(alias_minus_sqrt2_2,_SYMB,0,&minus_sqrt2_2_symb); 10757 const gen & minus_sqrt2_2 = *(const gen *)&alias_minus_sqrt2_2; 10758 10759 const define_tab2_alias_gen(alias_minus_sqrt3_3_tab,_SYMB,0,&minus_sqrt3_symb,_SYMB,0,&inv_3_symb); 10760 const define_alias_ref_vecteur2(minus_sqrt3_3_refv,alias_minus_sqrt3_3_tab); 10761 const define_alias_ref_symbolic( minus_sqrt3_3_symb ,alias_at_prod,_VECT,_SEQ__VECT,&minus_sqrt3_3_refv); 10762 const define_alias_gen(alias_minus_sqrt3_3,_SYMB,0,&minus_sqrt3_3_symb); 10763 const gen & minus_sqrt3_3 = *(const gen *)&alias_minus_sqrt3_3; 10764 10765 const define_tab2_alias_gen(alias_plus_sqrt3_2_tab,_SYMB,0,&plus_sqrt3_symb,_SYMB,0,&inv_2_symb); 10766 const define_alias_ref_vecteur2(plus_sqrt3_2_refv,alias_plus_sqrt3_2_tab); 10767 const define_alias_ref_symbolic( plus_sqrt3_2_symb ,alias_at_prod,_VECT,_SEQ__VECT,&plus_sqrt3_2_refv); 10768 const define_alias_gen(alias_plus_sqrt3_2,_SYMB,0,&plus_sqrt3_2_symb); 10769 const gen & plus_sqrt3_2 = *(const gen *)&alias_plus_sqrt3_2; 10770 10771 const define_tab2_alias_gen(alias_plus_sqrt2_2_tab,_SYMB,0,&plus_sqrt2_symb,_SYMB,0,&inv_2_symb); 10772 const define_alias_ref_vecteur2(plus_sqrt2_2_refv,alias_plus_sqrt2_2_tab); 10773 const define_alias_ref_symbolic( plus_sqrt2_2_symb ,alias_at_prod,_VECT,_SEQ__VECT,&plus_sqrt2_2_refv); 10774 const define_alias_gen(alias_plus_sqrt2_2,_SYMB,0,&plus_sqrt2_2_symb); 10775 const gen & plus_sqrt2_2 = *(const gen *)&alias_plus_sqrt2_2; 10776 10777 const define_tab2_alias_gen(alias_plus_sqrt3_3_tab,_SYMB,0,&plus_sqrt3_symb,_SYMB,0,&inv_3_symb); 10778 const define_alias_ref_vecteur2(plus_sqrt3_3_refv,alias_plus_sqrt3_3_tab); 10779 const define_alias_ref_symbolic( plus_sqrt3_3_symb ,alias_at_prod,_VECT,_SEQ__VECT,&plus_sqrt3_3_refv); 10780 const define_alias_gen(alias_plus_sqrt3_3,_SYMB,0,&plus_sqrt3_3_symb); 10781 const gen & plus_sqrt3_3 = *(const gen *)&alias_plus_sqrt3_3; 10782 10783 const define_tab2_alias_gen(alias_cos_pi_12_4_tab,_SYMB,0,&plus_sqrt6_symb,_SYMB,0,&plus_sqrt2_symb); 10784 const define_alias_ref_vecteur2(cos_pi_12_4_refv,alias_cos_pi_12_4_tab); 10785 const define_alias_ref_symbolic( cos_pi_12_4_symb ,alias_at_plus,_VECT,_SEQ__VECT,&cos_pi_12_4_refv); 10786 10787 const define_tab2_alias_gen(alias_cos_pi_12_tab,_SYMB,0,&cos_pi_12_4_symb,_SYMB,0,&inv_4_symb); 10788 const define_alias_ref_vecteur2(cos_pi_12_refv,alias_cos_pi_12_tab); 10789 const define_alias_ref_symbolic( cos_pi_12_symb ,alias_at_prod,_VECT,_SEQ__VECT,&cos_pi_12_refv); 10790 const define_alias_gen(alias_cos_pi_12,_SYMB,0,&cos_pi_12_symb); 10791 const gen & cos_pi_12 = *(const gen *)&alias_cos_pi_12; 10792 10793 const define_tab2_alias_gen(alias_minus_cos_pi_12_4_tab,_SYMB,0,&minus_sqrt6_symb,_SYMB,0,&minus_sqrt2_symb); 10794 const define_alias_ref_vecteur2(minus_cos_pi_12_4_refv,alias_minus_cos_pi_12_4_tab); 10795 const define_alias_ref_symbolic( minus_cos_pi_12_4_symb ,alias_at_plus,_VECT,_SEQ__VECT,&minus_cos_pi_12_4_refv); 10796 const define_tab2_alias_gen(alias_minus_cos_pi_12_tab,_SYMB,0,&minus_cos_pi_12_4_symb,_SYMB,0,&inv_4_symb); 10797 const define_alias_ref_vecteur2(minus_cos_pi_12_refv,alias_minus_cos_pi_12_tab); 10798 const define_alias_ref_symbolic( minus_cos_pi_12_symb ,alias_at_prod,_VECT,_SEQ__VECT,&minus_cos_pi_12_refv); 10799 const define_alias_gen(alias_minus_cos_pi_12,_SYMB,0,&minus_cos_pi_12_symb); 10800 const gen & minus_cos_pi_12 = *(const gen *)&alias_minus_cos_pi_12; 10801 10802 const define_tab2_alias_gen(alias_sin_pi_12_4_tab,_SYMB,0,&plus_sqrt6_symb,_SYMB,0,&minus_sqrt2_symb); 10803 const define_alias_ref_vecteur2(sin_pi_12_4_refv,alias_sin_pi_12_4_tab); 10804 const define_alias_ref_symbolic( sin_pi_12_4_symb ,alias_at_plus,_VECT,_SEQ__VECT,&sin_pi_12_4_refv); 10805 const define_tab2_alias_gen(alias_sin_pi_12_tab,_SYMB,0,&sin_pi_12_4_symb,_SYMB,0,&inv_4_symb); 10806 const define_alias_ref_vecteur2(sin_pi_12_refv,alias_sin_pi_12_tab); 10807 const define_alias_ref_symbolic( sin_pi_12_symb ,alias_at_prod,_VECT,_SEQ__VECT,&sin_pi_12_refv); 10808 const define_alias_gen(alias_sin_pi_12,_SYMB,0,&sin_pi_12_symb); 10809 const gen & sin_pi_12 = *(const gen *)&alias_sin_pi_12; 10810 10811 const define_tab2_alias_gen(alias_minus_sin_pi_12_4_tab,_SYMB,0,&plus_sqrt2_symb,_SYMB,0,&minus_sqrt6_symb); 10812 const define_alias_ref_vecteur2(minus_sin_pi_12_4_refv,alias_minus_sin_pi_12_4_tab); 10813 const define_alias_ref_symbolic( minus_sin_pi_12_4_symb ,alias_at_plus,_VECT,_SEQ__VECT,&minus_sin_pi_12_4_refv); 10814 const define_tab2_alias_gen(alias_minus_sin_pi_12_tab,_SYMB,0,&minus_sin_pi_12_4_symb,_SYMB,0,&inv_4_symb); 10815 const define_alias_ref_vecteur2(minus_sin_pi_12_refv,alias_minus_sin_pi_12_tab); 10816 const define_alias_ref_symbolic( minus_sin_pi_12_symb ,alias_at_prod,_VECT,_SEQ__VECT,&minus_sin_pi_12_refv); 10817 const define_alias_gen(alias_minus_sin_pi_12,_SYMB,0,&minus_sin_pi_12_symb); 10818 const gen & minus_sin_pi_12 = *(const gen *)&alias_minus_sin_pi_12; 10819 10820 const define_tab2_alias_gen(alias_tan_pi_12_tab,_INT_,0,2,_SYMB,0,&minus_sqrt3_symb); 10821 const define_alias_ref_vecteur2(tan_pi_12_refv,alias_tan_pi_12_tab); 10822 const define_alias_ref_symbolic( tan_pi_12_symb ,alias_at_plus,_VECT,_SEQ__VECT,&tan_pi_12_refv); 10823 const define_alias_gen(alias_tan_pi_12,_SYMB,0,&tan_pi_12_symb); 10824 const gen & tan_pi_12 = *(const gen *)&alias_tan_pi_12; 10825 10826 const define_tab2_alias_gen(alias_tan_5pi_12_tab,_INT_,0,2,_SYMB,0,&plus_sqrt3_symb); 10827 const define_alias_ref_vecteur2(tan_5pi_12_refv,alias_tan_5pi_12_tab); 10828 const define_alias_ref_symbolic( tan_5pi_12_symb ,alias_at_plus,_VECT,_SEQ__VECT,&tan_5pi_12_refv); 10829 const define_alias_gen(alias_tan_5pi_12,_SYMB,0,&tan_5pi_12_symb); 10830 const gen & tan_5pi_12 = *(const gen *)&alias_tan_5pi_12; 10831 10832 const define_alias_ref_symbolic( minus_tan_pi_12_symb ,alias_at_neg,_SYMB,0,&tan_pi_12_symb); 10833 const define_alias_gen(alias_minus_tan_pi_12,_SYMB,0,&minus_tan_pi_12_symb); 10834 const gen & minus_tan_pi_12 = *(const gen *)&alias_minus_tan_pi_12; 10835 10836 const define_alias_ref_symbolic( minus_tan_5pi_12_symb ,alias_at_neg,_SYMB,0,&tan_5pi_12_symb); 10837 const define_alias_gen(alias_minus_tan_5pi_12,_SYMB,0,&minus_tan_5pi_12_symb); 10838 const gen & minus_tan_5pi_12 = *(const gen *)&alias_minus_tan_5pi_12; 10839 10840 const define_alias_ref_symbolic( inv_pi_symb,alias_at_inv,_IDNT,0,&ref_pi); 10841 const define_alias_gen(alias_inv_pi,_SYMB,0,&inv_pi_symb); 10842 const gen & cst_inv_pi = * (const gen *) &alias_inv_pi; 10843 10844 const define_alias_ref_symbolic( inv_180_symb,alias_at_inv,_INT_,0,180); 10845 const define_alias_gen(alias_inv_180,_SYMB,0,&inv_180_symb); 10846 const gen & cst_inv_180 = * (const gen *) &alias_inv_180; 10847 10848 const define_tab2_alias_gen(alias_rad2deg_e_tab,_INT_,0,180,_SYMB,0,&inv_pi_symb); 10849 const define_alias_ref_vecteur2(rad2deg_e_refv,alias_rad2deg_e_tab); 10850 const define_alias_ref_symbolic( rad2deg_e_symb ,(size_t)&_prod,_VECT,_SEQ__VECT,&rad2deg_e_refv); 10851 const define_alias_gen(alias_rad2deg_e,_SYMB,0,&rad2deg_e_symb); 10852 const gen & rad2deg_e = *(const gen *)&alias_rad2deg_e; 10853 10854 const define_tab2_alias_gen(alias_deg2rad_e_tab,_IDNT,0,&ref_pi,_SYMB,0,&inv_180_symb); 10855 const define_alias_ref_vecteur2(deg2rad_e_refv,alias_deg2rad_e_tab); 10856 const define_alias_ref_symbolic( deg2rad_e_symb ,(size_t)&__prod,_VECT,_SEQ__VECT,°2rad_e_refv); 10857 const define_alias_gen(alias_deg2rad_e,_SYMB,0,°2rad_e_symb); 10858 const gen & deg2rad_e = *(const gen *)&alias_deg2rad_e; 10859 10860 //grad 10861 const define_tab2_alias_gen(alias_rad2grad_e_tab, _INT_, 0, 200, _SYMB, 0, &inv_pi_symb); 10862 const define_alias_ref_vecteur2(rad2grad_e_refv, alias_rad2grad_e_tab); 10863 const define_alias_ref_symbolic(rad2grad_e_symb, (size_t)&_prod, _VECT, _SEQ__VECT, &rad2grad_e_refv); 10864 const define_alias_gen(alias_rad2grad_e, _SYMB, 0, &rad2grad_e_symb); 10865 const gen & rad2grad_e = *(const gen *)&alias_rad2grad_e; 10866 10867 const define_tab2_alias_gen(alias_grad2rad_e_tab, _IDNT, 0, &ref_pi, _SYMB, 0, &inv_180_symb); 10868 const define_alias_ref_vecteur2(grad2rad_e_refv, alias_grad2rad_e_tab); 10869 const define_alias_ref_symbolic(grad2rad_e_symb, (size_t)&__prod, _VECT, _SEQ__VECT, &grad2rad_e_refv); 10870 const define_alias_gen(alias_grad2rad_e, _SYMB, 0, &grad2rad_e_symb); 10871 const gen & grad2rad_e = *(const gen *)&alias_grad2rad_e; 10872 10873 10874 // 0 = -pi, 12=0, 24=pi 10875 static const alias_gen * const table_cos_alias[trig_deno+1]={ 10876 &alias_minus_one,&alias_minus_cos_pi_12,&alias_minus_sqrt3_2,&alias_minus_sqrt2_2,&alias_minus_one_half,&alias_minus_sin_pi_12, 10877 &alias_zero,&alias_sin_pi_12,&alias_plus_one_half,&alias_plus_sqrt2_2,&alias_plus_sqrt3_2,&alias_cos_pi_12, 10878 &alias_plus_one,&alias_cos_pi_12,&alias_plus_sqrt3_2,&alias_plus_sqrt2_2,&alias_plus_one_half,&alias_sin_pi_12, 10879 &alias_zero,&alias_minus_sin_pi_12,&alias_minus_one_half,&alias_minus_sqrt2_2,&alias_minus_sqrt3_2,&alias_minus_cos_pi_12, 10880 &alias_minus_one 10881 }; 10882 const gen * const * table_cos= (const gen **) table_cos_alias; 10883 static const alias_gen * const table_tan_alias[trig_deno/2+1]={ 10884 &alias_zero,&alias_tan_pi_12,&alias_plus_sqrt3_3,&alias_plus_one,&alias_plus_sqrt3,&alias_tan_5pi_12, 10885 &alias_unsigned_inf,&alias_minus_tan_5pi_12,&alias_minus_sqrt3,&alias_minus_one,&alias_minus_sqrt3_3,&alias_minus_tan_pi_12, 10886 &alias_zero 10887 }; 10888 const gen * const * table_tan = (const gen **) table_tan_alias; 10889 10890 #endif // GIAC_GENERIC_CONSTANTS 10891 10892 const alias_type reim_op_alias[]={(alias_type)&__inv,(alias_type)&__exp,(alias_type)&__cos,(alias_type)&__sin,(alias_type)&__tan,(alias_type)&__cosh,(alias_type)&__sinh,(alias_type)&__tanh,(alias_type)&__atan,(alias_type)&__lnGamma_minus,(alias_type)&__Gamma,(alias_type)&__Psi_minus_ln,(alias_type)&__Psi,(alias_type)&__Zeta,(alias_type)&__Eta,(alias_type)&__sign,(alias_type)&__erf,(alias_type) & __of,0}; 10893 const unary_function_ptr * const reim_op=(const unary_function_ptr * const)reim_op_alias; 10894 // for subst.cc 10895 const alias_type sincostan_tab_alias[]={(alias_type)&__sin,(alias_type)&__cos,(alias_type)&__tan,0}; 10896 const unary_function_ptr * const sincostan_tab=(const unary_function_ptr * const) sincostan_tab_alias; 10897 10898 const alias_type asinacosatan_tab_alias[] = {(alias_type)&__asin,(alias_type)&__acos,(alias_type)&__atan,0}; 10899 const unary_function_ptr * const asinacosatan_tab=(const unary_function_ptr * const) asinacosatan_tab_alias; 10900 10901 const alias_type sinhcoshtanh_tab_alias[]={alias_at_sinh,alias_at_cosh,alias_at_tanh,0}; 10902 const unary_function_ptr * const sinhcoshtanh_tab=(const unary_function_ptr * const)sinhcoshtanh_tab_alias; 10903 10904 const alias_type sinhcoshtanhinv_tab_alias[]={(alias_type)&__sinh,(alias_type)&__cosh,(alias_type)&__tanh,(alias_type)&__inv,0}; 10905 const unary_function_ptr * const sinhcoshtanhinv_tab=(const unary_function_ptr * const)sinhcoshtanhinv_tab_alias; 10906 10907 const alias_type sincostansinhcoshtanh_tab_alias[]={(alias_type)&__sin,(alias_type)&__cos,(alias_type)&__tan,(alias_type)&__sinh,(alias_type)&__cosh,(alias_type)&__tanh,0}; 10908 const unary_function_ptr * const sincostansinhcoshtanh_tab=(const unary_function_ptr * const)sincostansinhcoshtanh_tab_alias; 10909 10910 // vector<unary_function_ptr> sincostan_v(sincostan_tab,sincostan_tab+3); 10911 // vector<unary_function_ptr> asinacosatan_v(asinacosatan_tab,asinacosatan_tab+3); 10912 // vector<unary_function_ptr> sinhcoshtanh_v(sinhcoshtanh_tab,sinhcoshtanh_tab+3); 10913 // vector <unary_function_ptr> sincostansinhcoshtanh_v(merge(sincostan_v,sinhcoshtanh_v)); 10914 const alias_type sign_floor_ceil_round_tab_alias[]={(alias_type)&__sign,(alias_type)&__floor,(alias_type)&__ceil,(alias_type)&__round,(alias_type)&__sum,0}; 10915 const unary_function_ptr * const sign_floor_ceil_round_tab=(const unary_function_ptr *const )sign_floor_ceil_round_tab_alias; 10916 10917 // vector<unary_function_ptr> sign_floor_ceil_round_v(sign_floor_ceil_round_tab,sign_floor_ceil_round_tab+5); 10918 const alias_type exp_tab_alias[]={(const alias_type)&__exp,0}; 10919 const unary_function_ptr * const exp_tab=(const unary_function_ptr * const)exp_tab_alias; 10920 10921 const alias_type tan_tab_alias[]={(const alias_type)&__tan,0}; 10922 const unary_function_ptr * const tan_tab=(const unary_function_ptr * const)tan_tab_alias; 10923 10924 const alias_type asin_tab_alias[]={(const alias_type)&__asin,0}; 10925 const unary_function_ptr * const asin_tab=(const unary_function_ptr * const)asin_tab_alias; 10926 10927 const alias_type acos_tab_alias[]={(const alias_type)&__acos,0}; 10928 const unary_function_ptr * const acos_tab=(const unary_function_ptr * const)acos_tab_alias; 10929 10930 const alias_type atan_tab_alias[]={(const alias_type)&__atan,0}; 10931 const unary_function_ptr * const atan_tab=(const unary_function_ptr * const)atan_tab_alias; 10932 10933 const alias_type pow_tab_alias[]={(const alias_type)&__pow,0}; 10934 const unary_function_ptr * const pow_tab=(const unary_function_ptr * const)pow_tab_alias; 10935 10936 const alias_type Heaviside_tab_alias[]={alias_at_Heaviside,0}; 10937 const unary_function_ptr * const Heaviside_tab=(const unary_function_ptr * const)Heaviside_tab_alias; 10938 10939 const alias_type invpowtan_tab_alias[]={alias_at_inv,alias_at_pow,alias_at_tan,0}; 10940 const unary_function_ptr * const invpowtan_tab=(const unary_function_ptr * const) invpowtan_tab_alias; 10941 10942 const gen_op_context halftan_tab[]={sin2tan2,cos2tan2,tan2tan2,0}; 10943 const gen_op_context hyp2exp_tab[]={sinh2exp,cosh2exp,tanh2exp,0}; 10944 const gen_op_context hypinv2exp_tab[]={sinh2exp,cosh2exp,tanh2exp,inv_test_exp,0}; 10945 const gen_op_context trig2exp_tab[]={sin2exp,cos2exp,tan2exp,0}; 10946 const gen_op_context atrig2ln_tab[]={asin2ln,acos2ln,atan2ln,0}; 10947 // vector< gen_op_context > halftan_v(halftan_tab,halftan_tab+3); 10948 // vector< gen_op_context > hyp2exp_v(hyp2exp_tab,hyp2exp_tab+3); 10949 // vector< gen_op_context > trig2exp_v(trig2exp_tab,trig2exp_tab+3); 10950 const gen_op_context halftan_hyp2exp_tab[]={sin2tan2,cos2tan2,tan2tan2,sinh2exp,cosh2exp,tanh2exp,0}; 10951 const gen_op_context exp2sincos_tab[]={exp2sincos,0}; 10952 const gen_op_context tan2sincos_tab[]={tantosincos,0}; 10953 const gen_op_context tan2sincos2_tab[]={tantosincos2,0}; 10954 const gen_op_context tan2cossin2_tab[]={tantocossin2,0}; 10955 const gen_op_context asin2acos_tab[]={asintoacos,0}; 10956 const gen_op_context asin2atan_tab[]={asintoatan,0}; 10957 const gen_op_context acos2asin_tab[]={acostoasin,0}; 10958 const gen_op_context acos2atan_tab[]={acostoatan,0}; 10959 const gen_op_context atan2asin_tab[]={atantoasin,0}; 10960 const gen_op_context atan2acos_tab[]={atantoacos,0}; 10961 // vector< gen_op_context > atrig2ln_v(atrig2ln_tab,atrig2ln_tab+3); 10962 const gen_op_context trigcos_tab[]={trigcospow,0}; 10963 const gen_op_context trigsin_tab[]={trigsinpow,0}; 10964 const gen_op_context trigtan_tab[]={trigtanpow,0}; 10965 const gen_op_context powexpand_tab[]={powtopowexpand,0}; 10966 const gen_op_context powneg2invpow_tab[]={pownegtoinvpow,0}; 10967 const gen_op_context exp2power_tab[]={exptopower,0}; 10968 const alias_type gamma_tab_alias[]={alias_at_Gamma,0}; 10969 const unary_function_ptr * const gamma_tab=(const unary_function_ptr * const)gamma_tab_alias; 10970 10971 const gen_op_context gamma2factorial_tab[]={gammatofactorial,0}; 10972 const alias_type factorial_tab_alias[]={alias_at_factorial,0}; 10973 const unary_function_ptr * const factorial_tab=(const unary_function_ptr * const)factorial_tab_alias; 10974 10975 const gen_op_context factorial2gamma_tab[]={factorialtogamma,0}; 10976 10977 // for integration 10978 const alias_type primitive_tab_op_alias[]={ (const alias_type)&__sin, (const alias_type)&__cos, (const alias_type)&__tan, (const alias_type)&__exp, (const alias_type)&__sinh, (const alias_type)&__cosh, (const alias_type)&__tanh, (const alias_type)&__asin, (const alias_type)&__acos, (const alias_type)&__atan, (const alias_type)&__ln,(const alias_type)&__asinh, (const alias_type)&__acosh, (const alias_type)&__atanh,0}; 10979 const unary_function_ptr * const primitive_tab_op=(const unary_function_ptr * const)primitive_tab_op_alias; 10980 const alias_type inverse_tab_op_alias[]={ (const alias_type)&__asin, (const alias_type)&__acos, (const alias_type)&__atan, (const alias_type)&__ln, (const alias_type)&__asinh, (const alias_type)&__acosh, (const alias_type)&__atanh, (const alias_type)&__erf, (const alias_type)&__erfc, (const alias_type)&__Ei, (const alias_type)&__Si, (const alias_type)&__Ci,0}; 10981 const unary_function_ptr * const inverse_tab_op=(const unary_function_ptr * const)inverse_tab_op_alias; 10982 10983 const alias_type analytic_sommets_alias[]={ (const alias_type)&__plus, (const alias_type)&__prod, (const alias_type)&__neg, (const alias_type)&__inv, (const alias_type)&__pow, (const alias_type)&__sin, (const alias_type)&__cos, (const alias_type)&__tan, (const alias_type)&__exp, (const alias_type)&__sinh, (const alias_type)&__cosh, (const alias_type)&__tanh, (const alias_type)&__asin, (const alias_type)&__acos, (const alias_type)&__atan, (const alias_type)&__asinh, (const alias_type)&__atanh, (const alias_type)&__acosh, (const alias_type)&__ln, (const alias_type)&__sqrt,0}; 10984 const unary_function_ptr * const analytic_sommets=(const unary_function_ptr * const)analytic_sommets_alias; 10985 // test if g is < > <= >=, 10986 const alias_type inequality_tab_alias[]={ (const alias_type)&__equal, (const alias_type)&__inferieur_strict, (const alias_type)&__inferieur_egal, (const alias_type)&__different, (const alias_type)&__superieur_strict, (const alias_type)&__superieur_egal,0}; 10987 const unary_function_ptr * const inequality_tab=(const unary_function_ptr * const)inequality_tab_alias; 10988 // if you add functions to solve_fcns, modify the second argument of solve_fcns_v to reflect the number of functions in the array 10989 const alias_type solve_fcns_tab_alias[]={ (const alias_type)&__exp, (const alias_type)&__ln, (const alias_type)&__sin, (const alias_type)&__cos, (const alias_type)&__tan, (const alias_type)&__asin, (const alias_type)&__acos, (const alias_type)&__atan, (const alias_type)&__sinh, (const alias_type)&__cosh, (const alias_type)&__tanh, (const alias_type)&__asinh, (const alias_type)&__acosh, (const alias_type)&__atanh,0}; 10990 const unary_function_ptr * const solve_fcns_tab = (const unary_function_ptr * const)solve_fcns_tab_alias; 10991 10992 const alias_type limit_tab_alias[]={(const alias_type)&__Gamma,(const alias_type)&__Psi,(const alias_type)&__erf,(const alias_type)&__Si,(const alias_type)&__Ci,(const alias_type)&__Ei,(const alias_type)&__lower_incomplete_gamma,(const alias_type)&__LambertW,0}; 10993 const unary_function_ptr * const limit_tab = (const unary_function_ptr * const) limit_tab_alias; 10994 const gen_op_context limit_replace [] = {Gamma_replace,Psi_replace,erf_replace,Si_replace,Ci_replace,Ei_replace,igamma_replace,LambertW_replace,0}; 10995 10996 // vector<unary_function_ptr> inequality_sommets(inequality_tab,inequality_tab+sizeof(inequality_tab)/sizeof(unary_function_ptr)); is_inequality(const gen & g)10997 int is_inequality(const gen & g){ 10998 if (g.type!=_SYMB) 10999 return false; 11000 return equalposcomp(inequality_tab,g._SYMBptr->sommet); 11001 } 11002 11003 unquote(const string & s)11004 string unquote(const string & s){ 11005 int l=int(s.size()); 11006 if (l>2 && s[0]=='"' && s[l-1]=='"') 11007 return s.substr(1,l-2); 11008 else 11009 return s; 11010 } 11011 11012 #ifdef NSPIRE 11013 template<class T> operator <<(nio::ios_base<T> & os,const alias_ref_vecteur & v)11014 nio::ios_base<T> & operator << (nio::ios_base<T> & os,const alias_ref_vecteur & v){ 11015 #ifdef IMMEDIATE_VECTOR 11016 os << &v << ":" << *(gen *)v.begin_immediate_vect << "," << *(gen*) (v.begin_immediate_vect+1); 11017 #else 11018 os << &v ; 11019 #endif 11020 return os; 11021 } 11022 #else operator <<(ostream & os,const alias_ref_vecteur & v)11023 ostream & operator << (ostream & os,const alias_ref_vecteur & v){ 11024 #ifdef IMMEDIATE_VECTOR 11025 os << &v << ":" << *(gen *)v.begin_immediate_vect << "," << *(gen*) (v.begin_immediate_vect+1); 11026 #else 11027 os << &v ; 11028 #endif 11029 return os; 11030 } 11031 #endif 11032 fonction_bidon()11033 void fonction_bidon(){ 11034 #if !defined GIAC_GENERIC_CONSTANTS && !defined NSPIRE && !defined FXCG && !defined GIAC_HAS_STO_38 11035 ofstream of("log"); 11036 of << gen_inv_2 << '\n'; 11037 of << alias_cst_two_pi_tab << " " << cst_two_pi_refv << '\n'; 11038 of << alias_cst_pi_over_2_tab << " " << cst_pi_over_2_refv << '\n'; 11039 of << alias_plus_sqrt3_tab << " " << plus_sqrt3_refv << '\n'; 11040 of << alias_plus_sqrt2_tab << " " << plus_sqrt2_refv << '\n'; 11041 of << alias_plus_sqrt6_tab << " " << plus_sqrt6_refv << '\n'; 11042 of << alias_minus_sqrt3_2_tab << " " << minus_sqrt3_2_refv << '\n'; 11043 of << alias_minus_sqrt2_2_tab << " " << minus_sqrt2_2_refv << '\n'; 11044 of << alias_minus_sqrt3_3_tab << " " << minus_sqrt3_3_refv << '\n'; 11045 of << alias_plus_sqrt3_2_tab << " " << plus_sqrt3_2_refv << '\n'; 11046 of << alias_plus_sqrt2_2_tab << " " << plus_sqrt2_2_refv << '\n'; 11047 of << alias_plus_sqrt3_3_tab << " " << plus_sqrt3_3_refv << '\n'; 11048 of << alias_cos_pi_12_4_tab << " " << cos_pi_12_4_refv << '\n'; 11049 of << alias_cos_pi_12_tab << " " << cos_pi_12_refv << '\n'; 11050 of << alias_minus_cos_pi_12_4_tab << " " << minus_cos_pi_12_4_refv << '\n'; 11051 of << alias_minus_cos_pi_12_tab << " " << minus_cos_pi_12_refv << '\n'; 11052 of << alias_sin_pi_12_4_tab << " " << sin_pi_12_4_refv << '\n'; 11053 of << alias_sin_pi_12_tab << " " << sin_pi_12_refv << '\n'; 11054 of << alias_minus_sin_pi_12_4_tab << " " << minus_sin_pi_12_4_refv << '\n'; 11055 of << alias_minus_sin_pi_12_tab << " " << minus_sin_pi_12_refv << '\n'; 11056 of << alias_tan_pi_12_tab << " " << tan_pi_12_refv << '\n'; 11057 of << alias_tan_5pi_12_tab << " " << tan_5pi_12_refv << '\n'; 11058 of << alias_rad2deg_e_tab << " " << rad2deg_e_refv << '\n'; 11059 of << alias_deg2rad_e_tab << " " << deg2rad_e_refv << '\n'; 11060 of << plus_inf << " "; 11061 of << minus_inf << " "; 11062 of << plus_one_half << " "; 11063 of << minus_one_half << " "; 11064 of << plus_sqrt3 << " "; 11065 of << plus_sqrt2 << " "; 11066 of << plus_sqrt6 << " "; 11067 of << minus_sqrt2 << " "; 11068 of << minus_sqrt3 << " "; 11069 of << minus_sqrt6 << " "; 11070 of << minus_sqrt3_2 << " "; 11071 of << minus_sqrt2_2 << " "; 11072 of << minus_sqrt3_3 << " "; 11073 of << plus_sqrt3_2 << " " ; 11074 of << plus_sqrt2_2 << " "; 11075 of << plus_sqrt3_3 << " "; 11076 of << cos_pi_12 << " "; 11077 of << minus_cos_pi_12 << " "; 11078 of << sin_pi_12 << " "; 11079 of << minus_sin_pi_12 << " "; 11080 of << tan_pi_12 << " "; 11081 of << tan_5pi_12 << " "; 11082 of << minus_tan_pi_12 << " "; 11083 of << minus_tan_5pi_12 << " " << '\n'; 11084 of << cst_two_pi << " " ; 11085 of << cst_pi_over_2 << " "; 11086 of << cst_inv_pi << " "; 11087 of << cst_inv_180 << " " << '\n'; 11088 of << rad2deg_e << " " ; 11089 of << deg2rad_e << " " << '\n'; 11090 #endif 11091 } 11092 11093 #ifndef NO_NAMESPACE_GIAC 11094 } // namespace giac 11095 #endif // ndef NO_NAMESPACE_GIAC 11096