1 // -*- mode:C++ ; compile-command: "g++-3.4 -I.. -g -c rpn.cc -DIN_GIAC -DHAVE_CONFIG_H" -*- 2 #include "giacPCH.h" 3 /* 4 * Copyright (C) 2001,14 B. Parisse, Institut Fourier, 38402 St Martin d'Heres 5 * 6 * This program is free software; you can redistribute it and/or modify 7 * it under the terms of the GNU General Public License as published by 8 * the Free Software Foundation; either version 3 of the License, or 9 * (at your option) any later version. 10 * 11 * This program is distributed in the hope that it will be useful, 12 * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 * GNU General Public License for more details. 15 * 16 * You should have received a copy of the GNU General Public License 17 * along with this program. If not, see <http://www.gnu.org/licenses/>. 18 */ 19 20 using namespace std; 21 #include "rpn.h" 22 #include "symbolic.h" 23 #include "unary.h" 24 #include <algorithm> 25 #include <math.h> 26 #include "prog.h" 27 #include "usual.h" 28 #include "identificateur.h" 29 #include <stdio.h> 30 #ifdef HAVE_UNISTD_H 31 #include <unistd.h> 32 #if !defined(NSPIRE) && !defined FXCG && !defined(__VISUALC__) && !defined(KHICAS)// #ifndef NSPIRE 33 #include <dirent.h> 34 #if !defined(__MINGW_H) && !defined(HAVE_NO_PWD_H) 35 #include <pwd.h> 36 #endif // MINGW 37 #endif // NSPIRE 38 #endif // UNISTD 39 #include "input_lexer.h" 40 #include "plot.h" 41 #include "tex.h" 42 #include "ti89.h" 43 #include "maple.h" 44 #include "misc.h" 45 #include "permu.h" 46 #include "intg.h" 47 #include "derive.h" 48 #include "sym2poly.h" 49 #include "input_parser.h" 50 #include "solve.h" 51 #include "subst.h" 52 #include "csturm.h" 53 #include "giacintl.h" 54 55 #ifdef GIAC_HAS_STO_38 56 #include "aspen.h" 57 //THPObj *EditMat(int); 58 #endif 59 60 61 #ifndef NO_NAMESPACE_GIAC 62 namespace giac { 63 #endif // ndef NO_NAMESPACE_GIAC 64 enmajuscule(const string & s)65 string enmajuscule(const string & s){ 66 string res; 67 string::const_iterator it=s.begin(),itend=s.end(); 68 for (;it!=itend;++it){ 69 if ((*it>='a') && (*it<='z')) 70 res += char(*it-32); 71 else 72 res += char(*it); 73 } 74 return res; 75 } 76 printasconstant(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)77 string printasconstant(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 78 return sommetstr; 79 } 80 #ifdef RTOS_THREADX return_undef(const gen &,GIAC_CONTEXT)81 gen return_undef(const gen &,GIAC_CONTEXT){ 82 return undef; 83 } 84 static const char _rpn_s []="rpn"; 85 static define_unary_function_eval2 (__rpn,&return_undef,_rpn_s,&printasconstant); 86 define_unary_function_ptr5( at_rpn ,alias_at_rpn ,(unary_function_eval*)&__rpn,0,true); 87 88 static const char _alg_s []="alg"; 89 static define_unary_function_eval2 (__alg,&return_undef,_alg_s,&printasconstant); 90 define_unary_function_ptr5( at_alg ,alias_at_alg ,(unary_function_eval *)&__alg,0,true); 91 92 static const char _ROLL_s []="ROLL"; 93 static define_unary_function_eval (__ROLL,&return_undef,_ROLL_s); 94 define_unary_function_ptr( at_ROLL ,alias_at_ROLL ,&__ROLL); 95 96 static const char _ROLLD_s []="ROLLD"; 97 static define_unary_function_eval (__ROLLD,&return_undef,_ROLLD_s); 98 define_unary_function_ptr( at_ROLLD ,alias_at_ROLLD ,&__ROLLD); 99 100 static const char _SWAP_s []="SWAP"; 101 static define_unary_function_eval (__SWAP,&return_undef,_SWAP_s); 102 define_unary_function_ptr5( at_SWAP ,alias_at_SWAP ,&__SWAP,0,T_RPN_OP); 103 104 static const char _DUP_s []="DUP"; 105 static define_unary_function_eval (__DUP,&return_undef,_DUP_s); 106 define_unary_function_ptr5( at_DUP ,alias_at_DUP ,&__DUP,0,T_RPN_OP); 107 108 static const char _OVER_s []="OVER"; 109 static define_unary_function_eval (__OVER,&return_undef,_OVER_s); 110 define_unary_function_ptr5( at_OVER ,alias_at_OVER ,&__OVER,0,T_RPN_OP); 111 112 static const char _PICK_s []="PICK"; 113 static define_unary_function_eval (__PICK,&return_undef,_PICK_s); 114 define_unary_function_ptr5( at_PICK ,alias_at_PICK ,&__PICK,0,T_RPN_OP); 115 116 static const char _DROP_s []="DROP"; 117 static define_unary_function_eval (__DROP,&return_undef,_DROP_s); 118 define_unary_function_ptr5( at_DROP ,alias_at_DROP ,&__DROP,0,T_RPN_OP); 119 120 static const char _NOP_s []="NOP"; 121 static define_unary_function_eval2_index (136,__NOP,&return_undef,_NOP_s,&printasconstant); 122 define_unary_function_ptr5( at_NOP ,alias_at_NOP ,&__NOP,0,T_RPN_OP); 123 124 static const char _IFTE_s []="IFTE"; 125 static define_unary_function_eval2_index (126,__IFTE,&return_undef,_IFTE_s,&printasconstant); 126 define_unary_function_ptr5( at_IFTE ,alias_at_IFTE ,&__IFTE,0,T_RPN_OP); 127 128 static const char _RPN_LOCAL_s []="RPN_LOCAL"; 129 static define_unary_function_eval2_index (130,__RPN_LOCAL,&return_undef,_RPN_LOCAL_s,&printasconstant); 130 define_unary_function_ptr5( at_RPN_LOCAL ,alias_at_RPN_LOCAL ,&__RPN_LOCAL,0,T_RPN_OP); 131 132 static const char _RPN_FOR_s []="RPN_FOR"; 133 static define_unary_function_eval2_index (132,__RPN_FOR,&return_undef,_RPN_FOR_s,&printasconstant); 134 define_unary_function_ptr5( at_RPN_FOR ,alias_at_RPN_FOR ,&__RPN_FOR,0,T_RPN_OP); 135 136 static const char _RPN_WHILE_s []="RPN_WHILE"; 137 static define_unary_function_eval2_index (134,__RPN_WHILE,&return_undef,_RPN_WHILE_s,&printasconstant); 138 define_unary_function_ptr5( at_RPN_WHILE ,alias_at_RPN_WHILE ,&__RPN_WHILE,0,T_RPN_OP); 139 140 static const char _RPN_CASE_s []="RPN_CASE"; 141 static define_unary_function_eval2_index (128,__RPN_CASE,&return_undef,_RPN_CASE_s,&printasconstant); 142 define_unary_function_ptr5( at_RPN_CASE ,alias_at_RPN_CASE ,&__RPN_CASE,0,T_RPN_OP); 143 144 static const char _RPN_UNTIL_s []="RPN_UNTIL"; 145 static define_unary_function_eval2 (__RPN_UNTIL,&return_undef,_RPN_UNTIL_s,&printasconstant); 146 define_unary_function_ptr( at_RPN_UNTIL ,alias_at_RPN_UNTIL ,&__RPN_UNTIL); 147 148 static const char _rpn_prog_s []="rpn_prog"; 149 static define_unary_function_eval2_index (83,__rpn_prog,&return_undef,_rpn_prog_s,&printasconstant); 150 define_unary_function_ptr5( at_rpn_prog ,alias_at_rpn_prog,&__rpn_prog,_QUOTE_ARGUMENTS,0); 151 #else // RTOS_THREADX symb_rpn(const gen & args)152 static gen symb_rpn(const gen & args){ 153 return symbolic(at_rpn,args); 154 } _rpn(const gen & args,GIAC_CONTEXT)155 gen _rpn(const gen & args,GIAC_CONTEXT){ 156 if ( args.type==_STRNG && args.subtype==-1) return args; 157 rpn_mode(contextptr)=true; 158 return symb_rpn(args); 159 } 160 static const char _rpn_s []="rpn"; 161 static define_unary_function_eval2 (__rpn,&_rpn,_rpn_s,&printasconstant); 162 define_unary_function_ptr5( at_rpn ,alias_at_rpn ,(unary_function_eval*)&__rpn,0,true); 163 symb_alg(const gen & args)164 static gen symb_alg(const gen & args){ 165 return symbolic(at_alg,args); 166 } _alg(const gen & args,GIAC_CONTEXT)167 gen _alg(const gen & args,GIAC_CONTEXT){ 168 if ( args.type==_STRNG && args.subtype==-1) return args; 169 rpn_mode(contextptr)=false; 170 return symb_alg(args); 171 } 172 static const char _alg_s []="alg"; 173 static define_unary_function_eval2 (__alg,&_alg,_alg_s,&printasconstant); 174 define_unary_function_ptr5( at_alg ,alias_at_alg ,(unary_function_eval *)&__alg,0,true); 175 roll(int i,vecteur & v)176 void roll(int i,vecteur & v){ 177 if (i<2) 178 return; 179 iterateur it=v.begin(),itend=v.end(); 180 if (itend-it<i) 181 return; 182 it=itend-i; 183 gen save=*it; 184 for (;;){ 185 ++it; 186 if (it==itend) 187 break; 188 *(it-1)=*it; 189 } 190 *(it-1)=save; 191 } 192 ROLL(int i,GIAC_CONTEXT)193 void ROLL(int i,GIAC_CONTEXT){ 194 roll(i,history_in(contextptr)); 195 roll(i,history_out(contextptr)); 196 } 197 _ROLL(const gen & args,GIAC_CONTEXT)198 gen _ROLL(const gen & args,GIAC_CONTEXT){ 199 if ( args.type==_STRNG && args.subtype==-1) return args; 200 if (args._VECTptr->empty()) 201 return args; 202 gen e=args._VECTptr->back(); 203 args._VECTptr->pop_back(); 204 if (e.type==_INT_) 205 roll(e.val,*args._VECTptr); 206 if (e.type==_DOUBLE_) 207 roll(int(e._DOUBLE_val),*args._VECTptr); 208 return args; 209 } 210 static const char _ROLL_s []="ROLL"; 211 static define_unary_function_eval (__ROLL,&_ROLL,_ROLL_s); 212 define_unary_function_ptr( at_ROLL ,alias_at_ROLL ,&__ROLL); 213 rolld(int i,vecteur & v)214 void rolld(int i,vecteur & v){ 215 if (i<2) 216 return; 217 iterateur it=v.begin(),itend=v.end(); 218 if (itend-it<i) 219 return; 220 it=itend-i; 221 --itend; 222 gen save=*itend; 223 for (;it!=itend;){ 224 --itend; 225 *(itend+1)=*itend; 226 } 227 *it=save; 228 } 229 ROLLD(int i,GIAC_CONTEXT)230 void ROLLD(int i,GIAC_CONTEXT){ 231 rolld(i,history_in(contextptr)); 232 rolld(i,history_out(contextptr)); 233 } _ROLLD(const gen & args,GIAC_CONTEXT)234 gen _ROLLD(const gen & args,GIAC_CONTEXT){ 235 if ( args.type==_STRNG && args.subtype==-1) return args; 236 if (args._VECTptr->empty()) 237 return args; 238 gen e=args._VECTptr->back(); 239 args._VECTptr->pop_back(); 240 if (e.type==_INT_) 241 rolld(e.val,*args._VECTptr); 242 if (e.type==_DOUBLE_) 243 rolld(int(e._DOUBLE_val),*args._VECTptr); 244 return args; 245 } 246 static const char _ROLLD_s []="ROLLD"; 247 static define_unary_function_eval (__ROLLD,&_ROLLD,_ROLLD_s); 248 define_unary_function_ptr( at_ROLLD ,alias_at_ROLLD ,&__ROLLD); 249 stack_swap(vecteur & v)250 void stack_swap(vecteur & v){ 251 iterateur it=v.begin(),itend=v.end(); 252 int s=int(itend-it); 253 if (s<2) 254 return; 255 --itend; 256 gen tmp=*itend; 257 *itend=*(itend-1); 258 *(itend-1)=tmp; 259 } 260 SWAP(GIAC_CONTEXT)261 void SWAP(GIAC_CONTEXT){ 262 stack_swap(history_in(contextptr)); 263 stack_swap(history_out(contextptr)); 264 } 265 _SWAP(const gen & args,GIAC_CONTEXT)266 gen _SWAP(const gen & args,GIAC_CONTEXT){ 267 if ( args.type==_STRNG && args.subtype==-1) return args; 268 stack_swap(*args._VECTptr); 269 return args; 270 } 271 static const char _SWAP_s []="SWAP"; 272 static define_unary_function_eval (__SWAP,&_SWAP,_SWAP_s); 273 define_unary_function_ptr5( at_SWAP ,alias_at_SWAP ,&__SWAP,0,T_RPN_OP); 274 dup(vecteur & v)275 void dup(vecteur & v){ 276 if (!v.empty()) 277 v.push_back(v.back()); 278 } _DUP(const gen & args,GIAC_CONTEXT)279 gen _DUP(const gen & args,GIAC_CONTEXT){ 280 if ( args.type==_STRNG && args.subtype==-1) return args; 281 dup(*args._VECTptr); 282 return args; 283 } 284 static const char _DUP_s []="DUP"; 285 static define_unary_function_eval (__DUP,&_DUP,_DUP_s); 286 define_unary_function_ptr5( at_DUP ,alias_at_DUP ,&__DUP,0,T_RPN_OP); 287 over(vecteur & v)288 void over(vecteur & v){ 289 int s=int(v.size()); 290 if (s>=2) 291 v.push_back(v[s-2]); 292 } _OVER(const gen & args,GIAC_CONTEXT)293 gen _OVER(const gen & args,GIAC_CONTEXT){ 294 if ( args.type==_STRNG && args.subtype==-1) return args; 295 over(*args._VECTptr); 296 return args; 297 } 298 static const char _OVER_s []="OVER"; 299 static define_unary_function_eval (__OVER,&_OVER,_OVER_s); 300 define_unary_function_ptr5( at_OVER ,alias_at_OVER ,&__OVER,0,T_RPN_OP); 301 pick(int i,vecteur & v)302 void pick(int i,vecteur & v){ 303 int s=int(v.size()); 304 if ((i>=1) && (s>=i)) 305 v.push_back(v[s-i]); 306 } _PICK(const gen & args,GIAC_CONTEXT)307 gen _PICK(const gen & args,GIAC_CONTEXT){ 308 if ( args.type==_STRNG && args.subtype==-1) return args; 309 if (args._VECTptr->empty()) 310 return args; 311 gen e=args._VECTptr->back(); 312 args._VECTptr->pop_back(); 313 if (e.type==_INT_) 314 pick(e.val,*args._VECTptr); 315 if (e.type==_DOUBLE_) 316 pick(int(e._DOUBLE_val),*args._VECTptr); 317 return args; 318 } 319 static const char _PICK_s []="PICK"; 320 static define_unary_function_eval (__PICK,&_PICK,_PICK_s); 321 define_unary_function_ptr5( at_PICK ,alias_at_PICK ,&__PICK,0,T_RPN_OP); 322 drop(vecteur & v)323 void drop(vecteur & v){ 324 if (v.empty()) 325 return; 326 v.pop_back(); 327 } _DROP(const gen & args,GIAC_CONTEXT)328 gen _DROP(const gen & args,GIAC_CONTEXT){ 329 if ( args.type==_STRNG && args.subtype==-1) return args; 330 drop(*args._VECTptr); 331 return args; 332 } 333 static const char _DROP_s []="DROP"; 334 static define_unary_function_eval (__DROP,&_DROP,_DROP_s); 335 define_unary_function_ptr5( at_DROP ,alias_at_DROP ,&__DROP,0,T_RPN_OP); 336 printasNOP(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)337 static string printasNOP(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 338 return sommetstr; 339 } symb_NOP(const gen & args)340 gen symb_NOP(const gen & args){ 341 return vecteur(1,symbolic(at_NOP,args)); 342 } _NOP(const gen & args,GIAC_CONTEXT)343 gen _NOP(const gen & args,GIAC_CONTEXT){ 344 if ( args.type==_STRNG && args.subtype==-1) return args; 345 return args; 346 } 347 static const char _NOP_s []="NOP"; 348 static define_unary_function_eval2_index (136,__NOP,&_NOP,_NOP_s,&printasNOP); 349 define_unary_function_ptr5( at_NOP ,alias_at_NOP ,&__NOP,0,T_RPN_OP); 350 printasIFTE(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)351 static string printasIFTE(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 352 const_iterateur it=feuille._VECTptr->begin(); 353 string res("IF " + printinner_VECT(*it->_VECTptr,_RPN_FUNC__VECT,contextptr)); 354 res += " THEN "; 355 ++it; 356 res += printinner_VECT(*it->_VECTptr,_RPN_FUNC__VECT,contextptr) + " ELSE "; 357 ++it; 358 return res + printinner_VECT(*it->_VECTptr,_RPN_FUNC__VECT,contextptr)+ " END"; 359 } symb_IFTE(const gen & args)360 gen symb_IFTE(const gen & args){ 361 return symbolic(at_IFTE,args); 362 } _IFTE(const gen & args,const context * contextptr)363 gen _IFTE(const gen & args,const context * contextptr){ 364 if ( args.type==_STRNG && args.subtype==-1) return args; 365 if (args.type!=_VECT || args._VECTptr->size()<3) 366 return gensizeerr(contextptr); 367 gen no=args._VECTptr->back(); 368 args._VECTptr->pop_back(); 369 gen yes=args._VECTptr->back(); 370 args._VECTptr->pop_back(); 371 gen e=args._VECTptr->back(); 372 args._VECTptr->pop_back(); 373 if (e.type==_VECT){ 374 rpn_eval(e,*args._VECTptr,contextptr); 375 if (args._VECTptr->empty()) 376 return args; 377 e=args._VECTptr->back(); 378 args._VECTptr->pop_back(); 379 } 380 if (is_zero(e)) 381 return rpn_eval(no,*args._VECTptr,contextptr); 382 else 383 return rpn_eval(yes,*args._VECTptr,contextptr); 384 } 385 static const char _IFTE_s []="IFTE"; 386 static define_unary_function_eval2_index (126,__IFTE,&_IFTE,_IFTE_s,&printasIFTE); 387 define_unary_function_ptr5( at_IFTE ,alias_at_IFTE ,&__IFTE,0,T_RPN_OP); 388 printasRPN_LOCAL(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)389 static string printasRPN_LOCAL(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 390 string s("-> "); 391 s += printinner_VECT(*feuille._VECTptr->front()._VECTptr,_RPN_FUNC__VECT,contextptr); 392 gen e= feuille._VECTptr->back(); 393 if ( (e.type==_VECT) && (e.subtype==_RPN_FUNC__VECT)) 394 return s + " " +e.print(contextptr); 395 else { 396 if ( (e.type==_SYMB) && (e._SYMBptr->sommet==at_quote)) 397 return s + " '"+e._SYMBptr->feuille.print(contextptr)+"'"; 398 else 399 return s + " '"+e.print(contextptr)+"'"; 400 } 401 } symb_RPN_LOCAL(const gen & a,const gen & b)402 gen symb_RPN_LOCAL(const gen & a,const gen & b){ 403 return symbolic(at_RPN_LOCAL,makesequence(a,b)); 404 } _RPN_LOCAL(const gen & args,const context * contextptr)405 gen _RPN_LOCAL(const gen & args,const context * contextptr) { 406 if ( args.type==_STRNG && args.subtype==-1) return args; 407 // stack level 2=symbolic names, level 1=program 408 if (args.type!=_VECT) 409 return symbolic(at_RPN_LOCAL,args); 410 int s=int(args._VECTptr->size()); 411 if (s<3) 412 return gentoofewargs("RPN_LOCAL must have at least 3 args"); 413 gen prog=args._VECTptr->back(); 414 args._VECTptr->pop_back(); 415 vecteur names=*(args._VECTptr->back()._VECTptr); // must be a vector 416 args._VECTptr->pop_back(); 417 // get values from stack 418 int nvars=int(names.size()); 419 if (s-2<nvars) 420 return gentoofewargs("RPN_LOCAL"); 421 vecteur values(names); 422 for (int j=nvars-1;j>=0;--j){ 423 values[j]=args._VECTptr->back(); 424 args._VECTptr->pop_back(); 425 } 426 // Initialization 427 context * newcontextptr = (context *) contextptr; 428 int protect=giac_bind(values,names,newcontextptr); 429 vecteur res; 430 if ((prog.type==_SYMB) && (prog._SYMBptr->sommet==at_quote)){ 431 args._VECTptr->push_back(prog._SYMBptr->feuille.eval(eval_level(contextptr),newcontextptr)); 432 res=*args._VECTptr; 433 } 434 else 435 res=rpn_eval(prog,*args._VECTptr,newcontextptr); 436 leave(protect,names,newcontextptr); 437 return gen(res,_RPN_STACK__VECT); 438 } 439 static const char _RPN_LOCAL_s []="RPN_LOCAL"; 440 static define_unary_function_eval2_index (130,__RPN_LOCAL,&_RPN_LOCAL,_RPN_LOCAL_s,&printasRPN_LOCAL); 441 define_unary_function_ptr5( at_RPN_LOCAL ,alias_at_RPN_LOCAL ,&__RPN_LOCAL,0,T_RPN_OP); 442 printasRPN_FOR(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)443 static string printasRPN_FOR(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 444 if ( (feuille.type!=_VECT) && (feuille._VECTptr->size()!=2)) 445 return "Invalid_RPN_FOR"; 446 string s; 447 gen controle=feuille._VECTptr->front(); 448 gen prog=feuille._VECTptr->back(); 449 bool is_start= (controle[0].print(contextptr)==" j"); 450 if (is_start) 451 s="START "; 452 else 453 s="FOR "+controle[0].print(contextptr)+" "; 454 s += printinner_VECT(*prog._VECTptr,_RPN_FUNC__VECT,contextptr); 455 if (is_one(controle[1])) 456 s+=" NEXT"; 457 else 458 s+= " "+controle[1].print(contextptr)+" STEP"; 459 return s; 460 } symb_RPN_FOR(const gen & a,const gen & b)461 gen symb_RPN_FOR(const gen & a,const gen & b){ 462 return symbolic(at_RPN_FOR,makesequence(a,b)); 463 } _RPN_FOR(const gen & args,const context * contextptr)464 gen _RPN_FOR(const gen & args,const context * contextptr) { 465 if ( args.type==_STRNG && args.subtype==-1) return args; 466 // stack level 4=init 467 // stack level 3=end 468 // stack level 2=[init_var,step] 469 // level 1=program to execute, 470 if (args.type!=_VECT) 471 return symbolic(at_RPN_FOR,args); 472 int s=int(args._VECTptr->size()); 473 if (s<4) 474 return gentoofewargs("RPN_FOR must have at least 4 args"); 475 gen prog=args._VECTptr->back(); 476 args._VECTptr->pop_back(); 477 vecteur controle=*(args._VECTptr->back()._VECTptr); // it must be a vector 478 args._VECTptr->pop_back(); 479 gen fin=args._VECTptr->back(); 480 args._VECTptr->pop_back(); 481 gen debut=args._VECTptr->back(); 482 args._VECTptr->pop_back(); 483 // Initialization 484 vecteur names(1,controle[0]); 485 gen test=inferieur_egal(controle[0],fin,contextptr); 486 context * newcontextptr = (context *) contextptr; 487 int protect=giac_bind(vecteur(1,debut),names,newcontextptr); 488 vecteur res; 489 for (;!is_zero(test.eval(eval_level(newcontextptr),newcontextptr).evalf(eval_level(contextptr),newcontextptr));sto(eval(controle[0]+controle[1],eval_level(newcontextptr),newcontextptr),controle[0],newcontextptr)){ 490 res=rpn_eval(prog,*args._VECTptr,newcontextptr); 491 } 492 leave(protect,names,newcontextptr); 493 return gen(res,_RPN_STACK__VECT); 494 } 495 static const char _RPN_FOR_s []="RPN_FOR"; 496 static define_unary_function_eval2_index (132,__RPN_FOR,&_RPN_FOR,_RPN_FOR_s,&printasRPN_FOR); 497 define_unary_function_ptr5( at_RPN_FOR ,alias_at_RPN_FOR ,&__RPN_FOR,0,T_RPN_OP); 498 printasRPN_WHILE(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)499 static string printasRPN_WHILE(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 500 if ( (feuille.type!=_VECT) && (feuille._VECTptr->size()!=2)) 501 return "Invalid_RPN_WHILE"; 502 return "WHILE "+ printinner_VECT(*feuille._VECTptr->front()._VECTptr,_RPN_FUNC__VECT,contextptr) + " REPEAT "+printinner_VECT(*feuille._VECTptr->back()._VECTptr,_RPN_FUNC__VECT,contextptr)+ " END "; 503 } symb_RPN_WHILE(const gen & a,const gen & b)504 gen symb_RPN_WHILE(const gen & a,const gen & b){ 505 return symbolic(at_RPN_WHILE,makesequence(a,b)); 506 } _RPN_WHILE(const gen & args,const context * contextptr)507 gen _RPN_WHILE(const gen & args,const context * contextptr) { 508 if ( args.type==_STRNG && args.subtype==-1) return args; 509 // stack level 2=condition 510 // level 1=program to execute 511 if (args.type!=_VECT) 512 return symbolic(at_RPN_WHILE,args); 513 int s=int(args._VECTptr->size()); 514 if (s<2) 515 return gentoofewargs("RPN_WHILE must have at least 2 args"); 516 gen prog=args._VECTptr->back(); 517 args._VECTptr->pop_back(); 518 gen controle=args._VECTptr->back(); 519 args._VECTptr->pop_back(); 520 vecteur res; 521 for (;;){ 522 res=rpn_eval(controle,*args._VECTptr,contextptr); 523 if (args._VECTptr->empty()) 524 return gentoofewargs("WHILE"); 525 gen tmp=args._VECTptr->back(); 526 args._VECTptr->pop_back(); 527 if (is_zero(tmp.eval(1,contextptr).evalf(1,contextptr))) 528 break; 529 res=rpn_eval(prog,*args._VECTptr,contextptr); 530 } 531 return gen(res,_RPN_STACK__VECT); 532 } 533 static const char _RPN_WHILE_s []="RPN_WHILE"; 534 static define_unary_function_eval2_index (134,__RPN_WHILE,&_RPN_WHILE,_RPN_WHILE_s,&printasRPN_WHILE); 535 define_unary_function_ptr5( at_RPN_WHILE ,alias_at_RPN_WHILE ,&__RPN_WHILE,0,T_RPN_OP); 536 printasRPN_CASE(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)537 static string printasRPN_CASE(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 538 if (feuille.type!=_VECT) 539 return "Invalid_RPN_CASE"; 540 vecteur v=*feuille._VECTptr; 541 if ((v.size()!=1) ||(v.front().type!=_VECT)) 542 return "Invalid_RPN_CASE"; 543 string res("CASE "); 544 const_iterateur it=v.front()._VECTptr->begin(),itend=v.front()._VECTptr->end(); 545 for (;it!=itend;){ 546 res += printinner_VECT(*it->_VECTptr,_RPN_FUNC__VECT,contextptr); 547 ++it; 548 if (it==itend) 549 break; 550 res += " THEN " + printinner_VECT(*it->_VECTptr,_RPN_FUNC__VECT,contextptr) + " END "; 551 ++it; 552 } 553 return res+" END "; 554 } symb_RPN_CASE(const gen & a)555 gen symb_RPN_CASE(const gen & a){ 556 return symbolic(at_RPN_CASE,vecteur(1,a)); 557 } _RPN_CASE(const gen & args,const context * contextptr)558 gen _RPN_CASE(const gen & args,const context * contextptr) { 559 if ( args.type==_STRNG && args.subtype==-1) return args; 560 // level 1=[case1, prg1, case2,prg2,..., [default]] 561 if (args.type!=_VECT) 562 return symbolic(at_RPN_CASE,args); 563 int s=int(args._VECTptr->size()); 564 if (s<1) 565 return gentoofewargs("RPN_CASE must have at least 1 arg"); 566 vecteur controle=*args._VECTptr->back()._VECTptr; 567 args._VECTptr->pop_back(); 568 const_iterateur it=controle.begin(),itend=controle.end(); 569 vecteur res; 570 for (;it!=itend;){ 571 res=rpn_eval(*it,*args._VECTptr,contextptr); 572 if (args._VECTptr->empty()) 573 return gentoofewargs("CASE"); 574 ++it; 575 if (it==itend) // default of the case struct 576 break; 577 gen test=args._VECTptr->back(); 578 args._VECTptr->pop_back(); 579 if (!(is_zero(test.eval(1,contextptr).evalf(1,contextptr)))){ 580 res=rpn_eval(*it,*args._VECTptr,contextptr); 581 break; 582 } 583 ++it; 584 } 585 return gen(*args._VECTptr,_RPN_STACK__VECT); 586 } 587 static const char _RPN_CASE_s []="RPN_CASE"; 588 static define_unary_function_eval2_index (128,__RPN_CASE,&_RPN_CASE,_RPN_CASE_s,&printasRPN_CASE); 589 define_unary_function_ptr5( at_RPN_CASE ,alias_at_RPN_CASE ,&__RPN_CASE,0,T_RPN_OP); 590 printasRPN_UNTIL(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)591 static string printasRPN_UNTIL(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 592 if ( (feuille.type!=_VECT) && (feuille._VECTptr->size()!=2)) 593 return "Invalid_RPN_UNTIL"; 594 return "DO "+ printinner_VECT(*feuille._VECTptr->front()._VECTptr,_RPN_FUNC__VECT,contextptr) + " UNTIL "+printinner_VECT(*feuille._VECTptr->back()._VECTptr,_RPN_FUNC__VECT,contextptr)+ " END "; 595 } symb_RPN_UNTIL(const gen & a,const gen & b)596 gen symb_RPN_UNTIL(const gen & a,const gen & b){ 597 return symbolic(at_RPN_UNTIL,makesequence(a,b)); 598 } _RPN_UNTIL(const gen & args,const context * contextptr)599 gen _RPN_UNTIL(const gen & args,const context * contextptr) { 600 if ( args.type==_STRNG && args.subtype==-1) return args; 601 // stack level 2=program 602 // level 1=condition 603 if (args.type!=_VECT) 604 return symbolic(at_RPN_UNTIL,args); 605 int s=int(args._VECTptr->size()); 606 if (s<2) 607 return gentoofewargs("RPN_UNTIL must have at least 2 args"); 608 gen controle=args._VECTptr->back(); 609 args._VECTptr->pop_back(); 610 gen prog=args._VECTptr->back(); 611 args._VECTptr->pop_back(); 612 vecteur res; 613 for (;;){ 614 res=rpn_eval(prog,*args._VECTptr,contextptr); 615 res=rpn_eval(controle,*args._VECTptr,contextptr); 616 if (args._VECTptr->empty()) 617 return gentoofewargs("UNTIL"); 618 gen tmp=args._VECTptr->back(); 619 args._VECTptr->pop_back(); 620 if (!is_zero(tmp.eval(eval_level(contextptr),contextptr).evalf(eval_level(contextptr),contextptr))) 621 break; 622 } 623 return gen(res,_RPN_STACK__VECT); 624 } 625 static const char _RPN_UNTIL_s []="RPN_UNTIL"; 626 static define_unary_function_eval2 (__RPN_UNTIL,&_RPN_UNTIL,_RPN_UNTIL_s,&printasRPN_UNTIL); 627 define_unary_function_ptr( at_RPN_UNTIL ,alias_at_RPN_UNTIL ,&__RPN_UNTIL); 628 629 // RPN evaluation loop (_VECTEVAL), no return stack currently rpn_eval(const vecteur & prog,vecteur & pile,const context * contextptr)630 vecteur rpn_eval(const vecteur & prog,vecteur & pile,const context * contextptr){ 631 const_iterateur it=prog.begin(),itend=prog.end(); 632 for (;it!=itend;++it){ 633 if (it->type==_FUNC){ 634 // test nargs with subtype 635 int nargs=it->subtype; 636 if (nargs>signed(pile.size())) 637 return vecteur(1,gentoofewargs(it->print(contextptr)+": stack "+gen(pile).print(contextptr))); 638 if (nargs==1){ 639 pile.back()=(*it->_FUNCptr)(pile.back(),contextptr); 640 } 641 else { 642 if (nargs){ 643 vecteur v(nargs); 644 for (int k=nargs-1;k>=0;--k){ 645 v[k]=pile.back(); 646 pile.pop_back(); 647 } 648 pile.push_back((*it->_FUNCptr)(v,contextptr)); 649 } 650 else { 651 gen res; 652 if (*it->_FUNCptr==at_eval){ // eval stack level 1 653 if (pile.empty()) 654 return vecteur(1,gentoofewargs("EVAL")); 655 res=pile.back(); 656 pile.pop_back(); 657 if ( (res.type==_SYMB) && (res._SYMBptr->sommet==at_rpn_prog)) 658 res=res._SYMBptr->feuille; 659 res=rpn_eval(res,pile,contextptr); 660 } 661 else 662 res=(*it->_FUNCptr)(pile,contextptr); 663 if ( (res.type==_VECT) && (res.subtype==_RPN_STACK__VECT) ) 664 pile= *res._VECTptr; 665 else 666 pile= vecteur(1,res); 667 } 668 } 669 } 670 else { 671 // test for special symbolic (control struct) 672 const unary_function_ptr control_op[]={*at_RPN_LOCAL,*at_RPN_FOR,*at_IFTE,*at_RPN_CASE,*at_RPN_WHILE,*at_RPN_UNTIL,0}; 673 if ( (it->type==_SYMB) && equalposcomp(control_op,it->_SYMBptr->sommet)){ 674 // push args of it to the stack and call sommet on the stack 675 if (it->_SYMBptr->feuille.type!=_VECT) // should not happen! 676 pile.push_back(it->_SYMBptr->feuille); 677 else 678 pile=mergevecteur(pile,*it->_SYMBptr->feuille._VECTptr); 679 gen res=it->_SYMBptr->sommet(pile,contextptr); 680 if ( (res.type==_VECT) && (res.subtype==_RPN_STACK__VECT) ) 681 pile= *res._VECTptr; 682 else 683 pile= vecteur(1,res); 684 } 685 else { 686 if ( (it->type!=_VECT) 687 // || (it->subtype==_RPN_FUNC__VECT) 688 ){ 689 gen res=it->eval(1,contextptr); 690 if ( (res.type==_VECT) && (res.subtype==_RPN_STACK__VECT)) 691 pile=*res._VECTptr; 692 else 693 pile.push_back(res); 694 } 695 else 696 pile.push_back(*it); 697 } 698 } 699 } 700 return pile; 701 } 702 rpn_eval(const gen & prog,vecteur & pile,const context * contextptr)703 vecteur rpn_eval(const gen & prog,vecteur & pile,const context * contextptr){ 704 if (prog.type!=_VECT) 705 return rpn_eval(vecteur(1,prog),pile,contextptr); 706 else 707 return rpn_eval(*prog._VECTptr,pile,contextptr); 708 } 709 printasrpn_prog(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)710 static string printasrpn_prog(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 711 if (feuille.type!=_VECT) 712 return "<< "+feuille.print(contextptr)+" >>"; 713 return "<< "+printinner_VECT(*feuille._VECTptr,_RPN_FUNC__VECT,contextptr)+" >>"; 714 } symb_rpn_prog(const gen & args)715 gen symb_rpn_prog(const gen & args){ 716 return symbolic(at_rpn_prog,args); 717 } _rpn_prog(const gen & args,const context * contextptr)718 gen _rpn_prog(const gen & args,const context * contextptr){ 719 if ( args.type==_STRNG && args.subtype==-1) return args; 720 if (!rpn_mode(contextptr) || (args.type!=_VECT)) 721 return symbolic(at_rpn_prog,args); 722 vecteur pile(history_out(contextptr)); 723 *logptr(contextptr) << pile << " " << args << '\n'; 724 return gen(rpn_eval(*args._VECTptr,pile,contextptr),_RPN_STACK__VECT); 725 } 726 static const char _rpn_prog_s []="rpn_prog"; 727 static define_unary_function_eval2_index (83,__rpn_prog,&_rpn_prog,_rpn_prog_s,&printasrpn_prog); 728 define_unary_function_ptr5( at_rpn_prog ,alias_at_rpn_prog,&__rpn_prog,_QUOTE_ARGUMENTS,0); 729 730 #endif // RTOS_THREADX 731 _RCL(const gen & args,const context * contextptr)732 gen _RCL(const gen & args,const context * contextptr) { 733 if ( args.type==_STRNG && args.subtype==-1) return args; 734 // stack level 2=condition 735 // level 1=program to execute 736 if (args.type!=_IDNT) 737 return symbolic(at_RCL,args); 738 return args._IDNTptr->eval(1,args,contextptr); 739 } 740 static const char _RCL_s []="RCL"; 741 static define_unary_function_eval (__RCL,&_RCL,_RCL_s); 742 define_unary_function_ptr5( at_RCL ,alias_at_RCL ,&__RCL,0,T_RPN_OP); 743 744 #if defined(__APPLE__) // || defined(__FreeBSD__) int_one(struct dirent * unused)745 static int int_one (struct dirent *unused){ 746 return 1; 747 } 748 #else int_one(const struct dirent * unused)749 static int int_one (const struct dirent *unused){ 750 return 1; 751 } 752 #endif 753 _VARS(const gen & args,const context * contextptr)754 gen _VARS(const gen & args,const context * contextptr) { 755 if ( args.type==_STRNG && args.subtype==-1) return args; 756 bool val=is_one(args); 757 bool valonly=args==-2; 758 bool valsto=is_minus_one(args); 759 bool strng=args==2; 760 bool strngeq=args==3; 761 vecteur res; 762 if (contextptr){ 763 if (contextptr->globalcontextptr && contextptr->globalcontextptr->tabptr){ 764 sym_tab::const_iterator it=contextptr->globalcontextptr->tabptr->begin(),itend=contextptr->globalcontextptr->tabptr->end(); 765 #if defined FXCG || defined GIAC_HAS_STO_38 || defined KHICAS 766 vecteur * keywordsptr=0; 767 #else 768 vecteur * keywordsptr=keywords_vecteur_ptr(); 769 #endif 770 for (;it!=itend;++it){ 771 lastprog_name(it->first,contextptr); 772 gen g=identificateur(it->first); 773 if (keywordsptr==0 || !equalposcomp(*keywordsptr,g)){ 774 if (strng) 775 g=string2gen(it->first,false); 776 if (strngeq){ 777 res.push_back(string2gen(it->first,false)); 778 int t=it->second.type; 779 #if !defined GIAC_HAS_STO_38 && !defined FXCG && !defined KHICAS 780 if ( (t==_SYMB && it->second._SYMBptr->sommet!=at_program) || t==_FRAC || t<=_REAL || t==_VECT) 781 g=_mathml(makesequence(it->second,1),contextptr); 782 else 783 #endif 784 g=string2gen(it->second.print(contextptr),false); 785 } 786 if (valonly) 787 res.push_back(it->second); 788 else { 789 if (val) 790 g=symbolic(at_equal,makesequence(g,it->second)); 791 if (valsto) 792 g=symb_sto(it->second,g); 793 res.push_back(g); 794 } 795 } 796 } 797 } 798 return res; 799 } 800 if (!variables_are_files(contextptr)){ 801 lock_syms_mutex(); 802 sym_string_tab::const_iterator it=syms().begin(),itend=syms().end(); 803 for (;it!=itend;++it){ 804 gen id=it->second; 805 if (id.type==_IDNT && id._IDNTptr->value){ 806 res.push_back(id); 807 } 808 } 809 unlock_syms_mutex(); 810 if (is_one(args) && current_folder_name.type==_IDNT && current_folder_name._IDNTptr->value){ // add variables of the current folder 811 gen & tmp=*current_folder_name._IDNTptr->value; 812 if (tmp.type==_VECT){ 813 vecteur v=*current_folder_name._IDNTptr->value->_VECTptr; 814 iterateur it=v.begin(),itend=v.end(); 815 for (;it!=itend;++it){ 816 if (it->type!=_VECT || it->_VECTptr->size()!=2) 817 continue; 818 vecteur & w=*it->_VECTptr; 819 res.push_back(w[0]); 820 } 821 } 822 } 823 return res; 824 } 825 #ifndef VARIABLE_ARE_FILES 826 return undef; 827 #else 828 struct dirent **eps; 829 int n; 830 n = scandir ("./", &eps, int_one, alphasort); 831 if (n >= 0){ 832 string s; 833 int cnt; 834 for (cnt = 0; cnt < n; ++cnt){ 835 s=string(eps[cnt]->d_name); 836 unsigned k=0; 837 for (;k<s.size();++k){ 838 if (!isalphan(s[k])) 839 break; 840 } 841 if ( (k==s.size()-4) && (s[k]=='.') && (s.substr(k+1,3)=="cas") ) 842 res.push_back(identificateur(s.substr(0,k))); 843 } 844 if ( rpn_mode(contextptr) && (args.type==_VECT) && (args.subtype==_RPN_STACK__VECT) ){ 845 args._VECTptr->push_back(res); 846 return args; 847 } 848 return res; 849 } 850 else 851 settypeerr ("Couldn't open the directory"); 852 return 0; 853 #endif 854 } 855 856 static const char _VARS_s []="VARS"; 857 static define_unary_function_eval (__VARS,&_VARS,_VARS_s); 858 define_unary_function_ptr( at_VARS ,alias_at_VARS ,&__VARS); 859 purgenoassume(const gen & args,const context * contextptr)860 gen purgenoassume(const gen & args,const context * contextptr){ 861 if (args.type==_VECT){ 862 vecteur & v=*args._VECTptr; 863 vecteur res; 864 for (unsigned i=0;i<v.size();++i) 865 res.push_back(purgenoassume(v[i],contextptr)); 866 return res; 867 } 868 if (args.type!=_IDNT) 869 return gensizeerr("Invalid purgenoassume "+args.print(contextptr)); 870 if (!contextptr) 871 return _purge(args,0); 872 const char * ch=args._IDNTptr->id_name; 873 if (strlen(ch)==1){ 874 if (ch[0]=='O' && (series_flags(contextptr) & (1<<6)) ) 875 series_flags(contextptr) ^= (1<<6); 876 if (ch[0]==series_variable_name(contextptr)){ 877 if (series_flags(contextptr) & (1<<5)) 878 series_flags(contextptr) ^= (1<<5); 879 if (series_flags(contextptr) & (1<<6)) 880 series_flags(contextptr) ^= (1<<6); 881 } 882 } 883 // purge a global variable 884 sym_tab::iterator it=contextptr->tabptr->find(ch),itend=contextptr->tabptr->end(); 885 if (it==itend) 886 return string2gen("No such variable "+args.print(contextptr),false); 887 gen res=it->second; 888 if (it->second.type==_POINTER_ && it->second.subtype==_THREAD_POINTER) 889 return gentypeerr(args.print(contextptr)+" is locked by thread "+it->second.print(contextptr)); 890 if (contextptr->previous) 891 it->second=identificateur(it->first); 892 else 893 contextptr->tabptr->erase(it); 894 if (res.is_symb_of_sommet(at_rootof)) 895 _purge(res,contextptr); 896 return res; 897 } 898 _purge(const gen & args,const context * contextptr)899 gen _purge(const gen & args,const context * contextptr) { 900 if ( args.type==_STRNG && args.subtype==-1) return args; 901 if (rpn_mode(contextptr) && (args.type==_VECT)){ 902 if (!args._VECTptr->size()) 903 return gentoofewargs("purge"); 904 gen apurger=args._VECTptr->back(); 905 _purge(apurger,contextptr); 906 args._VECTptr->pop_back(); 907 return gen(*args._VECTptr,_RPN_STACK__VECT); 908 } 909 if (args.type==_VECT) 910 return apply(args,contextptr,_purge); 911 if (args.is_symb_of_sommet(at_at)){ 912 gen & f = args._SYMBptr->feuille; 913 if (f.type==_VECT && f._VECTptr->size()==2){ 914 gen m = eval(f._VECTptr->front(),eval_level(contextptr),contextptr); 915 gen indice=eval(f._VECTptr->back(),eval_level(contextptr),contextptr); 916 if (m.type==_MAP){ 917 gen_map::iterator it=m._MAPptr->find(indice),itend=m._MAPptr->end(); 918 if (it==itend) 919 return gensizeerr(gettext("Bad index")+indice.print(contextptr)); 920 m._MAPptr->erase(it); 921 return 1; 922 } 923 if (m.type==_VECT && indice.type==_INT_){ 924 vecteur & v = *m._VECTptr; 925 int i=indice.val; 926 if (i>=0 && i<v.size()){ 927 v.erase(v.begin()+i); 928 return 1; 929 } 930 return gendimerr(contextptr); 931 } 932 } 933 } 934 if (contextptr && args.is_symb_of_sommet(at_rootof)){ 935 gen a=eval(args,1,contextptr); 936 if (!a.is_symb_of_sommet(at_rootof)) 937 return gensizeerr(gettext("Bad rootof")); 938 if (!contextptr->globalcontextptr->rootofs) 939 contextptr->globalcontextptr->rootofs=new vecteur; 940 gen Pmin=a._SYMBptr->feuille; 941 if (Pmin.type!=_VECT || Pmin._VECTptr->size()!=2 || Pmin._VECTptr->front()!=makevecteur(1,0)) 942 return gensizeerr(gettext("Bad rootof")); 943 Pmin=Pmin._VECTptr->back(); 944 vecteur & r =*contextptr->globalcontextptr->rootofs; 945 for (unsigned i=0;i<r.size();++i){ 946 gen ri=r[i]; 947 if (ri.type==_VECT && ri._VECTptr->size()==2 && Pmin==ri._VECTptr->front()){ 948 gen a=ri._VECTptr->back(); 949 r.erase(r.begin()+i); 950 return _purge(a,contextptr); 951 } 952 } 953 return 0; 954 } 955 if (args.type!=_IDNT) 956 return symbolic(at_purge,args); 957 // REMOVED! args.eval(eval_level(contextptr),contextptr); 958 if (contextptr){ 959 if (contextptr->globalcontextptr!=contextptr){ 960 // purge a local variable = set it to assume(DOM_SYMBOLIC) 961 gen a2(_SYMB); 962 a2.subtype=1; 963 return sto(gen(makevecteur(a2),_ASSUME__VECT),args,contextptr); 964 } 965 return purgenoassume(args,contextptr); 966 } 967 if (current_folder_name.type==_IDNT && current_folder_name._IDNTptr->value && current_folder_name._IDNTptr->value->type==_VECT){ 968 vecteur v=*current_folder_name._IDNTptr->value->_VECTptr; 969 iterateur it=v.begin(),itend=v.end(); 970 gen val; 971 for (;it!=itend;++it){ 972 if (it->type!=_VECT || it->_VECTptr->size()!=2) 973 continue; 974 vecteur & w=*it->_VECTptr; 975 if (w[0]==args){ 976 val=w[1]; 977 break; 978 } 979 } 980 if (it!=itend){ 981 v.erase(it); 982 gen res=gen(v,_FOLDER__VECT); 983 *current_folder_name._IDNTptr->value=res; 984 #ifdef HAVE_SIGNAL_H_OLD 985 if (!child_id && signal_store) 986 _signal(symb_quote(symbolic(at_sto,makesequence(res,current_folder_name))),contextptr); 987 #endif 988 return val; 989 } 990 } 991 if (args._IDNTptr->value){ 992 #if !defined RTOS_THREADX && !defined BESTA_OS && !defined FREERTOS && !defined FXCG 993 if (variables_are_files(contextptr)) 994 unlink((args._IDNTptr->name()+string(cas_suffixe)).c_str()); 995 #endif 996 gen res=*args._IDNTptr->value; 997 if (res.type==_VECT && res.subtype==_FOLDER__VECT){ 998 if (res._VECTptr->size()!=1) 999 return gensizeerr(gettext("Non-empty folder")); 1000 } 1001 delete args._IDNTptr->value; 1002 args._IDNTptr->value=0; 1003 #ifdef HAVE_SIGNAL_H_OLD 1004 if (!child_id && signal_store) 1005 _signal(symb_quote(symb_purge(args)),contextptr); 1006 #endif 1007 return res; 1008 } 1009 else 1010 return string2gen(args.print(contextptr)+" not assigned",false); 1011 } 1012 static const char _purge_s []="purge"; 1013 static define_unary_function_eval_quoted (__purge,&_purge,_purge_s); 1014 define_unary_function_ptr5( at_purge ,alias_at_purge,&__purge,_QUOTE_ARGUMENTS,0); 1015 printasdivision(const gen & feuille,const char * s,GIAC_CONTEXT)1016 static string printasdivision(const gen & feuille,const char * s,GIAC_CONTEXT){ 1017 if (feuille.type!=_VECT || feuille._VECTptr->size()!=2) 1018 return printsommetasoperator(feuille,s,contextptr); 1019 gen n=feuille._VECTptr->front(); 1020 bool need=need_parenthesis(n); 1021 string res; 1022 if (need) res+='('; 1023 res += n.print(contextptr); 1024 if (need) res += ')'; 1025 res += '/'; 1026 gen f=feuille._VECTptr->back(); 1027 if ( (f.type==_SYMB && ( f._SYMBptr->sommet==at_plus || f._SYMBptr->sommet==at_prod || f._SYMBptr->sommet==at_division || f._SYMBptr->sommet==at_inv || need_parenthesis(f._SYMBptr->sommet) )) || (f.type==_CPLX) || (f.type==_MOD)){ 1028 res += '('; 1029 res += f.print(contextptr); 1030 res += ')'; 1031 } 1032 else 1033 res += f.print(contextptr); 1034 return res; 1035 } 1036 texprintasdivision(const gen & feuille,const char * s,GIAC_CONTEXT)1037 static string texprintasdivision(const gen & feuille,const char * s,GIAC_CONTEXT){ 1038 if (feuille.type!=_VECT || feuille._VECTptr->size()!=2) 1039 return "invalid /"; 1040 return "\\frac{"+gen2tex(feuille._VECTptr->front(),contextptr)+"}{"+gen2tex(feuille._VECTptr->back(),contextptr)+"}"; 1041 } symb_division(const gen & args)1042 static gen symb_division(const gen & args){ 1043 return symbolic(at_division,args); 1044 } _division(const gen & args,GIAC_CONTEXT)1045 gen _division(const gen & args,GIAC_CONTEXT){ 1046 if ( args.type==_STRNG && args.subtype==-1) return args; 1047 if ( (args.type!=_VECT) || (args._VECTptr->size()!=2) ) 1048 return symb_division(args); 1049 gen a=args._VECTptr->front(),b=args._VECTptr->back(); 1050 if (a.is_approx()){ 1051 gen b1; 1052 if (has_evalf(b,b1,1,contextptr) && b.type!=b1.type){ 1053 #ifdef HAVE_LIBMPFR 1054 if (a.type==_REAL){ 1055 gen b2=accurate_evalf(b,mpfr_get_prec(a._REALptr->inf)); 1056 if (b2.is_approx()) 1057 return (*a._REALptr)/b2; 1058 } 1059 #endif 1060 return rdiv(a,b1,contextptr); 1061 } 1062 } 1063 if (b.is_approx()){ 1064 gen a1; 1065 if (has_evalf(a,a1,1,contextptr) && a.type!=a1.type){ 1066 #ifdef HAVE_LIBMPFR 1067 if (b.type==_REAL){ 1068 gen a2=accurate_evalf(a,mpfr_get_prec(b._REALptr->inf)); 1069 if (a2.is_approx()) 1070 return a2/b; 1071 } 1072 #endif 1073 return rdiv(a1,b,contextptr); 1074 } 1075 } 1076 return rdiv(a,b,contextptr); 1077 } 1078 static const char _division_s []="/"; 1079 static define_unary_function_eval4_index (10,__division,&_division,_division_s,&printasdivision,&texprintasdivision); 1080 define_unary_function_ptr( at_division ,alias_at_division ,&__division); 1081 symb_binary_minus(const gen & args)1082 static gen symb_binary_minus(const gen & args){ 1083 return symbolic(at_binary_minus,args); 1084 } _binary_minus(const gen & args,GIAC_CONTEXT)1085 gen _binary_minus(const gen & args,GIAC_CONTEXT){ 1086 if ( args.type==_STRNG && args.subtype==-1) return args; 1087 if ( (args.type!=_VECT) || (args._VECTptr->size()!=2) ) 1088 return symb_binary_minus(args); 1089 return args._VECTptr->front()-args._VECTptr->back(); 1090 } 1091 static const char _binary_minus_s[]="-"; 1092 static define_unary_function_eval4_index (6,__binary_minus,&_binary_minus,_binary_minus_s,&printsommetasoperator,&texprintsommetasoperator); 1093 define_unary_function_ptr( at_binary_minus ,alias_at_binary_minus ,&__binary_minus); 1094 tab2vecteur(gen tab[])1095 vecteur tab2vecteur(gen tab[]){ 1096 vecteur res; 1097 for (;!is_zero(*tab);++tab) 1098 res.push_back(*tab); 1099 return res; 1100 } 1101 1102 // hp38 compatibility 1103 // model _hp38(const gen & args,GIAC_CONTEXT)1104 gen _hp38(const gen & args,GIAC_CONTEXT){ 1105 if ( args.type==_STRNG && args.subtype==-1) return args; 1106 if ( (args.type!=_VECT) || (args._VECTptr->size()!=2) ) 1107 return gensizeerr(contextptr); 1108 return undef; 1109 } 1110 static const char _hp38_s[]="hp38"; 1111 static define_unary_function_eval (__hp38,&_hp38,_hp38_s); 1112 define_unary_function_ptr5( at_hp38 ,alias_at_hp38,&__hp38,0,true); 1113 1114 // real/complex _ABS(const gen & args,GIAC_CONTEXT)1115 gen _ABS(const gen & args,GIAC_CONTEXT){ 1116 if ( args.type==_STRNG && args.subtype==-1) return args; 1117 if (args.type!=_VECT) 1118 return abs(args,contextptr); 1119 if (args.subtype) 1120 return apply(args,_abs,contextptr); 1121 vecteur v; 1122 aplatir(*args._VECTptr,v); 1123 return _l2norm(v,contextptr); 1124 } 1125 static const char _ABS_s[]="ABS"; 1126 static define_unary_function_eval (__ABS,&_ABS,_ABS_s); 1127 define_unary_function_ptr5( at_ABS ,alias_at_ABS,&__ABS,0,T_UNARY_OP_38); 1128 _ARG38(const gen & g,GIAC_CONTEXT)1129 gen _ARG38(const gen & g,GIAC_CONTEXT){ 1130 // if (angle_radian(contextptr)==0) return arg(evalf2bcd(g,1,contextptr),contextptr); 1131 return arg(g,contextptr); 1132 } 1133 static const char _ARG38_s[]="ARG"; 1134 static define_unary_function_eval (__ARG38,&_ARG38,_ARG38_s); 1135 define_unary_function_ptr5( at_ARG38 ,alias_at_ARG38,&__ARG38,0,T_UNARY_OP_38); 1136 1137 static const char _CONJ_s[]="CONJ"; 1138 static define_unary_function_eval (__CONJ,(const gen_op_context)conj,_CONJ_s); 1139 define_unary_function_ptr5( at_CONJ ,alias_at_CONJ,&__CONJ,0,T_UNARY_OP_38); 1140 1141 static const char _RE_s[]="RE"; 1142 static define_unary_function_eval (__RE,(const gen_op_context)re,_RE_s); 1143 define_unary_function_ptr5( at_RE ,alias_at_RE,&__RE,0,T_UNARY_OP_38); 1144 1145 static const char _IM_s[]="IM"; 1146 static define_unary_function_eval (___IM,(const gen_op_context)im,_IM_s); 1147 define_unary_function_ptr5( at_IM ,alias_at_IM,&___IM,0,T_UNARY_OP_38); 1148 1149 static const char _FLOOR_s[]="FLOOR"; 1150 static define_unary_function_eval (__FLOOR,(const gen_op_context)_floor,_FLOOR_s); 1151 define_unary_function_ptr5( at_FLOOR ,alias_at_FLOOR,&__FLOOR,0,T_UNARY_OP_38); 1152 1153 static const char _CEILING_s[]="CEILING"; 1154 static define_unary_function_eval (__CEILING,(const gen_op_context)_ceil,_CEILING_s); 1155 define_unary_function_ptr5( at_CEILING ,alias_at_CEILING,&__CEILING,0,T_UNARY_OP_38); 1156 FP(const gen & g,GIAC_CONTEXT)1157 gen FP(const gen & g,GIAC_CONTEXT){ 1158 if (is_undef(g)) 1159 return g; 1160 if (is_equal(g)) 1161 return apply_to_equal(g,FP,contextptr); 1162 return g-_INT(g,contextptr); 1163 } 1164 static const char _FRAC_s[]="FP"; 1165 static define_unary_function_eval (__FRAC,&FP,_FRAC_s); 1166 define_unary_function_ptr5( at_FRAC ,alias_at_FRAC,&__FRAC,0,T_UNARY_OP_38); 1167 1168 static const char _MAX_s[]="MAX"; 1169 static define_unary_function_eval (__MAX,&_max,_MAX_s); 1170 define_unary_function_ptr5( at_MAX ,alias_at_MAX,&__MAX,0,T_UNARY_OP_38); 1171 1172 static const char _MIN_s[]="MIN"; 1173 static define_unary_function_eval (__MIN,&_min,_MIN_s); 1174 define_unary_function_ptr5( at_MIN ,alias_at_MIN,&__MIN,0,T_UNARY_OP_38); 1175 _MODULO(const gen & args,GIAC_CONTEXT)1176 gen _MODULO(const gen & args,GIAC_CONTEXT){ 1177 if ( args.type==_STRNG && args.subtype==-1) return args; 1178 if (args.type==_VECT && args._VECTptr->size()==2){ 1179 gen a=args._VECTptr->front(),b=args._VECTptr->back(); 1180 if (is_zero(b)) 1181 return a; 1182 if (is_integer(a)&&is_integer(b)) 1183 return _irem(args,contextptr); 1184 if (a.type==_FLOAT_){ 1185 if (b.type==_FLOAT_) 1186 return fmod(a._FLOAT_val,b._FLOAT_val); 1187 if (b.type==_INT_) 1188 return fmod(a._FLOAT_val,giac_float(b.val)); 1189 } 1190 return a-b*_floor(a/b,contextptr); 1191 } 1192 return gentypeerr(contextptr); 1193 } 1194 static const char _MOD_s[]="MOD"; 1195 static define_unary_function_eval4 (__MOD,&_MODULO,_MOD_s,&printsommetasoperator,&texprintsommetasoperator); 1196 define_unary_function_ptr5( at_MOD ,alias_at_MOD,&__MOD,0,T_DIV); 1197 1198 static const char _ROUND_s[]="ROUND"; 1199 static define_unary_function_eval (__ROUND,&_round,_ROUND_s); 1200 define_unary_function_ptr5( at_ROUND ,alias_at_ROUND,&__ROUND,0,T_UNARY_OP_38); 1201 _INTERSECT(const gen & g,GIAC_CONTEXT)1202 gen _INTERSECT(const gen & g,GIAC_CONTEXT){ 1203 return _intersect(g,contextptr); 1204 } 1205 static const char _INTERSECT_s[]="INTERSECT"; 1206 static define_unary_function_eval (__INTERSECT,&_INTERSECT,_INTERSECT_s); 1207 define_unary_function_ptr5( at_INTERSECT ,alias_at_INTERSECT,&__INTERSECT,0,T_UNARY_OP_38); 1208 _UNION(const gen & g,GIAC_CONTEXT)1209 gen _UNION(const gen & g,GIAC_CONTEXT){ 1210 return _union(g,contextptr); 1211 } 1212 static const char _UNION_s[]="UNION"; 1213 static define_unary_function_eval (__UNION,&_UNION,_UNION_s); 1214 define_unary_function_ptr5( at_UNION ,alias_at_UNION,&__UNION,0,T_UNARY_OP_38); 1215 _MINUS(const gen & g,GIAC_CONTEXT)1216 gen _MINUS(const gen & g,GIAC_CONTEXT){ 1217 return _minus(g,contextptr); 1218 } 1219 static const char _MINUS_s[]="MINUS"; 1220 static define_unary_function_eval (__MINUS,&_MINUS,_MINUS_s); 1221 define_unary_function_ptr5( at_MINUS ,alias_at_MINUS,&__MINUS,0,T_UNARY_OP_38); 1222 1223 gen _trunc(const gen & args,GIAC_CONTEXT); 1224 1225 static const char _TRUNCATE_s[]="TRUNCATE"; 1226 static define_unary_function_eval (__TRUNCATE,&_trunc,_TRUNCATE_s); 1227 define_unary_function_ptr5( at_TRUNCATE ,alias_at_TRUNCATE,&__TRUNCATE,0,T_UNARY_OP_38); 1228 1229 static const char _QUOTE_s[]="QUOTE"; 1230 static define_unary_function_eval_quoted (__QUOTE,"e,_QUOTE_s); 1231 define_unary_function_ptr5( at_QUOTE ,alias_at_QUOTE,&__QUOTE,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1232 1233 // Note that 0 is necessary otherwise conflict on freeBSD 1234 static const char _SIGN_s[]="SIGN"; 1235 static define_unary_function_eval (__SIGN0,&sign,_SIGN_s); 1236 define_unary_function_ptr5( at_SIGN ,alias_at_SIGN,&__SIGN0,0,T_UNARY_OP_38); 1237 1238 // proba 1239 static const char _COMB_s[]="COMB"; 1240 static define_unary_function_eval (__COMB,&_comb,_COMB_s); 1241 define_unary_function_ptr5( at_COMB ,alias_at_COMB,&__COMB,0,T_UNARY_OP_38); 1242 1243 static const char _PERM_s[]="PERM"; 1244 static define_unary_function_eval (__PERM,&_perm,_PERM_s); 1245 define_unary_function_ptr5( at_PERM ,alias_at_PERM,&__PERM,0,T_UNARY_OP_38); 1246 printasRANDOM(const gen & feuille,const char * s,GIAC_CONTEXT)1247 string printasRANDOM(const gen & feuille,const char * s,GIAC_CONTEXT){ 1248 if (feuille.type==_VECT && feuille._VECTptr->empty()) 1249 return s; 1250 return "("+(s+(" "+feuille.print())+")"); 1251 } _RANDOM(const gen & g0,GIAC_CONTEXT)1252 gen _RANDOM(const gen & g0,GIAC_CONTEXT){ 1253 gen g(g0); 1254 if ( g.type==_STRNG && g.subtype==-1) return g; 1255 is_integral(g); 1256 if (g.type==_CPLX) 1257 return _rand(gen(makevecteur(*g._CPLXptr,*(g._CPLXptr+1)),_SEQ__VECT),contextptr); 1258 if (g.type!=_VECT || g.subtype!=_SEQ__VECT || !g._VECTptr->empty()) 1259 return _rand(g,contextptr); 1260 return double(giac_rand(contextptr))/rand_max2; 1261 } 1262 static const char _RANDOM_s[]="RANDOM"; 1263 static define_unary_function_eval2 (__RANDOM,&_RANDOM,_RANDOM_s,&printasRANDOM); 1264 define_unary_function_ptr5( at_RANDOM ,alias_at_RANDOM,&__RANDOM,0,T_RETURN); 1265 1266 static const char _RANDSEED_s[]="RANDSEED"; 1267 static define_unary_function_eval (__RANDSEED,&_srand,_RANDSEED_s); 1268 define_unary_function_ptr5( at_RANDSEED ,alias_at_RANDSEED,&__RANDSEED,0,T_RETURN); 1269 _MAXREAL(const gen & g,GIAC_CONTEXT)1270 gen _MAXREAL(const gen & g,GIAC_CONTEXT){ 1271 if ( g.type==_STRNG && g.subtype==-1) return g; 1272 #if 0 // def BCD 1273 return_bcd_maxreal; 1274 #else 1275 return 1.79769313486e+308; 1276 #endif 1277 } 1278 static const char _MAXREAL_s[]="MAXREAL"; 1279 static define_unary_function_eval (__MAXREAL,&_MAXREAL,_MAXREAL_s); 1280 define_unary_function_ptr5( at_MAXREAL ,alias_at_MAXREAL,&__MAXREAL,0,T_NUMBER); 1281 _MINREAL(const gen & g,GIAC_CONTEXT)1282 gen _MINREAL(const gen & g,GIAC_CONTEXT){ 1283 if ( g.type==_STRNG && g.subtype==-1) return g; 1284 #if 0 // def BCD 1285 return_bcd_minreal; 1286 // return_bcd_minreal; 1287 #else 1288 return 2.22507385851e-308; // smallest non-denormalized double 1289 // return 1.26480805335e-321; 1290 #endif 1291 } 1292 static const char _MINREAL_s[]="MINREAL"; 1293 static define_unary_function_eval (__MINREAL,&_MINREAL,_MINREAL_s); 1294 define_unary_function_ptr5( at_MINREAL ,alias_at_MINREAL,&__MINREAL,0,T_NUMBER); 1295 1296 // transcendent 1297 static const char _EXP_s[]="EXP"; 1298 static define_unary_function_eval (__EXP,&exp,_EXP_s); 1299 define_unary_function_ptr5( at_EXP ,alias_at_EXP,&__EXP,0,T_UNARY_OP_38); 1300 1301 #if 0 1302 define_partial_derivative_onearg_genop( D_at_expm1,"D_at_expm1",&exp); 1303 #endif _EXPM1(const gen & g,GIAC_CONTEXT)1304 gen _EXPM1(const gen & g,GIAC_CONTEXT){ 1305 if ( g.type==_STRNG && g.subtype==-1) return g; 1306 if (g.type==_DOUBLE_) 1307 return expm1(g._DOUBLE_val); 1308 return exp(g,contextptr)-1; 1309 } 1310 static const char _EXPM1_s[]="EXPM1"; 1311 static define_unary_function_eval (__EXPM1,&_EXPM1,_EXPM1_s); 1312 define_unary_function_ptr5( at_EXPM1 ,alias_at_EXPM1,&__EXPM1,0,T_UNARY_OP_38); 1313 1314 static const char _expm1_s[]="expm1"; 1315 static define_unary_function_eval (__expm1,&_EXPM1,_expm1_s); 1316 define_unary_function_ptr5( at_expm1 ,alias_at_expm1,&__expm1,0,T_UNARY_OP); 1317 1318 #if 0 1319 static gen d_lnp1(const gen & args,GIAC_CONTEXT){ 1320 return inv(args+1,contextptr); 1321 } 1322 define_partial_derivative_onearg_genop( D_at_lnp1,"D_at_lnp1",&d_lnp1); 1323 #endif _LNP1(const gen & g,GIAC_CONTEXT)1324 gen _LNP1(const gen & g,GIAC_CONTEXT){ 1325 if ( g.type==_STRNG && g.subtype==-1) return g; 1326 if (g.type==_DOUBLE_) 1327 return log1p(g._DOUBLE_val); 1328 return ln(g+1,contextptr); 1329 } 1330 static const char _LNP1_s[]="LNP1"; 1331 static define_unary_function_eval (__LNP1,&_LNP1,_LNP1_s); 1332 define_unary_function_ptr5( at_LNP1 ,alias_at_LNP1,&__LNP1,0,T_UNARY_OP_38); 1333 1334 static const char _log1p_s[]="log1p"; 1335 static define_unary_function_eval (__log1p,&_LNP1,_log1p_s); 1336 define_unary_function_ptr5( at_log1p ,alias_at_log1p,&__log1p,0,T_UNARY_OP); 1337 1338 static const char _LN_s[]="LN"; 1339 static define_unary_function_eval (__LN,&ln,_LN_s); 1340 define_unary_function_ptr5( at_LN ,alias_at_LN,&__LN,0,T_UNARY_OP_38); 1341 _LOG(const gen & g,GIAC_CONTEXT)1342 gen _LOG(const gen & g,GIAC_CONTEXT){ 1343 if (g.type==_VECT && g.subtype==_SEQ__VECT && g._VECTptr->size()==2) 1344 return _logb(g,contextptr); 1345 return log10(g,contextptr); 1346 } 1347 static const char _LOG_s[]="LOG"; 1348 static define_unary_function_eval (__LOG,&_LOG,_LOG_s); 1349 define_unary_function_ptr5( at_LOG ,alias_at_LOG,&__LOG,0,T_UNARY_OP_38); 1350 1351 static const char _ALOG_s[]="ALOG"; 1352 static define_unary_function_eval (__ALOG,&alog10,_ALOG_s); 1353 define_unary_function_ptr5( at_ALOG ,alias_at_ALOG,&__ALOG,0,T_UNARY_OP_38); 1354 1355 static const char _SIN_s[]="SIN"; 1356 static define_unary_function_eval (__SIN,&sin,_SIN_s); 1357 define_unary_function_ptr5( at_SIN ,alias_at_SIN,&__SIN,0,T_UNARY_OP_38); 1358 1359 static const char _COS_s[]="COS"; 1360 static define_unary_function_eval (__COS,&cos,_COS_s); 1361 define_unary_function_ptr5( at_COS ,alias_at_COS,&__COS,0,T_UNARY_OP_38); 1362 1363 static const char _TAN_s[]="TAN"; 1364 static define_unary_function_eval (__TAN,&tan,_TAN_s); 1365 define_unary_function_ptr5( at_TAN ,alias_at_TAN,&__TAN,0,T_UNARY_OP_38); 1366 1367 static const char _ASIN_s[]="ASIN"; 1368 static define_unary_function_eval (__ASIN,&asin,_ASIN_s); 1369 define_unary_function_ptr5( at_ASIN ,alias_at_ASIN,&__ASIN,0,T_UNARY_OP_38); 1370 1371 static const char _ACOS_s[]="ACOS"; 1372 static define_unary_function_eval (__ACOS,&acos,_ACOS_s); 1373 define_unary_function_ptr5( at_ACOS ,alias_at_ACOS,&__ACOS,0,T_UNARY_OP_38); 1374 1375 static const char _ATAN_s[]="ATAN"; 1376 static define_unary_function_eval (__ATAN,&atan,_ATAN_s); 1377 define_unary_function_ptr5( at_ATAN ,alias_at_ATAN,&__ATAN,0,T_UNARY_OP_38); 1378 1379 static const char _SINH_s[]="SINH"; 1380 static define_unary_function_eval (__SINH,&sinh,_SINH_s); 1381 define_unary_function_ptr5( at_SINH ,alias_at_SINH,&__SINH,0,T_UNARY_OP_38); 1382 1383 static const char _COSH_s[]="COSH"; 1384 static define_unary_function_eval (__COSH,&cosh,_COSH_s); 1385 define_unary_function_ptr5( at_COSH ,alias_at_COSH,&__COSH,0,T_UNARY_OP_38); 1386 1387 static const char _TANH_s[]="TANH"; 1388 static define_unary_function_eval (__TANH,&tanh,_TANH_s); 1389 define_unary_function_ptr5( at_TANH ,alias_at_TANH,&__TANH,0,T_UNARY_OP_38); 1390 1391 static const char _ASINH_s[]="ASINH"; 1392 static define_unary_function_eval (__ASINH,&asinh,_ASINH_s); 1393 define_unary_function_ptr5( at_ASINH ,alias_at_ASINH,&__ASINH,0,T_UNARY_OP_38); 1394 1395 static const char _ACOSH_s[]="ACOSH"; 1396 static define_unary_function_eval (__ACOSH,&acosh,_ACOSH_s); 1397 define_unary_function_ptr5( at_ACOSH ,alias_at_ACOSH,&__ACOSH,0,T_UNARY_OP_38); 1398 1399 static const char _ATANH_s[]="ATANH"; 1400 static define_unary_function_eval (__ATANH,&atanh,_ATANH_s); 1401 define_unary_function_ptr5( at_ATANH ,alias_at_ATANH,&__ATANH,0,T_UNARY_OP_38); 1402 is_Ans(const gen & g)1403 bool is_Ans(const gen & g){ 1404 if (g.type==_FUNC && *g._FUNCptr==at_Ans) 1405 return true; 1406 if (g.type==_SYMB && g._SYMBptr->sommet==at_Ans) 1407 return true; 1408 return false; 1409 } 1410 /* matrices */ _ADDROW(const gen & args,GIAC_CONTEXT)1411 gen _ADDROW(const gen & args,GIAC_CONTEXT){ 1412 if ( args.type==_STRNG && args.subtype==-1) return args; 1413 vecteur v(gen2vecteur(args)); 1414 if (!v.empty() && is_Ans(v[0])) 1415 v[0]=eval(v[0],1,contextptr); 1416 if (!v.empty() && v[0].type==_IDNT){ 1417 gen v0=v[0]; 1418 gen g=eval(args,eval_level(contextptr),contextptr); 1419 if (ckmatrix(g[0])){ 1420 gen tmp=_ADDROW(g,contextptr); 1421 return is_undef(tmp)?tmp:sto(tmp,v0,contextptr); 1422 } 1423 } 1424 if (v.size()!=3) 1425 return gentypeerr(contextptr); 1426 v[1]=eval(v[1],1,contextptr); 1427 v[2]=eval(v[2],1,contextptr); 1428 v[2]=_floor(v[2],contextptr); 1429 if (!ckmatrix(v[0]) || v[1].type!=_VECT || v[2].type!=_INT_) 1430 return gentypeerr(contextptr); 1431 vecteur & w = *v[0]._VECTptr; 1432 if (w.front()._VECTptr->size()!=v[1]._VECTptr->size()) 1433 return gendimerr(contextptr); 1434 int s=int(w.size()); 1435 int shift = array_start(contextptr); //xcas_mode(contextptr)!=0 || abs_calc_mode(contextptr)==38; 1436 int l2=v[2].val-shift; 1437 if (l2<0 || l2>s) 1438 return gendimerr(contextptr); 1439 matrice res(w.begin(),w.begin()+l2); 1440 res.push_back(v[1]); 1441 for (int i=l2;i<s;++i) 1442 res.push_back(w[i]); 1443 return res; 1444 } 1445 static const char _ADDROW_s[]="ADDROW"; 1446 static define_unary_function_eval_quoted (__ADDROW,&_ADDROW,_ADDROW_s); 1447 define_unary_function_ptr5( at_ADDROW ,alias_at_ADDROW,&__ADDROW,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1448 _ADDCOL(const gen & args,GIAC_CONTEXT)1449 gen _ADDCOL(const gen & args,GIAC_CONTEXT){ 1450 if ( args.type==_STRNG && args.subtype==-1) return args; 1451 vecteur v(gen2vecteur(args)); 1452 if (!v.empty() && is_Ans(v[0])) 1453 v[0]=eval(v[0],1,contextptr); 1454 if (!v.empty() && v[0].type==_IDNT){ 1455 gen v0=v[0]; 1456 gen g=eval(args,eval_level(contextptr),contextptr); 1457 if (ckmatrix(g[0])){ 1458 gen tmp=_ADDCOL(g,contextptr); 1459 return is_undef(tmp)?tmp:sto(tmp,v0,contextptr); 1460 } 1461 } 1462 if (v.size()!=3 || !ckmatrix(v[0])) 1463 return gensizeerr(contextptr); 1464 matrice m; 1465 mtran(*v[0]._VECTptr,m); 1466 gen res=_ADDROW(makesequence(m,v[1],v[2]),contextptr); 1467 if (res.type==_VECT){ 1468 mtran(*res._VECTptr,m); 1469 res=m; 1470 } 1471 return res; 1472 } 1473 static const char _ADDCOL_s[]="ADDCOL"; 1474 static define_unary_function_eval_quoted (__ADDCOL,&_ADDCOL,_ADDCOL_s); 1475 define_unary_function_ptr5( at_ADDCOL ,alias_at_ADDCOL,&__ADDCOL,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1476 _SCALE(const gen & g,GIAC_CONTEXT)1477 gen _SCALE(const gen & g,GIAC_CONTEXT){ 1478 if ( g.type==_STRNG && g.subtype==-1) return g; 1479 if (g.type!=_VECT || g._VECTptr->size()!=3) 1480 return gensizeerr(contextptr); 1481 vecteur v =*g._VECTptr; 1482 v[1]=eval(v[1],1,contextptr); 1483 v[2]=eval(v[2],1,contextptr); 1484 swapgen(v[0],v[1]); 1485 return _mRow(gen(v,_SEQ__VECT),contextptr); 1486 } 1487 static const char _SCALE_s[]="SCALE"; 1488 static define_unary_function_eval_quoted (__SCALE,&_SCALE,_SCALE_s); 1489 define_unary_function_ptr5( at_SCALE ,alias_at_SCALE,&__SCALE,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1490 1491 static const char _scale_s[]="scale"; 1492 static define_unary_function_eval_quoted (__scale,&_SCALE,_scale_s); 1493 define_unary_function_ptr5( at_scale ,alias_at_scale,&__scale,_QUOTE_ARGUMENTS,T_UNARY_OP); 1494 _SCALEADD(const gen & g,GIAC_CONTEXT)1495 gen _SCALEADD(const gen & g,GIAC_CONTEXT){ 1496 if ( g.type==_STRNG && g.subtype==-1) return g; 1497 if (g.type!=_VECT || g._VECTptr->size()!=4) 1498 return gensizeerr(contextptr); 1499 vecteur v =*g._VECTptr; 1500 v[1]=eval(v[1],1,contextptr); 1501 v[2]=eval(v[2],1,contextptr); 1502 v[3]=eval(v[3],1,contextptr); 1503 swapgen(v[0],v[1]); 1504 return _mRowAdd(gen(v,_SEQ__VECT),contextptr); 1505 } 1506 static const char _SCALEADD_s[]="SCALEADD"; 1507 static define_unary_function_eval_quoted (__SCALEADD,&_SCALEADD,_SCALEADD_s); 1508 define_unary_function_ptr5( at_SCALEADD ,alias_at_SCALEADD,&__SCALEADD,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1509 1510 static const char _scaleadd_s[]="scaleadd"; 1511 static define_unary_function_eval_quoted (__scaleadd,&_SCALEADD,_scaleadd_s); 1512 define_unary_function_ptr5( at_scaleadd ,alias_at_scaleadd,&__scaleadd,_QUOTE_ARGUMENTS,T_UNARY_OP); 1513 _SWAPCOL(const gen & args,GIAC_CONTEXT)1514 gen _SWAPCOL(const gen & args,GIAC_CONTEXT){ 1515 if ( args.type==_STRNG && args.subtype==-1) return args; 1516 vecteur v(gen2vecteur(args)); 1517 if (!v.empty() && is_Ans(v[0])) 1518 v[0]=eval(v[0],1,contextptr); 1519 if (!v.empty() && v[0].type==_IDNT){ 1520 gen v0=v[0]; 1521 gen g=eval(args,eval_level(contextptr),contextptr); 1522 if (ckmatrix(g[0])) 1523 return sto(_SWAPCOL(g,contextptr),v0,contextptr); 1524 } 1525 if (v.size()!=3 || !ckmatrix(v[0])) 1526 return gensizeerr(contextptr); 1527 v[1]=eval(v[1],1,contextptr); 1528 v[2]=eval(v[2],1,contextptr); 1529 matrice m; 1530 mtran(*v[0]._VECTptr,m); 1531 gen res=_rowSwap(makesequence(m,v[1],v[2]),contextptr); 1532 if (res.type==_VECT){ 1533 mtran(*res._VECTptr,m); 1534 res=m; 1535 } 1536 return res; 1537 } 1538 static const char _SWAPCOL_s[]="SWAPCOL"; 1539 static define_unary_function_eval_quoted (__SWAPCOL,&_SWAPCOL,_SWAPCOL_s); 1540 define_unary_function_ptr5( at_SWAPCOL ,alias_at_SWAPCOL,&__SWAPCOL,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1541 1542 static const char _colswap_s[]="colswap"; 1543 static define_unary_function_eval (__colswap,&_SWAPCOL,_colswap_s); 1544 define_unary_function_ptr5( at_colswap ,alias_at_colswap,&__colswap,0,true); 1545 1546 static const char _swapcol_s[]="swapcol"; 1547 static define_unary_function_eval (__swapcol,&_SWAPCOL,_swapcol_s); 1548 define_unary_function_ptr5( at_swapcol ,alias_at_swapcol,&__swapcol,0,true); 1549 1550 static const char _colSwap_s[]="colSwap"; 1551 static define_unary_function_eval (__colSwap,&_SWAPCOL,_colSwap_s); 1552 define_unary_function_ptr5( at_colSwap ,alias_at_colSwap,&__colSwap,0,true); 1553 1554 static const char _DELCOL_s[]="DELCOL"; 1555 static define_unary_function_eval_quoted (__DELCOL,&_delcols,_DELCOL_s); 1556 define_unary_function_ptr5( at_DELCOL ,alias_at_DELCOL,&__DELCOL,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1557 1558 static const char _DELROW_s[]="DELROW"; 1559 static define_unary_function_eval_quoted (__DELROW,&_delrows,_DELROW_s); 1560 define_unary_function_ptr5( at_DELROW ,alias_at_DELROW,&__DELROW,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1561 1562 static const char _SWAPROW_s[]="SWAPROW"; 1563 static define_unary_function_eval_quoted (__SWAPROW,&_rowSwap,_SWAPROW_s); 1564 define_unary_function_ptr5( at_SWAPROW ,alias_at_SWAPROW,&__SWAPROW,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1565 _SUB(const gen & args,GIAC_CONTEXT)1566 gen _SUB(const gen & args,GIAC_CONTEXT){ 1567 if ( args.type==_STRNG && args.subtype==-1) return args; 1568 vecteur v(gen2vecteur(args)); 1569 gen v0=v[0]; 1570 v=*eval(v,eval_level(contextptr),contextptr)._VECTptr; 1571 if (v0.type!=_IDNT){ 1572 if (v.size()<3) 1573 return gendimerr(contextptr); 1574 if (ckmatrix(v[0])) 1575 return _subMat(gen(makevecteur(v[0],v[1],v[2]),_SEQ__VECT),contextptr); 1576 int shift = array_start(contextptr); //xcas_mode(contextptr)!=0 || abs_calc_mode(contextptr)==38; 1577 if (v[0].type==_VECT && v[1].type==_INT_ && v[2].type==_INT_){ 1578 vecteur & w =*v[0]._VECTptr; 1579 int v2=v[1].val-shift, v3=v[2].val-shift; 1580 if (v2<=v3 && v2>=0 && v3<int(w.size())) 1581 return gen(vecteur(w.begin()+v2,w.begin()+v3+1),v[1].subtype); 1582 } 1583 } 1584 if (v.size()==3) 1585 v.insert(v.begin(),v0); 1586 if (v.size()<4) 1587 return gendimerr(contextptr); 1588 v[2]=_floor(v[2],contextptr); 1589 v[3]=_floor(v[3],contextptr); 1590 if (ckmatrix(v[1])) 1591 return sto(_subMat(gen(makevecteur(v[1],v[2],v[3]),_SEQ__VECT),contextptr),v0,contextptr); 1592 int shift = array_start(contextptr); //xcas_mode(contextptr)!=0 || abs_calc_mode(contextptr)==38; 1593 if (v[1].type==_VECT && v[2].type==_INT_ && v[3].type==_INT_){ 1594 vecteur & w =*v[1]._VECTptr; 1595 int v2=v[2].val-shift, v3=v[3].val-shift; 1596 if (v2<=v3 && v2>=0 && v3<int(w.size())) 1597 return sto(gen(vecteur(w.begin()+v2,w.begin()+v3+1),v[1].subtype),v0,contextptr); 1598 } 1599 return undef; 1600 } 1601 static const char _SUB_s[]="SUB"; 1602 static define_unary_function_eval_quoted (__SUB,&_SUB,_SUB_s); 1603 define_unary_function_ptr5( at_SUB ,alias_at_SUB,&__SUB,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1604 _RANDMAT(const gen & args,GIAC_CONTEXT)1605 gen _RANDMAT(const gen & args,GIAC_CONTEXT){ 1606 if ( args.type==_STRNG && args.subtype==-1) return args; 1607 vecteur v(gen2vecteur(args)); 1608 int s=int(v.size()); 1609 if (s==1){ 1610 v[0]=_floor(v[0],contextptr); 1611 if (v[0].type!=_INT_) 1612 return gentypeerr(contextptr); 1613 return vranm(v[0].val,0,contextptr); 1614 } 1615 if (s<2) 1616 return gensizeerr(contextptr); 1617 gen name=v[0]; 1618 if (name.type!=_IDNT && !name.is_symb_of_sommet(at_double_deux_points)) 1619 return _ranm(eval(args,eval_level(contextptr),contextptr),contextptr); 1620 v=*eval(v,eval_level(contextptr),contextptr)._VECTptr; 1621 v[1]=_floor(v[1],contextptr); 1622 if (v[1].type!=_INT_) 1623 return gentypeerr(contextptr); 1624 if (s==2) 1625 return sto(vranm(v[1].val,0,contextptr),name,contextptr); 1626 v[2]=_floor(v[2],contextptr); 1627 if (v[2].type!=_INT_) 1628 return gentypeerr(contextptr); 1629 return sto(mranm(v[1].val,v[2].val,0,contextptr),name,contextptr); 1630 } 1631 static const char _RANDMAT_s[]="RANDMAT"; 1632 static define_unary_function_eval_quoted (__RANDMAT,&_RANDMAT,_RANDMAT_s); 1633 define_unary_function_ptr5( at_RANDMAT ,alias_at_RANDMAT,&__RANDMAT,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1634 _REDIM(const gen & args,GIAC_CONTEXT)1635 gen _REDIM(const gen & args,GIAC_CONTEXT){ 1636 if ( args.type==_STRNG && args.subtype==-1) return args; 1637 vecteur v(gen2vecteur(args)); 1638 int s=int(v.size()); 1639 if (s==3) 1640 return _REDIM(gen(makevecteur(v[0],makevecteur(v[1],v[2])),_SEQ__VECT),contextptr); 1641 gen name=v[0]; 1642 if (s!=2) 1643 return gensizeerr(contextptr); 1644 bool unnamed= name.type!=_IDNT && !name.is_symb_of_sommet(at_double_deux_points); 1645 v=*eval(v,eval_level(contextptr),contextptr)._VECTptr; 1646 if (v[0].type!=_VECT) 1647 return gentypeerr(contextptr); 1648 vecteur w=*v[0]._VECTptr,argv; 1649 argv=gen2vecteur(v[1]); 1650 for (unsigned i=0;i<argv.size();++i){ 1651 if (!is_integral(argv[i])) 1652 return gentypeerr(contextptr); 1653 } 1654 if (ckmatrix(v[0])){ 1655 if (argv.size()==2){ 1656 w.clear(); 1657 int newl=argv[0].val,newc=argv[1].val; 1658 if (newl<=0 || newc<=0 || newl*newc>LIST_SIZE_LIMIT) 1659 return gendimerr(contextptr); 1660 // create w 1661 vecteur & v0=*v[0]._VECTptr; 1662 newl=giacmin(newl,int(v0.size())); 1663 int nc=giacmin(newc,int(v0.front()._VECTptr->size())),j; 1664 for (int i=0;i<newl;++i){ 1665 vecteur & cur = *v0[i]._VECTptr; 1666 for (j=0;j<nc;++j){ 1667 w.push_back(cur[j]); 1668 } 1669 for (;j<newc;++j) 1670 w.push_back(0); 1671 } 1672 } 1673 else 1674 aplatir(*v[0]._VECTptr,w); 1675 } 1676 argv.push_back(w); 1677 if (unnamed) 1678 return _matrix(gen(argv,_SEQ__VECT),contextptr); 1679 return sto(_matrix(gen(argv,_SEQ__VECT),contextptr),name,contextptr); 1680 } 1681 static const char _REDIM_s[]="REDIM"; 1682 static define_unary_function_eval_quoted (__REDIM,&_REDIM,_REDIM_s); 1683 define_unary_function_ptr5( at_REDIM ,alias_at_REDIM,&__REDIM,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1684 1685 static const char _redim_s[]="redim"; 1686 static define_unary_function_eval_quoted (__redim,&_REDIM,_redim_s); 1687 define_unary_function_ptr5( at_redim ,alias_at_redim,&__redim,_QUOTE_ARGUMENTS,T_UNARY_OP); 1688 _REPLACE(const gen & args,GIAC_CONTEXT)1689 gen _REPLACE(const gen & args,GIAC_CONTEXT){ 1690 if ( args.type==_STRNG && args.subtype==-1) return args; 1691 vecteur v(gen2vecteur(args)); 1692 int s=int(v.size()); 1693 gen name=v[0]; 1694 if (s!=3) 1695 return gensizeerr(contextptr); 1696 bool unnamed= name.type!=_IDNT && !name.is_symb_of_sommet(at_double_deux_points); 1697 v=*eval(v,eval_level(contextptr),contextptr)._VECTptr; 1698 int pos,l,c=0,shift=abs_calc_mode(contextptr)==38; // && v[1].subtype==_LIST__VECT; 1699 if (v[0].type==_STRNG && v[1].type==_STRNG && v[2].type==_STRNG){ 1700 string s(*v[0]._STRNGptr),f(*v[1]._STRNGptr),rep(*v[2]._STRNGptr),res; 1701 int fs=int(f.size()); 1702 for (;;){ 1703 int pos=s.find(f); 1704 if (pos<0 || pos>int(s.size())-fs) 1705 break; 1706 res += s.substr(0,pos)+rep; 1707 s=s.substr(pos+fs,int(s.size())-pos-fs); 1708 } 1709 res += s; 1710 if (unnamed) 1711 return string2gen(res,false); 1712 return sto(string2gen(res,false),name,contextptr); 1713 } 1714 v[1]=_floor(v[1],contextptr); 1715 if (v[0].type!=_VECT || v[2].type!=_VECT) 1716 return gentypeerr(contextptr); 1717 vecteur w0=*v[0]._VECTptr,w2=*v[2]._VECTptr,argv; 1718 if (ckmatrix(v[0])){ 1719 mdims(w0,l,c); 1720 if (ckmatrix(v[2]) && v[1].type==_VECT){ 1721 vecteur & v1=*v[1]._VECTptr; 1722 if (v1.size()!=2 || v1.front().type!=_INT_ || v1.back().type!=_INT_) 1723 return gentypeerr(contextptr); 1724 int ls,cs,pos1=v1.front().val-shift,pos2=v1.back().val-shift; 1725 if (pos1<0 || pos1>=l || pos2<0 || pos2>=c) 1726 return gendimerr(contextptr); 1727 mdims(w2,ls,cs); 1728 std_matrix<gen> target,source; 1729 matrice2std_matrix_gen(w2,source); 1730 matrice2std_matrix_gen(w0,target); 1731 for (int i=0;i<ls;++i){ 1732 if (i+pos1>=l) 1733 break; 1734 vecteur & ws =source[i]; 1735 vecteur & wt =target[i+pos1]; 1736 for (int j=0;j<cs;++j){ 1737 if (j+pos2>=c) 1738 break; 1739 wt[j+pos2]=ws[j]; 1740 } 1741 } 1742 std_matrix_gen2matrice(target,w0); 1743 if (unnamed) 1744 return gen(w0,_MATRIX__VECT); 1745 return sto(gen(w0,_MATRIX__VECT),name,contextptr); 1746 } 1747 aplatir(*v[0]._VECTptr,w0); 1748 } 1749 else 1750 l=int(w0.size()); 1751 if (v[1].type==_VECT){ 1752 vecteur & v1=*v[1]._VECTptr; 1753 if (v1.size()!=2 || v1.front().type!=_INT_ || v1.back().type!=_INT_) 1754 return gentypeerr(contextptr); 1755 pos=(v1.front().val-shift)*c+(v1.back().val-shift); 1756 } 1757 else { 1758 if (v[1].type!=_INT_) 1759 return gentypeerr(contextptr); 1760 pos=v[1].val; 1761 if (abs_calc_mode(contextptr)==38) 1762 --pos; 1763 } 1764 if (ckmatrix(v[2])) 1765 aplatir(*v[2]._VECTptr,w2); 1766 int w0s=int(w0.size()),w2s=int(w2.size()),i=giacmax(pos,0),j=0; 1767 for (;i<w0s && j<w2s;++j,++i){ 1768 w0[i]=w2[j]; 1769 } 1770 if (!c){ 1771 if (unnamed) 1772 return gen(w0,v[0].subtype); 1773 return sto(gen(w0,v[0].subtype),name,contextptr); 1774 } 1775 if (unnamed) 1776 return _matrix(gen(makevecteur(l,c,w0),_SEQ__VECT),contextptr); 1777 return sto(_matrix(gen(makevecteur(l,c,w0),_SEQ__VECT),contextptr),name,contextptr); 1778 } 1779 static const char _REPLACE_s[]="REPLACE"; 1780 static define_unary_function_eval_quoted (__REPLACE,&_REPLACE,_REPLACE_s); 1781 define_unary_function_ptr5( at_REPLACE ,alias_at_REPLACE,&__REPLACE,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1782 1783 static const char _replace_s[]="replace"; 1784 static define_unary_function_eval_quoted (__replace,&_REPLACE,_replace_s); 1785 define_unary_function_ptr5( at_replace ,alias_at_replace,&__replace,_QUOTE_ARGUMENTS,T_UNARY_OP); 1786 1787 static const char _COLNORM_s[]="COLNORM"; 1788 static define_unary_function_eval (__COLNORM,&_colNorm,_COLNORM_s); 1789 define_unary_function_ptr5( at_COLNORM ,alias_at_COLNORM,&__COLNORM,0,T_UNARY_OP_38); 1790 1791 static const char _ROWNORM_s[]="ROWNORM"; 1792 static define_unary_function_eval (__ROWNORM,&_rowNorm,_ROWNORM_s); 1793 define_unary_function_ptr5( at_ROWNORM ,alias_at_ROWNORM,&__ROWNORM,0,T_UNARY_OP_38); 1794 1795 static const char _CROSS_s[]="CROSS"; 1796 static define_unary_function_eval (__CROSS,&_cross,_CROSS_s); 1797 define_unary_function_ptr5( at_CROSS ,alias_at_CROSS,&__CROSS,0,T_UNARY_OP_38); 1798 1799 static const char _DET_s[]="DET"; 1800 static define_unary_function_eval (__DET,&_det,_DET_s); 1801 define_unary_function_ptr5( at_DET ,alias_at_DET,&__DET,0,T_UNARY_OP_38); 1802 1803 static const char _DOT_s[]="DOT"; 1804 static define_unary_function_eval (__DOT,&_dotprod,_DOT_s); 1805 define_unary_function_ptr5( at_DOT ,alias_at_DOT,&__DOT,0,T_UNARY_OP_38); 1806 _EIGENVAL(const gen & args,GIAC_CONTEXT)1807 gen _EIGENVAL(const gen & args,GIAC_CONTEXT){ 1808 if ( args.type==_STRNG && args.subtype==-1) return args; 1809 if (!is_squarematrix(args)) 1810 return gendimerr(contextptr); 1811 bool b=complex_mode(contextptr); 1812 complex_mode(true,contextptr); 1813 gen res=_egvl(evalf(args,1,contextptr),contextptr); 1814 res=_diag(res,contextptr); 1815 complex_mode(b,contextptr); 1816 return res; 1817 } 1818 static const char _EIGENVAL_s[]="EIGENVAL"; 1819 static define_unary_function_eval (__EIGENVAL,&_EIGENVAL,_EIGENVAL_s); 1820 define_unary_function_ptr5( at_EIGENVAL ,alias_at_EIGENVAL,&__EIGENVAL,0,T_UNARY_OP_38); 1821 _EIGENVV(const gen & args,GIAC_CONTEXT)1822 gen _EIGENVV(const gen & args,GIAC_CONTEXT){ 1823 if ( args.type==_STRNG && args.subtype==-1) return args; 1824 if (!is_squarematrix(args)) 1825 return gendimerr(contextptr); 1826 bool b=complex_mode(contextptr); 1827 complex_mode(true,contextptr); 1828 gen res=_jordan(evalf(args,1,contextptr),contextptr); 1829 complex_mode(b,contextptr); 1830 if (res.type==_VECT) 1831 res.subtype=_LIST__VECT; 1832 return res; 1833 } 1834 static const char _EIGENVV_s[]="EIGENVV"; 1835 static define_unary_function_eval (__EIGENVV,&_EIGENVV,_EIGENVV_s); 1836 define_unary_function_ptr5( at_EIGENVV ,alias_at_EIGENVV,&__EIGENVV,0,T_UNARY_OP_38); 1837 1838 static const char _IDENMAT_s[]="IDENMAT"; 1839 static define_unary_function_eval (__IDENMAT,&_idn,_IDENMAT_s); 1840 define_unary_function_ptr5( at_IDENMAT ,alias_at_IDENMAT,&__IDENMAT,0,T_UNARY_OP_38); 1841 1842 static const char _INVERSE_s[]="INVERSE"; 1843 static define_unary_function_eval (__INVERSE,&inv,_INVERSE_s); 1844 define_unary_function_ptr5( at_INVERSE ,alias_at_INVERSE,&__INVERSE,0,T_UNARY_OP_38); 1845 _TRACE(const gen & g,GIAC_CONTEXT)1846 gen _TRACE(const gen & g,GIAC_CONTEXT){ 1847 if (!is_squarematrix(g)) 1848 return gensizeerr(contextptr); 1849 return mtrace(*g._VECTptr); 1850 } 1851 static const char _TRACE_s[]="TRACE"; 1852 static define_unary_function_eval (__TRACE,&_TRACE,_TRACE_s); 1853 define_unary_function_ptr5( at_TRACE ,alias_at_TRACE,&__TRACE,0,T_UNARY_OP_38); 1854 1855 static const char _TRN_s[]="TRN"; 1856 static define_unary_function_eval (__TRN,&_trn,_TRN_s); 1857 define_unary_function_ptr5( at_TRN ,alias_at_TRN,&__TRN,0,T_UNARY_OP_38); 1858 1859 static const char _RANK_s[]="RANK"; 1860 static define_unary_function_eval (__RANK,&_rank,_RANK_s); 1861 define_unary_function_ptr5( at_RANK ,alias_at_RANK,&__RANK,0,T_UNARY_OP_38); 1862 _SIZE(const gen & args,GIAC_CONTEXT)1863 gen _SIZE(const gen& args,GIAC_CONTEXT){ 1864 if (ckmatrix(args)) 1865 return _dim(args,contextptr); 1866 else 1867 return _size(args,contextptr); 1868 } 1869 static const char _SIZE_s[]="SIZE"; 1870 static define_unary_function_eval (__SIZE,&_SIZE,_SIZE_s); 1871 define_unary_function_ptr5( at_SIZE ,alias_at_SIZE,&__SIZE,0,T_UNARY_OP_38); 1872 1873 static const char _SORT_s[]="SORT"; 1874 static define_unary_function_eval (__SORT,&_sort,_SORT_s); 1875 define_unary_function_ptr5( at_SORT ,alias_at_SORT,&__SORT,0,T_UNARY_OP_38); 1876 1877 static const char _DELTALIST_s[]="ΔLIST"; 1878 static define_unary_function_eval (__DELTALIST,&_deltalist,_DELTALIST_s); 1879 define_unary_function_ptr5( at_DELTALIST ,alias_at_DELTALIST,&__DELTALIST,0,T_UNARY_OP_38); 1880 1881 static const char _CONCAT_s[]="CONCAT"; 1882 static define_unary_function_eval (__CCONCAT,&_concat,_CONCAT_s); 1883 define_unary_function_ptr5( at_CONCAT ,alias_at_CONCAT,&__CCONCAT,0,T_UNARY_OP_38); 1884 _PILIST(const gen & args,GIAC_CONTEXT)1885 gen _PILIST(const gen & args,GIAC_CONTEXT){ 1886 if (args.type==_VECT) 1887 return _product(change_subtype(args,0),contextptr); 1888 return _product(args,contextptr); 1889 } 1890 static const char _PILIST_s[]="ΠLIST"; 1891 static define_unary_function_eval (__PILIST,&_PILIST,_PILIST_s); 1892 define_unary_function_ptr5( at_PILIST ,alias_at_PILIST,&__PILIST,0,T_UNARY_OP_38); 1893 _SIGMALIST(const gen & args,GIAC_CONTEXT)1894 gen _SIGMALIST(const gen & args,GIAC_CONTEXT){ 1895 if (args.type==_VECT) 1896 return _sum(change_subtype(args,0),contextptr); 1897 return _sum(args,contextptr); 1898 } 1899 static const char _SIGMALIST_s[]="ΣLIST"; 1900 static define_unary_function_eval (__SIGMALIST,&_SIGMALIST,_SIGMALIST_s); 1901 define_unary_function_ptr5( at_SIGMALIST ,alias_at_SIGMALIST,&__SIGMALIST,0,T_UNARY_OP_38); 1902 1903 static const char _REVERSE_s[]="REVERSE"; 1904 static define_unary_function_eval (__REVERSE,&_revlist,_REVERSE_s); 1905 define_unary_function_ptr5( at_REVERSE ,alias_at_REVERSE,&__REVERSE,0,T_UNARY_OP_38); 1906 _POS(const gen & args,GIAC_CONTEXT)1907 gen _POS(const gen & args,GIAC_CONTEXT){ 1908 if ( args.type==_STRNG && args.subtype==-1) return args; 1909 if ( (args.type!=_VECT) || (args._VECTptr->size()!=2) || (args._VECTptr->front().type!=_VECT) ) 1910 return gensizeerr(contextptr); 1911 return equalposcomp(*args._VECTptr->front()._VECTptr,evalf2bcd(args._VECTptr->back(),1,contextptr)); 1912 } 1913 static const char _POS_s[]="POS"; 1914 static define_unary_function_eval (__POS,&_POS,_POS_s); 1915 define_unary_function_ptr5( at_POS ,alias_at_POS,&__POS,0,T_UNARY_OP_38); 1916 _MAKELIST(const gen & args,GIAC_CONTEXT)1917 gen _MAKELIST(const gen & args,GIAC_CONTEXT){ 1918 if (args.type!=_VECT || (args._VECTptr->size()!=4 && args._VECTptr->size()!=5)) 1919 return gensizeerr(contextptr); 1920 vecteur & v = *args._VECTptr; 1921 if (v.size()==5 && is_positive(-v[4]*(v[3]-v[2]),contextptr)) 1922 return gensizeerr(gettext("Invalid step value")); 1923 gen res=_seq(args,contextptr); 1924 if (res.type==_VECT) 1925 res.subtype=_LIST__VECT; 1926 return res; 1927 } 1928 static const char _MAKELIST_s[]="MAKELIST"; 1929 static define_unary_function_eval_quoted (__MAKELIST,&_MAKELIST,_MAKELIST_s); 1930 define_unary_function_ptr5( at_MAKELIST ,alias_at_MAKELIST,&__MAKELIST,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 1931 _INT(const gen & g,GIAC_CONTEXT)1932 gen _INT(const gen & g,GIAC_CONTEXT){ 1933 if ( g.type==_STRNG && g.subtype==-1) return g; 1934 if (g.type==_VECT) 1935 return apply(g,_INT,contextptr); 1936 if (g.type==_CPLX) 1937 return _INT(*g._CPLXptr,contextptr)+cst_i*_INT(*(g._CPLXptr+1),contextptr); 1938 if (is_positive(g,contextptr)) 1939 return _floor(g,contextptr); 1940 else { 1941 if (is_positive(-g,contextptr)) 1942 return _ceil(g,contextptr); 1943 gen sg=sign(g,contextptr); 1944 return sg*_floor(g*sg,contextptr);//symbolic(at_when,makesequence(symbolic(at_superieur_egal,makesequence(g,0)),symbolic(at_floor,g),symbolic(at_ceil,g))); 1945 } 1946 } 1947 static const char _INT_s[]="IP"; 1948 static define_unary_function_eval (__INT,&_INT,_INT_s); 1949 define_unary_function_ptr5( at_INT ,alias_at_INT,&__INT,0,T_UNARY_OP_38); 1950 1951 static int taylorxn=0; hp38_eval(vecteur & v,gen & x,gen & newx,GIAC_CONTEXT)1952 static void hp38_eval(vecteur & v,gen & x,gen& newx,GIAC_CONTEXT){ 1953 x=v[1]; 1954 if (is_equal(x)) 1955 x=x._SYMBptr->feuille[0]; 1956 identificateur idx("taylorx"+print_INT_(taylorxn)); 1957 ++taylorxn; 1958 newx=idx; 1959 gen tmp=subst(v[0],x,newx,false,contextptr); 1960 gen tmp1=eval(tmp,eval_level(contextptr),contextptr); 1961 if (!is_undef(tmp1)) 1962 tmp=tmp1; 1963 tmp1=subst(tmp,x,newx,false,contextptr); 1964 if (!is_undef(tmp1)) 1965 tmp=tmp1; 1966 v[0]=tmp; 1967 v[1]=newx; 1968 int s=int(v.size()); 1969 for (int i=2;i<s;++i) 1970 v[i]=eval(v[i],eval_level(contextptr),contextptr); 1971 } 1972 _HPDIFF(const gen & args,GIAC_CONTEXT)1973 gen _HPDIFF(const gen & args,GIAC_CONTEXT){ 1974 if ( args.type==_STRNG && args.subtype==-1) return args; 1975 gen tmp; 1976 if (args.type==_VECT && args.subtype==_SEQ__VECT && args._VECTptr->size()>=2){ 1977 gen value=(*args._VECTptr)[1],var=value; 1978 if (is_equal(value)){ 1979 var=value._SYMBptr->feuille[0]; 1980 value=value._SYMBptr->feuille[1]; 1981 } 1982 if (var.type!=_IDNT && abs_calc_mode(contextptr)==38) 1983 return gensizeerr(gettext("∂(expression,variable=value)")); 1984 int ndiff=1; 1985 if (args._VECTptr->size()>=3 && (*args._VECTptr)[2].type==_INT_ ){ 1986 ndiff=(*args._VECTptr)[2].val; 1987 if (ndiff<0) 1988 return gensizeerr(gettext("Order of derivation must be positive")); 1989 } 1990 if (args._VECTptr->size()>=4 && abs_calc_mode(contextptr)!=38) 1991 value=(*args._VECTptr)[3]; 1992 static int count=0; 1993 gen newx("hpdiffx"+print_INT_(count),contextptr); 1994 ++count; 1995 gen arg0=eval(subst(args._VECTptr->front(),var,newx,false,contextptr),eval_level(contextptr),contextptr); 1996 arg0=subst(arg0,var,newx,false,contextptr); 1997 if (ndiff==0){ 1998 value=eval(value,1,contextptr); 1999 tmp=gen(makevecteur(arg0,newx,value),_SEQ__VECT); 2000 return _limit(tmp,contextptr); 2001 } 2002 else { 2003 if (ndiff==1) 2004 tmp=gen(makesequence(arg0,newx)); 2005 else 2006 tmp=gen(makevecteur(arg0,newx,ndiff),_SEQ__VECT); 2007 tmp=_derive(tmp,contextptr); 2008 // return _limit(makesequence(tmp,newx,value),contextptr); 2009 tmp=subst(tmp,newx,value,false,contextptr); 2010 tmp=eval(tmp,1,contextptr); 2011 return tmp; 2012 } 2013 } 2014 else { 2015 gen a(args); 2016 if (guess_program(a,contextptr)) 2017 return _derive(a,contextptr); 2018 return _HPDIFF(gen(makevecteur(args,vx_var),_SEQ__VECT),contextptr); 2019 } 2020 } 2021 static const char _HPDIFF_s[]="∂"; 2022 static define_unary_function_eval_quoted (__HPDIFF,&_HPDIFF,_HPDIFF_s); 2023 define_unary_function_ptr5( at_HPDIFF ,alias_at_HPDIFF,&__HPDIFF,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2024 _HPINT(const gen & args,GIAC_CONTEXT)2025 gen _HPINT(const gen & args,GIAC_CONTEXT){ 2026 if ( args.type==_STRNG && args.subtype==-1) return args; 2027 if (args.type==_VECT && args.subtype==_SEQ__VECT){ 2028 vecteur v = *args._VECTptr; 2029 if (v.size()==3){ 2030 if (is_equal(v.front())){ 2031 gen var=v.front()._SYMBptr->feuille[0]; 2032 gen lower=v.front()._SYMBptr->feuille[1]; 2033 v=makevecteur(v[2],var,lower,v[1]); 2034 } 2035 if (is_equal(v[1])){ 2036 gen var=v[1]._SYMBptr->feuille[0]; 2037 gen lower=v[1]._SYMBptr->feuille[1]; 2038 v=makevecteur(v.front(),var,lower,v[2]); 2039 } 2040 if (v.size()==3) 2041 return _integrate(args,contextptr); 2042 } 2043 if (v.size()>=4){ 2044 if (v[1].type!=_IDNT){ 2045 return gensizeerr(gettext("∫(expression,var,lower,upper)")); 2046 // swapgen(v[0],v[2]); 2047 // swapgen(v[1],v[3]); 2048 } 2049 gen x,newx; 2050 hp38_eval(v,x,newx,contextptr); 2051 gen tmp=_integrate(gen(v,_SEQ__VECT),contextptr); 2052 if (eval(x,1,contextptr)!=x) 2053 return tmp; 2054 else 2055 return subst(tmp,newx,x,false,contextptr); 2056 // if we subst then the value of x may alter tmp even with subst 2057 } 2058 } 2059 #ifndef CAS38_DISABLED 2060 return _integrate(args,contextptr); 2061 #else 2062 return gensizeerr(contextptr); 2063 #endif 2064 } 2065 static const char _HPINT_s[]="∫"; 2066 static define_unary_function_eval_quoted (__HPINT,&_HPINT,_HPINT_s); 2067 define_unary_function_ptr5( at_HPINT ,alias_at_HPINT,&__HPINT,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2068 _HPSUM(const gen & args,GIAC_CONTEXT)2069 gen _HPSUM(const gen & args,GIAC_CONTEXT){ 2070 if ( args.type==_STRNG && args.subtype==-1) return args; 2071 if (args.type==_VECT && args.subtype==_SEQ__VECT){ 2072 int s=args._VECTptr->size(); 2073 if (s==4){ 2074 gen var=(*args._VECTptr)[1]; 2075 if (var.type==_IDNT && eval(var,1,contextptr)!=var){ 2076 gen newvar(var); 2077 while (eval(newvar,1,contextptr)!=newvar){ 2078 newvar=identificateur(newvar.print(contextptr)+"_"); 2079 } 2080 gen args_=subst(args,var,newvar,true,contextptr); 2081 return _HPSUM(args_,contextptr); 2082 } 2083 } 2084 if (s<=3){ 2085 if (s!=3) 2086 return gensizeerr(contextptr); 2087 const vecteur & v = *args._VECTptr; 2088 if (is_equal(v[0])){ 2089 gen var=v[0]._SYMBptr->feuille[0]; 2090 if (var.type!=_IDNT) 2091 return gensizeerr(contextptr); 2092 gen inf=v[0]._SYMBptr->feuille[1]; 2093 gen sup=v[1]; 2094 gen expr=v[2]; 2095 return _sum(gen(makevecteur(expr,var,inf,sup),_SEQ__VECT),contextptr); 2096 } 2097 if (is_equal(v[1])){ 2098 gen var=v[1]._SYMBptr->feuille[0]; 2099 if (var.type!=_IDNT) 2100 return gensizeerr(contextptr); 2101 gen inf=v[1]._SYMBptr->feuille[1]; 2102 gen sup=v[2]; 2103 gen expr=v[0]; 2104 return _sum(gen(makevecteur(expr,var,inf,sup),_SEQ__VECT),contextptr); 2105 } 2106 } 2107 } 2108 return _sum(args,contextptr); 2109 } 2110 static const char _HPSUM_s[]="Σ"; // "∑"; 2111 // static const char _HPSUM_s[]="∑"; // "Σ"; 2112 static define_unary_function_eval_quoted (__HPSUM,&_HPSUM,_HPSUM_s); 2113 define_unary_function_ptr5( at_HPSUM ,alias_at_HPSUM,&__HPSUM,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2114 _TAYLOR(const gen & args,GIAC_CONTEXT)2115 gen _TAYLOR(const gen & args,GIAC_CONTEXT){ 2116 #ifdef CAS38_DISABLED 2117 return gensizeerr(contextptr); 2118 #endif 2119 if ( args.type==_STRNG && args.subtype==-1) return args; 2120 if (args.type!=_VECT) 2121 return gentypeerr(contextptr); 2122 vecteur v = *args._VECTptr; 2123 if (v.size()<2) 2124 v.push_back(x__IDNT_e); 2125 gen x,newx; 2126 hp38_eval(v,x,newx,contextptr); 2127 gen res=subst(_taylor(gen(v,_SEQ__VECT),contextptr),newx,x,false,contextptr); 2128 v=lop(res,at_order_size); 2129 res=subst(res,v,vecteur(v.size()),false,contextptr); 2130 return res; 2131 } 2132 static const char _TAYLOR_s[]="TAYLOR"; 2133 static define_unary_function_eval_quoted (__TAYLOR,&_TAYLOR,_TAYLOR_s); 2134 define_unary_function_ptr5( at_TAYLOR ,alias_at_TAYLOR,&__TAYLOR,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2135 _POLYCOEFF(const gen & args0,GIAC_CONTEXT)2136 gen _POLYCOEFF(const gen &args0,GIAC_CONTEXT){ 2137 gen args=eval(args0,1,contextptr); 2138 if (args.type==_VECT && args.subtype!=_SEQ__VECT) 2139 return _pcoeff(args,contextptr); 2140 return _symb2poly(args0,contextptr); 2141 } 2142 static const char _POLYCOEF_s[]="POLYCOEF"; 2143 static define_unary_function_eval_quoted (__POLYCOEF,&_POLYCOEFF,_POLYCOEF_s); 2144 define_unary_function_ptr5( at_POLYCOEF ,alias_at_POLYCOEF,&__POLYCOEF,_QUOTE_ARGUMENTS,T_UNARY_OP); 2145 2146 gen _horner(const gen & args,GIAC_CONTEXT); _POLYEVAL(const gen & args,GIAC_CONTEXT)2147 gen _POLYEVAL(const gen & args,GIAC_CONTEXT){ 2148 if (args.type!=_VECT) 2149 return gentypeerr(contextptr); 2150 if (args.subtype!=_SEQ__VECT) 2151 return _POLYFORM(_horner(gen(makevecteur(args,vx_var),_SEQ__VECT),contextptr),contextptr); 2152 return _horner(args,contextptr); 2153 } 2154 static const char _POLYEVAL_s[]="POLYEVAL"; 2155 static define_unary_function_eval (__POLYEVAL,&_POLYEVAL,_POLYEVAL_s); 2156 define_unary_function_ptr5( at_POLYEVAL ,alias_at_POLYEVAL,&__POLYEVAL,0,T_UNARY_OP_38); 2157 evalfunc(const gen & args,GIAC_CONTEXT)2158 gen evalfunc(const gen & args,GIAC_CONTEXT){ 2159 #ifdef GIAC_HAS_STO_38 2160 vecteur v(lidnt(args)); 2161 vecteur lf,lfval; 2162 for (unsigned i=0;i<v.size();++i){ 2163 if (v[i].type!=_IDNT) 2164 continue; 2165 const char * ch=v[i]._IDNTptr->id_name; 2166 if (strlen(ch)==2 && (ch[0]=='F' || ch[0]=='X' || ch[0]=='Y' || ch[0]=='R')){ 2167 lf.push_back(v[i]); 2168 lfval.push_back(eval(v[i],1,contextptr)); 2169 } 2170 } 2171 if (lf.empty()) 2172 return args; 2173 return subst(args,lf,lfval,false,contextptr); 2174 #else 2175 return args; 2176 #endif 2177 } printasPOLYFORM(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)2178 static string printasPOLYFORM(const gen &feuille,const char * sommetstr,GIAC_CONTEXT){ 2179 if (feuille.type==_VECT && feuille._VECTptr->size()==2 && feuille._VECTptr->back().type==_FUNC){ 2180 const char * s=feuille._VECTptr->back()._FUNCptr->ptr()->s; 2181 return feuille._VECTptr->front().print(contextptr)+"\xe2\x96\xba"+((strcmp(s,"eval")==0)?"\xe2\x96\xba":s); 2182 } 2183 return string(sommetstr)+('('+feuille.print(contextptr)+')'); 2184 } _POLYFORM(const gen & args,GIAC_CONTEXT)2185 gen _POLYFORM(const gen & args,GIAC_CONTEXT){ 2186 if ( args.type==_STRNG && args.subtype==-1) return args; 2187 gen tmp; 2188 if (args.type==_VECT && !args._VECTptr->empty()){ 2189 const vecteur & v = *args._VECTptr; 2190 tmp=v[0]; 2191 tmp=eval(tmp,1,context0); 2192 tmp=evalfunc(tmp,contextptr); 2193 int vs=int(v.size()); 2194 #ifdef CAS38_DISABLED 2195 if (vs==2 && v.back()==at_prod && is_integral(tmp)) 2196 return _ifactor(tmp,context0); 2197 #else 2198 if (vs==2){ 2199 if (v.back()==at_eval) return tmp; 2200 if (v.back()==at_prod){ 2201 if (is_integral(tmp)) 2202 return _ifactor(tmp,context0); 2203 return _factor(tmp,context0); 2204 } 2205 if (v.back()==at_plus) 2206 return _partfrac(tmp,context0); 2207 if (v.back().type==_FUNC) 2208 return _convert(gen(makevecteur(tmp,v.back()),_SEQ__VECT),context0); 2209 } 2210 #endif 2211 if (v.back().type==_FUNC) // additional check for STO> +/-/etc. if CAS38_DISABLED is set 2212 return gensizeerr(contextptr); 2213 if (vs>1) 2214 return _reorder(makesequence(tmp,vecteur(v.begin()+1,v.end())),context0); 2215 } 2216 tmp=eval(args,1,context0); 2217 tmp=evalfunc(tmp,contextptr); 2218 return _recursive_normal(tmp,context0); // return symb_quote(_partfrac(args,contextptr)); // return symb_quote(recursive_normal(args,1,contextptr)); // symb_quote(simplify(eval(args,1,context0),context0)); 2219 } 2220 static const char _POLYFORM_s[]="POLYFORM"; 2221 static define_unary_function_eval2_quoted (__POLYFORM,&_POLYFORM,_POLYFORM_s,&printasPOLYFORM); 2222 define_unary_function_ptr5( at_POLYFORM ,alias_at_POLYFORM,&__POLYFORM,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2223 _POLYROOT(const gen & args0,GIAC_CONTEXT)2224 gen _POLYROOT(const gen & args0,GIAC_CONTEXT){ 2225 gen args=eval(args0,1,contextptr); 2226 if (args.type==_VECT && args.subtype!=_SEQ__VECT) 2227 ; 2228 else 2229 args=args0; 2230 gen res; 2231 if (complex_mode(contextptr)) 2232 res=_proot(args,contextptr); 2233 else { 2234 #if 0 // set to 1 : POLYROOT returns only real roots without multiplicities, SLOW on aspen 2235 vecteur vas_res; 2236 if (vas(symb2poly_num(args,contextptr),0,0,1e-14,vas_res,false,contextptr)) 2237 res=vas_res; 2238 else 2239 res=_proot(args,contextptr); 2240 #else 2241 res=_proot(args,contextptr); 2242 #endif 2243 } 2244 #ifdef GIAC_HAS_STO_38 2245 if (res.type==_VECT) 2246 res.subtype=_LIST__VECT; 2247 #endif 2248 return res; 2249 } 2250 static const char _POLYROOT_s[]="POLYROOT"; 2251 static define_unary_function_eval_quoted (__POLYROOT,&_POLYROOT,_POLYROOT_s); 2252 define_unary_function_ptr5( at_POLYROOT ,alias_at_POLYROOT,&__POLYROOT,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2253 _ISOLATE(const gen & args0,GIAC_CONTEXT)2254 gen _ISOLATE(const gen & args0,GIAC_CONTEXT){ 2255 #ifdef CAS38_DISABLED 2256 return gensizeerr(contextptr); 2257 #endif 2258 return symb_quote(_solve(args0,contextptr)); 2259 } 2260 static const char _ISOLATE_s[]="ISOLATE"; 2261 static define_unary_function_eval_quoted (__ISOLATE,&_ISOLATE,_ISOLATE_s); 2262 define_unary_function_ptr5( at_ISOLATE ,alias_at_ISOLATE,&__ISOLATE,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2263 2264 static const char _QUAD_s[]="QUAD"; 2265 static define_unary_function_eval_quoted (__QUAD,&_ISOLATE,_QUAD_s); 2266 define_unary_function_ptr5( at_QUAD ,alias_at_QUAD,&__QUAD,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2267 _IS_LINEAR(const gen & args,GIAC_CONTEXT)2268 gen _IS_LINEAR(const gen & args,GIAC_CONTEXT){ 2269 if ( args.type==_STRNG && args.subtype==-1) return args; 2270 if (args.type==_VECT && args._VECTptr->size()==2){ 2271 vecteur & v = *args._VECTptr; 2272 gen a,b; 2273 if (v[1].type==_IDNT && is_linear_wrt(v[0],v[1],a,b,contextptr)) 2274 return makevecteur(eval(a,eval_level(contextptr),contextptr),eval(b, eval_level(contextptr),contextptr)); 2275 else 2276 return 0; 2277 } 2278 return gentypeerr(contextptr); 2279 // return 0; 2280 } 2281 static const char _IS_LINEAR_s[]="LINEAR?"; 2282 static define_unary_function_eval_quoted (__IS_LINEAR,&_IS_LINEAR,_IS_LINEAR_s); 2283 define_unary_function_ptr5( at_IS_LINEAR ,alias_at_IS_LINEAR,&__IS_LINEAR,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2284 2285 static const char _FNROOT_s[]="FNROOT"; 2286 static define_unary_function_eval_quoted (__FNROOT,&_fsolve,_FNROOT_s); 2287 define_unary_function_ptr5( at_FNROOT ,alias_at_FNROOT,&__FNROOT,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2288 _SVD(const gen & args0,GIAC_CONTEXT)2289 gen _SVD(const gen & args0,GIAC_CONTEXT){ 2290 if ( args0.type==_STRNG && args0.subtype==-1) return args0; 2291 if (!ckmatrix(args0)) 2292 return gentypeerr(contextptr); 2293 if (!has_num_coeff(args0)) 2294 *logptr(contextptr) << gettext("SVD is implemented for numeric matrices, running evalf first") << '\n'; 2295 gen args=evalf(args0,1,contextptr); 2296 gen res= _svd(gen(makevecteur(args,-1),_SEQ__VECT),contextptr); 2297 if (res.type==_VECT) res.subtype=_LIST__VECT; 2298 return res; 2299 } 2300 static const char _SVD_s[]="SVD"; 2301 static define_unary_function_eval (__SVD,&_SVD,_SVD_s); // FIXME 2302 define_unary_function_ptr5( at_SVD ,alias_at_SVD,&__SVD,0,T_UNARY_OP_38); 2303 _SVL(const gen & args0,GIAC_CONTEXT)2304 gen _SVL(const gen & args0,GIAC_CONTEXT){ 2305 if ( args0.type==_STRNG && args0.subtype==-1) return args0; 2306 if (!ckmatrix(args0)) 2307 return gentypeerr(contextptr); 2308 gen args=evalf(args0,1,contextptr); 2309 return _svd(gen(makevecteur(args,-2),_SEQ__VECT),contextptr); 2310 } 2311 static const char _SVL_s[]="SVL"; 2312 static define_unary_function_eval (__SVL,&_SVL,_SVL_s); 2313 define_unary_function_ptr5( at_SVL ,alias_at_SVL,&__SVL,0,T_UNARY_OP_38); 2314 2315 static const char _svl_s[]="svl"; 2316 static define_unary_function_eval (__svl,&_SVL,_svl_s); 2317 define_unary_function_ptr5( at_svl ,alias_at_svl,&__svl,0,T_UNARY_OP); 2318 _SPECRAD(const gen & args0,GIAC_CONTEXT)2319 gen _SPECRAD(const gen & args0,GIAC_CONTEXT){ 2320 if ( args0.type==_STRNG && args0.subtype==-1) return args0; 2321 gen args=evalf(args0,1,contextptr); 2322 if (!is_squarematrix(args)) 2323 return gentypeerr(contextptr); 2324 vecteur v=megvl(*args._VECTptr,contextptr); 2325 if (is_undef(v)) return v; 2326 gen res,tmp; 2327 int s=int(v.size()); 2328 for (int i=0;i<s;++i){ 2329 tmp=abs(v[i],contextptr); 2330 if (ck_is_strictly_greater(tmp,res,contextptr)) 2331 res=tmp; 2332 } 2333 return res; 2334 } 2335 static const char _SPECRAD_s[]="SPECRAD"; 2336 static define_unary_function_eval (__SPECRAD,&_SPECRAD,_SPECRAD_s); // FIXME 2337 define_unary_function_ptr5( at_SPECRAD ,alias_at_SPECRAD,&__SPECRAD,0,T_UNARY_OP_38); 2338 _SPECNORM(const gen & args0,GIAC_CONTEXT)2339 gen _SPECNORM(const gen & args0,GIAC_CONTEXT){ 2340 if ( args0.type==_STRNG && args0.subtype==-1) return args0; 2341 gen args=evalf(args0,1,contextptr); 2342 if (!ckmatrix(args)){ 2343 if (args.type==_VECT) 2344 return _l2norm(args,contextptr); 2345 return gentypeerr(contextptr); 2346 } 2347 return _max(_SVL(*args._VECTptr,contextptr),contextptr); 2348 } 2349 static const char _SPECNORM_s[]="SPECNORM"; 2350 static define_unary_function_eval (__SPECNORM,&_SPECNORM,_SPECNORM_s); // FIXME 2351 define_unary_function_ptr5( at_SPECNORM ,alias_at_SPECNORM,&__SPECNORM,0,T_UNARY_OP_38); 2352 _COND(const gen & args0,GIAC_CONTEXT)2353 gen _COND(const gen & args0,GIAC_CONTEXT){ 2354 if ( args0.type==_STRNG && args0.subtype==-1) return args0; 2355 // COND(matrix,2) L2norm condition number 2356 // otherwise COLNORM(args0)*COLNORM(inv(args0)) 2357 if (args0.type==_VECT && args0._VECTptr->size()==2){ 2358 if (args0._VECTptr->back()==1) 2359 return _COND(args0._VECTptr->front(),contextptr); 2360 if (args0._VECTptr->back()==2){ 2361 gen args=args0._VECTptr->front(); 2362 if (!ckmatrix(args)) 2363 return gentypeerr(contextptr); 2364 double save_eps=epsilon(contextptr); 2365 epsilon(0.0,contextptr); // otherwise small singular values are cancelled and condition is infinity 2366 gen g=_SVL(args,contextptr); 2367 epsilon(save_eps,contextptr); 2368 if (is_undef(g)) return g; 2369 if (g.type!=_VECT) 2370 return undef; 2371 vecteur & v =*g._VECTptr; 2372 int s=int(v.size()); 2373 gen mina(plus_inf),maxa(0); 2374 for (int i=0;i<s;++i){ 2375 gen tmp=abs(v[i],contextptr); 2376 if (ck_is_strictly_greater(mina,tmp,contextptr)) 2377 mina=tmp; 2378 if (ck_is_strictly_greater(tmp,maxa,contextptr)) 2379 maxa=tmp; 2380 } 2381 return maxa/mina; 2382 } 2383 if (is_inf(args0._VECTptr->back())){ 2384 gen args=evalf(args0._VECTptr->front(),1,contextptr); 2385 if (!is_squarematrix(args)) 2386 return gensizeerr(contextptr); 2387 gen invargs=inv(args,contextptr); 2388 if (is_undef(invargs)) 2389 return undef; 2390 return _rowNorm(args,contextptr)*_rowNorm(invargs,contextptr); 2391 } 2392 } 2393 gen args=evalf(args0,1,contextptr); 2394 if (!is_squarematrix(args)) 2395 return gensizeerr(contextptr); 2396 gen invargs=inv(args,contextptr); 2397 if (is_undef(invargs)) 2398 return undef; 2399 return _colNorm(args,contextptr)*_colNorm(invargs,contextptr); 2400 // return _colNorm(args,contextptr)*_rowNorm(args,contextptr)/abs(_det(args,contextptr),contextptr); 2401 } 2402 static const char _COND_s[]="COND"; 2403 static define_unary_function_eval (__COND,&_COND,_COND_s); // FIXME 2404 define_unary_function_ptr5( at_COND ,alias_at_COND,&__COND,0,T_UNARY_OP_38); 2405 2406 static const char _cond_s[]="cond"; 2407 static define_unary_function_eval (__cond,&_COND,_cond_s); // FIXME 2408 define_unary_function_ptr5( at_cond ,alias_at_cond,&__cond,0,T_UNARY_OP); 2409 _SCHUR(const gen & args,GIAC_CONTEXT)2410 gen _SCHUR(const gen & args,GIAC_CONTEXT){ 2411 if ( args.type==_STRNG && args.subtype==-1) return args; 2412 gen res; 2413 if (ckmatrix(args)){ 2414 if (!is_squarematrix(args)) 2415 return gendimerr(contextptr); 2416 #ifdef HAVE_LIBMPFR 2417 res= _hessenberg(gen(makevecteur(args,epsilon(contextptr)),_SEQ__VECT),contextptr); 2418 #else 2419 res= _hessenberg(gen(makevecteur(args,1e-12),_SEQ__VECT),contextptr); 2420 #endif 2421 } 2422 else 2423 res= _hessenberg(args,contextptr); 2424 if (res.type==_VECT) res.subtype=_LIST__VECT; 2425 return res; 2426 } 2427 static const char _SCHUR_s[]="SCHUR"; 2428 static define_unary_function_eval (__SCHUR,&_SCHUR,_SCHUR_s); // FIXME 2429 define_unary_function_ptr5( at_SCHUR ,alias_at_SCHUR,&__SCHUR,0,T_UNARY_OP_38); 2430 2431 static const char _schur_s[]="schur"; 2432 static define_unary_function_eval (__schur,&_SCHUR,_schur_s); // FIXME 2433 define_unary_function_ptr5( at_schur ,alias_at_schur,&__schur,0,T_UNARY_OP); 2434 _LQ(const gen & args0,GIAC_CONTEXT)2435 gen _LQ(const gen & args0,GIAC_CONTEXT){ 2436 if ( args0.type==_STRNG && args0.subtype==-1) return args0; 2437 gen args=evalf(args0,1,contextptr); 2438 if (!ckmatrix(args)) 2439 return gentypeerr(contextptr); 2440 gen res=qr(makevecteur(_trn(args,contextptr),-1),contextptr); 2441 if (is_undef(res) || res.type!=_VECT || res._VECTptr->size()<3) 2442 return gensizeerr(contextptr); 2443 vecteur v(*res._VECTptr); 2444 v[0]=_trn(v[0],contextptr); 2445 v[1]=_trn(v[1],contextptr); 2446 swapgen(v[0],v[1]); 2447 // v[2]=midn(v[0]._VECTptr->size()); 2448 return gen(v,_LIST__VECT); 2449 } 2450 static const char _LQ_s[]="LQ"; 2451 static define_unary_function_eval (__LQ,&_LQ,_LQ_s); 2452 define_unary_function_ptr5( at_LQ ,alias_at_LQ,&__LQ,0,T_UNARY_OP_38); 2453 2454 static const char _RREF_s[]="RREF"; 2455 static define_unary_function_eval (__RREF,&_rref,_RREF_s); // FIXME 2456 define_unary_function_ptr5( at_RREF ,alias_at_RREF,&__RREF,0,T_UNARY_OP_38); 2457 _XPON(const gen & g0,GIAC_CONTEXT)2458 gen _XPON(const gen & g0,GIAC_CONTEXT){ 2459 if (g0.type==_STRNG && g0.subtype==-1) return g0; 2460 if (is_equal(g0)) 2461 return apply_to_equal(g0,_XPON,contextptr); 2462 if (g0.type==_VECT) 2463 return apply(g0,_XPON,contextptr); 2464 #if 0 // def BCD 2465 gen g=evalf2bcd(g0,1,contextptr); 2466 #else 2467 gen g=evalf_double(g0,1,contextptr); 2468 #endif 2469 if (is_exactly_zero(g)) 2470 return undef; 2471 gen gf=_floor(log10(abs(g,contextptr),contextptr),contextptr); 2472 if (gf.type!=_INT_ && gf.type!=_FLOAT_) 2473 return gensizeerr(contextptr); 2474 return gf; 2475 } 2476 static const char _XPON_s[]="XPON"; 2477 static define_unary_function_eval (__XPON,&_XPON,_XPON_s); // FIXME 2478 define_unary_function_ptr5( at_XPON ,alias_at_XPON,&__XPON,0,T_UNARY_OP_38); 2479 mantissa(const gen & g0,bool includesign,int base,gen & expo,GIAC_CONTEXT)2480 gen mantissa(const gen & g0,bool includesign,int base,gen & expo,GIAC_CONTEXT){ 2481 #if 0 // def BCD 2482 gen g=evalf2bcd(g0,1,contextptr); 2483 #else 2484 gen g=evalf_double(g0,1,contextptr); 2485 #endif 2486 if (is_exactly_zero(g)) 2487 return g; 2488 gen gabs=abs(g,contextptr); 2489 expo=base==10?log10(gabs,contextptr):_logb(makesequence(gabs,base),contextptr); 2490 expo=_floor(expo,contextptr); 2491 if (abs_calc_mode(contextptr)!=38 && expo.type!=_INT_) 2492 return gensizeerr(contextptr); 2493 // FIXME number of digits 2494 gabs=gabs*(base==10?alog10(-expo,contextptr):pow(base,-expo,contextptr)); 2495 return (includesign?sign(g,contextptr):1)*evalf(gabs,1,contextptr); 2496 } mantissa(const gen & g0,bool includesign,GIAC_CONTEXT)2497 gen mantissa(const gen & g0,bool includesign,GIAC_CONTEXT){ 2498 gen expo; 2499 return mantissa(g0,includesign,10,expo,contextptr); 2500 } _MANT(const gen & g0,GIAC_CONTEXT)2501 gen _MANT(const gen & g0,GIAC_CONTEXT){ 2502 if (g0.type==_STRNG && g0.subtype==-1) return g0; 2503 if (is_equal(g0)) 2504 return apply_to_equal(g0,_MANT,contextptr); 2505 if (g0.type==_VECT) 2506 return apply(g0,_MANT,contextptr); 2507 return mantissa(g0,true,contextptr); 2508 } 2509 static const char _MANT_s[]="MANT"; 2510 static define_unary_function_eval (__MANT,&_MANT,_MANT_s); 2511 define_unary_function_ptr5( at_MANT ,alias_at_MANT,&__MANT,0,T_UNARY_OP_38); 2512 _mantissa(const gen & g0,GIAC_CONTEXT)2513 gen _mantissa(const gen & g0,GIAC_CONTEXT){ 2514 if (g0.type==_STRNG && g0.subtype==-1) return g0; 2515 if (is_equal(g0)) 2516 return apply_to_equal(g0,_mantissa,contextptr); 2517 if (g0.type==_VECT) 2518 return apply(g0,_mantissa,contextptr); 2519 return mantissa(g0,false,contextptr); 2520 } 2521 static const char _mantissa_s[]="mantissa"; 2522 static define_unary_function_eval (__mantissa,&_mantissa,_mantissa_s); 2523 define_unary_function_ptr5( at_mantissa ,alias_at_mantissa,&__mantissa,0,T_UNARY_OP); 2524 _frexp(const gen & g0,GIAC_CONTEXT)2525 gen _frexp(const gen & g0,GIAC_CONTEXT){ 2526 if (g0.type==_STRNG && g0.subtype==-1) return g0; 2527 if (is_equal(g0)) 2528 return apply_to_equal(g0,_frexp,contextptr); 2529 if (g0.type==_VECT) 2530 return gensizeerr(contextptr); // apply(g0,_frexp,contextptr); 2531 gen expo; 2532 gen m=mantissa(g0,true,2,expo,contextptr); 2533 return makesequence(m/2,expo+1); 2534 } 2535 static const char _frexp_s[]="frexp"; 2536 static define_unary_function_eval (__frexp,&_frexp,_frexp_s); 2537 define_unary_function_ptr5( at_frexp ,alias_at_frexp,&__frexp,0,T_UNARY_OP); 2538 _ldexp(const gen & g0,GIAC_CONTEXT)2539 gen _ldexp(const gen & g0,GIAC_CONTEXT){ 2540 if (g0.type==_STRNG && g0.subtype==-1) return g0; 2541 if (g0.type!=_VECT || g0.subtype!=_SEQ__VECT || g0._VECTptr->size()!=2) 2542 return gensizeerr(contextptr); 2543 return g0._VECTptr->front()*pow(2,g0._VECTptr->back(),contextptr); 2544 } 2545 static const char _ldexp_s[]="ldexp"; 2546 static define_unary_function_eval (__ldexp,&_ldexp,_ldexp_s); 2547 define_unary_function_ptr5( at_ldexp ,alias_at_ldexp,&__ldexp,0,T_UNARY_OP); 2548 _copysign(const gen & g0,GIAC_CONTEXT)2549 gen _copysign(const gen & g0,GIAC_CONTEXT){ 2550 if (g0.type==_STRNG && g0.subtype==-1) return g0; 2551 if (g0.type!=_VECT || g0.subtype!=_SEQ__VECT || g0._VECTptr->size()!=2) 2552 return gensizeerr(contextptr); 2553 return abs(g0._VECTptr->front(),contextptr)*sign(g0._VECTptr->back(),contextptr); 2554 } 2555 static const char _copysign_s[]="copysign"; 2556 static define_unary_function_eval (__copysign,&_copysign,_copysign_s); 2557 define_unary_function_ptr5( at_copysign ,alias_at_copysign,&__copysign,0,T_UNARY_OP); 2558 _HMSX(const gen & g0,GIAC_CONTEXT)2559 gen _HMSX(const gen & g0,GIAC_CONTEXT){ 2560 if ( g0.type==_STRNG && g0.subtype==-1) return g0; 2561 if (g0.type==_VECT) 2562 return apply(g0,_HMSX,contextptr); 2563 gen g(evalf(g0,1,contextptr)); 2564 if (g.type==_DOUBLE_) 2565 g = g+1e-12; 2566 if (g.type==_FLOAT_) 2567 g = g+plus_one/20000; 2568 if (g.type!=_DOUBLE_ && g.type!=_FLOAT_) 2569 return gentypeerr(contextptr); 2570 gen h=_floor(g,contextptr); 2571 gen m=_floor(100*(g-h),contextptr); 2572 gen s=_floor(100*(100*(g-h)-m),contextptr); 2573 return h+m/giac_float(60.)+s/giac_float(3600.); 2574 } 2575 static const char _HMSX_s[]="HMSX"; 2576 static define_unary_function_eval (__HMSX,&_HMSX,_HMSX_s); 2577 define_unary_function_ptr5( at_HMSX ,alias_at_HMSX,&__HMSX,0,T_UNARY_OP_38); 2578 _XHMS(const gen & g0,GIAC_CONTEXT)2579 gen _XHMS(const gen & g0,GIAC_CONTEXT){ 2580 if ( g0.type==_STRNG && g0.subtype==-1) return g0; 2581 if (g0.type==_VECT) 2582 return apply(g0,_XHMS,contextptr); 2583 gen g(evalf(g0,1,contextptr)); 2584 if (g.type==_DOUBLE_) 2585 g = g+1e-12; 2586 if (g.type==_FLOAT_) 2587 g=g+plus_one/7200; 2588 if (g.type!=_DOUBLE_ && g.type!=_FLOAT_) 2589 return gentypeerr(contextptr); 2590 gen h=_floor(g,contextptr); 2591 gen m=_floor(60*(g-h),contextptr); 2592 gen s=_floor(60*(60*(g-h)-m),contextptr); 2593 return h+m/giac_float(100.)+s/giac_float(10000.); 2594 } 2595 static const char _XHMS_s[]="XHMS"; 2596 static define_unary_function_eval (__XHMS,&_XHMS,_XHMS_s); 2597 define_unary_function_ptr5( at_XHMS ,alias_at_XHMS,&__XHMS,0,T_UNARY_OP_38); 2598 _DEGXRAD(const gen & g,GIAC_CONTEXT)2599 gen _DEGXRAD(const gen & g,GIAC_CONTEXT){ 2600 if ( g.type==_STRNG && g.subtype==-1) return g; 2601 if (g.type==_VECT) 2602 return apply(g,_DEGXRAD,contextptr); 2603 return deg2rad_d*g; 2604 } 2605 static const char _DEGXRAD_s[]="DEGXRAD"; 2606 static define_unary_function_eval (__DEGXRAD,&_DEGXRAD,_DEGXRAD_s); 2607 define_unary_function_ptr5( at_DEGXRAD ,alias_at_DEGXRAD,&__DEGXRAD,0,T_UNARY_OP_38); 2608 _RADXDEG(const gen & g,GIAC_CONTEXT)2609 gen _RADXDEG(const gen & g,GIAC_CONTEXT){ 2610 if ( g.type==_STRNG && g.subtype==-1) return g; 2611 if (g.type==_VECT) 2612 return apply(g,_RADXDEG,contextptr); 2613 return rad2deg_d*g; 2614 } 2615 static const char _RADXDEG_s[]="RADXDEG"; 2616 static define_unary_function_eval (__RADXDEG,&_RADXDEG,_RADXDEG_s); 2617 define_unary_function_ptr5( at_RADXDEG ,alias_at_RADXDEG,&__RADXDEG,0,T_UNARY_OP_38); 2618 _PERCENT(const gen & g,GIAC_CONTEXT)2619 gen _PERCENT(const gen & g,GIAC_CONTEXT){ 2620 if ( g.type==_STRNG && g.subtype==-1) return g; 2621 if (g.type!=_VECT || g._VECTptr->size()!=2) 2622 return gentypeerr(contextptr); 2623 return g._VECTptr->front()*g._VECTptr->back()/giac_float(100.); 2624 } 2625 static const char _PERCENT_s[]="%"; // FIXE 2626 static define_unary_function_eval (__PERCENT,&_PERCENT,_PERCENT_s); 2627 define_unary_function_ptr5( at_PERCENT ,alias_at_PERCENT,&__PERCENT,0,T_UNARY_OP_38); 2628 _PERCENTCHANGE(const gen & g,GIAC_CONTEXT)2629 gen _PERCENTCHANGE(const gen & g,GIAC_CONTEXT){ 2630 if ( g.type==_STRNG && g.subtype==-1) return g; 2631 if (g.type!=_VECT || g._VECTptr->size()!=2) 2632 return gentypeerr(contextptr); 2633 return giac_float(100.)*(g._VECTptr->back()-g._VECTptr->front())/g._VECTptr->front(); 2634 } 2635 static const char _PERCENTCHANGE_s[]="%CHANGE"; 2636 static define_unary_function_eval (__PERCENTCHANGE,&_PERCENTCHANGE,_PERCENTCHANGE_s); 2637 define_unary_function_ptr5( at_PERCENTCHANGE ,alias_at_PERCENTCHANGE,&__PERCENTCHANGE,0,T_UNARY_OP_38); 2638 _PERCENTTOTAL(const gen & g,GIAC_CONTEXT)2639 gen _PERCENTTOTAL(const gen & g,GIAC_CONTEXT){ 2640 if ( g.type==_STRNG && g.subtype==-1) return g; 2641 if (g.type!=_VECT || g._VECTptr->size()!=2) 2642 return gentypeerr(contextptr); 2643 return giac_float(100.)*g._VECTptr->back()/g._VECTptr->front(); 2644 } 2645 static const char _PERCENTTOTAL_s[]="%TOTAL"; 2646 static define_unary_function_eval (__PERCENTTOTAL,&_PERCENTTOTAL,_PERCENTTOTAL_s); 2647 define_unary_function_ptr5( at_PERCENTTOTAL ,alias_at_PERCENTTOTAL,&__PERCENTTOTAL,0,T_UNARY_OP_38); 2648 _DISP(const gen & g,GIAC_CONTEXT)2649 gen _DISP(const gen & g,GIAC_CONTEXT){ 2650 if (g.type!=_VECT || g._VECTptr->size()!=2) 2651 return gensizeerr(contextptr); 2652 gen a=g._VECTptr->front(); 2653 if (a.type!=_INT_ || a.val <0 || a.val>10) 2654 setdimerr(contextptr); 2655 gen b=g._VECTptr->back(); 2656 return _legende(gen(makevecteur(makevecteur(0,a*gen(12)),b),_SEQ__VECT),contextptr); 2657 } 2658 static const char _DISP_s []="DISP"; 2659 static define_unary_function_eval_quoted (__DISP,&_DISP,_DISP_s); 2660 define_unary_function_ptr5( at_DISP ,alias_at_DISP,&__DISP,0,T_UNARY_OP_38); 2661 2662 static const char _WAIT_s []="WAIT"; 2663 static define_unary_function_eval (__WAIT,&_Pause,_WAIT_s); 2664 define_unary_function_ptr5( at_WAIT ,alias_at_WAIT,&__WAIT,0,T_UNARY_OP_38); 2665 2666 #if 0 // def GIAC_HAS_STO_38 2667 gen aspen_input(const vecteur & v,GIAC_CONTEXT); 2668 gen aspen_msgbox(const vecteur & v,GIAC_CONTEXT); 2669 #endif 2670 2671 // INPUT(A) or INPUT(A,"title") or INPUT(A,"title","label") or INPUT(A,"title","label","help") 2672 // or INPUT(A,"title","label","help",default_value) _INPUT(const gen & args,GIAC_CONTEXT)2673 gen _INPUT(const gen & args,GIAC_CONTEXT){ 2674 vecteur v=gen2vecteur(args); 2675 int s=int(v.size()); 2676 if (s==1){ 2677 v.push_back(string2gen("Input")); 2678 ++s; 2679 } 2680 if (s==2){ 2681 v.push_back(string2gen(v[0].print(contextptr),false)); 2682 ++s; 2683 } 2684 if (s==3){ 2685 v.push_back(string2gen("Enter value for "+v[0].print(contextptr),false)); 2686 ++s; 2687 } 2688 // check types 2689 if (v[0].is_symb_of_sommet(at_double_deux_points) && v[0]._SYMBptr->feuille.type==_VECT && v[0]._SYMBptr->feuille._VECTptr->size()==2) 2690 v[0]=v[0]._SYMBptr->feuille._VECTptr->back(); 2691 for (int i=1; i<=3; i++) { if (v[i].type!=_STRNG) v[i]= eval(v[i], 1, contextptr); if (v[i].type!=_STRNG) v[i]= string2gen(v[i].print(contextptr)); } 2692 if (v[0].type!=_IDNT || s>5) 2693 return gentypeerr(contextptr); 2694 // set default value in v[0] 2695 if (s==5){ 2696 gen tmpsto=sto(v[4],v[0],contextptr); 2697 if (is_undef(tmpsto)) return tmpsto; 2698 v.pop_back(); 2699 s=4; 2700 } 2701 #if 0 // def GIAC_HAS_STO_38 2702 return aspen_input(v,contextptr); 2703 #else 2704 // now make a dialog 2705 v[1]=symbolic(at_Title,v[1]); 2706 v[2]=symbolic(at_Request,makesequence(v[2],v[0])); 2707 v[3]=symbolic(at_Text,v[3]); 2708 v.erase(v.begin()); 2709 return _Dialog(gen(v,_SEQ__VECT),contextptr); 2710 #endif 2711 } 2712 static const char _INPUT_s []="INPUT"; 2713 static define_unary_function_eval_quoted (__INPUT,_INPUT,_INPUT_s); 2714 define_unary_function_ptr5( at_INPUT ,alias_at_INPUT,&__INPUT,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2715 2716 #if 0 // def GIAC_HAS_STO_38 2717 // MSGBOX(txt) or MSGBOX(txt, true/false) to have OK/Cancel or just OK menus 2718 gen _MSGBOX(const gen & args,GIAC_CONTEXT){ 2719 vecteur v=gen2vecteur(args); 2720 int s=int(v.size()); 2721 if (s==1) { v.push_back(gen(0)); ++s; } 2722 return aspen_msgbox(v,contextptr); 2723 } 2724 #else _MSGBOX(const gen & args,GIAC_CONTEXT)2725 gen _MSGBOX(const gen & args,GIAC_CONTEXT){ 2726 return _output(args,contextptr); 2727 } 2728 #endif 2729 static const char _MSGBOX_s []="MSGBOX"; 2730 static define_unary_function_eval (__MSGBOX,_MSGBOX,_MSGBOX_s); 2731 define_unary_function_ptr5( at_MSGBOX ,alias_at_MSGBOX,&__MSGBOX,0,T_UNARY_OP_38); 2732 2733 static const char _GETKEY_s[]="GETKEY"; 2734 #if 0 // def GIAC_HAS_STO_38 2735 static define_unary_function_eval(__GETKEY,&at_GETKEYAspen,_GETKEY_s); 2736 // unary_function_eval __GETKEY(0,&at_GETKEYAspen,_GETKEY_s); 2737 #else 2738 unary_function_eval __GETKEY(0,&_getKey,_GETKEY_s); 2739 #endif 2740 define_unary_function_ptr5( at_GETKEY ,alias_at_GETKEY,&__GETKEY,0,T_UNARY_OP_38); 2741 _ITERATE(const gen & args,GIAC_CONTEXT)2742 gen _ITERATE(const gen & args,GIAC_CONTEXT){ 2743 if ( args.type==_STRNG && args.subtype==-1) return args; 2744 if (args.type!=_VECT || args._VECTptr->size()!=4) 2745 return gentypeerr(contextptr); 2746 vecteur v = plotpreprocess(args,contextptr); 2747 gen v0=v[0]; 2748 gen v1=v[1]; 2749 // v[2]=eval(v[2],eval_level(contextptr),contextptr); 2750 // v[3]=eval(v[3],eval_level(contextptr),contextptr); 2751 if (v[3].type!=_INT_) 2752 return gentypeerr(contextptr); 2753 int n=v[3].val; 2754 bool all=n<0; 2755 if (all){ 2756 n=-n; 2757 if (n>LIST_SIZE_LIMIT) 2758 return gendimerr(contextptr); 2759 } 2760 gen value=v[2]; 2761 vecteur res; 2762 if (all) 2763 res=vecteur(n+1,value); 2764 for (int i=0;!ctrl_c && !interrupted && i<n;++i){ 2765 #ifdef TIMEOUT 2766 control_c(); 2767 #endif 2768 value=evalf(subst(v0,v1,value,false,contextptr),eval_level(contextptr),contextptr); 2769 if (is_undef(value)) 2770 return value; 2771 if (all) 2772 res[i+1]=value; 2773 } 2774 return all?res:value; 2775 } 2776 static const char _ITERATE_s[]="ITERATE"; 2777 static define_unary_function_eval_quoted (__ITERATE,&_ITERATE,_ITERATE_s); 2778 define_unary_function_ptr5( at_ITERATE ,alias_at_ITERATE,&__ITERATE,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2779 2780 #ifndef GIAC_HAS_STO_38 _RECURSE(const gen & args,GIAC_CONTEXT)2781 gen _RECURSE(const gen & args,GIAC_CONTEXT){ 2782 if ( args.type==_STRNG && args.subtype==-1) return args; 2783 if (args.type!=_VECT || args._VECTptr->size()<2) 2784 return gentypeerr(contextptr); 2785 vecteur v = *args._VECTptr; 2786 gen v0=v[0]; 2787 gen v1=v[1]; 2788 int s=int(v.size()); 2789 for (int i=2;i<s;++i) 2790 v[i]=eval(v[i],eval_level(contextptr),contextptr); 2791 if (v[0].type!=_IDNT) 2792 return _rsolve(gen(v,args.subtype),contextptr); 2793 // HP38 syntax, define recurrent sequence 2794 // idnt, expression, first term, second term 2795 // e.g. RECURSE(U,U(N-1)*N,1,2) STO> U1(N) 2796 return gentypeerr(contextptr); 2797 return undef; 2798 } 2799 static const char _RECURSE_s[]="RECURSE"; 2800 static define_unary_function_eval_quoted (__RECURSE,&_RECURSE,_RECURSE_s); 2801 define_unary_function_ptr5( at_RECURSE ,alias_at_RECURSE,&__RECURSE,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2802 #endif 2803 _MAKEMAT(const gen & args,GIAC_CONTEXT)2804 gen _MAKEMAT(const gen & args,GIAC_CONTEXT){ 2805 if ( args.type==_STRNG && args.subtype==-1) return args; 2806 if (args.type!=_VECT || args._VECTptr->size()!=3) 2807 return gentypeerr(contextptr); 2808 vecteur v = *args._VECTptr; 2809 gen v0=v[0]; 2810 gen v1=eval(v[1],eval_level(contextptr),contextptr); 2811 gen v2=eval(v[2],eval_level(contextptr),contextptr); 2812 is_integral(v1); 2813 is_integral(v2); 2814 if (v1.type!=_INT_ || v2.type!=_INT_ || v1.val<1 || v2.val<1) 2815 return gensizeerr(contextptr); 2816 int l=giacmax(v1.val,1),c=giacmax(v2.val,1); 2817 if (longlong(l)*c>LIST_SIZE_LIMIT) 2818 return gendimerr(contextptr); 2819 identificateur idI("I"),idJ("J"); 2820 vecteur IJ=makevecteur(idI,idJ); 2821 vecteur IJval(2),res; 2822 for (int i=1;i<=l;++i){ 2823 vecteur ligne(c); 2824 IJval[0]=i; 2825 for (int j=1;j<=c;++j){ 2826 IJval[1]=j; 2827 ligne[j-1]=eval(subst(v0,IJ,IJval,false,contextptr),eval_level(contextptr),contextptr); 2828 } 2829 res.push_back(ligne); 2830 } 2831 return res; 2832 } 2833 static const char _MAKEMAT_s[]="MAKEMAT"; 2834 static define_unary_function_eval_quoted (__MAKEMAT,&_MAKEMAT,_MAKEMAT_s); 2835 define_unary_function_ptr5( at_MAKEMAT ,alias_at_MAKEMAT,&__MAKEMAT,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 2836 2837 // For over-determined system, find the solution such that || A*X-B || (L2) is min 2838 // for under-determined system, find a solution X of A*X=B such that ||X|| is min _LSQ(const gen & args,GIAC_CONTEXT)2839 gen _LSQ(const gen & args,GIAC_CONTEXT){ 2840 if ( args.type==_STRNG && args.subtype==-1) return args; 2841 if (args.type!=_VECT || args._VECTptr->size()<2) 2842 return gentypeerr(contextptr); 2843 vecteur v = *args._VECTptr; 2844 gen v0=v[0]; // evalf(v[0],1,contextptr) 2845 gen v1=v[1]; 2846 int vs=int(v.size()); 2847 if (vs==3){ 2848 v.push_back(vecteur(0)); 2849 ++vs; 2850 } 2851 if (vs==4){ 2852 gen v2=v[2],v3=v[3]; 2853 if (v0.type==_VECT && v1.type==_VECT && !v0._VECTptr->empty() && v0._VECTptr->size()==v1._VECTptr->size() && v2.type==_VECT && v3.type==_VECT){ 2854 // v0=list of values of x or of [x,y,...], v1= observed value at x, 2855 // v2=v[vs-2]=list of expressions f_i(x) or f_i(x,y) or [f_i(vars)],[vars] 2856 // v3=v.back()=list of constraints = list of 2857 // [X_k,n_k (number of derivatives), Y_k=value of n_k-th diff at X_k] 2858 // or [[X_k,Y_k,...],[n_k],value] 2859 // minimize sum_j=1..N (y_j-sum_i=1..M(a_i*f_i(x_j),i))^2 2860 // under sum_i=1..M a_i*diff(f_i,n_k)(X_k) = 0 for k=1..K 2861 vecteur expr(*v2._VECTptr),constraints(*v3._VECTptr); 2862 if (!constraints.empty() && constraints.front().type!=_VECT) 2863 constraints=vecteur(1,constraints); 2864 if (!constraints.empty() && (!ckmatrix(constraints) || constraints.front()._VECTptr->size()!=3)) 2865 return gensizeerr(contextptr); 2866 vecteur & x=*v0._VECTptr; 2867 vecteur & y=*v1._VECTptr; 2868 unsigned M=unsigned(expr.size()), K=unsigned(constraints.size()),N=unsigned(v0._VECTptr->size()); 2869 vecteur vars(1,x__IDNT_e); 2870 int dim=2; 2871 if (x.front().type==_VECT){ 2872 if (!ckmatrix(x)) 2873 return gensizeerr(contextptr); 2874 dim=int(x.front()._VECTptr->size())+1; 2875 if (dim<2) 2876 return gendimerr(contextptr); 2877 } 2878 if (dim==3) 2879 vars.push_back(y__IDNT_e); 2880 if (expr.front().type==_VECT){ 2881 if (M!=2 || expr.back().type!=_VECT) 2882 return gensizeerr(contextptr); 2883 vars=*expr.back()._VECTptr; 2884 if (int(vars.size())!=dim-1) 2885 return gendimerr(contextptr); 2886 expr=*expr.front()._VECTptr; 2887 M=unsigned(expr.size()); 2888 } 2889 else { 2890 if (dim>3) 2891 return gendimerr(contextptr); 2892 } 2893 // F_{i,j}=f_i(x_j) 2894 matrice F; // M rows, N cols 2895 for (unsigned i=0;i<M;++i){ 2896 gen fi=expr[i]; 2897 vecteur ligne; 2898 for (unsigned j=0;j<N;++j){ 2899 ligne.push_back(subst(fi,vars,gen2vecteur(x[j]),false,contextptr)); 2900 } 2901 F.push_back(ligne); 2902 } 2903 // dF_{i,k}=diff(f_i,n_k)(X_k) 2904 matrice dF; // M rows, K cols 2905 for (unsigned i=0;i<M;++i){ 2906 gen fi=expr[i]; 2907 vecteur ligne; 2908 for (unsigned k=0;k<K;++k){ 2909 gen nk=constraints[k][1]; 2910 gen tmp=derive(fi,vars,gen2vecteur(nk),contextptr); 2911 ligne.push_back(subst(tmp,vars,gen2vecteur(constraints[k][0]),false,contextptr)); 2912 } 2913 dF.push_back(ligne); 2914 } 2915 matrice mat; // M+K rows, M+K+1 cols 2916 // first M equations of linear system: for l=1..M 2917 // sum_i=1..M a_i*sum_j=1..N f_l(x_j)*f_i(x_j) + sum_k=1..K lagrange_k*diff(f_l,n_k)(X_k) = sum_j=1..N f_l(x_j)*y_j 2918 for (unsigned l=0;l<M;++l){ 2919 vecteur ligne; 2920 for (unsigned i=0;i<M;++i){ 2921 gen tmp=0; 2922 for (unsigned j=0;j<N;++j) 2923 tmp += F[l][j]*F[i][j]; 2924 ligne.push_back(tmp); 2925 } 2926 for (unsigned k=0;k<K;++k){ 2927 ligne.push_back(dF[l][k]); 2928 } 2929 gen tmp=0; 2930 for (unsigned j=0;j<N;++j){ 2931 tmp += F[l][j]*y[j]; 2932 } 2933 ligne.push_back(tmp); 2934 mat.push_back(ligne); 2935 } 2936 // last K equations 2937 // sum_i=1..M a_i*diff(f_i,n_k)(X_k)=Y_k 2938 // giving a (M+K,M+K) matrix -> linsolve, first M coordinates 2939 // -> sum_i=1..M a_i f_i(x) 2940 for (unsigned k=0;k<K;++k){ 2941 vecteur ligne(M+K+1); 2942 ligne[M+K]=constraints[k][2]; 2943 for (unsigned i=0;i<M;++i){ 2944 ligne[i]=dF[i][k]; 2945 } 2946 mat.push_back(ligne); 2947 } 2948 // now solve linear system 2949 vecteur res=mker(mat,contextptr); 2950 if (res.size()!=1 || res.front().type!=_VECT || res.front()._VECTptr->size()!=M+K+1) 2951 return gensizeerr("Singular linear system"); 2952 vecteur Res=*res.front()._VECTptr; 2953 res=vecteur(Res.begin(),Res.begin()+M); 2954 return gen(res); 2955 } 2956 else 2957 return gensizeerr(contextptr); 2958 } 2959 if (!ckmatrix(v0) || v1.type!=_VECT) 2960 return gentypeerr(contextptr); 2961 int neq=int(v0._VECTptr->size()); // neq equations 2962 v0=_trn(v0,contextptr); 2963 matrice A=*v0._VECTptr,B; 2964 if (ckmatrix(v1)) 2965 B=gen2vecteur(_trn(v1,contextptr)); 2966 else 2967 B=vecteur(1,v1); 2968 if (int(B[0]._VECTptr->size())!=neq) 2969 return gendimerr(contextptr); 2970 int as=int(A.size()),bs=int(B.size()); 2971 // bs system to solve, each with neq equations and as variables 2972 if (as>neq){ // under-determined system, find the smallest solution 2973 if (has_num_coeff(A)){ 2974 // QR factorization of A=trn(system matrix) 2975 // R_1=neq first rows of R 2976 // Q_1=neq first cols of Q 2977 // solve R_1^* c = B[i] then output Q_1*c 2978 gen qrdec=qr(A,contextptr); 2979 if (qrdec.type==_VECT && qrdec._VECTptr->size()==2){ 2980 gen q=qrdec._VECTptr->front(),r=qrdec._VECTptr->back(); 2981 if (ckmatrix(q) && ckmatrix(r)){ 2982 if (!is_zero(r[neq-1])){ 2983 vecteur R(r._VECTptr->begin(),r._VECTptr->begin()+neq); 2984 r=mtran(R); 2985 R=*r._VECTptr; 2986 vecteur qt=mtran(*q._VECTptr); 2987 matrice res; 2988 qt=vecteur(qt.begin(),qt.begin()+neq); 2989 qt=mtran(qt); 2990 for (int i=0;i<bs;++i){ 2991 gen Bi=B[i]; 2992 vecteur v,w; 2993 linsolve_l(R,*Bi._VECTptr,v); 2994 multmatvecteur(qt,v,w); 2995 res.push_back(w); 2996 } 2997 return mtran(res); 2998 } 2999 } 3000 } 3001 } 3002 // not optimal since we solve the system for each Bi 3003 A.push_back(0); 3004 matrice res; 3005 for (int i=0;i<bs;++i){ 3006 gen Bi=B[i]; 3007 A[as]=Bi; 3008 matrice At=gen2vecteur(_trn(A,contextptr)); 3009 vecteur B=mker(At,contextptr); 3010 if (is_undef(B) || B.empty()) 3011 return undef; 3012 // The last element of B must have a non-zero last component 3013 vecteur Bend=*B.back()._VECTptr; 3014 gen last=-Bend.back(); 3015 if (is_zero(last)) 3016 return vecteur(0); 3017 vecteur R=divvecteur(Bend,last); 3018 R.pop_back(); 3019 B.pop_back(); 3020 int Bs=int(B.size()); 3021 for (int j=0;j<Bs;j++) 3022 B[j]._VECTptr->pop_back(); 3023 // The solution is R+Vect(B[0],..,B[Bs-1]) 3024 // the smallest solution is the orthogonal projection of 0 on R+Vect(B) 3025 // i.e. R + projection of -R on Vect(B) 3026 matrice r,Bg=gramschmidt(B,r,false,contextptr); 3027 gen Rtmp(R); 3028 for (int j=0;j<Bs;++j){ 3029 Rtmp -= dotvecteur(Bg[j],R)/dotvecteur(Bg[j],Bg[j])*Bg[j]; 3030 } 3031 res.push_back(Rtmp); 3032 } 3033 res=gen2vecteur(_trn(res,contextptr)); 3034 return res; 3035 } 3036 matrice res; 3037 if (has_num_coeff(v)){ 3038 // <Ax-b|Ax-b> minimal, i.e. A* Ax=A* b or 3039 // A=QR, if A has m rows and n cols and m>=n, then Q is m*m and R is m*n 3040 // first n cols of Q are Q1, first n rows of R are R1 3041 // solve R1*x=Q1^t*b 3042 gen qrdec=qr(v[0],contextptr); 3043 if (qrdec.type==_VECT && qrdec._VECTptr->size()==2){ 3044 gen q=qrdec._VECTptr->front(),r=qrdec._VECTptr->back(); 3045 if (ckmatrix(q) && ckmatrix(r)){ 3046 if (!is_zero(r[int(A.size())-1])){ 3047 gen qt=_trn(q,contextptr); 3048 qt=vecteur(qt._VECTptr->begin(),qt._VECTptr->begin()+as); 3049 vecteur R(r._VECTptr->begin(),r._VECTptr->begin()+A.size()); 3050 for (int i=0;i<bs;++i){ 3051 gen Bi=B[i]; 3052 vecteur v; 3053 linsolve_u(R,multmatvecteur(*qt._VECTptr,*Bi._VECTptr),v); 3054 res.push_back(v); 3055 } 3056 return mtran(res); 3057 } 3058 // A* Ax=A* b => R* Rx=R* Qb 3059 gen rstar=_trn(r,contextptr); 3060 gen rr=rstar*r; 3061 gen rq=rstar*q*B; 3062 return _linsolve(makesequence(rr,rq),contextptr); 3063 } 3064 } 3065 } 3066 // orthogonal projection of each vector of B on image of A 3067 if (A.size()>20) 3068 *logptr(contextptr) << "LSQ: exact data, running Gramschmidt instead of qr, this is much slower for large matrices" << '\n'; 3069 matrice r,Ag=gramschmidt(A,r,false,contextptr); 3070 for (int i=0;i<bs;++i){ 3071 gen Bi=B[i]; 3072 vecteur tmp(as); 3073 for (int j=0;j<as;++j){ 3074 tmp[j] = scalar_product(Ag[j],Bi,contextptr)/scalar_product(Ag[j],Ag[j],contextptr); 3075 } 3076 res.push_back(tmp); 3077 } 3078 res=gen2vecteur(_trn(res,contextptr)); 3079 return mmult(*inv(r,contextptr)._VECTptr,res); 3080 } 3081 static const char _LSQ_s[]="LSQ"; 3082 static define_unary_function_eval (__LSQ,&_LSQ,_LSQ_s); 3083 define_unary_function_ptr5( at_LSQ ,alias_at_LSQ,&__LSQ,0,T_UNARY_OP_38); 3084 3085 static const char _lsq_s []="lsq"; 3086 static define_unary_function_eval (__lsq,&_LSQ,_lsq_s); 3087 define_unary_function_ptr5( at_lsq ,alias_at_lsq,&__lsq,0,true); 3088 printasNTHROOT(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)3089 static string printasNTHROOT(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 3090 if (feuille.type==_VECT && feuille._VECTptr->size()==2 && abs_calc_mode(contextptr)!=38) 3091 return "surd("+feuille[1].print(contextptr)+","+feuille[0].print(contextptr)+")"; 3092 // return '('+(printsommetasoperator(feuille," NTHROOT ",contextptr))+')'; 3093 return printsommetasoperator(feuille," NTHROOT ",contextptr); 3094 } texprintasNTHROOT(const gen & g,const char * s,GIAC_CONTEXT)3095 static string texprintasNTHROOT(const gen & g,const char * s,GIAC_CONTEXT){ 3096 return texprintsommetasoperator(g,"\\mbox{ NTHROOT }",contextptr); 3097 } _NTHROOT(const gen & args,GIAC_CONTEXT)3098 gen _NTHROOT(const gen & args,GIAC_CONTEXT){ 3099 if ( args.type==_STRNG && args.subtype==-1) return args; 3100 if (args.type!=_VECT || args._VECTptr->size()!=2) 3101 return gensizeerr(contextptr); 3102 return _surd(gen(makevecteur(args._VECTptr->back(),args._VECTptr->front()),_SEQ__VECT),contextptr); 3103 } 3104 static const char _NTHROOT_s[]="NTHROOT"; 3105 static define_unary_function_eval4 (__NTHROOT,&_NTHROOT,_NTHROOT_s,&printasNTHROOT,&texprintasNTHROOT); 3106 define_unary_function_ptr5( at_NTHROOT ,alias_at_NTHROOT,&__NTHROOT,0,T_POW); 3107 3108 #ifndef GIAC_HAS_STO_38 rpn_ans()3109 gen * rpn_ans(){ 3110 return 0; 3111 } 3112 #endif _Ans(const gen & args,GIAC_CONTEXT)3113 gen _Ans(const gen & args,GIAC_CONTEXT){ 3114 if (rpn_ans()) 3115 return *rpn_ans(); 3116 return _ans(0,contextptr); 3117 } 3118 static const char _Ans_s[]="Ans"; printasAns(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)3119 static string printasAns(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){ 3120 return _Ans_s; 3121 } 3122 static define_unary_function_eval2 (__Ans,&_Ans,_Ans_s,&printasAns); 3123 define_unary_function_ptr5( at_Ans ,alias_at_Ans,&__Ans,0,T_LITERAL); 3124 _EXPORT_(const gen & args,GIAC_CONTEXT)3125 gen _EXPORT_(const gen & args,GIAC_CONTEXT){ 3126 // eval sto only 3127 vecteur v =gen2vecteur(args); 3128 int nsto=0,s=int(v.size()); 3129 for (int i=0;i<s;++i){ 3130 if (v[i].is_symb_of_sommet(at_sto)){ 3131 ++nsto; 3132 eval(v[i],1,contextptr); 3133 } 3134 } 3135 return nsto; 3136 } 3137 static const char _EXPORT__s[]="EXPORT"; 3138 static define_unary_function_eval_quoted (__EXPORT_,&_EXPORT_,_EXPORT__s); 3139 define_unary_function_ptr5( at_EXPORT ,alias_at_EXPORT_,&__EXPORT_,_QUOTE_ARGUMENTS,T_RETURN); 3140 _VIEWS(const gen & args,GIAC_CONTEXT)3141 gen _VIEWS(const gen & args,GIAC_CONTEXT){ 3142 return _EXPORT_(args,contextptr); 3143 } 3144 static const char _VIEWS_s[]="VIEWS"; 3145 static define_unary_function_eval_quoted (__VIEWS,&_VIEWS,_VIEWS_s); 3146 define_unary_function_ptr5( at_VIEWS ,alias_at_VIEWS,&__VIEWS,_QUOTE_ARGUMENTS,T_RETURN); 3147 3148 #ifdef USE_GMP_REPLACEMENTS mpz_get_ull(mpz_t n)3149 unsigned long long mpz_get_ull(mpz_t n){ 3150 return 0; // FIXME!!!! 3151 } 3152 #else mpz_get_ull(mpz_t n)3153 unsigned long long mpz_get_ull(mpz_t n){ 3154 unsigned int lo, hi; 3155 mpz_t tmp; 3156 3157 mpz_init( tmp ); 3158 mpz_mod_2exp( tmp, n, 64 ); /* tmp = (lower 64 bits of n) */ 3159 3160 lo = mpz_get_ui( tmp ); /* lo = tmp & 0xffffffff */ 3161 mpz_div_2exp( tmp, tmp, 32 ); /* tmp >>= 32 */ 3162 hi = mpz_get_ui( tmp ); /* hi = tmp & 0xffffffff */ 3163 3164 mpz_clear( tmp ); 3165 3166 return (((unsigned long long)hi) << 32) + lo; 3167 } 3168 #endif 3169 _pointer(const gen & args,GIAC_CONTEXT)3170 gen _pointer(const gen & args,GIAC_CONTEXT){ 3171 if (args.type!=_VECT || args._VECTptr->size()!=2) 3172 return gensizeerr(contextptr); 3173 if (args._VECTptr->back().type!=_INT_) 3174 return gentypeerr(contextptr); 3175 if (args._VECTptr->front().type==_INT_) 3176 return gen((void *)(unsigned long)args._VECTptr->front().val, args._VECTptr->back().val); 3177 #ifndef USE_GMP_REPLACEMENTS 3178 if (args._VECTptr->front().type==_ZINT){ 3179 unsigned long u=mpz_get_ull(*args._ZINTptr); 3180 return gen((void *)u,args._VECTptr->back().val); 3181 } 3182 #endif 3183 return gentypeerr(contextptr); 3184 } 3185 static const char _pointer_s[]="pointer"; 3186 static define_unary_function_eval (__pointer,&_pointer,_pointer_s); 3187 define_unary_function_ptr5( at_pointer ,alias_at_pointer,&__pointer,0,T_UNARY_OP); 3188 is_known_name_home_38(const char * idname)3189 int is_known_name_home_38(const char * idname){ 3190 int s=int(strlen(idname)); 3191 if (s==1 && idname[0]>='A' && idname[0]<='Z') 3192 return 3; 3193 if (s==2 && !strcmp(idname,"θ")) 3194 return 3; 3195 if (s==2 && (idname[0]=='Z' || idname[0]=='L' || idname[0]=='M') && idname[1]>='0' && idname[1]<='9') 3196 return 3; 3197 return is_known_name_38?is_known_name_38(0,idname):0; 3198 } 3199 3200 // 1 and 2 app or program variable, 3 home variable is_known_name_home_38(const char * name_space,const char * idname)3201 int is_known_name_home_38(const char * name_space,const char * idname){ 3202 if (name_space) 3203 return is_known_name_38?is_known_name_38(name_space,idname):0; 3204 return is_known_name_home_38(idname); 3205 } 3206 qualifysubst(const gen & g,const vecteur & vin,const vecteur & vout,GIAC_CONTEXT)3207 static gen qualifysubst(const gen & g,const vecteur & vin,const vecteur & vout,GIAC_CONTEXT){ 3208 if (vin.empty()) return g; 3209 if (g.type!=_VECT){ 3210 if (g.is_symb_of_sommet(at_sto)){ 3211 gen & f = g._SYMBptr->feuille; 3212 if (f.type==_VECT && f._VECTptr->size()==2){ 3213 return symbolic(at_sto,gen(makevecteur(subst(f._VECTptr->front(),vin,vout,true,contextptr),f._VECTptr->back()),_SEQ__VECT)); 3214 } 3215 } 3216 return subst(g,vin,vout,true,contextptr); 3217 } 3218 const_iterateur it=g._VECTptr->begin(),itend=g._VECTptr->end(); 3219 vecteur res; 3220 res.reserve(itend-it); 3221 for (;it!=itend;++it) 3222 res.push_back(qualifysubst(*it,vin,vout,contextptr)); 3223 return gen(res,g.subtype); 3224 } 3225 qualify(gen & g,const vecteur & v,const gen & prog,GIAC_CONTEXT)3226 void qualify(gen & g,const vecteur & v,const gen & prog,GIAC_CONTEXT){ 3227 if (v.empty()) return; 3228 vecteur w(v); 3229 unsigned s=unsigned(v.size()); 3230 for (unsigned i=0;i<s;++i){ 3231 w[i]=symbolic(at_double_deux_points,gen(makevecteur(prog,w[i]),_SEQ__VECT)); 3232 } 3233 g=subst(g,v,w,true,contextptr); 3234 //g=qualifysubst(g,v,w,contextptr); 3235 } 3236 3237 #if 0 3238 // 0: ok, -1: invalid views, -2: invalid VIEWS/EXPORT declaration in a program 3239 static int parse_program_decl(vecteur & assignation_by_equal,vecteur & undeclared_global_vars,vecteur & declared_global_vars,vecteur & declared_functions,vecteur & exported_function_names,vecteur & exported_variable_names,vecteur & unknown_exported,vecteur & unexported,vecteur & unexported_declared_global_vars,vecteur & views,vecteur & errors,const gen & prog,gen & parsed,GIAC_CONTEXT){ 3240 check_local_assign(parsed,vecteur(0),assignation_by_equal,undeclared_global_vars,declared_global_vars,declared_functions,true,contextptr); 3241 vecteur vprog=lop(parsed,at_program); 3242 if (!lop(vprog,at_VIEWS).empty() || !lop(vprog,at_EXPORT).empty()) 3243 return -2; 3244 // views 3245 vecteur vviews=lop(parsed,at_VIEWS); 3246 iterateur vt=vviews.begin(),vtend=vviews.end(); 3247 for (;vt!=vtend;++vt){ 3248 gen & f = vt->_SYMBptr->feuille; 3249 if (f.type==_VECT){ 3250 vecteur v=*f._VECTptr; 3251 if (v.size()==2){ 3252 if (v.front().type==_STRNG) 3253 reverse(v.begin(),v.end()); 3254 if (v.front().is_symb_of_sommet(at_sto)) 3255 v.front()=v.front()._SYMBptr->feuille[1]; 3256 views=mergevecteur(views,v); 3257 } 3258 else return -1; 3259 } 3260 } 3261 // exported/unexported: declaration like export f,"help for f"; 3262 vecteur exported=lop(parsed,at_EXPORT),exported_names; 3263 if (exported.empty()){ 3264 unexported=declared_functions; 3265 } 3266 else { 3267 iterateur it=exported.begin(),itend=exported.end(); 3268 for (;it!=itend;++it){ 3269 gen & f = it->_SYMBptr->feuille; 3270 if (f.type==_VECT){ 3271 vecteur v=*f._VECTptr; 3272 if (!v.empty()){ 3273 if (v.front().type==_STRNG) 3274 reverse(v.begin(),v.end()); 3275 if (v.front().is_symb_of_sommet(at_sto)) 3276 v.front()=v.front()._SYMBptr->feuille[1]; 3277 exported_names=mergevecteur(exported_names,v); 3278 } 3279 } 3280 else { 3281 exported_names.push_back(f.is_symb_of_sommet(at_sto)?f._SYMBptr->feuille[1]:f); 3282 } 3283 } 3284 // check if exported functions are defined or exported variables declared 3285 // check also that we do not redefine regular home variables 3286 itend=exported_names.end(); 3287 // first replace function definition by function name 3288 for (it=exported_names.begin();it!=itend;++it){ 3289 if (it->is_symb_of_sommet(at_sto)){ 3290 *it=it->_SYMBptr->feuille; 3291 if (it->type==_VECT && it->_VECTptr->size()==2) 3292 *it=it->_VECTptr->back(); 3293 } 3294 } 3295 for (it=exported_names.begin();it!=itend;++it){ 3296 if (it->type!=_STRNG){ 3297 if (equalposcomp(declared_functions,*it) && !equalposcomp(declared_global_vars,*it) && !equalposcomp(undeclared_global_vars,*it)) 3298 unknown_exported.push_back(*it); 3299 if (it->type==_IDNT && is_known_name_home_38(it->_IDNTptr->id_name)) 3300 errors.push_back(*it); 3301 } 3302 } 3303 it=declared_functions.begin(),itend=declared_functions.end(); 3304 for (;it!=itend;++it){ 3305 if (!equalposcomp(exported_names,*it)) 3306 unexported.push_back(*it); 3307 } 3308 } 3309 // remove exported functions/views and variables from undeclared global vars 3310 // check other: either home variables or put in errors 3311 vecteur tmp; 3312 tmp=undeclared_global_vars; 3313 undeclared_global_vars.clear(); 3314 const_iterateur jt=tmp.begin(),jtend=tmp.end(); 3315 for (;jt!=jtend;++jt){ 3316 if (jt->type!=_IDNT) 3317 continue; 3318 if (!equalposcomp(declared_functions,*jt) && !equalposcomp(exported_names,*jt)){ 3319 if (is_known_name_home_38(0,jt->_IDNTptr->id_name)) 3320 undeclared_global_vars.push_back(*jt); 3321 else 3322 errors.push_back(*jt); 3323 } 3324 } 3325 // keep only home and app variables in declared global vars 3326 tmp=declared_global_vars; 3327 declared_global_vars.clear(); 3328 jt=tmp.begin(); jtend=tmp.end(); 3329 for (;jt!=jtend;++jt){ 3330 if (jt->type==_IDNT && !equalposcomp(exported_names,*jt)){ 3331 if (is_known_name_home_38(0,jt->_IDNTptr->id_name)) 3332 declared_global_vars.push_back(*jt); 3333 else 3334 unexported_declared_global_vars.push_back(*jt); 3335 } 3336 } 3337 // split exported_names into function/variables 3338 exported_function_names.clear(); 3339 exported_variable_names.clear(); 3340 if (!exported_names.empty()){ 3341 vecteur sto_var=lop(parsed,at_sto); 3342 int s=int(exported_names.size()); 3343 int is_var=-1; 3344 for (int i=0;i<s;++i){ 3345 gen & var=exported_names[i]; 3346 if (var.type==_IDNT){ 3347 const_iterateur it=sto_var.begin(),itend=sto_var.end(); 3348 for (;it!=itend;++it){ 3349 if (it->type!=_SYMB) continue; 3350 gen & f =it->_SYMBptr->feuille; 3351 if (f.type==_VECT && f._VECTptr->size()==2 && f._VECTptr->back()==var){ 3352 if (f._VECTptr->front().is_symb_of_sommet(at_program)) 3353 is_var=0; 3354 else 3355 is_var=1; 3356 break; 3357 } 3358 } 3359 if (it==itend) 3360 is_var=1; 3361 } 3362 if (is_var>=0){ 3363 if (is_var) 3364 exported_variable_names.push_back(var); 3365 else 3366 exported_function_names.push_back(var); 3367 } 3368 } 3369 } 3370 // qualify unexported functions and declared unexported variables 3371 qualify(parsed,unexported,prog,contextptr); 3372 qualify(parsed,unexported_declared_global_vars,prog,contextptr); 3373 qualify(parsed,exported_variable_names,prog,contextptr); 3374 #if !defined RTOS_THREADX && !defined NSPIRE && !defined FXCG && !defined GIAC_HAS_STO_38 3375 ofstream of("c:\\log"); of << "=" << assignation_by_equal << '\n' << "undecl vars:" << undeclared_global_vars << '\n' << "decl vars:" << declared_global_vars << '\n' << "decl func.:" << declared_functions << '\n' << "exported func:" << exported_function_names << '\n' << "exported vars:"<<exported_variable_names << '\n' << "unknown exported:"<<unknown_exported << '\n' << "unexported:" << unexported << '\n' << "unexported declared global vars:"<<unexported_declared_global_vars << '\n' << "views:" << views << '\n' << "errors:" << errors << '\n' << "prog:"<<prog << '\n' << "parsed:" << parsed; of.close(); 3376 #endif 3377 return int(errors.size()); 3378 } 3379 3380 // 0: ok, -1: invalid view, >0: #errors 3381 int parse_program(const wchar_t * source,const wchar_t * progname,vecteur & assignation_by_equal,vecteur & undeclared_global_vars,vecteur & declared_global_vars,vecteur & exported_function_names,vecteur & exported_variable_names,vecteur & unknown_exported,vecteur & unexported,vecteur & unexported_declared_global_vars,vecteur & views,vecteur & errors,gen & parsed,GIAC_CONTEXT){ 3382 unsigned utfs = giacmax(utf8length(source),utf8length(progname)); 3383 char * utf8source = new char[utfs+1]; 3384 unicode2utf8(source,utf8source,wstrlen(source)); 3385 string s(utf8source); 3386 unicode2utf8(progname,utf8source,wstrlen(progname)); 3387 string utf8progname(utf8source); 3388 gen prog=identificateur(utf8progname); 3389 delete [] utf8source; 3390 int c=calc_mode(contextptr); 3391 calc_mode(contextptr)=-38; 3392 parsed=gen(s,contextptr); 3393 calc_mode(contextptr)=c; 3394 vecteur declared_functions; 3395 int err=parse_program_decl(assignation_by_equal,undeclared_global_vars,declared_global_vars,declared_functions,exported_function_names,exported_variable_names,unknown_exported,unexported,unexported_declared_global_vars,views,errors,prog,parsed,contextptr); 3396 return err; 3397 } 3398 3399 gen _testfunc(const gen & g0,GIAC_CONTEXT){ 3400 if (g0.type==_STRNG){ 3401 int c=calc_mode(contextptr); 3402 calc_mode(contextptr)=-38; 3403 gen parsed(*g0._STRNGptr,contextptr); 3404 calc_mode(contextptr)=c; 3405 gen prog("abc",contextptr); 3406 vecteur assignation_by_equal,undeclared_global_vars,declared_global_vars,declared_functions,exported_function_names,exported_variable_names,unknown_exported,unexported,unexported_declared_global_vars,views,errors; 3407 parse_program_decl(assignation_by_equal,undeclared_global_vars,declared_global_vars,declared_functions,exported_function_names,exported_variable_names,unknown_exported,unexported,unexported_declared_global_vars,views,errors,prog,parsed,contextptr); 3408 // eval 3409 gen res=eval(parsed,1,contextptr); 3410 vecteur resv=makevecteur(assignation_by_equal,undeclared_global_vars,declared_global_vars,exported_function_names,exported_variable_names,unknown_exported,unexported,unexported_declared_global_vars,errors); 3411 resv.push_back(res); 3412 return resv; 3413 } 3414 return undef; 3415 } 3416 static const char _testfunc_s[]="testfunc"; 3417 static define_unary_function_eval(__testfunc,&_testfunc,_testfunc_s); 3418 define_unary_function_ptr5( at_testfunc ,alias_at_testfunc,&__testfunc,0,true); 3419 #else 3420 _testfunc(const gen & g0,GIAC_CONTEXT)3421 gen _testfunc(const gen & g0,GIAC_CONTEXT){ 3422 #if 0 3423 string S; 3424 pixon_print(g0,S,contextptr); 3425 return string2gen(S,false); 3426 #else 3427 return g0; 3428 #endif 3429 } 3430 static const char _testfunc_s[]="testfunc"; 3431 static define_unary_function_eval(__testfunc,&_testfunc,_testfunc_s); 3432 define_unary_function_ptr5( at_testfunc ,alias_at_testfunc,&__testfunc,0,true); 3433 #endif // old code not used anymore 3434 3435 #ifdef DOUBLEVAL 3436 const identificateur nsymbolic__IDNT("nsymbolic"); 3437 const gen nsymbolic(nsymbolic__IDNT); 3438 3439 const identificateur u0_nm1__IDNT("u0_nm1"); 3440 const gen u0_nm1(u0_nm1__IDNT); 3441 const identificateur v0_nm2__IDNT("v0_nm2"); 3442 const gen v0_nm2(v0_nm2__IDNT); 3443 const identificateur U0__IDNT("U0"); 3444 const gen U0_idnt(U0__IDNT); 3445 3446 const identificateur u1_nm1__IDNT("u1_nm1"); 3447 const gen u1_nm1(u1_nm1__IDNT); 3448 const identificateur v1_nm2__IDNT("v1_nm2"); 3449 const gen v1_nm2(v1_nm2__IDNT); 3450 const identificateur U1__IDNT("U1"); 3451 const gen U1_idnt(U1__IDNT); 3452 3453 const identificateur u2_nm1__IDNT("u2_nm1"); 3454 const gen u2_nm1(u2_nm1__IDNT); 3455 const identificateur v2_nm2__IDNT("v2_nm2"); 3456 const gen v2_nm2(v2_nm2__IDNT); 3457 const identificateur U2__IDNT("U2"); 3458 const gen U2_idnt(U2__IDNT); 3459 3460 const identificateur u3_nm1__IDNT("u3_nm1"); 3461 const gen u3_nm1(u3_nm1__IDNT); 3462 const identificateur v3_nm2__IDNT("v3_nm2"); 3463 const gen v3_nm2(v3_nm2__IDNT); 3464 const identificateur U3__IDNT("U3"); 3465 const gen U3_idnt(U3__IDNT); 3466 3467 const identificateur u4_nm1__IDNT("u4_nm1"); 3468 const gen u4_nm1(u4_nm1__IDNT); 3469 const identificateur v4_nm2__IDNT("v4_nm2"); 3470 const gen v4_nm2(v4_nm2__IDNT); 3471 const identificateur U4__IDNT("U4"); 3472 const gen U4_idnt(U4__IDNT); 3473 3474 const identificateur u5_nm1__IDNT("u5_nm1"); 3475 const gen u5_nm1(u5_nm1__IDNT); 3476 const identificateur v5_nm2__IDNT("v5_nm2"); 3477 const gen v5_nm2(v5_nm2__IDNT); 3478 const identificateur U5__IDNT("U5"); 3479 const gen U5_idnt(U5__IDNT); 3480 3481 const identificateur u6_nm1__IDNT("u6_nm1"); 3482 const gen u6_nm1(u6_nm1__IDNT); 3483 const identificateur v6_nm2__IDNT("v6_nm2"); 3484 const gen v6_nm2(v6_nm2__IDNT); 3485 const identificateur U6__IDNT("U6"); 3486 const gen U6_idnt(U6__IDNT); 3487 3488 const identificateur u7_nm1__IDNT("u7_nm1"); 3489 const gen u7_nm1(u7_nm1__IDNT); 3490 const identificateur v7_nm2__IDNT("v7_nm2"); 3491 const gen v7_nm2(v7_nm2__IDNT); 3492 const identificateur U7__IDNT("U7"); 3493 const gen U7_idnt(U7__IDNT); 3494 3495 const identificateur u8_nm1__IDNT("u8_nm1"); 3496 const gen u8_nm1(u8_nm1__IDNT); 3497 const identificateur v8_nm2__IDNT("v8_nm2"); 3498 const gen v8_nm2(v8_nm2__IDNT); 3499 const identificateur U8__IDNT("U8"); 3500 const gen U8_idnt(U8__IDNT); 3501 3502 const identificateur u9_nm1__IDNT("u9_nm1"); 3503 const gen u9_nm1(u9_nm1__IDNT); 3504 const identificateur v9_nm2__IDNT("v9_nm2"); 3505 const gen v9_nm2(v9_nm2__IDNT); 3506 const identificateur U9__IDNT("U9"); 3507 const gen U9_idnt(U9__IDNT); 3508 3509 #else // GIAC_HAS_STO_38 3510 const alias_ref_identificateur ref_nsymbolic={-1,0,0,"nsymbolic",0,0}; 3511 const define_alias_gen(alias_nsymbolic,_IDNT,0,&ref_nsymbolic); 3512 const gen & nsymbolic = * (gen *) & alias_nsymbolic; 3513 3514 const alias_ref_identificateur ref_u0_nm1={-1,0,0,"u0_nm1",0,0}; 3515 const define_alias_gen(alias_u0_nm1,_IDNT,0,&ref_u0_nm1); 3516 const gen & u0_nm1 = * (gen *) & alias_u0_nm1; 3517 const alias_ref_identificateur ref_v0_nm2={-1,0,0,"v0_nm2",0,0}; 3518 const define_alias_gen(alias_v0_nm2,_IDNT,0,&ref_v0_nm2); 3519 const gen & v0_nm2 = * (gen *) & alias_v0_nm2; 3520 const alias_ref_identificateur ref_U0_idnt={-1,0,0,"U0",0,0}; 3521 const define_alias_gen(alias_U0_idnt,_IDNT,0,&ref_U0_idnt); 3522 const gen & U0_idnt = * (gen *) & alias_U0_idnt; 3523 3524 const alias_ref_identificateur ref_u1_nm1={-1,0,0,"u1_nm1",0,0}; 3525 const define_alias_gen(alias_u1_nm1,_IDNT,0,&ref_u1_nm1); 3526 const gen & u1_nm1 = * (gen *) & alias_u1_nm1; 3527 const alias_ref_identificateur ref_v1_nm2={-1,0,0,"v1_nm2",0,0}; 3528 const define_alias_gen(alias_v1_nm2,_IDNT,0,&ref_v1_nm2); 3529 const gen & v1_nm2 = * (gen *) & alias_v1_nm2; 3530 const alias_ref_identificateur ref_U1_idnt={-1,0,0,"U1",0,0}; 3531 const define_alias_gen(alias_U1_idnt,_IDNT,0,&ref_U1_idnt); 3532 const gen & U1_idnt = * (gen *) & alias_U1_idnt; 3533 3534 const alias_ref_identificateur ref_u2_nm1={-1,0,0,"u2_nm1",0,0}; 3535 const define_alias_gen(alias_u2_nm1,_IDNT,0,&ref_u2_nm1); 3536 const gen & u2_nm1 = * (gen *) & alias_u2_nm1; 3537 const alias_ref_identificateur ref_v2_nm2={-1,0,0,"v2_nm2",0,0}; 3538 const define_alias_gen(alias_v2_nm2,_IDNT,0,&ref_v2_nm2); 3539 const gen & v2_nm2 = * (gen *) & alias_v2_nm2; 3540 const alias_ref_identificateur ref_U2_idnt={-1,0,0,"U2",0,0}; 3541 const define_alias_gen(alias_U2_idnt,_IDNT,0,&ref_U2_idnt); 3542 const gen & U2_idnt = * (gen *) & alias_U2_idnt; 3543 3544 const alias_ref_identificateur ref_u3_nm1={-1,0,0,"u3_nm1",0,0}; 3545 const define_alias_gen(alias_u3_nm1,_IDNT,0,&ref_u3_nm1); 3546 const gen & u3_nm1 = * (gen *) & alias_u3_nm1; 3547 const alias_ref_identificateur ref_v3_nm2={-1,0,0,"v3_nm2",0,0}; 3548 const define_alias_gen(alias_v3_nm2,_IDNT,0,&ref_v3_nm2); 3549 const gen & v3_nm2 = * (gen *) & alias_v3_nm2; 3550 const alias_ref_identificateur ref_U3_idnt={-1,0,0,"U3",0,0}; 3551 const define_alias_gen(alias_U3_idnt,_IDNT,0,&ref_U3_idnt); 3552 const gen & U3_idnt = * (gen *) & alias_U3_idnt; 3553 3554 const alias_ref_identificateur ref_u4_nm1={-1,0,0,"u4_nm1",0,0}; 3555 const define_alias_gen(alias_u4_nm1,_IDNT,0,&ref_u4_nm1); 3556 const gen & u4_nm1 = * (gen *) & alias_u4_nm1; 3557 const alias_ref_identificateur ref_v4_nm2={-1,0,0,"v4_nm2",0,0}; 3558 const define_alias_gen(alias_v4_nm2,_IDNT,0,&ref_v4_nm2); 3559 const gen & v4_nm2 = * (gen *) & alias_v4_nm2; 3560 const alias_ref_identificateur ref_U4_idnt={-1,0,0,"U4",0,0}; 3561 const define_alias_gen(alias_U4_idnt,_IDNT,0,&ref_U4_idnt); 3562 const gen & U4_idnt = * (gen *) & alias_U4_idnt; 3563 3564 const alias_ref_identificateur ref_u5_nm1={-1,0,0,"u5_nm1",0,0}; 3565 const define_alias_gen(alias_u5_nm1,_IDNT,0,&ref_u5_nm1); 3566 const gen & u5_nm1 = * (gen *) & alias_u5_nm1; 3567 const alias_ref_identificateur ref_v5_nm2={-1,0,0,"v5_nm2",0,0}; 3568 const define_alias_gen(alias_v5_nm2,_IDNT,0,&ref_v5_nm2); 3569 const gen & v5_nm2 = * (gen *) & alias_v5_nm2; 3570 const alias_ref_identificateur ref_U5_idnt={-1,0,0,"U5",0,0}; 3571 const define_alias_gen(alias_U5_idnt,_IDNT,0,&ref_U5_idnt); 3572 const gen & U5_idnt = * (gen *) & alias_U5_idnt; 3573 3574 const alias_ref_identificateur ref_u6_nm1={-1,0,0,"u6_nm1",0,0}; 3575 const define_alias_gen(alias_u6_nm1,_IDNT,0,&ref_u6_nm1); 3576 const gen & u6_nm1 = * (gen *) & alias_u6_nm1; 3577 const alias_ref_identificateur ref_v6_nm2={-1,0,0,"v6_nm2",0,0}; 3578 const define_alias_gen(alias_v6_nm2,_IDNT,0,&ref_v6_nm2); 3579 const gen & v6_nm2 = * (gen *) & alias_v6_nm2; 3580 const alias_ref_identificateur ref_U6_idnt={-1,0,0,"U6",0,0}; 3581 const define_alias_gen(alias_U6_idnt,_IDNT,0,&ref_U6_idnt); 3582 const gen & U6_idnt = * (gen *) & alias_U6_idnt; 3583 3584 const alias_ref_identificateur ref_u7_nm1={-1,0,0,"u7_nm1",0,0}; 3585 const define_alias_gen(alias_u7_nm1,_IDNT,0,&ref_u7_nm1); 3586 const gen & u7_nm1 = * (gen *) & alias_u7_nm1; 3587 const alias_ref_identificateur ref_v7_nm2={-1,0,0,"v7_nm2",0,0}; 3588 const define_alias_gen(alias_v7_nm2,_IDNT,0,&ref_v7_nm2); 3589 const gen & v7_nm2 = * (gen *) & alias_v7_nm2; 3590 const alias_ref_identificateur ref_U7_idnt={-1,0,0,"U7",0,0}; 3591 const define_alias_gen(alias_U7_idnt,_IDNT,0,&ref_U7_idnt); 3592 const gen & U7_idnt = * (gen *) & alias_U7_idnt; 3593 3594 const alias_ref_identificateur ref_u8_nm1={-1,0,0,"u8_nm1",0,0}; 3595 const define_alias_gen(alias_u8_nm1,_IDNT,0,&ref_u8_nm1); 3596 const gen & u8_nm1 = * (gen *) & alias_u8_nm1; 3597 const alias_ref_identificateur ref_v8_nm2={-1,0,0,"v8_nm2",0,0}; 3598 const define_alias_gen(alias_v8_nm2,_IDNT,0,&ref_v8_nm2); 3599 const gen & v8_nm2 = * (gen *) & alias_v8_nm2; 3600 const alias_ref_identificateur ref_U8_idnt={-1,0,0,"U8",0,0}; 3601 const define_alias_gen(alias_U8_idnt,_IDNT,0,&ref_U8_idnt); 3602 const gen & U8_idnt = * (gen *) & alias_U8_idnt; 3603 3604 const alias_ref_identificateur ref_u9_nm1={-1,0,0,"u9_nm1",0,0}; 3605 const define_alias_gen(alias_u9_nm1,_IDNT,0,&ref_u9_nm1); 3606 const gen & u9_nm1 = * (gen *) & alias_u9_nm1; 3607 const alias_ref_identificateur ref_v9_nm2={-1,0,0,"v9_nm2",0,0}; 3608 const define_alias_gen(alias_v9_nm2,_IDNT,0,&ref_v9_nm2); 3609 const gen & v9_nm2 = * (gen *) & alias_v9_nm2; 3610 const alias_ref_identificateur ref_U9_idnt={-1,0,0,"U9",0,0}; 3611 const define_alias_gen(alias_U9_idnt,_IDNT,0,&ref_U9_idnt); 3612 const gen & U9_idnt = * (gen *) & alias_U9_idnt; 3613 3614 #endif 3615 has_Un(const gen & g)3616 int has_Un(const gen & g){ 3617 vecteur l(lvar(g)); 3618 for (unsigned i=0;i<l.size();++i){ 3619 if (l[i].type==_IDNT){ 3620 const char * s=l[i]._IDNTptr->id_name; 3621 if (strlen(s)==2 && s[0]=='U' && s[1]>='0' && s[1]<='9') 3622 return s[1]-'0'; 3623 } 3624 } 3625 return -1; 3626 } 3627 seqapp_lop_of(const gen & g,vecteur & res)3628 static void seqapp_lop_of(const gen & g,vecteur & res){ 3629 vecteur vof(lop(g,at_of)); 3630 const_iterateur it=vof.begin(),itend=vof.end(); 3631 for (;it!=itend;++it){ 3632 gen & f=it->_SYMBptr->feuille; 3633 if (f.type!=_VECT || f._VECTptr->size()!=2 || f._VECTptr->front().type!=_IDNT) 3634 continue; 3635 if (f._VECTptr->back().type==_SYMB) 3636 seqapp_lop_of(f._VECTptr->back(),res); 3637 res.push_back(*it); 3638 } 3639 } 3640 is_n_minus_one_or_two(const gen & arg)3641 int is_n_minus_one_or_two(const gen & arg){ 3642 if (arg.type!=_SYMB) 3643 return 0; 3644 if (arg._SYMBptr->feuille.type==_VECT && arg._SYMBptr->feuille._VECTptr->size()==2){ 3645 gen a1=arg._SYMBptr->feuille._VECTptr->front(); 3646 gen a2=arg._SYMBptr->feuille._VECTptr->back(); 3647 if (a1.type==_IDNT && !strcmp(a1._IDNTptr->id_name,"N")){ 3648 if (arg._SYMBptr->sommet==at_plus){ 3649 if (a2==-1) return 1; 3650 if (a2==-2) return 2; 3651 } 3652 if (arg._SYMBptr->sommet==at_binary_minus){ 3653 if (a2==1) return 1; 3654 if (a2==2) return 2; 3655 } 3656 } 3657 } 3658 return 0; 3659 } 3660 3661 // Prepares app sequence for computing a recurrence relation 3662 // Valid if 1 sequence is checked and does not depend on other sequences 3663 // Given expr_un, the expression of UK(N) in terms of UK(N-1) and UK(N-2) 3664 // write the recurrence relation as UK(N)=subst(expr,vars,[N,UK(N-1),UK(N-2)]) 3665 // Return 0 or -10-val if expr_un is invalid or depends on Uval, 3666 // 1 if it does not depend on UK(N-2) 3667 // 3 if not recurrent 3668 // 2 otherwise seqapp_prepare(const gen & expr_un,gen & expr,vecteur & vars,GIAC_CONTEXT,int seqno)3669 int seqapp_prepare(const gen & expr_un,gen & expr,vecteur & vars,GIAC_CONTEXT,int seqno){ 3670 if (has_Un(expr_un)!=-1) 3671 return 0; 3672 vecteur vof; seqapp_lop_of(expr_un,vof); // (lop(expr_un,at_of)); 3673 // check functions with names in U0-U9 3674 int s=int(vof.size()),retval=1; 3675 gen uk(vx_var); 3676 bool notrecurrent=true; 3677 for (int i=0;i<s;++i){ 3678 gen & f=vof[i]._SYMBptr->feuille; 3679 if (f.type!=_VECT || f._VECTptr->size()!=2 || f._VECTptr->front().type!=_IDNT) 3680 continue; 3681 gen & id=f._VECTptr->front(); 3682 const char * idname=id._IDNTptr->id_name; 3683 if (strlen(idname)!=2 || idname[0]!='U' || idname[1]<'0' || idname[1]>'9') 3684 continue; 3685 notrecurrent=false; 3686 uk=id; 3687 if (seqno==-1){ 3688 seqno=idname[1]-'0'; 3689 } 3690 else { 3691 if (seqno!=idname[1]-'0') 3692 return -10-(idname[1]-'0'); 3693 } 3694 gen & arg=f._VECTptr->back(); 3695 #if 1 3696 int test=is_n_minus_one_or_two(arg); 3697 if (!test) 3698 return 0; 3699 if (test==2) 3700 retval=2; 3701 #else 3702 if (arg!=n__IDNT_e-1 && arg!=n__IDNT_e-2) 3703 return 0; 3704 if (arg==n__IDNT_e-2) 3705 retval=2; 3706 #endif 3707 } 3708 identificateur uk_nm1_("uk_nm1"),uk_nm2_("uk_nm2"); 3709 gen uk_nm1(uk_nm1_),uk_nm2(uk_nm2_); 3710 vecteur vars0(makevecteur(n__IDNT_e,symb_of(uk,n__IDNT_e-1),symb_of(uk,n__IDNT_e-2))); 3711 vars=makevecteur(nsymbolic,uk_nm1,uk_nm2); 3712 expr=subst(expr_un,vars0,vars,true,contextptr); 3713 /* additional checking disabled 3714 vecteur lv(makevecteur(uk_nm1,uk_nm2)); 3715 lidnt(expr,lv); 3716 s=lv.size(); 3717 for (int i=2;i<s;++i){ 3718 gen & g =lv[i]; 3719 if (g.type!=_IDNT) 3720 return 0; 3721 if (strlen(g._IDNTptr->id_name)>1) 3722 return 0; 3723 if (g._IDNTptr->id_name[0]<'A' || g._IDNTptr->id_name[0]>'Z') 3724 return 0; 3725 } 3726 */ 3727 return notrecurrent?3:retval; 3728 } 3729 3730 // Compute UK(N) for K=k to m, where UK(k) and UK(k+1) are given 3731 // If the recurrence relation does not depend on UK(N-2), set UK(k+1) to undef seqapp_compute(const gen & expr0,const vecteur & vars,const gen & UK_k,const gen & UK_kp1,int k,int m,GIAC_CONTEXT)3732 vecteur seqapp_compute(const gen & expr0,const vecteur & vars,const gen & UK_k,const gen &UK_kp1,int k,int m,GIAC_CONTEXT){ 3733 gen f1f9(lidnt_function38(expr0)); 3734 gen f1f9value=eval(f1f9,1,contextptr); 3735 gen expr(expr0); 3736 if (f1f9.type==_VECT && !f1f9._VECTptr->empty()) 3737 expr=subst(expr0,f1f9,f1f9value,true,contextptr); 3738 gen UK_nm2(UK_k),UK_nm1(UK_kp1),tmp; 3739 if (is_undef(UK_k))// also compute UK_n 3740 UK_nm2=subst(expr,vars,makevecteur(k,UK_k,undef),false,contextptr); 3741 if (is_undef(UK_kp1))// compute UK_np1 3742 UK_nm1=subst(expr,vars,makevecteur(k+1,UK_k,undef),false,contextptr); 3743 UK_nm1=evalf(UK_nm1,1,contextptr); 3744 if (UK_nm1.type>_REAL && UK_nm1.type!=_FLOAT_) 3745 UK_nm1=undef; 3746 UK_nm2=evalf(UK_nm2,1,contextptr); 3747 if (UK_nm2.type>_REAL && UK_nm2.type!=_FLOAT_) 3748 UK_nm2=undef; 3749 vecteur res(makevecteur(UK_nm2,UK_nm1)); 3750 for (int n=k+2;n<=m;++n){ 3751 tmp=subst(expr,vars,makevecteur(n,UK_nm1,UK_nm2),false,contextptr); 3752 tmp=evalf(tmp,1,contextptr); 3753 if (tmp.type>_REAL && tmp.type!=_FLOAT_) 3754 res.push_back(undef); 3755 else 3756 res.push_back(tmp); 3757 UK_nm2=UK_nm1; 3758 UK_nm1=tmp; 3759 } 3760 return res; 3761 } 3762 3763 3764 3765 // Prepares app sequence for computing all recurrences relations 3766 // expr_un should contain the expression for U0(N) to UK(N) for K<=9 3767 // undef may be used if the sequence is not checked 3768 // Rewrite the recurrence relation as [U0(N),...,UK(N)]=subst(expr,vars,[N,U0(N-1),U0(N-2),...]) 3769 // Return 0 if expr_un is invalid, -10-val if Uval should be checked 3770 // Return 1 if it does not depend on UK(N-2), 3 if not recurrent, 2 otherwise seqapp_prepare(const vecteur & expr_un,vecteur & expr,vecteur & vars,GIAC_CONTEXT)3771 int seqapp_prepare(const vecteur & expr_un,vecteur & expr,vecteur & vars,GIAC_CONTEXT){ 3772 int dim=int(expr_un.size()); 3773 if (has_Un(expr_un)!=-1) 3774 return 0; 3775 vecteur vof; seqapp_lop_of(expr_un,vof); // (lop(expr_un,at_of)); 3776 vector<int> defined_seqs; 3777 for (unsigned i=0;i<expr_un.size();++i){ 3778 if (!is_undef(expr_un[i])) 3779 defined_seqs.push_back(i); // allowed sequences numbers (starts with U0, not U1) 3780 } 3781 // check functions with names in U0-U9 3782 int s=int(vof.size()),retval=3; 3783 gen uk; 3784 for (int i=0;i<s;++i){ 3785 gen & f=vof[i]._SYMBptr->feuille; 3786 if (f.type!=_VECT || f._VECTptr->size()!=2 || f._VECTptr->front().type!=_IDNT) 3787 continue; 3788 gen & id=f._VECTptr->front(); 3789 const char * idname=id._IDNTptr->id_name; 3790 if (strlen(idname)!=2 || idname[0]!='U' || idname[1]<'0' || idname[1]>'9') 3791 continue; 3792 int val=idname[1]-'0'; 3793 if (!equalposcomp(defined_seqs,val)) 3794 return -val-10; 3795 gen & arg=f._VECTptr->back(); 3796 #if 1 3797 int test=is_n_minus_one_or_two(arg); 3798 if (!test) 3799 return 0; 3800 if (test==2) 3801 retval=2; 3802 else { 3803 if (retval!=2) 3804 retval=1; 3805 } 3806 #else 3807 if (arg!=n__IDNT_e-1 && arg!=n__IDNT_e-2) 3808 return 0; 3809 if (arg==n__IDNT_e-2) 3810 retval=2; 3811 else { 3812 if (retval!=2) 3813 retval=1; 3814 } 3815 #endif 3816 } 3817 vecteur vars0(1,n__IDNT_e); vars=vecteur(1,nsymbolic); 3818 vecteur tab_uk(30); 3819 tab_uk[0]=u0_nm1; // (identificateur("u0_nm1")); 3820 tab_uk[1]=v0_nm2; // (identificateur("v0_nm2")); 3821 tab_uk[2]=U0_idnt; // (identificateur("U0")); 3822 tab_uk[3]=u1_nm1; // (identificateur("u1_nm1")); 3823 tab_uk[4]=v1_nm2; // (identificateur("v1_nm2")); 3824 tab_uk[5]=U1_idnt; // (identificateur("U1")); 3825 tab_uk[6]=u2_nm1; // (identificateur("u2_nm1")); 3826 tab_uk[7]=v2_nm2; // (identificateur("v2_nm2")); 3827 tab_uk[8]=U2_idnt; // (identificateur("U2")); 3828 tab_uk[9]=u3_nm1; // (identificateur("u3_nm1")); 3829 tab_uk[10]=v3_nm2; // (identificateur("v3_nm2")); 3830 tab_uk[11]=U3_idnt; // (identificateur("U3")); 3831 tab_uk[12]=u4_nm1; // (identificateur("u4_nm1")); 3832 tab_uk[13]=v4_nm2; // (identificateur("v4_nm2")); 3833 tab_uk[14]=U4_idnt; // (identificateur("U4")); 3834 tab_uk[15]=u5_nm1; // (identificateur("u5_nm1")); 3835 tab_uk[16]=v5_nm2; // (identificateur("v5_nm2")); 3836 tab_uk[17]=U5_idnt; // (identificateur("U5")); 3837 tab_uk[18]=u6_nm1; // (identificateur("u6_nm1")); 3838 tab_uk[19]=v6_nm2; // (identificateur("v6_nm2")); 3839 tab_uk[20]=U6_idnt; // (identificateur("U6")); 3840 tab_uk[21]=u7_nm1; // (identificateur("u7_nm1")); 3841 tab_uk[22]=v7_nm2; // (identificateur("v7_nm2")); 3842 tab_uk[23]=U7_idnt; // (identificateur("U7")); 3843 tab_uk[24]=u8_nm1; // (identificateur("u8_nm1")); 3844 tab_uk[25]=v8_nm2; // (identificateur("v8_nm2")); 3845 tab_uk[26]=U8_idnt; // (identificateur("U8")); 3846 tab_uk[27]=u9_nm1; // (identificateur("u9_nm1")); 3847 tab_uk[28]=v9_nm2; // (identificateur("v9_nm2")); 3848 tab_uk[29]=U9_idnt; // (identificateur("U9")); 3849 gen n_minus_1=n__IDNT_e-1; 3850 for (int i=0;i<dim;++i){ 3851 gen uk=tab_uk[3*i+2]; 3852 vars0.push_back(new_ref_symbolic(symbolic(at_of,makenewvecteur(uk,n_minus_1)))); 3853 vars.push_back(tab_uk[3*i]); 3854 } 3855 gen n_minus_2=n__IDNT_e-2; 3856 for (int i=0;i<dim;++i){ 3857 gen uk=tab_uk[3*i+2]; 3858 vars0.push_back(new_ref_symbolic(symbolic(at_of,makenewvecteur(uk,n_minus_2)))); 3859 vars.push_back(tab_uk[3*i+1]); 3860 } 3861 expr=subst(expr_un,vars0,vars,true,contextptr); 3862 /* additional checking disabled 3863 vecteur lv(vars); 3864 lidnt(expr,lv); 3865 s=lv.size(); 3866 for (int i=vars.size();i<s;++i){ 3867 gen & g =lv[i]; 3868 if (is_undef(g)) continue; 3869 if (g.type!=_IDNT) 3870 return 0; 3871 if (strlen(g._IDNTptr->id_name)>1) 3872 return 0; 3873 if (g._IDNTptr->id_name[0]<'A' || g._IDNTptr->id_name[0]>'Z') 3874 return 0; 3875 } 3876 */ 3877 return retval; 3878 } 3879 3880 3881 // Compute UK(N) for K=k to m, where UK(k) and UK(k+1) are given 3882 // If the recurrence relation does not depend on UK(N-2), set UK_kp1 to vecteur(0) seqapp_compute(const vecteur & expr0,const vecteur & vars,const vecteur & UK_k,const vecteur & UK_kp1,int k,int m,GIAC_CONTEXT)3883 vecteur seqapp_compute(const vecteur & expr0,const vecteur & vars,const vecteur & UK_k,const vecteur &UK_kp1,int k,int m,GIAC_CONTEXT){ 3884 gen f1f9(lidnt_function38(expr0)); 3885 gen f1f9value=eval(f1f9,1,contextptr); 3886 vecteur expr(expr0); 3887 if (f1f9.type==_VECT && !f1f9._VECTptr->empty()){ 3888 iterateur it=expr.begin(),itend=expr.end(); 3889 for (;it!=itend;++it){ 3890 *it = subst(*it,f1f9,f1f9value,true,contextptr); 3891 } 3892 } 3893 int dim=int(expr.size()); 3894 vecteur UK_nm2(UK_k),UK_nm1(UK_kp1),tmp(dim); 3895 vecteur vals(2*dim+1); 3896 if (UK_k.empty()){// compute UK_n 3897 vals[0]=k; 3898 for (int i=0;i<dim;++i){ 3899 vals[i+1]=undef; 3900 } 3901 for (int i=0;i<dim;++i) 3902 vals[dim+i+1]=undef; 3903 UK_nm2=gen2vecteur(subst(expr,vars,vals,false,contextptr)); 3904 } 3905 if (dim!=int(UK_nm2.size())) 3906 return vecteur(dim,gendimerr(contextptr)); 3907 if (UK_kp1.empty()){// compute UK_np1 3908 vals[0]=k+1; 3909 for (int i=0;i<dim;++i){ 3910 vals[i+1]=UK_nm2[i]; 3911 } 3912 for (int i=0;i<dim;++i) 3913 vals[dim+i+1]=undef; 3914 UK_nm1=subst(expr,vars,vals,false,contextptr); 3915 } 3916 gen tmpU=evalf(UK_nm2,1,contextptr); 3917 if (tmpU.type!=_VECT) 3918 return vecteur(dim,gendimerr(contextptr)); 3919 UK_nm2=*tmpU._VECTptr; 3920 tmpU=evalf(UK_nm1,1,contextptr); 3921 if (tmpU.type!=_VECT) 3922 return vecteur(dim,gendimerr(contextptr)); 3923 UK_nm1=*tmpU._VECTptr; 3924 vecteur res(makevecteur(UK_nm2,UK_nm1)); 3925 res.reserve(m-k+1); 3926 for (int n=k+2;n<=m;++n){ 3927 vals[0]=n; 3928 for (int i=0;i<dim;++i){ 3929 vals[i+1]=UK_nm1[i]; 3930 } 3931 for (int i=0;i<dim;++i){ 3932 vals[dim+i+1]=UK_nm2[i]; 3933 } 3934 vecteur::const_iterator it=expr.begin(),itend=expr.end(); 3935 for (int i=0;it!=itend;++it,++i) 3936 tmp[i]=is_undef(*it)?*it:evalf(sortsubst(*it,vars,vals,false,contextptr),1,contextptr); 3937 res.push_back(tmp); 3938 UK_nm2=UK_nm1; 3939 UK_nm1=tmp; 3940 } 3941 return res; 3942 } 3943 _tests(const gen & g0,GIAC_CONTEXT)3944 gen _tests(const gen & g0,GIAC_CONTEXT){ 3945 // return eval_before_diff(g0,vx_var,contextptr); 3946 if (g0.type==_VECT){ 3947 vecteur expr,vars; 3948 if (g0.subtype==_SEQ__VECT && g0._VECTptr->front().type==_VECT && g0._VECTptr->size()==3){ 3949 int i=seqapp_prepare(*g0._VECTptr->front()._VECTptr,expr,vars,contextptr); 3950 if (i<0) 3951 return gensizeerr(contextptr); 3952 gen g01=(*g0._VECTptr)[1]; 3953 gen g02=(*g0._VECTptr)[2]; 3954 vecteur v2; 3955 if (i==2 && g02.type==_VECT) 3956 v2=*g02._VECTptr; 3957 if (g01.type==_VECT) 3958 return seqapp_compute(expr,vars,*g01._VECTptr,v2,0,20,contextptr); 3959 } 3960 int i=seqapp_prepare(*g0._VECTptr,expr,vars,contextptr); 3961 if (i<0) 3962 return gensizeerr(contextptr); 3963 return seqapp_compute(expr,vars,vecteur(expr.size(),1.0),i==1?vecteur(0):vecteur(expr.size(),2.0),0,20,contextptr); 3964 } 3965 gen expr; vecteur vars; 3966 int i=seqapp_prepare(g0,expr,vars,contextptr); 3967 if (!i) 3968 return undef; 3969 return seqapp_compute(expr,vars,1.0,i==1?undef:2.0,0,20,contextptr); 3970 } 3971 static const char _tests_s[]="tests"; 3972 static define_unary_function_eval(__tests,&_tests,_tests_s); 3973 define_unary_function_ptr5( at_tests ,alias_at_tests,&__tests,0,T_UNARY_OP); 3974 _CHOOSE(const gen & args,GIAC_CONTEXT)3975 gen _CHOOSE(const gen & args,GIAC_CONTEXT){ 3976 if ( args.type==_STRNG && args.subtype==-1) return args; 3977 if (args.type!=_VECT || args._VECTptr->size()<3) 3978 return gentypeerr(contextptr); 3979 vecteur v = *args._VECTptr; 3980 if (v[0].is_symb_of_sommet(at_double_deux_points) && v[0]._SYMBptr->feuille.type==_VECT && v[0]._SYMBptr->feuille._VECTptr->size()==2) 3981 v[0]=v[0]._SYMBptr->feuille._VECTptr->back(); 3982 for (int i=1; i<=1; i++) { if (v[i].type!=_STRNG) v[i]= eval(v[i], 1, contextptr); if (v[i].type!=_STRNG) v[i]= string2gen(v[i].print(contextptr)); } 3983 if (v.front().type!=_IDNT || v[1].type!=_STRNG) 3984 return gentypeerr(contextptr); 3985 #if defined NSPIRE || defined FXCG 3986 return undef; 3987 #else 3988 #ifndef GIAC_HAS_STO_38 3989 vecteur res(3); 3990 res[2]=v[0]; 3991 res[0]=v[1]; 3992 vecteur tmp; 3993 for (unsigned i=2;i<v.size();i++) 3994 tmp.push_back(eval(v[i],1,contextptr)); 3995 res[1]=tmp; 3996 return __inputform.op(symbolic(at_choosebox,gen(res,_SEQ__VECT)),contextptr); 3997 #endif 3998 #endif 3999 return undef; 4000 } 4001 static const char _CHOOSE_s []="CHOOSE"; 4002 static define_unary_function_eval_quoted (__CHOOSE,&_CHOOSE,_CHOOSE_s); 4003 define_unary_function_ptr5( at_CHOOSE ,alias_at_CHOOSE,&__CHOOSE,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 4004 4005 4006 4007 #if 0 // def GIAC_HAS_STO_38 4008 // encoding is up to 8 nibbles with various values... 4009 // 1 optional graphic name 4010 // 2 graphic name 4011 // 3 coordinate pair 4012 // 4 optional coordinate pair 4013 // 5 color 4014 // 6 optional color 4015 // 7 integer 4016 // 8 boolean 4017 // 9 graphic name, return the adresses'adress and does not allow G0!!! 4018 // a: angle 4019 // b: optional integer 4020 // c: w/h based on 0/0 4021 // 0x631 means : optional graphic name, coordinate pair, optional color 4022 4023 #define CyrilleFnc(n) static const char _##n##_s []= #n; static define_unary_function_eval_quoted (__##n,&giac::_##n,_##n##_s); define_unary_function_ptr5( at_##n ,alias_at_##n,&__##n,0,T_UNARY_OP_38); 4024 gen _FREEZE(const gen & args,GIAC_CONTEXT) 4025 { 4026 dofreeze(); 4027 return 1; 4028 } 4029 CyrilleFnc(FREEZE); 4030 4031 gen _GETPIX(const gen & args,GIAC_CONTEXT) 4032 { 4033 void *g=0; int xy[2]; 4034 if (!GraphicVerifInputs(args, &g, xy, 0x31, NULL, contextptr)) return gensizeerr(contextptr); 4035 return gen(dogetpix(g, xy[0], xy[1])); 4036 } 4037 CyrilleFnc(GETPIX); 4038 4039 gen _LINE(const gen & args,GIAC_CONTEXT) 4040 { 4041 void *g=0; int xy[4], c= 0; 4042 if (!GraphicVerifInputs(args, &g, xy, 0x6331, &c, contextptr)) return gensizeerr(contextptr); 4043 doline(g, xy[0], xy[1], xy[2], xy[3], c); 4044 return 1; 4045 } 4046 CyrilleFnc(LINE); 4047 4048 gen _RECT(const gen & args,GIAC_CONTEXT) 4049 { 4050 void *g=0; int xy[4]= {0, 0, 0x0fffffff,0x0fffffff}, c[2]= { 3, -1}; 4051 if (!GraphicVerifInputs(args, &g, xy, 0x66441, c, contextptr)) return gensizeerr(contextptr); 4052 if (c[1]==-1) c[1]= c[0]; 4053 dorect(g, xy[0], xy[1], xy[2]-xy[0]+1, xy[3]-xy[1]+1, c[0], c[1]); 4054 return 1; 4055 } 4056 CyrilleFnc(RECT); 4057 4058 gen _INVERT(const gen & args,GIAC_CONTEXT) 4059 { 4060 void *g=0; int xy[4]= {0, 0, 0x0fffffff, 0x0fffffff }; 4061 if (!GraphicVerifInputs(args, &g, xy, 0x441, NULL, contextptr)) return gensizeerr(contextptr); 4062 doinvert(g, xy[0], xy[1], xy[2]-xy[0]+1, xy[3]-xy[1]+1); 4063 return 1; 4064 } 4065 CyrilleFnc(INVERT); 4066 4067 gen _BLIT(const gen & args,GIAC_CONTEXT) 4068 { 4069 void *g[2]={0,0}; int xy[8]= { 0, 0, 0xfffffff, 0xfffffff, 0, 0, 0xfffffff, 0xfffffff }, c= -1; 4070 if (!GraphicVerifInputs(args, g, xy, 0x6442431, NULL, contextptr)) return gensizeerr(contextptr); 4071 xy[3]+= -xy[1]+1; if (xy[3]<0) xy[3]= -2-xy[3]; 4072 xy[7]+= -xy[5]+1; if (xy[7]<0) xy[7]= -2-xy[7]; 4073 doblit(g[0], xy[0], xy[1], xy[2]-xy[0]+1, xy[3], g[1], xy[4], xy[5], xy[6]-xy[4]+1, xy[7], c); 4074 return 1; 4075 } 4076 CyrilleFnc(BLIT); 4077 gen _TEXTOUT(const gen &args, GIAC_CONTEXT) 4078 { 4079 if (args.type!=_VECT) return gensizeerr(contextptr); 4080 int s= args._VECTptr->size(); 4081 if (s<3) return gensizeerr(contextptr); 4082 gen t= *args._VECTptr->begin(); 4083 gen v(*args._VECTptr); v._VECTptr->erase(v._VECTptr->begin()); 4084 void *g=0; int xy[2]={0, 0}, c[4]= {0, 0, 1023, -1}; 4085 //TEXTOUT("text", [G?], x, y, [font, [color, [width, [color]]]]) 4086 if (!GraphicVerifInputs(v, &g, xy, 0x6b6b31, c, contextptr)) return gensizeerr(contextptr); 4087 return gen(dotextout(&t, g, xy, c, contextptr)); 4088 } 4089 CyrilleFnc(TEXTOUT); 4090 4091 gen _PIXON(const gen & args,GIAC_CONTEXT){ 4092 void *g=0; int xy[2], c= 0; 4093 if (!GraphicVerifInputs(args, &g, xy, 0x631, &c, contextptr)) return gensizeerr(contextptr); 4094 dopixon(g, xy[0], xy[1], c); 4095 return 1; 4096 } 4097 4098 gen _PIXOFF(const gen & args,GIAC_CONTEXT){ 4099 void *g=0; int xy[2]; 4100 if (!GraphicVerifInputs(args, &g, xy, 0x31, NULL, contextptr)) return gensizeerr(contextptr); 4101 dopixon(g, xy[0], xy[1], 3); 4102 return 1; 4103 } 4104 gen _DIMGROB(const gen &args,GIAC_CONTEXT) 4105 { 4106 void *g=0; int xy[2], c= 3; 4107 if (!GraphicVerifInputs(args, &g, xy, 0x6c9, &c, contextptr)) return gensizeerr(contextptr); 4108 dodimgrob((void**)g, xy[0], xy[1], c, gen()); 4109 return 1; 4110 } 4111 CyrilleFnc(DIMGROB); 4112 gen _SUBGROB(const gen &args,GIAC_CONTEXT) 4113 { 4114 void *g[2]={0,0}; int xy[4]= {0, 0, 0xfffffff, 0xfffffff}; 4115 if (!GraphicVerifInputs(args, g, xy, 0x9441, NULL, contextptr)) return gensizeerr(contextptr); 4116 dosubgrob(g, xy); 4117 return 1; 4118 } 4119 CyrilleFnc(SUBGROB); 4120 gen _ARC(const gen & args,GIAC_CONTEXT) 4121 { 4122 ///< draws a circle, or an arc between a1 and a2. full circle is 4096... 4123 // if OldColor is !=-1 and indiate the background color of the screen BEFORE the arc is drawn, the arc is filled... 4124 //int Arc(int x, int y, int r, int color, int a1=0, int a2=4096, int OldColor=-1); 4125 // ARC(x, y, r, [c, [a1, a2]]) 4126 void *g=0; int xy[2], c[4]= { 0, 0, 0, 4096}; 4127 if (!GraphicVerifInputs(args, &g, xy, 0xaab731, c, contextptr)) return gensizeerr(contextptr); 4128 doarc(g, true, xy, c); 4129 return 1; 4130 } 4131 4132 gen _GETPIX_P(const gen & args,GIAC_CONTEXT) 4133 { 4134 void *g=0; int xy[2]; 4135 if (!GraphicVerifInputs2(args, &g, xy, 0x31, NULL, true, contextptr)) return gensizeerr(contextptr); 4136 return gen(dogetpix(g, xy[0], xy[1])); 4137 } 4138 CyrilleFnc(GETPIX_P); 4139 4140 gen _LINE_P(const gen & args,GIAC_CONTEXT) 4141 { 4142 void *g=0; int xy[4], c= 0; 4143 if (!GraphicVerifInputs2(args, &g, xy, 0x6331, &c, true, contextptr)) return gensizeerr(contextptr); 4144 doline(g, xy[0], xy[1], xy[2], xy[3], c); 4145 return 1; 4146 } 4147 CyrilleFnc(LINE_P); 4148 4149 gen _RECT_P(const gen & args,GIAC_CONTEXT) 4150 { 4151 void *g=0; int xy[4]= {0, 0, 0x0fffffff,0x0fffffff}, c[2]= { 3, -1}; 4152 if (!GraphicVerifInputs2(args, &g, xy, 0x66441, c, true, contextptr)) return gensizeerr(contextptr); 4153 if (c[1]==-1) c[1]= c[0]; 4154 if (xy[0]>xy[2]) swap(xy[0], xy[2]); 4155 if (xy[1]>xy[3]) swap(xy[1], xy[3]); 4156 dorect(g, xy[0], xy[1], xy[2]-xy[0]+1, xy[3]-xy[1]+1, c[0], c[1]); 4157 return 1; 4158 } 4159 CyrilleFnc(RECT_P); 4160 4161 gen _INVERT_P(const gen & args,GIAC_CONTEXT) 4162 { 4163 void *g=0; int xy[4]= {0, 0, 0x0fffffff, 0x0fffffff }; 4164 if (!GraphicVerifInputs2(args, &g, xy, 0x441, NULL, true, contextptr)) return gensizeerr(contextptr); 4165 doinvert(g, xy[0], xy[1], xy[2]-xy[0]+1, xy[3]-xy[1]+1); 4166 return 1; 4167 } 4168 CyrilleFnc(INVERT_P); 4169 4170 gen _BLIT_P(const gen & args,GIAC_CONTEXT) 4171 { 4172 void *g[2]={0,0}; int xy[8]= { 0, 0, 0xfffffff, 0xfffffff, 0, 0, 0xfffffff, 0xfffffff }, c= -1; 4173 if (!GraphicVerifInputs2(args, g, xy, 0x6442431, NULL, true, contextptr)) return gensizeerr(contextptr); 4174 xy[3]+= -xy[1]+1; if (xy[3]<0) xy[3]= -2-xy[3]; 4175 xy[7]+= -xy[5]+1; if (xy[7]<0) xy[7]= -2-xy[7]; 4176 doblit(g[0], xy[0], xy[1], xy[2]-xy[0]+1, xy[3], g[1], xy[4], xy[5], xy[6]-xy[4]+1, xy[7], c); 4177 return 1; 4178 } 4179 CyrilleFnc(BLIT_P); 4180 gen _TEXTOUT_P(const gen &args, GIAC_CONTEXT) 4181 { 4182 if (args.type!=_VECT) return gensizeerr(contextptr); 4183 int s= args._VECTptr->size(); 4184 if (s<3) return gensizeerr(contextptr); 4185 gen t= *args._VECTptr->begin(); 4186 gen v(*args._VECTptr); v._VECTptr->erase(v._VECTptr->begin()); 4187 void *g=0; int xy[2]={0, 0}, c[4]= {0, 0, 1023, -1}; 4188 //TEXTOUT("text", [G?], x, y, [font, [color, [width, [color]]]]) 4189 if (!GraphicVerifInputs2(v, &g, xy, 0x6b6b31, c, true, contextptr)) return gensizeerr(contextptr); 4190 return gen(dotextout(&t, g, xy, c, contextptr)); 4191 } 4192 CyrilleFnc(TEXTOUT_P); 4193 gen _PIXON_P(const gen & args,GIAC_CONTEXT) 4194 { 4195 void *g=0; int xy[2], c= 0; 4196 if (!GraphicVerifInputs2(args, &g, xy, 0x631, &c, true, contextptr)) return gensizeerr(contextptr); 4197 dopixon(g, xy[0], xy[1], c); 4198 return 1; 4199 } 4200 CyrilleFnc(PIXON_P); 4201 gen _PIXOFF_P(const gen & args,GIAC_CONTEXT) 4202 { 4203 void *g=0; int xy[2]; 4204 if (!GraphicVerifInputs2(args, &g, xy, 0x31, NULL, true, contextptr)) return gensizeerr(contextptr); 4205 dopixon(g, xy[0], xy[1], 3); 4206 return 1; 4207 } 4208 CyrilleFnc(PIXOFF_P); 4209 gen _DIMGROB_P(const gen &args,GIAC_CONTEXT) 4210 { 4211 void *g=0; int xy[2], c= 3; 4212 if (!GraphicVerifInputs2(args, &g, xy, 0x6c9, &c, false, contextptr)) return gensizeerr(contextptr); 4213 dodimgrob((void**)g, xy[0], xy[1], c, args._VECTptr->end()[-1]); 4214 return 1; 4215 } 4216 CyrilleFnc(DIMGROB_P); 4217 gen _SUBGROB_P(const gen &args,GIAC_CONTEXT) 4218 { 4219 void *g[2]={0,0}; int xy[4]= {0, 0, 0xfffffff, 0xfffffff}; 4220 if (!GraphicVerifInputs2(args, g, xy, 0x9441, NULL, true, contextptr)) return gensizeerr(contextptr); 4221 dosubgrob(g, xy); 4222 return 1; 4223 } 4224 CyrilleFnc(SUBGROB_P); 4225 gen _ARC_P(const gen & args,GIAC_CONTEXT) 4226 { 4227 ///< draws a circle, or an arc between a1 and a2. full circle is 4096... 4228 // if OldColor is !=-1 and indiate the background color of the screen BEFORE the arc is drawn, the arc is filled... 4229 //int Arc(int x, int y, int r, int color, int a1=0, int a2=4096, int OldColor=-1); 4230 // ARC(x, y, r, [c, [a1, a2]]) 4231 void *g=0; int xy[2], c[4]= { 0, 0, 0, 4096}; 4232 if (!GraphicVerifInputs2(args, &g, xy, 0xaab731, c, true, contextptr)) return gensizeerr(contextptr); 4233 doarc(g, false, xy, c); 4234 return 1; 4235 } 4236 CyrilleFnc(ARC_P); 4237 gen _GROBW_P(const gen & args, GIAC_CONTEXT) 4238 { 4239 void *g=0; if (!GraphicVerifInputs(args, &g, NULL, 1, NULL, contextptr)) return gensizeerr(contextptr); 4240 return gen(dogrobw(g)); 4241 } 4242 CyrilleFnc(GROBW_P); 4243 gen _GROBH_P(const gen & args, GIAC_CONTEXT) 4244 { 4245 void *g=0; if (!GraphicVerifInputs(args, &g, NULL, 1, NULL, contextptr)) return gensizeerr(contextptr); 4246 return gen(dogrobh(g, false)); 4247 } 4248 CyrilleFnc(GROBH_P); 4249 gen _GROBW(const gen & args, GIAC_CONTEXT) 4250 { 4251 void *g=0; if (!GraphicVerifInputs(args, &g, NULL, 1, NULL, contextptr)) return gensizeerr(contextptr); 4252 int w= dogrobw(g); 4253 return w*getxrangeperpixel(); 4254 } 4255 CyrilleFnc(GROBW); 4256 gen _GROBH(const gen & args, GIAC_CONTEXT) 4257 { 4258 void *g=0; if (!GraphicVerifInputs(args, &g, NULL, 1, NULL, contextptr)) return gensizeerr(contextptr); 4259 int h= dogrobh(g, true); 4260 return h*getyrangeperpixel(); 4261 } 4262 CyrilleFnc(GROBH); 4263 4264 CyrilleFnc(ISKEYDOWN); 4265 4266 #else _ARC(const gen & args,GIAC_CONTEXT)4267 gen _ARC(const gen & args,GIAC_CONTEXT){ 4268 if (args.type!=_VECT || args._VECTptr->size()!=5) 4269 return gensizeerr(contextptr); 4270 vecteur & v =*args._VECTptr; 4271 return _cercle(gen(makevecteur(v[0]+cst_i*v[1],v[2],v[3],v[4]),_SEQ__VECT),contextptr); 4272 } _PIXON(const gen & args,GIAC_CONTEXT)4273 gen _PIXON(const gen & args,GIAC_CONTEXT){ 4274 if (args.type!=_VECT || args._VECTptr->size()!=2) 4275 return gensizeerr(contextptr); 4276 vecteur & v =*args._VECTptr; 4277 return symb_pnt(v.front()+cst_i*v.back(),int(FL_BLACK),contextptr); 4278 } _PIXOFF(const gen & args,GIAC_CONTEXT)4279 gen _PIXOFF(const gen & args,GIAC_CONTEXT){ 4280 if (args.type!=_VECT || args._VECTptr->size()!=2) 4281 return gensizeerr(contextptr); 4282 vecteur & v =*args._VECTptr; 4283 return symb_pnt(v.front()+cst_i*v.back(),int(FL_WHITE),contextptr); 4284 } _LINE(const gen & args,GIAC_CONTEXT)4285 gen _LINE(const gen & args,GIAC_CONTEXT){ 4286 if (args.type!=_VECT || args._VECTptr->size()!=4) 4287 return _droite(args,contextptr); 4288 vecteur & v =*args._VECTptr; 4289 return _droite(gen(makevecteur(v[0]+cst_i*v[1],v[2]+cst_i*v[3]),_SEQ__VECT),contextptr); 4290 } 4291 static const char _LINE_s []="LINE"; 4292 static define_unary_function_eval (__LINE,&_LINE,_LINE_s); 4293 define_unary_function_ptr5( at_LINE ,alias_at_LINE,&__LINE,0,T_UNARY_OP_38); 4294 _RECT(const gen & args,GIAC_CONTEXT)4295 gen _RECT(const gen & args,GIAC_CONTEXT){ 4296 if (args.type!=_VECT || args._VECTptr->size()!=4) 4297 return _droite(args,contextptr); 4298 vecteur & v =*args._VECTptr; 4299 gen a=v[0],b=v[1],c=v[2],d=v[3]; 4300 if (is_greater(a,c,contextptr)) 4301 swapgen(a,c); 4302 if (is_greater(b,d,contextptr)) 4303 swapgen(b,d); 4304 gen e=a+b*cst_i,f=c+b*cst_i,g=a+d*cst_i,h=c+d*cst_i; 4305 gen res=pnt_attrib(gen(makevecteur(e,f,h,g,e),_GROUP__VECT),vecteur(1,int(FL_BLACK)),contextptr); 4306 return res; 4307 } 4308 static const char _RECT_s []="RECT"; 4309 static define_unary_function_eval (__RECT,&_RECT,_RECT_s); 4310 define_unary_function_ptr5( at_RECT ,alias_at_RECT,&__RECT,0,T_UNARY_OP_38); 4311 4312 #endif 4313 static const char _PIXON_s []="PIXON"; 4314 static define_unary_function_eval (__PIXON,&_PIXON,_PIXON_s); 4315 define_unary_function_ptr5( at_PIXON ,alias_at_PIXON,&__PIXON,0,T_UNARY_OP_38); 4316 static const char _PIXOFF_s []="PIXOFF"; 4317 static define_unary_function_eval (__PIXOFF,&_PIXOFF,_PIXOFF_s); 4318 define_unary_function_ptr5( at_PIXOFF ,alias_at_PIXOFF,&__PIXOFF,0,T_UNARY_OP_38); 4319 static const char _ARC_s []="ARC"; 4320 static define_unary_function_eval (__ARC,&_ARC,_ARC_s); 4321 define_unary_function_ptr5( at_ARC ,alias_at_ARC,&__ARC,0,T_UNARY_OP_38); 4322 4323 static const char _PRINT_s []="PRINT"; 4324 static define_unary_function_eval_quoted (__PRINT,&_print,_PRINT_s); 4325 define_unary_function_ptr5( at_PRINT ,alias_at_PRINT,&__PRINT,0,T_UNARY_OP_38); 4326 4327 static const char _SEC_s []="SEC"; 4328 static define_unary_function_eval (__SEC,&_sec,_SEC_s); 4329 define_unary_function_ptr5( at_SEC ,alias_at_SEC,&__SEC,0,T_UNARY_OP_38); 4330 4331 static const char _CSC_s []="CSC"; 4332 static define_unary_function_eval (__CSC,&_csc,_CSC_s); 4333 define_unary_function_ptr5( at_CSC ,alias_at_CSC,&__CSC,0,T_UNARY_OP_38); 4334 4335 static const char _COT_s []="COT"; 4336 static define_unary_function_eval (__COT,&_cot,_COT_s); 4337 define_unary_function_ptr5( at_COT ,alias_at_COT,&__COT,0,T_UNARY_OP_38); 4338 4339 static const char _ASEC_s []="ASEC"; 4340 static define_unary_function_eval (__ASEC,&_asec,_ASEC_s); 4341 define_unary_function_ptr5( at_ASEC ,alias_at_ASEC,&__ASEC,0,T_UNARY_OP_38); 4342 4343 static const char _ACSC_s []="ACSC"; 4344 static define_unary_function_eval (__ACSC,&_acsc,_ACSC_s); 4345 define_unary_function_ptr5( at_ACSC ,alias_at_ACSC,&__ACSC,0,T_UNARY_OP_38); 4346 4347 static const char _ACOT_s []="ACOT"; 4348 static define_unary_function_eval (__ACOT,&_acot,_ACOT_s); 4349 define_unary_function_ptr5( at_ACOT ,alias_at_ACOT,&__ACOT,0,T_UNARY_OP_38); 4350 _Celsius2Fahrenheit(const gen & g,GIAC_CONTEXT)4351 gen _Celsius2Fahrenheit(const gen & g,GIAC_CONTEXT){ 4352 if (g.type==_VECT) 4353 return apply(g,_Celsius2Fahrenheit,contextptr); 4354 return (g*gen(9))/5+32; 4355 } 4356 #ifdef POCKETCAS 4357 static const char _Celsius2Fahrenheit_s []="CelsiusToFahrenheit"; 4358 #else 4359 static const char _Celsius2Fahrenheit_s []="Celsius2Fahrenheit"; 4360 #endif 4361 static define_unary_function_eval (__Celsius2Fahrenheit,&_Celsius2Fahrenheit,_Celsius2Fahrenheit_s); 4362 define_unary_function_ptr5( at_Celsius2Fahrenheit ,alias_at_Celsius2Fahrenheit,&__Celsius2Fahrenheit,0,T_UNARY_OP); 4363 _Fahrenheit2Celsius(const gen & g,GIAC_CONTEXT)4364 gen _Fahrenheit2Celsius(const gen & g,GIAC_CONTEXT){ 4365 if (g.type==_VECT) 4366 return apply(g,_Fahrenheit2Celsius,contextptr); 4367 return (g-32)*gen(5)/9; 4368 } 4369 #ifdef POCKETCAS 4370 static const char _Fahrenheit2Celsius_s []="FahrenheitToCelsius"; 4371 #else 4372 static const char _Fahrenheit2Celsius_s []="Fahrenheit2Celsius"; 4373 #endif 4374 static define_unary_function_eval (__Fahrenheit2Celsius,&_Fahrenheit2Celsius,_Fahrenheit2Celsius_s); 4375 define_unary_function_ptr5( at_Fahrenheit2Celsius ,alias_at_Fahrenheit2Celsius,&__Fahrenheit2Celsius,0,T_UNARY_OP); 4376 4377 // put here function names that are in lowercase in giac and should be printed uppercase 4378 // on HP 4379 static const char * const display_in_maj[] ={ 4380 "ABS", 4381 "ACOS", 4382 "ACOSH", 4383 "ACOT", 4384 "ACSC", 4385 // "ADDCOL", 4386 // "ADDROW", 4387 // "ALOG", 4388 "AND", 4389 // "ARC", 4390 "ARG", 4391 "ASEC", 4392 "ASIN", 4393 "ASINH", 4394 "ATAN", 4395 "ATANH", 4396 "BINOMIAL", 4397 "BINOMIAL_CDF", 4398 "BINOMIAL_ICDF", 4399 "BITAND", 4400 // "BITNOT", 4401 "BITOR", 4402 "BITXOR", 4403 //"BREAK", 4404 "CEILING", 4405 "CFACTOR", 4406 "CHAR", 4407 "CHISQUARE", 4408 "CHISQUARE_CDF", 4409 "CHISQUARE_ICDF", 4410 //"CHOOSE", 4411 "COLNORM", 4412 "COMB", 4413 "CONCAT", 4414 // "COND", 4415 "CONJ", 4416 "COS", 4417 "COSH", 4418 "COT", 4419 "CROSS", 4420 "CSC", 4421 "CSOLVE", 4422 // "DEGXRAD", 4423 // "DELCOL", 4424 // "DELROW", 4425 "DET", 4426 "DIM", 4427 //"DISP", 4428 "DOT", 4429 // "EIGENVAL", 4430 // "EIGENVV", 4431 "EXP", 4432 // "EXPM1", 4433 // "EXPORT", 4434 "EXPR", 4435 "FLOOR", 4436 "FISHER", 4437 "FISHER_CDF", 4438 "FISHER_ICDF", 4439 "FLOOR", 4440 //"FNROOT", 4441 "FP", 4442 // "FREEZE", 4443 // "GETKEY", 4444 // "GF", 4445 //"HMSX", 4446 //"IDENMAT", 4447 "IM", 4448 // "INPUT", 4449 "IP", 4450 "INVERSE", 4451 // "ISOLATE", 4452 "ISPRIME", 4453 // "ITERATE", 4454 "LINE", 4455 // "LINEAR?", 4456 "LN", 4457 // "LNP1", 4458 "LOG", 4459 // "LQ", 4460 // "LSQ", 4461 "LU", 4462 //"MAKELIST", 4463 "MAKEMAT", 4464 // "MANT", 4465 "MAX", 4466 // "MAXREAL", 4467 "MID", 4468 "MIN", 4469 // "MINREAL", 4470 "MKSA", 4471 // "MOD", // removed as cas has MOD and mod (operator and function) 4472 // "MSGBOX", 4473 "NEG", 4474 "NORMALD", 4475 "NORMALD_CDF", 4476 "NORMALD_ICDF", 4477 "NOT", 4478 // "NTHROOT", 4479 "OR", 4480 "PERM", 4481 "PI", 4482 "PIECEWISE", 4483 // "PIXOFF", 4484 // "PIXON", 4485 "POISSON", 4486 "POISSON_CDF", 4487 "POISSON_ICDF", 4488 // "POLYCOEF", 4489 // "POLYEVAL", 4490 // "POLYFORM", 4491 // "POLYROOT", 4492 // "POS", 4493 "PRINT", 4494 "QR", 4495 // "QUAD", 4496 "QUOTE", 4497 // "RADXDEG", 4498 //"RANDMAT", 4499 "RANDNORM", 4500 // "RANDOM", 4501 "RANDSEED", 4502 "RANK", 4503 "RE", 4504 // "RECURSE", 4505 // "REDIM", 4506 // "REPLACE", 4507 "RETURN", 4508 //"REVERSE", 4509 "RIGHT", 4510 "ROTATE", 4511 "ROUND", 4512 "ROWNORM", 4513 "RREF", 4514 // "SCALE", 4515 // "SCALEADD", 4516 // "SCHUR", 4517 "SEC", 4518 "SIGN", 4519 "SIN", 4520 "SINH", 4521 "SIZE", 4522 "SORT", 4523 // "SPECNORM", 4524 // "SPECRAD", 4525 "STRING", 4526 "STUDENT", 4527 "STUDENT_CDF", 4528 "STUDENT_ICDF", 4529 //"SUB", 4530 // "SVD", 4531 // "SVL", 4532 // "SWAPCOL", 4533 // "SWAPROW", 4534 "TAN", 4535 "TANH", 4536 "TAYLOR", 4537 "TCOLLECT", 4538 "TEXPAND", 4539 //"TRACE", 4540 "TRN", 4541 //"TRUNCATE", 4542 //"UTPC", 4543 //"UTPF", 4544 //"UTPN", 4545 //"UTPT", 4546 // "VIEWS", 4547 //"WAIT", 4548 // "XHMS", 4549 "XOR", 4550 // "XPON", 4551 }; 4552 4553 static const int display_in_maj_size=sizeof(display_in_maj)/sizeof(const char *); 4554 4555 // check if a lowercase commandname should be uppercased 4556 static char maj_converted[16]; 4557 hp38_display_in_maj(const char * s)4558 char * hp38_display_in_maj(const char * s){ 4559 int l=int(strlen(s)); 4560 if (l>15) 4561 return 0; 4562 maj_converted[l]=0; 4563 for (int i=0;i<l;++i){ 4564 maj_converted[i]=toupper(s[i]); 4565 } 4566 int beg=0,end=display_in_maj_size,cur,test; 4567 // string index is always >= begin and < end 4568 for (;;){ 4569 cur=(beg+end)/2; 4570 test=strcmp(maj_converted,display_in_maj[cur]); 4571 if (!test) 4572 return maj_converted; 4573 if (cur==beg){ 4574 return 0; 4575 } 4576 if (test>0) 4577 beg=cur; 4578 else 4579 end=cur; 4580 } 4581 return 0; 4582 } 4583 _polar_complex(const gen & g,GIAC_CONTEXT)4584 gen _polar_complex(const gen & g,GIAC_CONTEXT){ 4585 if (g.type==_STRNG && g.subtype==-1) return g; 4586 if (g.type!=_VECT) 4587 return makevecteur(abs(g,contextptr),arg(g,contextptr)); 4588 if (g._VECTptr->size()!=2) 4589 return gensizeerr(contextptr); 4590 gen res= g._VECTptr->front(); 4591 gen angle=g._VECTptr->back(); 4592 if (angle.is_symb_of_sommet(at_unit)){ 4593 gen f=angle._SYMBptr->feuille; 4594 gen f0=f[0],f1=f[1]; 4595 if (f1==(gen("_deg",contextptr)._SYMBptr->feuille)[1]) 4596 return res*exp(cst_i*f0*cst_pi/gen(180),contextptr); 4597 if (f1==(gen("_grad",contextptr)._SYMBptr->feuille)[1]) 4598 return res*exp(cst_i*f0*cst_pi/gen(200),contextptr); 4599 if (f1==(gen("_rad",contextptr)._SYMBptr->feuille)[1]) 4600 return res*exp(cst_i*f0,contextptr); 4601 } 4602 #ifdef GIAC_HAS_STO_38 4603 angle=evalf(angle,1,contextptr); 4604 res= evalf(res,1,contextptr); 4605 if (angle.type==_FLOAT_ && res.type==_FLOAT_) 4606 { 4607 HP_Real a, r, s, c; 4608 fExpand(gen2HP(angle), &a); fExpand(gen2HP(res), &r); 4609 fisin(&a, &s, angle_radian(contextptr)?AMRad:(angle_degree(contextptr)?AMDeg:AMGrad)); ficos(&a, &c, angle_radian(contextptr)?AMRad:(angle_degree(contextptr)?AMDeg:AMGrad)); //grad 4610 fimul_L(&s, &r, &s); fimul_L(&c, &r, &c); 4611 HP_gen C= fUnExpand(&c), S= fUnExpand(&s); 4612 gen gC, gS; gC= HP2gen(C); gS= HP2gen(S); 4613 res= gC+gS*cst_i; 4614 } else { 4615 if(!angle_radian(contextptr)) 4616 { 4617 //grad 4618 if(angle_degree(contextptr)) 4619 angle = angle * m_pi(contextptr) / 180; 4620 else 4621 angle = angle * m_pi(contextptr) / 200; 4622 } 4623 res=res*exp(cst_i*angle,contextptr); 4624 } 4625 #else 4626 res=res*(cos(angle,contextptr)+cst_i*sin(angle,contextptr)); 4627 #endif 4628 if (res.type==_CPLX){ 4629 int * ptr = complex_display_ptr(res); 4630 if (ptr) 4631 *ptr=1; 4632 return res; 4633 } 4634 else 4635 return calc_mode(contextptr)==1?symbolic(at_ggb_ang,g):symbolic(at_polar_complex,g); 4636 } 4637 #ifdef BCD 4638 static const char _polar_complex_s[]="\xe2\x88\xa1"; 4639 #else 4640 static const char _polar_complex_s[]="∡"; // " polar_complex "; 4641 #endif 4642 static define_unary_function_eval4 (__polar_complex,&_polar_complex,_polar_complex_s,&printsommetasoperator,&texprintsommetasoperator); 4643 define_unary_function_ptr5( at_polar_complex ,alias_at_polar_complex,&__polar_complex,0,T_MOD); 4644 4645 static const char _ggb_ang_s []="ggb_ang"; // prefixed version of polar complex 4646 static define_unary_function_eval (__ggb_ang,&_polar_complex,_ggb_ang_s); 4647 define_unary_function_ptr5( at_ggb_ang ,alias_at_ggb_ang,&__ggb_ang,0,true); 4648 4649 #ifdef GIAC_HAS_STO_38 4650 gen aspen_HDigits(int i); 4651 gen aspen_HFormat(int i); 4652 gen aspen_HAngle(int i); 4653 gen aspen_HComplex(int i); 4654 gen aspen_HLanguage(int i); 4655 #endif 4656 _HDigits(const gen & g0,GIAC_CONTEXT)4657 gen _HDigits(const gen & g0,GIAC_CONTEXT){ 4658 gen g=g0; 4659 if (g.type==_VECT && g._VECTptr->empty()){ 4660 g=-1; 4661 } 4662 else { 4663 if (g.type==_FLOAT_) 4664 g=get_int(g0._FLOAT_val); 4665 if (g.type==_DOUBLE_) 4666 g=_floor(g,contextptr); 4667 if (g.type!=_INT_) 4668 return gentypeerr(contextptr); 4669 if (g.val<0 || g.val>12) 4670 return gensizeerr(contextptr); 4671 } 4672 #ifdef GIAC_HAS_STO_38 4673 return aspen_HDigits(g.val); 4674 #else 4675 return _Digits(g,contextptr); 4676 #endif 4677 } 4678 static const char _HDigits_s []="HDigits"; 4679 static define_unary_function_eval2 (__HDigits,&_HDigits,_HDigits_s,&printasDigits); 4680 define_unary_function_ptr( at_HDigits ,alias_at_HDigits ,&__HDigits); 4681 _HFormat(const gen & g0,GIAC_CONTEXT)4682 gen _HFormat(const gen & g0,GIAC_CONTEXT){ 4683 gen g=g0; 4684 if (g.type==_VECT && g._VECTptr->empty()){ 4685 g=-1; 4686 } 4687 else { 4688 if (g.type==_FLOAT_) 4689 g=get_int(g0._FLOAT_val); 4690 if (g.type==_DOUBLE_) 4691 g=_floor(g,contextptr); 4692 if (g.type!=_INT_) 4693 return gentypeerr(contextptr); 4694 if (g.val<0 || g.val>4) 4695 return gensizeerr(contextptr); 4696 } 4697 #ifdef GIAC_HAS_STO_38 4698 return aspen_HFormat(g.val); 4699 #else 4700 return _scientific_format(g,contextptr); 4701 #endif 4702 } 4703 static const char _HFormat_s []="HFormat"; 4704 static define_unary_function_eval2 (__HFormat,&_HFormat,_HFormat_s,&printasDigits); 4705 define_unary_function_ptr( at_HFormat ,alias_at_HFormat ,&__HFormat); 4706 _HAngle(const gen & g0,GIAC_CONTEXT)4707 gen _HAngle(const gen & g0,GIAC_CONTEXT){ 4708 gen g=g0; 4709 if (g.type==_VECT && g._VECTptr->empty()){ 4710 g=-1; 4711 } 4712 else { 4713 if (g.type==_FLOAT_) 4714 g=get_int(g0._FLOAT_val); 4715 if (g.type==_DOUBLE_) 4716 g=_floor(g,contextptr); 4717 if (g.type!=_INT_) 4718 return gentypeerr(contextptr); 4719 if (g.val<1 || g.val>2) 4720 return gensizeerr(contextptr); 4721 } 4722 #ifdef GIAC_HAS_STO_38 4723 return aspen_HAngle(g.val); 4724 #else 4725 return _angle_radian(g-1,contextptr); 4726 #endif 4727 } 4728 static const char _HAngle_s []="HAngle"; 4729 static define_unary_function_eval2 (__HAngle,&_HAngle,_HAngle_s,&printasDigits); 4730 define_unary_function_ptr( at_HAngle ,alias_at_HAngle ,&__HAngle); 4731 _HComplex(const gen & g0,GIAC_CONTEXT)4732 gen _HComplex(const gen & g0,GIAC_CONTEXT){ 4733 gen g=g0; 4734 if (g.type==_VECT && g._VECTptr->empty()){ 4735 g=-1; 4736 } 4737 else { 4738 if (g.type==_FLOAT_) 4739 g=get_int(g0._FLOAT_val); 4740 if (g.type==_DOUBLE_) 4741 g=_floor(g,contextptr); 4742 if (g.type!=_INT_) 4743 return gentypeerr(contextptr); 4744 if (g.val<0 || g.val>1) 4745 return gensizeerr(contextptr); 4746 } 4747 #ifdef GIAC_HAS_STO_38 4748 return aspen_HComplex(g.val); 4749 #else 4750 return _complex_mode(g,contextptr); 4751 #endif 4752 } 4753 static const char _HComplex_s []="HComplex"; 4754 static define_unary_function_eval2 (__HComplex,&_HComplex,_HComplex_s,&printasDigits); 4755 define_unary_function_ptr( at_HComplex ,alias_at_HComplex ,&__HComplex); 4756 _HLanguage(const gen & g0,GIAC_CONTEXT)4757 gen _HLanguage(const gen & g0,GIAC_CONTEXT){ 4758 gen g=g0; 4759 if (g.type==_VECT && g._VECTptr->empty()){ 4760 g=-1; 4761 } 4762 else { 4763 if (g.type==_FLOAT_) 4764 g=get_int(g0._FLOAT_val); 4765 if (g.type==_DOUBLE_) 4766 g=_floor(g,contextptr); 4767 if (g.type!=_INT_) 4768 return gentypeerr(contextptr); 4769 if (g.val<0 || g.val>2) 4770 return gensizeerr(contextptr); 4771 } 4772 #ifdef GIAC_HAS_STO_38 4773 return aspen_HLanguage(g.val); 4774 #else 4775 if (g==-1) 4776 return language(contextptr); 4777 language(g.val,contextptr); 4778 return g.val; 4779 #endif 4780 } 4781 static const char _HLanguage_s []="HLanguage"; 4782 static define_unary_function_eval2 (__HLanguage,&_HLanguage,_HLanguage_s,&printasDigits); 4783 define_unary_function_ptr( at_HLanguage ,alias_at_HLanguage ,&__HLanguage); 4784 _EDITMAT(const gen & args,GIAC_CONTEXT)4785 gen _EDITMAT(const gen & args,GIAC_CONTEXT){ 4786 if (args.type==_STRNG && args.subtype==-1) return args; 4787 #ifdef GIAC_HAS_STO_38 4788 if (args.type!=_IDNT) 4789 return gensizeerr(contextptr); 4790 const char * id = args._IDNTptr->id_name; 4791 if (id[0]!='M' || id[1]<'0' || id[1]>'9') 4792 return gensizeerr(contextptr); 4793 int i=id[1]-'0'; 4794 // EditMat(i?i-1:9); 4795 #endif 4796 return eval(args,1,contextptr); 4797 } 4798 static const char _EDITMAT_s []="EDITMAT"; 4799 static define_unary_function_eval_quoted (__EDITMAT,&_EDITMAT,_EDITMAT_s); 4800 define_unary_function_ptr5( at_EDITMAT ,alias_at_EDITMAT,&__EDITMAT,_QUOTE_ARGUMENTS,T_UNARY_OP_38); 4801 4802 #ifndef NO_NAMESPACE_GIAC 4803 } // namespace giac 4804 #endif // ndef NO_NAMESPACE_GIAC 4805 4806