Changeset 6f2edc in git for Singular/LIB/deform.lib


Ignore:
Timestamp:
Apr 28, 1997, 9:27:25 PM (27 years ago)
Author:
Olaf Bachmann <obachman@…>
Branches:
(u'spielwiese', 'a719bcf0b8dbc648b128303a49777a094b57592c')
Children:
8c5a578cc8481c8a133a58030c4c4c8227d82bb1
Parents:
6d09c564c80f079b501f7187cf6984d040603849
Message:
Mon Apr 28 21:00:07 1997  Olaf Bachmann
<obachman@ratchwum.mathematik.uni-kl.de (Olaf Bachmann)>

     * dunno why I am committing these libs -- have not modified any
       of them


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

Legend:

Unmodified
Added
Removed

  • Singular/LIB/deform.lib

    r6d09c56 r6f2edc  
    1 // $Id: deform.lib,v 1.1.1.1 1997-04-25 15:13:25 obachman Exp $
    2 //(BM+GMG)
     1// $Id: deform.lib,v 1.2 1997-04-28 19:27:15 obachman Exp $
     2//(BM/GMG, last modified 22.06.96)
    33///////////////////////////////////////////////////////////////////////////////
    44LIBRARY:  deform.lib    PROCEDURES FOR COMPUTING MINIVERSAL DEFORMATION
    55
    66 miniversal(id[,deg]);  miniversal deformation of an isolated singularity id
    7  
     7
    88  SUB-PROCEDURES        used by main procedure:
    99  apply_col(A,B);       put A into col-nf and apply same col-operations to B
    … …  
    1515LIB "inout.lib";
    1616LIB "general.lib";
    17 LIB "sing.lib"; 
     17LIB "sing.lib";
    1818LIB "matrix.lib";
    1919///////////////////////////////////////////////////////////////////////////////
    2020
    2121proc miniversal (ideal id,list #)
    22 USAGE:   miniversal(id[,d,na,va,o,iv]); id=ideal, d=integer, 
     22USAGE:   miniversal(id[,d,na,va,o,iv]); id=ideal, d=integer,
    2323         na,va,o=strings, iv=intvec of positive integers
    2424COMUPTE: miniversal deformation of id up to degree d (default d=100)
    … …  
    2626         the basering by new variables given by va (deformation parameters).
    2727         -- The new vars come before the old vars
    28          -- The characteristic of `na`is the characteristic of the basering.
    29          -- The new vars are derived from va. If va is a single letter, say 
    30             va="T", and if n<=26 then T and the following n-1 letters from 
    31             T..Z..T (resp. T(1..n) if n>26) are taken as additional variables. 
    32             If va is a single letter followed by (, say va="x(", the new 
     28         -- The characteristic of `na`   is the characteristic of the basering.
     29         -- The new vars are derived from va. If va is a single letter, say
     30            va="T", and if n<=26 then T and the following n-1 letters from
     31            T..Z..T (resp. T(1..n) if n>26) are taken as additional variables.
     32            If va is a single letter followed by (, say va="x(", the new
    3333            variables are x(1),...,x(n) (default va="A").
    3434         -- The ordering is the product ordering between the ordering of r and
    35             an ordering derived from `o`, which has to be local!! (default: 
    36             o="ds") [and iv (a weight vector)]. 
     35            an ordering derived from `o`, which has to be local!! (default:
     36            o="ds") [and iv (a weight vector)].
    3737            Type 'help extendring' for a more detailed explanation of the
    38             ordering 
    39          -- Even if na,va,o are given, d and/or iv may be ommited. Then the 
     38            ordering
     39         -- Even if na,va,o are given, d and/or iv may be ommited. Then the
    4040            default values d=100, iv=0 (i.e. all weights = 1) are used.
    4141         The procedure creates also two ideals:
    4242            ideal jetJ - defining the miniversal base space (in `na`)
    4343            ideal jetF - defining miniversal total space (in `na`)
    44 NOTE:    int printlevel=2;  shows what is going on
    45          int printlevel=3;  shows also memory usage
    46          This proc uses 'execute' or calls a procedure using 'execute'.
    47          If you use it in your own proc, let the local names of your proc
     44NOTE:    printlevel >=0: display dimT1,T2 and explain created objects (default)
     45         printlevel >=1: show partial + final result during computation
     46         printlevel >=2: show also memory and time usage
     47         printlevel >=3: test and show obstructions
     48         printlevel >=4: create a file 'minbaseout' and (over) write part of
     49                         ideal of miniversal base up to current degree into it
     50         This proc uses 'execute' or calls a procedure using 'execute'.
     51         If you use it in your own proc, let the local names of your proc
    4852         start with @ (see the file HelpForProc)
    49 EXAMPLE: example miniversal; shows an example 
     53EXAMPLE: example miniversal; shows an example
    5054{
    5155//------- initialisation ------------------------------------------------------
    52    int @d,@deg,@t1,@t2,@colR,@noObstr;
     56   int @d,@deg,@t1,@t2,@colR,@noObstr,@j;
     57   int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
    5358   intvec @iv,@jv;
    5459   string @na,@va,@o;
    … …  
    6065   if( size(#)==4 ) { @deg=#[1]; @na=#[2];  @va=#[3]; @o=#[4];}
    6166   if( size(#)==5 ) { @deg=#[1]; @na=#[2];  @va=#[3]; @o=#[4]; @iv=#[5]; }
    62    if( find(@o,"s")==0 ) 
     67   if( find(@o,"s")==0 )
    6368   { "// ordering must be an s-ordering, please change!"; return();}
    64  
    65   def @Pn = basering; 
    66    string @ords = ordstr(@Pn);   
     69
     70  def @Pn = basering;
     71   string @ords = ordstr(@Pn);
    6772   id = simplify(id,10);
    6873   int @rowR = size(id);
    6974   if( @rowR<=1 )
    70    { 
     75   {
    7176      "// hypersurface, use proc deform from sing.lib";
    7277      return();
    73    }   
     78   }
    7479//------- change ordering if not correct --------------------------------------
    7580   @t1=1;
    76    for( @d=1;@d<=nvars(@Pn);@d++ ) { @t1=@t1*(lead(1+var(@d))==var(@d)); }
     81   for( @d=1;@d<=nvars(@Pn);@d=@d+1 ) { @t1=@t1*(lead(1+var(@d))==var(@d)); }
    7782   if( @t1==0 )
    7883   {
    79       if( @ords[size(@ords)]!="c" and @ords[size(@ords)]!="C" ) 
    80       { 
     84      if( @ords[size(@ords)]!="c" and @ords[size(@ords)]!="C" )
     85      {
    8186         if( @ords[1]=="c" ) { @ords=@ords[3,size(@ords)-2]+",c"; @t1=1;}
    8287         if( @ords[1]=="C" ) { @ords=@ords[3,size(@ords)-2]+",C"; @t1=1;}
    8388      }
    84       if( @t1==1 ) 
    85       { 
     89      if( @t1==1 )
     90      {
    8691         changeord("@On",@ords,@Pn);
    8792         ideal id  = imap(@Pn,id);
    … …  
    9095   if( defined(@On)==0 ) { def @On=@Pn; setring @On; }
    9196//-------  reproduce T12 -------------------------------------------------------
    92    list   Ls   = T12(id,1); 
    93    matrix Ro   = Ls[4];                         //syz(i)
    94    matrix InfD = Ls[3];                         //matrix of inf. deformations
    95    matrix PreO = Ls[5];                         //present. mat of Syz/Kos^*
    96    module PreT = Ls[2];                         //present. module of modT2
    97    @t1 = Ls[8];                                 //vdim of T1
    98    @t2 = Ls[9];                                 //vdim of T2
     97   list   Ls   = T12(id,1);
     98   matrix Ro   = Ls[6];                         //syz(i)
     99   matrix InfD = Ls[5];                         //matrix of inf. deformations
     100   matrix PreO = Ls[7];                         //present. mat of Syz/Kos^*
     101   module PreT = Ls[9];                         //present. module of modT2
     102   @t1 = Ls[3];                                 //vdim of T1
     103   @t2 = Ls[4];                                 //vdim of T2
    99104   kill Ls;
    100    dbpri(2,"","// ___ matrix of infinitesimal deformations:",InfD);
    101    @colR = ncols(Ro);                 
     105   dbprint(p-1,"","// ___ matrix of infinitesimal deformations:",InfD);
     106   @colR = ncols(Ro);
    102107   ideal i0 = std(id);
    103108  qring @Ox = i0;                               //ring of singularity to deform
    104    matrix Cup,lCup; module PreT;
     109   matrix Cup,lCup;
    105110   ideal testid;
    106111   matrix Ro   = fetch(@On,Ro);
    107112   matrix PreO = fetch(@On,PreO);
     113   module PreT = fetch(@On,PreT);
    108114//---- create new ring with @t1=dim T1 additional variables and initialize ----
    109115
    … …  
    116122   export jetF;
    117123   matrix Fo = matrix(jetF);                    //initial equations
    118    matrix Rs = imap(@On,Ro);                    //deformed syzygies
     124   matrix Ro = imap(@On,Ro);
     125   matrix Rs = imap(@On,Ro);                    //deformed syzygies
    119126   ideal  jetJ;                                 //(jet)ideal of minversal defor
    120127   export jetJ;
    … …  
    132139   jetF= Fs;
    133140   F_R = Fs*Rs;
    134    if (@t2<=0) { @d=0; }                         //finished, if "T2=0" 
     141   if (@t2<=0) { @d=0; }                         //finished, if "T2=0"
    135142//------- start the loop ------------------------------------------------------
    136    for (@d=1;@d<=@deg;@d++)
    137    {
    138       dbpri(2,"","// ___ start computation in degree "+string(@d)+":");
    139       dbpri(3,"memory="+string(kmemory())+"k");
     143   for (@d=1;@d<=@deg;@d=@d+1)
     144   {
     145      dbprint(p-1,"","// ___ start computation in degree "+string(@d)+":");
     146      dbprint(p-2,"// memory = "+string(kmemory())+"k");
    140147//------- lift relation to next degree ----------------------------------------
    141       F_r = reduce_s(F_R,Jo,@d+1); 
     148      F_r = reduce_s(F_R,Jo,@d+1);
    142149      Cup = matrix(jet(F_r,@d,@jv),1,@colR);
    143150      Rn  = (-1)*lift(Fo,Cup);
    144151      Rs  = Rs + Rn;
    145       F_R = F_R + Fs*Rn; 
     152      F_R = F_R + Fs*Rn;
    146153//------- test: already finished? ---------------------------------------------
    147154      testid = simplify(reduce(ideal(F_R),Jo),10);
    148155      if (testid[1]==0)
    149       {
    150          "// computation finished in degree "+string(@d);
    151          if( @d==@deg )
    152          {"// degree bound reached, result may not yet be complete!";}
     156      {  dbprint(p,"// ___ computation finished in degree "+string(@d));
     157         if( @d==@deg )
     158         { dbprint(p,"// ___ degree bound reached, result may not yet be complete!");}
    153159         break;
    154160      }
    155161//------- compute obstruction-matrix  -----------------------------------------
    156       F_r = reduce_s(F_R,Jo,@d+1); 
    157       Cup = matrix(jet(F_r,@d+1,@jv),1,@colR); 
     162      F_r = reduce_s(F_R,Jo,@d+1);
     163      Cup = matrix(jet(F_r,@d+1,@jv),1,@colR);
    158164      Test= Cup;
    159       dbpri(2,"","// ___ obstruction vector:",ideal(Cup));
     165      dbprint(p-3,"","// ___ obstruction vector:",ideal(Cup));
    160166      Cup,Mon = coef_ideal(Cup,@t1);
    161167//------- express obstructions in kbase of T2  --------------------------------
    … …  
    163169      Cup  = imap(`@na`,Cup);
    164170      lCup = lift(PreO,Cup);
    165       PreT = fetch(@On,PreT);
    166171      lCup = lift_kbase(lCup,PreT);
    167172      @t2   = nrows(lCup);
    168       dbpri(2,"","// ___ obstructions in kbase of T2:",lCup);
    169       testid = simplify(ideal(lCup),10);           // test no obstructions
     173      dbprint(p-3,"","// ___ obstructions in kbase of T2:",lCup);
     174      testid = simplify(ideal(lCup),10);               // test no obstructions
    170175      if (testid[1]==0)
    171       { @noObstr=1; } else { @noObstr=0; }
    172 //------- compute ideal of minversal(its k-jet) -------------------------------
     176      { @noObstr=1;dbprint(p-3,"// ___ no obstruction"); } else { @noObstr=0; }
     177      @j=size(module(gauss_col(lCup)));                // test:full obstruction
     178      if (@j==ncols(lCup))
     179      {  dbprint(p,"","// nothing to lift!",
     180         "// ___ miniversal base, defined by jetJ, is a fat point!");
     181         break;
     182      }
     183//------- compute ideal of minversal base (its k-jet) -------------------------
    173184   setring `@na`;
    174       if (@noObstr==0)                              //case of non-zero obstr.     
     185      if (@noObstr==0)                              //case of non-zero obstr.
    175186      {
    176187         lCup = imap(@Ox,lCup);
    177188         Jo   = lCup*transpose(Mon);
    178          jetJ = matrix(jetJ,1,@t2)+matrix(Jo,1,@t2);
    179          dbpri(2,"","// ___ degree-"+string(@d+1)+"-part of ideal of miniversal base"+":",Jo);
     189         jetJ = matrix(jetJ,1,@t2)+matrix(Jo,1,@t2);
     190         dbprint(p-1,"","// ___ degree-"+string(@d+1)+"-part of ideal of miniversal base"+":",Jo);
     191         if( p-1>=4 )
     192         { write (">minbaseout","// part of ideal of miniversal base up to degree <= "+string(@d+1)+":",jetJ); }
    180193         Jo = std(jetJ);
    181 //------- choose a defining system --------------------------------------------
    182          @iv,Cup = defining_system(lCup,Cup);
    183          dbpri(2,"","// ___ number of cols of defining system:",@iv);
    184 //------- lift the equations --------------------------------------------------
    185          if (sum(@iv)==0)
    186          {
    187             "// nothing to lift!";
    188             "// miniversal base, defined by jetJ, is a fat point!";break;
    189          }
    190    setring @Ox;
    191          Cup = imap(`@na`,Cup);
    192          Cup = submat(Cup,1..nrows(Cup),@iv);
    193          dbpri(2,"","// ___ matrix of defining system:",Cup);
    194       }
    195       else                                         // case of zero obstructions
    196       {       
    197    setring @Ox;
    198          Cup = imap(`@na`,Cup);
    199       }   
    200       Cup = lift(transpose(Ro),module(Cup));
    201    setring `@na`;
    202       Cup = imap(@Ox,Cup);
    203       if (@noObstr==0)
    204       {  Mon = submat(Mon,1..nrows(Mon),@iv); }
    205       Fn  = (-1)*transpose(Cup*transpose(Mon));
     194      }
     195      F_r = reduce_s(F_R,Jo,@d+1);
     196      Cup = matrix(jet(F_r,@d+1,@jv),1,@colR);
     197//---------------- repeat test: jetJ ok in deg d+1? --------------------------
     198      if( (p-1>=3) && (@noObstr==0) )
     199      {
     200         lCup,Mon = coef_ideal(Cup,@t1);
     201      setring @Ox;
     202         Cup  = imap(`@na`,Cup);
     203         lCup = lift(PreO,Cup);
     204         lCup = lift_kbase(lCup,PreT);
     205         dbprint(p-3,"","// ____ test: jetJ ok iff all entries are 0",lCup);
     206      setring `@na`;
     207      }
     208//---------------- lift equations F -----------------------------------------
     209      if (defined(Qrg)) {kill Qrg;}
     210  qring Qrg = std(ideal(Fo));
     211      def Ro=fetch(`@na`,Ro);
     212      def Cup=fetch(`@na`,Cup);
     213      def Fn = lift(transpose(Ro),transpose(Cup));
     214      Fn=(-1)*transpose(Fn);
     215  setring `@na`;
     216      Fn  = fetch(Qrg,Fn);
    206217      Fs  = Fs+Fn;
    207       F_R = F_R+Fn*Rs; 
     218      F_R = F_R+Fn*Rs;
    208219      jetF = matrix(Fs);
    209       dbpri(2,"","// ___ degree-"+string(@d+1)+"-part of deformed equations:",Fn);
    210    } 
     220      dbprint(p-1,"","// ___ degree-"+string(@d+1)+"-part of deformed equations:",Fn);
     221   }
    211222//---------  end loop and final output ---------------------------------------
    212   "";
    213   "// ___ Equations of miniversal base space ___";jetJ; "";
    214   "// ___ Equations of miniversal total space ___";jetF; "";
    215   "// Result belongs to ring",@na,"(total space of miniversal deformation).";
    216   "// Make",@na,"the basering and list objects defined in",@na,"by typing:";
    217   "   setring",@na,"; show("+@na+");";
    218   "   listvar(ideal);";
    219   kill @On; 
     223dbprint(p-1,"","// ___ Equations of miniversal base space ___",jetJ,
     224            "","// ___ Equations of miniversal total space ___",jetF);
     225dbprint(p,"","// Result belongs to ring "+@na+".",
     226       "// Equations of total space of miniversal deformation are ",
     227       "// given by jetF, equations of miniversal base space by jetJ.",
     228       "// Make "+@na+" the basering and list objects defined in "+@na+" by typing:",
     229       "   setring "+@na+"; show("+@na+");","   listvar(ideal);");
     230  kill @On;
    220231  return();
    221232}
    222 example 
     233example
    223234{ "EXAMPLE:"; echo = 2;
    224    ring r1=0,(x,y,z,u,v),ds;
    225    matrix m[2][4]=x,y,z,u,y,z,u,v;
    226    ideal i=minor(m,2);          //cone over rational normal curve of degree 4
     235   int p          = printlevel;
     236   ring r1        = 0,(x,y,z,u,v),ds;
     237   matrix m[2][4] = x,y,z,u,y,z,u,v;
     238   ideal i        = minor(m,2);          //cone over rational normal curve of degree 4
    227239   miniversal(i,"R","T(");
    228    // hit return-key to continue;
    229    // pause;
    230    ring  r = 0,(x,y,z),ds;
    231    ideal i = x2,xy,yz,zx;
    232    printlevel = 2;
    233    miniversal(i);"";
    234    kill printlevel;
    235 // NOTE: rings R and Ont are still alive!
    236 } 
    237 ///////////////////////////////////////////////////////////////////////////////
    238 
    239 proc apply_col (matrix A, matrix B)
     240   setring R;"";
     241   // ___ Equations of miniversal base space ___:
     242   jetJ;"";
     243   // ___ Equations of miniversal total space ___:
     244   jetF;"";
     245   ring  r        = 0,(x,y,z),ds;
     246   ideal i        = x2,xy,yz,zx;
     247   printlevel     = 3;
     248   miniversal(i);"";
     249   printlevel     = p;
     250   // NOTE: rings R and Ont are still alive!
     251}
     252///////////////////////////////////////////////////////////////////////////////
     253
     254proc apply_col (matrix A, matrix B)
    240255USAGE:   apply_col(A,B);  A,B=matrices
    241 ASSUME:  A = constant matrix in row-reduced (upper triangular) normal form, 
     256ASSUME:  A = constant matrix in row-reduced (upper triangular) normal form,
    242257         B = matrix of same size
    243258COMUPTE: apply to B those col-operations which reduce A into col-reduced nf
    244259RETURN:  two transformed matrices: col-reduced A, transformed B
    245 EXAMPLE: example apply_col; shows an example 
     260EXAMPLE: example apply_col; shows an example
    246261{
    247262   int i,j,k;
    … …  
    251266   matrix C  = concat(transpose(A),transpose(B));
    252267   module mC = transpose(C);
    253    for( k=1;k<=r;k++ )
     268   for( k=1;k<=r;k=k+1 )
    254269   {
    255270      j=1;
    256       while( C[j,k]==0 && j<c ) { j++; }
    257       for( i=j+1;i<=c;i++ )
     271      while( C[j,k]==0 && j<c ) { j=j+1; }
     272      for( i=j+1;i<=c;i=i+1 )
    258273      {
    259274         m = C[i,k];
    260          mC[i] = mC[i]-m*mC[j]; 
     275         mC[i] = mC[i]-m*mC[j];
    261276      }
    262277   }
    … …  
    266281   return(transpose(a),transpose(b));
    267282}
    268 example 
     283example
    269284{ "EXAMPLE:"; echo = 2;
    270285   ring R=0,(x,y,z),dp;
    … …  
    279294///////////////////////////////////////////////////////////////////////////////
    280295
    281 proc defining_system (matrix A,matrix B) 
     296proc defining_system (matrix A,matrix B)
    282297USAGE:   defining_system(A,B);  A,B=matrices
    283298ASSUME:  A a constant matrix
    … …  
    287302RETURN:  two objects: intvec iv, matrix M (the transformed matrix B)
    288303         The columns of M with index from iv are a defining sytem
    289 EXAMPLE: example defining_system; shows an example 
     304EXAMPLE: example defining_system; shows an example
    290305{
    291306   int    k,l;
    … …  
    295310   int rg = ncols(A);
    296311   A,B    = apply_col(A,B);                // special columne-reduction
    297    for( k=1;k<=rg;k++ )                  // collect zero-cols of B
    298    {
    299       if( A[k]==0) {l++;iv[l]=k;}        // test if kth column is 0
     312   for( k=1;k<=rg;k=k+1 )                  // collect zero-cols of B
     313   {
     314      if( A[k]==0) {l=l+1;iv[l]=k;}        // test if kth column is 0
    300315   }                                       // collect indices of 0-columns in iv
    301316   return(iv,B);
    302317}
    303 example 
     318example
    304319{ "EXAMPLE:"; echo = 2;
    305320   ring R=0,(x,y,z),dp;
    … …  
    323338  int d,k;
    324339  ideal j0 = std(j);
    325   for (k=1;k<=m;k++)
     340  for (k=1;k<=m;k=k+1)
    326341  {
    327342    if (deg(i[k])>=0)
    … …  
    333348  return(i);
    334349}
    335 example 
     350example
    336351{ "EXAMPLE:"; echo = 2;
    337352   ring r = 0,(x,y),ds;
    338353   poly f = x7+y7+(x-y)^2*x^2*y^2;
    339354   ideal j = jacob(f);
    340    reduce_s(f,j,10); 
     355   reduce_s(f,j,10);
    341356}
    342357///////////////////////////////////////////////////////////////////////////////
    … …  
    344359proc lift_kbase (N, M)
    345360USAGE:   lift_kbase(N,M); N,M=poly/ideal/vector/module
    346 RETURN:  matrix A, coefficient matrix expressing N as linear combination of 
    347          k-basis of M. Let the k-basis have k elements and A c columns.
     361RETURN:  matrix A, coefficient matrix expressing N as linear combination of
     362         k-basis of M. Let the k-basis have k elements and size(N)=c columns.
    348363         Then A satisfies:
    349364             matrix(reduce(N,std(M)),k,c) = matrix(kbase(std(M)))*A
    350 ASSUME:  dim(M)=0 and the monomial ordering is a well ordering or the last 
     365ASSUME:  dim(M)=0 and the monomial ordering is a well ordering or the last
    351366         block of the ordering is c or C
    352367EXAMPLE: example lift_kbase; shows an example
    … …  
    360375//------- check wether ordering is correct ------------------------------------
    361376   k=1;
    362    for( l=1;l<=nvars(basering);l++ ) { k=k*(lead(1+var(l))==var(l)); }
     377   for( l=1;l<=nvars(basering);l=l+1 ) { k=k*(lead(1+var(l))==var(l)); }
    363378   if( k==0 )
    364379   {
    365       if( ords[size(ords)]!="c" and ords[size(ords)]!="C" ) 
    366       { 
     380      if( ords[size(ords)]!="c" and ords[size(ords)]!="C" )
     381      {
    367382         "// change ordering!";
    368          "// ordering "+ordstr(basering)+" not implemented for this proc"; 
    369          return(); 
     383         "// ordering "+ordstr(basering)+" not implemented for this proc";
     384         return();
    370385      }
    371386   }
    … …  
    377392   if( d<1 )
    378393   { "// second argument in `lift_kbase` has vdim",d; return(); }
    379 //----------  compute kbase and reduce(N,M) ----------------------------------- 
     394//----------  compute kbase and reduce(N,M) -----------------------------------
    380395   kb = kbase(M);
    381396   col = ncols(N);
    382397   N = reduce(N,M);
     398   N = matrix(N,nrows(N),col);
    383399//----------  collecting coefficients of reduce(N,M) --------------------------
    384400   matrix result[d][col];
    … …  
    389405      {
    390406         for( k=1;k<=d;k=k+1 )
    391          { 
     407         {
    392408            p = kb[k];
    393             q = lead(v); 
     409            q = lead(v);
    394410            if( size(p-q)<2 )
    395411            {
    … …  
    399415               else { k=0; }
    400416            }
    401          }   
     417         }
    402418      }
    403419   }
    404420//---------  final test -------------------------------------------------------
    405421   testm = matrix(N,nrows(kb),ncols(result))- matrix(kb)*result;
    406    if( size(module(testm))!=0 ) 
    407    { 
     422   if( size(module(testm))!=0 )
     423   {
    408424      "// proc `lift_kbase` did'nt work correctly!";
    409425      "// Please inform tthe authors";
    … …  
    413429}
    414430example
    415 {
    416   "EXAMPLE:";     echo=2;
     431{"EXAMPLE:";     echo=2;
    417432  ring R=0,(x,y),ds;
    418433  module M=[x2,xy],[y2,xy],[0,xx],[0,yy];
    … …  
    432447ASSUME:  M=matrix with only one row and without any constant term
    433448COMPUTE: coef_matrices with respect to first s variables
    434 RETURN:  2 matrices: 
     449RETURN:  2 matrices:
    435450         matrix of coefficients (each column is formed by the coefficients
    436            of M with respect to some monomial) 
    437          row-matrix of corresponding monomials 
     451           of M with respect to some monomial)
     452         row-matrix of corresponding monomials
    438453EXAMPLE: example coef_ideal; shows an example
    439454{
    440455  int   k,l,n,z;
    441456  int   cM = ncols(M);
    442   ideal flatM = M; 
     457  ideal flatM = M;
    443458  ideal monId,flat;
    444459  poly  mon = product(maxideal(1),1..s);
    445460//--------- collect all monomials (!=1) ---------------------------------------
    446   for (k=1;k<=cM;k++)
     461  for (k=1;k<=cM;k=k+1)
    447462  {
    448463    matrix mci(k) = coef(flatM[k],mon);
    … …  
    450465    if (flat[1]!=1)
    451466    { monId = monId,flat;}
    452   } 
     467  }
    453468  monId = monId+ideal(0);
    454469  k=size(monId);
    455470  matrix BIG[cM][k];
    456471//---------  create coef_matrices  --------------------------------------------
    457   for (n=1;n<=k;n++)
     472  for (n=1;n<=k;n=n+1)
    458473  {
    459     for (l=1;l<=cM;l++)
     474    for (l=1;l<=cM;l=l+1)
    460475    {
    461       for (z=1;z<=ncols(mci(l));z++)
     476      for (z=1;z<=ncols(mci(l));z=z+1)
    462477      {
    463478        if(mci(l)[1,z]==monId[n])
    464479        { BIG[l,n] = mci(l)[2,z];}
    465       }   
     480      }
    466481    }
    467   } 
     482  }
    468483  return(BIG,matrix(monId));
    469 } 
    470 example 
     484}
     485example
    471486{ "EXAMPLE:"; echo = 2;
    472487  ring Z = 0,(A,B,C,x,y,z),ds;
    473   int  s = 3; 
     488  int  s = 3;
    474489  matrix M[1][4]=A+yB,2C,3AA,4BB+5CC;
    475490  print(M);
    … …  
    480495}
    481496///////////////////////////////////////////////////////////////////////////////
    482 ----------
    483 
    484 "example in r1: i=cone rational normal curve d=4";
    485 int d=4;
    486 ring r1=0,(x,y,z,u,v),ds;
    487 matrix m[2][4]=x,y,z,u,y,z,u,v;
    488 ideal i=minor(m,2);
    489 i=minbase(i);
    490 i;pause;
    491 int t=timer;miniversal(i);timer-t;
    492 ----------
    493 
    494 "example: in r4 i=cone rational normal curve d=5";
    495 int d=5;
    496 ring s=0,(x,y,z,u,v,w),ds;
    497 matrix m[2][5]=x,y,z,u,v,y,z,u,v,w;
    498 ideal i=minor(m,2);
    499 i=minbase(i);
    500 i;pause;
    501 
    502 ----------
    503 
    504 "Example: in r5 i=L_n^n,   n=4;";
    505 ring r5=0,(x,y,z,u),ds;
    506 ideal i;
    507 i=xy,xz,xu,yz,yu,zu;
    508 i;pause;
    509 
    510 ----------
    511 
    512 "Example 1 : cyclic quotient  in ws   
    513       (type setring r1;sud(i);)";
    514 ring r1=0,(x,y,z,u,v),ws(4,3,2,3,4);
    515 ideal i=xz-y2,yz2-xu,xv-yzu,yu-z3,z2u-yv,zv-u2;
    516 i;
    517 
    518 "Example 2: same in wp
    519       (ringr r2)";
    520 ring r2=0,(x,y,z,u,v),wp(4,3,2,3,4);
    521 ideal i=xz-y2,yz2-xu,xv-yzu,yu-z3,z2u-yv,zv-u2;
    522 i;
    523 
    524 "Example 3: same in ls";
    525 ring r3=0,(x,y,z,u,v),ls;
    526 ideal i=xz-y2,yz2-xu,xv-yzu,yu-z3,z2u-yv,zv-u2;
    527 i;
    528 
    529 "Example 4: by chance for testing";
    530 ring r4=0,(x,y,z),ds;
    531 ideal i=xy,yz,xz+y3,x2+y2+z3;
    532 i;
    533 
Note: See TracChangeset for help on using the changeset viewer.