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=¶ms;
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=¶ms;
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 = ¶ms ;
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 = ¶ms ;
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