source: git/Singular/LIB/pfd.lib @ 4689d0

spielwiese
Last change on this file since 4689d0 was 4689d0, checked in by Hans Schoenemann <hannes@…>, 3 years ago
rename poly.lib to polylib.lib
  • Property mode set to 100644
File size: 69.2 KB
Line 
1////////////////////////////////////////////////////////////////////
2version="version pfd.lib 4.1.3.2 Aug_2020 ";
3category="??";
4info="
5LIBRARY: pfd.lib Multivariate Partial Fraction Decomposition
6
7AUTHOR: Marcel Wittmann, e-mail: mwittman@mathematik.uni-kl.de
8
9OVERVIEW:
10This Library implements an algorithm based on the work of E. K. Leinartas to
11write rational functions in mutiple variables as a sum of functions with
12\"smaller\" numerators and denominators.
13This can be used to shorten the IBP reduction coeffcients of multi-loop Feynman
14integrals. For this application,
15we also provide a procedure that applies the algorithm to all entries of a
16matrix of rational functions given as one (possibly very big) txt-file.
17If you use the library pfd.lib, please cite the corresponding paper
18[J. Boehm, M. Wittmann, Z. Wu, Y. Xu, Y. Zhang: 'IBP reduction coefficients
19made simple'] (preprint 2020).
20
21KEYWORDS: partial fraction; decomposition; Leinartas
22
23PROCEDURES:
24  pfd();                  calculate a partial fraction decomposition
25                          of a rational function
26  checkpfd();             test if a decomposition is equal to a rational
27                          function given by numerator/denominator polynomials
28  evaluatepfd();          substitute values in a partial fraction
29                          decomposition gotten from @code{pfd}
30  displaypfd();           print a decomposition gotten as output of @code{pfd}
31  displaypfd_long();      like @code{display}, but denominators are written out
32  getStringpfd();         turn a decomposition gotten from @code{pfd} into one
33                          string
34  getStringpfd_indexed(); like @code{getStringpfd}, but writes the denominator
35                          factors just as @code{q1}, @code{q2}, ...
36  readInputTXT();         read a matrix of rational functions from a txt-file
37  pfdMat();               apply @code{pfd} to a matrix of rational functions
38                          in parallel (using @ref{parallel_lib}) and save result
39                          as easy-to-read txt-files.
40  checkpfdMat();          test output files of @code{pfdMat} for correctness
41";
42/////////////////////////////////////////////////////////////////////////////
43
44LIB "random.lib";
45LIB "ring.lib";
46LIB "parallel.lib";
47LIB "elim.lib";
48LIB "polylib.lib";
49
50/////////////////////////////////////////////////////////////////////////////
51
52static proc mod_init()
53{
54  printlevel = 2;
55  // export some static functions so they can be run in parallel using parallelWaitAll:
56  if (!defined(Tasks)) {LIB "tasks.lib";}
57  exportto(Tasks,pfdWrap);
58  importfrom(Tasks,pfdWrap);
59  exportto(Pfd,pfdWrap);
60  exportto(Tasks,testEntry);
61  importfrom(Tasks,testEntry);
62  exportto(Pfd,testEntry);
63}
64
65proc pfd(list #)
66"USAGE:   pfd(f,g[,debug]);   f,g poly, debug int
67          pfd(f,g[,debug]);   f poly, g list, debug int
68          pfd(arguments[, parallelize]);     arguments list, parallelize int
69RETURN:   a partial fraction decomposition of f/g as a list @code{l} where
70          @code{l[1]} is an ideal generated by irreducible polynomials and
71          @code{l[2]} is a list of fractions.
72          Each fraction is represented by a list of
73       @* 1) the numerator polynomial
74       @* 2) an intvec of indices @code{i} for which @code{l[1][i]} occurs
75             as a factor in the denominator
76       @* 3) an intvec containing the exponents of those irreducible factors.
77       @* Setting @code{debug} to a positive integer measures runtimes and
78          creates a log file (default: @code{debug=0}).
79       @* The denominator g can also be given in factorized form as a list of
80          an ideal of irreducible non constant polynomials and an intvec of
81          exponents. This can save time since the first step in the algorithm is
82          to factorize g. (A list of the zero-ideal and an empty intvec
83          represents a denominator of 1.)
84       @* If instead of f and g, the input is a single list (or even a list of
85          lists) containing elements of the form @code{list(f,g[,debug])}
86          (@code{f,g,debug} as above), the algorithm is applied to all entries
87          in parallel (using @ref{parallel_lib}), if @code{parallelize=1}
88          (default) and in sequence if @code{parallelize=0}. A list (or list of
89          lists) of the results is returned.
90NOTE:     The result depends on the monomial ordering. For \"small\" results
91          use @code{dp}.
92SEE ALSO: checkpfd, evaluatepfd, displaypfd, displaypfd_long, pfdMat
93EXAMPLE:  example pfd; shows an example"
94{
95  short = 0;
96  int i;
97  if(typeof(#[1])=="list")
98  {
99    if(size(#)>1)
100    {
101      if(typeof(#[2])=="list")
102        {list arguments = #;    int parallelize = 1;}
103      else{if(typeof(#[2])=="int")
104        {list arguments = #[1]; int parallelize = #[2];}
105      else {ERROR("wrong type for second argument, expected int");}}
106    }
107    if(parallelize)
108    {
109      for(i=1; i<=size(arguments); i++)
110      {
111        if(typeof(arguments[i][1])=="list") //input is list of lists
112          {arguments[i] = list(arguments[i],1);}
113      }
114      return(parallelWaitAll("pfd",arguments));
115    }
116    else
117    {
118      list results;
119      for(i=1; i<=size(arguments); i++)
120      {
121        if(typeof(arguments[i][1])=="list") //input is list of lists
122          {results[i] = pfd(arguments[i],0);}
123        else
124        {
125          if(size(arguments[i])==2)
126            {results[i] = pfd(arguments[i][1],arguments[i][2]);}
127          else{if(size(arguments[i])==3)
128            {results[i] = pfd(arguments[i][1],arguments[i][2],arguments[i][3]);}
129          else {ERROR("wrong number of arguments, expected 2 or 3");}}
130        }
131      }
132      return(results);
133    }
134  }
135  poly f = #[1];
136  if(typeof(#[2])=="list")
137  {
138    list g=#[2];
139  }
140  else
141  {
142    poly g=#[2];
143  }
144
145  int debug=0; link l=":w ";
146  if(size(#)>3) {ERROR("wrong number of arguments, expected 2 or 3");}
147  if(size(#)==3)
148  {
149    debug=#[3];
150    l=":a "+string(debug)+"_log_"+datetime()+".txt";
151    system("--ticks-per-sec",1000);
152  }
153  if(debug)
154  {
155    fprintf(l,"debug: %s", debug);
156    fprintf(l,"size(string(f)) = %s, size(string(g)) = %s %n",
157               size(string(f)), size(string(g)), 0);
158    int counter,tt,ttt;
159  }
160
161  if(f==0)
162  {
163    list dec = list(ideal(),list(list(poly(0),intvec(0:0),intvec(0:0))));
164    if(debug)
165      {fprintf(l,"%ntotal: 0 ms (numerator was 0)",0); close(l);}
166    if(voice<=printlevel) {displaypfd(dec);}
167    return(dec);
168  }
169  if(typeof(g)=="poly")
170  {
171    if(deg(g)==0)
172    {
173      list dec = list(ideal(),list(list(f/g,intvec(0:0),intvec(0:0))));
174      if(debug)
175        {fprintf(l,"%ntotal: 0 ms (denominator was constant)",0); close(l);}
176      if(voice<=printlevel) {displaypfd(dec);}
177      return(dec);
178    }
179
180    // (1) factorization of the denominator ////////////////////////////////////
181    if(debug) {int t1 = rtimer; write(l,"factorizing ");}
182    list factor = factorize(g);
183    number lcoeff;
184    for(i=2; i<=size(factor[1]); i++)
185    {
186      lcoeff = leadcoef(factor[1][i]);
187      factor[1][i] = factor[1][i]/lcoeff;
188      factor[1][1] = factor[1][1]*(lcoeff^factor[2][i]); // polynomial is monic (thus unique)
189      lcoeff = content(factor[1][i]);
190      factor[1][i] = factor[1][i]/lcoeff;
191      factor[1][1] = factor[1][1]*(lcoeff^factor[2][i]); // polynomial has nice coefficients
192    }
193    ideal q = factor[1];
194    f = f/q[1];
195    q=delete(q,1);
196    intvec e = factor[2]; e=delete(e,1);
197    int m = size(q);
198    if(debug) {t1 = rtimer-t1; fprintf(l,"done! (%s ms)", t1);}
199  }
200  else{if(typeof(g)=="list")
201  {
202    if(size(g[1])==0)
203    {
204      list dec = list(ideal(),list(list(f,intvec(0:0),intvec(0:0))));
205      if(debug)
206        {fprintf(l,"%ntotal: 0 ms (denominator was constant)",0); close(l);}
207      if(voice<=printlevel) {displaypfd(dec);}
208      return(dec);
209    }
210
211    // denominator is already factorized
212    for(i=1;i<=size(g[1]);i++)
213    {
214      if(size(factorize(g[1][i])[1])>2)
215        {ERROR("factors should be irreducible");}
216    }
217
218    ideal q = g[1];
219    intvec e = g[2];
220    int m = size(q);
221    if(debug) {int t1=0;}
222  }
223  else
224  {ERROR("wrong type for second argument, expected poly or list(ideal,intvec)");}}
225
226  // (2) Nullstellensatz decomposition /////////////////////////////////////////
227  if(debug)
228    {int t2 = rtimer; write(l,"Nullstellensatz decomposition ");}
229  list terms = list(list(poly(f),1..m,e));
230  list dec,newterms,result;
231  int imax;
232  while(size(terms)>0)
233  {
234    if(debug) {ttt = rtimer; counter++;}
235    imax = size(terms);
236    newterms = list();
237    for(i=1; i<=imax; i++)
238    {
239      result = NSSdecompStep(terms[i],q);
240      if(size(result)>1) {newterms = mergepfd(newterms, result);}
241      else                    {dec = mergepfd(dec,      result);}
242    }
243    terms = newterms;
244    if(debug)
245      {fprintf(l,"  %s: %s ms, %s terms, %s unfinished",
246       counter, rtimer-ttt, size(terms)+size(dec), size(terms));}
247  }
248  if(debug)
249    {t2 = rtimer-t2; fprintf(l,"done! (%s ms, %s terms)", t2, size(dec));}
250
251  // (3) short numerator decomposition /////////////////////////////////////////
252  if(debug)
253    {int t3 = rtimer; write(l,"short numerator decompositions "); counter=0;}
254  terms = dec;
255  dec = list();
256  while(size(terms)>0)
257  {
258    if(debug) {tt = rtimer; counter++;}
259    imax = size(terms);
260    newterms = list();
261    for(i=1; i<=imax; i++)
262    {
263      result = shortNumeratorDecompStep(terms[i],q,debug,l);
264
265      if(debug) {ttt = rtimer;}
266      newterms = mergepfd(newterms, result[1]);
267      dec = mergepfd(dec, result[2]);
268      if(debug)
269        {fprintf(l,"      merging: %s ms, %s new terms",
270         rtimer-ttt, size(result[1]));}
271    }
272    terms = newterms;
273    if(debug)
274      {fprintf(l,"  %s: %s ms, %s terms, %s unfinished",
275       counter, rtimer-tt, size(terms)+size(dec), size(terms));}
276  }
277  if(debug)
278    {t3 = rtimer-t3; fprintf(l,"done! (%s ms, %s terms)", t3, size(dec));}
279
280  // (4) algebraic dependence decomposition ////////////////////////////////////
281  if(debug)
282    {int t4 = rtimer; write(l,"algebraic dependence decomposition "); counter=0;}
283  terms = dec;
284  dec = list();
285  while(size(terms)>0)
286  {
287    if(debug) {tt = rtimer; counter++;}
288    imax = size(terms);
289    newterms = list();
290    for(i=1; i<=imax; i++)
291    {
292      result = algDependDecompStep(terms[i],q,debug,l);
293
294      if(debug) {ttt = rtimer;}
295      if(size(result)>1) {newterms = mergepfd(newterms, result);}
296      else                    {dec = mergepfd(dec,      result);}
297      if(debug)
298        {fprintf(l,"      merging: %s ms, %s new terms", rtimer-ttt, size(result));}
299    }
300    terms = newterms;
301    if(debug)
302      {fprintf(l,"  %s: %s ms, %s terms, %s unfinished",
303       counter, rtimer-tt, size(terms)+size(dec),size(terms));}
304  }
305  if(debug)
306    {t4 = rtimer-t4; fprintf(l,"done! (%s ms, %s terms)", t4, size(dec));}
307
308  // (5) numerator decomposition ///////////////////////////////////////////////
309  if(debug)
310    {int t5 = rtimer; write(l,"numerator decompositions "); counter=0;}
311  terms = dec;
312  dec = list();
313  while(size(terms)>0)
314  {
315    if(debug) {tt = rtimer; counter++;}
316    imax = size(terms);
317    newterms = list();
318    for(i=1; i<=imax; i++)
319    {
320      result = numeratorDecompStep(terms[i],q,debug,l);
321
322      if(debug) {ttt = rtimer;}
323      newterms = mergepfd(newterms, result[1]);
324      dec = mergepfd(dec, result[2]);
325      if(debug)
326        {fprintf(l,"      merging: %s ms, %s new terms", rtimer-ttt, size(result[1]));}
327    }
328    terms = newterms;
329    if(debug)
330      {fprintf(l,"  %s: %s ms, %s terms, %s unfinished",
331       counter, rtimer-tt, size(terms)+size(dec), size(terms));}
332  }
333  if(debug)
334    {t5 = rtimer-t5; fprintf(l,"done! (%s ms, %s terms)", t5, size(dec));}
335
336  dec = list(q,dec);
337  if(debug) {fprintf(l,"%ntotal: %s ms", t1+t2+t3+t4+t5); close(l);}
338  if(voice<=printlevel) {displaypfd(dec);}
339  return(dec);
340}
341example
342{
343  "EXAMPLE:";
344  echo=voice;
345  ring R = 0,(x,y),dp;
346  poly f = x^3+3*x^2*y+2*y^2-x^2+4*x*y;
347  poly g = x^2*y*(x-1)*(x-y)^2;
348
349  list dec = pfd(f,g);
350
351  displaypfd_long(dec);   // display result
352  checkpfd(list(f,g),dec);   // check for equality to f/g
353
354  // calculate decompositions of a 2x2 matrix of rational functions at once:
355  list arguments = list(list(f, g),          list(1, f)     ),
356                        list(list(x*y, y+1), list(1, x^2-y^2));
357
358  dec = pfd(arguments);
359
360  // the result has the same shape as the
361  // input (2x2 matrix as list of lists):
362  displaypfd_long(dec[1][1]);
363  displaypfd_long(dec[1][2]);
364  displaypfd_long(dec[2][1]);
365  displaypfd_long(dec[2][2]);
366
367  // a more complicated example
368  ring S = 0,(s12,s15,s23,s34,s45),dp;
369  poly f = 7*s12^4*s15^2 + 11*s12^3*s15^3 + 4*s12^2*s15^4 - 10*s12^4*s15*s23
370    - 14*s12^3*s15^2*s23 - 4*s12^2*s15^3*s23 + 3*s12^4*s23^2 + 3*s12^3*s15*s23^2
371    + 13*s12^4*s15*s34 + 12*s12^3*s15^2*s34 + 2*s12^2*s15^3*s34
372    - 5*s12^4*s23*s34 + 33*s12^3*s15*s23*s34 + 49*s12^2*s15^2*s23*s34
373    + 17*s12*s15^3*s23*s34 - 17*s12^3*s23^2*s34 - 19*s12^2*s15*s23^2*s34
374    - 5*s12*s15^2*s23^2*s34 - 24*s12^3*s15*s34^2 - 15*s12^2*s15^2*s34^2
375    + 2*s12*s15^3*s34^2 + 15*s12^3*s23*s34^2 - 34*s12^2*s15*s23*s34^2
376    - 31*s12*s15^2*s23*s34^2 + 2*s15^3*s23*s34^2 + 33*s12^2*s23^2*s34^2
377    + 29*s12*s15*s23^2*s34^2 + 5*s15^2*s23^2*s34^2 + 9*s12^2*s15*s34^3
378    - 4*s12*s15^2*s34^3 - 15*s12^2*s23*s34^3 + 9*s12*s15*s23*s34^3
379    - 4*s15^2*s23*s34^3 - 27*s12*s23^2*s34^3 - 13*s15*s23^2*s34^3
380    + 2*s12*s15*s34^4 + 5*s12*s23*s34^4 + 2*s15*s23*s34^4 + 8*s23^2*s34^4
381    - 6*s12^3*s15^2*s45 - 9*s12^2*s15^3*s45 - 2*s12*s15^4*s45
382    + 30*s12^3*s15*s23*s45 + 56*s12^2*s15^2*s23*s45 + 24*s12*s15^3*s23*s45
383    - 12*s12^3*s23^2*s45 - 23*s12^2*s15*s23^2*s45 - 10*s12*s15^2*s23^2*s45
384    - 30*s12^3*s15*s34*s45 - 32*s12^2*s15^2*s34*s45 - 6*s12*s15^3*s34*s45
385    + 7*s12^3*s23*s34*s45 - 86*s12^2*s15*s23*s34*s45 - 104*s12*s15^2*s23*s34*s45
386    - 15*s15^3*s23*s34*s45 + 41*s12^2*s23^2*s34*s45 + 51*s12*s15*s23^2*s34*s45
387    + 10*s15^2*s23^2*s34*s45 - 5*s12^3*s34^2*s45 + 33*s12^2*s15*s34^2*s45
388    + 14*s12*s15^2*s34^2*s45 - 2*s15^3*s34^2*s45 - 21*s12^2*s23*s34^2*s45
389    + 62*s12*s15*s23*s34^2*s45 + 28*s15^2*s23*s34^2*s45 - 46*s12*s23^2*s34^2*s45
390    - 28*s15*s23^2*s34^2*s45 + 10*s12^2*s34^3*s45 - s12*s15*s34^3*s45
391    + 4*s15^2*s34^3*s45 + 21*s12*s23*s34^3*s45 - 6*s15*s23*s34^3*s45
392    + 17*s23^2*s34^3*s45 - 5*s12*s34^4*s45 - 2*s15*s34^4*s45 - 7*s23*s34^4*s45
393    - 6*s12^2*s15^2*s45^2 - 5*s12*s15^3*s45^2 - 2*s15^4*s45^2
394    - 28*s12^2*s15*s23*s45^2 - 42*s12*s15^2*s23*s45^2 - 10*s15^3*s23*s45^2
395    + 9*s12^2*s23^2*s45^2 + 10*s12*s15*s23^2*s45^2 + 24*s12^2*s15*s34*s45^2
396    + 36*s12*s15^2*s34*s45^2 + 10*s15^3*s34*s45^2 - 11*s12^2*s23*s34*s45^2
397    + 31*s12*s15*s23*s34*s45^2 + 25*s15^2*s23*s34*s45^2
398    - 18*s12*s23^2*s34*s45^2 - 10*s15*s23^2*s34*s45^2 + 4*s12^2*s34^2*s45^2
399    - 29*s12*s15*s34^2*s45^2 - 17*s15^2*s34^2*s45^2 + 27*s12*s23*s34^2*s45^2
400    + 2*s15*s23*s34^2*s45^2 + 9*s23^2*s34^2*s45^2 - 3*s12*s34^3*s45^2
401    + 10*s15*s34^3*s45^2 - 16*s23*s34^3*s45^2 - s34^4*s45^2 + 6*s12*s15^2*s45^3
402    + 3*s15^3*s45^3 + 8*s12*s15*s23*s45^3 + 10*s15^2*s23*s45^3
403    - 8*s12*s15*s34*s45^3 - 10*s15^2*s34*s45^3 + 9*s12*s23*s34*s45^3
404    + s12*s34^2*s45^3 + 8*s15*s34^2*s45^3 - 9*s23*s34^2*s45^3 - s34^3*s45^3
405    - s15^2*s45^4 + s15*s34*s45^4;
406  poly g = 4*s12*s15*(s12 + s15 - s34)*(s15 - s23 - s34)*(s12 + s23 - s45)
407                                 *(s12 - s34 - s45)*(s12 + s15 - s34 - s45)*s45;
408
409  list dec = pfd(f,g);
410
411  displaypfd(dec);
412  checkpfd(list(f,g),dec);
413
414  // size comparison:
415  size(string(f)) + size(string(g));
416  size(getStringpfd(dec));
417}
418
419static proc NSSdecompStep(list l, ideal q)
420{
421  poly f=l[1];
422  intvec indices=l[2];
423  intvec e=l[3];
424  int m = size(indices);
425
426  if(m==0) // denominator is 1
427    {return(list(l));} // do nothing, return input
428
429  ideal qe = q[indices];
430  for(int i=1; i<=m; i++)
431    {qe[i] = qe[i]^e[i];}
432  matrix T;
433  ideal qe_std = liftstd(qe,T);
434
435  if(deg(qe_std) == 0)
436  {
437    T = T/qe_std[1];
438      // now 1 = T[1,1]*qe[1] + ... + T[m,1]*qe[m] is a Nullstellensatz certificate
439    list dec;
440    poly h;
441    for(i=1; i<=m; i++)
442    {
443      h = T[i,1];
444      if(h != 0)
445        {dec[size(dec)+1] = list(f*h,delete(indices,i),delete(e,i));}
446    }
447    return(dec);
448  }
449  else
450  {
451    return(list(l)); // do nothing, return input
452  }
453}
454
455static proc shortNumeratorDecompStep(list l, ideal q, list #)
456{
457  int debug=0;
458  if(size(#)>0) {debug=#[1]; link ll=#[2];}
459  if(debug) {system("--ticks-per-sec",1000); int tt=rtimer;}
460
461  poly f=l[1];
462  intvec indices=l[2];
463  intvec e=l[3];
464  int m = size(indices);
465
466  if(m==0) // denominator is 1
467  {
468    if(debug)
469      {fprintf(ll,"      shortNumeratorDecompStep: %s ms (m=%s, e=%s) "
470                    +"--> constant denominator", rtimer-tt, m, e);}
471    return(list(list(),list(l))); // do nothing, return input
472  }
473
474  ideal q_denom = q[indices]; // factors occuring in the denominator
475  matrix T;
476  ideal q_std = liftstd(q_denom,T);
477  list divrem = division(f,q_std);
478  poly r = divrem[2][1]/divrem[3][1,1];
479
480  if(r!=0)
481  {
482    if(debug)
483      {fprintf(ll,"      shortNumeratorDecompStep: %s ms (m=%s, e=%s) "
484                  +"--> remainder is nonzero", rtimer-tt, m, e);}
485    return(list(list(),list(l))); // if there is a rest, decomposing further would
486  }                               // not help in the next step (alg. depend. decomposition)
487
488  matrix a = divrem[1]/divrem[3][1,1]; // now f = r + a[1,1]*q_std[1] + ... +a[m,1]*q_std[m]
489  a = T*a;   // lift coefficients   ==>   now f = r + a[1,1]*q[1]     + ... +a[m,1]*q[m]
490
491  // reduce w.r.t. groebner basis of syz(q) to make the numerators "smaller":
492  vector v;
493  for(int i=1; i<=m; i++) {v = v + gen(i)*a[i,1];}
494  v = reduce(v, std(syz(q_denom)));
495
496  list fraction,dec;
497  for(i=1; i<=m; i++)
498  {
499    if(v[i] == 0)
500    {
501      i++;
502      continue;
503    }
504    fraction[1] = v[i];
505    if(e[i]==1)
506      {
507        fraction[2] = delete(indices,i);
508        fraction[3] = delete(e,i);
509      }
510    else
511    {
512      fraction[2] = indices;
513      fraction[3] = e;
514      fraction[3][i] = fraction[3][i] - 1;
515    }
516    dec[size(dec)+1] = fraction;
517  }
518
519  if(debug)
520    {fprintf(ll,"      shortNumeratorDecompStep: %s ms (m=%s, e=%s, deg(v)=%s, size(v)=%s)",
521     rtimer-tt, m, e, deg(v), size(v));}
522  return(list(dec,list()));
523}
524
525static proc algDependDecompStep(list l, ideal q, list #)
526{
527  int debug=0;
528  if(size(#)>0) {debug=#[1]; link ll=#[2];}
529  if(debug) {system("--ticks-per-sec",1000); int tt=rtimer;}
530  def br = basering;
531  int d = nvars(br);
532  intvec indices=l[2];
533  int m = size(indices);
534  intvec e=l[3];
535  int i;
536
537  if(m==0) // denominator is 1
538  {
539    if(debug)
540      {fprintf(ll,"      algDependDecompStep: %s ms (m=%s, e=%s)", rtimer-tt, m, e);}
541    return(list(l)); // do nothing, return input
542  }
543
544  if(m<=d)
545  {
546    if(size(syz(module(transpose(jacob(ideal(q[indices]))))))==0) // jacobian criterion
547    {
548      if(debug)
549        {fprintf(ll,"      algDependDecompStep: %s ms (m=%s, e=%s) "
550                    +"--> alg. indep.", rtimer-tt, m, e);}
551      return(list(l)); // do nothing, return input
552    }
553  }
554
555  def R = changeord(list(list("dp",m+d)),extendring(m, "y(", "dp", 1, changevar("x()",br)));
556  setring(R);
557
558  list l = fetch(br,l);
559  ideal q = fetch(br,q);
560  poly f=l[1];
561
562  ideal I;
563  for(i=1; i<=m; i++)
564    {I[i] = y(i)-q[indices[i]];}
565
566  ideal annihilatingPolys = eliminate(I,intvec(1..d));
567
568  poly g = annihilatingPolys[1];
569
570  poly tail = g[size(g)];    // term of lowest dp-order (thus lowest degree)
571  number tcoeff = leadcoef(tail);
572  intvec texpon = leadexp(tail);
573  texpon = texpon[(d+1)..(d+m)];
574  g = g-tail;
575  poly term;
576  number coeff;
577  intvec expon;
578  list fraction,dec;
579  int pow;
580  int jmax = size(g);
581  for(int j=1; j<=jmax; j++)
582  {
583    term = g[j];
584    coeff = leadcoef(term);
585    expon = leadexp(term);
586    expon = expon[(d+1)..(d+m)];
587    fraction[1] = -f*coeff/tcoeff;
588    fraction[2] = intvec(0:0);
589    fraction[3] = intvec(0:0);
590    for(i=1; i<=m; i++)
591    {
592      pow = expon[i]-texpon[i]-e[i];
593      if(pow>=0)
594      {
595        fraction[1] = fraction[1]*q[indices[i]]^pow;
596      }
597      else
598      {
599        fraction[2][size(fraction[2])+1] = indices[i];
600        fraction[3][size(fraction[3])+1] = -pow;
601      }
602    }
603    dec[size(dec)+1] = fraction;
604  }
605  setring(br);
606  list dec = fetch(R,dec);
607  if(debug)
608    {fprintf(ll,"      algDependDecompStep: %s ms (m=%s, e=%s)", rtimer-tt, m, e);}
609  return(dec);
610}
611
612static proc numeratorDecompStep(list l, ideal q, list #)
613{
614  int debug=0;
615  if(size(#)>0) {debug=#[1]; link ll=#[2];}
616  if(debug) {system("--ticks-per-sec",1000); int tt=rtimer;}
617
618  poly f=l[1];
619  intvec indices=l[2];
620  intvec e=l[3];
621  int m = size(indices);
622
623  if(m==0) // denominator is 1
624  {
625    if(debug)
626      {fprintf(ll,"      numeratorDecompStep: %s ms (m=%s, e=%s) "
627                  +"--> constant denominator", rtimer-tt, m, e);}
628    return(list(list(),list(l))); // do nothing, return input
629  }
630
631  ideal q_denom = q[indices]; // factors in the denominator
632  matrix T;
633  ideal q_std = liftstd(q_denom,T);
634  list divrem = division(f,q_std);
635  matrix a = divrem[1]/divrem[3][1,1];
636  poly r = divrem[2][1]/divrem[3][1,1]; // now f = r + a[1,1]*q_std[1] + ... +a[m,1]*q_std[m]
637  a = T*a;   // lift coefficients    ==>   now f = r + a[1,1]*q[1]     + ... +a[m,1]*q[m]
638
639  // reduce w.r.t. groebner basis of syz(q) to make the numerators "smaller"
640  vector v;
641  for(int i=1; i<=m; i++) {v = v + gen(i)*a[i,1];}
642  v = reduce(v, std(syz(q_denom)));
643
644  list fraction,dec,rest;
645  if(r!=0)
646    {rest[1] = list(r,indices,e);}
647  for(i=1; i<=m; i++)
648  {
649    if(v[i] == 0)
650    {
651      i++;
652      continue;
653    }
654    fraction[1] = v[i];
655    if(e[i]==1)
656      {
657        fraction[2] = delete(indices,i);
658        fraction[3] = delete(e,i);
659      }
660    else
661    {
662      fraction[2] = indices;
663      fraction[3] = e;
664      fraction[3][i] = fraction[3][i] - 1;
665    }
666    dec[size(dec)+1] = fraction;
667  }
668
669  if(debug)
670    {fprintf(ll,"      numeratorDecompStep: %s ms (m=%s, e=%s, deg(v)=%s, size(v)=%s)",
671     rtimer-tt, m, e, deg(v), size(v));}
672  return(list(dec,rest));
673}
674
675static proc mergepfd(list dec1, list dec2)
676{
677  // Note: assumes dec1 is already sorted w.r.t. dp in the denominator exponents
678  int n1=size(dec1);
679  int n2=size(dec2);
680  if(n2==0) {return(dec1);}
681  int i;
682  int a,b,m;
683  list entry;
684  for(i=1; i<=n2; i++)
685  {
686    entry = dec2[i];
687    if(n1==0)
688    {
689      dec1=list(entry); n1++;
690      i++; continue;
691    }
692
693    a=1;
694    b=n1;
695    m = (a+b) div 2;
696    while(b>a)
697    {
698      if(is_dp_smaller(dec1[m][2], dec1[m][3], entry[2], entry[3]))
699      {
700        a=m+1;
701      }
702      else
703      {
704        b=m;
705      }
706      m = (a+b) div 2;
707    }
708    if(is_dp_smaller(dec1[a][2], dec1[a][3], entry[2], entry[3]))
709      {dec1=insert(dec1,entry,a); n1++;}
710    else{if(entry[2]==dec1[a][2] && entry[3]==dec1[a][3])
711    {
712      dec1[a][1] = dec1[a][1] + entry[1];   //same denominator: add numerators
713      if(dec1[a][1]==0)
714        {dec1 = delete(dec1,a); n1--;}
715    }
716    else
717      {dec1=insert(dec1,entry,a-1); n1++;}}
718  }
719  return(dec1);
720}
721
722static proc is_dp_smaller(intvec indices1, intvec e1, intvec indices2, intvec e2)
723{
724  if(size(e2)==0) {return(0);}
725  if(size(e1)==0) {return(1);}
726  int s1,s2 = sum(e1),sum(e2);
727  if(s1<s2) {return(1);}
728  if(s1>s2) {return(0);}
729  int n1,n2 = size(indices1),size(indices2);
730  int imax = min(n1,n2);
731  for(int i=0; i<imax; i++)
732  {
733    if(indices1[n1-i]>indices2[n2-i]) {return(1);}
734    if(indices1[n1-i]<indices2[n2-i]) {return(0);}
735    if(e1[n1-i]>e2[n2-i]) {return(1);}
736    if(e1[n1-i]<e2[n2-i]) {return(0);}
737  }
738  return(0);
739}
740
741proc checkpfd(list fraction, list dec, list #)
742"USAGE:   checkpfd(list(f,g),dec[,N,C]);   f,g poly, dec list, N,C int
743RETURN:   0 or 1
744PURPOSE:  test for (mathematical) equality of f/g and a partial fraction
745          decomposition dec. The list dec has to have the same structure as the
746          output of @ref{pfd}.
747       @* The denominator g can also be given in factorized form as a list of
748          an ideal of irreducible non constant polynomials and an intvec of
749          exponents. This can save time since the first step in the algorithm is
750          to factorize g. (a list of the zero-ideal and an empty intvec
751          represents a denominator of 1.)
752       @* By default the test is done (exactly) by bringing all terms of the
753          decomposition on the same denominator and comparing to f/g.
754       @* If additional parameters N [, C] are given and if @code{N>0}, a
755          probabilistic method is chosen: evaluation at N random points with
756          coordinates between -C and C. This may be faster for big polynomials.
757SEE ALSO: pfd
758EXAMPLE:  example checkpfd; shows an example"
759{
760  poly f = fraction[1];
761  def g = fraction[2];
762  if(size(#)>0)
763  {
764    if(#[1]>0)
765    {
766      int N = #[1]; // number of random tests
767      int max_val=16;
768      if(size(#)>1) {max_val = #[2];}
769      ideal values;
770      ideal vars = maxideal(1);
771      int d=nvars(basering);
772      number val1,val2;
773      int div_by_0;
774      int i,j;
775      for(i=1; i<=N; i++)
776      {
777        values = ideal(random(max_val,1,d));
778
779        if(typeof(g)=="poly")
780          {val1 = number(substitute(g,vars,values));}
781        else{if(typeof(g)=="list") // denominator given in factorized form
782        {
783          val1 = number(1);
784          for(j=1; j<=size(g[1]); j++)
785            {val1 = val1 * number(substitute(g[1][j]^g[2][j],vars,values));}
786        }
787        else {ERROR("wrong type for second argument, expected poly or list");}}
788
789        if(val1==0) {continue;}
790        val1 = number(substitute(f,vars,values))/val1;
791        val2, div_by_0 = evaluatepfd(dec,values,2);
792        if(div_by_0) {continue;}
793        if(val1 != val2)
794          {return(0);}
795      }
796      return(1);
797    }
798  }
799  ideal q = dec[1];
800  dec = dec[2];
801
802  int m = size(q);
803  int jmax,j,ind,k;
804  intvec e_max; e_max[m]=0;
805  int imax = size(dec);
806  for(int i=1; i<=imax; i++)
807  {
808    jmax = size(dec[i][2]);
809    for(j=1; j<=jmax; j++)
810    {
811      ind = dec[i][2][j];
812      e_max[ind] = max(e_max[ind],dec[i][3][j]);
813    }
814  }
815  poly num;
816  poly sum_of_numerators = 0;
817  intvec e;
818  for(i=1; i<=imax; i++)
819  {
820    e = e_max;
821    jmax = size(dec[i][2]);
822    for(j=1; j<=jmax; j++)
823    {
824      ind = dec[i][2][j];
825      e[ind] = e[ind]-dec[i][3][j];
826    }
827    num = dec[i][1];
828    for(j=1; j<=m; j++)
829      {num = num * q[j]^(e[j]);}
830    sum_of_numerators = sum_of_numerators + num;
831  }
832  // the decomposition is now equal to sum_of_numerators/product(q[i]^e_max[i]) (i from 1 to imax)
833  // now: check if this equals f/g:
834  if(typeof(g)=="poly")
835  {
836    list fact = factorize(g);
837    ideal q_g = delete(fact[1],1);
838    intvec e_g = delete(fact[2],1);
839    num = f/fact[1][1];
840  }
841  else{if(typeof(g)=="list")    //denominator given in factorized form
842  {
843    ideal q_g = g[1];
844    intvec e_g = g[2];
845    num = f;
846  }
847  else {ERROR("wrong type for second argument, expected poly or list");}}
848
849  int m_g = size(q_g);
850  int expon;
851  number c;
852  for(i=1; i<=m_g; i++)
853  {
854    j=0;
855    for(k=1; k<=m; k++)
856    {
857      c = leadcoef(q[k])/leadcoef(q_g[i]);
858      if(c*q_g[i]==q[k]) {j=k; break;}
859    }
860    if(j==0)
861      {sum_of_numerators = sum_of_numerators*q_g[i]^e_g[i];}
862    else
863    {
864      num = num*(c^e_g[i]);    //fix lead coefficient
865      expon = e_g[i]-e_max[j];
866      if(expon>0)
867        {sum_of_numerators = sum_of_numerators*q[j]^expon;}
868      else{if(expon<0)
869        {num = num*q[j]^(-expon);}}
870    }
871  }
872  return(sum_of_numerators==num);
873}
874example
875{
876  "EXAMPLE:";
877  echo=voice;
878  ring R = 0,(x,y),dp;
879  poly f = x^3+3*x^2*y+2*y^2-x^2+4*x*y;
880  poly g = x^2*y*(x-1)*(x-y)^2;
881
882  // partial fraction decomposition of f/g:
883  list dec = pfd(f,g);
884  // some other decomposition (not equal to f/g):
885  list wrong_dec = pfd(f+1,g);
886
887  displaypfd_long(dec);
888  list fraction = f,g;
889
890  // exact test:
891  checkpfd(fraction,dec);
892  checkpfd(fraction,wrong_dec);
893  // probabilistic test (evaluation at 10 random points):
894  checkpfd(fraction,dec,10);
895  checkpfd(fraction,wrong_dec,10);
896}
897
898proc evaluatepfd(list dec, ideal values, list #)
899"USAGE:   evaluatepfd(dec, values[, mode]);   dec list, values ideal, mode int
900RETURN:   the number gotten by substituting the numbers generating the ideal
901          @code{values} for the variables in the partial fraction decomposition
902          @code{dec}. The list @code{dec} has to have the same structure as the
903          output of @ref{pfd}.
904       @* @code{mode=1}: raise Error in case of division by 0 (default)
905       @* @code{mode=2}: return a second integer which is 1 if the denominator
906          becomes 0, and 0 otherwise.
907SEE ALSO: pfd
908EXAMPLE:  example evaluatepfd; shows an example"
909{
910  int mode = 1;
911  if(size(#)>0) {mode = #[1];}
912
913  ideal vars = maxideal(1); // ideal generated by ring variables
914  number val=0;
915  number denom;
916  int m,i,j;
917  for(i=1; i<=size(dec[2]); i++)
918  {
919    denom = 1;
920    m = size(dec[2][i][2]);
921    for(j=1; j<=m; j++)
922    {
923      denom = denom * (number(substitute(dec[1][dec[2][i][2][j]],vars,values)))^dec[2][i][3][j];
924      if(denom == 0)
925      {
926        if(mode==1) {ERROR("division by 0");}
927        else {return(0,1);}
928      }
929    }
930    val = val + number(substitute(dec[2][i][1],vars,values))/denom;
931  }
932  if(mode==1) {return(val);}
933  else {return(val,0);}
934}
935example
936{
937  "EXAMPLE:";
938  echo=voice;
939  ring R = 0,(x,y),dp;
940  poly f = x+2*y;
941  poly g = x^2-y^2;
942
943  // partial fraction decomposition of f/g:
944  list dec = pfd(f,g);
945
946  displaypfd_long(dec);
947  // evaluation at x=2, y=1:
948  ideal values = 2,1;
949  evaluatepfd(dec,values);
950
951  // compare: f(2,1)/g(2,1) = (2+2*1)/(2^2-1^1) = 4/3
952}
953
954static proc find_entry(def l, def entry)
955{
956  int n=size(l);
957  for(int i=1; i<=n; i++)
958    {if(entry==l[i]) {return(i);}}
959  return(0);
960}
961
962proc displaypfd(list dec)
963"USAGE:   displaypfd(dec);   dec list
964PURPOSE:  print a partial fraction decomposition @code{dec} in a readable way.
965          The list @code{dec} has to have the same structure as the output of
966          @ref{pfd}.
967SEE ALSO: pfd, displaypfd_long, getStringpfd, getStringpfd_indexed
968EXAMPLE:  example displaypfd; shows an example"
969{
970  ideal q = dec[1];
971  dec = dec[2];
972  int imax=size(dec);
973  int jmax,j;
974  string s1,s2;
975  for(int i=1; i<=imax; i++)
976  {
977    s1 = "(" + string(dec[i][1]);
978    if(i>1) {s1 = "+ " + s1;}
979    else {s1 = "  " + s1;}
980    if(size(dec[i][2])>0)
981    {
982      s2 = ") / (";
983      jmax = size(dec[i][2]);
984      for(j=1; j<=jmax; j++)
985      {
986        s2 = s2 + "q" + string(dec[i][2][j]);
987        if(dec[i][3][j] != 1) {s2 = s2 + "^" + string(dec[i][3][j]);}
988        if(j<jmax) {s2 = s2 + "*";}
989      }
990      s2 = s2 + ")";
991    }
992    else {s2 = ")";}
993
994    if(size(s1)+size(s2)>192) {s1=s1[1..(192-size(s2))]; s1 = s1 + "... ";}
995    print(s1+s2);
996  }
997  print("where");
998  for(i=1; i<=size(q); i++)
999  {
1000    printf("q%s = %s",i,q[i]);
1001  }
1002  if(size(dec)==1) {printf("(%s terms)%n", 1, 0);}
1003  else {printf("(%s terms)%n", size(dec), 0);}
1004}
1005example
1006{
1007  "EXAMPLE:";
1008  echo=voice;
1009  ring R = 0,(x,y),dp;
1010  poly f = x^3+3*x^2*y+2*y^2-x^2+4*x*y;
1011  poly g = x^2*y*(x-1)*(x-y)^2;
1012
1013  list dec = pfd(f,g);
1014
1015  displaypfd(dec);
1016}
1017
1018proc displaypfd_long(list dec)
1019"USAGE:   displaypfd_long(dec);   dec list
1020PURPOSE:  like @ref{displaypfd}, but denominators are written out, not indexed.
1021SEE ALSO: pfd, displaypfd, getStringpfd, getStringpfd_indexed
1022EXAMPLE:  example displaypfd_long; shows an example"
1023{
1024  ideal q = dec[1];
1025  dec = dec[2];
1026  print("  "+getStringFraction(dec[1],q));
1027  for(int i=2; i<=size(dec); i++)
1028    {print("+ "+getStringFraction(dec[i],q));}
1029  if(size(dec)==1) {printf("(%s terms)%n", 1, 0);}
1030  else {printf("(%s terms)%n", size(dec), 0);}
1031}
1032example
1033{
1034  "EXAMPLE:";
1035  echo=voice;
1036  ring R = 0,(x,y),dp;
1037  poly f = x^3+3*x^2*y+2*y^2-x^2+4*x*y;
1038  poly g = x^2*y*(x-1)*(x-y)^2;
1039
1040  list dec = pfd(f,g);
1041
1042  displaypfd_long(dec);
1043}
1044
1045proc getStringpfd(list dec)
1046"USAGE:   getStringpfd(dec);   dec list
1047PURPOSE:  turn a partial fraction decomposition @code{dec} into one string. The
1048          list @code{dec} has to have the same structure as the output of
1049          @ref{pfd}.
1050SEE ALSO: pfd, getStringpfd_indexed, displaypfd, displaypfd_long
1051EXAMPLE:  example getStringpfd; shows an example"
1052{
1053  ideal q = dec[1];
1054  dec = dec[2];
1055  string s = getStringFraction(dec[1],q);
1056  for(int i=2; i<=size(dec); i++)
1057    {s = s+" + "+getStringFraction(dec[i],q);}
1058  return(s);
1059}
1060example
1061{
1062  "EXAMPLE:";
1063  echo=voice;
1064  ring R = 0,(x,y),dp;
1065  poly f = x^3+3*x^2*y+2*y^2-x^2+4*x*y;
1066  poly g = x^2*y*(x-1)*(x-y)^2;
1067
1068  list dec = pfd(f,g);
1069
1070  displaypfd_long(dec);
1071  getStringpfd(dec);
1072}
1073
1074proc getStringpfd_indexed(list dec)
1075"USAGE:   getStringpfd_indexed(dec);   dec list
1076PURPOSE:  turn a partial fraction decomposition @code{dec} into one string,
1077          writing the denominator factors just as @code{q1},@code{q2},... . The
1078          list @code{dec} has to have the same structure as the output of
1079          @ref{pfd}.
1080SEE ALSO: pfd, getStringpfd, displaypfd, displaypfd_long
1081EXAMPLE:  example getStringpfd_indexed; shows an example"
1082{
1083  if(typeof(dec[1])=="ideal") {dec = dec[2];}
1084  string s = getStringFraction_indexed(dec[1]);
1085  for(int i=2; i<=size(dec); i++)
1086    {s = s+" + "+getStringFraction_indexed(dec[i]);}
1087  return(s);
1088}
1089example
1090{
1091  "EXAMPLE:";
1092  echo=voice;
1093  ring R = 0,(x,y),dp;
1094  poly f = x^3+3*x^2*y+2*y^2-x^2+4*x*y;
1095  poly g = x^2*y*(x-1)*(x-y)^2;
1096
1097  list dec = pfd(f,g);
1098
1099  displaypfd(dec);
1100  getStringpfd_indexed(dec);
1101}
1102
1103static proc getStringFraction(list fraction, ideal q)
1104{
1105  int jmax,j;
1106  string s = "(" + string(fraction[1]);
1107  if(size(fraction[2])>0)
1108  {
1109    s = s + ")/(";
1110    jmax = size(fraction[2]);
1111    for(j=1; j<=jmax; j++)
1112    {
1113      s = s + "(" + string(q[fraction[2][j]]) + ")";
1114      if(fraction[3][j] != 1) {s = s + "^" + string(fraction[3][j]);}
1115      if(j<jmax) {s = s + "*";}
1116    }
1117  }
1118  s = s + ")";
1119  return(s);
1120}
1121
1122static proc getStringFraction_indexed(list fraction)
1123{
1124  int jmax,j;
1125  string s = "(" + string(fraction[1]);
1126  if(size(fraction[2])>0)
1127  {
1128    s = s + ")/(";
1129    jmax = size(fraction[2]);
1130    for(j=1; j<=jmax; j++)
1131    {
1132      s = s + "q" + string(fraction[2][j]);
1133      if(fraction[3][j] != 1) {s = s + "^" + string(fraction[3][j]);}
1134      if(j<jmax) {s = s + "*";}
1135    }
1136  }
1137  s = s + ")";
1138  return(s);
1139}
1140
1141proc readInputTXT(def file__, list #)
1142"USAGE:   readInputTXT(file[, mode]), file string, mode int
1143          readInputTXT(filelist[, mode]), filelist list, mode int
1144PURPOSE:  read matrix of rational functions from a txt-file and turn it into a
1145          matrix (i.e. a list of lists) of pairs of polynomials (numerators and
1146          denominators). The string @code{file} should be the [directory +] name
1147          of the file in the form \"@code{<path-to-file>/<filename>.txt}\".
1148       @* The input file should be a list of lists separated by the characters
1149          \"{\", \"}\" and \",\". Example:
1150       @* \"{{(x+y)/(x^2-x*y), -(x^2*y+1)/(y), x^2}, {(x+1)/y, y/x, 0}}\"
1151       @* Each rational function has to be an expression of the form \"a\",
1152          \"(a)/(b)\", \"(b)^(-n)\" or \"(a)*(b)^(-n)\" where \"a\",\"b\" stand
1153          for polynomials (i.e. strings, that can be parsed as a polynomial with
1154          the @code{execute} command) and \"n\" stands for a positive integer. A
1155          minus sign \"-\" followed by such an expression is also allowed.
1156       @* IMPORTANT: The strings \"a\",\"b\" must NOT contain the symbol \"/\".
1157          (So in case the coefficient field is the rationals, all denominators
1158          in the coefficients of numerator and denominator polynomials should be
1159          cleared.)
1160       @* The file should contain less than 2^31 characters (filesize < 2 GB).
1161          For bigger files the matrix should be split row-wise into multiple
1162          matrices and saved in different files (each smaller than 2 GB). A list
1163          of the filenames (in the right order) can then be given as first
1164          argument instead.
1165       @* Also the basering has to match the variable names used in the
1166          input file(s).
1167       @* @code{mode=1} (default): save result to an ssi-file of the same name
1168       @* @code{mode=2}: return result
1169       @* @code{mode=3}: save to ssi-file AND return result
1170SEE ALSO: pfdMat
1171"
1172{
1173  system("--ticks-per-sec",1000);
1174  short = 0;
1175  if(!defined(basering))
1176    {ERROR("no basering defined!");}
1177  int left__,right__,pos1__,mid__,pos2__,tmp__,i__,j__,k__,t__,tt__,depth__;
1178  int mode__=1;
1179  if(size(#)>0) {mode__=#[1];}
1180  if(typeof(file__)=="list") // list of filenames given --> apply function to each
1181  {                          // file and concatenate the resulting matrices
1182    int n = size(file__);
1183    list mat__ = list();
1184    for(i__=1;i__<=n;i__++)
1185    {
1186      dbprint(sprintf("  file %s of %s:",i__,n));
1187      if(find(file__[i__],".txt")==0) {ERROR("wrong file type, expected txt");}
1188      printlevel = printlevel+1;
1189      mat__ = mat__ + readInputTXT(file__[i__],2);
1190      printlevel = printlevel-1;
1191    }
1192
1193    if(mode__==2) {return(mat__);}
1194
1195    string filename__ = file__[1][1,find(file__[1],".txt")-1];
1196    dbprint("  saving to file "+filename__+".ssi "); t__ = rtimer;
1197    write("ssi:w "+filename__+".ssi", mat__);
1198    dbprint(sprintf("  done! (%s ms)", rtimer-t__));
1199
1200    if(mode__==3) {return(mat__);}
1201  }
1202  if(typeof(file__)!="string")
1203    {ERROR("wrong type for first argument (expected string or list)");}
1204  if(find(file__,".txt")==0) {ERROR("wrong file type, expected txt");}
1205
1206  dbprint("  reading file "); t__=rtimer;
1207  string data__ = read(":r "+file__);
1208  dbprint(sprintf("  done! (%s ms)", rtimer-t__));
1209
1210  dbprint("  processing input "); t__ = rtimer;
1211  left__ = find(data__,"{");
1212  right__ = find(data__,"}");
1213  tmp__ = find(data__,"{",left__+1);
1214  if(left__<tmp__ && tmp__<right__) {left__ = tmp__;}
1215
1216  int finished__,n__;
1217  poly p__,q__;
1218  list row__,mat__;
1219  string s__,ss__;
1220  i__=0;
1221  while(1)
1222  {
1223    i__++;
1224    tt__ = rtimer;
1225    row__ = list();
1226    pos2__ = left__;
1227    finished__ = 0;
1228    j__=0;
1229    while(not finished__)
1230    {
1231      j__++;
1232      s__ = "";
1233
1234      pos1__ = pos2__+1;
1235      pos2__ = find(data__,",",pos1__);
1236      if(pos2__==0 || pos2__>right__)    // end of row
1237      {
1238        finished__ = 1;
1239        pos2__ = right__;
1240      }
1241      s__ = data__[pos1__,pos2__-pos1__];
1242      mid__ = find(s__,"/");
1243      if(mid__==0)
1244      {
1245        tmp__ = find(s__,"^(-");
1246        if(tmp__==0)    //no denominator
1247        {
1248          execute("p__=" + s__);
1249          q__=1;
1250          row__[j__] = list(p__,q__);
1251          continue;
1252        }
1253        else    // denominator is given by a negative exponent
1254        {
1255          if(find(s__,"^(-",tmp__+1)>0)
1256            {ERROR(sprintf("invalid syntax in (%s,%s)-th entry:"
1257                              +" more than one negative exponent",i__,j__));}
1258          for(k__=tmp__+3; s__[k__]!=")"; k__++) {}
1259          execute("n__=" + s__[tmp__+3,k__-tmp__-3]);
1260          while(k__<size(s__))
1261          {
1262            k__++;
1263            if(s__[k__]!=" ")
1264            {ERROR(sprintf("invalid syntax in (%s,%s)-th entry",i__,j__));}
1265          }
1266          s__ = s__[1,tmp__-1];
1267          depth__=0;
1268          for(k__=tmp__-1; 1; k__--)
1269          {
1270            ss__ = s__[k__];
1271            if(ss__ == ")") {depth__++;}
1272            else{if(ss__ == "(") {depth__--;}}
1273            if(depth__==0) {break;}
1274          }
1275          if(k__>1)
1276          {
1277            while(1)
1278            {
1279              if(k__==0)
1280                {ERROR(sprintf("invalid syntax in (%s,%s)-th entry",i__,j__));}
1281              k__--;
1282              ss__ = s__[k__];
1283              if(ss__=="*" || ss__==" " || ss__=="-") {break;}
1284            }
1285          }
1286          s__ = s__[1,k__] + "1/" + s__[k__+1,size(s__)-k__] + "^" + string(n__);
1287          mid__ = k__+2;    // position of the character "/"
1288        }
1289      }
1290      if(find(s__,"/",mid__+1)>0)
1291        {ERROR(sprintf("invalid syntax in (%s,%s)-th entry:%n"
1292        +"no '/' allowed in the string representing the polynomials",i__,j__,0));}
1293
1294      execute("p__=" + fixBrackets(s__[1,mid__-1]));
1295      execute("q__=" + fixBrackets(s__[mid__+1,size(s__)-mid__]));
1296
1297      row__[j__] = list(p__,q__);
1298    }
1299    mat__[i__] = row__;    // append row to matrix
1300    dbprint(sprintf("    row %s done! (%s ms)",i__,rtimer-tt__));
1301
1302    left__ = find(data__,"{",right__);
1303    if(left__==0) {break;}
1304    right__ = find(data__,"}",left__);
1305  }
1306  dbprint(sprintf("  done! (%s ms)", rtimer-t__));
1307
1308  if(mode__==2) {return(mat__);}
1309
1310  string filename__ = file__[1,find(file__,".txt")-1];
1311  dbprint("  saving to file "+filename__+".ssi "); t__ = rtimer;
1312  write("ssi:w "+filename__+".ssi", mat__);
1313  dbprint(sprintf("  done! (%s ms)", rtimer-t__));
1314
1315  if(mode__==3) {return(mat__);}
1316}
1317
1318static proc fixBrackets(string data)
1319{
1320  int pos=0;
1321  int left_brackets =0;
1322  int right_brackets=0;
1323  int n=size(data);
1324  while(pos<n)
1325  {
1326    pos = find(data,"(",pos+1);
1327    if(pos==0) {break;}
1328    left_brackets++;
1329  }
1330  pos=0;
1331  while(pos<n)
1332  {
1333    pos = find(data,")",pos+1);
1334    if(pos==0) {break;}
1335    right_brackets++;
1336  }
1337  int difference = left_brackets-right_brackets;
1338  if(difference>0)
1339  {
1340    for(int i=1; i<=difference; i++) {data = data+")";}
1341  }
1342  if(difference<0)
1343  {
1344    for(int i=1; i<=-difference; i++) {data = "("+data;}
1345  }
1346  return(data);
1347}
1348
1349static proc pfdWrap(poly f, def g, int i, int j, link logfile, int output_mode)
1350{
1351  system("--ticks-per-sec",1000);
1352  if(output_mode>3)
1353    {write("ssi:w pfd_results_"+string(i)+"_"+string(j)
1354           +".ssi","task started, but not finished yet");}
1355  int t0 = rtimer;
1356  list result = pfd(f,g);
1357  fprintf(logfile,"_[%s,%s]: %s ms",i,j,rtimer-t0);
1358  if(output_mode>3)
1359    {write("ssi:w pfd_results_"+string(i)+"_"+string(j)+".ssi",result);}
1360  return(result);
1361}
1362
1363static proc testEntry(int i, int j, list fraction, list dec, link logfile, int N);
1364{
1365  int t=rtimer;
1366  system("--ticks-per-sec",1000);
1367  int result = checkpfd(fraction,dec,N);
1368  if(result==1) {fprintf(logfile, " _[%s,%s]: correct (%s ms)",i,j,rtimer-t);}
1369  else          {fprintf(logfile, " _[%s,%s]: WRONG! (%s ms)", i,j,rtimer-t);}
1370  return(result);
1371}
1372
1373proc pfdMat(def infile, list #)
1374"USAGE:   pfdMat(file[, dotest, ignore_nonlin, output_mode, parallelize]);
1375          file string, dotest,ignore_nonlin,output_mode,parallelize int
1376PURPOSE:  apply @code{pfd} to all entries of a matrix of rational functions
1377          saved in a txt-file. The string @code{file} should be the
1378          [directory +] name of the file.
1379       @* The input file can either be a txt-file or an ssi-file created with
1380          @code{readInputTXT}. In case of a txt-file, the base ring has to match
1381          and the matrix has to be in the same format specified in
1382          @ref{readInputTXT}. Also, txt-files that are bigger than 2 GB should
1383          be split as described for @code{readInputTXT} and a list of the
1384          filenames can be given as first argument instead.
1385       @* The result is saved in multiple txt- (and ssi-) files (see below)
1386          within the directory of the input file.
1387       @* Also a logfile is created, which protocols the memory used and the
1388          runtimes of @code{pfd} for each matrix entry in real-time.
1389
1390       @* There are also 4 optional arguments:
1391       @* If @code{dotest} is nonzero, test the results with checkpfd:
1392       @* @code{dotest<0} (default): exact test (may be slow),
1393       @* @code{dotest>0}: do this amount of probabilistic tests for each entry
1394                           (see @ref{checkpfd}).
1395
1396       @* If @code{ignore_nonlin} is nonzero (default), for each denominator,
1397          the nonlinear factors in the factorization are removed before applying
1398          @code{pfd} (and added back in in the output files).
1399
1400       @* If @code{parallelize} is nonzero (default), the decompositions are
1401          calculated in parallel using @ref{parallel_lib}.
1402
1403       @* The parameter @code{output_mode} controls the output files created:
1404       @* @code{output_mode=1} (default): The result consists of two files:
1405          @code{<filename>_pfd_indexed.txt} contains the matrix of all
1406          decompositions (as list of lists separated by the characters \"{\",
1407          \"}\" and \",\") where all the denominators are written in factorized
1408          form depending on irreducible factors @code{q1}, @code{q2}, ... .
1409          The file @code{<filename>_denominator_factors.txt} lists all the
1410          polynomials @code{q1}, @code{q2}, ... .
1411       @* @code{output_mode=2}: Additionally to mode 1, the file
1412          @code{<filename>_pfd.txt} is created, which also contains the matrix
1413          of decompositions but the factors in the denominators are written out.
1414       @* @code{output_mode=3}: Additionally to mode 2, the result and some
1415          intermediate results are saved as SINGULAR objects in ssi-files:
1416       @* @code{<filename>.ssi}: contains the result of @code{readInputTXT} in
1417          case a txt-file was given as input.
1418       @* @code{<filename>_factorized_denominators.ssi}: like the first file,
1419          but the denominators are saved in factorized form, that is as a list
1420          of an ideal of irreducible non constant polynomials and an intvec of
1421          exponents.
1422       @* @code{<filename>_linear_part.ssi} (only if @code{ignore_nonlin} is
1423          nonzero): like the previous file, but all the irreducible denominator
1424          factors are removed
1425       @* @code{<filename>_non_linear_factors.ssi} (only if @code{ignore_nonlin}
1426          is nonzero): a list of an ideal @code{p} generated by irreducible
1427          polynomials and a matrix (list of lists) of the nonlinear denominator
1428          factors of each entry of the input matrix. These are represented as
1429          lists of an intvec of indices @code{i} for which @code{p[i]} occurs
1430          as a (nonlinear) factor in the denominator and an intvec containing
1431          the exponents of those factors.
1432       @* @code{<filename>_pfd.ssi}: a list, where the first entry is an ideal
1433          @code{q} of denominator factors and the second entry is a matrix (as
1434          list of lists) containing the decompositions, each of which is a list
1435          of terms, where a term is represented as in the result of @ref{pfd}
1436          by a list containing
1437       @* 1) the numerator polynomial
1438       @* 2) an intvec of indices @code{i} for which @code{q[i]} occurs
1439             as a factor in the denominator
1440       @* 3) an intvec containing the exponents of those irreducible factors.
1441       @* IMPORTANT: If @code{ignore_nonlin} is nonzero, this file contains the
1442          decompositions of the entries of the matrix in
1443          @code{<filename>_linear_part.ssi}. Thus the nonlinear factors, are
1444          NOT contained in this file.
1445       @* @code{output_mode=4}: Additionally to mode 3, the direct output of
1446          each call of @code{pfd} is saved in separate ssi-files called
1447          @code{pfd_results_i_j.ssi} where i,j are the matrix indices. This
1448          creates a lot of files, but may be useful in case the algorithm does
1449          not terminate in time for every matrix entry. Other than the files
1450          created in mode 1-3, these files are saved in the current directory,
1451          rather than the directory of the input file.
1452SEE ALSO: readInputTXT, pfd, checkpfd, checkpfdMat
1453"
1454{
1455  system("--ticks-per-sec",1000);
1456  short = 0;
1457  int dotest,ignore_nonlin,output_mode,parallelize = -1,1,1,1;
1458  if(size(#)>0) {dotest = #[1];}
1459  if(size(#)>1) {ignore_nonlin = #[2];}
1460  if(size(#)>2) {output_mode = #[3];}
1461  if(size(#)>3) {parallelize = #[4];}
1462
1463  int i,j,k,l,ind;
1464  list arguments,results;
1465
1466  dbprint(newline+"reading data "); int t0=rtimer;
1467
1468  if(typeof(infile)=="list")
1469  {
1470    printlevel = printlevel+1;
1471    if(output_mode>2) {list mat = readInputTXT(infile,3);}
1472    else {list mat = readInputTXT(infile,2);}
1473    printlevel = printlevel-1;
1474    int pos=find(infile[1],".txt");
1475    string filename = infile[1][1,pos-1];
1476  }
1477  else
1478  {
1479    int pos=find(infile,".txt");
1480    if(pos!=0)
1481    {
1482      printlevel = printlevel+1;
1483      if(output_mode>2) {list mat = readInputTXT(infile,3);}
1484      else {list mat = readInputTXT(infile,2);}
1485      printlevel = printlevel-1;
1486    }
1487    else
1488    {
1489      pos=find(infile,".ssi");
1490      if(pos!=0) {list mat = read("ssi:r "+infile);}
1491      else {ERROR("invalid file type, expected ssi or txt");}
1492    }
1493    string filename = infile[1,pos-1];
1494  }
1495
1496  link qfile = ":w "+filename+"_denominator_factors.txt";
1497  int n = size(mat);
1498  int m = size(mat[1]);
1499  dbprint(sprintf("done! (%s ms)",rtimer-t0));
1500
1501  if(typeof(mat[1][1][2])!="list")    // denominators are not yet factorized
1502  {
1503    dbprint("factorizing the denominators "); t0=rtimer;
1504    printlevel = printlevel+1;
1505    mat = FactDenom(mat);
1506    printlevel = printlevel-1;
1507    if(output_mode>2)
1508      {write("ssi:w "+filename+"_factorized_denominators.ssi",mat);}
1509    dbprint(sprintf("done! (%s ms)",rtimer-t0));
1510  }
1511
1512  if(ignore_nonlin)
1513  {
1514    dbprint("removing nonlinear denominator factors before pfd is applied");
1515    list nonlin_denom_factors;
1516    ideal p;
1517    printlevel = printlevel+1;
1518    mat, nonlin_denom_factors, p = removeNonlinearFactors(mat, filename);
1519    printlevel = printlevel-1;
1520    if(output_mode>2)
1521    {
1522      dbprint("saving nonlinear factors to "+filename+"_non_linear_factors.ssi ");
1523      t0 = rtimer;
1524      write("ssi:w "+filename+"_non_linear_factors.ssi", list(p,nonlin_denom_factors));
1525      dbprint(sprintf("done! (%s ms)",rtimer-t0));
1526      dbprint("saving input matrix without the nonlinear factors to "
1527              +filename+"_linear_part.ssi ");
1528      t0 = rtimer;
1529      write("ssi:w "+filename+"_linear_part.ssi", mat);
1530      dbprint(sprintf("done! (%s ms)",rtimer-t0));
1531    }
1532  }
1533
1534  if(parallelize)
1535  {
1536    dbprint("creating tasks "); t0=rtimer;
1537    write(":w "+filename+"_pfdMat_logfile.txt","finished matrix entries with runtimes "
1538          +"(calculated in parallel on "+string(getcores())+" cores):");
1539    link logfile = ":a "+filename+"_pfdMat_logfile.txt";
1540    for(i=1; i<=n; i++)
1541    {
1542      for(j=1; j<=m; j++)
1543      {
1544        ind = m*(i-1)+j;
1545        arguments[ind] = list(mat[i][j][1],mat[i][j][2],i,j,logfile,output_mode);
1546      }
1547    }
1548    dbprint(sprintf("done! (%s ms)",rtimer-t0));
1549
1550    dbprint("applying pfd to each matrix entry "); t0 = rtimer;
1551    results = parallelWaitAll("pfdWrap",arguments);
1552    arguments = list();
1553    dbprint(sprintf("done! (%s ms)",rtimer-t0));
1554
1555    write(logfile,"decomposition: "+string(rtimer-t0)+" ms and "+string(memory(2))
1556                   +" Byte Memory max. (after calling pfd on each matrix entry)");
1557
1558    dbprint("writing results in matrix shape "); t0 = rtimer;
1559    list dec_mat;
1560    for(i=1; i<=n; i++)
1561    {
1562      dec_mat[i] = list();
1563      for(j=1; j<=m; j++)
1564      {
1565        ind = m*(i-1)+j;
1566        dec_mat[i][j] = results[ind];
1567      }
1568    }
1569    results = list();
1570    dbprint(sprintf("done! (%s ms)",rtimer-t0));
1571  }
1572  else
1573  {
1574    dbprint("applying pfd to each matrix entry "); t0=rtimer;
1575    write(":w "+filename+"_pfdMat_logfile.txt",
1576          "finished matrix entries with runtimes (no parallelization):");
1577    link logfile = ":a "+filename+"_pfdMat_logfile.txt";
1578    list dec_mat;
1579    for(i=1; i<=n; i++)
1580    {
1581      dec_mat[i] = list();
1582      for(j=1; j<=m; j++)
1583      {
1584        dec_mat[i][j] = pfdWrap(mat[i][j][1],mat[i][j][2],i,j,logfile,output_mode);
1585      }
1586    }
1587    dbprint(sprintf("done! (%s ms)",rtimer-t0));
1588    write(logfile,"decomposition: "+string(rtimer-t0)+" ms and "+string(memory(2))
1589          +" Byte Memory max. (after calling pfd on each matrix entry)");
1590 }
1591
1592  dbprint("making one single list of denominator factors "); t0 = rtimer;
1593  ideal q,new_q;
1594  intvec dict;
1595  for(i=1; i<=n; i++)
1596  {
1597    for(j=1; j<=m; j++)
1598    {
1599      new_q = dec_mat[i][j][1];
1600      dec_mat[i][j] = dec_mat[i][j][2];
1601      dict = 0:0;
1602      for(k=1; k<=size(new_q); k++)
1603      {
1604        ind = find_entry(q,new_q[k]);
1605        if(ind==0)
1606        {
1607          ind = size(q)+1;
1608          q[ind] = new_q[k];
1609        }
1610        dict[k] = ind;
1611      }
1612      for(k=1; k<=size(dec_mat[i][j]); k++)
1613      {
1614        if(size(dec_mat[i][j][k][2])>0)
1615          {dec_mat[i][j][k][2] = intvec(dict[dec_mat[i][j][k][2]]);}
1616      }
1617    }
1618    dbprint(sprintf("  row %s complete!",i));
1619  }
1620  dbprint(sprintf("done! (%s ms)",rtimer-t0));
1621
1622  if(output_mode>2)
1623  {
1624    dbprint("saving result to "+filename+"_pfd.ssi "); t0 = rtimer;
1625    write("ssi:w "+filename+"_pfd.ssi", list(q,dec_mat));
1626    dbprint(sprintf("done! (%s ms)",rtimer-t0));
1627  }
1628
1629  if(ignore_nonlin)
1630  {
1631    ind = size(q);
1632    for(i=1; i<=size(p); i++) {q[ind+i]=p[i];} // add nonlin. polynomials to q
1633    for(i=1; i<=n; i++)
1634    {
1635      for(j=1; j<=m; j++)
1636      {
1637        nonlin_denom_factors[i][j][1] = nonlin_denom_factors[i][j][1]+ind; // adjust indices
1638      }
1639    }
1640  }
1641
1642  if(ignore_nonlin)
1643    {dbprint(sprintf("creating readable .txt-files (including the nonlinear factors again)"));}
1644  else
1645    {dbprint(sprintf("creating readable .txt-files "));}
1646  t0 = rtimer;
1647  dbprint(" indexed ("+filename+"_pfd_indexed.txt):");
1648  printlevel = printlevel+1;
1649  if(ignore_nonlin)
1650    {saveResultTXT_indexed(dec_mat, filename+"_pfd_indexed", nonlin_denom_factors);}
1651  else {saveResultTXT_indexed(dec_mat, filename+"_pfd_indexed");}
1652  printlevel = printlevel-1;
1653  for(i=1; i<=size(q); i++) {fprintf(qfile, "q%s = %s;", i, q[i]);}
1654  if(output_mode>1)
1655  {
1656    dbprint(" denominators written out ("+filename+"_pfd.txt):");
1657    printlevel = printlevel+1;
1658    if(ignore_nonlin)
1659      {saveResultTXT(dec_mat, q, filename+"_pfd", nonlin_denom_factors);}
1660    else {saveResultTXT(dec_mat, q, filename+"_pfd");}
1661    printlevel = printlevel-1;
1662  }
1663  dbprint(sprintf("done! (%s ms)",rtimer-t0));
1664
1665  if(dotest)
1666  {
1667    if(dotest<0)
1668      {dbprint("checking for correctness (exact test) ");}
1669    else
1670      {dbprint(sprintf("checking for correctness (%s random evaluations per entry) ",dotest));}
1671    t0 = rtimer;
1672    if(parallelize)
1673    {
1674      for(i=1; i<=n; i++)
1675      {
1676        for(j=1; j<=m; j++)
1677        {
1678          arguments[m*(i-1)+j]=list(i,j,mat[i][j],list(q,dec_mat[i][j]),logfile,dotest);
1679        }
1680      }
1681      results = parallelWaitAll("testEntry",arguments);
1682    }
1683    else
1684    {
1685      for(i=1; i<=n; i++)
1686      {
1687        for(j=1; j<=m; j++)
1688        {
1689          results[m*(i-1)+j]=testEntry(i,j,mat[i][j],list(q,dec_mat[i][j]),logfile,dotest);
1690        }
1691      }
1692    }
1693    dbprint(sprintf("%s out of %s = %sx%s decompositions are correct! (%s ms)%n",
1694            sum(results),n*m,n,m,rtimer-t0,0));
1695    write(logfile,"checking for correctness: "+string(rtimer-t0)+" ms and "
1696          +string(memory(2))+" Byte Memory max. (at the end of pfdMat), "
1697          +string(sum(results))+" correct out of "+string(n*m));
1698  }
1699}
1700
1701static proc FactDenom(list mat)
1702{
1703  system("--ticks-per-sec",1000);
1704  int i,j,k,ind,t,counter;
1705  int n = size(mat);
1706  int m = size(mat[1]);
1707  list denom = list();
1708  for(i=1; i<=n; i++)
1709  {
1710    denom[i] = list();
1711    for(j=1; j<=m; j++)
1712    {
1713      denom[i][j] = mat[i][j][2];
1714      mat[i][j][2] = list(ideal(),intvec(0:0));
1715    }
1716  }
1717  int expon;
1718  list fact;
1719  number lcoeff;
1720  int timeout = 60000;
1721  int finished = 0;
1722  list arguments,results;
1723  ideal q;
1724  while(!finished)
1725  {
1726    t = rtimer;
1727    for(i=1; i<=n; i++)   // create argument list
1728    {
1729      for(j=1; j<=m; j++)
1730        {arguments[m*(i-1)+j] = list(denom[i][j]);}
1731    }
1732
1733    results = parallelWaitAll("factorize",arguments,timeout);
1734    arguments = list();
1735
1736    for(i=1; i<=n; i++)   // update q, mat, denom
1737    {
1738      for(j=1; j<=m; j++)
1739      {
1740        ind = m*(i-1)+j;
1741        if(typeof(results[ind]) != "none")
1742        {
1743          fact = results[ind];
1744          for(k=2; k<=size(fact[1]); k++)
1745          {
1746            lcoeff = leadcoef(fact[1][k]);
1747            fact[1][k] = fact[1][k]/lcoeff;
1748            fact[1][1] = fact[1][1]*(lcoeff^fact[2][k]); // polynomial is monic (thus unique)
1749            lcoeff = content(fact[1][k]);
1750            fact[1][k] = fact[1][k]/lcoeff;
1751            fact[1][1] = fact[1][1]*(lcoeff^fact[2][k]); // polynomial has nice coefficients
1752
1753            // add a new factor to q:
1754            ind = find_entry(q,fact[1][k]);
1755            if(ind==0) {q[size(q)+1] = fact[1][k];}
1756            // complete the factorization of the i,j-th denominator:
1757            ind = find_entry(mat[i][j][2][1],fact[1][k]);
1758            if(ind==0)
1759            {
1760              ind = size(mat[i][j][2][1])+1;
1761              mat[i][j][2][1][ind] = fact[1][k];
1762              mat[i][j][2][2][ind] = fact[2][k];
1763            }
1764            else
1765            {
1766              mat[i][j][2][2][ind] = mat[i][j][2][2][ind] + fact[2][k];
1767            }
1768          }
1769          mat[i][j][1] = mat[i][j][1]/fact[1][1];
1770          denom[i][j] = 1;
1771        }
1772      }
1773    }
1774    results = list();
1775
1776    finished = 1;
1777    counter = n*m;
1778    for(i=1; i<=n; i++) // factorize by any known factors (from q)
1779    {
1780      for(j=1; j<=m; j++)
1781      {
1782        for(k=1; k<=size(q); k++)
1783        {
1784          expon=0;
1785          while(reduce(denom[i][j],q[k])==0)
1786          {
1787            denom[i][j] = denom[i][j]/q[k];
1788            expon++;
1789          }
1790          if(expon>0)
1791          {
1792            ind = size(mat[i][j][2][1])+1;
1793            mat[i][j][2][1][ind] = q[k];
1794            mat[i][j][2][2][ind] = expon;
1795          }
1796        }
1797        if(deg(denom[i][j])==0)
1798        {
1799          mat[i][j][1] = mat[i][j][1]/denom[i][j];
1800          denom[i][j] = poly(1);
1801        }
1802        if(denom[i][j]!=poly(1)) {finished = 0; counter--;}
1803      }
1804    }
1805    timeout = timeout*2;
1806    dbprint(sprintf("  %s out of %s denominators factorized completely (%s ms)",
1807                                                         counter,n*m,rtimer-t));
1808  }
1809  return(mat);
1810}
1811
1812static proc saveResultTXT_indexed(list dec, string filename, list #)
1813{
1814  // expect dec = list(list(dec11, dec12, ...), list(dec21, dec22, ...), ...),
1815  // where dec11, dec12, ... are decompositions of form list(list(poly, intvec, intvec), ...)
1816  system("--ticks-per-sec",1000);
1817  list nonlinFactors = list();
1818  if(size(#)>0) {nonlinFactors = #;}
1819  link file = ":w "+filename+".txt";
1820
1821  int i,j;
1822  int t;
1823  string s="{";
1824  int n=size(dec);
1825  int m=size(dec[1]);
1826  int k;
1827  for(i=1; i<=n; i++)
1828  {
1829    t = rtimer;
1830    s = s+"{";
1831    for(j=1; j<=m; j++)
1832    {
1833      if(size(nonlinFactors)>0)
1834      {
1835        if(size(nonlinFactors[i][j][1])>0)
1836        {
1837          s = s + getStringFraction_indexed(list(poly(1))+nonlinFactors[i][j])
1838                + " * (" + getStringpfd_indexed(dec[i][j]) + "), ";
1839          j++; continue;
1840        }
1841      }
1842      s = s + getStringpfd_indexed(dec[i][j]) + ", ";
1843    }
1844    k = size(s);
1845    s[k-1] = "}"; s[k] = ","; s = s+" ";
1846    dbprint(sprintf("  row %s done! (%s ms)",i,rtimer-t));
1847  }
1848  k = size(s);
1849  s[k-1] = "}"; s[k] = " ";
1850  write(file,s);
1851}
1852
1853static proc saveResultTXT(list dec, ideal q, string filename, list #)
1854{
1855  // expect dec = list(list(dec11, dec12, ...), list(dec21, dec22, ...), ...),
1856  // where dec11, dec12, ... are decompositions of form list(list(poly, intvec, intvec), ...)
1857  system("--ticks-per-sec",1000);
1858  list nonlinFactors = list();
1859  if(size(#)>0) {nonlinFactors = #;}
1860  link file = ":w "+filename+".txt";
1861
1862  int i,j;
1863  int t;
1864  string s="{";
1865  int n=size(dec);
1866  int m=size(dec[1]);
1867  int k;
1868  for(i=1; i<=n; i++)
1869  {
1870    t = rtimer;
1871    s = s+"{";
1872    for(j=1; j<=m; j++)
1873    {
1874      if(size(nonlinFactors)>0)
1875      {
1876        if(size(nonlinFactors[i][j][1])>0)
1877        {
1878          s = s + getStringFraction(list(poly(1))+nonlinFactors[i][j],q)
1879                + " * (" + getStringpfd(list(q,dec[i][j])) + "), ";
1880          j++; continue;
1881        }
1882      }
1883      s = s + getStringpfd(list(q,dec[i][j])) + ", ";
1884    }
1885    k = size(s);
1886    s[k-1] = "}"; s[k] = ","; s = s+" ";
1887    dbprint(sprintf("  row %s done! (%s ms)",i,rtimer-t));
1888  }
1889  k = size(s);
1890  s[k-1] = "}"; s[k] = " ";
1891  write(file,s);
1892}
1893
1894static proc removeNonlinearFactors(list fractions, string filename)
1895{
1896  int n=size(fractions);
1897  int m=size(fractions[1]);
1898  int i,j,k,t0,ind;
1899  ideal p;
1900  list nonlin_denom_factors;
1901  intvec factors,exponents;
1902  list fac;
1903  for(i=1; i<=n; i++)
1904  {
1905    t0 = rtimer;
1906    nonlin_denom_factors[i] = list();
1907    for(j=1; j<=m; j++)
1908    {
1909      fac = fractions[i][j][2];
1910      factors = 0:0;
1911      exponents = 0:0;
1912      for(k=1; k<=size(fac[1]); k++)
1913      {
1914        if(deg(poly(fac[1][k]))>1)
1915        {
1916          // add the nonlin. factor fac[1][k] to p if necessary:
1917          if(size(p)==0) {ind = 1; p[ind]=fac[1][k];}
1918          else
1919          {
1920            for(ind=1;1;ind++)
1921            {
1922              if(p[ind]==fac[1][k]) {break;}
1923              if(ind==size(p))
1924              {
1925                ind++;
1926                p[ind]=fac[1][k];
1927                break;
1928              }
1929            }
1930          }
1931          factors[size(factors)+1] = ind;
1932          exponents[size(exponents)+1] = fac[2][k];
1933          fac[1] = delete(fac[1],k);
1934          fac[2] = delete(fac[2],k);
1935          continue;
1936        }
1937      }
1938      fractions[i][j][2] = fac;
1939      nonlin_denom_factors[i][j] = list(factors,exponents);
1940    }
1941    dbprint(sprintf("  row %s done! (%s ms)", i, rtimer-t0));
1942  }
1943  return(fractions, nonlin_denom_factors, p);
1944}
1945
1946proc checkpfdMat(def input, string output, string qfile, list #)
1947"USAGE:   checkpfdMat(input, output, denomFactors[, N, parallelize]);
1948          input,output,denomFactors string, N,parallelize int
1949PURPOSE:  test the output files of @code{pfdMat} for correctness. Input and
1950          output (indexed) txt-files have to be given as strings in the form
1951          \"@code{<path-to-file>/<filename>.txt}\". The output should be indexed
1952          (that is the output file ending in @code{..._pfd_indexed.txt}) and
1953          @code{denomFactors} has to be the file containing the denominator
1954          factors @code{q1}, @code{q2}, ... (the txt-file ending in
1955          @code{..._denominator_factors.txt}).
1956       @* As for @code{readInputTXT} and @code{pfdMat}, the basering has to
1957          match the variable names used in the input file, which has to be in
1958          the same format specified in @ref{readInputTXT}. Also, files bigger
1959          than 2 GB have to be split as described for @code{readInputTXT} and a
1960          list of filenames can be given as first argument instead.
1961       @* If a positive integer N is given, the test is done probabilistically by
1962          evaluation at N random points for each entry of the matrix. If N is
1963          nonpositive (default), the fractions in the decompositions will be
1964          expanded symbolically and compared to the input (may be slower).
1965       @* If @code{parallelize} is nonzero (default), the tests are run in
1966          parallel using @ref{parallel_lib}.
1967       @* The result is printed and as in @code{pfdMat} a logfile is created
1968          showing the results for each matrix entry.
1969SEE ALSO: readInputTXT, pfd, checkpfd, pfdMat
1970"
1971{
1972  system("--ticks-per-sec",1000);
1973  short = 0;
1974  int t0;
1975  int N=0;
1976  int parallelize=1;
1977  if(size(#)==1)
1978  {
1979    if(typeof(#[1])=="int") {N=#[1];}
1980    else {ERROR("invalid argument type: "+typeof(#[1]));}
1981  }
1982  if(size(#)==2)
1983  {
1984    if(typeof(#[1])=="int" && typeof(#[2])=="int")
1985      {N=#[1]; parallelize=#[2];}
1986    else {ERROR("invalid argument types: "+typeof(#[1])+", "+typeof(#[2]));}
1987  }
1988  if(size(#)>2) {ERROR("too many arguments");}
1989
1990  dbprint(newline+"reading input file:");
1991  printlevel = printlevel+1;
1992  list frac = readInputTXT(input,2);
1993  printlevel = printlevel-1;
1994  if(typeof(input)=="string") {string filename=input;}
1995  if(typeof(input)=="list")   {string filename=input[1];}
1996  filename = filename[1,find(filename,".txt")-1];
1997
1998  dbprint("factorizing the denominators "); t0=rtimer;
1999  printlevel = printlevel+1;
2000  frac = FactDenom(frac);
2001  printlevel = printlevel-1;
2002  dbprint(sprintf("done! (%s ms)",rtimer-t0));
2003
2004  dbprint("reading output files:"); t0=rtimer;
2005  dbprint(" reading list of denominator factors from "+qfile);
2006  ideal q;
2007  q = readQfileTXT(qfile);
2008  dbprint(" done!");
2009
2010  dbprint(" reading (indexed) output decompositions ");
2011  list dec,nonlin;
2012  printlevel = printlevel+1;
2013  dec,nonlin = readOutputTXT(output);
2014  printlevel = printlevel-1;
2015
2016  if(parallelize)
2017    {dbprint(sprintf("done! (%s ms)%n%ncreating tasks",rtimer-t0,0)); t0=rtimer;}
2018  else
2019  {
2020    dbprint(sprintf("done! (%s ms)%n",rtimer-t0,0));
2021    if(N<=0)
2022      {dbprint("checking for correctness (exact test) ");}
2023    else
2024      {dbprint(sprintf("checking for correctness (%s random evaluations per entry) ",N));}
2025    t0=rtimer;
2026  }
2027
2028  fprintf(":w "+filename+"_checkpfdMat_logfile.txt","Input file (matrix of rational functions):"
2029          +" %s%nOutput file (decompositions): %s%nlist of all denominator factors:"
2030          +" %s%n%nResults of checkpfdMat:",input,output,qfile,0);
2031  link logfile = ":a "+filename+"_checkpfdMat_logfile.txt";
2032
2033  int n=size(frac);
2034  int m=size(frac[1]);
2035  int i,j,k,ind;
2036  list arguments;
2037  for(i=1;i<=n;i++)
2038  {
2039    for(j=1;j<=m;j++)
2040    {
2041      for(k=1;k<=size(nonlin[i][j][1]);k++)
2042      {
2043        ind = find_entry(frac[i][j][2][1],q[nonlin[i][j][1][k]]);
2044        if(ind==0) {ERROR("nonlinear factors are wrong");}
2045        if(frac[i][j][2][2][ind]!=nonlin[i][j][2][k])
2046          {ERROR("nonlinear factors are wrong");}
2047        frac[i][j][2][1] = delete(frac[i][j][2][1],ind);
2048        frac[i][j][2][2] = delete(frac[i][j][2][2],ind);
2049      }
2050      if(parallelize)
2051        {arguments[(i-1)*m+j] = list(i,j,frac[i][j],list(q,dec[i][j]),logfile,N);}
2052      else
2053        {results[(i-1)*m+j] = testEntry(i,j,frac[i][j],list(q,dec[i][j]),logfile,N);}
2054    }
2055  }
2056
2057  if(parallelize)
2058  {
2059    dbprint(sprintf("done! (%s ms)%n",rtimer-t0,0));
2060    if(N<=0)
2061      {dbprint("checking for correctness (exact test) ");}
2062    else
2063      {dbprint(sprintf("checking for correctness (%s random evaluations per entry) ",N));}
2064    t0=rtimer;
2065    list results = parallelWaitAll("testEntry",arguments);
2066  }
2067  else {dbprint(sprintf("done! (%s ms)",rtimer-t0));}
2068  dbprint(sprintf("%s out of %s = %sx%s decompositions are correct! (%s ms)%n",
2069          sum(results),n*m,n,m,rtimer-t0,0));
2070  fprintf(logfile,"%s out of %s = %sx%s decompositions are correct! (%s ms)%n",
2071          sum(results),n*m,n,m,rtimer-t0,0);
2072}
2073
2074static proc readOutputTXT(string filename__)
2075{
2076  system("--ticks-per-sec",1000);
2077  dbprint("  reading matrix of decompositions from file "+filename__);
2078  int t__=rtimer;
2079  int tt__;
2080  string data__ = read(":r "+filename__);
2081  dbprint(sprintf("  done! (%s ms)", rtimer-t__));
2082
2083  dbprint("  processing input "); t__ = rtimer;
2084  list mat__;
2085  list nonlin__=list();
2086  int nonlin_factors_seperated__=0;
2087  if(find(data__," * ")>0) {nonlin_factors_seperated__=1;}
2088  int left__,right__=0,0;
2089  left__ = find(data__,"{");
2090  int pos1__,pos2__=0,0;
2091  int p1__,p2__;
2092  int tmp__,tmp2__,depth__;
2093  int i__,j__,k__,l__,max__;
2094  intvec factors__,exponents__;
2095  poly numerator__;
2096  string s__,ss__;
2097  for(i__=1;1;i__++)
2098  {
2099    tt__ = rtimer;
2100    left__ = find(data__,"{",left__+1);
2101    if(left__==0) {break;}
2102    right__ = find(data__,"}",left__);
2103    mat__[i__]=list();
2104    nonlin__[i__]=list();
2105    pos2__=left__;
2106    for(j__=1;pos2__<right__&&pos2__>0;j__++)
2107    {
2108      pos1__ = pos2__+1;
2109      pos2__ = find(data__,",",pos1__);
2110      if(pos2__==0||pos2__>right__) {s__ = data__[pos1__,right__-pos1__];}
2111      else {s__ = data__[pos1__,pos2__-pos1__];}
2112      mat__[i__][j__] = list();
2113
2114      factors__ = intvec(0:0);
2115      exponents__ = intvec(0:0);
2116      l__ = find(s__," * ");
2117      if(l__>0)
2118      {
2119        ss__ = s__[1,l__-1];    //ss__ contains the nonlinear factors
2120        s__ = s__[l__+3,size(s__)-l__-2];
2121        for(p1__=1;s__[p1__]!="(";p1__++) {}
2122        for(p2__=size(s__);s__[p2__]!=")";p2__--) {}
2123        s__ = s__[p1__+1,p2__-p1__-1];
2124        l__ = find(ss__,"q");
2125        ss__ = ss__[l__,find(ss__,")",l__)-l__];
2126        ss__ = ss__+"*";
2127        p1__=0;
2128        for(l__=1;1;l__++)
2129        {
2130          p1__ = find(ss__,"q",p1__+1);
2131          if(p1__==0) {break;}
2132          p1__++;
2133          p2__ = find(ss__,"^",p1__);
2134          tmp__ = find(ss__,"*",p1__);
2135          if((p2__>tmp__ && tmp__>0) || (p2__==0))    //exponent is 1
2136          {
2137            execute("factors__[l__]="+ss__[p1__,tmp__-p1__]);
2138            exponents__[l__] = 1;
2139          }
2140          else
2141          {
2142            execute("factors__[l__]="+ss__[p1__,p2__-p1__]);
2143            execute("exponents__[l__]="+ss__[p2__+1,tmp__-p2__-1]);
2144          }
2145        }
2146      }
2147      nonlin__[i__][j__] = list(factors__,exponents__);
2148
2149      depth__ = 0;
2150      s__=s__+" ";
2151      max__ = size(s__);
2152      tmp__ = 1;
2153      tmp2__ = 0;
2154      for(k__=1;k__<=max__;k__++)
2155      {
2156        if(s__[k__]=="(") {depth__++;k__++;continue;}
2157        if(s__[k__]==")") {depth__--;k__++;continue;}
2158        if(s__[k__]=="/" && depth__==0) {tmp2__ = k__;}
2159        if((s__[k__]=="+" && depth__==0) || k__==max__)
2160        {
2161          if(tmp2__==0)    // no denominator
2162          {
2163            execute("numerator__="+s__[tmp__,k__-tmp__]);
2164            mat__[i__][j__][size(mat__[i__][j__])+1] = list(numerator__,intvec(0:0),intvec(0:0));
2165            tmp__ = k__+1;
2166            k__++; continue;
2167          }
2168          execute("numerator__="+s__[tmp__,tmp2__-tmp__]);
2169          ss__ = s__[tmp2__+1,k__-tmp2__-1];
2170          p1__ = find(ss__,"(");
2171          p2__ = find(ss__,")");
2172          ss__ = ss__[p1__+1,p2__-p1__-1];   // now ss__ is only the denominator
2173
2174          ss__ = ss__+"*";
2175          factors__ = intvec(0:0);
2176          exponents__ = intvec(0:0);
2177          p1__=0;
2178          for(l__=1;1;l__++)
2179          {
2180            p1__ = find(ss__,"q",p1__+1);
2181            if(p1__==0) {break;}
2182            p1__++;
2183            p2__ = find(ss__,"^",p1__);
2184            tmp__ = find(ss__,"*",p1__);
2185            if((p2__>tmp__ && tmp__>0) || (p2__==0))    //exponent is 1
2186            {
2187              execute("factors__[l__]="+ss__[p1__,tmp__-p1__]);
2188              exponents__[l__] = 1;
2189            }
2190            else
2191            {
2192              execute("factors__[l__]="+ss__[p1__,p2__-p1__]);
2193              execute("exponents__[l__]="+ss__[p2__+1,tmp__-p2__-1]);
2194            }
2195          }
2196          mat__[i__][j__][size(mat__[i__][j__])+1] = list(numerator__,factors__,exponents__);
2197          tmp__ = k__+1;
2198          tmp2__ = 0;
2199        }
2200      }
2201    }
2202    dbprint(sprintf("    row %s done! (%s ms)",i__,rtimer-tt__));
2203  }
2204  dbprint(sprintf("  done! (%s ms)", rtimer-t__));
2205
2206  return(mat__,nonlin__);
2207}
2208
2209static proc readQfileTXT(string filename__)
2210{
2211  string data__ = read(":r "+filename__);
2212  ideal q__;
2213  int pos1__,pos2__=1,1;
2214  while(1)
2215  {
2216    pos1__=find(data__,"=",pos2__);
2217    if(pos1__==0) {break;}
2218    pos1__++;
2219    pos2__=find(data__,";",pos1__);
2220    execute("q__[size(q__)+1]="+data__[pos1__,pos2__-pos1__]);
2221  }
2222  return(q__);
2223}
Note: See TracBrowser for help on using the repository browser.