1 /* -*- mode:C++ ; compile-command: "g++ -I.. -I../include -DHAVE_CONFIG_H -DIN_GIAC -DGIAC_GENERIC_CONSTANTS -fno-strict-aliasing -g -c misc.cc -Wall" -*- */
2 #include "giacPCH.h"
3 /*
4 * Copyright (C) 2001, 2007 R. De Graeve, 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 <fstream>
22 #include <string>
23 #include "misc.h"
24 #include "usual.h"
25 #include "sym2poly.h"
26 #include "rpn.h"
27 #include "prog.h"
28 #include "derive.h"
29 #include "subst.h"
30 #include "intg.h"
31 #include "vecteur.h"
32 #include "ifactor.h"
33 #include "solve.h"
34 #include "modpoly.h"
35 #include "permu.h"
36 #include "sym2poly.h"
37 #include "plot.h"
38 #include "lin.h"
39 #include "modpoly.h"
40 #include "desolve.h"
41 #include "alg_ext.h"
42 #include "input_parser.h"
43 #include "input_lexer.h"
44 #include "maple.h"
45 #include "quater.h"
46 #include "sparse.h"
47 #include "giacintl.h"
48 #if defined GIAC_HAS_STO_38 || defined NSPIRE || defined NSPIRE_NEWLIB || defined FXCG || defined GIAC_GGB || defined USE_GMP_REPLACEMENTS || defined KHICAS
is_graphe(const giac::gen & g,std::string & disp_out,const giac::context *)49 inline bool is_graphe(const giac::gen &g,std::string &disp_out,const giac::context *){ return false; }
_graph_charpoly(const giac::gen & g,const giac::context *)50 inline giac::gen _graph_charpoly(const giac::gen &g,const giac::context *){ return g;}
51 #else
52 #include "graphtheory.h"
53 #endif
54
55 #define GIAC_LMCHANGES 1 // changes by L. Marohnić // regression checks
56
57 #ifdef KHICAS
58 #include "kdisplay.h"
59 const char * mp_hal_input(const char * prompt) ;
60 #endif
61
62 #ifndef NO_NAMESPACE_GIAC
63 namespace giac {
64 #endif // ndef NO_NAMESPACE_GIAC
65
_scalar_product(const gen & args,GIAC_CONTEXT)66 gen _scalar_product(const gen & args,GIAC_CONTEXT){
67 if ( args.type==_STRNG && args.subtype==-1) return args;
68 if (args.type!=_VECT || args._VECTptr->size()!=2)
69 return gensizeerr(contextptr);
70 vecteur & v=*args._VECTptr;
71 return scalar_product(v[0],v[1],contextptr);
72 }
73 static const char _scalar_product_s []="scalar_product";
74 static define_unary_function_eval (__scalar_product,&_scalar_product,_scalar_product_s);
75 define_unary_function_ptr5( at_scalar_product ,alias_at_scalar_product,&__scalar_product,0,true);
76
77 static const char _dot_s []="dot";
78 static define_unary_function_eval (__dot,&_scalar_product,_dot_s);
79 define_unary_function_ptr5( at_dot ,alias_at_dot,&__dot,0,true);
80
_compare(const gen & args,GIAC_CONTEXT)81 gen _compare(const gen & args,GIAC_CONTEXT){
82 if ( args.type==_STRNG && args.subtype==-1) return args;
83 if (args.type!=_VECT || args._VECTptr->size()!=2)
84 return gensizeerr(contextptr);
85 vecteur & v=*args._VECTptr;
86 return v[0].islesscomplexthan(v[1]);
87 }
88 static const char _compare_s []="compare";
89 static define_unary_function_eval (__compare,&_compare,_compare_s);
90 define_unary_function_ptr5( at_compare ,alias_at_compare,&__compare,0,true);
91
_preval(const gen & args,GIAC_CONTEXT)92 gen _preval(const gen & args,GIAC_CONTEXT){
93 if ( args.type==_STRNG && args.subtype==-1) return args;
94 if (args.type!=_VECT)
95 return symbolic(at_preval,args);
96 vecteur & v=*args._VECTptr;
97 int s=int(v.size());
98 if (s<3)
99 return gentoofewargs("");
100 gen f(v[0]),x,a,b;
101 a=v[1];
102 b=v[2];
103 if (s==3){
104 x=vx_var;
105 if (a.is_symb_of_sommet(at_equal)){
106 x=a._SYMBptr->feuille[0];
107 a=a._SYMBptr->feuille[1];
108 if (b.is_symb_of_sommet(at_equal))
109 b=b._SYMBptr->feuille[1];
110 }
111 }
112 else
113 x=v[3];
114 if (x.type!=_IDNT)
115 return gentypeerr(contextptr);
116 return preval(f,x,a,b,contextptr);
117 }
118 static const char _preval_s []="preval";
119 static define_unary_function_eval (__preval,&_preval,_preval_s);
120 define_unary_function_ptr5( at_preval ,alias_at_preval,&__preval,0,true);
121
122 // return suitable gen for interpolation
123 // if possible return j, if j is too large, return a GF element
interpolate_xi(int j,const gen & coeff)124 gen interpolate_xi(int j,const gen &coeff){
125 if (coeff.type==_MOD){
126 }
127 if (coeff.type!=_USER)
128 return j;
129 #ifndef NO_RTTI
130 if (galois_field * gf=dynamic_cast<galois_field *>(coeff._USERptr)){
131 if (j<gf->p.val)
132 return j;
133 galois_field g(*gf); // copy
134 g.a=_revlist(_convert(makesequence(j,change_subtype(_BASE,_INT_MAPLECONVERSION),gf->p),context0),context0);
135 return g;
136 }
137 #endif
138 return j;
139 }
140 // characteristic must be large enough to interpolate the resultant
141 // d1+1 evaluations + there is a probab. of 2/p of bad evaluation
142 // (d1+1)*p/(p-2)<p -> p>d1+3 + we add some more for safety
143 // on Galois fields comparison should be (d+1)*p/(p-2)<p^m
144 // assuming interpolation is done with all fields elements
interpolable_resultant(const polynome & P,int d1,gen & coefft,bool extend,GIAC_CONTEXT)145 bool interpolable_resultant(const polynome & P,int d1,gen & coefft,bool extend,GIAC_CONTEXT){
146 int tt=coefft.type;
147 if (tt!=_USER)
148 tt=coefftype(P,coefft);
149 return interpolable(d1,coefft,extend,contextptr);
150 }
151
interpolable(int d1,gen & coefft,bool extend,GIAC_CONTEXT)152 bool interpolable(int d1,gen & coefft,bool extend,GIAC_CONTEXT){
153 int tt=coefft.type;
154 if (tt==_USER){
155 #ifndef NO_RTTI
156 if (galois_field * gf=dynamic_cast<galois_field *>(coefft._USERptr)){
157 gen m=gf->p;
158 if (!is_integer(m))
159 return false;
160 return is_greater(pow(m,gf->P._VECTptr->size()-1,contextptr),d1+20,contextptr);
161 }
162 return true;
163 #endif
164 }
165 if (tt==_MOD){
166 gen m=*(coefft._MODptr+1);
167 if (!is_integer(m))
168 return false;
169 if (is_greater(m,d1+20,contextptr))
170 return true;
171 if (!extend || !_isprime(m,contextptr).val)
172 return false;
173 // build a suitable field extension...
174 int n=int(std::ceil(std::log(d1+20.0)/std::log(evalf_double(m,1,contextptr)._DOUBLE_val)));
175 #ifdef NO_RTTI
176 return false;
177 #else
178 coefft=_galois_field(makesequence(m,n),contextptr);
179 return true;
180 #endif
181 }
182 return true;
183 }
divided_differences(const vecteur & x,const vecteur & y)184 vecteur divided_differences(const vecteur & x,const vecteur & y){
185 vecteur res(y);
186 int s=int(x.size());
187 for (int k=1;k<s;++k){
188 for (int j=s-1;j>=k;--j){
189 res[j]=(res[j]-res[j-1])/(x[j]-x[j-k]);
190 }
191 //CERR << k << res << '\n';
192 }
193 return res;
194 }
_lagrange(const gen & args,GIAC_CONTEXT)195 gen _lagrange(const gen & args,GIAC_CONTEXT){
196 if ( args.type==_STRNG && args.subtype==-1) return args;
197 if (args.type!=_VECT)
198 return symbolic(at_lagrange,args);
199 vecteur & v=*args._VECTptr;
200 int s=int(v.size());
201 if (s<2)
202 return gentoofewargs("");
203 gen v0(v[0]),v1(v[1]),x=vx_var;
204 if (ckmatrix(v0) && v0._VECTptr->size()==2){
205 x=v1;
206 v1=v0._VECTptr->back();
207 v0=v0._VECTptr->front();
208 }
209 if (s>=3)
210 x=v[2];
211 if (v0.type!=_VECT && v1.type==_VECT){
212 gen tmp=v1;
213 v1=_apply(makesequence(v0,v1),contextptr);
214 v0=tmp;
215 }
216 if (v1.type!=_VECT && v0.type==_VECT)
217 v1=_apply(makesequence(v1,v0),contextptr);
218 if ( (v0.type!=_VECT) || (v1.type!=_VECT) )
219 return gensizeerr(contextptr);
220 vecteur & vx =*v0._VECTptr;
221 vecteur & vy=*v1._VECTptr;
222 s=int(vx.size());
223 if (!s || vy.size()!=unsigned(s))
224 return gendimerr(contextptr);
225 // Using divided difference instead of the theoretical formula
226 if (x.type==_VECT && x._VECTptr->empty()){
227 vecteur res;
228 interpolate(vx,vy,res,0);
229 return res;
230 }
231 vecteur w=divided_differences(vx,vy);
232 if (x==at_lagrange)
233 return w;
234 gen pi(1),res(w[s-1]);
235 for (int i=s-2;i>=0;--i){
236 res = res*(x-vx[i])+w[i];
237 if (i%100==99) // otherwise segfault
238 res=ratnormal(res,contextptr);
239 }
240 return res;
241 /*
242 gen res(zero);
243 for (int i=0;i<s;++i){
244 gen pix(plus_one),pix0(plus_one),x0(vx[i]);
245 for (int j=0;j<s;++j){
246 if (j==i)
247 continue;
248 pix=pix*(x-vx[j]);
249 pix0=pix0*(x0-vx[j]);
250 }
251 res=res+vy[i]*rdiv(pix,pix0);
252 }
253 return res;
254 */
255 }
256 static const char _lagrange_s []="lagrange";
257 static define_unary_function_eval (__lagrange,&_lagrange,_lagrange_s);
258 define_unary_function_ptr5( at_lagrange ,alias_at_lagrange,&__lagrange,0,true);
259
_reorder(const gen & args,GIAC_CONTEXT)260 gen _reorder(const gen & args,GIAC_CONTEXT){
261 if ( args.type==_STRNG && args.subtype==-1) return args;
262 if (args.type!=_VECT)
263 return symbolic(at_reorder,args);
264 vecteur & v=*args._VECTptr;
265 int s=int(v.size());
266 if (s<2)
267 return gentoofewargs("");
268 gen e(v[0]),l(v[1]);
269 if (e.type<=_POLY) return e;
270 if (l.type!=_VECT)
271 return gensizeerr(contextptr);
272 vecteur w(*l._VECTptr);
273 lvar(e,w);
274 e=e2r(e,w,contextptr);
275 return r2e(e,w,contextptr);
276 }
277 static const char _reorder_s []="reorder";
278 static define_unary_function_eval (__reorder,&_reorder,_reorder_s);
279 define_unary_function_ptr5( at_reorder ,alias_at_reorder,&__reorder,0,true);
280
_adjoint_matrix(const gen & args,GIAC_CONTEXT)281 gen _adjoint_matrix(const gen & args,GIAC_CONTEXT){
282 if ( args.type==_STRNG && args.subtype==-1) return args;
283 if (args.type!=_VECT)
284 return symbolic(at_adjoint_matrix,args);
285 matrice mr(*args._VECTptr);
286 if (!is_squarematrix(mr))
287 return gensizeerr(contextptr);
288 matrice m_adj;
289 vecteur p_car;
290 p_car=mpcar(mr,m_adj,true,true,contextptr);
291 return makevecteur(p_car,m_adj);
292 }
293 static const char _adjoint_matrix_s []="adjoint_matrix";
294 static define_unary_function_eval (__adjoint_matrix,&_adjoint_matrix,_adjoint_matrix_s);
295 define_unary_function_ptr5( at_adjoint_matrix ,alias_at_adjoint_matrix,&__adjoint_matrix,0,true);
296
_equal2diff(const gen & args,GIAC_CONTEXT)297 gen _equal2diff(const gen & args,GIAC_CONTEXT){
298 if ( args.type==_STRNG && args.subtype==-1) return args;
299 return apply(args,equal2diff);
300 }
301 static const char _equal2diff_s []="equal2diff";
302 static define_unary_function_eval (__equal2diff,&_equal2diff,_equal2diff_s);
303 define_unary_function_ptr5( at_equal2diff ,alias_at_equal2diff,&__equal2diff,0,true);
304
equal2list(const gen & arg)305 static gen equal2list(const gen & arg){
306 if ( !is_equal(arg))
307 return makevecteur(arg,zero);
308 return arg._SYMBptr->feuille;
309 }
_equal2list(const gen & args,GIAC_CONTEXT)310 gen _equal2list(const gen & args,GIAC_CONTEXT){
311 if ( args.type==_STRNG && args.subtype==-1) return args;
312 return apply(args,equal2list);
313 }
314 static const char _equal2list_s []="equal2list";
315 static define_unary_function_eval (__equal2list,&_equal2list,_equal2list_s);
316 define_unary_function_ptr5( at_equal2list ,alias_at_equal2list,&__equal2list,0,true);
317
_rank(const gen & args,GIAC_CONTEXT)318 gen _rank(const gen & args,GIAC_CONTEXT){
319 if ( args.type==_STRNG && args.subtype==-1) return args;
320 if (args.type!=_VECT)
321 return gentypeerr(contextptr); // return symbolic(at_adjoint_matrix,args);
322 matrice mr(*args._VECTptr);
323 if (!ckmatrix(mr))
324 return gensizeerr(contextptr);
325 mr=mrref(mr,contextptr);
326 int r=int(mr.size());
327 for (;r;--r){
328 if (!is_zero(mr[r-1]))
329 break;
330 }
331 return r;
332 }
333 static const char _rank_s []="rank";
334 static define_unary_function_eval (__rank,&_rank,_rank_s);
335 define_unary_function_ptr5( at_rank ,alias_at_rank,&__rank,0,true);
336
_sec(const gen & args,GIAC_CONTEXT)337 gen _sec(const gen & args,GIAC_CONTEXT){
338 if ( args.type==_STRNG && args.subtype==-1) return args;
339 return inv(cos(args,contextptr),contextptr);
340 }
341 static const char _sec_s []="sec";
342 static define_unary_function_eval (__sec,&_sec,_sec_s);
343 define_unary_function_ptr5( at_sec ,alias_at_sec,&__sec,0,true);
344
_csc(const gen & args,GIAC_CONTEXT)345 gen _csc(const gen & args,GIAC_CONTEXT){
346 if ( args.type==_STRNG && args.subtype==-1) return args;
347 return inv(sin(args,contextptr),contextptr);
348 }
349 static const char _csc_s []="csc";
350 static define_unary_function_eval (__csc,&_csc,_csc_s);
351 define_unary_function_ptr5( at_csc ,alias_at_csc,&__csc,0,true);
352
_cot(const gen & args,GIAC_CONTEXT)353 gen _cot(const gen & args,GIAC_CONTEXT){
354 if ( args.type==_STRNG && args.subtype==-1) return args;
355 return rdiv(cos(args,contextptr),sin(args,contextptr),contextptr);
356 }
357 static const char _cot_s []="cot";
358 static define_unary_function_eval (__cot,&_cot,_cot_s);
359 define_unary_function_ptr5( at_cot ,alias_at_cot,&__cot,0,true);
360
_asec(const gen & args,GIAC_CONTEXT)361 gen _asec(const gen & args,GIAC_CONTEXT){
362 if ( args.type==_STRNG && args.subtype==-1) return args;
363 return acos(inv(args,contextptr),contextptr);
364 }
365 static const char _asec_s []="asec";
366 static define_unary_function_eval (__asec,&_asec,_asec_s);
367 define_unary_function_ptr5( at_asec ,alias_at_asec,&__asec,0,true);
368
_acsc(const gen & args,GIAC_CONTEXT)369 gen _acsc(const gen & args,GIAC_CONTEXT){
370 if ( args.type==_STRNG && args.subtype==-1) return args;
371 return asin(inv(args,contextptr),contextptr);
372 }
373 static const char _acsc_s []="acsc";
374 static define_unary_function_eval (__acsc,&_acsc,_acsc_s);
375 define_unary_function_ptr5( at_acsc ,alias_at_acsc,&__acsc,0,true);
376
_acot(const gen & args,GIAC_CONTEXT)377 gen _acot(const gen & args,GIAC_CONTEXT){
378 if ( args.type==_STRNG && args.subtype==-1) return args;
379 if (is_zero(args))
380 //grad
381 return angle_radian(contextptr)?cst_pi_over_2:(angle_degree(contextptr)?90:100);
382 #if 0
383 if (abs_calc_mode(contextptr)==38)
384 return cst_pi_over_2-atan(args,contextptr);
385 #endif
386 return atan(inv(args,contextptr),contextptr);
387 }
388 static const char _acot_s []="acot";
389 static define_unary_function_eval (__acot,&_acot,_acot_s);
390 define_unary_function_ptr5( at_acot ,alias_at_acot,&__acot,0,true);
391
392 // args=[u'*v,v] or [[F,u'*v],v] -> [F+u*v,-u*v']
393 // a third argument would be the integration var
394 // if v=0 returns F+integrate(u'*v,x)
_ibpu(const gen & args,GIAC_CONTEXT)395 gen _ibpu(const gen & args,GIAC_CONTEXT) {
396 if ( args.type==_STRNG && args.subtype==-1) return args;
397 if ( (args.type!=_VECT) || (args._VECTptr->size()<2) )
398 return symbolic(at_ibpu,args);
399 vecteur & w=*args._VECTptr;
400 gen X(vx_var),x(vx_var),a,b;
401 bool bound=false;
402 if (w.size()>=3)
403 x=X=w[2];
404 if (is_equal(x))
405 x=x._SYMBptr->feuille[0];
406 if (w.size()>=5)
407 X=symb_equal(x,symb_interval(w[3],w[4]));
408 if (is_equal(X) && X._SYMBptr->feuille[1].is_symb_of_sommet(at_interval)){
409 a=X._SYMBptr->feuille[1]._SYMBptr->feuille[0];
410 b=X._SYMBptr->feuille[1]._SYMBptr->feuille[1];
411 bound=true;
412 }
413 gen u,v(w[1]),uprimev,F;
414 if (w.front().type==_VECT){
415 vecteur & ww=*w.front()._VECTptr;
416 if (ww.size()!=2)
417 return gensizeerr(contextptr);
418 F=ww.front();
419 uprimev=ww.back();
420 }
421 else
422 uprimev=w.front();
423 if (is_zero(v) || is_one(v)){
424 gen tmp=integrate_gen(uprimev,x,contextptr);
425 if (is_undef(tmp)) return tmp;
426 if (bound)
427 tmp=preval(tmp,x,a,b,contextptr);
428 return tmp+F;
429 }
430 gen uprime(normal(rdiv(uprimev,v,contextptr),contextptr));
431 u=integrate_gen(uprime,x,contextptr);
432 if (is_undef(u)) return u;
433 if (bound)
434 F += preval(u*v,x,a,b,contextptr);
435 else
436 F += u*v;
437 return makevecteur(F,normal(-u*derive(v,x,contextptr),contextptr));
438 }
439 static const char _ibpu_s []="ibpu";
440 static define_unary_function_eval (__ibpu,&_ibpu,_ibpu_s);
441 define_unary_function_ptr5( at_ibpu ,alias_at_ibpu,&__ibpu,0,true);
442
_changebase(const gen & args,GIAC_CONTEXT)443 gen _changebase(const gen & args,GIAC_CONTEXT){
444 if ( args.type==_STRNG && args.subtype==-1) return args;
445 if (args.type!=_VECT)
446 return symbolic(at_changebase,args);
447 vecteur & v=*args._VECTptr;
448 if (v.size()!=2)
449 return gentypeerr(contextptr);
450 gen a=v.front(),p=v.back();
451 if (!is_squarematrix(p))
452 return gensizeerr(contextptr);
453 return minv(*p._VECTptr,contextptr)*a*p;
454 }
455 static const char _changebase_s []="changebase";
456 static define_unary_function_eval (__changebase,&_changebase,_changebase_s);
457 define_unary_function_ptr5( at_changebase ,alias_at_changebase,&__changebase,0,true);
458
epsilon2zero(const gen & g,GIAC_CONTEXT)459 static gen epsilon2zero(const gen & g,GIAC_CONTEXT){
460 switch (g.type){
461 case _DOUBLE_:
462 if (fabs(g._DOUBLE_val)<epsilon(contextptr))
463 return zero;
464 else
465 return g;
466 case _CPLX:
467 return epsilon2zero(re(g,contextptr),contextptr)+cst_i*epsilon2zero(im(g,contextptr),contextptr);
468 case _SYMB:
469 return symbolic(g._SYMBptr->sommet,epsilon2zero(g._SYMBptr->feuille,contextptr));
470 case _VECT:
471 return apply(g,epsilon2zero,contextptr);
472 default:
473 return g;
474 }
475 }
_epsilon2zero(const gen & args,GIAC_CONTEXT)476 gen _epsilon2zero(const gen & args,GIAC_CONTEXT){
477 if ( args.type==_STRNG && args.subtype==-1) return args;
478 if (args.type==_VECT && args.subtype==_SEQ__VECT && args._VECTptr->size()==2){
479 gen p=evalf_double(args._VECTptr->back(),1,contextptr);
480 if (p.type==_DOUBLE_ && p._DOUBLE_val>0){
481 double eps=epsilon(contextptr);
482 epsilon(p._DOUBLE_val,contextptr);
483 gen res=epsilon2zero(args._VECTptr->front(),contextptr);
484 epsilon(eps,contextptr);
485 return res;
486 }
487 }
488 return epsilon2zero(args,contextptr);
489 }
490 static const char _epsilon2zero_s []="epsilon2zero";
491 static define_unary_function_eval (__epsilon2zero,&_epsilon2zero,_epsilon2zero_s);
492 define_unary_function_ptr5( at_epsilon2zero ,alias_at_epsilon2zero,&__epsilon2zero,0,true);
493
_suppress(const gen & args,GIAC_CONTEXT)494 gen _suppress(const gen & args,GIAC_CONTEXT){
495 if ( args.type==_STRNG && args.subtype==-1) return args;
496 if (args.type!=_VECT)
497 return symbolic(at_suppress,args);
498 vecteur & v=*args._VECTptr;
499 if (v.size()==3 && v[1].type==_INT_ && v[2].type==_INT_){
500 int i1=v[1].val-array_start(contextptr); //(xcas_mode(contextptr)!=0 || abs_calc_mode(contextptr)==38);
501 int i2=v[2].val-array_start(contextptr); //(xcas_mode(contextptr)!=0 || abs_calc_mode(contextptr)==38);
502 if (i1 >i2 || i1<0 || i2 < 0)
503 return gendimerr(contextptr);
504 if (v[0].type==_VECT){
505 vecteur w=*v[0]._VECTptr;
506 if (i1>=int(w.size()) || i2>=int(w.size()))
507 return gendimerr(contextptr);
508 return gen(mergevecteur(vecteur(w.begin(),w.begin()+i1),vecteur(w.begin()+i2+1,w.end())),v[0].subtype);
509 }
510 if (v[0].type==_STRNG){
511 string s=*v[0]._STRNGptr;
512 if (i1>=int(s.size()) || i2>=int(s.size()))
513 return gendimerr(contextptr);
514 return string2gen(s.substr(0,i1)+s.substr(i2+1,s.size()-i2-1),false);
515 }
516 return gensizeerr(contextptr);
517 }
518 if (v.size()!=2)
519 return gentypeerr(contextptr);
520 gen l=v.front(),i=v.back();
521 if (i.is_symb_of_sommet(at_deuxpoints))
522 return _suppress(makesequence(l,i[1],i[2]-1),contextptr);
523 if (i.is_symb_of_sommet(at_interval))
524 return _suppress(makesequence(l,i[1],i[2]),contextptr);
525 int ii=0;
526 if (i.type==_VECT){
527 i=sortad(*i._VECTptr,false,contextptr);
528 if (i.type==_VECT){
529 const_iterateur it=i._VECTptr->begin(),itend=i._VECTptr->end();
530 for (;it!=itend;++it){
531 l=_suppress(makesequence(l,*it),contextptr);
532 }
533 return l;
534 }
535 }
536 if (i.type==_INT_ )
537 ii=i.val-array_start(contextptr); //(xcas_mode(contextptr)!=0 || abs_calc_mode(contextptr)==38);
538 if (l.type==_STRNG){
539 string res;
540 string & s=*l._STRNGptr;
541 int n=int(s.size());
542 if (i.type==_INT_ && ii>=0 && ii<n)
543 res=s.substr(0,ii)+s.substr(ii+1,n-ii-1);
544 if (i.type==_STRNG){
545 string & remove=*i._STRNGptr;
546 int removen=int(remove.size());
547 for (int j=0;j<n;++j){
548 int k=int(remove.find(s[j]));
549 if (k<0 || k>=removen)
550 res += s[j];
551 }
552 }
553 return string2gen(res,false);
554 }
555 if ( (l.type!=_VECT) || (i.type!=_INT_) )
556 return gensizeerr(contextptr);
557 const_iterateur it=l._VECTptr->begin(),itend=l._VECTptr->end();
558 vecteur res;
559 res.reserve(itend-it);
560 for (int j=0;it!=itend;++it,++j){
561 if (j!=ii)
562 res.push_back(*it);
563 }
564 return gen(res,l.subtype);
565 }
566 static const char _suppress_s []="suppress";
567 static define_unary_function_eval (__suppress,&_suppress,_suppress_s);
568 define_unary_function_ptr5( at_suppress ,alias_at_suppress,&__suppress,0,true);
569
570 #if defined GIAC_HAS_STO_38 || defined FXCG || defined NSPIRE
571 const int pixel_lines=1; // 320; // calculator screen 307K
572 const int pixel_cols=1; // 240;
573 #else
574 #ifdef KHICAS
575 const int pixel_lines=320;
576 const int pixel_cols=240;
577 #else
578 const int pixel_lines=1024;
579 const int pixel_cols=768;
580 #endif
581 #endif
582 #ifdef KHICAS
clear_pixel_buffer()583 void clear_pixel_buffer(){
584 }
585 #else
586 int pixel_buffer[pixel_lines][pixel_cols];
clear_pixel_buffer()587 void clear_pixel_buffer(){
588 for (int i=0;i<pixel_lines;++i){
589 int * ptr=pixel_buffer[i];
590 int * ptrend = ptr+pixel_cols;
591 for (;ptr<ptrend;++ptr){
592 *ptr=int(FL_WHITE);
593 }
594 }
595 }
pixel_v()596 static gen & pixel_v(){
597 static gen * ptr=0;
598 if (ptr==0){
599 clear_pixel_buffer();
600 ptr=new gen(makevecteur(0));
601 }
602 return *ptr;
603 }
604 #endif
_clear(const gen & args,GIAC_CONTEXT)605 gen _clear(const gen & args,GIAC_CONTEXT){
606 if ( args.type==_STRNG && args.subtype==-1) return args;
607 if (args.type==_VECT && args._VECTptr->empty()){
608 #ifdef KHICAS
609 os_fill_rect(0,0,pixel_lines,pixel_cols,_WHITE);
610 #else // KHICAS
611 #ifdef GIAC_HAS_STO_38
612 static gen RECT_P(identificateur("RECT_P"));
613 _of(makesequence(RECT_P,args),contextptr);
614 #else
615 clear_pixel_buffer();
616 #endif // else HP
617 pixel_v()._VECTptr->clear();
618 history_plot(contextptr).clear();
619 #endif // else KHICAS
620 return 1;
621 }
622 gen g=eval(args,1,contextptr);
623 if (g.type==_STRNG)
624 g=string2gen("",false);
625 else {
626 if (g.type!=_VECT)
627 return gensizeerr(contextptr);
628 g=gen(vecteur(0),args.subtype);
629 }
630 if (args.type==_STRNG || args.type==_VECT)
631 return g;
632 return sto(g,args,contextptr);
633 }
634 static const char _clear_s []="clear";
635 static define_unary_function_eval_quoted (__clear,&_clear,_clear_s);
636 define_unary_function_ptr5( at_clear ,alias_at_clear,&__clear,_QUOTE_ARGUMENTS,true);
637
638 #ifndef KHICAS
_show_pixels(const gen & args,GIAC_CONTEXT)639 gen _show_pixels(const gen & args,GIAC_CONTEXT){
640 #ifdef GIAC_HAS_STO_38
641 static gen FREEZE(identificateur("FREEZE"));
642 return _of(makesequence(FREEZE,args),contextptr);
643 #else
644 #ifdef EMCC
645 return pixel_v();
646 #else
647 return makesequence(symb_equal(change_subtype(_AXES,_INT_PLOT),0),pixel_v());
648 #endif
649 #endif
650 }
651 static const char _show_pixels_s []="show_pixels";
652 static define_unary_function_eval (__show_pixels,&_show_pixels,_show_pixels_s);
653 define_unary_function_ptr5( at_show_pixels ,alias_at_show_pixels,&__show_pixels,0,true);
654 #endif
655
_show(const gen & args,GIAC_CONTEXT)656 gen _show(const gen & args,GIAC_CONTEXT){
657 return history_plot(contextptr);
658 }
659 static const char _show_s []="show";
660 static define_unary_function_eval (__show,&_show,_show_s);
661 define_unary_function_ptr5( at_show ,alias_at_show,&__show,0,true);
662
_insert(const gen & args,GIAC_CONTEXT)663 gen _insert(const gen & args,GIAC_CONTEXT){
664 if ( args.type==_STRNG && args.subtype==-1) return args;
665 if (args.type!=_VECT)
666 return gensizeerr(contextptr);
667 vecteur & v=*args._VECTptr;
668 if (v.size()!=3)
669 return gensizeerr(contextptr);
670 gen i=v[1];
671 if (!is_integral(i) || i.type!=_INT_)
672 return gensizeerr(contextptr);
673 int ii=i.val-array_start(contextptr); //(xcas_mode(contextptr)!=0 || abs_calc_mode(contextptr)==38);
674 if (v[0].type==_VECT){
675 vecteur w=*v[0]._VECTptr;
676 if (ii<0 || ii>int(w.size()))
677 return gendimerr(contextptr);
678 w.insert(w.begin()+ii,v[2]);
679 return gen(w,v[0].subtype);
680 }
681 if (v[0].type==_STRNG){
682 string s=*v[0]._STRNGptr;
683 if (ii<0 || ii>int(s.size()))
684 return gendimerr(contextptr);
685 string add=(v[2].type==_STRNG)?*v[2]._STRNGptr:v[2].print(contextptr);
686 s=s.substr(0,ii)+add+s.substr(ii,s.size()-ii);
687 return string2gen(s,false);
688 }
689 return gensizeerr(contextptr);
690 }
691 static const char _insert_s []="insert";
692 static define_unary_function_eval (__insert,&_insert,_insert_s);
693 define_unary_function_ptr5( at_insert ,alias_at_insert,&__insert,0,true);
694
_pop(const gen & args,GIAC_CONTEXT)695 gen _pop(const gen & args,GIAC_CONTEXT){
696 if ( args.type==_STRNG && args.subtype==-1) return args;
697 if (args.type==_VECT && args.subtype==_SEQ__VECT && args._VECTptr->size()==2 ){
698 if (args._VECTptr->front().type==_MAP){
699 const gen & m=args._VECTptr->front();
700 const gen & indice=args._VECTptr->back();
701 gen_map::iterator it=m._MAPptr->find(indice),itend=m._MAPptr->end();
702 if (it==itend)
703 return gensizeerr(gettext("Bad index")+indice.print(contextptr));
704 m._MAPptr->erase(it);
705 return 1;
706 }
707 if (args._VECTptr->back().type==_INT_){
708 int pos=args._VECTptr->back().val;
709 gen g=args._VECTptr->front();
710 if (pos>=0 && g.type==_VECT && g._VECTptr->size()>pos){
711 gen res=(*g._VECTptr)[pos];
712 g._VECTptr->erase(g._VECTptr->begin()+pos);
713 return res;
714 }
715 }
716 }
717 if (args.type!=_VECT || args._VECTptr->empty())
718 return gensizeerr(contextptr);
719 gen res=args._VECTptr->back();
720 args._VECTptr->pop_back();
721 return res;
722 }
723 static const char _pop_s []="pop";
724 static define_unary_function_eval (__pop,&_pop,_pop_s);
725 define_unary_function_ptr5( at_pop ,alias_at_pop,&__pop,0,true);
726
valuation(const polynome & p)727 static int valuation(const polynome & p){
728 if (p.coord.empty())
729 return -1;
730 return p.coord.back().index.front();
731 }
_valuation(const gen & args,GIAC_CONTEXT)732 gen _valuation(const gen & args,GIAC_CONTEXT){
733 if ( args.type==_STRNG && args.subtype==-1) return args;
734 gen p,x;
735 if (args.type!=_VECT){
736 x=vx_var;
737 p=args;
738 }
739 else {
740 vecteur & v=*args._VECTptr;
741 int s=int(v.size());
742 if (!s)
743 return minus_inf;
744 if ( (args.subtype==_POLY1__VECT) || (s!=2) || (v[1].type!=_IDNT) ){
745 int j=s;
746 for (;j;--j){
747 if (!is_zero(v[j-1]))
748 break;
749 }
750 return s-j;
751 }
752 x=v.back();
753 p=v.front();
754 }
755 vecteur lv(1,x);
756 lvar(p,lv);
757 gen aa=e2r(p,lv,contextptr),aan,aad;
758 if (is_zero(aa))
759 return minus_inf;
760 fxnd(aa,aan,aad);
761 if ( (aad.type==_POLY) && (aad._POLYptr->lexsorted_degree() ) )
762 return gensizeerr(contextptr);
763 if (aan.type!=_POLY)
764 return zero;
765 int res=valuation(*aan._POLYptr);
766 if (res==-1)
767 return minus_inf;
768 else
769 return res;
770 }
771 static const char _valuation_s []="valuation";
772 static define_unary_function_eval (__valuation,&_valuation,_valuation_s);
773 define_unary_function_ptr5( at_valuation ,alias_at_valuation,&__valuation,0,true);
774
775 static const char _ldegree_s []="ldegree";
776 static define_unary_function_eval (__ldegree,&_valuation,_ldegree_s);
777 define_unary_function_ptr5( at_ldegree ,alias_at_ldegree,&__ldegree,0,true);
778
sum_degree(const index_m & v1,int vars)779 int sum_degree(const index_m & v1,int vars){
780 int i=0;
781 for (index_t::const_iterator it=v1.begin();it!=v1.end() && it!=v1.begin()+vars;++it)
782 i=i+(*it);
783 return(i);
784 }
785
total_degree(const polynome & p,int vars)786 int total_degree(const polynome & p,int vars) {
787 std::vector< monomial<gen> >::const_iterator it=p.coord.begin();
788 std::vector< monomial<gen> >::const_iterator it_end=p.coord.end();
789 int res=0;
790 for (;it!=it_end;++it){
791 int temp=sum_degree(it->index,vars);
792 if (res<temp)
793 res=temp;
794 }
795 return res;
796 }
797
798
_degree_(const gen & args,bool total,GIAC_CONTEXT)799 gen _degree_(const gen & args,bool total,GIAC_CONTEXT){
800 if ( args.type==_STRNG && args.subtype==-1) return args;
801 gen p,x;
802 if (args.type!=_VECT){
803 p=args;
804 if (calc_mode(contextptr)==1)
805 x=ggb_var(p);
806 else
807 x=vx_var;
808 }
809 else {
810 vecteur & v=*args._VECTptr;
811 int s=int(v.size());
812 if ( (args.subtype==_POLY1__VECT) || (s!=2) || (v[1].type!=_IDNT && v[1].type!=_VECT) )
813 return s-1;
814 x=v.back();
815 p=v.front();
816 }
817 if (p.type==_POLY){
818 if (x.type==_INT_ && x.val>=0 && x.val<p._POLYptr->dim)
819 return p._POLYptr->degree(x.val);
820 else {
821 vecteur res(p._POLYptr->dim);
822 index_t idx(p._POLYptr->degree());
823 for (int i=0;i<p._POLYptr->dim;++i)
824 res[i]=idx[i];
825 return res;
826 }
827 }
828 vecteur lv(1,x);
829 if (x.type==_VECT)
830 lv=*x._VECTptr;
831 lvar(p,lv);
832 gen aa=e2r(p,lv,contextptr),aan,aad;
833 if (is_zero(aa))
834 return zero;
835 fxnd(aa,aan,aad);
836 if (x.type==_VECT){
837 if (total){
838 int deg=0;
839 if (aad.type==_POLY)
840 deg -= total_degree(*aad._POLYptr,int(x._VECTptr->size()));
841 if (aan.type==_POLY)
842 deg += total_degree(*aan._POLYptr,int(x._VECTptr->size()));
843 return deg;
844 }
845 int s=int(x._VECTptr->size());
846 vecteur res(s);
847 for (int i=0;i<s;++i){
848 int deg=0;
849 if (aad.type==_POLY)
850 deg -= aad._POLYptr->degree(i);;
851 if (aan.type!=_POLY)
852 res[i]=deg;
853 else
854 res[i]=deg+aan._POLYptr->degree(i);
855 }
856 return res;
857 }
858 int deg=0;
859 if ( (aad.type==_POLY) && (aad._POLYptr->lexsorted_degree() ) )
860 deg -= aad._POLYptr->lexsorted_degree();;
861 if (aan.type!=_POLY)
862 return deg;
863 return deg+aan._POLYptr->lexsorted_degree();
864 }
_degree(const gen & args,GIAC_CONTEXT)865 gen _degree(const gen & args,GIAC_CONTEXT){
866 return _degree_(args,false,contextptr);
867 }
868 static const char _degree_s []="degree";
869 static define_unary_function_eval (__degree,&_degree,_degree_s);
870 define_unary_function_ptr5( at_degree ,alias_at_degree,&__degree,0,true);
871
_total_degree(const gen & args,GIAC_CONTEXT)872 gen _total_degree(const gen & args,GIAC_CONTEXT){
873 return _degree_(args,true,contextptr);
874 }
875 static const char _total_degree_s []="total_degree";
876 static define_unary_function_eval (__total_degree,&_total_degree,_total_degree_s);
877 define_unary_function_ptr5( at_total_degree ,alias_at_total_degree,&__total_degree,0,true);
878
_lcoeff(const gen & args,GIAC_CONTEXT)879 gen _lcoeff(const gen & args,GIAC_CONTEXT){
880 if ( args.type==_STRNG && args.subtype==-1) return args;
881 gen x,p,order;
882 int s=2;
883 if (args.type!=_VECT){
884 x=vx_var;
885 p=args;
886 }
887 else {
888 vecteur & v=*args._VECTptr;
889 s=int(v.size());
890 if (!s)
891 return args;
892 if ( (args.subtype!=_SEQ__VECT) || (s<2) )
893 return v.front();
894 x=v[1];
895 p=v[0];
896 if (s>2)
897 order=v[2];
898 }
899 gen g=_e2r(makesequence(p,x),contextptr),n,d;
900 fxnd(g,n,d);
901 if (n.type!=_VECT){
902 if (n.type==_POLY){
903 polynome nlcoeff(*n._POLYptr);
904 if (!nlcoeff.coord.empty()){
905 if (order.type==_INT_)
906 change_monomial_order(nlcoeff,order);
907 nlcoeff.coord.erase(nlcoeff.coord.begin()+1,nlcoeff.coord.end());
908 }
909 n=nlcoeff;
910 }
911 return _r2e(gen(makevecteur(n/d,x),_SEQ__VECT),contextptr);
912 }
913 return n._VECTptr->front()/d;
914 }
915 static const char _lcoeff_s []="lcoeff";
916 static define_unary_function_eval (__lcoeff,&_lcoeff,_lcoeff_s);
917 define_unary_function_ptr5( at_lcoeff ,alias_at_lcoeff,&__lcoeff,0,true);
918
tcoeff(const vecteur & v)919 static gen tcoeff(const vecteur & v){
920 int s=int(v.size());
921 gen g;
922 for (;s;--s){
923 g=v[s-1];
924 if (!is_zero(g))
925 return g;
926 }
927 return zero;
928 }
_tcoeff(const gen & args,GIAC_CONTEXT)929 gen _tcoeff(const gen & args,GIAC_CONTEXT){
930 if ( args.type==_STRNG && args.subtype==-1) return args;
931 gen x,p;
932 if (args.type!=_VECT){
933 x=vx_var;
934 p=args;
935 }
936 else {
937 vecteur& v=*args._VECTptr;
938 int s=int(v.size());
939 if ( (args.subtype!=_SEQ__VECT) || (s!=2) || (v[1].type!=_IDNT) )
940 return tcoeff(v);
941 x=v[1];
942 p=v[0];
943 }
944 gen g=_e2r(makesequence(p,x),contextptr),n,d;
945 fxnd(g,n,d);
946 if (n.type!=_VECT)
947 return zero;
948 return tcoeff(*n._VECTptr)/d;
949 }
950 static const char _tcoeff_s []="tcoeff";
951 static define_unary_function_eval (__tcoeff,&_tcoeff,_tcoeff_s);
952 define_unary_function_ptr5( at_tcoeff ,alias_at_tcoeff,&__tcoeff,0,true);
953
_homogeneize(const gen & args,GIAC_CONTEXT)954 gen _homogeneize(const gen & args,GIAC_CONTEXT){
955 if (args.type==_STRNG && args.subtype==-1) return args;
956 gen t,p;
957 int s=2;
958 if (args.type!=_VECT){
959 t=t__IDNT_e;
960 p=args;
961 }
962 else {
963 vecteur & v=*args._VECTptr;
964 s=int(v.size());
965 if (!s)
966 return args;
967 if ( (args.subtype!=_SEQ__VECT) || (s<2) )
968 return v.front();
969 t=v[1];
970 p=v[0];
971 }
972 vecteur lv(lidnt(p));
973 vecteur lt(lv);
974 lt.push_back(t);
975 gen g=_e2r(makesequence(p,lv),contextptr),n,d;
976 fxnd(g,n,d);
977 if (n.type!=_POLY)
978 return p;
979 polynome nlcoeff(*n._POLYptr);
980 nlcoeff=nlcoeff.homogeneize();
981 if (d.type==_POLY){
982 polynome dlcoeff=d._POLYptr->homogeneize();
983 g=r2e(dlcoeff,lt,contextptr);
984 }
985 else
986 g=r2e(d,lv,contextptr);
987 return r2e(nlcoeff,lt,contextptr)/g;
988 }
989 static const char _homogeneize_s []="homogeneize";
990 static define_unary_function_eval (__homogeneize,&_homogeneize,_homogeneize_s);
991 define_unary_function_ptr5( at_homogeneize ,alias_at_homogeneize,&__homogeneize,0,true);
992
sqrfree(const gen & g,const vecteur & l,GIAC_CONTEXT)993 static gen sqrfree(const gen & g,const vecteur & l,GIAC_CONTEXT){
994 if (g.type!=_POLY)
995 return r2sym(g,l,contextptr);
996 factorization f(sqff(*g._POLYptr));
997 factorization::const_iterator it=f.begin(),itend=f.end();
998 gen res(plus_one);
999 for (;it!=itend;++it)
1000 res=res*pow(r2e(it->fact,l,contextptr),it->mult);
1001 return res;
1002 }
sqrfree(const gen & g,const vecteur & l,int mult,GIAC_CONTEXT)1003 static vecteur sqrfree(const gen & g,const vecteur & l,int mult,GIAC_CONTEXT){
1004 vecteur res;
1005 if (g.type!=_POLY){
1006 if (is_one(g))
1007 return res;
1008 return vecteur(1,makevecteur(r2sym(g,l,contextptr),mult));
1009 }
1010 factorization f(sqff(*g._POLYptr));
1011 factorization::const_iterator it=f.begin(),itend=f.end();
1012 for (;it!=itend;++it){
1013 const polynome & p=it->fact;
1014 gen pg=r2e(p,l,contextptr);
1015 if (!is_one(pg))
1016 res.push_back(makevecteur(pg,mult*it->mult));
1017 }
1018 return res;
1019 }
_sqrfree(const gen & args_,GIAC_CONTEXT)1020 gen _sqrfree(const gen & args_,GIAC_CONTEXT){
1021 gen args(args_);
1022 if ( args.type==_STRNG && args.subtype==-1) return args;
1023 bool factors=false;
1024 if (args.type==_VECT){
1025 vecteur argv=*args._VECTptr;
1026 if (!argv.empty() && argv.back()==at_factors){
1027 factors=true;
1028 argv.pop_back();
1029 if (argv.size()==1)
1030 args=argv.front();
1031 else
1032 args=gen(argv,args.subtype);
1033 }
1034 }
1035 if (args.type==_VECT) // fixme take care of factors
1036 return apply(args,_sqrfree,contextptr);
1037 if (args.type!=_SYMB)
1038 return factors?makevecteur(args,1):args;
1039 gen a,b;
1040 if (is_algebraic_program(args,a,b)) // fixme take care of factors
1041 return symbolic(at_program,makesequence(a,0,_sqrfree(b,contextptr)));
1042 vecteur l(alg_lvar(args));
1043 gen g=e2r(args,l,contextptr);
1044 if (g.type==_FRAC){
1045 fraction f=*g._FRACptr;
1046 if (factors)
1047 return mergevecteur(sqrfree(f.num,l,1,contextptr),sqrfree(f.den,l,-1,contextptr));
1048 return sqrfree(f.num,l,contextptr)/sqrfree(f.den,l,contextptr);
1049 }
1050 else {
1051 if (factors)
1052 return sqrfree(g,l,1,contextptr);
1053 return sqrfree(g,l,contextptr);
1054 }
1055 }
1056 static const char _sqrfree_s []="sqrfree";
1057 static define_unary_function_eval (__sqrfree,&_sqrfree,_sqrfree_s);
1058 define_unary_function_ptr5( at_sqrfree ,alias_at_sqrfree,&__sqrfree,0,true);
1059
_truncate(const gen & args,GIAC_CONTEXT)1060 gen _truncate(const gen & args,GIAC_CONTEXT){
1061 if ( args.type==_STRNG && args.subtype==-1) return args;
1062 gen e(args);
1063 int n,s=1;
1064 vecteur w(1,vx_var);
1065 gen gn(5);
1066 if (args.type==_VECT){
1067 vecteur & v=*args._VECTptr;
1068 s=int(v.size());
1069 if (s==0)
1070 return gensizeerr(contextptr);
1071 e=v[0];
1072 if (s==3){
1073 w=gen2vecteur(v[1]);
1074 gn=v[2];
1075 }
1076 else {
1077 if (s==2)
1078 gn=v[1];
1079 }
1080 }
1081 if (gn.type!=_INT_)
1082 return gensizeerr(contextptr);
1083 n=gn.val;
1084 int nvar=int(w.size()); // number of var w.r.t. which we truncate
1085 vecteur l(lop(e,at_order_size));
1086 vecteur lp(l.size(),zero);
1087 e=subst(e,l,lp,false,contextptr);
1088 // FIXME if l not empty, adjust order of truncation using arg of order_size
1089 lvar(e,w);
1090 e=e2r(e,w,contextptr);
1091 gen num,den;
1092 fxnd(e,num,den);
1093 if ( (den.type==_POLY) && (den._POLYptr->lexsorted_degree() ) )
1094 return gensizeerr(contextptr);
1095 if (num.type==_POLY){
1096 vector< monomial<gen> >::const_iterator it=num._POLYptr->coord.begin(),itend=num._POLYptr->coord.end();
1097 vector< monomial<gen> > res;
1098 for (;it!=itend;++it){
1099 index_t::const_iterator i=it->index.begin();
1100 int deg=0;
1101 for (int j=0;j<nvar;++j,++i)
1102 deg=deg+(*i);
1103 if (deg<=n)
1104 res.push_back(*it);
1105 }
1106 num._POLYptr->coord=res;
1107 }
1108 return r2e(rdiv(num,den,contextptr),w,contextptr);
1109 }
1110 static const char _truncate_s []="truncate";
1111 static define_unary_function_eval (__truncate,&_truncate,_truncate_s);
1112 define_unary_function_ptr5( at_truncate ,alias_at_truncate,&__truncate,0,true);
1113
_canonical_form(const gen & args,GIAC_CONTEXT)1114 gen _canonical_form(const gen & args,GIAC_CONTEXT){
1115 if ( args.type==_STRNG && args.subtype==-1) return args;
1116 gen p,x,a,b,c;
1117 if (is_equal(args))
1118 return _canonical_form(equal2diff(args),contextptr);
1119 if (is_algebraic_program(args,a,b))
1120 return symbolic(at_program,makesequence(a,0,_canonical_form(gen(makevecteur(b,a[0]),_SEQ__VECT),contextptr)));
1121 if (args.type!=_VECT){
1122 p=args;
1123 x=ggb_var(p);
1124 }
1125 else {
1126 vecteur & v=*args._VECTptr;
1127 if (v.size()!=2)
1128 return gentypeerr(contextptr);
1129 p=v.front();
1130 x=v.back();
1131 }
1132 if (x.type!=_IDNT)
1133 return gentypeerr(contextptr);
1134 if (!is_quadratic_wrt(p,x,a,b,c,contextptr))
1135 return gensizeerr(contextptr);
1136 if (is_zero(a))
1137 return b*x+c;
1138 // a*x^2+b*x+c -> a*(x+b/(2*a))^2+(b^2-4*a*c)/(4*a)
1139 return a*pow(x+symbolic(at_neg,(-b)/(2*a)),2)+(4*a*c-pow(b,2))/(4*a);
1140 }
1141 static const char _canonical_form_s []="canonical_form";
1142 static define_unary_function_eval (__canonical_form,&_canonical_form,_canonical_form_s);
1143 define_unary_function_ptr5( at_canonical_form ,alias_at_canonical_form,&__canonical_form,0,true);
1144
_taux_accroissement(const gen & args,GIAC_CONTEXT)1145 gen _taux_accroissement(const gen & args,GIAC_CONTEXT){
1146 if ( args.type==_STRNG && args.subtype==-1) return args;
1147 gen p,x,a,b,c;
1148 if (args.type!=_VECT || args._VECTptr->size()<3)
1149 return gensizeerr(contextptr);
1150 vecteur v = *args._VECTptr;
1151 if (is_algebraic_program(v.front(),a,b)){
1152 return _taux_accroissement(gen(makevecteur(b,a[0],v[1],v[2]),_SEQ__VECT),contextptr);
1153 // return symbolic(at_program,makevecteur(v[1],0,_taux_accroissement(gen(makevecteur(b,a[0],v[1],v[2]),_SEQ__VECT),contextptr)));
1154 }
1155 if (v.size()<4)
1156 v.insert(v.begin()+1,vx_var);
1157 if (v[1].type!=_IDNT)
1158 return gentypeerr(contextptr);
1159 return (subst(v.front(),v[1],v[3],false,contextptr)-subst(v.front(),v[1],v[2],false,contextptr))/(v[3]-v[2]);
1160 }
1161 static const char _taux_accroissement_s []="taux_accroissement";
1162 static define_unary_function_eval (__taux_accroissement,&_taux_accroissement,_taux_accroissement_s);
1163 define_unary_function_ptr5( at_taux_accroissement ,alias_at_taux_accroissement,&__taux_accroissement,0,true);
1164
_fcoeff(const gen & args,GIAC_CONTEXT)1165 gen _fcoeff(const gen & args,GIAC_CONTEXT){
1166 if ( args.type==_STRNG && args.subtype==-1) return args;
1167 gen x;
1168 vecteur p;
1169 if (args.type!=_VECT)
1170 return symbolic(at_fcoeff,args);
1171 vecteur & v=*args._VECTptr;
1172 if ( (v.size()!=2) || (v.front().type!=_VECT) ){
1173 p=v;
1174 x=vx_var;
1175 }
1176 else {
1177 p=*v.front()._VECTptr;
1178 x=v.back();
1179 }
1180 if (x.type!=_IDNT)
1181 return gentypeerr(contextptr);
1182 const_iterateur it=p.begin(),itend=p.end();
1183 if ( (itend-it)%2 )
1184 return gensizeerr(contextptr);
1185 gen res(plus_one);
1186 for (;it!=itend;it+=2){
1187 res=res*pow(x-*it,*(it+1),contextptr);
1188 }
1189 return res;
1190 }
1191 static const char _fcoeff_s []="fcoeff";
1192 static define_unary_function_eval (__fcoeff,&_fcoeff,_fcoeff_s);
1193 define_unary_function_ptr5( at_fcoeff ,alias_at_fcoeff,&__fcoeff,0,true);
1194
addfactors(const gen & p,const gen & x,int mult,vecteur & res,GIAC_CONTEXT)1195 static void addfactors(const gen & p,const gen & x,int mult,vecteur & res,GIAC_CONTEXT){
1196 vecteur v=sqff_factors(p,contextptr); // factors(p,x,contextptr);
1197 const_iterateur it=v.begin(),itend=v.end();
1198 for (;it!=itend;){
1199 vecteur w=solve(*it,x,1,contextptr);
1200 ++it;
1201 int n=it->val;
1202 ++it;
1203 const_iterateur jt=w.begin(),jtend=w.end();
1204 for (;jt!=jtend;++jt){
1205 res.push_back(*jt);
1206 res.push_back(n*mult);
1207 }
1208 }
1209 }
1210
_froot(const gen & args,GIAC_CONTEXT)1211 gen _froot(const gen & args,GIAC_CONTEXT){
1212 if ( args.type==_STRNG && args.subtype==-1) return args;
1213 gen p,x;
1214 if (args.type!=_VECT){
1215 x=vx_var;
1216 p=args;
1217 }
1218 else {
1219 vecteur & v=*args._VECTptr;
1220 if (v.size()!=2)
1221 return gensizeerr(contextptr);
1222 x=v.back();
1223 if (x.type!=_IDNT)
1224 return gensizeerr(gettext("2nd arg"));
1225 p=v.front();
1226 }
1227 vecteur lv(lvar(p));
1228 gen aa=e2r(p,lv,contextptr),aan,aad;
1229 fxnd(aa,aan,aad);
1230 vecteur res;
1231 addfactors(r2e(aan,lv,contextptr),x,1,res,contextptr);
1232 addfactors(r2e(aad,lv,contextptr),x,-1,res,contextptr);
1233 return res;
1234 }
1235
1236 static const char _froot_s []="froot";
1237 static define_unary_function_eval (__froot,&_froot,_froot_s);
1238 define_unary_function_ptr5( at_froot ,alias_at_froot,&__froot,0,true);
1239
_roots(const gen & g_,GIAC_CONTEXT)1240 gen _roots(const gen & g_,GIAC_CONTEXT){
1241 if ( g_.type==_STRNG && g_.subtype==-1) return g_;
1242 gen eq=0;
1243 gen g(g_);
1244 if (g.type==_VECT && g._VECTptr->size()==3 && g._VECTptr->back()==at_equal && g.subtype==_SEQ__VECT){
1245 eq=(*g._VECTptr)[1];
1246 g=makesequence(g._VECTptr->front(),eq);
1247 }
1248 gen r=_froot(g,contextptr);
1249 if (r.type!=_VECT || (r._VECTptr->size() % 2) )
1250 return gensizeerr(contextptr);
1251 vecteur & v = *r._VECTptr;
1252 vecteur res;
1253 int s=int(v.size()/2);
1254 for (int i=0;i<s;++i){
1255 if (v[2*i+1].val>0)
1256 res.push_back(makevecteur(eq==0?v[2*i]:symb_equal(eq,v[2*i]),v[2*i+1]));
1257 }
1258 return res;
1259 }
1260 static const char _roots_s []="roots";
1261 static define_unary_function_eval (__roots,&_roots,_roots_s);
1262 define_unary_function_ptr5( at_roots ,alias_at_roots,&__roots,0,true);
1263
_divpc(const gen & args,GIAC_CONTEXT)1264 gen _divpc(const gen & args,GIAC_CONTEXT){
1265 if ( args.type==_STRNG && args.subtype==-1) return args;
1266 gen p,q,x;
1267 if (args.type!=_VECT)
1268 return symbolic(at_divpc,args);
1269 vecteur & v=*args._VECTptr;
1270 int s=int(v.size());
1271 if (s<3)
1272 return gensizeerr(contextptr);
1273 p=v.front();
1274 q=v[1];
1275 if (v[2].type!=_INT_)
1276 return gensizeerr(contextptr);
1277 if (s==3)
1278 x=vx_var;
1279 else
1280 x=v.back();
1281 vecteur lv(1,x);
1282 lvar(p,lv);
1283 lvar(q,lv);
1284 gen aa=e2r(p,lv,contextptr),aan,aad;
1285 fxnd(aa,aan,aad);
1286 gen ba=e2r(q,lv,contextptr),ban,bad;
1287 fxnd(ba,ban,bad);
1288 if ( ( aad.type==_POLY && aad._POLYptr->lexsorted_degree())
1289 || (bad.type==_POLY && bad._POLYptr->lexsorted_degree())
1290 )
1291 return gensizeerr(contextptr);
1292 if (ban.type!=_POLY)
1293 return r2e(rdiv(aan*bad,ban*aad,contextptr),lv,contextptr);
1294 vecteur a;
1295 if (aan.type==_POLY)
1296 a=polynome2poly1(*aan._POLYptr,1);
1297 else
1298 a=vecteur(1,aan);
1299 vecteur b=polynome2poly1(*ban._POLYptr,1);
1300 if (is_zero(b.back()))
1301 divisionby0err(q);
1302 reverse(a.begin(),a.end());
1303 reverse(b.begin(),b.end());
1304 int n=int(b.size()-a.size())+v[2].val;
1305 for (int i=0;i<n;++i)
1306 a.push_back(zero);
1307 vecteur quo,rem;
1308 environment * env=new environment;
1309 DivRem(a,b,env,quo,rem);
1310 delete env;
1311 reverse(quo.begin(),quo.end());
1312 gen res(vecteur2polynome(quo,int(lv.size())));
1313 res=rdiv(res*bad,aad,contextptr);
1314 return r2e(res,lv,contextptr);
1315 }
1316
1317 static const char _divpc_s []="divpc";
1318 static define_unary_function_eval (__divpc,&_divpc,_divpc_s);
1319 define_unary_function_ptr5( at_divpc ,alias_at_divpc,&__divpc,0,true);
1320
_ptayl(const gen & args,GIAC_CONTEXT)1321 gen _ptayl(const gen & args,GIAC_CONTEXT){
1322 if ( args.type==_STRNG && args.subtype==-1) return args;
1323 gen p,q,x;
1324 if (args.type!=_VECT){
1325 p=_POLY1__VECT;
1326 p.subtype=_INT_MAPLECONVERSION;
1327 return _series(makesequence(args,p),contextptr);
1328 }
1329 vecteur v=*args._VECTptr;
1330 int s=int(v.size());
1331 if (s<2)
1332 return gensizeerr(contextptr);
1333 if (s>3 || v[1].is_symb_of_sommet(at_equal) || (s==3 && v[2].type==_INT_)){
1334 p=_POLY1__VECT;
1335 p.subtype=_INT_MAPLECONVERSION;
1336 v.push_back(p);
1337 return _series(gen(v,_SEQ__VECT),contextptr);
1338 }
1339 p=v.front();
1340 q=v[1];
1341 if (p.type==_VECT)
1342 return taylor(*p._VECTptr,q,0);
1343 if (s==2)
1344 x=vx_var;
1345 else
1346 x=v.back();
1347 if (is_integral(x)){
1348 p=_POLY1__VECT;
1349 p.subtype=_INT_MAPLECONVERSION;
1350 v.push_back(p);
1351 return _series(makesequence(gen(v,_SEQ__VECT)),contextptr);
1352 }
1353 if (!is_zero(derive(q,x,contextptr)))
1354 return gensizeerr(contextptr);
1355 vecteur lv(1,x);
1356 lvar(p,lv);
1357 lvar(q,lv);
1358 gen aa=e2r(p,lv,contextptr),aan,aad;
1359 fxnd(aa,aan,aad);
1360 if ( ( (aad.type==_POLY)&&(aad._POLYptr->lexsorted_degree()) )
1361 )
1362 return gensizeerr(contextptr);
1363 if (aan.type!=_POLY)
1364 return p;
1365 gen ba=e2r(q,vecteur(lv.begin()+1,lv.end()),contextptr);
1366 vecteur a(polynome2poly1(*aan._POLYptr,1));
1367 vecteur res=taylor(a,ba,0);
1368 return r2e(vecteur2polynome(res,int(lv.size())),lv,contextptr)/r2e(aad,lv,contextptr);
1369 }
1370
1371 static const char _ptayl_s []="ptayl";
1372 static define_unary_function_eval (__ptayl,&_ptayl,_ptayl_s);
1373 define_unary_function_ptr5( at_ptayl ,alias_at_ptayl,&__ptayl,0,true);
1374
gen2continued_fraction(const gen & g,int n,GIAC_CONTEXT)1375 vecteur gen2continued_fraction(const gen & g,int n,GIAC_CONTEXT){
1376 // Compute a vector of size n+1 with last element=remainder
1377 vecteur res,remain;
1378 gen tmp(g),f;
1379 #ifndef HAVE_LIBMPFR
1380 if (!alg_lvar(tmp).empty())
1381 tmp=evalf_double(tmp,1,contextptr);
1382 #endif
1383 int i=0,j;
1384 for (;i<n;++i){
1385 if ( (j=equalposcomp(remain,tmp)) ){
1386 // int s=remain.size();
1387 res.push_back(vecteur(res.begin()+j-1,res.end()));
1388 return res;
1389 }
1390 else
1391 remain.push_back(tmp);
1392 f=_floor(tmp,0);
1393 res.push_back(f);
1394 if (is_zero(tmp-f))
1395 return res;
1396 tmp=normal(inv(tmp-f,contextptr),contextptr);
1397 }
1398 res.push_back(tmp);
1399 return res;
1400 }
_dfc(const gen & g_orig,GIAC_CONTEXT)1401 gen _dfc(const gen & g_orig,GIAC_CONTEXT){
1402 if ( g_orig.type==_STRNG && g_orig.subtype==-1) return g_orig;
1403 gen g=g_orig;
1404 if (g.type==_FRAC){
1405 gen tmp=_floor(g,contextptr);
1406 vecteur res(1,tmp);
1407 g -= tmp;
1408 for (;!is_zero(g);){
1409 g = inv(g,contextptr);
1410 tmp = _floor(g,contextptr);
1411 res.push_back(tmp);
1412 g -=tmp;
1413 }
1414 return res;
1415 }
1416 double eps=epsilon(contextptr);
1417 if (g.type==_VECT && g._VECTptr->size()==2){
1418 gen gf=evalf_double(g._VECTptr->back(),1,contextptr);
1419 if (is_integral(gf))
1420 return gen2continued_fraction(g._VECTptr->front(),gf.val,contextptr);
1421 if (gf.type==_DOUBLE_){
1422 eps=gf._DOUBLE_val;
1423 g=evalf_double(g._VECTptr->front(),1,contextptr);
1424 }
1425 }
1426 g=evalf_double(g,1,contextptr);
1427 if (g.type!=_DOUBLE_)
1428 return gensizeerr(contextptr);
1429 return vector_int_2_vecteur(float2continued_frac(g._DOUBLE_val,eps));
1430 }
1431 static const char _dfc_s []="dfc";
1432 static define_unary_function_eval (__dfc,&_dfc,_dfc_s);
1433 define_unary_function_ptr5( at_dfc ,alias_at_dfc,&__dfc,0,true);
1434
_dfc2f(const gen & g,GIAC_CONTEXT)1435 gen _dfc2f(const gen & g,GIAC_CONTEXT){
1436 if ( g.type==_STRNG && g.subtype==-1) return g;
1437 if (g.type!=_VECT || g._VECTptr->empty())
1438 return gensizeerr(contextptr);
1439 vecteur v =(*g._VECTptr);
1440 gen res(v.back());
1441 if (v.back().type==_VECT){
1442 // represent a quadratic x=[... x], find equation
1443 identificateur tmp(" x");
1444 gen eq(tmp);
1445 const_iterateur it=v.back()._VECTptr->end()-1,itend=v.back()._VECTptr->begin()-1;
1446 for (;it!=itend;--it)
1447 eq=inv(eq,contextptr)+(*it);
1448 vecteur w=solve(eq-tmp,tmp,0,contextptr);
1449 gen ws=_sort(w,0);
1450 if (ws.type!=_VECT || ws._VECTptr->empty())
1451 return gensizeerr(contextptr);
1452 res=ws._VECTptr->back();
1453 }
1454 for (;;){
1455 v.pop_back();
1456 if (v.empty())
1457 return res;
1458 res=inv(res,contextptr);
1459 res=res+v.back();
1460 }
1461 // return continued_frac2gen(vecteur_2_vector_int(*g._VECTptr),nan(),epsilon);
1462 }
1463 static const char _dfc2f_s []="dfc2f";
1464 static define_unary_function_eval (__dfc2f,&_dfc2f,_dfc2f_s);
1465 define_unary_function_ptr5( at_dfc2f ,alias_at_dfc2f,&__dfc2f,0,true);
1466
float2rational(double d_orig,double eps,GIAC_CONTEXT)1467 gen float2rational(double d_orig,double eps,GIAC_CONTEXT){
1468 double d=d_orig;
1469 if (d<0)
1470 return -float2rational(-d,eps,contextptr);
1471 if (d>RAND_MAX)
1472 return d; // reconstruct
1473 vector<int> v(float2continued_frac(d,eps));
1474 return continued_frac2gen(v,d_orig,eps,contextptr);
1475 }
_float2rational(const gen & g,GIAC_CONTEXT)1476 gen _float2rational(const gen & g,GIAC_CONTEXT){
1477 if ( g.type==_STRNG && g.subtype==-1) return g;
1478 switch (g.type){
1479 case _DOUBLE_:
1480 return float2rational(g._DOUBLE_val,epsilon(contextptr),contextptr);
1481 case _REAL:
1482 return float2rational(evalf_double(g,1,contextptr)._DOUBLE_val,epsilon(contextptr),contextptr);
1483 case _CPLX:
1484 return _float2rational(re(g,contextptr),contextptr)+cst_i*_float2rational(im(g,contextptr),contextptr);
1485 case _SYMB:
1486 return symbolic(g._SYMBptr->sommet,_float2rational(g._SYMBptr->feuille,contextptr));
1487 case _VECT:
1488 return apply(g,_float2rational,contextptr);
1489 default:
1490 return g;
1491 }
1492 }
1493 static const char _float2rational_s []="float2rational";
1494 static define_unary_function_eval (__float2rational,&_float2rational,_float2rational_s);
1495 define_unary_function_ptr5( at_float2rational ,alias_at_float2rational,&__float2rational,0,true);
1496
_fmod(const gen & g,GIAC_CONTEXT)1497 gen _fmod(const gen & g,GIAC_CONTEXT){
1498 if (g.type==_STRNG && g.subtype==-1) return g;
1499 if (g.type!=_VECT || g.subtype!=_SEQ__VECT || g._VECTptr->size()!=2)
1500 return gensizeerr(contextptr);
1501 const gen & a=g._VECTptr->front(),b=g._VECTptr->back();
1502 if (a.type==_DOUBLE_ && b.type==_DOUBLE_)
1503 return a._DOUBLE_val-std::floor(a._DOUBLE_val/b._DOUBLE_val)*b._DOUBLE_val;
1504 return a-_floor(a/b,contextptr)*b;
1505 }
1506 static const char _fmod_s []="fmod";
1507 static define_unary_function_eval (__fmod,&_fmod,_fmod_s);
1508 define_unary_function_ptr5( at_fmod ,alias_at_fmod,&__fmod,0,true);
1509
_gramschmidt(const gen & g,GIAC_CONTEXT)1510 gen _gramschmidt(const gen & g,GIAC_CONTEXT){
1511 if ( g.type==_STRNG && g.subtype==-1) return g;
1512 if (g.type!=_VECT)
1513 return symbolic(at_gramschmidt,g);
1514 vecteur & v(*g._VECTptr);
1515 if (ckmatrix(v))
1516 return gramschmidt(v,true,contextptr);
1517 if (v.size()==2){
1518 gen lvect=v[0];
1519 gen scalaire=v[1];
1520 if (scalaire.type==_INT_ && ckmatrix(lvect))
1521 return gramschmidt(*lvect._VECTptr,scalaire.val,contextptr);
1522 if (lvect.type!=_VECT)
1523 return gensizeerr(contextptr);
1524 vecteur lv=*lvect._VECTptr;
1525 int s=int(lv.size());
1526 if (!s)
1527 return lv;
1528 vecteur sc(1,scalaire(gen(makevecteur(lv[0],lv[0]),_SEQ__VECT),contextptr));
1529 for (int i=1;i<s;++i){
1530 gen cl;
1531 for (int j=0;j<i;++j){
1532 gen tmp=rdiv(scalaire(gen(makevecteur(lv[i],lv[j]),_SEQ__VECT),contextptr),sc[j],contextptr)*lv[j];
1533 cl=cl+tmp;
1534 }
1535 lv[i]=lv[i]-cl;
1536 sc.push_back(scalaire(gen(makevecteur(lv[i],lv[i]),_SEQ__VECT),contextptr));
1537 }
1538 for (int i=0;i<s;++i)
1539 lv[i]=rdiv(lv[i],sqrt(sc[i],contextptr),contextptr);
1540 return lv;
1541 }
1542 return gensizeerr(contextptr);
1543 }
1544 static const char _gramschmidt_s []="gramschmidt";
1545 static define_unary_function_eval (__gramschmidt,&_gramschmidt,_gramschmidt_s);
1546 define_unary_function_ptr5( at_gramschmidt ,alias_at_gramschmidt,&__gramschmidt,0,true);
1547
aplatir(const matrice & m,vecteur & v,bool full)1548 void aplatir(const matrice & m,vecteur & v,bool full){
1549 int s=int(m.size());
1550 if (!full){
1551 v.clear();
1552 v.reserve(2*s);
1553 }
1554 const_iterateur it=m.begin(),itend=m.end(),jt,jtend;
1555 for (;it!=itend;++it){
1556 if (it->type!=_VECT || it->subtype==_GGB__VECT)
1557 v.push_back(*it);
1558 else {
1559 if (full){
1560 aplatir(*it->_VECTptr,v,full);
1561 continue;
1562 }
1563 jt=it->_VECTptr->begin(),jtend=it->_VECTptr->end();
1564 for (;jt!=jtend;++jt)
1565 v.push_back(*jt);
1566 }
1567 }
1568 }
1569
change_scale2(vecteur & v,const gen & g)1570 static void change_scale2(vecteur & v,const gen & g){
1571 gen l(g);
1572 for (unsigned i=1;i<v.size();++i){
1573 v[i]=v[i]/l;
1574 l=g*l;
1575 }
1576 }
1577
1578 /*
1579 gen exptorootof(const gen & g,GIAC_CONTEXT){
1580 gen h=ratnormal(g/cst_two_pi/cst_i,contextptr);
1581 if (h.type!=_FRAC || h._FRACptr->num.type!=_INT_ || h._FRACptr->den.type!=_INT_)
1582 return symbolic(at_exp,g);
1583 int n=h._FRACptr->num.val,d=h._FRACptr->den.val;
1584 n=n%d;
1585 if (d<0){ d=-d; n=-n; }
1586 vecteur v=cyclotomic(d);
1587 vecteur w(absint(n)+1);
1588 w[0]=1;
1589 w=w%v;
1590 h=symbolic(at_rootof,makesequence(w,v));
1591 if (n>0)
1592 return h;
1593 return inv(h,contextptr);
1594 }
1595 const gen_op_context exp2rootof_tab[]={exptorootof,0};
1596 gen exp2rootof(const gen & g,GIAC_CONTEXT){
1597 return subst(g,exp_tab,exp2rootof_tab,false,contextptr);
1598 }
1599 gen _exp2rootof(const gen & args,GIAC_CONTEXT){
1600 if ( args.type==_STRNG && args.subtype==-1) return args;
1601 gen var,res;
1602 if (is_algebraic_program(args,var,res))
1603 return symbolic(at_program,makesequence(var,0,_exp2rootof(res,contextptr)));
1604 if (is_equal(args))
1605 return apply_to_equal(args,_exp2rootof,contextptr);
1606 return exp2rootof(args,contextptr);
1607 }
1608 static const char _exp2rootof_s []="exp2rootof";
1609 static define_unary_function_eval (__exp2rootof,&_exp2rootof,_exp2rootof_s);
1610 define_unary_function_ptr5( at_exp2rootof ,alias_at_exp2rootof,&__exp2rootof,0,true);
1611 */
1612
pmin(const matrice & m,GIAC_CONTEXT)1613 static gen pmin(const matrice & m,GIAC_CONTEXT){
1614 int s=int(m.size());
1615 matrice mpow(midn(s));
1616 matrice res;
1617 vecteur v;
1618 for (int i=0;i<=s;++i){
1619 if (is_zero(mpow)){
1620 vecteur w(i+1);
1621 w[0]=1;
1622 return w;
1623 }
1624 aplatir(mpow,v);
1625 v.push_back(pow(vx_var,i));
1626 res.push_back(v);
1627 mpow=mmult(mpow,m);
1628 }
1629 matrice r;
1630 gen det;
1631 mrref(res,r,v,det,0,s+1,0,s*s,
1632 /* fullreduction */0,1,true,1,0,
1633 contextptr);
1634 // find 1st line with zeros (except in the last col)
1635 const_iterateur it=r.begin(),itend=r.end();
1636 for (;it!=itend;++it){
1637 if (is_zero(vecteur(it->_VECTptr->begin(),it->_VECTptr->end()-1)))
1638 break;
1639 }
1640 if (it==itend)
1641 return gensizeerr(contextptr);
1642 gen t= _e2r(makesequence(it->_VECTptr->back(),vx_var),contextptr);
1643 if (t.type==_VECT)
1644 return gen(t/lgcd(*t._VECTptr),_POLY1__VECT);
1645 else
1646 return t;
1647 }
_pmin(const gen & g,GIAC_CONTEXT)1648 gen _pmin(const gen & g,GIAC_CONTEXT){
1649 if ( g.type==_STRNG && g.subtype==-1) return g;
1650 if (is_squarematrix(g)){
1651 matrice &m =*g._VECTptr;
1652 vecteur w;
1653 gen p=m[0][0];
1654 if (p.type==_USER){
1655 std_matrix<gen> M;
1656 matrice2std_matrix_gen(m,M);
1657 mod_pcar(M,w,true);
1658 return gen(w,_POLY1__VECT);
1659 }
1660 if (p.type==_MOD && (p._MODptr+1)->type==_INT_){
1661 gen mg=unmod(m);
1662 if (mg.type==_VECT){
1663 matrice M=*mg._VECTptr;
1664 vector< vector<int> > N;
1665 int modulo=(p._MODptr+1)->val;
1666 bool krylov=true;
1667 vector<int> res;
1668 if (mod_pcar(M,N,modulo,krylov,res,contextptr,true)){
1669 vector_int2vecteur(res,w);
1670 return makemod(gen(w,_POLY1__VECT),modulo);
1671 // environment env; w=modularize(w,modulo,&env);
1672 // return gen(w,_POLY1__VECT);
1673 }
1674 }
1675 }
1676 if (is_integer_matrice(m)){
1677 w=mpcar_int(m,true,contextptr,true);
1678 return gen(w,_POLY1__VECT);
1679 }
1680 if (poly_pcar_interp(m,w,true,contextptr))
1681 return gen(w,_POLY1__VECT);
1682 if (proba_epsilon(contextptr) && probabilistic_pmin(m,w,true,contextptr))
1683 return gen(w,_POLY1__VECT);
1684 return pmin(m,contextptr);
1685 }
1686 if (is_integer(g) || g.type==_MOD)
1687 return gen(makevecteur(1,-g),_POLY1__VECT);
1688 // if (g.type==_FRAC) return gen(makevecteur(g._FRACptr->den,-g._FRACptr->num),_POLY1__VECT);
1689 if (is_cinteger(g) && g.type==_CPLX){
1690 gen a=*g._CPLXptr,b=*(g._CPLXptr+1);
1691 // z=(a+i*b), (z-a)^2=-b^2
1692 return gen(makevecteur(1,-2*a,a*a+b*b),_POLY1__VECT);
1693 }
1694 if (g.type==_FRAC)
1695 return gen(makevecteur(g._FRACptr->den,-g._FRACptr->num),_POLY1__VECT);
1696 if (g.type==_USER){
1697 #ifndef NO_RTTI
1698 if (galois_field * gf=dynamic_cast<galois_field *>(g._USERptr)){
1699 if (gf->a.type!=_VECT || gf->P.type!=_VECT || !is_integer(gf->p))
1700 return gensizeerr("Bad GF element");
1701 environment env;
1702 env.modulo=gf->p;
1703 env.pn=env.modulo;
1704 env.moduloon=true;
1705 // compute 1,a,a^2,...,a^n in lines then transpose and find ker
1706 int n=int(gf->P._VECTptr->size())-1;
1707 vecteur & A=*gf->a._VECTptr;
1708 vecteur current(1,1),suivant,temp;
1709 matrice m(n+1);
1710 m[0]=vecteur(n);
1711 m[0]._VECTptr->front()=1;
1712 // put constant term in first column (row) to avoid cancellation problems
1713 for (int i=1;i<=n;++i){
1714 mulmodpoly(current,A,&env,temp);
1715 suivant=operator_mod(temp,*gf->P._VECTptr,&env);
1716 m[i]=new ref_vecteur(n);
1717 for (unsigned j=0;j<suivant.size();++j){
1718 (*m[i]._VECTptr)[j]=makemod(suivant[suivant.size()-1-j],gf->p);
1719 }
1720 swap(current,suivant);
1721 }
1722 vecteur noyau;
1723 m=mtran(m);
1724 mker(m,noyau,0,contextptr);
1725 if (noyau.empty() || noyau.front().type!=_VECT)
1726 return gensizeerr("Internal error, no relation found");
1727 temp=*noyau.front()._VECTptr;
1728 for (;!temp.empty() && is_zero(temp.back());)
1729 temp.pop_back();
1730 reverse(temp.begin(),temp.end());
1731 mulmodpoly(temp,inv(temp.front(),contextptr),0,temp);
1732 return gen(temp,_POLY1__VECT);
1733 }
1734 #endif
1735 }
1736 if (g.type==_EXT)
1737 return minimal_polynomial(g,true,contextptr);
1738 if (g.type!=_VECT){
1739 gen g_(g);
1740 //if (!lop(g_,at_exp).empty())
1741 g_=cossinexp2rootof(g_,contextptr,32767);
1742 vecteur v=alg_lvar(g_);
1743 if (v.size()==1 && v.front().type==_VECT && v.front()._VECTptr->empty()){
1744 gen tmp=e2r(g_,v,contextptr);
1745 gen d=1;
1746 if (tmp.type==_FRAC){
1747 d=tmp._FRACptr->den;
1748 tmp=tmp._FRACptr->num;
1749 if (d.type==_CPLX){
1750 tmp=tmp*conj(d,contextptr);
1751 d=d*conj(d,contextptr);
1752 }
1753 }
1754 if (tmp.type==_POLY && tmp._POLYptr->dim==0)
1755 tmp=tmp._POLYptr->coord.front().value;
1756 if (tmp.type==_EXT){
1757 if (has_i(*tmp._EXTptr)){
1758 gen r,i;
1759 reim(tmp,r,i,contextptr);
1760 tmp=r+algebraic_EXTension(makevecteur(1,0),makevecteur(1,0,1))*i;
1761 while (tmp.type==_FRAC){
1762 d=d*tmp._FRACptr->den;
1763 tmp=tmp._FRACptr->num;
1764 }
1765 }
1766 tmp=minimal_polynomial(tmp,true,contextptr);
1767 if (tmp.type!=_VECT)
1768 return gensizeerr(contextptr);
1769 vecteur v=*tmp._VECTptr;
1770 change_scale2(v,d);
1771 return gen(v,_POLY1__VECT);
1772 }
1773 }
1774 }
1775 if (g.type!=_VECT || g._VECTptr->size()!=2)
1776 return symbolic(at_pmin,g);
1777 vecteur & v(*g._VECTptr);
1778 if (!is_squarematrix(v.front())){
1779 gen res=_pmin(v.front(),contextptr);
1780 if (res.type==_VECT)
1781 return symb_horner(*res._VECTptr,v.back());
1782 return gensizeerr(contextptr);
1783 }
1784 matrice &m=*v.front()._VECTptr;
1785 // probabilistic minimal polynomial
1786 vecteur w;
1787 if (proba_epsilon(contextptr) &&probabilistic_pmin(m,w,true,contextptr))
1788 return symb_horner(w,v.back());
1789 else
1790 return _r2e(gen(makevecteur(_pmin(m,contextptr),v.back()),_SEQ__VECT),contextptr);
1791 }
1792 static const char _pmin_s []="pmin";
1793 static define_unary_function_eval (__pmin,&_pmin,_pmin_s);
1794 define_unary_function_ptr5( at_pmin ,alias_at_pmin,&__pmin,0,true);
1795
fastpow(const gen & a,const gen & k_,GIAC_CONTEXT)1796 gen fastpow(const gen & a,const gen & k_,GIAC_CONTEXT){
1797 gen a2k(a),res(1),k(k_);
1798 while (k!=0){
1799 if (k.type==_ZINT){
1800 int m=modulo(*k._ZINTptr,2);
1801 if (m%2)
1802 res=res*a2k;
1803 k=(k-m)/2;
1804 }
1805 else {
1806 if (k.val % 2)
1807 res=res*a2k;
1808 k.val /= 2;
1809 }
1810 a2k=a2k*a2k;
1811 }
1812 return res;
1813 }
1814
1815 // multiplicative order of g, a divisor of mult
order(const gen & g,const gen & mult,GIAC_CONTEXT)1816 gen order(const gen &g,const gen & mult,GIAC_CONTEXT){
1817 vecteur v=ifactors(mult,contextptr);
1818 gen o(mult);
1819 int s=v.size();
1820 for (int i=0;i<s/2;++i){
1821 gen n(v[2*i]);
1822 gen m(v[2*i+1]);
1823 for (;m.val;--m.val){
1824 gen o1(o/n);
1825 gen chk=fastpow(g,o1,contextptr);
1826 if (!is_one(chk))
1827 break;
1828 o=o1;
1829 }
1830 }
1831 return o;
1832 }
1833
_order(const gen & g,GIAC_CONTEXT)1834 gen _order(const gen & g,GIAC_CONTEXT){
1835 if ( g.type==_STRNG && g.subtype==-1) return g;
1836 if (is_squarematrix(g)){
1837 matrice &m =*g._VECTptr;
1838 if (!mker(m,contextptr).empty())
1839 return gensizeerr(gettext("Not invertible"));
1840 gen m00=m[0][0],extdeg,p;
1841 if (m00.type==_USER){
1842 #ifndef NO_RTTI
1843 if (galois_field * gf=dynamic_cast<galois_field *>(m00._USERptr)){
1844 if (gf->a.type!=_VECT || gf->P.type!=_VECT || !is_integer(gf->p))
1845 return gensizeerr("Bad GF element");
1846 extdeg=gf->P._VECTptr->size()-1;
1847 p=gf->p;
1848 // a divisor of the lcm of gf->p^(n*degree)-1 for degree of irred factors of pmin
1849 }
1850 #endif
1851 }
1852 if (m00.type==_MOD){
1853 p=*(m00._MODptr+1);
1854 if (!is_probab_prime_p(p))
1855 return gensizeerr("0 or prime characteristic required");
1856 // a divisor of the lcm of p^degree-1 for degree of irred factors of pmin
1857 extdeg=1;
1858 }
1859 if (extdeg!=0){
1860 gen tmp=_pmin(makesequence(g,vx_var),contextptr);
1861 tmp=_factors(tmp,contextptr);
1862 if (tmp.type==_VECT){
1863 const vecteur & v=*tmp._VECTptr;
1864 gen res=1;
1865 for (int i=0;i<v.size()/2;++i){
1866 int m=v[2*i+1].val;
1867 gen o=pow(p,extdeg*_degree(v[2*i],contextptr),contextptr)-1;
1868 res=lcm(res,o);
1869 if (m>0)
1870 res=lcm(res,p);
1871 }
1872 return res;
1873 }
1874 }
1875 }
1876 if (g.type==_MOD){
1877 gen a=*g._MODptr,n=*(g._MODptr+1);
1878 if (!is_one(gcd(a,n,contextptr)))
1879 return gensizeerr(gettext("Not invertible"));
1880 gen p=euler(n,contextptr);
1881 return order(g,p,contextptr);
1882 }
1883 if (g.type==_USER){
1884 if (is_zero(g))
1885 return gensizeerr(gettext("Not invertible"));
1886 #ifndef NO_RTTI
1887 if (galois_field * gf=dynamic_cast<galois_field *>(g._USERptr)){
1888 if (gf->a.type!=_VECT || gf->P.type!=_VECT || !is_integer(gf->p))
1889 return gensizeerr("Bad GF element");
1890 // a divisor of gf->p^n-1
1891 return order(g,pow(gf->p,gf->P._VECTptr->size()-1,contextptr)-1,contextptr);
1892 }
1893 #endif
1894 }
1895 return undef;
1896 }
1897 static const char _order_s []="order";
1898 static define_unary_function_eval (__order,&_order,_order_s);
1899 define_unary_function_ptr5( at_order ,alias_at_order,&__order,0,true);
1900
1901 // a faire: vpotential, signtab
_potential(const gen & g,GIAC_CONTEXT)1902 gen _potential(const gen & g,GIAC_CONTEXT){
1903 if ( g.type==_STRNG && g.subtype==-1) return g;
1904 if ( (g.type!=_VECT) || (g._VECTptr->size()!=2) )
1905 return symbolic(at_potential,g);
1906 vecteur v(plotpreprocess(g,contextptr));
1907 if (is_undef(v))
1908 return v;
1909 gen f=v[0];
1910 gen x=v[1];
1911 if ( (f.type!=_VECT) || (x.type!=_VECT) )
1912 return gensizeerr(contextptr);
1913 vecteur & fv=*f._VECTptr;
1914 vecteur & xv=*x._VECTptr;
1915 int s=int(fv.size());
1916 if (unsigned(s)!=xv.size())
1917 return gendimerr(contextptr);
1918 for (int i=0;i<s;++i){
1919 for (int j=i+1;j<s;++j){
1920 if (!is_zero(simplify(derive(fv[i],xv[j],contextptr)-derive(fv[j],xv[i],contextptr),contextptr)))
1921 return gensizeerr(gettext("Not a potential"));
1922 }
1923 }
1924 gen res;
1925 for (int i=0;i<s;++i){
1926 res=res+integrate_gen(simplify(fv[i]-derive(res,xv[i],contextptr),contextptr),xv[i],contextptr);
1927 }
1928 return res;
1929 }
1930 static const char _potential_s []="potential";
1931 static define_unary_function_eval_quoted (__potential,&_potential,_potential_s);
1932 define_unary_function_ptr5( at_potential ,alias_at_potential,&__potential,_QUOTE_ARGUMENTS,true);
1933
_vpotential(const gen & g,GIAC_CONTEXT)1934 gen _vpotential(const gen & g,GIAC_CONTEXT){
1935 if ( g.type==_STRNG && g.subtype==-1) return g;
1936 if ( (g.type!=_VECT) || (g._VECTptr->size()!=2) )
1937 return symbolic(at_vpotential,g);
1938 vecteur v(plotpreprocess(g,contextptr));
1939 if (is_undef(v))
1940 return v;
1941 gen f=v[0];
1942 gen x=v[1];
1943 if ( (f.type!=_VECT) || (x.type!=_VECT) )
1944 return gensizeerr(contextptr);
1945 vecteur & fv=*f._VECTptr;
1946 vecteur & xv=*x._VECTptr;
1947 unsigned int s=unsigned(fv.size());
1948 if ( (s!=3) || (s!=xv.size()) )
1949 return gendimerr(contextptr);
1950 if (!is_zero(simplify(_divergence(g,contextptr),contextptr)))
1951 return gensizeerr(gettext("Not a vector potential"));
1952 vecteur res(3);
1953 /* return A0=0, A1=int[B_2,x0], A2=-int[B_1,x0]+F(x1,x2)
1954 * where F=int[B0+d_2[int[B_2,x0]]+d_1[int[B_1,x0]],x1]
1955 * F does not depend on x0 since divergence[B]=0 */
1956 res[1]=integrate_gen(fv[2],xv[0],contextptr);
1957 res[2]=integrate_gen(fv[1],xv[0],contextptr);
1958 gen F=simplify(fv[0]+derive(res[1],xv[2],contextptr)+derive(res[2],xv[1],contextptr),contextptr);
1959 F=integrate_gen(F,xv[1],contextptr);
1960 res[2]=F-res[2];
1961 return res;
1962 }
1963 static const char _vpotential_s []="vpotential";
1964 static define_unary_function_eval_quoted (__vpotential,&_vpotential,_vpotential_s);
1965 define_unary_function_ptr5( at_vpotential ,alias_at_vpotential,&__vpotential,_QUOTE_ARGUMENTS,true);
1966
_poly2symb(const gen & g,GIAC_CONTEXT)1967 gen _poly2symb(const gen & g,GIAC_CONTEXT){
1968 if ( g.type==_STRNG && g.subtype==-1) return g;
1969 if (g.type==_VECT && g.subtype!=_SEQ__VECT)
1970 return _r2e(gen(makevecteur(g,vx_var),_SEQ__VECT),contextptr);
1971 return _r2e(g,contextptr);
1972 }
1973 static const char _poly2symb_s []="poly2symb";
1974 static define_unary_function_eval (__poly2symb,&_poly2symb,_poly2symb_s);
1975 define_unary_function_ptr5( at_poly2symb ,alias_at_poly2symb,&__poly2symb,0,true);
1976
_symb2poly(const gen & g,GIAC_CONTEXT)1977 gen _symb2poly(const gen & g,GIAC_CONTEXT){
1978 if ( g.type==_STRNG && g.subtype==-1) return g;
1979 return _e2r(g,contextptr);
1980 }
1981 static const char _symb2poly_s []="symb2poly";
1982 static define_unary_function_eval (__symb2poly,&_symb2poly,_symb2poly_s);
1983 define_unary_function_ptr5( at_symb2poly ,alias_at_symb2poly,&__symb2poly,0,true);
1984
_exp2trig(const gen & g,GIAC_CONTEXT)1985 gen _exp2trig(const gen & g,GIAC_CONTEXT){
1986 if ( g.type==_STRNG && g.subtype==-1) return g;
1987 return _sincos(g,contextptr);
1988 }
1989 static const char _exp2trig_s []="exp2trig";
1990 static define_unary_function_eval (__exp2trig,&_exp2trig,_exp2trig_s);
1991 define_unary_function_ptr5( at_exp2trig ,alias_at_exp2trig,&__exp2trig,0,true);
1992
_nrows(const gen & g,GIAC_CONTEXT)1993 gen _nrows(const gen & g,GIAC_CONTEXT){
1994 if ( g.type==_STRNG && g.subtype==-1) return g;
1995 if (!ckmatrix(g))
1996 return gensizeerr(contextptr);
1997 return int(g._VECTptr->size());
1998 }
1999 static const char _nrows_s []="nrows";
2000 static define_unary_function_eval (__nrows,&_nrows,_nrows_s);
2001 define_unary_function_ptr5( at_nrows ,alias_at_nrows,&__nrows,0,true);
2002
_ncols(const gen & g,GIAC_CONTEXT)2003 gen _ncols(const gen & g,GIAC_CONTEXT){
2004 if ( g.type==_STRNG && g.subtype==-1) return g;
2005 if (!ckmatrix(g))
2006 return gensizeerr(contextptr);
2007 if (g._VECTptr->empty())
2008 return zero;
2009 return int(g._VECTptr->front()._VECTptr->size());
2010 }
2011 static const char _ncols_s []="ncols";
2012 static define_unary_function_eval (__ncols,&_ncols,_ncols_s);
2013 define_unary_function_ptr5( at_ncols ,alias_at_ncols,&__ncols,0,true);
2014
_l2norm(const gen & g0,GIAC_CONTEXT)2015 gen _l2norm(const gen & g0,GIAC_CONTEXT){
2016 if ( g0.type==_STRNG && g0.subtype==-1) return g0;
2017 gen g=remove_at_pnt(g0);
2018 if (g.type==_VECT && g.subtype==_VECTOR__VECT && g._VECTptr->size()==2)
2019 g=g._VECTptr->back()-g._VECTptr->front();
2020 if (g.type!=_VECT)
2021 return abs(g,contextptr);
2022 vecteur v;
2023 if (g._VECTptr->size()==2 && g._VECTptr->front().type==_VECT && g._VECTptr->back()==at_vector){
2024 aplatir(*g._VECTptr->front()._VECTptr,v);
2025 return l2norm(v,contextptr);
2026 }
2027 if (ckmatrix(g)){
2028 gen tmp=_SVL(g,contextptr);
2029 if (tmp.type==_VECT && tmp._VECTptr->size()==2 && tmp._VECTptr->back().type==_VECT)
2030 tmp=tmp._VECTptr->back();
2031 return _max(tmp,contextptr);
2032 }
2033 v=*g._VECTptr;
2034 return l2norm(v,contextptr);
2035 }
2036 static const char _l2norm_s []="l2norm";
2037 static define_unary_function_eval (__l2norm,&_l2norm,_l2norm_s);
2038 define_unary_function_ptr5( at_l2norm ,alias_at_l2norm,&__l2norm,0,true);
2039
2040 static const char _norm_s []="norm";
2041 static define_unary_function_eval (__norm,&_l2norm,_norm_s);
2042 define_unary_function_ptr5( at_norm ,alias_at_norm,&__norm,0,true);
2043
_normalize(const gen & a,GIAC_CONTEXT)2044 gen _normalize(const gen & a,GIAC_CONTEXT){
2045 if ( a.type==_STRNG && a.subtype==-1) return a;
2046 return a/_l2norm(a,contextptr);
2047 }
2048 static const char _normalize_s []="normalize";
2049 static define_unary_function_eval (__normalize,&_normalize,_normalize_s);
2050 define_unary_function_ptr5( at_normalize ,alias_at_normalize,&__normalize,0,true);
2051
2052 static const char _randmatrix_s []="randmatrix";
2053 static define_unary_function_eval (__randmatrix,&_ranm,_randmatrix_s);
2054 define_unary_function_ptr5( at_randmatrix ,alias_at_randmatrix,&__randmatrix,0,true);
2055
2056 extern const unary_function_ptr * const at_lgcd;
_lgcd(const gen & args,GIAC_CONTEXT)2057 gen _lgcd(const gen & args,GIAC_CONTEXT){
2058 if ( args.type==_STRNG && args.subtype==-1) return args;
2059 if (args.type!=_VECT)
2060 return symbolic(at_lgcd,args);
2061 return lgcd(*args._VECTptr);
2062 }
2063 static const char _lgcd_s []="lgcd";
2064 static define_unary_function_eval (__lgcd,&_lgcd,_lgcd_s);
2065 define_unary_function_ptr5( at_lgcd ,alias_at_lgcd,&__lgcd,0,true);
2066
2067 // synonyms
_float(const gen & g,GIAC_CONTEXT)2068 gen _float(const gen & g,GIAC_CONTEXT){
2069 if ( g.type==_STRNG && g.subtype==-1) return g;
2070 gen g_=g;
2071 if (g.type==_STRNG)
2072 g_=gen(*g._STRNGptr,contextptr);
2073 return evalf(g_,1,contextptr);
2074 }
2075 static const char _float_s []="float";
2076 static define_unary_function_eval (__float,&_float,_float_s);
2077 define_unary_function_ptr5( at_float ,alias_at_float,&__float,0,true);
2078
_build_complex(const gen & g,GIAC_CONTEXT)2079 gen _build_complex(const gen & g,GIAC_CONTEXT){
2080 if ( g.type==_STRNG && g.subtype==-1) return g;
2081 if (g.type==_VECT && g._VECTptr->size()==2)
2082 return gen(g._VECTptr->front(),g._VECTptr->back());
2083 if (g.type==_STRNG)
2084 return gen(*g._STRNGptr,contextptr);
2085 return g;
2086 }
2087 static const char _build_complex_s []="complex";
2088 static define_unary_function_eval (__build_complex,&_build_complex,_build_complex_s);
2089 define_unary_function_ptr5( at_complex ,alias_at_build_complex,&__build_complex,0,true);
2090
_hold(const gen & g,GIAC_CONTEXT)2091 gen _hold(const gen & g,GIAC_CONTEXT){
2092 if ( g.type==_STRNG && g.subtype==-1) return g;
2093 return g;
2094 }
2095 static const char _hold_s []="hold";
2096 static define_unary_function_eval_quoted (__hold,&_hold,_hold_s);
2097 define_unary_function_ptr5( at_hold ,alias_at_hold,&__hold,_QUOTE_ARGUMENTS,true);
2098
_eigenvals(const gen & g,GIAC_CONTEXT)2099 gen _eigenvals(const gen & g,GIAC_CONTEXT){
2100 if ( g.type==_STRNG && g.subtype==-1) return g;
2101 if (!is_squarematrix(g))
2102 return gendimerr(contextptr);
2103 bool b=complex_mode(contextptr);
2104 complex_mode(true,contextptr);
2105 matrice m;
2106 vecteur d;
2107 if (!egv(*g._VECTptr,m,d,contextptr,false,false,true))
2108 *logptr(contextptr) << gettext("Low accuracy") << '\n';
2109 complex_mode(b,contextptr);
2110 return gen(d,_SEQ__VECT);
2111 }
2112 static const char _eigenvals_s []="eigenvals";
2113 static define_unary_function_eval (__eigenvals,&_eigenvals,_eigenvals_s);
2114 define_unary_function_ptr5( at_eigenvals ,alias_at_eigenvals,&__eigenvals,0,true);
2115
2116 static const char _giackernel_s []="kernel";
2117 static define_unary_function_eval (__giackernel,&_ker,_giackernel_s);
2118 define_unary_function_ptr5( at_kernel ,alias_at_kernel,&__giackernel,0,true);
2119
_eigenvects(const gen & g,GIAC_CONTEXT)2120 gen _eigenvects(const gen & g,GIAC_CONTEXT){
2121 if ( g.type==_STRNG && g.subtype==-1) return g;
2122 bool b=complex_mode(contextptr);
2123 complex_mode(true,contextptr);
2124 gen res=_egv(g,contextptr);
2125 complex_mode(b,contextptr);
2126 return res;
2127 }
2128 static const char _eigenvects_s []="eigenvects";
2129 static define_unary_function_eval (__eigenvects,&_eigenvects,_eigenvects_s);
2130 define_unary_function_ptr5( at_eigenvects ,alias_at_eigenvects,&__eigenvects,0,true);
2131
2132 static const char _eigenvalues_s []="eigenvalues";
2133 static define_unary_function_eval (__eigenvalues,&_eigenvals,_eigenvalues_s);
2134 define_unary_function_ptr5( at_eigenvalues ,alias_at_eigenvalues,&__eigenvalues,0,true);
2135
_charpoly(const gen & args,GIAC_CONTEXT)2136 gen _charpoly(const gen & args,GIAC_CONTEXT){
2137 string s;
2138 if (is_graphe(args.subtype==_SEQ__VECT?args._VECTptr->front():args,s,contextptr))
2139 return _graph_charpoly(args,contextptr);
2140 return _pcar(args,contextptr);
2141 }
2142 static const char _charpoly_s []="charpoly";
2143 static define_unary_function_eval (__charpoly,&_charpoly,_charpoly_s);
2144 define_unary_function_ptr5( at_charpoly ,alias_at_charpoly,&__charpoly,0,true);
2145
2146 static const char _eigenvectors_s []="eigenvectors";
2147 static define_unary_function_eval (__eigenvectors,&_eigenvects,_eigenvectors_s);
2148 define_unary_function_ptr5( at_eigenvectors ,alias_at_eigenvectors,&__eigenvectors,0,true);
2149
2150 static const char _rowdim_s []="rowdim";
2151 static define_unary_function_eval (__rowdim,&_nrows,_rowdim_s);
2152 define_unary_function_ptr5( at_rowdim ,alias_at_rowdim,&__rowdim,0,true);
2153
2154 static const char _coldim_s []="coldim";
2155 static define_unary_function_eval (__coldim,&_ncols,_coldim_s);
2156 define_unary_function_ptr5( at_coldim ,alias_at_coldim,&__coldim,0,true);
2157
2158 static const char _multiply_s []="multiply";
2159 static define_unary_function_eval (__multiply,&_prod,_multiply_s);
2160 define_unary_function_ptr5( at_multiply ,alias_at_multiply,&__multiply,0,true);
2161
2162 /* Maple inert forms */
_Gcd(const gen & g,GIAC_CONTEXT)2163 gen _Gcd(const gen & g,GIAC_CONTEXT){
2164 if ( g.type==_STRNG && g.subtype==-1) return g;
2165 return symbolic(at_gcd,g);
2166 }
2167 static const char _Gcd_s []="Gcd";
2168 static define_unary_function_eval (__Gcd,&_Gcd,_Gcd_s);
2169 define_unary_function_ptr5( at_Gcd ,alias_at_Gcd,&__Gcd,0,true);
2170
_Gcdex(const gen & g,GIAC_CONTEXT)2171 gen _Gcdex(const gen & g,GIAC_CONTEXT){
2172 if ( g.type==_STRNG && g.subtype==-1) return g;
2173 return symbolic(at_gcdex,g);
2174 }
2175 static const char _Gcdex_s []="Gcdex";
2176 static define_unary_function_eval (__Gcdex,&_Gcdex,_Gcdex_s);
2177 define_unary_function_ptr5( at_Gcdex ,alias_at_Gcdex,&__Gcdex,0,true);
2178
_Factor(const gen & g,GIAC_CONTEXT)2179 gen _Factor(const gen & g,GIAC_CONTEXT){
2180 if ( g.type==_STRNG && g.subtype==-1) return g;
2181 return symbolic(at_factor,g);
2182 }
2183 static const char _Factor_s []="Factor";
2184 static define_unary_function_eval (__Factor,&_Factor,_Factor_s);
2185 define_unary_function_ptr5( at_Factor ,alias_at_Factor,&__Factor,0,true);
2186
_Rref(const gen & g,GIAC_CONTEXT)2187 gen _Rref(const gen & g,GIAC_CONTEXT){
2188 if ( g.type==_STRNG && g.subtype==-1) return g;
2189 return symbolic(at_rref,g);
2190 }
2191 static const char _Rref_s []="Rref";
2192 static define_unary_function_eval (__Rref,&_Rref,_Rref_s);
2193 define_unary_function_ptr5( at_Rref ,alias_at_Rref,&__Rref,0,true);
2194
_Rank(const gen & g,GIAC_CONTEXT)2195 gen _Rank(const gen & g,GIAC_CONTEXT){
2196 if ( g.type==_STRNG && g.subtype==-1) return g;
2197 return symbolic(at_rank,g);
2198 }
2199 static const char _Rank_s []="Rank";
2200 static define_unary_function_eval (__Rank,&_Rank,_Rank_s);
2201 define_unary_function_ptr5( at_Rank ,alias_at_Rank,&__Rank,0,true);
2202
_Det(const gen & g,GIAC_CONTEXT)2203 gen _Det(const gen & g,GIAC_CONTEXT){
2204 if ( g.type==_STRNG && g.subtype==-1) return g;
2205 return symbolic(at_det,g);
2206 }
2207 static const char _Det_s []="Det";
2208 static define_unary_function_eval (__Det,&_Det,_Det_s);
2209 define_unary_function_ptr5( at_Det ,alias_at_Det,&__Det,0,true);
2210
_Quo(const gen & g,GIAC_CONTEXT)2211 gen _Quo(const gen & g,GIAC_CONTEXT){
2212 if ( g.type==_STRNG && g.subtype==-1) return g;
2213 return symbolic(at_quo,g);
2214 }
2215 static const char _Quo_s []="Quo";
2216 static define_unary_function_eval (__Quo,&_Quo,_Quo_s);
2217 define_unary_function_ptr5( at_Quo ,alias_at_Quo,&__Quo,0,true);
2218
_Rem(const gen & g,GIAC_CONTEXT)2219 gen _Rem(const gen & g,GIAC_CONTEXT){
2220 if ( g.type==_STRNG && g.subtype==-1) return g;
2221 return symbolic(at_rem,g);
2222 }
2223 static const char _Rem_s []="Rem";
2224 static define_unary_function_eval (__Rem,&_Rem,_Rem_s);
2225 define_unary_function_ptr5( at_Rem ,alias_at_Rem,&__Rem,0,true);
2226
_Int(const gen & g,GIAC_CONTEXT)2227 gen _Int(const gen & g,GIAC_CONTEXT){
2228 if ( g.type==_STRNG && g.subtype==-1) return g;
2229 return symbolic(at_integrate,g);
2230 }
2231 static const char _Int_s []="Int";
2232 static define_unary_function_eval (__Int,&_Int,_Int_s);
2233 define_unary_function_ptr5( at_Int ,alias_at_Int,&__Int,0,true);
2234
_divisors(const gen & g,GIAC_CONTEXT)2235 gen _divisors(const gen & g,GIAC_CONTEXT){
2236 if ( g.type==_STRNG && g.subtype==-1) return g;
2237 gen res=_idivis(g,contextptr);
2238 if (res.type==_VECT) res.subtype=_SET__VECT;
2239 return res;
2240 }
2241 static const char _divisors_s []="divisors";
2242 static define_unary_function_eval (__divisors,&_divisors,_divisors_s);
2243 define_unary_function_ptr5( at_divisors ,alias_at_divisors,&__divisors,0,true);
2244
_maxnorm(const gen & g0,GIAC_CONTEXT)2245 gen _maxnorm(const gen & g0,GIAC_CONTEXT){
2246 if ( g0.type==_STRNG && g0.subtype==-1) return g0;
2247 gen g=remove_at_pnt(g0);
2248 if (g.type==_VECT && g.subtype==_VECTOR__VECT)
2249 g=vector2vecteur(*g._VECTptr);
2250 return linfnorm(g,contextptr);
2251 }
2252 static const char _maxnorm_s []="maxnorm";
2253 static define_unary_function_eval (__maxnorm,&_maxnorm,_maxnorm_s);
2254 define_unary_function_ptr5( at_maxnorm ,alias_at_maxnorm,&__maxnorm,0,true);
2255
l1norm(const vecteur & v,GIAC_CONTEXT)2256 gen l1norm(const vecteur & v,GIAC_CONTEXT){
2257 gen res;
2258 const_iterateur it=v.begin(),itend=v.end();
2259 for (;it!=itend;++it)
2260 res=res+linfnorm(*it,contextptr);
2261 return res;
2262 }
2263
_l1norm(const gen & g0,GIAC_CONTEXT)2264 gen _l1norm(const gen & g0,GIAC_CONTEXT){
2265 if ( g0.type==_STRNG && g0.subtype==-1) return g0;
2266 gen g=remove_at_pnt(g0);
2267 if (g.type==_VECT && g.subtype==_VECTOR__VECT)
2268 g=vector2vecteur(*g._VECTptr);
2269 if (g.type!=_VECT)
2270 return linfnorm(g,contextptr);
2271 if (g._VECTptr->size()==2 && g._VECTptr->front().type==_VECT && g._VECTptr->back()==at_vector){
2272 vecteur v;
2273 aplatir(*g._VECTptr->front()._VECTptr,v);
2274 return l1norm(v,contextptr);
2275 }
2276 if (ckmatrix(g))
2277 return _rowNorm(mtran(*g._VECTptr),contextptr);
2278 return l1norm(*g._VECTptr,contextptr);
2279 }
2280 static const char _l1norm_s []="l1norm";
2281 static define_unary_function_eval (__l1norm,&_l1norm,_l1norm_s);
2282 define_unary_function_ptr5( at_l1norm ,alias_at_l1norm,&__l1norm,0,true);
2283
_linfnorm(const gen & g0,GIAC_CONTEXT)2284 gen _linfnorm(const gen & g0,GIAC_CONTEXT){
2285 if ( g0.type==_STRNG && g0.subtype==-1) return g0;
2286 gen g=remove_at_pnt(g0);
2287 if (g.type==_VECT && g.subtype==_VECTOR__VECT)
2288 g=vector2vecteur(*g._VECTptr);
2289 if (g.type!=_VECT)
2290 return linfnorm(g,contextptr);
2291 if (g._VECTptr->size()==2 && g._VECTptr->front().type==_VECT && g._VECTptr->back()==at_vector){
2292 vecteur v;
2293 aplatir(*g._VECTptr->front()._VECTptr,v);
2294 return linfnorm(v,contextptr);
2295 }
2296 if (ckmatrix(g))
2297 return _rowNorm(g,contextptr);
2298 return linfnorm(*g._VECTptr,contextptr);
2299 }
2300 static const char _linfnorm_s []="linfnorm";
2301 static define_unary_function_eval (__linfnorm,&_linfnorm,_linfnorm_s);
2302 define_unary_function_ptr5( at_linfnorm ,alias_at_linfnorm,&__linfnorm,0,true);
2303
_frobenius_norm(const gen & g0,GIAC_CONTEXT)2304 gen _frobenius_norm(const gen & g0,GIAC_CONTEXT){
2305 if ( g0.type==_STRNG && g0.subtype==-1) return g0;
2306 gen g=remove_at_pnt(g0);
2307 if (g.type==_VECT && g.subtype==_VECTOR__VECT)
2308 g=vector2vecteur(*g._VECTptr);
2309 vecteur v;
2310 if (ckmatrix(g))
2311 aplatir(*g._VECTptr,v);
2312 else
2313 v=*g._VECTptr;
2314 return l2norm(v,contextptr);
2315 }
2316 static const char _frobenius_norm_s []="frobenius_norm";
2317 static define_unary_function_eval (__frobenius_norm,&_frobenius_norm,_frobenius_norm_s);
2318 define_unary_function_ptr5( at_frobenius_norm ,alias_at_frobenius_norm,&__frobenius_norm,0,true);
2319
_matrix_norm(const gen & g0,GIAC_CONTEXT)2320 gen _matrix_norm(const gen & g0,GIAC_CONTEXT){
2321 if ( g0.type==_STRNG && g0.subtype==-1) return g0;
2322 if (g0.type!=_VECT || g0._VECTptr->empty())
2323 return gentypeerr(contextptr);
2324 if (g0._VECTptr->back()==0){
2325 gen g=g0._VECTptr->front();
2326 if (!ckmatrix(g))
2327 return _linfnorm(g,contextptr);
2328 vecteur & v =*g._VECTptr;
2329 gen res=0;
2330 for (unsigned i=0;i<v.size();++i){
2331 res=max(res,linfnorm(v[i],contextptr),contextptr);
2332 }
2333 return res;
2334 }
2335 if (g0._VECTptr->back()==1)
2336 return _l1norm(g0._VECTptr->front(),contextptr);
2337 if (g0._VECTptr->back()==2)
2338 return _l2norm(g0._VECTptr->front(),contextptr);
2339 if (is_inf(g0._VECTptr->back()))
2340 return _linfnorm(g0._VECTptr->front(),contextptr);
2341 return _frobenius_norm(g0,contextptr);
2342 }
2343 static const char _matrix_norm_s []="matrix_norm";
2344 static define_unary_function_eval (__matrix_norm,&_matrix_norm,_matrix_norm_s);
2345 define_unary_function_ptr5( at_matrix_norm ,alias_at_matrix_norm,&__matrix_norm,0,true);
2346
_dotprod(const gen & g,GIAC_CONTEXT)2347 gen _dotprod(const gen & g,GIAC_CONTEXT){
2348 if ( g.type==_STRNG && g.subtype==-1) return g;
2349 if ( (g.type!=_VECT) || (g._VECTptr->size()!=2))
2350 return gentypeerr(contextptr);
2351 vecteur v=*g._VECTptr;
2352 if (v[0].type==_VECT && v[1].type==_VECT)
2353 return scalarproduct(*v[0]._VECTptr,*v[1]._VECTptr,contextptr);
2354 return dotvecteur(v[0],v[1]);
2355 }
2356 static const char _dotprod_s []="dotprod";
2357 static define_unary_function_eval (__dotprod,&_dotprod,_dotprod_s);
2358 define_unary_function_ptr5( at_dotprod ,alias_at_dotprod,&__dotprod,0,true);
2359
2360 static const char _crossproduct_s []="crossproduct";
2361 static define_unary_function_eval (__crossproduct,&_cross,_crossproduct_s);
2362 define_unary_function_ptr5( at_crossproduct ,alias_at_crossproduct,&__crossproduct,0,true);
2363
_diag(const gen & g,GIAC_CONTEXT)2364 gen _diag(const gen & g,GIAC_CONTEXT){
2365 if ( g.type==_STRNG && g.subtype==-1) return g;
2366 if (g.type!=_VECT || g._VECTptr->empty())
2367 return gensizeerr(contextptr);
2368 vecteur v=*g._VECTptr;
2369 int l=int(v.size());
2370 if (l==2){
2371 if (ckmatrix(v[0])){
2372 if (v[1]==at_left){
2373 matrice m=*v[0]._VECTptr,res;
2374 int n=int(m.size());
2375 res.reserve(n);
2376 for (int i=0;i<n;++i){
2377 vecteur v=*m[i]._VECTptr;
2378 int s=int(v.size());
2379 for (int j=i+1;j<s;++j)
2380 v[j]=0;
2381 res.push_back(v);
2382 }
2383 return res;
2384 }
2385 if (v[1]==at_right){
2386 matrice m=*v[0]._VECTptr,res;
2387 int n=int(m.size());
2388 res.reserve(n);
2389 for (int i=0;i<n;++i){
2390 vecteur v=*m[i]._VECTptr;
2391 for (int j=0;j<i;++j)
2392 v[j]=0;
2393 res.push_back(v);
2394 }
2395 return res;
2396 }
2397 if (v[1]==at_lu){
2398 matrice m=*v[0]._VECTptr,resl,resu,diag;
2399 int n=int(m.size());
2400 resl.reserve(n); resu.reserve(n);
2401 for (int i=0;i<n;++i){
2402 vecteur v=*m[i]._VECTptr;
2403 diag.push_back(v[i]);
2404 for (int j=0;j<=i;++j)
2405 v[j]=0;
2406 resu.push_back(v);
2407 v=*m[i]._VECTptr;
2408 int s=int(v.size());
2409 for (int j=i;j<s;++j)
2410 v[j]=0;
2411 resl.push_back(v);
2412 }
2413 return makesequence(resl,diag,resu);
2414 }
2415 if (is_integral(v[1]) && v[1].type==_INT_){
2416 // sub diagonal extraction
2417 int shift=v[1].val;
2418 const vecteur & V = *v[0]._VECTptr;
2419 const_iterateur it=V.begin();
2420 int vs=int(V.size());
2421 vecteur res;
2422 for (int i=giacmax(0,-shift);i<vs;++i){
2423 const vecteur & ligne=*V[i]._VECTptr;
2424 if (i+shift>=ligne.size())
2425 break;
2426 res.push_back(ligne[i+shift]);
2427 }
2428 return res;
2429 }
2430 }// if (ckmatrix(v[0])
2431 else {
2432 if (v[1].is_symb_of_sommet(at_equal))
2433 v[1]=v[1]._SYMBptr->feuille[1];
2434 if (v[0].type==_VECT &&is_integral(v[1]) && v[1].type==_INT_){
2435 int shift=v[1].val;
2436 const vecteur & V = *v[0]._VECTptr;
2437 const_iterateur it=V.begin();
2438 int vs=int(V.size());
2439 int ts=vs+absint(shift);
2440 vecteur res(ts);
2441 for (int i=0;i<ts;++i){
2442 vecteur ligne(ts);
2443 int j=i+shift;
2444 if (j>=0 && j<ts){
2445 ligne[j]=*it;
2446 ++it;
2447 }
2448 res[i]=ligne;
2449 }
2450 return gen(res,_MATRIX__VECT);
2451 }
2452 }
2453 }
2454 if (l==3 && v[0].type==_VECT && v[1].type==_VECT && v[2].type==_VECT && v[0]._VECTptr->size()+1==v[1]._VECTptr->size() && v[0]._VECTptr->size()==v[2]._VECTptr->size() ){
2455 vecteur & l=*v[0]._VECTptr;
2456 vecteur & d=*v[1]._VECTptr;
2457 vecteur & u=*v[2]._VECTptr;
2458 int n=int(d.size());
2459 matrice res(n);
2460 for (int i=0;i<n;++i){
2461 vecteur w(n);
2462 if (i)
2463 w[i-1]=l[i-1];
2464 w[i]=d[i];
2465 if (i<n-1)
2466 w[i+1]=u[i];
2467 res[i]=w;
2468 }
2469 return res;
2470 }
2471 if (is_squarematrix(v)){
2472 vecteur res(l);
2473 for (int i=0;i<l;++i)
2474 res[i]=v[i][i];
2475 return res;
2476 }
2477 if (ckmatrix(v)){
2478 if (l==1 && v[0].type==_VECT){
2479 v=*v[0]._VECTptr;
2480 }
2481 else
2482 v=*mtran(v)[0]._VECTptr;
2483 }
2484 l=int(v.size());
2485 matrice res;
2486 if (l && ckmatrix(v.front()) ){
2487 int s=0,r=0;
2488 for (int i=0;i<l;++i){
2489 if (!is_squarematrix(v[i]))
2490 return gentypeerr(contextptr);
2491 s += int(v[i]._VECTptr->size());
2492 }
2493 for (int i=0;i<l;++i){
2494 vecteur & current=*v[i]._VECTptr;
2495 int c=int(current.size());
2496 for (int j=0;j<c;++j){
2497 vecteur tmp(r);
2498 vecteur & currentj=*current[j]._VECTptr;
2499 for (int k=0;k<c;++k){
2500 tmp.push_back(currentj[k]);
2501 }
2502 for (int k=c+r;k<s;++k)
2503 tmp.push_back(zero);
2504 res.push_back(tmp);
2505 }
2506 r += c;
2507 }
2508 return res;
2509 }
2510 for (int i=0;i<l;++i){
2511 vecteur tmp(i);
2512 tmp.push_back(v[i]);
2513 res.push_back(mergevecteur(tmp,vecteur(l-1-i)));
2514 }
2515 return res;
2516 }
2517 static const char _diag_s []="diag";
2518 static define_unary_function_eval (__diag,&_diag,_diag_s);
2519 define_unary_function_ptr5( at_diag ,alias_at_diag,&__diag,0,true);
2520
2521 static const char _BlockDiagonal_s []="BlockDiagonal";
2522 static define_unary_function_eval (__BlockDiagonal,&_diag,_BlockDiagonal_s);
2523 define_unary_function_ptr5( at_BlockDiagonal ,alias_at_BlockDiagonal,&__BlockDiagonal,0,true);
2524
_input(const gen & args,GIAC_CONTEXT)2525 gen _input(const gen & args,GIAC_CONTEXT){
2526 #ifdef KHICAS
2527 #ifdef NUMWORKS
2528 const char * s=mp_hal_input("?") ;
2529 if (s)
2530 return string2gen(s,false);
2531 #else
2532 std::string S;
2533 const char * prompt = args.type==_STRNG?args._STRNGptr->c_str():"?";
2534 inputline(prompt,0,S,false,194,contextptr);
2535 *logptr(contextptr) << prompt << S << '\n';
2536 return string2gen(S,false);
2537 string s;
2538 #endif
2539 #else // KHICAS
2540 if (interactive_op_tab && interactive_op_tab[0])
2541 return interactive_op_tab[0](args,contextptr);
2542 if ( args.type==_STRNG && args.subtype==-1) return args;
2543 return _input(args,false,contextptr);
2544 #endif
2545 }
2546 static const char _input_s []="input";
2547 #ifdef RTOS_THREADX
2548 // const unary_function_eval __input(0,(const gen_op_context)_input,_input_s);
2549 define_unary_function_eval_quoted(__input,(const gen_op_context)_input,_input_s);
2550 #else
2551 unary_function_eval __input(0,(const gen_op_context)_input,_input_s);
2552 #endif
2553 define_unary_function_ptr5( at_input ,alias_at_input,&__input,_QUOTE_ARGUMENTS,true);
2554
_textinput(const gen & args,GIAC_CONTEXT)2555 gen _textinput(const gen & args,GIAC_CONTEXT){
2556 if ( args.type==_STRNG && args.subtype==-1) return args;
2557 return _input(args,true,contextptr);
2558 }
2559 static const char _textinput_s []="textinput";
2560 static define_unary_function_eval_quoted (__textinput,&_textinput,_textinput_s);
2561 define_unary_function_ptr5( at_textinput ,alias_at_textinput,&__textinput,_QUOTE_ARGUMENTS,true);
2562
2563 static const char _f2nd_s []="f2nd";
2564 static define_unary_function_eval (__f2nd,&_fxnd,_f2nd_s);
2565 define_unary_function_ptr5( at_f2nd ,alias_at_f2nd,&__f2nd,0,true);
2566
2567 // service=-3 for content -2 for primpart -1 for coeff, degree for coeff
primpartcontent(const gen & g,int service,GIAC_CONTEXT)2568 static gen primpartcontent(const gen& g,int service,GIAC_CONTEXT){
2569 vecteur v;
2570 if (g.type==_VECT && g.subtype !=_SEQ__VECT){
2571 if (calc_mode(contextptr)==1)
2572 v=makevecteur(g,ggb_var(g));
2573 else
2574 v=makevecteur(g,vx_var);
2575 }
2576 else
2577 v=gen2vecteur(g);
2578 if (!v.empty() && v[0].type==_POLY)
2579 v.insert(v.begin()+1,vecteur(0));
2580 int s=int(v.size());
2581 if (s==2 && v[1].is_symb_of_sommet(at_pow)){
2582 gen & f = v[1]._SYMBptr->feuille;
2583 if (f.type==_VECT && f._VECTptr->size()==2 && f._VECTptr->back().type==_INT_){
2584 v[1]=f._VECTptr->front();
2585 service=f._VECTptr->back().val;
2586 }
2587 }
2588 if (s>=2 && v[1].type==_VECT){
2589 vecteur l(*v[1]._VECTptr);
2590 int outerdim=int(l.size());
2591 lvar(v[0],l);
2592 int innerdim=int(l.size())-outerdim;
2593 fraction f(1);
2594 if (v[0].type==_POLY)
2595 f.num=v[0];
2596 else
2597 f=sym2r(v[0],l,contextptr);
2598 vecteur ll(l.begin()+outerdim,l.end());
2599 if (f.num.type!=_POLY){
2600 if (service==-1){
2601 gen res=r2e(v[0],l,contextptr);
2602 if (s==3){
2603 if (is_zero(v[2]))
2604 return res;
2605 else
2606 return zero;
2607 }
2608 return makevecteur(res);
2609 }
2610 if (service==-2)
2611 return r2e(inv(f.den,contextptr),l,contextptr);
2612 if (service==-3)
2613 return r2e(f.num,l,contextptr);
2614 if (service==-4)
2615 return is_integer(f.num)?f.num:plus_one;
2616 return gensizeerr(contextptr);
2617 }
2618 if (service==-4)
2619 return Tcontent(*f.num._POLYptr);
2620 polynome & p_aplati=*f.num._POLYptr;
2621 polynome p=splitmultivarpoly(p_aplati,innerdim);
2622 vector< monomial<gen> >::const_iterator it=p.coord.begin(),itend=p.coord.end();
2623 vecteur coeffs;
2624 coeffs.reserve(itend-it);
2625 for (;it!=itend;++it)
2626 coeffs.push_back(it->value);
2627 if (service==-1){
2628 gen gden=r2e(f.den,l,contextptr);
2629 if (s==3 && v[2].type==_VECT){
2630 index_t ind;
2631 if (!vecteur2index(*v[2]._VECTptr,ind))
2632 return zero;
2633 index_m i(ind);
2634 it=p.coord.begin();
2635 for (;it!=itend;++it){
2636 if (it->index==i)
2637 return r2e(it->value,ll,contextptr)/gden;
2638 }
2639 return zero;
2640 }
2641 return r2e(coeffs,ll,contextptr)/gden;
2642 }
2643 if (service==-2){
2644 p=p/_lgcd(coeffs,contextptr);
2645 p=unsplitmultivarpoly(p,innerdim);
2646 return r2e(p/f.den,l,contextptr);
2647 }
2648 if (service==-3)
2649 return r2e(_lgcd(coeffs,contextptr),ll,contextptr);
2650 return gensizeerr(contextptr);
2651 }
2652 if (s!=1 && s!=2)
2653 return gensizeerr(contextptr);
2654 gen x(vx_var);
2655 if (calc_mode(contextptr)==1)
2656 x=ggb_var(v[0]);
2657 if (s==2)
2658 x=v[1];
2659 gen f(_e2r(gen(makevecteur(v[0],x),_SEQ__VECT),contextptr));
2660 gen deno(1);
2661 if (f.type==_FRAC){
2662 deno=f._FRACptr->den;
2663 f=f._FRACptr->num;
2664 }
2665 if (f.type!=_VECT){
2666 switch(service){
2667 case -1:
2668 return makevecteur(f)/deno;
2669 case -2:
2670 return plus_one;
2671 case -3:
2672 return f;
2673 case -4:
2674 return (is_integer(f)?f:plus_one)/(is_integer(deno)?deno:plus_one);
2675 default:
2676 if (service>0)
2677 return zero;
2678 else
2679 return f;
2680 }
2681 }
2682 switch (service){
2683 case -1:
2684 return f/deno;
2685 case -2:
2686 return symb_horner(*f._VECTptr/_lgcd(f,contextptr),x);
2687 case -3:
2688 return _lgcd(f,contextptr)/deno;
2689 case -4:
2690 f=_lgcd(f,contextptr);
2691 return _icontent(makesequence(f,lvar(f)),contextptr)/(is_integer(deno)?deno:plus_one);
2692 }
2693 vecteur & w=*f._VECTptr;
2694 int ss=int(w.size());
2695 if (service>=ss)
2696 return zero;
2697 return w[ss-service-1]/deno;
2698 }
_primpart(const gen & g,GIAC_CONTEXT)2699 gen _primpart(const gen & g,GIAC_CONTEXT){
2700 if ( g.type==_STRNG && g.subtype==-1) return g;
2701 return primpartcontent(g,-2,contextptr);
2702 }
2703 static const char _primpart_s []="primpart";
2704 static define_unary_function_eval (__primpart,&_primpart,_primpart_s);
2705 define_unary_function_ptr5( at_primpart ,alias_at_primpart,&__primpart,0,true);
2706
_content(const gen & g,GIAC_CONTEXT)2707 gen _content(const gen & g,GIAC_CONTEXT){
2708 if ( g.type==_STRNG && g.subtype==-1) return g;
2709 return primpartcontent(g,-3,contextptr);
2710 }
2711 static const char _content_s []="content";
2712 static define_unary_function_eval (__content,&_content,_content_s);
2713 define_unary_function_ptr5( at_content ,alias_at_content,&__content,0,true);
2714
_icontent(const gen & g,GIAC_CONTEXT)2715 gen _icontent(const gen & g,GIAC_CONTEXT){
2716 if ( g.type==_STRNG && g.subtype==-1) return g;
2717 return primpartcontent(g,-4,contextptr);
2718 }
2719 static const char _icontent_s []="icontent";
2720 static define_unary_function_eval (__icontent,&_icontent,_icontent_s);
2721 define_unary_function_ptr5( at_icontent ,alias_at_icontent,&__icontent,0,true);
2722
_coeff(const gen & g,GIAC_CONTEXT)2723 gen _coeff(const gen & g,GIAC_CONTEXT){
2724 if ( g.type==_STRNG && g.subtype==-1) return g;
2725 if (g.type==_USER){
2726 #ifndef NO_RTTI
2727 if (galois_field * gptr=dynamic_cast<galois_field *>(g._USERptr))
2728 return gptr->a;
2729 #endif
2730 }
2731 if (g.type==_VECT && !g._VECTptr->empty() &&
2732 (g._VECTptr->back().type==_INT_ || g._VECTptr->back().type==_DOUBLE_ || g._VECTptr->back().type==_FRAC)){
2733 vecteur v=*g._VECTptr;
2734 if (v.size()==2 && v.front().type==_SPOL1){
2735 const sparse_poly1 & s=*v.front()._SPOL1ptr;
2736 sparse_poly1::const_iterator it=s.begin(),itend=s.end();
2737 gen n=v.back();
2738 for (;it!=itend;++it){
2739 if (it->exponent==n)
2740 return it->coeff;
2741 if (is_greater(it->exponent,n,contextptr))
2742 return 0;
2743 }
2744 return undef;
2745 }
2746 is_integral(v.back());
2747 if (v.back().val<0)
2748 return gendimerr(contextptr);
2749 int n=absint(v.back().val);
2750 v.pop_back();
2751 if (v.size()==1 && v.front().type==_USER){
2752 #ifndef NO_RTTI
2753 if (galois_field * gptr=dynamic_cast<galois_field *>(v.front()._USERptr)){
2754 gen ga=gptr->a;
2755 if (ga.type==_VECT){
2756 int s=ga._VECTptr->size();
2757 if (n>=s)
2758 return 0;
2759 n=s-1-n;
2760 if (n>=0 && n<s)
2761 return ga[n];
2762 }
2763 return gendimerr(contextptr);
2764 }
2765 #endif
2766 }
2767 return primpartcontent(gen(v,g.subtype),n,contextptr);
2768 }
2769 if (xcas_mode(contextptr)==1 && g.type==_VECT && g._VECTptr->size()==2 && g._VECTptr->back().type==_IDNT){
2770 return primpartcontent(g,1,contextptr);
2771 }
2772 return primpartcontent(g,-1,contextptr);
2773 }
2774 static const char _coeff_s []="coeff";
2775 static define_unary_function_eval (__coeff,&_coeff,_coeff_s);
2776 define_unary_function_ptr5( at_coeff ,alias_at_coeff,&__coeff,0,true);
2777
2778 static const char _coeffs_s []="coeffs";
2779 static define_unary_function_eval (__coeffs,&_coeff,_coeffs_s);
2780 define_unary_function_ptr5( at_coeffs ,alias_at_coeffs,&__coeffs,0,true);
2781
2782 static const char _ichrem_s []="ichrem";
2783 static define_unary_function_eval (__ichrem,&_ichinrem,_ichrem_s);
2784 define_unary_function_ptr5( at_ichrem ,alias_at_ichrem,&__ichrem,0,true);
2785
_chrem(const gen & g,GIAC_CONTEXT)2786 gen _chrem(const gen & g,GIAC_CONTEXT){
2787 if ( g.type==_STRNG && g.subtype==-1) return g;
2788 if (!ckmatrix(g) || g._VECTptr->size()!=2)
2789 return gensizeerr(contextptr);
2790 matrice m=mtran(*g._VECTptr);
2791 const_iterateur it=m.begin(),itend=m.end();
2792 if (it==itend)
2793 return gensizeerr(contextptr);
2794 gen res=*it;
2795 for (++it;it!=itend;++it){
2796 res=_ichinrem(makesequence(res,*it),contextptr);
2797 }
2798 return res;
2799 }
2800 static const char _chrem_s []="chrem";
2801 static define_unary_function_eval (__chrem,&_chrem,_chrem_s);
2802 define_unary_function_ptr5( at_chrem ,alias_at_chrem,&__chrem,0,true);
2803
_genpoly(const gen & g,GIAC_CONTEXT)2804 gen _genpoly(const gen & g,GIAC_CONTEXT){
2805 if ( g.type==_STRNG && g.subtype==-1) return g;
2806 if (g.type!=_VECT || g._VECTptr->size()!=3)
2807 return gentypeerr(contextptr);
2808 vecteur & v=*g._VECTptr;
2809 gen n=v[0],b=v[1],x=v[2];
2810 if (b.type!=_INT_ && b.type!=_ZINT)
2811 return gentypeerr(contextptr);
2812 b=abs(b,contextptr);
2813 if (is_zero(b)||is_one(b))
2814 return gensizeerr(contextptr);
2815 vecteur l(lvar(n));
2816 fraction f(e2r(n,l,contextptr));
2817 if (is_integer(f.num))
2818 f.num=pzadic(polynome(f.num,0),b);
2819 else {
2820 if (f.num.type==_POLY)
2821 f.num=pzadic(*f.num._POLYptr,b);
2822 }
2823 if (is_integer(f.den))
2824 f.den=pzadic(polynome(f.den,0),b);
2825 else {
2826 if (f.den.type==_POLY)
2827 f.den=pzadic(*f.den._POLYptr,b);
2828 }
2829 l.insert(l.begin(),x);
2830 return r2e(f,l,contextptr);
2831 }
2832 static const char _genpoly_s []="genpoly";
2833 static define_unary_function_eval (__genpoly,&_genpoly,_genpoly_s);
2834 define_unary_function_ptr5( at_genpoly ,alias_at_genpoly,&__genpoly,0,true);
2835
freq_quantile(const matrice & v,double d,GIAC_CONTEXT)2836 static gen freq_quantile(const matrice & v,double d,GIAC_CONTEXT){
2837 if (!ckmatrix(v))
2838 return undef;
2839 matrice w;
2840 if (v.size()==2)
2841 w=mtran(v);
2842 else
2843 w=v;
2844 if (w.front()._VECTptr->size()!=2)
2845 return undef;
2846 // Row Sort (using row 1)
2847 gen_sort_f(w.begin(),w.end(),first_ascend_sort);
2848 w=mtran(w);
2849 // w[0]=data, w[1]=frequencies
2850 vecteur data=*w[0]._VECTptr;
2851 vecteur freq=*w[1]._VECTptr;
2852 gen sigma=d*prodsum(freq,false);
2853 if (is_undef(sigma)) return sigma;
2854 int s=int(freq.size());
2855 gen partial_sum;
2856 for (int i=0;i<s;++i){
2857 partial_sum=partial_sum+freq[i];
2858 if (!is_zero(partial_sum) && is_strictly_greater(partial_sum,sigma,contextptr))
2859 return data[i];
2860 if (partial_sum==sigma && i<s)
2861 return (i==s-1 || (calc_mode(contextptr)!=1 && abs_calc_mode(contextptr)!=38) )?data[i]:(data[i]+data[i+1])/2;
2862 }
2863 return undef;
2864 }
_median(const gen & g,GIAC_CONTEXT)2865 gen _median(const gen & g,GIAC_CONTEXT){
2866 if ( g.type==_STRNG && g.subtype==-1) return g;
2867 vecteur v(gen2vecteur(g));
2868 if (g.type==_VECT && g.subtype==_SEQ__VECT && v.size()==2)
2869 return freq_quantile(v,0.5,contextptr);
2870 if (!ckmatrix(v)){
2871 if (!is_fully_numeric(evalf(v,1,contextptr))){
2872 islesscomplexthanf_sort(v.begin(),v.end());
2873 return v[int(std::ceil(v.size()/2.0))-1]; // v[(v.size()-1)/4];
2874 }
2875 matrice mt=mtran(ascsort(mtran(vecteur(1,v)),true));
2876 if ( (calc_mode(contextptr)==1 || abs_calc_mode(contextptr)==38) && !v.empty() && !(v.size()%2))
2877 return (mt[v.size()/2][0]+mt[v.size()/2-1][0])/2;
2878 return mt[int(std::ceil(v.size()/2.0))-1][0];
2879 }
2880 else
2881 v=ascsort(v,true);
2882 v=mtran(v);
2883 if ( (calc_mode(contextptr)==1 || abs_calc_mode(contextptr)==38) && !v.empty() && !(v.size()%2))
2884 return (v[v.size()/2]+v[v.size()/2-1])/2;
2885 return v[int(std::ceil(v.size()/2.0))-1]; // v[(v.size()-1)/2];
2886 }
2887 static const char _median_s []="median";
2888 static define_unary_function_eval(unary_median,&_median,_median_s);
2889 define_unary_function_ptr5( at_median ,alias_at_median,&unary_median,0,true);
2890
_quartile1(const gen & g,GIAC_CONTEXT)2891 gen _quartile1(const gen & g,GIAC_CONTEXT){
2892 if ( g.type==_STRNG && g.subtype==-1) return g;
2893 vecteur v(gen2vecteur(g));
2894 if (g.type==_VECT && g.subtype==_SEQ__VECT && v.size()==2)
2895 return freq_quantile(v,0.25,contextptr);
2896 if (!ckmatrix(v)){
2897 if (!is_fully_numeric(evalf(v,1,contextptr))){
2898 islesscomplexthanf_sort(v.begin(),v.end());
2899 return v[int(std::ceil(v.size()/4.0))-1]; // v[(v.size()-1)/4];
2900 }
2901 return mtran(ascsort(mtran(vecteur(1,v)),true))[int(std::ceil(v.size()/4.0))-1][0];
2902 }
2903 else
2904 v=ascsort(v,true);
2905 v=mtran(v);
2906 return v[int(std::ceil(v.size()/4.0))-1]; // v[(v.size()-1)/4];
2907 }
2908 static const char _quartile1_s []="quartile1";
2909 static define_unary_function_eval(unary_quartile1,&_quartile1,_quartile1_s);
2910 define_unary_function_ptr5( at_quartile1 ,alias_at_quartile1,&unary_quartile1,0,true);
2911
_quartile3(const gen & g,GIAC_CONTEXT)2912 gen _quartile3(const gen & g,GIAC_CONTEXT){
2913 if ( g.type==_STRNG && g.subtype==-1) return g;
2914 vecteur v(gen2vecteur(g));
2915 if (g.type==_VECT && g.subtype==_SEQ__VECT && v.size()==2)
2916 return freq_quantile(v,0.75,contextptr);
2917 if (!ckmatrix(v)){
2918 if (!is_fully_numeric(evalf(v,1,contextptr))){
2919 islesscomplexthanf_sort(v.begin(),v.end());
2920 return v[int(std::ceil(3*v.size()/4.0))-1]; // v[(v.size()-1)/4];
2921 }
2922 return mtran(ascsort(mtran(vecteur(1,v)),true))[int(std::ceil(3*v.size()/4.0))-1][0];
2923 }
2924 else
2925 v=ascsort(v,true);
2926 v=mtran(v);
2927 return v[int(std::ceil(3*v.size()/4.0))-1]; // v[(3*(v.size()-1))/4];
2928 }
2929 static const char _quartile3_s []="quartile3";
2930 static define_unary_function_eval(unary_quartile3,&_quartile3,_quartile3_s);
2931 define_unary_function_ptr5( at_quartile3 ,alias_at_quartile3,&unary_quartile3,0,true);
2932
_quantile(const gen & g,GIAC_CONTEXT)2933 gen _quantile(const gen & g,GIAC_CONTEXT){
2934 if ( g.type==_STRNG && g.subtype==-1) return g;
2935 vecteur v(gen2vecteur(g));
2936 if (v.size()<2 || v.front().type!=_VECT)
2937 return gensizeerr(contextptr);
2938 if (g.type==_VECT && g.subtype==_SEQ__VECT && v.size()==3){
2939 gen tmp=evalf_double(v.back(),1,contextptr);
2940 if (tmp.type!=_DOUBLE_)
2941 return gensizeerr(contextptr);
2942 double d=tmp._DOUBLE_val;
2943 if (d<=0 || d>=1)
2944 return gendimerr(contextptr);
2945 return freq_quantile(makevecteur(v[0],v[1]),d,contextptr);
2946 }
2947 if (v.size()!=2)
2948 return gensizeerr(contextptr);
2949 bool vect=v.back().type==_VECT;
2950 vecteur w=gen2vecteur(v.back()),res;
2951 v=*v.front()._VECTptr;
2952 bool matrix=true;
2953 if (!ckmatrix(v)){
2954 matrix=false;
2955 if (!is_fully_numeric(evalf(v,1,contextptr))){
2956 islesscomplexthanf_sort(v.begin(),v.end());
2957 for (unsigned j=0;j<w.size();++j){
2958 gen tmp=evalf_double(w[j],1,contextptr);
2959 if (tmp.type!=_DOUBLE_ || tmp._DOUBLE_val<=0 || tmp._DOUBLE_val>=1)
2960 res.push_back(undef);
2961 else
2962 res.push_back(v[int(std::ceil(tmp._DOUBLE_val*v.size()))-1]);
2963 }
2964 return vect?res:res.front();
2965 }
2966 v=ascsort(mtran(vecteur(1,v)),true);
2967 }
2968 else
2969 v=ascsort(v,true);
2970 v=mtran(v);
2971 for (unsigned j=0;j<w.size();++j){
2972 gen tmp=evalf_double(w[j],1,contextptr);
2973 if (tmp.type!=_DOUBLE_ || tmp._DOUBLE_val<=0 || tmp._DOUBLE_val>=1)
2974 res.push_back(undef);
2975 else {
2976 gen data=v[int(std::ceil(tmp._DOUBLE_val*v.size()))-1];
2977 if (!matrix && data.type==_VECT && data._VECTptr->size()==1)
2978 data=data._VECTptr->front();
2979 res.push_back(data);
2980 }
2981 }
2982 return vect?res:res.front();
2983 }
2984 static const char _quantile_s []="quantile";
2985 static define_unary_function_eval(unary_quantile,&_quantile,_quantile_s);
2986 define_unary_function_ptr5( at_quantile ,alias_at_quantile,&unary_quantile,0,true);
2987
_quartiles(const gen & g,GIAC_CONTEXT)2988 gen _quartiles(const gen & g,GIAC_CONTEXT){
2989 if ( g.type==_STRNG && g.subtype==-1) return g;
2990 vecteur v(gen2vecteur(g));
2991 if (g.type==_VECT && g.subtype==_SEQ__VECT && v.size()==2)
2992 return makevecteur(freq_quantile(v,0.0,contextptr),freq_quantile(v,0.25,contextptr),freq_quantile(v,0.5,contextptr),freq_quantile(v,0.75,contextptr),freq_quantile(v,1.0,contextptr));
2993 if (!ckmatrix(v)){
2994 if (!is_fully_numeric(evalf(v,1,contextptr))){
2995 islesscomplexthanf_sort(v.begin(),v.end());
2996 int s=int(v.size());
2997 return makevecteur(v[0],v[int(std::ceil(s/4.))-1],v[int(std::ceil(s/2.))-1],v[int(std::ceil(3*s/4.))-1],v[s-1]);
2998 }
2999 v=ascsort(mtran(vecteur(1,v)),true);
3000 }
3001 else
3002 v=ascsort(v,true);
3003 v=mtran(v);
3004 int s=int(v.size());
3005 if (s==0)
3006 return gensizeerr(contextptr);
3007 return makevecteur(v[0],v[int(std::ceil(s/4.))-1],v[int(std::ceil(s/2.))-1],v[int(std::ceil(3*s/4.))-1],v[s-1]);
3008 }
3009 static const char _quartiles_s []="quartiles";
3010 static define_unary_function_eval(unary_quartiles,&_quartiles,_quartiles_s);
3011 define_unary_function_ptr5( at_quartiles ,alias_at_quartiles,&unary_quartiles,0,true);
3012
_moustache(const gen & g_orig,GIAC_CONTEXT)3013 gen _moustache(const gen & g_orig,GIAC_CONTEXT){
3014 if ( g_orig.type==_STRNG && g_orig.subtype==-1) return g_orig;
3015 vecteur attributs(1,default_color(contextptr));
3016 gen g(g_orig);
3017 bool horizontal=true;
3018 double ymin=global_window_ymin;
3019 double ymax=global_window_ymax;
3020 if (g.type==_VECT && g.subtype==_SEQ__VECT){
3021 vecteur v(*g._VECTptr);
3022 int s=read_attributs(v,attributs,contextptr);
3023 if (s>1){
3024 gen tmp=v[s-1];
3025 if (is_equal(tmp)){
3026 if (tmp._SYMBptr->feuille[0]==x__IDNT_e)
3027 horizontal=false;
3028 tmp=tmp._SYMBptr->feuille[1];
3029 }
3030 if (tmp.is_symb_of_sommet(at_interval)){
3031 ymin=evalf_double(tmp._SYMBptr->feuille[0],1,contextptr)._DOUBLE_val;
3032 ymax=evalf_double(tmp._SYMBptr->feuille[1],1,contextptr)._DOUBLE_val;
3033 --s;
3034 }
3035 }
3036 if (s==1)
3037 g=v.front();
3038 else
3039 g=gen(vecteur(v.begin(),v.begin()+s),g_orig.subtype);
3040 }
3041 gen tmpp=_quartiles(g,contextptr);
3042 if (tmpp.type!=_VECT)
3043 return tmpp;
3044 vecteur v0(*tmpp._VECTptr),v;
3045 if (!ckmatrix(v0))
3046 v=vecteur(1,v0);
3047 else
3048 v=mtran(v0);
3049 // _Pictsize(0);
3050 int s=int(v.size());
3051 vecteur res;
3052 double xmin=gnuplot_xmin,xmax=gnuplot_xmax;
3053 gen tmpx=_min(v0[0],contextptr),tmpxx=_max(v0[4],contextptr);
3054 if (tmpx.type==_DOUBLE_)
3055 xmin=tmpx._DOUBLE_val;
3056 if (tmpxx.type==_DOUBLE_)
3057 xmax=tmpxx._DOUBLE_val;
3058 vecteur attr(attributs);
3059 vecteur legendes(1,string2gen("",false));
3060 if (attributs.size()>=2)
3061 legendes=gen2vecteur(attributs[1]);
3062 else
3063 attr.push_back(legendes);
3064 int ls=int(legendes.size());
3065 vecteur affichages(gen2vecteur(attributs[0]));
3066 int as=int(affichages.size());
3067 if (horizontal){
3068 double y_scale=(ymax-ymin)/(4*s);
3069 for (int i=0;i<s;++i){
3070 attr[0]=(i<as?affichages[i]:affichages[0]);
3071 attr[1]=(i<ls?legendes[i]:legendes[0]);
3072 double y_up=ymax-(4*i+1)*y_scale;
3073 double y_middle=ymax-(4*i+2)*y_scale;
3074 double y_down=ymax-(4*i+3)*y_scale;
3075 vecteur current=gen2vecteur(v[i]);
3076 if (current.size()!=5)
3077 continue;
3078 // trait min -> 1er quartile
3079 res.push_back(symb_segment(current[0]+y_middle*cst_i,current[1]+y_middle*cst_i,attr,_GROUP__VECT,contextptr));
3080 // rectangle
3081 res.push_back(pnt_attrib(gen(makevecteur(current[3]+y_down*cst_i,current[1]+y_down*cst_i,current[1]+y_up*cst_i,current[3]+y_up*cst_i,current[3]+y_down*cst_i),_GROUP__VECT),attr,contextptr));
3082 // mediane
3083 res.push_back(symb_segment(current[2]+y_down*cst_i,current[2]+y_up*cst_i,attr,_GROUP__VECT,contextptr));
3084 // trait 3eme quartile -> fin
3085 res.push_back(symb_segment(current[3]+y_middle*cst_i,current[4]+y_middle*cst_i,attr,_GROUP__VECT,contextptr));
3086 }
3087 } else { // vertical picture
3088 swapdouble(xmin,ymin);
3089 swapdouble(xmax,ymax);
3090 double x_scale=(xmax-xmin)/(4*s);
3091 for (int i=0;i<s;++i){
3092 attr[0]=(i<as?affichages[i]:affichages[0]);
3093 attr[1]=(i<ls?legendes[i]:legendes[0]);
3094 double x_up=xmax-(4*i+1)*x_scale;
3095 double x_middle=xmax-(4*i+2)*x_scale;
3096 double x_down=xmax-(4*i+3)*x_scale;
3097 vecteur current=gen2vecteur(v[i]);
3098 if (current.size()!=5)
3099 continue;
3100 // trait min -> 1er quartile
3101 res.push_back(symb_segment(x_middle+current[0]*cst_i,current[1]*cst_i+x_middle,attr,_GROUP__VECT,contextptr));
3102 // rectangle
3103 res.push_back(pnt_attrib(gen(makevecteur(current[1]*cst_i+x_up,current[1]*cst_i+x_down,current[3]*cst_i+x_down,current[3]*cst_i+x_up,current[1]*cst_i+x_up),_GROUP__VECT),attr,contextptr));
3104 // mediane
3105 res.push_back(symb_segment(current[2]*cst_i+x_down,current[2]*cst_i+x_up,attr,_GROUP__VECT,contextptr));
3106 // trait 3eme quartile -> fin
3107 res.push_back(symb_segment(current[3]*cst_i+x_middle,current[4]*cst_i+x_middle,attr,_GROUP__VECT,contextptr));
3108 }
3109 }
3110 return gen(res,_SEQ__VECT);
3111 }
3112 static const char _moustache_s []="moustache";
3113 static define_unary_function_eval(unary_moustache,&_moustache,_moustache_s);
3114 define_unary_function_ptr5( at_moustache ,alias_at_moustache,&unary_moustache,0,true);
3115
3116 static const char _boxwhisker_s []="boxwhisker";
3117 static define_unary_function_eval(unary_boxwhisker,&_moustache,_boxwhisker_s);
3118 define_unary_function_ptr5( at_boxwhisker ,alias_at_boxwhisker,&unary_boxwhisker,0,true);
3119
3120
stddevmean(const vecteur & v,int withstddev,int xcol,int freqcol,GIAC_CONTEXT)3121 static gen stddevmean(const vecteur & v,int withstddev,int xcol,int freqcol,GIAC_CONTEXT){
3122 int sv=int(v.size());
3123 if (xcol>=sv || freqcol>=sv)
3124 return gendimerr(contextptr);
3125 if (v[xcol].type!=_VECT || v[freqcol].type!=_VECT)
3126 return gensizeerr(contextptr);
3127 vecteur v1(*v[xcol]._VECTptr),v2(*v[freqcol]._VECTptr);
3128 // if v1 is made of intervals replace by the center of these intervals
3129 iterateur it=v1.begin(),itend=v1.end();
3130 for (;it!=itend;++it){
3131 if (it->is_symb_of_sommet(at_interval)){
3132 gen & f=it->_SYMBptr->feuille;
3133 if (f.type==_VECT && f._VECTptr->size()==2)
3134 *it=(f._VECTptr->front()+f._VECTptr->back())/2;
3135 }
3136 }
3137 if (ckmatrix(v1) ^ ckmatrix(v2))
3138 return gensizeerr(contextptr);
3139 int n=int(v1.size());
3140 if (unsigned(n)!=v2.size())
3141 return gensizeerr(contextptr);
3142 gen m,m2,s;
3143 for (int i=0;i<n;++i){
3144 s = s + v2[i];
3145 m = m + apply(v2[i],v1[i],prod);
3146 if (withstddev)
3147 m2 = m2 + apply(v2[i],apply(v1[i],v1[i],prod),prod);
3148 }
3149 m = apply(m,s,contextptr,rdiv);
3150 if (withstddev){
3151 m2=m2-apply(s,apply(m,m,prod),prod);
3152 if (s.type!=_VECT && is_greater(1,s,contextptr) && withstddev==2)
3153 *logptr(contextptr) << "stddevp called with N<=1, perhaps you are misusing this command with frequencies" << '\n';
3154 m2=apply(m2,s-(withstddev==2),contextptr,rdiv);
3155 if (withstddev==3)
3156 return m2;
3157 return apply(m2,sqrt,contextptr);
3158 }
3159 else
3160 return m;
3161 }
3162 // withstddev=0 (mean), 1 (stddev divided by n), 2 (by n-1), 3 (variance)
stddevmean(const gen & g,int withstddev,GIAC_CONTEXT)3163 static gen stddevmean(const gen & g,int withstddev,GIAC_CONTEXT){
3164 vecteur & v=*g._VECTptr;
3165 int s=int(v.size());
3166 if (s<2)
3167 return gensizeerr(contextptr);
3168 if (v[1].type!=_INT_)
3169 return stddevmean(v,withstddev,0,1,contextptr);
3170 if (v[0].type!=_VECT)
3171 return gensizeerr(contextptr);
3172 int xcol=v[1].val;
3173 int freqcol=xcol+1;
3174 if (s>2 && v[2].type==_INT_)
3175 freqcol=v[2].val;
3176 return stddevmean(mtran(*v[0]._VECTptr),withstddev,xcol,freqcol,contextptr);
3177 }
3178
_mean(const gen & g,GIAC_CONTEXT)3179 gen _mean(const gen & g,GIAC_CONTEXT){
3180 if ( g.type==_STRNG && g.subtype==-1) return g;
3181 int nd=is_distribution(g);
3182 if (g.type==_SYMB && nd){
3183 gen f=g._SYMBptr->feuille;
3184 if (f.type==_VECT && f._VECTptr->size()==1)
3185 f=f._VECTptr->front();
3186 int s=f.type==_VECT?int(f._VECTptr->size()):1;
3187 if (s!=distrib_nargs(nd))
3188 return gensizeerr(contextptr);
3189 if (nd==1)
3190 return f[0];
3191 if (nd==2)
3192 return f[0]*f[1];
3193 if (nd==3)
3194 return f[0]*(1-f[1])/f[1];
3195 if (nd==4 || nd==11)
3196 return f;
3197 if (nd==5)
3198 return (f.type<_IDNT && is_strictly_greater(1,f,contextptr))?undef:0;
3199 if (nd==6)
3200 return (f[1].type<_IDNT && is_greater(2,f[1],contextptr))?undef:f[1]/(f[1]-2);
3201 if (nd==8)
3202 return f[1]*Gamma(1+inv(f[0],contextptr),contextptr);
3203 if (nd==9)
3204 return f[0]/(f[0]+f[1]);
3205 if (nd==10)
3206 return f[0]/f[1];
3207 if (nd==12)
3208 return inv(f[0],contextptr);
3209 if (nd==13)
3210 return (f[1]+f[0])/2;
3211 if (nd==14)
3212 return inv(f[0],contextptr);
3213 return undef;
3214 }
3215 if (g.type==_VECT && !g._VECTptr->empty() && g._VECTptr->front().type==_FUNC && (nd=is_distribution(g._VECTptr->front()))){
3216 return _mean(symbolic(*g._VECTptr->front()._FUNCptr,gen(vecteur(g._VECTptr->begin()+1,g._VECTptr->end()),_SEQ__VECT)),contextptr);
3217 }
3218 if (g.type==_VECT && g.subtype==_SEQ__VECT)
3219 return stddevmean(g,0,contextptr);
3220 vecteur v(gen2vecteur(g));
3221 if (!ckmatrix(v))
3222 return mean(mtran(vecteur(1,v)),true)[0];
3223 else
3224 v=mean(v,true);
3225 return v;
3226 }
3227 static const char _mean_s []="mean";
3228 static define_unary_function_eval (__mean,&_mean,_mean_s);
3229 define_unary_function_ptr5( at_mean ,alias_at_mean,&__mean,0,true);
3230
3231 static const char _moyenne_s []="moyenne";
3232 static define_unary_function_eval (__moyenne,&_mean,_moyenne_s);
3233 define_unary_function_ptr5( at_moyenne ,alias_at_moyenne,&__moyenne,0,true);
3234
_stdDev(const gen & g,GIAC_CONTEXT)3235 gen _stdDev(const gen & g,GIAC_CONTEXT){
3236 if ( g.type==_STRNG && g.subtype==-1) return g;
3237 if (g.type==_VECT && g.subtype==_SEQ__VECT)
3238 return stddevmean(g,2,contextptr);
3239 vecteur v(gen2vecteur(g));
3240 if (!ckmatrix(v))
3241 return stddev(mtran(vecteur(1,v)),true,2)[0];
3242 else
3243 v=stddev(v,true,2);
3244 return v;
3245 }
3246 static const char _stdDev_s []="stdDev";
3247 static define_unary_function_eval (__stdDev,&_stdDev,_stdDev_s);
3248 define_unary_function_ptr5( at_stdDev ,alias_at_stdDev,&__stdDev,0,true);
3249
3250 static const char _stddevp_s []="stddevp";
3251 static define_unary_function_eval (__stddevp,&_stdDev,_stddevp_s);
3252 define_unary_function_ptr5( at_stddevp ,alias_at_stddevp,&__stddevp,0,true);
3253
3254 static const char _ecart_type_population_s []="ecart_type_population";
3255 static define_unary_function_eval (__ecart_type_population,&_stdDev,_ecart_type_population_s);
3256 define_unary_function_ptr5( at_ecart_type_population ,alias_at_ecart_type_population,&__ecart_type_population,0,true);
3257
_stddev(const gen & g,GIAC_CONTEXT)3258 gen _stddev(const gen & g,GIAC_CONTEXT){
3259 if ( g.type==_STRNG && g.subtype==-1) return g;
3260 int nd;
3261 if (g.type==_SYMB && (nd=is_distribution(g))){
3262 gen f=g._SYMBptr->feuille;
3263 if (f.type==_VECT && f._VECTptr->size()==1)
3264 f=f._VECTptr->front();
3265 int s=f.type==_VECT?int(f._VECTptr->size()):1;
3266 if (s!=distrib_nargs(nd))
3267 return gensizeerr(contextptr);
3268 if (nd==1)
3269 return f[1];
3270 if (nd==2)
3271 return sqrt(f[0]*f[1]*(1-f[1]),contextptr);
3272 if (nd==3)
3273 return sqrt(f[0]*(1-f[1]),contextptr)/f[1];
3274 if (nd==4)
3275 return sqrt(f,contextptr);
3276 if (nd==11)
3277 return sqrt(2*f,contextptr);
3278 if (nd==5){
3279 if (f.type<_IDNT && is_greater(1,f,contextptr)) return undef;
3280 if (f.type<_IDNT && is_greater(2,f,contextptr)) return plus_inf;
3281 return sqrt(f/(f-2),contextptr);
3282 }
3283 if (nd==6)
3284 return (f[1].type<_IDNT && is_greater(4,f[1],contextptr))?undef:f[1]/(f[1]-2)*sqrt(2*(f[0]+f[1]-2)/f[0]/(f[1]-4),contextptr);
3285 if (nd==8)
3286 return f[1]*sqrt(Gamma(1+gen(2)/f[0],contextptr)-pow(Gamma(1+gen(1)/f[0],contextptr),2,contextptr),contextptr);
3287 if (nd==9)
3288 return sqrt(f[0]*f[1]/(f[0]+f[1]+1),contextptr)/(f[0]+f[1]);
3289 if (nd==10)
3290 return sqrt(f[0],contextptr)/f[1];
3291 if (nd==12)
3292 return sqrt(1-f[0],contextptr)/f[0];
3293 if (nd==13)
3294 return (f[1]-f[0])*sqrt(3,contextptr)/6;
3295 if (nd==14)
3296 return inv(f[0],contextptr);
3297 return undef;
3298 }
3299 if (g.type==_VECT && !g._VECTptr->empty() && g._VECTptr->front().type==_FUNC && (nd=is_distribution(g._VECTptr->front()))){
3300 return _stddev(symbolic(*g._VECTptr->front()._FUNCptr,gen(vecteur(g._VECTptr->begin()+1,g._VECTptr->end()),_SEQ__VECT)),contextptr);
3301 }
3302 if (g.type==_VECT && g.subtype==_SEQ__VECT)
3303 return stddevmean(g,1,contextptr);
3304 vecteur v(gen2vecteur(g));
3305 if (!ckmatrix(v))
3306 return stddev(mtran(vecteur(1,v)),true,1)[0];
3307 else
3308 v=stddev(v,true,1);
3309 return v;
3310 }
3311 static const char _stddev_s []="stddev";
3312 static define_unary_function_eval (__stddev,&_stddev,_stddev_s);
3313 define_unary_function_ptr5( at_stddev ,alias_at_stddev,&__stddev,0,true);
3314
3315 static const char _ecart_type_s []="ecart_type";
3316 static define_unary_function_eval (__ecart_type,&_stddev,_ecart_type_s);
3317 define_unary_function_ptr5( at_ecart_type ,alias_at_ecart_type,&__ecart_type,0,true);
3318
_variance(const gen & g,GIAC_CONTEXT)3319 gen _variance(const gen & g,GIAC_CONTEXT){
3320 if ( g.type==_STRNG && g.subtype==-1) return g;
3321 if (g.type==_VECT && g.subtype==_SEQ__VECT)
3322 return stddevmean(g,3,contextptr);
3323 vecteur v(gen2vecteur(g));
3324 if (!ckmatrix(v))
3325 return stddev(mtran(vecteur(1,v)),true,3)[0];
3326 else
3327 v=stddev(v,true,3);
3328 return v;
3329 }
3330 static const char _variance_s []="variance";
3331 static define_unary_function_eval (__variance,&_variance,_variance_s);
3332 define_unary_function_ptr5( at_variance ,alias_at_variance,&__variance,0,true);
3333
genpoint2vecteur(const gen & g,GIAC_CONTEXT)3334 vecteur genpoint2vecteur(const gen & g,GIAC_CONTEXT){
3335 vecteur v(gen2vecteur(g));
3336 for (unsigned i=0;i<v.size();++i){
3337 gen & tmp = v[i];
3338 if (tmp.is_symb_of_sommet(at_pnt))
3339 tmp=complex2vecteur(remove_at_pnt(tmp),contextptr);
3340 }
3341 return v;
3342 }
3343
covariance_correlation(const gen & g,const gen & u1,const gen & u2,int xcol,int ycol,int freqcol,GIAC_CONTEXT)3344 static vecteur covariance_correlation(const gen & g,const gen & u1,const gen & u2,int xcol,int ycol,int freqcol,GIAC_CONTEXT){
3345 if (is_undef(g))
3346 return makevecteur(g,g);
3347 vecteur v(genpoint2vecteur(g,contextptr));
3348 if (!ckmatrix(v) || v.empty() || v.front()._VECTptr->size()<2)
3349 return makevecteur(undef,undef);
3350 gen sigmax,sigmay,sigmaxy,sigmax2,sigmay2,tmpx,tmpy,n,freq;
3351 if (freqcol<-1){
3352 // g is interpreted as a double-entry table with 1st col = x-values
3353 // 1st line=y-values, line/col is a frequency for this value of x/y
3354 int r,c;
3355 mdims(v,r,c);
3356 if (r<2 || c<2)
3357 return makevecteur(gendimerr(contextptr),gendimerr(contextptr));
3358 vecteur & vy=*v[0]._VECTptr;
3359 for (int i=1;i<r;++i){
3360 vecteur & w=*v[i]._VECTptr;
3361 gen & currentx=w[0];
3362 for (int j=1;j<c;++j){
3363 gen & currenty=vy[j];
3364 freq=w[j];
3365 n=n+freq;
3366 sigmax=sigmax+currentx*freq;
3367 sigmax2=sigmax2+currentx*currentx*freq;
3368 sigmay=sigmay+currenty*freq;
3369 sigmay2=sigmay2+currenty*currenty*freq;
3370 sigmaxy=sigmaxy+currentx*currenty*freq;
3371 }
3372 }
3373 }
3374 else {
3375 const_iterateur it=v.begin(),itend=v.end();
3376 int s=int(it->_VECTptr->size());
3377 if (xcol>=s || ycol>=s || freqcol >=s)
3378 return makevecteur(gendimerr(contextptr),gendimerr(contextptr));
3379 for (;it!=itend;++it){
3380 vecteur & w=*it->_VECTptr;
3381 if (u1.type==_FUNC)
3382 tmpx=u1(w[xcol],contextptr);
3383 else
3384 tmpx=w[xcol];
3385 if (u2.type==_FUNC)
3386 tmpy=u2(w[ycol],contextptr);
3387 else
3388 tmpy=w[ycol];
3389 if (freqcol>=0)
3390 freq=w[freqcol];
3391 else
3392 freq=plus_one;
3393 n = n+freq;
3394 sigmax = sigmax + tmpx*freq;
3395 sigmax2 = sigmax2 + tmpx*tmpx*freq;
3396 sigmay = sigmay + tmpy*freq;
3397 sigmay2 = sigmay2 + tmpy*tmpy*freq;
3398 sigmaxy = sigmaxy + tmpx*tmpy*freq;
3399 }
3400 }
3401 gen covariance=(n*sigmaxy-sigmax*sigmay)/(n*n);
3402 gen correlation=(n*sigmaxy-sigmax*sigmay)/sqrt((n*sigmax2-sigmax*sigmax)*(n*sigmay2-sigmay*sigmay),contextptr);
3403 return makevecteur(covariance,correlation);
3404 }
3405
find_xyfreq(const gen & g,gen & gv,int & xcol,int & ycol,int & freqcol,GIAC_CONTEXT)3406 static void find_xyfreq(const gen & g,gen & gv,int & xcol,int & ycol,int &freqcol,GIAC_CONTEXT){
3407 xcol=0;
3408 ycol=1;
3409 freqcol=-1;
3410 if (g.type==_VECT && g.subtype==_SEQ__VECT && !g._VECTptr->empty()){
3411 vecteur v=*g._VECTptr;
3412 if (v[0].type!=_VECT){
3413 gv=gensizeerr(contextptr);
3414 return;
3415 }
3416 int s=int(v.size());
3417 if (s==3 && v[1].type==_VECT){
3418 if (!ckmatrix(v[2]))
3419 v[2]=_diag(v[2],contextptr);
3420 int n,c;
3421 mdims(*v[2]._VECTptr,n,c);
3422 if (unsigned(n)==v[0]._VECTptr->size() && unsigned(c)==v[1]._VECTptr->size()){
3423 vecteur v0(*v[1]._VECTptr);
3424 v0.insert(v0.begin(),zero);
3425 matrice m(mtran(*v[2]._VECTptr));
3426 m.insert(m.begin(),v[0]);
3427 m=mtran(m);
3428 m.insert(m.begin(),v0);
3429 gv=m;
3430 freqcol=-2;
3431 return;
3432 }
3433 }
3434 if (s>1) {
3435 if (v[1].type==_INT_){
3436 xcol=v[1].val;
3437 if (xcol<0)
3438 freqcol=-2;
3439 }
3440 else {
3441 if (!ckmatrix(v))
3442 gv=gensizeerr(contextptr);
3443 else
3444 gv=mtran(v);
3445 return;
3446 }
3447 }
3448 if (s>2 && v[2].type==_INT_)
3449 ycol=v[2].val;
3450 if (s>3 && v[3].type==_INT_)
3451 freqcol=v[3].val;
3452 gv=v[0];
3453 }
3454 else {
3455 gv=genpoint2vecteur(g,contextptr);
3456 if (!ckmatrix(gv) || gv._VECTptr->empty()){
3457 gv=gensizeerr(contextptr);
3458 return;
3459 }
3460 if (gv._VECTptr->front()._VECTptr->size()>2)
3461 freqcol=2;
3462 if (gv._VECTptr->front()._VECTptr->front().type==_STRNG)
3463 freqcol=-2;
3464 }
3465 }
_covariance_correlation(const gen & g,GIAC_CONTEXT)3466 gen _covariance_correlation(const gen & g,GIAC_CONTEXT){
3467 if ( g.type==_STRNG && g.subtype==-1) return g;
3468 int xcol,ycol,freqcol;
3469 gen gv;
3470 find_xyfreq(g,gv,xcol,ycol,freqcol,contextptr);
3471 if (is_undef(gv)) return gv;
3472 return covariance_correlation(gv,zero,zero,xcol,ycol,freqcol,contextptr);
3473 }
3474 static const char _covariance_correlation_s []="covariance_correlation";
3475 static define_unary_function_eval (__covariance_correlation,&_covariance_correlation,_covariance_correlation_s);
3476 define_unary_function_ptr5( at_covariance_correlation ,alias_at_covariance_correlation,&__covariance_correlation,0,true);
3477
_covariance(const gen & g,GIAC_CONTEXT)3478 gen _covariance(const gen & g,GIAC_CONTEXT){
3479 if ( g.type==_STRNG && g.subtype==-1) return g;
3480 int xcol,ycol,freqcol;
3481 gen gv;
3482 find_xyfreq(g,gv,xcol,ycol,freqcol,contextptr);
3483 if (is_undef(gv)) return gv;
3484 return covariance_correlation(gv,zero,zero,xcol,ycol,freqcol,contextptr)[0];
3485 }
3486 static const char _covariance_s []="covariance";
3487 static define_unary_function_eval (__covariance,&_covariance,_covariance_s);
3488 define_unary_function_ptr5( at_covariance ,alias_at_covariance,&__covariance,0,true);
3489
_correlation(const gen & g,GIAC_CONTEXT)3490 gen _correlation(const gen & g,GIAC_CONTEXT){
3491 if ( g.type==_STRNG && g.subtype==-1) return g;
3492 int xcol,ycol,freqcol;
3493 gen gv;
3494 find_xyfreq(g,gv,xcol,ycol,freqcol,contextptr);
3495 if (is_undef(gv)) return gv;
3496 return covariance_correlation(gv,zero,zero,xcol,ycol,freqcol,contextptr)[1];
3497 }
3498 static const char _correlation_s []="correlation";
3499 static define_unary_function_eval (__correlation,&_correlation,_correlation_s);
3500 define_unary_function_ptr5( at_correlation ,alias_at_correlation,&__correlation,0,true);
3501
_interval2center(const gen & g,GIAC_CONTEXT)3502 gen _interval2center(const gen & g,GIAC_CONTEXT){
3503 if ( g.type==_STRNG && g.subtype==-1) return g;
3504 if (g.type==_VECT)
3505 return apply(g,_interval2center,contextptr);
3506 if (g.type==_REAL)
3507 return _milieu(g,contextptr);
3508 if (g.is_symb_of_sommet(at_interval)){
3509 gen & tmp=g._SYMBptr->feuille;
3510 if (tmp.type!=_VECT || tmp._VECTptr->size()!=2)
3511 return gensizeerr(contextptr);
3512 vecteur & v=*tmp._VECTptr;
3513 return (v.front()+v.back())/2;
3514 }
3515 return g;
3516 }
3517 static const char _interval2center_s []="interval2center";
3518 static define_unary_function_eval (__interval2center,&_interval2center,_interval2center_s);
3519 define_unary_function_ptr5( at_interval2center ,alias_at_interval2center,&__interval2center,0,true);
3520
vector3(const gen & x,const gen & y,const gen & f,GIAC_CONTEXT)3521 vector<double> vector3(const gen & x,const gen &y,const gen & f,GIAC_CONTEXT){
3522 vector<double> res;
3523 res.push_back(evalf_double(x,1,contextptr)._DOUBLE_val);
3524 res.push_back(evalf_double(y,1,contextptr)._DOUBLE_val);
3525 res.push_back(evalf_double(f,1,contextptr)._DOUBLE_val);
3526 return res;
3527 }
3528
Tran4(double * colmat)3529 void Tran4(double * colmat){
3530 giac::swapdouble(colmat[1],colmat[4]);
3531 giac::swapdouble(colmat[2],colmat[8]);
3532 giac::swapdouble(colmat[3],colmat[12]);
3533 giac::swapdouble(colmat[6],colmat[9]);
3534 giac::swapdouble(colmat[7],colmat[13]);
3535 giac::swapdouble(colmat[11],colmat[14]);
3536 }
3537
Mult4(double * colmat,double * vect,double * res)3538 void Mult4(double * colmat,double * vect,double * res){
3539 res[0]=colmat[0]*vect[0]+colmat[4]*vect[1]+colmat[8]*vect[2]+colmat[12]*vect[3];
3540 res[1]=colmat[1]*vect[0]+colmat[5]*vect[1]+colmat[9]*vect[2]+colmat[13]*vect[3];
3541 res[2]=colmat[2]*vect[0]+colmat[6]*vect[1]+colmat[10]*vect[2]+colmat[14]*vect[3];
3542 res[3]=colmat[3]*vect[0]+colmat[7]*vect[1]+colmat[11]*vect[2]+colmat[15]*vect[3];
3543 }
3544
Mult4(double * c,double k,double * res)3545 void Mult4(double * c,double k,double * res){
3546 for (int i=0;i<16;i++)
3547 res[i]=k*c[i];
3548 }
3549
Det4(double * c)3550 double Det4(double * c){
3551 return c[0]*c[5]*c[10]*c[15]-c[0]*c[5]*c[14]*c[11]-c[0]*c[9]*c[6]*c[15]+c[0]*c[9]*c[14]*c[7]+c[0]*c[13]*c[6]*c[11]-c[0]*c[13]*c[10]*c[7]-c[4]*c[1]*c[10]*c[15]+c[4]*c[1]*c[14]*c[11]+c[4]*c[9]*c[2]*c[15]-c[4]*c[9]*c[14]*c[3]-c[4]*c[13]*c[2]*c[11]+c[4]*c[13]*c[10]*c[3]+c[8]*c[1]*c[6]*c[15]-c[8]*c[1]*c[14]*c[7]-c[8]*c[5]*c[2]*c[15]+c[8]*c[5]*c[14]*c[3]+c[8]*c[13]*c[2]*c[7]-c[8]*c[13]*c[6]*c[3]-c[12]*c[1]*c[6]*c[11]+c[12]*c[1]*c[10]*c[7]+c[12]*c[5]*c[2]*c[11]-c[12]*c[5]*c[10]*c[3]-c[12]*c[9]*c[2]*c[7]+c[12]*c[9]*c[6]*c[3];
3552 }
3553
Inv4(double * c,double * res)3554 void Inv4(double * c,double * res){
3555 res[0]=c[5]*c[10]*c[15]-c[5]*c[14]*c[11]-c[10]*c[7]*c[13]-c[15]*c[9]*c[6]+c[14]*c[9]*c[7]+c[11]*c[6]*c[13];
3556 res[1]=-c[1]*c[10]*c[15]+c[1]*c[14]*c[11]+c[10]*c[3]*c[13]+c[15]*c[9]*c[2]-c[14]*c[9]*c[3]-c[11]*c[2]*c[13];
3557 res[2]=c[1]*c[6]*c[15]-c[1]*c[14]*c[7]-c[6]*c[3]*c[13]-c[15]*c[5]*c[2]+c[14]*c[5]*c[3]+c[7]*c[2]*c[13];
3558 res[3]=-c[1]*c[6]*c[11]+c[1]*c[10]*c[7]+c[6]*c[3]*c[9]+c[11]*c[5]*c[2]-c[10]*c[5]*c[3]-c[7]*c[2]*c[9];
3559 res[4]=-c[4]*c[10]*c[15]+c[4]*c[14]*c[11]+c[10]*c[7]*c[12]+c[15]*c[8]*c[6]-c[14]*c[8]*c[7]-c[11]*c[6]*c[12];
3560 res[5]=c[0]*c[10]*c[15]-c[0]*c[14]*c[11]-c[10]*c[3]*c[12]-c[15]*c[8]*c[2]+c[14]*c[8]*c[3]+c[11]*c[2]*c[12];
3561 res[6]=-c[0]*c[6]*c[15]+c[0]*c[14]*c[7]+c[6]*c[3]*c[12]+c[15]*c[4]*c[2]-c[14]*c[4]*c[3]-c[7]*c[2]*c[12];
3562 res[7]=c[0]*c[6]*c[11]-c[0]*c[10]*c[7]-c[6]*c[3]*c[8]-c[11]*c[4]*c[2]+c[10]*c[4]*c[3]+c[7]*c[2]*c[8];
3563 res[8]=c[4]*c[9]*c[15]-c[4]*c[13]*c[11]-c[9]*c[7]*c[12]-c[15]*c[8]*c[5]+c[13]*c[8]*c[7]+c[11]*c[5]*c[12];
3564 res[9]=-c[0]*c[9]*c[15]+c[0]*c[13]*c[11]+c[9]*c[3]*c[12]+c[15]*c[8]*c[1]-c[13]*c[8]*c[3]-c[11]*c[1]*c[12];
3565 res[10]=c[0]*c[5]*c[15]-c[0]*c[13]*c[7]-c[5]*c[3]*c[12]-c[15]*c[4]*c[1]+c[13]*c[4]*c[3]+c[7]*c[1]*c[12];
3566 res[11]=-c[0]*c[5]*c[11]+c[0]*c[9]*c[7]+c[5]*c[3]*c[8]+c[11]*c[4]*c[1]-c[9]*c[4]*c[3]-c[7]*c[1]*c[8];
3567 res[12]=-c[4]*c[9]*c[14]+c[4]*c[13]*c[10]+c[9]*c[6]*c[12]+c[14]*c[8]*c[5]-c[13]*c[8]*c[6]-c[10]*c[5]*c[12];
3568 res[13]=c[0]*c[9]*c[14]-c[0]*c[13]*c[10]-c[9]*c[2]*c[12]-c[14]*c[8]*c[1]+c[13]*c[8]*c[2]+c[10]*c[1]*c[12];
3569 res[14]=-c[0]*c[5]*c[14]+c[0]*c[13]*c[6]+c[5]*c[2]*c[12]+c[14]*c[4]*c[1]-c[13]*c[4]*c[2]-c[6]*c[1]*c[12];
3570 res[15]=c[0]*c[5]*c[10]-c[0]*c[9]*c[6]-c[5]*c[2]*c[8]-c[10]*c[4]*c[1]+c[9]*c[4]*c[2]+c[6]*c[1]*c[8];
3571 double det=Det4(c);
3572 Mult4(res,1/det,res);
3573 }
function_regression(const gen & g,const gen & u1,const gen & u2,gen & a,gen & b,double & xmin,double & xmax,gen & correl2,GIAC_CONTEXT)3574 gen function_regression(const gen & g,const gen & u1,const gen & u2,gen & a,gen &b,double & xmin,double & xmax,gen & correl2,GIAC_CONTEXT){
3575 gen gv,freq;
3576 int xcol,ycol,freqcol;
3577 xmin=1e300;
3578 xmax=-xmin;
3579 double ymin=1e300,ymax=-ymin; // for trig regressions initial guess
3580 find_xyfreq(g,gv,xcol,ycol,freqcol,contextptr);
3581 if (!ckmatrix(gv))
3582 return gensizeerr(contextptr);
3583 vecteur & v = *gv._VECTptr;
3584 gen n;
3585 gen sigmax,sigmay,sigmaxy,sigmax2,sigmay2,tmpx,tmpy;
3586 vector< vector<double> > trig;
3587 if (freqcol<-1){
3588 int r,c;
3589 mdims(v,r,c);
3590 if (r<2 || c<2)
3591 return gendimerr(contextptr);
3592 vecteur & vy=*v[0]._VECTptr;
3593 gen currentx,currenty;
3594 for (int i=1;i<r;++i){
3595 vecteur & w=*v[i]._VECTptr;
3596 gen tmpg=evalf_double(w[0],1,contextptr);
3597 if (tmpg.type==_DOUBLE_){
3598 double tmp=tmpg._DOUBLE_val;
3599 if (tmp<xmin)
3600 xmin=tmp;
3601 if (tmp>xmax)
3602 xmax=tmp;
3603 }
3604 if (u1.type==_FUNC && u1!=at_sin){
3605 currentx=u1(w[0],contextptr);
3606 }
3607 else
3608 currentx=w[0];
3609 for (int j=1;j<c;++j){
3610 if (u2.type==_FUNC)
3611 currenty=u2(vy[j],contextptr);
3612 else
3613 currenty=vy[j];
3614 currenty=_interval2center(currenty,contextptr);
3615 if (is_undef(currenty))
3616 return currenty;
3617 tmpg=evalf_double(currenty,1,contextptr);
3618 if (tmpg.type==_DOUBLE_){
3619 double tmp=tmpg._DOUBLE_val;
3620 if (tmp<ymin)
3621 ymin=tmp;
3622 if (tmp>ymax)
3623 ymax=tmp;
3624 }
3625 freq=w[j];
3626 if (u1==at_sin)
3627 trig.push_back(vector3(currentx,currenty,freq,contextptr));
3628 n=n+freq;
3629 sigmax=sigmax+currentx*freq;
3630 sigmax2=sigmax2+currentx*currentx*freq;
3631 sigmay=sigmay+currenty*freq;
3632 sigmay2=sigmay2+currenty*currenty*freq;
3633 sigmaxy=sigmaxy+currentx*currenty*freq;
3634 }
3635 }
3636 }
3637 else {
3638 const_iterateur it=v.begin(),itend=v.end();
3639 for (;it!=itend;++it){
3640 vecteur & w=*it->_VECTptr;
3641 gen tmpg=evalf_double(w[xcol],1,contextptr);
3642 if (tmpg.type==_DOUBLE_){
3643 double tmp=tmpg._DOUBLE_val;
3644 if (tmp<xmin)
3645 xmin=tmp;
3646 if (tmp>xmax)
3647 xmax=tmp;
3648 }
3649 if (u1.type==_FUNC && u1!=at_sin){
3650 tmpx=u1(w[xcol],contextptr);
3651 }
3652 else
3653 tmpx=w[xcol];
3654 tmpx=_interval2center(tmpx,contextptr);
3655 if (is_undef(tmpx))
3656 return tmpx;
3657 if (u2.type==_FUNC)
3658 tmpy=u2(w[ycol],contextptr);
3659 else
3660 tmpy=w[ycol];
3661 tmpy=_interval2center(tmpy,contextptr);
3662 if (is_undef(tmpy))
3663 return tmpy;
3664 tmpg=evalf_double(tmpy,1,contextptr);
3665 if (tmpg.type==_DOUBLE_){
3666 double tmp=tmpg._DOUBLE_val;
3667 if (tmp<ymin)
3668 ymin=tmp;
3669 if (tmp>ymax)
3670 ymax=tmp;
3671 }
3672 if (freqcol<0)
3673 freq=plus_one;
3674 else
3675 freq=w[freqcol];
3676 if (u1==at_sin)
3677 trig.push_back(vector3(tmpx,tmpy,freq,contextptr));
3678 sigmax = sigmax + freq*tmpx;
3679 sigmax2 = sigmax2 + freq*tmpx*tmpx;
3680 sigmay = sigmay + freq*tmpy;
3681 sigmay2 = sigmay2 + freq*tmpy*tmpy;
3682 sigmaxy = sigmaxy + freq*tmpx*tmpy;
3683 n = n + freq;
3684 }
3685 }
3686 gen tmp=(n*sigmaxy-sigmax*sigmay);
3687 a=tmp/(n*sigmax2-sigmax*sigmax);
3688 b=(sigmay-a*sigmax)/n;
3689 correl2=(tmp*tmp)/(n*sigmax2-sigmax*sigmax)/(n*sigmay2-sigmay*sigmay);
3690 if (u1==at_sin){ // trig regression a*sin(omega*x+phi)+b
3691 // initial guess b=(ymax+ymin)/2, a=(ymax-ymin)
3692 // estimate period with crossings of y=b
3693 double b_=(ymax+ymin)/2,a_=(ymax-ymin)/2,omega,phi;
3694 int n=trig.size();
3695 vector<double> crossup,crossdown,cross;
3696 for (int i=1;i<n;++i){
3697 double x0=trig[i-1][0],x1=trig[i][0];
3698 double y0=trig[i-1][1],y1=trig[i][1];
3699 double m=(y1-y0)/(x1-x0);
3700 double xb=x0+(b_-y0)/m;
3701 if ( (y1-b_)>0 && (y0-b_)<=0 ){
3702 crossup.push_back(xb);
3703 cross.push_back(xb);
3704 }
3705 if ( (y1-b_)<0 && (y0-b_)>=0 ){
3706 crossdown.push_back(xb);
3707 cross.push_back(xb);
3708 }
3709 }
3710 if (cross.size()<2)
3711 return gensizeerr(contextptr);
3712 double half_period=(cross.back()-cross.front())/(cross.size()-1);
3713 double period=2*half_period;
3714 omega=2*M_PI/period;
3715 phi=0;
3716 for (int i=0;i<crossup.size();++i){
3717 phi -= crossup[i]-i*period;
3718 }
3719 phi /= crossup.size();
3720 phi -= std::floor(phi/2/M_PI+.5)*2*M_PI;
3721 #if 1
3722 while (1){
3723 // E = 1/2*sum( f*(a*sin(x*o+phi)+b-y)^2)
3724 // Newton iteration compute first and second derivatives
3725 // E:=1/2*f*(a*sin(x*o+phi)+b-y)^2
3726 // subst(factor(diff(E,[a,b,o,phi])),[sin(x*o+phi),cos(x*o+phi)],[s,c])
3727 // subst(factor(diff(diff(E,[a,b,o,phi]),[a,b,o,phi])),[sin(x*o+phi),cos(x*o+phi)],[s,c])
3728 double dE[4]={0,0,0,0},delta[4];
3729 double d2E[16]={0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},invd2E[16];
3730 for (int i=0;i<n;++i){
3731 double x=trig[i][0];
3732 double y=trig[i][1];
3733 double f=trig[i][2];
3734 double s=std::sin(x*omega+phi);
3735 double c=std::cos(x*omega+phi);
3736 double asby=(a_*s+b_-y);
3737 // [f*s*(a*s+b-y),f*(a*s+b-y),a*c*f*x*(a*s+b-y),a*c*f*(a*s+b-y)]
3738 dE[0] += f*s*asby;
3739 dE[1] += f*asby;
3740 dE[2] += a_*f*x*c*asby;
3741 dE[3] += a_*f*c*asby;
3742 double as2by=(2*a_*s+b_-y);
3743 // f*s^2,f*s,c*f*x*(2*a*s+b-y),c*f*(2*a*s+b-y)
3744 d2E[0] += f*s*s;
3745 d2E[1] += f*s;
3746 d2E[2] += c*f*x*as2by;
3747 d2E[3] += c*f*as2by;
3748 // f*s,f,a*c*f*x,a*c*f
3749 d2E[4] += f*s;
3750 d2E[5] += f;
3751 d2E[6] += a_*c*f*x;
3752 d2E[7] += a_*c*f;
3753 double ac2s2=a_*(s*s-c*c)+s*(b_-y);
3754 // c*f*x*(2*a*s+b-y),a*c*f*x,-a*f*x^2*(-a*c^2+a*s^2+b*s-s*y),-a*f*x*(-a*c^2+a*s^2+b*s-s*y)
3755 d2E[8] += c*f*x*as2by;
3756 d2E[9] += a_*c*f*x;
3757 d2E[10] += -a_*f*x*x*ac2s2;
3758 d2E[11] += -a_*f*x*ac2s2;
3759 // c*f*(2*a*s+b-y),a*c*f,-a*f*x*(-a*c^2+a*s^2+b*s-s*y),-a*f*(-a*c^2+a*s^2+b*s-s*y)
3760 d2E[12] += c*f*as2by;
3761 d2E[13] += a_*c*f;
3762 d2E[14] += -a_*f*x*ac2s2;
3763 d2E[15] += -a_*f*ac2s2;
3764 }
3765 Tran4(d2E);
3766 Inv4(d2E,invd2E);
3767 Mult4(invd2E,dE,delta);
3768 a_ -= delta[0];
3769 b_ -= delta[1];
3770 omega -= delta[2];
3771 phi -= delta[3];
3772 if (fabs(a_?delta[0]/a_:delta[0])+fabs(b_?delta[1]/b_:delta[1])+fabs(omega?delta[2]/omega:delta[2])+fabs(phi?delta[3]/phi:delta[3])<1e-7)
3773 break;
3774 }
3775 a=makesequence(a_,b_,omega,phi);
3776 #else
3777 gen E,A(identificateur("A")),B(identificateur("B")),O(identificateur("omega")),P(identificateur("phi"));
3778 for (int i=0;i<n;++i){
3779 double x=trig[i][0];
3780 double y=trig[i][1];
3781 E += trig[i][2]*symb_pow(A*sin(x*O+P,contextptr)+B-y,2);
3782 }
3783 // now solve E'=0
3784 gen vars(makevecteur(A,B,O,P));
3785 a=_fsolve(makesequence(symb_equal(derive(E,vars,contextptr),0),vars,makevecteur(a_,b_,omega,phi)),contextptr);
3786 #endif
3787 b=undef;
3788 }
3789 return makevecteur(sigmax,sigmay,n,sigmax2,sigmay2);
3790 // cerr << sigmax << " "<< sigmay << " " << sigmaxy << " " << n << " " << sigmax2 << " " << sigmay2 << '\n';
3791 }
3792
function_regression(const gen & g,const gen & u1,const gen & u2,GIAC_CONTEXT)3793 static gen function_regression(const gen & g,const gen & u1,const gen & u2,GIAC_CONTEXT){
3794 gen a,b,correl2;
3795 double xmin,xmax;
3796 gen errcode=function_regression(g,u1,u2,a,b,xmin,xmax,correl2,contextptr);
3797 if (is_undef(errcode)) return errcode;
3798 return gen(makevecteur(a,b),_SEQ__VECT);
3799 }
3800
_linear_regression(const gen & g,GIAC_CONTEXT)3801 gen _linear_regression(const gen & g,GIAC_CONTEXT){
3802 if ( g.type==_STRNG && g.subtype==-1) return g;
3803 return function_regression(g,zero,zero,contextptr);
3804 }
3805 static const char _linear_regression_s []="linear_regression";
3806 static define_unary_function_eval (__linear_regression,&_linear_regression,_linear_regression_s);
3807 define_unary_function_ptr5( at_linear_regression ,alias_at_linear_regression,&__linear_regression,0,true);
3808
_sin_regression(const gen & g,GIAC_CONTEXT)3809 gen _sin_regression(const gen & g,GIAC_CONTEXT){
3810 if ( g.type==_STRNG && g.subtype==-1) return g;
3811 gen res=function_regression(g,at_sin,zero,contextptr);
3812 if (res.type!=_VECT || res._VECTptr->size()!=2) return gensizeerr(contextptr);
3813 res=res._VECTptr->front();
3814 return makesequence(res,res[0]*symb_sin(res[2]*vx_var+res[3])+res[1]);
3815 }
3816 static const char _sin_regression_s []="sin_regression";
3817 static define_unary_function_eval (__sin_regression,&_sin_regression,_sin_regression_s);
3818 define_unary_function_ptr5( at_sin_regression ,alias_at_sin_regression,&__sin_regression,0,true);
3819
_exponential_regression(const gen & g,GIAC_CONTEXT)3820 gen _exponential_regression(const gen & g,GIAC_CONTEXT){
3821 if ( g.type==_STRNG && g.subtype==-1) return g;
3822 return exp(function_regression(g,zero,at_ln,contextptr),contextptr);
3823 }
3824 static const char _exponential_regression_s []="exponential_regression";
3825 static define_unary_function_eval (__exponential_regression,&_exponential_regression,_exponential_regression_s);
3826 define_unary_function_ptr5( at_exponential_regression ,alias_at_exponential_regression,&__exponential_regression,0,true);
3827
_logarithmic_regression(const gen & g,GIAC_CONTEXT)3828 gen _logarithmic_regression(const gen & g,GIAC_CONTEXT){
3829 if ( g.type==_STRNG && g.subtype==-1) return g;
3830 return function_regression(g,at_ln,zero,contextptr);
3831 }
3832 static const char _logarithmic_regression_s []="logarithmic_regression";
3833 static define_unary_function_eval (__logarithmic_regression,&_logarithmic_regression,_logarithmic_regression_s);
3834 define_unary_function_ptr5( at_logarithmic_regression ,alias_at_logarithmic_regression,&__logarithmic_regression,0,true);
3835
_power_regression(const gen & g,GIAC_CONTEXT)3836 gen _power_regression(const gen & g,GIAC_CONTEXT){
3837 if ( g.type==_STRNG && g.subtype==-1) return g;
3838 gen res= function_regression(evalf(g,1,contextptr),at_ln,at_ln,contextptr);
3839 if (res.type==_VECT && res._VECTptr->size()==2){
3840 vecteur v(*res._VECTptr);
3841 v[1]=exp(v[1],contextptr);
3842 return gen(v,_SEQ__VECT);
3843 }
3844 return res;
3845 }
3846 static const char _power_regression_s []="power_regression";
3847 static define_unary_function_eval (__power_regression,&_power_regression,_power_regression_s);
3848 define_unary_function_ptr5( at_power_regression ,alias_at_power_regression,&__power_regression,0,true);
3849
regression_plot_attributs(const gen & g,vecteur & attributs,bool & eq,bool & r,GIAC_CONTEXT)3850 gen regression_plot_attributs(const gen & g,vecteur & attributs,bool & eq,bool & r,GIAC_CONTEXT){
3851 gen res=g;
3852 r=false; eq=false;
3853 if (g.type==_VECT && g.subtype==_SEQ__VECT){
3854 int n=read_attributs(*g._VECTptr,attributs,contextptr);
3855 vecteur v=vecteur(g._VECTptr->begin(),g._VECTptr->begin()+n);
3856 vecteur & w=*g._VECTptr;
3857 int ws=int(w.size());
3858 for (int i=0;i<ws;++i){
3859 if (w[i]==at_equation){
3860 eq=true;
3861 if (i<n){
3862 v.erase(v.begin()+i);
3863 --n;
3864 --i;
3865 }
3866 }
3867 if (w[i]==at_correlation){
3868 r=true;
3869 if (i<n){
3870 v.erase(v.begin()+i);
3871 --n;
3872 --i;
3873 }
3874 }
3875 }
3876 if (n==1)
3877 res=g._VECTptr->front();
3878 else
3879 res=gen(v,_SEQ__VECT);
3880 }
3881 else
3882 attributs=vecteur(1,default_color(contextptr));
3883 return res;
3884 }
3885
_linear_regression_plot(const gen & g,GIAC_CONTEXT)3886 gen _linear_regression_plot(const gen & g,GIAC_CONTEXT){
3887 if ( g.type==_STRNG && g.subtype==-1) return g;
3888 gen a,b,correl2;
3889 double xmin,xmax;
3890 vecteur attributs;
3891 bool eq,r;
3892 gen G=regression_plot_attributs(g,attributs,eq,r,contextptr);
3893 gen errcode=function_regression(G,zero,zero,a,b,xmin,xmax,correl2,contextptr);
3894 if (is_undef(errcode)) return errcode;
3895 xmax += (xmax-xmin);
3896 gen ad(evalf_double(a,1,contextptr)),bd(evalf_double(b,1,contextptr)),cd(evalf_double(correl2,1,contextptr));
3897 if (ad.type==_DOUBLE_ && bd.type==_DOUBLE_ && cd.type==_DOUBLE_){
3898 string eqs="y="+print_DOUBLE_(ad._DOUBLE_val,3)+"*x+"+print_DOUBLE_(bd._DOUBLE_val,3);
3899 string R2s=" , R2="+print_DOUBLE_(cd._DOUBLE_val,3);
3900 *logptr(contextptr) << eqs << R2s << '\n';
3901 string s;
3902 if (eq)
3903 s += eqs;
3904 if (r)
3905 s += R2s;
3906 attributs.push_back(string2gen(s,false));
3907 }
3908 return makesequence(_scatterplot(g,contextptr),put_attributs(_droite(makesequence(b*cst_i,1+(b+a)*cst_i),contextptr),attributs,contextptr));
3909 }
3910 static const char _linear_regression_plot_s []="linear_regression_plot";
3911 static define_unary_function_eval (__linear_regression_plot,&_linear_regression_plot,_linear_regression_plot_s);
3912 define_unary_function_ptr5( at_linear_regression_plot ,alias_at_linear_regression_plot,&__linear_regression_plot,0,true);
3913
_exponential_regression_plot(const gen & g,GIAC_CONTEXT)3914 gen _exponential_regression_plot(const gen & g,GIAC_CONTEXT){
3915 if ( g.type==_STRNG && g.subtype==-1) return g;
3916 gen a,b,correl2;
3917 double xmin,xmax;
3918 vecteur attributs;
3919 bool eq,r;
3920 gen G=regression_plot_attributs(g,attributs,eq,r,contextptr);
3921 gen errcode=function_regression(G,zero,at_ln,a,b,xmin,xmax,correl2,contextptr);
3922 if (is_undef(errcode)) return errcode;
3923 gen ad(evalf_double(a,1,contextptr)),bd(evalf_double(b,1,contextptr)),cd(evalf_double(correl2,1,contextptr));
3924 if (ad.type==_DOUBLE_ && bd.type==_DOUBLE_ && cd.type==_DOUBLE_){
3925 string eqs="y="+print_DOUBLE_(std::exp(ad._DOUBLE_val),3)+"^x*"+print_DOUBLE_(std::exp(bd._DOUBLE_val),3);
3926 string R2s=" , R2="+print_DOUBLE_(cd._DOUBLE_val,3);
3927 *logptr(contextptr) << eqs << R2s << '\n';
3928 string s;
3929 if (eq)
3930 s += eqs;
3931 if (r)
3932 s += R2s;
3933 attributs.push_back(string2gen(s,false));
3934 }
3935 return makesequence(_scatterplot(g,contextptr),put_attributs(_plotfunc(gen(makevecteur(evalf(exp(b,contextptr),1,contextptr)*exp(a*vx_var,contextptr),symb_equal(vx_var,symb_interval(xmin,xmax))),_SEQ__VECT),contextptr),attributs,contextptr));
3936 }
3937 static const char _exponential_regression_plot_s []="exponential_regression_plot";
3938 static define_unary_function_eval (__exponential_regression_plot,&_exponential_regression_plot,_exponential_regression_plot_s);
3939 define_unary_function_ptr5( at_exponential_regression_plot ,alias_at_exponential_regression_plot,&__exponential_regression_plot,0,true);
3940
_logarithmic_regression_plot(const gen & g,GIAC_CONTEXT)3941 gen _logarithmic_regression_plot(const gen & g,GIAC_CONTEXT){
3942 if ( g.type==_STRNG && g.subtype==-1) return g;
3943 gen a,b,correl2;
3944 double xmin,xmax;
3945 vecteur attributs;
3946 bool eq,r;
3947 gen G=regression_plot_attributs(g,attributs,eq,r,contextptr);
3948 gen errcode=function_regression(G,at_ln,zero,a,b,xmin,xmax,correl2,contextptr);
3949 if (is_undef(errcode)) return errcode;
3950 xmax += (xmax-xmin);
3951 gen ad(evalf_double(a,1,contextptr)),bd(evalf_double(b,1,contextptr)),cd(evalf_double(correl2,1,contextptr));
3952 if (ad.type==_DOUBLE_ && bd.type==_DOUBLE_ && cd.type==_DOUBLE_){
3953 string eqs="y="+print_DOUBLE_(ad._DOUBLE_val,3)+"*ln(x)+"+print_DOUBLE_(bd._DOUBLE_val,3);
3954 string R2s=" , R2="+print_DOUBLE_(cd._DOUBLE_val,3);
3955 *logptr(contextptr) << eqs << R2s << '\n';
3956 string s;
3957 if (eq)
3958 s += eqs;
3959 if (r)
3960 s += R2s;
3961 attributs.push_back(string2gen(s,false));
3962 }
3963 return makesequence(_scatterplot(g,contextptr),put_attributs(_plotfunc(gen(makevecteur(a*ln(vx_var,contextptr)+b,symb_equal(vx_var,symb_interval(xmin,xmax))),_SEQ__VECT),contextptr),attributs,contextptr));
3964 }
3965 static const char _logarithmic_regression_plot_s []="logarithmic_regression_plot";
3966 static define_unary_function_eval (__logarithmic_regression_plot,&_logarithmic_regression_plot,_logarithmic_regression_plot_s);
3967 define_unary_function_ptr5( at_logarithmic_regression_plot ,alias_at_logarithmic_regression_plot,&__logarithmic_regression_plot,0,true);
3968
_sin_regression_plot(const gen & g,GIAC_CONTEXT)3969 gen _sin_regression_plot(const gen & g,GIAC_CONTEXT){
3970 if ( g.type==_STRNG && g.subtype==-1) return g;
3971 gen a,b,correl2;
3972 double xmin,xmax;
3973 vecteur attributs;
3974 bool eq,r;
3975 gen G=regression_plot_attributs(g,attributs,eq,r,contextptr);
3976 gen res=function_regression(G,at_sin,zero,a,b,xmin,xmax,correl2,contextptr);
3977 res=a;
3978 if (is_undef(res) || res.type!=_VECT || res._VECTptr->size()!=4) return res;
3979 res = res[0]*symb_sin(res[2]*vx_var+res[3])+res[1];
3980 string eqs="y="+res.print(contextptr);
3981 *logptr(contextptr) << eqs << '\n';
3982 return makesequence(_scatterplot(g,contextptr),put_attributs(_plot(makesequence(res,vx_var,xmin,xmax),contextptr),attributs,contextptr));
3983 }
3984 static const char _sin_regression_plot_s []="sin_regression_plot";
3985 static define_unary_function_eval (__sin_regression_plot,&_sin_regression_plot,_sin_regression_plot_s);
3986 define_unary_function_ptr5( at_sin_regression_plot ,alias_at_sin_regression_plot,&__sin_regression_plot,0,true);
3987
_power_regression_plot(const gen & g,GIAC_CONTEXT)3988 gen _power_regression_plot(const gen & g,GIAC_CONTEXT){
3989 if ( g.type==_STRNG && g.subtype==-1) return g;
3990 gen a,b,correl2;
3991 double xmin,xmax;
3992 vecteur attributs;
3993 bool eq,r;
3994 gen G=regression_plot_attributs(g,attributs,eq,r,contextptr);
3995 gen errcode=function_regression(G,at_ln,at_ln,a,b,xmin,xmax,correl2,contextptr);
3996 if (is_undef(errcode)) return errcode;
3997 xmax += (xmax-xmin);
3998 gen ad(evalf_double(a,1,contextptr)),bd(evalf_double(b,1,contextptr)),cd(evalf_double(correl2,1,contextptr));
3999 if (ad.type==_DOUBLE_ && bd.type==_DOUBLE_ && cd.type==_DOUBLE_){
4000 string eqs="y="+print_DOUBLE_(exp(bd,contextptr)._DOUBLE_val,3)+"*x^"+print_DOUBLE_(ad._DOUBLE_val,3);
4001 string R2s=" , R2="+print_DOUBLE_(cd._DOUBLE_val,3);
4002 *logptr(contextptr) << eqs << R2s << '\n';
4003 string s;
4004 if (eq)
4005 s += eqs;
4006 if (r)
4007 s += R2s;
4008 attributs.push_back(string2gen(s,false));
4009 }
4010 return makesequence(_scatterplot(g,contextptr),put_attributs(_plotfunc(gen(makevecteur(exp(b,contextptr)*pow(vx_var,a,contextptr),symb_equal(vx_var,symb_interval(xmin,xmax))),_SEQ__VECT),contextptr),attributs,contextptr));
4011 }
4012 static const char _power_regression_plot_s []="power_regression_plot";
4013 static define_unary_function_eval (__power_regression_plot,&_power_regression_plot,_power_regression_plot_s);
4014 define_unary_function_ptr5( at_power_regression_plot ,alias_at_power_regression_plot,&__power_regression_plot,0,true);
4015
polynomial_regression(const gen & g,int d,const gen & u1,const gen & u2,double & xmin,double & xmax,GIAC_CONTEXT)4016 static gen polynomial_regression(const gen & g,int d,const gen & u1, const gen & u2,double & xmin, double & xmax,GIAC_CONTEXT){
4017 xmin=1e300,xmax=-xmin;
4018 vecteur v(genpoint2vecteur(g,contextptr));
4019 if (!ckmatrix(v) || v.empty() || v.front()._VECTptr->size()<2)
4020 return undef;
4021 // use first and second column
4022 const_iterateur it=v.begin(),itend=v.end();
4023 // int n(itend-it);
4024 gen sigmax,sigmay,sigmaxy,sigmax2,sigmay2,tmpx,tmpxd,tmpy;
4025 vecteur xmoment(2*d+1),xymoment(d+1);
4026 for (;it!=itend;++it){
4027 vecteur & w=*it->_VECTptr;
4028 if (u1.type==_FUNC)
4029 tmpx=u1(w.front(),contextptr);
4030 else
4031 tmpx=w.front();
4032 tmpxd=evalf_double(tmpx,1,contextptr);
4033 if (tmpxd.type==_DOUBLE_){
4034 double tmpxdd=tmpxd._DOUBLE_val;
4035 if (tmpxdd<xmin)
4036 xmin=tmpxdd;
4037 if (tmpxdd>xmax)
4038 xmax=tmpxdd;
4039 }
4040 if (u2.type==_FUNC)
4041 tmpy=u2(w.back(),contextptr);
4042 else
4043 tmpy=w.back();
4044 xmoment[0]=xmoment[0]+1;
4045 xymoment[0]=xymoment[0]+tmpy;
4046 for (int i=1;i<=2*d;++i)
4047 xmoment[i]=xmoment[i]+pow(tmpx,i);
4048 for (int i=1;i<=d;++i)
4049 xymoment[i]=xymoment[i]+pow(tmpx,i)*tmpy;
4050 }
4051 // make linear system
4052 matrice mat;
4053 for (int i=0;i<=d;++i){
4054 vecteur tmp;
4055 for (int j=d;j>=0;--j){
4056 tmp.push_back(xmoment[i+j]);
4057 }
4058 mat.push_back(tmp);
4059 }
4060 // return multmatvecteur(minv(mat,contextptr),xymoment);
4061 return linsolve(mat,xymoment,contextptr);
4062 }
polynomial_regression(const gen & g,double & xmin,double & xmax,GIAC_CONTEXT)4063 static gen polynomial_regression(const gen & g,double & xmin,double & xmax,GIAC_CONTEXT){
4064 if (g.type==_VECT && g._VECTptr->size()==3){
4065 vecteur & v=*g._VECTptr;
4066 if (v[0].type==_VECT && v[1].type==_VECT && v[0]._VECTptr->size()==v[1]._VECTptr->size())
4067 return polynomial_regression(makevecteur(mtran(makevecteur(v[0],v[1])),v[2]),xmin,xmax,contextptr);
4068 }
4069 if (g.type!=_VECT || g._VECTptr->size()!=2)
4070 return gensizeerr(contextptr);
4071 gen last=_floor(g._VECTptr->back(),contextptr);
4072 if (last.type!=_INT_)
4073 return gensizeerr(contextptr);
4074 return polynomial_regression(g._VECTptr->front(),absint(last.val),zero,zero,xmin,xmax,contextptr);
4075 }
_polynomial_regression(const gen & g,GIAC_CONTEXT)4076 gen _polynomial_regression(const gen & g,GIAC_CONTEXT){
4077 if ( g.type==_STRNG && g.subtype==-1) return g;
4078 double xmin,xmax;
4079 return polynomial_regression(g,xmin,xmax,contextptr);
4080 }
4081 static const char _polynomial_regression_s []="polynomial_regression";
4082 static define_unary_function_eval (__polynomial_regression,&_polynomial_regression,_polynomial_regression_s);
4083 define_unary_function_ptr5( at_polynomial_regression ,alias_at_polynomial_regression,&__polynomial_regression,0,true);
_polynomial_regression_plot(const gen & g,GIAC_CONTEXT)4084 gen _polynomial_regression_plot(const gen & g,GIAC_CONTEXT){
4085 if ( g.type==_STRNG && g.subtype==-1) return g;
4086 double xmin,xmax;
4087 vecteur attributs;
4088 bool eq,r;
4089 gen G=regression_plot_attributs(g,attributs,eq,r,contextptr);
4090 gen res=polynomial_regression(G,xmin,xmax,contextptr);
4091 if (is_undef(res)) return res;
4092 xmax += (xmax-xmin);
4093 res=horner(res,vx_var);
4094 return put_attributs(_plotfunc(gen(makevecteur(res,symb_equal(vx_var,symb_interval(xmin,xmax))),_SEQ__VECT),contextptr),attributs,contextptr);
4095 }
4096 static const char _polynomial_regression_plot_s []="polynomial_regression_plot";
4097 static define_unary_function_eval (__polynomial_regression_plot,&_polynomial_regression_plot,_polynomial_regression_plot_s);
4098 define_unary_function_ptr5( at_polynomial_regression_plot ,alias_at_polynomial_regression_plot,&__polynomial_regression_plot,0,true);
4099
4100 // logistic_regression
4101 // Qt=instant production at time t
4102 // Pt=cumulative production at time t
4103 // arg1=Qt_1...Qt_n, arg2=t1..tn or t1, arg3=Pt_1
4104 // or arg1=Qt_1...Qt_n, arg2=t1..tn or t1, n>=10, using Pt_1=Qt_1/(1-tau)
4105 // where tau is fitted from the first 5 records
logistic_regression(const gen & g,double & xmin,double & xmax,gen & r,GIAC_CONTEXT)4106 static gen logistic_regression(const gen & g,double & xmin,double & xmax,gen & r,GIAC_CONTEXT){
4107 if (g.type!=_VECT)
4108 return gensizeerr(contextptr);
4109 vecteur & v = *g._VECTptr;
4110 int s=int(v.size());
4111 if (s<2 || s>3)
4112 return gendimerr(contextptr);
4113 gen data=v[0];
4114 if (data.type!=_VECT)
4115 return gensizeerr(contextptr);
4116 vecteur & w=*data._VECTptr;
4117 int n=int(w.size());
4118 gen Pinit;
4119 if (s==2){
4120 if (n<20)
4121 return gendimerr(gettext("Guessing initial production requires more than 20 samples"));
4122 gen args=gen(makevecteur(makevecteur(0,1,2,3,4),ln(vecteur(w.begin(),w.begin()+5),contextptr)),_SEQ__VECT);
4123 gen res=_linear_regression(args,contextptr);
4124 if (res.type!=_VECT || res._VECTptr->size()!=2)
4125 return gentypeerr(contextptr);
4126 gen tmp=_correlation(evalf_double(args,1,contextptr),contextptr);
4127 if (tmp.type==_STRNG && tmp.subtype==-1) return tmp;
4128 Pinit=w[0]/(exp(res._VECTptr->front(),contextptr)-1);
4129 *logptr(contextptr) << gettext("Initial cumulative estimated to ") << Pinit << '\n' << gettext("Correlation for 5 first years to estimate initial cumulative : ") << tmp << '\n';
4130 }
4131 else
4132 Pinit=v[2];
4133 gen time=v[1],tinit,tend;
4134 if (time.is_symb_of_sommet(at_interval)){
4135 gen tmp=time._SYMBptr->feuille;
4136 if (tmp.type!=_VECT || tmp._VECTptr->size()!=2)
4137 return gensizeerr(contextptr);
4138 tinit=tmp._VECTptr->front();
4139 tend=tmp._VECTptr->back();
4140 }
4141 else {
4142 tinit=time;
4143 tend=time+int(w.size())-1;
4144 }
4145 tinit=evalf_double(tinit,1,contextptr);
4146 tend=evalf_double(tend,1,contextptr);
4147 if (tinit.type!=_DOUBLE_ || tend.type!=_DOUBLE_)
4148 return gensizeerr(contextptr);
4149 xmin = tinit._DOUBLE_val;
4150 xmax = tend._DOUBLE_val;
4151 gen tscale=(tend+1-tinit)/n;
4152 // compute cumulated production
4153 vecteur cum(n),quot(n);
4154 cum[0]=Pinit+w[0];
4155 quot[0]=w[0]/cum[0];
4156 for (int i=1;i<n;++i){
4157 cum[i]=cum[i-1]+w[i];
4158 quot[i]=w[i]/cum[i];
4159 }
4160 // linear regression of quot vs cum
4161 gen args=gen(makevecteur(cum,quot),_SEQ__VECT);
4162 gen res=_linear_regression(args,contextptr);
4163 r=_correlation(args,contextptr);
4164 if (r.type==_STRNG && r.subtype==-1) return r;
4165 if (res.type!=_VECT || res._VECTptr->size()!=2)
4166 return gendimerr(contextptr);
4167 gen a=res._VECTptr->front(),b=res._VECTptr->back(),urr=-b/a;
4168 *logptr(contextptr) << gettext("Pinstant=") << a << gettext("*Pcumul+") << b << '\n' << gettext("Correlation ") << r << gettext(", Estimated total P=") << urr << '\n' << gettext("Returning estimated Pcumul, Pinstant, Ptotal, Pinstantmax, tmax, R")<< '\n';
4169 // y'/y=a*y+b -> y=urr/[1+exp(-b*(t-t0))]
4170 // urr/y-1=exp(-b*(t-t0))
4171 // -> -b*(t-t0) = ln(urr/y-1)
4172 vecteur lnurr(n),t(n);
4173 for (int i=0;i<n;++i){
4174 lnurr[i]=ln(urr/cum[i]-1,contextptr);
4175 t[i]=tinit+i*tscale;
4176 }
4177 args=gen(makevecteur(t,lnurr),_SEQ__VECT);
4178 res=_linear_regression(args,contextptr);
4179 if (res.type!=_VECT || res._VECTptr->size()!=2)
4180 return gendimerr(contextptr);
4181 gen b2=res._VECTptr->front(),bt0=res._VECTptr->back();
4182 return makevecteur(urr/(1+exp(b2*vx_var+bt0,contextptr)),urr*b/2/(1+cosh(b2*vx_var+bt0,contextptr)),urr,urr*b/4,-bt0/b2,r);
4183 }
4184
_logistic_regression(const gen & g,GIAC_CONTEXT)4185 gen _logistic_regression(const gen & g,GIAC_CONTEXT){
4186 if ( g.type==_STRNG && g.subtype==-1) return g;
4187 double xmin,xmax;
4188 gen r;
4189 return logistic_regression(g,xmin,xmax,r,contextptr);
4190 }
4191 static const char _logistic_regression_s []="logistic_regression";
4192 static define_unary_function_eval (__logistic_regression,&_logistic_regression,_logistic_regression_s);
4193 define_unary_function_ptr5( at_logistic_regression ,alias_at_logistic_regression,&__logistic_regression,0,true);
4194
_logistic_regression_plot(const gen & g,GIAC_CONTEXT)4195 gen _logistic_regression_plot(const gen & g,GIAC_CONTEXT){
4196 if ( g.type==_STRNG && g.subtype==-1) return g;
4197 double xmin,xmax;
4198 vecteur attributs;
4199 bool eq,r;
4200 gen rcorr;
4201 gen G=regression_plot_attributs(g,attributs,eq,r,contextptr);
4202 gen res=logistic_regression(G,xmin,xmax,rcorr,contextptr);
4203 if (res.type==_STRNG && res.subtype==-1) return res;
4204 if (r){
4205 rcorr=rcorr*rcorr;
4206 string s = "R2="+rcorr.print(contextptr);
4207 attributs.push_back(string2gen(s,false));
4208 }
4209 xmax += (xmax-xmin);
4210 if (res.type!=_VECT || res._VECTptr->empty())
4211 return gensizeerr(contextptr);
4212 res=res[1];
4213 return put_attributs(_plotfunc(gen(makevecteur(res,symb_equal(vx_var,symb_interval(xmin,xmax))),_SEQ__VECT),contextptr),attributs,contextptr);
4214 }
4215 static const char _logistic_regression_plot_s []="logistic_regression_plot";
4216 static define_unary_function_eval (__logistic_regression_plot,&_logistic_regression_plot,_logistic_regression_plot_s);
4217 define_unary_function_ptr5( at_logistic_regression_plot ,alias_at_logistic_regression_plot,&__logistic_regression_plot,0,true);
4218
gen_interpolate(const gen & g,int deg,GIAC_CONTEXT)4219 static gen gen_interpolate(const gen & g,int deg,GIAC_CONTEXT){
4220 // args = matrix with 2 rows (x,y), xmin, xmax, xstep -> matrix of [x,y]
4221 if (g.type!=_VECT)
4222 return gensizeerr(contextptr);
4223 vecteur & v =*g._VECTptr;
4224 int s=int(v.size());
4225 if (s<4)
4226 return gensizeerr(contextptr);
4227 gen m=evalf_double(v[0],1,contextptr),
4228 Xmin=evalf_double(v[1],1,contextptr),
4229 Xmax=evalf_double(v[2],1,contextptr),
4230 Xstep=evalf_double(v[3],1,contextptr);
4231 if (!ckmatrix(m) || m._VECTptr->size()!=2 || Xmin.type!=_DOUBLE_ || Xmax.type!=_DOUBLE_ || Xstep.type!=_DOUBLE_)
4232 return gensizeerr(contextptr);
4233 double xmin=Xmin._DOUBLE_val,xmax=Xmax._DOUBLE_val,xstep=absdouble(Xstep._DOUBLE_val);
4234 // sort x in m
4235 matrice M(mtran(*m._VECTptr)); // 2 cols
4236 islesscomplexthanf_sort(M.begin(),M.end());
4237 reverse(M.begin(),M.end());
4238 int Ms=int(M.size());
4239 if (Ms<2)
4240 return gendimerr(contextptr);
4241 gen X0=M[0]._VECTptr->front(),X1=M[Ms-1]._VECTptr->front();
4242 if (X0.type!=_DOUBLE_ || X1.type!=_DOUBLE_)
4243 return gensizeerr(contextptr);
4244 double x0=X0._DOUBLE_val,x1=X1._DOUBLE_val;
4245 if (xmin<x0 || xmax>x1)
4246 return gensizeerr(gettext("Values out of range"));
4247 matrice res;
4248 int pos=0;
4249 gen Mcur=Xmin,Mnext=M[1]._VECTptr->front(),
4250 Ycur=M[0]._VECTptr->back(),Ynext=M[1]._VECTptr->back();
4251 double ycur;
4252 if (deg==1){
4253 for (double xcur=xmin;xcur<=xmax;xcur+=xstep){
4254 // find interval containing xcur in matrix
4255 for (;;){
4256 if (Mnext._DOUBLE_val>xcur)
4257 break;
4258 ++pos;
4259 if (pos==Ms)
4260 break;
4261 Mcur=M[pos]._VECTptr->front();
4262 Ycur=M[pos]._VECTptr->back();
4263 if (pos!=Ms-1){
4264 Mnext = M[pos+1]._VECTptr->front();
4265 Ynext = M[pos+1]._VECTptr->back();
4266 }
4267 }
4268 if (pos>=Ms-1){ // use Ycur
4269 res.push_back(makevecteur(xcur,Ycur));
4270 }
4271 else {
4272 ycur = Ycur._DOUBLE_val+(xcur-Mcur._DOUBLE_val)/(Mnext._DOUBLE_val-Mcur._DOUBLE_val)*(Ynext._DOUBLE_val-Ycur._DOUBLE_val);
4273 res.push_back(makevecteur(xcur,ycur));
4274 }
4275 }
4276 }
4277 else {
4278 vecteur current(deg+1); // contains the current Taylor expansion
4279 current[deg]=Ycur;
4280 // find z=current[0]: z*(Mnext-Mcur)^deg+Ycur=Ynext
4281 current[0]=(Ynext-Ycur)/pow(Mnext-Mcur,deg);
4282 for (double xcur=xmin;xcur<=xmax;xcur+=xstep){
4283 if (xcur>Mnext._DOUBLE_val){ // translate current, modify current[0]
4284 current=taylor(current,Mnext-Mcur);
4285 current[0]=0;
4286 Ycur=Ynext;
4287 Mcur=Mnext;
4288 ++pos;
4289 if (pos<Ms-1){
4290 Mnext = M[pos+1]._VECTptr->front();
4291 Ynext = M[pos+1]._VECTptr->back();
4292 current[0]=(Ynext-horner(current,Mnext-Mcur))/pow(Mnext-Mcur,deg);
4293 }
4294 }
4295 ycur=horner(current,xcur-Mcur)._DOUBLE_val;
4296 res.push_back(makevecteur(xcur,ycur));
4297 }
4298 }
4299 return mtran(res);
4300 }
_linear_interpolate(const gen & g,GIAC_CONTEXT)4301 gen _linear_interpolate(const gen & g,GIAC_CONTEXT){
4302 if ( g.type==_STRNG && g.subtype==-1) return g;
4303 return gen_interpolate(g,1,contextptr);
4304 }
4305 static const char _linear_interpolate_s []="linear_interpolate";
4306 static define_unary_function_eval (__linear_interpolate,&_linear_interpolate,_linear_interpolate_s);
4307 define_unary_function_ptr5( at_linear_interpolate ,alias_at_linear_interpolate,&__linear_interpolate,0,true);
4308
_parabolic_interpolate(const gen & g,GIAC_CONTEXT)4309 gen _parabolic_interpolate(const gen & g,GIAC_CONTEXT){
4310 if ( g.type==_STRNG && g.subtype==-1) return g;
4311 return gen_interpolate(g,2,contextptr);
4312 }
4313 static const char _parabolic_interpolate_s []="parabolic_interpolate";
4314 static define_unary_function_eval (__parabolic_interpolate,&_parabolic_interpolate,_parabolic_interpolate_s);
4315 define_unary_function_ptr5( at_parabolic_interpolate ,alias_at_parabolic_interpolate,&__parabolic_interpolate,0,true);
4316
prepare_effectifs(const vecteur & v,GIAC_CONTEXT)4317 static vector<double> prepare_effectifs(const vecteur & v,GIAC_CONTEXT){
4318 if (v.empty())
4319 return vector<double>(0);
4320 vecteur w;
4321 if (ckmatrix(v)){
4322 int s=int(v.front()._VECTptr->size());
4323 if (s==1)
4324 w=*evalf_double(mtran(v)[0],1,contextptr)._VECTptr;
4325 else
4326 return vector<double>(0);
4327 }
4328 else
4329 w=*evalf_double(v,1,contextptr)._VECTptr;
4330 // vector will be sorted keeping only DOUBLE data
4331 int s=int(w.size());
4332 vector<double> w1;
4333 w1.reserve(s);
4334 for (int i=0;i<s;++i){
4335 if (w[i].type==_DOUBLE_)
4336 w1.push_back(w[i]._DOUBLE_val);
4337 }
4338 sort(w1.begin(),w1.end());
4339 s=int(w1.size());
4340 if (!s)
4341 return vector<double>(0);
4342 return w1;
4343 }
effectifs(const vecteur & data,double class_minimum,double class_size,GIAC_CONTEXT)4344 matrice effectifs(const vecteur & data,double class_minimum,double class_size,GIAC_CONTEXT){
4345 if (data.empty())
4346 return data;
4347 if (class_size<=0){
4348 *logptr(contextptr) << gettext("Invalid class size (replaced by 1) ") << class_size << '\n';
4349 class_size=1;
4350 }
4351 vector<double> w1;
4352 if (ckmatrix(data)){
4353 if (!data.empty() && data.front()._VECTptr->size()>1){
4354 matrice tmp=data;
4355 gen_sort_f(tmp.begin(),tmp.end(),first_ascend_sort);
4356 tmp=mtran(tmp);
4357 vecteur tmpval=*evalf_double(tmp[0],1,contextptr)._VECTptr;
4358 vecteur tmpeff=*tmp[1]._VECTptr;
4359 if (tmpval.front().type!=_DOUBLE_ || tmpval.back().type!=_DOUBLE_)
4360 return vecteur(1,undef);
4361 double kbegin=std::floor((tmpval.front()._DOUBLE_val-class_minimum)/class_size);
4362 double kend=std::floor((tmpval.back()._DOUBLE_val-class_minimum)/class_size);
4363 int s=int(tmpval.size()),i=0;
4364 vecteur res;
4365 for (;kbegin<=kend;++kbegin){
4366 // count in this class
4367 double min_class=kbegin*class_size+class_minimum;
4368 double max_class=min_class+class_size;
4369 gen effectif;
4370 for (;i<s;effectif=effectif+tmpeff[i],++i){
4371 if (tmpval[i].type!=_DOUBLE_)
4372 return vecteur(1,undef);
4373 if (tmpval[i]._DOUBLE_val>=max_class)
4374 break;
4375 }
4376 res.push_back(makevecteur(symbolic(at_interval,makesequence(min_class,max_class)),effectif));
4377 }
4378 return res;
4379 }
4380 w1=prepare_effectifs(*mtran(data)[0]._VECTptr,contextptr);
4381 }
4382 else
4383 w1=prepare_effectifs(data,contextptr);
4384 if (w1.empty())
4385 return vecteur(1,undef);
4386 // class_min + k*class_size <= mini hence k
4387 double kbegin=std::floor((w1.front()-class_minimum)/class_size);
4388 double kend=std::floor((w1.back()-class_minimum)/class_size);
4389 if (kend-kbegin>LIST_SIZE_LIMIT)
4390 return vecteur(1,gendimerr("Too many classes"));
4391 vector<double>::const_iterator it=w1.begin(),itend=w1.end();
4392 vecteur res;
4393 for (;kbegin<=kend;++kbegin){
4394 // count in this class
4395 double min_class=kbegin*class_size+class_minimum;
4396 double max_class=min_class+class_size;
4397 int effectif=0;
4398 for (;it!=itend;++it,++effectif){
4399 if (*it>=max_class)
4400 break;
4401 }
4402 res.push_back(makevecteur(symbolic(at_interval,makesequence(min_class,max_class)),effectif));
4403 }
4404 return res;
4405 }
4406
effectifs(const vecteur & data,const vecteur & intervalles,GIAC_CONTEXT)4407 static matrice effectifs(const vecteur & data,const vecteur & intervalles,GIAC_CONTEXT){
4408 int s=int(intervalles.size());
4409 matrice res(s);
4410 vector<double> sorted_data;
4411 if (ckmatrix(data))
4412 sorted_data=prepare_effectifs(*mtran(data)[0]._VECTptr,contextptr);
4413 else
4414 sorted_data=prepare_effectifs(data,contextptr);
4415 if (sorted_data.empty())
4416 return vecteur(1,undef);
4417 vector<double>::const_iterator it=sorted_data.begin(),itend=sorted_data.end();
4418 for (int i=0;i<s;++i){
4419 gen cur_intervalle=intervalles[i];
4420 double debut,fin;
4421 if (!chk_double_interval(cur_intervalle,debut,fin,contextptr))
4422 return vecteur(1,undef);
4423 for (;it!=itend;++it){
4424 if (*it>=debut)
4425 break;
4426 }
4427 int effectif=0;
4428 for (;it!=itend;++it,++effectif){
4429 if (*it>=fin)
4430 break;
4431 }
4432 res[i]=makevecteur(cur_intervalle,effectif);
4433 }
4434 return res;
4435 }
4436
centres2intervalles(const vecteur & centres,double class_min,bool with_class_min,GIAC_CONTEXT)4437 static vecteur centres2intervalles(const vecteur & centres,double class_min,bool with_class_min,GIAC_CONTEXT){
4438 if (centres.size()<2)
4439 return vecteur(1,gensizeerr(contextptr));
4440 double d0=evalf_double(centres[0],1,contextptr)._DOUBLE_val,d1=evalf_double(centres[1],1,contextptr)._DOUBLE_val;
4441 double debut=class_min;
4442 if (!with_class_min || debut<=-1e307)
4443 debut=d0+(d0-d1)/2;
4444 vecteur res;
4445 const_iterateur it=centres.begin(),itend=centres.end();
4446 res.reserve(itend-it);
4447 for (;it!=itend;++it){
4448 gen g=evalf_double(*it,1,contextptr);
4449 if (g.type!=_DOUBLE_)
4450 return vecteur(1,gensizeerr(contextptr));
4451 double milieu=g._DOUBLE_val;
4452 double fin=milieu+(milieu-debut);
4453 if (it+1!=itend){
4454 g=evalf_double(*(it+1),1,contextptr);
4455 if (g.type!=_DOUBLE_)
4456 return vecteur(1,gensizeerr(contextptr));
4457 fin=(milieu+g._DOUBLE_val)/2;
4458 }
4459 if (fin<=debut)
4460 return vecteur(1,gensizeerr(contextptr));
4461 res.push_back(symb_interval(debut,fin));
4462 debut=fin;
4463 }
4464 return res;
4465 }
4466
_center2interval(const gen & g,GIAC_CONTEXT)4467 gen _center2interval(const gen & g,GIAC_CONTEXT){
4468 if ( g.type==_STRNG && g.subtype==-1) return g;
4469 if (g.type!=_VECT)
4470 return gentypeerr(contextptr);
4471 if (g.subtype==_SEQ__VECT && g._VECTptr->size()==2){
4472 vecteur & v=*g._VECTptr;
4473 gen c=evalf_double(v[1],1,contextptr);
4474 if (v[0].type!=_VECT || c.type!=_DOUBLE_)
4475 return gentypeerr(contextptr);
4476 return gen(centres2intervalles(*v[0]._VECTptr,c._DOUBLE_val,true,contextptr),_SEQ__VECT);
4477 }
4478 return gen(centres2intervalles(*g._VECTptr,0.0,false,contextptr),_SEQ__VECT);
4479 }
4480 static const char _center2interval_s []="center2interval";
4481 static define_unary_function_eval (__center2interval,&_center2interval,_center2interval_s);
4482 define_unary_function_ptr5( at_center2interval ,alias_at_center2interval,&__center2interval,0,true);
4483
4484
histogram(const vecteur & v,double class_minimum,double class_size,const vecteur & attributs,GIAC_CONTEXT)4485 static gen histogram(const vecteur & v,double class_minimum,double class_size,const vecteur & attributs,GIAC_CONTEXT){
4486 #ifndef WIN32
4487 bool old_iograph=io_graph(contextptr);
4488 io_graph(false,contextptr);
4489 #endif
4490 if (class_size<=0){
4491 // find class_minimum and class_size from data and number of classes
4492 int nc=int(class_minimum); // arg passed is the number of classes
4493 vector<double> w=prepare_effectifs(v,contextptr);
4494 if (w.size()<2)
4495 return gensizeerr(contextptr);
4496 class_minimum=w.front();
4497 class_size=((w.back()-w.front())*(1+1e-12))/nc;
4498 }
4499 if (ckmatrix(v) && !v.empty() && v.front()._VECTptr->size()==2){
4500 // matrix format is 2 columns 1st column=interval, 2nd column=frequency
4501 // OR value/frequencies
4502 // get total of population
4503 const_iterateur it=v.begin(),itend=v.end();
4504 double n=0;
4505 for (;it!=itend;++it)
4506 n += evalf_double(it->_VECTptr->back(),1,contextptr)._DOUBLE_val;
4507 // get surface
4508 gen g=v.front()._VECTptr->front();
4509 if (g.is_symb_of_sommet(at_interval)){
4510 g=g._SYMBptr->feuille;
4511 if (g.type!=_VECT || g._VECTptr->size()!=2)
4512 return gentypeerr(contextptr);
4513 g=evalf_double(g._VECTptr->front(),1,contextptr);
4514 }
4515 else
4516 g=g-class_size/2;
4517 gen h=(itend-1)->_VECTptr->front();
4518 if (h.is_symb_of_sommet(at_interval)){
4519 h=h._SYMBptr->feuille;
4520 if (h.type!=_VECT || h._VECTptr->size()!=2)
4521 return gentypeerr(contextptr);
4522 h=evalf_double(h._VECTptr->back(),1,contextptr);
4523 }
4524 else
4525 h=h+class_size/2;
4526 if (g.type!=_DOUBLE_ || h.type!=_DOUBLE_ || g._DOUBLE_val>=h._DOUBLE_val)
4527 return gensizeerr(contextptr);
4528 double inf,sup; // delta=h._DOUBLE_val-g._DOUBLE_val;
4529 it=v.begin();
4530 // int nclass=itend-it;
4531 #if defined HAVE_LIBFLTK && defined GIAC_LMCHANGES // changes by L. Marohnić
4532 vecteur res(1,symb_equal(change_subtype(gen(_AXES),_INT_PLOT),3));
4533 #else
4534 vecteur res;
4535 #endif
4536 for (;it!=itend;++it){
4537 gen current=it->_VECTptr->front();
4538 if (current.is_symb_of_sommet(at_interval)){
4539 if (!chk_double_interval(current,inf,sup,contextptr))
4540 return gentypeerr(contextptr);
4541 }
4542 else {
4543 gen tmp=evalf_double(current,1,contextptr);
4544 if (tmp.type!=_DOUBLE_)
4545 return gentypeerr(contextptr);
4546 inf = tmp._DOUBLE_val -class_size/2;
4547 sup = tmp._DOUBLE_val + class_size/2;
4548 }
4549 double height=1/(sup-inf);
4550 height=height*evalf_double(it->_VECTptr->back(),1,contextptr)._DOUBLE_val/n;
4551 gen mini(inf,height),maxi(sup,height);
4552 gen rectan(makevecteur(inf,sup,maxi,mini,inf),_LINE__VECT);
4553 res.push_back(pnt_attrib(rectan,attributs,contextptr));
4554 #ifdef GIAC_LMCHANGES // changes by L. Marohnić
4555 res.push_back(_segment(makevecteur(inf,mini),contextptr));
4556 res.push_back(_segment(makevecteur(mini,maxi),contextptr));
4557 res.push_back(_segment(makevecteur(maxi,sup),contextptr));
4558 res.push_back(_segment(makevecteur(inf,sup),contextptr));
4559 #else
4560 // res.push_back(_segment(makevecteur(inf,mini),contextptr));
4561 // res.push_back(_segment(makevecteur(mini,maxi),contextptr));
4562 // res.push_back(_segment(makevecteur(maxi,sup),contextptr));
4563 #endif
4564 }
4565 #ifndef WIN32
4566 io_graph(old_iograph,contextptr);
4567 #endif
4568 return res;
4569 }
4570 vector<double> w1=prepare_effectifs(v,contextptr);
4571 int s=int(w1.size());
4572 if (!s)
4573 return gendimerr(contextptr);
4574 // class_min + k*class_size <= mini hence k
4575 double kbegin=std::floor((w1.front()-class_minimum)/class_size);
4576 double kend=std::floor((w1.back()-class_minimum)/class_size);
4577 vector<double>::const_iterator it=w1.begin(),itend=w1.end();
4578 #if defined HAVE_LIBFLTK && defined GIAC_LMCHANGES // changes by L. Marohnić
4579 vecteur res(1,symb_equal(change_subtype(gen(_AXES),_INT_PLOT),3));
4580 #else
4581 vecteur res;
4582 #endif
4583 for (;kbegin<=kend;++kbegin){
4584 // count in this class
4585 double min_class=kbegin*class_size+class_minimum;
4586 double max_class=min_class+class_size;
4587 double effectif=0;
4588 for (;it!=itend;++it,++effectif){
4589 if (*it>=max_class)
4590 break;
4591 }
4592 effectif /= s*class_size; // height of the class
4593 gen ming=min_class+gen(0.0,effectif);
4594 gen maxg=max_class+gen(0.0,effectif);
4595 gen rectan(makevecteur(min_class,max_class,maxg,ming,min_class),_LINE__VECT);
4596 res.push_back(pnt_attrib(rectan,attributs,contextptr));
4597 #ifdef GIAC_LMCHANGES // changes by L. Marohnić
4598 res.push_back(_segment(makevecteur(min_class,ming),contextptr));
4599 res.push_back(_segment(makevecteur(ming,maxg),contextptr));
4600 res.push_back(_segment(makevecteur(maxg,max_class),contextptr));
4601 res.push_back(_segment(makevecteur(min_class,max_class),contextptr));
4602 #else
4603 // res.push_back(_segment(makevecteur(min_class,ming),contextptr));
4604 // res.push_back(_segment(makevecteur(ming,maxg),contextptr));
4605 // res.push_back(_segment(makevecteur(maxg,max_class),contextptr));
4606 #endif
4607 }
4608 #ifndef WIN32
4609 io_graph(old_iograph,contextptr);
4610 #endif
4611 return res; // gen(res,_SEQ__VECT);
4612 }
_histogram(const gen & g,GIAC_CONTEXT)4613 gen _histogram(const gen & g,GIAC_CONTEXT){
4614 if ( g.type==_STRNG && g.subtype==-1) return g;
4615 if (g.type==_SYMB && is_distribution(g)){
4616 vecteur v(gen2vecteur(g._SYMBptr->feuille));
4617 v.insert(v.begin(),g._SYMBptr->sommet);
4618 return _histogram(gen(v,_SEQ__VECT),contextptr);
4619 }
4620 if (g.type!=_VECT)
4621 return gensizeerr(contextptr);
4622 vecteur args;
4623 if (g.subtype==_SEQ__VECT)
4624 args=*g._VECTptr;
4625 #if defined HAVE_LIBFLTK && defined GIAC_LMCHANGES // changes by L. Marohnić
4626 vecteur attributs(1,int(FL_DARK1));
4627 int s=read_attributs(args,attributs,contextptr);
4628 int col=attributs[0].val;
4629 col=int(unsigned(col) | _FILL_POLYGON);
4630 attributs[0]=col;
4631 #else
4632 vecteur attributs(1,default_color(contextptr));
4633 int s=read_attributs(args,attributs,contextptr);
4634 #endif
4635 args=vecteur(args.begin(),args.begin()+s);
4636 int nd;
4637 if (s>=1 && (nd=is_distribution(args[0]))){
4638 if (args[0].type==_SYMB){
4639 vecteur tmp(gen2vecteur(args[0]._SYMBptr->feuille));
4640 for (unsigned i=0;i<tmp.size();++i)
4641 args.insert(args.begin()+1+i,tmp[i]); // inefficient ...
4642 args[0]=args[0]._SYMBptr->sommet;
4643 s+=int(tmp.size());
4644 }
4645 gen a,b;
4646 if (distrib_support(nd,a,b,true) || s!=distrib_nargs(nd)+1)
4647 return gensizeerr(contextptr);
4648 args.push_back(vx_var);
4649 gen res;
4650 if (args[0].type==_FUNC)
4651 res=symbolic(*args[0]._FUNCptr,gen(vecteur(args.begin()+1,args.end()),_SEQ__VECT));
4652 else
4653 res=args[0](gen(vecteur(args.begin()+1,args.end()),_SEQ__VECT),contextptr);
4654 if (nd==2) // binomial
4655 b=args[1];
4656 if (a.type!=_INT_ || !is_integral(b) || b.type!=_INT_ || b.val<=0)
4657 return gensizeerr(contextptr);
4658 int A=a.val,B=b.val;
4659 vecteur v;
4660 for (int i=A;i<=B;++i){
4661 gen y=subst(res,vx_var,i,false,contextptr);
4662 vecteur w=makevecteur(i-.5,i+.5,i+.5+cst_i*y,i-.5+cst_i*y);
4663 w.push_back(w.front());
4664 v.push_back(pnt_attrib(gen(w,_GROUP__VECT),attributs,contextptr));
4665 }
4666 return v;
4667 }
4668 if (s>=2){
4669 if (args[0].type!=_VECT)
4670 return gensizeerr(contextptr);
4671 vecteur data=*args[0]._VECTptr;
4672 if (data.empty())
4673 return gensizeerr(contextptr);
4674 if (data.front().type==_VECT && data.front()._VECTptr->size()==1 && ckmatrix(data))
4675 data=*mtran(data).front()._VECTptr;
4676 gen arg1=evalf_double(args[1],1,contextptr);
4677 if (ckmatrix(data)&&arg1.type==_DOUBLE_){ // [ [center, effectif] ... ], min
4678 data=mtran(data); // 1st line = all centers
4679 if (data.size()!=2)
4680 return gensizeerr(contextptr);
4681 data[0]=centres2intervalles(*data[0]._VECTptr,arg1._DOUBLE_val,true,contextptr);
4682 if (is_undef(data[0]))
4683 return gensizeerr(contextptr);
4684 data=mtran(data);
4685 gen g=data[0][0];
4686 if (g.is_symb_of_sommet(at_interval) && g._SYMBptr->feuille.type==_VECT && g._SYMBptr->feuille._VECTptr->size()==2){
4687 gen g1=g._SYMBptr->feuille._VECTptr->front();
4688 g1=evalf_double(g1,1,contextptr);
4689 gen g2=g._SYMBptr->feuille._VECTptr->back();
4690 g2=evalf_double(g2,1,contextptr);
4691 if (g1.type==_DOUBLE_ && g2.type==_DOUBLE_)
4692 return histogram(data,g1._DOUBLE_val,(g2-g1)._DOUBLE_val,attributs,contextptr);
4693 }
4694 return histogram(data,0.0,0.0,attributs,contextptr);
4695 }
4696 if (s==3){
4697 gen arg2=evalf_double(args[2],1,contextptr);
4698 if (arg1.type==_DOUBLE_ && arg2.type==_DOUBLE_)
4699 return histogram(data,arg1._DOUBLE_val,arg2._DOUBLE_val,attributs,contextptr);
4700 }
4701 if (s==2 && is_integral(arg1) && arg1.type==_INT_ && arg1.val>0)
4702 return histogram(data,arg1.val,0.0,attributs,contextptr);
4703 if (s==2 && args[1].type==_VECT)
4704 return _histogram(gen(makevecteur(mtran(args),-1.1e307),_SEQ__VECT),contextptr);
4705 return gensizeerr(contextptr);
4706 }
4707 if (s==1 && args.front().type==_VECT)
4708 args=*args.front()._VECTptr;
4709 else
4710 args=gen2vecteur(g);
4711 if (ckmatrix(args)){
4712 gen tmp=args[0];
4713 if (tmp._VECTptr->size()==2 && !tmp._VECTptr->front().is_symb_of_sommet(at_interval)){
4714 vecteur data=mtran(args); // 1st line = all centers
4715 if (data.size()!=2)
4716 return gensizeerr(contextptr);
4717 data[0]=centres2intervalles(*data[0]._VECTptr,0,false,contextptr);
4718 if (is_undef(data[0]))
4719 return gensizeerr(contextptr);
4720 data=mtran(data);
4721 return histogram(data,0.0,1e-14,attributs,contextptr);
4722 }
4723 }
4724 return histogram(args,class_minimum,class_size,attributs,contextptr);
4725 }
4726 static const char _histogram_s []="histogram";
4727 static define_unary_function_eval (__histogram,&_histogram,_histogram_s);
4728 define_unary_function_ptr5( at_histogram ,alias_at_histogram,&__histogram,0,true);
4729
4730 struct xeff {
4731 double x;
4732 double eff;
xeffgiac::xeff4733 xeff(): x(0),eff(0) {}
xeffgiac::xeff4734 xeff(double x0,double eff0): x(x0),eff(eff0) {}
4735 };
4736
operator <(const xeff & a,const xeff & b)4737 bool operator <(const xeff & a,const xeff & b){
4738 return a.x<b.x;
4739 }
4740
frequencies(const gen & v,GIAC_CONTEXT)4741 vecteur frequencies(const gen & v,GIAC_CONTEXT){
4742 gen g(_sort(v,contextptr));
4743 if (g.type!=_VECT)
4744 return vecteur(1,g);
4745 vecteur & w = *g._VECTptr;
4746 double total=double(w.size());
4747 vecteur res;
4748 gen current=w[0]; unsigned count=1;
4749 for (unsigned i=1;i<w.size();++i){
4750 if (w[i]!=current){
4751 res.push_back(makevecteur(current,count/total));
4752 current=w[i];
4753 count=0;
4754 }
4755 ++count;
4756 }
4757 res.push_back(makevecteur(current,count/total));
4758 return res;
4759 }
_frequencies(const gen & g,GIAC_CONTEXT)4760 gen _frequencies(const gen & g,GIAC_CONTEXT){
4761 gen h=evalf_double(g,1,contextptr);
4762 if (h.type!=_VECT || !is_numericv(*h._VECTptr) || h._VECTptr->empty())
4763 return gensizeerr(contextptr);
4764 return frequencies(g,contextptr);
4765 }
4766 static const char _frequencies_s []="frequencies";
4767 static define_unary_function_eval (__frequencies,&_frequencies,_frequencies_s);
4768 define_unary_function_ptr5( at_frequencies ,alias_at_frequencies,&__frequencies,0,true);
4769
_cumulated_frequencies(const gen & g,GIAC_CONTEXT)4770 gen _cumulated_frequencies(const gen & g,GIAC_CONTEXT){
4771 if ( g.type==_STRNG && g.subtype==-1) return g;
4772 gen g0(g);
4773 double class_min=class_minimum;//,class_s=class_size;
4774 if (g0.type==_VECT && g0.subtype==_SEQ__VECT && g0._VECTptr->size()==2){
4775 vecteur v = *g._VECTptr;
4776 gen tmp=evalf_double(v[1],1,contextptr);
4777 if (tmp.type!=_DOUBLE_) {
4778 if (ckmatrix(g)){
4779 // if (!v[0]._VECTptr->front().is_symb_of_sommet(at_interval)) v[0]=centres2intervalles(*v[0]._VECTptr,-1.1e307,true,contextptr);
4780 if (is_undef(v[0]))
4781 return gensizeerr(contextptr);
4782 g0=mtran(v);
4783 }
4784 }
4785 else {
4786 g0=v[0];
4787 class_min=tmp._DOUBLE_val;
4788 }
4789 }
4790 if (!ckmatrix(g0)){
4791 gen h=evalf_double(g0,1,contextptr);
4792 if (h.type!=_VECT || !is_numericv(*h._VECTptr) || h._VECTptr->empty())
4793 return gensizeerr(contextptr);
4794 g0=frequencies(g0,contextptr);
4795 }
4796 // 1st column = values (or classes), 2nd column = effectif
4797 matrice m= *g0._VECTptr ;
4798 if (m.empty() || m[0]._VECTptr->size()<2)
4799 return gensizeerr(contextptr);
4800 int s=int(m[0]._VECTptr->size());
4801 vecteur ans;
4802 for (int k=1;k<s;++k){
4803 // compute total eff
4804 iterateur it=m.begin(),itend=m.end();
4805 vector<xeff> veff;
4806 double n=0,x=0;
4807 if (it !=itend && it->_VECTptr->front().is_symb_of_sommet(at_interval)){
4808 gen tmp=it->_VECTptr->front()._SYMBptr->feuille;
4809 if (tmp.type!=_VECT || tmp._VECTptr->size()!=2)
4810 return gensizeerr(contextptr);
4811 else
4812 tmp=tmp._VECTptr->front();
4813 tmp=evalf_double(tmp,1,contextptr);
4814 if (tmp.type!=_DOUBLE_)
4815 return gensizeerr(contextptr);
4816 veff.push_back(xeff(tmp._DOUBLE_val,0));
4817 }
4818 else
4819 veff.push_back(xeff(class_min,0));
4820 bool interv=false;
4821 for (;it!=itend;++it){
4822 vecteur & v = *it->_VECTptr;
4823 gen tmp=evalf_double(v[k],1,contextptr);
4824 if (tmp.type!=_DOUBLE_)
4825 return gensizeerr(contextptr);
4826 // class_s = tmp._DOUBLE_val - x;
4827 n = n + (x=tmp._DOUBLE_val) ;
4828 if (v.front().is_symb_of_sommet(at_interval)){
4829 interv=true;
4830 tmp=v.front()._SYMBptr->feuille;
4831 if (tmp.type!=_VECT || tmp._VECTptr->size()!=2)
4832 return gensizeerr(contextptr);
4833 else
4834 tmp=tmp._VECTptr->back();
4835 }
4836 else
4837 tmp=v.front(); // +class_s/2; // FIX 30/11/2012 for e.g. cumulated_frequencies([[1,0.3],[2,0.5],[3,0.2]])
4838 tmp=evalf_double(tmp,1,contextptr);
4839 if (tmp.type!=_DOUBLE_)
4840 return gensizeerr(contextptr);
4841 veff.push_back(xeff(tmp._DOUBLE_val,x));
4842 }
4843 sort(veff.begin(),veff.end());
4844 vecteur res;
4845 vecteur respnt;
4846 vector<xeff>::const_iterator jt=veff.begin(),jtend=veff.end();
4847 double cumul=0,oldcumul=0;
4848 for (;jt!=jtend;++jt){
4849 cumul += jt->eff/n ;
4850 if (!interv)
4851 res.push_back(gen(jt->x)+cst_i*gen(oldcumul));
4852 res.push_back(gen(jt->x)+cst_i*gen(cumul));
4853 oldcumul=cumul;
4854 respnt.push_back(symb_pnt(gen(jt->x)+cst_i*gen(cumul),k+_POINT_WIDTH_2,contextptr));
4855 }
4856 ans.push_back(symb_pnt(gen(res,_GROUP__VECT),k,contextptr));
4857 ans.push_back(respnt);
4858 }
4859 return gen(ans,_SEQ__VECT);
4860 }
4861 static const char _cumulated_frequencies_s []="cumulated_frequencies";
4862 static define_unary_function_eval (__cumulated_frequencies,&_cumulated_frequencies,_cumulated_frequencies_s);
4863 define_unary_function_ptr5( at_cumulated_frequencies ,alias_at_cumulated_frequencies,&__cumulated_frequencies,0,true);
4864
4865 // classes(vector or column matrix,begin of class, class size)
4866 // " ( " ,list of intervals)
4867 // " ( " ,list of centers,begin of 1st class)
_classes(const gen & g,GIAC_CONTEXT)4868 gen _classes(const gen & g,GIAC_CONTEXT){
4869 if ( g.type==_STRNG && g.subtype==-1) return g;
4870 if (g.type==_VECT && g.subtype==_SEQ__VECT){
4871 vecteur & args=*g._VECTptr;
4872 int s=int(args.size());
4873 if (s<2)
4874 return gensizeerr(contextptr);
4875 if (args[0].type!=_VECT)
4876 return gensizeerr(contextptr);
4877 vecteur data=*args[0]._VECTptr;
4878 if (s==2 && args[1].type==_VECT){ // 2nd arg=list of intervals
4879 return effectifs(data,*args[1]._VECTptr,contextptr);
4880 }
4881 if (s==3){
4882 gen arg2=evalf_double(args[2],1,contextptr);
4883 gen arg1=evalf_double(args[1],1,contextptr);
4884 if (args[2].type==_VECT && arg1.type==_DOUBLE_){
4885 vecteur tmp=centres2intervalles(*args[2]._VECTptr,0.0,false,contextptr);
4886 if (is_undef(tmp))
4887 return gensizeerr(contextptr);
4888 return effectifs(data,tmp,contextptr);
4889 }
4890 if (arg1.type==_DOUBLE_ && arg2.type==_DOUBLE_)
4891 return effectifs(data,arg1._DOUBLE_val,arg2._DOUBLE_val,contextptr);
4892 }
4893 return gensizeerr(contextptr);
4894 }
4895 vecteur v(gen2vecteur(g));
4896 return effectifs(v,class_minimum,class_size,contextptr);
4897 }
4898 static const char _classes_s []="classes";
4899 static define_unary_function_eval (__classes,&_classes,_classes_s);
4900 define_unary_function_ptr5( at_classes ,alias_at_classes,&__classes,0,true);
4901
listplot(const gen & g,vecteur & attributs,GIAC_CONTEXT)4902 static vecteur listplot(const gen & g,vecteur & attributs,GIAC_CONTEXT){
4903 if (g.type!=_VECT || g._VECTptr->empty())
4904 return vecteur(1,gensizeerr(contextptr));
4905 int s=read_attributs(*g._VECTptr,attributs,contextptr);
4906 vecteur v;
4907 if (g.subtype==_SEQ__VECT && s>=4 && g[1].type==_IDNT)
4908 return listplot(_seq(g,contextptr),attributs,contextptr);
4909 if (s>=2 && g._VECTptr->front().type<=_DOUBLE_ && g[1].type==_VECT){
4910 int l=int(g[1]._VECTptr->size());
4911 v=*g._VECTptr;
4912 v[0]=vecteur(l);
4913 double d=evalf_double(g._VECTptr->front(),1,contextptr)._DOUBLE_val;
4914 for (int j=0;j<l;++j){
4915 (*v[0]._VECTptr)[j]=j+d;
4916 }
4917 if (!ckmatrix(v))
4918 return vecteur(1,gendimerr(contextptr));
4919 v=mtran(v);
4920 }
4921 else {
4922 if (g._VECTptr->front().type==_VECT){
4923 vecteur & v0 = *g._VECTptr->front()._VECTptr;
4924 int v0s=int(v0.size());
4925 if (s==1)
4926 v=v0;
4927 else {
4928 if (v0s==1 && ckmatrix(g))
4929 v=*mtran(*g._VECTptr).front()._VECTptr;
4930 else
4931 v=*g._VECTptr;
4932 }
4933 }
4934 else
4935 v=*g._VECTptr;
4936 }
4937 s=int(v.size());
4938 vecteur res;
4939 res.reserve(s);
4940 for (int i=0;i<s;++i){
4941 gen tmp=v[i];
4942 if (tmp.type==_VECT){
4943 if (tmp._VECTptr->size()==2)
4944 res.push_back(tmp._VECTptr->front()+cst_i*tmp._VECTptr->back());
4945 else
4946 return vecteur(1,gendimerr(contextptr));
4947 }
4948 else
4949 res.push_back(i+(xcas_mode(contextptr)?1:0)+cst_i*tmp);
4950 }
4951 return res;
4952 }
4953
_listplot(const gen & g,GIAC_CONTEXT)4954 gen _listplot(const gen & g,GIAC_CONTEXT){
4955 if ( g.type==_STRNG && g.subtype==-1) return g;
4956 vecteur attributs(1,default_color(contextptr));
4957 vecteur res=listplot(g,attributs,contextptr);
4958 if (is_undef(res) && !res.empty())
4959 return res.front();
4960 if (attributs.size()>1)
4961 return symb_pnt_name(gen(res,_GROUP__VECT),attributs[0],attributs[1],contextptr);
4962 else
4963 return symb_pnt(gen(res,_GROUP__VECT),attributs[0],contextptr);
4964 }
4965 static const char _listplot_s []="listplot";
4966 static define_unary_function_eval (__listplot,&_listplot,_listplot_s);
4967 define_unary_function_ptr5( at_listplot ,alias_at_listplot,&__listplot,0,true);
4968 static const char _plotlist_s []="plotlist";
4969 static define_unary_function_eval (__plotlist,&_listplot,_plotlist_s);
4970 define_unary_function_ptr5( at_plotlist ,alias_at_plotlist,&__plotlist,0,true);
4971
4972 // [[x1 y1] [x2 y2] ...]
scatterplot(const gen & g,int mode,GIAC_CONTEXT)4973 static gen scatterplot(const gen & g,int mode,GIAC_CONTEXT){
4974 bool polygone=bool(mode&1),scatter=bool(mode&2),bar=bool(mode &4);
4975 vecteur v(gen2vecteur(g));
4976 vecteur attr(1,default_color(contextptr));
4977 int s=read_attributs(v,attr,contextptr);
4978 if (s==1 && ckmatrix(v.front()))
4979 v=*v.front()._VECTptr;
4980 else
4981 v=vecteur(v.begin(),v.begin()+s);
4982 if (s>2 && v.back().type==_INT_){
4983 // discard size
4984 --s;
4985 v.pop_back();
4986 }
4987 if (g.type==_VECT && s==2 && g.subtype==_SEQ__VECT){
4988 if (!ckmatrix(v))
4989 return gensizeerr(contextptr);
4990 v=mtran(v);
4991 }
4992 unsigned ncol=0;
4993 const gen & vf=v.front();
4994 if (vf.type!=_VECT){
4995 if (polygone)
4996 return _listplot(g,contextptr);
4997 vecteur attributs(1,default_color(contextptr));
4998 vecteur res=listplot(g,attributs,contextptr);
4999 int s=int(res.size());
5000 for (int i=0;i<s;++i){
5001 res[i]=symb_pnt(res[i],attributs[0],contextptr);
5002 }
5003 return gen(res,_SEQ__VECT);
5004 }
5005 if (!ckmatrix(v)||v.empty() || (ncol=unsigned(vf._VECTptr->size()))<2)
5006 return gensizeerr(contextptr);
5007 if (vf._VECTptr->front().type==_STRNG){
5008 if (attr.size()==1)
5009 attr.push_back(vecteur(vf._VECTptr->begin()+1,vf._VECTptr->end()));
5010 v.erase(v.begin());
5011 }
5012 #ifndef WIN32
5013 bool old_iograph=io_graph(contextptr);
5014 io_graph(false,contextptr);
5015 #endif
5016 const_iterateur it=v.begin(),itend=v.end();
5017 stable_sort(v.begin(),v.end(),first_ascend_sort);
5018 vecteur res;
5019 string nullstr;
5020 vecteur vres;
5021 for (unsigned j=1;j<ncol;++j){
5022 vecteur attributs(1,int(j<=FL_WHITE?j-1:j));
5023 attributs.push_back(string2gen("",false));
5024 if (!attr.empty()){
5025 if (ncol==2)
5026 attributs[0]=attr[0];
5027 if (attr[0].type==_VECT && attr[0]._VECTptr->size()>=j)
5028 attributs[0]=(*attr[0]._VECTptr)[j-1];
5029 if (attr.size()>1){
5030 if (ncol==2)
5031 attributs[1]=attr[1];
5032 if (attr[1].type==_VECT && attr[1]._VECTptr->size()>=j)
5033 attributs[1]=(*attr[1]._VECTptr)[j-1];
5034 }
5035 }
5036 res.clear();
5037 for (it=v.begin();it!=itend;++it){
5038 gen tmp=(*it->_VECTptr)[j];
5039 if (tmp.type==_STRNG && attributs[1].type==_STRNG && *attributs[1]._STRNGptr==nullstr)
5040 attributs[1]=gen(*tmp._STRNGptr,contextptr);
5041 else {
5042 if (is_equal(tmp))
5043 read_attributs(vecteur(1,tmp),attributs,contextptr);
5044 else {
5045 if (polygone)
5046 res.push_back(it->_VECTptr->front()+cst_i*tmp);
5047 if (scatter)
5048 vres.push_back(symb_pnt_name(it->_VECTptr->front()+cst_i*tmp,attributs[0],string2gen(( (it==v.begin() && !polygone) ?gen2string(attributs[1]):""),false),contextptr));
5049 if (bar)
5050 vres.push_back(symb_segment(it->_VECTptr->front(),it->_VECTptr->front()+cst_i*tmp,attributs,_GROUP__VECT,contextptr));
5051 }
5052 }
5053 }
5054 if (polygone)
5055 vres.push_back(symb_pnt_name(res,attributs[0],attributs[1],contextptr));
5056 }
5057 #ifndef WIN32
5058 io_graph(old_iograph,contextptr);
5059 #endif
5060 if (polygone && !scatter && ncol==2)
5061 return vres.front();
5062 return gen(vres,_SEQ__VECT);
5063 }
_scatterplot(const gen & g,GIAC_CONTEXT)5064 gen _scatterplot(const gen & g,GIAC_CONTEXT){
5065 if ( g.type==_STRNG && g.subtype==-1) return g;
5066 return scatterplot(g,2,contextptr);
5067 }
5068 static const char _scatterplot_s []="scatterplot";
5069 static define_unary_function_eval (__scatterplot,&_scatterplot,_scatterplot_s);
5070 define_unary_function_ptr5( at_scatterplot ,alias_at_scatterplot,&__scatterplot,0,true);
5071
5072 static const char _nuage_points_s []="nuage_points";
5073 static define_unary_function_eval (__nuage_points,&_scatterplot,_nuage_points_s);
5074 define_unary_function_ptr5( at_nuage_points ,alias_at_nuage_points,&__nuage_points,0,true);
5075
_polygonplot(const gen & g,GIAC_CONTEXT)5076 gen _polygonplot(const gen & g,GIAC_CONTEXT){
5077 if ( g.type==_STRNG && g.subtype==-1) return g;
5078 return scatterplot(g,1,contextptr);
5079 }
5080 static const char _polygonplot_s []="polygonplot";
5081 static define_unary_function_eval (__polygonplot,&_polygonplot,_polygonplot_s);
5082 define_unary_function_ptr5( at_polygonplot ,alias_at_polygonplot,&__polygonplot,0,true);
5083
5084 static const char _ligne_polygonale_s []="ligne_polygonale";
5085 static define_unary_function_eval (__ligne_polygonale,&_polygonplot,_ligne_polygonale_s);
5086 define_unary_function_ptr5( at_ligne_polygonale ,alias_at_ligne_polygonale,&__ligne_polygonale,0,true);
5087
_polygonscatterplot(const gen & g,GIAC_CONTEXT)5088 gen _polygonscatterplot(const gen & g,GIAC_CONTEXT){
5089 if ( g.type==_STRNG && g.subtype==-1) return g;
5090 return scatterplot(g,3,contextptr);
5091 }
5092 static const char _polygonscatterplot_s []="polygonscatterplot";
5093 static define_unary_function_eval (__polygonscatterplot,&_polygonscatterplot,_polygonscatterplot_s);
5094 define_unary_function_ptr5( at_polygonscatterplot ,alias_at_polygonscatterplot,&__polygonscatterplot,0,true);
5095
5096 static const char _ligne_polygonale_pointee_s []="ligne_polygonale_pointee";
5097 static define_unary_function_eval (__ligne_polygonale_pointee,&_polygonscatterplot,_ligne_polygonale_pointee_s);
5098 define_unary_function_ptr5( at_ligne_polygonale_pointee ,alias_at_ligne_polygonale_pointee,&__ligne_polygonale_pointee,0,true);
5099
_batons(const gen & g,GIAC_CONTEXT)5100 gen _batons(const gen & g,GIAC_CONTEXT){
5101 if ( g.type==_STRNG && g.subtype==-1) return g;
5102 return scatterplot(g,4,contextptr);
5103 }
5104 static const char _batons_s []="batons";
5105 static define_unary_function_eval (__batons,&_batons,_batons_s);
5106 define_unary_function_ptr5( at_batons ,alias_at_batons,&__batons,0,true);
5107
read_camembert_args(const gen & g,vecteur & vals,vecteur & names,vecteur & attributs,GIAC_CONTEXT)5108 static gen read_camembert_args(const gen & g,vecteur & vals,vecteur & names,vecteur & attributs,GIAC_CONTEXT){
5109 if (g.type!=_VECT)
5110 return gensizeerr(contextptr);
5111 attributs=vecteur(1,default_color(contextptr) | _FILL_POLYGON);
5112 int s=read_attributs(*g._VECTptr,attributs,contextptr);
5113 gen args=(s==1)?g._VECTptr->front():gen(vecteur(g._VECTptr->begin(),g._VECTptr->begin()+s),g.subtype);
5114 if (ckmatrix(args)){
5115 matrice tmp(*args._VECTptr);
5116 if (tmp.empty())
5117 return gendimerr(contextptr);
5118 if (tmp.size()!=2)
5119 tmp=mtran(tmp);
5120 int ts=int(tmp.size());
5121 if (ts<2)
5122 return gendimerr(contextptr);
5123 if (ts>2){
5124 // draw a camembert for each line
5125 // [ list_of_class_names camembert1_values camembert2_values etc. ]
5126 // camembertj_values may begin with a title string
5127 names=*tmp.front()._VECTptr;
5128 if (names.size()<2)
5129 return gendimerr(contextptr);
5130 if (names[1].type!=_STRNG)
5131 return gensizeerr(contextptr);
5132 vals=vecteur(tmp.begin()+1,tmp.end());
5133 return 0;
5134 }
5135 vals=*tmp[1]._VECTptr;
5136 names=*tmp[0]._VECTptr;
5137 if (vals.front().type==_STRNG)
5138 std::swap(vals,names);
5139 vals=vecteur(1,vals);
5140 return 0;
5141 }
5142 if (args.type!=_VECT)
5143 return gensizeerr(contextptr);
5144 vals=*args._VECTptr;
5145 names=vecteur(vals.size(),string2gen("",false));
5146 vals=vecteur(1,vals);
5147 return 0;
5148 }
5149
5150 // list of values or matrix with col1=list of legends, col2=list of values
_diagramme_batons(const gen & g_,GIAC_CONTEXT)5151 gen _diagramme_batons(const gen & g_,GIAC_CONTEXT){
5152 gen g(g_);
5153 if ( g.type==_STRNG && g.subtype==-1) return g;
5154 vecteur vals,names,attributs,res;
5155 double largeur=.8;
5156 if (g.type==_VECT && g.subtype==_SEQ__VECT){
5157 vecteur v=*g._VECTptr;
5158 if (v.size()>1 && v.front().type==_VECT && v.back().type!=_VECT){
5159 gen l=evalf_double(v.back(),1,contextptr);
5160 if (l.type==_DOUBLE_){
5161 largeur=v.back()._DOUBLE_val;
5162 v.pop_back();
5163 if (v.size()==1)
5164 v=*v.front()._VECTptr;
5165 }
5166 }
5167 for (unsigned i=0;i<v.size();++i){
5168 if (v[i].is_symb_of_sommet(at_equal) && v[i]._SYMBptr->feuille.type==_VECT){
5169 gen f=v[i]._SYMBptr->feuille._VECTptr->front();
5170 if (f==at_size || (f.type==_IDNT && strcmp(f._IDNTptr->id_name,"width")==0)){
5171 gen tmp=v[i]._SYMBptr->feuille._VECTptr->back();
5172 tmp=evalf_double(tmp,1,contextptr);
5173 if (tmp.type!=_DOUBLE_ || tmp._DOUBLE_val<=0 || tmp._DOUBLE_val>1)
5174 return gensizeerr(contextptr);
5175 largeur=tmp._DOUBLE_val;
5176 v.erase(v.begin()+i);
5177 --i;
5178 }
5179 }
5180 }
5181 if (v.size()==1)
5182 g=v.front();
5183 else
5184 g=gen(v,_SEQ__VECT);
5185 }
5186 largeur /=2;
5187 gen errcode=read_camembert_args(g,vals,names,attributs,contextptr);
5188 if (is_undef(errcode)) return errcode;
5189 vecteur attr(gen2vecteur(attributs[0]));
5190 int ncamemberts=int(vals.size()),s=int(vals.front()._VECTptr->size()),t=int(attr.size());
5191 int c=default_color(contextptr) & 0xffff;
5192 if (t==1){
5193 t=0;
5194 c=attr[0].val;
5195 }
5196 gen namesf=evalf(names,1,contextptr);
5197 if (namesf.type==_VECT && !is_numericv(*namesf._VECTptr))
5198 res.push_back(symb_equal(change_subtype(gen(_AXES),_INT_PLOT),2));
5199 #if defined HAVE_LIBFLTK && defined GIAC_LMCHANGES // changes by L. Marohnić
5200 vecteur allvals(0);
5201 for (const_iterateur it=vals.begin();it!=vals.end();++it) {
5202 if (it->type==_VECT)
5203 allvals=mergevecteur(allvals,vecteur(it->_VECTptr->begin()+(it->_VECTptr->front().type==_STRNG?1:0),
5204 it->_VECTptr->end()));
5205 }
5206 double dsc=2.0,padding=0.0;
5207 if (!allvals.empty()) {
5208 gen maxval=_evalf(_max(allvals,contextptr),contextptr);
5209 if (maxval.type==_DOUBLE_ && is_positive(maxval,contextptr)) {
5210 dsc=maxval.DOUBLE_val()*0.1;
5211 padding=maxval.DOUBLE_val()*0.02;
5212 }
5213 }
5214 for (int j=0;j<ncamemberts;j++){
5215 vecteur & Vals = *vals[j]._VECTptr;
5216 int i=0;
5217 gen xy=(s-0.25)*j;
5218 if (Vals[0].type==_STRNG){
5219 // add title
5220 res.push_back(symb_pnt_name(xy-largeur-dsc*cst_i,_POINT_INVISIBLE,Vals[0],contextptr));
5221 ++i;
5222 }
5223 for (;i<s;++i){
5224 gen tmp,xpos;
5225 if (names[i].type!=_STRNG && has_evalf(names[i],xpos,1,contextptr)){
5226 tmp=gen(makevecteur(xpos+largeur+cst_i*Vals[i],xpos+largeur,xpos-largeur,xpos-largeur+cst_i*Vals[i],xpos+largeur+cst_i*Vals[i]),_LINE__VECT);
5227 res.push_back(symb_pnt(tmp,i<t?attr[i]:(c | _FILL_POLYGON),contextptr));
5228 }
5229 else {
5230 tmp=gen(makevecteur(xy+i-1+largeur+cst_i*Vals[i],xy+i-1+largeur,xy+i-1-largeur,xy+i-1-largeur+cst_i*Vals[i],xy+i-1+largeur+cst_i*Vals[i]),_LINE__VECT);
5231 res.push_back(symb_pnt(tmp,i<t?attr[i]:((i==7?0:i) | _FILL_POLYGON),contextptr));
5232 res.push_back(symb_pnt_name(xy+i-1+largeur+cst_i*(Vals[i]+padding),_POINT_INVISIBLE | _QUADRANT2,names[i],contextptr));
5233 }
5234 }
5235 }
5236 #else
5237 for (int j=0;j<ncamemberts;j++){
5238 vecteur & Vals = *vals[j]._VECTptr;
5239 int i=0;
5240 gen xy=s*j;
5241 if (Vals[0].type==_STRNG){
5242 // add title
5243 res.push_back(symb_pnt_name(xy+.5-2*cst_i,_POINT_INVISIBLE,Vals[0],contextptr));
5244 ++i;
5245 }
5246 for (;i<s;++i){
5247 gen tmp,xpos;
5248 if (names[i].type!=_STRNG && has_evalf(names[i],xpos,1,contextptr)){
5249 tmp=gen(makevecteur(xpos+largeur+cst_i*Vals[i],xpos+largeur,xpos-largeur,xpos-largeur+cst_i*Vals[i],xpos+largeur+cst_i*Vals[i]),_LINE__VECT);
5250 res.push_back(symb_pnt(tmp,i<t?attr[i]:(c | _FILL_POLYGON | _QUADRANT2),contextptr));
5251 }
5252 else {
5253 tmp=gen(makevecteur(xy+i+largeur+cst_i*Vals[i],xy+i+largeur,xy+i-largeur,xy+i-largeur+cst_i*Vals[i],xy+i+largeur+cst_i*Vals[i]),_LINE__VECT);
5254 res.push_back(symb_pnt_name(tmp,i<t?attr[i]:((i==7?0:i) | _FILL_POLYGON | _QUADRANT2),names[i],contextptr));
5255 }
5256 }
5257 }
5258 #endif
5259 return res;
5260 }
5261 static const char _diagramme_batons_s []="bar_plot";
5262 static define_unary_function_eval (__diagramme_batons,&_diagramme_batons,_diagramme_batons_s);
5263 define_unary_function_ptr5( at_diagramme_batons ,alias_at_diagramme_batons,&__diagramme_batons,0,true);
5264
5265 static const char _diagrammebatons_s []="barplot";
5266 static define_unary_function_eval (__diagrammebatons,&_diagramme_batons,_diagrammebatons_s);
5267 define_unary_function_ptr5( at_diagrammebatons ,alias_at_diagrammebatons,&__diagrammebatons,0,true);
5268
_camembert(const gen & g,GIAC_CONTEXT)5269 gen _camembert(const gen & g,GIAC_CONTEXT){
5270 if ( g.type==_STRNG && g.subtype==-1) return g;
5271 vecteur vals,names,attributs,res;
5272 #if 1 // changes by L. Marohnić
5273 res.push_back(symb_equal(change_subtype(gen(_AXES),_INT_PLOT),0));
5274 res.push_back(symb_equal(change_subtype(gen(_GL_ORTHO),_INT_PLOT),1));
5275 gen errcode=read_camembert_args(g,vals,names,attributs,contextptr);
5276 if (is_undef(errcode)) return errcode;
5277 vecteur attr(gen2vecteur(attributs[0]));
5278 int ncamemberts=int(vals.size()),s=int(vals.front()._VECTptr->size()),t=int(attr.size());
5279 int rowlen=2;
5280 if (ncamemberts>4) rowlen=3;
5281 if (ncamemberts>6) rowlen=4;
5282 for (int j=0;j<ncamemberts;j++){
5283 gen xy=5*(j%rowlen)-5*(j/rowlen)*cst_i;
5284 gen diametre=makevecteur(-1+xy,1+xy);
5285 gen a(0),da;
5286 double da100;
5287 char ss[256];
5288 vecteur & Vals = *vals[j]._VECTptr;
5289 gen somme;
5290 int i=0,pos=0;;
5291 if (Vals[0].type==_STRNG){
5292 // add title
5293 res.push_back(symb_pnt_name(xy-1+1.75*cst_i,_POINT_INVISIBLE,Vals[0],contextptr));
5294 ++i;
5295 somme=_plus(vecteur(Vals.begin()+1,Vals.end()),contextptr);
5296 }
5297 else
5298 somme=_plus(Vals,contextptr);
5299 string name;
5300 for (;i<s;++i){
5301 if (ck_is_strictly_positive(-Vals[i],contextptr))
5302 return gensizeerr(gettext("Negative value encoutered"));
5303 da=2*cst_pi*Vals[i]/somme;
5304 da100=evalf_double(100*Vals[i]/somme,1,contextptr)._DOUBLE_val;
5305 if (da100>0){
5306 sprintfdouble(ss,"%.4g",da100);
5307 if (is_positive(a-cst_pi/2,contextptr))
5308 pos=_QUADRANT2;
5309 if (is_positive(a-cst_pi,contextptr))
5310 pos=_QUADRANT3;
5311 if (is_positive(a-3*cst_pi/2,contextptr))
5312 pos=_QUADRANT4;
5313 gen tmp=symbolic(at_cercle,gen(makevecteur(diametre,a,a+da),_PNT__VECT));
5314 name=gen2string(names[i]);
5315 if (name.length()>1)
5316 name+=": ";
5317 res.push_back(symb_pnt_name(tmp,i<t?attr[i]:(i%7 | _FILL_POLYGON | pos),
5318 string2gen(name+string(ss)+"%",false),contextptr));
5319 a=a+da;
5320 }
5321 }
5322 }
5323 #else
5324 gen errcode=read_camembert_args(g,vals,names,attributs,contextptr);
5325 if (is_undef(errcode)) return errcode;
5326 vecteur attr(gen2vecteur(attributs[0]));
5327 int ncamemberts=int(vals.size()),s=int(vals.front()._VECTptr->size()),t=int(attr.size());
5328 for (int j=0;j<ncamemberts;j++){
5329 gen xy=5*(j%4)-5*(j/4)*cst_i;
5330 gen diametre=makevecteur(-1+xy,1+xy);
5331 gen a(0),da;
5332 double da100;
5333 char ss[256];
5334 vecteur & Vals = *vals[j]._VECTptr;
5335 gen somme;
5336 int i=0,pos=0;;
5337 if (Vals[0].type==_STRNG){
5338 // add title
5339 res.push_back(symb_pnt_name(xy-1+2*cst_i,_POINT_INVISIBLE,Vals[0],contextptr));
5340 ++i;
5341 somme=_plus(vecteur(Vals.begin()+1,Vals.end()),contextptr);
5342 }
5343 else
5344 somme=_plus(Vals,contextptr);
5345 for (;i<s;++i){
5346 if (ck_is_strictly_positive(-Vals[i],contextptr))
5347 return gensizeerr(gettext("Negative value encoutered"));
5348 da=2*cst_pi*Vals[i]/somme;
5349 da100=evalf_double(100*Vals[i]/somme,1,contextptr)._DOUBLE_val;
5350 if (da100>0){
5351 sprintfdouble(ss,"%.4g",da100);
5352 if (is_positive(a-cst_pi/2,contextptr))
5353 pos=_QUADRANT2;
5354 if (is_positive(a-cst_pi,contextptr))
5355 pos=_QUADRANT3;
5356 if (is_positive(a-3*cst_pi/2,contextptr))
5357 pos=_QUADRANT4;
5358 gen tmp=symbolic(at_cercle,gen(makevecteur(diametre,a,a+da),_PNT__VECT));
5359 res.push_back(symb_pnt_name(tmp,i<t?attr[i]:(i%7 | _FILL_POLYGON | pos),string2gen(gen2string(names[i])+":"+string(ss)+"%",false),contextptr));
5360 a=a+da;
5361 }
5362 }
5363 }
5364 #endif
5365 return res;
5366 }
5367 static const char _camembert_s []="camembert";
5368 static define_unary_function_eval (__camembert,&_camembert,_camembert_s);
5369 define_unary_function_ptr5( at_camembert ,alias_at_camembert,&__camembert,0,true);
5370
_axis(const gen & g,GIAC_CONTEXT)5371 gen _axis(const gen & g,GIAC_CONTEXT){
5372 if (g.type!=_VECT || g._VECTptr->size()<4)
5373 return gensizeerr(contextptr);
5374 const vecteur & v=*g._VECTptr;
5375 gen X(symb_equal(change_subtype(_GL_X,_INT_PLOT),symb_interval(v[0],v[1])));
5376 history_plot(contextptr).push_back(X);
5377 gen Y(symb_equal(change_subtype(_GL_Y,_INT_PLOT),symb_interval(v[2],v[3])));
5378 history_plot(contextptr).push_back(Y);
5379 if (v.size()<6)
5380 return makesequence(X,Y);
5381 gen Z(symb_equal(change_subtype(_GL_Z,_INT_PLOT),symb_interval(v[4],v[5])));
5382 history_plot(contextptr).push_back(Z);
5383 return makesequence(X,Y,Z);
5384 }
5385 static const char _axis_s []="axis";
5386 static define_unary_function_eval (__axis,&_axis,_axis_s);
5387 define_unary_function_ptr5( at_axis ,alias_at_axis,&__axis,0,true);
5388
_grid(const gen & g,GIAC_CONTEXT)5389 gen _grid(const gen & g,GIAC_CONTEXT){
5390 bool b=is_exactly_zero(g);
5391 return symb_equal(change_subtype(_AXES,_INT_PLOT),b?0:(g==2?2:1));
5392 }
5393 static const char _grid_s []="grid";
5394 static define_unary_function_eval (__grid,&_grid,_grid_s);
5395 define_unary_function_ptr5( at_grid ,alias_at_grid,&__grid,0,true);
5396
5397 // Graham scan convex hull
graham_sort_function(const gen & a,const gen & b)5398 static bool graham_sort_function(const gen & a,const gen & b){
5399 if (a.type!=_VECT || b.type!=_VECT || a._VECTptr->size()!=3 || b._VECTptr->size()!=3){
5400 #ifdef NO_STDEXCEPT
5401 return false;
5402 #else
5403 setsizeerr(gettext("graham_sort_function"));
5404 #endif
5405 }
5406 vecteur & v=*a._VECTptr;
5407 vecteur & w=*b._VECTptr;
5408 return is_strictly_greater(w[1],v[1],context0) || (v[1]==w[1] && is_strictly_greater(w[2],v[2],context0)) ;
5409 }
5410
cross_prod(const gen & a,const gen & b,const gen & c,GIAC_CONTEXT)5411 gen cross_prod(const gen & a,const gen & b,const gen & c,GIAC_CONTEXT){
5412 gen ab=b-a,ac=c-a;
5413 gen A(re(ab,contextptr)),B(im(ab,contextptr)),C(re(ac,contextptr)),D(im(ac,contextptr));
5414 return A*D-B*C;
5415 }
5416
_convexhull(const gen & g,GIAC_CONTEXT)5417 gen _convexhull(const gen & g,GIAC_CONTEXT){
5418 if ( g.type==_STRNG && g.subtype==-1) return g;
5419 if (g.type!=_VECT)
5420 return gensizeerr(contextptr);
5421 vecteur l0(*_affixe(g,contextptr)._VECTptr),l;
5422 int s=int(l0.size());
5423 for (int i=0;i<s;++i){
5424 if (l0[i].type==_VECT)
5425 l=mergevecteur(l,*l0[i]._VECTptr);
5426 else
5427 l.push_back(l0[i]);
5428 }
5429 s=int(l.size());
5430 if (s<=3){
5431 #if 0
5432 if (abs_calc_mode(contextptr)==38)
5433 return _polygone(l,contextptr);
5434 #endif
5435 return l;
5436 }
5437 gen zmin=l[0],zcur;
5438 gen ymin=im(zmin,contextptr),ycur,xmin=re(zmin,contextptr),xcur;
5439 for (int j=1;j<s;++j){
5440 zcur=l[j]; ycur=im(zcur,contextptr); xcur=re(zcur,contextptr);
5441 if ( is_strictly_greater(ymin,ycur,contextptr) ||
5442 (ycur==ymin && is_strictly_greater(xmin,xcur,contextptr)) ){
5443 zmin=zcur; ymin=ycur; xmin=xcur;
5444 }
5445 }
5446 vecteur ls;
5447 for (int j=0;j<s;++j){
5448 zcur=l[j];
5449 if (zcur!=zmin){
5450 ls.push_back(makevecteur(zcur,arg(zcur-zmin,contextptr),(zcur-zmin)*conj(zcur-zmin,contextptr)));
5451 }
5452 }
5453 gen_sort_f(ls.begin(),ls.end(),graham_sort_function);
5454 vecteur res(makevecteur(zmin,ls[0][0]));
5455 int ress=2;
5456 gen o;
5457 for (int j=1;j<s-1;++j){
5458 zcur=ls[j][0];
5459 o=cross_prod(res[ress-2],res[ress-1],zcur,contextptr);
5460 if (is_zero(o))
5461 res[ress-1]=zcur;
5462 else {
5463 if (is_strictly_positive(o,contextptr)){
5464 res.push_back(zcur);
5465 ress++;
5466 }
5467 else {
5468 while (!is_positive(o,contextptr) && ress>2){
5469 res.pop_back();
5470 ress--;
5471 o=cross_prod(res[ress-2],res[ress-1],zcur,contextptr);
5472 }
5473 res.push_back(zcur);
5474 ress++;
5475 }
5476 }
5477 }
5478 #if 0
5479 if (abs_calc_mode(contextptr)==38)
5480 return _polygone(res,contextptr);
5481 #endif
5482 return gen(res,g.subtype);
5483 }
5484 static const char _convexhull_s []="convexhull";
5485 static define_unary_function_eval (__convexhull,&_convexhull,_convexhull_s);
5486 define_unary_function_ptr5( at_convexhull ,alias_at_convexhull,&__convexhull,0,true);
5487
5488 #ifdef RTOS_THREADX
_simplex_reduce(const gen & args,GIAC_CONTEXT)5489 gen _simplex_reduce(const gen & args,GIAC_CONTEXT){
5490 return undef;
5491 }
5492 static const char _simplex_reduce_s []="simplex_reduce";
5493 static define_unary_function_eval (__simplex_reduce,&_simplex_reduce,_simplex_reduce_s);
5494 define_unary_function_ptr5( at_simplex_reduce ,alias_at_simplex_reduce,&__simplex_reduce,0,true);
5495 #else
5496 // Simplex algorithm solving max c.x where constraints on x are in
5497 // canonical form: A*x <= b with b>= 0
5498 // Variables are added to get [A|I] (x,x_slack) = b
5499 //
5500 // Arguments:
5501 // m must contain an identity matrix in the n-1 first rows
5502 // like [A|I|b], to solve for b>=0, A*x<=b (I is for "slack" variables)
5503 // <variables d'ecarts ajoutees pour transformer <= en egalite >
5504 // last line (objective function row) [-c|0|0], maximize or minimize c.x
5505 // if the coefficients of the last row at the columns of the identity
5506 // are not zero, step 0 will transform the last row to set them to 0.
5507 // max_pb is true for maximization and false for min
5508 // choose_first=true if we choose the first possible entering/outgoing index
5509 //
5510 // Returns:
5511 // optimum will contain the max (min) value, if not +/-inf
5512 // bfs contains the coordinates of a solution
5513 // At the end of the algorithm we have [B^-1*A|B^-1|B^-1*b] for the
5514 // n-1 first row, and for last row [-c+c_B * B^-1*A | c_B*B^-1|c_B*B^-1*b]
5515 // where all coeffs of non-basic variables are + (for a max) and other are 0
5516 // Since the function to maximize + (last row) scalar (x,x_slack_variables)
5517 // = c_B*B^-1*b, it is not possible to improve c_B*B^-1*b
5518 // The reason is that the current solution has non-0 components
5519 // corresponding to the 0 value in the last row
5520 // and 0 components corresponding to non-0 positive values in the last row
5521 // If we move one 0 component of the current solution, it must increase
5522 // hence we have to decrease one of the coeff corresponding to non-0
5523 // positive coeffs in the last row, decreasing the value of the function
5524 // to maximize.
5525 //
5526 // Not yet implemented: how to reduce any linear programming problem
5527 // to a feasible canonical matrix m
5528 // The idea is to add artificial variables (as many as there are equalities)
5529 // and maximize -sum(artificial variables) starting with all non
5530 // artificial variables equal to 0
5531 // If the max is not 0 there is no solution
5532 // otherwise all artificial variables are set to 0 and we have a
5533 // basic feasible solution to start with
5534 //
5535 // NB: If a coeff of the bfs is 0 we may cycle, using choose_first=true
5536 // will insure we do not cycle (Bland's rule)
5537 // another rule might be implemented by keeping somewhere all the
5538 // visited basis corresponding to the same max value
simplex_reduce(const matrice & m_orig,vecteur & bfs,gen & optimum,bool max_pb,bool choose_first,GIAC_CONTEXT)5539 matrice simplex_reduce(const matrice & m_orig,vecteur & bfs,gen & optimum,bool max_pb,bool choose_first,GIAC_CONTEXT){
5540 matrice m(m_orig);
5541 int nr=int(m.size());
5542 int nc=int(m.front()._VECTptr->size());
5543 if (nc<nr+1)
5544 return vecteur(1,gendimerr(contextptr));
5545 // Step 0 set the coefficients of the last row in the idn column to 0
5546 vecteur lastline(nr-1);
5547 matrice mt(mtran(m));
5548 for (int i=0;i<nc-1;++i){
5549 int cur_col=-1;
5550 vecteur & mti=*mt[i]._VECTptr;
5551 for (int j=0;j<nr-1;++j){
5552 if (is_zero(mti[j]))
5553 continue;
5554 if (!is_one(mti[j]) || cur_col>=0){
5555 cur_col=-1;
5556 break; // not an idn line
5557 }
5558 cur_col=j;
5559 }
5560 if (cur_col>=0)
5561 lastline[cur_col]=mti[nr-1];
5562 }
5563 for (int i=0;i<nr-1;++i){
5564 if (!is_zero(lastline[i]))
5565 m[nr-1]=subvecteur(*m[nr-1]._VECTptr,multvecteur(lastline[i],*m[i]._VECTptr));
5566 }
5567 for (;;){
5568 // Step 1: find the most positive (min_pb) or negative (max_pb)
5569 // coefficient of the objective function row (last row)
5570 // or choose the first + or - if choose_first is true
5571 gen mincoeff=0;
5572 int J=-1;
5573 vecteur &last=*m.back()._VECTptr;
5574 for (int j=0;j<nc-1;++j){
5575 if (is_strictly_greater((max_pb?mincoeff:last[j]),
5576 (max_pb?last[j]:mincoeff),contextptr)){
5577 J=j;
5578 mincoeff=last[j];
5579 if (choose_first)
5580 break;
5581 }
5582 }
5583 if (J==-1){ // Find bfs and optimum
5584 optimum=m[nr-1][nc-1];
5585 bfs=vecteur(nc-1);
5586 // Push back 0 or m[i][nc-1] if column is an identity column
5587 matrice mt=mtran(m);
5588 int counter=nr-1;
5589 for (int i=0;i<nc-1 && counter>0;++i){
5590 int cur_col=-1;
5591 if (is_zero(mt[i][nr-1])){
5592 for (int j=0;j<nr-1;++j){
5593 if (is_zero(mt[i][j]))
5594 continue;
5595 if (cur_col>=0){
5596 cur_col=-1;
5597 break; // not an idn line
5598 }
5599 cur_col=j;
5600 }
5601 }
5602 if (cur_col>=0 && is_one(mt[i][cur_col])){ // BUGFIX by Luka Marohnić: a proper check for idn line
5603 --counter;
5604 bfs[i]=mt[nc-1][cur_col];
5605 }
5606 }
5607 return m;
5608 }
5609 int I=-1;
5610 mincoeff=plus_inf;
5611 gen ratio;
5612 // We will move the J-th variable from 0 to something positive
5613 // We have to find which variables govern how much positive xJ can be
5614 // -> find the smallest positive ratio
5615 // and choose the 1st one if the smallest ratio is reached several times
5616 for (int i=0;i<nr-1;++i){
5617 gen m1(m[i][J]);
5618 if (is_strictly_positive(m1,contextptr) &&
5619 is_strictly_greater(mincoeff,ratio=m[i][nc-1]/m1,contextptr)){
5620 I=i;
5621 mincoeff=ratio;
5622 }
5623 }
5624 if (I==-1){ // The function is not bounded since xJ can grow to +inf
5625 optimum=max_pb?plus_inf:minus_inf;
5626 return m;
5627 }
5628 if (is_zero(mincoeff)) // Bland's rule
5629 choose_first=true;
5630 // Pivot found, line I, column J, reduce matrix (Gauss-like)
5631 m[I]=divvecteur(*m[I]._VECTptr,m[I][J]);
5632 vecteur & pivot_v = *m[I]._VECTptr;
5633 gen a;
5634 for (int i=0;i<nr;++i){
5635 if (i==I)
5636 continue;
5637 vecteur & v=*m[i]._VECTptr;
5638 a=v[J];
5639 for (int j=0;j<nc;++j){
5640 v[j]=v[j]-a*pivot_v[j];
5641 }
5642 }
5643 }
5644 }
5645
5646 // solve max(c.x) under Ax<=b, returns optimum value, solution x0
5647 // and reduced matrix
_simplex_reduce(const gen & g,GIAC_CONTEXT)5648 gen _simplex_reduce(const gen & g,GIAC_CONTEXT){
5649 if ( g.type==_STRNG && g.subtype==-1) return g;
5650 matrice m;
5651 vecteur v;
5652 gen optimum;
5653 if (g.type ==_VECT && g.subtype==_SEQ__VECT && g._VECTptr->size()==3){
5654 vecteur & gv =*g._VECTptr;
5655 if (gv[0].type!=_VECT || gv[1].type!=_VECT || gv[2].type!=_VECT)
5656 return gentypeerr(contextptr);
5657 m=*gv[0]._VECTptr;
5658 int add=int(m.size());
5659 m=mtran(m);
5660 m=mergevecteur(m,midn(add));
5661 m.push_back(gv[1]);
5662 if (!ckmatrix(m))
5663 return gendimerr(contextptr);
5664 m=mtran(m);
5665 m.push_back(mergevecteur(*(-gv[2])._VECTptr,vecteur(add+1,0)));
5666 if (!ckmatrix(m))
5667 return gendimerr(contextptr);
5668 }
5669 else {
5670 if (!ckmatrix(g))
5671 return gensizeerr(contextptr);
5672 m=*g._VECTptr;
5673 }
5674 m=simplex_reduce(m,v,optimum,true,false,contextptr);
5675 if (is_undef(m) && !m.empty())
5676 return m.front();
5677 return gen(makevecteur(optimum,v,m),_SEQ__VECT);
5678 }
5679 static const char _simplex_reduce_s []="simplex_reduce";
5680 static define_unary_function_eval (__simplex_reduce,&_simplex_reduce,_simplex_reduce_s);
5681 define_unary_function_ptr5( at_simplex_reduce ,alias_at_simplex_reduce,&__simplex_reduce,0,true);
5682 #endif
5683
5684 // natural_spline([x0,...,xn],[y0,...,yn],x,d)
5685 // -> spline of degree d, in C^{d-1}, with values yk at xk
5686 // and initial/final derivatives = 0 from order 1 to (d-1)/2,
5687 // d-1 conditions
5688 // returns a list of n polynomials with respect to x
5689 // to get the value of the spline, find the right interval hence polynomial
5690 // and call horner(poly,value-xi)
5691 // x and d are optionnal, if not precised d is 3
_spline(const gen & g,GIAC_CONTEXT)5692 gen _spline(const gen & g,GIAC_CONTEXT){
5693 if ( g.type==_STRNG && g.subtype==-1) return g;
5694 if (g.type!=_VECT || g._VECTptr->size()<2)
5695 return gensizeerr(contextptr);
5696 vecteur w(*g._VECTptr);
5697 if (w.size()<3)
5698 w.push_back(vx_var);
5699 if (w.size()<4)
5700 w.push_back(3);
5701 gen X(w[0]), Y(w[1]), xvar(w[2]), dg(w[3]);
5702 if (dg.type!=_INT_ || dg.val<1 || X.type!=_VECT || Y.type!=_VECT)
5703 return gentypeerr(contextptr);
5704 vecteur &x=*X._VECTptr;
5705 vecteur &y=*Y._VECTptr;
5706 int n=int(x.size())-1;
5707 if (n<1 || y.size()!=unsigned(n+1))
5708 return gendimerr(contextptr);
5709 int d(dg.val);
5710 // create n unknowns, the values of the highest derivative coeff
5711 // at x0, ..., xn-1
5712 // and (d-1)/2 unknowns, the values of diff(spline,x$k) for k=1 to (d-1)/2
5713 vecteur z(n),f((d-1)/2),pol;
5714 for (int i=0;i<n;++i){
5715 z[i]=identificateur(" z"+print_INT_(i));
5716 }
5717 for (int i=0;i<(d-1)/2;++i){
5718 f[i]=identificateur(" f"+print_INT_(i));
5719 }
5720 // create vector of linear equations to solve for
5721 vecteur lineq;
5722 // create initial taylor polynomial form of the poly
5723 vecteur v(d+1);
5724 v[0]=z[0]; // z[0]*(x-x0)^d + f_(d-1)/2 * (x-x0)^{(d-1)/2} + ...+f_0*(x-x_0) + y0
5725 for (int i=1;i<=(d-1)/2;++i)
5726 v[d-i]=f[i-1];
5727 v[d]=y[0]; // all conditions at x0 are solved
5728 pol.push_back(v);
5729 for (int i=0;i<n;++i){
5730 // move from xi to xi+1
5731 v=*ratnormal(taylor(v,x[i+1]-x[i]),contextptr)._VECTptr;
5732 lineq.push_back(v[d]-y[i+1]);
5733 // new v changes by the first coeff of v only
5734 v[0]=(i==n-1)?0:z[i+1];
5735 pol.push_back(v);
5736 }
5737 // add conditions at x[n]
5738 for (int i=1;i<=(d-1)/2;++i){
5739 lineq.push_back(v[i]);
5740 }
5741 vecteur inconnu(mergevecteur(z,f));
5742 vecteur zf=linsolve(lineq,inconnu,contextptr);
5743 if (is_undef(zf)) return zf;
5744 pol.pop_back();
5745 pol=*ratnormal(subst(pol,inconnu,zf,false,contextptr),contextptr)._VECTptr;
5746 for (int i=0;i<n;++i){
5747 if (pol[i].type==_VECT)
5748 pol[i]=symb_horner(*pol[i]._VECTptr,xvar-x[i]);
5749 }
5750 return pol;
5751 }
5752 static const char _spline_s []="spline";
5753 static define_unary_function_eval (__spline,&_spline,_spline_s);
5754 define_unary_function_ptr5( at_spline ,alias_at_spline,&__spline,0,true);
5755
giac_bitand(const gen & a,const gen & b)5756 gen giac_bitand(const gen & a,const gen & b){
5757 register unsigned t=(a.type<< _DECALAGE) | b.type;
5758 if (!t)
5759 return( a.val & b.val);
5760 register ref_mpz_t * e;
5761 switch ( t ) {
5762 case _ZINT__ZINT:
5763 e = new ref_mpz_t;
5764 mpz_and(e->z,*a._ZINTptr,*b._ZINTptr);
5765 return e;
5766 case _INT___ZINT:
5767 e = new ref_mpz_t;
5768 mpz_set_ui(e->z,a.val);
5769 mpz_and(e->z,e->z,*b._ZINTptr);
5770 return(e);
5771 case _ZINT__INT_:
5772 e = new ref_mpz_t;
5773 mpz_set_ui(e->z,b.val);
5774 mpz_and(e->z,*a._ZINTptr,e->z);
5775 return(e);
5776 }
5777 return symbolic(at_bitand,gen(makevecteur(a,b),_SEQ__VECT));
5778 }
giac_bitor(const gen & a,const gen & b)5779 gen giac_bitor(const gen & a,const gen & b){
5780 register unsigned t=(a.type<< _DECALAGE) | b.type;
5781 if (!t)
5782 return( a.val | b.val);
5783 register ref_mpz_t * e;
5784 switch ( t ) {
5785 case _ZINT__ZINT:
5786 e = new ref_mpz_t;
5787 mpz_ior(e->z,*a._ZINTptr,*b._ZINTptr);
5788 return(e);
5789 case _INT___ZINT:
5790 e = new ref_mpz_t;
5791 mpz_set_ui(e->z,a.val);
5792 mpz_ior(e->z,e->z,*b._ZINTptr);
5793 return(e);
5794 case _ZINT__INT_:
5795 e = new ref_mpz_t;
5796 mpz_set_ui(e->z,b.val);
5797 mpz_ior(e->z,*a._ZINTptr,e->z);
5798 return(e);
5799 }
5800 return symbolic(at_bitor,gen(makevecteur(a,b),_SEQ__VECT));
5801 }
giac_bitxor(const gen & a,const gen & b)5802 gen giac_bitxor(const gen & a,const gen & b){
5803 register unsigned t=(a.type<< _DECALAGE) | b.type;
5804 if (!t)
5805 return( a.val ^ b.val);
5806 register ref_mpz_t * e;
5807 switch ( t ) {
5808 case _ZINT__ZINT:
5809 e = new ref_mpz_t;
5810 mpz_xor(e->z,*a._ZINTptr,*b._ZINTptr);
5811 return(e);
5812 case _INT___ZINT:
5813 e = new ref_mpz_t;
5814 mpz_set_ui(e->z,a.val);
5815 mpz_xor(e->z,e->z,*b._ZINTptr);
5816 return(e);
5817 case _ZINT__INT_:
5818 e = new ref_mpz_t;
5819 mpz_set_ui(e->z,b.val);
5820 mpz_xor(e->z,*a._ZINTptr,e->z);
5821 return(e);
5822 }
5823 return symbolic(at_bitxor,gen(makevecteur(a,b),_SEQ__VECT));
5824 }
5825
giac_hamdist(const gen & a,const gen & b)5826 gen giac_hamdist(const gen & a,const gen & b){
5827 unsigned long t=(a.type<< _DECALAGE) | b.type;
5828 if (t==0){
5829 unsigned res=0;
5830 unsigned val=a.val ^ b.val;
5831 for (int i=0;i<31;++i){
5832 res += (val >>i) & 1;
5833 }
5834 return int(res);
5835 }
5836 ref_mpz_t * e = new ref_mpz_t;
5837 switch ( t ) {
5838 /*
5839 case 0:
5840 mpz_set_ui(e->z,a.val ^ b.val);
5841 t = mpz_popcount(e->z);
5842 break;
5843 */
5844 case _ZINT__ZINT:
5845 t=mpz_hamdist(*a._ZINTptr,*b._ZINTptr);
5846 break;
5847 case _INT___ZINT:
5848 mpz_set_ui(e->z,a.val);
5849 t=mpz_hamdist(e->z,*b._ZINTptr);
5850 break;
5851 case _ZINT__INT_:
5852 mpz_set_ui(e->z,b.val);
5853 t=mpz_hamdist(*a._ZINTptr,e->z);
5854 break;
5855 default:
5856 delete e;
5857 return symbolic(at_hamdist,gen(makevecteur(a,b),_SEQ__VECT));
5858 }
5859 delete e;
5860 return longlong(t);
5861 }
5862
binop(const gen & g,gen (* f)(const gen &,const gen &))5863 gen binop(const gen & g,gen (* f) (const gen &, const gen &)){
5864 if (g.type!=_VECT || g._VECTptr->empty())
5865 return gensizeerr(gettext("binop"));
5866 const_iterateur it=g._VECTptr->begin(),itend=g._VECTptr->end();
5867 gen res=*it;
5868 for (++it;it!=itend;++it){
5869 res=apply(res,*it,f);
5870 }
5871 return res;
5872 }
_bitand(const gen & g,GIAC_CONTEXT)5873 gen _bitand(const gen & g,GIAC_CONTEXT){
5874 if ( g.type==_STRNG && g.subtype==-1) return g;
5875 return binop(g,giac_bitand);
5876 }
5877 static const char _bitand_s []="bitand";
5878 static define_unary_function_eval (__bitand,&_bitand,_bitand_s);
5879 define_unary_function_ptr5( at_bitand ,alias_at_bitand,&__bitand,0,true);
5880
_bitor(const gen & g,GIAC_CONTEXT)5881 gen _bitor(const gen & g,GIAC_CONTEXT){
5882 if ( g.type==_STRNG && g.subtype==-1) return g;
5883 return binop(g,giac_bitor);
5884 }
5885 static const char _bitor_s []="bitor";
5886 static define_unary_function_eval (__bitor,&_bitor,_bitor_s);
5887 define_unary_function_ptr5( at_bitor ,alias_at_bitor,&__bitor,0,true);
5888
_bitxor(const gen & g,GIAC_CONTEXT)5889 gen _bitxor(const gen & g,GIAC_CONTEXT){
5890 if ( g.type==_STRNG && g.subtype==-1) return g;
5891 return binop(g,giac_bitxor);
5892 }
5893 static const char _bitxor_s []="bitxor";
5894 static define_unary_function_eval (__bitxor,&_bitxor,_bitxor_s);
5895 define_unary_function_ptr5( at_bitxor ,alias_at_bitxor,&__bitxor,0,true);
5896
_bitnot(const gen & g,GIAC_CONTEXT)5897 gen _bitnot(const gen & g,GIAC_CONTEXT){
5898 if ( g.type==_STRNG && g.subtype==-1) return g;
5899 if (g.type==_INT_)
5900 return ~g.val;
5901 #if !defined(USE_GMP_REPLACEMENTS)
5902 if (g.type==_ZINT){
5903 ref_mpz_t * e = new ref_mpz_t;
5904 mpz_com(e->z,*g._ZINTptr);
5905 return e;
5906 }
5907 #endif
5908 return gensizeerr();
5909 }
5910 static const char _bitnot_s []="bitnot";
5911 static define_unary_function_eval (__bitnot,&_bitnot,_bitnot_s);
5912 define_unary_function_ptr5( at_bitnot ,alias_at_bitnot,&__bitnot,0,true);
5913
_hamdist(const gen & g,GIAC_CONTEXT)5914 gen _hamdist(const gen & g,GIAC_CONTEXT){
5915 if ( g.type==_STRNG && g.subtype==-1) return g;
5916 if (g.type==_VECT && g.subtype==_SEQ__VECT && g._VECTptr->size()==2 && g._VECTptr->front().type==_VECT && g._VECTptr->back().type==_VECT && g._VECTptr->front().subtype!=_LIST__VECT && g._VECTptr->back().subtype!=_LIST__VECT){
5917 const vecteur & f=*g._VECTptr->front()._VECTptr;
5918 const vecteur & b=*g._VECTptr->back()._VECTptr;
5919 size_t fs=f.size();
5920 if (f.size()==b.size()){
5921 int res=0;
5922 for (size_t i=0;i<fs;++i){
5923 if (f[i]!=b[i])
5924 res++;
5925 }
5926 return res;
5927 }
5928 }
5929 return binop(g,giac_hamdist);
5930 }
5931 static const char _hamdist_s []="hamdist";
5932 static define_unary_function_eval (__hamdist,&_hamdist,_hamdist_s);
5933 define_unary_function_ptr5( at_hamdist ,alias_at_hamdist,&__hamdist,0,true);
5934
5935
5936 // ploarea(polygone), plotarea(f(x),x=a..b), plotarea(f(x),x=a..b,n,method)
5937 // method=trapeze,point_milieu,rectangle_gauche,rectangle_droit
_plotarea(const gen & g,GIAC_CONTEXT)5938 gen _plotarea(const gen & g,GIAC_CONTEXT){
5939 if ( g.type==_STRNG && g.subtype==-1) return g;
5940 vecteur v(gen2vecteur(g));
5941 vecteur attributs(default_color(contextptr));
5942 int s=read_attributs(v,attributs,contextptr);
5943 if (!s)
5944 return gensizeerr(contextptr);
5945 if (attributs.size()<2)
5946 attributs.push_back(0);
5947 if (attributs[0].type==_INT_)
5948 attributs[0].val= attributs[0].val | _FILL_POLYGON;
5949 v[0]=remove_at_pnt(v[0]);
5950 if (v[0].type==_VECT){
5951 attributs[1]=_aire(v[0],contextptr);
5952 return pnt_attrib(v[0],attributs,contextptr);
5953 }
5954 if (s>=2 && v[0].type!=_VECT){
5955 gen tmp(v[1]),a,b,x(vx_var);
5956 if (is_equal(tmp) && tmp._SYMBptr->feuille.type==_VECT && tmp._SYMBptr->feuille._VECTptr->size()==2){
5957 x=tmp._SYMBptr->feuille[0];
5958 tmp=tmp._SYMBptr->feuille[1];
5959 }
5960 if (tmp.is_symb_of_sommet(at_interval) && tmp._SYMBptr->feuille.type==_VECT && tmp._SYMBptr->feuille._VECTptr->size()==2){
5961 a=tmp._SYMBptr->feuille[0];
5962 b=tmp._SYMBptr->feuille[1];
5963 }
5964 else
5965 return gensizeerr(gettext("plotarea(f(x),x=a..b[,n,method])"));
5966 if (s>=2){
5967 int s1=s-1;
5968 for (;s1>0;--s1){
5969 if (v[s1].type!=_INT_)
5970 break;
5971 }
5972 gen graph=funcplotfunc(gen(vecteur(v.begin(),v.begin()+s1+1),_SEQ__VECT),false,contextptr); // must be a graph of fcn
5973 if (is_undef(graph))
5974 return graph;
5975 // extract polygon
5976 gen graphe=remove_at_pnt(graph);
5977 if (graphe.type==_VECT && graphe._VECTptr->size()==2)
5978 graphe=symbolic(at_curve,makesequence(v.front(),graphe));
5979 if (graphe.is_symb_of_sommet(at_curve) && graphe._SYMBptr->feuille.type==_VECT){
5980 vecteur & graphev=*graphe._SYMBptr->feuille._VECTptr;
5981 if (graphev.size()>1){
5982 gen polyg=graphev[1];
5983 if (polyg.type==_VECT){
5984 if (s==2){
5985 // add verticals and horizontal
5986 vecteur res(*polyg._VECTptr);
5987 res.insert(res.begin(),a);
5988 res.insert(res.begin(),b);
5989 res.push_back(b);
5990 int nd=decimal_digits(contextptr);
5991 decimal_digits(3,contextptr);
5992 attributs[1]=string2gen(_gaussquad(gen(makevecteur(v[0],v[1]),_SEQ__VECT),contextptr).print(contextptr),false);
5993 decimal_digits(nd,contextptr);
5994 return pnt_attrib(gen(res,_GROUP__VECT),attributs,contextptr);
5995 } // end s==2
5996 if (s>=3)
5997 v[2]=_floor(v[2],contextptr);
5998 if (s>=3 && v[2].type==_INT_){
5999 int n=v[2].val;
6000 if (n<1)
6001 return gensizeerr(contextptr);
6002 vecteur res;
6003 res.push_back(b);
6004 res.push_back(a);
6005 gen dx=(b-a)/n,x0=a,xf=x0,fxf,f=v[0],A;
6006 int method=_TRAPEZE;
6007 if (s>=4 && v[3].type==_INT_)
6008 method = v[3].val;
6009 if (method==_RECTANGLE_DROIT || method==_RECTANGLE_GAUCHE || method==_POINT_MILIEU){
6010 if (method==_RECTANGLE_DROIT)
6011 xf=x0+dx;
6012 if (method==_POINT_MILIEU)
6013 xf=x0+dx/2;
6014 for (int i=0;i<n;++i){
6015 fxf=evalf(quotesubst(f,x,xf,contextptr),1,contextptr);
6016 A=A+dx*fxf;
6017 res.push_back(x0+fxf*cst_i);
6018 x0=x0+dx;
6019 xf=xf+dx;
6020 res.push_back(x0+fxf*cst_i);
6021 }
6022 }
6023 if (method==_TRAPEZE){
6024 fxf=evalf(quotesubst(f,x,xf,contextptr),1,contextptr);
6025 A=dx*fxf/2;
6026 res.push_back(xf+fxf*cst_i);
6027 xf=x0+dx;
6028 for (int i=0;i<n-1;++i){
6029 fxf=evalf(quotesubst(f,x,xf,contextptr),1,contextptr);
6030 A=A+dx*fxf;
6031 res.push_back(xf+fxf*cst_i);
6032 x0=x0+dx;
6033 xf=xf+dx;
6034 }
6035 fxf=evalf(quotesubst(f,x,b,contextptr),1,contextptr);
6036 A=A+dx*fxf/2;
6037 res.push_back(b+fxf*cst_i);
6038 }
6039 res.push_back(b);
6040 int nd=decimal_digits(contextptr);
6041 decimal_digits(3,contextptr);
6042 attributs[1]=string2gen(A.print(contextptr),false);
6043 decimal_digits(nd,contextptr);
6044 return gen(makevecteur(gen(makevecteur(pnt_attrib(res,attributs,contextptr),graph),_SEQ__VECT),_couleur(makevecteur(graph,_RED+_DASH_LINE+_LINE_WIDTH_3),contextptr)),_SEQ__VECT);
6045 } // end if (s>=3)
6046 } // end polyg.type==_VECT
6047 }
6048 }
6049 } // end s>=2
6050 }
6051 return gensizeerr(gettext("not supported"));
6052 }
6053 static const char _plotarea_s []="plotarea";
6054 static define_unary_function_eval (__plotarea,&_plotarea,_plotarea_s);
6055 define_unary_function_ptr5( at_plotarea ,alias_at_plotarea,&__plotarea,0,true);
6056
6057 static const char _areaplot_s []="areaplot";
6058 static define_unary_function_eval (__areaplot,&_plotarea,_areaplot_s);
6059 define_unary_function_ptr5( at_areaplot ,alias_at_areaplot,&__areaplot,0,true);
6060
_add_language(const gen & args,GIAC_CONTEXT)6061 gen _add_language(const gen & args,GIAC_CONTEXT){
6062 if ( args.type==_STRNG && args.subtype==-1) return args;
6063 if (args.type==_INT_){
6064 add_language(args.val,contextptr);
6065 return 1;
6066 }
6067 if (args.type==_STRNG){
6068 string s=*args._STRNGptr;
6069 s=s.substr(0,2);
6070 int i=string2lang(s);
6071 if (i){
6072 add_language(i,contextptr);
6073 return 1;
6074 }
6075 }
6076 return 0;
6077 }
6078 static const char _add_language_s []="add_language";
6079 static define_unary_function_eval (__add_language,&_add_language,_add_language_s);
6080 define_unary_function_ptr5( at_add_language ,alias_at_add_language,&__add_language,0,true);
6081
_remove_language(const gen & args,GIAC_CONTEXT)6082 gen _remove_language(const gen & args,GIAC_CONTEXT){
6083 if ( args.type==_STRNG && args.subtype==-1) return args;
6084 if (args.type==_INT_){
6085 remove_language(args.val,contextptr);
6086 return 1;
6087 }
6088 if (args.type==_STRNG){
6089 string s=*args._STRNGptr;
6090 s=s.substr(0,2);
6091 int i=string2lang(s);
6092 if (i){
6093 remove_language(i,contextptr);
6094 return 1;
6095 }
6096 }
6097 return 0;
6098 }
6099 static const char _remove_language_s []="remove_language";
6100 static define_unary_function_eval (__remove_language,&_remove_language,_remove_language_s);
6101 define_unary_function_ptr5( at_remove_language ,alias_at_remove_language,&__remove_language,0,true);
6102
_show_language(const gen & args,GIAC_CONTEXT)6103 gen _show_language(const gen & args,GIAC_CONTEXT){
6104 if ( args.type==_STRNG && args.subtype==-1) return args;
6105 return vector_int_2_vecteur(lexer_localization_vector());
6106 }
6107 static const char _show_language_s []="show_language";
6108 static define_unary_function_eval (__show_language,&_show_language,_show_language_s);
6109 define_unary_function_ptr5( at_show_language ,alias_at_show_language,&__show_language,0,true);
6110
_set_language(const gen & args,GIAC_CONTEXT)6111 gen _set_language(const gen & args,GIAC_CONTEXT){
6112 if ( args.type==_STRNG && args.subtype==-1) return args;
6113 if (args.type!=_INT_)
6114 return undef;
6115 #if 0
6116 static int i=0;
6117 if (language(contextptr)==args.val){
6118 ++i;
6119 return string2gen("ans("+print_INT_(i)+")= ",false);
6120 }
6121 #endif
6122 gen res=string2gen(set_language(args.val,contextptr),false);
6123 return res;
6124 }
6125 static const char _set_language_s []="set_language";
6126 static define_unary_function_eval (__set_language,&_set_language,_set_language_s);
6127 define_unary_function_ptr5( at_set_language ,alias_at_set_language,&__set_language,0,true);
6128
_os_version(const gen & args,GIAC_CONTEXT)6129 gen _os_version(const gen & args,GIAC_CONTEXT){
6130 if ( args.type==_STRNG && args.subtype==-1) return args;
6131 #ifdef WIN32
6132 return string2gen("win",false);
6133 #else
6134 #ifdef __APPLE__
6135 return string2gen("macos",false);
6136 #else
6137 return string2gen("unix",false);
6138 #endif
6139 #endif
6140 }
6141 static const char _os_version_s []="os_version";
6142 static define_unary_function_eval (__os_version,&_os_version,_os_version_s);
6143 define_unary_function_ptr5( at_os_version ,alias_at_os_version,&__os_version,0,true);
6144
6145 #ifndef GIAC_HAS_STO_38
plotproba(const gen & args,const vecteur & positions,const vecteur & attributs,GIAC_CONTEXT)6146 gen plotproba(const gen & args,const vecteur & positions,const vecteur & attributs,GIAC_CONTEXT){
6147 if (args.type!=_VECT)
6148 return gensizeerr(contextptr);
6149 matrice m (*args._VECTptr);
6150 // check if there is a row of legende strings
6151 gen leg;
6152 if (!is_squarematrix(m)){
6153 if (!ckmatrix(m) || m.empty())
6154 return gensizeerr(contextptr);
6155 int r=m.size();
6156 int c=m[0]._VECTptr->size();
6157 if (c==r+1){
6158 m=mtran(m);
6159 c=r;
6160 }
6161 else {
6162 if (r!=c+1)
6163 return gensizeerr(contextptr);
6164 }
6165 // first or last row?
6166 gen m00=m[0][0];
6167 if (m00.type==_IDNT || m00.type==_STRNG){
6168 leg=m.front();
6169 m=vecteur(m.begin()+1,m.end());
6170 }
6171 else {
6172 leg=m.back();
6173 m.pop_back();
6174 }
6175 }
6176 int ms=m.size();
6177 if (ms<2)
6178 return gendimerr(contextptr);
6179 // check if coeffs>=0 and sum coeffs = 1 on rows or on columns
6180 gen g=_sum(args,contextptr);
6181 if (!is_zero(g-vecteur(ms,1))){
6182 m=mtran(m);
6183 ms=m.size();
6184 g=_sum(m,contextptr);
6185 if (!is_zero(g-vecteur(ms,1)))
6186 *logptr(contextptr) << gettext("Warning: not a graph matrix!") << '\n';
6187 }
6188 // first make points,
6189 double xmin(0),xmax(0),ymin(0),ymax(0);
6190 vecteur l(ms),pos(ms),col(ms,_BLACK);
6191 switch (ms){
6192 case 2:
6193 xmin=-0.5; xmax=1.5; ymin=-0.5; ymax=0.5;
6194 l[0]=0.; pos[0]=_QUADRANT3;
6195 l[1]=1.; pos[1]=_QUADRANT4; col[1]=35;
6196 break;
6197 case 3:
6198 xmin=-0.5; xmax=1.5; ymin=-0.5; ymax=1;
6199 l[0]=0.0; pos[0]=_QUADRANT3;
6200 l[1]=1.0; pos[1]=_QUADRANT4;col[1]=35;
6201 l[2]=gen(0.5,std::sqrt(3.0)/2); pos[2]=_QUADRANT1; col[2]=11;
6202 break;
6203 case 4:
6204 xmin=-0.5; xmax=1.5; ymin=-0.5; ymax=1;
6205 l[0]=0.; pos[0]=_QUADRANT3;
6206 l[1]=1; pos[1]=_QUADRANT4;col[1]=35;
6207 l[2]=gen(0.5,0.5*std::sqrt(3.0)); pos[2]=_QUADRANT1; col[2]=11;
6208 l[3]=(l[1]+l[2])/3; // isobarycenter
6209 col[3]=58;
6210 break;
6211 case 5:
6212 xmin=-0.5; xmax=3.5; ymin=-0.5; ymax=3;
6213 l[0]=0.; pos[0]=_QUADRANT3;
6214 l[1]=3.; pos[1]=_QUADRANT4;col[1]=35;
6215 l[2]=gen(1.5,1.5*std::sqrt(3.0)); pos[2]=_QUADRANT1; col[2]=11;
6216 l[3]=gen(1.,.75); col[3]=58;
6217 l[4]=gen(2.,.75); col[4]=_MAGENTA;
6218 break;
6219 case 6:
6220 xmin=-0.5; xmax=3.5; ymin=-0.5; ymax=3;
6221 l[0]=0.; pos[0]=_QUADRANT3;
6222 l[1]=3.; pos[1]=_QUADRANT4;col[1]=35;
6223 l[2]=gen(1.5,1.5*std::sqrt(3.0)); pos[2]=_QUADRANT1; col[2]=11;
6224 l[3]=gen(1.,.5); col[3]=58;
6225 l[4]=gen(2.,.5); col[4]=_MAGENTA;
6226 l[5]=gen(1.5,1.36602540378); col[5]=220;
6227 break;
6228 default:
6229 xmin=-0.5; xmax=3.5; ymin=-0.5; ymax=3;
6230 l[0]=0.; pos[0]=_QUADRANT3;
6231 l[1]=3.; pos[1]=_QUADRANT4;col[1]=35;
6232 l[2]=gen(1.5,1.5*std::sqrt(3.0)); pos[2]=_QUADRANT1; col[2]=11;
6233 l[3]=gen(1.,.5); col[3]=58;
6234 l[4]=gen(2.,.5); col[4]=_MAGENTA;
6235 l[5]=gen(1.5,1.36602540378); col[5]=220;
6236 l[6]=gen(1.36,0.97); col[6]=_RED;
6237 break;
6238 }
6239 if (int(positions.size())==ms){
6240 vecteur tmp=positions;
6241 for (int i=0;i<ms;++i){
6242 tmp[i]=eval(tmp[i],1,contextptr);
6243 gen p=evalf_double(tmp[i],1,contextptr);
6244 tmp[i]=remove_at_pnt(p);
6245 if (tmp[i].type<_POLY){
6246 l[i]=tmp[i];
6247 // adjust color and position
6248 if (p.is_symb_of_sommet(at_pnt) && p._SYMBptr->feuille.type==_VECT && p._SYMBptr->feuille._VECTptr->size()>1){
6249 p=(*p._SYMBptr->feuille._VECTptr)[1];
6250 if (p.type==_VECT && !p._VECTptr->empty())
6251 p=p._VECTptr->front();
6252 p=exact(p,contextptr);
6253 if (p.type==_INT_){
6254 if ((p.val & 0xffff)){
6255 pos[i]=0;
6256 col[i]=p.val;
6257 }
6258 else
6259 pos[i]=p.val;
6260 }
6261 }
6262 }
6263 }
6264 }
6265 else {
6266 if (ms>7)
6267 return gendimerr(contextptr);
6268 }
6269 if (!attributs.empty() && attributs[0].type==_VECT && int(attributs[0]._VECTptr->size())==ms)
6270 col=*attributs[0]._VECTptr;
6271 // then link if matrix cell is not 0
6272 vecteur res;
6273 res.reserve(2*ms*ms+ms+3);
6274 res.push_back(symb_equal(change_subtype(_AXES,_INT_PLOT),0));
6275 if (xmin!=xmax && ymin!=ymax){
6276 res.push_back(symb_equal(change_subtype(_GL_X,_INT_PLOT),symb_interval(xmin,xmax)));
6277 res.push_back(symb_equal(change_subtype(_GL_Y,_INT_PLOT),symb_interval(ymin,ymax)));
6278 }
6279 for (int i=0;i<ms;++i){
6280 string s;
6281 if (leg.type==_VECT && int(leg._VECTptr->size())>i)
6282 s=leg[i].print(contextptr);
6283 else {
6284 if (int(positions.size())>i && positions[i].type==_IDNT)
6285 s = positions[i].print(contextptr);
6286 else
6287 s+=char('A'+i);
6288 }
6289 gen mii=m[i][i];
6290 if (mii.type==_DOUBLE_)
6291 mii=_round(makesequence(mii,3),contextptr);
6292 if (!is_zero(mii))
6293 s += ':'+mii.print();
6294 gen legende=symb_equal(at_legende,string2gen(s,false));
6295 pos[i].subtype=_INT_PLOT;
6296 col[i].subtype=_INT_PLOT;
6297 gen aff=symb_equal(at_display,pos[i]+col[i]);
6298 res.push_back(_point(gen(makevecteur(l[i],legende,aff),_SEQ__VECT),contextptr));
6299 }
6300 for (int i=0;i<ms;++i){
6301 for (int j=0;j<ms;++j){
6302 if (i==j)
6303 continue;
6304 gen mij=m[i][j];
6305 if (mij.type==_DOUBLE_)
6306 mij=_round(makesequence(mij,3),contextptr);
6307 if (mij!=0){
6308 gen legende=symb_equal(at_legende,mij);
6309 gen aff=symb_equal(at_display,col[j]);
6310 res.push_back(_arc(gen(makevecteur(l[i],l[j],0.6,2,legende,aff),_SEQ__VECT),contextptr));
6311 }
6312 }
6313 }
6314 return res;
6315 }
6316
6317 // plotproba(matrix)
6318 // display a graph from a weight matrix
_plotproba(const gen & args,GIAC_CONTEXT)6319 gen _plotproba(const gen & args,GIAC_CONTEXT){
6320 if ( args.type==_STRNG && args.subtype==-1) return args;
6321 vecteur attributs(1,default_color(contextptr));
6322 vecteur v(seq2vecteur(args));
6323 int s=read_attributs(v,attributs,contextptr);
6324 if (!s || s>2 || (s==2 && v[1].type!=_VECT) )
6325 return gendimerr(contextptr);
6326 v.front()=eval(v.front(),1,contextptr);
6327 if (s==2 && v.front().type==_VECT && is_squarematrix(v.front()) && !v[1]._VECTptr->empty() && v[1]._VECTptr->front().type==_STRNG){
6328 vecteur mb=*v.front()._VECTptr;
6329 mb.push_back(v.back());
6330 v.front()=mb;
6331 s=1;
6332 }
6333 if (s==1)
6334 return plotproba(v.front(),vecteur(0),attributs,contextptr);
6335 return plotproba(v[0],*v[1]._VECTptr,attributs,contextptr);
6336 }
6337 static const char _plotproba_s []="plotproba";
6338 static define_unary_function_eval_quoted (__plotproba,&_plotproba,_plotproba_s);
6339 define_unary_function_ptr5( at_plotproba ,alias_at_plotproba,&__plotproba,_QUOTE_ARGUMENTS,true);
6340 #endif
6341
_flatten(const gen & args,GIAC_CONTEXT)6342 gen _flatten(const gen & args,GIAC_CONTEXT){
6343 if ( args.type==_STRNG && args.subtype==-1) return args;
6344 if (args.type!=_VECT) return gensizeerr(contextptr);
6345 vecteur res;
6346 aplatir(*args._VECTptr,res,true);
6347 return gen(res,args.subtype);
6348 }
6349 static const char _flatten_s []="flatten";
6350 static define_unary_function_eval (__flatten,&_flatten,_flatten_s);
6351 define_unary_function_ptr5( at_flatten ,alias_at_flatten,&__flatten,0,true);
6352
_flatten1(const gen & args,GIAC_CONTEXT)6353 gen _flatten1(const gen & args,GIAC_CONTEXT){
6354 if ( args.type==_STRNG && args.subtype==-1) return args;
6355 if (args.type!=_VECT) return gensizeerr(contextptr);
6356 vecteur res;
6357 aplatir(*args._VECTptr,res,false);
6358 return res;
6359 }
6360 static const char _flatten1_s []="flatten1";
6361 static define_unary_function_eval (__flatten1,&_flatten1,_flatten1_s);
6362 define_unary_function_ptr5( at_flatten1 ,alias_at_flatten1,&__flatten1,0,true);
6363
has_undef_stringerr(const gen & g,std::string & err)6364 bool has_undef_stringerr(const gen & g,std::string & err){
6365 if (g.type==_STRNG && g.subtype==-1){
6366 err=*g._STRNGptr;
6367 return true;
6368 }
6369 if (g.type==_VECT){
6370 unsigned s=unsigned(g._VECTptr->size());
6371 for (unsigned i=0;i<s;++i){
6372 if (has_undef_stringerr((*g._VECTptr)[i],err))
6373 return true;
6374 }
6375 return false;
6376 }
6377 if (g.type==_POLY){
6378 unsigned s=unsigned(g._POLYptr->coord.size());
6379 for (unsigned i=0;i<s;++i){
6380 if (has_undef_stringerr(g._POLYptr->coord[i].value,err))
6381 return true;
6382 }
6383 return false;
6384 }
6385 if (g.type==_SYMB)
6386 return has_undef_stringerr(g._SYMBptr->feuille,err);
6387 return false;
6388 }
6389
_caseval(const gen & args,GIAC_CONTEXT)6390 gen _caseval(const gen & args,GIAC_CONTEXT){
6391 #ifdef TIMEOUT
6392 caseval_begin=time(0);
6393 #endif
6394 if ( args.type==_STRNG && args.subtype==-1) return args;
6395 if (args.type!=_STRNG){
6396 gen g=protecteval(args,1,contextptr);
6397 string err;
6398 if (has_undef_stringerr(g,err)){
6399 err = "GIAC_ERROR: "+err;
6400 g=string2gen(err,false);
6401 g.subtype=-1;
6402 }
6403 return g;
6404 }
6405 if (*args._STRNGptr=="init geogebra")
6406 init_geogebra(1,contextptr);
6407 if (*args._STRNGptr=="close geogebra")
6408 init_geogebra(0,contextptr);
6409 #ifdef TIMEOUT
6410 if (args._STRNGptr->size()>8 && args._STRNGptr->substr(0,8)=="timeout "){
6411 string t=args._STRNGptr->substr(8,args._STRNGptr->size()-8);
6412 double f=atof(t.c_str());
6413 if (f>=0 && f<24*60){
6414 caseval_maxtime=f;
6415 caseval_n=0;
6416 caseval_mod=10;
6417 return string2gen("Max eval time set to "+gen(f).print(),false);
6418 }
6419 }
6420 if (args._STRNGptr->size()>8 && args._STRNGptr->substr(0,8)=="ckevery "){
6421 string t=args._STRNGptr->substr(8,args._STRNGptr->size()-8);
6422 int f=atoi(t.c_str());
6423 if (f>0 && f<1e6){
6424 caseval_mod=f;
6425 return string2gen("Check every "+gen(f).print(),false);
6426 }
6427 }
6428 #endif
6429 return string2gen(caseval(args._STRNGptr->c_str()),false);
6430 }
6431 static const char _caseval_s []="caseval";
6432 static define_unary_function_eval_quoted (__caseval,&_caseval,_caseval_s);
6433 define_unary_function_ptr5( at_caseval ,alias_at_caseval,&__caseval,_QUOTE_ARGUMENTS,true);
6434
scalarproduct(const vecteur & a,const vecteur & b,GIAC_CONTEXT)6435 gen scalarproduct(const vecteur & a,const vecteur & b,GIAC_CONTEXT){
6436 vecteur::const_iterator ita=a.begin(), itaend=a.end();
6437 vecteur::const_iterator itb=b.begin(), itbend=b.end();
6438 gen res,tmp;
6439 for (;(ita!=itaend)&&(itb!=itbend);++ita,++itb){
6440 type_operator_times(conj(*ita,contextptr),(*itb),tmp);
6441 res += tmp;
6442 }
6443 return res;
6444 }
6445
conjugate_gradient(const matrice & A,const vecteur & b_orig,const vecteur & x0,double eps,int maxiter,GIAC_CONTEXT)6446 gen conjugate_gradient(const matrice & A,const vecteur & b_orig,const vecteur & x0,double eps,int maxiter,GIAC_CONTEXT){
6447 int n=int(A.size());
6448 vecteur b=subvecteur(b_orig,multmatvecteur(A,x0));
6449 vecteur xk(x0);
6450 vecteur rk(b),pk(b);
6451 gen rk2=scalarproduct(rk,rk,contextptr);
6452 vecteur Apk(n),tmp(n);
6453 for (int k=1;k<=maxiter;++k){
6454 multmatvecteur(A,pk,Apk);
6455 gen alphak=rk2/scalarproduct(pk,Apk,contextptr);
6456 multvecteur(alphak,pk,tmp);
6457 addvecteur(xk,tmp,xk);
6458 multvecteur(alphak,Apk,tmp);
6459 subvecteur(rk,tmp,rk);
6460 gen newrk2=scalarproduct(rk,rk,contextptr);
6461 if (is_greater(eps*eps,newrk2,contextptr))
6462 return xk;
6463 multvecteur(newrk2/rk2,pk,tmp);
6464 addvecteur(rk,tmp,pk);
6465 rk2=newrk2;
6466 }
6467 *logptr(contextptr) << gettext("Warning! Leaving conjugate gradient algorithm after dimension of matrix iterations. Check that your matrix is hermitian/symmetric definite.") << '\n';
6468 return xk;
6469 }
6470
6471 // Ax=b where A=D+B, Dx_{n+1}=b-B*x_n
jacobi_linsolve(const matrice & A,const vecteur & b_orig,const vecteur & x0,double eps,int maxiter,GIAC_CONTEXT)6472 gen jacobi_linsolve(const matrice & A,const vecteur & b_orig,const vecteur & x0,double eps,int maxiter,GIAC_CONTEXT){
6473 int n=int(A.size());
6474 matrice B(A);
6475 vecteur D(n);
6476 vecteur b=*evalf_double(b_orig,1,contextptr)._VECTptr;
6477 for (int i=0;i<n;++i){
6478 vecteur Ai=*evalf(A[i],1,contextptr)._VECTptr;
6479 D[i]=Ai[i];
6480 Ai[i]=0;
6481 B[i]=Ai;
6482 }
6483 vecteur tmp(n),xn(x0),prev(n);
6484 gen bn=l2norm(b,contextptr);
6485 for (int i=0;i<maxiter;++i){
6486 prev=xn;
6487 multmatvecteur(B,xn,tmp);
6488 subvecteur(b,tmp,xn);
6489 iterateur jt=xn.begin(),jtend=xn.end(),dt=D.begin();
6490 for (;jt!=jtend;++jt){
6491 *jt=*jt / *dt;
6492 }
6493 gen g=l2norm(xn-prev,contextptr)/bn;
6494 if (is_greater(eps,g,contextptr))
6495 return xn;
6496 }
6497 *logptr(contextptr) << gettext("Warning! Leaving Jacobi iterative algorithm after maximal number of iterations. Check that your matrix is diagonal dominant.") << '\n';
6498 return xn;
6499 }
6500
6501 // Ax=b where A=L+D+U, (D+L)x_{n+1}=b-U*x_n (Gauss-Seidel for omega==1)
6502 // or (L+D/omega)*x_{n+1}=b-(U+D*(1-1/omega))*x_n
gauss_seidel_linsolve(const matrice & A,const vecteur & b_orig,const vecteur & x0,double omega,double eps,int maxiter,GIAC_CONTEXT)6503 gen gauss_seidel_linsolve(const matrice & A,const vecteur & b_orig,const vecteur & x0,double omega,double eps,int maxiter,GIAC_CONTEXT){
6504 int n=int(A.size());
6505 double invomega=1/omega;
6506 matrice L(n),U(n);
6507 vecteur b=*evalf_double(b_orig,1,contextptr)._VECTptr;
6508 for (int i=0;i<n;++i){
6509 vecteur Ai=*evalf(A[i],1,contextptr)._VECTptr;
6510 L[i]=vecteur(Ai.begin(),Ai.begin()+i);
6511 L[i]._VECTptr->reserve(n);
6512 L[i]._VECTptr->push_back(invomega*Ai[i]);
6513 for (int j=i+1;j<n;++j) L[i]._VECTptr->push_back(0.0);
6514 vecteur tmp(i+1,0.0);
6515 tmp[i]=(1-invomega)*Ai[i];
6516 U[i]=mergevecteur(tmp,vecteur(Ai.begin()+i+1,Ai.end()));
6517 }
6518 vecteur tmp(n),xn(x0),prev(n);
6519 gen bn=l2norm(b,contextptr);
6520 for (int i=0;i<maxiter;++i){
6521 prev=xn;
6522 multmatvecteur(U,xn,tmp);
6523 subvecteur(b,tmp,tmp);
6524 linsolve_l(L,tmp,xn);
6525 gen g=l2norm(xn-prev,contextptr)/bn;
6526 if (is_greater(eps,g,contextptr))
6527 return xn;
6528 }
6529 *logptr(contextptr) << gettext("Warning! Leaving Gauss-Seidel iterative algorithm after maximal number of iterations. Check that your matrix is diagonal dominant.") << '\n';
6530 return xn;
6531 }
6532
6533 // params: matrix A, vector b, optional init value x0, optional precision eps
iterative_solver(const gen & args,int method,GIAC_CONTEXT)6534 gen iterative_solver(const gen & args,int method,GIAC_CONTEXT){
6535 if ( args.type==_STRNG && args.subtype==-1) return args;
6536 if (args.type!=_VECT || args._VECTptr->size()<2)
6537 return gensizeerr(contextptr);
6538 vecteur v = *args._VECTptr;
6539 double omega=1.0;
6540 if (!v.empty() && v[0].type!=_VECT && v[0].type!=_MAP){
6541 gen v0=evalf_double(v[0],1,contextptr);
6542 if (v0.type!=_DOUBLE_)
6543 return gensizeerr("Bad omega value or bad first argument value");
6544 omega=v0._DOUBLE_val;
6545 if (omega<=0)
6546 omega=epsilon(contextptr);
6547 if (omega>=2)
6548 omega=2-epsilon(contextptr);
6549 v.erase(v.begin());
6550 }
6551 int s=int(v.size());
6552 gen A=v[0];
6553 gen b=v[1];
6554 bool creux=A.type==_MAP && b.type==_VECT;
6555 int n;
6556 if (creux)
6557 n=int(b._VECTptr->size());
6558 else {
6559 if (!is_squarematrix(A) || b.type!=_VECT)
6560 return gensizeerr(contextptr);
6561 n=int(A._VECTptr->size());
6562 if (n!=int(b._VECTptr->size()))
6563 return gensizeerr(contextptr);
6564 }
6565 vecteur x0(n);
6566 gen eps; gen niter(-1);
6567 if (s>=3){
6568 if (v[2].type==_VECT){
6569 if (int(v[2]._VECTptr->size())!=n)
6570 return gensizeerr(contextptr);
6571 x0=*v[2]._VECTptr;
6572 if (s>3){
6573 eps=v[3];
6574 if (s>4)
6575 niter=v[4];
6576 }
6577 }
6578 else {
6579 eps=v[2];
6580 if (s>3)
6581 niter=v[3];
6582 }
6583 }
6584 if (is_greater(eps,1,contextptr))
6585 swapgen(eps,niter);
6586 if (niter==-1){
6587 switch (method){
6588 case 1: case 2:
6589 niter=SOLVER_MAX_ITERATE*n;
6590 break;
6591 case 4:
6592 niter=n;
6593 break;
6594 default:
6595 niter=n;
6596 }
6597 }
6598 eps=evalf_double(eps,1,contextptr);
6599 if (eps.type!=_DOUBLE_ || eps._DOUBLE_val < 0 || eps._DOUBLE_val>=1)
6600 return gentypeerr(contextptr);
6601 if (!is_integral(niter) || niter.val<1)
6602 return gentypeerr(contextptr);
6603 if (method==1)
6604 return creux?sparse_jacobi_linsolve(*A._MAPptr,*b._VECTptr,x0,eps._DOUBLE_val,niter.val,contextptr):jacobi_linsolve(*A._VECTptr,*b._VECTptr,x0,eps._DOUBLE_val,niter.val,contextptr);
6605 if (method==2)
6606 return creux?sparse_gauss_seidel_linsolve(*A._MAPptr,*b._VECTptr,x0,omega,eps._DOUBLE_val,niter.val,contextptr):gauss_seidel_linsolve(*A._VECTptr,*b._VECTptr,x0,omega,eps._DOUBLE_val,niter.val,contextptr);
6607 if (method==4)
6608 return creux?sparse_conjugate_gradient(*A._MAPptr,*b._VECTptr,x0,eps._DOUBLE_val,niter.val,contextptr):conjugate_gradient(*A._VECTptr,*b._VECTptr,x0,eps._DOUBLE_val,niter.val,contextptr);
6609 return gensizeerr(contextptr);
6610 }
6611 // params: matrix A, vector b, optional init value x0, optional precision eps
_conjugate_gradient(const gen & args,GIAC_CONTEXT)6612 gen _conjugate_gradient(const gen & args,GIAC_CONTEXT){
6613 return iterative_solver(args,4,contextptr);
6614 }
6615 static const char _conjugate_gradient_s []="conjugate_gradient";
6616 static define_unary_function_eval (__conjugate_gradient,&_conjugate_gradient,_conjugate_gradient_s);
6617 define_unary_function_ptr5( at_conjugate_gradient ,alias_at_conjugate_gradient,&__conjugate_gradient,0,true);
6618
_jacobi_linsolve(const gen & args,GIAC_CONTEXT)6619 gen _jacobi_linsolve(const gen & args,GIAC_CONTEXT){
6620 return iterative_solver(args,1,contextptr);
6621 }
6622 static const char _jacobi_linsolve_s []="jacobi_linsolve";
6623 static define_unary_function_eval (__jacobi_linsolve,&_jacobi_linsolve,_jacobi_linsolve_s);
6624 define_unary_function_ptr5( at_jacobi_linsolve ,alias_at_jacobi_linsolve,&__jacobi_linsolve,0,true);
6625
_gauss_seidel_linsolve(const gen & args,GIAC_CONTEXT)6626 gen _gauss_seidel_linsolve(const gen & args,GIAC_CONTEXT){
6627 return iterative_solver(args,2,contextptr);
6628 }
6629 static const char _gauss_seidel_linsolve_s []="gauss_seidel_linsolve";
6630 static define_unary_function_eval (__gauss_seidel_linsolve,&_gauss_seidel_linsolve,_gauss_seidel_linsolve_s);
6631 define_unary_function_ptr5( at_gauss_seidel_linsolve ,alias_at_gauss_seidel_linsolve,&__gauss_seidel_linsolve,0,true);
6632
_subtype(const gen & args,GIAC_CONTEXT)6633 gen _subtype(const gen & args,GIAC_CONTEXT){
6634 if (args.type==_INT_ && args.subtype==0)
6635 return change_subtype(0,_INT_TYPE);
6636 if (args.type==_ZINT && args.subtype==0)
6637 return change_subtype(2,_INT_TYPE);
6638 if (args.type==_DOUBLE_)
6639 return change_subtype(1,_INT_TYPE);
6640 if (args.type==_REAL)
6641 return change_subtype(3,_INT_TYPE);
6642 return args.subtype;
6643 }
6644 static const char _subtype_s []="subtype";
6645 static define_unary_function_eval (__subtype,&_subtype,_subtype_s);
6646 define_unary_function_ptr5( at_subtype ,alias_at_subtype,&__subtype,0,true);
6647
6648 // Graph utilities
6649 // convert matrice of probability to matrice of booleans
6650 // m[i][j]!=0 means there is a link from i to j
proba2adjacence(const matrice & m,vector<vector<unsigned>> & v,bool check,GIAC_CONTEXT)6651 bool proba2adjacence(const matrice & m,vector< vector<unsigned> >& v,bool check,GIAC_CONTEXT){
6652 if (!is_integer_matrice(m) && !is_zero(1-_plus(m.front(),contextptr),contextptr)){
6653 if (!check)
6654 return false;
6655 return proba2adjacence(mtran(m),v,false,contextptr);
6656 }
6657 int l,c;
6658 mdims(m,l,c);
6659 v.resize(l);
6660 for (int i=0;i<l;++i){
6661 vecteur & mi=*m[i]._VECTptr;
6662 vector<unsigned> & vi =v[i];
6663 vi.clear();
6664 vi.resize((c+31)/32);
6665 for (int j=0;j<c;++j){
6666 if (!is_zero(mi[j]))
6667 vi[j/32] |= 1<<(j%32);
6668 }
6669 }
6670 return true;
6671 }
6672
6673 // For large graphs, use Tarjan algorithm
6674 struct vertex {
6675 int index,lowlink;
vertexgiac::vertex6676 vertex():index(-1),lowlink(-1){}; // -1 means undefined
6677 };
6678
strongconnect(const vector<vector<unsigned>> & G,vector<vertex> & V,int & index,vector<unsigned> & S,vector<bool> & inS,vector<vector<unsigned>> & SCC,unsigned v)6679 void strongconnect(const vector< vector<unsigned> > & G,vector<vertex> & V,int & index,vector<unsigned> & S,vector<bool> & inS,vector< vector<unsigned> > & SCC,unsigned v){
6680 V[v].index=index;
6681 V[v].lowlink=index;
6682 ++index;
6683 S.push_back(v);
6684 inS[v]=true;
6685 const vector<unsigned> & Gv=G[v];
6686 for (unsigned i=0;i<Gv.size();++i){
6687 unsigned Gvi=Gv[i];
6688 if (!Gvi)
6689 continue;
6690 for (unsigned j=0;Gvi && j<32;Gvi/=2, ++j){
6691 if (!(Gvi %2))
6692 continue;
6693 unsigned w=i*32+j;
6694 if (V[w].index==-1){
6695 // Successor w has not yet been visited; recurse on it
6696 strongconnect(G,V,index,S,inS,SCC,w);
6697 V[v].lowlink=giacmin(V[v].lowlink,V[w].lowlink);
6698 continue;
6699 }
6700 if (inS[w]){
6701 // successor of w is in stack S, hence is in the current SCC
6702 V[v].lowlink=giacmin(V[v].lowlink,V[w].index);
6703 }
6704 }
6705 } // end for (visit all vertices connected to v)
6706 // If v is a root node, pop the stack and generate a strongly connected component
6707 if (V[v].lowlink==V[v].index){
6708 vector<unsigned> scc;
6709 for (;!S.empty();){
6710 scc.push_back(S.back());
6711 S.pop_back();
6712 inS[scc.back()]=false;
6713 if (scc.back()==v)
6714 break;
6715 }
6716 SCC.push_back(scc);
6717 }
6718 }
6719
tarjan(const vector<vector<unsigned>> & G,vector<vector<unsigned>> & SCC)6720 void tarjan(const vector< vector<unsigned> > & G,vector< vector<unsigned> > & SCC){
6721 vector<vertex> V(G.size());
6722 SCC.clear();
6723 vector<unsigned> S;
6724 S.reserve(G.size());
6725 vector<bool> inS(G.size(),false);
6726 int index=0;
6727 for (unsigned v=0;v<G.size();++v){
6728 if (V[v].index==-1)
6729 strongconnect(G,V,index,S,inS,SCC,v);
6730 }
6731 }
6732
classify_scc(const vector<vector<unsigned>> & G,vector<vector<unsigned>> & SCC,vector<vector<unsigned>> & SCCrec,vector<vector<unsigned>> & SCCtrans)6733 void classify_scc(const vector< vector<unsigned> > & G,vector< vector<unsigned> > & SCC, vector< vector<unsigned> > & SCCrec,vector< vector<unsigned> > & SCCtrans){
6734 // Look at each SCC: if it has all outgoing edges going to the same component,
6735 // then this is a recurrent positive, and we can compute the invariant probability
6736 if (SCC.empty())
6737 tarjan(G,SCC);
6738 for (unsigned i=0;i<SCC.size();++i){
6739 const vector<unsigned> & SCCi=SCC[i];
6740 vector<bool> in(G.size(),false);
6741 for (unsigned j=0;j<SCCi.size();++j){
6742 in[SCCi[j]]=true;
6743 }
6744 bool recurrent=true;
6745 for (unsigned j=0;recurrent && j<SCCi.size();++j){
6746 unsigned source=SCCi[j];
6747 const vector<unsigned> & targetv=G[source];
6748 for (unsigned k=0;recurrent && k<targetv.size();++k){
6749 unsigned Gsk=targetv[k];
6750 unsigned l=k*32;
6751 for (;Gsk;++l,Gsk/=2){
6752 if (Gsk %2 && !in[l]){
6753 recurrent=false;
6754 break;
6755 }
6756 }
6757 }
6758 }
6759 if (recurrent)
6760 SCCrec.push_back(SCCi);
6761 else
6762 SCCtrans.push_back(SCCi);
6763 } // end loop on strong connected components
6764 }
6765
vector_unsigned2vecteur(const vector<unsigned> & V,vecteur & v)6766 void vector_unsigned2vecteur(const vector<unsigned> & V,vecteur & v){
6767 v.clear();
6768 v.reserve(V.size());
6769 for (unsigned i=0;i<V.size();++i)
6770 v.push_back(int(V[i]));
6771 }
6772
matrix_unsigned2matrice(const vector<vector<unsigned>> & M,matrice & m)6773 void matrix_unsigned2matrice(const vector< vector<unsigned> > & M,matrice & m){
6774 m.clear();
6775 m.reserve(M.size());
6776 for (unsigned i=0;i<M.size();++i){
6777 vecteur v;
6778 vector_unsigned2vecteur(M[i],v);
6779 m.push_back(v);
6780 }
6781 }
6782
6783 // Input matrix of adjacency or transition matrix
6784 // Output a list of strongly connected components
_graph_scc(const gen & args,GIAC_CONTEXT)6785 gen _graph_scc(const gen & args,GIAC_CONTEXT){
6786 if ( args.type==_STRNG && args.subtype==-1) return args;
6787 if (!is_squarematrix(args))
6788 return gensizeerr(contextptr);
6789 vector< vector<unsigned> > G,GRAPH_SCC;
6790 if (!proba2adjacence(*args._VECTptr,G,true,contextptr))
6791 return gensizeerr(contextptr);
6792 tarjan(G,GRAPH_SCC);
6793 matrice m;
6794 matrix_unsigned2matrice(GRAPH_SCC,m);
6795 return m;
6796 }
6797 static const char _graph_scc_s []="graph_scc";
6798 static define_unary_function_eval (__graph_scc,&_graph_scc,_graph_scc_s);
6799 define_unary_function_ptr5( at_graph_scc ,alias_at_graph_scc,&__graph_scc,0,true);
6800
extract_submatrix(const matrice & M,const vector<unsigned> & v,matrice & m)6801 void extract_submatrix(const matrice & M,const vector<unsigned> & v,matrice & m){
6802 m.reserve(v.size());
6803 vecteur current(v.size());
6804 for (unsigned j=0;j<v.size();++j){
6805 vector<unsigned>::const_iterator it=v.begin(),itend=v.end();
6806 const_iterateur jt=M[v[j]]._VECTptr->begin();
6807 iterateur kt=current.begin();
6808 for (;it!=itend;++kt,++it)
6809 *kt=*(jt+*it);
6810 m.push_back(current);
6811 }
6812 }
6813
6814 // check that g is a stochastic right or left matrix
6815 // if so set M to the matrix with sum of rows=1
is_stochastic(const gen & g,matrice & M,GIAC_CONTEXT)6816 bool is_stochastic(const gen & g,matrice & M,GIAC_CONTEXT){
6817 if (!is_squarematrix(g))
6818 return false;
6819 gen gd=evalf_double(g,1,contextptr);
6820 if (!is_fully_numeric(gd))
6821 return false;
6822 M=*g._VECTptr;
6823 int ms=int(M.size());
6824 for (int i=0;i<ms;++i){
6825 const vecteur & v=*M[i]._VECTptr;
6826 for (int j=0;j<ms;++j){
6827 if (is_strictly_greater(0,v[j],contextptr))
6828 return false;
6829 }
6830 }
6831 gen sg=_sum(_tran(g,contextptr),contextptr);
6832 if (!is_zero(sg-vecteur(ms,1),contextptr)){
6833 M=mtran(M);
6834 sg=_sum(g,contextptr);
6835 if (!is_zero(sg-vecteur(ms,1),contextptr))
6836 return false;
6837 }
6838 return true;
6839 }
6840
6841 // returns
6842 // -> recurrent states: a list of at least one list:
6843 // each sublist is a strongly connected component
6844 // -> invariant probability state (1-eigenstate) for each recurrent loop
6845 // -> transient states: a list of lists, each sublist is strongly connected
6846 // -> final probability: starting from each site, probability to end up
6847 // in any of the invariant probability state
_markov(const gen & args,GIAC_CONTEXT)6848 gen _markov(const gen & args,GIAC_CONTEXT){
6849 if ( args.type==_STRNG && args.subtype==-1) return args;
6850 gen g;
6851 double eps(epsilon(contextptr));
6852 if (args.type==_VECT && args.subtype==_SEQ__VECT && args._VECTptr->size()>=2){
6853 g=evalf_double(args._VECTptr->back(),1,contextptr);
6854 if (g.type!=_DOUBLE_)
6855 return gensizeerr(contextptr);
6856 eps=g._DOUBLE_val;
6857 g=args._VECTptr->front();
6858 }
6859 else
6860 g=args;
6861 matrice M;
6862 if (!is_stochastic(g,M,contextptr))
6863 return gensizeerr("Not a stochastic matrix!");
6864 int ms=int(M.size());
6865 vector< vector<unsigned> > G,GRAPH_SCC,SCCrec,SCCtrans;
6866 proba2adjacence(M,G,true,contextptr);
6867 classify_scc(G,GRAPH_SCC,SCCrec,SCCtrans);
6868 matrice mrec,mtrans,meigen;
6869 matrix_unsigned2matrice(SCCrec,mrec);
6870 matrix_unsigned2matrice(SCCtrans,mtrans);
6871 // Find eigenstate 1 for each component of SCCrec
6872 for (unsigned i=0;i<SCCrec.size();++i){
6873 vector<unsigned> v=SCCrec[i];
6874 // extract corresponding submatrix from M
6875 matrice m;
6876 sort(v.begin(),v.end());
6877 if (v.size()==M.size())
6878 m=M;
6879 else
6880 extract_submatrix(M,v,m);
6881 m=mtran(m); // find standard linear algebra 1-eigenvector
6882 vecteur w,z;
6883 if (is_exact(m)){
6884 vecteur k;
6885 mker(subvecteur(m,midn(int(m.size()))),k,contextptr);
6886 //k=negvecteur(k);
6887 if (k.size()==1 && k.front().type==_VECT){
6888 // if dim Ker(m-idn)>1 should find a vector with all coordinate >0
6889 z=divvecteur(*k.front()._VECTptr,prodsum(k.front(),false));
6890 }
6891 }
6892 if (z.empty()){
6893 w=vecteur(m.size(),evalf(1,1,contextptr)/int(m.size())); // initial guess
6894 for (;;){
6895 multmatvecteur(m,w,z);
6896 if (is_greater(eps,l1norm(w-z,contextptr),contextptr))
6897 break;
6898 swap(w,z);
6899 }
6900 }
6901 if (v.size()==M.size())
6902 meigen.push_back(z);
6903 else {
6904 w.clear();
6905 unsigned pos=0;
6906 for (unsigned j=0;j<v.size();++j){
6907 for (;pos<v[j];++pos)
6908 w.push_back(0);
6909 w.push_back(z[j]);
6910 ++pos;
6911 }
6912 for (;pos<M.size();++pos)
6913 w.push_back(0);
6914 meigen.push_back(w);
6915 }
6916 }
6917 int nrec=int(meigen.size());
6918 if (nrec==1)
6919 return makesequence(mrec,meigen,mtrans,vecteur(ms,vecteur(1,1)));
6920 // For each initial pure state, find probability to end in
6921 // the recurrents states from meigen
6922 M=mtran(M); // linear algebra iteration v->M*v
6923 matrice mfinal; // will have nrec columns
6924 for (unsigned i=0;int(i)<ms;++i){
6925 vecteur line;
6926 line.reserve(nrec);
6927 // start at state i
6928 // speedup: first look if i is in a recurrent strong component
6929 // if so the final state is the recurrent strong component eigenstate
6930 for (unsigned j=0;j<SCCrec.size();++j){
6931 if (equalposcomp(SCCrec[j],i)){
6932 line=vecteur(nrec,0);
6933 line[j]=1;
6934 break;
6935 }
6936 }
6937 if (!line.empty()){
6938 mfinal.push_back(line);
6939 continue;
6940 }
6941 // otherwise iterate starting from 1 at position i
6942 vecteur w(ms),z(ms);
6943 w[i]=1;
6944 for (;;){
6945 multmatvecteur(M,w,z);
6946 if (is_greater(eps,l1norm(w-z,contextptr),contextptr))
6947 break;
6948 swap(w,z);
6949 }
6950 // find z as a linear combination of the vectors of meigen
6951 for (unsigned j=0;j<meigen.size();++j){
6952 const vecteur & cur=*meigen[j]._VECTptr;
6953 // find the largest component of mcur
6954 int pos=0;
6955 gen maxcur=0;
6956 for (unsigned k=0;k<cur.size();++k){
6957 if (is_strictly_greater(cur[k],maxcur,contextptr)){
6958 maxcur=cur[k];
6959 pos=k;
6960 }
6961 }
6962 // find coefficient
6963 line.push_back(z[pos]/cur[pos]);
6964 }
6965 mfinal.push_back(line);
6966 }
6967 return makesequence(mrec,meigen,mtrans,mfinal);
6968 }
6969 static const char _markov_s []="markov";
6970 static define_unary_function_eval (__markov,&_markov,_markov_s);
6971 define_unary_function_ptr5( at_markov ,alias_at_markov,&__markov,0,true);
6972
6973 // random iterations for a Markov chain of transition matrix M, initial state i,
6974 // number of iterations n
6975 // randmarkov(M,i,n) returns the list of n+1 states starting at i
6976 // randmarkov(M,[i1,..,ip],b) returns the matrix of p rows, each row is
6977 // the list of n+1 states starting at ip
6978 // randmarkov([n1,..,np],nt) make a random Markov transition matrix
6979 // with p recurrent loops of size n1,...,np and nt transient states
_randmarkov(const gen & args,GIAC_CONTEXT)6980 gen _randmarkov(const gen & args,GIAC_CONTEXT){
6981 if ( args.type==_STRNG && args.subtype==-1) return args;
6982 if (args.type!=_VECT)
6983 return gensizeerr(contextptr);
6984 vecteur v = *args._VECTptr;
6985 vecteur attributs(1,default_color(contextptr));
6986 int vs=read_attributs(v,attributs,contextptr);
6987 if (vs<2 || vs>4)
6988 return gensizeerr(contextptr);
6989 bool plot=int(args._VECTptr->size())>vs;
6990 bool polygon=true;
6991 if (vs==4) {
6992 if (v[3]==at_plot || v[3]==at_polygonplot || v[3]==at_scatterplot){
6993 if (v[3]==at_scatterplot)
6994 polygon=true;
6995 plot=true;
6996 }
6997 else
6998 return gensizeerr(contextptr);
6999 }
7000 if (vs==2){
7001 is_integral(v[1]);
7002 if (v[1].type!=_INT_ || v[1].val<0)
7003 return gensizeerr(contextptr);
7004 vecteur w=gen2vecteur(v[0]);
7005 if (!is_integer_vecteur(w))
7006 return gensizeerr(contextptr);
7007 unsigned ws=unsigned(w.size()),n=0;
7008 vector<unsigned> W(ws),Wc(ws+1);
7009 for (unsigned i=0;i<ws;++i){
7010 if (w[i].type!=_INT_ || w[i].val<=0)
7011 return gendimerr(contextptr);
7012 n += (W[i]=w[i].val);
7013 Wc[i+1]=Wc[i]+W[i];
7014 }
7015 int nt=v[1].val,nnt=n+nt;
7016 if (nnt*nnt>LIST_SIZE_LIMIT)
7017 return gendimerr(contextptr);
7018 matrice res(nnt);
7019 int pos=0; // position in W
7020 // first lines (recurrent states)
7021 int cur=Wc[0],next=Wc[1];
7022 for (int i=0;i<int(n);++i){
7023 if (i>=next){
7024 ++pos;
7025 cur=next;
7026 next=Wc[pos+1];
7027 }
7028 vecteur line(nnt);
7029 // create Wc[pos] zeros
7030 // then Wc[pos+1]-Wc[pos] probabilities
7031 for (int j=cur;j<next;++j){
7032 line[j]=giac_rand(contextptr)/(rand_max2+1.0);
7033 }
7034 res[i]=divvecteur(line,prodsum(line,false));
7035 }
7036 // transient states
7037 for (int i=n;i<nnt;++i){
7038 vecteur line(nnt);
7039 for (int j=0;j<nnt;++j){
7040 line[j]=giac_rand(contextptr)/(rand_max2+1.0);
7041 }
7042 res[i]=divvecteur(line,prodsum(line,false));
7043 }
7044 return res;
7045 }
7046 vecteur v1=gen2vecteur(v[1]);
7047 if (!is_integer_vecteur(v1))
7048 return gensizeerr();
7049 is_integral(v[2]);
7050 if (v[2].type!=_INT_ || v[2].val<0)
7051 return gensizeerr(contextptr);
7052 int n=v[2].val;
7053 gen g=v[0];
7054 matrice M;
7055 if (!is_stochastic(g,M,contextptr))
7056 return gensizeerr("Not a stochastic matrix!");
7057 int shift=array_start(contextptr); //0;
7058 //if (xcas_mode(contextptr) || abs_calc_mode(contextptr)==38) shift=1;
7059 vector<unsigned> start(v1.size());
7060 for (unsigned i=0;i<v1.size();++i){
7061 int pos=v1[i].val-shift;
7062 if (pos<0 || pos>=int(M.size()))
7063 return gendimerr(contextptr);
7064 start[i]=pos;
7065 }
7066 // find cumulated frequencies for each row
7067 matrix_double Mcumul(int(M.size()));
7068 for (unsigned I=0;I<Mcumul.size();++I){
7069 const vecteur & v=*M[I]._VECTptr;
7070 vector<giac_double> vcumul(v.size()+1);
7071 vcumul[0]=0;
7072 for (unsigned j=1;j<=v.size();++j){
7073 vcumul[j] = vcumul[j-1]+evalf_double(v[j-1],1,contextptr)._DOUBLE_val;
7074 }
7075 Mcumul[I]=vcumul;
7076 }
7077 // iterate
7078 matrice res;
7079 vecteur line1;
7080 for (int j=0;j<=int(n);++j){
7081 line1.push_back(j);
7082 }
7083 for (unsigned pos=0;pos<start.size();++pos){
7084 int i=start[pos];
7085 vecteur line(1,i);
7086 for (int j=0;j<n;++j){
7087 double d=giac_rand(contextptr)/(rand_max2+1.0);
7088 if (i>int(Mcumul.size()))
7089 return gendimerr(contextptr);
7090 int pos=dichotomy(Mcumul[i],d);
7091 if (pos==-1)
7092 return gendimerr(contextptr);
7093 i=pos;
7094 line.push_back(i+shift);
7095 }
7096 res.push_back(line);
7097 }
7098 if (v[1].type==_INT_){
7099 if (plot){
7100 gen tmp=makesequence(line1,res.front());
7101 if (polygon)
7102 return _polygonscatterplot(tmp,contextptr);
7103 else
7104 return _scatterplot(tmp,contextptr);
7105 }
7106 return res.front();
7107 }
7108 if (plot){
7109 res.insert(res.begin(),line1);
7110 if (polygon)
7111 return _polygonplot(_tran(res,contextptr),contextptr);
7112 else
7113 return _scatterplot(_tran(res,contextptr),contextptr);
7114 }
7115 return res;
7116 }
7117 static const char _randmarkov_s []="randmarkov";
7118 static define_unary_function_eval (__randmarkov,&_randmarkov,_randmarkov_s);
7119 define_unary_function_ptr5( at_randmarkov ,alias_at_randmarkov,&__randmarkov,0,true);
7120
lvarxwithinvsqrt(const gen & e,const gen & x,GIAC_CONTEXT)7121 vecteur lvarxwithinvsqrt(const gen &e,const gen & x,GIAC_CONTEXT){
7122 gen ee=subst(e,invpowtan_tab,invpowtan2_tab,false,contextptr);
7123 ee=remove_nop(ee,x,contextptr);
7124 vecteur w(lvar(ee)),v;
7125 for (int i=0;i<w.size();++i){
7126 if (!is_constant_wrt(w[i],x,contextptr))
7127 v.push_back(w[i]);
7128 }
7129 return v; // to remove nop do a return *(eval(v)._VECTptr);
7130 }
7131
_is_polynomial(const gen & args,GIAC_CONTEXT)7132 gen _is_polynomial(const gen & args,GIAC_CONTEXT){
7133 if ( args.type==_STRNG && args.subtype==-1) return args;
7134 vecteur v;
7135 if (args.type==_VECT && args.subtype!=_SEQ__VECT)
7136 v=vecteur(1,args);
7137 else
7138 v=gen2vecteur(args);
7139 if (v.empty())
7140 return gensizeerr(contextptr);
7141 if (v.size()==1)
7142 v.push_back(ggb_var(args));
7143 gen tmp=apply(v,equal2diff);
7144 vecteur lv=lvarxwithinvsqrt(tmp,v[1],contextptr);
7145 gen res=lv.size()<2?1:0;
7146 res.subtype=_INT_BOOLEAN;
7147 return res;
7148 }
7149 static const char _is_polynomial_s []="is_polynomial";
7150 static define_unary_function_eval (__is_polynomial,&_is_polynomial,_is_polynomial_s);
7151 define_unary_function_ptr5( at_is_polynomial ,alias_at_is_polynomial,&__is_polynomial,0,true);
7152
7153 // find positions of object in list or first position of substring in string
_find(const gen & args,GIAC_CONTEXT)7154 gen _find(const gen & args,GIAC_CONTEXT){
7155 if ( args.type==_STRNG && args.subtype==-1) return args;
7156 vecteur v = gen2vecteur(args);
7157 if (v.size()!=2 && v.size()!=3)
7158 return gensizeerr(contextptr);
7159 gen a=v.front();
7160 int pos=0;
7161 if (v.size()==3){
7162 if (v[2].type!=_INT_)
7163 return gensizeerr(contextptr);
7164 pos=v[2].val;
7165 }
7166 int shift=array_start(contextptr); //xcas_mode(contextptr)>0 || abs_calc_mode(contextptr)==38;
7167 bool py=python_compat(contextptr);
7168 if (a.type==_STRNG && v[1].type!=_VECT){
7169 if (v[1].type!=_STRNG)
7170 return gensizeerr(contextptr);
7171 string s=*v[1]._STRNGptr;
7172 string as=*a._STRNGptr;
7173 if (s.size()>as.size()){
7174 s.swap(as);
7175 *logptr(contextptr) << "Exchanging arguments" << '\n';
7176 }
7177 vecteur res;
7178 for (;;++pos){
7179 pos=int(as.find(s,pos));
7180 if (py)
7181 return pos;
7182 if (pos<0 || pos>=int(as.size()))
7183 break;
7184 res.push_back(pos+shift);
7185 }
7186 return res;
7187 }
7188 if (v[1].type!=_VECT){
7189 if (a.type==_VECT){
7190 *logptr(contextptr) << "Exchanging arguments" << '\n';
7191 v[0]=v[1];
7192 v[1]=a;
7193 a=v[0];
7194 }
7195 else
7196 return gensizeerr(contextptr);
7197 }
7198 const vecteur & w =*v[1]._VECTptr;
7199 int s=int(w.size());
7200 vecteur res;
7201 for (int i=pos;i<s;++i){
7202 if (a==w[i]){
7203 if (py)
7204 return i;
7205 res.push_back(i+shift);
7206 }
7207 }
7208 return res;
7209 }
7210 static const char _find_s []="find";
7211 static define_unary_function_eval (__find,&_find,_find_s);
7212 define_unary_function_ptr5( at_find ,alias_at_find,&__find,0,true);
7213
_dayofweek(const gen & args,GIAC_CONTEXT)7214 gen _dayofweek(const gen & args,GIAC_CONTEXT){
7215 if (args.type!=_VECT || args._VECTptr->size()!=3)
7216 return gensizeerr(contextptr);
7217 vecteur & v = *args._VECTptr;
7218 gen d=v[0],m=v[1],a=v[2];
7219 if (!is_integral(d) && !is_integral(m) && !is_integral(a))
7220 return gensizeerr(contextptr);
7221 int D=d.val,M=m.val,A=a.val;
7222 if (D<1 || D>31 || M<1 || M>12)
7223 return gensizeerr(contextptr);
7224 int x=A;
7225 if (M<3) x--;
7226 int y=(23*M)/9+D+4+A+x/4-x/100+x/400;
7227 if (M<3) y=y%7; else y=(y-2)%7;
7228 return y;
7229 }
7230 static const char _dayofweek_s []="dayofweek";
7231 static define_unary_function_eval (__dayofweek,&_dayofweek,_dayofweek_s);
7232 define_unary_function_ptr5( at_dayofweek ,alias_at_dayofweek,&__dayofweek,0,true);
7233
_evalfa(const gen & args,GIAC_CONTEXT)7234 gen _evalfa(const gen & args,GIAC_CONTEXT){
7235 vecteur v(lop(args,at_rootof));
7236 gen w=evalf(v,1,contextptr);
7237 return subst(args,v,w,false,contextptr);
7238 }
7239 static const char _evalfa_s []="evalfa";
7240 static define_unary_function_eval (__evalfa,&_evalfa,_evalfa_s);
7241 define_unary_function_ptr5( at_evalfa ,alias_at_evalfa,&__evalfa,0,true);
7242
_linspace(const gen & args,GIAC_CONTEXT)7243 gen _linspace(const gen & args,GIAC_CONTEXT){
7244 if (args.type!=_VECT || args._VECTptr->size()<2) return gensizeerr(contextptr);
7245 int n=100;
7246 vecteur v = *args._VECTptr;
7247 gen start=v[0],stop=v[1];
7248 if (v.size()>2){
7249 gen N=v[2];
7250 if (!is_integral(N) || N.val<2)
7251 return gendimerr(contextptr);
7252 n=N.val;
7253 }
7254 gen step=(stop-start)/(n-1);
7255 vecteur w(n);
7256 for (int i=0;i<n;++i){
7257 w[i]=start+i*step;
7258 }
7259 return w;
7260 }
7261 static const char _linspace_s []="linspace";
7262 static define_unary_function_eval (__linspace,&_linspace,_linspace_s);
7263 define_unary_function_ptr5( at_linspace ,alias_at_linspace,&__linspace,0,true);
7264
_Li(const gen & args,GIAC_CONTEXT)7265 gen _Li(const gen & args,GIAC_CONTEXT){
7266 return _Ei(ln(args,contextptr),contextptr);
7267 }
7268 static const char _Li_s []="Li";
7269 static define_unary_function_eval (__Li,&_Li,_Li_s);
7270 define_unary_function_ptr5( at_Li ,alias_at_Li,&__Li,0,true);
7271
_coth(const gen & args,GIAC_CONTEXT)7272 gen _coth(const gen & args,GIAC_CONTEXT){
7273 return inv(tanh(args,contextptr),contextptr);
7274 }
7275 static const char _coth_s []="coth";
7276 static define_unary_function_eval (__coth,&_coth,_coth_s);
7277 define_unary_function_ptr5( at_coth ,alias_at_coth,&__coth,0,true);
7278
_atan2(const gen & args,GIAC_CONTEXT)7279 gen _atan2(const gen & args,GIAC_CONTEXT){
7280 if (args.type!=_VECT)
7281 return gensizeerr(contextptr);
7282 if (//&& args.subtype==_SEQ__VECT
7283 args._VECTptr->size()==2)
7284 return arg(args._VECTptr->back()+cst_i*args._VECTptr->front(),contextptr);
7285 return gensizeerr(contextptr); //apply(args,_atan2,contextptr);
7286 }
7287 static const char _atan2_s []="atan2";
7288 static define_unary_function_eval (__atan2,&_atan2,_atan2_s);
7289 define_unary_function_ptr5( at_atan2 ,alias_at_atan2,&__atan2,0,true);
7290
_acoth(const gen & args,GIAC_CONTEXT)7291 gen _acoth(const gen & args,GIAC_CONTEXT){
7292 return atanh(inv(args,contextptr),contextptr);
7293 }
7294 static const char _acoth_s []="acoth";
7295 static define_unary_function_eval (__acoth,&_acoth,_acoth_s);
7296 define_unary_function_ptr5( at_acoth ,alias_at_acoth,&__acoth,0,true);
7297
_add_autosimplify(const gen & args,GIAC_CONTEXT)7298 gen _add_autosimplify(const gen & args,GIAC_CONTEXT){
7299 return eval(add_autosimplify(args,contextptr),eval_level(contextptr),contextptr);
7300 }
7301 static const char _add_autosimplify_s []="add_autosimplify";
7302 static define_unary_function_eval_quoted (__add_autosimplify,&_add_autosimplify,_add_autosimplify_s);
7303 define_unary_function_ptr5( at_add_autosimplify ,alias_at_add_autosimplify,&__add_autosimplify,_QUOTE_ARGUMENTS,true);
7304
7305
7306 #if 0
7307 // Small graphs, not tested
7308 bool different(const vector<unsigned> & a,const vector<unsigned> & b,vector<int> & pos){
7309 pos.clear();
7310 int s=a.size();
7311 for (int i=0;i<s;++i){
7312 unsigned ai=a[i],bi=b[i];
7313 if (ai!=bi){
7314 int p=i*32;
7315 for (;ai&&bi;++p,ai/=2,bi/=2){
7316 if ( ai%2 != bi%2 )
7317 pos.push_back(p);
7318 }
7319 }
7320 }
7321 return !pos.empty();
7322 }
7323
7324 // v[i][j]==true if i is connected to j
7325 // compute w such that w[i][j]==true if i is connected to j using a path of length >= 1
7326 // at the end, if w[i][i]=true then i is recurrent, else transient
7327 // i is recurrent positive if for all j w[i][j]=true => w[j][i]=true
7328 void connected(const vector< vector<unsigned> >& v,vector< vector<unsigned> > & w){
7329 int l=v.size();
7330 int c=v.front().size(); // number of columns = c*32
7331 w=v;
7332 vector<int> pos;
7333 for (int i=0;i<l;++i){
7334 // compute w[i]
7335 vector<unsigned> oldvi(c);
7336 vector<unsigned> curvi(w[i]);
7337 vector<unsigned> newvi(c);
7338 // oldvi[i/32] = 1 << (i%32);
7339 for (;;){
7340 // find indices that differ between oldvi and curvi,
7341 if (!different(oldvi,curvi,pos))
7342 break;
7343 newvi=curvi;
7344 for (unsigned j=0;j<pos.size();++j){
7345 // make an OR of curvi with w[pos[j]]
7346 vector<unsigned>::const_iterator wit=w[pos[j]].begin();
7347 vector<unsigned>::iterator newit=newvi.begin(),newitend=newvi.end();
7348 for (;newit!=newitend;++wit,++newit){
7349 *newit |= *wit;
7350 }
7351 }
7352 oldvi=curvi;
7353 curvi=newvi;
7354 }
7355 w[i]=curvi;
7356 }
7357 }
7358 #endif
7359
7360 // step by step utilities
7361
is_periodic(const gen & f,const gen & x,gen & periode,GIAC_CONTEXT)7362 bool is_periodic(const gen & f,const gen & x,gen & periode,GIAC_CONTEXT){
7363 periode=0;
7364 vecteur vx=lvarx(f,x);
7365 for (unsigned i=0;i<vx.size();++i){
7366 if (vx[i].type!=_SYMB || (vx[i]._SYMBptr->sommet!=at_exp && vx[i]._SYMBptr->sommet!=at_sin && vx[i]._SYMBptr->sommet!=at_cos && vx[i]._SYMBptr->sommet!=at_tan)){
7367 if (f.type==_SYMB)
7368 return is_periodic(f._SYMBptr->feuille,x,periode,contextptr);
7369 return false;
7370 }
7371 }
7372 gen g=_lin(trig2exp(f,contextptr),contextptr);
7373 vecteur v;
7374 rlvarx(g,x,v);
7375 islesscomplexthanf_sort(v.begin(),v.end());
7376 int i,s=int(v.size());
7377 if (s<2)
7378 return false;
7379 gen a,b,v0,alpha,beta,alphacur,betacur,gof,periodecur;
7380 for (i=1;i<s;++i){
7381 if (!v[i].is_symb_of_sommet(at_exp)){
7382 if (!is_periodic(v[i]._SYMBptr->feuille,x,periodecur,contextptr))
7383 return false;
7384 periode=gcd(periode,periodecur,contextptr);
7385 continue;
7386 }
7387 v0=v[i];
7388 gen v0arg=v0._SYMBptr->feuille;
7389 if (is_linear_wrt(v0arg,x,alphacur,betacur,contextptr)){
7390 periodecur=normal(alphacur/cst_i,contextptr);
7391 if (!is_zero(im(periodecur,contextptr)))
7392 return false;
7393 periode=gcd(periode,periodecur,contextptr);
7394 }
7395 else
7396 return false;
7397 }
7398 periode=ratnormal(cst_two_pi/periode);
7399 return !is_zero(periode);
7400 }
7401
in_domain(const gen & df,const gen & x,const gen & x0,GIAC_CONTEXT)7402 bool in_domain(const gen & df,const gen &x,const gen & x0,GIAC_CONTEXT){
7403 if (df==x)
7404 return true;
7405 if (df.type==_VECT){
7406 const vecteur v=*df._VECTptr;
7407 for (int i=0;i<int(v.size());++i){
7408 if (in_domain(v[i],x,x0,contextptr))
7409 return true;
7410 }
7411 return false;
7412 }
7413 gen g=eval(subst(df,x,x0,false,contextptr),1,contextptr);
7414 return is_one(g);
7415 }
7416
7417 // convert series expansion f at x=x0 to polynomial Taylor expansion
7418 // a is set to the predominant non constant monomial coefficient
7419 // (i.e. start from end first non 0)
convert_polynom(const gen & f,const gen & x,const gen & x0,vecteur & v,gen & a,int & order,GIAC_CONTEXT)7420 bool convert_polynom(const gen & f,const gen & x,const gen & x0,vecteur & v,gen & a,int &order,GIAC_CONTEXT){
7421 v.clear();
7422 vecteur l(lop(f,at_order_size));
7423 vecteur lp(l.size(),zero);
7424 gen g=subst(f,l,lp,false,contextptr);
7425 l=vecteur(1,x);
7426 lp=vecteur(1,x+x0);
7427 g=subst(g,l,lp,false,contextptr);
7428 lvar(g,l);
7429 gen temp=e2r(g,l,contextptr);
7430 if (is_zero(temp))
7431 return true;
7432 l.erase(l.begin());
7433 gen res;
7434 gen tmp2(polynome2poly1(temp,1));
7435 res=l.empty()?tmp2:((tmp2.type==_FRAC && tmp2._FRACptr->den.type==_VECT && tmp2._FRACptr->den._VECTptr->size()>1)?gen(fraction(r2e(tmp2._FRACptr->num,l,contextptr),r2e(tmp2._FRACptr->den,l,contextptr))):r2e(tmp2,l,contextptr));
7436 if (res.type==_FRAC && res._FRACptr->num.type==_VECT && res._FRACptr->den.type<_POLY){
7437 res=inv(res._FRACptr->den,contextptr)*res._FRACptr->num;
7438 }
7439 if (res.type!=_VECT)
7440 return false;
7441 v=*res._VECTptr;
7442 order=0;
7443 for (int i=int(v.size())-2;i>=0;--i){
7444 if (v[i]!=0){
7445 a=v[i];
7446 order=int(v.size())-i-1;
7447 break;
7448 }
7449 }
7450 return true;
7451 }
7452
write_legende(const gen & g,bool exactlegende,GIAC_CONTEXT)7453 static gen write_legende(const gen & g,bool exactlegende,GIAC_CONTEXT){
7454 if (exactlegende)
7455 return symb_equal(at_legende,g);
7456 int digits=decimal_digits(contextptr);
7457 decimal_digits(3,contextptr);
7458 gen res=evalf(g,1,contextptr);
7459 res=string2gen(res.print(contextptr),false);
7460 res=symb_equal(at_legende,res);
7461 decimal_digits(digits,contextptr);
7462 return res;
7463 }
7464
endpoints(const gen & g)7465 vecteur endpoints(const gen & g){
7466 vecteur res;
7467 if (g.type==_VECT){
7468 const_iterateur it=g._VECTptr->begin(),itend=g._VECTptr->end();
7469 for (;it!=itend;++it)
7470 res=mergevecteur(res,endpoints(*it));
7471 return res;
7472 }
7473 if (g.type!=_SYMB)
7474 return res;
7475 if (g._SYMBptr->sommet==at_and || g._SYMBptr->sommet==at_ou)
7476 return endpoints(g._SYMBptr->feuille);
7477 if (is_inequation(g) || g._SYMBptr->sommet==at_different || g._SYMBptr->sommet==at_equal)
7478 return vecteur(1,g._SYMBptr->feuille[1]);
7479 return res;
7480 }
7481
crunch_rootof(const gen & g,GIAC_CONTEXT)7482 static gen crunch_rootof(const gen & g,GIAC_CONTEXT){
7483 if (has_op(g,*at_rootof))
7484 return evalf(g,1,contextptr);
7485 if (!lop(g,*at_LambertW).empty())
7486 return evalf(g,1,contextptr);
7487 return g;
7488 }
7489
try_limit_undef(const gen & f,const identificateur & x,const gen & x0,int direction,GIAC_CONTEXT)7490 gen try_limit_undef(const gen & f,const identificateur & x,const gen & x0,int direction,GIAC_CONTEXT){
7491 gen res;
7492 //COUT << "try_limit_undef " << f << " " << x << "=" << x0 << '\n';
7493 #ifdef NO_STDEXCEPT
7494 res=limit(f,x,x0,direction,contextptr);
7495 if (res.type==_STRNG)
7496 res=undef; // message too long
7497 #else
7498 try {
7499 res=limit(f,x,x0,direction,contextptr);
7500 } catch (std::runtime_error & err){
7501 res=undef;
7502 }
7503 #endif
7504 return res;
7505 }
7506
step_param_(const gen & f,const gen & g,const gen & t,gen & tmin,gen & tmax,vecteur & poi,vecteur & tvi,bool printtvi,bool exactlegende,GIAC_CONTEXT)7507 int step_param_(const gen & f,const gen & g,const gen & t,gen & tmin,gen&tmax,vecteur & poi,vecteur & tvi,bool printtvi,bool exactlegende,GIAC_CONTEXT){
7508 if (t.type!=_IDNT)
7509 return 0;
7510 gprintf(gettext("====================\nParametric plot (%gen,%gen), variable %gen"),makevecteur(f,g,t),1,contextptr);
7511 gen periodef,periodeg,periode;
7512 if (is_periodic(f,t,periodef,contextptr) && is_periodic(g,t,periodeg,contextptr)){
7513 periode=gcd(periodef,periodeg,contextptr);
7514 if (is_greater(tmax-tmin,periode,contextptr)){
7515 tmin=normal(-periode/2,contextptr);
7516 tmax=normal(periode/2,contextptr);
7517 }
7518 }
7519 int eof=0,eog=0;
7520 if (tmin==-tmax && (eof=is_even_odd(f,t,contextptr)) && (eog=is_even_odd(g,t,contextptr))){
7521 if (eof==1){
7522 if (eog==1)
7523 gprintf(gettext("Even functions."),vecteur(0),1,contextptr);
7524 else
7525 gprintf(gettext("Even function %gen, odd function %gen. Reflection Ox"),makevecteur(f,g),1,contextptr);
7526 }
7527 else {
7528 if (eog==1)
7529 gprintf(gettext("Odd function %gen, even function %gen. Reflection Oy"),makevecteur(f,g),1,contextptr);
7530 else
7531 gprintf(gettext("Odd functions. Center O"),vecteur(0),1,contextptr);
7532 }
7533 tmin=0;
7534 }
7535 gen tmin0=ratnormal(tmin,contextptr),tmax0=ratnormal(tmax,contextptr);
7536 vecteur lv=lidnt(evalf(f,1,contextptr));
7537 if (lv.empty())
7538 return 1;
7539 if (lv.size()!=1 || lv.front()!=t)
7540 return 0;
7541 gen fg=symbolic(at_nop,makesequence(f,g));
7542 gen df=domain(fg,t,0,contextptr);
7543 if (ctrl_c || interrupted)
7544 return 0;
7545 gprintf(gettext("Domain %gen"),vecteur(1,df),1,contextptr);
7546 gen df1=domain(fg,t,1,contextptr); // singular values only
7547 if (df1.type!=_VECT){
7548 gensizeerr(gettext("Unable to find singular points"));
7549 return 0;
7550 }
7551 // Singularities
7552 vecteur sing,crit;
7553 identificateur xid=*t._IDNTptr;
7554 iterateur it=df1._VECTptr->begin(),itend=df1._VECTptr->end();
7555 for (;it!=itend;++it){
7556 if (is_greater(*it,tmin,contextptr) && is_greater(tmax,*it,contextptr)){
7557 sing.push_back(*it);
7558 }
7559 }
7560 // Extremas
7561 int st=step_infolevel(contextptr);
7562 step_infolevel(0,contextptr);
7563 gen f1=_factor(derive(f,t,contextptr),contextptr),g1=_factor(derive(g,t,contextptr),contextptr);
7564 gen f2=derive(f1,t,contextptr),g2=derive(g1,t,contextptr);
7565 gen conv=f1*g2-f2*g1;
7566 gen tval=eval(t,1,contextptr);
7567 giac_assume(symb_and(symb_superieur_egal(t,tmin),symb_inferieur_egal(t,tmax)),contextptr);
7568 int cm=calc_mode(contextptr);
7569 calc_mode(-38,contextptr); // avoid rootof
7570 gen cx=recursive_normal(solve(f1,t,periode==0?2:0,contextptr),contextptr);
7571 if (ctrl_c || interrupted)
7572 return 0;
7573 gen cy=recursive_normal(solve(g1,t,periode==0?2:0,contextptr),contextptr);
7574 if (ctrl_c || interrupted)
7575 return 0;
7576 gen cc=recursive_normal(solve(conv,t,periode==0?2:0,contextptr),contextptr);
7577 if (ctrl_c || interrupted)
7578 return 0;
7579 calc_mode(cm,contextptr); // avoid rootof
7580 if (t!=tval)
7581 sto(tval,t,contextptr);
7582 step_infolevel(st,contextptr);
7583 if (cx.type!=_VECT || cy.type!=_VECT){
7584 *logptr(contextptr) << gettext("Unable to find critical points") << '\n';
7585 purgenoassume(t,contextptr);
7586 return 0;
7587 }
7588 vecteur c=mergevecteur(*cx._VECTptr,*cy._VECTptr),infl;
7589 if (cc.type==_VECT){
7590 infl=*cc._VECTptr;
7591 c=mergevecteur(c,infl);
7592 }
7593 else
7594 *logptr(contextptr) << gettext("Unable to find inflection points") << '\n';
7595 for (int i=0;i<int(infl.size());++i)
7596 infl[i]=ratnormal(infl[i],contextptr);
7597 for (int i=0;i<int(c.size());++i)
7598 c[i]=ratnormal(c[i],contextptr);
7599 comprim(c);
7600 if (!lidnt(evalf(c,1,contextptr)).empty()){
7601 *logptr(contextptr) << gettext("Infinite number of critical points. Try with optional argument ") << t << "=tmin..tmax" << '\n';
7602 purgenoassume(t,contextptr);
7603 return 0;
7604 }
7605 it=c.begin();itend=c.end();
7606 for (;it!=itend;++it){
7607 if (ctrl_c || interrupted)
7608 return 0;
7609 if (!lop(*it,at_rootof).empty())
7610 *it=re(evalf(*it,1,contextptr),contextptr);
7611 *it=recursive_normal(*it,contextptr);
7612 if (in_domain(df,t,*it,contextptr) && is_greater(*it,tmin,contextptr) && is_greater(tmax,*it,contextptr)){
7613 crit.push_back(*it);
7614 gen fx=try_limit_undef(f,xid,*it,0,contextptr);
7615 fx=recursive_normal(fx,contextptr);
7616 gen gx=try_limit_undef(g,xid,*it,0,contextptr);
7617 gx=recursive_normal(gx,contextptr);
7618 gen ax,ay;
7619 bool singp=equalposcomp(*cx._VECTptr,*it) && equalposcomp(*cy._VECTptr,*it);
7620 if (singp){
7621 // singular point, find tangent (and kind?)
7622 /* ax=try_limit_undef(f2,xid,*it,0,contextptr);
7623 ax=recursive_normal(ax,contextptr);
7624 ay=try_limit_undef(g2,xid,*it,0,contextptr);
7625 ay=recursive_normal(ay,contextptr); */
7626 int ordre=5;
7627 vecteur vx,vy;
7628 int ox=0,oy=0,o1=0,o2=0;
7629 while (ordre<=20 && o1==0){
7630 if (ctrl_c || interrupted)
7631 return 0;
7632 // series expansion
7633 if (!convert_polynom(series(f,xid,*it,ordre,contextptr),xid,*it,vx,ax,ox,contextptr))
7634 break;
7635 if (!convert_polynom(series(g,xid,*it,ordre,contextptr),xid,*it,vy,ay,oy,contextptr))
7636 break;
7637 o1=ox;
7638 if (ox<oy)
7639 ay=0;
7640 if (oy<ox){
7641 ax=0;
7642 o1=oy;
7643 }
7644 if (o1){
7645 // find cusp kind / type de rebroussement
7646 reverse(vx.begin(),vx.end());
7647 reverse(vy.begin(),vy.end());
7648 while (vx.size()<vy.size())
7649 vx.push_back(0);
7650 while (vy.size()<vx.size())
7651 vy.push_back(0);
7652 o2=o1+1;
7653 int vs=int(vx.size());
7654 for (;o2<vs;++o2){
7655 gen determinant=simplify(vx[o1]*vy[o2]-vx[o2]*vy[o1],contextptr);
7656 if (!is_zero(determinant))
7657 break;
7658 }
7659 if (o2==vs)
7660 o1=0;
7661 }
7662 ordre *= 2;
7663 }
7664 gprintf(gettext("Singular point %gen, point %gen direction %gen kind (%gen,%gen)\nTaylor expansions %gen"),makevecteur(symb_equal(t__IDNT_e,*it),makevecteur(fx,gx),makevecteur(ax,ay),o1,o2,makevecteur(vx,vy)),1,contextptr);
7665 gprintf(" \n",vecteur(0),1,contextptr);
7666 }
7667 else {
7668 ax=try_limit_undef(f1,xid,*it,0,contextptr);
7669 ay=try_limit_undef(g1,xid,*it,0,contextptr);
7670 ax=recursive_normal(ax,contextptr);
7671 ay=recursive_normal(ay,contextptr);
7672 }
7673 gen n=sqrt(ax*evalf(ax,1,contextptr)+ay*ay,contextptr);
7674 if (!is_undef(fx) && !is_inf(fx) && !is_undef(gx) && !is_inf(gx)){
7675 gen pnt=_point(makesequence(fx,gx,write_legende(makevecteur(fx,gx),exactlegende,contextptr),symb_equal(at_couleur,equalposcomp(infl,*it)?_RED:_MAGENTA)),contextptr);
7676 poi.push_back(pnt);
7677 if (singp){
7678 vecteur ve=makevecteur(_point(makesequence(fx,gx),contextptr),makevecteur(ax/n,ay/n),symb_equal(at_couleur,_BLUE));
7679 ve.push_back(write_legende(makevecteur(ax,ay),exactlegende,contextptr));
7680 gen vv=_vector(gen(ve,_SEQ__VECT),contextptr);
7681 poi.push_back(vv);
7682 }
7683 }
7684 }
7685 }
7686 if (tmin==minus_inf && !equalposcomp(sing,minus_inf)){
7687 if (in_domain(df,t,tmin,contextptr))
7688 sing.push_back(tmin);
7689 tmin=plus_inf;
7690 }
7691 if (tmax==plus_inf && !equalposcomp(sing,plus_inf)){
7692 if (in_domain(df,t,tmax,contextptr))
7693 sing.push_back(tmax);
7694 tmax=minus_inf;
7695 }
7696 it=crit.begin();itend=crit.end();
7697 for (;it!=itend;++it){
7698 if (!is_inf(*it)){
7699 if (is_greater(tmin,*it,contextptr))
7700 tmin=*it;
7701 if (is_greater(*it,tmax,contextptr))
7702 tmax=*it;
7703 }
7704 }
7705 it=infl.begin();itend=infl.end();
7706 for (;it!=itend;++it){
7707 if (!is_inf(*it)){
7708 if (is_greater(tmin,*it,contextptr))
7709 tmin=*it;
7710 if (is_greater(*it,tmax,contextptr))
7711 tmax=*it;
7712 }
7713 }
7714 // asymptotes
7715 gen xmin(plus_inf),xmax(minus_inf),ymin(plus_inf),ymax(minus_inf);
7716 it=sing.begin();itend=sing.end();
7717 for (;it!=itend;++it){
7718 if (ctrl_c || interrupted)
7719 return 0;
7720 if (!is_inf(*it)){
7721 if (is_greater(tmin,*it,contextptr))
7722 tmin=*it;
7723 if (is_greater(*it,tmax,contextptr))
7724 tmax=*it;
7725 }
7726 gen fx=try_limit_undef(f,xid,*it,0,contextptr);
7727 fx=recursive_normal(fx,contextptr);
7728 if (!is_inf(fx) && !lidnt(evalf(fx,1,contextptr)).empty()) continue;
7729 gen fy=try_limit_undef(g,xid,*it,0,contextptr);
7730 fy=recursive_normal(fy,contextptr);
7731 if (!is_inf(fy) && !lidnt(evalf(fy,1,contextptr)).empty()) continue;
7732 if (is_inf(fx)){
7733 if (!is_inf(fy)){
7734 gen equ=symb_equal(y__IDNT_e,fy);
7735 if (is_greater(ymin,fy,contextptr))
7736 ymin=fy;
7737 if (is_greater(fy,ymax,contextptr))
7738 ymax=fy;
7739 gprintf(gettext("Horizontal asymptote at %gen : %gen"),makevecteur(*it,equ),1,contextptr);
7740 gen dr=_droite(makesequence(equ,write_legende(equ,exactlegende,contextptr),symb_equal(at_couleur,_RED)),contextptr);
7741 if (!equalposcomp(poi,dr))
7742 poi.push_back(dr);
7743 continue;
7744 }
7745 gen a=try_limit_undef(g/f,xid,*it,0,contextptr);
7746 a=recursive_normal(a,contextptr);
7747 if (is_undef(a)) continue;
7748 if (is_inf(a)){
7749 gprintf(gettext("Vertical parabolic asymptote at %gen"),vecteur(1,*it),1,contextptr);
7750 continue;
7751 }
7752 else
7753 if (!lidnt(evalf(a,1,contextptr)).empty()) continue;
7754 if (is_zero(a)){
7755 gprintf(gettext("Horizontal parabolic asymptote at %gen"),vecteur(1,*it),1,contextptr);
7756 continue;
7757 }
7758 gen b=try_limit_undef(g-a*f,xid,*it,0,contextptr);
7759 b=recursive_normal(b,contextptr);
7760 if (is_undef(b)) continue;
7761 if (is_inf(b)){
7762 gprintf(gettext("Parabolic asymptote direction at %gen: %gen"),makevecteur(*it,symb_equal(y__IDNT_e,a*x__IDNT_e)),1,contextptr);
7763 continue;
7764 }
7765 else
7766 if (!lidnt(evalf(b,1,contextptr)).empty()) continue;
7767 gen equ=symb_equal(y__IDNT_e,a*x__IDNT_e+b);
7768 gprintf(gettext("Asymptote at %gen: %gen"),makevecteur(*it,equ),1,contextptr);
7769 gen dr=_droite(makesequence(equ,write_legende(equ,exactlegende,contextptr),symb_equal(at_couleur,_RED)),contextptr);
7770 if (!equalposcomp(poi,dr))
7771 poi.push_back(dr);
7772 continue;
7773 }
7774 if (is_inf(fy)){
7775 gen equ=symb_equal(x__IDNT_e,fx);
7776 if (is_greater(xmin,fx,contextptr))
7777 xmin=fx;
7778 if (is_greater(fx,xmax,contextptr))
7779 xmax=fx;
7780 gprintf(gettext("Vertical asymptote at %gen: %gen"),makevecteur(*it,equ),1,contextptr);
7781 gen dr=_droite(makesequence(equ,write_legende(equ,exactlegende,contextptr),symb_equal(at_couleur,_RED)),contextptr);
7782 if (!equalposcomp(poi,dr))
7783 poi.push_back(dr);
7784 continue;
7785 }
7786 }
7787 for (int i=0;i<int(sing.size());++i)
7788 sing[i]=ratnormal(sing[i],contextptr);
7789 for (int i=0;i<int(crit.size());++i)
7790 crit[i]=ratnormal(crit[i],contextptr);
7791 vecteur tvx=mergevecteur(sing,crit);
7792 if (in_domain(df,t,tmin0,contextptr))
7793 tvx.insert(tvx.begin(),tmin0);
7794 if (in_domain(df,t,tmax0,contextptr))
7795 tvx.push_back(tmax0);
7796 // add endpoints of df
7797 vecteur ep=endpoints(df);
7798 for (size_t i=0;i<ep.size();++i){
7799 if (is_greater(ep[i],tmin0,contextptr) && is_greater(tmax0,ep[i],contextptr) && in_domain(df,t,ep[i],contextptr))
7800 tvx.push_back(ep[i]);
7801 }
7802 comprim(tvx);
7803 gen tmp=_sort(tvx,contextptr);
7804 if (tmp.type!=_VECT){
7805 purgenoassume(t,contextptr);
7806 return 0;
7807 }
7808 tvx=*tmp._VECTptr;
7809 int pos=equalposcomp(tvx,minus_inf);
7810 if (pos){
7811 tvx.erase(tvx.begin()+pos-1);
7812 tvx.insert(tvx.begin(),minus_inf);
7813 }
7814 pos=equalposcomp(tvx,plus_inf);
7815 if (pos){
7816 tvx.erase(tvx.begin()+pos-1);
7817 tvx.push_back(plus_inf);
7818 }
7819 gen nextt=tvx.front();
7820 vecteur tvit=makevecteur(t,nextt);
7821 gen x=try_limit_undef(f,xid,nextt,1,contextptr);
7822 if (!has_inf_or_undef(x) && is_greater(xmin,x,contextptr))
7823 xmin=x;
7824 if (!has_inf_or_undef(x) && is_greater(x,xmax,contextptr))
7825 xmax=x;
7826 gen y=try_limit_undef(g,xid,nextt,1,contextptr);
7827 if (!has_inf_or_undef(y) && is_greater(ymin,y,contextptr))
7828 ymin=y;
7829 if (!has_inf_or_undef(y) && is_greater(y,ymax,contextptr))
7830 ymax=y;
7831 vecteur tvif=makevecteur(symb_equal(x__IDNT_e,f),x);
7832 vecteur tvig=makevecteur(symb_equal(y__IDNT_e,g),y);
7833 gen nothing=string2gen(" ",false);
7834 vecteur tvidf=makevecteur(symb_equal(symbolic(at_derive,x__IDNT_e),f1),try_limit_undef(f1,xid,nextt,1,contextptr));
7835 vecteur tvidg=makevecteur(symb_equal(symbolic(at_derive,y__IDNT_e),g1),try_limit_undef(g1,xid,nextt,1,contextptr));
7836 vecteur tviconv=makevecteur(symbolic(at_derive,x__IDNT_e)*symbolic(at_derive,symbolic(at_derive,y__IDNT_e))-symbolic(at_derive,y__IDNT_e)*symbolic(at_derive,symbolic(at_derive,x__IDNT_e)),try_limit_undef(conv,xid,nextt,1,contextptr));
7837 int tvs=int(tvx.size());
7838 for (int i=1;i<tvs;++i){
7839 if (ctrl_c || interrupted)
7840 return 0;
7841 gen curt=nextt,dfx,dgx,convt;
7842 nextt=tvx[i];
7843 tvit.push_back(nothing);
7844 if (is_inf(nextt) && is_inf(curt)){
7845 dfx=try_limit_undef(f1,xid,0,0,contextptr);
7846 dgx=try_limit_undef(g1,xid,0,0,contextptr);
7847 convt=try_limit_undef(conv,xid,0,0,contextptr);
7848 }
7849 else {
7850 if (curt==minus_inf){
7851 dfx=try_limit_undef(f1,xid,nextt-1,0,contextptr);
7852 dgx=try_limit_undef(g1,xid,nextt-1,0,contextptr);
7853 convt=try_limit_undef(conv,xid,nextt-1,0,contextptr);
7854 }
7855 else {
7856 if (nextt==plus_inf){
7857 dfx=try_limit_undef(f1,xid,curt+1,0,contextptr);
7858 dgx=try_limit_undef(g1,xid,curt+1,0,contextptr);
7859 convt=try_limit_undef(conv,xid,curt+1,0,contextptr);
7860 }
7861 else {
7862 gen milieut=(curt+nextt)/2;
7863 gen curxd=evalf_double(curt,1,contextptr);
7864 gen nextxd=evalf_double(nextt,1,contextptr);
7865 if (curxd.type==_DOUBLE_ && nextxd.type==_DOUBLE_){
7866 double cd=curxd._DOUBLE_val,nd=nextxd._DOUBLE_val;
7867 if (nd-cd>1e-6*(absdouble(cd)+absdouble(nd))){
7868 milieut=exact((cd+nd)/2,contextptr);
7869 }
7870 }
7871 dfx=try_limit_undef(f1,xid,milieut,0,contextptr);
7872 dgx=try_limit_undef(g1,xid,milieut,0,contextptr);
7873 convt=try_limit_undef(conv,xid,(curt+nextt)/2,0,contextptr);
7874 }
7875 }
7876 }
7877 if (is_zero(dfx) || is_zero(dgx)){
7878 purgenoassume(t,contextptr);
7879 return 0;
7880 }
7881 if (is_strictly_positive(dfx,contextptr)){
7882 #if defined NSPIRE || defined NSPIRE_NEWLIB || defined KHICAS || defined HAVE_WINT_T
7883 #ifdef KHICAS
7884 tvif.push_back(string2gen("inc",false));
7885 #else
7886 tvif.push_back(string2gen("↑",false));
7887 #endif
7888 #else
7889 tvif.push_back(string2gen("↗",false));
7890 #endif
7891 tvidf.push_back(string2gen("+",false));
7892 }
7893 else {
7894 #if defined NSPIRE || defined NSPIRE_NEWLIB || defined KHICAS || defined HAVE_WINT_T
7895 #ifdef KHICAS
7896 tvif.push_back(string2gen("dec",false));
7897 #else
7898 tvif.push_back(string2gen("↓",false));
7899 #endif
7900 #else
7901 tvif.push_back(string2gen("↘",false));
7902 #endif
7903 tvidf.push_back(string2gen("-",false));
7904 }
7905 bool convtpos=is_strictly_positive(convt,contextptr);
7906 if (convtpos)
7907 tviconv.push_back(string2gen(abs_calc_mode(contextptr)==38?"∪":"convex",false));
7908 else
7909 tviconv.push_back(string2gen(abs_calc_mode(contextptr)==38?"∩":"concav",false));
7910 if (is_strictly_positive(dgx,contextptr)){
7911 #if defined NSPIRE || defined NSPIRE_NEWLIB || defined KHICAS || defined HAVE_WINT_T
7912 #ifdef KHICAS
7913 tvig.push_back(string2gen("inc",false));
7914 #else
7915 tvig.push_back(string2gen("↑",false));
7916 #endif
7917 #else
7918 tvig.push_back(string2gen("↗",false));
7919 #endif
7920 tvidg.push_back(string2gen("+",false));
7921 }
7922 else {
7923 #if defined NSPIRE || defined NSPIRE_NEWLIB || defined KHICAS || defined HAVE_WINT_T
7924 #ifdef KHICAS
7925 tvig.push_back(string2gen("dec",false));
7926 #else
7927 tvig.push_back(string2gen("↓",false));
7928 #endif
7929 #else
7930 tvig.push_back(string2gen("↘",false));
7931 #endif
7932 tvidg.push_back(string2gen("-",false));
7933 }
7934 if (i<tvs-1 && equalposcomp(sing,nextt)){
7935 x=try_limit_undef(f,xid,nextt,-1,contextptr);
7936 x=recursive_normal(x,contextptr);
7937 if (!has_inf_or_undef(x) && is_greater(xmin,x,contextptr))
7938 xmin=x;
7939 if (!has_inf_or_undef(x) && is_greater(x,xmax,contextptr))
7940 xmax=x;
7941 y=try_limit_undef(g,xid,nextt,-1,contextptr);
7942 y=recursive_normal(y,contextptr);
7943 if (ctrl_c || interrupted)
7944 return 0;
7945 if (!has_inf_or_undef(y) && is_greater(ymin,y,contextptr))
7946 ymin=y;
7947 if (!has_inf_or_undef(y) && is_greater(y,ymax,contextptr))
7948 ymax=y;
7949 tvit.push_back(nextt);
7950 tvif.push_back(x);
7951 tvig.push_back(crunch_rootof(y,contextptr));
7952 tvidf.push_back(nothing);
7953 tvidg.push_back(nothing);
7954 tviconv.push_back(nothing);
7955 gen x=try_limit_undef(f,xid,nextt,1,contextptr);
7956 x=recursive_normal(x,contextptr);
7957 if (!has_inf_or_undef(x) && is_greater(xmin,x,contextptr))
7958 xmin=x;
7959 if (!has_inf_or_undef(x) && is_greater(x,xmax,contextptr))
7960 xmax=x;
7961 y=try_limit_undef(g,xid,nextt,1,contextptr);
7962 y=recursive_normal(y,contextptr);
7963 if (ctrl_c || interrupted)
7964 return 0;
7965 if (!has_inf_or_undef(y) && is_greater(ymin,y,contextptr))
7966 ymin=y;
7967 if (!has_inf_or_undef(y) && is_greater(y,ymax,contextptr))
7968 ymax=y;
7969 tvit.push_back(nextt);
7970 tvif.push_back(x);
7971 tvig.push_back(crunch_rootof(y,contextptr));
7972 tvidf.push_back(nothing);
7973 tvidg.push_back(nothing);
7974 tviconv.push_back(nothing);
7975 }
7976 else {
7977 gen x=try_limit_undef(f,xid,nextt,-1,contextptr);
7978 x=recursive_normal(x,contextptr);
7979 if (!has_inf_or_undef(x) && is_greater(xmin,x,contextptr))
7980 xmin=x;
7981 if (!has_inf_or_undef(x) && is_greater(x,xmax,contextptr))
7982 xmax=x;
7983 y=try_limit_undef(g,xid,nextt,-1,contextptr);
7984 y=recursive_normal(y,contextptr);
7985 if (ctrl_c || interrupted)
7986 return 0;
7987 if (!has_inf_or_undef(y) && is_greater(ymin,y,contextptr))
7988 ymin=y;
7989 if (!has_inf_or_undef(y) && is_greater(y,ymax,contextptr))
7990 ymax=y;
7991 tvit.push_back(nextt);
7992 tvif.push_back(x);
7993 tvig.push_back(y);
7994 y=try_limit_undef(f1,xid,nextt,-1,contextptr);
7995 y=recursive_normal(y,contextptr);
7996 tvidf.push_back(crunch_rootof(y,contextptr));
7997 y=try_limit_undef(g1,xid,nextt,-1,contextptr);
7998 y=recursive_normal(y,contextptr);
7999 if (ctrl_c || interrupted)
8000 return 0;
8001 tvidg.push_back(crunch_rootof(y,contextptr));
8002 if (equalposcomp(infl,nextt)) y=0;
8003 else {
8004 y=try_limit_undef(conv,xid,nextt,-1,contextptr);
8005 y=recursive_normal(y,contextptr);
8006 }
8007 tviconv.push_back(crunch_rootof(y,contextptr));
8008 }
8009 }
8010 tvi=makevecteur(tvit,tvif,tvidf,tvig,tvidg,tviconv);
8011 gen xscale=xmax-xmin;
8012 if (is_inf(xscale) || xscale==0)
8013 xscale=gnuplot_xmax-gnuplot_xmin;
8014 if (eof==2){
8015 xmax=max(xmax,-xmin,contextptr);
8016 xmin=-xmax;
8017 }
8018 if (eog==2){
8019 ymax=max(ymax,-ymin,contextptr);
8020 ymin=-ymax;
8021 }
8022 if (eof && eog)
8023 tmin=-tmax;
8024 if (periode==0){
8025 gen tscale=tmax-tmin;
8026 tmax += tscale/2;
8027 tmin -= tscale/2;
8028 }
8029 if (tmax==tmin){
8030 tmin=gnuplot_tmin;
8031 tmax=gnuplot_tmax;
8032 }
8033 gen glx(_GL_X);
8034 glx.subtype=_INT_PLOT;
8035 glx=symb_equal(glx,symb_interval(xmin-xscale/2,xmax+xscale/2));
8036 poi.insert(poi.begin(),glx);
8037 gen yscale=ymax-ymin;
8038 if (is_inf(yscale) || yscale==0){
8039 yscale=gnuplot_ymax-gnuplot_ymin;
8040 ymax=gnuplot_ymax;
8041 ymin=gnuplot_ymin;
8042 }
8043 if (eog==2){
8044 ymax=max(ymax,-ymin,contextptr);
8045 ymin=-ymax;
8046 }
8047 gen gly(_GL_Y);
8048 gly.subtype=_INT_PLOT;
8049 gly=symb_equal(gly,symb_interval(ymin-yscale/2,ymax+yscale/2));
8050 poi.insert(poi.begin(),gly);
8051 gprintf(gettext("Variations (%gen,%gen)\n%gen"),makevecteur(f,g,tvi),1,contextptr);
8052 #ifndef EMCC
8053 if (printtvi && step_infolevel(contextptr)==0)
8054 *logptr(contextptr) << tvi << '\n';
8055 #endif
8056 // finished!
8057 purgenoassume(t,contextptr);
8058 return 1 + (periode!=1);
8059 }
8060
step_param(const gen & f,const gen & g,const gen & t,gen & tmin,gen & tmax,vecteur & poi,vecteur & tvi,bool printtvi,bool exactlegende,GIAC_CONTEXT)8061 int step_param(const gen & f,const gen & g,const gen & t,gen & tmin,gen&tmax,vecteur & poi,vecteur & tvi,bool printtvi,bool exactlegende,GIAC_CONTEXT){
8062 bool c=complex_mode(contextptr); int st=step_infolevel(contextptr),s=0;
8063 if (t==x__IDNT_e || t==y__IDNT_e)
8064 *logptr(contextptr) << gettext("Warning, using x or y as variable in parametric plot may lead to confusion!") << '\n';
8065 step_infolevel(0,contextptr);
8066 #ifdef NO_STDEXCEPT
8067 s=step_param_(f,g,t,tmin,tmax,poi,tvi,printtvi,exactlegende,contextptr);
8068 #else
8069 try {
8070 s=step_param_(f,g,t,tmin,tmax,poi,tvi,printtvi,exactlegende,contextptr);
8071 } catch(std::runtime_error & e){
8072 last_evaled_argptr(contextptr)=NULL;
8073 s=0;
8074 }
8075 #endif
8076 complex_mode(c,contextptr);
8077 step_infolevel(st,contextptr);
8078 return s;
8079 }
8080
strict2large(const gen & g)8081 gen strict2large(const gen & g){
8082 if (g.type==_VECT){
8083 vecteur v(*g._VECTptr);
8084 for (size_t i=0;i<v.size();++i)
8085 v[i]=strict2large(v[i]);
8086 return gen(v,g.subtype);
8087 }
8088 if (g.type!=_SYMB)
8089 return g;
8090 if (g._SYMBptr->sommet==at_superieur_strict)
8091 return symbolic(at_superieur_egal,g._SYMBptr->feuille);
8092 if (g._SYMBptr->sommet==at_inferieur_strict)
8093 return symbolic(at_inferieur_egal,g._SYMBptr->feuille);
8094 if (g._SYMBptr->sommet==at_different)
8095 return 1;
8096 return symbolic(g._SYMBptr->sommet,strict2large(g._SYMBptr->feuille));
8097 }
8098
8099 // x->f in xmin..xmax
8100 // pass -inf and inf by default.
8101 // poi will contain point of interest: asymptotes and extremas
8102 // xmin and xmax will be set to values containing all points in poi
step_func_(const gen & f,const gen & x,gen & xmin,gen & xmax,vecteur & poi,vecteur & tvi,gen & periode,vecteur & asym,vecteur & parab,vecteur & crit,vecteur & infl,bool printtvi,bool exactlegende,GIAC_CONTEXT,int do_inflex_tabsign)8103 int step_func_(const gen & f,const gen & x,gen & xmin,gen&xmax,vecteur & poi,vecteur & tvi,gen& periode,vecteur & asym,vecteur & parab,vecteur & crit,vecteur & infl,bool printtvi,bool exactlegende,GIAC_CONTEXT,int do_inflex_tabsign){
8104 if (x.type!=_IDNT)
8105 return 0;
8106 if (do_inflex_tabsign!=2)
8107 gprintf(gettext("====================\nFunction plot %gen, variable %gen"),makevecteur(f,x),1,contextptr);
8108 if (is_periodic(f,x,periode,contextptr)){
8109 gprintf(gettext("Periodic function T=%gen"),vecteur(1,periode),1,contextptr);
8110 if (is_strictly_greater(xmax-xmin,periode,contextptr)){
8111 if (!is_inf(xmin)) // ? do_inflex_tabsign==2 &&
8112 xmax=xmin+periode;
8113 else {
8114 if (!is_inf(xmax)) // ? do_inflex_tabsign==2 &&
8115 xmin=xmax-periode;
8116 else {
8117 xmin=normal(-periode/2,contextptr);
8118 xmax=normal(periode/2,contextptr);
8119 }
8120 }
8121 }
8122 }
8123 int eo=0;
8124 if (xmin==-xmax && (eo=is_even_odd(f,x,contextptr))){
8125 if (eo==1)
8126 gprintf(gettext("Even function %gen. Reflection Oy"),vecteur(1,f),1,contextptr);
8127 else
8128 gprintf(gettext("Odd function %gen. Center O"),vecteur(1,f),1,contextptr);
8129 if ((do_inflex_tabsign & 1)==1)
8130 xmin=0;
8131 }
8132 gen xmin0=ratnormal(xmin,contextptr),xmax0=ratnormal(xmax,contextptr);
8133 vecteur lv=lidnt(evalf(f,1,contextptr));
8134 if (lv.empty())
8135 lv=lidnt(f);
8136 if (lv.empty())
8137 return 1;
8138 if (lv.size()!=1 || lv.front()!=x)
8139 return 0;
8140 gen xval=eval(x,1,contextptr);
8141 giac_assume(symb_and(symb_superieur_egal(x,xmin),symb_inferieur_egal(x,xmax)),contextptr);
8142 gen df=domain(f,x,0,contextptr);
8143 gen dflarge=strict2large(df);
8144 gprintf(gettext("Domain %gen"),vecteur(1,df),1,contextptr);
8145 gen df1=domain(f,x,1,contextptr); // singular values only
8146 if (df1.type!=_VECT){
8147 gensizeerr(gettext("Unable to find singular points"));
8148 return 0;
8149 }
8150 // Asymptotes
8151 vecteur sing;
8152 identificateur xid=*x._IDNTptr;
8153 iterateur it=df1._VECTptr->begin(),itend=df1._VECTptr->end();
8154 for (;it!=itend;++it){
8155 if (in_domain(dflarge,x,*it,contextptr) && is_greater(*it,xmin,contextptr) && is_greater(xmax,*it,contextptr)){
8156 sing.push_back(*it);
8157 }
8158 }
8159 // Extremas
8160 int st=step_infolevel(contextptr);
8161 step_infolevel(0,contextptr);
8162 gen f1=do_inflex_tabsign==2?f:_factor(derive(f,x,contextptr),contextptr);
8163 gen f2=derive(f1,x,contextptr);
8164 #if 1
8165 int cm=calc_mode(contextptr);
8166 calc_mode(-38,contextptr); // avoid rootof
8167 gen c1=solve(f1,x,periode==0?2:0,contextptr);
8168 if (is_undef(c1))
8169 return 0;
8170 // add approx root if not detected by exact solver
8171 double eps=epsilon(contextptr);
8172 gen c1f=evalf(c1,1,contextptr);
8173 if (c1.type==_VECT && c1f.type==_VECT){
8174 vecteur c1v=*c1f._VECTptr,w=*c1._VECTptr;
8175 c1f=_fsolve(makesequence(f1,symb_equal(x,symb_interval(xmin,xmax))),contextptr);
8176 if (c1f.type==_VECT){
8177 vecteur c1fv=*c1f._VECTptr;
8178 for (int i=0;i<c1fv.size();++i){
8179 gen r=c1fv[i];
8180 int j=0;
8181 for (;j<c1v.size();++j){
8182 if (is_greater(eps,abs(r-c1v[j],contextptr),contextptr))
8183 break;
8184 }
8185 if (j==c1v.size())
8186 w.push_back(r);
8187 }
8188 }
8189 c1=gen(w,c1.subtype);
8190 }
8191 gen c2=(!(do_inflex_tabsign & 1) || is_zero(f2))?gen(vecteur(0)):solve(_numer(f2,contextptr),x,periode==0?2:0,contextptr),c(c1);
8192 calc_mode(cm,contextptr);
8193 step_infolevel(st,contextptr);
8194 if (x!=xval)
8195 sto(xval,x,contextptr);
8196 if (c1.type!=_VECT){
8197 *logptr(contextptr) << gettext("Unable to find critical points") << '\n';
8198 return 0;
8199 }
8200 if (c2.type==_VECT){
8201 infl=*c2._VECTptr;
8202 c=gen(mergevecteur(gen2vecteur(c1),infl));
8203 }
8204 else
8205 *logptr(contextptr) << gettext("Unable to find convexity") << '\n';
8206 // if (c.type==_VECT && c._VECTptr->empty()) c=_fsolve(makesequence(f,x),contextptr);
8207 #else
8208 gen c=critical(makesequence(f,x),false,contextptr);
8209 step_infolevel(st,contextptr);
8210 if (c.type!=_VECT){
8211 *logptr(contextptr) << gettext("Unable to find critical points") << '\n';
8212 purgenoassume(x,contextptr);
8213 return 0;
8214 }
8215 #endif
8216 if (ctrl_c || interrupted)
8217 return 0;
8218 if (!lidnt(evalf(c,1,contextptr)).empty()){
8219 *logptr(contextptr) << gettext("Infinite number of critical points. Try with optional argument ") << x << "=xmin..xmax" << '\n';
8220 purgenoassume(x,contextptr);
8221 return 0;
8222 }
8223 it=c._VECTptr->begin();itend=c._VECTptr->end();
8224 for (;it!=itend;++it){
8225 if (ctrl_c || interrupted)
8226 return 0;
8227 if (!lop(*it,at_rootof).empty())
8228 *it=re(evalf(*it,1,contextptr),contextptr);
8229 if (in_domain(df,x,*it,contextptr) && is_greater(*it,xmin,contextptr) && is_greater(xmax,*it,contextptr)){
8230 crit.push_back(*it);
8231 gen fx=try_limit_undef(f,xid,*it,0,contextptr);
8232 fx=recursive_normal(fx,contextptr);
8233 if (!is_undef(fx) && !is_inf(fx)){
8234 if (1 || exactlegende)
8235 poi.push_back(_point(makesequence(*it,fx,write_legende(makevecteur(*it,fx),exactlegende,contextptr),symb_equal(at_couleur,equalposcomp(infl,*it)?_GREEN:_MAGENTA)),contextptr));
8236 else {
8237 gen abscisse=evalf_double(*it,1,contextptr);
8238 gen ordonnee=evalf_double(fx,1,contextptr);
8239 if (abscisse.type==_DOUBLE_ && ordonnee.type==_DOUBLE_)
8240 poi.push_back(_point(makesequence(*it,fx,write_legende(string2gen(print_DOUBLE_(abscisse._DOUBLE_val,3)+","+print_DOUBLE_(ordonnee._DOUBLE_val,3),false),exactlegende,contextptr),symb_equal(at_couleur,_MAGENTA)),contextptr));
8241 }
8242 }
8243 }
8244 }
8245 if (xmin==minus_inf && !equalposcomp(sing,minus_inf)){
8246 if (in_domain(df,x,xmin,contextptr))
8247 sing.push_back(xmin);
8248 xmin=plus_inf;
8249 }
8250 if (xmax==plus_inf && !equalposcomp(sing,plus_inf)){
8251 if (in_domain(df,x,xmax,contextptr))
8252 sing.push_back(xmax);
8253 xmax=minus_inf;
8254 }
8255 it=crit.begin();itend=crit.end();
8256 for (;it!=itend;++it){
8257 if (ctrl_c || interrupted)
8258 return 0;
8259 if (!has_inf_or_undef(*it)){
8260 if (is_greater(xmin,*it,contextptr))
8261 xmin=*it;
8262 if (is_greater(*it,xmax,contextptr))
8263 xmax=*it;
8264 }
8265 }
8266 it=sing.begin();itend=sing.end();
8267 for (;do_inflex_tabsign!=2 && it!=itend;++it){
8268 if (ctrl_c || interrupted)
8269 return 0;
8270 gen equ;
8271 if (!has_inf_or_undef(*it)){ // vertical
8272 if (is_greater(xmin,*it,contextptr))
8273 xmin=*it;
8274 if (is_greater(*it,xmax,contextptr))
8275 xmax=*it;
8276 gen l=try_limit_undef(f,xid,*it,1,contextptr);
8277 l=recursive_normal(l,contextptr);
8278 if (is_inf(l)){
8279 equ=symb_equal(x__IDNT_e,*it);
8280 asym.push_back(makevecteur(*it,equ));
8281 gprintf(gettext("Vertical asymptote %gen"),vecteur(1,equ),1,contextptr);
8282 poi.push_back(_droite(makesequence(*it,*it+cst_i,write_legende(equ,exactlegende,contextptr),symb_equal(at_couleur,_RED)),contextptr));
8283 if (eo && *it!=0){
8284 equ=symb_equal(x__IDNT_e,-*it);
8285 asym.push_back(makevecteur(-*it,equ));
8286 gprintf(gettext("Symmetric vertical asymptote %gen"),vecteur(1,equ),1,contextptr);
8287 poi.push_back(_droite(makesequence(-*it,-*it+cst_i,write_legende(equ,exactlegende,contextptr),symb_equal(at_couleur,_RED)),contextptr));
8288 }
8289 }
8290 continue;
8291 }
8292 gen l=try_limit_undef(f,xid,*it,0,contextptr);
8293 l=recursive_normal(l,contextptr);
8294 if (is_undef(l)) continue;
8295 if (!is_inf(l)){
8296 if (!lidnt(evalf(l,1,contextptr)).empty()) continue;
8297 equ=symb_equal(y__IDNT_e,l);
8298 asym.push_back(makevecteur(*it,equ));
8299 gprintf(gettext("Horizontal asymptote %gen"),vecteur(1,equ),1,contextptr);
8300 gen dr=_droite(makesequence(l*cst_i,l*cst_i+1,write_legende(equ,exactlegende,contextptr),symb_equal(at_couleur,_RED)),contextptr);
8301 if (!equalposcomp(poi,dr))
8302 poi.push_back(dr);
8303 if (eo==2 && *it!=0 && l!=0){
8304 equ=symb_equal(y__IDNT_e,l);
8305 asym.push_back(makevecteur(-*it,-equ));
8306 gprintf(gettext("Symmetric horizontal asymptote %gen"),vecteur(1,-equ),1,contextptr);
8307 dr=_droite(makesequence(-l*cst_i,-l*cst_i+1,write_legende(equ,exactlegende,contextptr),symb_equal(at_couleur,_RED)),contextptr);
8308 if (!equalposcomp(poi,dr))
8309 poi.push_back(dr);
8310 }
8311 continue;
8312 }
8313 gen a=try_limit_undef(f/x,xid,*it,0,contextptr);
8314 a=recursive_normal(a,contextptr);
8315 if (is_undef(a)) continue;
8316 if (is_inf(a)){
8317 parab.push_back(makevecteur(*it,a));
8318 gprintf(gettext("Vertical parabolic asymptote at %gen"),vecteur(1,*it),1,contextptr);
8319 continue;
8320 }
8321 else
8322 if (!lidnt(evalf(a,1,contextptr)).empty()) continue;
8323 if (is_zero(a)){
8324 parab.push_back(makevecteur(*it,0));
8325 gprintf(gettext("Horizontal parabolic asymptote at %gen"),vecteur(1,*it),1,contextptr);
8326 continue;
8327 }
8328 gen b=try_limit_undef(f-a*x,xid,*it,0,contextptr);
8329 b=recursive_normal(b,contextptr);
8330 if (is_undef(b)) continue;
8331 // avoid bounded_function
8332 if (is_inf(b)){
8333 parab.push_back(makevecteur(*it,a));
8334 gprintf(gettext("Parabolic asymptote direction %gen at infinity"),vecteur(1,symb_equal(y__IDNT_e,a*x__IDNT_e)),1,contextptr);
8335 continue;
8336 }
8337 else
8338 if (!lidnt(evalf(b,1,contextptr)).empty()) continue;
8339 equ=symb_equal(y__IDNT_e,a*x__IDNT_e+b);
8340 asym.push_back(makevecteur(*it,equ));
8341 gprintf(gettext("Asymptote %gen"),vecteur(1,equ),1,contextptr);
8342 gen dr=_droite(makesequence(equ,write_legende(equ,exactlegende,contextptr),symb_equal(at_couleur,_RED)),contextptr);
8343 if (!equalposcomp(poi,dr))
8344 poi.push_back(dr);
8345 if (eo && *it!=0){
8346 if (eo==1)
8347 equ=symb_equal(y__IDNT_e,-a*x__IDNT_e+b);
8348 else
8349 equ=symb_equal(y__IDNT_e,a*x__IDNT_e-b);
8350 asym.push_back(makevecteur(*it,equ));
8351 gprintf(gettext("Symmetric asymptote %gen"),vecteur(1,equ),1,contextptr);
8352 gen dr=_droite(makesequence(equ,write_legende(equ,exactlegende,contextptr),symb_equal(at_couleur,_RED)),contextptr);
8353 if (!equalposcomp(poi,dr))
8354 poi.push_back(dr);
8355 }
8356 }
8357 // merge sing and crit, add xmin0, xmax0, build variation matrix
8358 for (int i=0;i<int(sing.size());++i)
8359 sing[i]=ratnormal(sing[i],contextptr);
8360 for (int i=0;i<int(crit.size());++i)
8361 crit[i]=ratnormal(crit[i],contextptr);
8362 vecteur tvx=mergevecteur(sing,crit);
8363 if (in_domain(df,x,xmin0,contextptr))
8364 tvx.insert(tvx.begin(),xmin0);
8365 if (in_domain(df,x,xmax0,contextptr))
8366 tvx.push_back(xmax0);
8367 // add endpoints of df
8368 vecteur ep=endpoints(df);
8369 for (size_t i=0;i<ep.size();++i){
8370 if (is_greater(ep[i],xmin0,contextptr) && is_greater(xmax0,ep[i],contextptr) && in_domain(df,x,ep[i],contextptr))
8371 tvx.push_back(ep[i]);
8372 }
8373 // add sign/abs
8374 vecteur lsignabs(mergevecteur(lop(f,at_sign),lop(f,at_abs)));
8375 if (!lsignabs.empty()){
8376 lsignabs=lvarx(lsignabs,x);
8377 for (size_t i=0;i<lsignabs.size();++i){
8378 tvx=mergevecteur(tvx,solve(lsignabs[i]._SYMBptr->feuille,x,periode==0?2:0,contextptr));
8379 }
8380 }
8381 comprim(tvx);
8382 gen tmp=_sort(tvx,contextptr);
8383 if (tmp.type!=_VECT){
8384 purgenoassume(x,contextptr);
8385 return 0;
8386 }
8387 tvx=*tmp._VECTptr;
8388 int pos=equalposcomp(tvx,minus_inf);
8389 if (pos){
8390 tvx.erase(tvx.begin()+pos-1);
8391 tvx.insert(tvx.begin(),minus_inf);
8392 }
8393 pos=equalposcomp(tvx,plus_inf);
8394 if (pos){
8395 tvx.erase(tvx.begin()+pos-1);
8396 tvx.push_back(plus_inf);
8397 }
8398 gen nextx=tvx.front();
8399 if (!lop(nextx,at_rootof).empty())
8400 nextx=re(evalf(nextx,1,contextptr),contextptr);
8401 vecteur tvix=makevecteur(x,nextx);
8402 gen y=try_limit_undef(f,xid,nextx,1,contextptr),ymin(plus_inf),ymax(minus_inf);
8403 if (!has_inf_or_undef(y) && is_greater(ymin,y,contextptr))
8404 ymin=y;
8405 if (!has_inf_or_undef(y) && is_greater(y,ymax,contextptr))
8406 ymax=y;
8407 gen yof=y__IDNT_e; // symb_of(y__IDNT_e,x); //
8408 vecteur tvif=makevecteur(symb_equal(yof,f),y);
8409 gen nothing=string2gen(" ",false);
8410 vecteur tvidf=makevecteur(do_inflex_tabsign==2?f1:symb_equal(symbolic(at_derive,yof),f1),try_limit_undef(f1,xid,nextx,1,contextptr));
8411 vecteur tvidf2;
8412 if ((do_inflex_tabsign & 1))
8413 tvidf2=makevecteur(symbolic(at_derive,symbolic(at_derive,yof)),try_limit_undef(f2,xid,nextx,1,contextptr));
8414 int tvs=int(tvx.size());
8415 for (int i=1;i<tvs;++i){
8416 if (ctrl_c || interrupted)
8417 return 0;
8418 gen curx=nextx,dfx,df2;
8419 nextx=tvx[i];
8420 if (!lop(nextx,at_rootof).empty())
8421 nextx=re(evalf(nextx,1,contextptr),contextptr);
8422 tvix.push_back(nothing);
8423 if (is_inf(nextx) && is_inf(curx)){
8424 dfx=try_limit_undef(f1,xid,0,0,contextptr);
8425 if ((do_inflex_tabsign & 1)) df2=try_limit_undef(f2,xid,0,0,contextptr);
8426 }
8427 else {
8428 if (curx==minus_inf){
8429 dfx=try_limit_undef(f1,xid,nextx-1,0,contextptr);
8430 if ((do_inflex_tabsign & 1)) df2=try_limit_undef(f2,xid,nextx-1,0,contextptr);
8431 }
8432 else {
8433 if (nextx==plus_inf){
8434 dfx=try_limit_undef(f1,xid,curx+1,0,contextptr);
8435 if ((do_inflex_tabsign & 1)) df2=try_limit_undef(f2,xid,curx+1,0,contextptr);
8436 }
8437 else {
8438 gen m=(curx+nextx)/2;
8439 gen curxd=evalf_double(curx,1,contextptr);
8440 gen nextxd=evalf_double(nextx,1,contextptr);
8441 if (curxd.type==_DOUBLE_ && nextxd.type==_DOUBLE_){
8442 double cd=curxd._DOUBLE_val,nd=nextxd._DOUBLE_val;
8443 if (nd-cd>1e-6*(absdouble(cd)+absdouble(nd))){
8444 m=exact((cd+nd)/2,contextptr);
8445 }
8446 }
8447 if (in_domain(df,x,m,contextptr)){
8448 dfx=try_limit_undef(f1,xid,m,0,contextptr);
8449 if ((do_inflex_tabsign & 1)) df2=try_limit_undef(f2,xid,m,0,contextptr);
8450 }
8451 else dfx=df2=undef;
8452 }
8453 }
8454 }
8455 if (is_zero(dfx)){
8456 purgenoassume(x,contextptr);
8457 return 0;
8458 }
8459 if (is_undef(dfx)){
8460 tvif.push_back(string2gen("X",false));
8461 tvidf.push_back(string2gen("X",false));
8462 }
8463 else {
8464 if (is_strictly_positive(dfx,contextptr)){
8465 #if defined NSPIRE || defined NSPIRE_NEWLIB || defined KHICAS || defined HAVE_WINT_T
8466 #ifdef KHICAS
8467 tvif.push_back(string2gen("inc",false));
8468 #else
8469 tvif.push_back(string2gen("↑",false));
8470 #endif
8471 #else
8472 tvif.push_back(string2gen("↗",false));
8473 #endif
8474 tvidf.push_back(string2gen("+",false));
8475 }
8476 else {
8477 #if defined NSPIRE || defined NSPIRE_NEWLIB || defined KHICAS || defined HAVE_WINT_T
8478 #ifdef KHICAS
8479 tvif.push_back(string2gen("dec",false));
8480 #else
8481 tvif.push_back(string2gen("↓",false));
8482 #endif
8483 #else
8484 tvif.push_back(string2gen("↘",false));
8485 #endif
8486 tvidf.push_back(string2gen("-",false));
8487 }
8488 }
8489 if ((do_inflex_tabsign & 1)){
8490 if (is_undef(df2))
8491 tvidf2.push_back(string2gen("X",false));
8492 else {
8493 if (is_strictly_positive(df2,contextptr)){
8494 #ifdef KHICAS
8495 tvidf2.push_back(string2gen("+ (U)",false));
8496 #else
8497 tvidf2.push_back(string2gen(abs_calc_mode(contextptr)==38?"∪":"+ (∪)",false));
8498 #endif
8499 }
8500 else {
8501 #ifdef KHICAS
8502 tvidf2.push_back(string2gen("- (^)",false));
8503 #else
8504 tvidf2.push_back(string2gen(abs_calc_mode(contextptr)==38?"∩":"- (∩)",false));
8505 #endif
8506 }
8507 }
8508 }
8509 if (i<tvs-1 && equalposcomp(sing,nextx)){
8510 y=try_limit_undef(f,xid,nextx,-1,contextptr);
8511 y=recursive_normal(y,contextptr);
8512 if (!has_inf_or_undef(y) && is_greater(ymin,y,contextptr))
8513 ymin=y;
8514 if (!has_inf_or_undef(y) && is_greater(y,ymax,contextptr))
8515 ymax=y;
8516 tvix.push_back(nextx);
8517 tvif.push_back(crunch_rootof(y,contextptr));
8518 tvidf.push_back(string2gen("||",false));
8519 if ((do_inflex_tabsign & 1)) tvidf2.push_back(string2gen("||",false));
8520 y=try_limit_undef(f,xid,nextx,1,contextptr);
8521 y=recursive_normal(y,contextptr);
8522 if (!has_inf_or_undef(y) && is_greater(ymin,y,contextptr))
8523 ymin=y;
8524 if (!has_inf_or_undef(y) && is_greater(y,ymax,contextptr))
8525 ymax=y;
8526 tvix.push_back(nextx);
8527 tvif.push_back(crunch_rootof(y,contextptr));
8528 tvidf.push_back(string2gen("||",false));
8529 if ((do_inflex_tabsign & 1)) tvidf2.push_back(string2gen("||",false));
8530 }
8531 else {
8532 y=try_limit_undef(f,xid,nextx,-1,contextptr);
8533 if (0 && !is_inf(nextx) && !is_zero(recursive_normal(y-try_limit_undef(f,xid,nextx,1,contextptr),contextptr))) // should not happen
8534 y=undef;
8535 y=recursive_normal(y,contextptr);
8536 if (!has_inf_or_undef(y) && is_greater(ymin,y,contextptr))
8537 ymin=y;
8538 if (!has_inf_or_undef(y) && is_greater(y,ymax,contextptr))
8539 ymax=y;
8540 tvix.push_back(crunch_rootof(nextx,contextptr));
8541 tvif.push_back(crunch_rootof(y,contextptr));
8542 y=try_limit_undef(f1,xid,nextx,-1,contextptr);
8543 // additional check for same bidirectional limit
8544 gen ysecond;
8545 if (!is_inf(nextx) && !is_zero(recursive_normal(y-(ysecond=try_limit_undef(f1,xid,nextx,1,contextptr)),contextptr)))
8546 y=makevecteur(y,ysecond);
8547 y=recursive_normal(y,contextptr);
8548 tvidf.push_back(crunch_rootof(y,contextptr));
8549 if ((do_inflex_tabsign & 1)){
8550 y=try_limit_undef(f2,xid,nextx,0,contextptr);
8551 y=recursive_normal(y,contextptr);
8552 tvidf2.push_back(crunch_rootof(y,contextptr));
8553 }
8554 }
8555 }
8556 tvi=do_inflex_tabsign==2?makevecteur(tvix,tvidf):makevecteur(tvix,tvidf,tvif);
8557 if ((do_inflex_tabsign & 1)) tvi.push_back(tvidf2);
8558 vecteur tvit(mtran(tvi));
8559 for (size_t i=1;i<tvit.size();++i){
8560 if (tvit[i]==tvit[i-1])
8561 tvit.erase(tvit.begin()+i);
8562 }
8563 tvi=mtran(tvit);
8564 gen yscale=ymax-ymin;
8565 if (is_inf(yscale) || yscale==0){
8566 yscale=xmax-xmin;
8567 ymax=gnuplot_ymax;
8568 ymin=gnuplot_ymin;
8569 }
8570 if (is_inf(yscale) || yscale==0){
8571 yscale=gnuplot_ymax-gnuplot_ymin;
8572 ymax=gnuplot_ymax;
8573 ymin=gnuplot_ymin;
8574 }
8575 if (eo){
8576 xmax=max(xmax,-xmin,contextptr);
8577 xmin=-xmax;
8578 if (eo==2){
8579 ymax=max(ymax,-ymin,contextptr);
8580 ymin=-ymax;
8581 }
8582 }
8583 gen gly(_GL_Y);
8584 gly.subtype=_INT_PLOT;
8585 gly=symb_equal(gly,symb_interval(ymin-yscale/2,ymax+yscale/2));
8586 poi.insert(poi.begin(),gly);
8587 gprintf(gettext(do_inflex_tabsign==2?"Sign %gen\n%gen":"Variations %gen\n%gen"),makevecteur(f,tvi),1,contextptr);
8588 #ifndef EMCC
8589 if (printtvi && step_infolevel(contextptr)==0)
8590 *logptr(contextptr) << tvi << '\n';
8591 #endif
8592 // finished!
8593 purgenoassume(x,contextptr);
8594 return 1 + (periode!=0);
8595 }
8596
8597 // bit 0 of do_inflex_tabsign = set to 1 for inflexion (valid for tabvar)
8598 // bit 1 of do_inflex_tabsign = set to 1 for tabsign, 0 for tabvar
step_func(const gen & f,const gen & x,gen & xmin,gen & xmax,vecteur & poi,vecteur & tvi,gen & periode,vecteur & asym,vecteur & parab,vecteur & crit,vecteur & inflex,bool printtvi,bool exactlegende,GIAC_CONTEXT,int do_inflex_tabsign)8599 int step_func(const gen & f,const gen & x,gen & xmin,gen&xmax,vecteur & poi,vecteur & tvi,gen & periode,vecteur & asym,vecteur & parab,vecteur & crit,vecteur & inflex,bool printtvi,bool exactlegende,GIAC_CONTEXT,int do_inflex_tabsign){
8600 bool c=complex_mode(contextptr); int st=step_infolevel(contextptr),s=0;
8601 step_infolevel(0,contextptr);
8602 #ifdef NO_STDEXCEPT
8603 s=step_func_(f,x,xmin,xmax,poi,tvi,periode,asym,parab,crit,inflex,printtvi,exactlegende,contextptr,do_inflex_tabsign);
8604 #else
8605 try {
8606 s=step_func_(f,x,xmin,xmax,poi,tvi,periode,asym,parab,crit,inflex,printtvi,exactlegende,contextptr,do_inflex_tabsign);
8607 } catch (std::runtime_error & e){
8608 last_evaled_argptr(contextptr)=NULL;
8609 s=0;
8610 }
8611 #endif
8612 complex_mode(c,contextptr);
8613 step_infolevel(st,contextptr);
8614 return s;
8615 }
8616
_tabvar(const gen & g,GIAC_CONTEXT)8617 gen _tabvar(const gen & g,GIAC_CONTEXT){
8618 if ( g.type==_STRNG && g.subtype==-1) return g;
8619 vecteur v(g.type==_VECT && g.subtype==_SEQ__VECT?*g._VECTptr:vecteur(1,g));
8620 int s=int(v.size());
8621 #ifdef EMCC
8622 int plot=1;
8623 #else
8624 int plot=0;
8625 #endif
8626 bool return_tabvar=false,return_equation=false,return_coordonnees=false;
8627 int do_inflex_tabsign=1;
8628 for (int i=0;i<s;++i){
8629 if (v[i]==at_sign){
8630 v.erase(v.begin()+i);
8631 do_inflex_tabsign=2;
8632 --s; --i; continue;
8633 }
8634 if (v[i]==at_plot){
8635 plot=2;
8636 v.erase(v.begin()+i);
8637 --s; --i; continue;
8638 }
8639 if (v[i]==at_tabvar){
8640 return_tabvar=true;
8641 v.erase(v.begin()+i);
8642 --s; --i; continue;
8643 }
8644 if (v[i]==at_equation){
8645 return_equation=true;
8646 v.erase(v.begin()+i);
8647 --s; --i; continue;
8648 }
8649 if (v[i]==at_coordonnees){
8650 return_coordonnees=true;
8651 v.erase(v.begin()+i);
8652 --s; --i; continue;
8653 }
8654 if (v[i]==at_derive){
8655 do_inflex_tabsign=0;
8656 v.erase(v.begin()+i);
8657 --s; --i; continue;
8658 }
8659 if (v[i].is_symb_of_sommet(at_equation)){
8660 gen & f=v[i]._SYMBptr->feuille;
8661 if (f.type==_VECT && f._VECTptr->size()==2 && f._VECTptr->front()==at_derive){
8662 if (f._VECTptr->back()==2)
8663 do_inflex_tabsign=1;
8664 else
8665 do_inflex_tabsign=0;
8666 v.erase(v.begin()+i);
8667 --s; --i; continue;
8668 }
8669 }
8670 }
8671 bool exactlegende=false;
8672 if (s>1 && v[s-1]==at_exact){
8673 exactlegende=true;
8674 v.pop_back();
8675 --s;
8676 }
8677 if (s==2 && v[1].type==_SYMB && v[1]._SYMBptr->sommet!=at_equal)
8678 v=makevecteur(v,ggb_var(v));
8679 if (s==1){
8680 v.push_back(ggb_var(g));
8681 ++s;
8682 }
8683 if (s<2)
8684 return gensizeerr(contextptr);
8685 gen f=exact(v[0],contextptr);
8686 gen x=v[1];
8687 int s0=2;
8688 gen xmin(minus_inf),xmax(plus_inf);
8689 bool default_interval=true;
8690 if (x.is_symb_of_sommet(at_equal)){
8691 gen g=x._SYMBptr->feuille;
8692 if (g.type!=_VECT || g._VECTptr->size()!=2)
8693 return gensizeerr(contextptr);
8694 x=g._VECTptr->front();
8695 g=g._VECTptr->back();
8696 if (g.is_symb_of_sommet(at_interval)){
8697 xmin=g._SYMBptr->feuille[0];
8698 xmax=g._SYMBptr->feuille[1];
8699 default_interval=(xmin==minus_inf && xmax==plus_inf);
8700 }
8701 }
8702 else {
8703 if (s>=4){
8704 xmin=v[2];
8705 xmax=v[3];
8706 default_interval=(xmin==minus_inf && xmax==plus_inf);
8707 s0=4;
8708 }
8709 if (s==2 && x.type!=_IDNT)
8710 return _tabvar(makevecteur(f,x),contextptr);
8711 }
8712 if (!when2sign(f,x,contextptr))
8713 return gensizeerr("Bad when");
8714 vecteur tvi,poi;
8715 bool param=f.type==_VECT && f._VECTptr->size()==2;
8716 int periodic=0;
8717 if (param)
8718 periodic=step_param(f._VECTptr->front(),f._VECTptr->back(),x,xmin,xmax,poi,tvi,false,exactlegende,contextptr);
8719 else {
8720 gen periode; vecteur asym,parab,crit,inflex;
8721 periodic=step_func(f,x,xmin,xmax,poi,tvi,periode,asym,parab,crit,inflex,false,exactlegende,contextptr,do_inflex_tabsign);
8722 }
8723 // round floats in tvi
8724 for (int i=0;i<int(tvi.size());++i){
8725 gen tmp=tvi[i];
8726 if (tmp.type==_VECT){
8727 vecteur v=*tmp._VECTptr;
8728 for (int j=0;j<int(v.size());++j){
8729 if (v[j].type==_DOUBLE_)
8730 v[j]=_round(makesequence(v[j],3),contextptr);
8731 }
8732 tvi[i]=gen(v,tmp.subtype);
8733 }
8734 }
8735 if (periodic==0)
8736 return undef;
8737 if (return_tabvar)
8738 return tvi;
8739 if (return_equation)
8740 return _equation(poi,contextptr);
8741 if (return_coordonnees)
8742 return _coordonnees(poi,contextptr);
8743 gen scale=(gnuplot_xmax-gnuplot_xmin)/5.0;
8744 gen m=xmin,M=xmax;
8745 if (is_inf(m))
8746 m=gnuplot_xmin;
8747 if (is_inf(M))
8748 M=gnuplot_xmax;
8749 if (m!=M)
8750 scale=(M-m)/3.0;
8751 if (xmin!=xmax && (periodic==2 || !default_interval) ){
8752 m=m-0.009*scale; M=M+0.01*scale;
8753 }
8754 else {
8755 m=m-0.973456*scale; M=M+1.018546*scale;
8756 }
8757 x=symb_equal(x,symb_interval(m,M));
8758 vecteur w=makevecteur(f,x);
8759 for (;s0<s;++s0){
8760 w.push_back(v[s0]);
8761 }
8762 gen p;
8763 if (param)
8764 p=paramplotparam(gen(w,_SEQ__VECT),false,contextptr);
8765 else
8766 p=funcplotfunc(gen(w,_SEQ__VECT),false,contextptr);
8767 if (plot){
8768 poi=mergevecteur(poi,gen2vecteur(p));
8769 if (plot==2)
8770 return gen(poi,_SEQ__VECT);
8771 if (plot==1)
8772 return tvi; // gprintf("%gen",makevecteur(gen(poi,_SEQ__VECT)),1,contextptr);
8773 }
8774 if (abs_calc_mode(contextptr)!=38){
8775 *logptr(contextptr) << (param?"plotparam(":"plotfunc(") << gen(w,_SEQ__VECT) << ')'
8776 #if defined HAVE_LIBFLTK && defined GIAC_LMCHANGES
8777 <<"\nInside Xcas you can see the function with Cfg>Show>DispG."
8778 #endif
8779 << '\n';
8780 }
8781 return tvi;
8782 }
8783 static const char _tabvar_s []="tabvar";
8784 static define_unary_function_eval (__tabvar,&_tabvar,_tabvar_s);
8785 define_unary_function_ptr5( at_tabvar ,alias_at_tabvar,&__tabvar,0,true);
8786
_tabsign(const gen & g,GIAC_CONTEXT)8787 gen _tabsign(const gen & g,GIAC_CONTEXT){
8788 if ( g.type==_STRNG && g.subtype==-1) return g;
8789 vecteur v(gen2vecteur(g));
8790 v.push_back(at_sign);
8791 return _tabvar(gen(v,_SEQ__VECT),contextptr);
8792 }
8793 static const char _tabsign_s []="tabsign";
8794 static define_unary_function_eval (__tabsign,&_tabsign,_tabsign_s);
8795 define_unary_function_ptr5( at_tabsign ,alias_at_tabsign,&__tabsign,0,true);
8796
_printf(const gen & args,GIAC_CONTEXT)8797 gen _printf(const gen & args,GIAC_CONTEXT){
8798 if (args.type!=_VECT || args.subtype!=_SEQ__VECT){
8799 int st=step_infolevel(contextptr);
8800 step_infolevel(1,contextptr);
8801 gprintf("%gen",vecteur(1,args),contextptr);
8802 step_infolevel(st,contextptr);
8803 return 1;
8804 }
8805 vecteur v=*args._VECTptr;
8806 if (v.empty() || v.front().type!=_STRNG)
8807 return 0;
8808 string s=*v.front()._STRNGptr;
8809 v.erase(v.begin());
8810 int st=step_infolevel(contextptr);
8811 step_infolevel(1,contextptr);
8812 gprintf(s,v,contextptr);
8813 step_infolevel(st,contextptr);
8814 return 1;
8815 }
8816 static const char _printf_s []="printf";
8817 static define_unary_function_eval (__printf,&_printf,_printf_s);
8818 define_unary_function_ptr5( at_printf ,alias_at_printf,&__printf,0,true);
8819
_sech(const gen & args,GIAC_CONTEXT)8820 gen _sech(const gen & args,GIAC_CONTEXT){
8821 return inv(cosh(args,contextptr),contextptr);
8822 }
8823 static const char _sech_s []="sech";
8824 static define_unary_function_eval (__sech,&_sech,_sech_s);
8825 define_unary_function_ptr5( at_sech ,alias_at_sech,&__sech,0,true);
8826
_csch(const gen & args,GIAC_CONTEXT)8827 gen _csch(const gen & args,GIAC_CONTEXT){
8828 return inv(sinh(args,contextptr),contextptr);
8829 }
8830 static const char _csch_s []="csch";
8831 static define_unary_function_eval (__csch,&_csch,_csch_s);
8832 define_unary_function_ptr5( at_csch ,alias_at_csch,&__csch,0,true);
8833
8834 // ggb function for latitude of a 3-d point
8835 // was ggbalt(x):=when(type(x)==DOM_IDENT,altsymb(x),when(x[0]=='pnt',when(is3dpoint(x),atan2(x[1][2],sqrt(x[1][0]^2+x[1][1]^2)),0),?))
_ggbalt(const gen & args,GIAC_CONTEXT)8836 gen _ggbalt(const gen & args,GIAC_CONTEXT){
8837 if (args.type==_IDNT)
8838 return symbolic(at_ggbalt,args);
8839 if (args.is_symb_of_sommet(at_pnt)){
8840 gen x=remove_at_pnt(args);
8841 if (x.type==_VECT && x.subtype==_POINT__VECT && x._VECTptr->size()==3 ){
8842 vecteur v=*x._VECTptr;
8843 return arg(sqrt(pow(v[0],2,contextptr)+pow(v[1],2,contextptr),contextptr)+cst_i*v[2],contextptr);
8844 }
8845 if (args.type==_SYMB && equalposcomp(not_point_sommets,args._SYMBptr->sommet))
8846 return undef;
8847 return 0;
8848 }
8849 return undef;
8850 }
8851 static const char _ggbalt_s []="ggbalt";
8852 static define_unary_function_eval (__ggbalt,&_ggbalt,_ggbalt_s);
8853 define_unary_function_ptr5( at_ggbalt ,alias_at_ggbalt,&__ggbalt,0,true);
8854
8855 // ggbsort(x):=when(length(x)==0,{},when(type(x[0])==DOM_LIST,x,sort(x)))
_ggbsort(const gen & args,GIAC_CONTEXT)8856 gen _ggbsort(const gen & args,GIAC_CONTEXT){
8857 if (args.type!=_VECT || args._VECTptr->empty() || args._VECTptr->front().type==_VECT) return args;
8858 return _sort(args,contextptr);
8859 }
8860 static const char _ggbsort_s []="ggbsort";
8861 static define_unary_function_eval (__ggbsort,&_ggbsort,_ggbsort_s);
8862 define_unary_function_ptr5( at_ggbsort ,alias_at_ggbsort,&__ggbsort,0,true);
8863
charx2int(char c)8864 int charx2int(char c){
8865 if (c>='0' && c<='9') return c-'0';
8866 if (c>='a' && c<='z') return c-'a'+10;
8867 if (c>='A' && c<='Z') return c-'A'+10;
8868 return -1;
8869 }
8870
html_filter(const string & s)8871 string html_filter(const string & s){
8872 int ss=s.size();
8873 string res;
8874 bool semi=false;
8875 for (int i=0;i<ss;++i){
8876 char c=s[i];
8877 if (i<ss-2 && c=='%'){
8878 c = char(charx2int(s[i+1])*16+charx2int(s[i+2]));
8879 i += 2;
8880 }
8881 if (c==';')
8882 semi=true;
8883 else {
8884 if (c!=' ' && c!='\n')
8885 semi=false;
8886 }
8887 res += c;
8888 }
8889 if (!semi)
8890 res += ';';
8891 return res;
8892 }
8893
8894 // translate HTML Xcas for Firefox link to a giac list of commands
link2giac(const string & s,GIAC_CONTEXT)8895 string link2giac(const string & s,GIAC_CONTEXT){
8896 string res;
8897 // find # position, then create normal line for +, slider for *
8898 int pos=s.find('#'),L=s.size();
8899 if (pos>0 && pos<L){
8900 bool finished=false;
8901 while (!finished){
8902 int nextpos=s.find('&',pos+1);
8903 if (nextpos > L){
8904 nextpos=L;
8905 finished=true;
8906 }
8907 if (nextpos<pos+2)
8908 break;
8909 string txt=s.substr(pos+2,nextpos-pos-2);
8910 txt=html_filter(txt);
8911 if (s[pos+1]=='*'){
8912 gen g(txt,contextptr);
8913 if (g.type==_VECT && g._VECTptr->size()>=5){
8914 txt="assume("+g[0].print(contextptr)+"=["+g[1].print(contextptr)+","+g[2].print(contextptr)+","+g[3].print(contextptr)+","+g[4].print(contextptr)+"])";
8915 }
8916 }
8917 res += txt;
8918 pos=nextpos;
8919 }
8920 }
8921 return res;
8922 }
8923
_link2giac(const gen & args,GIAC_CONTEXT)8924 gen _link2giac(const gen & args,GIAC_CONTEXT){
8925 if (args.type!=_STRNG)
8926 return gensizeerr(contextptr);
8927 return string2gen(link2giac(*args._STRNGptr,contextptr),false);
8928 }
8929 static const char _link2giac_s []="link2giac";
8930 static define_unary_function_eval (__link2giac,&_link2giac,_link2giac_s);
8931 define_unary_function_ptr5( at_link2giac ,alias_at_link2giac,&__link2giac,0,true);
8932
_range(const gen & args,GIAC_CONTEXT)8933 gen _range(const gen & args,GIAC_CONTEXT){
8934 gen g(args);
8935 if (is_integral(g) && g.type==_INT_ && g.val>=0){
8936 int n=g.val;
8937 vecteur v(n);
8938 for (int i=0;i<n;++i)
8939 v[i]=i;
8940 return v;
8941 }
8942 if (g.type==_VECT && g._VECTptr->size()>=2){
8943 gen a=g._VECTptr->front(),b=(*g._VECTptr)[1],c=1;
8944 if (g._VECTptr->size()==3)
8945 c=g._VECTptr->back();
8946 if (is_integral(a) && is_integral(b) && is_integral(c)){
8947 int A=a.val,B=b.val,C=c.val;
8948 if ( (A<=B && C>0) || (A>=B && C<0)){
8949 int s=std::ceil(double(B-A)/C);
8950 vecteur w(s);
8951 for (int i=0;i<s;++i)
8952 w[i]=A+i*C;
8953 return w;
8954 }
8955 }
8956 a=evalf_double(a,1,contextptr);
8957 b=evalf_double(b,1,contextptr);
8958 c=evalf_double(c,1,contextptr);
8959 if (a.type==_DOUBLE_ && b.type==_DOUBLE_ && c.type==_DOUBLE_){
8960 double A=a._DOUBLE_val,B=b._DOUBLE_val,C=c._DOUBLE_val;
8961 if ( (A<=B && C>0) || (A>=B && C<0)){
8962 int s=std::ceil((B-A)/C);
8963 vecteur w(s);
8964 for (int i=0;i<s;++i)
8965 w[i]=A+i*C;
8966 return w;
8967 }
8968 }
8969 }
8970 return gensizeerr(contextptr);
8971 }
8972 static const char _range_s []="range";
8973 static define_unary_function_eval (__range,&_range,_range_s);
8974 define_unary_function_ptr5( at_range ,alias_at_range,&__range,0,true);
8975
strip(const string & s,const string & chars)8976 string strip(const string & s,const string &chars){
8977 int ss=int(s.size()),cs=int(chars.size()),i,j;
8978 for (i=0;i<ss;++i){
8979 int pos=chars.find(s[i]);
8980 if (pos<0 || pos>=cs)
8981 break;
8982 }
8983 for (j=ss-1;j>=i;--j){
8984 int pos=chars.find(s[j]);
8985 if (pos<0 || pos>=cs)
8986 break;
8987 }
8988 return s.substr(i,j-i+1);
8989 }
8990
_strip(const gen & args,GIAC_CONTEXT)8991 gen _strip(const gen & args,GIAC_CONTEXT){
8992 if (args.type==_STRNG)
8993 return string2gen(strip(*args._STRNGptr," "),false);
8994 if (args.type==_VECT && args._VECTptr->size()==2 && args._VECTptr->front().type==_STRNG && args._VECTptr->back().type==_STRNG)
8995 return string2gen(strip(*args._VECTptr->front()._STRNGptr,*args._VECTptr->back()._STRNGptr),false);
8996 return gensizeerr(contextptr);
8997 }
8998 static const char _strip_s []="strip";
8999 static define_unary_function_eval (__strip,&_strip,_strip_s);
9000 define_unary_function_ptr5( at_strip ,alias_at_strip,&__strip,0,true);
9001
_lower(const gen & args,GIAC_CONTEXT)9002 gen _lower(const gen & args,GIAC_CONTEXT){
9003 if (ckmatrix(args)){
9004 vecteur res(*args._VECTptr);
9005 int l=int(res.size());
9006 for (int i=0;i<l;++i){
9007 vecteur ligne=*res[i]._VECTptr;
9008 int c=int(ligne.size());
9009 for (int j=i+1;j<c;++j)
9010 ligne[j]=0;
9011 res[i]=ligne;
9012 }
9013 return gen(res,_MATRIX__VECT);
9014 }
9015 if (args.type!=_STRNG)
9016 return gensizeerr(contextptr);
9017 string s(*args._STRNGptr);
9018 int ss=s.size();
9019 for (int i=0;i<ss;++i)
9020 s[i]=tolower(s[i]);
9021 return string2gen(s,false);
9022 }
9023 static const char _lower_s []="lower";
9024 static define_unary_function_eval (__lower,&_lower,_lower_s);
9025 define_unary_function_ptr5( at_lower ,alias_at_lower,&__lower,0,true);
9026
_upper(const gen & args,GIAC_CONTEXT)9027 gen _upper(const gen & args,GIAC_CONTEXT){
9028 if (ckmatrix(args)){
9029 vecteur res(*args._VECTptr);
9030 int l=int(res.size());
9031 for (int i=0;i<l;++i){
9032 vecteur ligne=*res[i]._VECTptr;
9033 int c=int(ligne.size());
9034 for (int j=0;j<i;++j)
9035 ligne[j]=0;
9036 res[i]=ligne;
9037 }
9038 return gen(res,_MATRIX__VECT);
9039 }
9040 if (args.type!=_STRNG)
9041 return gensizeerr(contextptr);
9042 string s(*args._STRNGptr);
9043 int ss=s.size();
9044 for (int i=0;i<ss;++i)
9045 s[i]=toupper(s[i]);
9046 return string2gen(s,false);
9047 }
9048 static const char _upper_s []="upper";
9049 static define_unary_function_eval (__upper,&_upper,_upper_s);
9050 define_unary_function_ptr5( at_upper ,alias_at_upper,&__upper,0,true);
9051
_isinf(const gen & a,GIAC_CONTEXT)9052 gen _isinf(const gen & a,GIAC_CONTEXT){
9053 if (a.type==_STRNG && a.subtype==-1) return a;
9054 return change_subtype(is_inf(a),_INT_BOOLEAN);
9055 }
9056 static const char _isinf_s []="isinf";
9057 static define_unary_function_eval (__isinf,&_isinf,_isinf_s);
9058 define_unary_function_ptr5( at_isinf ,alias_at_isinf,&__isinf,0,true);
9059
_isnan(const gen & a,GIAC_CONTEXT)9060 gen _isnan(const gen & a,GIAC_CONTEXT){
9061 if (a.type==_STRNG && a.subtype==-1) return a;
9062 return change_subtype(is_undef(a),_INT_BOOLEAN);
9063 }
9064 static const char _isnan_s []="isnan";
9065 static define_unary_function_eval (__isnan,&_isnan,_isnan_s);
9066 define_unary_function_ptr5( at_isnan ,alias_at_isnan,&__isnan,0,true);
9067
_isfinite(const gen & a,GIAC_CONTEXT)9068 gen _isfinite(const gen & a,GIAC_CONTEXT){
9069 if (a.type==_STRNG && a.subtype==-1) return a;
9070 return change_subtype(!is_inf(a) && !is_undef(a),_INT_BOOLEAN);
9071 }
9072 static const char _isfinite_s []="isfinite";
9073 static define_unary_function_eval (__isfinite,&_isfinite,_isfinite_s);
9074 define_unary_function_ptr5( at_isfinite ,alias_at_isfinite,&__isfinite,0,true);
9075
_is_matrix(const gen & a,GIAC_CONTEXT)9076 gen _is_matrix(const gen & a,GIAC_CONTEXT){
9077 if (a.type==_STRNG && a.subtype==-1) return a;
9078 return change_subtype(ckmatrix(a),_INT_BOOLEAN);
9079 }
9080 static const char _is_matrix_s []="is_matrix";
9081 static define_unary_function_eval (__is_matrix,&_is_matrix,_is_matrix_s);
9082 define_unary_function_ptr5( at_is_matrix ,alias_at_is_matrix,&__is_matrix,0,true);
9083
9084 // Python compat convert to list
_python_list(const gen & a,GIAC_CONTEXT)9085 gen _python_list(const gen & a,GIAC_CONTEXT){
9086 if (a.type==_STRNG && a.subtype==-1) return a;
9087 if (a.type==_VECT) return a;
9088 if (a.type==_STRNG){
9089 const string & as=*a._STRNGptr;
9090 unsigned ass=as.size();
9091 vecteur res(ass);
9092 for (unsigned i=0;i<ass;++i)
9093 res[i]=string2gen(string(1,as[i]),false);
9094 return res;
9095 }
9096 return _convert(makesequence(a,change_subtype(_MAPLE_LIST,_INT_MAPLECONVERSION)),contextptr);
9097 }
9098 static const char _python_list_s []="python_list";
9099 static define_unary_function_eval (__python_list,&_python_list,_python_list_s);
9100 define_unary_function_ptr5( at_python_list ,alias_at_python_list,&__python_list,0,true);
9101
9102 bool freeze=false;
rgb565to888(int c)9103 int rgb565to888(int c){
9104 c &= 0xffff;
9105 int r=(c>>11)&0x1f,g=(c>>5)&0x3f,b=c&0x1f;
9106 return (r<<19)|(g<<10)|(b<<3);
9107 }
9108
rgb(const gen & g,GIAC_CONTEXT)9109 inline int rgb(const gen & g,GIAC_CONTEXT){
9110 return g.type==_INT_?g.val:_rgb(g,contextptr).val;
9111 }
remove_at_display(const gen & g,GIAC_CONTEXT)9112 gen remove_at_display(const gen &g,GIAC_CONTEXT){
9113 if (g.is_symb_of_sommet(at_equal)){
9114 const gen & f=g._SYMBptr->feuille;
9115 if (f.type==_VECT && f._VECTptr->size()==2 && f._VECTptr->front()==at_display)
9116 return rgb(f._VECTptr->back(),contextptr);
9117 }
9118 return rgb(g,contextptr);
9119 }
9120
_set_pixel(const gen & a_,GIAC_CONTEXT)9121 gen _set_pixel(const gen & a_,GIAC_CONTEXT){
9122 freeze=true;
9123 gen a(a_);
9124 if (a.type==_STRNG && a.subtype==-1) return a;
9125 #ifdef KHICAS
9126 if (a.type==_VECT && a._VECTptr->empty()){
9127 sync_screen();
9128 return 1;
9129 }
9130 #endif
9131 #if defined GIAC_HAS_STO_38 || defined KHICAS
9132 if (a.type!=_VECT || a._VECTptr->size()<2)
9133 return gentypeerr(contextptr);
9134 const vecteur & v=*a._VECTptr;
9135 size_t vs=v.size();
9136 if (vs>=2){
9137 gen x=v.front();
9138 gen y=v[1];
9139 if (x.type==_DOUBLE_)
9140 x=int(x._DOUBLE_val+.5);
9141 if (y.type==_DOUBLE_)
9142 y=int(y._DOUBLE_val+.5);
9143 if (x.type==_INT_ && y.type==_INT_ ){
9144 #ifdef KHICAS
9145 os_set_pixel(x.val,y.val,vs==2?0:remove_at_display(v[2],contextptr).val);
9146 #else
9147 aspen_set_pixel(x.val,y.val,vs==2?0:remove_at_display(v[2],contextptr).val);
9148 #endif // KHICAS
9149 return 1;
9150 }
9151 }
9152 return gensizeerr(contextptr);
9153 //static gen PIXEL(identificateur("PIXON_P"));
9154 //return _of(makesequence(PIXEL,a_),contextptr);
9155 #else // HP && KHICAS
9156 if (a.type==_VECT && a._VECTptr->empty())
9157 return pixel_v();
9158 if (is_integral(a)){
9159 pixel_v()._VECTptr->clear();
9160 if (a==0) a=vecteur(0);
9161 return _pixon(a,contextptr);
9162 }
9163 else {
9164 vecteur v=*a._VECTptr;
9165 if (v.size()==3)
9166 v[2]=remove_at_display(v[2],contextptr);
9167 if (a.type!=_VECT || a._VECTptr->size()<2 || !is_integer_vecteur(v))
9168 return 0;
9169 gen b(v,_SEQ__VECT);
9170 pixel_v()._VECTptr->push_back(_pixon(b,contextptr));
9171 size_t vs=v.size();
9172 if (vs>=2){
9173 const gen & x=v.front();
9174 const gen & y=v[1];
9175 if (x.type==_INT_ && x.val>=0 && x.val < pixel_cols && y.type==_INT_ && y.val>=0 && y.val<pixel_lines){
9176 pixel_buffer[y.val][x.val]=vs==2?int(FL_BLACK):v[2].val;
9177 }
9178 }
9179 }
9180 return pixel_v();
9181 #endif // else HP && KHICAS
9182 }
9183 #ifdef KHICAS
set_pixel(int x,int y,int c,GIAC_CONTEXT)9184 void set_pixel(int x,int y,int c,GIAC_CONTEXT){
9185 os_set_pixel(x,y,c);
9186 }
set_pixel(double x,double y,int c,GIAC_CONTEXT)9187 void set_pixel(double x,double y,int c,GIAC_CONTEXT){
9188 os_set_pixel(int(x+.5),int(y+.5),c);
9189 }
9190 #else
set_pixel(int x,int y,int c,GIAC_CONTEXT)9191 void set_pixel(int x,int y,int c,GIAC_CONTEXT){
9192 _set_pixel(makesequence(x,y,c),contextptr);
9193 }
set_pixel(double x,double y,int c,GIAC_CONTEXT)9194 void set_pixel(double x,double y,int c,GIAC_CONTEXT){
9195 _set_pixel(makesequence(int(x+.5),int(y+.5),c),contextptr);
9196 }
9197 #endif
9198 static const char _set_pixel_s []="set_pixel";
9199 static define_unary_function_eval (__set_pixel,&_set_pixel,_set_pixel_s);
9200 define_unary_function_ptr5( at_set_pixel ,alias_at_set_pixel,&__set_pixel,0,true);
9201
9202 static const char _draw_pixel_s []="draw_pixel";
9203 static define_unary_function_eval (__draw_pixel,&_set_pixel,_draw_pixel_s);
9204 define_unary_function_ptr5( at_draw_pixel ,alias_at_draw_pixel,&__draw_pixel,0,true);
9205
9206 //Uses the Bresenham line algorithm
draw_line(int x1,int y1,int x2,int y2,int color,GIAC_CONTEXT)9207 void draw_line(int x1, int y1, int x2, int y2, int color,GIAC_CONTEXT) {
9208 int w =(color & 0x00070000) >> 16;
9209 ++w;
9210 color &= 0xffff;
9211 signed char ix;
9212 signed char iy;
9213
9214 // if x1 == x2 or y1 == y2, then it does not matter what we set here
9215 int delta_x = (x2 > x1?(ix = 1, x2 - x1):(ix = -1, x1 - x2)) << 1;
9216 int delta_y = (y2 > y1?(iy = 1, y2 - y1):(iy = -1, y1 - y2)) << 1;
9217
9218 set_pixel(x1, y1, color,contextptr);
9219 if (delta_x >= delta_y) {
9220 int error = delta_y - (delta_x >> 1); // error may go below zero
9221 while (x1 != x2) {
9222 if (error >= 0) {
9223 if (error || (ix > 0)) {
9224 y1 += iy;
9225 error -= delta_x;
9226 } // else do nothing
9227 } // else do nothing
9228 x1 += ix;
9229 error += delta_y;
9230 #if 1
9231 int y__=y1+(w+1)/2;
9232 for (int y_=y1-w/2;y_<y__;++y_)
9233 set_pixel(x1, y_, color,contextptr);
9234 #else
9235 set_pixel(x1, y1, color,contextptr);
9236 #endif
9237 }
9238 } else {
9239 int error = delta_x - (delta_y >> 1); // error may go below zero
9240 while (y1 != y2) {
9241 if (error >= 0) {
9242 if (error || (iy > 0)) {
9243 x1 += ix;
9244 error -= delta_y;
9245 } // else do nothing
9246 } // else do nothing
9247 y1 += iy;
9248 error += delta_x;
9249 #if 1
9250 int x__=x1+(w+1)/2;
9251 for (int x_=x1-w/2;x_<x__;++x_)
9252 set_pixel(x_, y1, color,contextptr);
9253 #else
9254 set_pixel(x1, y1, color,contextptr);
9255 #endif
9256 }
9257 }
9258 }
9259
asc_sort_int(const void * vptr,const void * wptr)9260 int asc_sort_int(const void * vptr,const void *wptr){
9261 const vector<int> * v=(const vector<int> * )vptr;
9262 const vector<int> * w=(const vector<int> * )wptr;
9263 for (size_t i=0;i<v->size();++i){
9264 int vi=(*v)[i];
9265 int wi=(*w)[i];
9266 if (vi!=wi)
9267 return vi<wi?-1:1;
9268 }
9269 return 0;
9270 }
9271
asc_sort_double(const void * vptr,const void * wptr)9272 int asc_sort_double(const void * vptr,const void *wptr){
9273 const vector<double> * v=(const vector<double> * )vptr;
9274 const vector<double> * w=(const vector<double> * )wptr;
9275 for (size_t i=0;i<v->size();++i){
9276 double vi=(*v)[i];
9277 double wi=(*w)[i];
9278 if (abs(vi-wi)>1e-6*abs(wi))
9279 return vi<wi?-1:1;
9280 }
9281 return 0;
9282 }
9283
9284 // L might be modified by closing the polygon
draw_filled_polygon(vector<vector<int>> & L,int xmin,int xmax,int ymin,int ymax,int color,GIAC_CONTEXT)9285 void draw_filled_polygon(vector< vector<int> > &L,int xmin,int xmax,int ymin,int ymax,int color,GIAC_CONTEXT){
9286 int n=L.size();
9287 // close polygon if it is open
9288 if (!(L[n-1]==L[0]))
9289 L.push_back(L[0]);
9290 else
9291 n--;
9292 // ordered list of ymin,x,index (ordered by ascending ymin)
9293 vector< vector<int> > om(n,vector<int>(4)); // size==12K for n==384
9294 for (int j=0;j<n;j++){
9295 int y0=L[j][1],y1=L[j+1][1];
9296 om[j][0]=y0<y1?y0:y1;
9297 om[j][1]=y0<y1?L[j][0]:L[j+1][0];
9298 om[j][2]=j;
9299 om[j][3]=y0<y1?j:(j==n-1?0:j+1);
9300 }
9301 qsort(&om.front(),om.size(),sizeof(vector<int>),asc_sort_int);
9302 // reverse(om.begin(),om.end());
9303 vector<double> p(n); // inverses of slopes
9304 for (int j=0;j<n;j++){
9305 double dx=L[j+1][0]-L[j][0];
9306 double dy=L[j+1][1]-L[j][1];
9307 p[j]=dy==0?(dx>0?1e300:-1e300):dx/dy;
9308 }
9309 // initialization, lowest horizontal that is crossing the polygon
9310 // y at ymin-1, that way lxj is initialized in the loop
9311 int y=om[0][0]-1,j,ompos=0;
9312 vector< vector<double> > lxj; // size about 12K for n==384
9313 // main loop
9314 for (;y<ymax;){
9315 if (y>=ymin){ // draw pixels for this horizontal frame
9316 size_t lxjs=lxj.size();
9317 qsort(&lxj.front(),lxjs,sizeof(vector<double>),asc_sort_double);
9318 bool odd=false;
9319 vector<char> impair(lxjs);
9320 for (size_t k=0;k<lxjs;++k){
9321 int arete=lxj[k][1]; // edge L[arete]->L[arete+1]
9322 int y1=L[arete][1],y2=L[arete+1][1];
9323 if (y!=y1 && y!=y2)
9324 odd=!odd;
9325 else {
9326 int ym=giacmin(y1,y2);
9327 if ( y1!=y2 && (ym==y || ym==y)){
9328 odd=!odd;
9329 }
9330 }
9331 impair[k]=odd;
9332 }
9333 for (size_t k=0;k<lxjs;++k){
9334 if (impair[k]){
9335 int x1=giacmax(xmin,int(lxj[k][0]+.5));
9336 int x2=k==lxjs-1?xmax:giacmin(xmax,int(lxj[k+1][0]+.5));
9337 for (;x1<=x2;++x1)
9338 set_pixel(x1,y,color,contextptr);
9339 }
9340 }
9341 } // end if y>=ymin
9342 y++;
9343 if (y>=ymax) break;
9344 // update lxj
9345 for (j=0;j<lxj.size();++j){
9346 int k=lxj[j][1];
9347 if (y<=giacmax(L[k][1],L[k+1][1]))
9348 lxj[j][0] += p[k];
9349 else {
9350 lxj.erase(lxj.begin()+j);
9351 --j;
9352 }
9353 }
9354 // new edges
9355 for (j=ompos;j<n;++j){
9356 ompos=j;
9357 if (om[j][0]>y)
9358 break;
9359 if (om[j][0]<y)
9360 continue;
9361 vector<double> add(2,om[j][1]);
9362 add[1]=om[j][2];
9363 lxj.push_back(add);
9364 }
9365 } // end for (;y<ymax;)
9366 }
9367
draw_polygon(vector<vector<int>> & v1,int color,GIAC_CONTEXT)9368 void draw_polygon(vector< vector<int> > & v1,int color,GIAC_CONTEXT){
9369 if (!(v1.back()==v1.front()))
9370 v1.push_back(v1.front());
9371 int n=v1.size()-1;
9372 for (int i=0;i<n;++i){
9373 int x1=v1[i][0],y1=v1[i][1],x2=v1[i+1][0],y2=v1[i+1][1];
9374 draw_line(x1,y1,x2,y2,color,contextptr);
9375 }
9376 }
9377
_draw_polygon(const gen & a,GIAC_CONTEXT)9378 gen _draw_polygon(const gen & a,GIAC_CONTEXT){
9379 freeze=true;
9380 if (a.type==_STRNG && a.subtype==-1) return a;
9381 if (a.type!=_VECT || a._VECTptr->size()<2)
9382 return gentypeerr(contextptr);
9383 const vecteur & v=*a._VECTptr;
9384 vector< vector<int> > v1;
9385 if (ckmatrix(v) && v.front()._VECTptr->size()==2){
9386 if (!vecteur2vectvector_int(v,0,v1))
9387 return gensizeerr(contextptr);
9388 draw_polygon(v1,0,contextptr);
9389 return 1;
9390 }
9391 gen g(v[0]);
9392 if (!ckmatrix(g) || g._VECTptr->front()._VECTptr->size()!=2 || !vecteur2vectvector_int(*g._VECTptr,0,v1))
9393 return gensizeerr(contextptr);
9394 int attr=remove_at_display(v.back(),contextptr).val;
9395 if (attr & 0x40000000)
9396 draw_filled_polygon(v1,0,1024,0,768,attr & 0xffff,contextptr);
9397 else
9398 draw_polygon(v1,attr & 0xffff,contextptr);
9399 return 1;
9400 }
9401 static const char _draw_polygon_s []="draw_polygon";
9402 static define_unary_function_eval (__draw_polygon,&_draw_polygon,_draw_polygon_s);
9403 define_unary_function_ptr5( at_draw_polygon ,alias_at_draw_polygon,&__draw_polygon,0,true);
9404
draw_rectangle(int x,int y,int width,int height,unsigned short color,GIAC_CONTEXT)9405 void draw_rectangle(int x, int y, int width, int height, unsigned short color,GIAC_CONTEXT){
9406 if (x<0){ width+=x; x=0;}
9407 if (y<0){ height+=y; y=0;}
9408 if (width<0 || height<0) return;
9409 #ifdef KHICAS
9410 os_fill_rect(x,y,width,height,color);
9411 #else
9412 for (int j=0;j<=height;++j){
9413 for (int i=0;i<width;++i)
9414 set_pixel(x+i,y+j,color,contextptr);
9415 }
9416 #endif
9417 }
9418
draw_circle(int xc,int yc,int r,int color,bool q1,bool q2,bool q3,bool q4,GIAC_CONTEXT)9419 void draw_circle(int xc,int yc,int r,int color,bool q1,bool q2,bool q3,bool q4,GIAC_CONTEXT){
9420 int x=0,y=r,delta=0;
9421 while (x<=y){
9422 if (q4){
9423 set_pixel(xc+x,yc+y,color,contextptr);
9424 set_pixel(xc+y,yc+x,color,contextptr);
9425 }
9426 if (q3){
9427 set_pixel(xc-x,yc+y,color,contextptr);
9428 set_pixel(xc-y,yc+x,color,contextptr);
9429 }
9430 if (q1){
9431 set_pixel(xc+x,yc-y,color,contextptr);
9432 set_pixel(xc+y,yc-x,color,contextptr);
9433 }
9434 if (q2){
9435 set_pixel(xc-x,yc-y,color,contextptr);
9436 set_pixel(xc-y,yc-x,color,contextptr);
9437 }
9438 ++x;
9439 if (delta<0){
9440 delta += 2*y+1;
9441 --y;
9442 }
9443 delta += 1-2*x;
9444 }
9445 }
9446
draw_filled_arc(int x,int y,int rx,int ry,int theta1_deg,int theta2_deg,int color,int xmin,int xmax,int ymin,int ymax,bool segment,GIAC_CONTEXT)9447 void draw_filled_arc(int x,int y,int rx,int ry,int theta1_deg,int theta2_deg,int color,int xmin,int xmax,int ymin,int ymax,bool segment,GIAC_CONTEXT){
9448 // approximation by a filled polygon
9449 // points: (x,y), (x+rx*cos(theta)/2,y+ry*sin(theta)/2) theta=theta1..theta2
9450 while (theta2_deg<theta1_deg)
9451 theta2_deg+=360;
9452 if (theta2_deg-theta1_deg>=360){
9453 theta1_deg=0;
9454 theta2_deg=360;
9455 }
9456 int N0=theta2_deg-theta1_deg+1;
9457 // reduce N if rx or ry is small
9458 double red=double(rx)/1024*double(ry)/768;
9459 if (red>1) red=1;
9460 if (red<0.1) red=0.1;
9461 int N=red*N0;
9462 if (N<5)
9463 N=N0>5?5:N0;
9464 if (N<2)
9465 N=2;
9466 vector< vector<int> > v(segment?N+1:N+2,vector<int>(2));
9467 int i=0;
9468 if (!segment){
9469 v[0][0]=x;
9470 v[0][1]=y;
9471 ++i;
9472 }
9473 double theta=theta1_deg*M_PI/180;
9474 double thetastep=(theta2_deg-theta1_deg)*M_PI/(180*(N-1));
9475 for (;i<v.size()-1;++i){
9476 v[i][0]=int(x+rx*std::cos(theta)+.5);
9477 v[i][1]=int(y-ry*std::sin(theta)+.5); // y is inverted
9478 theta += thetastep;
9479 }
9480 v.back()=v.front();
9481 draw_filled_polygon(v,xmin,xmax,ymin,ymax,color,contextptr);
9482 }
9483
9484
9485 // arc of ellipse, for y/x in [t1,t2] and in quadrant 1, 2, 3, 4
9486 // y must be replaced by -y
draw_arc(int xc,int yc,int rx,int ry,int color,double t1,double t2,bool q1,bool q2,bool q3,bool q4,GIAC_CONTEXT)9487 void draw_arc(int xc,int yc,int rx,int ry,int color,double t1, double t2,bool q1,bool q2,bool q3,bool q4,GIAC_CONTEXT){
9488 double x=0,y=rx,delta=0;
9489 double ryx=double(ry)/rx;
9490 // *logptr(contextptr) << "t1,t2:" << t1 << "," << t2 << ",q1234" << q1 << "," << q2 << "," << q3 << "," << q4 << '\n';
9491 while (x<=y){
9492 double xeff=x*ryx,yeff=y*ryx;
9493 if (q4){
9494 if (y>=-x*t2 && y<=-x*t1) set_pixel(xc+x,yc+yeff,color,contextptr);
9495 if (x>=-y*t2 && x<=-y*t1) set_pixel(xc+y,yc+xeff,color,contextptr);
9496 }
9497 if (q3){
9498 if (y>=x*t1 && y<=x*t2) set_pixel(xc-x,yc+yeff,color,contextptr);
9499 if (x>=y*t1 && x<=y*t2) set_pixel(xc-y,yc+xeff,color,contextptr);
9500 }
9501 if (q1){
9502 if (y>=x*t1 && y<=x*t2) set_pixel(xc+x,yc-yeff,color,contextptr);
9503 if (x>=y*t1 && x<=y*t2) set_pixel(xc+y,yc-xeff,color,contextptr);
9504 }
9505 if (q2){
9506 if (y>=-x*t2 && y<=-x*t1) set_pixel(xc-x,yc-yeff,color,contextptr);
9507 if (x>=-y*t2 && x<=-y*t1) set_pixel(xc-y,yc-xeff,color,contextptr);
9508 }
9509 ++x;
9510 if (delta<0){
9511 delta += 2*y+1;
9512 --y;
9513 }
9514 delta += 1-2*x;
9515 }
9516 }
9517
draw_arc(int xc,int yc,int rx,int ry,int color,double theta1,double theta2,GIAC_CONTEXT)9518 void draw_arc(int xc,int yc,int rx,int ry,int color,double theta1, double theta2,GIAC_CONTEXT){
9519 if (theta2-theta1>=2*M_PI){
9520 draw_arc(xc,yc,rx,ry,color,-1e307,1e307,true,true,true,true,contextptr);
9521 return;
9522 }
9523 // at most one vertical in [theta1,theta2]
9524 double t1=std::tan(theta1);
9525 double t2=std::tan(theta2);
9526 int n=int(std::floor(theta1/M_PI+.5));
9527 // n%2==0 -pi/2<theta1<pi/2, n%2==1 pi/2<theta1<3*pi/2
9528 double theta=(n+.5)*M_PI;
9529 // if theta1 is almost pi/2 mod pi, t1 might be wrong because of rounding
9530 if (std::fabs(theta1-(theta-M_PI))<1e-6 && t1>0)
9531 t1=-1e307;
9532 //*logptr(contextptr) << "thetas:" << theta1 << "," << theta << "," << theta2 << ", n " << n << ", t:" << t1 << "," << t2 << '\n';
9533 if (theta2>theta){
9534 if (theta2>=theta+M_PI){
9535 if (n%2==0){ // -pi/2<theta1<pi/2<3*pi/2<theta2
9536 draw_arc(xc,yc,rx,ry,color,t1,1e307,true,false,false,false,contextptr);
9537 draw_arc(xc,yc,rx,ry,color,-1e307,1e307,false,true,true,false,contextptr);
9538 draw_arc(xc,yc,rx,ry,color,-1e307,t2,false,false,false,true,contextptr);
9539 }
9540 else { // -3*pi/2<theta1<-pi/2<pi/2<theta2
9541 draw_arc(xc,yc,rx,ry,color,t1,1e307,false,false,true,false,contextptr);
9542 draw_arc(xc,yc,rx,ry,color,-1e307,1e307,true,false,false,true,contextptr);
9543 draw_arc(xc,yc,rx,ry,color,-1e307,t2,false,true,false,false,contextptr);
9544 }
9545 return;
9546 }
9547 if (n%2==0){ // -pi/2<theta1<pi/2<theta2<3*pi/2
9548 draw_arc(xc,yc,rx,ry,color,t1,1e307,true,false,false,false,contextptr);
9549 draw_arc(xc,yc,rx,ry,color,-1e307,t2,false,true,false,false,contextptr);
9550 }
9551 else { // -3*pi/2<theta1<-pi/2<theta2<pi/2
9552 draw_arc(xc,yc,rx,ry,color,t1,1e307,false,false,true,false,contextptr);
9553 draw_arc(xc,yc,rx,ry,color,-1e307,t2,false,false,false,true,contextptr);
9554 }
9555 return;
9556 }
9557 if (n%2==0) { // -pi/2<theta1<theta2<pi/2
9558 draw_arc(xc,yc,rx,ry,color,t1,t2,true,false,false,true,contextptr);
9559 }
9560 else { // pi/2<theta1<theta2<3*pi/2
9561 draw_arc(xc,yc,rx,ry,color,t1,t2,false,true,true,false,contextptr);
9562 }
9563 }
9564
draw_filled_circle(int xc,int yc,int r,int color,bool left,bool right,GIAC_CONTEXT)9565 void draw_filled_circle(int xc,int yc,int r,int color,bool left,bool right,GIAC_CONTEXT){
9566 int x=0,y=r,delta=0;
9567 while (x<=y){
9568 for (int Y=-y;Y<=y;Y++){
9569 if (right)
9570 set_pixel(xc+x,yc+Y,color,contextptr);
9571 if (left)
9572 set_pixel(xc-x,yc+Y,color,contextptr);
9573 }
9574 for (int Y=-x;Y<=x;Y++){
9575 if (right)
9576 set_pixel(xc+y,yc+Y,color,contextptr);
9577 if (left)
9578 set_pixel(xc-y,yc+Y,color,contextptr);
9579 }
9580 ++x;
9581 if (delta<0){
9582 delta += 2*y+1;
9583 --y;
9584 }
9585 delta += 1-2*x;
9586 }
9587 }
9588
_draw_arc(const gen & a_,bool arc,GIAC_CONTEXT)9589 gen _draw_arc(const gen & a_,bool arc,GIAC_CONTEXT){
9590 freeze=true;
9591 gen a(a_);
9592 if (a.type==_STRNG && a.subtype==-1) return a;
9593 if (a.type!=_VECT || a._VECTptr->size()<2)
9594 return gentypeerr(contextptr);
9595 const vecteur & v=*a._VECTptr;
9596 size_t vs=v.size();
9597 if (arc && vs<6)
9598 return gendimerr(contextptr);
9599 if (vs>=3){
9600 gen x0=v.front();
9601 gen y0=v[1];
9602 gen r=v[2];
9603 if (x0.type==_DOUBLE_)
9604 x0=int(x0._DOUBLE_val+.5);
9605 if (y0.type==_DOUBLE_)
9606 y0=int(y0._DOUBLE_val+.5);
9607 if (r.type==_DOUBLE_)
9608 r=int(r._DOUBLE_val+.5);
9609 int attr=vs==(arc?6:3)?0:remove_at_display(v.back(),contextptr).val;
9610 if (x0.type==_INT_ && y0.type==_INT_ && r.type==_INT_){
9611 if (arc){
9612 gen ry=v[3];
9613 if (ry.type==_DOUBLE_)
9614 ry=int(ry._DOUBLE_val+.5);
9615 gen theta1=evalf_double(v[4],1,contextptr);
9616 gen theta2=evalf_double(v[5],1,contextptr);
9617 if (attr & 0x40000000)
9618 draw_filled_arc(x0.val,y0.val,r.val,ry.val,int(theta1._DOUBLE_val*180/M_PI+.5),int(theta2._DOUBLE_val*180/M_PI+.5),attr & 0xffff,0,pixel_cols,0,pixel_lines,false,contextptr);
9619 draw_arc(x0.val,y0.val,r.val,ry.val,attr & 0xffff,theta1._DOUBLE_val,theta2._DOUBLE_val,contextptr);
9620 }
9621 else {
9622 if (attr & 0x40000000)
9623 draw_filled_circle(x0.val,y0.val,r.val,attr &0xffff,true,true,contextptr);
9624 else
9625 draw_circle(x0.val,y0.val,r.val,attr & 0xffff,true,true,true,true,contextptr);
9626 }
9627 return 1;
9628 }
9629 }
9630 return gensizeerr(contextptr);
9631 //static gen PIXEL(identificateur("PIXON_P"));
9632 //return _of(makesequence(PIXEL,a_),contextptr);
9633 }
_draw_circle(const gen & a_,GIAC_CONTEXT)9634 gen _draw_circle(const gen & a_,GIAC_CONTEXT){
9635 return _draw_arc(a_,false,contextptr);
9636 }
9637 static const char _draw_circle_s []="draw_circle";
9638 static define_unary_function_eval (__draw_circle,&_draw_circle,_draw_circle_s);
9639 define_unary_function_ptr5( at_draw_circle ,alias_at_draw_circle,&__draw_circle,0,true);
9640
_draw_arc(const gen & a_,GIAC_CONTEXT)9641 gen _draw_arc(const gen & a_,GIAC_CONTEXT){
9642 return _draw_arc(a_,true,contextptr);
9643 }
9644 static const char _draw_arc_s []="draw_arc";
9645 static define_unary_function_eval (__draw_arc,&_draw_arc,_draw_arc_s);
9646 define_unary_function_ptr5( at_draw_arc ,alias_at_draw_arc,&__draw_arc,0,true);
9647
draw_line_or_rectangle(const gen & a_,GIAC_CONTEXT,int rect)9648 gen draw_line_or_rectangle(const gen & a_,GIAC_CONTEXT,int rect){
9649 gen a(a_);
9650 if (a.type==_STRNG && a.subtype==-1) return a;
9651 if (a.type!=_VECT || a._VECTptr->size()<2)
9652 return gentypeerr(contextptr);
9653 const vecteur & v=*a._VECTptr;
9654 size_t vs=v.size();
9655 if (vs>=4){
9656 gen x0=v.front();
9657 gen y0=v[1];
9658 gen x1=v[2];
9659 gen y1=v[3];
9660 if (x0.type==_DOUBLE_)
9661 x0=int(x0._DOUBLE_val+.5);
9662 if (y0.type==_DOUBLE_)
9663 y0=int(y0._DOUBLE_val+.5);
9664 if (x1.type==_DOUBLE_)
9665 x1=int(x1._DOUBLE_val+.5);
9666 if (y1.type==_DOUBLE_)
9667 y1=int(y1._DOUBLE_val+.5);
9668 if (x0.type==_INT_ && y0.type==_INT_ && x1.type==_INT_ && y1.type==_INT_){
9669 if (rect){
9670 int attr=vs==4?0:remove_at_display(v[4],contextptr).val;
9671 if (rect==2 || (attr & 0x40000000))
9672 draw_rectangle(x0.val,y0.val,x1.val,y1.val,attr & 0xffff,contextptr);
9673 else {
9674 draw_line(x0.val,y0.val,x0.val+x1.val,y0.val,attr & 0xffff,contextptr);
9675 draw_line(x0.val+x1.val,y0.val,x0.val+x1.val,y0.val+y1.val,attr & 0xffff,contextptr);
9676 draw_line(x0.val+x1.val,y0.val+y1.val,x0.val,y0.val+y1.val,attr & 0xffff,contextptr);
9677 draw_line(x0.val,y0.val,x0.val,y0.val+y1.val,attr & 0xffff,contextptr);
9678 }
9679 }
9680 else
9681 draw_line(x0.val,y0.val,x1.val,y1.val,vs==4?0:remove_at_display(v[4],contextptr).val,contextptr);
9682 return 1;
9683 }
9684 }
9685 return gensizeerr(contextptr);
9686 //static gen PIXEL(identificateur("PIXON_P"));
9687 //return _of(makesequence(PIXEL,a_),contextptr);
9688 }
_draw_line(const gen & a_,GIAC_CONTEXT)9689 gen _draw_line(const gen & a_,GIAC_CONTEXT){
9690 freeze=true;
9691 return draw_line_or_rectangle(a_,contextptr,0);
9692 }
9693 static const char _draw_line_s []="draw_line";
9694 static define_unary_function_eval (__draw_line,&_draw_line,_draw_line_s);
9695 define_unary_function_ptr5( at_draw_line ,alias_at_draw_line,&__draw_line,0,true);
9696
_draw_rectangle(const gen & a_,GIAC_CONTEXT)9697 gen _draw_rectangle(const gen & a_,GIAC_CONTEXT){
9698 freeze=true;
9699 return draw_line_or_rectangle(a_,contextptr,1);
9700 }
9701 static const char _draw_rectangle_s []="draw_rectangle";
9702 static define_unary_function_eval (__draw_rectangle,&_draw_rectangle,_draw_rectangle_s);
9703 define_unary_function_ptr5( at_draw_rectangle ,alias_at_draw_rectangle,&__draw_rectangle,0,true);
9704
_fill_rect(const gen & a_,GIAC_CONTEXT)9705 gen _fill_rect(const gen & a_,GIAC_CONTEXT){
9706 freeze=true;
9707 return draw_line_or_rectangle(a_,contextptr,2);
9708 }
9709 static const char _fill_rect_s []="fill_rect";
9710 static define_unary_function_eval (__fill_rect,&_fill_rect,_fill_rect_s);
9711 define_unary_function_ptr5( at_fill_rect ,alias_at_fill_rect,&__fill_rect,0,true);
9712
_draw_string(const gen & a_,GIAC_CONTEXT)9713 gen _draw_string(const gen & a_,GIAC_CONTEXT){
9714 freeze=true;
9715 #ifdef GIAC_HAS_STO_38
9716 static gen PIXEL(identificateur("TEXTOUT_P"));
9717 return _of(makesequence(PIXEL,a_),contextptr);
9718 #else // HP
9719 gen a(a_);
9720 if (a.type==_STRNG && a.subtype==-1) return a;
9721 if (a.type!=_VECT)
9722 return gensizeerr(contextptr);
9723 vecteur v(*a._VECTptr);
9724 if (v.size()<3 || v.size()>5)
9725 return gendimerr(contextptr);
9726 if (v[0].type!=_STRNG || !is_integral(v[1]) || !is_integral(v[2]))
9727 return gensizeerr(contextptr);
9728 gen s=v[0];
9729 #ifdef KHICAS
9730 os_draw_string(v[1].val,v[2].val,v.size()>3?remove_at_display(v[3],contextptr).val:_BLACK,v.size()>4?remove_at_display(v[4],contextptr).val:_WHITE,s._STRNGptr->c_str());
9731 return 1;
9732 #else
9733 v.erase(v.begin());
9734 v.push_back(s);
9735 pixel_v()._VECTptr->push_back(_pixon(gen(v,_SEQ__VECT),contextptr));
9736 return pixel_v();
9737 #endif // KHICAS
9738 #endif // HP
9739 }
9740 static const char _draw_string_s []="draw_string";
9741 static define_unary_function_eval (__draw_string,&_draw_string,_draw_string_s);
9742 define_unary_function_ptr5( at_draw_string ,alias_at_draw_string,&__draw_string,0,true);
9743
_get_pixel(const gen & a_,GIAC_CONTEXT)9744 gen _get_pixel(const gen & a_,GIAC_CONTEXT){
9745 #ifdef GIAC_HAS_STO_38
9746 static gen PIXEL(identificateur("GETPIX_P"));
9747 return _of(makesequence(PIXEL,a_),contextptr);
9748 #else // GIAC_HAS_STO_38
9749 gen a(a_);
9750 if (a.type==_STRNG && a.subtype==-1) return a;
9751 if (a.type!=_VECT || a._VECTptr->size()!=2)
9752 return gensizeerr(contextptr);
9753 gen x=a._VECTptr->front(),y=a._VECTptr->back();
9754 if (x.type==_INT_ && x.val>=0 && x.val<pixel_cols && y.type==_INT_ && y.val>=0 && y.val<pixel_lines){
9755 #ifdef KHICAS
9756 int c=os_get_pixel(x.val,y.val);
9757 #else
9758 int c=pixel_buffer[y.val][x.val];
9759 #endif
9760 if (python_compat(contextptr)==2){
9761 c &= 0xffff;
9762 int r=(c>>11)&0x1f,g=(c>>5)&0x3f,b=c&0x1f;
9763 return gen(makevecteur(r<<3,g<<2,b<<3),_TUPLE__VECT);
9764 }
9765 return c;
9766 }
9767 #ifdef KHICAS
9768 return undef;
9769 #else // KHICAS
9770 const vecteur v= *pixel_v()._VECTptr;
9771 for (size_t i=0;i<v.size();++i){
9772 const gen & vi_=v[i];
9773 const gen * vi=&vi_;
9774 if (vi_.type==_SYMB && vi_._SYMBptr->sommet==at_pnt){
9775 const gen & f=vi_._SYMBptr->feuille;
9776 if (f.type==_VECT){
9777 const vecteur & w=*f._VECTptr;
9778 if (!w.empty())
9779 vi=&v.front();
9780 }
9781 }
9782 if (vi->is_symb_of_sommet(at_pixon)){
9783 const gen & f=vi->_SYMBptr->feuille;
9784 if (f.type==_VECT){
9785 const vecteur & w=*f._VECTptr;
9786 int ws=w.size();
9787 if (ws>=2 && w.front()==x && w[1]==y){
9788 if (ws>=3) return w[2];
9789 return int(FL_BLACK);
9790 }
9791 }
9792 }
9793 }
9794 return int(FL_WHITE);
9795 #endif // KHICAS
9796 #endif // GIAC_HAS_STO_38
9797 }
9798 static const char _get_pixel_s []="get_pixel";
9799 static define_unary_function_eval (__get_pixel,&_get_pixel,_get_pixel_s);
9800 define_unary_function_ptr5( at_get_pixel ,alias_at_get_pixel,&__get_pixel,0,true);
9801
_dtype(const gen & args,GIAC_CONTEXT)9802 gen _dtype(const gen & args,GIAC_CONTEXT){
9803 gen g(args);
9804 while (g.type==_VECT && !g._VECTptr->empty())
9805 g=g._VECTptr->front();
9806 return change_subtype(g.type,_INT_TYPE);
9807 }
9808 static const char _dtype_s []="dtype";
9809 static define_unary_function_eval (__dtype,&_dtype,_dtype_s);
9810 define_unary_function_ptr5( at_dtype ,alias_at_dtype,&__dtype,0,true);
9811
_rgb(const gen & args,GIAC_CONTEXT)9812 gen _rgb(const gen & args,GIAC_CONTEXT){
9813 if (args.type!=_VECT || args._VECTptr->size()<3)
9814 return gensizeerr(contextptr);
9815 const vecteur & v=*args._VECTptr;
9816 gen a=v[0],b=v[1],c=v[2];
9817 if (a.type==_DOUBLE_ || b.type==_DOUBLE_ || c.type==_DOUBLE_){
9818 a=_floor(255*a+.5,contextptr);
9819 b=_floor(255*b+.5,contextptr);
9820 c=_floor(255*c+.5,contextptr);
9821 }
9822 if (a.type==_INT_ && b.type==_INT_ && c.type==_INT_ && a.val>=0 && b.val>=0 && c.val>=0 ){
9823 int d=0,av=giacmin(a.val,255),bv=giacmin(b.val,255),cv=giacmin(c.val,255);
9824 if (v.size()==4 && (v.back()==888 || v.back()==at_pixon || v.back()==at_set_pixel)){
9825 d=(av<<16)|(bv<<8)|cv;
9826 if (d>0 && d<512)
9827 d += (1<<16);
9828 }
9829 else {
9830 if (v.size()==4 && v.back()!=565)
9831 return gensizeerr(contextptr);
9832 d=(((av*32)/256)<<11) | (((bv*64)/256)<<5) | ((cv*32)/256);
9833 if (d>0 && d<512){
9834 d += (1<<11);
9835 }
9836 }
9837 return d;
9838 }
9839 return gensizeerr(contextptr);
9840 }
9841 static const char _rgb_s []="rgb";
9842 static define_unary_function_eval (__rgb,&_rgb,_rgb_s);
9843 define_unary_function_ptr5( at_rgb ,alias_at_rgb,&__rgb,0,true);
9844
prediction(const gen & args,int type,GIAC_CONTEXT)9845 gen prediction(const gen & args,int type,GIAC_CONTEXT){
9846 if (args.type!=_VECT || args._VECTptr->size()!=2)
9847 return gensizeerr(contextptr);
9848 const vecteur & v=*args._VECTptr;
9849 gen p=v[0],n=v[1],b=inv(sqrt(n,contextptr),contextptr);
9850 if (type==0 || type==2){
9851 if (type==0 &&(is_strictly_greater(25,n,contextptr) || is_strictly_greater(.2,p,contextptr) || is_strictly_greater(p,.8,contextptr)))
9852 return gensizeerr("Unable to predict");
9853 return makevecteur(max(p-b,0,contextptr),min(p+b,1,contextptr));
9854 }
9855 if (type==1){
9856 b=1.96*sqrt(p*(1-p),contextptr)*b;
9857 if (is_strictly_greater(30,n,contextptr) || is_greater(5,n*p,contextptr) || is_greater(5,n*(1-p),contextptr))
9858 return gensizeerr("Unable to predict");
9859 return makevecteur(max(p-b,0,contextptr),min(p+b,1,contextptr));
9860 }
9861 return undef;
9862 }
_prediction(const gen & args,GIAC_CONTEXT)9863 gen _prediction(const gen & args,GIAC_CONTEXT){
9864 return prediction(args,0,contextptr);
9865 }
9866 static const char _prediction_s []="prediction";
9867 static define_unary_function_eval (__prediction,&_prediction,_prediction_s);
9868 define_unary_function_ptr5( at_prediction ,alias_at_prediction,&__prediction,0,true);
9869
_confidence(const gen & args,GIAC_CONTEXT)9870 gen _confidence(const gen & args,GIAC_CONTEXT){
9871 return prediction(args,2,contextptr);
9872 }
9873 static const char _confidence_s []="confidence";
9874 static define_unary_function_eval (__confidence,&_confidence,_confidence_s);
9875 define_unary_function_ptr5( at_confidence ,alias_at_confidence,&__confidence,0,true);
9876
_prediction95(const gen & args,GIAC_CONTEXT)9877 gen _prediction95(const gen & args,GIAC_CONTEXT){
9878 return prediction(args,1,contextptr);
9879 }
9880 static const char _prediction95_s []="prediction95";
9881 static define_unary_function_eval (__prediction95,&_prediction95,_prediction95_s);
9882 define_unary_function_ptr5( at_prediction95 ,alias_at_prediction95,&__prediction95,0,true);
9883
_log2(const gen & args,GIAC_CONTEXT)9884 gen _log2(const gen & args,GIAC_CONTEXT){
9885 return _logb(makesequence(args,2),contextptr);
9886 }
9887 static const char _log2_s []="log2";
9888 static define_unary_function_eval (__log2,&_log2,_log2_s);
9889 define_unary_function_ptr5( at_log2 ,alias_at_log2,&__log2,0,true);
9890
_radians(const gen & args,GIAC_CONTEXT)9891 gen _radians(const gen & args,GIAC_CONTEXT){
9892 return M_PI/180*args;
9893 }
9894 static const char _radians_s []="radians";
9895 static define_unary_function_eval (__radians,&_radians,_radians_s);
9896 define_unary_function_ptr5( at_radians ,alias_at_radians,&__radians,0,true);
9897
_degrees(const gen & args,GIAC_CONTEXT)9898 gen _degrees(const gen & args,GIAC_CONTEXT){
9899 return 180/M_PI*args;
9900 }
9901 static const char _degrees_s []="degrees";
9902 static define_unary_function_eval (__degrees,&_degrees,_degrees_s);
9903 define_unary_function_ptr5( at_degrees ,alias_at_degrees,&__degrees,0,true);
9904
_modf(const gen & args,GIAC_CONTEXT)9905 gen _modf(const gen & args,GIAC_CONTEXT){
9906 gen g=evalf_double(args,1,contextptr);
9907 if (g.type!=_DOUBLE_)
9908 return gensizeerr(contextptr);
9909 double d=g._DOUBLE_val;
9910 bool neg=d<0;
9911 if (neg) d=-d;
9912 double d1=std::floor(d),d2=d-d1;
9913 if (neg){ d1=-d1; d2=-d2; }
9914 return makesequence(d2,d1);
9915 }
9916 static const char _modf_s []="modf";
9917 static define_unary_function_eval (__modf,&_modf,_modf_s);
9918 define_unary_function_ptr5( at_modf ,alias_at_modf,&__modf,0,true);
9919
9920 #ifdef EMCC
9921 #ifdef EMCC_FETCH
9922 // with emscripten 1.37.28, it does not work
9923 #include <emscripten/fetch.h>
9924
fetch(const string & url)9925 string fetch(const string & url){
9926 COUT << "fetch " << url << '\n';
9927 emscripten_fetch_attr_t attr;
9928 emscripten_fetch_attr_init(&attr);
9929 strcpy(attr.requestMethod, "GET");
9930 attr.attributes = EMSCRIPTEN_FETCH_LOAD_TO_MEMORY | EMSCRIPTEN_FETCH_SYNCHRONOUS;
9931 emscripten_fetch_t *fetch = emscripten_fetch(&attr, url.c_str()); // Blocks here until the operation is complete.
9932 COUT << "status, bytes: " << fetch->status << "," << fetch->numBytes << '\n';
9933 if (fetch->status == 200) {
9934 string fetch_string="";
9935 for (int i=0;i< fetch->numBytes;++i)
9936 fetch_string += char(fetch->data[i]);
9937 return fetch_string;
9938 }
9939 return "Failed";
9940 }
9941 #else
9942 #include <emscripten/emscripten.h>
9943
fetch(const string & url)9944 string fetch(const string & url){
9945 COUT << "wget_data " << url << '\n';
9946 char * buf;
9947 #if 0 // does not work emscripten 1.34/37
9948 int data_size,data_error;
9949 emscripten_wget_data(url.c_str(),(void **)&buf,&data_size,&data_error);
9950 if (data_size>0){
9951 buf[data_size-1]=0;
9952 string s(buf);
9953 COUT << "buffer " << s << '\n';
9954 free(buf);
9955 return s;
9956 }
9957 return "ERROR";
9958 #else
9959 const int bufsize=512*1024;
9960 buf=(char *)malloc(bufsize);
9961 EM_ASM_ARGS({
9962 var url=Module.Pointer_stringify($0);
9963 console.log("url:"+url);
9964 var req = new XMLHttpRequest();
9965 var bufsize=$2;
9966 req.open("GET", url, false); // false: synchrone, true: async
9967 req.overrideMimeType("text/plain; charset=x-user-defined");
9968 req.send(null);
9969 // will not work on different domain, except if
9970 // cross-domain is enabled (firefox CORS extension like Cross Domain)
9971 if (req.status === 200) {
9972 console.log("Réponse reçue: %s", req.responseText);
9973 var s=req.responseText;
9974 if (s.length>=bufsize-1)
9975 s=s.substr(0,bufsize-1);
9976 Module.writeStringToMemory(s,$1);
9977 } else {
9978 console.log("Status de la réponse: %d (%s)", req.status, req.statusText);
9979 Module.writeStringToMemory("ERROR",$1);
9980 }
9981 },url.c_str(),buf,bufsize);
9982 string s(buf);
9983 free(buf);
9984 return s;
9985 #endif
9986 }
9987 #endif // EMCC_FETCH
9988
9989 #else // EMCC
9990 #ifdef HAVE_LIBCURL
9991 #include <curl/curl.h>
9992 #include <curl/easy.h>
9993 //#include <curl/curlbuild.h>
write_data(void * ptr,size_t size,size_t nmemb,void * stream)9994 size_t write_data(void *ptr, size_t size, size_t nmemb, void *stream) {
9995 string data((const char*) ptr, (size_t) size * nmemb);
9996 *((stringstream*) stream) << data << '\n';
9997 return size * nmemb;
9998 }
fetch(const string & url)9999 string fetch(const string & url){
10000 void * curl = curl_easy_init();
10001 curl_easy_setopt(curl, CURLOPT_URL, url.c_str());
10002 /* example.com is redirected, so we tell libcurl to follow redirection */
10003 curl_easy_setopt(curl, CURLOPT_FOLLOWLOCATION, 1L);
10004 curl_easy_setopt(curl, CURLOPT_NOSIGNAL, 1); //Prevent "longjmp causes uninitialized stack frame" bug
10005 curl_easy_setopt(curl, CURLOPT_ACCEPT_ENCODING, "deflate");
10006 std::stringstream out;
10007 curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, write_data);
10008 curl_easy_setopt(curl, CURLOPT_WRITEDATA, &out);
10009 /* Perform the request, res will get the return code */
10010 CURLcode res = curl_easy_perform(curl);
10011 /* Check for errors */
10012 if (res != CURLE_OK) {
10013 string s=string("Failure: ")+curl_easy_strerror(res);
10014 curl_easy_cleanup(curl);
10015 return s;
10016 }
10017 curl_easy_cleanup(curl);
10018 return out.str();
10019 }
10020 #else
fetch(const string & url)10021 string fetch(const string & url){
10022 return "Failed";
10023 }
10024 #endif // HAVE_LIBCURL
10025 #endif // EMCC
10026
10027 #ifndef NO_NAMESPACE_GIAC
10028 } // namespace giac
10029 #endif // ndef NO_NAMESPACE_GIAC
10030