1 // -*- mode:C++ ; compile-command: "g++ -I.. -g -c -fno-strict-aliasing -DGIAC_GENERIC_CONSTANTS -DHAVE_CONFIG_H -DIN_GIAC solve.cc" -*-
2 #include "giacPCH.h"
3 
4 /*
5  *  Copyright (C) 2001,14 B. Parisse, R. De Graeve
6  *  Institut Fourier, 38402 St Martin d'Heres
7  *
8  *  This program is free software; you can redistribute it and/or modify
9  *  it under the terms of the GNU General Public License as published by
10  *  the Free Software Foundation; either version 3 of the License, or
11  *  (at your option) any later version.
12  *
13  *  This program is distributed in the hope that it will be useful,
14  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
15  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16  *  GNU General Public License for more details.
17  *
18  *  You should have received a copy of the GNU General Public License
19  *  along with this program. If not, see <http://www.gnu.org/licenses/>.
20  */
21 using namespace std;
22 #include <stdexcept>
23 #include <cmath>
24 #include <algorithm>
25 #include "gen.h"
26 #include "solve.h"
27 #include "modpoly.h"
28 #include "unary.h"
29 #include "symbolic.h"
30 #include "usual.h"
31 #include "sym2poly.h"
32 #include "subst.h"
33 #include "derive.h"
34 #include "plot.h"
35 #include "prog.h"
36 #include "series.h"
37 #include "alg_ext.h"
38 #include "intg.h"
39 #include "rpn.h"
40 #include "lin.h"
41 #include "misc.h"
42 #include "cocoa.h"
43 #include "ti89.h"
44 #include "maple.h"
45 #include "csturm.h"
46 #include "sparse.h"
47 #include "giacintl.h"
48 #ifdef HAVE_LIBGSL
49 #include <gsl/gsl_roots.h>
50 #include <gsl/gsl_multiroots.h>
51 #include <gsl/gsl_errno.h>
52 #include <gsl/gsl_vector.h>
53 #endif
54 
55 #ifndef NO_NAMESPACE_GIAC
56 namespace giac {
57 #endif // ndef NO_NAMESPACE_GIAC
58 
59   // FIXME intvar_counter should be contextized
60   int intvar_counter=0;
61   int realvar_counter=0;
print_intvar_counter(GIAC_CONTEXT)62   string print_intvar_counter(GIAC_CONTEXT){
63     if (intvar_counter<0)
64       return print_INT_(-intvar_counter);
65     string res=print_INT_(intvar_counter);
66     ++intvar_counter;
67     return res;
68   }
69 
print_realvar_counter(GIAC_CONTEXT)70   string print_realvar_counter(GIAC_CONTEXT){
71     if (realvar_counter<0)
72       return print_INT_(int(-realvar_counter));
73     string res=print_INT_(int(realvar_counter));
74     ++realvar_counter;
75     return res;
76   }
77 
_reset_solve_counter(const gen & args,const context * contextptr)78   gen _reset_solve_counter(const gen & args,const context * contextptr){
79     if ( args.type==_STRNG && args.subtype==-1) return  args;
80     if (is_zero(args,contextptr)){
81       intvar_counter=0;
82       return 1;
83     }
84     if (is_one(args)){
85       realvar_counter=0;
86       return 1;
87     }
88     if (args.type==_VECT && args._VECTptr->size()==2){
89       intvar_counter=int(evalf_double(args._VECTptr->front(),1,contextptr)._DOUBLE_val);
90       realvar_counter=int(evalf_double(args._VECTptr->back(),1,contextptr)._DOUBLE_val);
91     }
92     else {
93       intvar_counter=0;
94       realvar_counter=0;
95     }
96     return 1;
97   }
98   static const char _reset_solve_counter_s []="reset_solve_counter";
99   static define_unary_function_eval (___reset_solve_counter,&_reset_solve_counter,_reset_solve_counter_s);
100   define_unary_function_ptr5( at_reset_solve_counter ,alias_at_reset_solve_counter,&___reset_solve_counter,0,true);
101 
set_merge(vecteur & v,const vecteur & w)102   void set_merge(vecteur & v,const vecteur & w){
103     if (is_undef(w)){
104       v=w;
105       return;
106     }
107     const_iterateur it=w.begin(),itend=w.end();
108     for (;it!=itend;++it)
109       if (!equalposcomp(v,*it))
110 	v.push_back(*it);
111   }
112 
one_tour(GIAC_CONTEXT)113   static gen one_tour(GIAC_CONTEXT){
114     if (angle_radian(contextptr))
115       return cst_two_pi;
116     else if(angle_degree(contextptr))
117       return 360;
118     //grad
119     else
120       return 400;
121   }
one_half_tour(GIAC_CONTEXT)122   static gen one_half_tour(GIAC_CONTEXT){
123     if (angle_radian(contextptr))
124       return cst_pi;
125     else if(angle_degree(contextptr))
126       return 180;
127     //grad
128     else
129       return 200;
130   }
isolate_exp(const gen & e,int isolate_mode,GIAC_CONTEXT)131   static gen isolate_exp(const gen & e,int isolate_mode,GIAC_CONTEXT){
132     if (isolate_mode &1)
133       return ln(e,contextptr);
134     if (e.type!=_VECT){
135       if (is_strictly_positive(-e,contextptr))
136 	return vecteur(0);
137       else
138 	return ln(e,contextptr);
139     }
140     // check in real mode for negative ln
141     const_iterateur it=e._VECTptr->begin(),itend=e._VECTptr->end();
142     vecteur res;
143     for (;it!=itend;++it){
144       if (!is_strictly_positive(-*it,contextptr))
145 	res.push_back(ln(*it,contextptr));
146     }
147     return res;
148   }
isolate_ln(const gen & e,int isolate_mode,GIAC_CONTEXT)149   static gen isolate_ln(const gen & e,int isolate_mode,GIAC_CONTEXT){
150     return simplify(exp(e,contextptr),contextptr);
151   }
isolate_sin(const gen & e,int isolate_mode,GIAC_CONTEXT)152   static gen isolate_sin(const gen & e,int isolate_mode,GIAC_CONTEXT){
153     gen asine=asin(e,contextptr);
154     if (!(isolate_mode & 2))
155       return makevecteur(asine,one_half_tour(contextptr)-asine);
156     identificateur x(string("n_")+print_intvar_counter(contextptr));
157     if (is_zero(e,contextptr))
158       return asine+(x)*one_half_tour(contextptr);
159     return makevecteur(asine+(x)*one_tour(contextptr),one_half_tour(contextptr)-asine+(x)*one_tour(contextptr));
160   }
isolate_cos(const gen & e,int isolate_mode,GIAC_CONTEXT)161   static gen isolate_cos(const gen & e,int isolate_mode,GIAC_CONTEXT){
162     gen acose=acos(e,contextptr);
163     if (!(isolate_mode & 2))
164       return makevecteur(acose,-acose);
165     identificateur x(string("n_")+print_intvar_counter(contextptr));
166     if (is_zero(e,contextptr))
167       return acose+(x)*one_half_tour(contextptr);
168     return makevecteur(acose+(x)*one_tour(contextptr),-acose+(x)*one_tour(contextptr));
169   }
isolate_tan(const gen & e,int isolate_mode,GIAC_CONTEXT)170   static gen isolate_tan(const gen & e,int isolate_mode,GIAC_CONTEXT){
171     if (!(isolate_mode & 2))
172       return atan(e,contextptr);
173     identificateur x(string("n_")+print_intvar_counter(contextptr));
174     return atan(e,contextptr)+(x)*one_half_tour(contextptr);
175   }
isolate_asin(const gen & e,int isolate_mode,GIAC_CONTEXT)176   static gen isolate_asin(const gen & e,int isolate_mode,GIAC_CONTEXT){
177     return sin(e,contextptr);
178   }
isolate_acos(const gen & e,int isolate_mode,GIAC_CONTEXT)179   static gen isolate_acos(const gen & e,int isolate_mode,GIAC_CONTEXT){
180     return cos(e,contextptr);
181   }
isolate_atan(const gen & e,int isolate_mode,GIAC_CONTEXT)182   static gen isolate_atan(const gen & e,int isolate_mode,GIAC_CONTEXT){
183     return tan(e,contextptr);
184   }
185 
isolate_asinh(const gen & e,int isolate_mode,GIAC_CONTEXT)186   static gen isolate_asinh(const gen & e,int isolate_mode,GIAC_CONTEXT){
187     return sinh(e,contextptr);
188   }
isolate_acosh(const gen & e,int isolate_mode,GIAC_CONTEXT)189   static gen isolate_acosh(const gen & e,int isolate_mode,GIAC_CONTEXT){
190     return cosh(e,contextptr);
191   }
isolate_atanh(const gen & e,int isolate_mode,GIAC_CONTEXT)192   static gen isolate_atanh(const gen & e,int isolate_mode,GIAC_CONTEXT){
193     return tanh(e,contextptr);
194   }
195 
isolate_sinh(const gen & e,int isolate_mode,GIAC_CONTEXT)196   static gen isolate_sinh(const gen & e,int isolate_mode,GIAC_CONTEXT){
197     gen asine= asinh(e,contextptr);
198     if (!(isolate_mode & 2))
199       return asine;
200     identificateur * x=new identificateur(string("n_")+print_intvar_counter(contextptr));
201     return makevecteur(asine+(*x)*one_tour(contextptr)*cst_i,(one_half_tour(contextptr)+(*x)*one_tour(contextptr))*cst_i-asine);
202   }
isolate_cosh(const gen & e,int isolate_mode,GIAC_CONTEXT)203   static gen isolate_cosh(const gen & e,int isolate_mode,GIAC_CONTEXT){
204     gen acose=acosh(e,contextptr);
205     if (!(isolate_mode & 2))
206       return makevecteur(acose,-acose);
207     identificateur * x=new identificateur(string("n_")+print_intvar_counter(contextptr));
208     return makevecteur(acose+(*x)*one_tour(contextptr)*cst_i,-acose+(*x)*one_tour(contextptr)*cst_i);
209   }
isolate_tanh(const gen & e,int isolate_mode,GIAC_CONTEXT)210   static gen isolate_tanh(const gen & e,int isolate_mode,GIAC_CONTEXT){
211     if (!(isolate_mode & 2))
212       return atanh(e,contextptr);
213     identificateur * x=new identificateur(string("n_")+print_intvar_counter(contextptr));
214     return atanh(e,contextptr)+(*x)*one_half_tour(contextptr)*cst_i;
215   }
216 
217   static gen (* const isolate_fcns[] ) (const gen &,int,GIAC_CONTEXT) = { isolate_exp,isolate_ln,isolate_sin,isolate_cos,isolate_tan,isolate_asin,isolate_acos,isolate_atan,isolate_sinh,isolate_cosh,isolate_tanh,isolate_asinh,isolate_acosh,isolate_atanh};
218 
find_excluded(const gen & g,GIAC_CONTEXT)219   static vecteur find_excluded(const gen & g,GIAC_CONTEXT){
220     if (g.type!=_IDNT)
221       return vecteur(0);
222     gen g2=g._IDNTptr->eval(eval_level(contextptr),g,contextptr);
223     if ((g2.type==_VECT) && (g2.subtype==_ASSUME__VECT)){
224       vecteur v=*g2._VECTptr;
225       if ( v.size()==3 && v[0]!=_INT_ && v[2].type==_VECT ){
226 	return *v[2]._VECTptr;
227       }
228     }
229     return vecteur(0);
230   }
231 
check(const gen & id,const gen & value,const gen & ids,const gen & vals,GIAC_CONTEXT)232   static bool check(const gen & id,const gen & value,const gen & ids,const gen & vals,GIAC_CONTEXT){
233     if (is_inequation(value))
234       return true; // FIXME!!
235     if (id.type==_VECT && value.type==_VECT && id._VECTptr->size()==value._VECTptr->size()){
236       for (unsigned i=0;i<id._VECTptr->size();++i){
237 	if (!check((*id._VECTptr)[i],(*value._VECTptr)[i],ids,vals,contextptr))
238 	  return false;
239       }
240       return true;
241     }
242     if (id.type!=_IDNT)
243       return true;
244     gen g,g2=id._IDNTptr->eval(1,g,contextptr);
245     g2=subst(g2,ids,vals,false,contextptr);
246     if ((g2.type==_VECT) && (g2.subtype==_ASSUME__VECT)){
247       vecteur v=*g2._VECTptr;
248       if (!v.empty() && v[0].type==_INT_ && (v[0].val==_INT_ || v[0].val==_ZINT) && value.type!=_IDNT && value.type!=_SYMB && !is_integer(value))
249 	return false;
250       if ( v.size()==3 && v[1].type==_VECT && v[2].type==_VECT){
251 	for (unsigned i=0;i<v[2]._VECTptr->size();++i){
252 	  if (value==(*v[2]._VECTptr)[i])
253 	    return false;
254 	}
255 	int loupe=0;
256 	for (unsigned i=0;i<v[1]._VECTptr->size();++i){
257 	  gen tmp=(*v[1]._VECTptr)[i];
258 	  if (tmp.type==_VECT && tmp._VECTptr->size()==2){
259 	    gen a=tmp._VECTptr->front(),b=tmp._VECTptr->back();
260 	    if (is_strictly_greater(a,value,contextptr) || is_strictly_greater(value,b,contextptr))
261 	      loupe++;
262 	    else {
263 	      if (is_greater(value,a,contextptr) && is_greater(b,value,contextptr))
264 		break;
265 	    }
266 	  }
267 	}
268 	if (loupe==int(v[1]._VECTptr->size())) // all tests above returned false
269 	  return false;
270       }
271     }
272     return true;
273   }
274 
275   // Fix isolate_mode if g is assumed to be in a given interval
ck_isolate_mode(int & isolate_mode,const gen & g,GIAC_CONTEXT)276   static void ck_isolate_mode(int & isolate_mode,const gen & g,GIAC_CONTEXT){
277     if ( (isolate_mode& 2) ||  g.type!=_IDNT)
278       return ;
279     gen g2=g._IDNTptr->eval(eval_level(contextptr),g,contextptr);
280     if (g2.type==_VECT && g2.subtype==_ASSUME__VECT){
281       vecteur v=*g2._VECTptr;
282       if ( v.size()==3 && v[0]!= _INT_ && v[1].type==_VECT && !v[1]._VECTptr->empty()){
283 	gen a=v[1]._VECTptr->front(),b=v[1]._VECTptr->back();
284 	if (a.type==_VECT && !a._VECTptr->empty() && !is_inf(a._VECTptr->front()) && b.type==_VECT && !b._VECTptr->empty() && !is_inf(b._VECTptr->back()))
285 	  isolate_mode |= 2;
286       }
287     }
288   }
289 
protect_sort(const vecteur & res,GIAC_CONTEXT)290   vecteur protect_sort(const vecteur & res,GIAC_CONTEXT){
291 #ifndef NO_STDEXCEPT
292     try {
293 #endif
294       gen tmp=_sort(res,contextptr);
295       if (tmp.type==_VECT){
296 	vecteur w=*tmp._VECTptr,res;
297 	iterateur it=w.begin(),itend=w.end();
298 	for (;it!=itend;++it){
299 	  if (res.empty() || *it!=res.back())
300 	    res.push_back(*it);
301 	}
302 	return res;
303       }
304 #ifndef NO_STDEXCEPT
305     }
306     catch (std::runtime_error & e){
307       last_evaled_argptr(contextptr)=NULL;
308       CERR << e.what() << '\n';
309     }
310 #endif
311     return res;
312   }
313 
is_inequation(const gen & g)314   bool is_inequation(const gen & g){
315     return g.is_symb_of_sommet(at_superieur_strict) || g.is_symb_of_sommet(at_superieur_egal)
316       || g.is_symb_of_sommet(at_inferieur_strict) || g.is_symb_of_sommet(at_inferieur_egal);
317   }
318 
find_singularities(const gen & e,const identificateur & x,int cplxmode,GIAC_CONTEXT)319   vecteur find_singularities(const gen & e,const identificateur & x,int cplxmode,GIAC_CONTEXT){
320     vecteur lv(lvarxpow(e,x));
321     if (cplxmode & 8){
322       lv=mergevecteur(lv,lvarxwithinv(e,x,contextptr));
323       cplxmode ^= 8;
324     }
325     vecteur res;
326     vecteur l(lvar(e));
327     gen p=e2r(e,l,contextptr),n,d;
328     vecteur pv=gen2vecteur(p);
329     const_iterateur jt=pv.begin(),jtend=pv.end();
330     for (;jt!=jtend;++jt){
331       fxnd(*jt,n,d);
332       if (d.type==_POLY){
333 	res=solve(r2e(d,l,contextptr),x,cplxmode,contextptr);
334       }
335       if (is_undef(res))
336 	return res;
337     }
338     const_iterateur it=lv.begin(),itend=lv.end();
339     for (;it!=itend;++it){
340       if (it->type!=_SYMB)
341 	continue;
342       const unary_function_ptr & u=it->_SYMBptr->sommet;
343       gen & f=it->_SYMBptr->feuille;
344       res=mergevecteur(res,find_singularities(f,x,cplxmode,contextptr));
345       if (u==at_ln || u==at_sign)
346 	res=mergevecteur(res,solve(f,x,cplxmode,contextptr));
347       if (u==at_pow && f.type==_VECT && f._VECTptr->size()==2)
348 	res=mergevecteur(res,solve(f._VECTptr->front(),x,cplxmode,contextptr));
349       if (u==at_tan)
350 	res=mergevecteur(res,solve(cos(f,contextptr),x,cplxmode,contextptr));
351       if (u==at_piecewise && f.type==_VECT){
352 	vecteur & v = *f._VECTptr;
353 	int s=int(v.size());
354 	for (int i=0;i<s-1;i+=2){
355 	  gen & e =v[i];
356 	  if (is_inequation(e)){
357 	    vecteur tmp=solve(e._SYMBptr->feuille._VECTptr->front()-e._SYMBptr->feuille._VECTptr->back(),x,cplxmode,contextptr);
358 	    // is *it continuous at tmp
359 	    gen etoileit=subst(*it,undef,identificateur("undef_"),false,contextptr);
360 	    const_iterateur jt=tmp.begin(),jtend=tmp.end();
361 	    for (;jt!=jtend;++jt){
362 	      if (!is_zero(limit(etoileit,x,*jt,1,contextptr)-limit(etoileit,x,*jt,-1,contextptr),contextptr))
363 		res.push_back(*jt);
364 	    }
365 	  }
366 	}
367       }
368     }
369     if (cplxmode)
370       return res;
371     return protect_sort(res,contextptr);
372   }
373 
protect_find_singularities(const gen & e,const identificateur & x,int cplxmode,GIAC_CONTEXT)374   vecteur protect_find_singularities(const gen & e,const identificateur & x,int cplxmode,GIAC_CONTEXT){
375     //int C=calc_mode(contextptr);
376     //calc_mode(0,contextptr);
377     vecteur sp;
378 #ifdef NO_STDEXCEPT
379     sp=find_singularities(e,x,cplxmode,contextptr);
380     if (is_undef(sp)){
381       *logptr(contextptr) << sp << '\n';
382       // sp.clear();
383     }
384 #else
385     try {
386       sp=find_singularities(e,x,cplxmode,contextptr);
387     }
388     catch (std::runtime_error & e){
389       last_evaled_argptr(contextptr)=NULL;
390       *logptr(contextptr) << e.what() << '\n';
391       sp=vecteur(1,undef);
392       // sp.clear();
393     }
394 #endif
395     //calc_mode(C,contextptr);
396     return sp;
397   }
398 
solve_ckrange(const identificateur & x,vecteur & v,int isolate_mode,GIAC_CONTEXT)399   static void solve_ckrange(const identificateur & x,vecteur & v,int isolate_mode,GIAC_CONTEXT){
400     vecteur w,excluded(find_excluded(x,contextptr));
401     // assumption on x, either range or integer
402     int fr=find_range(x,w,contextptr);
403     // optimization does not work because some tests are done after
404     // examples assume(n>0);solve(((n)^(2))*(((x)/(n))^(log10(x)))=(x)^(2),x);
405     if (0 && fr==1 && w.size()==1 && w.front().type==_VECT && w.front()._VECTptr->front()==minus_inf && w.front()._VECTptr->back()==plus_inf){
406       return;
407     }
408     if (fr>=2){
409       int s=int(v.size());
410       for (int i=0;i<s;++i){
411 	if (is_integer(v[i]))
412 	  w.push_back(v[i]);
413       }
414       v=w;
415       if (fr==2)
416 	return;
417     }
418     if (w.size()!=1 || w.front().type!=_VECT)
419       return;
420     w=*w.front()._VECTptr;
421     if (w.size()!=2)
422       return;
423     gen l(w.front()),m(w.back());
424     vecteur newv;
425     iterateur it=v.begin(),itend=v.end();
426     for (;it!=itend;++it){
427       *it=simplifier(*it,contextptr);
428       if (equalposcomp(excluded,*it))
429 	continue;
430       gen sol=*it;
431       if (l!=minus_inf && sign(l-sol,contextptr)==1)
432 	continue;
433       if (m!=plus_inf && sign(sol-m,contextptr)==1)
434 	continue;
435       sol=evalf(sol,eval_level(contextptr),contextptr);
436       if (!(isolate_mode &1) && ( (sol.type==_CPLX && !is_zero(im(sol,contextptr),contextptr))
437 				  || (sol.type!=_CPLX && has_i(sol))))
438 	continue;
439       if (sol.type!=_DOUBLE_){ // check for trig solutions
440 	newv.push_back(*it);
441 	vecteur lv(lidnt(sol));
442 	if (lv.size()!=1 || l==minus_inf || m==plus_inf)
443 	  continue;
444 	gen n(lv.front()),a,b,expr(*it);
445 	expr=pow2expln(expr,contextptr);
446 	// check linearity
447 	while (expr.type==_SYMB){
448 	  vecteur varn(lvarx(expr,n));
449 	  if (varn.size()!=1)
450 	    break;
451 	  if (!is_linear_wrt(expr,varn.front(),a,b,contextptr))
452 	    break;
453 	  expr=varn.front();
454 	  l=ratnormal((l-b)/a);
455 	  m=ratnormal((m-b)/a);
456 	  if (is_strictly_positive(-a,contextptr))
457 	    swapgen(l,m);
458 	  if (expr.is_symb_of_sommet(at_ln)){
459 	    l=exp(l,contextptr);
460 	    m=exp(m,contextptr);
461 	    expr=expr._SYMBptr->feuille;
462 	    continue;
463 	  }
464 	  if (expr.is_symb_of_sommet(at_exp)){
465 	    if (is_positive(l,contextptr)){
466 	      l=l==0?minus_inf:ln(l,contextptr);
467 	      m=m==0?minus_inf:ln(m,contextptr);
468 	    }
469 	    else
470 	      l=m=minus_inf;
471 	    expr=expr._SYMBptr->feuille;
472 	    continue;
473 	  }
474 	  break;
475 	}
476 	if (is_inf(l) || n.type!=_IDNT || n.print(contextptr).substr(0,2)!="n_" || !is_linear_wrt(expr,n,a,b,contextptr)){
477 	  *logptr(contextptr) << gettext("Warning: unable to find ") <<n << gettext(" integer solutions for ") << expr << ">=" << l << gettext(" and <=") << m << gettext(", answer may be wrong.\nIf you are computing an integral with exact boundaries, replace by approx. boundaries") << '\n';
478 	  if (v.size()!=1) v=vecteur(1,undef);
479 	  return;
480 	}
481 	newv.pop_back();
482 	a=normal(a,contextptr);
483 	b=normal(b,contextptr);
484 	if (!is_positive(a,contextptr))
485 	  swapgen(l,m);
486 	gen tmp=(l-b)/a;
487 #if defined HAVE_LIBMPFR && !defined NO_STDEXCEPT
488 	try {
489 	  if (tmp.type!=_FRAC && tmp.type!=_EXT)
490 	    tmp=accurate_evalf(tmp,1000);
491 	} catch (std::runtime_error & ) {
492 	  last_evaled_argptr(contextptr)=NULL;
493 	}
494 #endif
495 	tmp=evalf(tmp,eval_level(contextptr),contextptr);
496 	int n0(_ceil(tmp,contextptr).val);
497 	tmp=(m-b)/a;
498 #if defined HAVE_LIBMPFR && !defined NO_STDEXCEPT
499 	try {
500 	  if (tmp.type!=_FRAC && tmp.type!=_EXT)
501 	    tmp=accurate_evalf(tmp,1000);
502 	} catch (std::runtime_error & ) {
503 	  last_evaled_argptr(contextptr)=NULL;
504 	}
505 #endif
506 	tmp=evalf(tmp,eval_level(contextptr),contextptr);
507 	int n1(_floor(tmp,contextptr).val);
508 	for (;n0<=n1;++n0){
509 	  gen sol=ratnormal(subst(*it,n,n0,false,contextptr),contextptr);
510 	  if (!equalposcomp(excluded,sol))
511 	    newv.push_back(sol);
512 	}
513       }
514       else {
515 	if (is_strictly_greater(l,sol,contextptr))
516 	  continue;
517 	if (is_strictly_greater(sol,m,contextptr))
518 	  continue;
519 	newv.push_back(*it);
520       }
521     }
522     v=newv;
523   }
524 
525   // Helper for the solver, make a translation using x^(n-1) coeff
526   // and find gcd of deg, return true if non-trivial gcd found
translate_gcddeg(const vecteur & v,vecteur & v_translated,gen & x_translation,int & gcddeg)527   static bool translate_gcddeg(const vecteur & v,vecteur & v_translated, gen & x_translation,int & gcddeg){
528     int s=int(v.size());
529     if (s<4)
530       return false;
531     x_translation=-v[1]/((s-1)*v[0]);
532     v_translated=taylor(v,x_translation,0);
533     gcddeg=0;
534     for (int i=1;i<s;++i){
535       if (!is_zero(v_translated[i]))
536 	gcddeg=gcd(gcddeg,i);
537     }
538     if (gcddeg<=1)
539       return false;
540     int newdeg=(s-1)/gcddeg+1;
541     // compress v_translated, keep only terms with index multiple of gcddeg
542     for (int i=1;i<newdeg;++i){
543       v_translated[i]=v_translated[i*gcddeg];
544     }
545     v_translated=vecteur(v_translated.begin(),v_translated.begin()+newdeg);
546     return true;
547   }
548 
549   static vecteur solve_inequation(const gen & e0,const identificateur & x,int direction,GIAC_CONTEXT);
550 
solve_piecewise(const gen & args_,const gen & value,const identificateur & x,int isolate_mode,GIAC_CONTEXT)551   static vecteur solve_piecewise(const gen & args_,const gen & value,const identificateur & x,int isolate_mode,GIAC_CONTEXT){
552     gen args=_exp2pow(args_,contextptr);
553     if (is_undef(args))
554       args=args_;
555     if (args.type!=_VECT)
556       return vecteur(1,gensizeerr(contextptr));
557     vecteur & piece_args=*args._VECTptr;
558     vecteur failtest; // all these tests must fail to keep solution
559     gen successtest,equation; // this test must succeed
560     int s=int(piece_args.size());
561     vecteur res;
562     for (int i=0;i<s;i+=2){
563       if (i)
564 	failtest.push_back(successtest);
565       if (i+1==s){
566 	successtest=1;
567 	equation=piece_args[i];
568       }
569       else {
570 	successtest=piece_args[i];
571 	equation=piece_args[i+1];
572       }
573       int fails=int(failtest.size());
574       vecteur sol=solve(equation-value,x,isolate_mode,contextptr);
575       // now test whether solutions in sol are acceptable
576       const_iterateur it=sol.begin(),itend=sol.end();
577       for (;it!=itend;++it){
578 	const gen & g=*it;
579 	if (g==x){
580 	  if (fails){
581 	    gen tmp=symb_not(symbolic(at_ou,gen(failtest,_SEQ__VECT)));
582 	    res.push_back(is_one(successtest)?tmp:symb_and(tmp,successtest));
583 	  }
584 	  else
585 	    res.push_back(is_one(successtest)?g:successtest);
586 	  continue;
587 	}
588 	if (!is_zero(derive(g,x,contextptr),contextptr)){
589 	  if (fails){
590 	    gen tmp=symb_not(symbolic(at_ou,gen(failtest,_SEQ__VECT)));
591 	    tmp=is_one(successtest)?tmp:symb_and(tmp,successtest);
592 	    res.push_back(symb_and(tmp,g));
593 	  }
594 	  else
595 	    res.push_back(is_one(successtest)?g:symb_and(successtest,g));
596 	  continue;
597 	}
598 	int j;
599 	for (j=0;j<fails;++j){
600 	  if (is_one(subst(failtest[j],x,g,false,contextptr)))
601 	    break;
602 	}
603 	if (j==fails && is_one(subst(successtest,x,g,false,contextptr)))
604 	  res.push_back(g);
605       }
606     }
607     return res;
608   }
609 
610   // inner solver
in_solve(const gen & e,const identificateur & x,vecteur & v,int isolate_mode,GIAC_CONTEXT)611   void in_solve(const gen & e,const identificateur & x,vecteur &v,int isolate_mode,GIAC_CONTEXT){
612     if (has_op(e,*at_equal) || has_op(e,*at_equal2)){
613       v=vecteur(1,gensizeerr(gettext("Bad equal in")+e.print(contextptr)));
614       return;
615     }
616     bool complexmode=isolate_mode & 1;
617     vecteur lv(lvarx(e,x));
618     int s=int(lv.size());
619     if (!s)
620       return;
621     if (s>1){
622       if (s==2 && lv[1]==x)
623 	swapgen(lv[0],lv[1]);
624       gen m1(-exp(-1,contextptr));
625       if (s==2 && lv[0]==x && (isolate_mode & 1)==0){
626 	gen a,b,newe(e);
627 	if (0 && lv[1].is_symb_of_sommet(at_pow)){ // not reached, not tested
628 	  gen f=lv[1]._SYMBptr->feuille;
629 	  if (f.type==_VECT && f._VECTptr->size()==2){
630 	    f=symb_exp(f._VECTptr->back()*ln(f._VECTptr->front(),contextptr));
631 	    newe=subst(e,lv[1],f,false,contextptr);
632 	    lv[1]=f;
633 	  }
634 	}
635 	if (lv[1].is_symb_of_sommet(at_ln) && is_linear_wrt(lv[1]._SYMBptr->feuille,x,a,b,contextptr) && a!=0){
636 	  // ln(ax+b)=t -> x=(exp(t)-b)/a, solve in t
637 	  gen newx=(symb_exp(x)-b)/a;
638 	  newe=subst(e,lv,makevecteur(newx,x),false,contextptr);
639 	  vecteur newv;
640 	  in_solve(newe,x,newv,isolate_mode,contextptr);
641 	  const_iterateur it=newv.begin(),itend=newv.end();
642 	  for (;it!=itend;++it){
643 	    v.push_back((exp(*it,contextptr)-b)/a);
644 	  }
645 	  return;
646 	}
647 	if (lv[1].is_symb_of_sommet(at_exp) && is_linear_wrt(lv[1]._SYMBptr->feuille,x,a,b,contextptr) && a!=0){
648 	  gen A,B,C,D,E,F;
649 	  if (is_linear_wrt(e,lv[1],A,B,contextptr) && A!=0 && is_linear_wrt(B,x,C,D,contextptr) && is_linear_wrt(A,x,E,F,contextptr)){
650 	    if (E==0){
651 	      // A*exp(a*x+b)+C*x+D=0, t=a*x+b
652 	      // A*exp(t)+C*(t-b)/a+D=0 -> A*exp(t)+C/a*t+D-C*b/a=0
653 	      gen a_(A),b_(C/a),c_(D-C*b/a);
654 	      gen delta=a_/b_*exp(-c_/b_,contextptr);
655 	      if (is_strictly_greater(m1,delta,contextptr))
656 		return; // no solution
657 	      gen sol=-_LambertW(delta,contextptr)-c_/b_;
658 	      v.push_back((sol-b)/a);
659 	      if (is_positive(delta,contextptr)|| delta==m1)
660 		return;
661 	      sol=-_LambertW(makesequence(delta,-1),contextptr)-c_/b_;
662 	      v.push_back((sol-b)/a);
663 	      return;
664 	    }
665 	    if (C==0){
666 	      // (E*x+F)*exp(a*x+b)+D==0
667 	      // write a*x+b=a/E*(E*x+F)+b-a*F/E
668 	      // a/E*(E*x+F)*exp(a/E*(E*x+F))=-D*a/E*exp(a*F/E-b)
669 	      gen delta=-D*a/E*exp(a*F/E-b,contextptr);
670 	      if (is_greater(m1,delta,contextptr))
671 		return; // no solution
672 	      gen sol=(_LambertW(delta,contextptr)-F/E)/a;
673 	      v.push_back((sol-b)/a);
674 	      if (is_positive(delta,contextptr)|| delta==m1)
675 		return;
676 	      sol=(_LambertW(makesequence(delta,-1),contextptr)-F/E)/a;
677 	      v.push_back((sol-b)/a);
678 	      return;
679 	    }
680 	  }
681 	  // lv[1]=exp(a*x+b), set exp(ax+b)=t/(ax+b),
682 	  // if equation does not depend on x, solve in t, then x=(W(t)-b)/a
683 	  gen t(identificateur(" t"));
684 	  gen rep=subst(newe,lv[1],t/lv[1]._SYMBptr->feuille,false,contextptr),xfact(1),tfact(1);
685 	  rep=_factors(rep,contextptr);
686 	  if (separate_variables(rep,x,t,xfact,tfact,0,contextptr)){
687 	    vecteur vt;
688 	    in_solve(tfact,*t._IDNTptr,vt,isolate_mode,contextptr);
689 	    const_iterateur it=vt.begin(),itend=vt.end();
690 	    for (;it!=itend;++it){
691 	      if (is_greater(m1,*it,contextptr))
692 		continue;
693 	      v.push_back((_LambertW(*it,contextptr)-b)/a);
694 	      if (is_strictly_positive(-*it,contextptr))
695 		v.push_back((_LambertW(makesequence(*it,-1),contextptr)-b)/a);
696 	    }
697 	    return;
698 	  }
699 	  // try with exp(ax+b)=-(ax+b)/t
700 	  rep=subst(e,lv[1],-lv[1]._SYMBptr->feuille/t,false,contextptr);
701 	  xfact=1;tfact=1;
702 	  rep=_factors(rep,contextptr);
703 	  if (separate_variables(rep,x,t,xfact,tfact,0,contextptr)){
704 	    vecteur vt;
705 	    in_solve(tfact,*t._IDNTptr,vt,isolate_mode,contextptr);
706 	    const_iterateur it=vt.begin(),itend=vt.end();
707 	    for (;it!=itend;++it){
708 	      if (is_greater(m1,*it,contextptr))
709 		continue;
710 	      v.push_back((b-_LambertW(*it,contextptr))/a);
711 	      if (is_strictly_positive(-*it,contextptr))
712 		v.push_back((b-_LambertW(makesequence(*it,-1),contextptr))/a);
713 	    }
714 	    return;
715 	  }
716 	}
717       }
718       for (int i=0;i<s;++i){
719 	gen xvar=lv[i];
720 	if (xvar._SYMBptr->sommet==at_sign){
721 	  gen new_e=subst(e,xvar,1,false,contextptr);
722 	  vecteur vplus;
723 	  in_solve(new_e,x,vplus,isolate_mode,contextptr);
724 	  const_iterateur it=vplus.begin(),itend=vplus.end();
725 	  for (;it!=itend;++it){
726 	    if (is_one(subst(xvar,x,*it,false,contextptr)))
727 	      v.push_back(*it);
728 	  }
729 	  new_e=subst(e,xvar,-1,false,contextptr);
730 	  vecteur vminus;
731 	  in_solve(new_e,x,vminus,isolate_mode,contextptr);
732 	  it=vminus.begin();
733 	  itend=vminus.end();
734 	  for (;it!=itend;++it){
735 	    if (is_one(-subst(xvar,x,*it,false,contextptr)))
736 	      v.push_back(*it);
737 	  }
738 	  return;
739 	}
740       }
741       if (lidnt(e)==vecteur(1,x)){
742 	// if the equation does not depend on parameters
743 	// and the variable is assumed to live in a finite interval
744 	// try bisection solver
745 	vecteur a;
746 	gen a0,a1;
747 	if (find_range(x,a,contextptr)==1 && a.size()==1){
748 	  gen A=a.front();
749 	  if (A.type==_VECT && A._VECTptr->size()==2 && (a0=A._VECTptr->front())!=minus_inf && (a1=A._VECTptr->back())!=plus_inf){
750 	    int iszero=-1;
751 	    a=bisection_solver(e,x,a0,a1,iszero,contextptr);
752 	    if (iszero==1 || iszero==0){
753 	      *logptr(contextptr) << gettext("Unable to isolate ")+string(x.print(contextptr))+" in "+e.print(contextptr) << gettext(", switching to approx. solutions") << '\n';
754 	      v=mergevecteur(v,a);
755 	      return;
756 	    }
757 	  }
758 	}
759       }
760 #if 1
761       string msg=gettext("Unable to isolate ")+string(x.print(contextptr))+" in "+e.print(contextptr);
762       if (calc_mode(contextptr)==1){ // for solve(ln(exp(x)+1)=x)
763 	v.push_back(undef); // (string2gen(msg,false));
764 	return;
765       }
766       *logptr(contextptr) << msg+gettext(", switching to approx. solutions") << '\n';
767       gen a=_fsolve(makesequence(e,x),contextptr);
768       if (a.type==_VECT)
769 	v=mergevecteur(v,*a._VECTptr);
770       else
771 	if (!is_undef(a) && !a.is_symb_of_sommet(at_fsolve)) v.push_back(a);
772       return;
773 #else
774 #ifndef NO_STDEXCEPT
775       throw(std::runtime_error("Unable to isolate "+string(x.print(contextptr))+" in "+e.print(contextptr)));
776 #endif
777       v=vecteur(1,undeferr(gettext("Unable to isolate ")+string(x.print(contextptr))+" in "+e.print(contextptr)));
778       return;
779 #endif
780     }
781     gen xvar(lv.front());
782     if (xvar!=x){ // xvar must be a unary function of x, except for a few special cases
783       if (xvar.type!=_SYMB){
784 	v=vecteur(1,gentypeerr(contextptr));
785 	return;
786       }
787       if (xvar._SYMBptr->sommet!=at_piecewise && xvar._SYMBptr->feuille.type==_VECT){
788 	if ((xvar._SYMBptr->sommet==at_NTHROOT && xvar._SYMBptr->feuille.type==_VECT && xvar._SYMBptr->feuille._VECTptr->size()==2 && is_integer(xvar._SYMBptr->feuille._VECTptr->front())))
789 	  ;
790 	else {
791 #ifndef NO_STDEXCEPT
792 	  throw(std::runtime_error("Unable to isolate "+string(x.print(contextptr))+" in "+xvar.print(contextptr)));
793 #endif
794 	  v=vecteur(1,undeferr(gettext("Unable to isolate ")+string(x.print(contextptr))+" in "+xvar.print(contextptr)));
795 	  return;
796 	}
797       }
798       if (xvar._SYMBptr->sommet==at_sign){
799 	gen new_e=subst(e,xvar,1,false,contextptr);
800 	if (is_zero(new_e,contextptr)){
801 	  v=solve_inequation(symbolic(at_superieur_strict,makesequence(xvar._SYMBptr->feuille,0)),x,1,contextptr);
802 	}
803 	else {
804 	  new_e=subst(e,xvar,-1,false,contextptr);
805 	  if (is_zero(new_e,contextptr)){
806 	    v=solve_inequation(symbolic(at_inferieur_strict,makesequence(xvar._SYMBptr->feuille,0)),x,-1,contextptr);
807 	  }
808 	}
809 	return;
810       }
811       int pos=equalposcomp(solve_fcns_tab,xvar._SYMBptr->sommet);
812       if (xvar._SYMBptr->sommet==at_piecewise)
813 	pos=-1;
814       if (xvar._SYMBptr->sommet==at_NTHROOT)
815 	pos=-2;
816       if (!pos){
817 #ifndef NO_STDEXCEPT
818 	throw(std::runtime_error(string(gettext("Unable to isolate function "))+xvar._SYMBptr->sommet.ptr()->print(contextptr)));
819 #endif
820 	v=vecteur(1,undeferr(string(gettext("Unable to isolate function "))+xvar._SYMBptr->sommet.ptr()->print(contextptr)));
821 	return;
822       }
823       // solve with respect to xvar
824       identificateur localt(" t");
825       // ck_parameter_t();
826       gen new_e=subst(e,xvar,localt,false,contextptr);
827       vecteur new_v=solve(new_e,localt,isolate_mode,contextptr);
828       const_iterateur it=new_v.begin(),itend=new_v.end();
829       for (;it!=itend;++it){
830 	if (pos==-2){
831 	  set_merge(v,vecteur(1,pow(*it,xvar._SYMBptr->feuille[0],contextptr)));
832 	  continue;
833 	}
834 	if (pos==-1){
835 	  // solve piecewise()==*it
836 	  set_merge(v,solve_piecewise(xvar._SYMBptr->feuille,*it,x,isolate_mode,contextptr));
837 	  if (is_undef(v)) return;
838 	  continue;
839 	}
840 	if ( (isolate_mode & 1)==0 && (pos==3 || pos==4) && is_strictly_greater(*it**it,1,contextptr)){
841 	  continue;
842 	}
843 	gen res=isolate_fcns[pos-1](*it,isolate_mode,contextptr);
844 	if (res.type!=_VECT)
845 	  set_merge(v,solve(xvar._SYMBptr->feuille-res,x,isolate_mode,contextptr));
846 	else {
847 	  const_iterateur it=res._VECTptr->begin(),itend=res._VECTptr->end();
848 	  for (;it!=itend;++it)
849 	    set_merge(v,solve(xvar._SYMBptr->feuille-*it,x,isolate_mode,contextptr));
850 	}
851       }
852       solve_ckrange(x,v,isolate_mode,contextptr);
853       return;
854     } // end xvar!=x
855     // rewrite e as a univariate polynomial, first add other vars to x
856     vecteur newv;
857     lv=vecteur(1,vecteur(1,x));
858     alg_lvar(e,lv);
859     vecteur lvrat(1,x);
860     lvar(e,lvrat);
861     if (lvrat==lv.front())
862       lv=lvrat;
863     vecteur lv_(lv);
864     // int lv_size=lv.size();
865     gen num,den,f;
866     f=e2r(e,lv,contextptr);
867     fxnd(f,num,den);
868     if (num.type!=_POLY || num._POLYptr->dim==0)
869       return;
870     vecteur w=polynome2poly1(*num._POLYptr,1);
871     if (lv.front().type==_VECT){
872       lv.front()=vecteur(lv.front()._VECTptr->begin()+1,lv.front()._VECTptr->end());
873       if (lv.front()._VECTptr->empty())
874 	lv.erase(lv.begin()); // remove x from lv (CDR_VECT)
875     }
876     else
877       lv.erase(lv.begin()); // remove x from lv (CDR_VECT)
878     int deg;
879     vecteur w_translated;
880     gen delta_x;
881     if (translate_gcddeg(w,w_translated,delta_x,deg)){
882       // composite polynomials
883       gen invdeg=inv(deg,contextptr);
884       identificateur compositex("tmp_x_solve_composite_");
885       gen newe=symb_horner(*r2sym(w_translated,lv,contextptr)._VECTptr,compositex);
886       delta_x=r2sym(delta_x,lv,contextptr);
887       vecteur vtmp;
888       in_solve(newe,compositex,vtmp,isolate_mode,contextptr);
889       vecteur unitroot(1,plus_one),munitroot;
890       if (complexmode){
891 	for (int k=1;k<deg;++k)
892 	  unitroot.push_back(exp(2*k*cst_pi/deg*cst_i,contextptr));
893 	for (int k=0;k<deg;++k)
894 	  munitroot.push_back(exp((1+2*k)*cst_pi/deg*cst_i,contextptr));
895       }
896       const_iterateur it=vtmp.begin(),itend=vtmp.end();
897       for (;it!=itend;++it){
898 	bool negatif=is_strictly_positive(-*it,contextptr);
899 	gen tmp;
900 	if (deg==2)
901 	  tmp=sqrt((negatif?-*it:*it),contextptr);
902 	else
903 	  tmp=pow((negatif?-*it:*it),invdeg,contextptr);
904 	if (complexmode){
905 	  const_iterateur jt,jtend;
906 	  if (!negatif){
907 	    jt=unitroot.begin();
908 	    jtend=unitroot.end();
909 	  }
910 	  else {
911 	    jt=munitroot.begin();
912 	    jtend=munitroot.end();
913 	  }
914 	  for (;jt!=jtend;++jt)
915 	    newv.push_back(delta_x + (*jt) * tmp);
916 	}
917 	else {
918 	  if (deg%2)
919 	    newv.push_back(delta_x + (negatif?-tmp:tmp));
920 	  else {
921 	    if (!negatif){
922 	      newv.push_back(delta_x + tmp);
923 	      newv.push_back(delta_x - tmp);
924 	    }
925 	  }
926 	}
927       }
928       solve_ckrange(x,newv,isolate_mode,contextptr);
929       v=mergevecteur(v,newv);
930       return;
931     }
932     // if degree(w)=0, 1 or 2 solve it, otherwise error (should return ext)
933     int d=int(w.size())-1;
934     if (!d)
935       return;
936     if (d==1){
937       gen tmp=rdiv(-r2sym(w.back(),lv,contextptr),r2sym(w.front(),lv,contextptr),contextptr);
938       if (!complexmode && has_i(tmp))
939 	return;
940       newv.push_back(tmp);
941       solve_ckrange(x,newv,isolate_mode,contextptr);
942       v=mergevecteur(v,newv);
943       return;
944     }
945     if (d>2){
946       if (has_num_coeff(w)){
947 	if (complexmode)
948 	  newv=proot(w,epsilon(contextptr));
949 	else
950 	  newv=real_proot(w,epsilon(contextptr),contextptr);
951 	solve_ckrange(x,newv,isolate_mode,contextptr);
952 	v=mergevecteur(v,newv);
953 	return;
954       }
955       int n=is_cyclotomic(w,epsilon(contextptr));
956       if (!n){
957 	if (calc_mode(contextptr)!=1 && abs_calc_mode(contextptr)!=38 && d==3 && lv_.size()==1){
958 	  gen W=r2sym(num,lv_,contextptr);
959 #if 1
960 	  // ALT: alpha*x^3+beta*x^2+gamma*x+delta
961 	  /*
962 	    A:=beta/alpha;
963 	    B:=gamma/alpha;
964 	    C:=delta/alpha;
965 	    P:=x^3+A*x^2+B*x+C;
966 	    // Check if discriminant is a square
967 	    d:=4*A^3*C-A^2*B^2-18*A*B*C+4*B^3+27*C^2;
968 	    // = (27*alpha^2*delta^2-18*alpha*beta*delta*gamma+4*alpha*gamma^3+4*beta^3*delta-beta^2*gamma^2)/alpha^4
969 	    // if discriminant is positive and not a square, the real root is > the conjugates real part if (27*alpha^2*delta-9*alpha*beta*gamma+2*beta^3)/(27*alpha^3) <0
970             Q:=poly1[alpha^4,0,6*alpha^3*gamma-2*alpha^2*beta^2,0,9*alpha^2*gamma^2-6*alpha*beta^2*gamma+beta^4,0,27*alpha^2*delta^2-18*alpha*beta*delta*gamma+4*alpha*gamma^3+4*beta^3*delta-beta^2*gamma^2];
971 	    ro:=rootof([1,0],Q);
972 	    D:=27*alpha^2*delta-9*alpha*beta*gamma+2*beta^3;
973 	    P1:=[-3*alpha^4,0,-15*alpha^3*gamma+5*alpha^2*beta^2,0,-9*alpha^2*beta*delta-12*alpha^2*gamma^2+11*alpha*beta^2*gamma-2*beta^4];
974 	    R1:=rootof([P1,Q])/alpha/D;
975 	    P2:=[3*alpha^3,0,15*alpha^2*gamma-5*alpha*beta^2,27*alpha^2*delta-9*alpha*beta*gamma+2*beta^3,-18*alpha*beta*delta+12*alpha*gamma^2-2*beta^2*gamma];
976 	    R2:=rootof(P2,Q)/2/D;
977 	    P3:=[3*alpha^3,0,15*alpha^2*gamma-5*alpha*beta^2,-27*alpha^2*delta+9*alpha*beta*gamma-2*beta^3,-18*alpha*beta*delta+12*alpha*gamma^2-2*beta^2*gamma];
978 	    R3:=rootof(P3,Q)/2/D;
979 	    normal(subst(P,x,R1)); // ->0
980 	    normal(subst(P,x,R2)); // ->0
981 	    normal(subst(P,x,R3)); // ->0
982 	    normal(R1+R2+R3); // ok
983 	    normal(R1*R2+R2*R3+R3*R1); // ok
984 	    normal(R1*R2*R3); // ok
985 	  */
986 	  gen alpha=w[0],beta=w[1],gamma=w[2],delta=w[3];
987 	  gen alpha2=alpha*alpha,alpha3=alpha2*alpha,alpha4=alpha3*alpha,beta2=beta*beta,beta3=beta2*beta,beta4=beta3*beta,delta2=delta*delta,gamma2=gamma*gamma,gamma3=gamma2*gamma;
988 	  gen discriminant=(27*alpha2*delta2-18*alpha*beta*delta*gamma+4*alpha*gamma3+4*beta3*delta-beta2*gamma2);
989 	  gen test1=x*x-r2sym(discriminant,lv,contextptr);
990 	  bool b=withsqrt(contextptr);
991 	  withsqrt(false,contextptr);
992 	  bool bc=complex_mode(contextptr);
993 	  complex_mode(false,contextptr);
994 	  test1=_factors(test1,contextptr);
995 	  if (test1.type==_VECT && test1._VECTptr->size()==4){
996 	    // discriminant is a perfect square
997 	    gen ROOTOF=rootof(gen(makevecteur(
998 					  makevecteur(1,0),
999 					  _symb2poly(gen(makevecteur(W,x),_SEQ__VECT),contextptr)
1000 					  ),_SEQ__VECT),contextptr);
1001 	    gen F=_factor(gen(makevecteur(W,ROOTOF),_SEQ__VECT),contextptr);
1002 	    newv=solve(F,x,isolate_mode,contextptr);
1003 	  }
1004 	  else {
1005 	    vecteur Q=makevecteur(alpha4,0,6*alpha3*gamma-2*alpha2*beta2,0,9*alpha2*gamma2-6*alpha*beta2*gamma+beta4,0,27*alpha2*delta2-18*alpha*beta*delta*gamma+4*alpha*gamma3+4*beta3*delta-beta2*gamma2);
1006 	    gen tmp=lgcd(Q);
1007 	    divvecteur(Q,tmp,Q);
1008 	    gen q=r2sym(Q,lv,contextptr),q0;
1009 	    if (q.type==_VECT && !q._VECTptr->empty()){
1010 	      q0=q._VECTptr->front();
1011 	      if (!is_one(q0) && is_one(q0*q0*q0*q0)){
1012 		q=q/q0;
1013 		q0=1;
1014 	      }
1015 	    }
1016 	    if (q.type==_VECT && !q._VECTptr->empty() && !is_one(q._VECTptr->front())){
1017 	      // make change of variable so that Q becomes monic and solve again
1018 	      gen e1=subst(e,x,x/q0,false,contextptr);
1019 	      vecteur newv;
1020 	      int is=isolate_mode;
1021 	      isolate_mode |= 16;
1022 	      in_solve(e1,x,newv,isolate_mode,contextptr);
1023 	      isolate_mode = is;
1024 	      multvecteur(inv(q0,contextptr),newv,newv);
1025 	      solve_ckrange(x,newv,isolate_mode,contextptr);
1026 	      v=mergevecteur(v,newv);
1027 	      return;
1028 	    }
1029 	    gen D=r2sym(27*alpha2*delta-9*alpha*beta*gamma+2*beta3,lv,contextptr);
1030 	    vecteur P1=makevecteur(-3*alpha4,0,-15*alpha3*gamma+5*alpha2*beta2,0,-9*alpha2*beta*delta-12*alpha2*gamma2+11*alpha*beta2*gamma-2*beta4);
1031 	    gen R1=rootof(makevecteur(r2sym(P1,lv,contextptr),q),contextptr)/r2sym(alpha,lv,contextptr)/D;
1032 	    vecteur P2=makevecteur(3*alpha3,0,15*alpha2*gamma-5*alpha*beta2,27*alpha2*delta-9*alpha*beta*gamma+2*beta3,-18*alpha*beta*delta+12*alpha*gamma2-2*beta2*gamma);
1033 	    gen R2=rootof(makevecteur(r2sym(P2,lv,contextptr),q),contextptr)/2/D;
1034 	    vecteur P3=makevecteur(3*alpha3,0,15*alpha2*gamma-5*alpha*beta2,-27*alpha2*delta+9*alpha*beta*gamma-2*beta3,-18*alpha*beta*delta+12*alpha*gamma2-2*beta2*gamma);
1035 	    gen R3=rootof(makevecteur(r2sym(P3,lv,contextptr),q),contextptr)/2/D;
1036 	    newv=makevecteur(R1,R2,R3);
1037 	  }
1038 	  // End ALT
1039 #else
1040 	  // w is of order 3,
1041 	  // find the 3 roots in term of an extension of order 6
1042 	  // let r1,r2,r3 be the 3 roots, the extension min poly
1043 	  // will have rj-rk j=1..3, k!=j has roots
1044 	  // Let x=rj-rk, y=rk then w(x+y)=w(y)=0
1045 	  // therefore resultant((w(x+y)-w(y))/x,w(y),y)=0
1046 	  // and it has the right degree
1047 	  // FIXME check complex_mode if there is only 1 real root!
1048 	  gen Y(identificateur(" solve_y"));
1049 	  gen WY=subst(W,x,Y,false,contextptr);
1050 	  gen WXY=subst(W,x,x+Y,false,contextptr);
1051 	  gen R=_resultant(gen(makevecteur((WXY-WY)/x,WY,Y),_SEQ__VECT),contextptr);
1052 	  gen ROOTOF=rootof(gen(makevecteur(
1053 					    makevecteur(1,0),
1054 					    _symb2poly(gen(makevecteur(R,x),_SEQ__VECT),contextptr)
1055 					    ),_SEQ__VECT),contextptr);
1056 	  gen F=_factor(gen(makevecteur(W,ROOTOF),_SEQ__VECT),contextptr);
1057 	  newv=solve(F,x,isolate_mode,contextptr);
1058 #endif
1059 	  withsqrt(b,contextptr);
1060 	  complex_mode(bc,contextptr);
1061 	  if ((isolate_mode & 16)==0)
1062 	    solve_ckrange(x,newv,isolate_mode,contextptr);
1063 	  v=mergevecteur(v,newv);
1064 	  return ;
1065 	}
1066 	if (debug_infolevel) // abs_calc_mode(contextptr)!=38)
1067 	  *logptr(contextptr) << gettext("Warning! Algebraic extension not implemented yet for poly ") << r2sym(w,lv,contextptr) << '\n';
1068 	gen w_orig;
1069 	w=*evalf((w_orig=r2sym(w,lv,contextptr)),1,contextptr)._VECTptr;
1070 	if (has_num_coeff(w)){ // FIXME: test is always true...
1071 #ifndef NO_STDEXCEPT
1072 	  try {
1073 #endif
1074 	    if (complexmode)
1075 	      newv=proot(w,epsilon(contextptr));
1076 	    else {
1077 	      if (lvar(w_orig).empty() && !has_num_coeff(w_orig))
1078 		newv=gen2vecteur(_realroot(gen(makevecteur(w_orig,epsilon(contextptr),at_evalf),_SEQ__VECT),contextptr));
1079 	      else
1080 		newv=real_proot(w,epsilon(contextptr),contextptr);
1081 	    }
1082 	    solve_ckrange(x,newv,isolate_mode,contextptr);
1083 	    v=mergevecteur(v,newv);
1084 #ifndef NO_STDEXCEPT
1085 	  }
1086 	  catch (std::runtime_error & ){
1087 	    last_evaled_argptr(contextptr)=NULL;
1088 	  }
1089 #endif
1090 	  return;
1091 	}
1092 	return;
1093       }
1094       if (complexmode){
1095 	for (int j=1;j<=n/2;++j){
1096 	  if (gcd(j,n)==1){
1097 	    if (n%2){
1098 	      newv.push_back(exp(rdiv(gen(2*j)*cst_pi*cst_i,n,contextptr),contextptr));
1099 	      newv.push_back(exp(rdiv(gen(-2*j)*cst_pi*cst_i,n,contextptr),contextptr));
1100 	    }
1101 	    else {
1102 	      newv.push_back(exp(rdiv(gen(j)*cst_pi*cst_i,n/2,contextptr),contextptr));
1103 	      newv.push_back(exp(rdiv(gen(-j)*cst_pi*cst_i,n/2,contextptr),contextptr));
1104 	    }
1105 	  }
1106 	}
1107       }
1108       solve_ckrange(x,newv,isolate_mode,contextptr);
1109       v=mergevecteur(v,newv);
1110       return ;
1111     }
1112     gen b_over_2=rdiv(w[1],plus_two,contextptr);
1113     if (b_over_2.type!=_FRAC){
1114       gen a=r2sym(w.front(),lv,contextptr);
1115       gen minus_b_over_2=r2sym(-b_over_2,lv,contextptr);
1116       gen delta_prime=r2sym(pow(b_over_2,2,contextptr)-w.front()*w.back(),lv,contextptr);
1117 #if 1 // def NO_STDEXCEPT
1118       if (!complexmode && (lidnt(evalf(makevecteur(a,minus_b_over_2,delta_prime),1,contextptr)).empty() || lvar(delta_prime).size()==1)&& is_positive(-delta_prime,contextptr))
1119 	return;
1120 #else
1121       if (!complexmode && is_positive(-delta_prime,contextptr))
1122 	return;
1123 #endif
1124       if (fastsign(delta_prime,contextptr)<0)
1125 	delta_prime=cst_i*sqrt(-delta_prime,contextptr);
1126       else
1127 	delta_prime=sqrt(delta_prime,contextptr);
1128       delta_prime=normalize_sqrt(delta_prime,contextptr,false); // no abs in sqrt
1129       newv.push_back(rdiv(minus_b_over_2+delta_prime,a,contextptr));
1130       if (!is_zero(delta_prime,contextptr))
1131 	newv.push_back(rdiv(minus_b_over_2-delta_prime,a,contextptr));
1132     }
1133     else {
1134       gen two_a=r2sym(plus_two*w.front(),lv,contextptr);
1135       gen minus_b=r2sym(-w[1],lv,contextptr);
1136       gen delta=r2sym(w[1]*w[1]-gen(4)*w.front()*w.back(),lv,contextptr);
1137 #if 1 // def NO_STDEXCEPT
1138       if (!complexmode && (lidnt(evalf(makevecteur(two_a,minus_b,delta),1,contextptr)).empty() || lvar(delta).size()==1) && is_positive(-delta,contextptr))
1139 	return;
1140 #else
1141       if (!complexmode && is_positive(-delta,contextptr))
1142 	return;
1143 #endif
1144       if (complexmode && (lidnt(evalf(makevecteur(two_a,minus_b,delta),1,contextptr)).empty() || lvar(delta).size()==1) && is_positive(-delta,contextptr))
1145 	delta=cst_i*normalize_sqrt(sqrt(-delta,contextptr),contextptr);
1146       else
1147 	delta=normalize_sqrt(sqrt(delta,contextptr),contextptr);
1148       newv.push_back(rdiv(minus_b+delta,two_a,contextptr));
1149       newv.push_back(rdiv(minus_b-delta,two_a,contextptr));
1150     }
1151     solve_ckrange(x,newv,isolate_mode,contextptr);
1152     v=mergevecteur(v,newv);
1153   }
1154 
1155   // v assumed to represent an irreducible dense 1-d poly
solve(const vecteur & v,bool complexmode,GIAC_CONTEXT)1156   vecteur solve(const vecteur & v,bool complexmode,GIAC_CONTEXT){
1157     vecteur res;
1158     int d=int(v.size())-1;
1159     if (d<1)
1160       return res;
1161     if (d==1){
1162       res.push_back(rdiv(-v.back(),v.front(),contextptr));
1163       return res;
1164     }
1165     if (!is_one(v.front())){
1166       // if v is not monic, set Y=a*X
1167       gen a(v.front()),puissance(plus_one);
1168       vecteur w;
1169       w.reserve(d+1);
1170       for (int i=0;i<=d;++i,puissance=puissance*a)
1171 	w.push_back(v[i]*puissance);
1172       return divvecteur(solve(divvecteur(w,a),complex_mode(contextptr),contextptr),a);
1173     }
1174     // should call sym2rxroot for extensions of extensions
1175     vecteur tmp(2,zero);
1176     tmp.front()=plus_one;
1177     if (d==2){
1178       gen b(v[1]),c(v[2]);
1179       gen bprime(rdiv(b,plus_two,contextptr));
1180       if (!has_denominator(bprime)){
1181 	gen delta(bprime*bprime-c);
1182 	if (!complexmode && is_positive(-delta,contextptr))
1183 	  return res;
1184 	vecteur w(3,zero);
1185 	w.front()=plus_one;
1186 	w.back()=-delta;
1187 	tmp.back()=-bprime;
1188 	res.push_back(algebraic_EXTension(tmp,w));
1189 	tmp.front()=minus_one;
1190 	tmp.back()=-bprime;
1191 	res.push_back(algebraic_EXTension(tmp,w));
1192       }
1193       else {
1194 	if (!complexmode && is_positive(4*c-b*b,contextptr))
1195 	  return res;
1196 	tmp.back()=zero;
1197 	res.push_back(algebraic_EXTension(tmp,v));
1198 	tmp.front()=minus_one;
1199 	tmp.back()=-b;
1200 	res.push_back(algebraic_EXTension(tmp,v));
1201       }
1202       return res;
1203     }
1204     // should return a list of d algebraic extension with order number
1205     res.push_back(algebraic_EXTension(tmp,v));
1206     return res;
1207   }
1208 
in_solve_inequation(const gen & e0,const gen & e,const identificateur & x,int direction,const gen & rangeg,const vecteur & veq_excluded,const vecteur & veq_not_singu,const vecteur & excluded_not_singu,const vecteur & singu,GIAC_CONTEXT)1209   static vecteur in_solve_inequation(const gen & e0,const gen &e,const identificateur & x,int direction,const gen & rangeg,const vecteur & veq_excluded,const vecteur & veq_not_singu,const vecteur & excluded_not_singu,const vecteur & singu,GIAC_CONTEXT){
1210     if (rangeg.type!=_VECT)
1211       return vecteur(0);
1212     vecteur rangev = *rangeg._VECTptr,range=rangev;
1213     if (rangev.size()==2){
1214       gen &a=rangev.front();
1215       gen & b=rangev.back();
1216       // keep only values inside a,b
1217       range=vecteur(1,a);
1218       const_iterateur it=veq_excluded.begin(),itend=veq_excluded.end();
1219       for (;it!=itend;++it){
1220 	if (is_strictly_greater(*it,a,contextptr))
1221 	  break;
1222       }
1223       for (;it!=itend;++it){
1224 	if (is_greater(*it,b,contextptr))
1225 	  break;
1226 	range.push_back(*it);
1227       }
1228       range.push_back(b);
1229     }
1230     else {
1231       range=mergevecteur(rangev,veq_excluded);
1232       range=protect_sort(range,contextptr);
1233     }
1234     vecteur res;
1235     int s=int(range.size());
1236     if (s<2)
1237       return vecteur(1,gensizeerr(contextptr));
1238     if (s==2 && range[0]==minus_inf && range[1]==plus_inf){
1239       gen test=sign(subst(e,x,0,false,contextptr),contextptr);
1240       if (direction<0)
1241 	test=-test;
1242       if (is_one(test))
1243 	return vecteur(1,x);
1244       if (is_one(-test))
1245 	return vecteur(0);
1246       return vecteur(1,gensizeerr(gettext("Unable to check sign ")+test.print()));
1247     }
1248     vecteur add_eq,already_added;
1249     for (int i=0;i<s-1;++i){
1250       gen l=range[i],m=range[i+1];
1251       if (l==m)
1252 	continue;
1253       gen testval;
1254       if (l==minus_inf)
1255 	testval=m-1;
1256       else {
1257 	if (m==plus_inf)
1258 	  testval=l+1;
1259 	else
1260 	  testval=(l+m)/2;
1261       }
1262       gen test=eval(subst(e0,x,testval,false,contextptr),eval_level(contextptr),contextptr);
1263       if (is_undef(test)){
1264 	if (e0.type==_SYMB && e0._SYMBptr->feuille.type==_VECT && e0._SYMBptr->feuille._VECTptr->size()==2){
1265 	  gen a=e0._SYMBptr->feuille[0];
1266 	  a=limit(a,x,testval,0,contextptr);
1267 	  gen b=e0._SYMBptr->feuille[1];
1268 	  b=limit(b,x,testval,0,contextptr);
1269 	  test=e0._SYMBptr->sommet(gen(makevecteur(a,b),_SEQ__VECT),contextptr);
1270 	  if (is_undef(test))
1271 	    a=limit(e0._SYMBptr->feuille[0]-e0._SYMBptr->feuille[1],x,testval,0,contextptr);
1272 	  test=e0._SYMBptr->sommet(gen(makevecteur(a,0),_SEQ__VECT),contextptr);
1273 	}
1274 	if (is_undef(test))
1275 	  return vecteur(1,gensizeerr(gettext("Unable to check test at x=")+test.print()));
1276       }
1277       if (test!=1){
1278 	if (!equalposcomp(already_added,l) && equalposcomp(veq_not_singu,l)){
1279 	  gen a=e0._SYMBptr->feuille[0];
1280 	  a=subst(a,x,l,false,contextptr);
1281 	  if (!has_i(a))
1282 	    add_eq.push_back(l);
1283 	}
1284 	continue;
1285       }
1286       already_added.push_back(m);
1287       gen symb_sup,symb_inf;
1288       if (equalposcomp(singu,l) && e0.type==_SYMB && e0._SYMBptr->feuille.type==_VECT && e0._SYMBptr->feuille._VECTptr->size()==2){
1289 	gen a=e0._SYMBptr->feuille[0];
1290 	gen b=e0._SYMBptr->feuille[1];
1291 	a=limit(a-b,x,l,1,contextptr);
1292 	if (is_inf(a) || is_undef(a))
1293 	  test=0;
1294 	else
1295 	  test=e0._SYMBptr->sommet(gen(makevecteur(a,0),_SEQ__VECT),contextptr);
1296       }
1297       else
1298 	test=eval(subst(e0,x,l,false,contextptr),eval_level(contextptr),contextptr);
1299       gen testeq=abs(evalf(subst(e,x,l,false,contextptr),eval_level(contextptr),contextptr),contextptr);
1300       double eps=epsilon(contextptr); gen lf=_epsilon2zero(evalf_double(l,1,contextptr),contextptr);
1301       gen lsymb=l;
1302       if (has_op(lsymb,*at_rootof) && abs_calc_mode(contextptr)==38)
1303 	lsymb=lf;
1304       if (lf.type==_DOUBLE_){
1305 	double lfd=fabs(lf._DOUBLE_val);
1306 	if (lfd>1)
1307 	  eps=lfd*eps;
1308       }
1309       // 22 feb 2018: revert change ... || test!=1 to && test!=1 made for solve(abs(x^2)=abs(x)^2)
1310       if ((is_greater(eps,testeq,contextptr) || test!=1) &&
1311 	  (equalposcomp(excluded_not_singu,l) || equalposcomp(singu,l) ||
1312 	   ( !(direction %2) && equalposcomp(veq_not_singu,l)))
1313 	  )
1314 	symb_inf=symb_superieur_strict(x,lsymb);
1315       else {
1316 	if (equalposcomp(excluded_not_singu,l) || (test!=1 && equalposcomp(singu,l)))
1317 	  symb_inf=symb_superieur_strict(x,lsymb);
1318 	else
1319 	  symb_inf=symb_superieur_egal(x,lsymb);
1320       }
1321       if (equalposcomp(singu,m) && e0.type==_SYMB && e0._SYMBptr->feuille.type==_VECT && e0._SYMBptr->feuille._VECTptr->size()==2){
1322 	gen a=e0._SYMBptr->feuille[0];
1323 	gen b=e0._SYMBptr->feuille[1];
1324 	a=limit(a-b,x,m,-1,contextptr);
1325 	if (is_inf(a) || is_undef(a))
1326 	  test=0;
1327 	else
1328 	  test=e0._SYMBptr->sommet(gen(makevecteur(a,0),_SEQ__VECT),contextptr);
1329       }
1330       else
1331 	test=eval(subst(e0,x,m,false,contextptr),eval_level(contextptr),contextptr);
1332       lf=_epsilon2zero(evalf_double(m,1,contextptr),contextptr);
1333       gen msymb=m;
1334       if (has_op(m,*at_rootof) && abs_calc_mode(contextptr)==38)
1335 	msymb=lf;
1336       testeq=abs(evalf(subst(e,x,m,false,contextptr),eval_level(contextptr),contextptr),contextptr);
1337       eps=epsilon(contextptr);
1338       // if ( (lf.type!=_DOUBLE_ && lf.type!=_CPLX) || (testeq.type!=_DOUBLE_ || testeq.type != _CPLX && !is_undef(testeq) && !is_inf(testeq)) ) return vecteur(1,gensizeerr("Unable to solve inequation"));
1339       if (lf.type==_DOUBLE_){
1340 	double lfd=fabs(lf._DOUBLE_val);
1341 	if (lfd>1)
1342 	  eps=lfd*eps;
1343       }
1344       if ( (is_greater(eps,testeq,contextptr) || test!=1) &&
1345 	  (equalposcomp(excluded_not_singu,m) || equalposcomp(singu,m) ||
1346 	   ( !(direction %2) && equalposcomp(veq_not_singu,m)) )
1347 	  )
1348 	symb_sup=symb_inferieur_strict(x,msymb);
1349       else {
1350 	if (equalposcomp(excluded_not_singu,m) || (test!=1 && equalposcomp(singu,m)))
1351 	  symb_sup=symb_inferieur_strict(x,msymb);
1352 	else
1353 	  symb_sup=symb_inferieur_egal(x,msymb);
1354       }
1355       if (l==minus_inf)
1356 	res.push_back(symb_sup);
1357       else {
1358 	if (m==plus_inf)
1359 	  res.push_back(symb_inf);
1360 	else
1361 	  res.push_back(symbolic(at_and,makesequence(symb_inf,symb_sup)));
1362       }
1363     }
1364     if (direction % 2)
1365       res=mergevecteur(add_eq,res);
1366     return res;
1367   }
1368 
ck_sorted(const vecteur & v,GIAC_CONTEXT)1369   static bool ck_sorted(const vecteur & v,GIAC_CONTEXT){
1370     int vs=int(v.size());
1371     for (int i=1;i<vs;++i){
1372       if (!ck_is_greater(v[i],v[i-1],contextptr))
1373 	return false;
1374     }
1375     return true;
1376   }
1377 
1378   // works for continuous functions only
solve_inequation(const gen & e0,const identificateur & x,int direction,GIAC_CONTEXT)1379   static vecteur solve_inequation(const gen & e0,const identificateur & x,int direction,GIAC_CONTEXT){
1380     gen e=e0;
1381     if (has_num_coeff(e0)){
1382       *logptr(contextptr) << gettext("Unable to solve inequations with approx coeffs ") << '\n';
1383       e=exact(e0,contextptr);
1384     }
1385     gen a1=e._SYMBptr->feuille[0];
1386     gen a2=e._SYMBptr->feuille[1];
1387     vecteur w=lop(lvarx(makevecteur(a1,a2),x),at_pow);
1388     if (a2.type!=_VECT && a2!=0 && w.size()>1)
1389       e=lncollect(lnexpand(ln(simplify(a1,contextptr),contextptr)-ln(simplify(a2,contextptr),contextptr),contextptr),contextptr);
1390     else
1391       e=a1-a2;
1392     if (is_inequation(e))
1393       return vecteur(1,gensizeerr(gettext("Inequation inside inequation not implemented ")+e.print()));
1394     if (is_zero(ratnormal(derive(e,x,contextptr),contextptr),contextptr))
1395       *logptr(contextptr) <<gettext("Inequation is constant with respect to ")+string(x.print(contextptr)) << '\n';
1396     vecteur veq_not_singu,veq,singu;
1397     int cm=calc_mode(contextptr);
1398     calc_mode(0,contextptr); // for solve(1/(log(abs(x))-x) > 0)
1399     singu=find_singularities(e,x,2,contextptr);
1400     veq_not_singu=solve(e,x,2,contextptr);
1401     calc_mode(cm,contextptr);
1402     for (unsigned i=0;i<singu.size();++i){
1403       singu[i]=ratnormal(singu[i],contextptr);
1404       if (equalposcomp(veq_not_singu,singu[i])){
1405 	gen tmp=subst(e0,x,singu[i],false,contextptr);
1406 	if (eval(tmp,1,contextptr)==1)
1407 	  singu.erase(singu.begin()+i);
1408       }
1409     }
1410     for (unsigned i=0;i<veq_not_singu.size();++i)
1411       veq_not_singu[i]=ratnormal(veq_not_singu[i],contextptr);
1412     // Check if trig equations have introduced infinitely many solutions depending on add. param.
1413     vecteur eid=lidnt(e),eids=eid;
1414     lidnt(evalf(veq_not_singu,1,contextptr),eids,false);
1415     gen singuf=evalf(singu,1,contextptr), veq_not_singuf=evalf(veq_not_singu,1,contextptr);
1416     if (singuf.type!=_VECT || veq_not_singuf.type!=_VECT || !is_numericv(*singuf._VECTptr) || !is_numericv(*veq_not_singuf._VECTptr)){
1417       if (eids.size()>eid.size())
1418 	return vecteur(1,gensizeerr(gettext("Unable to find numeric values solving equation. For trigonometric equations this may be solved using assumptions, e.g. assume(x>-pi && x<pi)")));
1419       *logptr(contextptr) << gettext("Warning! Solving parametric inequation requires assumption on parameters otherwise solutions may be missed. The solutions of the equation are ") << veq_not_singu << '\n';
1420     }
1421     veq=mergevecteur(veq_not_singu,singu);
1422     vecteur range,excluded_not_singu(find_excluded(x,contextptr));
1423     vecteur excluded=mergevecteur(excluded_not_singu,singu);
1424     vecteur veq_excluded=mergevecteur(excluded,veq);
1425     veq_excluded=protect_sort(veq_excluded,contextptr);
1426     if (!ck_sorted(veq_excluded,contextptr))
1427       return vecteur(1,gensizeerr(gettext("Unable to sort ")+gen(veq_excluded).print(contextptr)));
1428     // From the lower bound of range to the higher bound
1429     // find the sign
1430     vecteur res;
1431     if (!find_range(x,range,contextptr))
1432       return res;
1433     for (unsigned i=0;i<range.size();i++){
1434       res=mergevecteur(res,in_solve_inequation(e0,e,x,direction,range[i],veq_excluded,veq_not_singu,excluded_not_singu,singu,contextptr));
1435     }
1436     return res;
1437   }
1438 
1439   // modular roots, modulo p, p supposed to be prime
1440   // dogcd should be set to true except if you have already done gcd with x^p-x
modpolyroot(const modpoly & a,const gen & p,vecteur & v,bool dogcd,GIAC_CONTEXT)1441   bool modpolyroot(const modpoly & a,const gen & p,vecteur & v,bool dogcd,GIAC_CONTEXT){
1442     environment env;
1443     env.moduloon=true;
1444     env.modulo=p;
1445     modpoly A,B(2,1),D,C;
1446     if (dogcd){
1447       C=modpoly(p.val+1);
1448       C[0]=1;
1449       C[p.val-1]=-1;
1450       gcdmodpoly(a,C,&env,A);
1451     }
1452     else
1453       A=a;
1454     if (A.size()==1)
1455       return true;
1456     if (A.size()==2){
1457       v.push_back(smod(invmod(-A.front(),p)*A.back(),p));
1458       return true;
1459     }
1460     // try to split a in 2 parts using gcd with (x+random)^((p-1)/2) mod p and a -1
1461     for (;;){
1462       gen r=smod(gen(giac_rand(contextptr)),p);
1463       B[1]=r;
1464       D=powmod(B,(p-1)/2,A,&env);
1465       D.back()=D.back()-1;
1466       if (is_zero(D.front(),contextptr))
1467 	continue;
1468       gcdmodpoly(A,D,&env,C);
1469       if (C.size()>1 && C.size()<A.size()){
1470 	return modpolyroot(C,p,v,false,contextptr) && modpolyroot(A/C,p,v,false,contextptr);
1471       }
1472     }
1473   }
1474 
modsolve(const gen & e,const identificateur & x,const gen & modulo,vecteur & v,GIAC_CONTEXT)1475   static bool modsolve(const gen & e,const identificateur & x,const gen & modulo,vecteur &v,GIAC_CONTEXT){
1476     vecteur l=lvar(e);
1477     if (modulo.type!=_INT_ || modulo.val> (1<<30))
1478       return false; // setdimerr(gettext("Modular equation with modulo too large"));
1479     if (l.size()==1 && l.front()==x && is_probab_prime_p(modulo)){
1480       // Convert e to polynomial wrt x
1481       gen tmp=_symb2poly(gen(makevecteur(e,l.front()),_SEQ__VECT),contextptr);
1482       if (tmp.type==_FRAC)
1483 	tmp=tmp._FRACptr->num;
1484       tmp=unmod(tmp);
1485       if (tmp.type!=_VECT)
1486 	return false;
1487       vecteur w=*tmp._VECTptr;
1488       return modpolyroot(w,modulo,v,true,contextptr);
1489     }
1490     int m=modulo.val;
1491     for (int i=0;i<m;++i){
1492       gen tmp=subst(e,x,i,false,contextptr);
1493       if (is_zero(tmp.eval(eval_level(contextptr),contextptr),contextptr))
1494 	v.push_back(i);
1495     }
1496     return true;
1497   }
1498 
clean(gen & e,const identificateur & x,GIAC_CONTEXT)1499   static void clean(gen & e,const identificateur & x,GIAC_CONTEXT){
1500     if (e.type!=_SYMB)
1501       return;
1502 #if 1
1503     gen z=fast_icontent(e);
1504     e=fast_divide_by_icontent(e,z);
1505     if (e.type!=_SYMB)
1506       return;
1507 #endif
1508     if ( complex_mode(contextptr)==0 && lvarx(e,x).size()>1 ){
1509       gen es=e;
1510       if (has_op(es,*at_ln)){
1511 	es=lncollect(es,contextptr);
1512 	if (lvarx(es,x).size()==1){
1513 	  e=es;
1514 	  return;
1515 	}
1516       }
1517       es=simplify(e,contextptr);
1518       if (lvarx(es,x).size()==1){
1519 	e=es;
1520 	return;
1521       }
1522     }
1523     if (e._SYMBptr->sommet==at_inv || (e._SYMBptr->sommet==at_pow && is_positive(-e._SYMBptr->feuille._VECTptr->back(),contextptr))){
1524       gen ef=e._SYMBptr->feuille;
1525       if (e._SYMBptr->sommet==at_pow)
1526 	ef=ef._VECTptr->front();
1527       // search for a tan in the variables
1528       vecteur lv(lvarx(e,x));
1529       if (lv.size()!=1)
1530 	e=1;
1531       else {
1532 	gen xvar(lv.front());
1533 	if (!xvar.is_symb_of_sommet(at_tan))
1534 	  e=1;
1535       }
1536       return;
1537     }
1538     if (e._SYMBptr->sommet==at_prod){
1539       gen ef=e._SYMBptr->feuille;
1540       if (ef.type!=_VECT)
1541 	return;
1542       vecteur v=*ef._VECTptr;
1543       int vs=int(v.size());
1544 #if 0
1545       // find num and den, check if gcd is 1, otherwise simplify
1546       gen num(1),den(1);
1547       for (int i=0;i<vs;++i){
1548 	if (v[i].is_symb_of_sommet(at_inv))
1549 	  den = den*v[i]._SYMBptr->feuille;
1550 	else {
1551 	  if (v[i].is_symb_of_sommet(at_pow) && v[i]._SYMBptr->feuille[1].type==_INT_ && v[i]._SYMBptr->feuille[1].val<0)
1552 	    den=den*inv(v[i],contextptr);
1553 	  else
1554 	    num= num*v[i];
1555 	}
1556       }
1557       gen g=gcd(num,den,contextptr);
1558       if (!is_constant_wrt(g,x,contextptr)){
1559 	v=makevecteur(num,inv(den,contextptr));
1560 	vs=2;
1561       }
1562 #endif
1563       for (int i=0;i<vs;++i)
1564 	clean(v[i],x,contextptr);
1565       ef=gen(v,ef.subtype);
1566       e=symbolic(at_prod,ef);
1567     }
1568   }
1569 
1570   // detect product and powers
solve(const gen & e,const identificateur & x,vecteur & v,int isolate_mode,GIAC_CONTEXT)1571   void solve(const gen & e,const identificateur & x,vecteur &v,int isolate_mode,GIAC_CONTEXT){
1572     if (is_zero(e,contextptr)){
1573       v.push_back(x);
1574       return;
1575     }
1576     switch (e.type){
1577     case _IDNT:
1578       if (*e._IDNTptr==x){
1579 	vecteur newv(1,0);
1580 	solve_ckrange(x,newv,isolate_mode,contextptr);
1581 	if (!newv.empty())
1582 	  addtolvar(zero,v);
1583       }
1584       return;
1585     case _SYMB:
1586       if ( e._SYMBptr->sommet==at_pow && ck_is_strictly_positive(e._SYMBptr->feuille._VECTptr->back(),contextptr) ){
1587 	vecteur tmpv;
1588 	solve(e._SYMBptr->feuille._VECTptr->front(),x,tmpv,isolate_mode,contextptr);
1589 	int ncopy=1;
1590 	// make copies of the answer (xcas_mode(contextptr)==1 compatibility)
1591 	if (xcas_mode(contextptr)==1 && e._SYMBptr->feuille._VECTptr->back().type==_INT_)
1592 	  ncopy=e._SYMBptr->feuille._VECTptr->back().val;
1593 	const_iterateur it=tmpv.begin(),itend=tmpv.end();
1594 	for (;it!=itend;++it){
1595 	  for (int i=0;i<ncopy;++i)
1596 	    v.push_back(*it);
1597 	}
1598 	return;
1599       }
1600       if (e._SYMBptr->sommet==at_prod){
1601 	const_iterateur it=e._SYMBptr->feuille._VECTptr->begin(),itend=e._SYMBptr->feuille._VECTptr->end();
1602 	for (;it!=itend;++it){
1603 	  solve(*it,x,v,isolate_mode,contextptr);
1604 	  if (is_undef(v)) break;
1605 	}
1606 	return;
1607       }
1608       if (e._SYMBptr->sommet==at_neg){
1609 	solve(e._SYMBptr->feuille,x,v,isolate_mode,contextptr);
1610 	return;
1611       }
1612       if (//!(isolate_mode & 2) && // commented for assume(x>0 et x<2*pi);simplifier(solve(cos(x)+sin(x)=-1))
1613 	  (e._SYMBptr->sommet==at_inv || (e._SYMBptr->sommet==at_pow && ck_is_positive(-e._SYMBptr->feuille._VECTptr->back(),contextptr)))
1614 	  ){
1615 	gen ef=e._SYMBptr->feuille;
1616 	if (e._SYMBptr->sommet==at_pow)
1617 	  ef=ef._VECTptr->front();
1618 	// search for a tan in the variables
1619 	vecteur lv(lvarx(e,x));
1620 	if (lv.size()!=1)
1621 	  return;
1622 	gen xvar(lv.front());
1623 	if (!xvar.is_symb_of_sommet(at_tan))
1624 	  return;
1625 	gen arg=xvar._SYMBptr->feuille;
1626 	// solve arg=pi/2[pi]
1627 	in_solve(arg-isolate_tan(plus_inf,isolate_mode,contextptr),x,v,isolate_mode,contextptr);
1628 	return;
1629       }
1630       in_solve(e,x,v,isolate_mode,contextptr);
1631       break;
1632     default:
1633       return;
1634     }
1635   }
1636 
1637   // find the arguments of fractional power inside expression e
lvarfracpow(const gen & e)1638   vecteur lvarfracpow(const gen & e){
1639     vecteur l0=lvar(e),l;
1640     iterateur it=l0.begin(),itend=l0.end();
1641     for (;it!=itend;++it){
1642       if (it->_SYMBptr->sommet==at_surd){
1643 	vecteur & arg=*it->_SYMBptr->feuille._VECTptr;
1644 	if (arg.size()==2 && arg.back().type==_INT_){
1645 	  l.push_back(arg[0]);
1646 	  l.push_back(arg[1]);
1647 	  l.push_back(*it);
1648 	}
1649 	continue;
1650       }
1651       if (it->_SYMBptr->sommet==at_NTHROOT){
1652 	vecteur & arg=*it->_SYMBptr->feuille._VECTptr;
1653 	if (arg.size()==2 && arg.front().type==_INT_){
1654 	  l.push_back(arg[1]);
1655 	  l.push_back(arg[0]);
1656 	  l.push_back(*it);
1657 	}
1658 	continue;
1659       }
1660       if (it->_SYMBptr->sommet!=at_pow)
1661 	continue;
1662       vecteur & arg=*it->_SYMBptr->feuille._VECTptr;
1663       gen g=arg[1],expnum,expden;
1664       if (g.type==_FRAC){
1665 	expnum=g._FRACptr->num;
1666 	expden=g._FRACptr->den;
1667       }
1668       else {
1669 	if ( (g.type!=_SYMB) || (g._SYMBptr->sommet!=at_prod) )
1670 	  continue;
1671 	gen & arg1=g._SYMBptr->feuille;
1672 	if (arg1.type!=_VECT)
1673 	  continue;
1674 	vecteur & v=*arg1._VECTptr;
1675 	if ( (v.size()!=2) || (v[1].type!=_SYMB) || (v[1]._SYMBptr->sommet==at_inv) )
1676 	  continue;
1677 	expnum=v[0];
1678 	expden=v[1]._SYMBptr->feuille;
1679       }
1680       if (expden.type!=_INT_)
1681 	continue;
1682       l.push_back(arg[0]);
1683       l.push_back(expden.val);
1684       l.push_back(*it);
1685       vecteur v=lvarfracpow(arg[0]);
1686       if (!v.empty())
1687 	l=mergevecteur(v,l);
1688     }
1689     return l;
1690   }
1691 
lvarfracpow(const gen & g,const identificateur & x,GIAC_CONTEXT)1692   static vecteur lvarfracpow(const gen & g,const identificateur & x,GIAC_CONTEXT){
1693     vecteur l0=lvarfracpow(g),l;
1694     const_iterateur it=l0.begin(),itend=l0.end();
1695     for (;it!=itend;++it){
1696       if (!is_zero(derive(*it,x,contextptr),contextptr)){
1697 	l.push_back(*it);
1698 	++it;
1699 	l.push_back(*it);
1700 	++it;
1701 	l.push_back(*it);
1702       }
1703       else
1704 	it+=2;
1705     }
1706     return l;
1707   }
1708 
solve_fracpow(const gen & e,const identificateur & x,const vecteur & eq,const vecteur & listvars,vecteur & fullres,int isolate_mode,GIAC_CONTEXT)1709   static void solve_fracpow(const gen & e,const identificateur & x,const vecteur & eq,const vecteur & listvars,vecteur & fullres,int isolate_mode,GIAC_CONTEXT){
1710     vecteur equations(eq);
1711     if (e.type==_IDNT){
1712       if (*e._IDNTptr==x && !equalposcomp(find_excluded(x,contextptr),zero)){
1713 	addtolvar(zero,fullres);
1714 	return;
1715       }
1716     }
1717     if (e.type==_SYMB){
1718       if ( (e._SYMBptr->sommet==at_pow) && (ck_is_positive(e._SYMBptr->feuille._VECTptr->back(),contextptr)) ){
1719 	solve_fracpow(e._SYMBptr->feuille._VECTptr->front(),x,equations,listvars,fullres,isolate_mode,contextptr);
1720 	return;
1721       }
1722       if (e._SYMBptr->sommet==at_prod){
1723 	const_iterateur it=e._SYMBptr->feuille._VECTptr->begin(),itend=e._SYMBptr->feuille._VECTptr->end();
1724 	for (;it!=itend;++it)
1725 	  solve_fracpow(*it,x,equations,listvars,fullres,isolate_mode,contextptr);
1726 	return;
1727       }
1728       if (e._SYMBptr->sommet==at_neg){
1729 	solve_fracpow(e._SYMBptr->feuille,x,equations,listvars,fullres,isolate_mode,contextptr);
1730 	return;
1731       }
1732     } // end if (e.type==_SYMB)
1733     vecteur tmp1=listvars;
1734     tmp1.push_back(x);
1735     tmp1.push_back(cst_pi);
1736     vecteur tmp2=tmp1;
1737     lvar(e,tmp1);
1738     if (tmp1==tmp2){
1739       // new code with resultant in all var except the first one
1740       // disadvantage: does not check that listvars[i] are admissible
1741       // example assume(M<0); solve(sqrt(x)=M);
1742       // hence can be used only if no parameter present
1743       gen expr(e);
1744       int s=int(listvars.size());
1745       for (int i=s-1;i>=1;--i){
1746 	// expr must be rationnal wrt listvars[i]
1747 	vecteur vtmp(1,listvars[i]);
1748 	if (listvars[i].type!=_IDNT)
1749 	  setsizeerr();
1750 	rlvarx(expr,listvars[i],vtmp);
1751 	// IMPROVE: maybe a function applied to expr is rationnal
1752 	if (vtmp.size()!=1)
1753 	  setsizeerr(gettext("Solve with fractional power:")+expr.print(contextptr)+gettext(" is not rationnal w.r.t. ")+listvars[i].print(contextptr));
1754 	if (!is_zero(derive(expr,listvars[i],contextptr),contextptr)){
1755 	  expr=_resultant(makevecteur(expr,equations[i-1],listvars[i]),contextptr);
1756 	  if (is_zero(expr))
1757 	    expr=_gcd(makesequence(expr,equations[i-1]),contextptr);
1758 	}
1759       }
1760       expr=factor(expr,false,contextptr);
1761       if (is_zero(derive(expr,x,contextptr),contextptr))
1762 	return;
1763       solve(pow2expln(expr,contextptr),x,fullres,isolate_mode,contextptr);
1764       return;
1765     }
1766     // old code with Groebner basis
1767     equations.push_back(e);
1768     int evalf_after=approx_mode(contextptr)?1:0;
1769     vecteur res=gsolve(equations,listvars,complex_mode(contextptr),evalf_after,contextptr);
1770 #ifndef NO_STDEXCEPT
1771     if (!res.empty() && res.front().type==_STRNG)
1772       setsizeerr(*res.front()._STRNGptr);
1773 #endif
1774     iterateur it=res.begin(),itend=res.end();
1775     for (;it!=itend;++it)
1776       *it=(*it)[0];
1777     purgenoassume(vecteur(listvars.begin()+1,listvars.end()),contextptr);
1778     if (listvars[0].type==_IDNT){
1779       fullres=mergevecteur(res,fullres);
1780       return;
1781     }
1782     // recursive call to solve composevar=*it with respect to x
1783     for (it=res.begin();it!=itend;++it){
1784       fullres=mergevecteur(fullres,solve(*it-listvars[0],x,isolate_mode,contextptr));
1785     }
1786   }
1787 
remove_neg(gen & g)1788   bool remove_neg(gen & g){
1789     if (g.type!=_SYMB || g._SYMBptr->sommet!=at_neg)
1790       return false;
1791     g=g._SYMBptr->feuille;
1792     return true;
1793   }
1794 
rationalize(const gen & g,const gen & x,GIAC_CONTEXT)1795   gen rationalize(const gen & g,const gen & x,GIAC_CONTEXT){
1796     gen expr=g;
1797     vecteur lv(lvarx(expr,x));
1798     int s=int(lv.size());
1799     if (s==1)
1800       return expr;
1801     expr=hyp2exp(expr,contextptr); // was halftan_hyp2exp, changed for solve(sin(2x)=sin(x))
1802     lv=lvarx(expr,x);
1803     s=int(lv.size());
1804     if (s==1)
1805       return expr;
1806     // solve(sin(3x)=cos(x))
1807     if (expr.is_symb_of_sommet(at_plus) && expr._SYMBptr->feuille.type==_VECT && expr._SYMBptr->feuille._VECTptr->size()==2){
1808       const vecteur & v = *expr._SYMBptr->feuille._VECTptr;
1809       gen a=v[0],b=v[1];
1810       bool nega=remove_neg(a);
1811       bool negb=remove_neg(b);
1812       if (nega)
1813 	negb=!negb;
1814       bool cosa=a.type==_SYMB && a._SYMBptr->sommet==at_cos;
1815       bool sina=a.type==_SYMB && a._SYMBptr->sommet==at_sin;
1816       bool cosb=b.type==_SYMB && b._SYMBptr->sommet==at_cos;
1817       bool sinb=b.type==_SYMB && b._SYMBptr->sommet==at_sin;
1818       if ( (cosa || sina) && (cosb || sinb)){
1819 	a=a._SYMBptr->feuille;
1820 	if (negb)
1821 	  b=b._SYMBptr->feuille+cst_pi;
1822 	else
1823 	  b=b._SYMBptr->feuille;
1824 	if (sina)
1825 	  a=a-cst_pi/2;
1826 	if (sinb)
1827 	  b=b-cst_pi/2;
1828 	// cos(a)+cos(b)=0 equivalent to cos((a+b)/2)*cos((a-b)/2)=0
1829 	expr=cos((a+b)/2,contextptr)*cos((a-b)/2,contextptr);
1830 	return expr;
1831       }
1832     }
1833     gen tmp;
1834     if (lv.size()==2 && lv[0].type==_SYMB && lv[1].type==_SYMB && lv[0]._SYMBptr->feuille==lv[1]._SYMBptr->feuille)
1835       tmp=expr;
1836     else
1837       tmp=_texpand(expr,contextptr);
1838     vecteur tmplv=lvarx(tmp,x);
1839     if (tmplv.size()==2 && tmplv[0].type==_SYMB && tmplv[1].type==_SYMB && tmplv[0]._SYMBptr->feuille==tmplv[1]._SYMBptr->feuille){
1840       gen a,b,c,d;
1841       if (is_linear_wrt(tmp,tmplv[0],a,b,contextptr) && is_zero(derive(a,x,contextptr)) && is_linear_wrt(b,tmplv[1],c,d,contextptr) && is_zero(derive(c,x,contextptr)) && is_zero(derive(d,x,contextptr))){
1842 	// tmp=a*tmplv[0]+c*tmplv[1]+d
1843 	if (tmplv[0]._SYMBptr->sommet==at_sin && tmplv[1]._SYMBptr->sommet==at_cos){
1844 	  // a*sin(x)+c*cos(x)=C*sin(x+phi) where exp(i*phi)=a+i*c;
1845 	  gen phi=arg(halftan(a+cst_i*c,contextptr),contextptr);
1846 	  tmp=sqrt(a*a+c*c,contextptr)*sin(tmplv[0]._SYMBptr->feuille+phi,contextptr)+d;
1847 	}
1848 	if (tmplv[0]._SYMBptr->sommet==at_cos && tmplv[1]._SYMBptr->sommet==at_sin){
1849 	  // a*cos(x)+c*sin(x)=C*sin(x+phi) where exp(i*phi)=c+i*a;
1850 	  gen phi=arg(halftan(c+cst_i*a,contextptr),contextptr);
1851 	  tmp=sqrt(a*a+c*c,contextptr)*sin(tmplv[0]._SYMBptr->feuille+phi,contextptr)+d;
1852 	}
1853       }
1854       else {
1855 	if (is_linear_wrt(tmp,tmplv[1],a,b,contextptr) && is_zero(derive(a,x,contextptr)) && is_linear_wrt(b,tmplv[0],c,d,contextptr) && is_zero(derive(c,x,contextptr)) && is_zero(derive(d,x,contextptr))){
1856 	  // tmp=a*tmplv[0]+c*tmplv[1]+d
1857 	  if (tmplv[1]._SYMBptr->sommet==at_sin && tmplv[0]._SYMBptr->sommet==at_cos){
1858 	    // a*sin(x)+c*cos(x)=C*sin(x+phi) where exp(i*phi)=a+i*c;
1859 	    gen phi=arg(halftan(a+cst_i*c,contextptr),contextptr);
1860 	    tmp=sqrt(a*a+c*c,contextptr)*sin(tmplv[1]._SYMBptr->feuille+phi,contextptr)+d;
1861 	  }
1862 	  if (tmplv[1]._SYMBptr->sommet==at_cos && tmplv[0]._SYMBptr->sommet==at_sin){
1863 	    // a*cos(x)+c*sin(x)=C*sin(x+phi) where exp(i*phi)=c+i*a;
1864 	    gen phi=arg(halftan(c+cst_i*a,contextptr),contextptr);
1865 	    tmp=sqrt(a*a+c*c,contextptr)*sin(tmplv[1]._SYMBptr->feuille+phi,contextptr)+d;
1866 	  }
1867 	}
1868       }
1869     }
1870     if (lvarx(tmp,x).size()==1)
1871       expr=tmp;
1872     else {
1873       gen tmp1=_trigtan(tmp,contextptr);
1874       if (lvarx(tmp1,x).size()==1)
1875 	tmp=tmp1;
1876       else {
1877 	tmp1=_trigcos(tmp,contextptr);
1878 	if (lvarx(tmp1,x).size()==1)
1879 	  tmp=tmp1;
1880 	else
1881 	  tmp=halftan(tmp,contextptr); // on Casio, problematic for tabvar([sin(2t),cos(3t)]), fixed by adding trigcos test
1882       }
1883       // change made on 6 dec 2014 for solve(-e^x*(-cos(x)+sin(x)),x);
1884       int tmps=int(lvarx(tmp,x).size());
1885       if (tmps==1)
1886 	expr=tmp;
1887       else {
1888 	tmp=_lncollect((tmps<s?tmp:expr),contextptr);
1889 	int s1=int(lvarx(tmp,x).size());
1890 	if (s1<s){
1891 	  // Note: we are checking solutions numerically later
1892 	  *logptr(contextptr) << gettext("Warning: solving in ") << x << gettext(" equation ") << tmp << "=0" << '\n';
1893 	  expr=tmp;
1894 	  s=s1;
1895 	}
1896 	// code added 11 october 2015 for solve(2^(3*x-1)+2^(6*x-2)-2^(3*x+3)-(4^(3*x-2))=0);
1897 	tmp=_tsimplify(tmps<s?tmp:expr,contextptr);
1898 	if (int(lvarx(tmp,x).size())<s){
1899 	  expr=tmp;
1900 	}
1901       }
1902     }
1903     return expr;
1904   }
1905 
solve_numeric_check(const gen & e,const gen & x,const vecteur & sol,GIAC_CONTEXT)1906   static vecteur solve_numeric_check(const gen & e,const gen & x,const vecteur & sol,GIAC_CONTEXT){
1907     if (is_undef(sol))
1908       return sol;
1909     vecteur res;
1910     vecteur eid=lidnt(e);
1911     if (eid.size()==1 && lvar(e)==eid)
1912       return sol; // it was a univariate polynomial equation, no need to check
1913     for (unsigned i=0;i<sol.size();++i){
1914       gen tmp=subst(e,x,sol[i],false,contextptr);
1915 #ifdef HAVE_LIBMPFR
1916       tmp=_evalf(makesequence(tmp,100),contextptr);
1917 #endif
1918       tmp=evalf_double(tmp,1,contextptr);
1919       vecteur tmpid=lidnt(tmp); // find identifiers introduced by all_trig_sols=true
1920       for (unsigned j=0;j<tmpid.size();++j){
1921 	if (!equalposcomp(eid,tmpid[j]))
1922 	  tmp=subst(tmp,tmpid[j],0,false,contextptr);
1923       }
1924       tmp=evalf_double(tmp,1,contextptr);
1925       // the following test accepts undef, otherwise we might miss some solutions
1926       if ((tmp.type>_CPLX && tmp.type!=_FLOAT_) || is_greater(1e-6,abs(tmp,contextptr),contextptr))
1927 	res.push_back(sol[i]);
1928     }
1929     return res;
1930   }
1931 
1932   // v are solutions in varx, solve for x
solve_subst(const vecteur & v,const identificateur & x,const gen & varx,int isolate_mode,GIAC_CONTEXT)1933   static vecteur solve_subst(const vecteur & v,const identificateur & x,const gen & varx,int isolate_mode,GIAC_CONTEXT){
1934     if (x==varx)
1935       return v;
1936     vecteur res;
1937     const_iterateur it=v.begin(),itend=v.end();
1938     for (;it!=itend;++it){
1939       in_solve(varx-*it,x,res,isolate_mode,contextptr);
1940     }
1941     return res;
1942   }
1943 
solve_cleaned(const gen & e,const gen & e_check,const identificateur & x,int isolate_mode,GIAC_CONTEXT)1944   static vecteur solve_cleaned(const gen & e,const gen & e_check,const identificateur & x,int isolate_mode,GIAC_CONTEXT){
1945     if (e.is_symb_of_sommet(at_exp))
1946       return vecteur(0);
1947     gen expr(e),a,b;
1948     if (is_linear_wrt(e,x,a,b,contextptr)){
1949       if (contains(a,x))
1950 	a=ratnormal(a,contextptr);
1951       if (is_exactly_zero(a)){
1952 	if (is_exactly_zero(b))
1953 	  return vecteur(1,x);
1954 	return vecteur(0);
1955       }
1956       a=-b/a;
1957       if (rlvarx(a,x).empty()){
1958 	vecteur res(1,a);
1959 	solve_ckrange(x,res,isolate_mode,contextptr);
1960 	return res;
1961       }
1962     }
1963     if (expr.is_symb_of_sommet(at_neg))
1964       expr=expr._SYMBptr->feuille;
1965     if (expr.is_symb_of_sommet(at_prod)){
1966       vecteur v=gen2vecteur(expr._SYMBptr->feuille),res;
1967       for (unsigned i=0;i<v.size();++i){
1968 	res=mergevecteur(res,solve_cleaned(v[i],e_check,x,isolate_mode,contextptr));
1969       }
1970       return res;
1971     }
1972     if (expr.is_symb_of_sommet(at_pow)){
1973       gen & f =expr._SYMBptr->feuille;
1974       if (f.type==_VECT && f._VECTptr->size()==2 && is_strictly_positive(f._VECTptr->back(),contextptr))
1975 	return solve_cleaned(f._VECTptr->front(),e_check,x,isolate_mode,contextptr);
1976     }
1977     // Check for re/im/conj in complexmode
1978     bool complexmode=isolate_mode & 1;
1979     if (complexmode){
1980       vecteur lc=mergevecteur(lop(expr,at_conj),mergevecteur(lop(expr,at_re),lop(expr,at_im)));
1981       int s=int(lc.size());
1982       for (int i=0;i<s;++i){
1983 	gen f=lc[i]._SYMBptr->feuille;
1984 	if (!is_zero(derive(f,x,contextptr),contextptr)){
1985 	  identificateur xrei(" x"),ximi(" y");
1986 	  gen xre(xrei),xim(ximi);
1987 	  bool savec=complex_mode(contextptr);
1988 	  bool savecv=complex_variables(contextptr);
1989 	  complex_mode(false,contextptr);
1990 	  complex_variables(false,contextptr);
1991 	  gen tmp=subst(_numer(e,contextptr),x,xre+cst_i*xim,false,contextptr);
1992 	  vecteur res=gsolve(makevecteur(re(tmp,contextptr),im(tmp,contextptr)),makevecteur(xre,xim),false,0,contextptr);
1993 	  complex_mode(savec,contextptr);
1994 	  complex_variables(savecv,contextptr);
1995 	  s=int(res.size());
1996 	  for (int j=0;j<s;++j){
1997 	    if (res[j].type==_VECT && res[j]._VECTptr->size()==2){
1998 	      gen a=res[j]._VECTptr->front();
1999 	      gen b=res[j]._VECTptr->back();
2000 	      if (is_zero(a,contextptr))
2001 		res[j]=cst_i*b;
2002 	      else {
2003 		if (is_zero(b,contextptr))
2004 		  res[j]=a;
2005 		else
2006 		  res[j]=symbolic(at_plus,gen(makevecteur(a,cst_i*b),_SEQ__VECT));
2007 	      }
2008 	    }
2009 	  }
2010 	  return res;
2011 	}
2012       }
2013     }
2014     if ( (approx_mode(contextptr) || has_num_coeff(e)) && lidnt(e)==makevecteur(x)){
2015       vecteur vtmp=makevecteur(e,x);
2016       vecteur res=gen2vecteur(in_fsolve(vtmp,contextptr));
2017       solve_ckrange(x,res,isolate_mode,contextptr);
2018       return res;
2019     }
2020     // should rewrite e in terms of a minimal number of variables
2021     // first factorization of e
2022     // Checking for abs
2023     vecteur la;
2024     if (!complexmode)
2025       la=lop(expr,at_abs);
2026     const_iterateur itla=la.begin(),itlaend=la.end();
2027     for (;itla!=itlaend;++itla){
2028       gen g=itla->_SYMBptr->feuille;
2029       if (is_zero(derive(g,x,contextptr),contextptr))
2030 	continue;
2031       vecteur res;
2032       gen ee=subst(expr,*itla,g,false,contextptr);
2033       vecteur v1=solve(ee,x,isolate_mode,contextptr);
2034       const_iterateur it=v1.begin(),itend=v1.end();
2035       for (;it!=itend;++it){
2036 	if (*it==x){
2037 	  res=mergevecteur(res,solve_inequation(symbolic(at_superieur_egal,gen(makevecteur(g,0),_SEQ__VECT)),x,0,contextptr)); // > replaced by >= for solve((3*abs(6-x)+2*abs(3/2*x-5))=8,x)
2038 	  continue;
2039 	}
2040 	if (contains(*it,x)){
2041 	  *logptr(contextptr) << gettext("Warning, trying to solve ") << g << ">=0 with " << *it << '\n';
2042 	  gen tmp=symbolic(at_solve,gen(makevecteur(symbolic(at_superieur_egal,gen(makevecteur(g,0),_SEQ__VECT)),x),_SEQ__VECT));
2043 	  gen xval=eval(x,1,contextptr);
2044 	  tmp=_tilocal(gen(makevecteur(tmp,*it),_SEQ__VECT),contextptr);
2045 	  sto(xval,x,contextptr);
2046 	  if (tmp.type==_VECT)
2047 	    res=mergevecteur(res,*tmp._VECTptr);
2048 	  continue;
2049 	}
2050 	gen g1=subst(g,x,*it,false,contextptr);
2051 	gen g1f=evalf(g1,1,contextptr);
2052 	if ( (g1f.type==_DOUBLE_ || g1f.type==_FLOAT_ || g1f.type==_REAL) && is_positive(g1,contextptr))
2053 	  res.push_back(*it);
2054 	else {
2055 	  if (normal(abs(g1,contextptr)-g1,contextptr)==0) // was ratnormal, but insufficient
2056 	    res.push_back(*it);
2057 	}
2058       }
2059       ee=subst(expr,*itla,-g,false,contextptr);
2060       v1=solve(ee,x,isolate_mode,contextptr);
2061       it=v1.begin(); itend=v1.end();
2062       for (;it!=itend;++it){
2063 	if (*it==x){
2064 	  res=mergevecteur(res,solve_inequation(symbolic(at_inferieur_strict,gen(makevecteur(g,0),_SEQ__VECT)),x,0,contextptr));
2065 	  continue;
2066 	}
2067 	if (contains(*it,x)){
2068 	  *logptr(contextptr) << gettext("Warning, trying to solve ") << g << "<=0 with " << *it << '\n';
2069 	  gen tmp=symbolic(at_solve,gen(makevecteur(symbolic(at_inferieur_egal,gen(makevecteur(g,0),_SEQ__VECT)),x),_SEQ__VECT));
2070 	  gen xval=eval(x,1,contextptr);
2071 	  tmp=_tilocal(gen(makevecteur(tmp,*it),_SEQ__VECT),contextptr);
2072 	  sto(xval,x,contextptr);
2073 	  if (tmp.type==_VECT)
2074 	    res=mergevecteur(res,*tmp._VECTptr);
2075 	  continue;
2076 	}
2077 	gen g1=subst(g,x,*it,false,contextptr);
2078 	gen g1f=evalf(g1,1,contextptr);
2079 	if ( (g1f.type==_DOUBLE_ || g1f.type==_FLOAT_ || g1f.type==_REAL) && is_positive(-g1,contextptr))
2080 	  res.push_back(*it);
2081 	else {
2082 	  if (normal(abs(g1,contextptr)+g1,contextptr)==0)
2083 	    res.push_back(*it);
2084 	}
2085       }
2086       return res;
2087     }
2088     expr=rationalize(expr,x,contextptr);
2089     // Checking for fractional power
2090     //vecteur surd1,surd2; // ggb 4089
2091     //surd2pow(expr,surd1,surd2,contextptr);
2092     //if (!surd1.empty()) expr=subst(expr,surd1,surd2,false,contextptr);
2093     // Remark: algebraic extension could also be solved using resultant
2094     vecteur ls(lvarfracpow(expr,x,contextptr));
2095     if (!ls.empty()){ // Use auxiliary variables
2096       int s=int(ls.size())/3;
2097       vecteur substin,substout,equations,listvars(lvarx(expr,x,true));
2098       // remove ls from listvars, add aux var instead
2099       for (int i=0;i<s;++i){
2100 	gen lsvar=ls[3*i+2];
2101 	int j=equalposcomp(listvars,ls);
2102 	if (j)
2103 	  listvars.erase(listvars.begin()+j-1);
2104       }
2105       if (listvars.size()!=1)
2106 	return vecteur(1,gensizeerr(gettext("Unable to isolate ")+gen(listvars).print(contextptr)+gettext(" solving equation ")+expr.print(contextptr)));
2107       vecteur assumedvars;
2108       for (int i=0;i<s;++i){
2109 	gen lsvar=ls[3*i+2];
2110 	gen ls3i=subst(ls[3*i],substin,substout,false,contextptr);
2111 	if (equalposcomp(substin,lsvar))
2112 	  continue;
2113 	substin.push_back(lsvar);
2114 #ifdef GIAC_GGB
2115 	gen tmp("d_"+print_intvar_counter(contextptr),contextptr);
2116 #else
2117 	gen tmp("c__"+print_intvar_counter(contextptr),contextptr);
2118 #endif
2119 	if (!(ls[3*i+1].val %2)){
2120 	  assumesymbolic(symb_superieur_egal(tmp,0),0,contextptr);
2121 	  assumedvars.push_back(tmp);
2122 	}
2123 	listvars.push_back(tmp);
2124 	substout.push_back(tmp);
2125 	equations.push_back(pow(tmp,ls[3*i+1],contextptr)-ls3i);
2126       }
2127       gen expr1=subst(expr,substin,substout,false,contextptr);
2128       expr1=factor(expr1,false,contextptr);
2129       if (is_undef(expr1))
2130 	return vecteur(1,expr1);
2131       vecteur fullres;
2132       solve_fracpow(expr1,x,equations,listvars,fullres,isolate_mode,contextptr);
2133       // Check that e_check at x=fullres is 0
2134       // Only if expr1 does not depend on other variables than x
2135       vecteur othervar(1,x),res;
2136       lidnt(expr1,othervar,false);
2137       int pospi;
2138       if ((pospi=equalposcomp(othervar,cst_pi)))
2139 	othervar.erase(othervar.begin()+pospi-1);
2140       if (othervar.size()<=listvars.size()){
2141 	const_iterateur it=fullres.begin(),itend=fullres.end();
2142 	for (;it!=itend;++it){
2143 	  vecteur algv=alg_lvar(*it);
2144 	  if (!algv.empty() && algv.front().type==_VECT && !algv.front()._VECTptr->empty()){
2145 	    *logptr(contextptr) << "Warning, " << *it << " not checked" << '\n';
2146 	    res.push_back(*it);
2147 	  }
2148 	  else {
2149 #ifdef HAVE_LIBMPFR
2150 	    gen tmp=abs(_evalf(makesequence(subst(e_check,x,*it,false,contextptr),100),contextptr),contextptr);
2151 #else
2152 	    gen tmp=evalf(subst(e_check,x,*it,false,contextptr),1,contextptr);
2153 #endif
2154 	    if ( (tmp.type==_DOUBLE_ || tmp.type==_REAL || tmp.type==_FLOAT_) && is_greater(1e-8,abs(tmp,contextptr),contextptr)){
2155 	      if ( (calc_mode(contextptr)==1 || abs_calc_mode(contextptr)==38) && has_op(*it,*at_rootof))
2156 		res.push_back(evalf(*it,1,contextptr));
2157 	      else
2158 		res.push_back(*it);
2159 	      continue;
2160 	    }
2161 	    if (is_undef(tmp)){
2162 #ifdef EMCC // computation takes too long in emscripten, accept the solution without check
2163 	      tmp=0;
2164 	      *logptr(contextptr) << "Warning, " << *it << " not checked" << '\n';
2165 #else
2166 	      tmp=limit(e_check,x,*it,0,contextptr);
2167 #endif
2168 	    }
2169 	    if (is_zero(tmp,contextptr))
2170 	      res.push_back(*it);
2171 	  }
2172 	}
2173       }
2174       else {
2175 	if (debug_infolevel)
2176 	  *logptr(contextptr) << gettext("Warning, solutions were not checked!") << '\n';
2177 	res=fullres;
2178       }
2179       purgenoassume(assumedvars,contextptr);
2180       return res;
2181     }
2182     vecteur lv=lvarx(expr,x);
2183     if (lv.size()>1){
2184       gen tmp=factor(simplify(expr,contextptr),false,contextptr);
2185       if (is_undef(tmp))
2186 	return vecteur(1,tmp);
2187       int lvs=0;
2188       if (tmp.is_symb_of_sommet(at_prod) && tmp._SYMBptr->feuille.type==_VECT){
2189 	vecteur & f=*tmp._SYMBptr->feuille._VECTptr;
2190 	int fs=int(f.size());
2191 	for (int i=0;i<fs;++i){
2192 	  lvs=int(lvarx(f[i],x).size());
2193 	  if (lvs>1)
2194 	    break;
2195 	}
2196       }
2197       else
2198 	lvs=int(lvarx(tmp,x).size());
2199       if (lvs<2)
2200 	expr=tmp;
2201     }
2202     // -> exp/ln
2203     expr=pow2expln(expr,x,contextptr);
2204     bool setcplx=complexmode && complex_mode(contextptr)==false;
2205     if (setcplx)
2206       complex_mode(true,contextptr);
2207 #if 1
2208     vecteur lvarxexpr(lvarx(expr,x));
2209     if (lvarxexpr.size()==1){
2210       // quick check for expr=alpha*x^n+beta
2211       vecteur ll(1,lvarxexpr.front());
2212       lvar(expr,ll);
2213       fraction f=sym2r(expr,ll,contextptr);
2214       if (f.num.type==_POLY){
2215 	polynome & p = *f.num._POLYptr;
2216 	int n=p.lexsorted_degree();
2217 	int n0=p.valuation(0);
2218 	n -= n0;
2219 	if (n>3){
2220 	  std::vector< monomial<gen> >::const_iterator it=p.coord.begin(),itend=p.coord.end();
2221 	  polynome p1=Tnextcoeff<gen>(it,itend);
2222 	  p1.dim=p.dim-1;
2223 	  if (it!=itend){
2224 	    polynome p2=Tnextcoeff<gen>(it,itend);
2225 	    p2.dim=p.dim-1;
2226 	    if (it==itend){
2227 	      ll.erase(ll.begin());
2228 	      gen g1=r2sym(p1,ll,contextptr);
2229 	      gen g2=r2sym(p2,ll,contextptr);
2230 	      factorization f; gen an,extra_div; bool has_nthroot=false;
2231 	      if ((isolate_mode & 1) && cfactor(p,an,f,true,extra_div) && f.size()>1){
2232 		for (unsigned i=0;i<f.size();++i){
2233 		  if (f[i].fact.lexsorted_degree()==1){
2234 		    it=f[i].fact.coord.begin(),itend=f[i].fact.coord.end();
2235 		    p1=Tnextcoeff<gen>(it,itend);
2236 		    p2=Tnextcoeff<gen>(it,itend);
2237 		    an=-r2sym(p2,ll,contextptr)/r2sym(p1,ll,contextptr);
2238 		    an=r2sym(an,vecteur(1,vecteur(0)),contextptr);
2239 		    has_nthroot=true;
2240 		    break;
2241 		  }
2242 		}
2243 	      }
2244 	      if (isolate_mode & 1){
2245 		vecteur res;
2246 		if (is_positive(g2/g1,contextptr) && !has_nthroot){
2247 		  gen g=pow(g2/g1,inv(n,contextptr),contextptr);
2248 		  for (int i=n-1;i>=0;--i){
2249 		    res.push_back(g*exp(cst_i*cst_pi*gen(2*i+1)/n,contextptr));
2250 		  }
2251 		}
2252 		else {
2253 		  gen g=has_nthroot?an:pow(-g2/g1,inv(n,contextptr),contextptr);
2254 		  for (int i=n-1;i>=0;--i){
2255 		    if (n%2)
2256 		      res.push_back(g*exp(cst_i*cst_two_pi*gen(i)/n,contextptr));
2257 		    else
2258 		      res.push_back(g*exp(cst_i*cst_pi*gen(i)/(n/2),contextptr));
2259 		  }
2260 		}
2261 		if (n0)
2262 		  res.push_back(0);
2263 		return solve_subst(res,x,lvarxexpr.front(),isolate_mode,contextptr);
2264 	      }
2265 	      vecteur res;
2266 	      if (n0)
2267 		res.push_back(0);
2268 	      gen g2g1=g2/g1;
2269 	      if (n%2){
2270 		if (is_positive(g2g1,contextptr))
2271 		  res.push_back(-pow(g2g1,inv(n,contextptr),contextptr));
2272 		else
2273 		  res.push_back(pow(-g2g1,inv(n,contextptr),contextptr));
2274 		return solve_subst(res,x,lvarxexpr.front(),isolate_mode,contextptr);
2275 	      }
2276 	      if (is_positive(g2g1,contextptr))
2277 		return solve_subst(res,x,lvarxexpr.front(),isolate_mode,contextptr);
2278 	      gen g=simplifier(pow(-g2g1,inv(n,contextptr),contextptr),contextptr);
2279 	      res.push_back(-g); res.push_back(g);
2280 	      return solve_subst(res,x,lvarxexpr.front(),isolate_mode,contextptr);
2281 	    }
2282 	  }
2283 	}
2284       }
2285     }
2286 #endif
2287     gen ea,eb,ec;
2288     if (is_quadratic_wrt(expr,x,ea,eb,ec,contextptr)){
2289       gen tmp;
2290       bool doreal=complex_mode(contextptr) && is_real(ea,contextptr) && is_real(eb,contextptr) && is_real(ec,contextptr) && is_positive(eb*eb-4*ea*ec,contextptr);
2291       if (doreal)
2292 	complex_mode(false,contextptr);
2293       tmp=factor(expr,false,contextptr); // factor in complex or real mode
2294       if (doreal)
2295 	complex_mode(true,contextptr);
2296       if (!lop(tmp,at_rootof).empty())
2297 	expr=_sqrfree(expr,contextptr);
2298       else
2299 	expr=tmp;
2300     }
2301     else
2302       expr=factor(expr,false,contextptr); // factor in complex or real mode
2303     if (expr.is_symb_of_sommet(at_neg))
2304       expr=expr._SYMBptr->feuille;
2305     if (is_undef(expr))
2306       return vecteur(1,expr);
2307     if (setcplx)
2308       complex_mode(false,contextptr);
2309     lv=lvarx(expr,x);
2310     int s=int(lv.size());
2311     if (s==1 && lv[0].is_symb_of_sommet(at_tan) && expr.is_symb_of_sommet(at_prod) && expr._SYMBptr->feuille.type==_VECT){
2312       // remove denominator if limit!=0
2313       gen etan=limit(subst(expr,lv[0],x,false,contextptr),x,plus_inf,-1,contextptr);
2314       if (!is_zero(etan,contextptr)){
2315 	const vecteur varg=*expr._SYMBptr->feuille._VECTptr;
2316 	vecteur newarg;
2317 	for (unsigned i=0;i<varg.size();++i){
2318 	  if (varg[i].type==_SYMB && (varg[i]._SYMBptr->sommet==at_inv || (varg[i]._SYMBptr->sommet==at_pow && ck_is_positive(-varg[i]._SYMBptr->feuille._VECTptr->back(),contextptr))) )
2319 	    ;
2320 	  else
2321 	    newarg.push_back(varg[i]);
2322 	}
2323 	expr=_prod(gen(newarg,_SEQ__VECT),contextptr);
2324       }
2325     }
2326     vecteur v;
2327     if (!s){
2328       if (is_zero(expr,contextptr))
2329 	v.push_back(x);
2330       return v;
2331     }
2332     solve(expr,x,v,isolate_mode,contextptr);
2333     if (is_undef(v)) return v;
2334     v=solve_numeric_check(e_check,x,v,contextptr);
2335     if (0 && !(isolate_mode & 2)){
2336       // check solutions if there is a tan inside, commented now that we have the test above
2337       for (int i=0;i<s;++i){
2338 	if (lv[i].is_symb_of_sommet(at_tan)){
2339 	  vecteur res;
2340 	  const_iterateur it=v.begin(),itend=v.end();
2341 	  for (;it!=itend;++it){
2342 	    if (has_num_coeff(*it) || is_zero(recursive_normal(limit(_tan2sincos2(expr,contextptr),x,*it,0,contextptr),contextptr),contextptr) || is_zero(recursive_normal(limit(expr,x,*it,0,contextptr),contextptr),contextptr))
2343 	      res.push_back(*it);
2344 	  }
2345 	  return res;
2346 	}
2347       }
2348     }
2349     return v;
2350   }
2351 
protect_solve(const gen & e,const identificateur & x,int isolate_mode,GIAC_CONTEXT)2352   vecteur protect_solve(const gen & e,const identificateur & x,int isolate_mode,GIAC_CONTEXT){
2353     vecteur res;
2354 #ifdef NO_STDEXCEPT
2355     res=solve(e,x,isolate_mode,contextptr);
2356 #else
2357     try {
2358       res=solve(e,x,isolate_mode,contextptr);
2359     } catch(std::runtime_error & e){
2360       last_evaled_argptr(contextptr)=NULL;
2361       res=vecteur(1,undef);
2362     }
2363 #endif
2364     return res;
2365   }
2366 
solve(const gen & e,const identificateur & x,int isolate_mode,GIAC_CONTEXT)2367   vecteur solve(const gen & e,const identificateur & x,int isolate_mode,GIAC_CONTEXT){
2368     ck_isolate_mode(isolate_mode,x,contextptr);
2369     if (is_undef(e)) return vecteur(0);
2370     gen expr(exp2pow(e,contextptr));
2371     // keep e if x is isolable inside
2372     vecteur lv0(lvarx(e,x));
2373     int s0=int(lv0.size());
2374     if (s0==1){
2375       gen xvar(lv0.front());
2376       if (xvar!=x && xvar.type==_SYMB && equalposcomp(solve_fcns_tab,xvar._SYMBptr->sommet))
2377 	expr=e;
2378     }
2379     gen modulo;
2380     if (has_mod_coeff(expr,modulo)){
2381       vecteur v;
2382       if (!modsolve(expr,x,modulo,v,contextptr))
2383 	return vecteur(1,gensizeerr(gettext("Modulo too large")));
2384       return v;
2385     }
2386     // Inequation?
2387     if (e.type==_SYMB){
2388       if (e._SYMBptr->sommet==at_inferieur_strict)
2389 	return solve_inequation(e,x,-2,contextptr);
2390       if (e._SYMBptr->sommet==at_inferieur_egal)
2391 	return solve_inequation(e,x,-1,contextptr);
2392       if (e._SYMBptr->sommet==at_superieur_strict)
2393 	return solve_inequation(e,x,2,contextptr);
2394       if (e._SYMBptr->sommet==at_superieur_egal)
2395 	return solve_inequation(e,x,1,contextptr);
2396       if (e._SYMBptr->sommet==at_equal || e._SYMBptr->sommet==at_equal2 || e._SYMBptr->sommet==at_same)
2397 	expr = e._SYMBptr->feuille._VECTptr->front()-e._SYMBptr->feuille._VECTptr->back();
2398     }
2399     vecteur v=lvarx(expr,x);
2400     v=lop(v,at_of);
2401     if (!v.empty())
2402       return vecteur(1,gensizeerr("Invalid function "+v.front().print(contextptr)+" perhaps a missing * for multiplication"));
2403     clean(expr,x,contextptr);
2404     vecteur res= solve_cleaned(expr,e,x,isolate_mode,contextptr);
2405     if (has_op(expr,*at_unit)){
2406       gen tmp=eval(res,1,contextptr);
2407       //tmp=mksa_reduce(tmp,contextptr);
2408       if (tmp.type==_VECT)
2409 	res=*tmp._VECTptr;
2410     }
2411     return res;
2412   }
2413 
remove_and(const gen & g,const unary_function_ptr * u)2414   gen remove_and(const gen & g,const unary_function_ptr * u){
2415     if (g.type==_VECT){
2416       vecteur res;
2417       const_iterateur it=g._VECTptr->begin(),itend=g._VECTptr->end();
2418       for (;it!=itend;++it){
2419 	gen tmp=remove_and(*it,u);
2420 	if (tmp.type!=_VECT){
2421 	  tmp=remove_and(*it,at_and);
2422 	  res.push_back(tmp);
2423 	}
2424 	else
2425 	  res=mergevecteur(res,*tmp._VECTptr);
2426       }
2427       return res;
2428     }
2429     if (!g.is_symb_of_sommet(u)){
2430       // if (g.is_symb_of_sommet(at_and)) return g._SYMBptr->feuille;
2431       return g;
2432     }
2433     return remove_and(g._SYMBptr->feuille,u);
2434   }
2435 
solve(const gen & e,const gen & x,int isolate_mode,GIAC_CONTEXT)2436   vecteur solve(const gen & e,const gen & x,int isolate_mode,GIAC_CONTEXT){
2437     bool complexmode=isolate_mode & 1;
2438     vecteur res;
2439     if (x.type!=_IDNT){
2440       if (x.type==_VECT && x._VECTptr->size()==1 && e.type==_VECT && e._VECTptr->size()==1){
2441 	vecteur res=solve(e._VECTptr->front(),x._VECTptr->front(),isolate_mode,contextptr);
2442 	iterateur it=res.begin(),itend=res.end();
2443 	for (;it!=itend;++it)
2444 	  *it=vecteur(1,*it);
2445 	return res;
2446       }
2447       if (x.type==_VECT )
2448 	return gsolve(gen2vecteur(e),*x._VECTptr,complexmode,(approx_mode(contextptr)?1:0),contextptr);
2449       identificateur xx("x_solve");
2450       res=solve(subst(e,x,xx,false,contextptr),xx,isolate_mode,contextptr);
2451       res=subst(res,xx,x,false,contextptr);
2452       return res;
2453     }
2454     if (e.type==_VECT){
2455       if (x.type==_IDNT && lvarx(e,x)==vecteur(1,x))
2456 	return solve(_gcd(e,contextptr),x,isolate_mode,contextptr);
2457       const_iterateur it=e._VECTptr->begin(),itend=e._VECTptr->end();
2458       gen curx=x._IDNTptr->eval(1,x,contextptr);
2459       res=vecteur(1,x); // everything is solution up to now
2460       for (;it!=itend;++it){
2461 	if (res==vecteur(1,x))
2462 	  res=solve(*it,*x._IDNTptr,isolate_mode,contextptr);
2463 	else { // check every element of res
2464 	  vecteur newres;
2465 	  const_iterateur jt=res.begin(),jtend=res.end();
2466 	  for (;jt!=jtend;++jt){
2467 	    if (is_inequation(*jt) ||
2468 		jt->is_symb_of_sommet(at_and)){
2469 	      assumesymbolic(*jt,0,contextptr); // assume and solve next equation
2470 	      newres=mergevecteur(newres,solve(*it,*x._IDNTptr,isolate_mode,contextptr));
2471 	      purgenoassume(x,contextptr);
2472 	    }
2473 	    else {
2474 	      if (is_zero(normal(subst(*it,x,*jt,true,contextptr),1,contextptr),contextptr))
2475 		newres.push_back(*jt);
2476 	    }
2477 	  } // end for (;jt!=jtend;++jt) loop on previous solutions
2478 	  res=newres;
2479 	} // end else
2480       } // end for (;it!=itend;++it) loop on equations
2481       if (curx!=x)
2482 	sto(curx,x,contextptr);
2483       return res;
2484     }
2485     else
2486       res=solve(e,*x._IDNTptr,isolate_mode,contextptr);
2487     return res;
2488   }
2489 
symb_solution(const gen & g,const gen & var,GIAC_CONTEXT)2490   static gen symb_solution(const gen & g,const gen & var,GIAC_CONTEXT){
2491     if (var.type!=_VECT){
2492       if (var.type==_IDNT && g.type!=_IDNT && !lvarx(g,var).empty())
2493 	return g;
2494       else
2495 	return symbolic(at_equal,makesequence(var,g));
2496     }
2497     vecteur v=*var._VECTptr;
2498     if (g.type!=_VECT || g._VECTptr->size()!=v.size())
2499       return gensizeerr(contextptr);
2500     const_iterateur it=v.begin(),itend=v.end(),jt=g._VECTptr->begin();
2501     vecteur res;
2502     res.reserve(itend-it);
2503     for (;it!=itend;++it,++jt){
2504       // if (*it!=*jt)
2505       if (jt->is_symb_of_sommet(at_equal) && jt->_SYMBptr->feuille[0]==*it)
2506 	res.push_back(*jt);
2507       else
2508 	res.push_back(symbolic(at_equal,makesequence(*it,*jt)));
2509     }
2510     if (xcas_mode(contextptr)==3)
2511       return symbolic(at_and,res);
2512     else
2513       return res;
2514   }
2515 
quote_inferieur_strict(const gen & g,GIAC_CONTEXT)2516   static gen quote_inferieur_strict(const gen & g,GIAC_CONTEXT){
2517     return symbolic(at_quote,symbolic(at_inferieur_strict,eval(g,eval_level(contextptr),contextptr)));
2518   }
2519 
quote_superieur_strict(const gen & g,GIAC_CONTEXT)2520   static gen quote_superieur_strict(const gen & g,GIAC_CONTEXT){
2521     return symbolic(at_quote,symbolic(at_superieur_strict,eval(g,eval_level(contextptr),contextptr)));
2522   }
2523 
quote_inferieur_egal(const gen & g,GIAC_CONTEXT)2524   static gen quote_inferieur_egal(const gen & g,GIAC_CONTEXT){
2525     return symbolic(at_quote,symbolic(at_inferieur_egal,eval(g,eval_level(contextptr),contextptr)));
2526   }
2527 
quote_superieur_egal(const gen & g,GIAC_CONTEXT)2528   static gen quote_superieur_egal(const gen & g,GIAC_CONTEXT){
2529     return symbolic(at_quote,symbolic(at_superieur_egal,eval(g,eval_level(contextptr),contextptr)));
2530   }
2531 
quote_conj(const gen & g,GIAC_CONTEXT)2532   static gen quote_conj(const gen & g,GIAC_CONTEXT){
2533     return symbolic(at_quote,symbolic(at_conj,eval(g,eval_level(contextptr),contextptr)));
2534   }
2535 
quote_re(const gen & g,GIAC_CONTEXT)2536   static gen quote_re(const gen & g,GIAC_CONTEXT){
2537     return symbolic(at_quote,symbolic(at_re,eval(g,eval_level(contextptr),contextptr)));
2538   }
2539 
quote_im(const gen & g,GIAC_CONTEXT)2540   static gen quote_im(const gen & g,GIAC_CONTEXT){
2541     return symbolic(at_quote,symbolic(at_im,eval(g,eval_level(contextptr),contextptr)));
2542   }
2543 
solvepreprocess(const gen & args,bool complexmode,GIAC_CONTEXT)2544   vecteur solvepreprocess(const gen & args,bool complexmode,GIAC_CONTEXT){
2545     gen g(args);
2546     if (g.is_symb_of_sommet(at_and) && g._SYMBptr->feuille.type==_VECT)
2547       g=makesequence(*g._SYMBptr->feuille._VECTptr,vx_var);
2548     if (g.type==_VECT && !g._VECTptr->empty() && g._VECTptr->front().is_symb_of_sommet(at_and)){
2549       vecteur v(*g._VECTptr);
2550       v.front()=remove_and(v.front(),at_and);
2551       g=gen(v,g.subtype);
2552     }
2553     // quote < <= > and >=
2554     vector<const unary_function_ptr *> quote_inf;
2555     quote_inf.push_back(at_inferieur_strict);
2556     quote_inf.push_back(at_inferieur_egal);
2557     quote_inf.push_back(at_superieur_strict);
2558     quote_inf.push_back(at_superieur_egal);
2559     if (complexmode){
2560       quote_inf.push_back(at_conj);
2561       quote_inf.push_back(at_re);
2562       quote_inf.push_back(at_im);
2563     }
2564     vector< gen_op_context > quote_inf_v;
2565     quote_inf_v.push_back(quote_inferieur_strict);
2566     quote_inf_v.push_back(quote_inferieur_egal);
2567     quote_inf_v.push_back(quote_superieur_strict);
2568     quote_inf_v.push_back(quote_superieur_egal);
2569     if (complexmode){
2570       quote_inf_v.push_back(quote_conj);
2571       quote_inf_v.push_back(quote_re);
2572       quote_inf_v.push_back(quote_im);
2573     }
2574     g=subst(g,quote_inf,quote_inf_v,true,contextptr);
2575     return plotpreprocess(g,contextptr);
2576   }
2577 
solvepostprocess(const gen & g,const gen & x,GIAC_CONTEXT)2578   gen solvepostprocess(const gen & g,const gen & x,GIAC_CONTEXT){
2579     if (g.type!=_VECT)
2580       return g;
2581     vecteur res=*g._VECTptr;
2582     // convert solution to an expression
2583     iterateur it=res.begin(),itend=res.end();
2584     if (it==itend)
2585       return res;
2586     if (x.type==_VECT || xcas_mode(contextptr)==3 || calc_mode(contextptr)==1){
2587       for (;it!=itend;++it)
2588 	*it=symb_solution(*it,x,contextptr);
2589     }
2590     if (xcas_mode(contextptr)==3)
2591       return symbolic(at_ou,res);
2592     if (xcas_mode(contextptr)==2 || calc_mode(contextptr)==1)
2593       return gen(res,_SET__VECT);
2594     return gen(res,_SEQ__VECT);
2595   }
2596 
point2xy(const gen & g,GIAC_CONTEXT)2597   gen point2xy(const gen & g,GIAC_CONTEXT){
2598     if (g.type==_VECT)
2599       return apply(g,point2xy,contextptr);
2600     if (is_equal(g))
2601       return apply_to_equal(g,point2xy,contextptr);
2602     if (g.is_symb_of_sommet(at_pnt))
2603       return _coordonnees(g,contextptr);
2604     return g;
2605   }
2606 
_solve_uncompressed(const gen & args,GIAC_CONTEXT)2607   gen _solve_uncompressed(const gen & args,GIAC_CONTEXT){
2608     if (args.type==_VECT && args.subtype==0 && ckmatrix(args))
2609       return _solve_uncompressed(change_subtype(args,_SEQ__VECT),contextptr);
2610     if (args.type==_VECT && args.subtype==_SEQ__VECT && lidnt(args).empty())
2611       return _linsolve(args,contextptr);
2612     if (args.type==_VECT && !args._VECTptr->empty() && args._VECTptr->back()==at_equal){
2613       int x=calc_mode(contextptr);
2614       calc_mode(1,contextptr);
2615       gen g=gen(vecteur(args._VECTptr->begin(),args._VECTptr->end()-1),args.subtype);
2616       g=_solve(g,contextptr);
2617       calc_mode(x,contextptr);
2618       return g;
2619     }
2620     int isolate_mode=int(complex_mode(contextptr)) | int(int(all_trig_sol(contextptr)) << 1);
2621     if (calc_mode(contextptr)==1){
2622       if (args.type==_VECT && args.subtype!=_SEQ__VECT){
2623 	vecteur w(1,cst_pi);
2624 	lidnt(args,w,false);
2625 	w.erase(w.begin());
2626 	return _solve(makesequence(args,w),contextptr);
2627       }
2628     }
2629     if (args.type!=_VECT) // change 9 dec 2019: x no more default var
2630       return _solve(makesequence(args,ggb_var(eval(args,1,contextptr))),contextptr);
2631     if (has_op(args,*at_irem)){
2632       vector<const unary_function_ptr *> v(1,at_irem);
2633       vector<gen_op_context> w(1,_normalmod);
2634       return _solve(subst(args,v,w,false,contextptr),contextptr);
2635     }
2636     vecteur v(solvepreprocess(args,complex_mode(contextptr),contextptr));
2637     if (v.size()>1 && v[1].is_symb_of_sommet(at_unquote))
2638       v[1]=eval(v[1],1,contextptr);
2639     int s=int(v.size());
2640     if (s && ckmatrix(v[0])){
2641       vecteur w;
2642       aplatir(*v[0]._VECTptr,w,true);
2643       v[0]=w;
2644     }
2645     if (s && v.back()==at_interval)
2646       return _fsolve(args,contextptr);
2647     if (s>=2 && ckmatrix(v[1]) && v[1]._VECTptr->front()._VECTptr->size()==1)
2648       v[1]=mtran(*v[1]._VECTptr).front();
2649     if (s==2 && is_equal(v[1]))
2650       return _fsolve(gen(makevecteur(v[0],v[1]._SYMBptr->feuille[0],v[1]._SYMBptr->feuille[1]),_SEQ__VECT),contextptr);
2651     if (s>2)
2652       return _fsolve(args,contextptr);
2653     gen arg1(point2xy(v.front(),contextptr));
2654     if (arg1.type==_VECT){ // Flatten equations which are list of equations
2655       vecteur w,w1,w2;
2656       const_iterateur it=arg1._VECTptr->begin(),itend=arg1._VECTptr->end();
2657       for (;it!=itend;++it){
2658 	gen tmp=equal2diff(*it);
2659 	if (tmp.type==_VECT){
2660 	  const_iterateur jt=tmp._VECTptr->begin(),jtend=tmp._VECTptr->end();
2661 	  for (;jt!=jtend;++jt){
2662 	    if (is_inequation(*jt))
2663 	      w1.push_back(*jt);
2664 	    else
2665 	      w2.push_back(*jt);
2666 	  }
2667 	}
2668 	else {
2669 	  if (is_inequation(tmp))
2670 	    w1.push_back(tmp);
2671 	  else
2672 	    w2.push_back(tmp);
2673 	}
2674       }
2675       // put inequations first
2676       w=mergevecteur(w1,w2);
2677       arg1=w;
2678     }
2679     if (arg1.type!=_VECT && !is_equal(arg1) && !is_inequation(arg1))
2680       *logptr(contextptr) << gettext("Warning, argument is not an equation, solving ") << arg1 << "=0" << '\n';
2681     else {
2682 #if 1 // ATESTER
2683       if (arg1.type==_VECT && arg1._VECTptr->size()==2 && v[1].type==_VECT && v[1]._VECTptr->size()==2){
2684 	gen eq1(arg1._VECTptr->front()),eq2(arg1._VECTptr->back()),var1(v[1]._VECTptr->front()),var2(v[1]._VECTptr->back()),a,b,c,d;
2685 	if (is_linear_wrt(eq1,var1,a,b,contextptr) && is_linear_wrt(eq2,var1,c,d,contextptr) && lvarxwithinv(makevecteur(a,b,c,d),var2,contextptr).size()>1 && !is_zero(recursive_normal(a*d-b*c,contextptr))){
2686 	  // a*var1+b=c*var1+d=0 => b*c-a*d=0
2687 	  vecteur V;
2688 	  gen res=_solve(makesequence(symb_equal(a*d,b*c),var2),contextptr);
2689 	  if (res.type==_VECT && !res._VECTptr->empty()){
2690 	    for (unsigned i=0;i<res._VECTptr->size();++i){
2691 	      gen v2=(*res._VECTptr)[i];
2692 	      gen v2val=v2.is_symb_of_sommet(at_equal)?v2._SYMBptr->feuille._VECTptr->back():v2;
2693 	      gen res2=derive(eq1,var1,contextptr);
2694 	      if (!is_zero(res2))
2695 		res2=_simplify(subst(eq1,var2,v2val,false,contextptr),contextptr);
2696 	      if (!is_zero(res2)){
2697 		if (taille(res2,RAND_MAX)>taille(v2val,RAND_MAX)*10){
2698 		  res2=subst(eq1,var2,v2val,false,contextptr);
2699 		  res2=ratnormal(_solve(makesequence(symb_equal(res2,0),var1),contextptr),contextptr);
2700 		}
2701 		else
2702 		  res2=_simplify(_solve(makesequence(symb_equal(res2,0),var1),contextptr),contextptr);
2703 	      }
2704 	      gen res3=derive(eq2,var1,contextptr);
2705 	      if (!is_zero(res3))
2706 		res3=_simplify(subst(eq2,var2,v2val,false,contextptr),contextptr);
2707 	      if (!is_zero(res3)){
2708 		if (taille(res3,RAND_MAX)>taille(v2val,RAND_MAX)*10){
2709 		  res3=subst(eq2,var2,v2val,false,contextptr);
2710 		  res3=ratnormal(_solve(makesequence(symb_equal(res3,0),var1),contextptr),contextptr);
2711 		}
2712 		else
2713 		  res3=_simplify(_solve(makesequence(symb_equal(res3,0),var1),contextptr),contextptr);
2714 		if (is_zero(res2))
2715 		  res2=res3;
2716 		else
2717 		  res2=_intersect(makesequence(res2,res3),contextptr);
2718 	      }
2719 	      if (res2.type==_VECT){
2720 		for (unsigned j=0;j<res2._VECTptr->size();++j)
2721 		  V.push_back(makevecteur((*res2._VECTptr)[j],v2));
2722 	      }
2723 	    }
2724 	    return V;
2725 	  } // if res.type==_VECT ...
2726 	}
2727 	if (is_linear_wrt(eq1,var2,a,b,contextptr) && is_linear_wrt(eq2,var2,c,d,contextptr) && lvarxwithinv(makevecteur(a,b,c,d),var1,contextptr).size()>1 && !is_zero(recursive_normal(a*d-b*c,contextptr))){
2728 	  vecteur V;
2729 	  gen res=_solve(makesequence(symb_equal(a*d,b*c),var1),contextptr);
2730 	  if (res.type==_VECT && !res._VECTptr->empty()){
2731 	    for (unsigned i=0;i<res._VECTptr->size();++i){
2732 	      gen v1=(*res._VECTptr)[i];
2733 	      gen v1val=v1.is_symb_of_sommet(at_equal)?v1._SYMBptr->feuille._VECTptr->back():v1;
2734 	      gen res2=derive(eq1,var2,contextptr);
2735 	      if (!is_zero(res2))
2736 		res2=_simplify(subst(eq1,var1,v1val,false,contextptr),contextptr);
2737 	      if (!is_zero(res2))
2738 		res2=_simplify(_solve(makesequence(symb_equal(res2,0),var2),contextptr),contextptr);
2739 	      gen res3=derive(eq2,var2,contextptr);
2740 	      if (!is_zero(res3))
2741 		res3=_simplify(subst(eq2,var1,v1val,false,contextptr),contextptr);
2742 	      if (!is_zero(res3)){
2743 		res3=_simplify(_solve(makesequence(symb_equal(res3,0),var2),contextptr),contextptr);
2744 		if (is_zero(res2))
2745 		  res2=res3;
2746 		else
2747 		  res2=_intersect(makesequence(res2,res3),contextptr);
2748 	      }
2749 	      if (res2.type==_VECT){
2750 		for (unsigned j=0;j<res2._VECTptr->size();++j)
2751 		  V.push_back(makevecteur(v1,(*res2._VECTptr)[j]));
2752 	      }
2753 	    }
2754 	    return V;
2755 	  } // if res.type==_VECT
2756 	}
2757       }
2758       if (v[1].type!=_VECT){
2759 	vecteur arg1l=lvarx(equal2diff(arg1),v[1]);
2760 	if (arg1l.size()>1){
2761 	  if (arg1.type==_VECT){
2762 	    arg1l.clear();
2763 	    for (int i=0;i<int(arg1._VECTptr->size());++i){
2764 	      gen tmp=(*arg1._VECTptr)[i];
2765 	      arg1l.push_back(is_inequation(tmp)?tmp:powneg2invpow(tmp,contextptr));
2766 	    }
2767 	    arg1=gen(arg1l,arg1.subtype);
2768 	  }
2769 	  else {
2770 	    if (!is_inequation(arg1))
2771 	      arg1=powneg2invpow(arg1,contextptr);
2772 	  }
2773 	}
2774       }
2775       if (is_equal(arg1) && arg1._SYMBptr->feuille.type==_VECT){
2776 	gen a1=arg1._SYMBptr->feuille[0];
2777 	gen a2=arg1._SYMBptr->feuille[1];
2778 	if (a1.is_symb_of_sommet(at_program) || a2.is_symb_of_sommet(at_program))
2779 	  return gensizeerr(contextptr);
2780 	if (a2==0 && a1.is_symb_of_sommet(at_plus) && a1._SYMBptr->feuille._VECTptr->size()==2){
2781 	  a2=-a1._SYMBptr->feuille._VECTptr->back();
2782 	  a1=a1._SYMBptr->feuille._VECTptr->front();
2783 	}
2784 	if (a1.is_symb_of_sommet(at_neg)){
2785 	  a1=a1._SYMBptr->feuille;
2786 	  a2=-a2;
2787 	}
2788 	// solve(simplify(surd((5/10),570)^(x))=(8/10))
2789 	if (a2.type!=_VECT && !is_zero(a2) && (!lvarx(a1,v.back()).empty() || !lvarx(a2,v.back()).empty())){
2790 	  vecteur lv=lvarx(makevecteur(a1,a2),v.back());
2791 	  vecteur wpow=lop(lvar(lop(lv,at_pow)),at_pow);
2792 	  vecteur w=mergevecteur(wpow,lop(lv,at_exp));
2793 	  if (!wpow.empty() || w.size()>1){
2794 	    gen a12=gcd(a1,a2,contextptr);
2795 	    if (!lvarx(a12,v.back()).empty()){
2796 	      gen res1=_solve(makesequence(symb_equal(a12,0),v.back()),contextptr);
2797 	      gen res2=_solve(makesequence(symb_equal(ratnormal(a1/a12,contextptr),ratnormal(a2/a12,contextptr)),v.back()),contextptr);
2798 	      return gen(mergevecteur(gen2vecteur(res1),gen2vecteur(res2)),res1.subtype);
2799 	    }
2800 	    arg1=ln(simplify(a1,contextptr),contextptr)-ln(simplify(a2,contextptr),contextptr);
2801 	    if (lvarx(arg1,v.back()).size()>1){
2802 	      arg1=lnexpand(arg1,contextptr);
2803 	      if (!lop(arg1,at_pow).empty()){
2804 		arg1=lnexpand(a1-a2,contextptr);
2805 		if (lvarx(arg1,v.back()).size()>1)
2806 		  arg1=a1-a2;
2807 	      }
2808 	    }
2809 	  }
2810 	  w=lop(lv,at_exp);
2811 	  if (w.size()>1){
2812 	    arg1=lnexpand(ln(simplify(a1,contextptr),contextptr)-ln(simplify(a2,contextptr),contextptr),contextptr);
2813 	    // check if ln trick worked, for example it does not for:
2814 	    // f(x):=exp(x);g(x):=2*exp(x/2)-1; solve(f(x)=g(x))
2815 	    if (!lop(arg1,at_exp).empty())
2816 	      arg1=a1-a2;
2817 	  }
2818 	}
2819       }
2820 #endif
2821     }
2822     arg1=apply(arg1,equal2diff);
2823     if (arg1.is_symb_of_sommet(at_program))
2824       return gensizeerr(contextptr);
2825     arg1=subst(arg1,undef,identificateur("undef_"),true,contextptr);
2826     vecteur _res=solve(arg1,v.back(),isolate_mode,contextptr);
2827     if (_res.empty() || _res.front().type==_STRNG || is_undef(_res))
2828       return _res;
2829     // quick check if back substitution returns undef
2830     const_iterateur it=_res.begin(),itend=_res.end();
2831     vecteur res;
2832     for (;it!=itend;++it){
2833       if (is_inequation(*it) || it->is_symb_of_sommet(at_ou) || it->is_symb_of_sommet(at_and)){
2834 	res.push_back(*it);
2835 	continue;
2836       }
2837       if (!check(v.back(),*it,v.back(),*it,contextptr))
2838 	continue;
2839       gen tmp=subst(arg1,v.back(),*it,false,contextptr);
2840       tmp=eval(tmp,1,contextptr);
2841       if (!is_undef(tmp) && !is_inf(tmp)){
2842 	vecteur itv=lop(*it,at_ln); // check added so that solve(2^x=8,x) returns 3 instead of ln(8)/ln(2)
2843 	if (itv.size()>1)
2844 	  res.push_back(simplify(*it,contextptr));
2845 	else
2846 	  res.push_back(*it);
2847       }
2848     }
2849     // if (is_fully_numeric(res))
2850     if (!v.empty() && v.back().type!=_VECT &&
2851 	lidnt(evalf(res,1,contextptr)).empty()
2852 	// lidnt(res).empty() && is_zero(im(res,contextptr),contextptr)
2853 	)
2854       res=protect_sort(res,contextptr);
2855     if (!xcas_mode(contextptr) && calc_mode(contextptr)!=1)
2856       return gen(res,_LIST__VECT);
2857     gen vres=solvepostprocess(res,v[1],contextptr);
2858     return vres;
2859   }
_solve(const gen & args,GIAC_CONTEXT)2860   gen _solve(const gen & args,GIAC_CONTEXT){
2861     if ( args.type==_STRNG && args.subtype==-1) return  args;
2862     gen res=_solve_uncompressed(args,contextptr);
2863     if (res.type==_VECT){
2864       vecteur v=*res._VECTptr;
2865       comprim(v);
2866       res=gen(v,res.subtype);
2867     }
2868     return res;
2869   }
2870   static const char _solve_s []="solve";
2871   static define_unary_function_eval_quoted (__solve,&_solve,_solve_s);
2872   define_unary_function_ptr5( at_solve ,alias_at_solve,&__solve,_QUOTE_ARGUMENTS,true);
2873 
_realproot(const gen & e,GIAC_CONTEXT)2874   gen _realproot(const gen & e,GIAC_CONTEXT) {
2875     gen g=_proot(e,contextptr);
2876     if (g.type!=_VECT)
2877       return g;
2878     vecteur w;
2879     for (unsigned i=0;i<g._VECTptr->size();++i){
2880       gen tmp=(*g._VECTptr)[i];
2881       if (is_zero(im(tmp,contextptr),contextptr))
2882 	w.push_back(tmp);
2883     }
2884     return w;
2885   }
2886   static const char _realproot_s []="realproot";
2887   static define_unary_function_eval (__realproot,&_realproot,_realproot_s);
2888   define_unary_function_ptr5( at_realproot ,alias_at_realproot,&__realproot,0,true);
2889 
2890   // bisection solver on a0,b0 with a sign reversal inside
bisection_solver_sr(const gen & equation,const gen & var,const gen & a0,const gen & b0,int & iszero,double faorig,double fborig,GIAC_CONTEXT)2891   static vecteur bisection_solver_sr(const gen & equation,const gen & var,const gen & a0,const gen &b0,int & iszero,double faorig,double fborig,GIAC_CONTEXT){
2892     gen a=a0,b=b0;
2893     gen fa=subst(equation,var,a,false,contextptr);
2894     fa=eval(fa,1,contextptr);
2895     gen fb=subst(equation,var,b,false,contextptr);
2896     fb=eval(fb,1,contextptr);
2897     if (is_exactly_zero(fa)){
2898       iszero=1;
2899       return vecteur(1,a);
2900     }
2901     if (is_exactly_zero(fb)){
2902       iszero=1;
2903       return vecteur(1,b);
2904     }
2905     // sign change in [a,b]
2906     // number of steps
2907     gen n=ln(abs(b-a,contextptr),contextptr)-ln(max(abs(b,contextptr),abs(a,contextptr),contextptr),contextptr)+53;
2908     n=_floor(n/0.69,contextptr);
2909     for (int i=0;i<n.val;i++){
2910       gen c=(a+b)/2,fc;
2911 #ifndef NO_STDEXCEPT
2912       try {
2913 #endif
2914 	fc=subst(equation,var,c,false,contextptr);
2915 	fc=eval(fc,1,contextptr);
2916 #ifndef NO_STDEXCEPT
2917       } catch (std::runtime_error & ){
2918 	last_evaled_argptr(contextptr)=NULL;
2919 	iszero=-1;
2920 	return vecteur(0);
2921       }
2922 #endif
2923       if (fc.type!=_DOUBLE_){
2924 	iszero=-1;
2925 	if (fa.type==_DOUBLE_){
2926 	  b=c; fb=fc;
2927 	  continue;
2928 	}
2929 	if (fb.type==_DOUBLE_){
2930 	  a=c; fa=fc;
2931 	  continue;
2932 	}
2933 	return vecteur(1,c);
2934       }
2935       if (is_exactly_zero(fc)){
2936 	iszero=1;
2937 	return vecteur(1,c);
2938       }
2939       if (fa._DOUBLE_val*fc._DOUBLE_val>0){
2940 	a=c;
2941 	fa=fc;
2942       }
2943       else {
2944 	b=c;
2945 	fb=fc;
2946       }
2947     }
2948     iszero=2;
2949     if (fa.type==_DOUBLE_ && fb.type==_DOUBLE_ && fabs(fa._DOUBLE_val*fb._DOUBLE_val/faorig/fborig)<1e-10)
2950       iszero=1;
2951     return vecteur(1,(a+b)/2);
2952   }
2953 
2954   // also sets iszero to -2 if endpoints have same sign, -1 if err or undef
2955   // 1 if zero found, 2 if sign reversal (no undef),
2956   // set iszero to 0 on entry if only one root
2957   // set to -1 or positive if you want many sign reversals
2958   // -1 means no step specified, positive means nstep specified
bisection_solver(const gen & equation,const gen & var,const gen & a0,const gen & b0,int & iszero,GIAC_CONTEXT)2959   vecteur bisection_solver(const gen & equation,const gen & var,const gen & a0,const gen &b0,int & iszero,GIAC_CONTEXT){
2960     bool onlyone=iszero==0;
2961     int nstep=gnuplot_pixels_per_eval;
2962     if (iszero>0)
2963       nstep=iszero;
2964     else {
2965       if (has_op(equation,*at_tan))
2966 	nstep *= 16;
2967     }
2968     iszero=0;
2969     gen a(is_inf(a0)?gnuplot_xmin:evalf_double(a0,1,contextptr)),b(is_inf(b0)?gnuplot_xmax:evalf_double(b0,1,contextptr));
2970     if (is_strictly_greater(a,b,contextptr))
2971       swapgen(a,b);
2972     gen fa,fb,decal=(b-a)/nstep;
2973     if (is_zero(decal,contextptr))
2974       return vecteur(0);
2975     while (a+decal==a || b-decal==b){
2976       decal=2*decal;
2977     }
2978     vecteur res;
2979 #ifndef NO_STDEXCEPT
2980     try {
2981 #endif
2982       for (;is_strictly_greater(b,a,contextptr);){
2983 	fa=subst(equation,var,a,false,contextptr);
2984 	fa=eval(fa,1,contextptr);
2985 	if (!is_zero(fa,contextptr))
2986 	  break;
2987 	if (onlyone)
2988 	  return vecteur(1,a);
2989 	if (is_exactly_zero(a))
2990 	  res.push_back(a);
2991 	a +=decal;
2992       }
2993       fb=fa;
2994       for (;is_strictly_greater(b,a,contextptr);){
2995 	fb=subst(equation,var,b,false,contextptr);
2996 	fb=eval(fb,1,contextptr);
2997 	if (!is_zero(fb,contextptr))
2998 	  break;
2999 	if (onlyone)
3000 	  return vecteur(1,b);
3001 	if (is_exactly_zero(b))
3002 	  res.push_back(b);
3003 	b -=decal;
3004       }
3005 #ifndef NO_STDEXCEPT
3006     } catch (std::runtime_error & ){
3007       last_evaled_argptr(contextptr)=NULL;
3008       iszero=-1;
3009       return vecteur(0);
3010     }
3011 #endif
3012     int ntries=40;
3013     gen ab=(b-a)/ntries;
3014     if (fb.type!=_DOUBLE_ || is_undef(fb)){
3015       for (int i=0;i<ntries;++i){
3016 	b -= ab;
3017 	fb=subst(equation,var,b,false,contextptr);
3018 	fb=eval(fb,1,contextptr);
3019 	if (fb.type==_DOUBLE_)
3020 	  break;
3021       }
3022     }
3023     ab=(b-a)/ntries;
3024     if (fb.type==_DOUBLE_ && (fa.type!=_DOUBLE_ || is_undef(fa))){
3025       for (int i=0;i<ntries;++i){
3026 	a += ab;
3027 	fa=subst(equation,var,a,false,contextptr);
3028 	fa=eval(fa,1,contextptr);
3029 	if (fa.type==_DOUBLE_)
3030 	  break;
3031       }
3032     }
3033     if (fa.type!=_DOUBLE_ || fb.type!=_DOUBLE_){
3034       iszero=-1;
3035       return vecteur(0);
3036     }
3037     double faorig=fa._DOUBLE_val,fborig=fb._DOUBLE_val;
3038     if (onlyone){
3039       if (fa._DOUBLE_val*fb._DOUBLE_val>0){
3040 	bool test1=fa._DOUBLE_val>0;
3041 	bool found=false;
3042 	gen b0=b;
3043 	// discretization of [a,b] searching a sign reversal
3044 	for (int i=1;i<=6;i++){
3045 	  int ntest=1 << (i-1);
3046 	  gen decal=(b0-a)/gen(1 << i);
3047 	  b=a+decal;
3048 	  // double bd=b._DOUBLE_val;
3049 	  decal=2*decal;
3050 	  for (int j=0;j<ntest;j++,b+=decal){
3051 #ifndef NO_STDEXCEPT
3052 	    try {
3053 #endif
3054 	      fb=subst(equation,var,b,false,contextptr);
3055 	      fb=eval(fb,1,contextptr);
3056 #ifndef NO_STDEXCEPT
3057 	    } catch (std::runtime_error & ){
3058 	      last_evaled_argptr(contextptr)=NULL;
3059 	      iszero=-1;
3060 	      return vecteur(0);
3061 	    }
3062 #endif
3063 	    if (fb.type!=_DOUBLE_){
3064 	      iszero=-1;
3065 	      return vecteur(0);
3066 	    }
3067 	    double fbd=fb._DOUBLE_val;
3068 	    bool test2=fbd>0;
3069 	    if (test1 ^ test2){
3070 	      found=true;
3071 	      break;
3072 	    }
3073 	  }
3074 	  if (found)
3075 	    break;
3076 	}
3077 	if (!found){
3078 	  iszero=-2;
3079 	  return vecteur(0);
3080 	}
3081       }
3082       return bisection_solver_sr(equation,var,a,b,iszero,faorig,fborig,contextptr);
3083     }
3084     // we are searching many zeros in this interval, cutting it in small intervals
3085     // and searching a sign reversal in each
3086     decal=(b-a)/nstep;
3087     b=a+decal;
3088     for (int i=0;i<nstep;++i, a=b, fa=fb,b+=decal){
3089 #ifndef NO_STDEXCEPT
3090       try {
3091 #endif
3092 	fb=subst(equation,var,b,false,contextptr);
3093 	fb=eval(fb,1,contextptr);
3094 #ifndef NO_STDEXCEPT
3095       } catch (std::runtime_error & ){
3096 	last_evaled_argptr(contextptr)=NULL;
3097 	continue;
3098       }
3099 #endif
3100       if (fb.type!=_DOUBLE_)
3101 	continue;
3102       if (fb._DOUBLE_val==0){
3103 	res.push_back(b);
3104 	continue;
3105       }
3106       if (fa._DOUBLE_val*fb._DOUBLE_val>0)
3107 	continue;
3108       vecteur addres=bisection_solver_sr(equation,var,a,b,iszero,faorig,fborig,contextptr);
3109       if (iszero==1)
3110 	res=mergevecteur(res,addres);
3111     }
3112     comprim(res);
3113     return res;
3114   }
3115 
set_nearest_first(const gen & guess,vecteur & res,GIAC_CONTEXT)3116   static void set_nearest_first(const gen & guess,vecteur & res,GIAC_CONTEXT){
3117     int s=int(res.size());
3118     if (s<2)
3119       return;
3120     int pos=0,i;
3121     gen minabs=evalf_double(abs(res[0]-guess,contextptr),1,contextptr);
3122     for (i=1;i<s;++i){
3123       gen curabs=evalf_double(abs(res[i]-guess,contextptr),1,contextptr);
3124       if (is_strictly_greater(minabs,curabs,contextptr)){
3125 	minabs=curabs;
3126 	pos=i;
3127       }
3128     }
3129     if (pos){
3130       minabs=res[0];
3131       res[0]=res[pos];
3132       res[pos]=minabs;
3133     }
3134   }
3135 
is_idnt_function38(const gen & g)3136   bool is_idnt_function38(const gen & g){
3137     if (g.type!=_IDNT)
3138       return false;
3139     const char * ch = g._IDNTptr->id_name;
3140     if (strlen(ch)==2 && ch[1]>='0' && ch[1]<='9'){
3141       switch (ch[0]){
3142       case 'F': case 'X': case 'Y': case 'R':
3143 	return true;
3144       }
3145     }
3146     return false;
3147   }
3148 
lidnt_solve(const gen & g,vecteur & res)3149   void lidnt_solve(const gen &g,vecteur & res){
3150     vecteur v=lidnt(g);
3151     for (unsigned i=0;i<v.size();++i){
3152       if (!is_idnt_function38(v[i]))
3153 	res.push_back(v[i]);
3154     }
3155   }
3156 
lidnt_solve(const gen & g)3157   vecteur lidnt_solve(const gen & g){
3158     vecteur res;
3159     lidnt_solve(g,res);
3160     return res;
3161   }
3162 
lidnt_function38(const gen & g,vecteur & res)3163   void lidnt_function38(const gen &g,vecteur & res){
3164     vecteur v=lidnt(g);
3165     for (unsigned i=0;i<v.size();++i){
3166       if (is_idnt_function38(v[i]))
3167 	res.push_back(v[i]);
3168     }
3169   }
3170 
lidnt_function38(const gen & g)3171   vecteur lidnt_function38(const gen & g){
3172     vecteur res;
3173     lidnt_function38(g,res);
3174     return res;
3175   }
3176 
3177   // Find zero or extrema of equation for variable near guess in real mode
3178   // For polynomial input, returns all zeros or extrema
3179   // On entry type=0 for zeros, =1 for extrema
3180   //  guess might be a single value or vecteur with 2 values (an interval)
3181   //  bisection is used if guess is an interval
3182   //  if guess is a single value, guess is checked to be in [xmin,xmax]
3183   // returns 0 if zero(s) were found, 1 if extrema found, 2 if sign reversal found
solve_zero_extremum(const gen & equation0,const gen & variable0,const gen & guess,double xmin,double xmax,int & type,GIAC_CONTEXT)3184   vecteur solve_zero_extremum(const gen & equation0,const gen & variable0,const gen & guess,double xmin, double xmax,int & type,GIAC_CONTEXT){
3185     if (variable0.type!=_IDNT)
3186       return vecteur(1,gentypeerr(contextptr));
3187     vecteur l0(1,variable0);
3188     lidnt(equation0,l0,false);
3189     vecteur l1=gen2vecteur(eval(l0,1,contextptr));
3190     identificateur id_solve("aspen_x");
3191     gen variable(id_solve);
3192     l1.front()=variable;
3193     gen eq0=subst(equation0,l0,l1,false,contextptr),eq;
3194     // ofstream of("log"); of << equation0 << '\n' << eq0 << '\n' << l0 << '\n' << l1 << '\n'; of.close();
3195     eq0=remove_equal(eval(eq0,1,contextptr));
3196     vecteur res;
3197     if (is_undef(eq0) || is_inf(eq0)){
3198       type=-2;
3199       return res;
3200     }
3201     gen a,b;
3202     if (is_linear_wrt(eq0,variable,a,b,contextptr)){
3203       a=ratnormal(a,contextptr);
3204       if (is_zero(a,contextptr)){
3205 	type=-1;
3206 	return 0;
3207       }
3208       type=0;
3209       a=-b/a;
3210       b=im(a,contextptr);
3211       if (is_zero(b,contextptr))
3212 	res=vecteur(1,re(a,contextptr));
3213       else
3214 	res=vecteur(1,undef);
3215       return res;
3216     }
3217     bool interval=false;
3218     a=xmin;b=xmax;
3219     if (guess.type==_VECT){
3220       if (guess._VECTptr->size()!=2)
3221 	return vecteur(1,gendimerr(contextptr));
3222       // Find in [a,b]
3223       interval=true;
3224       a=guess._VECTptr->front();
3225       b=guess._VECTptr->back();
3226     }
3227     else {
3228       gen tmp=evalf_double(guess,1,contextptr);
3229       if (tmp.type==_DOUBLE_){
3230 	if (tmp._DOUBLE_val>xmax)
3231 	  b=tmp;
3232 	if (tmp._DOUBLE_val<xmin)
3233 	  a=tmp;
3234       }
3235     }
3236     // Check if equation is smooth, if not, find an interval for solving
3237 #ifndef NO_STDEXCEPT
3238     try {
3239 #endif
3240       eq=derive(eq0,variable,contextptr);
3241       if (is_undef(eq))
3242 	interval=true;
3243 #ifndef NO_STDEXCEPT
3244     } catch (std::runtime_error &){
3245       last_evaled_argptr(contextptr)=NULL;
3246       eq=undef;
3247       interval=true;
3248     }
3249 #endif
3250     // ofstream of("log"); of << eq << " " << diffeq << '\n'; of.close();
3251     if (is_zero(ratnormal(eq,contextptr),contextptr)){
3252       type=-1;
3253       return res;
3254     }
3255     if (type==0){ // Find zero
3256       if (interval){
3257 	int iszero=0;
3258 	res=bisection_solver(eq0,*variable._IDNTptr,a,b,iszero,contextptr);
3259 	if (iszero<=0)
3260 	  res.clear();
3261 	if (iszero==2)
3262 	  type=2;
3263       }
3264       else {
3265 #ifndef NO_STDEXCEPT
3266 	try {
3267 #endif
3268 	  if (lvar(eq0)==vecteur(1,variable)){
3269 	    res=solve(eq0,*variable._IDNTptr,0,contextptr);
3270 	    set_nearest_first(guess,res,contextptr);
3271 	    if (res.empty())
3272 	      type=1;
3273 	  }
3274 #ifndef NO_STDEXCEPT
3275 	}
3276 	catch (std::runtime_error & ){
3277 	  last_evaled_argptr(contextptr)=NULL;
3278 	  res.clear();
3279 	}
3280 #endif
3281       }
3282       if (!res.empty() && is_undef(res.front()))
3283 	res.clear();
3284       if (type==0 && res.empty()){
3285 	gen sol=_fsolve(gen(makevecteur(evalf(eq0,1,contextptr),symbolic(at_equal,makesequence(variable,guess))),_SEQ__VECT),contextptr);
3286 	sol=evalf2bcd_nock(sol,1,contextptr);
3287 	if (sol.type==_VECT){
3288 	  res=*sol._VECTptr;
3289 	  set_nearest_first(guess,res,contextptr);
3290 	}
3291 	else {
3292 	  if (sol.type==_FLOAT_)
3293 	    res=vecteur(1,sol);
3294 	}
3295       }
3296       if (!res.empty() && !is_undef(res))
3297 	return *eval(res,1,contextptr)._VECTptr;
3298     }
3299     if (type==0)
3300       type=1;
3301     if (type==1 && !is_undef(eq)){ // Find extremum
3302       if (interval){
3303 	int iszero=0;
3304 	res=bisection_solver(eq,variable,a,b,iszero,contextptr);
3305 	if (iszero<=0)
3306 	  res.clear();
3307       }
3308       else {
3309 #ifndef NO_STDEXCEPT
3310 	try {
3311 #endif
3312 	  if (lvar(eq)==vecteur(1,variable)){
3313 	    res=solve(eq,*variable._IDNTptr,0,contextptr);
3314 	    if (!res.empty() && is_undef(res.front()))
3315 	      res.clear();
3316 	    if (res.empty())
3317 	      type=2;
3318 	    else
3319 	      set_nearest_first(guess,res,contextptr);
3320 	  }
3321 #ifndef NO_STDEXCEPT
3322 	}
3323 	catch (std::runtime_error & ){
3324 	  last_evaled_argptr(contextptr)=NULL;
3325 	  res.clear();
3326 	}
3327 #endif
3328       }
3329       if (!res.empty() && is_undef(res.front()))
3330 	res.clear();
3331       if (type==1 && res.empty()){
3332 	gen sol=_fsolve(gen(makevecteur(evalf(eq,1,contextptr),symbolic(at_equal,makesequence(variable,guess))),_SEQ__VECT),contextptr);
3333 	sol=evalf2bcd_nock(sol,1,contextptr);
3334 	if (sol.type==_VECT){
3335 	  res=*sol._VECTptr;
3336 	  set_nearest_first(guess,res,contextptr);
3337 	}
3338 	else {
3339 	  if (sol.type==_FLOAT_)
3340 	    res=vecteur(1,sol);
3341 	}
3342       }
3343       if (!res.empty() && !is_undef(res))
3344 	return *eval(res,1,contextptr)._VECTptr;
3345     }
3346     type=2; // Find singularities
3347     res=find_singularities(eq0,*variable._IDNTptr,0,contextptr);
3348     if (res.empty()) type=3;
3349     return *eval(res,1,contextptr)._VECTptr;
3350   }
solve_zero_extremum(const gen & equation0,const gen & variable,const gen & guess,int & type,GIAC_CONTEXT)3351   vecteur solve_zero_extremum(const gen & equation0,const gen & variable,const gen & guess,int & type,GIAC_CONTEXT){
3352 #ifndef NO_STDEXCEPT
3353     try {
3354 #endif
3355       return solve_zero_extremum(equation0,variable,guess,gnuplot_xmin,gnuplot_xmax,type,contextptr);
3356 #ifndef NO_STDEXCEPT
3357     } catch(std::runtime_error & ){
3358       last_evaled_argptr(contextptr)=NULL;
3359       type=-2;
3360       return vecteur(1,undef);
3361     }
3362 #endif
3363   }
_solve_zero_extremum(const gen & args,GIAC_CONTEXT)3364   gen _solve_zero_extremum(const gen & args,GIAC_CONTEXT){
3365     if ( args.type==_STRNG && args.subtype==-1) return  args;
3366     vecteur v(solvepreprocess(args,complex_mode(contextptr),contextptr));
3367     int s=int(v.size());
3368     if (s<3 || v[1].type!=_IDNT)
3369       return gensizeerr(contextptr);
3370     int type=0;
3371     if (s==4 && v[3].type==_INT_)
3372       type=v[3].val;
3373     vecteur res=solve_zero_extremum(v[0],v[1],v[2],type,contextptr);
3374     return makevecteur(type,res);
3375   }
3376   static const char _solve_zero_extremum_s []="solve_zero_extremum";
3377   static define_unary_function_eval_quoted (__solve_zero_extremum,&_solve_zero_extremum,_solve_zero_extremum_s);
3378   define_unary_function_ptr5( at_solve_zero_extremum ,alias_at_solve_zero_extremum,&__solve_zero_extremum,_QUOTE_ARGUMENTS,true);
3379 
nan()3380   double nan(){
3381     double x=0.0;
3382     return 0.0/x;
3383   }
3384 #ifdef HAVE_LIBGSL
3385   // p should point a vector with elements the expression f(x) and x
3386   // OR with f(x), f'(x) and x
my_f(double x0,void * p)3387   static double my_f (double x0, void * p) {
3388     gen & params = * ((gen *)p) ;
3389 #ifdef DEBUG_SUPPORT
3390     if ( (params.type!=_VECT) || (params._VECTptr->size()<2))
3391       setsizeerr(gettext("solve.cc/my_f"));
3392 #endif	// DEBUG_SUPPORT
3393     gen & f=params._VECTptr->front();
3394     gen & x=params._VECTptr->back();
3395     gen res=evalf(subst(f,x,x0,false,context0),1,context0);
3396     if (res.type==_REAL)
3397       res=evalf_double(res,1,context0);
3398 #ifdef DEBUG_SUPPORT
3399     if (res.type>_IDNT)
3400       setsizeerr();
3401 #endif
3402     if (res.type!=_DOUBLE_)
3403       return nan();
3404     else
3405       return res._DOUBLE_val;
3406   }
3407 
my_df(double x0,void * p)3408   static double my_df (double x0, void * p) {
3409     gen & params = * ((gen *)p) ;
3410 #ifdef DEBUG_SUPPORT
3411     if ( (params.type!=_VECT) || (params._VECTptr->size()!=3))
3412       setsizeerr(gettext("solve.cc/my_df"));
3413 #endif	// DEBUG_SUPPORT
3414     gen & f=(*params._VECTptr)[1];
3415     gen & x=params._VECTptr->back();
3416     gen res=evalf_double(subst(f,x,x0,false,context0),1,context0);
3417 #ifdef DEBUG_SUPPORT
3418     if (res.type>_IDNT)
3419       setsizeerr();
3420 #endif
3421     if (res.type!=_DOUBLE_)
3422       return nan();
3423     else
3424       return res._DOUBLE_val;
3425   }
3426 
my_fdf(double x0,void * p,double * fx,double * dfx)3427   static void my_fdf (double x0, void * p,double * fx,double * dfx) {
3428     gen & params = * ((gen *)p) ;
3429 #ifdef DEBUG_SUPPORT
3430     if ( (params.type!=_VECT) || (params._VECTptr->size()!=3))
3431       setsizeerr(gettext("solve.cc/my_fdf"));
3432 #endif	// DEBUG_SUPPORT
3433     gen & f=params._VECTptr->front();
3434     gen & df=(*params._VECTptr)[1];
3435     gen & x=params._VECTptr->back();
3436     gen res=evalf_double(subst(f,x,x0,false,context0),1,context0);
3437     if (res.type!=_DOUBLE_)
3438       *fx=nan();
3439     else
3440       *fx=res._DOUBLE_val;
3441     res=evalf_double(subst(df,x,x0,false,context0),1,context0);
3442     if (res.type!=_DOUBLE_)
3443       *dfx=nan();
3444     else
3445       *dfx=res._DOUBLE_val;
3446   }
3447 
my_F(const gsl_vector * x0,void * p,gsl_vector * F)3448   static int my_F (const gsl_vector * x0, void * p,gsl_vector * F) {
3449     gen & params = * ((gen *)p) ;
3450 #ifdef DEBUG_SUPPORT
3451     if ( (params.type!=_VECT) || (params._VECTptr->size()<2))
3452       setsizeerr(gettext("solve.cc/my_F"));
3453 #endif	// DEBUG_SUPPORT
3454     gen & f=params._VECTptr->front();
3455     gen & x=params._VECTptr->back();
3456     gen res=evalf_double(subst(f,x,gsl_vector2vecteur(x0),false,context0),1,context0);
3457     if (res.type!=_VECT)
3458       return !GSL_SUCCESS;
3459     return vecteur2gsl_vector(*res._VECTptr,F,context0);
3460   }
3461 
my_dF(const gsl_vector * x0,void * p,gsl_matrix * J)3462   static int my_dF (const gsl_vector *x0, void * p,gsl_matrix * J) {
3463     gen & params = * ((gen *)p) ;
3464 #ifdef DEBUG_SUPPORT
3465     if ( (params.type!=_VECT) || (params._VECTptr->size()!=3))
3466       setsizeerr(gettext("solve.cc/my_dF"));
3467 #endif	// DEBUG_SUPPORT
3468     gen & f=(*params._VECTptr)[1];
3469     gen & x=params._VECTptr->back();
3470     gen res=evalf_double(subst(f,x,gsl_vector2vecteur(x0),false,context0),1,context0);
3471     if (res.type!=_VECT)
3472       return !GSL_SUCCESS;
3473     else
3474       return matrice2gsl_matrix(*res._VECTptr,J,context0);
3475   }
3476 
my_FdF(const gsl_vector * x0,void * p,gsl_vector * fx,gsl_matrix * dfx)3477   static int my_FdF (const gsl_vector * x0, void * p,gsl_vector * fx,gsl_matrix * dfx) {
3478     gen & params = * ((gen *)p) ;
3479 #ifdef DEBUG_SUPPORT
3480     if ( (params.type!=_VECT) || (params._VECTptr->size()!=3))
3481       setsizeerr(gettext("solve.cc/my_FdF"));
3482 #endif	// DEBUG_SUPPORT
3483     gen & f=params._VECTptr->front();
3484     gen & df=(*params._VECTptr)[1];
3485     gen & x=params._VECTptr->back();
3486     gen g0=gsl_vector2vecteur(x0);
3487     gen res=evalf_double(subst(f,x,g0,false,context0),1,context0);
3488     if (res.type!=_VECT)
3489       return !GSL_SUCCESS;
3490     int ires=vecteur2gsl_vector(*res._VECTptr,fx,context0);
3491     if (ires!=GSL_SUCCESS)
3492       return !GSL_SUCCESS;
3493     res=evalf_double(subst(df,x,g0,false,context0),1,context0);
3494     if (res.type!=_VECT)
3495       return !GSL_SUCCESS;
3496     return matrice2gsl_matrix(*res._VECTptr,dfx,context0);
3497   }
3498 
msolve(const gen & f,const vecteur & vars,const vecteur & g,int method,double eps,GIAC_CONTEXT)3499   gen msolve(const gen & f,const vecteur & vars,const vecteur & g,int method,double eps,GIAC_CONTEXT){
3500     vecteur guess(g);
3501     bool with_derivative=false;
3502     int dim=vars.size();
3503     switch (method){
3504     case _NEWTONJ_SOLVER: case _HYBRIDSJ_SOLVER: case _HYBRIDJ_SOLVER:
3505       with_derivative=true;
3506       break;
3507     case _DNEWTON_SOLVER: case _HYBRIDS_SOLVER: case _HYBRID_SOLVER:
3508       with_derivative=false;
3509       break;
3510     }
3511     if (with_derivative){
3512       gen difff=derive(f,vars,contextptr);
3513       if (is_undef(difff) || difff.type!=_VECT)
3514 	return vecteur(vars.size(),undef);
3515       gen params(makevecteur(f,mtran(*difff._VECTptr),vars));
3516       gsl_multiroot_function_fdf FDF;
3517       FDF.f=&my_F;
3518       FDF.df=&my_dF;
3519       FDF.fdf=&my_FdF;
3520       FDF.n=dim;
3521       FDF.params=&params;
3522       const gsl_multiroot_fdfsolver_type * T=0;
3523       switch (method){
3524       case _NEWTONJ_SOLVER:
3525 	T=gsl_multiroot_fdfsolver_gnewton;
3526 	break;
3527       case _HYBRIDSJ_SOLVER:
3528 	T=gsl_multiroot_fdfsolver_hybridsj;
3529 	break;
3530       case _HYBRIDJ_SOLVER:
3531 	T=gsl_multiroot_fdfsolver_hybridj;
3532 	break;
3533       }
3534       gsl_multiroot_fdfsolver * s= gsl_multiroot_fdfsolver_alloc (T, dim);
3535       gsl_vector * X=vecteur2gsl_vector(guess,contextptr);
3536       gsl_multiroot_fdfsolver_set (s, &FDF, X);
3537       int maxiter=SOLVER_MAX_ITERATE,res=0;
3538       vecteur oldguess;
3539       for (;maxiter;--maxiter){
3540 	oldguess=guess;
3541 	res=gsl_multiroot_fdfsolver_iterate(s);
3542 	if ( (res==GSL_EBADFUNC) || (res==GSL_ENOPROG) )
3543 	  break;
3544 	guess=gsl_vector2vecteur(gsl_multiroot_fdfsolver_root(s));
3545 	if (is_strictly_greater(eps,abs(guess-oldguess,contextptr),contextptr))
3546 	  break;
3547       }
3548       gsl_multiroot_fdfsolver_free(s);
3549       if ( (res==GSL_EBADFUNC) || (res==GSL_ENOPROG) )
3550 	return vecteur(dim,gensizeerr(contextptr));
3551       return guess;
3552     }
3553     else {
3554       gen params(makevecteur(f,vars));
3555       gsl_multiroot_function F;
3556       F.f=&my_F;
3557       F.n=dim;
3558       F.params=&params;
3559       const gsl_multiroot_fsolver_type * T=0;
3560       switch (method){
3561       case _DNEWTON_SOLVER:
3562 	T=gsl_multiroot_fsolver_dnewton;
3563 	break;
3564       case _HYBRIDS_SOLVER:
3565 	T=gsl_multiroot_fsolver_hybrids;
3566 	break;
3567       case _HYBRID_SOLVER:
3568 	T=gsl_multiroot_fsolver_hybrid;
3569 	break;
3570       }
3571       gsl_multiroot_fsolver * s= gsl_multiroot_fsolver_alloc (T, dim);
3572       gsl_vector * X=vecteur2gsl_vector(guess,contextptr);
3573       gsl_multiroot_fsolver_set (s, &F, X);
3574       int maxiter=SOLVER_MAX_ITERATE,res=0;
3575       vecteur oldguess;
3576       for (;maxiter;--maxiter){
3577 	oldguess=guess;
3578 	res=gsl_multiroot_fsolver_iterate(s);
3579 	if ( (res==GSL_EBADFUNC) || (res==GSL_ENOPROG) )
3580 	  break;
3581 	guess=gsl_vector2vecteur(gsl_multiroot_fsolver_root(s));
3582 	if (is_strictly_greater(eps,abs(guess-oldguess,contextptr),contextptr))
3583 	  break;
3584       }
3585       gsl_multiroot_fsolver_free(s);
3586       if ( (res==GSL_EBADFUNC) || (res==GSL_ENOPROG) )
3587 	return vecteur(1,gensizeerr(contextptr));
3588       return guess;
3589     }
3590   }
3591 #endif // HAVE_LIBGSL
3592 
3593   // fsolve(expr,var[,interval/guess,method])
_fsolve(const gen & args,GIAC_CONTEXT)3594   gen _fsolve(const gen & args,GIAC_CONTEXT){
3595     if ( args.type==_STRNG && args.subtype==-1) return  args;
3596     if (calc_mode(contextptr)==1 && args.type!=_VECT)
3597       return _fsolve(makesequence(args,ggb_var(args)),contextptr);
3598     vecteur v(plotpreprocess(args,contextptr));
3599     gen res=undef;
3600     res=in_fsolve(v,contextptr);
3601     if (calc_mode(contextptr)!=1)
3602       return res;
3603     // ggb always in a list
3604     if (res.type!=_VECT)
3605       res=vecteur(1,res);
3606     return res;
3607   }
3608 
3609   // same as lidnt but removes mute variable in int/sum/fsolve
3610   // FIXME: Home functions names should be removed from the list
true_lidnt(const gen & g)3611   vecteur true_lidnt(const gen & g){
3612     vecteur v=lvar(g);
3613     vecteur w;
3614     for (unsigned i=0;i<v.size();++i){
3615       if (v[i].is_symb_of_sommet(at_fsolve) ||
3616 	  v[i].is_symb_of_sommet(at_integrate) ||
3617 	  v[i].is_symb_of_sommet(at_sum) ||
3618 	  v[i].is_symb_of_sommet(at_product)
3619 	  ){
3620 	if (v[i]._SYMBptr->feuille.type!=_VECT || v[i]._SYMBptr->feuille._VECTptr->size()<2)
3621 	  continue;
3622 	gen v1=(*v[i]._SYMBptr->feuille._VECTptr)[1];
3623 	if (v1.is_symb_of_sommet(at_equal) && v1._SYMBptr->feuille.type==_VECT && !v1._SYMBptr->feuille._VECTptr->empty())
3624 	  v1=v1._SYMBptr->feuille._VECTptr->front();
3625 	vecteur tmp=true_lidnt(v[i]._SYMBptr->feuille);
3626 	if (int pos=equalposcomp(tmp,v1))
3627 	  tmp.erase(tmp.begin()+pos-1);
3628 	w=mergevecteur(w,tmp);
3629 	continue;
3630       }
3631       w.push_back(v[i]);
3632     }
3633     v=lidnt(w);
3634     w.clear();
3635     for (unsigned i=0;i<v.size();++i){
3636       if (!is_inf(v[i]) && !is_undef(v[i]))
3637 	w.push_back(v[i]);
3638     }
3639     return w;
3640   }
3641 
in_fsolve(vecteur & v,GIAC_CONTEXT)3642   gen in_fsolve(vecteur & v,GIAC_CONTEXT){
3643     if (is_undef(v))
3644       return v;
3645     bool interv=false;
3646     double gsl_eps=abs_calc_mode(contextptr)==38?1e-5:epsilon(contextptr);
3647     int s=int(v.size());
3648     if (s && v.back()==at_interval){
3649       --s;
3650       v.pop_back();
3651       interv=true;
3652     }
3653     if (s<2)
3654       return gentoofewargs("fsolve");
3655     if (v[0].is_symb_of_sommet(at_program))
3656       swapgen(v[0],v[1]);
3657     if (v[1].is_symb_of_sommet(at_program)){ // scilab-like syntax
3658       gen var(identificateur("fsolve_tmpvar"));
3659       v.insert(v.begin()+1,var);
3660       swapgen(v[0],v[2]);
3661       v[0]=v[0](v[1],contextptr);
3662       return in_fsolve(v,contextptr);
3663     }
3664     gen v0=remove_equal(v[0]);
3665     vecteur I1(lidnt(v[1]));
3666     vecteur I0(true_lidnt(v0)); // should remove embedded fsolve/sum/int
3667     I0=lidnt(makevecteur(evalf(I0,1,contextptr),I1));
3668     if (_sort(I0,contextptr)!=_sort(I1,contextptr))
3669       return symbolic(at_fsolve,gen(v,_SEQ__VECT));
3670     int evalf_after=interv?3:1;
3671     if (s>=2 && v0.type==_VECT && v[1].type==_VECT && !v[1]._VECTptr->empty()){
3672       // check v[1]
3673       vecteur w=*v[1]._VECTptr;
3674       unsigned i=0;
3675       if (w.front().is_symb_of_sommet(at_equal)){
3676 	vecteur v1,v2;
3677 	for (;i<w.size();++i){
3678 	  if (w[i].is_symb_of_sommet(at_equal)){
3679 	    v1.push_back(w[i]._SYMBptr->feuille[0]);
3680 	    v2.push_back(w[i]._SYMBptr->feuille[1]);
3681 	  }
3682 	  else {
3683 	    v1.push_back(w[i]);
3684 	    v2.push_back(0);
3685 	  }
3686 	}
3687 	v[1]=v1;
3688 	v.insert(v.begin()+2,v2);
3689 	return in_fsolve(v,contextptr);
3690       }
3691       for (;i<w.size();++i){
3692 	if (w[i].type==_IDNT)
3693 	  continue;
3694 	if (!w[i].is_symb_of_sommet(at_at))
3695 	  break;
3696       }
3697       if (i!=w.size())
3698 	return gensizeerr(gettext("fsolve([equations],[variables],[guesses])"));
3699       if (s==2 && _sort(lvar(v0),contextptr)==_sort(v[1],contextptr))
3700 	return evalf(gsolve(*v0._VECTptr,*v[1]._VECTptr,complex_mode(contextptr),evalf_after,contextptr),1,contextptr);
3701     }
3702     if (s==2 && v[1].type==_IDNT){
3703       // no initial guess, check for poly-like equation
3704       vecteur lv(lvar(v0));
3705       lv=lvar(evalf(lv,1,contextptr));
3706       int lvs=int(lv.size());
3707       bool poly=true;
3708       for (unsigned i=0;i<lv.size();++i){
3709 	if (lv[i]==v[1] || lv[i]==cst_pi || lv[i]==cst_euler_gamma)
3710 	  continue;
3711 	poly=false;
3712 	break;
3713       }
3714       if (poly){
3715 	gen tmp=_e2r(makesequence(v0,v[1]),contextptr),tmp1=tmp;
3716 	if (tmp.type==_FRAC)
3717 	  tmp1=tmp=tmp._FRACptr->num;
3718 	tmp=evalf(tmp,eval_level(contextptr),contextptr);
3719 	if (tmp.type==_VECT && tmp._VECTptr->size()<1024){
3720 	  // call realroot? this would be more accurate
3721 	  gen res=complex_mode(contextptr)?proot(*tmp._VECTptr,epsilon(contextptr)):(lvar(tmp1).empty()?_realroot(gen(makevecteur(tmp1,epsilon(contextptr),at_evalf),_SEQ__VECT),contextptr):real_proot(*tmp._VECTptr,epsilon(contextptr),contextptr));
3722 	  if (res.type==_VECT && res._VECTptr->size()==1)
3723 	    return res._VECTptr->front();
3724 	  return res;
3725 	}
3726       }
3727       gen v0orig(v0); bool testpi=false;
3728       if (lvs>1){
3729 	v0=halftan_hyp2exp(v0,contextptr);
3730 	testpi=true;
3731       }
3732       lv=lvar(v0);
3733       lvs=int(lv.size());
3734       if (lvs==1 && lv[0].type==_SYMB && lv[0]._SYMBptr->feuille.type!=_VECT){
3735 	int pos=equalposcomp(solve_fcns_tab,lv[0]._SYMBptr->sommet);
3736 	if (pos){
3737 	  gen tmp=_e2r(makesequence(v0,lv[0]),contextptr);
3738 	  if (tmp.type==_FRAC)
3739 	    tmp=tmp._FRACptr->num;
3740 	  tmp=evalf(tmp,eval_level(contextptr),contextptr);
3741 	  if (tmp.type==_VECT){
3742 	    vecteur res0=complex_mode(contextptr)?proot(*tmp._VECTptr,epsilon(contextptr)):real_proot(*tmp._VECTptr,epsilon(contextptr),contextptr);
3743 	    vecteur res;
3744 	    if (testpi && is_zero(subst(v0orig,v[1],M_PI,false,contextptr),contextptr))
3745 	      res.push_back(M_PI);
3746 	    const_iterateur it=res0.begin(),itend=res0.end();
3747 	    for (;it!=itend;++it){
3748 	      vecteur res0val=gen2vecteur(isolate_fcns[pos-1](*it,complex_mode(contextptr),contextptr));
3749 	      const_iterateur jt=res0val.begin(),jtend=res0val.end();
3750 	      for (;jt!=jtend;++jt){
3751 		gen fs=_fsolve(gen(makevecteur(lv[0]._SYMBptr->feuille-*jt,v[1]),_SEQ__VECT),contextptr);
3752 		if (fs.type==_VECT)
3753 		  res=mergevecteur(res,*fs._VECTptr);
3754 		else
3755 		  res.push_back(fs);
3756 	      }
3757 	    }
3758 	    return res;
3759 	  }
3760 	}
3761       } // end lvs==1 etc.
3762       // no guess, try to root by bisection over a large interval of R
3763       // x=tan(t) change of var
3764       if (1
3765 	  //abs_calc_mode(contextptr)==38
3766 	  ){
3767 	*logptr(contextptr) << gettext("Solving by bisection with change of variable x=tan(t) and t=-1.57..1.57. Try fsolve(equation,x=guess) for iterative solver or fsolve(equation,x=xmin..xmax) for bisection.") << "\nEquation: " << v[0] << '\n';
3768 	gen eq=subst(v[0],v[1],tan(v[1],contextptr),false,contextptr);
3769   //grad
3770 	vecteur v_=makevecteur(eq,symb_equal(v[1],angle_radian(contextptr)?symb_interval(-1.57,1.57):(angle_degree(contextptr)?symb_interval(-89.97,89.97):symb_interval(-99.97,99.97))));
3771 	gen res=in_fsolve(v_,contextptr);
3772 	if (is_undef(res))
3773 	  return res;
3774 	if (res.type==_VECT && res._VECTptr->empty()){
3775 	  *logptr(contextptr) << gettext("No solution found by bisection. Trying iterative method starting at 0") << '\n';
3776 	  v_=makevecteur(v[0],v[1],0);
3777 	  return in_fsolve(v_,contextptr);
3778 	}
3779 	return tan(res,contextptr);
3780       }
3781       *logptr(contextptr) << gettext("Solving with initial guess 0. Try fsolve(equation,x=guess) for iterative solver or fsolve(equation,x=xmin..xmax) for bisection.") << '\n';
3782     }
3783     gen gguess;
3784     if (v[1].type==_VECT && !v[1]._VECTptr->empty() && is_equal(v[1]._VECTptr->front())){
3785       vecteur v1=*v[1]._VECTptr;
3786       vecteur vguess(v1.size());
3787       for (unsigned i=0;i<v1.size();++i){
3788 	if (is_equal(v1[i])){
3789 	  vguess[i]=v1[i]._SYMBptr->feuille[1];
3790 	  v1[i]=v1[i]._SYMBptr->feuille[0];
3791 	}
3792       }
3793       v[1]=gen(v1);
3794       gguess=vguess;
3795     }
3796     if (is_equal(v[1])){
3797       gguess=v[1]._SYMBptr->feuille[1];
3798       v[1]=v[1]._SYMBptr->feuille[0];
3799       v.insert(v.begin()+2,gguess);
3800       ++s;
3801     }
3802     if (s>=3 && (v[2].type!=_INT_ || v[2].subtype!=_INT_SOLVER))
3803       gguess=v[2];
3804     if (is_equal(gguess))
3805       return gensizeerr(contextptr);
3806     if (gguess.type==_VECT && gguess._VECTptr->size()!=2 && v[1].type==_IDNT){
3807       int nvar=int(gguess._VECTptr->size());
3808       vecteur tmp(nvar);
3809       vecteur chk=lop(v[0],at_of);
3810       bool at=true;
3811       for (unsigned i=0;at && i<chk.size();++i){
3812 	if (chk[i][1]==v[1])
3813 	  at=false;
3814       }
3815       for (int i=0;i<nvar;++i)
3816 	tmp[i]=at?symbolic(at_at,makesequence(v[1],i)):symb_of(v[1],i+1);
3817       v[1]=tmp;
3818     }
3819     if (gguess.is_symb_of_sommet(at_interval) && (s<4 || v[3].subtype!=_INT_PLOT)){
3820       int iszero=-1;
3821       gen a=gguess._SYMBptr->feuille[0],b=gguess._SYMBptr->feuille[1];
3822       if (s>=4){
3823 	if (is_integer(v[3]))
3824 	  iszero=v[3].val;
3825 	if (is_equal(v[3])){
3826 	  gen v30=v[3]._SYMBptr->feuille[0];
3827 	  gen v31=v[3]._SYMBptr->feuille[1];
3828 	  if (v30.subtype==_INT_PLOT && v30==_NSTEP)
3829 	    v30=v31;
3830 	  if (v30.subtype==_INT_PLOT && (v30==_XSTEP || v30==_TSTEP))
3831 	    v30=_floor((b-a)/v31,contextptr);
3832 	  if (v30.type==_INT_ && v30.val>0)
3833 	    iszero=v30.val;
3834 	}
3835       }
3836       return bisection_solver(v0,v[1],a,b,iszero,contextptr);
3837     }
3838     if (gguess.type==_VECT && gguess._VECTptr->size()>1){
3839       for (unsigned i=0;i<gguess._VECTptr->size();++i){
3840 	gen tmp=evalf_double((*gguess._VECTptr)[i],1,contextptr);
3841 	if (tmp.type!=_DOUBLE_ && tmp.type!=_CPLX)
3842 	  return gensizeerr("Bad guess "+gguess.print(contextptr));
3843       }
3844     }
3845     if (v0.type==_VECT){
3846       if ( (v[1].type==_VECT && v0._VECTptr->size()!=v[1]._VECTptr->size())
3847 	   || (v[1].type!=_VECT && v[1]._VECTptr->size()!=1))
3848 	return gendimerr(contextptr);
3849     }
3850     // check method
3851     int method=_NEWTON_SOLVER;
3852     //int method=0;
3853     if ( (s>=5) && (v[4].type==_DOUBLE_) )
3854       gsl_eps=v[4]._DOUBLE_val;
3855     if ( (s>=4) && (v[3].type==_INT_) )
3856       method=v[3].val;
3857     if (v[1].type==_VECT){
3858       int dim=int(v[1]._VECTptr->size());
3859       if (!dim)
3860 	return gensizeerr(contextptr);
3861       if (s>=3){
3862 	if (gguess.type!=_VECT)
3863 	  return gensizeerr(contextptr);
3864 	if (gguess._VECTptr->size()!=unsigned(dim))
3865 	  return gensizeerr(contextptr);
3866       }
3867       else {
3868 	gguess=vecteur(dim);
3869 	gguess[0]=(gnuplot_xmin+gnuplot_xmax)/2;
3870 	if (dim>1)
3871 	  gguess[1]=(gnuplot_ymin+gnuplot_ymax)/2;
3872 	if (dim>2)
3873 	  gguess[2]=(gnuplot_zmin+gnuplot_zmax)/2;
3874 	if (dim>3)
3875 	  gguess[3]=(gnuplot_tmin+gnuplot_tmax)/2;
3876       }
3877 #ifdef HAVE_LIBGSL
3878       if (method!=_NEWTON_SOLVER)
3879 	return msolve(v0,*v[1]._VECTptr,*gguess._VECTptr,method,gsl_eps,contextptr);
3880 #endif
3881     }
3882 #ifndef HAVE_LIBGSL
3883     if (v[1].type!=_VECT && gguess.type==_VECT && gguess._VECTptr->size()==2){
3884       int iszero=0;
3885       vecteur res= bisection_solver(v0,v[1],gguess[0],gguess[1],iszero,contextptr);
3886       if (!res.empty() && iszero!=1)
3887 	*logptr(contextptr) << (iszero==-1?gettext("Warning: undefined"):gettext("Warning: sign reversal")) << '\n';
3888       return res;
3889     }
3890 #endif
3891 #ifdef HAVE_LIBGSL
3892     if (method!=_NEWTON_SOLVER){
3893       bool with_derivative=false;
3894       switch (method){
3895       case _BISECTION_SOLVER: case _FALSEPOS_SOLVER: case _BRENT_SOLVER:
3896 	with_derivative=false;
3897 	break;
3898       case _NEWTON_SOLVER: case _SECANT_SOLVER: case _STEFFENSON_SOLVER:
3899 	with_derivative=true;
3900 	break;
3901       }
3902       gen params;
3903       if (with_derivative){
3904 	gen dv0=derive(v0,v[1],contextptr);
3905 	if (is_undef(dv0))
3906 	  return dv0;
3907 	params= makevecteur(v0,dv0,v[1]);
3908 	double guess((gnuplot_xmin+gnuplot_xmax)/2),oldguess;
3909 	if (s>=3){
3910 	  gen g=evalf(gguess,eval_level(contextptr),contextptr);
3911 	  if (g.type==_DOUBLE_)
3912 	    guess=g._DOUBLE_val;
3913 	}
3914 	gsl_function_fdf FDF ;
3915 	FDF.f = &my_f ;
3916 	FDF.df = &my_df ;
3917 	FDF.fdf = &my_fdf ;
3918 	FDF.params = &params ;
3919 	gsl_root_fdfsolver * slv=0;
3920 	switch (method){
3921 	case _NEWTON_SOLVER:
3922 	  slv=gsl_root_fdfsolver_alloc (gsl_root_fdfsolver_newton);
3923 	  break;
3924 	case _SECANT_SOLVER:
3925 	  slv=gsl_root_fdfsolver_alloc (gsl_root_fdfsolver_secant);
3926 	  break;
3927 	case _STEFFENSON_SOLVER:
3928 	  slv=gsl_root_fdfsolver_alloc (gsl_root_fdfsolver_steffenson);
3929 	  break;
3930 	}
3931 	if (!slv)
3932 	  return gensizeerr(contextptr);
3933 	gsl_root_fdfsolver_set(slv,&FDF,guess);
3934 	int maxiter=SOLVER_MAX_ITERATE,res=0;
3935 	for (;maxiter;--maxiter){
3936 	  oldguess=guess;
3937 	  res=gsl_root_fdfsolver_iterate(slv);
3938 	  guess=gsl_root_fdfsolver_root(slv);
3939 	  if ( (res==GSL_EBADFUNC) || (res==GSL_EZERODIV) )
3940 	    break;
3941 	  if (fabs(guess-oldguess)<gsl_eps)
3942 	    break;
3943 	}
3944 	gsl_root_fdfsolver_free(slv);
3945 	if (!maxiter)
3946 	  return gensizeerr(contextptr);
3947 	if ( (res==GSL_EBADFUNC) || (res==GSL_EZERODIV) )
3948 	  return undef;
3949 	else
3950 	  return guess;
3951       }
3952       else {
3953 	params= makevecteur(v0,v[1]);
3954 	double x_low,x_high;
3955 	if (s>=3) {
3956 	  vecteur w;
3957 	  if (gguess.type==_VECT)
3958 	    w=*gguess._VECTptr;
3959 	  else {
3960 	    if ( (gguess.type==_SYMB) && (gguess._SYMBptr->sommet==at_interval) )
3961 	      w=*gguess._SYMBptr->feuille._VECTptr;
3962 	  }
3963 	  if (w.size()!=2)
3964 	    return gentypeerr(contextptr);
3965 	  gen low=w[0].evalf(eval_level(contextptr),contextptr);
3966 	  gen high=w[1].evalf(eval_level(contextptr),contextptr);
3967 	  if ( (low.type!=_DOUBLE_) || (high.type!=_DOUBLE_) )
3968 	    return gensizeerr(contextptr);
3969 	  x_low=low._DOUBLE_val;
3970 	  x_high=high._DOUBLE_val;
3971 	}
3972 	else {
3973 	  x_low=gnuplot_xmin;
3974 	  x_high=gnuplot_xmax;
3975 	}
3976 	if (x_low>x_high){
3977 	  double tmp=x_low;
3978 	  x_low=x_high;
3979 	  x_high=tmp;
3980 	}
3981 	gsl_function F ;
3982 	F.function=&my_f;
3983 	F.params = &params ;
3984 	gsl_root_fsolver * slv =0 ;
3985 	switch (method){
3986 	case  _BISECTION_SOLVER:
3987 	  slv=gsl_root_fsolver_alloc (gsl_root_fsolver_bisection);
3988 	  break;
3989 	case _FALSEPOS_SOLVER:
3990 	  slv=gsl_root_fsolver_alloc (gsl_root_fsolver_falsepos);
3991 	  break;
3992 	case _BRENT_SOLVER:
3993 	  slv=gsl_root_fsolver_alloc (gsl_root_fsolver_brent);
3994 	  break;
3995 	}
3996 	if (!slv)
3997 	  return gensizeerr(contextptr);
3998 	gsl_root_fsolver_set (slv,&F,x_low,x_high);
3999 	int res=0;
4000 	int maxiter=SOLVER_MAX_ITERATE;
4001 	for (;maxiter && (x_high-x_low>gsl_eps);--maxiter){
4002 	  res=gsl_root_fsolver_iterate(slv);
4003 	  if (res==GSL_EBADFUNC)
4004 	    break;
4005 	  x_low=gsl_root_fsolver_x_lower(slv);
4006 	  x_high= gsl_root_fsolver_x_upper(slv);
4007 	}
4008 	gsl_root_fsolver_free (slv);
4009 	if (res==GSL_EBADFUNC)
4010 	  return undef;
4011 	return makevecteur(x_low,x_high);
4012       } // end if derivative
4013     }
4014 #else // HAVE_LIBGSL
4015     if (method!=_NEWTON_SOLVER)
4016       return gensizeerr(gettext("Not linked with GSL"));
4017 #endif    // HAVE_LIBGSL
4018     else  {// newton method, call newton
4019       gguess=newton(v0,v[1],gguess,NEWTON_DEFAULT_ITERATION,gsl_eps,1e-12,!complex_mode(contextptr),1,0,1,0,1,contextptr);
4020       if (is_greater(1e-8,abs(im(gguess,contextptr),contextptr)/abs(re(gguess,contextptr),contextptr),contextptr))
4021 	return re(gguess,contextptr);
4022       return gguess;
4023     }
4024     return undef;
4025   } // end f_solve
4026   static const char _fsolve_s []="fsolve";
4027   static define_unary_function_eval_quoted (__fsolve,&_fsolve,_fsolve_s);
4028   define_unary_function_ptr5( at_fsolve ,alias_at_fsolve,&__fsolve,_QUOTE_ARGUMENTS,true);
4029 
_cfsolve(const gen & args,GIAC_CONTEXT)4030   gen _cfsolve(const gen &args,GIAC_CONTEXT){
4031     bool b=complex_mode(contextptr);
4032     complex_mode(true,contextptr);
4033     gen res=_fsolve(args,contextptr);
4034     complex_mode(b,contextptr);
4035     return res;
4036   }
4037   static const char _cfsolve_s []="cfsolve";
4038   static define_unary_function_eval_quoted (__cfsolve,&_cfsolve,_cfsolve_s);
4039   define_unary_function_ptr5( at_cfsolve ,alias_at_cfsolve,&__cfsolve,_QUOTE_ARGUMENTS,true);
4040 
sxa(const vecteur & sl_orig,const vecteur & x,GIAC_CONTEXT)4041   vecteur sxa(const vecteur & sl_orig,const vecteur & x,GIAC_CONTEXT){
4042     vecteur sl(sl_orig);
4043     int d;
4044     d=int(x.size());
4045     int de;
4046     de=int(sl.size());
4047     for (int i=0;i<de;i++){
4048       //gen e:
4049       //e=sl[i];
4050       if ( (sl[i].type==_SYMB) && ((*sl[i]._SYMBptr).sommet==at_equal || (*sl[i]._SYMBptr).sommet==at_equal2 || (*sl[i]._SYMBptr).sommet==at_same)){
4051 	sl[i]=(*sl[i]._SYMBptr).feuille[0]-(*sl[i]._SYMBptr).feuille[1];
4052       }
4053     }
4054     vecteur A;
4055     for (int i=0;i<de;i++){
4056       vecteur li(d+1);
4057       gen lo=sl[i];
4058       for (int j=0;j<d;j++){
4059 	lo=subst(lo,x[j],0,false,contextptr);
4060 	li[j]=derive(sl[i],x[j],contextptr);
4061       }
4062       li[d]=lo;
4063       A.push_back(li);
4064     }
4065     return(A);
4066   }
4067 
linsolve(const vecteur & sl,const vecteur & x,GIAC_CONTEXT)4068   vecteur linsolve(const vecteur & sl,const vecteur & x,GIAC_CONTEXT){
4069     if (sl.empty())
4070       return x;
4071     vecteur A;
4072     if (ckmatrix(sl)){
4073       unsigned int n=unsigned(sl.size());
4074       if (n>=GIAC_PADIC && n==x.size() && is_integer_matrice(sl) && is_integer_vecteur(x)){
4075 	gen p,det_mod_p,h2;
4076 	int res=padic_linsolve(sl,x,A,p,det_mod_p,h2);
4077 	if (res==1)
4078 	  return A;
4079       }
4080       A=mtran(sl);
4081       if (ckmatrix(x)){
4082 	if (x.size()==1){
4083 	  if (x.front()._VECTptr->size()!=n)
4084 	    return vecteur(1,gendimerr(contextptr));
4085 	  A.push_back(-x.front());
4086 	}
4087 	else {
4088 	  if (x.size()!=n)
4089 	    return vecteur(1,gendimerr(contextptr));
4090 	  matrice xm=mtran(x);
4091 	  if (xm.size()!=1)
4092 	    return vecteur(1,gensizeerr(contextptr));
4093 	  A.push_back(-xm.front());
4094 	}
4095       }
4096       else {
4097 	if (x.size()!=n)
4098 	  return vecteur(1,gendimerr(contextptr));
4099 	A.push_back(-x);
4100       }
4101       A=mtran(A);
4102       //int c=int(A.front()._VECTptr->size());
4103       vecteur B=-mker(A,contextptr);
4104       if (is_undef(B) || B.empty())
4105 	return B;
4106       // The last element of B must have a non-zero last component
4107       vecteur Bend=*B.back()._VECTptr;
4108       gen last=Bend.back();
4109       if (is_zero(last,contextptr))
4110 	return vecteur(0);
4111       gen R=Bend/last;
4112       // The solution is sum(B[k]*Ck+Blast/last)
4113       int s=int(B.size());
4114       for (int k=0;k<s-1;k++)
4115 	R=R+gen("C_"+print_INT_(k),contextptr)*B[k];
4116       vecteur res=*R._VECTptr;
4117       res.pop_back();
4118       return res;
4119     }
4120     A=sxa(sl,x,contextptr);
4121     vecteur B,R(x);
4122     gen rep;
4123     B=mrref(A,contextptr);
4124     //COUT<<B<<'\n';
4125     int d=int(x.size());
4126     int de=int(sl.size());
4127     for (int i=0; i<de;i++){
4128       vecteur li(d+1);
4129       for(int k=0;k<d+1;k++){
4130 	li[k]=B[i][k];
4131       }
4132       int j;
4133       j=i;
4134       while (j<d && li[j]==0){
4135 	j=j+1;
4136       }
4137       if (j==d && !is_zero(li[d],contextptr)){
4138 	return vecteur(0);
4139       }
4140       else {
4141 	if (j<d){
4142 	  rep=-li[d];
4143 	  for (int k=j+1;k<d;k++){
4144 	    rep=rep-li[k]*x[k];
4145 	  }
4146 	  rep=rdiv(rep,li[j],contextptr);
4147 	  R[j]=rep;
4148 	}
4149       }
4150     }
4151     return R;
4152   }
4153 
equal2diff(const gen & g)4154   gen equal2diff(const gen & g){
4155     if ( (g.type==_SYMB) && (g._SYMBptr->sommet==at_equal || g._SYMBptr->sommet==at_equal2 || g._SYMBptr->sommet==at_same) ){
4156       vecteur & v=*g._SYMBptr->feuille._VECTptr;
4157       return v[0]-v[1];
4158     }
4159     else
4160       return g;
4161   }
4162 
symb_linsolve(const gen & syst,const gen & vars)4163   gen symb_linsolve(const gen & syst,const gen & vars){
4164     return symbolic(at_linsolve,makesequence(syst,vars));
4165   }
4166 
linsolve(const gen & syst,const gen & vars,GIAC_CONTEXT)4167   gen linsolve(const gen & syst,const gen & vars,GIAC_CONTEXT){
4168     if ((syst.type!=_VECT)||(vars.type!=_VECT))
4169       return symb_linsolve(syst,vars);
4170     gen res=linsolve(*syst._VECTptr,*vars._VECTptr,contextptr);
4171     if (!has_i(syst) && has_i(res))
4172       res=_evalc(res,contextptr);
4173     else
4174       res=normal(res,contextptr);
4175     return res;
4176   }
4177 
4178 
4179   // solve triangular system l*a=y where l is the lower part of a lu decomp
linsolve_l(const matrice & m,const vecteur & y,vecteur & a)4180   void linsolve_l(const matrice & m,const vecteur & y,vecteur & a){
4181     // l*a=y: a1=y1, a2=y2-m_21*a1, ..., ak=yk-sum_{j=1..k-1}(m_kj*aj)
4182     int n=int(y.size());
4183     a.resize(n);
4184     gen * astart=&a[0];
4185     *astart=y[0]/m[0][0];
4186     for (int k=1;k<n;++k){
4187       const gen * mkj=&m[k]._VECTptr->front();
4188       gen *aj=astart,*ak=astart+k;
4189       gen res=y[k];
4190       for (;aj<ak;++mkj,++aj)
4191 	res -= (*mkj)*(*aj);
4192       *ak=res/(*mkj);
4193     }
4194   }
4195 
4196   // solve upper triangular system m*y=a
linsolve_u(const matrice & m,const vecteur & y,vecteur & a)4197   void linsolve_u(const matrice & m,const vecteur & y,vecteur & a){
4198     // u*[a0,..,an-1]=[y0,...,yn]
4199     // a_{n-1}=y_{n-1}/u_{n-1,n-1}
4200     // a_{n-2}=(y_{n-2}-u_{n-2,n-1}*a_{n-1})/u_{n-2,n-2}
4201     // ...
4202     // a_k=(y_{k}-sum_{j=k+1..n-1} u_{k,j}a_j)/u_{k,k}
4203     int n=int(y.size());
4204     a.resize(n);
4205     for (int k=n-1;k>=0;--k){
4206       gen res=y[k];
4207       gen * mkj=&(*m[k]._VECTptr)[n-1],*colj=&a[n-1],*colend=&a[k];
4208       for (;colj>colend;--mkj,--colj){
4209 	res -= (*mkj)*(*colj);
4210       }
4211       *colj=res/(*mkj);
4212     }
4213   }
4214 
_linsolve(const gen & args,GIAC_CONTEXT)4215   gen _linsolve(const gen & args,GIAC_CONTEXT){
4216     if ( args.type==_STRNG && args.subtype==-1) return  args;
4217     vecteur v(plotpreprocess(args,contextptr));
4218     if (is_undef(v))
4219       return v;
4220     int s=int(v.size());
4221     bool eq=false;
4222     if (s==3 && v[2]==at_equal){
4223       eq=true;
4224       --s;
4225       v.pop_back();
4226     }
4227     if (s==4){
4228       // P,L,U,B, solve A*X=B where P*A=L*U
4229       gen P=v[0],L=eval(v[1],1,contextptr),U=v[2],B=v[3];
4230       if (P.type!=_VECT || B.type!=_VECT)
4231 	return gensizeerr(contextptr);
4232       vector<int> p;
4233       if (!is_permu(*P._VECTptr,p,contextptr))
4234 	return gensizeerr(contextptr);
4235       matrice b; int n=int(B._VECTptr->size());
4236       bool mat=ckmatrix(B);
4237       if (!mat){
4238 	b=vecteur(1,B);
4239 	if (!ckmatrix(b))
4240 	  return gensizeerr(contextptr);
4241       }
4242       else
4243 	b=mtran(*B._VECTptr);
4244       bool map=L.type==_MAP && U.type==_MAP;
4245       if (!map && (!ckmatrix(L) || !ckmatrix(U)))
4246 	return gensizeerr(contextptr);
4247       if (n!=int(p.size()) || (!map && (n!=int(L._VECTptr->size()) || n!=int(U._VECTptr->size()))))
4248 	return gendimerr(contextptr);
4249       vecteur res; res.reserve(b.size());
4250       for (unsigned i=0;i<b.size();++i){
4251 	const vecteur & Bv=*b[i]._VECTptr;
4252 	vecteur c(n),y(n),x(n);
4253 	for (int i=0;i<n;++i)
4254 	  c[i]=Bv[p[i]];
4255 	// now solve L*(U*X)=c
4256 	if (map){
4257 	  if (!sparse_linsolve_l(*L._MAPptr,c,y))
4258 	    return gendimerr(contextptr);
4259 	  if (!sparse_linsolve_u(*U._MAPptr,y,x))
4260 	    return gendimerr(contextptr);
4261 	}
4262 	else {
4263 	  linsolve_l(*L._VECTptr,c,y);
4264 	  linsolve_u(*U._VECTptr,y,x);
4265 	}
4266 	if (!mat)
4267 	  return x;
4268 	res.push_back(x);
4269       }
4270       return gen(mtran(res),_MATRIX__VECT);
4271     }
4272     if (s!=2)
4273       return gentoomanyargs("linsolve");
4274     if (is_squarematrix(v[0]) && v[1].type==_VECT){
4275       // maybe it's a triangular system
4276       matrice & m=*v[0]._VECTptr;
4277       int n=int(m.size());
4278       bool mat=ckmatrix(v[1]);
4279       vecteur b,res;
4280       if (!mat){
4281 	b=vecteur(1,v[1]);
4282 	if (!ckmatrix(b))
4283 	  return gensizeerr(contextptr);
4284       }
4285       else
4286 	b=mtran(*v[1]._VECTptr);
4287       if (n>=2){
4288 	if (is_zero(m[0][1],contextptr)){
4289 	  // lower triangular?
4290 	  bool lower=true;
4291 	  for (int i=0;lower && i<n;++i){
4292 	    vecteur & v=*m[i]._VECTptr;
4293 	    for (int j=i+1;lower && j<n;++j){
4294 	      lower=is_zero(v[j]);
4295 	    }
4296 	  }
4297 	  if (lower){
4298 	    for (unsigned i=0;i<b.size();++i){
4299 	      vecteur y(n);
4300 	      linsolve_l(m,*b[i]._VECTptr,y);
4301 	      if (!mat)
4302 		return y;
4303 	      res.push_back(y);
4304 	    }
4305 	    return res;
4306 	  }
4307 	}
4308 	// upper triangular?
4309 	bool upper=true;
4310 	for (int i=1;upper && i<n;++i){
4311 	  vecteur & v=*m[i]._VECTptr;
4312 	  for (int j=0;upper && j<i;++j){
4313 	    upper=is_zero(v[j]);
4314 	  }
4315 	}
4316 	if (upper){
4317 	  for (unsigned i=0;i<b.size();++i){
4318 	    vecteur y(n);
4319 	    linsolve_u(m,*b[i]._VECTptr,y);
4320 	    if (!mat)
4321 	      return y;
4322 	    res.push_back(y);
4323 	  }
4324 	  return res;
4325 	}
4326       }
4327     }
4328     if (v[1].type==_IDNT)
4329       v[1]=eval(v[1],eval_level(contextptr),contextptr);
4330     gen syst=apply(v[0],equal2diff),vars=v[1];
4331     gen res= linsolve(syst,v[1],contextptr);
4332     if (eq)
4333       res=_list2exp(makesequence(res,v[1]),contextptr);
4334     return res;
4335   }
4336   static const char _linsolve_s []="linsolve";
4337   static define_unary_function_eval_quoted (__linsolve,&_linsolve,_linsolve_s);
4338   define_unary_function_ptr5( at_linsolve ,alias_at_linsolve,&__linsolve,_QUOTE_ARGUMENTS,true);
4339 
4340   static const char _resoudre_systeme_lineaire_s []="resoudre_systeme_lineaire";
4341   static define_unary_function_eval_quoted (__resoudre_systeme_lineaire,&_linsolve,_resoudre_systeme_lineaire_s);
4342   define_unary_function_ptr5( at_resoudre_systeme_lineaire ,alias_at_resoudre_systeme_lineaire,&__resoudre_systeme_lineaire,_QUOTE_ARGUMENTS,true);
4343 
4344   /*
4345   gen iter(const gen & f, const gen & x,const gen & arg,int maxiter,double eps, int & b){
4346     gen a=arg;
4347     complex<double> olda;
4348     complex<double> ad;
4349     b=0;
4350     ad=gen2complex_d(a);
4351     //COUT<<"a"<<a<<'\n';
4352     //COUT<<"ad"<<ad<<'\n';
4353     for (int j=1;j<=maxiter;j++){
4354       olda=ad;
4355       // COUT << f << " " << x << " " << a << '\n';
4356       a=subst(f,x,a).evalf();
4357       // COUT<<"a"<<a<<'\n';
4358       //a=a.evalf();
4359       //ad=a._DOUBLE_val;
4360       ad=gen2complex_d(a);
4361       // COUT<<"a"<<a<<'\n';
4362       // COUT<<"ad"<<ad<<'\n';
4363       // COUT<<"j"<<j<<"abs"<<abs(ad-olda)<<'\n';
4364       if (eps>abs(ad-olda)) {
4365 	b=1; return(a);
4366       }
4367     }
4368     return(a);
4369   }
4370 
4371   gen newtona(const gen & f, const gen & x, const gen & arg,int niter1, int niter2, double eps1,double eps2,double prefact1,double prefact2, int & b){
4372     if (x.type!=_IDNT)
4373       settypeerr(gettext("2nd arg must be an identifier"));
4374     //COUT<<a<<'\n';
4375     gen a=arg;
4376     gen g1;
4377     gen g;
4378     g1=x-gen(prefact1)*rdiv(f,derive(f,x));
4379     // sym_sub(x,sym_mult(rdiv(9,10),rdiv(f,derive(f,x))));
4380     try {
4381       a= iter(g1,x,a,niter1,eps1,b);
4382       g=x-gen(prefact2)*rdiv(f,derive(f,x));
4383       a= iter(g,x,a,niter2,eps2,b);
4384     }
4385     catch (std::runtime_error & err){
4386       last_evaled_argptr(contextptr)=NULL;
4387       b=0;
4388     }
4389     return a;
4390   }
4391 
4392   gen newton(const gen & f, const gen & x,const gen & guess,int niter1,int niter2,double eps1,double eps2,double prefact1,double prefact2){
4393     bool guess_first=is_undef(guess);
4394     for (int j=1;j<5;j++,niter2 *=2, niter1 *=2){
4395       gen a;
4396       int b;
4397       //on prend un d�part au hasard (a=x0=un _DOUBLE_)
4398       // a=gen(2.0);
4399       if (guess_first)
4400 	a=j*4*(rand()/(RAND_MAX+1.0)-0.5);
4401       else {
4402 	a=guess;
4403 	guess_first=true;
4404       }
4405       // COUT<<j<<"j"<<a<<'\n';
4406       gen e;
4407       e=newtona(f, x, a,niter1,niter2,eps1,eps2,prefact1,prefact2,b);
4408       if (b==1) return e;
4409       gen c;
4410       c=j*4*(rand()/(RAND_MAX+1.0)-0.5);
4411       // COUT<<j<<"j"<<c<<'\n';
4412       // g=x-gen(0.5)*rdiv(f,derive(f,x));
4413       gen ao(gen(0.0),c);
4414       // COUT<<"ao"<<ao<<'\n';
4415       gen e0= newtona(f, x, ao,niter1,niter2,eps1,eps2,prefact1,prefact2,b);
4416       if (b==1)
4417 	return(e0);
4418       gen a1(a,c);
4419       // COUT<<j<<"j,a1"<<a1<<'\n';
4420       e0= newtona(f, x, a1,niter1,niter2,eps1,eps2,prefact1,prefact2,b);
4421       if (b==1)
4422 	return(e0);
4423     }
4424     setsizeerr(gettext("nontrouve"));
4425     return(0);
4426   }
4427   */
4428 
newton_rand(int j,bool real,double xmin,double xmax,GIAC_CONTEXT)4429   static gen newton_rand(int j,bool real,double xmin,double xmax,GIAC_CONTEXT){
4430     gen a=gen(giac_rand(contextptr));
4431     a=a/(gen(rand_max2)+1);
4432     if (xmin<xmax)
4433       return xmin+(xmax-xmin)*a;
4434     a-=plus_one_half;
4435     a=evalf(j*4*a,1,contextptr);
4436     if (j>2 && complex_mode(contextptr) && !real)
4437       a=a+cst_i*evalf(j*4*(gen(giac_rand(contextptr))/(gen(rand_max2)+1)-plus_one_half),1,contextptr);
4438     return a;
4439   }
4440 
newton_rand(int j,bool real,double xmin,double xmax,const gen & f,GIAC_CONTEXT)4441   static gen newton_rand(int j,bool real,double xmin,double xmax,const gen & f,GIAC_CONTEXT){
4442     if (f.type==_VECT){
4443       int s=int(f._VECTptr->size());
4444       vecteur v(s);
4445       for (int i=0;i<s;++i)
4446 	v[i]=(newton_rand(j,real,xmin,xmax,contextptr));
4447       return v;
4448     }
4449     return newton_rand(j,real,xmin,xmax,contextptr);
4450   }
4451 
newton(const gen & f0,const gen & x,const gen & guess_,int niter,double eps1,double eps2,bool real,double xmin,double xmax,double rand_xmin,double rand_xmax,double init_prefactor,GIAC_CONTEXT)4452   gen newton(const gen & f0, const gen & x,const gen & guess_,int niter,double eps1, double eps2,bool real,double xmin,double xmax,double rand_xmin,double rand_xmax,double init_prefactor,GIAC_CONTEXT){
4453     if (real && (!is_zero(im(f0,contextptr),contextptr) || !is_zero(im(guess_,contextptr),contextptr)) )
4454       real=false;
4455     if (x.type!=_IDNT && x.type!=_VECT){
4456       if (x.type!=_SYMB || (x._SYMBptr->sommet!=at_at && x._SYMBptr->sommet!=at_of))
4457 	return gensizeerr(contextptr);
4458     }
4459     bool out=niter!=NEWTON_DEFAULT_ITERATION;
4460     gen guess(guess_);
4461     // ofstream of("log"); of << f0 << '\n' << x << '\n' << guess << '\n' << niter ;
4462     gen f=real?eval(f0,1,context0):f0;  // eval of f wrt context0 is intentionnal, replace UTPN by erf
4463     if (guess.is_symb_of_sommet(at_interval))
4464       guess=(guess._SYMBptr->feuille[0]+guess._SYMBptr->feuille[1])/2;
4465     bool inv_after=f.type==_VECT;
4466     gen a,b,d,fa,fb,invdf=inv_after?derive(f,x,contextptr):inv(derive(f,x,contextptr),contextptr),epsg1(eps1),epsg2(eps2);
4467     if (is_undef(invdf))
4468       return invdf;
4469     if (ckmatrix(invdf))
4470       invdf=mtran(*invdf._VECTptr);
4471     bool guess_first=is_undef(guess);
4472     // Main loop with random initialization
4473     int j=1;
4474     for (;j<=5 ;j++,niter += 5){
4475       if (guess_first){
4476 	a=newton_rand(j,real,rand_xmin,rand_xmax,f,contextptr);
4477       }
4478       else {
4479 	a=guess;
4480 	guess_first=true;
4481       }
4482 #ifndef NO_STDEXCEPT
4483       try {
4484 #endif
4485 	fa=evalf(eval(subst(f,x,a,false,contextptr),eval_level(contextptr),contextptr),1,contextptr);
4486 	// First loop to localize the solution with prefactor
4487 	gen lambda(init_prefactor);
4488 #ifdef HAVE_LIBMPFR
4489 	if (a.type==_REAL){
4490 	  int prec=mpfr_get_prec(a._REALptr->inf);
4491 	  lambda=accurate_evalf(exact(lambda,contextptr),prec);
4492 	}
4493 #endif
4494 	int k;
4495 	for (k=0;k<niter;++k){
4496 #ifdef TIMEOUT
4497 	  control_c();
4498 #endif
4499 	  if (ctrl_c || interrupted) {
4500 	    interrupted = true; ctrl_c=false;
4501 	    return gensizeerr(gettext("Stopped by user interruption."));
4502 	  }
4503 	  d=subst(invdf,x,a,false,contextptr);
4504 	  // of << k << " " << d << " " << invdf << " " << x << " " << a << " ";
4505 	  d=eval(d,eval_level(contextptr),contextptr);
4506 	  // of << d << " " << fa << " ";
4507 	  if (inv_after)
4508 	    d=linsolve(evalf(d,1,contextptr),-fa,contextptr);
4509 	  else
4510 	    d=-evalf(d*fa,1,contextptr);
4511 	  if (is_undef(d) || (d.type==_VECT &&d._VECTptr->empty()) || !lidnt(d).empty()){
4512 	    a=newton_rand(j,real,rand_xmin,rand_xmax,f,contextptr);
4513 	    fa=evalf(eval(subst(f,x,a,false,contextptr),eval_level(contextptr),contextptr),1,contextptr);
4514 	    continue;
4515 	  }
4516 	  if (d.type!=_FLOAT_ && d.type!=_DOUBLE_ && d.type!=_CPLX && d.type!=_REAL && d.type!=_VECT && !is_undef(d) && !is_inf(d))
4517 	    return gensizeerr(contextptr);
4518 	  if (k==0 && is_zero(d,contextptr) && is_greater(abs(fa,contextptr),std::sqrt(eps2),contextptr)){
4519 	    a=newton_rand(j,real,rand_xmin,rand_xmax,f,contextptr);
4520 	    fa=evalf(eval(subst(f,x,a,false,contextptr),eval_level(contextptr),contextptr),1,contextptr);
4521 	    continue;
4522 	  }
4523 	  // of << d << " " << '\n';
4524 	  // of << k << " " << invdf << " " << " " << f << " " << x << " " << a << " " << fa << " " << d << " " << epsg1 << '\n';
4525 	  // CERR << k << " " << invdf << " " << " " << f << " " << x << " " << a << " " << fa << " " << d << " " << epsg1 << '\n';
4526 	  b=a+lambda*d;
4527 	  if (xmin<xmax){
4528 	    if (!is_zero(im(b,contextptr),contextptr) || is_greater(xmin,b,contextptr) || is_greater(b,xmax,contextptr)){
4529 	      for (;;) {
4530 		a=newton_rand(j,real,rand_xmin,rand_xmax,contextptr);
4531 		if (is_greater(a,xmin,contextptr) && is_greater(xmax,a,contextptr))
4532 		break;
4533 	      }
4534 	      fa=evalf(eval(subst(f,x,a,false,contextptr),eval_level(contextptr),contextptr),1,contextptr);
4535 	      continue;
4536 	    }
4537 	  }
4538 	  else {
4539 	    if(real && !is_zero(im(b,contextptr),contextptr)){
4540 	      a=newton_rand(j,real,rand_xmin,rand_xmax,contextptr);
4541 	      fa=evalf(eval(subst(f,x,a,false,contextptr),eval_level(contextptr),contextptr),1,contextptr);
4542 	      continue;
4543 	    }
4544 	  }
4545 	  gen babs=_l2norm(b,contextptr);
4546 	  if (is_inf(babs) || is_undef(babs)){
4547 	    guess_first=true;
4548 	    k=niter;
4549 	    break;
4550 	  }
4551 	  if (is_positive(epsg1-_l2norm(d,contextptr)/max(1,babs,contextptr),contextptr)){
4552 	    a=b;
4553 	    break;
4554 	  }
4555 	  fb=evalf(eval(subst(f,x,b,false,contextptr),eval_level(contextptr),contextptr),1,contextptr);
4556 	  if ( (real && !is_zero(im(fb,contextptr),contextptr)) ||
4557 	       is_positive(_l2norm(fb,contextptr)-_l2norm(fa,contextptr),contextptr)){
4558 	    // Decrease prefactor and try again
4559 	    lambda=evalf(plus_one_half*lambda,1,contextptr);
4560 	  }
4561 	  else {
4562 	    // Save new value of a and increase the prefactor slightly
4563 	    if (is_positive(lambda-0.9,contextptr))
4564 	      lambda=1;
4565 	    else
4566 	      lambda=evalf(gen(12)/gen(10),1,contextptr)*lambda;
4567 	    a=b;
4568 	    fa=fb;
4569 	  }
4570 	} // end for (k<niter)
4571 	if (k==niter){
4572 	  if (out)
4573 	    return a;
4574 	  continue;
4575 	}
4576 	// Second loop to improve precision (prefactor 1)
4577 	for (k=0;k<niter;++k){
4578 #ifdef TIMEOUT
4579 	  control_c();
4580 #endif
4581 	  if (ctrl_c || interrupted) {
4582 	    interrupted = true; ctrl_c=false;
4583 	    return gensizeerr(gettext("Stopped by user interruption."));
4584 	  }
4585 	  if (inv_after)
4586 	    d=linsolve(evalf(subst(invdf,x,a,false,contextptr),1,contextptr),-subst(f,x,a,false,contextptr),contextptr);
4587 	  else
4588 	    d=-evalf(subst(invdf,x,a,false,contextptr)*subst(f,x,a,false,contextptr),1,contextptr);
4589 	  a=a+d;
4590 	  if (is_positive(epsg2-_l2norm(d,contextptr)/max(1,abs(a,contextptr),contextptr),contextptr))
4591 	    break;
4592 	}
4593 	if (k!=niter || is_positive(epsg1-_l2norm(d,contextptr)/max(1,abs(a,contextptr),contextptr),contextptr))
4594 	  break;
4595 #ifndef NO_STDEXCEPT
4596       } catch (std::runtime_error & ){
4597 	last_evaled_argptr(contextptr)=NULL;
4598 	continue; // start with a new initial point
4599       }
4600 #endif
4601     } // end for
4602     if (j>5)
4603       return undef;
4604     return a;
4605   }
4606 
_newton(const gen & args,GIAC_CONTEXT)4607   gen _newton(const gen & args,GIAC_CONTEXT){
4608     if ( args.type==_STRNG && args.subtype==-1) return  args;
4609     double gsl_eps=epsilon(contextptr);
4610     if (args.type!=_VECT)
4611       return newton(args,vx_var,undef,NEWTON_DEFAULT_ITERATION,gsl_eps,1e-12,!complex_mode(contextptr),1,0,1,0,1,contextptr);
4612     vecteur v=*args._VECTptr;
4613     int s=int(v.size());
4614     v[0]=apply(v[0],equal2diff);
4615     if (s<2)
4616       return gensizeerr(contextptr);
4617     if (s==2){
4618       if (is_equal(v[1]))
4619 	return newton(v[0],v[1]._SYMBptr->feuille[0],v[1]._SYMBptr->feuille[1],NEWTON_DEFAULT_ITERATION,gsl_eps,1e-12,!complex_mode(contextptr),1,0,1,0,1,contextptr);
4620       return newton(v[0],v[1],undef,NEWTON_DEFAULT_ITERATION,gsl_eps,1e-12,!complex_mode(contextptr),1,0,1,0,1,contextptr);
4621     }
4622     int niter=NEWTON_DEFAULT_ITERATION;
4623     double eps=epsilon(contextptr);
4624     for (int j=3;j<s;++j){
4625       if (v[j].type==_INT_)
4626 	niter=v[j].val;
4627       else {
4628 	gen tmp=evalf_double(v[j],1,contextptr);
4629 	if (tmp.type==_DOUBLE_)
4630 	  eps=tmp._DOUBLE_val;
4631       }
4632     }
4633     gen res=newton(v[0],v[1],v[2],niter,1e-10,eps,!complex_mode(contextptr),1,0,1,0,1,contextptr);
4634     if (debug_infolevel)
4635       *logptr(contextptr) << res << '\n';
4636     return res;
4637     // return gentoomanyargs("newton");
4638   }
4639   static const char _newton_s []="newton";
4640   static define_unary_function_eval (__newton,&_newton,_newton_s);
4641   define_unary_function_ptr5( at_newton ,alias_at_newton,&__newton,0,true);
4642 
has_num_coeff(const vecteur & v)4643   bool has_num_coeff(const vecteur & v){
4644     const_iterateur it=v.begin(),itend=v.end();
4645     for (;it!=itend;++it){
4646       if (has_num_coeff(*it))
4647 	return true;
4648     }
4649     return false;
4650   }
4651 
has_num_coeff(const polynome & p)4652   bool has_num_coeff(const polynome & p){
4653     vector< monomial<gen> >::const_iterator it=p.coord.begin(),itend=p.coord.end();
4654     for (;it!=itend;++it){
4655       if (has_num_coeff(it->value))
4656 	return true;
4657     }
4658     return false;
4659   }
4660 
has_num_coeff(const gen & e)4661   bool has_num_coeff(const gen & e){
4662     switch (e.type){
4663     case _ZINT: case _INT_: case _IDNT: case _USER:
4664       return false;
4665     case _DOUBLE_: case _REAL: case _FLOAT_:
4666       return true;
4667     case _CPLX:
4668       return (e._CPLXptr->type==_DOUBLE_) || ((e._CPLXptr+1)->type==_DOUBLE_);
4669     case _SYMB:
4670       return has_num_coeff(e._SYMBptr->feuille);
4671     case _VECT:
4672       return has_num_coeff(*e._VECTptr);
4673     case _POLY:
4674       return has_num_coeff(*e._POLYptr);
4675     case _FRAC:
4676       return has_num_coeff(e._FRACptr->num) || has_num_coeff(e._FRACptr->den);
4677     default:
4678       return false;
4679     }
4680     return 0;
4681   }
4682 
has_mod_coeff(const vecteur & v,gen & modulo)4683   bool has_mod_coeff(const vecteur & v,gen & modulo){
4684     const_iterateur it=v.begin(),itend=v.end();
4685     for (;it!=itend;++it){
4686       if (has_mod_coeff(*it,modulo))
4687 	return true;
4688     }
4689     return false;
4690   }
4691 
has_mod_coeff(const polynome & p,gen & modulo)4692   bool has_mod_coeff(const polynome & p,gen & modulo){
4693     vector< monomial<gen> >::const_iterator it=p.coord.begin(),itend=p.coord.end();
4694     for (;it!=itend;++it){
4695       if (has_mod_coeff(it->value,modulo))
4696 	return true;
4697     }
4698     return false;
4699   }
4700 
has_mod_coeff(const gen & e,gen & modulo)4701   bool has_mod_coeff(const gen & e,gen & modulo){
4702     switch (e.type){
4703     case _MOD:
4704       modulo = *(e._MODptr+1);
4705       return true;
4706     case _SYMB:
4707       return has_mod_coeff(e._SYMBptr->feuille,modulo);
4708     case _VECT:
4709       return has_mod_coeff(*e._VECTptr,modulo);
4710     case _POLY:
4711       return has_mod_coeff(*e._POLYptr,modulo);
4712     default:
4713       return false;
4714     }
4715   }
4716 
4717 #if 1
4718 #define inplace_ppz ppz
4719 #else
4720   // find gcd of coefficients of p but aborts and returns 1 if it is small
4721   // otherwise divides
zint_ppz(polynome & p)4722   gen zint_ppz(polynome & p){
4723     vector< monomial<gen> >::iterator it=p.coord.begin(),itend=p.coord.end();
4724     if (it==itend)
4725       return 1;
4726     for (;it!=itend;++it){
4727       if (it->value.type==_INT_)
4728 	return 1;
4729     }
4730     gen res=(itend-1)->value;
4731     for (it=p.coord.begin();it!=itend;++it){
4732       res=gcd(res,it->value);
4733       if (res.type==_INT_)
4734 	return 1;
4735     }
4736     for (it=p.coord.begin();it!=itend;++it){
4737       if (it->value.type!=_ZINT || it->value.ref_count()>1)
4738 	it->value=it->value/res;
4739       else
4740 	mpz_divexact(*it->value._ZINTptr,*it->value._ZINTptr,*res._ZINTptr);
4741     }
4742     return res;
4743   }
4744 
inplace_ppz(polynome & p,bool divide=true)4745   gen inplace_ppz(polynome & p,bool divide=true){
4746     vector< monomial<gen> >::iterator it=p.coord.begin(),itend=p.coord.end();
4747     if (it==itend)
4748       return 1;
4749     gen res=(itend-1)->value;
4750     for (it=p.coord.begin();it!=itend-1;++it){
4751       res=gcd(res,it->value);
4752       if (is_one(res))
4753 	return 1;
4754     }
4755     if (!divide)
4756       return res;
4757     if (res.type==_INT_ && res.val>0){
4758       for (it=p.coord.begin();it!=itend;++it){
4759 	if (it->value.type!=_ZINT || it->value.ref_count()>1)
4760 	  it->value=it->value/res;
4761 	else
4762 	  mpz_divexact_ui(*it->value._ZINTptr,*it->value._ZINTptr,res.val);
4763       }
4764       return res;
4765     }
4766     if (res.type==_ZINT){
4767       for (it=p.coord.begin();it!=itend;++it){
4768 	if (it->value.type!=_ZINT || it->value.ref_count()>1)
4769 	  it->value=it->value/res;
4770 	else
4771 	  mpz_divexact(*it->value._ZINTptr,*it->value._ZINTptr,*res._ZINTptr);
4772       }
4773       return res;
4774     }
4775     for (it=p.coord.begin();it!=itend;++it){
4776       it->value=it->value/res;
4777     }
4778     return res;
4779   }
4780 #endif
4781 
spoly(const polynome & p,const polynome & q,environment * env)4782   polynome spoly(const polynome & p,const polynome & q,environment * env){
4783     if (p.coord.empty())
4784       return q;
4785     if (q.coord.empty())
4786       return p;
4787     const index_t & pi = p.coord.front().index.iref();
4788     const index_t & qi = q.coord.front().index.iref();
4789     index_t lcm = index_lcm(pi,qi);
4790     polynome tmp=p.shift(lcm-pi,q.coord.front().value)-q.shift(lcm-qi,p.coord.front().value);
4791     // gen g=zint_ppz(tmp); if (debug_infolevel>1) CERR << "spoly ppz " << g << '\n';
4792     return (env && env->moduloon)?smod(tmp,env->modulo):tmp;
4793   }
4794 
4795   // this version of reduce returns in rem the reduction of m*p
4796   // other version of reduce do not care about m
reduce(const polynome & p,const polynome * it0,const polynome * itend,polynome & rem,gen & m,environment * env,vector<polynome> * quo=0)4797   void reduce(const polynome & p,const polynome * it0,const polynome * itend,polynome & rem,gen & m,environment * env,vector<polynome> * quo=0){
4798     if (quo){
4799       quo->resize(itend-it0);
4800       for (int i=0;i<int(quo->size());++i){
4801 	(*quo)[i].dim=p.dim;
4802 	(*quo)[i].coord.clear();
4803       }
4804     }
4805     m=1;
4806     if (&p!=&rem)
4807       rem=p;
4808     if (p.coord.empty())
4809       return ;
4810     polynome TMP1(p.dim,p),TMP2(p.dim,p);
4811     std::vector< monomial<gen> >::const_iterator pt=p.coord.begin(),ptend;
4812     const polynome * it;
4813     for (;;){
4814       ptend=rem.coord.end();
4815       // look in rem for a monomial >= to a monomial in it0, then it0+1
4816       for (it=it0; it!=itend ;++it){
4817 	for (pt=rem.coord.begin();pt!=ptend;++pt){
4818 	  if (pt->index>=it->coord.front().index)
4819 	    break;
4820 	}
4821 	if (pt!=ptend)
4822 	  break;
4823       }
4824       if (it==itend) // no monomial of rem are divisible by LT(b): finished
4825 	break;
4826       gen a(pt->value),b(it->coord.front().value) ;
4827       if (env && env->moduloon){
4828 	gen q=a*invmod(b,env->modulo);
4829 	polynome temp=it->shift(pt->index-it->coord.front().index,q);
4830 	rem = smod(rem - temp,env->modulo) ; // FIXME: improve!
4831 	if (quo){
4832 	  (*quo)[it-it0].coord.push_back(monomial<gen>(q,pt->index-it->coord.front().index));
4833 	}
4834       }
4835       else {
4836 	simplify(a,b);
4837 	m=b*m;
4838 	if (quo){
4839 	  for (int i=0;i<int(quo->size());++i){
4840 	    (*quo)[i]=b*((*quo)[i]);
4841 	  }
4842 	  (*quo)[it-it0].coord.push_back(monomial<gen>(a,pt->index-it->coord.front().index));
4843 	}
4844 #if 0
4845 	polynome temp=it->shift(pt->index-it->coord.front().index,a);
4846 	if (is_one(b))
4847 	  rem = rem-temp;
4848 	else {
4849 	  rem = b*rem - temp;
4850 	  inplace_ppz(rem);
4851 	}
4852 #else
4853 	TMP1.coord.clear();
4854 	TMP2.coord.clear();
4855 	Shift(it->coord,pt->index-it->coord.front().index,a,TMP1.coord);
4856 	if (!is_one(b))
4857 	  rem *= b;
4858 	rem.TSub(TMP1,TMP2);
4859 	swap(rem.coord,TMP2.coord);
4860 #endif
4861       }
4862     }
4863     if (quo && (!env || !env->moduloon)){
4864       for (int i=0;i<int(quo->size());++i){
4865 	(*quo)[i]=(*quo)[i]/m;
4866       }
4867     }
4868     m=m/inplace_ppz(rem);
4869   }
4870 
reduce(const polynome & p,const polynome * it0,const polynome * itend,environment * env)4871   polynome reduce(const polynome & p,const polynome * it0,const polynome * itend,environment * env){
4872     polynome rem(p.dim,p);
4873     gen m;
4874     reduce(p,it0,itend,rem,m,env);
4875     return rem;
4876   }
4877 
reduce(const polynome & p,const vectpoly & v,environment * env)4878   polynome reduce(const polynome & p,const vectpoly & v,environment * env){
4879     const polynome * it=&v.front(),* itend=it+v.size();
4880     return reduce(p,it,itend,env);
4881   }
4882 
4883   struct sort_vectpoly_t {
sort_vectpoly_tgiac::sort_vectpoly_t4884     sort_vectpoly_t() {}
operator ()giac::sort_vectpoly_t4885     bool operator () (const tensor<gen> & p,const tensor<gen> & q){
4886 #if 1
4887       if (p.coord.empty())
4888 	return false;
4889       if (q.coord.empty())
4890 	return true;
4891       return p.is_strictly_greater(p.coord.front().index,q.coord.front().index);
4892       // return p.is_strictly_greater(q.coord.front().index,p.coord.front().index);
4893 #else
4894       return tensor_is_strictly_greater<gen>(p,q);
4895 #endif
4896     }
4897   };
4898 
sort_vectpoly(vectpoly::iterator it,vectpoly::iterator itend)4899   void sort_vectpoly(vectpoly::iterator it,vectpoly::iterator itend){
4900 #if 1
4901     sort(it,itend,sort_vectpoly_t());
4902 #else
4903     sort(it,itend,tensor_is_strictly_greater<gen>);
4904 #endif
4905   }
4906 
reduce(vectpoly & res,environment * env)4907   void reduce(vectpoly & res,environment * env){
4908     if (res.empty())
4909       return;
4910     polynome pred(res.front().dim,res.front());
4911     sort_vectpoly(res.begin(),res.end());
4912     // reduce res
4913     for (int i=int(res.size())-2;i>=0;){
4914       polynome & p=res[i];
4915       gen m;
4916       reduce(p,&res.front()+i+1,&res.front()+res.size(),pred,m,env);
4917       if (pred.coord.empty()){
4918 	res.erase(res.begin()+i);
4919 	--i;
4920 	continue;
4921       }
4922       if (pred.coord.size()==p.coord.size()){
4923 	gen & p0=p.coord.front().value;
4924 	gen & pred0=pred.coord.front().value;
4925 	vector< monomial<gen> >::const_iterator it=p.coord.begin(),itend=p.coord.end(),jt=pred.coord.begin();
4926 	for (;it!=itend;++jt,++it){
4927 	  if (it->index!=jt->index || it->value*pred0 != jt->value*p0)
4928 	    break;
4929 	}
4930 	if (it==itend){
4931 	  --i;
4932 	  continue;
4933 	}
4934       }
4935       // find where we must insert pred
4936       unsigned j;
4937       for (j=i+1;j<res.size();++j){
4938 	if (pred.is_strictly_greater(pred.coord.front().index,res[j].coord.front().index))
4939 	  break;
4940 	else
4941 	  swap(res[j-1].coord,res[j].coord);
4942       }
4943       // now we can overwrite res[j-1] (=original res[i]) with pred
4944       swap(res[j-1].coord,pred.coord);
4945       i=j-2;
4946     }
4947   }
4948 
4949   // Will work for a few order only
4950   // add total degree for faster comparisons
4951   struct heap_index {
4952 #if 0
4953     unsigned short order:4;
4954     unsigned short resi:22; // position in res[G[i]], up to 2^22 monomials allowed
4955     unsigned short qi:22; // same for quotients[i]
4956     unsigned short tdeg; // total degree of the product of monomial
4957 #else
4958     unsigned short resi;
4959     unsigned short qi;
4960     unsigned short order;
4961     unsigned short tdeg; // total degree of the product of monomial
4962 #endif
4963     unsigned short i; // position in G
4964     index_m lm; // records the leading monomial
heap_indexgiac::heap_index4965     heap_index():resi(0),qi(0),order(0),tdeg(0),i(0) {}
heap_indexgiac::heap_index4966     heap_index(unsigned _resi,unsigned _qi,unsigned _i):resi(_resi),qi(_qi),order(_REVLEX_ORDER),tdeg(0),i(_i){}
dbgprintgiac::heap_index4967     void dbgprint() { CERR << "index" << lm << " res[G[" << i << "]][" << resi << "], quotients[" << i << "][" << qi << "]" << '\n'; }
4968   };
4969 
operator <(const heap_index & b,const heap_index & a)4970   bool operator < (const heap_index & b,const heap_index & a){
4971     switch(a.order){
4972     case _TDEG_ORDER:
4973       if (b.tdeg!=a.tdeg)
4974 	return b.tdeg<a.tdeg;
4975       return i_total_lex_is_strictly_greater(a.lm,b.lm);
4976     case _PLEX_ORDER:
4977       return i_lex_is_strictly_greater(a.lm,b.lm);
4978     case _3VAR_ORDER:
4979       return i_3var_is_strictly_greater(a.lm,b.lm);
4980     case _7VAR_ORDER:
4981       return i_7var_is_strictly_greater(a.lm,b.lm);
4982     case _11VAR_ORDER:
4983       return i_11var_is_strictly_greater(a.lm,b.lm);
4984     case _16VAR_ORDER:
4985       return i_16var_is_strictly_greater(a.lm,b.lm);
4986     case _32VAR_ORDER:
4987       return i_32var_is_strictly_greater(a.lm,b.lm);
4988     case _64VAR_ORDER:
4989       return i_64var_is_strictly_greater(a.lm,b.lm);
4990     default:
4991       if (b.tdeg!=a.tdeg)
4992 	return b.tdeg<a.tdeg;
4993       return i_total_revlex_is_strictly_greater(a.lm,b.lm);
4994     }
4995   }
4996 
4997 #ifdef HEAP_REDUCE
heap_reduce(const polynome & p0,const vectpoly & res,const vector<unsigned> & G,unsigned excluded,polynome & rem,polynome & p,polynome & p2,environment * env)4998   void heap_reduce(const polynome & p0,const vectpoly & res,const vector<unsigned> & G,unsigned excluded,polynome & rem,polynome & p,polynome & p2,environment * env){
4999     p=p0;
5000     vectpoly quotients(G.size(),polynome(p.dim,p)); // init quotients to null poly
5001     // first compute quotients using a heap, the heap is the sum_i res[G[i]]*quotients[i]
5002     vector<index_m> reslm(G.size());
5003     vecteur reslc(G.size());
5004     unsigned heapsize=0;
5005     for (unsigned j=0;j<G.size();++j){
5006       if (j==excluded)
5007 	continue;
5008       heapsize+=res[G[j]].coord.size();
5009       if (!res[G[j]].coord.empty()){
5010 	reslm[j]=res[G[j]].coord.front().index;
5011 	reslc[j]=res[G[j]].coord.front().value;
5012       }
5013       if (debug_infolevel>100)
5014 	reslm[0].dbgprint();
5015     }
5016     vector<heap_index> heap;
5017     heap.reserve(heapsize);
5018     for (unsigned j=0;j<G.size();++j){
5019       if (j==excluded)
5020 	continue;
5021       for (unsigned k=0;k<res[G[j]].coord.size();++k)
5022 	heap.push_back(heap_index(k,0,j));
5023       if (debug_infolevel>100)
5024 	heap.front().dbgprint();
5025     }
5026     unsigned heappos=0;
5027     unsigned ppos=0;
5028     for (;;){
5029       gen topcoeff=0;
5030       // find largest monomial between the heap and p.coord[pos]
5031       index_m topindex;
5032       if (heappos==0){
5033 	if (ppos>=p.coord.size())
5034 	  break; // nothing more to do, except copying the rest of p into rem
5035 	topindex=p.coord[ppos].index;
5036 	topcoeff=p.coord[ppos].value;
5037 	++ppos;
5038       }
5039       else {
5040 	bool popheap=true;
5041 	topindex=heap.front().lm;
5042 	if (ppos<p.coord.size()){
5043 	  if (topindex==p.coord[ppos].index){
5044 	    topcoeff=p.coord[ppos].value;
5045 	    ++ppos;
5046 	  }
5047 	  else {
5048 	    if (p.is_strictly_greater(p.coord[ppos].index,topindex)){
5049 	      topindex=p.coord[ppos].index;
5050 	      topcoeff=p.coord[ppos].value;
5051 	      ++ppos;
5052 	      popheap=false;
5053 	    }
5054 	  }
5055 	}
5056 	if (popheap){ // add all coefficients of the heap which have the same leading monomial
5057 	  for (;;){
5058 	    heap_index hf=heap.front();
5059 	    std::pop_heap(heap.begin(),heap.begin()+heappos);
5060 	    topcoeff -= res[G[hf.i]].coord[hf.resi].value*quotients[hf.i].coord[hf.qi].value;
5061 	    // replace heap term
5062 	    ++hf.qi;
5063 	    if (hf.qi<quotients[hf.i].coord.size()){
5064 	      hf.lm = res[G[hf.i]].coord[hf.resi].index + quotients[hf.i].coord[hf.qi].index;
5065 	      hf.tdeg = total_degree(res[G[hf.i]].coord[hf.resi].index)+total_degree(quotients[hf.i].coord[hf.qi].index);
5066 	      heap[heappos-1]=hf;
5067 	      std::push_heap(heap.begin(),heap.begin()+heappos);
5068 	    }
5069 	    else { // quotient term unknown
5070 	      heap[heappos-1]=hf;
5071 	      --heappos;
5072 	    }
5073 	    if (heappos==0 || heap.front().lm!=topindex)
5074 	      break;
5075 	  } // end for
5076 	} // end if popheap
5077       } // end else heap.empty()
5078       if (is_zero(topcoeff,contextptr)){
5079 	continue;
5080       }
5081       // now we have collected the top coeff and monomial of p-sum_i res[G[i]]*quotients[i]
5082       // if we can find a leading monomial in res[G[i]] that is <= to this monomial
5083       // add a new quotient term, update the heap
5084       // otherwise move the coeff/monomial to rem
5085       unsigned j;
5086       for (j=0;j<G.size();++j){
5087 	if (j==excluded)
5088 	  continue;
5089 	if (topindex >= reslm[j])
5090 	  break;
5091       }
5092       if (j==G.size()){
5093 	rem.coord.push_back(monomial<gen>(topcoeff,topindex));
5094 	continue;
5095       }
5096       // Add a quotient term,
5097       // FIXME, take care of env
5098       gen s=reslc[j];
5099       simplify(s,topcoeff);
5100       if (is_minus_one(s)){ // should check also for i and -i
5101 	s=-s;
5102 	topcoeff=-topcoeff;
5103       }
5104       if (!is_one(s)){ // multiply everything by s, so that no fraction appear
5105 	rem *= s;
5106 	p *= s;
5107 	for (unsigned k=0;k<G.size();++k)
5108 	  quotients[k] *= s;
5109       }
5110       index_m qlm=topindex-reslm[j];
5111       quotients[j].coord.push_back(monomial<gen>(topcoeff,qlm));
5112       // look after the heap for terms with
5113       // i==j and qi=quotients[j].coord.size()-1
5114       // if multiplied by res[G[i]][0] increment qi, otherwise
5115       // their index must be computed and they must be pushed on the heap
5116       for (unsigned k=heappos;k<heapsize;++k){
5117 	heap_index & hf =heap[k];
5118 	if (hf.i==j && hf.qi==quotients[j].coord.size()-1){
5119 	  if (hf.resi==0)
5120 	    ++hf.qi;
5121 	  else {
5122 	    hf.lm=qlm+res[G[hf.i]].coord[hf.resi].index;
5123 	    hf.tdeg=total_degree(qlm)+total_degree(res[G[hf.i]].coord[hf.resi].index);
5124 	    swap(heap[heappos],hf);
5125 	    ++heappos;
5126 	    push_heap(heap.begin(),heap.begin()+heappos);
5127 	  }
5128 	}
5129       }
5130     } // end of division loop
5131     gen g=inplace_ppz(rem);
5132     if (debug_infolevel>1)
5133       CERR << "ppz is " << g << '\n';
5134   }
5135 #endif
5136 
5137   // #define LINEAR_COMB
5138 #ifdef LINEAR_COMB // it's slower, perhaps because a==1 makes new elements
5139   // a*A+b*B_shifted -> res
linear_combination(const polynome & A,const gen & a,const polynome & B,const gen & b,const index_m & bshift,polynome & res)5140   void linear_combination(const polynome & A,const gen & a,const polynome & B,const gen & b,const index_m & bshift,polynome & res){
5141     vector< monomial<gen> >::const_iterator ait=A.coord.begin(),ait_end=A.coord.end(),
5142       bit=B.coord.begin(),bit_end=B.coord.end();
5143     for (;;){
5144       // If A is finished, fill up with elements from B and stop
5145       if (ait == ait_end) {
5146 	while (bit != bit_end) {
5147 	  res.coord.push_back(monomial<gen>(b*bit->value,bit->index+bshift));
5148 	  ++bit;
5149 	}
5150 	break;
5151       }
5152       // If A is finished, fill up with elements from a and stop
5153       if (bit == bit_end) {
5154 	while (ait != ait_end) {
5155 	  res.coord.push_back(monomial<gen>(a*ait->value,ait->index));
5156 	  ++ait;
5157 	}
5158 	break;
5159       }
5160       index_m pow_b = bit->index+bshift;
5161       // ait and b are non-empty, compare powers
5162       if (ait->index==pow_b){
5163 	gen diff = a* ait->value + b* bit->value;
5164 	if (!is_zero(diff,contextptr))
5165 	  res.coord.push_back(monomial<gen>(diff,ait->index));
5166 	++ait;
5167 	++bit;
5168       }
5169       else {
5170 	while (ait!=ait_end && A.is_strictly_greater(ait->index, pow_b)) {
5171 	  // a has greater power, get coefficient from a
5172 	  res.coord.push_back(monomial<gen>(a*ait->value,ait->index));
5173 	  ++ait;
5174 	}
5175 	if (ait==ait_end || ait->index!=pow_b){
5176 	  // b has greater power, get coefficient from b
5177 	  res.coord.push_back(monomial<gen>(b*bit->value,pow_b));
5178 	  ++bit;
5179 	}
5180       }
5181     }
5182   }
5183 #endif
5184 
reduce(const polynome & p,const vectpoly & res,const vector<unsigned> & G,unsigned excluded,polynome & rem,polynome & TMP1,polynome & TMP2,environment * env)5185   void reduce(const polynome & p,const vectpoly & res,const vector<unsigned> & G,unsigned excluded,polynome & rem,polynome & TMP1, polynome & TMP2,environment * env){
5186 #ifdef HEAP_REDUCE
5187     TMP2.coord.clear();
5188     heap_reduce(p,res,G,excluded,TMP2,TMP1,TMP2,env);
5189     swap(rem.coord,TMP2.coord);
5190     return;
5191 #endif
5192     if (&p!=&rem)
5193       rem=p;
5194     if (p.coord.empty())
5195       return ;
5196     std::vector< monomial<gen> >::const_iterator pt,ptend;
5197     unsigned i,rempos=0;
5198     for (unsigned count=0;;++count){
5199       ptend=rem.coord.end();
5200 #if 1 // this branch search first in all leading coeff of G for a monomial
5201       // <= to the current rem monomial
5202       pt=rem.coord.begin()+rempos;
5203       if (pt>=ptend)
5204 	break;
5205       for (i=0;i<G.size();++i){
5206 	if (i==excluded || res[G[i]].coord.empty())
5207 	  continue;
5208 	if (pt->index>=res[G[i]].coord.front().index)
5209 	  break;
5210       }
5211       if (i==G.size()){ // no leading coeff of G is smaller than the current coeff of rem
5212 	++rempos;
5213 	continue;
5214       }
5215 #else
5216       // look in rem for a monomial >= to a monomial in it0, then it0+1
5217       for (i=0; i<G.size() ;++i){
5218 	if (i==excluded || res[G[i]].coord.empty())
5219 	  continue;
5220 	const index_m & Gi=res[G[i]].coord.front().index;
5221 	for (pt=rem.coord.begin();pt!=ptend;++pt){
5222 	  if (pt->index>=Gi)
5223 	    break;
5224 	}
5225 	if (pt!=ptend)
5226 	  break;
5227       }
5228       if (i==G.size()) // no monomial of rem are divisible by LT(b): finished
5229 	break;
5230 #endif
5231       gen a(pt->value),b(res[G[i]].coord.front().value);
5232       if (env && env->moduloon){
5233 	polynome temp=res[G[i]].shift(pt->index-res[G[i]].coord.front().index,a*invmod(b,env->modulo));
5234 	rem = smod(rem - temp,env->modulo) ; // FIXME: improve!
5235       }
5236       else {
5237 	simplify(a,b);
5238 	if (b==-1){
5239 	  b=-b;
5240 	  a=-a;
5241 	}
5242 	TMP1.coord.clear();
5243 	TMP2.coord.clear();
5244 #if 0
5245 	linear_combination(rem,b,res[G[i]],-a,pt->index-res[G[i]].coord.front().index,TMP2);
5246 #else
5247 	Shift(res[G[i]].coord,pt->index-res[G[i]].coord.front().index,a,TMP1.coord);
5248 	if (!is_one(b)){
5249 	  rem *= -b;
5250 	  rem.TAdd(TMP1,TMP2);
5251 	}
5252 	else
5253 	  rem.TSub(TMP1,TMP2);
5254 #endif
5255 	swap(rem.coord,TMP2.coord);
5256 	// zint_ppz(rem);
5257       }
5258     }
5259     gen g=inplace_ppz(rem);
5260     if (debug_infolevel>1)
5261       CERR << "ppz was " << g << '\n';
5262   }
5263 
reduce(const polynome & p,const vectpoly & res,const vector<unsigned> & G,unsigned excluded,polynome & rem,environment * env)5264   void reduce(const polynome & p,const vectpoly & res,const vector<unsigned> & G,unsigned excluded,polynome & rem,environment * env){
5265     polynome TMP1(p.dim,p),TMP2(p.dim,p);
5266     reduce(p,res,G,excluded,rem,TMP1,TMP2,env);
5267   }
5268 
5269   // reduce with respect to itself the elements of res with index in G
reduce(vectpoly & res,vector<unsigned> G,environment * env)5270   void reduce(vectpoly & res,vector<unsigned> G,environment * env){
5271     if (res.empty() || G.empty())
5272       return;
5273     polynome pred(res.front().dim,res.front());
5274     polynome TMP1(res.front().dim,res.front()),TMP2(res.front().dim,res.front());
5275     // reduce res
5276     for (unsigned i=0;i<G.size();++i){
5277       polynome & p=res[i];
5278       reduce(p,res,G,i,pred,TMP1,TMP2,env);
5279       swap(res[i].coord,pred.coord);
5280     }
5281   }
5282 
ppz(vectpoly & res)5283   void ppz(vectpoly & res){
5284     vectpoly::iterator it=res.begin(),itend=res.end();
5285     for (;it!=itend;++it)
5286       inplace_ppz(*it);
5287   }
5288 
gbasis_update(vector<unsigned> & G,vector<pair<unsigned,unsigned>> & B,vectpoly & res,unsigned pos,environment * env)5289   static void gbasis_update(vector<unsigned> & G,vector< pair<unsigned,unsigned> > & B,vectpoly & res,unsigned pos,environment * env){
5290     const polynome & h = res[pos];
5291     vector<unsigned> C;
5292     C.reserve(G.size());
5293     const index_m & h0=h.coord.front().index;
5294     index_t tmp1,tmp2;
5295     // C is used to construct new pairs
5296     // create pairs with h and elements g of G, then remove
5297     // -> if g leading monomial is prime with h, remove the pair
5298     // -> if g leading monomial is not disjoint from h leading monomial
5299     //    keep it only if lcm of leading monomial is not divisible by another one
5300     for (unsigned i=0;i<G.size();++i){
5301       if (res[G[i]].coord.empty() || disjoint(h0,res[G[i]].coord.front().index))
5302 	continue;
5303       index_lcm(h0,res[G[i]].coord.front().index,tmp1); // h0 and G[i] leading monomial not prime together
5304       unsigned j;
5305       for (j=0;j<G.size();++j){
5306 	if (i==j || res[G[j]].coord.empty())
5307 	  continue;
5308 	index_lcm(h0,res[G[j]].coord.front().index,tmp2);
5309 	if (tmp1>=tmp2){
5310 	  // found another pair, keep the smallest, or the first if equal
5311 	  if (tmp1!=tmp2)
5312 	    break;
5313 	  if (i>j)
5314 	    break;
5315 	}
5316       } // end for j
5317       if (j==G.size())
5318 	C.push_back(G[i]);
5319     }
5320     vector< pair<unsigned,unsigned> > B1;
5321     B1.reserve(B.size()+C.size());
5322     for (unsigned i=0;i<B.size();++i){
5323       if (res[B[i].first].coord.empty() || res[B[i].second].coord.empty())
5324 	continue;
5325       index_lcm(res[B[i].first].coord.front().index,res[B[i].second].coord.front().index,tmp1);
5326       if (!(tmp1>=h0)){
5327 	B1.push_back(B[i]);
5328 	continue;
5329       }
5330       index_lcm(res[B[i].first].coord.front().index,h0,tmp2);
5331       if (tmp2==tmp1){
5332 	B1.push_back(B[i]);
5333 	continue;
5334       }
5335       index_lcm(res[B[i].second].coord.front().index,h0,tmp2);
5336       if (tmp2==tmp1){
5337 	B1.push_back(B[i]);
5338 	continue;
5339       }
5340     }
5341     // B <- B union pairs(h,g) with g in C
5342     for (unsigned i=0;i<C.size();++i)
5343       B1.push_back(pair<unsigned,unsigned>(pos,C[i]));
5344     swap(B1,B);
5345     // Update G by removing elements with leading monomial >= leading monomial of h
5346     C.clear();
5347     C.reserve(G.size());
5348 #if 0 // sort G by leading monomial increasing order
5349     bool pospushed=false;
5350     for (unsigned i=0;i<G.size();++i){
5351       if (!res[G[i]].coord.empty() && !(res[G[i]].coord.front().index>=h0)){
5352 	// reduce res[G[i]] with respect to h
5353 	reduce(res[G[i]],&h,&h+1,res[G[i]],env);
5354 	if (!pospushed && res[G[i]].is_strictly_greater(res[G[i]].coord.front().index,h0)){
5355 	  pospushed=true;
5356 	  C.push_back(pos);
5357 	}
5358 	C.push_back(G[i]);
5359       }
5360       // NB: removing all pairs containing i in it does not work
5361     }
5362     if (!pospushed)
5363       C.push_back(pos);
5364 #else // without sorting G
5365     for (unsigned i=0;i<G.size();++i){
5366       if (!res[G[i]].coord.empty() && !(res[G[i]].coord.front().index>=h0)){
5367 	// reduce res[G[i]] with respect to h
5368 	gen m;
5369 	reduce(res[G[i]],&h,&h+1,res[G[i]],m,env);
5370 	C.push_back(G[i]);
5371       }
5372       // NB: removing all pairs containing i in it does not work
5373     }
5374     C.push_back(pos);
5375 #endif
5376     swap(C,G);
5377   }
5378 
5379   // first occurence in v: i<0 not found, i>=0 means v[i]==idx
find(const vector<index_m> & v,const index_m & idx)5380   int find(const vector<index_m> & v,const index_m & idx){
5381     unsigned debut=0,fin=unsigned(v.size()); // search in [debut,fin[
5382     if (v.empty() || i_lex_is_strictly_greater(v[0],idx))
5383       return -1;
5384     if (i_lex_is_strictly_greater(idx,v.back()))
5385       return -int(fin);
5386     for (;fin-debut>1;){
5387       unsigned i=(fin+debut)/2;
5388       if (i_lex_is_greater(v[i],idx)){
5389 	if (v[i]==idx)
5390 	  return i;
5391 	fin=i;
5392       }
5393       else
5394 	debut=i;
5395     }
5396     if (v[debut]==idx)
5397       return debut;
5398     return -int(fin);
5399   }
5400 
inplace_division(gen & a,const gen & b)5401   void inplace_division(gen & a,const gen & b){
5402 #ifndef USE_GMP_REPLACEMENTS
5403     if (a.type==_ZINT && a.ref_count()==1){
5404       if (b.type==_INT_ && mpz_divisible_ui_p(*a._ZINTptr,b.val)){
5405 	if (b.val>0)
5406 	  mpz_divexact_ui(*a._ZINTptr,*a._ZINTptr,b.val);
5407 	else {
5408 	  mpz_divexact_ui(*a._ZINTptr,*a._ZINTptr,-b.val);
5409 	  mpz_neg(*a._ZINTptr,*a._ZINTptr);
5410 	}
5411 	return;
5412       }
5413       if (b.type==_ZINT && mpz_divisible_p(*a._ZINTptr,*b._ZINTptr)){
5414 	mpz_divexact(*a._ZINTptr,*a._ZINTptr,*b._ZINTptr);
5415 	return;
5416       }
5417     }
5418     if (a.type==_POLY && a.ref_count()==1){
5419       *a._POLYptr /= b;
5420       return;
5421     }
5422 #endif
5423     a = rdiv(a,b,context0);
5424   }
5425 
inplace_multpoly(const gen & a,polynome & p)5426   void inplace_multpoly(const gen & a,polynome & p){
5427     vector< monomial<gen> >::iterator jt=p.coord.begin(),jtend=p.coord.end();
5428     for (;jt!=jtend;++jt)
5429       type_operator_times(a,jt->value,jt->value);
5430   }
5431 
inplace_divpoly(polynome & p,const gen & a)5432   void inplace_divpoly(polynome & p,const gen & a){
5433     vector< monomial<gen> >::iterator jt=p.coord.begin(),jtend=p.coord.end();
5434     for (;jt!=jtend;++jt)
5435       inplace_division(jt->value,a);
5436   }
5437 
5438   // (a*A+b*B)/c->B, in-place
inplace_linear_combination(const gen & a,const vecteur & A,const gen & b,vecteur & B,const gen & c,int start,polynome & TMP1,polynome & TMP2)5439   static void inplace_linear_combination(const gen & a,const vecteur & A,const gen & b,vecteur & B,const gen & c,int start,polynome & TMP1, polynome & TMP2){
5440     const_iterateur it=A.begin()+start,itend=A.end()-1;
5441     iterateur jt=B.begin()+start;
5442     gen tmp;
5443     for (;it!=itend;++jt,++it){
5444       type_operator_times(b,*jt,*jt);
5445       type_operator_times(a,*it,tmp);
5446       *jt += tmp;
5447       inplace_division(*jt,c);
5448     }
5449     // last operation is polynomial
5450     if (it->type==_POLY && jt->type==_POLY){
5451       *jt->_POLYptr *= b;
5452       TMP1 = *it->_POLYptr;
5453       inplace_multpoly(a,TMP1); // TMP1 *= a;
5454       TMP2.coord.clear();
5455       TMP1.TAdd(*jt->_POLYptr,TMP2);
5456       inplace_divpoly(TMP2,c); // TMP2 /= c;
5457       swap(TMP2.coord,jt->_POLYptr->coord);
5458     }
5459     else {
5460       type_operator_times(b,*jt,*jt);
5461       type_operator_times(a,*it,tmp);
5462       *jt += tmp;
5463       *jt = *jt/c;
5464     }
5465   }
5466 
inplace_multvecteur(const gen & a,vecteur & A,int start=0)5467   static void inplace_multvecteur(const gen & a,vecteur & A,int start=0){
5468     iterateur it=A.begin()+start,itend=A.end()-1;
5469     for (;it!=itend;++it){
5470       type_operator_times(a,*it,*it);
5471     }
5472     if (it->type==_POLY){
5473       inplace_multpoly(a,*it->_POLYptr);
5474       // *it->_POLYptr *= a;
5475     }
5476     else
5477       type_operator_times(a,*it,*it);
5478   }
5479 
inplace_divvecteur(vecteur & A,const gen & a,int start=0)5480   static void inplace_divvecteur(vecteur & A,const gen & a,int start=0){
5481     iterateur it=A.begin()+start,itend=A.end()-1;
5482     for (;it!=itend;++it){
5483       inplace_division(*it,a);
5484     }
5485     if (it->type==_POLY){
5486       inplace_divpoly(*it->_POLYptr,a);
5487       // *it->_POLYptr /= a;
5488     }
5489     else
5490       inplace_division(*it,a);
5491   }
5492 
coeffs(const polynome & p,vector<index_m> rmonomials,environment * env)5493   vecteur coeffs(const polynome & p,vector<index_m> rmonomials,environment * env){
5494     vecteur res(rmonomials.size());
5495     for (unsigned k=0;k<p.coord.size();++k){
5496       int pos=find(rmonomials,p.coord[k].index);
5497       if (pos<0 || pos>=int(res.size()))
5498 	return res; // FIXME error (should not happen)
5499       res[pos]=p.coord[k].value;
5500     }
5501     return res;
5502   }
5503 
5504   // Does not work if env->moduloon
fglm_lex(const vectpoly & G,vectpoly & Glex,unsigned maxpow,environment * env,GIAC_CONTEXT)5505   bool fglm_lex(const vectpoly & G,vectpoly & Glex,unsigned maxpow,environment * env,GIAC_CONTEXT){
5506     Glex.clear();
5507     if (G.empty())
5508       return true;
5509     const polynome & G0=G.front();
5510     unsigned dim=G0.dim;
5511     vector<index_m> rmonomials;
5512     // rmonomials contains the list of indexes of monomials of reducted poly
5513     // they are sorted
5514     vector<unsigned> positions;
5515     // positions[k] is the column of the matrix corresponding to rmonomials[k]
5516     // that way we can quickly find a monomial in rmonomials (sorted) and
5517     // find the corresponding column in the matrix mat
5518     // the two last columns of mat are non-reduced and reduced polynomials
5519     matrice mat,matr; vecteur ligne; vecteur pivots;
5520     // rows of mat are made of coefficients wrt monomials of reduction wrt G
5521     // of the non reduced monomial (last col of G)
5522     // then new monomials may be added to rmonomials to take in account reduced[i]
5523     // adding new columns of 0 to mat
5524     // then reduction of last row by previous ones
5525     // ? and reduction of a column by the last row (TODO?)
5526     // with same linear combination on the (nonreduced) last column
5527     // if the last line is 0 -> new element nonreduced in Glex
5528     index_m idxm(dim);
5529     index_t idxt(dim),prev;
5530     polynome M(G0.dim,G0),R(G0.dim,G0),Rlex(G0.dim),TMP1(G0.dim),TMP2(G0.dim);
5531     M.coord.push_back(monomial<gen>(1,idxm));
5532     gen m;
5533     reduce(M,&G.front(),&G.back()+1,R,m,env);
5534     if (R.coord.empty()){
5535       Glex.push_back(M);
5536       return true;
5537     }
5538     rmonomials.push_back(idxm);
5539     positions.push_back(0);
5540     ligne.push_back(1);
5541     ligne.push_back(M);
5542     mat.push_back(ligne);
5543     idxt[dim-1]=1;
5544     for (;;){
5545       if (sum_degree(idxt)>int(maxpow))
5546 	return false;
5547       // bool found=false;
5548       // reduce monomial w.r.t. G (G order)
5549       M.coord.clear();
5550       idxm=index_t(idxt);
5551       M.coord.push_back(monomial<gen>(1,idxm));
5552       if (debug_infolevel>0)
5553 	CERR << CLOCK() << " reduce begin " << M << '\n';
5554       gen mprev=m;
5555       m=1;
5556       if (prev.empty())
5557 	reduce(M,&G.front(),&G.back()+1,R,m,env); // m*M=<G>+R
5558       else {
5559 	vector< monomial<gen> >::iterator it=R.coord.begin(),itend=R.coord.end();
5560 	for (;it!=itend;++it){
5561 	  *it=it->shift(idxt-prev);
5562 	}
5563 	reduce(R,&G.front(),&G.back()+1,R,m,env); // m*R=<G>+R
5564 	m=mprev*m;
5565       }
5566       if (debug_infolevel>0)
5567 	CERR << CLOCK() << " reduce end " << '\n';
5568       // 1st check if we need to add new monomials
5569       int pos;
5570       bool inserted=false;
5571       for (unsigned i=0;i<R.coord.size();++i){
5572 	pos=find(rmonomials,R.coord[i].index);
5573 	if (pos<0){
5574 	  // set this monomial at column mat.size()
5575 	  rmonomials.insert(rmonomials.begin()-pos,R.coord[i].index);
5576 	  int c=int(mat.size());
5577 	  for (unsigned j=0;j<positions.size();++j){
5578 	    if (int(positions[j])>=c)
5579 	      ++positions[j];
5580 	  }
5581 	  positions.insert(positions.begin()-pos,c);
5582 	  for (unsigned j=0;j<mat.size();++j){
5583 	    vecteur & l=*mat[j]._VECTptr;
5584 	    l.insert(l.begin()+c,0);
5585 	  }
5586 	  inserted=true;
5587 	}
5588       }
5589       if (debug_infolevel>0)
5590 	CERR << CLOCK() << " end insert monomials" << '\n';
5591       // now make last matrix line
5592       ligne.clear();
5593       for (unsigned i=0;i<positions.size();++i)
5594 	ligne.push_back(0);
5595       for (unsigned i=0;i<R.coord.size();++i){
5596 	int pos=find(rmonomials,R.coord[i].index);
5597 	if (pos<0 || pos>=int(ligne.size()))
5598 	  return false; // (should not happen)
5599 	ligne[positions[pos]]=R.coord[i].value;
5600       }
5601       swap(Rlex.coord,M.coord);
5602       Rlex *= m; // no need to sort here
5603       ligne.push_back(Rlex);
5604       mat.push_back(ligne);
5605       // Gauss row reduction on mat
5606       gen det,bareiss=1,piv,coeff;
5607       int li=0,lmax=int(mat.size()),c=0,cmax=int(mat.front()._VECTptr->size())-1;
5608       if (debug_infolevel>0)
5609 	CERR << CLOCK() << " reduce line" << '\n';
5610       for (;li<lmax-1 && c<cmax;){
5611 	vecteur & v=*mat[li]._VECTptr;
5612 	piv=v[c];
5613 	if (is_zero(piv,contextptr)){
5614 	  // ERROR
5615 	  CERR << "error" << '\n';
5616 	  break;
5617 	}
5618 	vecteur & w =*mat[lmax-1]._VECTptr;
5619 	coeff=w[c];
5620 	// row combination of mat[lmax-1] and mat[p]
5621 	if (is_zero(coeff,contextptr)){
5622 	  gen x=piv/bareiss,num,den;
5623 	  if (!is_one(x) && !is_minus_one(x)){
5624 	    fxnd(x,num,den);
5625 	    inplace_multvecteur(num,w,c+1);
5626 	    if (!is_one(den))
5627 	      inplace_divvecteur(w,den,c+1);
5628 	  }
5629 	}
5630 	else {
5631 	  w[c]=0;
5632 	  inplace_linear_combination(-coeff,v,piv,w,bareiss,c+1,TMP1,TMP2);
5633 	  // linear_combination(piv,*mat[lmax-1]._VECTptr,-coeff,*mat[li]._VECTptr,bareiss,*mat[lmax-1]._VECTptr,0.0,0);
5634 	}
5635 	bareiss=piv;
5636 	++li;
5637 	++c;
5638       }
5639 #if 0 // creates 0 in column c==lmax-1
5640       if (li==lmax-1 && c==li && !is_zero(piv=(*mat[li]._VECTptr)[c],contextptr)){
5641 	if (c)
5642 	  bareiss=(*mat[c-1]._VECTptr)[c-1];
5643 	else
5644 	  bareiss=1;
5645 	for (li=0;li<lmax-1;++li){
5646 	  vecteur & w=*mat[li]._VECTptr;
5647 	  coeff=w[c];
5648 	  vecteur & v =*mat[lmax-1]._VECTptr;
5649 	  if (is_zero(coeff,contextptr)){
5650 	    gen x=piv/bareiss,num,den;
5651 	    if (!is_one(x) && !is_minus_one(x)){
5652 	      fxnd(x,num,den);
5653 	      inplace_multvecteur(num,w,c+1);
5654 	      if (!is_one(den))
5655 		inplace_divvecteur(w,den,c+1);
5656 	    }
5657 	  }
5658 	  else {
5659 	    w[c]=0;
5660 	    inplace_linear_combination(-coeff,v,piv,w,bareiss,c+1,TMP1,TMP2);
5661 	  }
5662 	}
5663       }
5664 #endif
5665       const vecteur & l=*mat.back()._VECTptr;
5666       if (li==lmax-1 && c<cmax){
5667 	// search in current line for first non-zero pivot
5668 	// exchange columns
5669 	if (is_zero(l[c],contextptr)){
5670 	  for (pos=c+1;pos<cmax;++pos){
5671 	    if (!is_zero(l[pos],contextptr)){ // if it does not happen, add to Glex
5672 	      for (unsigned k=0;k<positions.size();++k){
5673 		if (int(positions[k])==c)
5674 		  positions[k]=pos;
5675 		else {
5676 		  if (int(positions[k])==pos)
5677 		    positions[k]=c;
5678 		}
5679 	      }
5680 	      for (unsigned k=0;k<mat.size();++k){
5681 		vecteur & w = *mat[k]._VECTptr;
5682 		swapgen(w[c],w[pos]);
5683 	      }
5684 	      break;
5685 	    }
5686 	  }
5687 	}
5688       }
5689       if (li<lmax-1 && c<cmax){
5690 	for (unsigned i=0;i<mat.size();++i){
5691 	  vecteur & v=*mat[i]._VECTptr;
5692 	  gen g=lgcd(v);
5693 	  divvecteur(v,g,v);
5694 	}
5695 	mrref(mat,matr,pivots,det,0,int(mat.size()),0,int(mat.front()._VECTptr->size())-2,
5696 	      /* fullreduction */0,0,true,RREF_BAREISS,0,context0);
5697 	swap(mat,matr);
5698       }
5699       if (debug_infolevel>0)
5700 	CERR << CLOCK() << " reduce line end" << '\n';
5701       // if last line is 0, add element to Glex and remove last line from mat
5702       for (pos=0;pos<int(l.size())-1;++pos){
5703 	if (!is_zero(l[pos],contextptr))
5704 	  break;
5705       }
5706       if (pos==int(l.size())-1){
5707 	if (l.back().type!=_POLY)
5708 	  return false; // should not happen
5709 	Glex.push_back(*l.back()._POLYptr);
5710 	ppz(Glex.back());
5711 	if (debug_infolevel>0){
5712 	  CERR << "Found element " << Glex.back() << '\n';
5713 	}
5714 	index_t tmp=l.back()._POLYptr->coord.front().index.iref();
5715 	index_t tmp1(dim);
5716 	tmp1[0]=tmp[0];
5717 	if (tmp==tmp1){
5718 	  reduce(Glex,env);
5719 	  reverse(Glex.begin(),Glex.end());
5720 	  return true;
5721 	}
5722 	mat.pop_back();
5723       }
5724       // compute next monomial using lex ordering
5725       pos=dim-1;
5726       prev=idxt;
5727       for (;pos>=0;--pos){
5728 	++idxt[pos];
5729 	idxm=idxt;
5730 	// compare to Glex leading monomial, if >= to one of them -> change var
5731 	unsigned j=0;
5732 	for (;j<Glex.size();++j){
5733 	  if (idxm>=Glex[j].coord.front().index)
5734 	    break;
5735 	}
5736 	if (j==Glex.size())
5737 	  break;
5738 	prev.clear();
5739 	idxt[pos]=0;
5740       }
5741       if (pos<0) // should not happen
5742 	return true;
5743     }
5744     return true;
5745   }
5746 
5747 #if 0
5748   // try to convert a basis G to a lex basis Glex
5749   bool fglm1_lex(const vectpoly & G,vectpoly & Glex,unsigned maxpow,environment * env,GIAC_CONTEXT){
5750     Glex.clear();
5751     if (G.empty())
5752       return true;
5753     const polynome & G0=G.front();
5754     unsigned dim=G0.dim;
5755     vector<index_m> monomials,rmonomials;
5756     // monomials contains the list of indexes of input monomials
5757     vectpoly reduced;
5758     // reduced[i] is the reduction wrt G of monomials[i]
5759     // rmonomials is the list of monomials of all reduced[i]
5760     // they are sorted in increasing lex order
5761     index_m idxm(dim);
5762     index_t idxt(dim);
5763     polynome M(G0.dim,G0),R(G0.dim,G0);
5764     M.coord.push_back(monomial<gen>(1,idxm));
5765     gen m;
5766     reduce(M,&G.front(),&G.back()+1,R,m,env);
5767     if (R.coord.empty()){
5768       Glex.push_back(M);
5769       return true;
5770     }
5771     monomials.push_back(idxm);
5772     rmonomials.push_back(idxm);
5773     reduced.push_back(R);
5774     matrice lignes,syst,syst0;
5775     idxt[dim-1]=1;
5776     for (;;){
5777       if (sum_degree(idxt)>maxpow)
5778 	return false;
5779       bool found=false;
5780       // reduce monomial w.r.t. G (G order)
5781       idxm=index_t(idxt);
5782       M.coord.front().index=idxm;
5783       gen m;
5784       if (debug_infolevel>0)
5785 	CERR << CLOCK() << " reduce begin " << '\n';
5786       reduce(M,&G.front(),&G.back()+1,R,m,env);
5787       if (debug_infolevel>0)
5788 	CERR << CLOCK() << " reduce end " << '\n';
5789       if (R.coord.empty()){
5790 	Glex.push_back(M);
5791 	break;
5792       }
5793       R /= m;
5794       // can we express the reduction as a linear combination of the preceding ones?
5795       // 1st check by updating rmonomial, if we need to add a monomial there answer is no
5796       int pos;
5797       bool inserted=false;
5798       for (unsigned i=0;i<R.coord.size();++i){
5799 	// CERR << rmonomials << " " << R.coord[i].index << '\n';
5800 	pos=find(rmonomials,R.coord[i].index);
5801 	if (pos<0){
5802 	  rmonomials.insert(rmonomials.begin()-pos,R.coord[i].index);
5803 	  inserted=true;
5804 	}
5805       }
5806       // if i==R.coord.size(), solve linear system to find linear. comb.
5807       if (!inserted){
5808 	if (debug_infolevel>0){
5809 	  if (R==M)
5810 	    CERR << "R=M " ;
5811 	  CERR << CLOCK() << " fill matrix " << '\n';
5812 	}
5813 	lignes.clear();
5814 	lignes.reserve(reduced.size()+1);
5815 	for (unsigned k=0;k<reduced.size();k++){
5816 	  lignes.push_back(coeffs(reduced[k],rmonomials,env));
5817 	}
5818 	lignes.push_back(coeffs(R,rmonomials,env));
5819 	int nunknown=lignes.size();
5820 	vecteur B;
5821 	mtran(lignes,syst);
5822 	int neq=syst.size();
5823 	bool checked=false;
5824 #if 0
5825 	// scan lines of syst to simplify the system
5826 	// if a line contains only 1 non-zero coeff (except last col)
5827 	// we can determine the unknown of that column
5828 	vecteur sol(nunknown,undef);
5829 	vecteur syst1(syst);
5830 	unsigned totalfound=0;
5831 	for (;;){
5832 	  unsigned found=0;
5833 	  for (unsigned i=0;i<syst1.size();++i){
5834 	    unsigned pos=-1;
5835 	    const vecteur & current=*syst1[i]._VECTptr;
5836 	    gen somme;
5837 	    for (unsigned j=0;j<nunknown-1;j++){
5838 	      if (is_zero(current[j],contextptr))
5839 		continue;
5840 	      if (sol[j]==undef){
5841 		if (pos==-1)
5842 		  pos=j;
5843 		else {
5844 		  pos=-1;
5845 		  break;
5846 		}
5847 	      }
5848 	      else
5849 		somme += current[j]*sol[j];
5850 	    }
5851 	    if (pos!=-1){
5852 	      sol[pos]=(current[nunknown-1]-somme)/current[pos];
5853 	      syst1.erase(syst1.begin()+i);
5854 	      --i;
5855 	      ++found;
5856 	      ++totalfound;
5857 	      if (totalfound==nunknown-1)
5858 		break;
5859 	    }
5860 	  }
5861 	  if (found==0 || totalfound==nunknown-1)
5862 	    break;
5863 	}
5864 	if (totalfound==nunknown-1){
5865 	  sol[nunknown-1]=1;
5866 	  checked=true;
5867 	  if (is_zero(multmatvecteur(syst,sol),contextptr))
5868 	    B=vecteur(1,sol);
5869 	}
5870 	// lignes.size()== number of unknowns, syst.size()=numbers of equations
5871 	// first try to solve with number of equations=number of unknowns -1 ?
5872 	// if the ker is dim 1 we can check that full_syst*ker[0]=0
5873 	if (neq>nunknown){
5874 	  syst0=vecteur(syst.begin(),syst.begin()+nunknown-1);
5875 	  mker(syst0,B,contextptr);
5876 	  if (B.size()!=1)
5877 	    B.clear();
5878 	  else {
5879 	    checked=true;
5880 	    if (!is_zero(multmatvecteur(syst,B),contextptr))
5881 	      B.clear();
5882 	  }
5883 	}
5884 #endif
5885 	if (!checked){
5886 	  gen m;
5887 	  for (unsigned i=0;i<syst.size();++i){
5888 	    lcmdeno(*syst[i]._VECTptr,m,context0);
5889 	  }
5890 	  if (debug_infolevel>0)
5891 	    CERR << CLOCK() << " ker begin " << neq << "*" << nunknown << '\n';
5892 	  mker(syst,B,contextptr);
5893 	  if (debug_infolevel>0)
5894 	    CERR << CLOCK() << " ker end " << '\n';
5895 	}
5896 	if (is_undef(B) || B.empty())
5897 	  ;
5898 	else {
5899 	  // The last element of B must have a non-zero last component
5900 	  vecteur Bend=*B.back()._VECTptr;
5901 	  gen last=Bend.back();
5902 	  if (!is_zero(last,contextptr)){
5903 	    // solution found!
5904 	    // make scalar product of Bend with reduced
5905 	    polynome res(dim);
5906 	    res.coord.push_back(monomial<gen>(last,idxm));
5907 	    for (unsigned k=0;k<reduced.size();++k){
5908 	      if (!is_zero(Bend[k],contextptr))
5909 		res.coord.push_back(monomial<gen>(Bend[k],monomials[k]));
5910 	    }
5911 	    res.tsort();
5912 	    m=1;
5913 	    lcmdeno(res,m);
5914 	    res *= m;
5915 	    Glex.push_back(res);
5916 	    if (debug_infolevel>0)
5917 	      CERR << "Found element beginning with [x1,x2,...]^" << idxt << '\n';
5918 	    // check if we are finished
5919 	    index_t tmp=res.coord.front().index.iref();
5920 	    index_t tmp1(dim);
5921 	    tmp1[0]=tmp[0];
5922 	    if (tmp==tmp1)
5923 	      return true;
5924 	    found=true;
5925 	  }
5926 	}
5927       }
5928       // if monomial not found
5929       // add idxm to the list of monomials and R to the list of reduced
5930       if (!found){
5931 	monomials.push_back(idxm);
5932 	reduced.push_back(R);
5933 	change_monomial_order(reduced.back(),_PLEX_ORDER);
5934       }
5935       // compute next monomial using lex ordering
5936       pos=dim-1;
5937       for (;pos>=0;--pos){
5938 	++idxt[pos];
5939 	idxm=idxt;
5940 	// compare to Glex leading monomial, if >= to one of them -> change var
5941 	unsigned j=0;
5942 	for (;j<Glex.size();++j){
5943 	  if (idxm>=Glex[j].coord.front().index)
5944 	    break;
5945 	}
5946 	if (j==Glex.size())
5947 	  break;
5948 	idxt[pos]=0;
5949       }
5950       if (pos<0) // should not happen
5951 	return true;
5952     }
5953     return true;
5954   }
5955 #endif
5956 
is_zero_dim(vectpoly & G)5957   bool is_zero_dim(vectpoly & G){
5958     if (G.empty())
5959       return false;
5960     unsigned dim=G.front().dim,count=0;
5961     for (unsigned i=0;i<G.size();++i){
5962       const index_m & idxm=G[i].coord.front().index;
5963       // check if idx is a power of an indeterminate
5964       for (unsigned j=0;j<dim;++j){
5965 	if (idxm[j]==0)
5966 	  continue;
5967 	index_t idxt(dim);
5968 	idxt[j]=idxm[j];
5969 	if (idxm.iref()==idxt)
5970 	  ++count;
5971 	else
5972 	  break;
5973       }
5974     }
5975     return count==dim;
5976   }
5977 
giac_gbasis(vectpoly & res,const gen & order_,environment * env,int modularcheck,int & rur,GIAC_CONTEXT,gbasis_param_t gbasis_param)5978   static bool giac_gbasis(vectpoly & res,const gen & order_,environment * env,int modularcheck,int & rur,GIAC_CONTEXT,gbasis_param_t gbasis_param){
5979     if (res.empty()) return true;
5980     int order,lexvars=0;
5981     if (order_.type==_VECT && order_._VECTptr->size()==2){
5982       if (order_._VECTptr->front().type==_INT_ && order_._VECTptr->back().type==_INT_){
5983 	order=order_._VECTptr->front().val;
5984 	lexvars=order_._VECTptr->back().val;
5985       }
5986       else return false;
5987     }
5988     else {
5989       if (order_.type!=_INT_)
5990 	return false;
5991       order=order_.val;
5992     }
5993     if (order==_PLEX_ORDER || order==0){
5994       // try first a 0-dim ideal with REVLEX and conversion
5995       vectpoly resrev(res),reslex;
5996       for (unsigned k=0;k<resrev.size();++k)
5997 	change_monomial_order(resrev[k],_REVLEX_ORDER);
5998       gbasis_param.eliminate_flag=false;
5999       if (!giac_gbasis(resrev,_REVLEX_ORDER,env,modularcheck,rur,contextptr,gbasis_param))
6000 	return false;
6001       if (is_zero_dim(resrev) && fglm_lex(resrev,reslex,1024,env,context0)){
6002 	reslex.swap(res);
6003 	return true;
6004       }
6005     }
6006     if (order<0){
6007       order=-order;
6008       rur=1;
6009     }
6010     if (gbasis_param.reinject_begin==-1 && gbasis_param.reinject_end==-1){
6011 #ifdef GIAC_REDUCEMODULO
6012       //if (res.size()<=2*res.front().dim) reduce(res,env);
6013 #else
6014       reduce(res,env);
6015 #endif
6016       sort_vectpoly(res.begin(),res.end());
6017       reverse(res.begin(),res.end());
6018       if (debug_infolevel>6)
6019 	res.dbgprint();
6020     }
6021 #if !defined GIAC_HAS_STO_38 && !defined FXCG // CAS38_DISABLED
6022     if (
6023 #ifdef GIAC_64VARS
6024 	1 ||
6025 #endif
6026 	 res.front().dim<=GROEBNER_VARS+1-(order!=_PLEX_ORDER)){
6027       vectpoly tmp;
6028       order_t order_={static_cast<short>(order),(unsigned char)(lexvars/256),(unsigned char)(lexvars)};
6029       if (!gbasis8(res,order_,tmp,env,modularcheck!=0,modularcheck>=2,rur,contextptr,gbasis_param))
6030 	return false;
6031       int i;
6032       for (i=0;i<tmp.size();++i){
6033 	if (tmp[i].coord.empty())
6034 	  break;
6035       }
6036       if (rur || i==tmp.size())
6037 	tmp.swap(res);
6038       else {
6039 	// remove 0
6040 	res.clear();
6041 	for (int i=0;i<tmp.size();++i){
6042 	  if (!tmp[i].coord.empty())
6043 	    res.push_back(tmp[i]);
6044 	}
6045       }
6046       // reduce(res,env);
6047       if (!rur){
6048 	sort_vectpoly(res.begin(),res.end());
6049 	if (increasing_power(contextptr))
6050 	  reverse(res.begin(),res.end());
6051       }
6052       return true;
6053     }
6054 #endif
6055 #if 0 // def BESTA_OS
6056     bool notfound=true;
6057     for (;notfound && !interrupted;){
6058       if (debug_infolevel>6)
6059 	res.dbgprint();
6060       notfound=false;
6061       vectpoly::const_iterator it=res.begin(),itend=res.end(),jt;
6062       vectpoly newres(res);
6063       for (;it!=itend && !interrupted;++it){
6064 	for (jt=it+1;jt!=itend && !interrupted;++jt){
6065 	  if (disjoint(it->coord.front().index,jt->coord.front().index))
6066 	    continue;
6067 	  polynome toadd(spoly(*it,*jt,env));
6068 	  toadd=reduce(toadd,newres,env);
6069 	  if (!toadd.coord.empty()){
6070 	    newres.push_back(toadd); // should be at the right place
6071 	    notfound=true;
6072 	  }
6073 	}
6074       }
6075       reduce(newres,env);
6076       swap(res,newres);
6077     }
6078 #else
6079     // BP: What's wrong for besta here?
6080     vector<unsigned> G;
6081     vector< pair<unsigned,unsigned> > B;
6082     for (unsigned l=0;l<res.size();++l){
6083       gbasis_update(G,B,res,l,env);
6084     }
6085     for (;!B.empty() && !interrupted;){
6086       if (debug_infolevel>1)
6087 	CERR << CLOCK() << " number of pairs: " << B.size() << ", base size: " << G.size() << '\n';
6088       // find smallest lcm pair in B
6089       index_t small0,cur;
6090       unsigned smallpos;
6091       int smalltd=RAND_MAX;
6092       for (smallpos=0;smallpos<B.size();++smallpos){
6093 	if (!res[B[smallpos].first].coord.empty() && !res[B[smallpos].second].coord.empty())
6094 	  break;
6095       }
6096       index_lcm(res[B[smallpos].first].coord.front().index,res[B[smallpos].second].coord.front().index,small0);
6097       for (unsigned i=smallpos+1;i<B.size();++i){
6098 	if (res[B[i].first].coord.empty() || res[B[i].second].coord.empty())
6099 	  continue;
6100 	index_lcm(res[B[i].first].coord.front().index,res[B[i].second].coord.front().index,cur);
6101 	int curtd=RAND_MAX; // total_degree(cur); // commented otherwise lex is '\n'ess
6102 	if (curtd<smalltd
6103 	    || (curtd==smalltd && res.front().is_strictly_greater(small0,cur))
6104 	    ){
6105 	  smalltd=curtd;
6106 	  swap(small0,cur); // small0=cur;
6107 	  smallpos=i;
6108 	}
6109       }
6110       pair<unsigned,unsigned> bk=B[smallpos];
6111       if (debug_infolevel>1 && (equalposcomp(G,bk.first)==0 || equalposcomp(G,bk.second)==0))
6112 	CERR << CLOCK() << " reducing pair with 1 element not in basis " << bk << " from " << B << '\n';
6113       B.erase(B.begin()+smallpos);
6114       polynome h=spoly(res[bk.first],res[bk.second],env);
6115       if (debug_infolevel>1)
6116 	CERR << CLOCK() << " reduce begin, pair " << bk << " remainder size " << h.coord.size() << '\n';
6117       reduce(h,res,G,unsigned(-1),h,env);
6118       if (debug_infolevel>1){
6119 	if (debug_infolevel>2){ CERR << h << '\n'; }
6120 	CERR << CLOCK() << " reduce end, remainder size " << h.coord.size() << '\n';
6121       }
6122       if (!h.coord.empty()){
6123 	res.push_back(h);
6124 	gbasis_update(G,B,res,int(res.size())-1,env);
6125 	if (debug_infolevel>2)
6126 	  CERR << CLOCK() << " basis indexes " << G << " pairs indexes " << B << '\n';
6127       }
6128     }
6129     vectpoly newres(G.size(),polynome(res.front().dim,res.front()));
6130     for (unsigned i=0;i<G.size();++i)
6131       swap(newres[i].coord,res[G[i]].coord);
6132     swap(res,newres);
6133     reduce(res,env);
6134     if (!env || !env->moduloon)
6135       ppz(res);
6136 #endif
6137     sort_vectpoly(res.begin(),res.end());
6138     if (increasing_power(contextptr))
6139       reverse(res.begin(),res.end());
6140     return true;
6141   }
6142 
gbasis(const vectpoly & v,const gen & order,bool with_cocoa,int modular,environment * env,int & rur,GIAC_CONTEXT,gbasis_param_t gbasis_param)6143   vectpoly gbasis(const vectpoly & v,const gen & order,bool with_cocoa,int modular,environment * env,int & rur,GIAC_CONTEXT,gbasis_param_t gbasis_param){
6144     if (v.size()<=1){
6145       return v;
6146     }
6147     vectpoly res(v);
6148 #ifndef NO_STDEXCEPT
6149     try {
6150 #endif
6151       if (with_cocoa && order.type==_INT_){
6152 	// modular used as a synonym for with_f5
6153 	bool ok=modular?f5(res,order):cocoa_gbasis(res,order);
6154 	if (ok){
6155 	  if (debug_infolevel>1)
6156 	    CERR << res << '\n';
6157 	  return res;
6158 	}
6159       }
6160 #ifndef NO_STDEXCEPT
6161     } catch (...){
6162       last_evaled_argptr(contextptr)=NULL;
6163       if (debug_infolevel)
6164 	CERR << "Unable to compute gbasis with CoCoA" << '\n';
6165     }
6166 #endif
6167     if (!giac_gbasis(res,order,env,modular,rur,contextptr,gbasis_param))
6168       gensizeerr(gettext("Unable to compute gbasis with giac, perhaps dimension is too large"));
6169     return res;
6170   }
6171 
remove_equal(const gen & f)6172   gen remove_equal(const gen & f){
6173     if ( (f.type==_SYMB) && (f._SYMBptr->sommet==at_equal || f._SYMBptr->sommet==at_equal2 || f._SYMBptr->sommet==at_same ) ){
6174       vecteur & v=*f._SYMBptr->feuille._VECTptr;
6175       return v.front()-v.back();
6176     }
6177     if (f.type==_VECT)
6178       return apply(f,remove_equal);
6179     return f;
6180   }
6181 
remove_equal(const_iterateur it,const_iterateur itend)6182   vecteur remove_equal(const_iterateur it,const_iterateur itend){
6183     vecteur conditions;
6184     conditions.reserve(itend-it);
6185     for (;it!=itend;++it){
6186       conditions.push_back(remove_equal(*it));
6187     }
6188     return conditions;
6189   }
6190 
vecteur2vector_polynome(const vecteur & eq_in,const vecteur & l,vectpoly & eqp)6191   bool vecteur2vector_polynome(const vecteur & eq_in,const vecteur & l,vectpoly & eqp){
6192     // remove all denominators
6193     const_iterateur it=eq_in.begin(),itend=eq_in.end();
6194     for (;it!=itend;++it){
6195       gen n,d;
6196       fxnd(*it,n,d);
6197       if (n.type==_POLY){
6198 	// should reordre n with total degree+revlex order here
6199 	eqp.push_back(*n._POLYptr);
6200 	continue;
6201       }
6202       if (!is_zero(n))
6203 	return false;
6204     }
6205     return true;
6206   }
6207 
gen2poly(const gen & g)6208   vecteur gen2poly(const gen &g){
6209     if (g.type==_FRAC && g._FRACptr->num.type==_VECT)
6210       return multvecteur(inv(g._FRACptr->den,context0),*g._FRACptr->num._VECTptr);
6211     return gen2vecteur(g);
6212   }
6213 
gsolve(const vecteur & eq_orig,const vecteur & var_orig,bool complexmode,int evalf_after,GIAC_CONTEXT)6214   vecteur gsolve(const vecteur & eq_orig,const vecteur & var_orig,bool complexmode,int evalf_after,GIAC_CONTEXT){
6215     // replace variables in var_orig by true identificators
6216     vecteur var(var_orig);
6217     if (!lop(eq_orig,*at_unit).empty())
6218       *logptr(contextptr) << "Units are not supported"<<'\n';
6219     // check if the whole system is linear
6220     if (is_zero(derive(derive(eq_orig,var,contextptr),var,contextptr),contextptr)){
6221       gen sol=_linsolve(makesequence(eq_orig,var),contextptr);
6222       if (sol.type==_VECT && sol._VECTptr->empty())
6223 	return *sol._VECTptr;
6224       return vecteur(1,sol);
6225     }
6226     iterateur it=var.begin(),itend=var.end();
6227     int s=int(itend-it); // # of unknowns
6228     if (s==0)
6229       return vecteur(1,gendimerr(contextptr));
6230     if (s==1){
6231       vecteur v=solve(eq_orig,var[0],complexmode,contextptr);
6232       for (unsigned i=0;i<v.size();++i){
6233 	v[i]=makevecteur(v[i]);
6234       }
6235       return v;
6236     }
6237 #if 0
6238     if (s>int(eq_orig.size())){
6239       *logptr(contextptr) << gettext("Warning: solving by reducing number of unknowns to number of equations: ") << var_orig << " -> " << vecteur(it,it+eq_orig.size()) << '\n';
6240       vecteur remvars=vecteur(it+eq_orig.size(),itend);
6241       vecteur res=gsolve(eq_orig,vecteur(it,it+eq_orig.size()),complexmode,evalf_after,contextptr);
6242       for (unsigned i=0;i<res.size();++i){
6243 	if (res[i].type==_VECT)
6244 	  res[i]=mergevecteur(*res[i]._VECTptr,remvars);
6245       }
6246       return res;
6247     }
6248 #endif
6249     bool need_subst=false;
6250     vector<identificateur> tab_idnt(s);
6251     for (int i=0;it!=itend;++it,++i){
6252       if (it->type!=_IDNT){
6253 	*it=tab_idnt[i];
6254 	need_subst=true;
6255       }
6256     }
6257     vecteur eq(remove_equal(eq_orig.begin(),eq_orig.end()));
6258     if (need_subst)
6259       eq=subst(eq,var_orig,var,false,contextptr);
6260     if (approx_mode(contextptr)){
6261       if (_sort(lvar(eq),contextptr)!=_sort(lidnt(eq),contextptr)){
6262 #ifdef HAVE_LIBGSL
6263 	return makevecteur(msolve(eq,var,multvecteur(zero,var),_HYBRID_SOLVER,epsilon(contextptr),contextptr));
6264 #else
6265 	return vecteur(1,undef);
6266 #endif
6267       }
6268       eq=*apply(eq,exact,contextptr)._VECTptr;
6269       evalf_after |= 1;
6270     }
6271     if (var.size()>1){
6272 #if 1 // ATESTER
6273       if (eq.size()<=lidnt(eq).size()+3){
6274 	// first check for linear dependencies -> substitutions
6275 	gen a,b;
6276 	for (unsigned i=0;i<eq.size();++i){
6277 	  gen numeqi=_numer(eq[i],contextptr);
6278 	  for (unsigned j=0;j<var.size();++j){
6279 	    if (is_linear_wrt(numeqi,var[j],a,b,contextptr)){
6280 	      if (j==0 && is_zero(a) && is_zero(b)){
6281 		// suppress eq[i]
6282 		eq.erase(eq.begin()+i);
6283 		--i;
6284 		break;
6285 	      }
6286 	      if (is_zero(derive(a,var,contextptr),contextptr)
6287 		  && !is_zero(simplify(a,contextptr),contextptr)){
6288 		if (a!=1 && a!=-1){
6289 		  // maybe eq[i] is linear wrt var[jj] for jj>j with a simpler a coeff
6290 		  for (unsigned jj=j+1;jj<var.size();++jj){
6291 		    gen aa,bb;
6292 		    if (is_linear_wrt(numeqi,var[jj],aa,bb,contextptr)
6293 			&& is_zero(derive(aa,var,contextptr),contextptr)
6294 			&& !is_zero(simplify(aa,contextptr),contextptr)){
6295 		      if (aa.islesscomplexthan(a)){
6296 			j=jj;
6297 			a=aa;
6298 			b=bb;
6299 		      }
6300 		    }
6301 		  }
6302 		}
6303 		// eq[i]=a*var[j]+b
6304 		// replace var[j] by -b/a
6305 		gen elimj=-b/a;
6306 		vecteur eqs(eq);
6307 		vecteur elim(var);
6308 		eqs.erase(eqs.begin()+i);
6309 		for (unsigned k=0;k<eqs.size();++k){
6310 		  eqs[k]=_numer(subst(eqs[k],elim[j],elimj,false,contextptr),contextptr);
6311 		}
6312 		elim.erase(elim.begin()+j);
6313 		vecteur res=gsolve(eqs,elim,complexmode,evalf_after,contextptr);
6314 		for (unsigned k=0;k<res.size();++k){
6315 		  gen & resk=res[k];
6316 		  if (resk.type==_VECT && resk._VECTptr->size()==elim.size()){
6317 		    vecteur resmodif(*resk._VECTptr);
6318 		    gen resval=subst(elimj,elim,resk,false,contextptr);
6319 		    if (is_undef(resval)){
6320 		      res.erase(res.begin()+k);
6321 		      --k;
6322 		      continue;
6323 		    }
6324 		    resmodif.insert(resmodif.begin()+j,resval);
6325 		    resk=gen(resmodif,resk.subtype);
6326 		  }
6327 		  else
6328 		    resk=gensizeerr(contextptr);
6329 		}
6330 		return res;
6331 	      }
6332 	      if (eq.size()==2 && var.size()==2 && is_zero(derive(derive(eq,var[j],contextptr),var[j],contextptr))){
6333 		// add resultant and solve again
6334 		gen resu=_resultant(makesequence(eq[0],eq[1],var[j]),contextptr);
6335 		eq.push_back(resu);
6336 	      }
6337 	    } // end if is_linear
6338 	  }
6339 	}
6340       }
6341 #endif
6342       vecteur ls=lvarfracpow(eq);
6343       if ( ((evalf_after & 4)==0) && !ls.empty()){
6344 	// add equations and variables
6345 	int s=int(ls.size())/3;
6346 	vecteur substin,substout,equations,listvars;
6347 	vector<int> poscheck;
6348 	for (unsigned i=0;int(i)<s;++i){
6349 	  gen lsvar=ls[3*i+2];
6350 	  gen ls3i=subst(ls[3*i],substin,substout,false,contextptr);
6351 	  if (equalposcomp(substin,lsvar))
6352 	    continue;
6353 	  substin.push_back(lsvar);
6354 	  gen tmp("c__"+print_intvar_counter(contextptr),contextptr);
6355 	  if (!(ls[3*i+1].val %2))
6356 	    poscheck.push_back(int(var.size()+listvars.size()));
6357 	  listvars.push_back(tmp);
6358 	  substout.push_back(tmp);
6359 	  equations.push_back(pow(tmp,ls[3*i+1],contextptr)-ls3i);
6360 	}
6361 	vecteur neweq=subst(eq,substin,substout,false,contextptr);
6362 	vecteur newvar=mergevecteur(var,listvars);
6363 	vecteur sol=gsolve(mergevecteur(neweq,equations),newvar,complexmode,evalf_after | 4,contextptr);
6364 	// extract var part
6365 	for (unsigned i=0;i<sol.size();++i){
6366 	  if (sol[i].type==_VECT && sol[i]._VECTptr->size()==newvar.size()){
6367 	    // check positivity for sqrt variables and so on
6368 	    vecteur w=*sol[i]._VECTptr;
6369 	    unsigned j;
6370 	    for (j=0;j<poscheck.size();++j){
6371 	      if (is_strictly_positive(-w[poscheck[j]],contextptr))
6372 		break;
6373 	    }
6374 	    if (j<poscheck.size()){
6375 	      sol.erase(sol.begin()+i);
6376 	      --i;
6377 	    }
6378 	    else
6379 	      sol[i]=vecteur(w.begin(),w.begin()+var.size());
6380 	  }
6381 	}
6382 	return sol;
6383 	//return vecteur(1,gensizeerr(contextptr));
6384       } // end fractional power code
6385       // check if one equation depends only on one unknown
6386       if ((evalf_after & 4)==0){
6387 	for (unsigned i=0;i<eq.size();++i){
6388 	  vecteur curv=lidnt(eq[i]);
6389 	  gen curvvar=_intersect(makesequence(curv,var),contextptr);
6390 	  if (curvvar.type==_VECT && curvvar._VECTptr->size()==1){
6391 	    gen curvar= curvvar._VECTptr->front();
6392 	    int varn=equalposcomp(var,curvar);
6393 	    var.erase(var.begin()+varn-1);
6394 	    vecteur sol=solve(eq[i],curvar,complexmode,contextptr);
6395 	    vecteur res;
6396 	    if (!is_undef(res)){
6397 	      eq.erase(eq.begin()+i);
6398 	      for (unsigned j=0;j<sol.size();++j){
6399 		gen eq1=subst(eq,curvar,sol[j],false,contextptr),tmp;
6400 		if (var.size()==1){
6401 		  if (eq1.type==_VECT && eq1._VECTptr->size()==1)
6402 		    tmp=solve(eq1._VECTptr->front(),var.front(),complexmode,contextptr);
6403 		  else
6404 		    tmp=solve(eq1,var.front(),complexmode,contextptr);
6405 		}
6406 		else
6407 		  tmp=solve(eq1,var,complexmode,contextptr);
6408 		if (tmp.type==_VECT){
6409 		  for (unsigned k=0;k<tmp._VECTptr->size();++k){
6410 		    vecteur solv=gen2vecteur((*tmp._VECTptr)[k]);
6411 		    if (int(solv.size())<varn-1)
6412 		      return vecteur(1,gensizeerr(contextptr));
6413 		    solv.insert(solv.begin()+varn-1,sol[j]);
6414 		    res.push_back(solv);
6415 		  }
6416 		}
6417 	      } // for j (solutions in the single variable)
6418 	      return res;
6419 	    } // end if !is_undef(res)
6420 	  } // end curvar size==1
6421 	} // end for on all equations
6422       } // end if evalf_after | 4 == 0
6423     } // end var size >1
6424     bool convertapprox=has_num_coeff(eq);
6425     gen eqs=eq;
6426     if (convertapprox)
6427       eq=*exact(evalf(eq,1,contextptr),contextptr)._VECTptr;
6428     // check rational
6429     int varn=0;
6430     for (it=var.begin();it!=itend;++it,++varn){
6431       if (it->type!=_IDNT) // should not occur!
6432 	return vecteur(1,gensizeerr(gettext("Bad var ")+it->print(contextptr)));
6433       vecteur l(rlvarx(eq,*it));
6434       if (l.size()>1){
6435 	gen tmp=rationalize(eq,*it,contextptr);
6436 	if (tmp.type==_VECT){
6437 	  eq=*tmp._VECTptr;
6438 	  l=lvarx(eq,*it);
6439 	  if (l.size()==1){
6440 	    // solve with respect to l[0] then extract *it
6441 	    gen newvar=l.front();
6442 	    gen tmpeq=subst(eq,newvar,*it,false,contextptr);
6443 	    if (tmpeq.type==_VECT){
6444 	      vecteur res0=gsolve(*tmpeq._VECTptr,var,complexmode,0,contextptr);
6445 	      // solve newvar=varn-th component of each solution in res
6446 	      vecteur res;
6447 	      int i=0;
6448 	      for (;i<int(res0.size());++i){
6449 		gen cur=res0[i];
6450 		if (cur.type!=_VECT || cur._VECTptr->size()<varn)
6451 		  break;
6452 		vecteur curv=*cur._VECTptr;
6453 		gen val=curv[varn];
6454 		vecteur resval=solve(newvar-val,*it,complexmode,contextptr);
6455 		for (int j=0;j<int(resval.size());++j){
6456 		  curv[varn]=resval[j];
6457 		  res.push_back(curv);
6458 		}
6459 	      }
6460 	      if (i==res0.size()){
6461 		// subst original var with result, for example for solve([ exp(x^2 + y^2) =8, exp(x^2 + y^2)=8*y^2],[x,y]);
6462 		for (int j=0;j<res.size();++j){
6463 		  res[j]=subst(res[j],var_orig,res[j],false,contextptr);
6464 		}
6465 		return res;
6466 	      }
6467 	    }
6468 	  }
6469 	}
6470 	return vecteur(1,gensizeerr(gen(l).print(contextptr)+gettext(" is not rational w.r.t. ")+it->print(contextptr)));
6471       }
6472     }
6473     int varsize=int(var.size());
6474 #if 1 // trying with rational univariate rep., assuming radical ideal of dim 0
6475     if (varsize<=GROEBNER_VARS && varsize==int(eq.size())){
6476       double eps=epsilon(contextptr);
6477       if (varsize==2){ // try by resultant
6478 	//eq=*eqs._VECTptr;
6479 	gen r=_resultant(makesequence(eq[0],eq[1],var[0]),contextptr);
6480 	if (!is_zero(r)){
6481 	  // solve r w.r.t. var[1]
6482 	  vecteur S,res;
6483 	  if (convertapprox){
6484 	    gen p=_symb2poly(makesequence(r,var[1]),contextptr);
6485 	    p=evalf(p,1,contextptr);
6486 	    p=_proot(p,contextptr);
6487 	    if (p.type!=_VECT) return vecteur(1,gensizeerr(contextptr));
6488 	    S=*p._VECTptr;
6489 	  }
6490 	  else
6491 	    S=solve(r,var[1],complexmode,contextptr);
6492 	  for (int i=0;i<int(S.size());++i){
6493 	    gen y=S[i];
6494 	    if (has_num_coeff(y)){
6495 	      vecteur T=solve(subst(eq[0],var[1],y,false,contextptr),var[0],complexmode,contextptr);
6496 	      for (int j=0;j<int(T.size());++j){
6497 		gen x=T[j];
6498 		gen tst=subst(subst(eq[1],var[1],y,false,contextptr),var[0],x,false,contextptr);
6499 		if (is_greater(1e-6,abs(tst,contextptr),contextptr))
6500 		  res.push_back(makevecteur(x,y));
6501 	      }
6502 	    }
6503 	    else {
6504 	      gen G=gcd(subst(eq[0],var[1],y,false,contextptr),subst(eq[1],var[1],y,false,contextptr));
6505 	      vecteur T=solve(G,var[0],complexmode,contextptr);
6506 	      for (int j=0;j<int(T.size());++j){
6507 		res.push_back(makevecteur(T[j],y));
6508 	      }
6509 	    }
6510 	  }
6511 	  return res;
6512 	} // end resultant not 0
6513       } // end #var=2
6514       gen G=_gbasis(makesequence(eq,var,change_subtype(_RUR_REVLEX,_INT_GROEBNER)),contextptr);
6515       if (G.type==_VECT && G._VECTptr->size()==var.size()+4 && G._VECTptr->front().type==_INT_ && G._VECTptr->front().val==_RUR_REVLEX){
6516 	vecteur Gv=*G._VECTptr,S;
6517 	gen rurvar=var.front();
6518 	if (Gv[1].type==_IDNT)
6519 	  rurvar=Gv[1];
6520 	if (proba_epsilon(contextptr)<1e-16){
6521 	  // check the solution replace var by G[4..end]/G[3] in eq and divide by G[2]
6522 	  for (unsigned i=0;i<eq.size();++i){
6523 	    gen check=subst(eq[i],var,divvecteur(vecteur(Gv.begin()+4,Gv.end()),Gv[3]),false,contextptr);
6524 	    check=_numer(check,contextptr);
6525 	    check=_rem(makesequence(check,Gv[2],rurvar),contextptr);
6526 	    if (!is_zero(check,contextptr))
6527 	      *logptr(contextptr) << "Warning, solution does not seem to cancel " << eq[i] << '\n';
6528 	  }
6529 	}
6530 	else
6531 	  *logptr(contextptr) << "Rational univariate representation is not certified, set proba_epsilon:=0 to certify" << '\n';
6532 	int deg=_degree(makesequence(Gv[2],rurvar),contextptr).val;
6533 	if (evalf_after & 1){
6534 	  gen pol=Gv[2],tmp;
6535 	  if (complexmode){
6536 	    // FIXME: implement interval arit. for complexes
6537 	    if (0 && (evalf_after & 2)){
6538 	      tmp=complexroot(makesequence(pol,eps),true,contextptr);
6539 	    }
6540 	    else {
6541 	      if (deg>28)
6542 		tmp=_proot(makesequence(pol,rurvar,deg/2),contextptr);
6543 	      else
6544 		tmp=_proot(makesequence(pol,rurvar),contextptr);
6545 	    }
6546 	  }
6547 	  else {
6548 	    if (deg>28){
6549 	      double eps2=std::pow(2.0,-deg/2);
6550 	      if (eps2<eps)
6551 		eps=eps2;
6552 	    }
6553 	    tmp=complexroot(makesequence(pol,eps),false,contextptr); // realroots
6554 	  }
6555 	  // CERR << tmp << '\n';
6556 	  if (tmp.type==_VECT)
6557 	    S=*tmp._VECTptr;
6558 	}
6559 	if (S.empty()){
6560 	  // G[1] separating, G[2]=minpoly, G[3]=derivative, G[4..end]=solution
6561 	  if (debug_infolevel)
6562 	    *logptr(contextptr) << "Solutions = substitute roots of " << Gv[2] << " in " << vecteur(Gv.begin()+4,Gv.end()) << "/(" << Gv[3] << ")" << '\n';
6563 	  S=solve(Gv[2],rurvar,complexmode,contextptr);
6564 	}
6565 	vecteur res;
6566 	modpoly minp=gen2poly(_symb2poly(makesequence(Gv[2],rurvar),contextptr));
6567 	modpoly minp1=derivative(minp);
6568 	modpoly denp=gen2poly(_symb2poly(makesequence(Gv[3],rurvar),contextptr));
6569 	vector<modpoly> numv;
6570 	for (unsigned i=4;i<Gv.size();++i){
6571 	  numv.push_back(gen2poly(_symb2poly(makesequence(Gv[i],rurvar),contextptr)));
6572 	}
6573 	for (unsigned i=0;i<S.size();++i){
6574 	  gen s=S[i];
6575 	  if (s.type==_VECT && s._VECTptr->size()==2){
6576 	    s=s._VECTptr->front();
6577 	    if (s.type==_VECT && s._VECTptr->size()==2){
6578 #if 1 // arithmetic interval
6579 	      gen l=s._VECTptr->front(),r=s._VECTptr->back();
6580 	      vecteur den;
6581 	      // accuracy
6582 	      int nbits=0;
6583 	      gen deuxn=1,lr=r-l;
6584 	      gen Eps=pow(gen(10),int(std::floor(std::log10(eps))),contextptr);
6585 	      for (;is_greater(1,deuxn*lr,contextptr);){
6586 		++nbits;
6587 		deuxn=plus_two*deuxn;
6588 	      }
6589 	      for (bool stopnextiter=false;;){
6590 		if (!stopnextiter)
6591 		  den=horner_interval(denp,l,r);
6592 		gen den0=den[0],den1=den[1];
6593 		bool lpos=is_positive(den0,contextptr),rpos=is_positive(den1,contextptr);
6594 		if ( !(lpos ^ rpos) && is_greater(Eps/3,abs(den[1]/den[0]-1,contextptr),contextptr)){
6595 		  // try numerators
6596 		  unsigned pos=0;
6597 		  vecteur Hs;
6598 		  for (;pos<numv.size();++pos){
6599 		    vecteur num=horner_interval(numv[pos],l,r);
6600 		    if (!stopnextiter && is_greater(abs(num[1]/num[0]-1,contextptr),Eps/3,contextptr))
6601 		      break;
6602 		    gen num0=num[0],num1=num[1],a=makesequence(num0/den0,num0/den1,num1/den0,num1/den1);
6603 #ifdef HAVE_LIBMPFI
6604 		    if (evalf_after & 2)
6605 		      Hs.push_back(eval(gen(makevecteur(_min(a,contextptr),_max(a,contextptr)),_INTERVAL__VECT),1,contextptr));
6606 		    else
6607 		      Hs.push_back(accurate_evalf((num0+num1)/(den0+den1),nbits));
6608 #else
6609 		      Hs.push_back(accurate_evalf((num0+num1)/(den0+den1),nbits));
6610 #endif
6611 		  }
6612 		  if (pos==numv.size()){
6613 		    res.push_back(Hs);
6614 		    break;
6615 		  }
6616 		} // end if
6617 		s=(l+r)/2;
6618 		in_round2(s,deuxn,nbits);
6619 		s=s-horner(minp,s,0,false)/horner(minp1,s,0,false);
6620 		nbits*=2;
6621 		deuxn=deuxn*deuxn;
6622 		in_round2(s,deuxn,nbits);
6623 		lr=int(minp.size()-1)*abs(horner(minp,s,0,false)/horner(minp1,s,0,false),contextptr); // warranted bounds
6624 		double lrd=evalf_double(lr,1,contextptr)._DOUBLE_val;
6625 		if (is_greater(lrd,1e-300,contextptr))
6626 		  lr=pow(plus_two,int(std::log(lrd)/std::log(2.))+1);
6627 		if (lrd==0)
6628 		  stopnextiter=true;
6629 		else {
6630 		  l=s-lr;
6631 		  r=s+lr;
6632 		  lr=2*lr;
6633 		}
6634 	      } // end for(;;)
6635 	      continue;
6636 #else
6637 	      s=(s._VECTptr->front()+s._VECTptr->back())/2;
6638 	      if (eps<1e-14)
6639 		s=accurate_evalf(s,int(-3.2*std::log(eps)));
6640 	      else
6641 		s=evalf_double(s,1,contextptr);
6642 #endif
6643 	    }
6644 	  }
6645 	  if (!complexmode && !is_zero(im(s,contextptr),contextptr))
6646 	    continue;
6647 	  vecteur Hs;
6648 #ifdef HAVE_LIBMPFR
6649 	  bool sdouble=(s.type==_DOUBLE_ || (s.type==_CPLX && s._CPLXptr->type==_DOUBLE_));
6650 	  if (sdouble)
6651 	    s=accurate_evalf(s,60); // ,giacmax(deg,60));
6652 	  if ((s.type==_REAL || (s.type==_CPLX && s._CPLXptr->type==_REAL)) )
6653 	    sdouble=true;
6654 #else
6655 	  bool sdouble=false;
6656 #endif
6657 	  gen den=_horner(makesequence(Gv[3],s,rurvar),contextptr);
6658 	  for (unsigned j=4;j<Gv.size();++j){
6659 	    Hs.push_back(recursive_normal(_horner(makesequence(Gv[j],s,rurvar),contextptr)/den,contextptr));
6660 	    if (sdouble)
6661 	      Hs.back()=evalf_double(Hs.back(),1,contextptr);
6662 	  }
6663 	  res.push_back(Hs);
6664 	}
6665 	return res;
6666       }
6667     }
6668 #endif
6669 #if 0
6670     // Trying with a partial elimination
6671     // Add a variable t linear combination of x1,...,xn with random small integers coeffs
6672     // eliminate all variables except t (and params) with revlex/revlex ordering
6673     // This returns a polynomial f in t in the Groebner basis
6674     // and in generic situations, it will return a basis of size n+1
6675     // where f is first basis element, and all other are degree 1 in xn...x1
6676     // therefore can be used to express xn...x1 in terms of t a root of f
6677     /* Example solve [24*u*z-u^2-z^2-u^2*z^2-13,24*y*z-y^2-z^2-y^2*z^2-13,24*u*y-u^2-y^2-u^2*y^2-13] for [u,y,z]:
6678        I:=[24*u*z-u^2-z^2-u^2*z^2-13,24*y*z-y^2-z^2-y^2*z^2-13,24*u*y-u^2-y^2-u^2*y^2-13,t-u-2y+z];
6679        G:=gbasis(I,[u,y,z]); // eliminates t
6680        H:=greduce([u,y,z],G,[u,y,z]); // u,y,z in terms of t
6681        rem(subst(I[0],[u,y,z],H),G[0],t); // check that rem is indeed 0
6682        S:=solve(G[0],t);
6683        sol:=map(S,s->normal(map(H,h->horner(h,s,t))));
6684        size(sol);
6685        normal(subst(I[0..2],[u,y,z],sol[0])); // check a solution
6686     */
6687     // Should be improved using global revlex ordering and
6688     // partial FGLM i.e. find min poly on t, then express f'(T)*each variable
6689     // in term of powers of T up to degree(f)-1
6690     // first try, with the variables
6691     if (varsize<=11 && varsize==eq.size()){
6692       vecteur H,res; gen G,caspart;
6693       // retry with a random linear combination of the variables
6694       gen vart=identificateur("gsolve_t");
6695       for (unsigned k=0;k<varsize;++k){
6696 	gen T=vart-var[k];
6697 	vecteur eqv=gen2vecteur(eq);
6698 	eqv.push_back(T);
6699 	G=_gbasis(makesequence(eqv,var),contextptr);
6700 	if (G.type==_VECT && G._VECTptr->size()>=varsize+1){
6701 	  H = vecteur(G._VECTptr->begin()+1,G._VECTptr->begin()+varsize+1);
6702 	  // check whether we have a linear system
6703 	  gen M=derive(H,var,contextptr);
6704 	  if (!is_zero(derive(M,var,contextptr),contextptr))
6705 	    H.clear();
6706 	  else {
6707 	    // additional cases if det(M)==0
6708 	    M=_det(M,contextptr);
6709 	    M=ratnormal(M/gcd(M,derive(M,*vart._IDNTptr,contextptr)),contextptr);
6710 	    if (_degree(makesequence(M,vart),contextptr)>2)
6711 	      H.clear();
6712 	    else {
6713 	      caspart=_solve(makesequence(M,vart),contextptr);
6714 	      if (caspart.type!=_VECT)
6715 		H.clear();
6716 	      else {
6717 		vecteur casv=*caspart._VECTptr;
6718 		for (unsigned j=0;j<casv.size();++j){
6719 		  // solve with var[k]=casv[j]
6720 		  gen eqpart=subst(eq,var[k],casv[j],false,contextptr);
6721 		  vecteur varpart(var);
6722 		  varpart.erase(varpart.begin()+k);
6723 		  vecteur solpart=solve(eqpart,varpart,complexmode,contextptr);
6724 		  for (unsigned l=0;l<solpart.size();++l){
6725 		    gen solpartl=solpart[l];
6726 		    if (solpartl.type==_VECT)
6727 		      solpartl._VECTptr->insert(solpartl._VECTptr->begin()+k,casv[j]);
6728 		  }
6729 		  res=mergevecteur(res,solpart);
6730 		}
6731 	      }
6732 	    }
6733 	  }
6734 	}
6735 	if (H.size()==varsize)
6736 	  break;
6737       }
6738       if (H.size()!=varsize){
6739 	caspart=vecteur(0);
6740 	for (unsigned essai=0;essai<10;++essai){
6741 	  H.clear();
6742 	  gen hasard;
6743 	  if (essai==0){
6744 	    vecteur v;
6745 	    for (unsigned j=0;j<varsize;++j){
6746 	      v.push_back(int(j)%3-1);
6747 	    }
6748 	    hasard=v;
6749 	  }
6750 	  else {
6751 	    hasard=_ranm(int(var.size()),contextptr);
6752 	    hasard=_iquo(makesequence(hasard,int(100/(essai+1))),contextptr);
6753 	  }
6754 	  gen T=vart-dotvecteur(hasard,var);
6755 	  vecteur eqv=gen2vecteur(eq);
6756 	  eqv.push_back(T);
6757 	  *logptr(contextptr) << "Trying " << eqv << '\n';
6758 	  G=_gbasis(makesequence(eqv,var),contextptr);
6759 	  if (G.type==_VECT && G._VECTptr->size()>=varsize+1){ // bingo (probably)
6760 	    H = vecteur(G._VECTptr->begin()+1,G._VECTptr->begin()+varsize+1);
6761 	    gen M=derive(H,var,contextptr);
6762 	    vecteur var1(var);
6763 	    var1.push_back(vart);
6764 	    if (!is_zero(derive(M,var1,contextptr),contextptr))
6765 	      H.clear();
6766 	  }
6767 	  if (H.size()==varsize)
6768 	    break;
6769 	}
6770       }
6771       if (H.size()==varsize){
6772 	H=linsolve(H,var,contextptr);
6773 	*logptr(contextptr) << "map(proot(" <<subst(G[0],vart,vx_var,false,contextptr) << "),r->map(" << subst(H ,vart,vx_var,false,contextptr) << ",h->horner(h,r,"<<vx_var<<"))" << '\n';
6774 	vecteur S=solve(G[0],vart,complexmode,contextptr);
6775 	for (unsigned i=0;i<S.size();++i){
6776 	  gen s=S[i];
6777 	  if (caspart.type==_VECT && equalposcomp(*caspart._VECTptr,s))
6778 	    continue;
6779 	  vecteur Hs;
6780 	  for (unsigned j=0;j<H.size();++j){
6781 	    Hs.push_back(recursive_normal(_horner(makesequence(H[j],s,vart),contextptr),contextptr));
6782 	  }
6783 	  res.push_back(Hs);
6784 	}
6785 	return res;
6786       }
6787     }
6788 #endif
6789     vecteur l(1,var);
6790     alg_lvar(eq,l);
6791     // convert eq to polynomial
6792     vecteur eq_in(*e2r(eq,l,contextptr)._VECTptr);
6793     vectpoly eqp;
6794     // remove all denominators
6795     it=eq_in.begin();
6796     itend=eq_in.end();
6797     for (;it!=itend;++it){
6798       gen n,d;
6799       fxnd(*it,n,d);
6800       if (n.type==_POLY){
6801 	// should reordre n with total degree+revlex order here
6802 	eqp.push_back(*n._POLYptr);
6803 	continue;
6804       }
6805       if (!is_zero(n,contextptr))
6806 	return vecteur(0); // no solution since cst equation
6807     }
6808     int rur=0;
6809     gbasis_param_t gbasis_param={false,-1,-1,-1};
6810     vectpoly eqpr(gbasis(eqp,_PLEX_ORDER,/* cocoa */false,/* f5 */ false,/*environment * */0,rur,contextptr,gbasis_param));
6811     // should reorder eqpr with lex order here
6812     // solve from right to left
6813     sort_vectpoly(eqpr.begin(),eqpr.end());
6814     reverse(eqpr.begin(),eqpr.end());
6815     // reverse(eqpr.begin(),eqpr.end());
6816     vecteur sols(1,vecteur(0)); // sols=[ [] ]
6817     vectpoly::const_iterator jt=eqpr.begin(),jtend=eqpr.end();
6818     for (;jt!=jtend;++jt){
6819       // the # of found vars is the size of sols.front()
6820       if (sols.empty())
6821 	break;
6822       vecteur newsols;
6823       gen g(r2e(*jt,l,contextptr));
6824       const_iterateur st=sols.begin(),stend=sols.end();
6825       for (;st!=stend;++st){
6826 	int foundvars=int(st->_VECTptr->size());
6827 	gen curgf=_factors(ratnormal(ratnormal(subst(g,vecteur(var.end()-foundvars,var.end()),*st,false,contextptr),contextptr),contextptr),contextptr);
6828 	if (curgf.type!=_VECT) return vecteur(1,gensizeerr(contextptr));
6829 	const_iterateur curgfit=curgf._VECTptr->begin(),curgfend=curgf._VECTptr->end();
6830 	for (;curgfit!=curgfend;curgfit+=2){
6831 	  vecteur current=*st->_VECTptr;
6832 	  foundvars=int(st->_VECTptr->size());
6833 	  gen curg=*curgfit;
6834 	  gen x;
6835 	  int xpos=0;
6836 	  // First search in current an identifier curg depends on
6837 	  for (;xpos<foundvars;++xpos){
6838 	    x=current[xpos];
6839 	    if (x==var[s-foundvars+xpos] && !is_zero(derive(curg,x,contextptr),contextptr) )
6840 	      break;
6841 	  }
6842 	  if (xpos==foundvars){
6843 	    xpos=0;
6844 	    // find next var g depends on
6845 	    for (;foundvars<s;++foundvars){
6846 	      x=var[s-foundvars-1];
6847 	      current.insert(current.begin(),x);
6848 	      if (!is_zero(derive(curg,x,contextptr),contextptr))
6849 		break;
6850 	    }
6851 	    if (s==foundvars){
6852 	      if (is_zero(simplify(curg,contextptr),contextptr))
6853 		newsols.push_back(current);
6854 	      continue;
6855 	    }
6856 	  }
6857 	  // solve
6858 	  vecteur xsol(solve(curg,*x._IDNTptr,complexmode,contextptr));
6859 	  const_iterateur xt=xsol.begin(),xtend=xsol.end();
6860 	  for (;xt!=xtend;++xt){
6861 	    // current[xpos]=*xt;
6862 	    newsols.push_back(subst(current,*x._IDNTptr,*xt,false,contextptr));
6863 	  }
6864 	} // end for curfit!=curfitend
6865       } // end for (;st!=stend;)
6866       sols=newsols;
6867     } // end for jt!=jtend
6868     // Add var at the beginning of each solution of sols if needed
6869     it=sols.begin();
6870     itend=sols.end();
6871     for (;it!=itend;++it){
6872       int ss=int(it->_VECTptr->size());
6873       if (ss<s)
6874 	*it=mergevecteur(vecteur(var.begin(),var.begin()+s-ss),*it->_VECTptr);
6875     }
6876     if (need_subst)
6877       sols=subst(sols,var,var_orig,false,contextptr);
6878 #if 1
6879     // Do a fast subst in eq_orig and check if there is an undef, if not consider it a solution
6880     vecteur sol0(sols);
6881     sols.clear();
6882     for (unsigned i=0;i<sol0.size();++i){
6883       gen val=subst(eq_orig,var_orig,sol0[i],false,contextptr);
6884       if (!equalposcomp(lidnt(val),undef))
6885 	sols.push_back(sol0[i]);
6886     }
6887 #endif
6888     if (convertapprox)
6889       sols=*evalf_VECT(sols,0,1,contextptr)._VECTptr;
6890     return sols;
6891   }
6892 
_gbasis_reinject(const gen & g,GIAC_CONTEXT)6893   gen _gbasis_reinject(const gen & g,GIAC_CONTEXT){
6894     if ( g.type==_STRNG &&  g.subtype==-1) return  g;
6895     if (g==0){
6896       int tmp1=gbasis_stop;
6897       int tmp2=gbasis_logz_age_sort;
6898       gbasis_stop=0;
6899       gbasis_logz_age_sort=0;
6900       return makevecteur(tmp1,tmp2);
6901     }
6902     if (g.type==_INT_ && g.val<=2){
6903       if (g.val<0){
6904 	int tmp=gbasis_stop;
6905 	gbasis_stop=g.val;
6906 	return tmp;
6907       }
6908       int tmp=gbasis_logz_age_sort;
6909       gbasis_logz_age_sort=g.val;
6910       return tmp;
6911     }
6912     gen args(evalf_double(g,1,contextptr));
6913     double old=gbasis_reinject_ratio,oldtime=gbasis_reinject_speed_ratio;
6914     if (g.type==_DOUBLE_){
6915       gbasis_reinject_ratio=g._DOUBLE_val<=0?0:g._DOUBLE_val;
6916       return old;
6917     }
6918     if (g.type==_VECT && g._VECTptr->size()==2){
6919       gen a=g._VECTptr->front(),b=g._VECTptr->back();
6920       if (a.type==_DOUBLE_ && b.type==_DOUBLE_){
6921 	gbasis_reinject_ratio=a._DOUBLE_val<=0?0:a._DOUBLE_val;
6922 	gbasis_reinject_speed_ratio=b._DOUBLE_val<=0?0:b._DOUBLE_val;
6923 	return makevecteur(old,oldtime);
6924       }
6925     }
6926     if (g.type==_VECT && g._VECTptr->empty())
6927       return makevecteur(old,oldtime);
6928     return gensizeerr(contextptr);
6929   }
6930   static const char _gbasis_reinject_s []="gbasis_reinject";
6931   static define_unary_function_eval2 (__gbasis_reinject,&_gbasis_reinject,_gbasis_reinject_s,&printasDigits);
6932   define_unary_function_ptr5( at_gbasis_reinject ,alias_at_gbasis_reinject ,&__gbasis_reinject,0,true);
6933 
read_gbargs(vecteur & v,int start,int s,gen & order,bool & with_cocoa,bool & with_f5,int & modular,gbasis_param_t & gbasis_param)6934   static void read_gbargs(vecteur & v,int start,int s,gen & order,bool & with_cocoa,bool & with_f5,int & modular,gbasis_param_t & gbasis_param){
6935     for (int i=start;i<s;++i){
6936       if (v[i]==at_eliminate){
6937 	gbasis_param.eliminate_flag=true;
6938       }
6939       if (v[i]==at_irem || v[i]==at_chinrem){
6940 	modular=1;
6941 	with_f5=false;
6942 	with_cocoa=false;
6943       }
6944       if (is_equal(v[i])){
6945 	gen & tmp=v[i]._SYMBptr->feuille;
6946 	if (tmp.type==_VECT && v[0].type==_VECT && tmp._VECTptr->front()==at_gbasis_reinject){
6947 	  if (tmp._VECTptr->back().type==_VECT){
6948 	    gbasis_param.reinject_begin=v[0]._VECTptr->size();
6949 	    v[0]=mergevecteur(*v[0]._VECTptr,*tmp._VECTptr->back()._VECTptr);
6950 	    gbasis_param.reinject_end=v[0]._VECTptr->size();
6951 	  }
6952 	  if (tmp._VECTptr->back().type==_INT_)
6953 	    gbasis_param.reinject_for_calc=(gbasis_param.reinject_begin>=0?gbasis_param.reinject_begin:v[0]._VECTptr->size())+tmp._VECTptr->back().val;
6954 	  continue;
6955 	}
6956 	if (tmp.type==_VECT && (tmp._VECTptr->front()==at_irem || tmp._VECTptr->front()==at_chinrem) && tmp._VECTptr->back().type==_INT_){
6957 	  modular=tmp._VECTptr->back().val;
6958 	}
6959 	if (tmp.type==_VECT && tmp._VECTptr->front()==at_eliminate && tmp._VECTptr->back().type==_INT_){
6960 	  gbasis_param.eliminate_flag=tmp._VECTptr->back().val!=0;
6961 	}
6962 	if (tmp.type==_VECT && tmp._VECTptr->front().type==_INT_ && tmp._VECTptr->back().type==_INT_){
6963 	  switch (tmp._VECTptr->front().val){
6964 	  case _WITH_COCOA:
6965 	    with_cocoa=tmp._VECTptr->back().val!=0;
6966 	    modular=!with_cocoa;
6967 	    break;
6968 	  case _WITH_F5: case _MODULAR_CHECK:
6969 	    with_f5=tmp._VECTptr->back().val!=0;
6970 	    break;
6971 	  }
6972 	}
6973       }
6974       if (v[i].type==_INT_ && v[i].subtype==_INT_GROEBNER){
6975 	switch (v[i].val){
6976 	case _WITH_COCOA:
6977 	  with_cocoa=true;
6978 	  break;
6979 	case _WITH_F5: case _MODULAR_CHECK:
6980 	  with_f5=true;
6981 	  break;
6982 	default:
6983 	  order=v[i].val;
6984 	}
6985       }
6986     }
6987 #ifndef HAVE_LIBCOCOA
6988     with_cocoa=false;
6989 #endif
6990   }
6991 
6992 
change_monomial_order(polynome & p,const gen & order)6993   void change_monomial_order(polynome & p,const gen & order){
6994     switch (order.val){
6995     case _PLEX_ORDER:
6996       p.is_strictly_greater=i_lex_is_strictly_greater;
6997       p.m_is_strictly_greater=std::ptr_fun(m_lex_is_strictly_greater<gen>);
6998       break;
6999     case _REVLEX_ORDER:
7000       p.is_strictly_greater=i_total_revlex_is_strictly_greater;
7001       p.m_is_strictly_greater=std::ptr_fun(m_total_revlex_is_strictly_greater<gen>);
7002       break;
7003     case _TDEG_ORDER:
7004       p.is_strictly_greater=i_total_lex_is_strictly_greater;
7005       p.m_is_strictly_greater=std::ptr_fun(m_total_lex_is_strictly_greater<gen>);
7006       break;
7007     case _3VAR_ORDER:
7008       p.is_strictly_greater=i_3var_is_strictly_greater;
7009       p.m_is_strictly_greater=std::ptr_fun(m_3var_is_strictly_greater<gen>);
7010       break;
7011     case _7VAR_ORDER:
7012       p.is_strictly_greater=i_7var_is_strictly_greater;
7013       p.m_is_strictly_greater=std::ptr_fun(m_7var_is_strictly_greater<gen>);
7014       break;
7015     case _11VAR_ORDER:
7016       p.is_strictly_greater=i_11var_is_strictly_greater;
7017       p.m_is_strictly_greater=std::ptr_fun(m_11var_is_strictly_greater<gen>);
7018       break;
7019     case _16VAR_ORDER:
7020       p.is_strictly_greater=i_16var_is_strictly_greater;
7021       p.m_is_strictly_greater=std::ptr_fun(m_16var_is_strictly_greater<gen>);
7022       break;
7023     case _32VAR_ORDER:
7024       p.is_strictly_greater=i_32var_is_strictly_greater;
7025       p.m_is_strictly_greater=std::ptr_fun(m_32var_is_strictly_greater<gen>);
7026       break;
7027     case _64VAR_ORDER:
7028       p.is_strictly_greater=i_64var_is_strictly_greater;
7029       p.m_is_strictly_greater=std::ptr_fun(m_64var_is_strictly_greater<gen>);
7030       break;
7031     }
7032     p.tsort();
7033   }
7034 
change_monomial_order(vectpoly & eqp,const gen & order)7035   static void change_monomial_order(vectpoly & eqp,const gen & order){
7036     // change polynomial order
7037     if (order.type==_INT_ && order.val){
7038       vectpoly::iterator it=eqp.begin(),itend=eqp.end();
7039       for (;it!=itend;++it){
7040 	change_monomial_order(*it,order);
7041       }
7042     }
7043   }
7044 
7045   // l=variables, l0=parameters, add 0 to l
7046   // returns first fake variable, i.e. value of l with a 0 (or l.size())
revlex_parametrize(vecteur & l,const vecteur & l0,int & order)7047   int revlex_parametrize(vecteur & l,const vecteur &l0,int & order){
7048     bool rur=order<0;
7049     int res=int(l.size());
7050 #if GROEBNER_VARS==15
7051     // split variables and parameters for revlex
7052     if (!l.empty() && l!=l0 && l0.size()<=64 && (order==_REVLEX_ORDER || order==_RUR_REVLEX)){
7053       if (l.size()>11 || (l0.size()+3-l.size()%4)>14){
7054 	if (l.size()<=11){
7055 #ifdef GIAC_CHARDEGTYPE
7056 	  while (l.size()<16) l.push_back(0);
7057 	  order=_16VAR_ORDER; // improve: could be less
7058 #else
7059 	  while (l.size()<12) l.push_back(0);
7060 	  order=_11VAR_ORDER; // improve: could be less
7061 #endif
7062 	}
7063 	else {
7064 	  int j=nextpow2(int(l.size()));
7065 	  if (j==16) order=_16VAR_ORDER;
7066 	  if (j==32) order=_32VAR_ORDER;
7067 	  if (j==64) order=_64VAR_ORDER;
7068 	  for (;int(l.size())<j;)
7069 	    l.push_back(0);
7070 	}
7071       }
7072       else { // l.size()<=11 and l0.size() small enough
7073 	// add fake variables
7074 	if (l.size()/4==0)
7075 	  order=_3VAR_ORDER;
7076 	if (l.size()/4==1)
7077 	  order=_7VAR_ORDER;
7078 	if (l.size()/4==2)
7079 	  order=_11VAR_ORDER;
7080 	for (int j=l.size()%4;j<3;j++){
7081 	  l.push_back(0);
7082 	}
7083       }
7084       if (rur)
7085 	order=-order;
7086     }
7087 #endif
7088     return res;
7089   }
7090 
7091   // gbasis([Pi],[vars]) -> [Pi']
_gbasis(const gen & args,GIAC_CONTEXT)7092   gen _gbasis(const gen & args,GIAC_CONTEXT){
7093     if ( args.type==_STRNG && args.subtype==-1) return  args;
7094     if (args.type!=_VECT)
7095       return symbolic(at_gbasis,args);
7096     vecteur v = *args._VECTptr;
7097     int s=int(v.size());
7098     if (s<2)
7099       return gentoofewargs("gbasis");
7100     if (debug_infolevel)
7101       CERR << CLOCK()*1e-6 << " gbasis begin :" << memory_usage()*1e-6 << '\n';
7102     if ( (v[0].type!=_VECT) || (v[1].type!=_VECT) )
7103       return gensizeerr(contextptr);
7104     v[0]=remove_equal(v[0]);
7105     gen order=_REVLEX_ORDER; // 0 assumes plex and 0-dimension ideal so that FGLM applies
7106     // v[2] will serve for ordering
7107     bool with_f5=false,with_cocoa=false;
7108     gbasis_param_t gbasis_param={false,-1,-1,-1};
7109     int modular=1;
7110     read_gbargs(v,2,s,order,with_cocoa,with_f5,modular,gbasis_param);
7111     vecteur l1=*v[1]._VECTptr;
7112     vecteur l0;
7113     if (s>2 && v[2].type==_VECT)
7114       lidnt(v[2],l0,true); // ordering for remaining variables
7115     for (int i=0;i<s;++i){
7116       if (v[i]==_RUR_REVLEX)
7117 	lidnt(v[1],l0,true); // insure all variables are here for rur
7118     }
7119     lidnt(v[0],l0,true);
7120     // remove variables not in args0
7121     vecteur l;
7122     for (unsigned i=0;i<l1.size();++i){
7123       if (equalposcomp(l0,l1[i]))
7124 	l.push_back(l1[i]);
7125     }
7126     l0=lidnt_with_at(makevecteur(l,l0)); // this sorts l0 with l variables first
7127     int faken=revlex_parametrize(l,l0,order.val),lsize=int(l.size());
7128     l=vecteur(1,l);
7129     if (s>2 && v[2].type==_VECT)
7130       alg_lvar(v[2],l); // ordering for remaining variables
7131     alg_lvar(v[0],l);
7132     // if (l.front()._VECTptr->size()==15 && order.val==11) l.front()._VECTptr->insert(l.front()._VECTptr->begin()+11,0);
7133     // convert eq to polynomial
7134     if (debug_infolevel)
7135       CERR << CLOCK()*1e-6 << " before convert :" << memory_usage()*1e-6 << '\n';
7136     vectpoly eqp;
7137     {
7138       // all negative integers will be duplicated in e2r, adding about 50% mem
7139       gen eqtmp=e2r(v[0],l,contextptr);
7140       const vecteur & eq_in=*eqtmp._VECTptr;
7141       if (debug_infolevel)
7142 	CERR << CLOCK()*1e-6 << " after convert :" << memory_usage()*1e-6 << '\n';
7143       if (!vecteur2vector_polynome(eq_in,l,eqp))
7144 	return vecteur(1,plus_one);
7145     }
7146     if (eqp.empty()) return vecteur(0);
7147     // add fake polynomials for fake variables added by revlex_parametrize
7148     int dim=eqp.front().dim;
7149 #if 1
7150     for (;faken<lsize;++faken){
7151       polynome fakep(dim,vector< monomial<gen> >(1,monomial<gen>(1,faken+1,dim)));
7152       eqp.push_back(fakep);
7153     }
7154 #endif
7155     gen coeff;
7156     environment env ;
7157     if (modular){
7158       env.modulo=0;
7159       with_cocoa=false;
7160     }
7161     env.moduloon = false;
7162     for (unsigned i=0;i<eqp.size();++i){
7163       if (coefftype(eqp[i],coeff)==_MOD){
7164 	with_cocoa = false;
7165 	env.moduloon = true;
7166 	env.modulo = *(coeff._MODptr+1);
7167 	env.pn=env.modulo;
7168 	vectpoly::iterator it=eqp.begin(),itend=eqp.end();
7169 	for (;it!=itend;++it)
7170 	  *it=unmodularize(*it);
7171 	break;
7172       }
7173     }
7174     if (!with_cocoa)
7175       change_monomial_order(eqp,abs(order,contextptr));
7176     int rur=0;
7177     vectpoly eqpr(gbasis(eqp,order,with_cocoa,with_cocoa?with_f5:modular,&env,rur,contextptr,gbasis_param));
7178     vecteur res;
7179     vectpoly::const_iterator it=eqpr.begin(),itend=eqpr.end();
7180     res.reserve(itend-it);
7181     for (;it!=itend;++it){
7182       gen tmp=r2e(*it,l,contextptr);
7183       if (is_zero(tmp) && !is_zero(*it))
7184 	continue;
7185       res.push_back(tmp);
7186     }
7187     if (order.val<0 && rur){
7188       // subst l[0] by another variable name to avoid confusion in res[2..]?
7189       if (res[0].type==_IDNT && l.front().type==_VECT && !l.front()._VECTptr->empty())
7190 	res=subst(res,l.front()[0],res[0],false,contextptr);
7191       res.insert(res.begin(),change_subtype(order,_INT_GROEBNER));
7192     }
7193     return res;
7194   }
7195   static const char _gbasis_s []="gbasis";
7196   static define_unary_function_eval (__gbasis,&_gbasis,_gbasis_s);
7197   define_unary_function_ptr5( at_gbasis ,alias_at_gbasis,&__gbasis,0,true);
7198 
_gbasis_max_pairs(const gen & g,GIAC_CONTEXT)7199   gen _gbasis_max_pairs(const gen & g,GIAC_CONTEXT){
7200     if ( g.type==_STRNG &&  g.subtype==-1) return  g;
7201     gen args(g);
7202     if (g.type==_DOUBLE_)
7203       args=int(g._DOUBLE_val);
7204     if (args.type!=_INT_)
7205       return int(max_pairs_by_iteration);
7206     int old=max_pairs_by_iteration;
7207     max_pairs_by_iteration=args.val<256?(1<<30):args.val;
7208     return old;
7209   }
7210   static const char _gbasis_max_pairs_s []="gbasis_max_pairs";
7211   static define_unary_function_eval2 (__gbasis_max_pairs,&_gbasis_max_pairs,_gbasis_max_pairs_s,&printasDigits);
7212   define_unary_function_ptr5( at_gbasis_max_pairs ,alias_at_gbasis_max_pairs ,&__gbasis_max_pairs,0,true);
7213 
_gbasis_simult_primes(const gen & g,GIAC_CONTEXT)7214   gen _gbasis_simult_primes(const gen & g,GIAC_CONTEXT){
7215     if ( g.type==_STRNG &&  g.subtype==-1) return  g;
7216     gen args(g);
7217     int old=simult_primes;
7218     if (g.type==_VECT && g._VECTptr->size()==5 && is_integer_vecteur(*g._VECTptr)){
7219       const vecteur & v=*g._VECTptr;
7220       simult_primes=giacmax(1,v[0].val);
7221       simult_primes_seuil2=v[1].val;
7222       simult_primes2=giacmax(1,v[2].val);
7223       simult_primes_seuil3=v[3].val;
7224       simult_primes3=giacmax(1,v[4].val);
7225       *logptr(contextptr) << simult_primes << ", n>" << simult_primes_seuil2 << ":" << simult_primes2 << " ,n>" << simult_primes_seuil3 << ":" << simult_primes3 << '\n';
7226       return old;
7227     }
7228     if (g.type==_DOUBLE_)
7229       args=int(g._DOUBLE_val);
7230     if (args.type!=_INT_)
7231       return int(simult_primes);
7232     simult_primes=args.val<1?1:args.val;
7233     return old;
7234   }
7235   static const char _gbasis_simult_primes_s []="gbasis_simult_primes";
7236   static define_unary_function_eval2 (__gbasis_simult_primes,&_gbasis_simult_primes,_gbasis_simult_primes_s,&printasDigits);
7237   define_unary_function_ptr5( at_gbasis_simult_primes ,alias_at_gbasis_simult_primes ,&__gbasis_simult_primes,0,true);
7238 
in_greduce(const gen & eq,const vecteur & l,const vectpoly & eqp,const gen & order,bool with_cocoa,GIAC_CONTEXT,vector<polynome> * quo=0)7239   static gen in_greduce(const gen & eq,const vecteur & l,const vectpoly & eqp,const gen & order,bool with_cocoa,GIAC_CONTEXT,vector<polynome> * quo=0){
7240     if (eq.type!=_POLY)
7241       return r2e(eq,l,contextptr);
7242     gen coeff;
7243     environment env ;
7244     if (coefftype(*eq._POLYptr,coeff)==_MOD){
7245       with_cocoa = false;
7246       env.moduloon = true;
7247       env.modulo = *(coeff._MODptr+1);
7248       env.pn=env.modulo;
7249     }
7250     else
7251       env.moduloon = false;
7252     polynome p(*eq._POLYptr);
7253     change_monomial_order(p,order);
7254     vectpoly rescocoa;
7255     if (!env.moduloon && with_cocoa && cocoa_greduce(vectpoly(1,p),eqp,order,rescocoa))
7256       return r2e(rescocoa.front(),l,contextptr);
7257     // FIXME: get constant term, substract one to get the correct constant
7258     // gen C(p.constant_term());
7259     // eq=eq-C+plus_one;
7260     // p=*eq._POLYptr;
7261     // change_monomial_order(p,order);
7262     // polynome res(env.moduloon?reduce(p,eqp.begin(),eqp.end(),&env):reducegb(p,eqp.begin(),eqp.end(),&env));
7263     gen C1;
7264     if (debug_infolevel>1)
7265       COUT << CLOCK() << "begin reduce poly #monomials " << p.coord.size() << '\n';
7266     reduce(p,&eqp.front(),&eqp.front()+eqp.size(),p,C1,&env,quo);
7267     if (debug_infolevel>1)
7268       COUT << CLOCK() << "end reduce poly #monomials " << p.coord.size() << '\n';
7269     // gen C1(res.constant_term());
7270     if (env.moduloon){
7271       p=invmod(C1,env.modulo)*p;
7272       modularize(p,env.modulo);
7273     }
7274     else
7275       p=p/C1;
7276     return r2e(p,l,contextptr);
7277   }
7278 
in_ideal(const vectpoly & r,const vecteur & l,const vectpoly & v,const gen & order,bool with_cocoa,bool with_f5,environment * env)7279   static gen in_ideal(const vectpoly & r,const vecteur &l,const vectpoly & v,const gen & order,bool with_cocoa,bool with_f5,environment * env){
7280 #ifndef NO_STDEXCEPT
7281     try {
7282       if (with_cocoa){
7283 	return cocoa_in_ideal(r,v,order);
7284       }
7285     } catch (...){
7286      return -1;
7287     }
7288 #endif
7289     vecteur res;
7290     for (int i=0;i<int(r.size());++i){
7291       res.push_back(is_zero(in_greduce(r[i],l,v,order,with_cocoa,context0)));
7292     }
7293     return res;
7294   }
7295 
greduce(const gen & g,const vecteur & l,const vectpoly & eqp,const gen & order,bool with_cocoa,GIAC_CONTEXT,vecteur * quo=0)7296   static gen greduce(const gen & g,const vecteur & l,const vectpoly & eqp,const gen & order,bool with_cocoa,GIAC_CONTEXT,vecteur * quo=0){
7297     gen eq(e2r(g,l,contextptr));
7298     vector<polynome> q;
7299     if (eq.type==_FRAC){
7300       gen den=in_greduce(eq._FRACptr->den,l,eqp,order,with_cocoa,contextptr,0);
7301       gen res=in_greduce(eq._FRACptr->num,l,eqp,order,with_cocoa,contextptr,quo?&q:0)/den;
7302       if (quo){
7303 	for (int i=0;i<int(quo->size());++i){
7304 	  (*quo)[i]=r2e(q[i],l,contextptr)/den;
7305 	}
7306       }
7307       reverse(quo->begin(),quo->end()); // the gbasis was reversed
7308       return res;
7309     }
7310     gen res=in_greduce(eq,l,eqp,order,with_cocoa,contextptr,quo?&q:0);
7311     if (quo){
7312       quo->clear();
7313       quo->resize(q.size());
7314       for (int i=0;i<int(quo->size());++i){
7315 	(*quo)[i]=r2e(q[i],l,contextptr);
7316       }
7317       reverse(quo->begin(),quo->end()); // the gbasis was reversed
7318     }
7319     return res;
7320   }
7321 
7322   // greduce(P,[gbasis],[vars])
_greduce(const gen & args,GIAC_CONTEXT)7323   gen _greduce(const gen & args,GIAC_CONTEXT){
7324     if ( args.type==_STRNG && args.subtype==-1) return  args;
7325     if (args.type!=_VECT)
7326       return symbolic(at_gbasis,args);
7327     vecteur v = *args._VECTptr;
7328     int s=int(v.size());
7329     vecteur quo;
7330     vecteur * quoptr=0;
7331     if (s && (v.back()==at_quo || v.back()==at_quorem)){
7332       quoptr=&quo;
7333       v.pop_back();
7334       --s;
7335     }
7336     if (s<2)
7337       return gentoofewargs("greduce");
7338     if (s<3)
7339       v.push_back(lidnt_with_at(v[1]));
7340     if (v[1].type!=_VECT)
7341       v[1]=vecteur(1,v[1]);
7342     v[1]=remove_equal(v[1]);
7343     if (v[2].type!=_VECT)
7344       return gensizeerr(contextptr);
7345     // v[3] will serve for ordering
7346     gen order=_REVLEX_ORDER;// _PLEX_ORDER; // FIXME for parameters!
7347     bool with_f5=false,with_cocoa=false;
7348     gbasis_param_t gbasis_param={false,-1,-1,-1};
7349     int modular=1;
7350     read_gbargs(v,3,s,order,with_cocoa,with_f5,modular,gbasis_param);
7351     vecteur l1=gen2vecteur(v[2]),l0=lidnt_with_at(makevecteur(v[0],v[1]));
7352     // remove variables not in args0
7353     vecteur l;
7354     for (unsigned i=0;i<l1.size();++i){
7355       if (equalposcomp(l0,l1[i]))
7356 	l.push_back(l1[i]);
7357     }
7358     int faken=revlex_parametrize(l,l0,order.val),lsize=int(l.size());
7359     l=vecteur(1,l);
7360     if (s>3 && v[3].type==_VECT)
7361       alg_lvar(v[3],l); // ordering for remaining variables
7362     alg_lvar(makevecteur(v[0],v[1]),l);
7363     vecteur eq_in(*e2r(v[1],l,contextptr)._VECTptr);
7364     vectpoly eqp;
7365     if (!vecteur2vector_polynome(eq_in,l,eqp))
7366       return gensizeerr("Bad second argument, expecting a Groebner basis");
7367     change_monomial_order(eqp,order);
7368     reverse(eqp.begin(),eqp.end());
7369 #if !defined CAS38_DISABLED && !defined FXCG
7370     vecteur red_in_(gen2vecteur(v[0])),deno(red_in_.size());
7371     for (int i=0;i<int(red_in_.size());++i){
7372       gen eq(e2r(red_in_[i],l,contextptr));
7373       if (eq.type!=_FRAC)
7374 	deno[i]=1;
7375       else {
7376 	deno[i]=eq._FRACptr->den;
7377 	eq=eq._FRACptr->num;
7378       }
7379       red_in_[i]=eq;
7380     }
7381     vectpoly red_in,red_out;
7382     if (!vecteur2vector_polynome(red_in_,l,red_in))
7383       return gensizeerr("Bad first argument, expecting polynomial or list of polynomials");
7384     change_monomial_order(red_in,order);
7385     order_t order_={static_cast<short>(order.val),0};
7386     environment env;
7387     env.moduloon=false;
7388     if (!quoptr && greduce8(red_in,eqp,order_,red_out,&env,contextptr)){
7389       vecteur red_out_;
7390       for (int i=0;i<int(red_out.size());++i)
7391 	red_out_.push_back(r2e(red_out[i],l,contextptr));
7392       if (v[0].type==_VECT || red_out_.size()!=1)
7393 	return red_out_;
7394       return red_out_.front();
7395     }
7396 #endif
7397     if (v[0].type==_VECT){
7398       vecteur res(v[0]._VECTptr->size());
7399       if (debug_infolevel>1)
7400 	COUT << CLOCK() << " begin reduce vector size " << res.size() << '\n';
7401       for (unsigned i=0;i<v[0]._VECTptr->size();++i){
7402 	res[i]=greduce((*v[0]._VECTptr)[i],l,eqp,order,with_cocoa,contextptr,quoptr);
7403 	if (quoptr)
7404 	  res[i]=makevecteur(res[i],*quoptr);
7405       }
7406       if (debug_infolevel>1)
7407 	COUT << CLOCK() << " end reduce vector size " << res.size() << '\n';
7408       return res;
7409     }
7410     gen res=greduce(v[0],l,eqp,order,with_cocoa,contextptr,quoptr);
7411     if (quoptr)
7412       return makevecteur(res,*quoptr);
7413     return res;
7414   }
7415 
7416   static const char _greduce_s []="greduce";
7417   static define_unary_function_eval (__greduce,&_greduce,_greduce_s);
7418   define_unary_function_ptr5( at_greduce ,alias_at_greduce,&__greduce,0,true);
7419 
7420   // eliminate/algsubs (very first version adapted from Reinhard Oldenburg user code)
7421   // eliminate(eqs,vars)
_eliminate(const gen & args,GIAC_CONTEXT)7422   gen _eliminate(const gen & args,GIAC_CONTEXT){
7423     if (args.type!=_VECT || args._VECTptr->size()<2)
7424       return gensizeerr(contextptr);
7425     int returngb=0;
7426     if (args._VECTptr->back()==at_gbasis)
7427       returngb=1;
7428     if (args._VECTptr->back()==at_lcoeff)
7429       returngb=2;
7430     if (args._VECTptr->back()==at_resultant)
7431       returngb=3;
7432     bool with_f5=false,with_cocoa=false; int modular=1; gen o;
7433     gbasis_param_t gbasis_param={epsilon(contextptr)!=0,-1,-1,-1};
7434     read_gbargs(*args._VECTptr,2,int(args._VECTptr->size()),o,with_cocoa,with_f5,modular,gbasis_param);
7435     vecteur eqs=gen2vecteur(remove_equal(args._VECTptr->front()));
7436     vecteur elim=gen2vecteur((*args._VECTptr)[1]);
7437     if (elim.empty())
7438       return eqs;
7439     vecteur l(elim);
7440     if (args._VECTptr->size()>2 && (*args._VECTptr)[2].type==_VECT)
7441       lvar((*args._VECTptr)[2],l);
7442     lvar(eqs,l); // add other vars after vars to eliminate
7443     vecteur remainvars(l.begin()+elim.size(),l.end());
7444     if (!returngb && eqs.size()<=l.size()+3){
7445       // eliminate variables with linear dependency
7446       // (in order to lower the number of vars, since <= 11 vars is handled faster)
7447       for (unsigned i=0;i<eqs.size();++i){
7448 	for (unsigned j=0;j<elim.size();++j){
7449 	  gen a,b;
7450 	  if (is_linear_wrt(eqs[i],elim[j],a,b,contextptr) && !is_zero(simplify(a,contextptr),contextptr) &&
7451 	      is_zero(derive(a,l,contextptr),contextptr)
7452 	      ){
7453 	    // Warning: a is not identically 0 but may vanish for some values of elim...
7454 	    // eqs[i]=a*elim[j]+b
7455 	    // replace elim[j] by -b/a
7456 	    gen elimj=-b/a;
7457 	    eqs.erase(eqs.begin()+i);
7458 	    for (unsigned k=0;k<eqs.size();++k){
7459 	      eqs[k]=_numer(subst(eqs[k],elim[j],elimj,false,contextptr),contextptr);
7460 	    }
7461 	    elim.erase(elim.begin()+j);
7462 	    gen res=_eliminate(makesequence(eqs,elim,symb_equal(at_irem,modular),symb_equal(at_eliminate,gbasis_param.eliminate_flag)),contextptr);
7463 	    // additional check for
7464 	    // eliminate([v49+-1*v49*v48+-1*v47+v50*v47,-1*v49+-1*v49*v48+v47+v50*v47,v59+-1*v55,v60+-1*v56,2*v63+-1*v59,-1+v50,v48,-1+2*v64+-1*v60,-4*v56+v55^2,-1*v47,-1*v49],revlist([v47,v48,v49,v50,v55,v56,v59,v60]));
7465 	    // eliminate([-2+2*v7+-1*v5,-4+2*v8+-1*v6,4*v6+-1*v6^2+2*v5+-1*v5^2,-4*v6+v6^2+-2*v5+v5^2],revlist([v5,v6]));
7466 	    if (elim.empty())
7467 	      res= _eliminate(makesequence(res,gen2vecteur((*args._VECTptr)[1])),contextptr);
7468 	    return res;
7469 	  }
7470 	}
7471       }
7472     }
7473     if (elim.size()==1 && returngb!=1 && eqs.size()>1) {
7474       *logptr(contextptr) << "1 variable to eliminate, using resultant. Run with last optional parameter gbasis if you want to force gbasis\n";
7475       returngb=3; // for example for eliminate([((-((t)^(2)))*((((t)^(2))+(1))^(3)))+((((((t)^(4))+((x)*((((t)^(2))+(1))^(2))))+((6)*((t)^(2))))-(3))^(2)), (-((((t)^(2))+(1))^(3)))+((((-(8))*((t)^(3)))+((y)*((((t)^(2))+(1))^(2))))^(2))],[t])
7476     }
7477     vecteur linelim;
7478 #ifdef GIAC_GBASISLEX
7479     if (returngb==3 && eqs.size()<=l.size()+3){
7480       // eliminate variables with linear dependency
7481       // (in order to lower the number of vars, since <= 11 vars is handled faster)
7482       // not faster
7483       // Perhaps better: find revlex gbasis and do something similar to FGLM
7484       for (unsigned i=0;i<eqs.size();++i){
7485 	for (unsigned j=0;j<elim.size();++j){
7486 	  gen a,b;
7487 	  if (!equalposcomp(linelim,elim[j]) && is_linear_wrt(eqs[i],elim[j],a,b,contextptr) && !is_zero(simplify(a,contextptr),contextptr)
7488 	      && is_zero(derive(a,remainvars,contextptr),contextptr)
7489 	      ){
7490 	    linelim.push_back(elim[j]);
7491 	  }
7492 	}
7493       }
7494     }
7495 #endif
7496     // put linear dependent variables first
7497     int lexvars=int(linelim.size());
7498     lvar(elim,linelim);
7499     elim=linelim;
7500     int es=int(elim.size()),rs=int(l.size()-elim.size()),neq=int(eqs.size());
7501 #if 1
7502     // check if we should eliminate linear dependency with resultant
7503     // to fit inside 3/11 or 7/7 or 11/3
7504     if (returngb==3 && neq>=2 && neq<=l.size()+3){
7505       bool ok=es>=1;
7506       if (ok){
7507 	*logptr(contextptr) << "Eliminating with resultant. Original equations may reduce further."<<'\n';
7508 	vector<int> vtdeg;
7509 	// Choose lowest degree pivot
7510 	int curdeg=_total_degree(makesequence(eqs.front(),l),contextptr).val;
7511 	vtdeg.push_back(curdeg);
7512 	vector<int> pos(1,0);
7513 	for (int i=1;i<neq;++i){
7514 	  int tdeg=_total_degree(makesequence(eqs[i],l),contextptr).val;
7515 	  vtdeg.push_back(tdeg);
7516 	  if (tdeg>curdeg)
7517 	    continue;
7518 	  if (tdeg<curdeg){
7519 	    curdeg=tdeg;
7520 	    pos=vector<int>(1,i);
7521 	  }
7522 	  pos.push_back(i);
7523 	}
7524 	// Choose lowest degree variable in pos
7525 	curdeg=RAND_MAX;
7526 	vector<int> poselim;
7527 	for (int i=0;i<int(pos.size());++i){
7528 	  gen eq=eqs[pos[i]];
7529 	  gen eqdeg=_degree(makesequence(eq,elim),contextptr);
7530 	  if (eqdeg.type==_VECT){
7531 	    const vecteur & v =*eqdeg._VECTptr;
7532 	    for (int j=0;j<int(v.size());++j){
7533 	      if (v[j].type!=_INT_ || v[j].val==0 || v[j].val>curdeg)
7534 		continue;
7535 	      if (v[j].val<curdeg){
7536 		curdeg=v[j].val;
7537 		poselim=vector<int>(1,j);
7538 	      }
7539 	      if (!equalposcomp(poselim,j))
7540 		poselim.push_back(j);
7541 	    }
7542 	  }
7543 	}
7544 	if (1 || curdeg==1){
7545 	  // Choose lowest number of dependant equations in poselim
7546 	  gen besteq(0),bestvar(0); int bestpos=-1,n0deps=-1;
7547 	  for (int i=0;i<int(poselim.size());++i){
7548 	    gen curvar=elim[poselim[i]];
7549 	    gen curdiff=derive(eqs,curvar,contextptr);
7550 	    gen cur0deps=_count_eq(makesequence(0,curdiff),contextptr);
7551 	    if (cur0deps.type==_INT_ && cur0deps.val>n0deps && curdiff.type==_VECT){
7552 	      n0deps=cur0deps.val;
7553 	      bestvar=curvar;
7554 	      // find smallest total degree equation depending on bestvar
7555 	      bestpos=-1; besteq=0;
7556 	      int besttdeg=RAND_MAX;
7557 	      for (int j=0;j<int(curdiff._VECTptr->size());++j){
7558 		if (is_zero((*curdiff._VECTptr)[j],contextptr)) continue;
7559 		if (vtdeg[j]<besttdeg){
7560 		  besttdeg=vtdeg[j];
7561 		  besteq=eqs[j];
7562 		  bestpos=j;
7563 		}
7564 	      }
7565 	    }
7566 	  }
7567 	  // make resultant of all equations except posi with cureq, curvar
7568 	  vecteur neweq;
7569 	  for (int i=0;i<neq;++i){
7570 	    if (i==bestpos) continue;
7571 	    gen a=_simp2(makesequence(eqs[i],besteq),contextptr);
7572 	    if (a.type!=_VECT || a._VECTptr->size()!=2)
7573 	      return gensizeerr(contextptr);
7574 	    gen r=_resultant(makesequence(a._VECTptr->front(),a._VECTptr->back(),bestvar),contextptr);
7575 	    vecteur rv=lvar(r);
7576 	    r=_primpart(makesequence(r,rv),contextptr);
7577 	    neweq.push_back(r);
7578 	  }
7579 	  vecteur newelim;
7580 	  for (int i=0;i<int(elim.size());++i){
7581 	    if (elim[i]!=bestvar)
7582 	      newelim.push_back(elim[i]);
7583 	  }
7584 	  // recursive call
7585 	  if (newelim.empty())
7586 	    return neweq;
7587 	  gen res=_eliminate(makesequence(neweq,newelim,at_resultant),contextptr);
7588 	  return res;
7589 	}
7590       }
7591     }
7592 #endif
7593     vecteur gb,res;
7594     int order=_PLEX_ORDER;
7595 #if GROEBNER_VARS==15
7596     if (es<=64){
7597       unsigned i=0;
7598       for (;i<l.size();++i){
7599 	if (!equalposcomp(elim,l[i]))
7600 	  break;
7601       }
7602       if (1
7603 	  // ||(l.size()+3-(i%4)<=14)
7604 	  ){
7605 	for (;i%4<3;++i)
7606 	  l.insert(l.begin()+i,0);
7607 	if (l.size()>=
7608 #ifdef GIAC_CHARDEGTYPE
7609 	    15
7610 #else
7611 	    16
7612 #endif
7613 	    ){
7614 	  int lim=nextpow2(es);
7615 #ifdef GIAC_CHARDEGTYPE
7616 	  if (es<=7)
7617 	    lim=8;
7618 #else
7619 	  if (es<=11)
7620 	    lim=12;
7621 	  if (es<=7)
7622 	    lim=8;
7623 	  if (es<=3)
7624 	    lim=4;
7625 #endif
7626 	  for (;int(i)<lim;++i)
7627 	    l.insert(l.begin()+i,0);
7628 	  if (lim<16) i--;
7629 	}
7630 	if (l.size()==15) l.insert(l.begin()+i,0); // insure that the fast algo in cocoa.cc is not called because it would fail
7631 	order = i; // double revlex ordering of type 3/7/11/16/32/64
7632 	l=vecteur(1,l);
7633 	alg_lvar(eqs,l);
7634 	// convert eq to polynomial
7635 	vecteur eq_in(*e2r(eqs,l,contextptr)._VECTptr);
7636 	vectpoly eqp;
7637 	if (!vecteur2vector_polynome(eq_in,l,eqp)){
7638 	  for (int i=0;i<int(eq_in.size());++i){
7639 	    gen tmp=eq_in[i];
7640 	    if (is_integer(tmp) || tmp.type==_FRAC)
7641 	      return vecteur(1,1);
7642 	  }
7643 	  return gensizeerr(contextptr);
7644 	}
7645 	gen coeff;
7646 	environment env ;
7647 	env.moduloon = false;
7648 	for (unsigned i=0;i<eqp.size();++i){
7649 	  if (coefftype(eqp[i],coeff)==_MOD){
7650 	    env.moduloon = true;
7651 	    env.modulo = *(coeff._MODptr+1);
7652 	    env.pn=env.modulo;
7653 	    vectpoly::iterator it=eqp.begin(),itend=eqp.end();
7654 	    for (;it!=itend;++it)
7655 	      *it=unmodularize(*it);
7656 	    break;
7657 	  }
7658 	}
7659 	// add "x_k=0" equation for fake variables x_k in eqp
7660 	if (l.front().type==_VECT){
7661 	  vecteur lf=*l.front()._VECTptr;
7662 	  for (int i=0;i<int(lf.size());++i){
7663 	    if (is_zero(lf[i])){
7664 	      index_t idx(lf.size());
7665 	      idx[i]=1;
7666 	      eqp.push_back(polynome(int(lf.size())));
7667 	      eqp.back().coord.push_back(monomial<gen>(1,idx));
7668 	    }
7669 	  }
7670 	}
7671 	change_monomial_order(eqp,order);
7672 	if (debug_infolevel)
7673 	  CERR << "eliminate revlex/revlex with " << order << " variables " << '\n';
7674 	int rur=0;
7675 	vectpoly eqpr;
7676 	if (gbasis_param.eliminate_flag && !eqp.empty() && eqp.front().dim==order+1){
7677 	  rur=2;
7678 	  eqpr=gbasis(eqp,makevecteur(_REVLEX_ORDER,0),false,modular,&env,rur,contextptr,gbasis_param);
7679 	}
7680 	if (rur==0)
7681 	  eqpr=gbasis(eqp,makevecteur(order,lexvars),false,modular,&env,rur,contextptr,gbasis_param);
7682 	vectpoly::const_iterator it=eqpr.begin(),itend=eqpr.end();
7683 	gb.reserve(itend-it);
7684 	if (returngb){
7685 	  for (;it!=itend;++it){
7686 	    gb.push_back(r2e(*it,l,contextptr));
7687 	  }
7688 	}
7689 	else {
7690 	  for (;it!=itend;++it){
7691 	    // keep *it if it does not depend on elim
7692 	    if (it->coord.empty())
7693 	      continue;
7694 	    const index_m & i=it->coord.front().index;
7695 	    index_t::const_iterator jt=i.begin(),jtend=jt+order;
7696 	    for (;jt!=jtend;++jt){
7697 	      if (*jt!=0)
7698 		break;
7699 	    }
7700 	    if (jt==jtend){
7701 	      gen tmp=r2e(*it,l,contextptr);
7702 	      if (!is_zero(tmp))
7703 		gb.push_back(tmp);
7704 	    }
7705 	  }
7706 	  if (debug_infolevel)
7707 	    COUT << CLOCK() << " end eliminate" << '\n';
7708 	  return gb;
7709 	}
7710       }
7711     }
7712 #endif
7713     if (order==_PLEX_ORDER)
7714       gb=gen2vecteur(_gbasis(gen(makevecteur(eqs,l,change_subtype(order,_INT_GROEBNER)),_SEQ__VECT),contextptr));
7715     // keep in gb values that do not depend on elim
7716     for (unsigned i=0;i<gb.size();++i){
7717       vecteur v=lidnt_with_at(gb[i]);
7718       if (is_zero(derive(v,elim,contextptr),contextptr)){
7719 	res.push_back(gb[i]);
7720       }
7721       if (returngb==2 && gb[i].is_symb_of_sommet(at_plus)){
7722 	gb[i]=gb[i][1];
7723       }
7724     }
7725     if (returngb)
7726       return makevecteur(res,gb);
7727 #if 0 // def GIAC_ELIMINATE1
7728     vecteur othervars=lidnt_with_at(res),addres;
7729     gen gres=_gbasis(makesequence(res,othervars),contextptr);
7730     if (gres.type==_VECT){
7731       res=*gres._VECTptr;
7732       for (unsigned i=0;i<gb.size();++i){
7733 	vecteur v=lidnt_with_at(gb[i]);
7734 	if (!is_zero(derive(v,elim,contextptr),contextptr)){
7735 	  gen c=_content(makesequence(gb[i],elim),contextptr);
7736 	  c=_greduce(makesequence(c,res,othervars),contextptr);
7737 	  if (!lidnt_with_at(c).empty()){
7738 	    addres.push_back(c);
7739 	  }
7740 	}
7741       }
7742     }
7743     return mergevecteur(res,addres);
7744 #endif
7745     //return _gbasis(makesequence(res,lidnt_with_at(res)),contextptr);
7746     return res;
7747   }
7748   static const char _eliminate_s []="eliminate";
7749   static define_unary_function_eval (__eliminate,&_eliminate,_eliminate_s);
7750   define_unary_function_ptr5( at_eliminate ,alias_at_eliminate,&__eliminate,0,true);
7751 
7752   // algsubs(eqs,vars)
_algsubs(const gen & args,GIAC_CONTEXT)7753   gen _algsubs(const gen & args,GIAC_CONTEXT){
7754     if (args.type!=_VECT || args._VECTptr->size()!=2)
7755       return gensizeerr(contextptr);
7756     gen eq=args._VECTptr->front();
7757     vecteur term=gen2vecteur(_fxnd(args._VECTptr->back(),contextptr));
7758     if (term.size()!=2 || !is_equal(eq))
7759       return gensizeerr();
7760     gen idnt(identificateur(" algsubs"));
7761     gen ee=term[0]-term[1]*idnt;
7762     gen lhs=eq._SYMBptr->feuille[0],rhs=eq._SYMBptr->feuille[1];
7763     term=gen2vecteur(_fxnd(lhs,contextptr));
7764     if (term.size()!=2) return gensizeerr(contextptr);
7765     gen eq1=term[0]-term[1]*rhs;
7766     vecteur ids(lidnt_with_at(eq));
7767     vecteur sol;
7768     for (;!ids.empty();){
7769       sol=gen2vecteur(_eliminate(makevecteur(makevecteur(eq1,ee),ids),contextptr));
7770       if (!sol.empty())
7771 	break;
7772       ids.pop_back();
7773     }
7774     gen solu=_solve(gen(makevecteur(sol,vecteur(1,idnt)),_SEQ__VECT),contextptr);
7775     if (equalposcomp(lidnt_with_at(solu),idnt))
7776       return gensizeerr(gettext("Error solving equations. Check that your variables are purged"));
7777     if (solu.type!=_VECT)
7778       return gensizeerr(contextptr);
7779     if (solu._VECTptr->empty())
7780       return args._VECTptr->back();
7781     if (solu._VECTptr->size()>1)
7782       *logptr(contextptr) << gettext("Warning: algsubs selected one branch. Consider running G:=gbasis(") << gen2vecteur(eq) << ","<< ids << ");greduce("<<args._VECTptr->back()<<",G," << ids << ");" << '\n';
7783     return normal(solu[0][0],contextptr);
7784   }
7785   static const char _algsubs_s []="algsubs";
7786   static define_unary_function_eval (__algsubs,&_algsubs,_algsubs_s);
7787   define_unary_function_ptr5( at_algsubs ,alias_at_algsubs,&__algsubs,0,true);
7788 
7789   // in_ideal([Pi],[gb],[vars]) -> true/false
_in_ideal(const gen & args,GIAC_CONTEXT)7790   gen _in_ideal(const gen & args,GIAC_CONTEXT){
7791     if ( args.type==_STRNG && args.subtype==-1) return  args;
7792     gen res=_greduce(args,contextptr);
7793     if (res.type==_VECT){
7794       vecteur v=*res._VECTptr;
7795       for (int i=0;i<int(v.size());++i){
7796 	v[i]=is_zero(v[i])?1:0;
7797       }
7798       return v;
7799     }
7800     return is_zero(res);
7801 #if 0
7802     if (args.type!=_VECT)
7803       return gensizeerr(contextptr);
7804     vecteur & v = *args._VECTptr;
7805     int s=int(v.size());
7806     if (s<3)
7807       return gentoofewargs("in_ideal");
7808     if ( v[1].type!=_VECT || v[2].type!=_VECT )
7809       return gensizeerr(contextptr);
7810     vecteur atester=gen2vecteur(v[0]);
7811     vecteur l=vecteur(1,v[2]);
7812     alg_lvar(v[1],l);
7813     alg_lvar(v[0],l);
7814     gen order=_PLEX_ORDER; // _REVLEX_ORDER;
7815     bool with_f5=false,with_cocoa=false;
7816     gbasis_param_t gbasis_param={false,-1,-1,-1};
7817     int modular=1;
7818     read_gbargs(v,3,s,order,with_cocoa,with_f5,modular,gbasis_param);
7819     // convert eq to polynomial
7820     vecteur eq_in(*e2r(v[1],l,contextptr)._VECTptr);
7821     vecteur r(*e2r(atester,l,contextptr)._VECTptr);
7822     vectpoly eqp,eqr;
7823     if (!vecteur2vector_polynome(eq_in,l,eqp) || !vecteur2vector_polynome(r,l,eqr))
7824       return gensizeerr(contextptr);
7825     gen coeff;
7826     environment env ;
7827     if (!eqp.empty() && coefftype(eqp.front(),coeff)==_MOD){
7828       with_cocoa = false;
7829       env.moduloon = true;
7830       env.modulo = *(coeff._MODptr+1);
7831       env.pn=env.modulo;
7832       vectpoly::iterator it=eqp.begin(),itend=eqp.end();
7833       for (;it!=itend;++it)
7834 	*it=unmodularize(*it);
7835     }
7836     else
7837       env.moduloon = false;
7838     if (!with_cocoa){
7839       change_monomial_order(eqp,order);
7840       change_monomial_order(eqr,order);
7841     }
7842     // is r in ideal eqp?
7843     gen res=in_ideal(eqr,l,eqp,order,with_cocoa,with_f5,&env);
7844     if (res.type==_VECT && res._VECTptr->size()==1 && v[0].type!=_VECT)
7845       return res._VECTptr->front();
7846     return res;
7847 #endif
7848   }
7849   static const char _in_ideal_s []="in_ideal";
7850   static define_unary_function_eval (__in_ideal,&_in_ideal,_in_ideal_s);
7851   define_unary_function_ptr5( at_in_ideal ,alias_at_in_ideal,&__in_ideal,0,true);
7852 
7853   // returns 0 for 0 solution, 1 for 1 solution, 2 for infinity solution
7854   // -1 on error
aspen_linsolve(const matrice & m,GIAC_CONTEXT)7855   int aspen_linsolve(const matrice & m,GIAC_CONTEXT){
7856     gen k=_ker(exact(gen(m),contextptr),contextptr);
7857     if (is_undef(k) || k.type!=_VECT) return -1;
7858     if (k._VECTptr->empty()) return 0;
7859     if (is_zero(k._VECTptr->back()._VECTptr->back(),contextptr))
7860       return 0;
7861     if (k._VECTptr->size()==1)
7862       return 1;
7863     return 2;
7864   }
7865   // returns 0 for 0 solution, 1 for 1 solution, 2 for infinity solution
7866   // -1 on error
aspen_linsolve_2x2(const gen & a,const gen & b,const gen & c,const gen & d,const gen & e,const gen & f,GIAC_CONTEXT)7867   int aspen_linsolve_2x2(const gen & a,const gen &b,const gen &c,
7868 			  const gen &d,const gen & e,const gen & f,GIAC_CONTEXT){
7869     matrice m(makevecteur(makevecteur(a,b,c),makevecteur(d,e,f)));
7870     return aspen_linsolve(m,contextptr);
7871   }
7872   // returns 0 for 0 solution, 1 for 1 solution, 2 for infinity solution
7873   // -1 on error
aspen_linsolve_3x3(const gen & a,const gen & b,const gen & c,const gen & d,const gen & e,const gen & f,const gen & g,const gen & h,const gen & i,const gen & j,const gen & k,const gen & l,GIAC_CONTEXT)7874   int aspen_linsolve_3x3(const gen & a,const gen &b,const gen &c,const gen &d,
7875 			  const gen & e,const gen &f,const gen & g,const gen &h,
7876 			  const gen & i,const gen & j,const gen &k,const gen &l,GIAC_CONTEXT){
7877     matrice m(makevecteur(makevecteur(a,b,c,d),makevecteur(e,f,g,h),makevecteur(i,j,k,l)));
7878     return aspen_linsolve(m,contextptr);
7879   }
7880 
7881 #if defined(GIAC_HAS_STO_38) || defined(ConnectivityKit)
fmin_cobyla(const gen & f,const vecteur & constraints,const vecteur & variables,const vecteur & guess,const gen & eps0,const gen & maxiter0,GIAC_CONTEXT)7882   gen fmin_cobyla(const gen & f,const vecteur & constraints,const vecteur & variables,const vecteur & guess,const gen & eps0,const gen & maxiter0,GIAC_CONTEXT){
7883     return gensizeerr(contextptr);
7884   }
7885 #else // GIAC_HAS_STO_38
7886   struct gen_context {
7887     gen g; //  should be a vector [function,conditions,variables]
7888     const context * contextptr;
7889   };
7890   // state is a pointer of type gen_context
cobyla_giac_function(int n,int m,double * x,double * f,double * con,void * state)7891   int cobyla_giac_function(int n, int m, double *x, double *f, double *con,void *state){
7892     gen_context * gptr=(gen_context *)state;
7893     if (gptr->g.type!=_VECT || gptr->g._VECTptr->size()!=3)
7894       return 1; //error
7895     gen F=(*gptr->g._VECTptr)[0];
7896     vecteur conditions=gen2vecteur((*gptr->g._VECTptr)[1]);
7897     vecteur variables=gen2vecteur((*gptr->g._VECTptr)[2]);
7898     if (int(conditions.size())!=m || int(variables.size())!=n)
7899       return 1;
7900     vecteur values(n);
7901     for (int i=0;i<n;++i)
7902       values[i]=x[i];
7903     gen Fx=subst(F,variables,values,false,gptr->contextptr);
7904     Fx=evalf_double(Fx,1,gptr->contextptr);
7905     if (Fx.type!=_DOUBLE_)
7906       return 1;
7907     *f=Fx._DOUBLE_val;
7908     gen conditionsx=subst(conditions,variables,values,false,gptr->contextptr);
7909     if (conditionsx.type!=_VECT || int(conditionsx._VECTptr->size())!=m)
7910       return 1;
7911     vecteur & conditionsv=*conditionsx._VECTptr;
7912     for (int i=0;i<m;++i){
7913       gen cx=evalf_double(conditionsv[i],1,gptr->contextptr);
7914       if (cx.type!=_DOUBLE_)
7915 	return 1;
7916       con[i]=cx._DOUBLE_val;
7917     }
7918     return 0;
7919   }
7920 
7921   // COBYLA will try to make all the values of the constraints positive.
7922   // So if you want to input a constraint j such as x[i] <= MAX, set:
7923   // con[j] = MAX - x[i]
fmin_cobyla(const gen & f,const vecteur & constraints,const vecteur & variables,const vecteur & guess,const gen & eps0,const gen & maxiter0,GIAC_CONTEXT)7924   gen fmin_cobyla(const gen & f,const vecteur & constraints,const vecteur & variables,const vecteur & guess,const gen & eps0,const gen & maxiter0,GIAC_CONTEXT){
7925     vecteur con;
7926     const_iterateur ct=constraints.begin(),ctend=constraints.end();
7927     for (;ct!=ctend;++ct){
7928       if (ct->type!=_SYMB || ct->_SYMBptr->feuille.type!=_VECT || ct->_SYMBptr->feuille._VECTptr->size()!=2 || ct->_SYMBptr->sommet!=at_equal){
7929 	con.push_back(*ct);
7930 	continue;
7931       }
7932       con.push_back(ct->_SYMBptr->feuille._VECTptr->back()-ct->_SYMBptr->feuille._VECTptr->front());
7933       con.push_back(ct->_SYMBptr->feuille._VECTptr->front()-ct->_SYMBptr->feuille._VECTptr->back());
7934     }
7935     iterateur it=con.begin(),itend=con.end();
7936     for (;it!=itend;++it){
7937       if (it->type!=_SYMB || it->_SYMBptr->feuille.type!=_VECT || it->_SYMBptr->feuille._VECTptr->size()!=2)
7938 	continue;
7939       if (it->_SYMBptr->sommet==at_superieur_strict || it->_SYMBptr->sommet==at_superieur_egal)
7940 	*it=it->_SYMBptr->feuille._VECTptr->front()-it->_SYMBptr->feuille._VECTptr->back();
7941       if (it->_SYMBptr->sommet==at_inferieur_strict || it->_SYMBptr->sommet==at_inferieur_egal)
7942 	*it=it->_SYMBptr->feuille._VECTptr->back()-it->_SYMBptr->feuille._VECTptr->front();
7943     }
7944     gen fcv=makevecteur(f,con,variables);
7945     gen_context gc={fcv,contextptr};
7946     int n=variables.size(),m=con.size(),message(debug_infolevel),maxfun(1000);
7947     gen maxiter(maxiter0);
7948     gen eps0d=evalf_double(eps0,1,contextptr);
7949     if (is_greater(1,maxiter,contextptr) || is_greater(eps0d,1,contextptr))
7950       swapgen(maxiter,eps0d);
7951     if (is_integral(maxiter))
7952       maxfun=maxiter.val;
7953     if (int(guess.size())!=n)
7954       return gendimerr(contextptr);
7955 #ifdef VISUALC
7956     double x[100];
7957 #else
7958     double x[n];
7959 #endif
7960     for (int i=0;i<n;++i){
7961       gen tmp=evalf_double(guess[i],1,contextptr);
7962       if (tmp.type!=_DOUBLE_)
7963 	return gensizeerr(contextptr);
7964       x[i]=tmp._DOUBLE_val;
7965     }
7966     double eps;
7967     if (eps0d.type==_DOUBLE_)
7968       eps=eps0d._DOUBLE_val;
7969     else {
7970       eps=(x[0]>1e-10?absdouble(x[0]):1)*epsilon(contextptr);
7971       if (eps<1e-13)
7972 	eps=1e-13;
7973     }
7974     int cres=cobyla(n,m,x,x[0]/100,eps,message,&maxfun,cobyla_giac_function,&gc);
7975     vecteur res(n);
7976     for (int i=0;i<n;++i)
7977       res[i]=x[i];
7978     if (cres==0)
7979       return res;
7980     *logptr(contextptr) << gettext("Unable to minimize at given precision, last value ") << res << '\n';
7981     return undef;
7982   }
7983 
7984 #endif // GIAC_HAS_STO_38
7985 
7986 #ifndef NO_NAMESPACE_GIAC
7987 } // namespace giac
7988 #endif // ndef NO_NAMESPACE_GIAC
7989 
7990 #if !defined(GIAC_HAS_STO_38) && !defined(ConnectivityKit)
7991 /* cobyla : contrained optimization by linear approximation */
7992 
7993 /*
7994  * Copyright (c) 1992, Michael J. D. Powell (M.J.D.Powell@damtp.cam.ac.uk)
7995  * Copyright (c) 2004, Jean-Sebastien Roy (js@jeannot.org)
7996  *
7997  * Permission is hereby granted, free of charge, to any person obtaining a
7998  * copy of this software and associated documentation files (the
7999  * "Software"), to deal in the Software without restriction, including
8000  * without limitation the rights to use, copy, modify, merge, publish,
8001  * distribute, sublicense, and/or sell copies of the Software, and to
8002  * permit persons to whom the Software is furnished to do so, subject to
8003  * the following conditions:
8004  *
8005  * The above copyright notice and this permission notice shall be included
8006  * in all copies or substantial portions of the Software.
8007  *
8008  * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
8009  * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
8010  * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
8011  * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
8012  * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
8013  * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
8014  * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
8015  */
8016 
8017 /*
8018  * This software is a C version of COBYLA2, a contrained optimization by linear
8019  * approximation package developed by Michael J. D. Powell in Fortran.
8020  *
8021  * The original source code can be found at :
8022  * http://plato.la.asu.edu/topics/problems/nlores.html
8023  */
8024 
8025 static char const rcsid[] =
8026   "@(#) $Jeannot: cobyla.c,v 1.11 2004/04/18 09:51:36 js Exp $";
8027 
8028 #include <stdlib.h>
8029 #include <stdio.h>
8030 #include <math.h>
8031 
8032 #define min(a,b) ((a) <= (b) ? (a) : (b))
8033 #define max(a,b) ((a) >= (b) ? (a) : (b))
8034 #define abs(x) ((x) >= 0 ? (x) : -(x))
8035 
8036 /*
8037  * Return code strings
8038  */
8039 const char *cobyla_rc_string[6] =
8040 {
8041   "N<0 or M<0",
8042   "Memory allocation failed",
8043   "Normal return from cobyla",
8044   "Maximum number of function evaluations reached",
8045   "Rounding errors are becoming damaging",
8046   "User requested end of minimization"
8047 };
8048 
8049 static int cobylb(int *n, int *m, int *mpp, double *x, double *rhobeg,
8050   double *rhoend, int *iprint, int *maxfun, double *con, double *sim,
8051   double *simi, double *datmat, double *a, double *vsig, double *veta,
8052   double *sigbar, double *dx, double *w, int *iact, cobyla_function *calcfc,
8053   void *state);
8054 static int trstlp(int *n, int *m, double *a, double *b, double *rho,
8055   double *dx, int *ifull, int *iact, double *z__, double *zdota, double *vmultc,
8056   double *sdirn, double *dxnew, double *vmultd);
8057 
8058 /* ------------------------------------------------------------------------ */
8059 
cobyla(int n,int m,double * x,double rhobeg,double rhoend,int iprint,int * maxfun,cobyla_function * calcfc,void * state)8060 int cobyla(int n, int m, double *x, double rhobeg, double rhoend, int iprint,
8061   int *maxfun, cobyla_function *calcfc, void *state)
8062 {
8063   int icon, isim, isigb, idatm, iveta, isimi, ivsig, iwork, ia, idx, mpp, rc;
8064   int *iact;
8065   double *w;
8066 
8067 /*
8068  * This subroutine minimizes an objective function F(X) subject to M
8069  * inequality constraints on X, where X is a vector of variables that has
8070  * N components. The algorithm employs linear approximations to the
8071  * objective and constraint functions, the approximations being formed by
8072  * linear interpolation at N+1 points in the space of the variables.
8073  * We regard these interpolation points as vertices of a simplex. The
8074  * parameter RHO controls the size of the simplex and it is reduced
8075  * automatically from RHOBEG to RHOEND. For each RHO the subroutine tries
8076  * to achieve a good vector of variables for the current size, and then
8077  * RHO is reduced until the value RHOEND is reached. Therefore RHOBEG and
8078  * RHOEND should be set to reasonable initial changes to and the required
8079  * accuracy in the variables respectively, but this accuracy should be
8080  * viewed as a subject for experimentation because it is not guaranteed.
8081  * The subroutine has an advantage over many of its competitors, however,
8082  * which is that it treats each constraint individually when calculating
8083  * a change to the variables, instead of lumping the constraints together
8084  * into a single penalty function. The name of the subroutine is derived
8085  * from the phrase Constrained Optimization BY Linear Approximations.
8086  *
8087  * The user must set the values of N, M, RHOBEG and RHOEND, and must
8088  * provide an initial vector of variables in X. Further, the value of
8089  * IPRINT should be set to 0, 1, 2 or 3, which controls the amount of
8090  * printing during the calculation. Specifically, there is no output if
8091  * IPRINT=0 and there is output only at the end of the calculation if
8092  * IPRINT=1. Otherwise each new value of RHO and SIGMA is printed.
8093  * Further, the vector of variables and some function information are
8094  * given either when RHO is reduced or when each new value of F(X) is
8095  * computed in the cases IPRINT=2 or IPRINT=3 respectively. Here SIGMA
8096  * is a penalty parameter, it being assumed that a change to X is an
8097  * improvement if it reduces the merit function
8098  *      F(X)+SIGMA*MAX(0.0,-C1(X),-C2(X),...,-CM(X)),
8099  * where C1,C2,...,CM denote the constraint functions that should become
8100  * nonnegative eventually, at least to the precision of RHOEND. In the
8101  * printed output the displayed term that is multiplied by SIGMA is
8102  * called MAXCV, which stands for 'MAXimum Constraint Violation'. The
8103  * argument MAXFUN is an int variable that must be set by the user to a
8104  * limit on the number of calls of CALCFC, the purpose of this routine being
8105  * given below. The value of MAXFUN will be altered to the number of calls
8106  * of CALCFC that are made. The arguments W and IACT provide real and
8107  * int arrays that are used as working space. Their lengths must be at
8108  * least N*(3*N+2*M+11)+4*M+6 and M+1 respectively.
8109  *
8110  * In order to define the objective and constraint functions, we require
8111  * a subroutine that has the name and arguments
8112  *      SUBROUTINE CALCFC (N,M,X,F,CON)
8113  *      DIMENSION X(*),CON(*)  .
8114  * The values of N and M are fixed and have been defined already, while
8115  * X is now the current vector of variables. The subroutine should return
8116  * the objective and constraint functions at X in F and CON(1),CON(2),
8117  * ...,CON(M). Note that we are trying to adjust X so that F(X) is as
8118  * small as possible subject to the constraint functions being nonnegative.
8119  *
8120  * Partition the working space array W to provide the storage that is needed
8121  * for the main calculation.
8122  */
8123 
8124   if (n == 0)
8125   {
8126     if (iprint>=1) fprintf(stderr, "cobyla: N==0.\n");
8127     *maxfun = 0;
8128     return 0;
8129   }
8130 
8131   if (n < 0 || m < 0)
8132   {
8133     if (iprint>=1) fprintf(stderr, "cobyla: N<0 or M<0.\n");
8134     *maxfun = 0;
8135     return -2;
8136   }
8137 
8138   /* workspace allocation */
8139   w = (double *) malloc((n*(3*n+2*m+11)+4*m+6)*sizeof(*w));
8140   if (w == NULL)
8141   {
8142     if (iprint>=1) fprintf(stderr, "cobyla: memory allocation error.\n");
8143     *maxfun = 0;
8144     return -1;
8145   }
8146   iact = (int *) malloc((m+1)*sizeof(*iact));
8147   if (iact == NULL)
8148   {
8149     if (iprint>=1) fprintf(stderr, "cobyla: memory allocation error.\n");
8150     free(w);
8151     *maxfun = 0;
8152     return -1;
8153   }
8154 
8155   /* Parameter adjustments */
8156   --iact;
8157   --w;
8158   --x;
8159 
8160   /* Function Body */
8161   mpp = m + 2;
8162   icon = 1;
8163   isim = icon + mpp;
8164   isimi = isim + n * n + n;
8165   idatm = isimi + n * n;
8166   ia = idatm + n * mpp + mpp;
8167   ivsig = ia + m * n + n;
8168   iveta = ivsig + n;
8169   isigb = iveta + n;
8170   idx = isigb + n;
8171   iwork = idx + n;
8172   rc = cobylb(&n, &m, &mpp, &x[1], &rhobeg, &rhoend, &iprint, maxfun,
8173       &w[icon], &w[isim], &w[isimi], &w[idatm], &w[ia], &w[ivsig], &w[iveta],
8174       &w[isigb], &w[idx], &w[iwork], &iact[1], calcfc, state);
8175 
8176   /* Parameter adjustments (reverse) */
8177   ++iact;
8178   ++w;
8179 
8180   free(w);
8181   free(iact);
8182 
8183   return rc;
8184 } /* cobyla */
8185 
8186 /* ------------------------------------------------------------------------- */
cobylb(int * n,int * m,int * mpp,double * x,double * rhobeg,double * rhoend,int * iprint,int * maxfun,double * con,double * sim,double * simi,double * datmat,double * a,double * vsig,double * veta,double * sigbar,double * dx,double * w,int * iact,cobyla_function * calcfc,void * state)8187 int cobylb(int *n, int *m, int *mpp, double
8188     *x, double *rhobeg, double *rhoend, int *iprint, int *
8189     maxfun, double *con, double *sim, double *simi,
8190     double *datmat, double *a, double *vsig, double *veta,
8191      double *sigbar, double *dx, double *w, int *iact, cobyla_function *calcfc,
8192      void *state)
8193 {
8194   /* System generated locals */
8195   int sim_dim1, sim_offset, simi_dim1, simi_offset, datmat_dim1,
8196       datmat_offset, a_dim1, a_offset, i__1, i__2, i__3;
8197   double d__1, d__2;
8198 
8199   /* Local variables */
8200   double alpha, delta, denom, tempa, barmu;
8201   double beta, cmin = 0.0, cmax = 0.0;
8202   double cvmaxm, dxsign, prerem = 0.0;
8203   double edgmax, pareta, prerec = 0.0, phimin, parsig = 0.0;
8204   double gamma;
8205   double phi, rho, sum = 0.0;
8206   double ratio, vmold, parmu, error, vmnew;
8207   double resmax, cvmaxp;
8208   double resnew, trured;
8209   double temp, wsig, f;
8210   double weta;
8211   int i__, j, k, l;
8212   int idxnew;
8213   int iflag = 0;
8214   int iptemp;
8215   int isdirn, nfvals, izdota;
8216   int ivmc;
8217   int ivmd;
8218   int mp, np, iz, ibrnch;
8219   int nbest, ifull, iptem, jdrop;
8220   int rc = 0;
8221 
8222 /* Set the initial values of some parameters. The last column of SIM holds */
8223 /* the optimal vertex of the current simplex, and the preceding N columns */
8224 /* hold the displacements from the optimal vertex to the other vertices. */
8225 /* Further, SIMI holds the inverse of the matrix that is contained in the */
8226 /* first N columns of SIM. */
8227 
8228   /* Parameter adjustments */
8229   a_dim1 = *n;
8230   a_offset = 1 + a_dim1 * 1;
8231   a -= a_offset;
8232   simi_dim1 = *n;
8233   simi_offset = 1 + simi_dim1 * 1;
8234   simi -= simi_offset;
8235   sim_dim1 = *n;
8236   sim_offset = 1 + sim_dim1 * 1;
8237   sim -= sim_offset;
8238   datmat_dim1 = *mpp;
8239   datmat_offset = 1 + datmat_dim1 * 1;
8240   datmat -= datmat_offset;
8241   --x;
8242   --con;
8243   --vsig;
8244   --veta;
8245   --sigbar;
8246   --dx;
8247   --w;
8248   --iact;
8249 
8250   /* Function Body */
8251   iptem = min(*n,4);
8252   iptemp = iptem + 1;
8253   np = *n + 1;
8254   mp = *m + 1;
8255   alpha = .25;
8256   beta = 2.1;
8257   gamma = .5;
8258   delta = 1.1;
8259   rho = *rhobeg;
8260   parmu = 0.;
8261   if (*iprint >= 2) {
8262     fprintf(stderr,
8263       "cobyla: the initial value of RHO is %12.6E and PARMU is set to zero.\n",
8264       rho);
8265   }
8266   nfvals = 0;
8267   temp = 1. / rho;
8268   i__1 = *n;
8269   for (i__ = 1; i__ <= i__1; ++i__) {
8270     sim[i__ + np * sim_dim1] = x[i__];
8271     i__2 = *n;
8272     for (j = 1; j <= i__2; ++j) {
8273       sim[i__ + j * sim_dim1] = 0.;
8274       simi[i__ + j * simi_dim1] = 0.;
8275     }
8276     sim[i__ + i__ * sim_dim1] = rho;
8277     simi[i__ + i__ * simi_dim1] = temp;
8278   }
8279   jdrop = np;
8280   ibrnch = 0;
8281 
8282 /* Make the next call of the user-supplied subroutine CALCFC. These */
8283 /* instructions are also used for calling CALCFC during the iterations of */
8284 /* the algorithm. */
8285 
8286 L40:
8287   if (nfvals >= *maxfun && nfvals > 0) {
8288     if (*iprint >= 1) {
8289       fprintf(stderr,
8290         "cobyla: maximum number of function evaluations reach.\n");
8291     }
8292     rc = 1;
8293     goto L600;
8294   }
8295   ++nfvals;
8296   if (calcfc(*n, *m, &x[1], &f, &con[1], state))
8297   {
8298     if (*iprint >= 1) {
8299       fprintf(stderr, "cobyla: user requested end of minimization.\n");
8300     }
8301     rc = 3;
8302     goto L600;
8303   }
8304   resmax = 0.;
8305   if (*m > 0) {
8306     i__1 = *m;
8307     for (k = 1; k <= i__1; ++k) {
8308       d__1 = resmax, d__2 = -con[k];
8309       resmax = max(d__1,d__2);
8310     }
8311   }
8312   if (nfvals == *iprint - 1 || *iprint == 3) {
8313     fprintf(stderr, "cobyla: NFVALS = %4d, F =%13.6E, MAXCV =%13.6E\n",
8314       nfvals, f, resmax);
8315     i__1 = iptem;
8316     fprintf(stderr, "cobyla: X =");
8317     for (i__ = 1; i__ <= i__1; ++i__) {
8318       if (i__>1) fprintf(stderr, "  ");
8319       fprintf(stderr, "%13.6E", x[i__]);
8320     }
8321     if (iptem < *n) {
8322       i__1 = *n;
8323       for (i__ = iptemp; i__ <= i__1; ++i__) {
8324         if (!((i__-1) % 4)) fprintf(stderr, "\ncobyla:  ");
8325         fprintf(stderr, "%15.6E", x[i__]);
8326       }
8327     }
8328     fprintf(stderr, "\n");
8329   }
8330   con[mp] = f;
8331   con[*mpp] = resmax;
8332   if (ibrnch == 1) {
8333     goto L440;
8334   }
8335 
8336 /* Set the recently calculated function values in a column of DATMAT. This */
8337 /* array has a column for each vertex of the current simplex, the entries of */
8338 /* each column being the values of the constraint functions (if any) */
8339 /* followed by the objective function and the greatest constraint violation */
8340 /* at the vertex. */
8341 
8342   i__1 = *mpp;
8343   for (k = 1; k <= i__1; ++k) {
8344     datmat[k + jdrop * datmat_dim1] = con[k];
8345   }
8346   if (nfvals > np) {
8347     goto L130;
8348   }
8349 
8350 /* Exchange the new vertex of the initial simplex with the optimal vertex if */
8351 /* necessary. Then, if the initial simplex is not complete, pick its next */
8352 /* vertex and calculate the function values there. */
8353 
8354   if (jdrop <= *n) {
8355     if (datmat[mp + np * datmat_dim1] <= f) {
8356       x[jdrop] = sim[jdrop + np * sim_dim1];
8357     } else {
8358       sim[jdrop + np * sim_dim1] = x[jdrop];
8359       i__1 = *mpp;
8360       for (k = 1; k <= i__1; ++k) {
8361         datmat[k + jdrop * datmat_dim1] = datmat[k + np * datmat_dim1]
8362             ;
8363         datmat[k + np * datmat_dim1] = con[k];
8364       }
8365       i__1 = jdrop;
8366       for (k = 1; k <= i__1; ++k) {
8367         sim[jdrop + k * sim_dim1] = -rho;
8368         temp = 0.f;
8369         i__2 = jdrop;
8370         for (i__ = k; i__ <= i__2; ++i__) {
8371           temp -= simi[i__ + k * simi_dim1];
8372         }
8373         simi[jdrop + k * simi_dim1] = temp;
8374       }
8375     }
8376   }
8377   if (nfvals <= *n) {
8378     jdrop = nfvals;
8379     x[jdrop] += rho;
8380     goto L40;
8381   }
8382 L130:
8383   ibrnch = 1;
8384 
8385 /* Identify the optimal vertex of the current simplex. */
8386 
8387 L140:
8388   phimin = datmat[mp + np * datmat_dim1] + parmu * datmat[*mpp + np *
8389       datmat_dim1];
8390   nbest = np;
8391   i__1 = *n;
8392   for (j = 1; j <= i__1; ++j) {
8393     temp = datmat[mp + j * datmat_dim1] + parmu * datmat[*mpp + j *
8394         datmat_dim1];
8395     if (temp < phimin) {
8396       nbest = j;
8397       phimin = temp;
8398     } else if (temp == phimin && parmu == 0.) {
8399       if (datmat[*mpp + j * datmat_dim1] < datmat[*mpp + nbest *
8400           datmat_dim1]) {
8401         nbest = j;
8402       }
8403     }
8404   }
8405 
8406 /* Switch the best vertex into pole position if it is not there already, */
8407 /* and also update SIM, SIMI and DATMAT. */
8408 
8409   if (nbest <= *n) {
8410     i__1 = *mpp;
8411     for (i__ = 1; i__ <= i__1; ++i__) {
8412       temp = datmat[i__ + np * datmat_dim1];
8413       datmat[i__ + np * datmat_dim1] = datmat[i__ + nbest * datmat_dim1]
8414           ;
8415       datmat[i__ + nbest * datmat_dim1] = temp;
8416     }
8417     i__1 = *n;
8418     for (i__ = 1; i__ <= i__1; ++i__) {
8419       temp = sim[i__ + nbest * sim_dim1];
8420       sim[i__ + nbest * sim_dim1] = 0.;
8421       sim[i__ + np * sim_dim1] += temp;
8422       tempa = 0.;
8423       i__2 = *n;
8424       for (k = 1; k <= i__2; ++k) {
8425         sim[i__ + k * sim_dim1] -= temp;
8426         tempa -= simi[k + i__ * simi_dim1];
8427       }
8428       simi[nbest + i__ * simi_dim1] = tempa;
8429     }
8430   }
8431 
8432 /* Make an error return if SIGI is a poor approximation to the inverse of */
8433 /* the leading N by N submatrix of SIG. */
8434 
8435   error = 0.;
8436   i__1 = *n;
8437   for (i__ = 1; i__ <= i__1; ++i__) {
8438     i__2 = *n;
8439     for (j = 1; j <= i__2; ++j) {
8440       temp = 0.;
8441       if (i__ == j) {
8442         temp += -1.;
8443       }
8444       i__3 = *n;
8445       for (k = 1; k <= i__3; ++k) {
8446         temp += simi[i__ + k * simi_dim1] * sim[k + j * sim_dim1];
8447       }
8448       d__1 = error, d__2 = abs(temp);
8449       error = max(d__1,d__2);
8450     }
8451   }
8452   if (error > .1) {
8453     if (*iprint >= 1) {
8454       fprintf(stderr, "cobyla: rounding errors are becoming damaging.\n");
8455     }
8456     rc = 2;
8457     goto L600;
8458   }
8459 
8460 /* Calculate the coefficients of the linear approximations to the objective */
8461 /* and constraint functions, placing minus the objective function gradient */
8462 /* after the constraint gradients in the array A. The vector W is used for */
8463 /* working space. */
8464 
8465   i__2 = mp;
8466   for (k = 1; k <= i__2; ++k) {
8467     con[k] = -datmat[k + np * datmat_dim1];
8468     i__1 = *n;
8469     for (j = 1; j <= i__1; ++j) {
8470       w[j] = datmat[k + j * datmat_dim1] + con[k];
8471     }
8472     i__1 = *n;
8473     for (i__ = 1; i__ <= i__1; ++i__) {
8474       temp = 0.;
8475       i__3 = *n;
8476       for (j = 1; j <= i__3; ++j) {
8477         temp += w[j] * simi[j + i__ * simi_dim1];
8478       }
8479       if (k == mp) {
8480         temp = -temp;
8481       }
8482       a[i__ + k * a_dim1] = temp;
8483     }
8484   }
8485 
8486 /* Calculate the values of sigma and eta, and set IFLAG=0 if the current */
8487 /* simplex is not acceptable. */
8488 
8489   iflag = 1;
8490   parsig = alpha * rho;
8491   pareta = beta * rho;
8492   i__1 = *n;
8493   for (j = 1; j <= i__1; ++j) {
8494     wsig = 0.;
8495     weta = 0.;
8496     i__2 = *n;
8497     for (i__ = 1; i__ <= i__2; ++i__) {
8498       d__1 = simi[j + i__ * simi_dim1];
8499       wsig += d__1 * d__1;
8500       d__1 = sim[i__ + j * sim_dim1];
8501       weta += d__1 * d__1;
8502     }
8503     vsig[j] = 1. / std::sqrt(wsig);
8504     veta[j] = std::sqrt(weta);
8505     if (vsig[j] < parsig || veta[j] > pareta) {
8506       iflag = 0;
8507     }
8508   }
8509 
8510 /* If a new vertex is needed to improve acceptability, then decide which */
8511 /* vertex to drop from the simplex. */
8512 
8513   if (ibrnch == 1 || iflag == 1) {
8514     goto L370;
8515   }
8516   jdrop = 0;
8517   temp = pareta;
8518   i__1 = *n;
8519   for (j = 1; j <= i__1; ++j) {
8520     if (veta[j] > temp) {
8521       jdrop = j;
8522       temp = veta[j];
8523     }
8524   }
8525   if (jdrop == 0) {
8526     i__1 = *n;
8527     for (j = 1; j <= i__1; ++j) {
8528       if (vsig[j] < temp) {
8529         jdrop = j;
8530         temp = vsig[j];
8531       }
8532     }
8533   }
8534 
8535 /* Calculate the step to the new vertex and its sign. */
8536 
8537   temp = gamma * rho * vsig[jdrop];
8538   i__1 = *n;
8539   for (i__ = 1; i__ <= i__1; ++i__) {
8540     dx[i__] = temp * simi[jdrop + i__ * simi_dim1];
8541   }
8542   cvmaxp = 0.;
8543   cvmaxm = 0.;
8544   i__1 = mp;
8545   for (k = 1; k <= i__1; ++k) {
8546     sum = 0.;
8547     i__2 = *n;
8548     for (i__ = 1; i__ <= i__2; ++i__) {
8549       sum += a[i__ + k * a_dim1] * dx[i__];
8550     }
8551     if (k < mp) {
8552       temp = datmat[k + np * datmat_dim1];
8553       d__1 = cvmaxp, d__2 = -sum - temp;
8554       cvmaxp = max(d__1,d__2);
8555       d__1 = cvmaxm, d__2 = sum - temp;
8556       cvmaxm = max(d__1,d__2);
8557     }
8558   }
8559   dxsign = 1.;
8560   if (parmu * (cvmaxp - cvmaxm) > sum + sum) {
8561     dxsign = -1.;
8562   }
8563 
8564 /* Update the elements of SIM and SIMI, and set the next X. */
8565 
8566   temp = 0.;
8567   i__1 = *n;
8568   for (i__ = 1; i__ <= i__1; ++i__) {
8569     dx[i__] = dxsign * dx[i__];
8570     sim[i__ + jdrop * sim_dim1] = dx[i__];
8571     temp += simi[jdrop + i__ * simi_dim1] * dx[i__];
8572   }
8573   i__1 = *n;
8574   for (i__ = 1; i__ <= i__1; ++i__) {
8575     simi[jdrop + i__ * simi_dim1] /= temp;
8576   }
8577   i__1 = *n;
8578   for (j = 1; j <= i__1; ++j) {
8579     if (j != jdrop) {
8580       temp = 0.;
8581       i__2 = *n;
8582       for (i__ = 1; i__ <= i__2; ++i__) {
8583         temp += simi[j + i__ * simi_dim1] * dx[i__];
8584       }
8585       i__2 = *n;
8586       for (i__ = 1; i__ <= i__2; ++i__) {
8587         simi[j + i__ * simi_dim1] -= temp * simi[jdrop + i__ *
8588             simi_dim1];
8589       }
8590     }
8591     x[j] = sim[j + np * sim_dim1] + dx[j];
8592   }
8593   goto L40;
8594 
8595 /* Calculate DX=x(*)-x(0). Branch if the length of DX is less than 0.5*RHO. */
8596 
8597 L370:
8598   iz = 1;
8599   izdota = iz + *n * *n;
8600   ivmc = izdota + *n;
8601   isdirn = ivmc + mp;
8602   idxnew = isdirn + *n;
8603   ivmd = idxnew + *n;
8604   trstlp(n, m, &a[a_offset], &con[1], &rho, &dx[1], &ifull, &iact[1], &w[
8605       iz], &w[izdota], &w[ivmc], &w[isdirn], &w[idxnew], &w[ivmd]);
8606   if (ifull == 0) {
8607     temp = 0.;
8608     i__1 = *n;
8609     for (i__ = 1; i__ <= i__1; ++i__) {
8610       d__1 = dx[i__];
8611       temp += d__1 * d__1;
8612     }
8613     if (temp < rho * .25 * rho) {
8614       ibrnch = 1;
8615       goto L550;
8616     }
8617   }
8618 
8619 /* Predict the change to F and the new maximum constraint violation if the */
8620 /* variables are altered from x(0) to x(0)+DX. */
8621 
8622   resnew = 0.;
8623   con[mp] = 0.;
8624   i__1 = mp;
8625   for (k = 1; k <= i__1; ++k) {
8626     sum = con[k];
8627     i__2 = *n;
8628     for (i__ = 1; i__ <= i__2; ++i__) {
8629       sum -= a[i__ + k * a_dim1] * dx[i__];
8630     }
8631     if (k < mp) {
8632       resnew = max(resnew,sum);
8633     }
8634   }
8635 
8636 /* Increase PARMU if necessary and branch back if this change alters the */
8637 /* optimal vertex. Otherwise PREREM and PREREC will be set to the predicted */
8638 /* reductions in the merit function and the maximum constraint violation */
8639 /* respectively. */
8640 
8641   barmu = 0.;
8642   prerec = datmat[*mpp + np * datmat_dim1] - resnew;
8643   if (prerec > 0.) {
8644     barmu = sum / prerec;
8645   }
8646   if (parmu < barmu * 1.5) {
8647     parmu = barmu * 2.;
8648     if (*iprint >= 2) {
8649       fprintf(stderr, "cobyla: increase in PARMU to %12.6E\n", parmu);
8650     }
8651     phi = datmat[mp + np * datmat_dim1] + parmu * datmat[*mpp + np *
8652         datmat_dim1];
8653     i__1 = *n;
8654     for (j = 1; j <= i__1; ++j) {
8655       temp = datmat[mp + j * datmat_dim1] + parmu * datmat[*mpp + j *
8656           datmat_dim1];
8657       if (temp < phi) {
8658         goto L140;
8659       }
8660       if (temp == phi && parmu == 0.f) {
8661         if (datmat[*mpp + j * datmat_dim1] < datmat[*mpp + np *
8662             datmat_dim1]) {
8663           goto L140;
8664         }
8665       }
8666     }
8667   }
8668   prerem = parmu * prerec - sum;
8669 
8670 /* Calculate the constraint and objective functions at x(*). Then find the */
8671 /* actual reduction in the merit function. */
8672 
8673   i__1 = *n;
8674   for (i__ = 1; i__ <= i__1; ++i__) {
8675     x[i__] = sim[i__ + np * sim_dim1] + dx[i__];
8676   }
8677   ibrnch = 1;
8678   goto L40;
8679 L440:
8680   vmold = datmat[mp + np * datmat_dim1] + parmu * datmat[*mpp + np *
8681       datmat_dim1];
8682   vmnew = f + parmu * resmax;
8683   trured = vmold - vmnew;
8684   if (parmu == 0. && f == datmat[mp + np * datmat_dim1]) {
8685     prerem = prerec;
8686     trured = datmat[*mpp + np * datmat_dim1] - resmax;
8687   }
8688 
8689 /* Begin the operations that decide whether x(*) should replace one of the */
8690 /* vertices of the current simplex, the change being mandatory if TRURED is */
8691 /* positive. Firstly, JDROP is set to the index of the vertex that is to be */
8692 /* replaced. */
8693 
8694   ratio = 0.;
8695   if (trured <= 0.f) {
8696     ratio = 1.f;
8697   }
8698   jdrop = 0;
8699   i__1 = *n;
8700   for (j = 1; j <= i__1; ++j) {
8701     temp = 0.;
8702     i__2 = *n;
8703     for (i__ = 1; i__ <= i__2; ++i__) {
8704       temp += simi[j + i__ * simi_dim1] * dx[i__];
8705     }
8706     temp = abs(temp);
8707     if (temp > ratio) {
8708       jdrop = j;
8709       ratio = temp;
8710     }
8711     sigbar[j] = temp * vsig[j];
8712   }
8713 
8714 /* Calculate the value of ell. */
8715 
8716   edgmax = delta * rho;
8717   l = 0;
8718   i__1 = *n;
8719   for (j = 1; j <= i__1; ++j) {
8720     if (sigbar[j] >= parsig || sigbar[j] >= vsig[j]) {
8721       temp = veta[j];
8722       if (trured > 0.) {
8723         temp = 0.;
8724         i__2 = *n;
8725         for (i__ = 1; i__ <= i__2; ++i__) {
8726           d__1 = dx[i__] - sim[i__ + j * sim_dim1];
8727           temp += d__1 * d__1;
8728         }
8729         temp = std::sqrt(temp);
8730       }
8731       if (temp > edgmax) {
8732         l = j;
8733         edgmax = temp;
8734       }
8735     }
8736   }
8737   if (l > 0) {
8738     jdrop = l;
8739   }
8740   if (jdrop == 0) {
8741     goto L550;
8742   }
8743 
8744 /* Revise the simplex by updating the elements of SIM, SIMI and DATMAT. */
8745 
8746   temp = 0.;
8747   i__1 = *n;
8748   for (i__ = 1; i__ <= i__1; ++i__) {
8749     sim[i__ + jdrop * sim_dim1] = dx[i__];
8750     temp += simi[jdrop + i__ * simi_dim1] * dx[i__];
8751   }
8752   i__1 = *n;
8753   for (i__ = 1; i__ <= i__1; ++i__) {
8754     simi[jdrop + i__ * simi_dim1] /= temp;
8755   }
8756   i__1 = *n;
8757   for (j = 1; j <= i__1; ++j) {
8758     if (j != jdrop) {
8759       temp = 0.;
8760       i__2 = *n;
8761       for (i__ = 1; i__ <= i__2; ++i__) {
8762         temp += simi[j + i__ * simi_dim1] * dx[i__];
8763       }
8764       i__2 = *n;
8765       for (i__ = 1; i__ <= i__2; ++i__) {
8766         simi[j + i__ * simi_dim1] -= temp * simi[jdrop + i__ *
8767             simi_dim1];
8768       }
8769     }
8770   }
8771   i__1 = *mpp;
8772   for (k = 1; k <= i__1; ++k) {
8773     datmat[k + jdrop * datmat_dim1] = con[k];
8774   }
8775 
8776 /* Branch back for further iterations with the current RHO. */
8777 
8778   if (trured > 0. && trured >= prerem * .1) {
8779     goto L140;
8780   }
8781 L550:
8782   if (iflag == 0) {
8783     ibrnch = 0;
8784     goto L140;
8785   }
8786 
8787 /* Otherwise reduce RHO if it is not at its least value and reset PARMU. */
8788 
8789   if (rho > *rhoend) {
8790     rho *= .5;
8791     if (rho <= *rhoend * 1.5) {
8792       rho = *rhoend;
8793     }
8794     if (parmu > 0.) {
8795       denom = 0.;
8796       i__1 = mp;
8797       for (k = 1; k <= i__1; ++k) {
8798         cmin = datmat[k + np * datmat_dim1];
8799         cmax = cmin;
8800         i__2 = *n;
8801         for (i__ = 1; i__ <= i__2; ++i__) {
8802           d__1 = cmin, d__2 = datmat[k + i__ * datmat_dim1];
8803           cmin = min(d__1,d__2);
8804           d__1 = cmax, d__2 = datmat[k + i__ * datmat_dim1];
8805           cmax = max(d__1,d__2);
8806         }
8807         if (k <= *m && cmin < cmax * .5) {
8808           temp = max(cmax,0.) - cmin;
8809           if (denom <= 0.) {
8810             denom = temp;
8811           } else {
8812             denom = min(denom,temp);
8813           }
8814         }
8815       }
8816       if (denom == 0.) {
8817         parmu = 0.;
8818       } else if (cmax - cmin < parmu * denom) {
8819         parmu = (cmax - cmin) / denom;
8820       }
8821     }
8822     if (*iprint >= 2) {
8823       fprintf(stderr, "cobyla: reduction in RHO to %12.6E and PARMU =%13.6E\n",
8824         rho, parmu);
8825     }
8826     if (*iprint == 2) {
8827       fprintf(stderr, "cobyla: NFVALS = %4d, F =%13.6E, MAXCV =%13.6E\n",
8828         nfvals, datmat[mp + np * datmat_dim1], datmat[*mpp + np * datmat_dim1]);
8829 
8830       fprintf(stderr, "cobyla: X =");
8831       i__1 = iptem;
8832       for (i__ = 1; i__ <= i__1; ++i__) {
8833         if (i__>1) fprintf(stderr, "  ");
8834         fprintf(stderr, "%13.6E", sim[i__ + np * sim_dim1]);
8835       }
8836       if (iptem < *n) {
8837         i__1 = *n;
8838         for (i__ = iptemp; i__ <= i__1; ++i__) {
8839           if (!((i__-1) % 4)) fprintf(stderr, "\ncobyla:  ");
8840           fprintf(stderr, "%15.6E", x[i__]);
8841         }
8842       }
8843       fprintf(stderr, "\n");
8844     }
8845     goto L140;
8846   }
8847 
8848 /* Return the best calculated values of the variables. */
8849 
8850   if (*iprint >= 1) {
8851     fprintf(stderr, "cobyla: normal return.\n");
8852   }
8853   if (ifull == 1) {
8854     goto L620;
8855   }
8856 L600:
8857   i__1 = *n;
8858   for (i__ = 1; i__ <= i__1; ++i__) {
8859     x[i__] = sim[i__ + np * sim_dim1];
8860   }
8861   f = datmat[mp + np * datmat_dim1];
8862   resmax = datmat[*mpp + np * datmat_dim1];
8863 L620:
8864   if (*iprint >= 1) {
8865     fprintf(stderr, "cobyla: NFVALS = %4d, F =%13.6E, MAXCV =%13.6E\n",
8866       nfvals, f, resmax);
8867     i__1 = iptem;
8868     fprintf(stderr, "cobyla: X =");
8869     for (i__ = 1; i__ <= i__1; ++i__) {
8870       if (i__>1) fprintf(stderr, "  ");
8871       fprintf(stderr, "%13.6E", x[i__]);
8872     }
8873     if (iptem < *n) {
8874       i__1 = *n;
8875       for (i__ = iptemp; i__ <= i__1; ++i__) {
8876         if (!((i__-1) % 4)) fprintf(stderr, "\ncobyla:  ");
8877         fprintf(stderr, "%15.6E", x[i__]);
8878       }
8879     }
8880     fprintf(stderr, "\n");
8881   }
8882   *maxfun = nfvals;
8883   return rc;
8884 } /* cobylb */
8885 
8886 /* ------------------------------------------------------------------------- */
trstlp(int * n,int * m,double * a,double * b,double * rho,double * dx,int * ifull,int * iact,double * z__,double * zdota,double * vmultc,double * sdirn,double * dxnew,double * vmultd)8887 int trstlp(int *n, int *m, double *a,
8888     double *b, double *rho, double *dx, int *ifull,
8889     int *iact, double *z__, double *zdota, double *vmultc,
8890      double *sdirn, double *dxnew, double *vmultd)
8891 {
8892 #ifndef MS_SMART // https://connect.microsoft.com/VisualStudio/feedback/details/1028781/crash-c1001-on-relase-build
8893   /* System generated locals */
8894   int a_dim1, a_offset, z_dim1, z_offset, i__1, i__2;
8895   double d__1, d__2;
8896 
8897   /* Local variables */
8898   double alpha, tempa;
8899   double beta;
8900   double optnew, stpful, sum, tot, acca, accb;
8901   double ratio, vsave, zdotv, zdotw, dd;
8902   double sd;
8903   double sp, ss, resold = 0.0, zdvabs, zdwabs, sumabs, resmax, optold;
8904   double spabs;
8905   double temp, step;
8906   int icount;
8907   int iout, i__, j, k;
8908   int isave;
8909   int kk;
8910   int kl, kp, kw;
8911   int nact, icon = 0, mcon;
8912   int nactx = 0;
8913 
8914 
8915 /* This subroutine calculates an N-component vector DX by applying the */
8916 /* following two stages. In the first stage, DX is set to the shortest */
8917 /* vector that minimizes the greatest violation of the constraints */
8918 /*   A(1,K)*DX(1)+A(2,K)*DX(2)+...+A(N,K)*DX(N) .GE. B(K), K=2,3,...,M, */
8919 /* subject to the Euclidean length of DX being at most RHO. If its length is */
8920 /* strictly less than RHO, then we use the resultant freedom in DX to */
8921 /* minimize the objective function */
8922 /*      -A(1,M+1)*DX(1)-A(2,M+1)*DX(2)-...-A(N,M+1)*DX(N) */
8923 /* subject to no increase in any greatest constraint violation. This */
8924 /* notation allows the gradient of the objective function to be regarded as */
8925 /* the gradient of a constraint. Therefore the two stages are distinguished */
8926 /* by MCON .EQ. M and MCON .GT. M respectively. It is possible that a */
8927 /* degeneracy may prevent DX from attaining the target length RHO. Then the */
8928 /* value IFULL=0 would be set, but usually IFULL=1 on return. */
8929 
8930 /* In general NACT is the number of constraints in the active set and */
8931 /* IACT(1),...,IACT(NACT) are their indices, while the remainder of IACT */
8932 /* contains a permutation of the remaining constraint indices. Further, Z is */
8933 /* an orthogonal matrix whose first NACT columns can be regarded as the */
8934 /* result of Gram-Schmidt applied to the active constraint gradients. For */
8935 /* J=1,2,...,NACT, the number ZDOTA(J) is the scalar product of the J-th */
8936 /* column of Z with the gradient of the J-th active constraint. DX is the */
8937 /* current vector of variables and here the residuals of the active */
8938 /* constraints should be zero. Further, the active constraints have */
8939 /* nonnegative Lagrange multipliers that are held at the beginning of */
8940 /* VMULTC. The remainder of this vector holds the residuals of the inactive */
8941 /* constraints at DX, the ordering of the components of VMULTC being in */
8942 /* agreement with the permutation of the indices of the constraints that is */
8943 /* in IACT. All these residuals are nonnegative, which is achieved by the */
8944 /* shift RESMAX that makes the least residual zero. */
8945 
8946 /* Initialize Z and some other variables. The value of RESMAX will be */
8947 /* appropriate to DX=0, while ICON will be the index of a most violated */
8948 /* constraint if RESMAX is positive. Usually during the first stage the */
8949 /* vector SDIRN gives a search direction that reduces all the active */
8950 /* constraint violations by one simultaneously. */
8951 
8952   /* Parameter adjustments */
8953   z_dim1 = *n;
8954   z_offset = 1 + z_dim1 * 1;
8955   z__ -= z_offset;
8956   a_dim1 = *n;
8957   a_offset = 1 + a_dim1 * 1;
8958   a -= a_offset;
8959   --b;
8960   --dx;
8961   --iact;
8962   --zdota;
8963   --vmultc;
8964   --sdirn;
8965   --dxnew;
8966   --vmultd;
8967 
8968   /* Function Body */
8969   *ifull = 1;
8970   mcon = *m;
8971   nact = 0;
8972   resmax = 0.;
8973   i__1 = *n;
8974   for (i__ = 1; i__ <= i__1; ++i__) {
8975     i__2 = *n;
8976     for (j = 1; j <= i__2; ++j) {
8977       z__[i__ + j * z_dim1] = 0.;
8978     }
8979     z__[i__ + i__ * z_dim1] = 1.;
8980     dx[i__] = 0.;
8981   }
8982   if (*m >= 1) {
8983     i__1 = *m;
8984     for (k = 1; k <= i__1; ++k) {
8985       if (b[k] > resmax) {
8986         resmax = b[k];
8987         icon = k;
8988       }
8989     }
8990     i__1 = *m;
8991     for (k = 1; k <= i__1; ++k) {
8992       iact[k] = k;
8993       vmultc[k] = resmax - b[k];
8994     }
8995   }
8996   if (resmax == 0.) {
8997     goto L480;
8998   }
8999   i__1 = *n;
9000   for (i__ = 1; i__ <= i__1; ++i__) {
9001     sdirn[i__] = 0.;
9002   }
9003 
9004 /* End the current stage of the calculation if 3 consecutive iterations */
9005 /* have either failed to reduce the best calculated value of the objective */
9006 /* function or to increase the number of active constraints since the best */
9007 /* value was calculated. This strategy prevents cycling, but there is a */
9008 /* remote possibility that it will cause premature termination. */
9009 
9010 L60:
9011   optold = 0.;
9012   icount = 0;
9013 L70:
9014   if (mcon == *m) {
9015     optnew = resmax;
9016   } else {
9017     optnew = 0.;
9018     i__1 = *n;
9019     for (i__ = 1; i__ <= i__1; ++i__) {
9020       optnew -= dx[i__] * a[i__ + mcon * a_dim1];
9021     }
9022   }
9023   if (icount == 0 || optnew < optold) {
9024     optold = optnew;
9025     nactx = nact;
9026     icount = 3;
9027   } else if (nact > nactx) {
9028     nactx = nact;
9029     icount = 3;
9030   } else {
9031     --icount;
9032     if (icount == 0) {
9033       goto L490;
9034     }
9035   }
9036 
9037 /* If ICON exceeds NACT, then we add the constraint with index IACT(ICON) to */
9038 /* the active set. Apply Givens rotations so that the last N-NACT-1 columns */
9039 /* of Z are orthogonal to the gradient of the new constraint, a scalar */
9040 /* product being set to zero if its nonzero value could be due to computer */
9041 /* rounding errors. The array DXNEW is used for working space. */
9042 
9043   if (icon <= nact) {
9044     goto L260;
9045   }
9046   kk = iact[icon];
9047   i__1 = *n;
9048   for (i__ = 1; i__ <= i__1; ++i__) {
9049     dxnew[i__] = a[i__ + kk * a_dim1];
9050   }
9051   tot = 0.;
9052   k = *n;
9053 L100:
9054   if (k > nact) {
9055     sp = 0.;
9056     spabs = 0.;
9057     i__1 = *n;
9058     for (i__ = 1; i__ <= i__1; ++i__) {
9059       temp = z__[i__ + k * z_dim1] * dxnew[i__];
9060       sp += temp;
9061       spabs += abs(temp);
9062     }
9063     acca = spabs + abs(sp) * .1;
9064     accb = spabs + abs(sp) * .2;
9065     if (spabs >= acca || acca >= accb) {
9066       sp = 0.;
9067     }
9068     if (tot == 0.) {
9069       tot = sp;
9070     } else {
9071       kp = k + 1;
9072       temp = std::sqrt(sp * sp + tot * tot);
9073       alpha = sp / temp;
9074       beta = tot / temp;
9075       tot = temp;
9076       i__1 = *n;
9077       for (i__ = 1; i__ <= i__1; ++i__) {
9078         temp = alpha * z__[i__ + k * z_dim1] + beta * z__[i__ + kp *
9079             z_dim1];
9080         z__[i__ + kp * z_dim1] = alpha * z__[i__ + kp * z_dim1] -
9081             beta * z__[i__ + k * z_dim1];
9082         z__[i__ + k * z_dim1] = temp;
9083       }
9084     }
9085     --k;
9086     goto L100;
9087   }
9088 
9089 /* Add the new constraint if this can be done without a deletion from the */
9090 /* active set. */
9091 
9092   if (tot != 0.) {
9093     ++nact;
9094     zdota[nact] = tot;
9095     vmultc[icon] = vmultc[nact];
9096     vmultc[nact] = 0.;
9097     goto L210;
9098   }
9099 
9100 /* The next instruction is reached if a deletion has to be made from the */
9101 /* active set in order to make room for the new active constraint, because */
9102 /* the new constraint gradient is a linear combination of the gradients of */
9103 /* the old active constraints. Set the elements of VMULTD to the multipliers */
9104 /* of the linear combination. Further, set IOUT to the index of the */
9105 /* constraint to be deleted, but branch if no suitable index can be found. */
9106 
9107   ratio = -1.;
9108   k = nact;
9109 L130:
9110   zdotv = 0.;
9111   zdvabs = 0.;
9112   i__1 = *n;
9113   for (i__ = 1; i__ <= i__1; ++i__) {
9114     temp = z__[i__ + k * z_dim1] * dxnew[i__];
9115     zdotv += temp;
9116     zdvabs += abs(temp);
9117   }
9118   acca = zdvabs + abs(zdotv) * .1;
9119   accb = zdvabs + abs(zdotv) * .2;
9120   if (zdvabs < acca && acca < accb) {
9121     temp = zdotv / zdota[k];
9122     if (temp > 0. && iact[k] <= *m) {
9123       tempa = vmultc[k] / temp;
9124       if (ratio < 0. || tempa < ratio) {
9125         ratio = tempa;
9126         iout = k;
9127       }
9128     }
9129     if (k >= 2) {
9130       kw = iact[k];
9131       i__1 = *n;
9132       for (i__ = 1; i__ <= i__1; ++i__) {
9133         dxnew[i__] -= temp * a[i__ + kw * a_dim1];
9134       }
9135     }
9136     vmultd[k] = temp;
9137   } else {
9138     vmultd[k] = 0.;
9139   }
9140   --k;
9141   if (k > 0) {
9142     goto L130;
9143   }
9144   if (ratio < 0.) {
9145     goto L490;
9146   }
9147 
9148 /* Revise the Lagrange multipliers and reorder the active constraints so */
9149 /* that the one to be replaced is at the end of the list. Also calculate the */
9150 /* new value of ZDOTA(NACT) and branch if it is not acceptable. */
9151 
9152   i__1 = nact;
9153   for (k = 1; k <= i__1; ++k) {
9154     d__1 = 0., d__2 = vmultc[k] - ratio * vmultd[k];
9155     vmultc[k] = max(d__1,d__2);
9156   }
9157   if (icon < nact) {
9158     isave = iact[icon];
9159     vsave = vmultc[icon];
9160     k = icon;
9161 L170:
9162     kp = k + 1;
9163     kw = iact[kp];
9164     sp = 0.;
9165     i__1 = *n;
9166     for (i__ = 1; i__ <= i__1; ++i__) {
9167       sp += z__[i__ + k * z_dim1] * a[i__ + kw * a_dim1];
9168     }
9169     d__1 = zdota[kp];
9170     temp = std::sqrt(sp * sp + d__1 * d__1);
9171     alpha = zdota[kp] / temp;
9172     beta = sp / temp;
9173     zdota[kp] = alpha * zdota[k];
9174     zdota[k] = temp;
9175     i__1 = *n;
9176     for (i__ = 1; i__ <= i__1; ++i__) {
9177       temp = alpha * z__[i__ + kp * z_dim1] + beta * z__[i__ + k *
9178           z_dim1];
9179       z__[i__ + kp * z_dim1] = alpha * z__[i__ + k * z_dim1] - beta *
9180           z__[i__ + kp * z_dim1];
9181       z__[i__ + k * z_dim1] = temp;
9182     }
9183     iact[k] = kw;
9184     vmultc[k] = vmultc[kp];
9185     k = kp;
9186     if (k < nact) {
9187       goto L170;
9188     }
9189     iact[k] = isave;
9190     vmultc[k] = vsave;
9191   }
9192   temp = 0.;
9193   i__1 = *n;
9194   for (i__ = 1; i__ <= i__1; ++i__) {
9195     temp += z__[i__ + nact * z_dim1] * a[i__ + kk * a_dim1];
9196   }
9197   if (temp == 0.) {
9198     goto L490;
9199   }
9200   zdota[nact] = temp;
9201   vmultc[icon] = 0.;
9202   vmultc[nact] = ratio;
9203 
9204 /* Update IACT and ensure that the objective function continues to be */
9205 /* treated as the last active constraint when MCON>M. */
9206 
9207 L210:
9208   iact[icon] = iact[nact];
9209   iact[nact] = kk;
9210   if (mcon > *m && kk != mcon) {
9211     k = nact - 1;
9212     sp = 0.;
9213     i__1 = *n;
9214     for (i__ = 1; i__ <= i__1; ++i__) {
9215       sp += z__[i__ + k * z_dim1] * a[i__ + kk * a_dim1];
9216     }
9217     d__1 = zdota[nact];
9218     temp = std::sqrt(sp * sp + d__1 * d__1);
9219     alpha = zdota[nact] / temp;
9220     beta = sp / temp;
9221     zdota[nact] = alpha * zdota[k];
9222     zdota[k] = temp;
9223     i__1 = *n;
9224     for (i__ = 1; i__ <= i__1; ++i__) {
9225       temp = alpha * z__[i__ + nact * z_dim1] + beta * z__[i__ + k *
9226           z_dim1];
9227       z__[i__ + nact * z_dim1] = alpha * z__[i__ + k * z_dim1] - beta *
9228           z__[i__ + nact * z_dim1];
9229       z__[i__ + k * z_dim1] = temp;
9230     }
9231     iact[nact] = iact[k];
9232     iact[k] = kk;
9233     temp = vmultc[k];
9234     vmultc[k] = vmultc[nact];
9235     vmultc[nact] = temp;
9236   }
9237 
9238 /* If stage one is in progress, then set SDIRN to the direction of the next */
9239 /* change to the current vector of variables. */
9240 
9241   if (mcon > *m) {
9242     goto L320;
9243   }
9244   kk = iact[nact];
9245   temp = 0.;
9246   i__1 = *n;
9247   for (i__ = 1; i__ <= i__1; ++i__) {
9248     temp += sdirn[i__] * a[i__ + kk * a_dim1];
9249   }
9250   temp += -1.;
9251   temp /= zdota[nact];
9252   i__1 = *n;
9253   for (i__ = 1; i__ <= i__1; ++i__) {
9254     sdirn[i__] -= temp * z__[i__ + nact * z_dim1];
9255   }
9256   goto L340;
9257 
9258 /* Delete the constraint that has the index IACT(ICON) from the active set. */
9259 
9260 L260:
9261   if (icon < nact) {
9262     isave = iact[icon];
9263     vsave = vmultc[icon];
9264     k = icon;
9265 L270:
9266     kp = k + 1;
9267     kk = iact[kp];
9268     sp = 0.;
9269     i__1 = *n;
9270     for (i__ = 1; i__ <= i__1; ++i__) {
9271       sp += z__[i__ + k * z_dim1] * a[i__ + kk * a_dim1];
9272     }
9273     d__1 = zdota[kp];
9274     temp = std::sqrt(sp * sp + d__1 * d__1);
9275     alpha = zdota[kp] / temp;
9276     beta = sp / temp;
9277     zdota[kp] = alpha * zdota[k];
9278     zdota[k] = temp;
9279     i__1 = *n;
9280     for (i__ = 1; i__ <= i__1; ++i__) {
9281       temp = alpha * z__[i__ + kp * z_dim1] + beta * z__[i__ + k *
9282           z_dim1];
9283       z__[i__ + kp * z_dim1] = alpha * z__[i__ + k * z_dim1] - beta *
9284           z__[i__ + kp * z_dim1];
9285       z__[i__ + k * z_dim1] = temp;
9286     }
9287     iact[k] = kk;
9288     vmultc[k] = vmultc[kp];
9289     k = kp;
9290     if (k < nact) {
9291       goto L270;
9292     }
9293     iact[k] = isave;
9294     vmultc[k] = vsave;
9295   }
9296   --nact;
9297 
9298 /* If stage one is in progress, then set SDIRN to the direction of the next */
9299 /* change to the current vector of variables. */
9300 
9301   if (mcon > *m) {
9302     goto L320;
9303   }
9304   temp = 0.;
9305   i__1 = *n;
9306   for (i__ = 1; i__ <= i__1; ++i__) {
9307     temp += sdirn[i__] * z__[i__ + (nact + 1) * z_dim1];
9308   }
9309   i__1 = *n;
9310   for (i__ = 1; i__ <= i__1; ++i__) {
9311     sdirn[i__] -= temp * z__[i__ + (nact + 1) * z_dim1];
9312   }
9313   goto L340;
9314 
9315 /* Pick the next search direction of stage two. */
9316 
9317 L320:
9318   temp = 1. / zdota[nact];
9319   i__1 = *n;
9320   for (i__ = 1; i__ <= i__1; ++i__) {
9321     sdirn[i__] = temp * z__[i__ + nact * z_dim1];
9322   }
9323 
9324 /* Calculate the step to the boundary of the trust region or take the step */
9325 /* that reduces RESMAX to zero. The two statements below that include the */
9326 /* factor 1.0E-6 prevent some harmless underflows that occurred in a test */
9327 /* calculation. Further, we skip the step if it could be zero within a */
9328 /* reasonable tolerance for computer rounding errors. */
9329 
9330 L340:
9331   dd = *rho * *rho;
9332   sd = 0.;
9333   ss = 0.;
9334   i__1 = *n;
9335   for (i__ = 1; i__ <= i__1; ++i__) {
9336     if ((d__1 = dx[i__], abs(d__1)) >= *rho * 1e-6f) {
9337       d__2 = dx[i__];
9338       dd -= d__2 * d__2;
9339     }
9340     sd += dx[i__] * sdirn[i__];
9341     d__1 = sdirn[i__];
9342     ss += d__1 * d__1;
9343   }
9344   if (dd <= 0.) {
9345     goto L490;
9346   }
9347   temp = std::sqrt(ss * dd);
9348   if (abs(sd) >= temp * 1e-6f) {
9349     temp = std::sqrt(ss * dd + sd * sd);
9350   }
9351   stpful = dd / (temp + sd);
9352   step = stpful;
9353   if (mcon == *m) {
9354     acca = step + resmax * .1;
9355     accb = step + resmax * .2;
9356     if (step >= acca || acca >= accb) {
9357       goto L480;
9358     }
9359     step = min(step,resmax);
9360   }
9361 
9362 /* Set DXNEW to the new variables if STEP is the steplength, and reduce */
9363 /* RESMAX to the corresponding maximum residual if stage one is being done. */
9364 /* Because DXNEW will be changed during the calculation of some Lagrange */
9365 /* multipliers, it will be restored to the following value later. */
9366 
9367   i__1 = *n;
9368   for (i__ = 1; i__ <= i__1; ++i__) {
9369     dxnew[i__] = dx[i__] + step * sdirn[i__];
9370   }
9371   if (mcon == *m) {
9372     resold = resmax;
9373     resmax = 0.;
9374     i__1 = nact;
9375     for (k = 1; k <= i__1; ++k) {
9376       kk = iact[k];
9377       temp = b[kk];
9378       i__2 = *n;
9379       for (i__ = 1; i__ <= i__2; ++i__) {
9380         temp -= a[i__ + kk * a_dim1] * dxnew[i__];
9381       }
9382       resmax = max(resmax,temp);
9383     }
9384   }
9385 
9386 /* Set VMULTD to the VMULTC vector that would occur if DX became DXNEW. A */
9387 /* device is included to force VMULTD(K)=0.0 if deviations from this value */
9388 /* can be attributed to computer rounding errors. First calculate the new */
9389 /* Lagrange multipliers. */
9390 
9391   k = nact;
9392 L390:
9393   zdotw = 0.;
9394   zdwabs = 0.;
9395   i__1 = *n;
9396   for (i__ = 1; i__ <= i__1; ++i__) {
9397     temp = z__[i__ + k * z_dim1] * dxnew[i__];
9398     zdotw += temp;
9399     zdwabs += abs(temp);
9400   }
9401   acca = zdwabs + abs(zdotw) * .1;
9402   accb = zdwabs + abs(zdotw) * .2;
9403   if (zdwabs >= acca || acca >= accb) {
9404     zdotw = 0.;
9405   }
9406   vmultd[k] = zdotw / zdota[k];
9407   if (k >= 2) {
9408     kk = iact[k];
9409     i__1 = *n;
9410     for (i__ = 1; i__ <= i__1; ++i__) {
9411       dxnew[i__] -= vmultd[k] * a[i__ + kk * a_dim1];
9412     }
9413     --k;
9414     goto L390;
9415   }
9416   if (mcon > *m) {
9417     d__1 = 0., d__2 = vmultd[nact];
9418     vmultd[nact] = max(d__1,d__2);
9419   }
9420 
9421 /* Complete VMULTC by finding the new constraint residuals. */
9422 
9423   i__1 = *n;
9424   for (i__ = 1; i__ <= i__1; ++i__) {
9425     dxnew[i__] = dx[i__] + step * sdirn[i__];
9426   }
9427   if (mcon > nact) {
9428     kl = nact + 1;
9429     i__1 = mcon;
9430     for (k = kl; k <= i__1; ++k) {
9431       kk = iact[k];
9432       sum = resmax - b[kk];
9433       sumabs = resmax + (d__1 = b[kk], abs(d__1));
9434       i__2 = *n;
9435       for (i__ = 1; i__ <= i__2; ++i__) {
9436         temp = a[i__ + kk * a_dim1] * dxnew[i__];
9437         sum += temp;
9438         sumabs += abs(temp);
9439       }
9440       acca = sumabs + abs(sum) * .1f;
9441       accb = sumabs + abs(sum) * .2f;
9442       if (sumabs >= acca || acca >= accb) {
9443         sum = 0.f;
9444       }
9445       vmultd[k] = sum;
9446     }
9447   }
9448 
9449 /* Calculate the fraction of the step from DX to DXNEW that will be taken. */
9450 
9451   ratio = 1.;
9452   icon = 0;
9453   i__1 = mcon;
9454   for (k = 1; k <= i__1; ++k) {
9455     if (vmultd[k] < 0.) {
9456       temp = vmultc[k] / (vmultc[k] - vmultd[k]);
9457       if (temp < ratio) {
9458         ratio = temp;
9459         icon = k;
9460       }
9461     }
9462   }
9463 
9464 /* Update DX, VMULTC and RESMAX. */
9465 
9466   temp = 1. - ratio;
9467   i__1 = *n;
9468   for (i__ = 1; i__ <= i__1; ++i__) {
9469     dx[i__] = temp * dx[i__] + ratio * dxnew[i__];
9470   }
9471   i__1 = mcon;
9472   for (k = 1; k <= i__1; ++k) {
9473     d__1 = 0., d__2 = temp * vmultc[k] + ratio * vmultd[k];
9474     vmultc[k] = max(d__1,d__2);
9475   }
9476   if (mcon == *m) {
9477     resmax = resold + ratio * (resmax - resold);
9478   }
9479 
9480 /* If the full step is not acceptable then begin another iteration. */
9481 /* Otherwise switch to stage two or end the calculation. */
9482 
9483   if (icon > 0) {
9484     goto L70;
9485   }
9486   if (step == stpful) {
9487     goto L500;
9488   }
9489 L480:
9490   mcon = *m + 1;
9491   icon = mcon;
9492   iact[mcon] = mcon;
9493   vmultc[mcon] = 0.;
9494   goto L60;
9495 
9496 /* We employ any freedom that may be available to reduce the objective */
9497 /* function before returning a DX whose length is less than RHO. */
9498 
9499 L490:
9500   if (mcon == *m) {
9501     goto L480;
9502   }
9503   *ifull = 0;
9504 L500:
9505 #endif // MS_SMART
9506   return 0;
9507 } /* trstlp */
9508 
9509 #endif // GIAC_HAS_STO_38
9510