Changeset 6149f4f in git for Singular/LIB/standard.lib


Ignore:
Timestamp:
May 24, 1998, 6:43:11 PM (26 years ago)
Author:
Olaf Bachmann <obachman@…>
Branches:
(u'spielwiese', '379ec2d037299db64c43fe3550b5ba8fe508dbe5')
Children:
fbb9b1ddc38f7b1d1c34af1cc911d3accaacf872
Parents:
45f7bfcca3edf19f70b4d4e83236758f8d71c6da
Message:
* added groebner, resu
* resu needs documentation !!!


git-svn-id: file:///usr/local/Singular/svn/trunk@1963 2c84dea3-7e68-4137-9b89-c4e89433aadc
File:
1 edited

Legend:

Unmodified
Added
Removed

  • Singular/LIB/standard.lib

    r45f7bf r6149f4f  
    1 // $Id: standard.lib,v 1.12 1998-05-24 15:50:27 obachman Exp $
    2 ///////////////////////////////////////////////////////////////////////////////
    3 
    4 version="$Id: standard.lib,v 1.12 1998-05-24 15:50:27 obachman Exp $";
     1// $Id: standard.lib,v 1.13 1998-05-24 16:43:11 obachman Exp $
     2//////////////////////////////////////////////////////////////////////////////
     3
     4version="$Id: standard.lib,v 1.13 1998-05-24 16:43:11 obachman Exp $";
    55info="
    66LIBRARY: standard.lib   PROCEDURES WHICH ARE ALWAYS LOADED AT START-UP
    … …  
    1212";
    1313
    14 ///////////////////////////////////////////////////////////////////////////////
     14//////////////////////////////////////////////////////////////////////////////
    1515
    1616proc stdfglm (ideal i, list #)
    … …  
    5555   i2;
    5656}
    57 ///////////////////////////////////////////////////////////////////////////////
     57/////////////////////////////////////////////////////////////////////////////
    5858
    5959proc stdhilb(ideal i,list #)
    … …  
    122122   ideal i2=stdhilb(i,v);
    123123}
    124 ///////////////////////////////////////////////////////////////////////////////
     124//////////////////////////////////////////////////////////////////////////
    125125
    126126proc groebner(def i, list #)
    127 "USAGE: groebner(i) i ideal/module
    128 RETURNS: standard basis of ideal or module which is computed using a
     127"USAGE: groebner(i[, wait]) i -- ideal/module; wait -- int
     128RETURNS: Standard basis of ideal or module which is computed using a
    129129         heuristically choosen method:
    130          If the ordering of the current ring is a lokal ordering, or
     130         If the ordering of the current ring is a local ordering, or
    131131         if it is a non-block ordering and the current ring has no
    132132         parameters, then std(i) is returned. 
    … …  
    135135         followed by a Hilbert-series based std computation in the
    136136         original ring.
     137NOTE: If a 2nd argument 'wait' is given, then the computation proceeds
     138      at most 'wait' seconds. That is, if no result could be computed in
     139      'wait' seconds, then the computation is interrupted, 0 is returned,
     140       a warning message is displayed, and the global variable
     141       'groebner_error' is defined.
    137142EXAMPLE: example groebner; shows an example"
    138143{
    139144  def P=basering;
     145
     146  // we have two arguments -- try to use MPfork links
    140147  if (size(#) > 0)
    141148  {
    … …  
    144151      if (typeof(#[1]) == "int")
    145152      {
    146         int wait = #[1];
    147         int j, pid;
     153        int wait = #[1] * 1000000;
     154        int j,k = 10, 0;
    148155        string bs = nameof(basering);
    149156        link l_fork = "MPtcp:fork";
    150157        open(l_fork);
    151158        write(l_fork, quote(system("pid")));
    152         pid = read(l_fork);
     159        int pid = read(l_fork);
    153160        write(l_fork, quote(groebner(eval(i))));
    154161       
    155         for (j=0; j<wait; j++)
     162        while(k < wait)
    156163        {
    157           if (status(l_fork, "read", "ready", 1)) {break;}
     164          if (status(l_fork, "read", "ready", j)) {break;}
     165          k = k + j;
     166          j = j + j;
    158167        }
    159        
     168
    160169        if (status(l_fork, "read", "ready"))
    161170        {
    … …  
    168177            kill PP;
    169178          }
     179          if (defined(groebner_error))
     180          {
     181            kill(groebner_error);
     182          }
    170183          kill (l_fork);
    171184        }
    … …  
    173186        {
    174187          ideal result;
     188          groebner_error = 1;
    175189          if (! defined(groebner_error))
    176190          {
    177             int groebner_error;
     191            int groebner_error = 1;
    178192            export groebner_error;
    179193          }
    180           groebner_error = 1;
    181194          "// ** groebner did not finish";
    182195          j = system("sh", "kill " + string(pid));
    … …  
    194207    }
    195208  }
    196    string ordstr_P = ordstr(P);
    197 
    198    if (find(ordstr_P,"s") > 0)
    199    {
    200      //spaeter den lokalen fall ueber lp oder aehnlich behandeln
    201       return(std(i));
    202    }
    203    
    204    int IsSimple_P;
    205    if (system("nblocks") <= 2)
    206    {
    207      if (find(ordstr_P, "M") <= 0)
    208      {
    209        IsSimple_P = 1;
    210      }
    211    }
    212    int npars_P = npars(P);
    213 
    214    // return std if no parameters and (dp or wp)
    215    if ((npars_P == 0) && IsSimple_P)
    216    {
    217      if (find(ordstr_P, "d") > 0)
    218      {
    219        return (std(i));
    220      }
    221      if (find(ordstr_P,"w") > 0)
    222      {
    223        return (std(i));
    224      }
    225    }
    226 
    227    // reset options
    228    intvec opt=option(get);
    229    int p_opt;
    230    string s_opt = option();
    231    option(none);
    232    // turn on option(prot) and/or option(mem), if previously set
    233    if (find(s_opt, "prot"))
    234    {
    235      option(prot);
    236      p_opt = 1;
    237    }
    238    if (find(s_opt, "mem"))
    239    {
    240      option(mem);
    241    }
    242    
    243    // construct ring in which first std computation is done
    244    string varstr_P = varstr(P);
    245    string parstr_P = parstr(P);
    246    int is_homog = (homog(i) && (npars_P == 0));
    247    
    248    string ri = "ring Phelp =" + string(char(P)) + ",(" + varstr_P;
    249    // parameters are converted to ring variables
    250    if (npars_P > 0)
    251    {
    252      ri = ri + "," + parstr_P;
    253    }
    254    // a homogenizing variable is added, if necessary
    255    if (! is_homog)
    256    {
    257      ri = ri + ",@t";
    258    }
    259    // ordering is set to (dp, C)
    260    ri = ri + "),(dp,C);";
    261 
    262    // change the ring
    263    execute(ri);
    264    
    265    // get ideal from previous ring
    266    if (is_homog)
    267    {
    268      ideal qh = imap(P, i);
    269    }
    270    else
    271    {
    272      // and homogenize
    273      ideal qh=homog(imap(P,i),@t);
    274    }
    275    
    276    // compute std and hilbert series
    277    if (p_opt)
    278    {
    279      "std in " + ri[13, size(ri) - 13];
    280    }
    281    ideal qh1=std(qh);
    282    intvec hi=hilb(qh1,1);
    283 
    284    if (is_homog && (npars_P == 0))
    285    {
    286      // no additional variables were introduced
    287      setring P; // can immediately change to original ring
    288      // simply compute std with hilbert series in original ring
    289      if (p_opt)
    290      {
    291        "std with hilb in basering";
    292        i = std(i, hi);
    293      }
    294    }
    295    else
    296    {
    297      // additional variables were introduced
    298      // need another intermediate ring
    299      ri = "ring Phelp1 =" + string(char(P))
    300        + ",(" + varstr(Phelp) + "),(" + ordstr_P;
     209
     210  // we are still here -- do the actual computation
     211  string ordstr_P = ordstr(P);
     212  if (find(ordstr_P,"s") > 0)
     213  {
     214    //spaeter den lokalen fall ueber lp oder aehnlich behandeln
     215    return(std(i));
     216  }
     217   
     218  int IsSimple_P;
     219  if (system("nblocks") <= 2)
     220  {
     221    if (find(ordstr_P, "M") <= 0)
     222    {
     223      IsSimple_P = 1;
     224    }
     225  }
     226  int npars_P = npars(P);
     227
     228  // return std if no parameters and (dp or wp)
     229  if ((npars_P == 0) && IsSimple_P)
     230  {
     231    if (find(ordstr_P, "d") > 0)
     232    {
     233      return (std(i));
     234    }
     235    if (find(ordstr_P,"w") > 0)
     236    {
     237      return (std(i));
     238    }
     239  }
     240
     241  // reset options
     242  intvec opt=option(get);
     243  int p_opt;
     244  string s_opt = option();
     245  option(none);
     246  // turn on option(prot) and/or option(mem), if previously set
     247  if (find(s_opt, "prot"))
     248  {
     249    option(prot);
     250    p_opt = 1;
     251  }
     252  if (find(s_opt, "mem"))
     253  {
     254    option(mem);
     255  }
     256   
     257  // construct ring in which first std computation is done
     258  string varstr_P = varstr(P);
     259  string parstr_P = parstr(P);
     260  int is_homog = (homog(i) && (npars_P == 0));
     261   
     262  string ri = "ring Phelp =" + string(char(P)) + ",(" + varstr_P;
     263  // parameters are converted to ring variables
     264  if (npars_P > 0)
     265  {
     266    ri = ri + "," + parstr_P;
     267  }
     268  // a homogenizing variable is added, if necessary
     269  if (! is_homog)
     270  {
     271    ri = ri + ",@t";
     272  }
     273  // ordering is set to (dp, C)
     274  ri = ri + "),(dp,C);";
     275
     276  // change the ring
     277  execute(ri);
     278   
     279  // get ideal from previous ring
     280  if (is_homog)
     281  {
     282    ideal qh = imap(P, i);
     283  }
     284  else
     285  {
     286    // and homogenize
     287    ideal qh=homog(imap(P,i),@t);
     288  }
     289   
     290  // compute std and hilbert series
     291  if (p_opt)
     292  {
     293    "std in " + ri[13, size(ri) - 13];
     294  }
     295  ideal qh1=std(qh);
     296  intvec hi=hilb(qh1,1);
     297
     298  if (is_homog && (npars_P == 0))
     299  {
     300    // no additional variables were introduced
     301    setring P; // can immediately change to original ring
     302    // simply compute std with hilbert series in original ring
     303    if (p_opt)
     304    {
     305      "std with hilb in basering";
     306      i = std(i, hi);
     307    }
     308  }
     309  else
     310  {
     311    // additional variables were introduced
     312    // need another intermediate ring
     313    ri = "ring Phelp1 =" + string(char(P))
     314      + ",(" + varstr(Phelp) + "),(" + ordstr_P;
    301315     
    302      // for lp without parameters, we do not need a block ordering
    303      if ( ! (IsSimple_P && (npars_P + is_homog < 2) && find(ordstr_P, "l")))
    304      {
    305        // need block ordering
    306        ri = ri + ", dp(" + string(npars_P + is_homog) + ")";
    307      }
    308      ri = ri + ");";
     316    // for lp without parameters, we do not need a block ordering
     317    if ( ! (IsSimple_P && (npars_P + is_homog < 2) && find(ordstr_P, "l")))
     318    {
     319      // need block ordering
     320      ri = ri + ", dp(" + string(npars_P + is_homog) + ")";
     321    }
     322    ri = ri + ");";
    309323     
    310      // change to intermediate ring
    311      execute(ri);
    312      ideal qh = imap(Phelp, qh);
    313      kill Phelp;
    314      if (p_opt)
    315      {
    316        "std with hilb in " + ri[14,size(ri)-14];
    317      }
    318      // compute std with Hilbert series
    319      qh = std(qh, hi);
    320      // subst 1 for homogenizing var
    321      if (!is_homog)
    322      {
    323        qh = subst(qh, @t, 1);
    324      }
     324    // change to intermediate ring
     325    execute(ri);
     326    ideal qh = imap(Phelp, qh);
     327    kill Phelp;
     328    if (p_opt)
     329    {
     330      "std with hilb in " + ri[14,size(ri)-14];
     331    }
     332    // compute std with Hilbert series
     333    qh = std(qh, hi);
     334    // subst 1 for homogenizing var
     335    if (!is_homog)
     336    {
     337      qh = subst(qh, @t, 1);
     338    }
    325339     
    326      // go back to original ring
    327      setring P;
    328      // get ideal, delete zeros and clean SB
    329      i = imap(Phelp1,qh);
    330      i = simplify(i, 34);
    331      kill Phelp1;
    332    }
    333 
    334    // clean-up time
    335    option(set, opt);
    336    if (find(s_opt, "redSB") > 0)
    337    {
    338      i=interred(i);
    339    }
    340    attrib(i, "isSB", 1);
    341    return (i);
     340    // go back to original ring
     341    setring P;
     342    // get ideal, delete zeros and clean SB
     343    i = imap(Phelp1,qh);
     344    i = simplify(i, 34);
     345    kill Phelp1;
     346  }
     347
     348  // clean-up time
     349  option(set, opt);
     350  if (find(s_opt, "redSB") > 0)
     351  {
     352    i=interred(i);
     353  }
     354  attrib(i, "isSB", 1);
     355  return (i);
    342356}
    343357example
    … …  
    353367  option(noprot);
    354368  j; simplify(j, 1); std(i);
    355 }
    356 
     369  if (system("with", "MP")) {groebner(i, 0);}
     370  defined(groebner_error);
     371}
     372
     373
     374//////////////////////////////////////////////////////////////////////////
     375proc resu(list #)
     376{
     377   def P=basering;
     378   list result;
     379   def m=#[1]; //the ideal or module
     380   
     381   int i=#[2]; //the length of the resolution
     382               //if size(#)>2 a minimal resolution is computed
     383
     384   //LaScala for the homogeneous case
     385   if(homog(m)==1)
     386   {
     387      resolution re=lres(m,i);
     388      if(size(#)>2)
     389      {
     390         re=minres(re);
     391      }
     392      return(re);
     393   }
     394
     395   //mres for the global non homogeneous case
     396   if(find(ordstr(P),"s")==0)
     397   {
     398      string ri= "ring Phelp ="
     399                  +string(char(P))+",("+varstr_P+"),(dp,C);";
     400      execute(ri);
     401      def m=imap(P,m);
     402      list re=mres(m,i);
     403      setring P;
     404      result=imap(Phelp,re);
     405      return(result);   
     406   }
     407
     408   //sres for the local case and not minimal resolution
     409   if(size(#)<=2)
     410   {
     411      string ri= "ring Phelp ="
     412                  +string(char(P))+",("+varstr_P+"),(ls,c);";
     413      execute(ri);
     414      def m=imap(P,m);
     415      m=std(m);
     416      list re=sres(m,i);
     417      setring P;
     418      result=imap(Phelp,re);
     419      return(result);
     420   }
     421
     422   //mres for the local case and minimal resolution
     423   string ri= "ring Phelp ="
     424                  +string(char(P))+",("+varstr_P+"),(ls,C);";
     425   execute(ri);
     426   def m=imap(P,m);
     427   list re=mres(m,i);
     428   setring P;
     429   result=imap(Phelp,re);
     430   return(result);     
     431}
     432
     433proc minresu(list #)
     434{
     435   return(resu(#[1],#[2],1));
     436}
Note: See TracChangeset for help on using the changeset viewer.