Changeset 67e0dc in git for Singular/LIB/grobcov.lib


Ignore:
Timestamp:
Oct 21, 2015, 2:57:17 PM (8 years ago)
Author:
Hans Schoenemann <hannes@…>
Branches:
(u'spielwiese', '5b153614cbc72bfa198d75b1e9e33dab2645d9fe')
Children:
5bd9ec36b87fa8f176a21995de2b56724d67be2d
Parents:
a1b6c917a1c8886b1bba1b05680ff06cfd39c82def1a968e317a12b42f88e04cd7f9483e47fba2f7
Message:
Merge pull request #718 from adipopescu/STDChanes2

Std over rings
File:
1 edited

Legend:

Unmodified
Added
Removed
  • Singular/LIB/grobcov.lib

    ref1a96 r67e0dc  
    11//
    2 version="version grobcov.lib 4.0.1.2 Jan_2015 "; // $Id$
     2version="version grobcov.lib 4.0.2.0 Jul_2015 "; // $Id$
     3           // version L;  July_2015;
    34category="General purpose";
    45info="
     
    5455            Groebner Cover, and new theoretical developments have been done.
    5556
     57            The actual version also includes a routine (ConsLevels)
     58            for computing the canonical form of a constructible set, given as a
     59            union of locally closed sets. It is used in the new version for the
     60            computation of loci and envelops. It determines the canonical locally closed
     61            level sets of a constructuble. They will be described in a forthcoming paper:
     62
     63             J.M. Brunat, A. Montes,
     64            \"Computing the canonical representation of constructible sets\".
     65            Submited to Mathematics in Computer Science. July 2015.
     66
    5667            A new set of routines (locus, locusdg, locusto) has been included to
    5768            compute loci of points. The routines are used in the Dynamic
     
    6980             \''Envelops in Dynamic Geometry using the Groebner cover\''.
    7081
    71             The actual version also includes two routines (AddCons and AddconsP)
    72             for computing the canonical form of a constructible set, given as a
    73             union of locally closed sets. They are used in the new version for the
    74             computation of loci and envelops. It determines the canonical locally closed
    75             level sets of a constructuble. They will be described in a forthcoming paper:
    76 
    77             A. Montes, J.M. Brunat,
    78             \"Canonical representations of constructible sets\".
    79 
    80             This version was finished on 31/01/2015
     82
     83            This version was finished on 31/07/2015
    8184
    8285NOTATIONS: All given and determined polynomials and ideals are in the
     
    8588@*         grobcov, cgsdr,
    8689@*         generate the global rings
    87 @*         Grobcov::@R   (Q[a][x]),
    88 @*         Grobcov::@P   (Q[a]),
    89 @*         Grobcov::@RP  (Q[x,a])
     90@*         @R   (Q[a][x]),
     91@*         @P   (Q[a]),
     92@*         @RP  (Q[x,a])
    9093@*         that are used inside and killed before the output.
    91 @*         If you want to use some internal routine you must
    92 @*         create before the above rings by calling setglobalrings();
    93 @*         because some of the internal routines use these rings.
    94 @*         The call to the basic routines grobcov, cgsdr will
    95 @*         kill these rings.
    9694
    9795PROCEDURES:
     
    109107             (the own routine of 2010 that is no more used).
    110108             Now, KSW algorithm is used.
    111 
    112 setglobalrings();  Generates the global rings @R, @P and @PR that
    113               are respectively the rings Q[a][x], Q[a], Q[x,a].  (a=parameters,
    114              x=variables) It is called inside each of the fundamental
    115              routines of the library: grobcov, cgsdr, locus, locusdg and
    116              killed before the output.
    117109
    118110pdivi(f,F); Performs a pseudodivision of a parametric polynomial
     
    138130             the bases are computed, and one can obtain the full
    139131             representation using extend.
     132
     133ConsLevels(L); Given a list L of locally closed sets, it returns the canonical levels
     134             of the constructible set of the union of them, as well as the levels
     135             of the complement. It is described in the paper
     136
     137             J.M. Brunat, A. Montes,
     138            \"Computing the canonical representation of constructible sets\".
     139            Submited to Mathematics in Computer Science. July 2015.
    140140
    141141locus(G);    Special routine for determining the geometrical locus of points
     
    178178             \''Envelops in Dynamic Geometry using the Gr\"obner cover\''.
    179179
    180 
    181180envelopdg(ev); Is a special routine to determine the 'Relevant' components
    182181             of the envelop of a family of curves to be used in Dynamic Geometry.
    183182             It must be called to the output of envelop(F,C).
    184183
    185 locusto(L); Transforms the output of locus, locusdg, envelop and  envelopdg
     184locusto(L); Transforms the output of locus, locusdg, envelop and envelopdg
    186185             into a string that can be reed from different computational systems.
    187186
    188 AddCons(L); Uses the routine AddConsP. Given a set of locally closed sets as
    189              difference of of varieties (does not need to be in C-representation)
    190              it returns the canonical P-representation of the constructible set
    191              formed by the union of them. The result is formed by a set of embedded,
    192              disjoint, locally closed sets (levels).
    193 
    194 AddConsP(L);  Given a set of locally closed P-components, it returns the
    195              canonical P-representation of the constructible set
    196              formed by the union of them, consisting of a set of embedded,
    197              disjoint locally closed sets (levels).
    198              The routines AddCons and AddConsP and the canonical structure
    199              of the constructible sets will be described in a forthcoming paper.
    200 
    201              A. Montes, J.M. Brunat,
    202              \"Canonical representations of constructible sets\".
    203187
    204188SEE ALSO: compregb_lib
     
    228212// Uses KSW algorithm for cgsdr
    229213// Final data: 21-11-2013
    230 // Release K: (public)
    231 // Updated locus: 8-1-2015
    232 // Updated AddConsP and AddCons: 8-1-2015
    233 // Reformed many routines, examples and helps: 8-1-2015
     214// Release L: (public)
     215// New routine ConsLevels: 10-7-2015
     216// Updated locus: 10-7-2015 (uses Conslevels)
    234217// New routines for computing the envelop of a family of curves: 22-1-2015
    235 // Final data: 22-1-2015
     218// Final data: 22-7-2015
    236219
    237220//*************Auxiliary routines**************
     
    297280  if (size(l)==1 and i==1){return(L);}
    298281  // L=l[1];
    299   if(i==1)
    300   {
    301     for(j=2;j<=size(l);j++)
    302     {
    303       L[j-1]=l[j];
    304     }
    305   }
    306   else
     282  if(i>1)
    307283  {
    308284    for(j=1;j<=i-1;j++)
    309285    {
    310       L[j]=l[j];
    311     }
    312     for(j=i+1;j<=size(l);j++)
    313     {
    314       L[j-1]=l[j];
    315     }
     286      L[size(L)+1]=l[j];
     287    }
     288  }
     289  for(j=i+1;j<=size(l);j++)
     290  {
     291    L[size(L)+1]=l[j];
    316292  }
    317293  return(L);
     
    773749//}
    774750
    775 proc setglobalrings()
    776 "USAGE:   setglobalrings();
    777           No arguments
    778 RETURN:   After its call the rings @R=Q[a][x], @P=Q[a], @RP=Q[x,a] are
    779           defined as global variables.  (a=parameters, x=variables)
    780 NOTE: It is called internally by many basic routines of the
    781           library grobcov, cgsdr, extend, pdivi, pnormalf, locus, locusdg,
    782           envelop, envelopdg, and killed before the output.
    783           The user does not need to call it, except when it is interested
    784           in using some internal routine of the library that
    785           uses these rings.
    786           The basering R, must be of the form Q[a][x], (a=parameters,
    787           x=variables), and should be defined previously.
    788 KEYWORDS: ring, rings
    789 EXAMPLE:  setglobalrings; shows an example"
     751static proc setglobalrings()
     752// "USAGE:   setglobalrings();
     753//           No arguments
     754// RETURN: After its call the rings Grobcov::@R=Q[a][x], Grobcov::@P=Q[a],
     755//           Grobcov::@RP=Q[x,a] are defined as global variables.
     756//           (a=parameters, x=variables)
     757// NOTE: It is called internally by many basic routines of the
     758//           library grobcov, cgsdr, extend, pdivi, pnormalf, locus, locusdg,
     759//           envelop, envelopdg, and killed before the output.
     760//           The user does not need to call it, except when it is interested
     761//           in using some internal routine of the library that
     762//           uses these rings.
     763//           The basering R, must be of the form Q[a][x], (a=parameters,
     764//           x=variables), and should be defined previously.
     765// KEYWORDS: ring, rings
     766// EXAMPLE:  setglobalrings; shows an example"
    790767{
    791768  if (defined(@P))
     
    810787  setring(RR);
    811788};
    812 example
    813 {
    814   "EXAMPLE:"; echo = 2;
    815   ring R=(0,a,b),(x,y,z),dp;
    816   setglobalrings();
    817   R;
    818   Grobcov::@R;
    819   Grobcov::@P;
    820   Grobcov::@RP;
    821   ringlist(Grobcov::@R);
    822   ringlist(Grobcov::@P);
    823   ringlist(Grobcov::@RP);
    824 }
     789// example
     790// {
     791//   "EXAMPLE:"; echo = 2;
     792//   ring R=(0,a,b),(x,y,z),dp;
     793//   setglobalrings();
     794//   " ";"R=";R;
     795//   " ";"Grobcov::@R=";Grobcov::@R;
     796//   " ";"Grobcov::@P=";Grobcov::@P;
     797//   " ";"Grobcov::@RP=";Grobcov::@RP;
     798//  " "; "ringlist(Grobcov::@R)=";  ringlist(Grobcov::@R);
     799//  " "; "ringlist(Grobcov::@P)=";  ringlist(Grobcov::@P);
     800//  " "; "ringlist(Grobcov::@RP)=";  ringlist(Grobcov::@RP);
     801// }
    825802
    826803// cld : clears denominators of an ideal and normalizes to content 1
     
    15151492    }
    15161493  }
     1494  //"T_abans="; prep;
    15171495  if (size(prep)==0){prep=list(list(ideal(1),list(ideal(1))));}
     1496  //"T_Prep="; prep;
     1497  //def Lout=CompleteA(prep,prep);
     1498  //"T_Lout="; Lout;
    15181499  return(prep);
    15191500}
     
    39343915
    39353916//********************* End KapurSunWang *************************
     3917
     3918//********************* Begin ConsLevels ***************************
     3919
     3920static proc zeroone(int n)
     3921{
     3922  list L; list L2;
     3923  intvec e; intvec e2; intvec e3;
     3924  int j;
     3925  if(n==1)
     3926  {
     3927    e[1]=0;
     3928    L[1]=e;
     3929    e[1]=1;
     3930    L[2]=e;
     3931    return(L);
     3932  }
     3933  if(n>1)
     3934  {
     3935    L=zeroone(n-1);
     3936    for(j=1;j<=size(L);j++)
     3937    {
     3938      e2=L[j];
     3939      e3=e2;
     3940      e3[size(e3)+1]=0;
     3941      L2[size(L2)+1]=e3;
     3942      e3=e2;
     3943      e3[size(e3)+1]=1;
     3944      L2[size(L2)+1]=e3;
     3945    }
     3946  }
     3947  return(L2);
     3948}
     3949
     3950// Auxiliary routine
     3951// subsets: the list of subsets of (1,..n)
     3952static proc subsets(int n)
     3953{
     3954  list L; list L1;
     3955  int i; int j;
     3956  L=zeroone(n);
     3957  intvec e; intvec e1;
     3958  for(i=1;i<=size(L);i++)
     3959  {
     3960    e=L[i];
     3961    kill e1; intvec e1;
     3962    for(j=1;j<=n;j++)
     3963    {
     3964      if(e[n+1-j]==1)
     3965      {
     3966        if(e1==intvec(0)){e1[1]=j;}
     3967        else{e1[size(e1)+1]=j};
     3968      }
     3969    }
     3970    L1[i]=e1;
     3971  }
     3972  return(L1);
     3973}
     3974
     3975// Input a list A of locally closed sets in C-rep
     3976// Output a list B of a simplified list of A
     3977static proc SimplifyUnion(list A)
     3978{
     3979  int i; int j;
     3980  list L=A;
     3981  int n=size(L);
     3982  if(n<2){return(A);}
     3983  for(i=1;i<=size(L);i++)
     3984  {
     3985    for(j=1;j<=size(L);j++)
     3986    {
     3987      if(i != j)
     3988      {
     3989        if(equalideals(L[i][2],L[j][1])==1)
     3990        {
     3991          L[i][2]=L[j][2];
     3992        }
     3993      }
     3994    }
     3995  }
     3996  ideal T=ideal(1);
     3997  intvec v;
     3998  for(i=1;i<=size(L);i++)
     3999  {
     4000    if(equalideals(L[i][2],ideal(1)))
     4001    {
     4002      v[size(v)+1]=i;
     4003      T=intersect(T,L[i][1]);
     4004    }
     4005  }
     4006  if(size(v)>0)
     4007  {
     4008    for(i=1; i<=size(v);i++)
     4009    {
     4010      j=v[size(v)+1-i];
     4011      L=elimfromlist(L, j);
     4012    }
     4013  }
     4014  if(equalideals(T,ideal(1))==0){L[size(L)+1]=list(std(T),ideal(1))};
     4015  //string("T_n=",n," new n0",size(L));
     4016  return(L);
     4017}
     4018
     4019// Input: list(A)
     4020//          A is a list of locally closed sets in Crep. A=[[P1,Q1],[P2,Q2],..,[Pr,Qr]]
     4021//          whose union is a constructible set from
     4022// Output list [Lev,C]:
     4023//          where Lev is the Crep of the canonical first level of A, and
     4024//          C is the complement of the first level Lev wrt to the closure of A. The elements are given in Crep,
     4025static proc FirstLevel(list A)
     4026{
     4027  int n=size(A);
     4028  list T=zeroone(n);
     4029  ideal P; ideal Q;
     4030  list Cb;  ideal Cc=ideal(1);
     4031  int i; int j;
     4032  intvec t;
     4033  ideal Z=ideal(1);
     4034  list C;
     4035  for(i=1;i<=size(A);i++)
     4036  {
     4037    Z=intersect(Z,A[i][1]);
     4038  }
     4039  for(i=2; i<=size(T);i++)
     4040  {
     4041    t=T[i];
     4042    P=ideal(1); Q=ideal(0);
     4043    for(j=1;j<=n;j++)
     4044    {
     4045      if(t[n+1-j]==1)
     4046      {
     4047        Q=Q+A[j][2];
     4048      }
     4049      else
     4050      {
     4051        P=intersect(P,A[j][1]);
     4052      }
     4053    }
     4054    //"T_Q="; Q; "T_P="; P;
     4055    Cb=Crep(Q,P);
     4056    //"T_Cb="; Cb;
     4057    if(Cb[1][1]<>1)
     4058    {
     4059      C[size(C)+1]=Cb;
     4060      Cc=intersect(Cc,Cb[1]);
     4061    }
     4062  }
     4063  list Lev=list(Z,Cc);                //Crep(Z,Cc);
     4064  if(size(C)>1){C=SimplifyUnion(C);}
     4065  return(list(Lev,C));
     4066}
     4067
     4068// Input: list(A)
     4069//          A is a list of locally closed sets in Crep. A=[[P1,Q1],[P2,Q2],..,[Pr,Qr]]
     4070//          whose union is a constructible set from which the algorithm computes its canonical form.
     4071// Output:
     4072//     list [L,C] where
     4073//          where L is the list of canonical levels of A,
     4074//          and C is the list of canonical levels of the complement of A wrt to the closure of A.
     4075//          All locally closed sets are given in Crep.
     4076//          L=[[1,[p1,p2],[3,[p3,p4],..,[2r-1,[p_{2r-1},p_2r]]]] is the list of levels of A in Crep.
     4077//          C=[[2,p2,p3],[4,[p4,p5],..,[2s,[p_{2s},p_{2s+1}]]]  is the list of levels of C,
     4078//                                              the complement of S wrt the closure of A, in Crep.
     4079proc ConsLevels(list A)
     4080"USAGE:   ConsLevels(A);
     4081          A is a list of locally closed sets in Crep. A=[[P1,Q1],[P2,Q2],..,[Pr,Qr]]
     4082          whose union is a constructible set from which the algorithm computes its
     4083          canonical form.
     4084RETURN: A list with two elements: [L,C]
     4085          where L is the list of canonical levels of A, and C is the list of canonical
     4086          levels of the
     4087          complement of A wrt to the closure of A.
     4088          All locally closed sets are given in Crep.
     4089          L=[[1,[p1,p2],[3,[p3,p4],..,[2r-1,[p_{2r-1},p_2r]]]]
     4090          C=[[2,p2,p3],[4,[p4,p5],..,[2s,[p_{2s},p_{2s+1}]]]
     4091NOTE: The basering R, must be of the form Q[a]
     4092KEYWORDS: locally closed set, constructible set
     4093EXAMPLE:  ConsLevels; shows an example"
     4094{
     4095  list L; list C; int i;
     4096  list B; list T;
     4097  for(i=1; i<=size(A);i++)
     4098  {
     4099    T=Crep(A[i][1],A[i][2]);
     4100    B[size(B)+1]=T;
     4101  }
     4102  int level=0;
     4103  list K;
     4104  while(size(B)>0)
     4105  {
     4106    level++;
     4107    K=FirstLevel(B);
     4108    if(level mod 2==1){L[size(L)+1]=list(level,K[1]);}
     4109    else{C[size(C)+1]=list(level,K[1]);}
     4110    //"T_L="; L;
     4111    //"T_C="; C;
     4112    B=K[2];
     4113    //"T_size(B)="; size(B);
     4114  }
     4115  return(list(L,C));
     4116}
     4117example
     4118{ "EXAMPLE:"; echo = 2;
     4119// Example of ConsLevels with nice geometrical interpretetion and 2 levels
     4120
     4121if (defined(R)){kill R;}
     4122if (defined(@P)){kill @P; kill @R; kill @RP;}
     4123
     4124  ring R=0,(x,y,z),lp;
     4125  short=0;
     4126  ideal P1=x*(x^2+y^2+z^2-1);
     4127  ideal Q1=z,x^2+y^2-1;
     4128  ideal P2=y,x^2+z^2-1;
     4129  ideal Q2=z*(z+1),y,x*(x+1);
     4130
     4131  list Cr1=Crep(P1,Q1);
     4132  list Cr2=Crep(P2,Q2);
     4133
     4134  list L=list(Cr1,Cr2);
     4135  L;
     4136  // ConsLevels(L)=
     4137  ConsLevels(L);
     4138
     4139//----------------------------------------------------------------------
     4140// Begin Problem S93
     4141// Automatic theorem proving
     4142// Generalized Steiner-Lehmus Theorem
     4143// A.Montes, T.Recio
     4144
     4145// Bisector of A(-1,0) = Bisector of B(1,0) varying C(a,b)
     4146
     4147if(defined(R1)){kill R1;}
     4148ring R1=(0,a,b),(x1,y1,x2,y2,p,r),dp;
     4149ideal S93=(a+1)^2+b^2-(p+1)^2,
     4150                    (a-1)^2+b^2-(1-r)^2,
     4151                    a*y1-b*x1-y1+b,
     4152                    a*y2-b*x2+y2-b,
     4153                    -2*y1+b*x1-(a+p)*y1+b,
     4154                    2*y2+b*x2-(a+r)*y2-b,
     4155                    (x1+1)^2+y1^2-(x2-1)^2-y2^2;
     4156
     4157short=0;
     4158def GC93=grobcov(S93,"nonnull",ideal(b),"rep",1);
     4159//"grobcov(S93,'nonnull',ideal(b),"rep",1)="; GC93;
     4160
     4161list L0;
     4162for(int i=1;i<=size(GC93);i++)
     4163{
     4164   L0[size(L0)+1]=GC93[i][3];
     4165}
     4166
     4167def GC93ab=grobcov(S93,"nonnull",ideal(a*b),"rep",1);
     4168
     4169ring RR=0,(a,b),lp;
     4170
     4171list L1;
     4172L1=imap(R1,L0);
     4173// L1=Total elements of the grobcov(S93,'nonnull',ideal(b),'rep',1) to be added=
     4174L1;
     4175
     4176// Adding all the elements of grobcov(S93,'nonnull',ideal(b),'rep',1)=
     4177ConsLevels(L1);
     4178}
     4179
     4180//**************************** End ConsLevels ******************
    39364181
    39374182//******************** Begin locus ******************************
     
    45224767  locus(grobcov(S));
    45234768  kill R;
    4524   "********************************************";
     4769  //********************************************
    45254770
    45264771  ring R=(0,x,y),(x1,x2),dp;
     
    46114856  locusdg(locus(grobcov(S96)));
    46124857  kill R;
    4613   "********************************************";
     4858  //********************************************
    46144859  ring R=(0,a,b),(x4,x3,x2,x1),dp;
    46154860  ideal S=(x1-3)^2+(x2-1)^2-9,
     
    46224867  locusdg(locus(grobcov(S)));
    46234868  kill R;
    4624   "********************************************";
     4869  //********************************************
    46254870
    46264871  ring R=(0,x,y),(x1,x2),dp;
     
    46334878}
    46344879
    4635 // locusto: Transforms the output of locus to a string that
    4636 //      can be read by different computational systems.
     4880// locusto: Transforms the output of locus, locusdg, envelop and envelopdg
     4881//             into a string that can be reed from different computational systems.
    46374882// input:
    46384883//     list L: The output of locus
     
    47174962  locusto(locusdg(locus(grobcov(S))));
    47184963  kill R;
    4719   "********************************************";
     4964  //********************************************
    47204965
    47214966  // 1. Take a fixed line l: x1-y1=0  and consider
     
    47374982  locusto(envelopdg(envelop(F,C)));
    47384983  kill R;
    4739   "********************************************";
     4984  //********************************************
    47404985
    47414986  // Steiner Deltoid
     
    48045049  return(d);
    48055050}
    4806 
    4807 // // locusdgto: Transforms the output of locusdg to a string that
    4808 // //      can be read by different computational systems.
    4809 // // input:
    4810 // //     list L: The output of locus
    4811 // // output:
    4812 // //     string s: The output of locus converted to a string readable by other programs
    4813 // //                   Outputs only the relevant dynamical geometry components.
    4814 // //                   Without unnecessary parenthesis
    4815 // proc locusdgto(list LL)
    4816 // "USAGE: locusdgto(L);
    4817 //           The argument must be the output of locusdg of a parametrical ideal
    4818 //           It transforms the output into a string in standard form
    4819 //           readable in many languages (Geogebra).
    4820 // RETURN: The locusdg in string standard form
    4821 // NOTE: It can only be called after computing the locusdg(grobcov(F)) of the
    4822 //           parametrical ideal.
    4823 //           The basering R, must be of the form Q[a,b,..][x,y,..].
    4824 // KEYWORDS: geometrical locus, locus, loci.
    4825 // EXAMPLE:  locusdgto; shows an example"
    4826 // {
    4827 //   int i; int j; int k; int short0=short; int ojo;
    4828 //   int te=0;
    4829 //   short=0;
    4830 //   if(size(LL)==0){ojo=1; list L;}
    4831 //   else
    4832 //   {
    4833 //     def L=LL;
    4834 //   }
    4835 //   string s="["; string sf="]"; string st=s+sf;
    4836 //   if(size(L)==0){return(st);}
    4837 //   ideal p;
    4838 //   ideal q;
    4839 //   for(i=1;i<=size(L);i++)
    4840 //   {
    4841 //     if(L[i][3]=="Relevant")
    4842 //     {
    4843 //       s=string(s,"[[");
    4844 //       for (j=1;j<=size(L[i][1]);j++)
    4845 //       {
    4846 //         s=string(s,L[i][1][j],",");
    4847 //       }
    4848 //       s[size(s)]="]";
    4849 //       s=string(s,",[");
    4850 //       for(j=1;j<=size(L[i][2]);j++)
    4851 //       {
    4852 //         s=string(s,"[");
    4853 //         for(k=1;k<=size(L[i][2][j]);k++)
    4854 //         {
    4855 //           s=string(s,L[i][2][j][k],",");
    4856 //         }
    4857 //         s[size(s)]="]";
    4858 //         s=string(s,",");
    4859 //       }
    4860 //       s[size(s)]="]";
    4861 //       s=string(s,"]");
    4862 //       s[size(s)]="]";
    4863 //       s=string(s,",");
    4864 //     }
    4865 //   }
    4866 //   if(s=="["){s="[]";}
    4867 //   else{s[size(s)]="]";}
    4868 //   short=short0;
    4869 //   return(s);
    4870 // }
    4871 // example
    4872 // {"EXAMPLE:"; echo = 2;
    4873 //   ring R=(0,a,b),(x,y),dp;
    4874 //   short=0;
    4875 //   ideal S96=x^2+y^2-4,(b-2)*x-a*y+2*a,(a-x)^2+(b-y)^2-1;
    4876 //   "System="; S96; " ";
    4877 //   "locusdgto(locusdg(grobcov(S96)))=";
    4878 //   locusdgto(locusdg(grobcov(S96)));
    4879 // }
    48805051
    48815052static proc norspec(ideal F)
     
    48985069  exportto(Top,@RP);     // global ring K[x,a] with product order
    48995070  setring(RR);
    4900 
    49015071}
    49025072
     
    50595229}
    50605230
    5061 //********************* End locus ****************************
    5062 
    5063 //********************* Begin AddCons **********************
    5064 
    5065 // Input: L1,L2: lists of components with common top
    5066 // Output L: list of the union of L1 and L2.
    5067 static proc Add2ComWithCommonTop(list L1, list L2)
    5068 {
    5069   int i; int j; ideal pij; list L; list Lp; list PR; int k;
    5070   for(i=1;i<=size(L1[2]);i++)
    5071   {
    5072     for(j=1;j<=size(L2[2]);j++)
    5073     {
    5074       pij=std(L1[2][i]+L2[2][j]);
    5075       PR=minGTZ(pij);
    5076       for(k=1;k<=size(PR);k++)
    5077       {
    5078         Lp[size(Lp)+1]=PR[k];
    5079       }
    5080     }
    5081   }
    5082   for(i=1; i<=size(Lp);i++)
    5083   {
    5084     for(j=i+1;j<=size(Lp);j++)
    5085     {
    5086       if(idcontains(Lp[i],Lp[j])) {Lp=delete(Lp,j);}
    5087     }
    5088     for(j=1;j<i;j++)
    5089     {
    5090       if(idcontains(Lp[i],Lp[j])){Lp=delete(Lp,j); j=j-1; i=i-1;}
    5091     }
    5092   }
    5093   L[1]=L1[1];
    5094   L[2]=Lp;
    5095   return(L);
    5096 }
    5097 
    5098 // Input: L list od P-rep of components to be added. L[i]=[p_i,[p_{i1},...p_{ir_i}]]
    5099 // Output: lists A,B,L
    5100 //       where no top in the lists are repeated
    5101 //       A: list of components with higher tops
    5102 //       B: list of components with lower tops
    5103 //       L1: A,B
    5104 static proc SepareAB(list L)
    5105 {
    5106   int i;  int j; list Ln=L;
    5107   for(i=1;i<=size(Ln);i++)
    5108   {
    5109     for(j=i+1;j<=size(Ln);j++)
    5110     {
    5111       if (equalideals(Ln[j][1],Ln[i][1]))
    5112       {
    5113         Ln[i]=Add2ComWithCommonTop(Ln[i],Ln[j]);
    5114         Ln=delete(Ln,j);
    5115         j=j-1;
    5116       }
    5117     }
    5118   }
    5119   list A; list B; int clas; list T; list L1;
    5120   for(i=1;i<=size(Ln);i++)
    5121   {
    5122     j=1;
    5123     clas=0;
    5124     while((clas==0) and  (j<=size(Ln)))
    5125     {
    5126       if(j!=i)
    5127       {
    5128         if(idcontains(Ln[i][1],Ln[j][1]) ) {B[size(B)+1]=Ln[i]; clas=1;}
    5129       }
    5130       j++;
    5131     }
    5132     if(clas==0) {A[size(A)+1]=Ln[i];}
    5133   }
    5134   L1=A; for(j=1;j<=size(B);j++){L1[size(L1)+1]=B[j];}
    5135   T[1]=A; T[2]=B; T[3]=L1;
    5136   return(T);
    5137 }
    5138 
    5139 // Input:
    5140 //  A1: list of high set of P-reps to be completed by the remaining P-reps
    5141 //  L1: the list A1, completed with the list of lower P-reps.
    5142 // Output:
    5143 //  A: list A1 completed with all possible parts of the remaining parts of L1 with the
    5144 //      condition of building locally closed sets.
    5145 static proc CompleteA(list A1,list L1)
    5146 {
    5147   int modif; int i; int j; int k; int l;
    5148   ideal pij; ideal pk; ideal pijkl; ideal pkl;
    5149   int n; list nl; int te; int clas; list vvv; list AAA;
    5150   list Lp; int m; ideal Pij;
    5151   list A0;
    5152   modif=1;
    5153   list A=A1;
    5154   while(modif==1)
    5155   {
    5156       modif=0;
    5157       A0=A;
    5158       for(i=1;i<=size(A);i++)
    5159       {
    5160           for(j=1;j<=size(A[i][2]); j++)
    5161           {
    5162               pij=A[i][2][j];
    5163              for(k=1;k<=size(L1);k++)
    5164              {
    5165                  if(k!=i)
    5166                  {
    5167                      pk=L1[k][1];
    5168                      if(idcontains(pij,pk)==1)
    5169                      {
    5170                          te=0;
    5171                          kill nl;
    5172                          list nl; l=1;
    5173                          while((te==0) and (l<=size(L1[k][2])))
    5174                          {
    5175                               pkl=L1[k][2][l];
    5176                               if((equalideals(pij,pkl)==1) or (idcontains(pij,pkl)==1)) {te=1;}
    5177                               l++;
    5178                          }   // end while ((te=0) and (l>...
    5179                          //"T_te="; te; pause();
    5180                          if(te==0)
    5181                          {
    5182                            modif=1;
    5183                            kill Pij; ideal Pij=1;
    5184                            for(l=1; l<=size(L1[k][2]);l++)
    5185                            {
    5186                              pkl=L1[k][2][l];
    5187                              pijkl=std(pij+pkl);
    5188                              Pij=intersect(Pij,pijkl);
    5189                            }
    5190                            kill Lp; list Lp;
    5191                            Lp=minGTZ(Pij);
    5192                            for(m=1;m<=size(Lp);m++)
    5193                             {
    5194                                nl[size(nl)+1]=Lp[m];
    5195                             }
    5196                             A[i][2]=delete(A[i][2], j);
    5197                             for(n=1;n<=size(nl);n++)
    5198                             {
    5199                               A[i][2][size(A[i][2])+1]=nl[n];
    5200                             }
    5201                           } // end if(te==0)
    5202                      } // end if(idcontains(pij,pk)==1)
    5203                  }  // end if (k!=i)
    5204              } // end for k
    5205          }  // end for j
    5206          kill vvv; list vvv;
    5207          if(modif==1)
    5208          // Select the maximal ideals of the set A[I][2][j]
    5209          {
    5210              kill nl; list nl;
    5211              nl=selectminideals(A[i][2]);
    5212              kill AAA; list AAA;
    5213              for(j=1;j<=size(nl);j++)
    5214              {
    5215                AAA[size(AAA)+1]=A[i][2][nl[j]];
    5216              }
    5217              A[i][2]=AAA;
    5218          } // end if(modif=1)
    5219       }  // end for i
    5220       modif=1-equallistsAall(A,A0);
    5221   } // end while(modif==1)
    5222   return(A);
    5223 }
    5224 
    5225 // Input:
    5226 //   A: list of the top P-reps of one level
    5227 //   B: list of remaining lower P-reps that have not yeen be possible to add
    5228 // Output:
    5229 //   Bn: list B where the elements that are completely included in A are removed and the parts that are
    5230 //         included in A also.
    5231 static proc ReduceB(list A,list B)
    5232 {
    5233      int i; int j; list nl; list Bn; int te; int k; int elim;
    5234      ideal pC; ideal pD; ideal pCD; ideal pBC; list nB; int j0;
    5235      for(i=1;i<=size(B);i++)
    5236      {
    5237          j=1; te=0;
    5238          while((te==0) and (j<=size(A)))
    5239          {
    5240              if(idcontains(B[i][1],A[j][1])){te=1; j0=j;}
    5241              else{j++;}
    5242          }
    5243          pD=B[i][2][1];
    5244          for(k=2;k<=size(B[i][2]);k++){pD=intersect(pD,B[i][2][k]);}
    5245          pC=A[j0][2][1];
    5246          for(k=2;k<=size(A[j0][2]);k++) {pC=intersect(pC,A[j0][2][k]);}
    5247          pCD=std(pD+pC);
    5248          pBC=std(B[i][1]+pC);
    5249          elim=0;
    5250          if(idcontains(pBC,pCD)){elim=1;}   // B=delfromlist(B,i);i=i-1;
    5251          else
    5252          {
    5253               nB=Prep(pBC,pCD);
    5254               if(equalideals(nB[1][1],ideal(1))==0)
    5255               {
    5256                   for(k=1;k<=size(nB);k++){Bn[size(Bn)+1]=nB[k];}
    5257               }
    5258          }
    5259     }   // end for i
    5260     return(Bn);
    5261 }
    5262 
    5263 // AddConsP: given a set of components of locally closed sets in P-representation, it builds the
    5264 //       canonical P-representation of the corresponding constructible set, of its union,
    5265 //       including levels it they are.
    5266 proc AddConsP(list L)
    5267 "USAGE:   AddConsP(L)
    5268       Input L: list of components in P-rep to be added
    5269       [  [[p_1,[p_11,..,p_1,r1]],..[p_k,[p_k1,..,p_kr_k]]  ]
    5270 RETURN:
    5271      list of lists of levels of the different locally closed sets of
    5272      the canonical P-rep of the constructible.
    5273      [  [level_1,[ [Comp_11,..Comp_1r_1] ] ], .. ,
    5274         [level_s,[ [Comp_s1,..Comp_sr_1] ]
    5275      ]
    5276      where level_i=i,   Comp_ij=[ p_i,[p_i1,..,p_it_i] ] is a prime component.
    5277 NOTE:     Operates in a ring R=Q[u_1,..,u_m]
    5278 KEYWORDS: Constructible set, Canoncial form
    5279 EXAMPLE:  AddConsP; shows an example"
    5280 {
    5281   list LL; list A; list B; list L1; list T; int level=0; list h;
    5282   LL=L; int i;
    5283   while(size(LL)!=0)
    5284   {
    5285     level++;
    5286     L1=SepareAB(LL);
    5287     A=L1[1]; B=L1[2]; LL=L1[3];
    5288     A=CompleteA(A,LL);
    5289     for(i=1;i<=size(A);i++)
    5290     {
    5291       LL[i]=A[i];
    5292     }
    5293     h[1]=level; h[2]=A;
    5294     T[size(T)+1]=h;
    5295     LL=ReduceB(A,B);
    5296   }
    5297   return(T);
    5298 }
    5299 example
    5300 {
    5301   "EXAMPLE:"; echo = 2;
    5302   if (defined(Grobcov::@P)){kill Grobcov::@P; kill Grobcov::@R; kill Grobcov::@RP;}
    5303   ring R=0,(x,y,z),lp;
    5304   short=0;
    5305 
    5306   ideal P1=x;
    5307   ideal Q1=x,y;
    5308   ideal P2=y;
    5309   ideal Q2=y,z;
    5310 
    5311   list L=list(Prep(P1,Q1)[1],Prep(P2,Q2)[1]);
    5312   L;
    5313   AddConsP(L);
    5314 }
    5315 
    5316 // AddCons:  given a set of  locally closed sets by pairs of ideal, it builds the
    5317 //       canonical P-representation of the corresponding constructible set, of its union,
    5318 //       including levels it they are.
    5319 //       It makes a call to AddConsP after transforming the input.
    5320 // Input list of lists of pairs of ideals representing locally colsed sets:
    5321 //     L=  [ [E1,N1], .. , [E_s,N_s] ]
    5322 // Output: The canonical frepresentation of the constructible set union of the V(E_i) \ V(N_i)
    5323 //     T=[  [level_1,[ [p_1,[p_11,..,p_1s_1]],.., [p_k,[p_k1,..,p_ks_k]] ]],, .. , [level_r,[..       ]]  ]
    5324 proc AddCons(list L)
    5325 "USAGE:   AddCons(L)
    5326       Calls internally AddConsP and allows a different input.
    5327       Input L: list of pairs of of ideals [ [P_1,Q_1], .., [Pr,Qr] ]
    5328       representing a set of locally closed setsV(P_i) \ V(Q_i)
    5329       to be added.
    5330 RETURN:
    5331       list of lists of levels of the different locally closed sets of
    5332       the canonical P-rep of the constructible.
    5333       [  [level_1,[ [Comp_11,..Comp_1r_1] ] ], .. ,
    5334          [level_s,[ [Comp_s1,..Comp_sr_1] ]
    5335       ]
    5336       where level_i=i,   Comp_ij=[ p_i,[p_i1,..,p_it_i] ] is a prime component.
    5337 NOTE: Operates in a ring R=Q[u_1,..,u_m]
    5338 KEYWORDS: Constructible set, Canoncial form
    5339 EXAMPLE: AddCons; shows an example"
    5340 {
    5341   int i; list H; list P; int j;
    5342   for(i=1;i<=size(L);i++)
    5343   {
    5344     P=Prep(L[i][1],L[i][2]);
    5345     for(j=1;j<=size(P);j++)
    5346     {
    5347       H[size(H)+1]=P[j];
    5348     }
    5349   }
    5350   return(AddConsP(H));
    5351 }
    5352 example
    5353 {
    5354   "EXAMPLE:"; echo = 2;
    5355   if (defined(Grobcov::@P)){kill Grobcov::@P; kill Grobcov::@R; kill Grobcov::@RP;}
    5356   ring R=0,(x,y,z),lp;
    5357   short=0;
    5358 
    5359   ideal P1=x;
    5360   ideal Q1=x,y;
    5361   ideal P2=y;
    5362   ideal Q2=y,z;
    5363 
    5364   list L=list(list(P1,Q1), list(P2,Q2) );
    5365   L;
    5366 
    5367   AddCons(L);
    5368 }
    5369 
    53705231// AddLocus: auxilliary routine for locus0 that computes the components of the constructible:
    53715232// Input:  the list of locally closed sets to be added, each with its type as third argument
     
    53975258    }
    53985259  }
    5399   L3=AddConsP(L1);
     5260  L3=LocusConsLevels(L1);
    54005261  list L4; int level;
    54015262  ideal p1; ideal pp1; int t; int k; int k0; string typ; list l4;
     
    54265287}
    54275288
    5428 //********************* End AddCons **********************
    5429 ;
     5289// Input L: list of components in P-rep to be added
     5290//         [  [[p_1,[p_11,..,p_1,r1]],..[p_k,[p_k1,..,p_kr_k]]  ]
     5291// Output:
     5292//          list of lists of levels of the different locally closed sets of
     5293//          the canonical P-rep of the constructible.
     5294//          [  [level_1,[ [Comp_11,..Comp_1r_1] ] ], .. ,
     5295//             [level_s,[ [Comp_s1,..Comp_sr_1] ]
     5296//          ]
     5297//          where level_i=i,   Comp_ij=[ p_i,[p_i1,..,p_it_i] ] is a prime component.
     5298// LocusConsLevels: given a set of components of locally closed sets in P-representation, it builds the
     5299//       canonical P-representation of the corresponding constructible set of its union,
     5300//       including levels it they are.
     5301static proc LocusConsLevels(list L)
     5302{
     5303  list Lc; list Sc;
     5304  int i;
     5305  for(i=1;i<=size(L);i++)
     5306  {
     5307    Sc=PtoCrep(list(L[i]));
     5308    Lc[size(Lc)+1]=Sc;
     5309  }
     5310  list S=ConsLevels(Lc)[1];
     5311  list Sout;
     5312  list Lev;
     5313  for(i=1;i<=size(S);i++)
     5314  {
     5315    Lev=list(i,Prep(S[i][2][1],S[i][2][2]));
     5316    Sout[size(Sout)+1]=Lev;
     5317  }
     5318  return(Sout);
     5319}
     5320
     5321//********************* End locus ****************************
     5322
Note: See TracChangeset for help on using the changeset viewer.