source: git/Singular/LIB/surfex.lib @ ea6e16e

spielwiese
Last change on this file since ea6e16e was ea6e16e, checked in by Sachin <sachinkm308@…>, 4 years ago
replacing execute with create_ring(16)
  • Property mode set to 100644
File size: 47.9 KB
Line 
1////////////////////////////////////////////////////////////////////////////
2version="version surfex.lib 4.1.2.0 Feb_2019 "; // $Id$
3category="Visualization";
4info="
5LIBRARY: surfex.lib      Procedures for visualizing and rotating surfaces.
6AUTHOR: Oliver Labs
7        This library uses the program surf
8        (written by Stefan Endrass and others)
9        and surfex (written by Oliver Labs and others, mainly Stephan Holzer).
10
11NOTE:
12@texinfo
13 It is still an alpha version (see @uref{http://www.AlgebraicSurface.net})@*
14 This library requires the program surfex, surf and java to be installed.
15 The software is used for producing raytraced images of surfaces.
16 You can download @code{surfex} from @uref{http://www.surfex.AlgebraicSurface.net}
17@end texinfo
18
19 surfex is a front-end for surf which aims to be easier to use than
20 the original tool.
21
22SEE ALSO: surf_lib
23
24PROCEDURES:
25plotRotated(poly,coord); Plot the surface given by the polynomial p
26                         with the coordinates coords(list)
27plotRot(poly);           Similar to plotRotated,
28                         but guesses automatically
29                         which coordinates should be used
30plotRotatedList(varieties, coords); Plot the varieties given by the list varieties
31                                    with the coordinates coords
32plotRotatedDirect(varieties);       Plot the varieties given by the list varietiesList
33plotRotatedListFromSpecifyList(varietiesList);  Plot the varieties given by the list varietiesList
34";
35
36LIB "solve.lib";
37LIB "primdec.lib";
38LIB "sing.lib";
39LIB "surf.lib";
40LIB "ring.lib";
41///////////////////////////////////////////////////////////
42//
43// the main procedures:
44//
45
46proc plotRot(poly p, list #)
47"
48USAGE: plotRot(poly p, list #)
49Similar to plotRotated, but guesses automatically which coordinates should be used.
50The optional int parameter can be used to set plotting quality.
51
52It opens the external program surfex for drawing the surface given by p,
53seen as a surface in the real affine space with coordinates coords.
54
55ASSUME: The basering is of characteristic zero and without parameters.
56"
57{
58    list coords = list();
59    if(num_vars_id(p)==3)
60    {
61        execute("coords = "+string_of_vars(p)+";");
62    }
63    else
64    {
65        if(num_vars_id(p)<3)
66        {
67            if(nvars(basering)==3)
68            {
69                execute("coords = "+varstr(basering)+";");
70            }
71            else
72            {
73                if(nvars(basering)<3) {
74                    "Could not guess the coordinates because the number of variables in the basering is smaller than 3!";
75                    "Please use plotRotated() instead of plotRot() and specify the coordinates explicitly.";
76                    return(0);
77                } else {
78                    "Could not guess the coordinates because the number of variables in the polynomial is smaller than 3 and the number of variables in the basering is greater than three!";
79                    "Please use plotRotated() instead of plotRot() and specify the coordinates explicitly.";
80                    return(0);
81                }
82            }
83        } else {
84            "Could not guess the coordinates because the number of variables in the polynomial is greater than 3!";
85                    "Please use plotRotated() instead of plotRot() and specify the coordinates explicitly.";
86            return(0);
87        }
88    }
89    return(plotRotatedList(list(p), coords, #));
90}
91example
92{
93    "Example:"; echo=2;
94
95    // More variables in the basering, but only 3 variables in the polynomial:
96    ring r1 = 0, (w,x,y,z), dp;
97    poly cayley_cubic = x^3+y^3+z^3+1^3-1/4*(x+y+z+1)^3;
98    plotRot(cayley_cubic);
99
100    // Three variables in the basering, but fewer variables in the polynomial:
101    ring r2 = 0, (x,y,z), dp;
102    plotRot(x^2+y^2-1);
103    plotRot(y^2+z^2-1);
104
105    // A cubic surface with a solitary point:
106    // Use the additional parameter 3 to ask singular
107    // to compute the singular locus before calling surfex.
108    ring r3 = 0, (x,y,z), dp;
109    poly kn_10 = x^3-3*x*y^2+z^3+3*x^2+3*y^2+z^2;
110    plotRot(kn_10, 3);
111
112    // The swallowtail:
113    // a surface with a real solitary curve sticking out of the surface.
114    // Use the additional parameter 3 to ask singular
115    // to compute the singular locus before calling surfex.
116    poly swallowtail = -4*y^2*z^3-16*x*z^4+27*y^4+144*x*y^2*z+128*x^2*z^2-256*x^3;
117}
118
119proc plotRotated(poly p, list coords, list #)
120"
121USAGE: plotRotated(poly p, list coords, list #)
122This opens the external program surfex for drawing the surface given by p,
123seen as a surface in the real affine space with coordinates coords.
124The optional int parameter can be used to set plotting quality.
125
126ASSUME: coords is a list of three variables.
127The basering is of characteristic zero and without parameters.
128"
129{
130    return(plotRotatedList(list(p), coords, #));
131}
132example
133{
134    "Example:"; echo=2;
135
136    // An easy example: a surface with four conical nodes.
137    ring r = 0, (x,y,z), dp;
138    poly cayley_cubic = x^3+y^3+z^3+1^3-1/4*(x+y+z+1)^3;
139//     plotRotated(cayley_cubic, list(x,y,z));
140
141    // A difficult example: a surface with a one-dimensional real component!
142    poly whitney_umbrella = x^2*z-y^2;
143    // The Whitney Umbrella without its handle:
144    plotRotated(whitney_umbrella, list(x,y,z));
145
146    // The Whitney Umbrella together with its handle:
147    plotRotated(whitney_umbrella, list(x,y,z), 2);
148}
149
150
151proc plotRotatedList(list varieties, list coords, list #)
152"
153USAGE: plotRotatedList(list varieties, list coords, list #)
154This opens the external program surfex for drawing the surfaces given by varieties,
155seen as a surface in the real affine space with coordinates coords.
156The optional int parameter can be used to set plotting quality.
157
158ASSUME: coords is a list of three variables, varieties is a list of ideals
159describing the varieties to be shown.
160The basering is of characteristic zero and without parameters.
161"
162{
163    def oring = basering;
164
165    int plotquality = 0;
166    if(size(#)>0) {
167        plotquality = #[1];
168    }
169
170    list varietiesList = list(list(), list(), list(), list());
171    list usedSurfaces = list();
172    list curveColors = list();
173
174    // go through the list of varieties
175    // produce a list which can be used as input for plotRotatedListFromList()
176    int i;
177    int j;
178    list indList;
179    int ind;
180    ideal itmp;
181    int ncurves;
182    list pd;
183    int k;
184    int surfind;
185    list curSurfColors = list();
186
187    list listOfPoints = list();
188    string str_I = "";
189
190    for(i=1; i<=size(varieties); i++) {
191        itmp = varieties[i];
192        if(plotquality>=3) {
193            itmp = radical(itmp);
194        }
195        itmp = simplify(itmp,1);
196        itmp = simplify(itmp,2);
197        if(size(itmp)==1) { // i.e.: a surface given by one equation
198            surfind = findInList(surfEqn(itmp[1],coords), usedSurfaces);
199            if(surfind==0) {
200                usedSurfaces = usedSurfaces + list(surfEqn(itmp[1],coords));
201                curSurfColors = list(list("insidecolor:",getInsideColorStr(size(varietiesList[1])+1)),
202                                     list("outsidecolor:",getOutsideColorStr(size(varietiesList[1])+1)));
203                varietiesList[1] = varietiesList[1] +
204                    list(list(list("eqno:",string(size(varietiesList[1])+1)),
205                              list("equation:",surfEqn(itmp[1], coords)),
206                              curSurfColors[1],
207                              curSurfColors[2],
208                              list("showcbox:","true"),
209                              list("transparency:","0")));
210                surfind = size(varietiesList[1]);
211
212            }
213            if(plotquality==1) {
214                varieties = varieties + list(slocus(itmp[1]));
215            }
216            if(plotquality==2 || plotquality==3) {
217                // remove doubled components and
218                // add the 1-dimensional singular components
219                // of the surface to the list of curves:
220                int dsl = dim_slocus(itmp[1]);
221                dsl;
222                if(dsl>=0) { // i.e. there is a singular locus
223                    "compute singular locus...";
224                    list eqd;
225                    //
226                    eqd = equidim(slocus(itmp[1]));
227                    ideal tmp_l;
228                    tmp_l = std(eqd[size(eqd)]);
229                    "dim:",dim(tmp_l);
230                    if(dim(tmp_l)==(nvars(basering)-3+2)) {
231                        "--- 2-dim.";
232                        // we have found a multiple component;
233                        // replace it by a simple copy of it
234                        itmp = quotient(itmp[1], tmp_l);
235                        varieties[i] = itmp[1];
236                        eqd = delete(eqd,size(eqd));
237                        if(size(eqd)>0) {
238                            tmp_l = std(eqd[size(eqd)]);
239                        }
240                    }
241                    if(dim(tmp_l)==(nvars(basering)-3+1)) {
242                        "--- 1-dim.";
243                        // we have found a 1-dimensional singular locus
244                        pd = std_primdecGTZ(tmp_l,2);
245                        for(k=1; k<=size(pd); k++) {
246                            if(pd[k][3]==(nvars(basering)-3+1)) {
247                                varieties = varieties + list(pd[k][2]);
248                                curveColors[size(varieties)] = curSurfColors;
249                            } else {
250                                "???";
251                            }
252                        }
253                        eqd = delete(eqd,size(eqd));
254                        if(size(eqd)>0) {
255                            tmp_l = std(eqd[size(eqd)]);
256                        }
257                    }
258                    if(dim(tmp_l)==(nvars(basering)-3+0)) {
259                        "--- 0-dim.";
260                        // we have found a 0-dimensional singular locus
261                        // we compute floating point approximations of the
262                        // coordinates of all singular points
263                        if(npars(oring)>0) {
264                            "str:",parstr(1),rootminpoly();
265                            list all_real_sols = allroots_minpoly();
266//                            "all sols:";all_real_sols;
267//                            sprintf("number %s = %s; ", parstr(1), rootminpoly());
268                            int minp;
269                            if((npars(basering) == 1) && (minpoly != 0)) {
270                                minp = 1;
271                            } else {
272                                minp = 0;
273                            }
274                            str_I = "";
275                            if(minp==1) {
276                                "minp=1";
277                                string str_para = parstr(1);
278                                string str_tmp_l;
279                                def cur_ring = basering;
280                                if(1) {
281                                    short=0;
282                                    str_tmp_l = "ideal eqd_tmp = "+
283//                                        string(tmp_l)+","+string(minpoly)+";";
284                                        string(tmp_l);
285                                    "str:",str_tmp_l;
286                                    string str_num_mp = "number "+parstr(1)+"="+
287                                        decstr2ratstr(rootminpoly())+";";
288                                    ring Iring = create_ring(0, "("+string(coords)+")", "dp");
289                                    basering;
290                                    execute(str_num_mp);
291                                    execute(str_tmp_l);
292                                    eqd_tmp;
293                                    list real_sols = real_solve(eqd_tmp);
294                                    real_sols;
295                                    $;
296                                    setring cur_ring;
297                                }
298                            } else {
299                                // minp==0: we do not know how to handle this
300                                "???";
301                            }
302                        } else {
303                            "no pars";
304                            ideal eqd_tmp = tmp_l;
305                            short=0;
306                            string str_tmp_l = "ideal eqd_tmp = "+string(tmp_l)+";";
307                            def cur_ring = basering;
308                            ring Iring = create_ring("(real,30)", "("+string(coords)+")", "("+ordstr(oring)+")");
309//                            basering;
310                            execute(str_I);
311                            execute(str_tmp_l);
312                            list real_sols = real_solve(eqd_tmp);
313                            setring cur_ring;
314                        }
315                        "real_sols:";real_sols;
316                        for(k=1; k<=size(real_sols); k++) {
317                            "search point:";
318                             string(list(real_sols[k][1],real_sols[k][2],real_sols[k][3],string(surfind)));
319//                             listOfPoints;
320                            if(findInList(string(list(list(real_sols[k][1],real_sols[k][2],real_sols[k][3],string(surfind)))),
321                                          listOfPoints)==0) {
322                                "add pt";
323                                varietiesList[4] = varietiesList[4] +
324                                    list(list(real_sols[k][1],real_sols[k][2],real_sols[k][3],string(surfind)));
325                                listOfPoints = listOfPoints +
326                                    list(string(list(real_sols[k][1],real_sols[k][2],real_sols[k][3],string(surfind))));
327                            }
328                        }
329                    }
330                }
331            }
332        } else {
333            // i.e.: more than one equation
334            varietiesList[2] = varietiesList[2] +
335                list(list(list("surfaces:"),
336                          list("curveno:",
337                               string(size(varietiesList[2])+1)),
338                          list("showcbox:","true")));
339            if(size(curveColors) >= i) {
340                varietiesList[2][size(varietiesList[2])][4] = curveColors[i][1];
341                varietiesList[2][size(varietiesList[2])][4][1] = "color:";
342            }
343            ncurves = size(varietiesList[2]);
344            for(j=1; j<=size(itmp); j++) {
345                ind = findInList(surfEqn(itmp[j],coords), usedSurfaces);
346                usedSurfaces = usedSurfaces + list(surfEqn(itmp[1],coords));
347//                "indList:";indList;
348                if(ind == 0) {
349//                    "--------> not in list", surfEqn(itmp[j], coords);
350                    if(j==1) {
351                        varietiesList[1] = varietiesList[1] +
352                            list(list(list("eqno:",string(size(varietiesList[1])+1)),
353                                      list("equation:",surfEqn(itmp[j], coords)),
354                                      list("insidecolor:",getInsideColorStr(size(varietiesList[1])+1)),
355                                      list("outsidecolor:",getOutsideColorStr(size(varietiesList[1])+1)),
356                                      list("showcbox:","true"),
357                                      list("transparency:","100")));
358                    } else {
359                        varietiesList[1] = varietiesList[1] +
360                            list(list(list("eqno:",string(size(varietiesList[1])+1)),
361                                      list("equation:",surfEqn(itmp[j], coords)),
362                                      list("insidecolor:",getInsideColorStr(size(varietiesList[1])+1)),
363                                      list("outsidecolor:",getOutsideColorStr(size(varietiesList[1])+1)),
364                                      list("showcbox:","false"),
365                                      list("transparency:","0")));
366                    }
367                    ind = size(varietiesList[1]);
368                } else {
369                }
370                varietiesList[2][ncurves][1] = varietiesList[2][ncurves][1] + list(string(ind));
371            }
372        }
373    }
374
375//      "------------";
376//      varietiesList;
377//      "------------";
378    return(plotRotatedListFromSpecifyList(varietiesList, coords, #));
379}
380example {
381    "Example:"; echo=2;
382
383    // A cubic surface together with a tritangent plane
384    // (i.e. a plane which cuts out three lines).
385    ring r = 0, (x,y,z), dp;
386    poly cayley_cubic = x^3+y^3+z^3+1^3-1/4*(x+y+z+1)^3;
387    poly plane = 1-x-y-z;
388    plotRotatedList(list(cayley_cubic, plane), list(x,y,z));
389
390    // The same cubic and plane.
391    // The plane is not shown but only its intersection with the surface.
392    plotRotatedList(list(cayley_cubic, ideal(cayley_cubic, plane)), list(x,y,z));
393}
394
395
396proc plotRotatedListFromSpecifyList(list varietiesList, list #)
397"
398USAGE: plotRotatedListFromSpecifyList(list varietiesList, list #);
399varietiesList has a complicated format (not documented yet);
400see the example.@*
401The optional int parameter can be used to set plotting quality.
402
403ASSUME: The basering is of characteristic zero.
404
405EXAMPLE: example plotRotatedListFromSpecifyList;
406"
407{
408    // make the surfex file
409    string str = getSurfexCodeFromSpecifyList(varietiesList, #);
410
411    return(plotRotatedFromCode(str, #));
412}
413example
414{
415    "Example:"; echo=2;
416
417    // A cubic surface depending on a parameter:
418    ring r = (0,p1), (x,y,z), dp;
419    poly cayley_cubic = x^3+y^3+z^3+1^3-p1*(x+y+z+1)^3;
420    poly plane = 1-x-y-z;
421    plotRotatedListFromSpecifyList(list(list(list(list("eqno:","1"),
422                                                  list("equation:",
423                                                       string(cayley_cubic))
424                                                 )
425                                            ),
426                                        list(),
427                                        list(list(1,"0.0","1.0","500","0.25+0.25*sin(PI*p1)")),
428                                        list()
429                                       ));
430}
431
432
433proc plotRotatedListFromStringList(list varieties, list #)
434"
435RETURN: the return code of the system command which executes surfex.
436
437USAGE: not documented yet.
438"
439{
440    // make the surfex file
441    getSurfexCodeFromStringList(varieties, #);
442    string str = getSurfexCodeFromStringList(varieties, #);
443
444    return(plotRotatedFromCode(str, #));
445}
446
447
448proc plotRotatedDirect(list varieties, list #)
449"
450USAGE: plotRotatedDirect(list varieties, list #)
451This opens the external program surfex for drawing the surfaces given by varieties,
452seen as a surface in the real affine space with coordinates x,y,z.
453The format for the list varieties is not fully documented yet;
454please, see the examples below and try to adjust the examples to suit your needs.@*
455The optional int parameter can be used to set plotting quality.
456
457ASSUME:
458Passes the equations directly to surfex, i.e., the variable names should
459be x,y,z.
460The advantage is that one can use parameters p1, p2, ...;
461these will be passed to surfex.
462"
463{
464    string str = getSurfexCodeFromListDirect(varieties, #);
465
466    return(plotRotatedFromCode(str, #));
467}
468example
469{
470    "Example:"; echo=2;
471
472    // A cubic surface depending on a parameter:
473    ring r = (0,p1), (x,y,z), dp;
474    poly cayley_cubic = x^3+y^3+z^3+1^3-p1*(x+y+z+1)^3;
475    // The entries of the list of varieties can either be polynomials
476    plotRotatedDirect(list(list(list(cayley_cubic)),
477                           list(),
478                           list(list(1,"0.0","1.0","500","0.25+0.25*sin(PI*p1)"))
479                           ));
480
481    // or strings which represent surfex-readable polynomials
482    plotRotatedDirect(list(list(list("x^3+y^3+z^3+1^3-p1*(x+y+z+1)^3")),
483                           list(),
484                           list(list("1","0.0","1.0","500","0.25+0.25*sin(PI*p1)"))
485                           ));
486
487    // More complicated varieties
488    plotRotatedDirect(list(list(list("x^2+y^2-z^2-3^2"),
489                                list("x*sin(p1)+y*cos(p1)-3")),
490                           list(list(list(1,2))),
491                           list(list("1","0.0","1.0","500","2*PI*p1"))
492                           ));
493}
494
495proc plotRotatedFromCode(string str, list #)
496"
497USAGE: plotRotatedFromCode(string str, list #);
498
499This procedure is only for internal usage;
500it takes the surfex-code as a string and calls surfex.
501
502"
503{
504     // we need a temporary .sux file for surfex
505    string tmpd = "/tmp";
506    string l="surf"+string(system("pid"))+".sux";
507    // a temporary file which stores the output of surfex
508    string erg="/tmp/surferg"+string(system("pid"));
509
510    write(":w "+tmpd+"/"+l, str);
511
512    string surfex_path=system("Singular");
513    while(surfex_path[size(surfex_path)]!="/") { surfex_path=surfex_path[1..size(surfex_path)-1]; }
514    surfex_path=surfex_path+"../LIB/surfex";
515    if (status(surfex_path,"exists")=="no")
516    {
517    // search in SINGULAR_PATH:
518       string surfex_path1=system("SingularLib");
519       string surfex_path2=surfex_path1;
520       while (find(surfex_path1,":")!=0)
521       {
522         surfex_path2=surfex_path1[1..find(surfex_path1,":")-1];
523         while(surfex_path2[size(surfex_path2)]==" ") {
524           surfex_path2 = surfex_path2[1..(size(surfex_path2)-1)];
525         }
526
527         if (status(surfex_path2+"/surfex","exists")=="yes") break;
528         surfex_path1=surfex_path1[find(surfex_path1,":")+1,size(surfex_path1)];
529         surfex_path2=surfex_path1[1..(size(surfex_path1)-1)];
530         while(surfex_path2[size(surfex_path2)]==" ") {
531           surfex_path2 = surfex_path2[1..(size(surfex_path2)-1)];
532         }
533       }
534       surfex_path=surfex_path2+"/surfex";
535    }
536
537     int i=system("sh","surfex \""+surfex_path+"\" -d "+tmpd+" -i " + l +" >"+erg+" 2>/dev/null");
538
539    // delete the temporary file
540    i = system("sh","rm " + l +" 2>/dev/null");
541    return(read(erg));
542}
543
544
545///////////////////////////////////////////////////////////
546//
547// procedures used to produce the surf-code:
548//
549
550
551proc getSurfexCodeFromListDirect(list varieties, list #)
552"
553USAGE: getSurfexCodeFromListDirect(list varieties, list #)
554
555ASSUME: varieties has four components,
556        - the first is a list of polynomials, say f_1, ..., f_k
557        - the second is a list of lists of numbers in {1, ..., k} describing the curves
558          as intersections of the corresponding f_i
559        - the third is a list of lists describing the parameters used in the polynomials f_i
560        - the fourth is a list of lists of points given by their approximate coordinates (three decimal numbers)
561
562RETURN: the surfex code (.sux)
563"
564{
565    int i;
566    int j;
567    string str = "this is surfex v0.89.07"+newline;
568
569    str = str + "TYPE:" + newline;
570    str = str + "specify"+newline;
571    str = str + "EQUATIONS:"+newline;
572    str = str + string(size(varieties[1])) + newline;
573    for(i=1; i<=size(varieties[1]); i++) {
574        str = str + "Equation:"+newline;
575        str = str + "eqno:"+newline;
576        str = str + string(i) + newline;
577        str = str + "equation:"+newline;
578        str = str + surfEqnDir(varieties[1][i][1]) + newline;
579        if(size(varieties[1][i])>=2) {
580            str = str + "showcbox:"+newline;
581            str = str + varieties[1][i][2] + newline;     // show it or not
582            if(size(varieties[1][i])>=3) {
583                str = str + "transparency:"+newline;
584                str = str + string(varieties[1][i][3]) + newline;     // transparency
585            }
586        }
587    }
588    str = str + "CURVES:"+newline;
589    str = str + string(size(varieties[2])) + newline;
590    for(i=1; i<=size(varieties[2]); i++) {
591        str = str + "Curve:"+newline;
592        str = str + "curveno:"+newline;
593        str = str + string(i) + newline;
594        str = str + "surfaces:"+newline;
595//        "curves:";varieties[2][i];
596        for(j=1; j<=size(varieties[2][i][1]); j++) {
597            str = str + string(varieties[2][i][1][j]) + newline;
598        }
599        if(size(varieties[2][i])>=2) {
600            str = str + "showcbox:"+newline;
601            str = str + varieties[2][i][2] + newline;     // show it or not
602        }
603    }
604    str = str + "PARAMETERS:"+newline;
605    str = str + string(size(varieties[3])) + newline;
606    for(i=1; i<=size(varieties[3]); i++) {
607        str = str + "Parameter:"+newline;
608        str = str + "parno:"+newline;
609        str = str + string(varieties[3][i][1]) + newline;
610        str = str + "fromtoval:"+newline;
611        str = str + varieties[3][i][2] + newline;
612        str = str + varieties[3][i][3] + newline;
613        str = str + string(varieties[3][i][4]) + newline;
614        if(size(varieties[3][i])>=5) {
615            str = str + "function:"+newline;
616            str = str + varieties[3][i][5]+newline;
617        }
618    }
619//     str = str + "////////////////// Parameter: /////////////////////////"+newline;
620//     str = str + "1" + newline;
621//     str = str + "0.0" + newline;
622//     str = str + "1.0" + newline;
623//     str = str + "1000" + newline;
624//    str = str + string(size(varieties[3])) + newline;
625    return(str);
626}
627
628proc getSurfexCodeFromList(list varieties, list coords, list #)
629"
630ASSUME: varieties has four components,
631        - the first is a list of polynomials, say f_1, ..., f_k
632        - the second is a list of lists of numbers in {1, ..., k} describing the curves
633          as intersections of the corresponding f_i
634        - the third is a list of lists describing the parameters used in the polynomials f_i
635        - the fourth is a list of lists of points given by their approximate coordinates (three decimal numbers)
636
637RETURN: the surfex code (.sux)
638"
639{
640    int i;
641    int j;
642    string str = "this is surfex v0.89.07"+newline;
643
644    str = str + "TYPE:" + newline;
645    str = str + "specify"+newline;
646    str = str + "EQUATIONS:"+newline;
647    str = str + string(size(varieties[1])) + newline;
648    for(i=1; i<=size(varieties[1]); i++) {
649        str = str + "Equation:"+newline;
650        str = str + "eqno:"+newline;
651        str = str + string(i) + newline;
652        str = str + "equation:"+newline;
653        str = str + surfEqn(varieties[1][i][1], coords) + newline;
654        str = str + "showcbox:"+newline;
655        str = str + varieties[1][i][2] + newline;     // show it or not
656        str = str + "transparency:"+newline;
657        str = str + string(varieties[1][i][3]) + newline;     // transparency
658    }
659    str = str + "CURVES:"+newline;
660    str = str + string(size(varieties[2])) + newline;
661    for(i=1; i<=size(varieties[2]); i++) {
662        str = str + "Curve:"+newline;
663        str = str + "curveno:"+newline;
664        str = str + string(i) + newline;
665        str = str + "surfaces:"+newline;
666        for(j=1; j<=size(varieties[2][i]); j++) {
667            str = str + string(varieties[2][i][1][j]) + newline;
668        }
669        str = str + "showcbox:"+newline;
670        str = str + varieties[2][i][2] + newline;     // show it or not
671    }
672    str = str + "PARAMETERS:"+newline;
673    str = str + string(size(varieties[3])) + newline;
674    for(i=1; i<=size(varieties[3]); i++) {
675        str = str + "Parameter:"+newline;
676        str = str + "parno:"+newline;
677        str = str + string(varieties[3][i][1]) + newline;
678        str = str + "fromtoval:"+newline;
679        str = str + surfEqn(varieties[3][i][2], coords) + newline;
680        str = str + surfEqn(varieties[3][i][3], coords) + newline;
681        str = str + string(varieties[3][i][4]) + newline;
682        if(size(varieties[3][i])>=5) {
683            str = str + "function:"+newline;
684            str = str + varieties[3][i][5]+newline;
685        }
686    }
687//     str = str + "////////////////// Parameter: /////////////////////////"+newline;
688//     str = str + "1" + newline;
689//     str = str + "0.0" + newline;
690//     str = str + "1.0" + newline;
691//     str = str + "1000" + newline;
692//    str = str + string(size(varieties[3])) + newline;
693    return(str);
694}
695
696proc getSurfexCodeFromStringList(list varieties, list #)
697"
698ASSUME: varieties has three components,
699        - the first is a list of polynomials, say f_1, ..., f_k
700        - the second is a list of lists of numbers in {1, ..., k} describing the curves
701          as intersections of the corresponding f_i
702        - the third is a list of lists describing the parameters used in the polynomials f_i
703
704RETURN: the surfex code (.sux)
705"
706{
707    int i;
708    int j;
709    string str = "this is surfex v0.89.07"+newline;
710
711    str = str + "TYPE:" + newline;
712    str = str + "specify"+newline;
713    str = str + "EQUATIONS:"+newline;
714    str = str + string(size(varieties[1])) + newline;
715    for(i=1; i<=size(varieties[1]); i++) {
716        str = str + "Equation:"+newline;
717        str = str + "eqno:"+newline;
718        str = str + string(i) + newline;
719        str = str + "equation:"+newline;
720        str = str + varieties[1][i][1] + newline;
721        str = str + "showcbox:"+newline;
722        str = str + varieties[1][i][2] + newline;     // show it or not
723        str = str + "transparency:"+newline;
724        str = str + varieties[1][i][3] + newline;     // transparency
725    }
726    str = str + "CURVES:"+newline;
727    str = str + string(size(varieties[2])) + newline;
728    for(i=1; i<=size(varieties[2]); i++) {
729        str = str + "Curve:"+newline;
730        str = str + "curveno:"+newline;
731        str = str + string(i) + newline;
732        str = str + "surfaces:"+newline;
733        for(j=1; j<=size(varieties[2][i][1]); j++) {
734            str = str + string(varieties[2][i][1][j]) + newline;
735        }
736        str = str + "showcbox:"+newline;
737        str = str + varieties[2][i][2] + newline;     // show it or not
738    }
739    str = str + "PARAMETERS:"+newline;
740    str = str + string(size(varieties[3])) + newline;
741    for(i=1; i<=size(varieties[3]); i++) {
742        str = str + "Parameter:"+newline;
743        str = str + "parno:"+newline;
744        str = str + string(varieties[3][i][1]) + newline;
745        str = str + "fromtoval:"+newline;
746        str = str + varieties[3][i][2] + newline;
747        str = str + varieties[3][i][3] + newline;
748        str = str + string(varieties[3][i][4]) + newline;
749        if(size(varieties[3][i])>=5) {
750            str = str + "function:"+newline;
751            str = str + varieties[3][i][5]+newline;
752        }
753    }
754    return(str);
755}
756
757
758proc getSurfexCodeFromSpecifyList(list varieties, list #)
759"
760ASSUME: varieties has three components,
761        - the first is a list of polynomials, say f_1, ..., f_k
762        - the second is a list of lists of numbers in {1, ..., k} describing the curves
763          as intersections of the corresponding f_i
764        - the third is a list of lists describing the parameters used in the polynomials f_i
765        - the fourth is a list of lists describing the singular points to be shown as spheres
766
767RETURN: the surfex code (.sux)
768"
769{
770    int i;
771    int j;
772    int k;
773    string str = "this is surfex v0.89.07"+newline;
774
775    str = str + "TYPE:" + newline;
776    str = str + "specify"+newline;
777    str = str + "EQUATIONS:"+newline;
778    str = str + string(size(varieties[1])) + newline;
779    for(i=1; i<=size(varieties[1]); i++) {
780        str = str + "Equation:"+newline;
781        for(j=1; j<=size(varieties[1][i]); j++) {
782            str = str + varieties[1][i][j][1] +newline;
783            str = str + varieties[1][i][j][2] +newline;
784        }
785    }
786    str = str + "CURVES:"+newline;
787    str = str + string(size(varieties[2])) + newline;
788    for(i=1; i<=size(varieties[2]); i++) {
789        str = str + "Curve:"+newline;
790        for(j=1; j<=size(varieties[2][i]); j++) {
791            str = str + varieties[2][i][j][1] +newline;
792            if(varieties[2][i][j][1] == "surfaces:") {
793                for(k=2; k<=size(varieties[2][i][j]); k++) {
794                    str = str + string(varieties[2][i][j][k]) + newline;
795                }
796            } else {
797                str = str + varieties[2][i][j][2] +newline;
798            }
799        }
800//         str = str + "curveno:"+newline;
801//         str = str + string(i) + newline;
802//         str = str + "surfaces:"+newline;
803//         for(j=1; j<=size(varieties[2][i][1]); j++) {
804//             str = str + string(varieties[2][i][1][j]) + newline;
805//         }
806//         str = str + "showcbox:"+newline;
807//         str = str + varieties[2][i][2] + newline;     // show it or not
808    }
809    str = str + "PARAMETERS:"+newline;
810    str = str + string(size(varieties[3])) + newline;
811    for(i=1; i<=size(varieties[3]); i++) {
812        str = str + "Parameter:"+newline;
813        str = str + "parno:"+newline;
814        str = str + string(varieties[3][i][1]) + newline;
815        str = str + "fromtoval:"+newline;
816        str = str + varieties[3][i][2] + newline;
817        str = str + varieties[3][i][3] + newline;
818        str = str + string(varieties[3][i][4]) + newline;
819        if(size(varieties[3][i])>=5) {
820            str = str + "function:"+newline;
821            str = str + varieties[3][i][5]+newline;
822        }
823    }
824    string str_from = "0.0";
825    string str_to = "5.0";
826    string str_radius = "50";
827    str = str + "SOLITARY POINTS:"+newline;
828    str = str + string(size(varieties[4])) + newline;
829    for(i=1; i<=size(varieties[4]); i++) {
830        str = str + "SolitaryPoint:"+newline;
831        str = str + "solPtNo:"+newline;
832        str = str + string(i) + newline;
833        str = str + "surface:"+newline;
834        str = str + varieties[4][i][4] + newline;
835        str = str + "fromtoval:"+newline;
836        str = str + str_from + newline;
837        str = str + str_to + newline;
838        str = str + str_radius + newline;
839        str = str + "coords:" + newline;
840        str = str + varieties[4][i][1] + newline;
841        str = str + varieties[4][i][2] + newline;
842        str = str + varieties[4][i][3] + newline;
843    }
844    return(str);
845}
846
847///////////////////////////////////////////////////////////
848//
849// procedures for standard colors:
850//
851
852proc numBaseColors()
853"
854USAGE: numBaseColors()
855
856RETURN: the number of predefined surface colors.
857"
858{
859    return(6);
860}
861
862proc baseSurfaceColors(int no)
863"
864USAGE: baseSurfaceColors(int no)
865
866REMARK: There are currently 6=numBaseColors() basic surface colors.
867You can modify them according to your wishes
868by just redefining this procedure in your Singular-script.
869
870If you want more colors, then you also have to redefine numBaseColors() accordingly.
871
872RETURN: a list of three integers describing the RGB values of a color.
873"
874{
875    if(no%numBaseColors()==1) {
876        return(list(240,160,0));
877    }
878    if(no%numBaseColors()==2) {
879        return(list(160,240,0));
880    }
881    if(no%numBaseColors()==3) {
882        return(list(0,160,240));
883    }
884    if(no%numBaseColors()==4) {
885        return(list(240,0,160));
886    }
887    if(no%numBaseColors()==5) {
888        return(list(0,240,160));
889    }
890    if(no%numBaseColors()==0) {
891        return(list(160,0,240));
892    }
893}
894
895proc getInsideColorStr(int no)
896"
897USAGE: getInsideColorStr(int no)
898
899RETURN: a string describing inside color number no
900where the three integer RGB values are in one line each.
901"
902{
903    list bc = baseSurfaceColors(no);
904    string str = string(bc[1])+newline+string(bc[2])+newline+string(bc[3]);
905    return(str);
906}
907
908proc getOutsideColorStr(int no)
909"
910USAGE: getOutsideColorStr(int no)
911
912RETURN: a string describing outside color number no
913where the three integer RGB values are in one line each.
914"
915{
916    list bc = baseSurfaceColors(no);
917    string str = string(bc[1])+newline+string(bc[2])+newline+string(bc[3]);
918    return(str);
919}
920
921///////////////////////////////////////////////////////////
922//
923// procedures used by the plot procedures:
924//
925
926proc surfEqnDir(list #)
927"
928USAGE: surfEqnDir(list #) without any checks etc.
929
930RETURN: string(#[1]) where short=0.
931"
932{
933    int stmp = short; short = 0;
934    string str = string(#[1]);
935    short = stmp;
936    return(str);
937}
938
939proc surfEqn(poly p, list coords, list #)
940"
941USAGE: surfEqn(poly p, list coords)
942       Tries to produce a string for the equation of p which is convenient for surfex.
943ASSUME: - p defines a plane curve or a surface,
944         - coords is a list of the three coordinates to use, e.g. list(x,y,z),
945           in this way, it is possible to distinguish between x^2+y^2-1 and y^2+z^2-1
946RETURN: a string, that one can use with the external program surf
947EXAMPLE: example surfEqn; shows an example
948"
949{
950    int params=0;
951    if(size(#)>0) {
952        params = #[1];
953    }
954    string err_mes; // string containing error messages
955    def base=basering;
956    int mynvars = nvars(basering);
957
958    intvec ind=Surf::num_of_vars(p);
959
960    int i,j,n;
961    int minp = 0;
962    n=0;
963    for(i=size(ind);i>0;i--)
964    {
965          if (ind[i]!=0) {
966            n++;
967        } else {
968            if(var(i)==coords[1] || var(i)==coords[2] || var(i)==coords[3]) {
969                ind[i]=1;
970                n++;
971            }
972        }
973    }
974
975    params = params + npars(basering);
976    n = n + npars(basering);
977    if((npars(basering) == 1) && (minpoly != 0)) {
978        minp = 1;
979    } else {
980        minp = 0;
981    }
982    string str_I = "";
983    for(i=1; i<=npars(basering); i=i+1) {
984        if(!(parstr(i) == "i")) {
985            if(minp==1) {
986                str_I = str_I + sprintf("number %s = %s; ", parstr(i), rootminpoly());
987            } else {
988            }
989        }
990    }
991    int bshort = short; short = 0;
992    if(!(minp==1 || npars(basering)==0)) {
993        p=cleardenom(p);
994        err_mes="Cannot plot equations with a parameter without a specified minpoly";
995        ERROR(err_mes);
996    }
997    str_I = str_I + "poly p = " + string(p) + ";";
998
999    short = bshort;
1000
1001    if(params==0) {
1002        if (n<=2 or n>=4)
1003        {
1004            err_mes="Cannot plot equations with "+string(n)+" variables";
1005            ERROR(err_mes);
1006//            return("0");
1007        }
1008        if(n==4) {
1009            ring r=(real,30,30),(xx,yy,zz,ww),dp;
1010        } else {
1011            ring r=(real,30,30),(x,y,z),dp;
1012        }
1013    } else {
1014        if(n-params<=2 || n-params>=4) {
1015            err_mes="Cannot plot equations with "+string(n-params)+" variables";
1016            ERROR(err_mes);
1017//            return("0");
1018        } else {
1019            if(params == 1) {
1020                if(n-params==3) {
1021                    if(minp==1) {
1022                        // switch to a ring without minimal polynomial:
1023                        ring rr = create_ring("(real,30,30)", "("+varstr(base)+")", "dp");
1024//                        rr;
1025//                        "str_I",str_I;
1026                        execute(str_I);
1027                        def base = rr;
1028                        ring r=(real,30,30),(x,y,z),dp;
1029                    } else {
1030                        p=cleardenom(p);
1031                        ring r=(real,30,30),(x,y,z,p1),dp;
1032                    }
1033                }
1034            }
1035            if(params == 2) {
1036                if(n-params==3) {
1037                    p=cleardenom(p);
1038                    ring r=(real,30,30),(x,y,z,p1,p2),dp;
1039                }
1040            }
1041            if(params == 3) {
1042                if(n-params==3) {
1043                    p=cleardenom(p);
1044                    ring rr = create_ring("(real,30,30)", "("+varstr(base)+","+parstr(base)+")", "dp");
1045                    rr;
1046                    "str_I",str_I;
1047                    execute(str_I);
1048                    "pnew:",p;
1049                    def base = rr;
1050
1051                    ring r=(real,30,30),(x,y,z,p1,p2,p3),dp;
1052                }
1053            }
1054        }
1055    }
1056//    basering;
1057    short=0;
1058    map phi=base,0;
1059    j=1;
1060
1061    for(i=1;i<=mynvars;i++)
1062    {
1063        if (ind[i]!=0)
1064        {
1065            phi[i]=var(j);
1066            j++;
1067        }
1068    }
1069    poly p=(simplify(phi(p),1));
1070    if (leadcoef(p) <0) {
1071        if(size(#)>1) {
1072            if(#[2]!=0) {
1073                p=-p;
1074            }
1075        } else {
1076            p=-p;
1077        }
1078    }
1079    if(leadcoef(p)!=0) {
1080        p = p/leadcoef(p);
1081    }
1082    string thesurfstr = string(p);
1083    if(minp == 1) {
1084        // replace k by rootRepl
1085    }
1086
1087    return (thesurfstr);
1088} // end of surfEqn()
1089example
1090{ "EXAMPLE:"; echo =2;
1091
1092  ring rr0 = 0,(x(1..3)),dp;
1093  poly p = x(1)^3 - x(2)^2;
1094  print(surfEqn(p,list(x(1),x(2),x(3))));
1095
1096  ring rr1 = 0,(x,y,z),dp;
1097  poly I(1) = 2x2-1/2x3 +1-y+1;
1098  print(surfEqn(I(1),list(x,y,z)));
1099
1100  // Steiner surface
1101  poly J(2) = x^2*y^2+x^2*z^2+y^2*z^2-17*x*y*z;
1102  print(surfEqn(J(2),list(x,y,z)));
1103} // end of example surfEqn()
1104
1105
1106proc num_vars_id(ideal I)
1107"
1108USAGE: num_vars_id(ideal I)
1109
1110RETURN: The number of ring-variables occurring in the ideal I.
1111"
1112{
1113    intvec v = Surf::num_of_vars(I);
1114    int num = 0;
1115    for(int i=size(v);i>0;i--)
1116    {
1117        if (v[i]!=0) { num++; }
1118    }
1119    return(num);
1120}
1121example {
1122    "EXAMPLE:"; echo = 2;
1123    ring r = 0, (x,y,z),dp;
1124    ideal j = x^2-y, x^3-2;
1125    num_vars_id(j);
1126}
1127
1128proc findInList(list obj, list l)
1129"
1130USAGE: findInList(list obj, list l)
1131       Tries to find the object obj in the list l.
1132
1133ASSUME: the object obj[1] can be compared to the objects in the list l
1134
1135RETURN: if obj[1]=l[i] for some i, then return the first such i,
1136        otherwise return 0
1137"
1138{
1139    for(int i=1; i<=size(l); i++) {
1140        if(l[i]==obj[1]) {
1141            return(i);
1142        }
1143    }
1144
1145    return(0);
1146}
1147example {
1148    "EXAMPLE:"; echo = 2;
1149    ring r = 0,(x,y,z), dp;
1150    list a = list(x^2+y^2+z^2+1, x^2+y^2+z^2-1, x^2+y^2-z^2+1, x^2+y^2-z^2-1);
1151    findInList(x^2+y^2+z^2-1, a);
1152    findInList(x^2+y^2+z^2, a);
1153}
1154
1155proc std_primdecGTZ(ideal I, list #)
1156"
1157USAGE: std_primdecGTZ(ideal I, list #)
1158Computes a primdary decomposition pd of I using primdecGTZ and then
1159calls std_for_pd(pd).
1160For the output and options, consult the help of std_for_pd.
1161
1162RETURN: see std_for_pd.
1163"
1164{
1165    list pd = primdecGTZ(I);
1166    return(std_for_pd(pd, #));
1167}
1168example {
1169    "EXAMPLE:"; echo = 2;
1170
1171    ring r = 0, (x,y), dp;
1172    ideal j = y-x^2,z-x^3;
1173    primdecGTZ(j);
1174    std_primdecGTZ(j);
1175    std_primdecGTZ(j,1);
1176}
1177
1178proc std_for_pd(list pd, list #)
1179"
1180USAGE: std_for_pd(list pd, list #)
1181Call std for each of the prime ideals in the list pd
1182replace the prime ideals by their standard-basis.
1183Compute dim() and mult() of each prime component using these standard bases.
1184If an additional argument is given then do the same for the primary components.
1185
1186ASSUME:
1187pd is in the format produced by primdecGTZ() or primdecSY().
1188
1189RETURN: A list, say l, of lists, similar to a list returned by primdecSY() or primdecGTZ().
1190However, each of the entries of l (which is a list l[i]) contains some additional entries:
1191l[1]: the primary ideal
1192l[2]: a standard basis of the associated prime ideal
1193l[3]: dim() of this prime ideal
1194l[4]: mult() of this prime ideal
1195
1196If an additional argument # is given then l[1] changes:
1197l[1]: a standard basis of the primary ideal
1198Morever, there are some more entries:
1199l[5]: dim() of this primary ideal
1200l[6]: mult() of this primary ideal
1201l[7]: l[6] / l[5]
1202"
1203{
1204
1205    if(typeof(pd[1])=="ideal") {
1206        // this is a Singular bug!?
1207//        "bug!";pd;"---";
1208        pd = list(list(pd[1], pd[1]));
1209//        pd;$;
1210    }
1211    list pd_neu;
1212    int i;
1213    list coords;
1214    ideal stdtmp;
1215    ideal stdtmp2;
1216    for(i=1; i<=size(pd); i++) {
1217        stdtmp = std(pd[i][2]);
1218        stdtmp2 = pd[i][1];
1219        if(size(#)>0) {
1220            stdtmp2 = std(stdtmp2);
1221            if(mult(stdtmp)==0) {
1222                pd_neu[i] = list(stdtmp2,
1223                                 stdtmp,
1224                                 dim(stdtmp), mult(stdtmp),
1225                                 dim(stdtmp2), mult(stdtmp2),
1226                                 0);
1227            } else {
1228                pd_neu[i] = list(stdtmp2,
1229                                 stdtmp,
1230                                 dim(stdtmp), mult(stdtmp),
1231                                 dim(stdtmp2), mult(stdtmp2),
1232                                 mult(stdtmp2) div mult(stdtmp));
1233            }
1234        } else {
1235            pd_neu[i] = list(stdtmp2,
1236                             stdtmp,
1237                             dim(stdtmp), mult(stdtmp));
1238        }
1239    }
1240    return(pd_neu);
1241}
1242example {
1243    "EXAMPLE:"; echo = 2;
1244
1245    ring r = 0, (x,y,z), dp;
1246    ideal j = y-x^2,z-x^3;
1247    list pd = primdecGTZ(j);
1248    pd;
1249    std_for_pd(pd, 1);
1250}
1251
1252proc real_solve(ideal to_solve)
1253"
1254USAGE: real_solve(ideal to_solve)
1255
1256RETURN: a list of all real solutions (as strings)
1257of the zero-dimensional ideal to_solve (without multiplicities).
1258
1259REMARK: Until now, it may happen that some points appear more than once.
1260"
1261{
1262    int k;
1263    int i;
1264
1265//    def Isolring = solve(to_solve,30,0,60,"nodisplay");
1266    def Isolring = solve(to_solve,9,0,13,"nodisplay");
1267    setring Isolring;
1268//    list SOL = solve(to_solve, "oldring", "nodisplay");
1269    list real_sols = list();
1270    list tmpl;
1271    for(k=1; k<=size(SOL); k++) {
1272        if(find(string(SOL[k]),"I")==0 && find(string(SOL[k]),"i")==0) {
1273            tmpl = list();
1274            for(i=1; i<=size(SOL[k]); i++) {
1275                tmpl = tmpl + list(string(SOL[k][i]));
1276            }
1277            real_sols = real_sols + list(tmpl);
1278        }
1279    }
1280    return(real_sols);
1281}
1282example {
1283    "EXAMPLE:"; echo = 2;
1284    ring r = 0, (x,y), dp;
1285    number a = 2;
1286    number b = 3;
1287    ideal j = (x^2-a),(y^3-b);
1288    real_solve(j);
1289}
1290
1291proc rootminpoly(list #)
1292"
1293USAGE: rootminpoly(list #)
1294
1295RETURN: A root of the current minpoly
1296as a string representation of a complex number with
1297the given precision #[1] (default: 30).
1298E.g. ring r=(0,s),x,dp; minpoly = s^2-2; => rootminpoly() 1.41421356237309504880168872421
1299
1300ASSUME: The current minpoly is non-zero.
1301"
1302{
1303    int prec = 30;
1304    int k, done;
1305    if(size(#)>0) {
1306        prec = #[1];
1307    }
1308    short = 0;
1309    string str_lag = sprintf("list lag = laguerre_solve(%s);", minpoly);
1310    ring r_sqrt = create_ring("(complex,prec,I)", "(" + parstr(basering) +")", "lp");
1311    execute(str_lag);
1312//    lag;
1313    // choose a real solution, if it exists:
1314    done = 0;
1315    for(k=1; k<=size(lag) && done==0; k++) {
1316        if(find(string(lag[k]),"I")==0) {
1317            done = k;
1318        }
1319    }
1320    if(done==0) {
1321//        "no real solution.";
1322    }
1323
1324    if(size(lag)>2) {
1325        // return the first real solution
1326        return(sprintf("%s",lag[done]));
1327    }
1328
1329    if(sprintf("%s",lag[1])[1] == "-") {
1330        return(sprintf("%s",lag[2]));
1331    } else {
1332        if(sprintf("%s",lag[1])[1] == "(") {
1333            if(sprintf("%s",lag[1])[2] == "-") {
1334                return(sprintf("%s",lag[2]));
1335            } else {
1336                return(sprintf("%s",lag[1]));
1337            }
1338        } else {
1339            return(sprintf("%s",lag[1]));
1340        }
1341    }
1342    short = 1;
1343}
1344example
1345{
1346   "EXAMPLE:"; echo =2;
1347   ring r=(0,s),x,dp;
1348   minpoly = s^2-2;
1349   rootminpoly();
1350
1351   ring R=(0,s),x,dp;
1352   minpoly = s^2+2;
1353   rootminpoly();
1354}
1355
1356proc allroots_minpoly(list #)
1357"
1358USAGE: allroots_minpoly(list #)
1359
1360RETURN: a list of strings containing all real roots of the minimal polynomial of the active ring.
1361
1362ASSUME: The current minpoly is non-zero.
1363"
1364{
1365    int prec = 30;
1366    int k, done;
1367    if(size(#)>0) {
1368        prec = #[1];
1369    }
1370    short = 0;
1371    string str_lag = sprintf("list lag = laguerre_solve(%s);", minpoly);
1372    ring r_sqrt = create_ring("(complex,prec,I)", "(" + parstr(basering) +")", "lp");
1373    execute(str_lag);
1374
1375    // only take the real solutions:
1376    done = 0;
1377    list real_sols = list();
1378    for(k=1; k<=size(lag) && done==0; k++) {
1379        if(find(string(lag[k]),"I")==0) {
1380            real_sols = real_sols + list(string(lag[k]));
1381        }
1382    }
1383    return(real_sols);
1384}
1385example {
1386    "EXAMPLE:"; echo = 2;
1387   ring r=(0,s),x,dp;
1388   minpoly = s^3-2;
1389   allroots_minpoly();
1390
1391   ring R=(0,s),x,dp;
1392   minpoly = s^2-2;
1393   allroots_minpoly();
1394}
1395
1396proc decstr2ratstr(string str)
1397"
1398USAGE: decstr2ratstr(string str)
1399Convert a decimal number of not more than 30 digits to a rational number with 14 digits.
1400
1401REMARK: This procedure still has to be adapted to accept other precisions!
1402"
1403{
1404    ring decR = (complex,30,I),(x),lp;
1405    execute("number r="+str+";");
1406    execute("r = "+truncdec(r,14)+";");
1407    return(real2ratstr(r));
1408}
1409
1410proc real2ratstr(number r)
1411"
1412USAGE: real2ratstr(number r)
1413
1414RETURN: A string containing a rational number representing the decimal number r.
1415
1416ASSUME: The current ring has either real or complex base field.
1417"
1418{
1419    string ratstr = "number("+string(r*number(10000000000000000))+")/number(10000000000000000)";
1420    return(ratstr);
1421}
1422
1423proc truncdec(number r, int decs)
1424"
1425USAGE: truncdec(number r, int decs)
1426Truncates a decimal number r to the given number (decs) of digits.
1427
1428RETURN: A string representing the truncated number.
1429"
1430{
1431    string str = string(r);
1432    return(str[1,(decs+2)]);
1433}
1434
1435proc string_of_vars(ideal I)
1436"
1437USAGE: string_of_vars(ideal I)
1438
1439RETURN: A string of all variables contained in the ideal I, separated by commas.
1440"
1441{
1442    list listvars = list();
1443    intvec v;
1444    int i;
1445    poly p;
1446    for(i=size(I);i>0;i--)
1447    {
1448        p=I[i];
1449        while(p!=0)
1450        {
1451            v=v+leadexp(p);
1452            p=p-lead(p);
1453        }
1454    }
1455    for(i=1; i<=nvars(basering); i++) {
1456        if(v[i] > 0) {
1457            listvars = listvars + list(var(i));
1458        }
1459    }
1460    string strvars = string(listvars);
1461    return(strvars);
1462}
Note: See TracBrowser for help on using the repository browser.