singular-data 4.0.3+ds-1 / usr / share / singular / LIB / surfex.lib

////////////////////////////////////////////////////////////////////////////
version="version surfex.lib 4.0.0.0 Jun_2013 "; // $Id: 2fb800ee344397b6175558e40cba9e886c6192ba $
category="Visualization";
info="
LIBRARY: surfex.lib      Procedures for visualizing and rotating surfaces.
@*         It is still an alpha version (see http://www.AlgebraicSurface.net)
AUTHOR: Oliver Labs
        This library uses the program surf
        (written by Stefan Endrass and others)
        and surfex (written by Oliver Labs and others, mainly Stephan Holzer).

NOTE:
 This library requires the program surfex, surf and java to be installed.
 The software is used for producing raytraced images of surfaces.
 You can download @code{surfex} from http://www.surfex.AlgebraicSurface.net

 surfex is a front-end for surf which aims to be easier to use than
 the original tool.

SEE ALSO: surf_lib

PROCEDURES:
plotRotated(poly,coord); Plot the surface given by the polynomial p
                         with the coordinates coords(list)
plotRot(poly);           Similar to plotRotated,
                         but guesses automatically
                         which coordinates should be used
plotRotatedList(varieties, coords); Plot the varieties given by the list varieties
                                    with the coordinates coords
plotRotatedDirect(varieties);       Plot the varieties given by the list varietiesList
plotRotatedListFromSpecifyList(varietiesList);  Plot the varieties given by the list varietiesList
";

LIB "solve.lib";
LIB "primdec.lib";
LIB "sing.lib";
LIB "surf.lib";

///////////////////////////////////////////////////////////
//
// the main procedures:
//

proc plotRot(poly p, list #)
"
USAGE: plotRot(poly p, list #)
Similar to plotRotated, but guesses automatically which coordinates should be used.
The optional int parameter can be used to set plotting quality.

It opens the external program surfex for drawing the surface given by p,
seen as a surface in the real affine space with coordinates coords.

ASSUME: The basering is of characteristic zero and without parameters.
"
{
    list coords = list();
    if(num_vars_id(p)==3)
    {
        execute("coords = "+string_of_vars(p)+";");
    }
    else
    {
        if(num_vars_id(p)<3)
        {
            if(nvars(basering)==3)
            {
                execute("coords = "+varstr(basering)+";");
            }
            else
            {
                if(nvars(basering)<3) {
                    "Could not guess the coordinates because the number of variables in the basering is smaller than 3!";
                    "Please use plotRotated() instead of plotRot() and specify the coordinates explicitly.";
                    return(0);
                } else {
                    "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!";
                    "Please use plotRotated() instead of plotRot() and specify the coordinates explicitly.";
                    return(0);
                }
            }
        } else {
            "Could not guess the coordinates because the number of variables in the polynomial is greater than 3!";
                    "Please use plotRotated() instead of plotRot() and specify the coordinates explicitly.";
            return(0);
        }
    }
    return(plotRotatedList(list(p), coords, #));
}
example
{
    "Example:"; echo=2;

    // More variables in the basering, but only 3 variables in the polynomial:
    ring r1 = 0, (w,x,y,z), dp;
    poly cayley_cubic = x^3+y^3+z^3+1^3-1/4*(x+y+z+1)^3;
    plotRot(cayley_cubic);

    // Three variables in the basering, but fewer variables in the polynomial:
    ring r2 = 0, (x,y,z), dp;
    plotRot(x^2+y^2-1);
    plotRot(y^2+z^2-1);

    // A cubic surface with a solitary point:
    // Use the additional parameter 3 to ask singular
    // to compute the singular locus before calling surfex.
    ring r3 = 0, (x,y,z), dp;
    poly kn_10 = x^3-3*x*y^2+z^3+3*x^2+3*y^2+z^2;
    plotRot(kn_10, 3);

    // The swallowtail:
    // a surface with a real solitary curve sticking out of the surface.
    // Use the additional parameter 3 to ask singular
    // to compute the singular locus before calling surfex.
    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;
}

proc plotRotated(poly p, list coords, list #)
"
USAGE: plotRotated(poly p, list coords, list #)
This opens the external program surfex for drawing the surface given by p,
seen as a surface in the real affine space with coordinates coords.
The optional int parameter can be used to set plotting quality.

ASSUME: coords is a list of three variables.
The basering is of characteristic zero and without parameters.
"
{
    return(plotRotatedList(list(p), coords, #));
}
example
{
    "Example:"; echo=2;

    // An easy example: a surface with four conical nodes.
    ring r = 0, (x,y,z), dp;
    poly cayley_cubic = x^3+y^3+z^3+1^3-1/4*(x+y+z+1)^3;
//     plotRotated(cayley_cubic, list(x,y,z));

    // A difficult example: a surface with a one-dimensional real component!
    poly whitney_umbrella = x^2*z-y^2;
    // The Whitney Umbrella without its handle:
    plotRotated(whitney_umbrella, list(x,y,z));

    // The Whitney Umbrella together with its handle:
    plotRotated(whitney_umbrella, list(x,y,z), 2);
}


proc plotRotatedList(list varieties, list coords, list #)
"
USAGE: plotRotatedList(list varieties, list coords, list #)
This opens the external program surfex for drawing the surfaces given by varieties,
seen as a surface in the real affine space with coordinates coords.
The optional int parameter can be used to set plotting quality.

ASSUME: coords is a list of three variables, varieties is a list of ideals
describing the varieties to be shown.
The basering is of characteristic zero and without parameters.
"
{
    def oring = basering;

    int plotquality = 0;
    if(size(#)>0) {
        plotquality = #[1];
    }

    list varietiesList = list(list(), list(), list(), list());
    list usedSurfaces = list();
    list curveColors = list();

    // go through the list of varieties
    // produce a list which can be used as input for plotRotatedListFromList()
    int i;
    int j;
    list indList;
    int ind;
    ideal itmp;
    int ncurves;
    list pd;
    int k;
    int surfind;
    list curSurfColors = list();

    list listOfPoints = list();
    string str_I = "";

    for(i=1; i<=size(varieties); i++) {
        itmp = varieties[i];
        if(plotquality>=3) {
            itmp = radical(itmp);
        }
        itmp = simplify(itmp,1);
        itmp = simplify(itmp,2);
        if(size(itmp)==1) { // i.e.: a surface given by one equation
            surfind = findInList(surfEqn(itmp[1],coords), usedSurfaces);
            if(surfind==0) {
                usedSurfaces = usedSurfaces + list(surfEqn(itmp[1],coords));
                curSurfColors = list(list("insidecolor:",getInsideColorStr(size(varietiesList[1])+1)),
                                     list("outsidecolor:",getOutsideColorStr(size(varietiesList[1])+1)));
                varietiesList[1] = varietiesList[1] +
                    list(list(list("eqno:",string(size(varietiesList[1])+1)),
                              list("equation:",surfEqn(itmp[1], coords)),
                              curSurfColors[1],
                              curSurfColors[2],
                              list("showcbox:","true"),
                              list("transparency:","0")));
                surfind = size(varietiesList[1]);

            }
            if(plotquality==1) {
                varieties = varieties + list(slocus(itmp[1]));
            }
            if(plotquality==2 || plotquality==3) {
                // remove doubled components and
                // add the 1-dimensional singular components
                // of the surface to the list of curves:
                int dsl = dim_slocus(itmp[1]);
                dsl;
                if(dsl>=0) { // i.e. there is a singular locus
                    "compute singular locus...";
                    list eqd;
                    //
                    eqd = equidim(slocus(itmp[1]));
                    ideal tmp_l;
                    tmp_l = std(eqd[size(eqd)]);
                    "dim:",dim(tmp_l);
                    if(dim(tmp_l)==(nvars(basering)-3+2)) {
                        "--- 2-dim.";
                        // we have found a multiple component;
                        // replace it by a simple copy of it
                        itmp = quotient(itmp[1], tmp_l);
                        varieties[i] = itmp[1];
                        eqd = delete(eqd,size(eqd));
                        if(size(eqd)>0) {
                            tmp_l = std(eqd[size(eqd)]);
                        }
                    }
                    if(dim(tmp_l)==(nvars(basering)-3+1)) {
                        "--- 1-dim.";
                        // we have found a 1-dimensional singular locus
                        pd = std_primdecGTZ(tmp_l,2);
                        for(k=1; k<=size(pd); k++) {
                            if(pd[k][3]==(nvars(basering)-3+1)) {
                                varieties = varieties + list(pd[k][2]);
                                curveColors[size(varieties)] = curSurfColors;
                            } else {
                                "???";
                            }
                        }
                        eqd = delete(eqd,size(eqd));
                        if(size(eqd)>0) {
                            tmp_l = std(eqd[size(eqd)]);
                        }
                    }
                    if(dim(tmp_l)==(nvars(basering)-3+0)) {
                        "--- 0-dim.";
                        // we have found a 0-dimensional singular locus
                        // we compute floating point approximations of the
                        // coordinates of all singular points
                        if(npars(oring)>0) {
                            "str:",parstr(1),rootminpoly();
                            list all_real_sols = allroots_minpoly();
//                            "all sols:";all_real_sols;
//                            sprintf("number %s = %s; ", parstr(1), rootminpoly());
                            int minp;
                            if((npars(basering) == 1) && (minpoly != 0)) {
                                minp = 1;
                            } else {
                                minp = 0;
                            }
                            str_I = "";
                            if(minp==1) {
                                "minp=1";
                                string str_para = parstr(1);
                                string str_tmp_l;
                                def cur_ring = basering;
                                if(1) {
                                    short=0;
                                    str_tmp_l = "ideal eqd_tmp = "+
//                                        string(tmp_l)+","+string(minpoly)+";";
                                        string(tmp_l);
                                    "str:",str_tmp_l;
                                    string str_num_mp = "number "+parstr(1)+"="+
                                        decstr2ratstr(rootminpoly())+";";
                                    execute("ring Iring = 0,("
//                                            +string(coords)+","+str_para+"),dp;");
                                            +string(coords)+"),dp;");
                                    basering;
                                    execute(str_num_mp);
                                    execute(str_tmp_l);
                                    eqd_tmp;
                                    list real_sols = real_solve(eqd_tmp);
                                    real_sols;
                                    $;
                                    setring cur_ring;
                                }
                            } else {
                                // minp==0: we do not know how to handle this
                                "???";
                            }
                        } else {
                            "no pars";
                            ideal eqd_tmp = tmp_l;
                            short=0;
                            string str_tmp_l = "ideal eqd_tmp = "+string(tmp_l)+";";
                            def cur_ring = basering;
                            execute("ring Iring = (real,30),("+string(coords)+"),("+ordstr(oring)+");");
//                            basering;
                            execute(str_I);
                            execute(str_tmp_l);
                            list real_sols = real_solve(eqd_tmp);
                            setring cur_ring;
                        }
                        "real_sols:";real_sols;
                        for(k=1; k<=size(real_sols); k++) {
                            "search point:";
                             string(list(real_sols[k][1],real_sols[k][2],real_sols[k][3],string(surfind)));
//                             listOfPoints;
                            if(findInList(string(list(list(real_sols[k][1],real_sols[k][2],real_sols[k][3],string(surfind)))),
                                          listOfPoints)==0) {
                                "add pt";
                                varietiesList[4] = varietiesList[4] +
                                    list(list(real_sols[k][1],real_sols[k][2],real_sols[k][3],string(surfind)));
                                listOfPoints = listOfPoints +
                                    list(string(list(real_sols[k][1],real_sols[k][2],real_sols[k][3],string(surfind))));
                            }
                        }
                    }
                }
            }
        } else {
            // i.e.: more than one equation
            varietiesList[2] = varietiesList[2] +
                list(list(list("surfaces:"),
                          list("curveno:",
                               string(size(varietiesList[2])+1)),
                          list("showcbox:","true")));
            if(size(curveColors) >= i) {
                varietiesList[2][size(varietiesList[2])][4] = curveColors[i][1];
                varietiesList[2][size(varietiesList[2])][4][1] = "color:";
            }
            ncurves = size(varietiesList[2]);
            for(j=1; j<=size(itmp); j++) {
                ind = findInList(surfEqn(itmp[j],coords), usedSurfaces);
                usedSurfaces = usedSurfaces + list(surfEqn(itmp[1],coords));
//                "indList:";indList;
                if(ind == 0) {
//                    "--------> not in list", surfEqn(itmp[j], coords);
                    if(j==1) {
                        varietiesList[1] = varietiesList[1] +
                            list(list(list("eqno:",string(size(varietiesList[1])+1)),
                                      list("equation:",surfEqn(itmp[j], coords)),
                                      list("insidecolor:",getInsideColorStr(size(varietiesList[1])+1)),
                                      list("outsidecolor:",getOutsideColorStr(size(varietiesList[1])+1)),
                                      list("showcbox:","true"),
                                      list("transparency:","100")));
                    } else {
                        varietiesList[1] = varietiesList[1] +
                            list(list(list("eqno:",string(size(varietiesList[1])+1)),
                                      list("equation:",surfEqn(itmp[j], coords)),
                                      list("insidecolor:",getInsideColorStr(size(varietiesList[1])+1)),
                                      list("outsidecolor:",getOutsideColorStr(size(varietiesList[1])+1)),
                                      list("showcbox:","false"),
                                      list("transparency:","0")));
                    }
                    ind = size(varietiesList[1]);
                } else {
                }
                varietiesList[2][ncurves][1] = varietiesList[2][ncurves][1] + list(string(ind));
            }
        }
    }

//      "------------";
//      varietiesList;
//      "------------";
    return(plotRotatedListFromSpecifyList(varietiesList, coords, #));
}
example {
    "Example:"; echo=2;

    // A cubic surface together with a tritangent plane
    // (i.e. a plane which cuts out three lines).
    ring r = 0, (x,y,z), dp;
    poly cayley_cubic = x^3+y^3+z^3+1^3-1/4*(x+y+z+1)^3;
    poly plane = 1-x-y-z;
    plotRotatedList(list(cayley_cubic, plane), list(x,y,z));

    // The same cubic and plane.
    // The plane is not shown but only its intersection with the surface.
    plotRotatedList(list(cayley_cubic, ideal(cayley_cubic, plane)), list(x,y,z));
}


proc plotRotatedListFromSpecifyList(list varietiesList, list #)
"
USAGE: plotRotatedListFromSpecifyList(list varietiesList, list #);
varietiesList has a complicated format (not documented yet);
see the example.@*
The optional int parameter can be used to set plotting quality.

ASSUME: The basering is of characteristic zero.

EXAMPLE: example plotRotatedListFromSpecifyList;
"
{
    // make the surfex file
    string str = getSurfexCodeFromSpecifyList(varietiesList, #);

    return(plotRotatedFromCode(str, #));
}
example
{
    "Example:"; echo=2;

    // A cubic surface depending on a parameter:
    ring r = (0,p1), (x,y,z), dp;
    poly cayley_cubic = x^3+y^3+z^3+1^3-p1*(x+y+z+1)^3;
    poly plane = 1-x-y-z;
    plotRotatedListFromSpecifyList(list(list(list(list("eqno:","1"),
                                                  list("equation:",
                                                       string(cayley_cubic))
                                                 )
                                            ),
                                        list(),
                                        list(list(1,"0.0","1.0","500","0.25+0.25*sin(PI*p1)")),
                                        list()
                                       ));
}


proc plotRotatedListFromStringList(list varieties, list #)
"
RETURN: the return code of the system command which executes surfex.

USAGE: not documented yet.
"
{
    // make the surfex file
    getSurfexCodeFromStringList(varieties, #);
    string str = getSurfexCodeFromStringList(varieties, #);

    return(plotRotatedFromCode(str, #));
}


proc plotRotatedDirect(list varieties, list #)
"
USAGE: plotRotatedDirect(list varieties, list #)
This opens the external program surfex for drawing the surfaces given by varieties,
seen as a surface in the real affine space with coordinates x,y,z.
The format for the list varieties is not fully documented yet;
please, see the examples below and try to adjust the examples to suit your needs.@*
The optional int parameter can be used to set plotting quality.

ASSUME:
Passes the equations directly to surfex, i.e., the variable names should
be x,y,z.
The advantage is that one can use parameters p1, p2, ...;
these will be passed to surfex.
"
{
    string str = getSurfexCodeFromListDirect(varieties, #);

    return(plotRotatedFromCode(str, #));
}
example
{
    "Example:"; echo=2;

    // A cubic surface depending on a parameter:
    ring r = (0,p1), (x,y,z), dp;
    poly cayley_cubic = x^3+y^3+z^3+1^3-p1*(x+y+z+1)^3;
    // The entries of the list of varieties can either be polynomials
    plotRotatedDirect(list(list(list(cayley_cubic)),
                           list(),
                           list(list(1,"0.0","1.0","500","0.25+0.25*sin(PI*p1)"))
                           ));

    // or strings which represent surfex-readable polynomials
    plotRotatedDirect(list(list(list("x^3+y^3+z^3+1^3-p1*(x+y+z+1)^3")),
                           list(),
                           list(list("1","0.0","1.0","500","0.25+0.25*sin(PI*p1)"))
                           ));

    // More complicated varieties
    plotRotatedDirect(list(list(list("x^2+y^2-z^2-3^2"),
                                list("x*sin(p1)+y*cos(p1)-3")),
                           list(list(list(1,2))),
                           list(list("1","0.0","1.0","500","2*PI*p1"))
                           ));
}

proc plotRotatedFromCode(string str, list #)
"
USAGE: plotRotatedFromCode(string str, list #);

This procedure is only for internal usage;
it takes the surfex-code as a string and calls surfex.

"
{
     // we need a temporary .sux file for surfex
    string tmpd = "/tmp";
    string l="surf"+string(system("pid"))+".sux";
    // a temporary file which stores the output of surfex
    string erg="/tmp/surferg"+string(system("pid"));

    write(":w "+tmpd+"/"+l, str);

    string surfex_path=system("Singular");
    while(surfex_path[size(surfex_path)]!="/") { surfex_path=surfex_path[1..size(surfex_path)-1]; }
    surfex_path=surfex_path+"../LIB/surfex";
    if (status(surfex_path,"exists")=="no")
    {
    // search in SINGULAR_PATH:
       string surfex_path1=system("SingularLib");
       string surfex_path2=surfex_path1;
       while (find(surfex_path1,":")!=0)
       {
         surfex_path2=surfex_path1[1..find(surfex_path1,":")-1];
         while(surfex_path2[size(surfex_path2)]==" ") {
           surfex_path2 = surfex_path2[1..(size(surfex_path2)-1)];
         }

         if (status(surfex_path2+"/surfex","exists")=="yes") break;
         surfex_path1=surfex_path1[find(surfex_path1,":")+1,size(surfex_path1)];
         surfex_path2=surfex_path1[1..(size(surfex_path1)-1)];
         while(surfex_path2[size(surfex_path2)]==" ") {
           surfex_path2 = surfex_path2[1..(size(surfex_path2)-1)];
         }
       }
       surfex_path=surfex_path2+"/surfex";
    }

     int i=system("sh","surfex \""+surfex_path+"\" -d "+tmpd+" -i " + l +" >"+erg+" 2>/dev/null");

    // delete the temporary file
    i = system("sh","rm " + l +" 2>/dev/null");
    return(read(erg));
}


///////////////////////////////////////////////////////////
//
// procedures used to produce the surf-code:
//


proc getSurfexCodeFromListDirect(list varieties, list #)
"
USAGE: getSurfexCodeFromListDirect(list varieties, list #)

ASSUME: varieties has four components,
        - the first is a list of polynomials, say f_1, ..., f_k
        - the second is a list of lists of numbers in {1, ..., k} describing the curves
          as intersections of the corresponding f_i
        - the third is a list of lists describing the parameters used in the polynomials f_i
        - the fourth is a list of lists of points given by their approximate coordinates (three decimal numbers)

RETURN: the surfex code (.sux)
"
{
    int i;
    int j;
    string str = "this is surfex v0.89.07"+newline;

    str = str + "TYPE:" + newline;
    str = str + "specify"+newline;
    str = str + "EQUATIONS:"+newline;
    str = str + string(size(varieties[1])) + newline;
    for(i=1; i<=size(varieties[1]); i++) {
        str = str + "Equation:"+newline;
        str = str + "eqno:"+newline;
        str = str + string(i) + newline;
        str = str + "equation:"+newline;
        str = str + surfEqnDir(varieties[1][i][1]) + newline;
        if(size(varieties[1][i])>=2) {
            str = str + "showcbox:"+newline;
            str = str + varieties[1][i][2] + newline;     // show it or not
            if(size(varieties[1][i])>=3) {
                str = str + "transparency:"+newline;
                str = str + string(varieties[1][i][3]) + newline;     // transparency
            }
        }
    }
    str = str + "CURVES:"+newline;
    str = str + string(size(varieties[2])) + newline;
    for(i=1; i<=size(varieties[2]); i++) {
        str = str + "Curve:"+newline;
        str = str + "curveno:"+newline;
        str = str + string(i) + newline;
        str = str + "surfaces:"+newline;
//        "curves:";varieties[2][i];
        for(j=1; j<=size(varieties[2][i][1]); j++) {
            str = str + string(varieties[2][i][1][j]) + newline;
        }
        if(size(varieties[2][i])>=2) {
            str = str + "showcbox:"+newline;
            str = str + varieties[2][i][2] + newline;     // show it or not
        }
    }
    str = str + "PARAMETERS:"+newline;
    str = str + string(size(varieties[3])) + newline;
    for(i=1; i<=size(varieties[3]); i++) {
        str = str + "Parameter:"+newline;
        str = str + "parno:"+newline;
        str = str + string(varieties[3][i][1]) + newline;
        str = str + "fromtoval:"+newline;
        str = str + varieties[3][i][2] + newline;
        str = str + varieties[3][i][3] + newline;
        str = str + string(varieties[3][i][4]) + newline;
        if(size(varieties[3][i])>=5) {
            str = str + "function:"+newline;
            str = str + varieties[3][i][5]+newline;
        }
    }
//     str = str + "////////////////// Parameter: /////////////////////////"+newline;
//     str = str + "1" + newline;
//     str = str + "0.0" + newline;
//     str = str + "1.0" + newline;
//     str = str + "1000" + newline;
//    str = str + string(size(varieties[3])) + newline;
    return(str);
}

proc getSurfexCodeFromList(list varieties, list coords, list #)
"
ASSUME: varieties has four components,
        - the first is a list of polynomials, say f_1, ..., f_k
        - the second is a list of lists of numbers in {1, ..., k} describing the curves
          as intersections of the corresponding f_i
        - the third is a list of lists describing the parameters used in the polynomials f_i
        - the fourth is a list of lists of points given by their approximate coordinates (three decimal numbers)

RETURN: the surfex code (.sux)
"
{
    int i;
    int j;
    string str = "this is surfex v0.89.07"+newline;

    str = str + "TYPE:" + newline;
    str = str + "specify"+newline;
    str = str + "EQUATIONS:"+newline;
    str = str + string(size(varieties[1])) + newline;
    for(i=1; i<=size(varieties[1]); i++) {
        str = str + "Equation:"+newline;
        str = str + "eqno:"+newline;
        str = str + string(i) + newline;
        str = str + "equation:"+newline;
        str = str + surfEqn(varieties[1][i][1], coords) + newline;
        str = str + "showcbox:"+newline;
        str = str + varieties[1][i][2] + newline;     // show it or not
        str = str + "transparency:"+newline;
        str = str + string(varieties[1][i][3]) + newline;     // transparency
    }
    str = str + "CURVES:"+newline;
    str = str + string(size(varieties[2])) + newline;
    for(i=1; i<=size(varieties[2]); i++) {
        str = str + "Curve:"+newline;
        str = str + "curveno:"+newline;
        str = str + string(i) + newline;
        str = str + "surfaces:"+newline;
        for(j=1; j<=size(varieties[2][i]); j++) {
            str = str + string(varieties[2][i][1][j]) + newline;
        }
        str = str + "showcbox:"+newline;
        str = str + varieties[2][i][2] + newline;     // show it or not
    }
    str = str + "PARAMETERS:"+newline;
    str = str + string(size(varieties[3])) + newline;
    for(i=1; i<=size(varieties[3]); i++) {
        str = str + "Parameter:"+newline;
        str = str + "parno:"+newline;
        str = str + string(varieties[3][i][1]) + newline;
        str = str + "fromtoval:"+newline;
        str = str + surfEqn(varieties[3][i][2], coords) + newline;
        str = str + surfEqn(varieties[3][i][3], coords) + newline;
        str = str + string(varieties[3][i][4]) + newline;
        if(size(varieties[3][i])>=5) {
            str = str + "function:"+newline;
            str = str + varieties[3][i][5]+newline;
        }
    }
//     str = str + "////////////////// Parameter: /////////////////////////"+newline;
//     str = str + "1" + newline;
//     str = str + "0.0" + newline;
//     str = str + "1.0" + newline;
//     str = str + "1000" + newline;
//    str = str + string(size(varieties[3])) + newline;
    return(str);
}

proc getSurfexCodeFromStringList(list varieties, list #)
"
ASSUME: varieties has three components,
        - the first is a list of polynomials, say f_1, ..., f_k
        - the second is a list of lists of numbers in {1, ..., k} describing the curves
          as intersections of the corresponding f_i
        - the third is a list of lists describing the parameters used in the polynomials f_i

RETURN: the surfex code (.sux)
"
{
    int i;
    int j;
    string str = "this is surfex v0.89.07"+newline;

    str = str + "TYPE:" + newline;
    str = str + "specify"+newline;
    str = str + "EQUATIONS:"+newline;
    str = str + string(size(varieties[1])) + newline;
    for(i=1; i<=size(varieties[1]); i++) {
        str = str + "Equation:"+newline;
        str = str + "eqno:"+newline;
        str = str + string(i) + newline;
        str = str + "equation:"+newline;
        str = str + varieties[1][i][1] + newline;
        str = str + "showcbox:"+newline;
        str = str + varieties[1][i][2] + newline;     // show it or not
        str = str + "transparency:"+newline;
        str = str + varieties[1][i][3] + newline;     // transparency
    }
    str = str + "CURVES:"+newline;
    str = str + string(size(varieties[2])) + newline;
    for(i=1; i<=size(varieties[2]); i++) {
        str = str + "Curve:"+newline;
        str = str + "curveno:"+newline;
        str = str + string(i) + newline;
        str = str + "surfaces:"+newline;
        for(j=1; j<=size(varieties[2][i][1]); j++) {
            str = str + string(varieties[2][i][1][j]) + newline;
        }
        str = str + "showcbox:"+newline;
        str = str + varieties[2][i][2] + newline;     // show it or not
    }
    str = str + "PARAMETERS:"+newline;
    str = str + string(size(varieties[3])) + newline;
    for(i=1; i<=size(varieties[3]); i++) {
        str = str + "Parameter:"+newline;
        str = str + "parno:"+newline;
        str = str + string(varieties[3][i][1]) + newline;
        str = str + "fromtoval:"+newline;
        str = str + varieties[3][i][2] + newline;
        str = str + varieties[3][i][3] + newline;
        str = str + string(varieties[3][i][4]) + newline;
        if(size(varieties[3][i])>=5) {
            str = str + "function:"+newline;
            str = str + varieties[3][i][5]+newline;
        }
    }
    return(str);
}


proc getSurfexCodeFromSpecifyList(list varieties, list #)
"
ASSUME: varieties has three components,
        - the first is a list of polynomials, say f_1, ..., f_k
        - the second is a list of lists of numbers in {1, ..., k} describing the curves
          as intersections of the corresponding f_i
        - the third is a list of lists describing the parameters used in the polynomials f_i
        - the fourth is a list of lists describing the singular points to be shown as spheres

RETURN: the surfex code (.sux)
"
{
    int i;
    int j;
    int k;
    string str = "this is surfex v0.89.07"+newline;

    str = str + "TYPE:" + newline;
    str = str + "specify"+newline;
    str = str + "EQUATIONS:"+newline;
    str = str + string(size(varieties[1])) + newline;
    for(i=1; i<=size(varieties[1]); i++) {
        str = str + "Equation:"+newline;
        for(j=1; j<=size(varieties[1][i]); j++) {
            str = str + varieties[1][i][j][1] +newline;
            str = str + varieties[1][i][j][2] +newline;
        }
    }
    str = str + "CURVES:"+newline;
    str = str + string(size(varieties[2])) + newline;
    for(i=1; i<=size(varieties[2]); i++) {
        str = str + "Curve:"+newline;
        for(j=1; j<=size(varieties[2][i]); j++) {
            str = str + varieties[2][i][j][1] +newline;
            if(varieties[2][i][j][1] == "surfaces:") {
                for(k=2; k<=size(varieties[2][i][j]); k++) {
                    str = str + string(varieties[2][i][j][k]) + newline;
                }
            } else {
                str = str + varieties[2][i][j][2] +newline;
            }
        }
//         str = str + "curveno:"+newline;
//         str = str + string(i) + newline;
//         str = str + "surfaces:"+newline;
//         for(j=1; j<=size(varieties[2][i][1]); j++) {
//             str = str + string(varieties[2][i][1][j]) + newline;
//         }
//         str = str + "showcbox:"+newline;
//         str = str + varieties[2][i][2] + newline;     // show it or not
    }
    str = str + "PARAMETERS:"+newline;
    str = str + string(size(varieties[3])) + newline;
    for(i=1; i<=size(varieties[3]); i++) {
        str = str + "Parameter:"+newline;
        str = str + "parno:"+newline;
        str = str + string(varieties[3][i][1]) + newline;
        str = str + "fromtoval:"+newline;
        str = str + varieties[3][i][2] + newline;
        str = str + varieties[3][i][3] + newline;
        str = str + string(varieties[3][i][4]) + newline;
        if(size(varieties[3][i])>=5) {
            str = str + "function:"+newline;
            str = str + varieties[3][i][5]+newline;
        }
    }
    string str_from = "0.0";
    string str_to = "5.0";
    string str_radius = "50";
    str = str + "SOLITARY POINTS:"+newline;
    str = str + string(size(varieties[4])) + newline;
    for(i=1; i<=size(varieties[4]); i++) {
        str = str + "SolitaryPoint:"+newline;
        str = str + "solPtNo:"+newline;
        str = str + string(i) + newline;
        str = str + "surface:"+newline;
        str = str + varieties[4][i][4] + newline;
        str = str + "fromtoval:"+newline;
        str = str + str_from + newline;
        str = str + str_to + newline;
        str = str + str_radius + newline;
        str = str + "coords:" + newline;
        str = str + varieties[4][i][1] + newline;
        str = str + varieties[4][i][2] + newline;
        str = str + varieties[4][i][3] + newline;
    }
    return(str);
}

///////////////////////////////////////////////////////////
//
// procedures for standard colors:
//

proc numBaseColors()
"
USAGE: numBaseColors()

RETURN: the number of predefined surface colors.
"
{
    return(6);
}

proc baseSurfaceColors(int no)
"
USAGE: baseSurfaceColors(int no)

REMARK: There are currently 6=numBaseColors() basic surface colors.
You can modify them according to your wishes
by just redefining this procedure in your Singular-script.

If you want more colors, then you also have to redefine numBaseColors() accordingly.

RETURN: a list of three integers describing the RGB values of a color.
"
{
    if(no%numBaseColors()==1) {
        return(list(240,160,0));
    }
    if(no%numBaseColors()==2) {
        return(list(160,240,0));
    }
    if(no%numBaseColors()==3) {
        return(list(0,160,240));
    }
    if(no%numBaseColors()==4) {
        return(list(240,0,160));
    }
    if(no%numBaseColors()==5) {
        return(list(0,240,160));
    }
    if(no%numBaseColors()==0) {
        return(list(160,0,240));
    }
}

proc getInsideColorStr(int no)
"
USAGE: getInsideColorStr(int no)

RETURN: a string describing inside color number no
where the three integer RGB values are in one line each.
"
{
    list bc = baseSurfaceColors(no);
    string str = string(bc[1])+newline+string(bc[2])+newline+string(bc[3]);
    return(str);
}

proc getOutsideColorStr(int no)
"
USAGE: getOutsideColorStr(int no)

RETURN: a string describing outside color number no
where the three integer RGB values are in one line each.
"
{
    list bc = baseSurfaceColors(no);
    string str = string(bc[1])+newline+string(bc[2])+newline+string(bc[3]);
    return(str);
}

///////////////////////////////////////////////////////////
//
// procedures used by the plot procedures:
//

proc surfEqnDir(list #)
"
USAGE: surfEqnDir(list #) without any checks etc.

RETURN: string(#[1]) where short=0.
"
{
    int stmp = short; short = 0;
    string str = string(#[1]);
    short = stmp;
    return(str);
}

proc surfEqn(poly p, list coords, list #)
"
USAGE: surfEqn(poly p, list coords)
       Tries to produce a string for the equation of p which is convenient for surfex.
ASSUME: - p defines a plane curve or a surface,
         - coords is a list of the three coordinates to use, e.g. list(x,y,z),
           in this way, it is possible to distinguish between x^2+y^2-1 and y^2+z^2-1
RETURN: a string, that one can use with the external program surf
EXAMPLE: example surfEqn; shows an example
"
{
    int params=0;
    if(size(#)>0) {
        params = #[1];
    }
    string err_mes; // string containing error messages
    def base=basering;
    int mynvars = nvars(basering);

    intvec ind=num_of_vars(p);

    int i,j,n;
    int minp = 0;
    n=0;
    for(i=size(ind);i>0;i--)
    {
          if (ind[i]!=0) {
            n++;
        } else {
            if(var(i)==coords[1] || var(i)==coords[2] || var(i)==coords[3]) {
                ind[i]=1;
                n++;
            }
        }
    }

    params = params + npars(basering);
    n = n + npars(basering);
    if((npars(basering) == 1) && (minpoly != 0)) {
        minp = 1;
    } else {
        minp = 0;
    }
    string str_I = "";
    for(i=1; i<=npars(basering); i=i+1) {
        if(!(parstr(i) == "i")) {
            if(minp==1) {
                str_I = str_I + sprintf("number %s = %s; ", parstr(i), rootminpoly());
            } else {
            }
        }
    }
    int bshort = short; short = 0;
    if(!(minp==1 || npars(basering)==0)) {
        p=cleardenom(p);
        err_mes="Cannot plot equations with a parameter without a specified minpoly";
        ERROR(err_mes);
    }
    str_I = str_I + "poly p = " + string(p) + ";";

    short = bshort;

    if(params==0) {
        if (n<=2 or n>=4)
        {
            err_mes="Cannot plot equations with "+string(n)+" variables";
            ERROR(err_mes);
//            return("0");
        }
        if(n==4) {
            ring r=(real,30,30),(xx,yy,zz,ww),dp;
        } else {
            ring r=(real,30,30),(x,y,z),dp;
        }
    } else {
        if(n-params<=2 || n-params>=4) {
            err_mes="Cannot plot equations with "+string(n-params)+" variables";
            ERROR(err_mes);
//            return("0");
        } else {
            if(params == 1) {
                if(n-params==3) {
                    if(minp==1) {
                        // switch to a ring without minimal polynomial:
                        execute("ring rr = (real,30,30),("+varstr(base)+"), dp;");
//                        rr;
//                        "str_I",str_I;
                        execute(str_I);
                        def base = rr;
                        ring r=(real,30,30),(x,y,z),dp;
                    } else {
                        p=cleardenom(p);
                        ring r=(real,30,30),(x,y,z,p1),dp;
                    }
                }
            }
            if(params == 2) {
                if(n-params==3) {
                    p=cleardenom(p);
                    ring r=(real,30,30),(x,y,z,p1,p2),dp;
                }
            }
            if(params == 3) {
                if(n-params==3) {
                    p=cleardenom(p);
                    execute("ring rr = (real,30,30),("+varstr(base)+","+parstr(base)+"), dp;");
                    rr;
                    "str_I",str_I;
                    execute(str_I);
                    "pnew:",p;
                    def base = rr;

                    ring r=(real,30,30),(x,y,z,p1,p2,p3),dp;
                }
            }
        }
    }
//    basering;
    short=0;
    map phi=base,0;
    j=1;

    for(i=1;i<=mynvars;i++)
    {
        if (ind[i]!=0)
        {
            phi[i]=var(j);
            j++;
        }
    }
    poly p=(simplify(phi(p),1));
    if (leadcoef(p) <0) {
        if(size(#)>1) {
            if(#[2]!=0) {
                p=-p;
            }
        } else {
            p=-p;
        }
    }
    if(leadcoef(p)!=0) {
        p = p/leadcoef(p);
    }
    string thesurfstr = string(p);
    if(minp == 1) {
        // replace k by rootRepl
    }

    return (thesurfstr);
} // end of surfEqn()
example
{ "EXAMPLE:"; echo =2;

  ring rr0 = 0,(x(1..3)),dp;
  poly p = x(1)^3 - x(2)^2;
  print(surfEqn(p,list(x(1),x(2),x(3))));

  ring rr1 = 0,(x,y,z),dp;
  poly I(1) = 2x2-1/2x3 +1-y+1;
  print(surfEqn(I(1),list(x,y,z)));

  // Steiner surface
  poly J(2) = x^2*y^2+x^2*z^2+y^2*z^2-17*x*y*z;
  print(surfEqn(J(2),list(x,y,z)));
} // end of example surfEqn()


proc num_vars_id(ideal I)
"
USAGE: num_vars_id(ideal I)

RETURN: The number of ring-variables occurring in the ideal I.
"
{
    intvec v = num_of_vars(I);
    int num = 0;
    for(int i=size(v);i>0;i--)
    {
        if (v[i]!=0) { num++; }
    }
    return(num);
}
example {
    "EXAMPLE:"; echo = 2;
    ring r = 0, (x,y,z),dp;
    ideal j = x^2-y, x^3-2;
    num_vars_id(j);
}

proc findInList(list obj, list l)
"
USAGE: findInList(list obj, list l)
       Tries to find the object obj in the list l.

ASSUME: the object obj[1] can be compared to the objects in the list l

RETURN: if obj[1]=l[i] for some i, then return the first such i,
        otherwise return 0
"
{
    for(int i=1; i<=size(l); i++) {
        if(l[i]==obj[1]) {
            return(i);
        }
    }

    return(0);
}
example {
    "EXAMPLE:"; echo = 2;
    ring r = 0,(x,y,z), dp;
    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);
    findInList(x^2+y^2+z^2-1, a);
    findInList(x^2+y^2+z^2, a);
}

proc std_primdecGTZ(ideal I, list #)
"
USAGE: std_primdecGTZ(ideal I, list #)
Computes a primdary decomposition pd of I using primdecGTZ and then
calls std_for_pd(pd).
For the output and options, consult the help of std_for_pd.

RETURN: see std_for_pd.
"
{
    list pd = primdecGTZ(I);
    return(std_for_pd(pd, #));
}
example {
    "EXAMPLE:"; echo = 2;

    ring r = 0, (x,y), dp;
    ideal j = y-x^2,z-x^3;
    primdecGTZ(j);
    std_primdecGTZ(j);
    std_primdecGTZ(j,1);
}

proc std_for_pd(list pd, list #)
"
USAGE: std_for_pd(list pd, list #)
Call std for each of the prime ideals in the list pd
replace the prime ideals by their standard-basis.
Compute dim() and mult() of each prime component using these standard bases.
If an additional argument is given then do the same for the primary components.

ASSUME:
pd is in the format produced by primdecGTZ() or primdecSY().

RETURN: A list, say l, of lists, similar to a list returned by primdecSY() or primdecGTZ().
However, each of the entries of l (which is a list l[i]) contains some additional entries:
l[1]: the primary ideal
l[2]: a standard basis of the associated prime ideal
l[3]: dim() of this prime ideal
l[4]: mult() of this prime ideal

If an additional argument # is given then l[1] changes:
l[1]: a standard basis of the primary ideal
Morever, there are some more entries:
l[5]: dim() of this primary ideal
l[6]: mult() of this primary ideal
l[7]: l[6] / l[5]
"
{

    if(typeof(pd[1])=="ideal") {
        // this is a Singular bug!?
//        "bug!";pd;"---";
        pd = list(list(pd[1], pd[1]));
//        pd;$;
    }
    list pd_neu;
    int i;
    list coords;
    ideal stdtmp;
    ideal stdtmp2;
    for(i=1; i<=size(pd); i++) {
        stdtmp = std(pd[i][2]);
        stdtmp2 = pd[i][1];
        if(size(#)>0) {
            stdtmp2 = std(stdtmp2);
            if(mult(stdtmp)==0) {
                pd_neu[i] = list(stdtmp2,
                                 stdtmp,
                                 dim(stdtmp), mult(stdtmp),
                                 dim(stdtmp2), mult(stdtmp2),
                                 0);
            } else {
                pd_neu[i] = list(stdtmp2,
                                 stdtmp,
                                 dim(stdtmp), mult(stdtmp),
                                 dim(stdtmp2), mult(stdtmp2),
                                 mult(stdtmp2) div mult(stdtmp));
            }
        } else {
            pd_neu[i] = list(stdtmp2,
                             stdtmp,
                             dim(stdtmp), mult(stdtmp));
        }
    }
    return(pd_neu);
}
example {
    "EXAMPLE:"; echo = 2;

    ring r = 0, (x,y,z), dp;
    ideal j = y-x^2,z-x^3;
    list pd = primdecGTZ(j);
    pd;
    std_for_pd(pd, 1);
}

proc real_solve(ideal to_solve)
"
USAGE: real_solve(ideal to_solve)

RETURN: a list of all real solutions (as strings)
of the zero-dimensional ideal to_solve (without multiplicities).

REMARK: Until now, it may happen that some points appear more than once.
"
{
    int k;
    int i;

//    def Isolring = solve(to_solve,30,0,60,"nodisplay");
    def Isolring = solve(to_solve,9,0,13,"nodisplay");
    setring Isolring;
//    list SOL = solve(to_solve, "oldring", "nodisplay");
    list real_sols = list();
    list tmpl;
    for(k=1; k<=size(SOL); k++) {
        if(find(string(SOL[k]),"I")==0 && find(string(SOL[k]),"i")==0) {
            tmpl = list();
            for(i=1; i<=size(SOL[k]); i++) {
                tmpl = tmpl + list(string(SOL[k][i]));
            }
            real_sols = real_sols + list(tmpl);
        }
    }
    return(real_sols);
}
example {
    "EXAMPLE:"; echo = 2;
    ring r = 0, (x,y), dp;
    number a = 2;
    number b = 3;
    ideal j = (x^2-a),(y^3-b);
    real_solve(j);
}

proc rootminpoly(list #)
"
USAGE: rootminpoly(list #)

RETURN: A root of the current minpoly
as a string representation of a complex number with
the given precision #[1] (default: 30).
E.g. ring r=(0,s),x,dp; minpoly = s^2-2; => rootminpoly() 1.41421356237309504880168872421

ASSUME: The current minpoly is non-zero.
"
{
    int prec = 30;
    int k, done;
    if(size(#)>0) {
        prec = #[1];
    }
    short = 0;
    string str_lag = sprintf("list lag = laguerre_solve(%s);", minpoly);
    string str_ring = sprintf("ring r_sqrt = (complex,prec,I),(%s),lp;", parstr(basering));
    execute(str_ring);
    execute(str_lag);
//    lag;
    // choose a real solution, if it exists:
    done = 0;
    for(k=1; k<=size(lag) && done==0; k++) {
        if(find(string(lag[k]),"I")==0) {
            done = k;
        }
    }
    if(done==0) {
//        "no real solution.";
    }

    if(size(lag)>2) {
        // return the first real solution
        return(sprintf("%s",lag[done]));
    }

    if(sprintf("%s",lag[1])[1] == "-") {
        return(sprintf("%s",lag[2]));
    } else {
        if(sprintf("%s",lag[1])[1] == "(") {
            if(sprintf("%s",lag[1])[2] == "-") {
                return(sprintf("%s",lag[2]));
            } else {
                return(sprintf("%s",lag[1]));
            }
        } else {
            return(sprintf("%s",lag[1]));
        }
    }
    short = 1;
}
example
{
   "EXAMPLE:"; echo =2;
   ring r=(0,s),x,dp;
   minpoly = s^2-2;
   rootminpoly();

   ring R=(0,s),x,dp;
   minpoly = s^2+2;
   rootminpoly();
}

proc allroots_minpoly(list #)
"
USAGE: allroots_minpoly(list #)

RETURN: a list of strings containing all real roots of the minimal polynomial of the active ring.

ASSUME: The current minpoly is non-zero.
"
{
    int prec = 30;
    int k, done;
    if(size(#)>0) {
        prec = #[1];
    }
    short = 0;
    string str_lag = sprintf("list lag = laguerre_solve(%s);", minpoly);
    string str_ring = sprintf("ring r_sqrt = (complex,prec,I),(%s),lp;", parstr(basering));
    execute(str_ring);
    execute(str_lag);

    // only take the real solutions:
    done = 0;
    list real_sols = list();
    for(k=1; k<=size(lag) && done==0; k++) {
        if(find(string(lag[k]),"I")==0) {
            real_sols = real_sols + list(string(lag[k]));
        }
    }
    return(real_sols);
}
example {
    "EXAMPLE:"; echo = 2;
   ring r=(0,s),x,dp;
   minpoly = s^3-2;
   allroots_minpoly();

   ring R=(0,s),x,dp;
   minpoly = s^2-2;
   allroots_minpoly();
}

proc decstr2ratstr(string str)
"
USAGE: decstr2ratstr(string str)
Convert a decimal number of not more than 30 digits to a rational number with 14 digits.

REMARK: This procedure still has to be adapted to accept other precisions!
"
{
    ring decR = (complex,30,I),(x),lp;
    execute("number r="+str+";");
    execute("r = "+truncdec(r,14)+";");
    return(real2ratstr(r));
}

proc real2ratstr(number r)
"
USAGE: real2ratstr(number r)

RETURN: A string containing a rational number representing the decimal number r.

ASSUME: The current ring has either real or complex base field.
"
{
    string ratstr = "number("+string(r*number(10000000000000000))+")/number(10000000000000000)";
    return(ratstr);
}

proc truncdec(number r, int decs)
"
USAGE: truncdec(number r, int decs)
Truncates a decimal number r to the given number (decs) of digits.

RETURN: A string representing the truncated number.
"
{
    string str = string(r);
    return(str[1,(decs+2)]);
}

proc string_of_vars(ideal I)
"
USAGE: string_of_vars(ideal I)

RETURN: A string of all variables contained in the ideal I, separated by commas.
"
{
    list listvars = list();
    intvec v;
    int i;
    poly p;
    for(i=size(I);i>0;i--)
    {
        p=I[i];
        while(p!=0)
        {
            v=v+leadexp(p);
            p=p-lead(p);
        }
    }
    for(i=1; i<=nvars(basering); i++) {
        if(v[i] > 0) {
            listvars = listvars + list(var(i));
        }
    }
    string strvars = string(listvars);
    return(strvars);
}