ipshell.cc
Go to the documentation of this file.
1 /****************************************
2 * Computer Algebra System SINGULAR *
3 ****************************************/
4 /*
5 * ABSTRACT:
6 */
7 
8 #include <kernel/mod2.h>
9 
10 #include <omalloc/omalloc.h>
11 
12 #include <factory/factory.h>
13 
14 #include <misc/options.h>
15 #include <misc/mylimits.h>
16 #include <misc/intvec.h>
17 #include <misc/prime.h>
18 
19 #include <coeffs/numbers.h>
20 #include <coeffs/coeffs.h>
21 
22 #include <coeffs/rmodulon.h>
23 #include <coeffs/longrat.h>
24 
25 #include <polys/monomials/ring.h>
26 #include <polys/monomials/maps.h>
27 
28 #include <polys/prCopy.h>
29 #include <polys/matpol.h>
30 
31 #include <polys/weight.h>
32 #include <polys/clapsing.h>
33 
34 
37 
38 #include <kernel/polys.h>
39 #include <kernel/ideals.h>
40 
43 
44 #include <kernel/GBEngine/syz.h>
45 #include <kernel/GBEngine/kstd1.h>
46 #include <kernel/GBEngine/kutil.h> // denominator_list
47 
50 
51 #include <kernel/spectrum/semic.h>
52 #include <kernel/spectrum/splist.h>
54 
56 
57 #include <Singular/lists.h>
58 #include <Singular/attrib.h>
59 #include <Singular/ipconv.h>
60 #include <Singular/links/silink.h>
61 #include <Singular/ipshell.h>
62 #include <Singular/maps_ip.h>
63 #include <Singular/tok.h>
64 #include <Singular/ipid.h>
65 #include <Singular/subexpr.h>
66 #include <Singular/fevoices.h>
67 #include <Singular/sdb.h>
68 
69 #include <math.h>
70 #include <ctype.h>
71 
72 #include <kernel/maps/gen_maps.h>
73 
74 #ifdef SINGULAR_4_1
75 #include <Singular/number2.h>
76 #include <coeffs/bigintmat.h>
77 #endif
80 const char *lastreserved=NULL;
81 
83 
84 /*0 implementation*/
85 
86 const char * iiTwoOps(int t)
87 {
88  if (t<127)
89  {
90  static char ch[2];
91  switch (t)
92  {
93  case '&':
94  return "and";
95  case '|':
96  return "or";
97  default:
98  ch[0]=t;
99  ch[1]='\0';
100  return ch;
101  }
102  }
103  switch (t)
104  {
105  case COLONCOLON: return "::";
106  case DOTDOT: return "..";
107  //case PLUSEQUAL: return "+=";
108  //case MINUSEQUAL: return "-=";
109  case MINUSMINUS: return "--";
110  case PLUSPLUS: return "++";
111  case EQUAL_EQUAL: return "==";
112  case LE: return "<=";
113  case GE: return ">=";
114  case NOTEQUAL: return "<>";
115  default: return Tok2Cmdname(t);
116  }
117 }
118 
119 int iiOpsTwoChar(const char *s)
120 {
121 /* not handling: &&, ||, ** */
122  if (s[1]=='\0') return s[0];
123  else if (s[2]!='\0') return 0;
124  switch(s[0])
125  {
126  case '.': if (s[1]=='.') return DOTDOT;
127  else return 0;
128  case ':': if (s[1]==':') return COLONCOLON;
129  else return 0;
130  case '-': if (s[1]=='-') return MINUSMINUS;
131  else return 0;
132  case '+': if (s[1]=='+') return PLUSPLUS;
133  else return 0;
134  case '=': if (s[1]=='=') return EQUAL_EQUAL;
135  else return 0;
136  case '<': if (s[1]=='=') return LE;
137  else if (s[1]=='>') return NOTEQUAL;
138  else return 0;
139  case '>': if (s[1]=='=') return GE;
140  else return 0;
141  case '!': if (s[1]=='=') return NOTEQUAL;
142  else return 0;
143  }
144  return 0;
145 }
146 
147 static void list1(const char* s, idhdl h,BOOLEAN c, BOOLEAN fullname)
148 {
149  char buffer[22];
150  int l;
151  char buf2[128];
152 
153  if(fullname) sprintf(buf2, "%s::%s", "", IDID(h));
154  else sprintf(buf2, "%s", IDID(h));
155 
156  Print("%s%-30.30s [%d] ",s,buf2,IDLEV(h));
157  if (h == currRingHdl) PrintS("*");
158  PrintS(Tok2Cmdname((int)IDTYP(h)));
159 
160  ipListFlag(h);
161  switch(IDTYP(h))
162  {
163  case ALIAS_CMD: Print(" for %s",IDID((idhdl)IDDATA(h))); break;
164  case INT_CMD: Print(" %d",IDINT(h)); break;
165  case INTVEC_CMD:Print(" (%d)",IDINTVEC(h)->length()); break;
166  case INTMAT_CMD:Print(" %d x %d",IDINTVEC(h)->rows(),IDINTVEC(h)->cols());
167  break;
168  case POLY_CMD:
169  case VECTOR_CMD:if (c)
170  {
171  PrintS(" ");wrp(IDPOLY(h));
172  if(IDPOLY(h) != NULL)
173  {
174  Print(", %d monomial(s)",pLength(IDPOLY(h)));
175  }
176  }
177  break;
178  case MODUL_CMD: Print(", rk %d", (int)(IDIDEAL(h)->rank));
179  case IDEAL_CMD: Print(", %u generator(s)",
180  IDELEMS(IDIDEAL(h))); break;
181  case MAP_CMD:
182  Print(" from %s",IDMAP(h)->preimage); break;
183  case MATRIX_CMD:Print(" %u x %u"
184  ,MATROWS(IDMATRIX(h))
185  ,MATCOLS(IDMATRIX(h))
186  );
187  break;
188  case PACKAGE_CMD:
189  paPrint(IDID(h),IDPACKAGE(h));
190  break;
191  case PROC_CMD: if((IDPROC(h)->libname!=NULL)
192  && (strlen(IDPROC(h)->libname)>0))
193  Print(" from %s",IDPROC(h)->libname);
194  if(IDPROC(h)->is_static)
195  PrintS(" (static)");
196  break;
197  case STRING_CMD:
198  {
199  char *s;
200  l=strlen(IDSTRING(h));
201  memset(buffer,0,22);
202  strncpy(buffer,IDSTRING(h),si_min(l,20));
203  if ((s=strchr(buffer,'\n'))!=NULL)
204  {
205  *s='\0';
206  }
207  PrintS(" ");
208  PrintS(buffer);
209  if((s!=NULL) ||(l>20))
210  {
211  Print("..., %d char(s)",l);
212  }
213  break;
214  }
215  case LIST_CMD: Print(", size: %d",IDLIST(h)->nr+1);
216  break;
217  case RING_CMD:
218  if ((IDRING(h)==currRing) && (currRingHdl!=h))
219  PrintS("(*)"); /* this is an alias to currRing */
220 #ifdef RDEBUG
222  Print(" <%lx>",(long)(IDRING(h)));
223 #endif
224  break;
225 #ifdef SINGULAR_4_1
226  case CNUMBER_CMD:
227  { number2 n=(number2)IDDATA(h);
228  Print(" (%s)",nCoeffName(n->cf));
229  break;
230  }
231  case CMATRIX_CMD:
232  { bigintmat *b=(bigintmat*)IDDATA(h);
233  Print(" %d x %d (%s)",
234  b->rows(),b->cols(),
235  nCoeffName(b->basecoeffs()));
236  break;
237  }
238 #endif
239  /*default: break;*/
240  }
241  PrintLn();
242 }
243 
245 {
246  BOOLEAN oldShortOut = FALSE;
247 
248  if (currRing != NULL)
249  {
250  oldShortOut = currRing->ShortOut;
251  currRing->ShortOut = 1;
252  }
253  int t=v->Typ();
254  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
255  switch (t)
256  {
257  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
258  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
259  ((intvec*)(v->Data()))->cols()); break;
260  case MATRIX_CMD:Print(" %u x %u\n" ,
261  MATROWS((matrix)(v->Data())),
262  MATCOLS((matrix)(v->Data())));break;
263  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
264  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
265 
266  case PROC_CMD:
267  case RING_CMD:
268  case IDEAL_CMD: PrintLn(); break;
269 
270  //case INT_CMD:
271  //case STRING_CMD:
272  //case INTVEC_CMD:
273  //case POLY_CMD:
274  //case VECTOR_CMD:
275  //case PACKAGE_CMD:
276 
277  default:
278  break;
279  }
280  v->Print();
281  if (currRing != NULL)
282  currRing->ShortOut = oldShortOut;
283 }
284 
285 static void killlocals0(int v, idhdl * localhdl, const ring r)
286 {
287  idhdl h = *localhdl;
288  while (h!=NULL)
289  {
290  int vv;
291  //Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
292  if ((vv=IDLEV(h))>0)
293  {
294  if (vv < v)
295  {
296  if (iiNoKeepRing)
297  {
298  //PrintS(" break\n");
299  return;
300  }
301  h = IDNEXT(h);
302  //PrintLn();
303  }
304  else //if (vv >= v)
305  {
306  idhdl nexth = IDNEXT(h);
307  killhdl2(h,localhdl,r);
308  h = nexth;
309  //PrintS("kill\n");
310  }
311  }
312  else
313  {
314  h = IDNEXT(h);
315  //PrintLn();
316  }
317  }
318 }
319 
320 void killlocals_rec(idhdl *root,int v, ring r)
321 {
322  idhdl h=*root;
323  while (h!=NULL)
324  {
325  if (IDLEV(h)>=v)
326  {
327 // Print("kill %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
328  idhdl n=IDNEXT(h);
329  killhdl2(h,root,r);
330  h=n;
331  }
332  else if (IDTYP(h)==PACKAGE_CMD)
333  {
334  // Print("into pack %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
335  if (IDPACKAGE(h)!=basePack)
336  killlocals_rec(&(IDRING(h)->idroot),v,r);
337  h=IDNEXT(h);
338  }
339  else if (IDTYP(h)==RING_CMD)
340  {
341  if ((IDRING(h)!=NULL) && (IDRING(h)->idroot!=NULL))
342  // we have to test IDRING(h)!=NULL: qring Q=groebner(...): killlocals
343  {
344  // Print("into ring %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
345  killlocals_rec(&(IDRING(h)->idroot),v,IDRING(h));
346  }
347  h=IDNEXT(h);
348  }
349  else
350  {
351 // Print("skip %s lev %d for lev %d\n",IDID(h),IDLEV(h),v);
352  h=IDNEXT(h);
353  }
354  }
355 }
357 {
358  if (L==NULL) return FALSE;
359  BOOLEAN changed=FALSE;
360  int n=L->nr;
361  for(;n>=0;n--)
362  {
363  leftv h=&(L->m[n]);
364  void *d=h->data;
365  if ((h->rtyp==RING_CMD)
366  && (((ring)d)->idroot!=NULL))
367  {
368  if (d!=currRing) {changed=TRUE;rChangeCurrRing((ring)d);}
369  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
370  }
371  else if (h->rtyp==LIST_CMD)
372  changed|=killlocals_list(v,(lists)d);
373  }
374  return changed;
375 }
376 void killlocals(int v)
377 {
378  BOOLEAN changed=FALSE;
379  idhdl sh=currRingHdl;
380  ring cr=currRing;
381  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
382  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
383 
384  killlocals_rec(&(basePack->idroot),v,currRing);
385 
387  {
388  int t=iiRETURNEXPR.Typ();
389  if (/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
390  {
392  if (((ring)h->data)->idroot!=NULL)
393  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
394  }
395  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
396  {
398  changed |=killlocals_list(v,(lists)h->data);
399  }
400  }
401  if (changed)
402  {
404  if (currRingHdl==NULL)
405  currRing=NULL;
406  else if(cr!=currRing)
407  rChangeCurrRing(cr);
408  }
409 
410  if (myynest<=1) iiNoKeepRing=TRUE;
411  //Print("end killlocals >= %d\n",v);
412  //listall();
413 }
414 
415 void list_cmd(int typ, const char* what, const char *prefix,BOOLEAN iterate, BOOLEAN fullname)
416 {
417  package savePack=currPack;
418  idhdl h,start;
419  BOOLEAN all = typ<0;
420  BOOLEAN really_all=FALSE;
421 
422  if ( typ==0 )
423  {
424  if (strcmp(what,"all")==0)
425  {
426  if (currPack!=basePack)
427  list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
428  really_all=TRUE;
429  h=basePack->idroot;
430  }
431  else
432  {
433  h = ggetid(what);
434  if (h!=NULL)
435  {
436  if (iterate) list1(prefix,h,TRUE,fullname);
437  if (IDTYP(h)==ALIAS_CMD) PrintS("A");
438  if ((IDTYP(h)==RING_CMD)
439  //|| (IDTYP(h)==PACKE_CMD)
440  )
441  {
442  h=IDRING(h)->idroot;
443  }
444  else if(IDTYP(h)==PACKAGE_CMD)
445  {
446  currPack=IDPACKAGE(h);
447  //Print("list_cmd:package\n");
448  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
449  h=IDPACKAGE(h)->idroot;
450  }
451  else
452  {
453  currPack=savePack;
454  return;
455  }
456  }
457  else
458  {
459  Werror("%s is undefined",what);
460  currPack=savePack;
461  return;
462  }
463  }
464  all=TRUE;
465  }
466  else if (RingDependend(typ))
467  {
468  h = currRing->idroot;
469  }
470  else
471  h = IDROOT;
472  start=h;
473  while (h!=NULL)
474  {
475  if ((all
476  && (IDTYP(h)!=PROC_CMD)
477  &&(IDTYP(h)!=PACKAGE_CMD)
478  #ifdef SINGULAR_4_1
479  &&(IDTYP(h)!=CRING_CMD)
480  #endif
481  )
482  || (typ == IDTYP(h))
483  #ifdef SINGULAR_4_1
484  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
485  #endif
486  )
487  {
488  list1(prefix,h,start==currRingHdl, fullname);
489  if ((IDTYP(h)==RING_CMD)
490  && (really_all || (all && (h==currRingHdl)))
491  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
492  {
493  list_cmd(0,IDID(h),"// ",FALSE);
494  }
495  if (IDTYP(h)==PACKAGE_CMD && really_all)
496  {
497  package save_p=currPack;
498  currPack=IDPACKAGE(h);
499  list_cmd(0,IDID(h),"// ",FALSE);
500  currPack=save_p;
501  }
502  }
503  h = IDNEXT(h);
504  }
505  currPack=savePack;
506 }
507 
508 void test_cmd(int i)
509 {
510  int ii;
511 
512  if (i<0)
513  {
514  ii= -i;
515  if (ii < 32)
516  {
517  si_opt_1 &= ~Sy_bit(ii);
518  }
519  else if (ii < 64)
520  {
521  si_opt_2 &= ~Sy_bit(ii-32);
522  }
523  else
524  WerrorS("out of bounds\n");
525  }
526  else if (i<32)
527  {
528  ii=i;
529  if (Sy_bit(ii) & kOptions)
530  {
531  Warn("Gerhard, use the option command");
532  si_opt_1 |= Sy_bit(ii);
533  }
534  else if (Sy_bit(ii) & validOpts)
535  si_opt_1 |= Sy_bit(ii);
536  }
537  else if (i<64)
538  {
539  ii=i-32;
540  si_opt_2 |= Sy_bit(ii);
541  }
542  else
543  WerrorS("out of bounds\n");
544 }
545 
547 {
548  int rc = 0;
549  while (v!=NULL)
550  {
551  switch (v->Typ())
552  {
553  case INT_CMD:
554  case POLY_CMD:
555  case VECTOR_CMD:
556  case NUMBER_CMD:
557  rc++;
558  break;
559  case INTVEC_CMD:
560  case INTMAT_CMD:
561  rc += ((intvec *)(v->Data()))->length();
562  break;
563  case MATRIX_CMD:
564  case IDEAL_CMD:
565  case MODUL_CMD:
566  {
567  matrix mm = (matrix)(v->Data());
568  rc += mm->rows() * mm->cols();
569  }
570  break;
571  case LIST_CMD:
572  rc+=((lists)v->Data())->nr+1;
573  break;
574  default:
575  rc++;
576  }
577  v = v->next;
578  }
579  return rc;
580 }
581 
583 {
584  sleftv vf;
585  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
586  {
587  WerrorS("link expected");
588  return TRUE;
589  }
590  si_link l=(si_link)vf.Data();
591  if (vf.next == NULL)
592  {
593  WerrorS("write: need at least two arguments");
594  return TRUE;
595  }
596 
597  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
598  if (b)
599  {
600  const char *s;
601  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
602  else s=sNoName;
603  Werror("cannot write to %s",s);
604  }
605  vf.CleanUp();
606  return b;
607 }
608 
609 leftv iiMap(map theMap, const char * what)
610 {
611  idhdl w,r;
612  leftv v;
613  int i;
614  nMapFunc nMap;
615 
616  r=IDROOT->get(theMap->preimage,myynest);
617  if ((currPack!=basePack)
618  &&((r==NULL) || ((r->typ != RING_CMD) )))
619  r=basePack->idroot->get(theMap->preimage,myynest);
620  if ((r==NULL) && (currRingHdl!=NULL)
621  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
622  {
623  r=currRingHdl;
624  }
625  if ((r!=NULL) && (r->typ == RING_CMD))
626  {
627  ring src_ring=IDRING(r);
628  if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
629  {
630  Werror("can not map from ground field of %s to current ground field",
631  theMap->preimage);
632  return NULL;
633  }
634  if (IDELEMS(theMap)<src_ring->N)
635  {
636  theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
637  IDELEMS(theMap)*sizeof(poly),
638  (src_ring->N)*sizeof(poly));
639  for(i=IDELEMS(theMap);i<src_ring->N;i++)
640  theMap->m[i]=NULL;
641  IDELEMS(theMap)=src_ring->N;
642  }
643  if (what==NULL)
644  {
645  WerrorS("argument of a map must have a name");
646  }
647  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
648  {
649  char *save_r=NULL;
651  sleftv tmpW;
652  memset(&tmpW,0,sizeof(sleftv));
653  tmpW.rtyp=IDTYP(w);
654  if (tmpW.rtyp==MAP_CMD)
655  {
656  tmpW.rtyp=IDEAL_CMD;
657  save_r=IDMAP(w)->preimage;
658  IDMAP(w)->preimage=0;
659  }
660  tmpW.data=IDDATA(w);
661  // check overflow
662  BOOLEAN overflow=FALSE;
663  if ((tmpW.rtyp==IDEAL_CMD)
664  || (tmpW.rtyp==MODUL_CMD)
665  || (tmpW.rtyp==MAP_CMD))
666  {
667  ideal id=(ideal)tmpW.data;
668  long *degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
669  for(int i=IDELEMS(id)-1;i>=0;i--)
670  {
671  poly p=id->m[i];
672  if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
673  else degs[i]=0;
674  }
675  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
676  {
677  if (theMap->m[j]!=NULL)
678  {
679  long deg_monexp=pTotaldegree(theMap->m[j]);
680 
681  for(int i=IDELEMS(id)-1;i>=0;i--)
682  {
683  poly p=id->m[i];
684  if ((p!=NULL) && (degs[i]!=0) &&
685  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
686  {
687  overflow=TRUE;
688  break;
689  }
690  }
691  }
692  }
693  omFreeSize(degs,IDELEMS(id)*sizeof(long));
694  }
695  else if (tmpW.rtyp==POLY_CMD)
696  {
697  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
698  {
699  if (theMap->m[j]!=NULL)
700  {
701  long deg_monexp=pTotaldegree(theMap->m[j]);
702  poly p=(poly)tmpW.data;
703  long deg=0;
704  if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
705  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
706  {
707  overflow=TRUE;
708  break;
709  }
710  }
711  }
712  }
713  if (overflow)
714  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
715 #if 0
716  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
717  {
718  v->rtyp=tmpW.rtyp;
719  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
720  }
721  else
722 #endif
723  {
724  if ((tmpW.rtyp==IDEAL_CMD)
725  ||(tmpW.rtyp==MODUL_CMD)
726  ||(tmpW.rtyp==MATRIX_CMD)
727  ||(tmpW.rtyp==MAP_CMD))
728  {
729  v->rtyp=tmpW.rtyp;
730  char *tmp = theMap->preimage;
731  theMap->preimage=(char*)1L;
732  // map gets 1 as its rank (as an ideal)
733  v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
734  theMap->preimage=tmp; // map gets its preimage back
735  }
736  if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
737  {
738  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
739  {
740  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
742  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
743  return NULL;
744  }
745  }
746  }
747  if (save_r!=NULL)
748  {
749  IDMAP(w)->preimage=save_r;
750  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
751  v->rtyp=MAP_CMD;
752  }
753  return v;
754  }
755  else
756  {
757  Werror("%s undefined in %s",what,theMap->preimage);
758  }
759  }
760  else
761  {
762  Werror("cannot find preimage %s",theMap->preimage);
763  }
764  return NULL;
765 }
766 
767 #ifdef OLD_RES
768 void iiMakeResolv(resolvente r, int length, int rlen, char * name, int typ0,
769  intvec ** weights)
770 {
771  lists L=liMakeResolv(r,length,rlen,typ0,weights);
772  int i=0;
773  idhdl h;
774  char * s=(char *)omAlloc(strlen(name)+5);
775 
776  while (i<=L->nr)
777  {
778  sprintf(s,"%s(%d)",name,i+1);
779  if (i==0)
780  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
781  else
782  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
783  if (h!=NULL)
784  {
785  h->data.uideal=(ideal)L->m[i].data;
786  h->attribute=L->m[i].attribute;
788  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
789  }
790  else
791  {
792  idDelete((ideal *)&(L->m[i].data));
793  Warn("cannot define %s",s);
794  }
795  //L->m[i].data=NULL;
796  //L->m[i].rtyp=0;
797  //L->m[i].attribute=NULL;
798  i++;
799  }
800  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
802  omFreeSize((ADDRESS)s,strlen(name)+5);
803 }
804 #endif
805 
806 //resolvente iiFindRes(char * name, int * len, int *typ0)
807 //{
808 // char *s=(char *)omAlloc(strlen(name)+5);
809 // int i=-1;
810 // resolvente r;
811 // idhdl h;
812 //
813 // do
814 // {
815 // i++;
816 // sprintf(s,"%s(%d)",name,i+1);
817 // h=currRing->idroot->get(s,myynest);
818 // } while (h!=NULL);
819 // *len=i-1;
820 // if (*len<=0)
821 // {
822 // Werror("no objects %s(1),.. found",name);
823 // omFreeSize((ADDRESS)s,strlen(name)+5);
824 // return NULL;
825 // }
826 // r=(ideal *)omAlloc(/*(len+1)*/ i*sizeof(ideal));
827 // memset(r,0,(*len)*sizeof(ideal));
828 // i=-1;
829 // *typ0=MODUL_CMD;
830 // while (i<(*len))
831 // {
832 // i++;
833 // sprintf(s,"%s(%d)",name,i+1);
834 // h=currRing->idroot->get(s,myynest);
835 // if (h->typ != MODUL_CMD)
836 // {
837 // if ((i!=0) || (h->typ!=IDEAL_CMD))
838 // {
839 // Werror("%s is not of type module",s);
840 // omFreeSize((ADDRESS)r,(*len)*sizeof(ideal));
841 // omFreeSize((ADDRESS)s,strlen(name)+5);
842 // return NULL;
843 // }
844 // *typ0=IDEAL_CMD;
845 // }
846 // if ((i>0) && (idIs0(r[i-1])))
847 // {
848 // *len=i-1;
849 // break;
850 // }
851 // r[i]=IDIDEAL(h);
852 // }
853 // omFreeSize((ADDRESS)s,strlen(name)+5);
854 // return r;
855 //}
856 
858 {
859  int i;
860  resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
861 
862  for (i=0; i<l; i++)
863  if (r[i]!=NULL) res[i]=idCopy(r[i]);
864  return res;
865 }
866 
868 {
869  int len=0;
870  int typ0;
871  lists L=(lists)v->Data();
872  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
873  int add_row_shift = 0;
874  if (weights==NULL)
875  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
876  if (weights!=NULL) add_row_shift=weights->min_in();
877  resolvente rr=liFindRes(L,&len,&typ0);
878  if (rr==NULL) return TRUE;
879  resolvente r=iiCopyRes(rr,len);
880 
881  syMinimizeResolvente(r,len,0);
882  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
883  len++;
884  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
885  return FALSE;
886 }
887 
889 {
890  sleftv tmp;
891  memset(&tmp,0,sizeof(tmp));
892  tmp.rtyp=INT_CMD;
893  tmp.data=(void *)1;
894  if ((u->Typ()==IDEAL_CMD)
895  || (u->Typ()==MODUL_CMD))
896  return jjBETTI2_ID(res,u,&tmp);
897  else
898  return jjBETTI2(res,u,&tmp);
899 }
900 
902 {
904  l->Init(1);
905  l->m[0].rtyp=u->Typ();
906  l->m[0].data=u->Data();
907  attr *a=u->Attribute();
908  if (a!=NULL)
909  l->m[0].attribute=*a;
910  sleftv tmp2;
911  memset(&tmp2,0,sizeof(tmp2));
912  tmp2.rtyp=LIST_CMD;
913  tmp2.data=(void *)l;
914  BOOLEAN r=jjBETTI2(res,&tmp2,v);
915  l->m[0].data=NULL;
916  l->m[0].attribute=NULL;
917  l->m[0].rtyp=DEF_CMD;
918  l->Clean();
919  return r;
920 }
921 
923 {
924  resolvente r;
925  int len;
926  int reg,typ0;
927  lists l=(lists)u->Data();
928 
929  intvec *weights=NULL;
930  int add_row_shift=0;
931  intvec *ww=NULL;
932  if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
933  if (ww!=NULL)
934  {
935  weights=ivCopy(ww);
936  add_row_shift = ww->min_in();
937  (*weights) -= add_row_shift;
938  }
939  //Print("attr:%x\n",weights);
940 
941  r=liFindRes(l,&len,&typ0);
942  if (r==NULL) return TRUE;
943  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
944  res->data=(void*)res_im;
945  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
946  //Print("rowShift: %d ",add_row_shift);
947  for(int i=1;i<=res_im->rows();i++)
948  {
949  if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
950  else break;
951  }
952  //Print(" %d\n",add_row_shift);
953  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
954  if (weights!=NULL) delete weights;
955  return FALSE;
956 }
957 
959 {
960  int len,reg,typ0;
961 
962  resolvente r=liFindRes(L,&len,&typ0);
963 
964  if (r==NULL)
965  return -2;
966  intvec *weights=NULL;
967  int add_row_shift=0;
968  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
969  if (ww!=NULL)
970  {
971  weights=ivCopy(ww);
972  add_row_shift = ww->min_in();
973  (*weights) -= add_row_shift;
974  }
975  //Print("attr:%x\n",weights);
976 
977  intvec *dummy=syBetti(r,len,&reg,weights);
978  if (weights!=NULL) delete weights;
979  delete dummy;
980  omFreeSize((ADDRESS)r,len*sizeof(ideal));
981  return reg+1+add_row_shift;
982 }
983 
985 #define BREAK_LINE_LENGTH 80
986 void iiDebug()
987 {
988 #ifdef HAVE_SDB
989  sdb_flags=1;
990 #endif
991  Print("\n-- break point in %s --\n",VoiceName());
992  if (iiDebugMarker) VoiceBackTrack();
993  char * s;
994  iiDebugMarker=FALSE;
995  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
996  loop
997  {
998  memset(s,0,80);
1000  if (s[BREAK_LINE_LENGTH-1]!='\0')
1001  {
1002  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1003  }
1004  else
1005  break;
1006  }
1007  if (*s=='\n')
1008  {
1009  iiDebugMarker=TRUE;
1010  }
1011 #if MDEBUG
1012  else if(strncmp(s,"cont;",5)==0)
1013  {
1014  iiDebugMarker=TRUE;
1015  }
1016 #endif /* MDEBUG */
1017  else
1018  {
1019  strcat( s, "\n;~\n");
1020  newBuffer(s,BT_execute);
1021  }
1022 }
1023 
1024 lists scIndIndset(ideal S, BOOLEAN all, ideal Q)
1025 {
1026  int i;
1027  indset save;
1029 
1030  hexist = hInit(S, Q, &hNexist, currRing);
1031  if (hNexist == 0)
1032  {
1033  intvec *iv=new intvec(rVar(currRing));
1034  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1035  res->Init(1);
1036  res->m[0].rtyp=INTVEC_CMD;
1037  res->m[0].data=(intvec*)iv;
1038  return res;
1039  }
1040  else if (hisModule!=0)
1041  {
1042  res->Init(0);
1043  return res;
1044  }
1045  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1046  hMu = 0;
1047  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1048  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1049  hpure = (scmon)omAlloc((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1050  hrad = hexist;
1051  hNrad = hNexist;
1052  radmem = hCreate(rVar(currRing) - 1);
1053  hCo = rVar(currRing) + 1;
1054  hNvar = rVar(currRing);
1055  hRadical(hrad, &hNrad, hNvar);
1056  hSupp(hrad, hNrad, hvar, &hNvar);
1057  if (hNvar)
1058  {
1059  hCo = hNvar;
1060  memset(hpure, 0, (rVar(currRing) + 1) * sizeof(long));
1061  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1062  hLexR(hrad, hNrad, hvar, hNvar);
1064  }
1065  if (hCo && (hCo < rVar(currRing)))
1066  {
1068  }
1069  if (hMu!=0)
1070  {
1071  ISet = save;
1072  hMu2 = 0;
1073  if (all && (hCo+1 < rVar(currRing)))
1074  {
1077  i=hMu+hMu2;
1078  res->Init(i);
1079  if (hMu2 == 0)
1080  {
1082  }
1083  }
1084  else
1085  {
1086  res->Init(hMu);
1087  }
1088  for (i=0;i<hMu;i++)
1089  {
1090  res->m[i].data = (void *)save->set;
1091  res->m[i].rtyp = INTVEC_CMD;
1092  ISet = save;
1093  save = save->nx;
1095  }
1096  omFreeBin((ADDRESS)save, indlist_bin);
1097  if (hMu2 != 0)
1098  {
1099  save = JSet;
1100  for (i=hMu;i<hMu+hMu2;i++)
1101  {
1102  res->m[i].data = (void *)save->set;
1103  res->m[i].rtyp = INTVEC_CMD;
1104  JSet = save;
1105  save = save->nx;
1107  }
1108  omFreeBin((ADDRESS)save, indlist_bin);
1109  }
1110  }
1111  else
1112  {
1113  res->Init(0);
1115  }
1116  hKill(radmem, rVar(currRing) - 1);
1117  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1118  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1119  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1121  return res;
1122 }
1123 
1124 int iiDeclCommand(leftv sy, leftv name, int lev,int t, idhdl* root,BOOLEAN isring, BOOLEAN init_b)
1125 {
1126  BOOLEAN res=FALSE;
1127  const char *id = name->name;
1128 
1129  memset(sy,0,sizeof(sleftv));
1130  if ((name->name==NULL)||(isdigit(name->name[0])))
1131  {
1132  WerrorS("object to declare is not a name");
1133  res=TRUE;
1134  }
1135  else
1136  {
1137  if (t==QRING_CMD) t=RING_CMD; // qring is always RING_CMD
1138 
1139  if (TEST_V_ALLWARN
1140  && (name->rtyp!=0)
1141  && (name->rtyp!=IDHDL)
1142  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1143  {
1144  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1146  }
1147  {
1148  sy->data = (char *)enterid(id,lev,t,root,init_b);
1149  }
1150  if (sy->data!=NULL)
1151  {
1152  sy->rtyp=IDHDL;
1153  currid=sy->name=IDID((idhdl)sy->data);
1154  // name->name=NULL; /* used in enterid */
1155  //sy->e = NULL;
1156  if (name->next!=NULL)
1157  {
1159  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1160  }
1161  }
1162  else res=TRUE;
1163  }
1164  name->CleanUp();
1165  return res;
1166 }
1167 
1169 {
1170  attr at=NULL;
1171  if (iiCurrProc!=NULL)
1172  at=iiCurrProc->attribute->get("default_arg");
1173  if (at==NULL)
1174  return FALSE;
1175  sleftv tmp;
1176  memset(&tmp,0,sizeof(sleftv));
1177  tmp.rtyp=at->atyp;
1178  tmp.data=at->CopyA();
1179  return iiAssign(p,&tmp);
1180 }
1182 {
1183  // <string1...stringN>,<proc>
1184  // known: args!=NULL, l>=1
1185  int l=args->listLength();
1186  int ll=0;
1187  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1188  if (ll!=(l-1)) return FALSE;
1189  leftv h=args;
1190  short *t=(short*)omAlloc(l*sizeof(short));
1191  t[0]=l-1;
1192  int b;
1193  int i;
1194  for(i=1;i<l;i++,h=h->next)
1195  {
1196  if (h->Typ()!=STRING_CMD)
1197  {
1198  omFree(t);
1199  Werror("arg %d is not a string",i);
1200  return TRUE;
1201  }
1202  int tt;
1203  b=IsCmd((char *)h->Data(),tt);
1204  if(b) t[i]=tt;
1205  else
1206  {
1207  omFree(t);
1208  Werror("arg %d is not a type name",i);
1209  return TRUE;
1210  }
1211  }
1212  if (h->Typ()!=PROC_CMD)
1213  {
1214  omFree(t);
1215  Werror("last arg (%d) is not a proc",i);
1216  return TRUE;
1217  }
1218  b=iiCheckTypes(iiCurrArgs,t,0);
1219  omFree(t);
1220  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1221  {
1222  BOOLEAN err;
1223  //Print("branchTo: %s\n",h->Name());
1224  iiCurrProc=(idhdl)h->data;
1225  procinfo * pi=IDPROC(iiCurrProc);
1226  if( pi->data.s.body==NULL )
1227  {
1229  if (pi->data.s.body==NULL) return TRUE;
1230  }
1231  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1232  {
1233  currPack=pi->pack;
1236  //Print("set pack=%s\n",IDID(currPackHdl));
1237  }
1238  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(iiCurrArgs==NULL));
1240  if (iiCurrArgs!=NULL)
1241  {
1242  if (!err) Warn("too many arguments for %s",IDID(iiCurrProc));
1243  iiCurrArgs->CleanUp();
1244  omFreeBin((ADDRESS)iiCurrArgs, sleftv_bin);
1245  iiCurrArgs=NULL;
1246  }
1247  return 2-err;
1248  }
1249  return FALSE;
1250 }
1252 {
1253  if (iiCurrArgs==NULL)
1254  {
1255  if (strcmp(p->name,"#")==0)
1256  return iiDefaultParameter(p);
1257  Werror("not enough arguments for proc %s",VoiceName());
1258  p->CleanUp();
1259  return TRUE;
1260  }
1261  leftv h=iiCurrArgs;
1262  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1263  BOOLEAN is_default_list=FALSE;
1264  if (strcmp(p->name,"#")==0)
1265  {
1266  is_default_list=TRUE;
1267  rest=NULL;
1268  }
1269  else
1270  {
1271  h->next=NULL;
1272  }
1273  BOOLEAN res=iiAssign(p,h);
1274  if (is_default_list)
1275  {
1276  iiCurrArgs=NULL;
1277  }
1278  else
1279  {
1280  iiCurrArgs=rest;
1281  }
1282  h->CleanUp();
1284  return res;
1285 }
1286 
1287 static BOOLEAN iiInternalExport (leftv v, int toLev)
1288 {
1289  idhdl h=(idhdl)v->data;
1290  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1291  if (IDLEV(h)==0)
1292  {
1293  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(h));
1294  }
1295  else
1296  {
1297  h=IDROOT->get(v->name,toLev);
1298  idhdl *root=&IDROOT;
1299  if ((h==NULL)&&(currRing!=NULL))
1300  {
1301  h=currRing->idroot->get(v->name,toLev);
1302  root=&currRing->idroot;
1303  }
1304  BOOLEAN keepring=FALSE;
1305  if ((h!=NULL)&&(IDLEV(h)==toLev))
1306  {
1307  if (IDTYP(h)==v->Typ())
1308  {
1309  if ((IDTYP(h)==RING_CMD)
1310  && (v->Data()==IDDATA(h)))
1311  {
1312  IDRING(h)->ref++;
1313  keepring=TRUE;
1314  IDLEV(h)=toLev;
1315  //WarnS("keepring");
1316  return FALSE;
1317  }
1318  if (BVERBOSE(V_REDEFINE))
1319  {
1320  Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1321  }
1322  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1323  killhdl2(h,root,currRing);
1324  }
1325  else
1326  {
1327  return TRUE;
1328  }
1329  }
1330  h=(idhdl)v->data;
1331  IDLEV(h)=toLev;
1332  if (keepring) IDRING(h)->ref--;
1334  //Print("export %s\n",IDID(h));
1335  }
1336  return FALSE;
1337 }
1338 
1339 BOOLEAN iiInternalExport (leftv v, int toLev, package rootpack)
1340 {
1341  idhdl h=(idhdl)v->data;
1342  if(h==NULL)
1343  {
1344  Warn("'%s': no such identifier\n", v->name);
1345  return FALSE;
1346  }
1347  package frompack=v->req_packhdl;
1348  if (frompack==NULL) frompack=currPack;
1349  if ((RingDependend(IDTYP(h)))
1350  || ((IDTYP(h)==LIST_CMD)
1351  && (lRingDependend(IDLIST(h)))
1352  )
1353  )
1354  {
1355  //Print("// ==> Ringdependent set nesting to 0\n");
1356  return (iiInternalExport(v, toLev));
1357  }
1358  else
1359  {
1360  IDLEV(h)=toLev;
1361  v->req_packhdl=rootpack;
1362  if (h==frompack->idroot)
1363  {
1364  frompack->idroot=h->next;
1365  }
1366  else
1367  {
1368  idhdl hh=frompack->idroot;
1369  while ((hh!=NULL) && (hh->next!=h))
1370  hh=hh->next;
1371  if ((hh!=NULL) && (hh->next==h))
1372  hh->next=h->next;
1373  else
1374  {
1375  Werror("`%s` not found",v->Name());
1376  return TRUE;
1377  }
1378  }
1379  h->next=rootpack->idroot;
1380  rootpack->idroot=h;
1381  }
1382  return FALSE;
1383 }
1384 
1385 BOOLEAN iiExport (leftv v, int toLev)
1386 {
1387  BOOLEAN nok=FALSE;
1388  leftv r=v;
1389  while (v!=NULL)
1390  {
1391  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1392  {
1393  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1394  nok=TRUE;
1395  }
1396  else
1397  {
1398  if(iiInternalExport(v, toLev))
1399  {
1400  r->CleanUp();
1401  return TRUE;
1402  }
1403  }
1404  v=v->next;
1405  }
1406  r->CleanUp();
1407  return nok;
1408 }
1409 
1410 /*assume root!=idroot*/
1411 BOOLEAN iiExport (leftv v, int toLev, package pack)
1412 {
1413 #ifdef SINGULAR_4_1
1414 // if ((pack==basePack)&&(pack!=currPack))
1415 // { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1416 #endif
1417  BOOLEAN nok=FALSE;
1418  leftv rv=v;
1419  while (v!=NULL)
1420  {
1421  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1422  )
1423  {
1424  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1425  nok=TRUE;
1426  }
1427  else
1428  {
1429  idhdl old=pack->idroot->get( v->name,toLev);
1430  if (old!=NULL)
1431  {
1432  if ((pack==currPack) && (old==(idhdl)v->data))
1433  {
1434  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1435  break;
1436  }
1437  else if (IDTYP(old)==v->Typ())
1438  {
1439  if (BVERBOSE(V_REDEFINE))
1440  {
1441  Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1442  }
1443  v->name=omStrDup(v->name);
1444  killhdl2(old,&(pack->idroot),currRing);
1445  }
1446  else
1447  {
1448  rv->CleanUp();
1449  return TRUE;
1450  }
1451  }
1452  //Print("iiExport: pack=%s\n",IDID(root));
1453  if(iiInternalExport(v, toLev, pack))
1454  {
1455  rv->CleanUp();
1456  return TRUE;
1457  }
1458  }
1459  v=v->next;
1460  }
1461  rv->CleanUp();
1462  return nok;
1463 }
1464 
1466 {
1467  if (currRing==NULL)
1468  {
1469  #ifdef SIQ
1470  if (siq<=0)
1471  {
1472  #endif
1473  if (RingDependend(i))
1474  {
1475  WerrorS("no ring active");
1476  return TRUE;
1477  }
1478  #ifdef SIQ
1479  }
1480  #endif
1481  }
1482  return FALSE;
1483 }
1484 
1485 poly iiHighCorner(ideal I, int ak)
1486 {
1487  int i;
1488  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1489  poly po=NULL;
1491  {
1492  scComputeHC(I,currRing->qideal,ak,po);
1493  if (po!=NULL)
1494  {
1495  pGetCoeff(po)=nInit(1);
1496  for (i=rVar(currRing); i>0; i--)
1497  {
1498  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1499  }
1500  pSetComp(po,ak);
1501  pSetm(po);
1502  }
1503  }
1504  else
1505  po=pOne();
1506  return po;
1507 }
1508 
1510 {
1511  if (p!=basePack)
1512  {
1513  idhdl t=basePack->idroot;
1514  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1515  if (t==NULL)
1516  {
1517  WarnS("package not found\n");
1518  p=basePack;
1519  }
1520  }
1521 }
1522 
1523 idhdl rDefault(const char *s)
1524 {
1525  idhdl tmp=NULL;
1526 
1527  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1528  if (tmp==NULL) return NULL;
1529 
1530 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1532  {
1534  memset(&sLastPrinted,0,sizeof(sleftv));
1535  }
1536 
1537  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1538 
1539  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1540  r->N = 3;
1541  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1542  /*names*/
1543  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1544  r->names[0] = omStrDup("x");
1545  r->names[1] = omStrDup("y");
1546  r->names[2] = omStrDup("z");
1547  /*weights: entries for 3 blocks: NULL*/
1548  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1549  /*order: dp,C,0*/
1550  r->order = (int *) omAlloc(3 * sizeof(int *));
1551  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1552  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1553  /* ringorder dp for the first block: var 1..3 */
1554  r->order[0] = ringorder_dp;
1555  r->block0[0] = 1;
1556  r->block1[0] = 3;
1557  /* ringorder C for the second block: no vars */
1558  r->order[1] = ringorder_C;
1559  /* the last block: everything is 0 */
1560  r->order[2] = 0;
1561 
1562  /* complete ring intializations */
1563  rComplete(r);
1564  rSetHdl(tmp);
1565  return currRingHdl;
1566 }
1567 
1569 {
1570  idhdl h=rSimpleFindHdl(r,IDROOT,n);
1571  if (h!=NULL) return h;
1572  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1573  if (h!=NULL) return h;
1575  while(p!=NULL)
1576  {
1577  if ((p->cPack!=basePack)
1578  && (p->cPack!=currPack))
1579  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1580  if (h!=NULL) return h;
1581  p=p->next;
1582  }
1583  idhdl tmp=basePack->idroot;
1584  while (tmp!=NULL)
1585  {
1586  if (IDTYP(tmp)==PACKAGE_CMD)
1587  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1588  if (h!=NULL) return h;
1589  tmp=IDNEXT(tmp);
1590  }
1591  return NULL;
1592 }
1593 
1594 void rDecomposeCF(leftv h,const ring r,const ring R)
1595 {
1597  L->Init(4);
1598  h->rtyp=LIST_CMD;
1599  h->data=(void *)L;
1600  // 0: char/ cf - ring
1601  // 1: list (var)
1602  // 2: list (ord)
1603  // 3: qideal
1604  // ----------------------------------------
1605  // 0: char/ cf - ring
1606  L->m[0].rtyp=INT_CMD;
1607  L->m[0].data=(void *)(long)r->cf->ch;
1608  // ----------------------------------------
1609  // 1: list (var)
1611  LL->Init(r->N);
1612  int i;
1613  for(i=0; i<r->N; i++)
1614  {
1615  LL->m[i].rtyp=STRING_CMD;
1616  LL->m[i].data=(void *)omStrDup(r->names[i]);
1617  }
1618  L->m[1].rtyp=LIST_CMD;
1619  L->m[1].data=(void *)LL;
1620  // ----------------------------------------
1621  // 2: list (ord)
1623  i=rBlocks(r)-1;
1624  LL->Init(i);
1625  i--;
1626  lists LLL;
1627  for(; i>=0; i--)
1628  {
1629  intvec *iv;
1630  int j;
1631  LL->m[i].rtyp=LIST_CMD;
1633  LLL->Init(2);
1634  LLL->m[0].rtyp=STRING_CMD;
1635  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1636  if (r->block1[i]-r->block0[i] >=0 )
1637  {
1638  j=r->block1[i]-r->block0[i];
1639  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1640  iv=new intvec(j+1);
1641  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1642  {
1643  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1644  }
1645  else switch (r->order[i])
1646  {
1647  case ringorder_dp:
1648  case ringorder_Dp:
1649  case ringorder_ds:
1650  case ringorder_Ds:
1651  case ringorder_lp:
1652  for(;j>=0; j--) (*iv)[j]=1;
1653  break;
1654  default: /* do nothing */;
1655  }
1656  }
1657  else
1658  {
1659  iv=new intvec(1);
1660  }
1661  LLL->m[1].rtyp=INTVEC_CMD;
1662  LLL->m[1].data=(void *)iv;
1663  LL->m[i].data=(void *)LLL;
1664  }
1665  L->m[2].rtyp=LIST_CMD;
1666  L->m[2].data=(void *)LL;
1667  // ----------------------------------------
1668  // 3: qideal
1669  L->m[3].rtyp=IDEAL_CMD;
1670  if (nCoeff_is_transExt(R->cf))
1671  L->m[3].data=(void *)idInit(1,1);
1672  else
1673  {
1674  ideal q=idInit(IDELEMS(r->qideal));
1675  q->m[0]=p_Init(R);
1676  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1677  L->m[3].data=(void *)q;
1678 // I->m[0] = pNSet(R->minpoly);
1679  }
1680  // ----------------------------------------
1681 }
1682 #ifdef SINGULAR_4_1
1683 static void rDecomposeC_41(leftv h,const coeffs C)
1684 /* field is R or C */
1685 {
1687  if (nCoeff_is_long_C(C)) L->Init(3);
1688  else L->Init(2);
1689  h->rtyp=LIST_CMD;
1690  h->data=(void *)L;
1691  // 0: char/ cf - ring
1692  // 1: list (var)
1693  // 2: list (ord)
1694  // ----------------------------------------
1695  // 0: char/ cf - ring
1696  L->m[0].rtyp=INT_CMD;
1697  L->m[0].data=(void *)0;
1698  // ----------------------------------------
1699  // 1:
1701  LL->Init(2);
1702  LL->m[0].rtyp=INT_CMD;
1703  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1704  LL->m[1].rtyp=INT_CMD;
1705  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1706  L->m[1].rtyp=LIST_CMD;
1707  L->m[1].data=(void *)LL;
1708  // ----------------------------------------
1709  // 2: list (par)
1710  if (nCoeff_is_long_C(C))
1711  {
1712  L->m[2].rtyp=STRING_CMD;
1713  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1714  }
1715  // ----------------------------------------
1716 }
1717 #endif
1718 static void rDecomposeC(leftv h,const ring R)
1719 /* field is R or C */
1720 {
1722  if (rField_is_long_C(R)) L->Init(3);
1723  else L->Init(2);
1724  h->rtyp=LIST_CMD;
1725  h->data=(void *)L;
1726  // 0: char/ cf - ring
1727  // 1: list (var)
1728  // 2: list (ord)
1729  // ----------------------------------------
1730  // 0: char/ cf - ring
1731  L->m[0].rtyp=INT_CMD;
1732  L->m[0].data=(void *)0;
1733  // ----------------------------------------
1734  // 1:
1736  LL->Init(2);
1737  LL->m[0].rtyp=INT_CMD;
1738  LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1739  LL->m[1].rtyp=INT_CMD;
1740  LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1741  L->m[1].rtyp=LIST_CMD;
1742  L->m[1].data=(void *)LL;
1743  // ----------------------------------------
1744  // 2: list (par)
1745  if (rField_is_long_C(R))
1746  {
1747  L->m[2].rtyp=STRING_CMD;
1748  L->m[2].data=(void *)omStrDup(*rParameter(R));
1749  }
1750  // ----------------------------------------
1751 }
1752 
1753 #ifdef SINGULAR_4_1
1754 #ifdef HAVE_RINGS
1756 /* field is R or C */
1757 {
1759  if (nCoeff_is_Ring(C)) L->Init(1);
1760  else L->Init(2);
1761  h->rtyp=LIST_CMD;
1762  h->data=(void *)L;
1763  // 0: char/ cf - ring
1764  // 1: list (module)
1765  // ----------------------------------------
1766  // 0: char/ cf - ring
1767  L->m[0].rtyp=STRING_CMD;
1768  L->m[0].data=(void *)omStrDup("integer");
1769  // ----------------------------------------
1770  // 1: modulo
1771  if (nCoeff_is_Ring_Z(C)) return;
1773  LL->Init(2);
1774  LL->m[0].rtyp=BIGINT_CMD;
1775  LL->m[0].data=nlMapGMP((number) C->modBase, C, coeffs_BIGINT);
1776  LL->m[1].rtyp=INT_CMD;
1777  LL->m[1].data=(void *) C->modExponent;
1778  L->m[1].rtyp=LIST_CMD;
1779  L->m[1].data=(void *)LL;
1780 }
1781 #endif
1782 #endif
1783 
1784 void rDecomposeRing(leftv h,const ring R)
1785 /* field is R or C */
1786 {
1787 #ifdef HAVE_RINGS
1789  if (rField_is_Ring_Z(R)) L->Init(1);
1790  else L->Init(2);
1791  h->rtyp=LIST_CMD;
1792  h->data=(void *)L;
1793  // 0: char/ cf - ring
1794  // 1: list (module)
1795  // ----------------------------------------
1796  // 0: char/ cf - ring
1797  L->m[0].rtyp=STRING_CMD;
1798  L->m[0].data=(void *)omStrDup("integer");
1799  // ----------------------------------------
1800  // 1: module
1801  if (rField_is_Ring_Z(R)) return;
1803  LL->Init(2);
1804  LL->m[0].rtyp=BIGINT_CMD;
1805  LL->m[0].data=nlMapGMP((number) R->cf->modBase, R->cf, R->cf); // TODO: what is this?? // extern number nlMapGMP(number from, const coeffs src, const coeffs dst); // FIXME: replace with n_InitMPZ(R->cf->modBase, coeffs_BIGINT); ?
1806  LL->m[1].rtyp=INT_CMD;
1807  LL->m[1].data=(void *) R->cf->modExponent;
1808  L->m[1].rtyp=LIST_CMD;
1809  L->m[1].data=(void *)LL;
1810 #else
1811  WerrorS("rDecomposeRing");
1812 #endif
1813 }
1814 
1815 
1816 #ifdef SINGULAR_4_1
1818 {
1819  assume( C != NULL );
1820 
1821  // sanity check: require currRing==r for rings with polynomial data
1822  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1823  {
1824  WerrorS("ring with polynomial data must be the base ring or compatible");
1825  return TRUE;
1826  }
1827  if (nCoeff_is_numeric(C))
1828  {
1829  rDecomposeC_41(res,C);
1830  }
1831 #ifdef HAVE_RINGS
1832  else if (nCoeff_is_Ring(C))
1833  {
1834  rDecomposeRing_41(res,C);
1835  }
1836 #endif
1837  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1838  {
1839  rDecomposeCF(res, C->extRing, currRing);
1840  }
1841  else if(nCoeff_is_GF(C))
1842  {
1844  Lc->Init(4);
1845  // char:
1846  Lc->m[0].rtyp=INT_CMD;
1847  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1848  // var:
1850  Lv->Init(1);
1851  Lv->m[0].rtyp=STRING_CMD;
1852  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1853  Lc->m[1].rtyp=LIST_CMD;
1854  Lc->m[1].data=(void*)Lv;
1855  // ord:
1857  Lo->Init(1);
1859  Loo->Init(2);
1860  Loo->m[0].rtyp=STRING_CMD;
1861  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1862 
1863  intvec *iv=new intvec(1); (*iv)[0]=1;
1864  Loo->m[1].rtyp=INTVEC_CMD;
1865  Loo->m[1].data=(void *)iv;
1866 
1867  Lo->m[0].rtyp=LIST_CMD;
1868  Lo->m[0].data=(void*)Loo;
1869 
1870  Lc->m[2].rtyp=LIST_CMD;
1871  Lc->m[2].data=(void*)Lo;
1872  // q-ideal:
1873  Lc->m[3].rtyp=IDEAL_CMD;
1874  Lc->m[3].data=(void *)idInit(1,1);
1875  // ----------------------
1876  res->rtyp=LIST_CMD;
1877  res->data=(void*)Lc;
1878  }
1879  else
1880  {
1881  res->rtyp=INT_CMD;
1882  res->data=(void *)(long)C->ch;
1883  }
1884  // ----------------------------------------
1885  return FALSE;
1886 }
1887 #endif
1888 
1889 #ifdef SINGULAR_4_1
1891 {
1892  assume( r != NULL );
1893  const coeffs C = r->cf;
1894  assume( C != NULL );
1895 
1896  // sanity check: require currRing==r for rings with polynomial data
1897  if ( (r!=currRing) && (
1898  (nCoeff_is_algExt(C) && (C != currRing->cf))
1899  || (r->qideal != NULL)
1900 #ifdef HAVE_PLURAL
1901  || (rIsPluralRing(r))
1902 #endif
1903  )
1904  )
1905  {
1906  WerrorS("ring with polynomial data must be the base ring or compatible");
1907  return NULL;
1908  }
1909  // 0: char/ cf - ring
1910  // 1: list (var)
1911  // 2: list (ord)
1912  // 3: qideal
1913  // possibly:
1914  // 4: C
1915  // 5: D
1917  if (rIsPluralRing(r))
1918  L->Init(6);
1919  else
1920  L->Init(4);
1921  // ----------------------------------------
1922  // 0: char/ cf - ring
1923  L->m[0].rtyp=CRING_CMD;
1924  L->m[0].data=(char*)r->cf; r->cf->ref++;
1925  // ----------------------------------------
1926  // 1: list (var)
1928  LL->Init(r->N);
1929  int i;
1930  for(i=0; i<r->N; i++)
1931  {
1932  LL->m[i].rtyp=STRING_CMD;
1933  LL->m[i].data=(void *)omStrDup(r->names[i]);
1934  }
1935  L->m[1].rtyp=LIST_CMD;
1936  L->m[1].data=(void *)LL;
1937  // ----------------------------------------
1938  // 2: list (ord)
1940  i=rBlocks(r)-1;
1941  LL->Init(i);
1942  i--;
1943  lists LLL;
1944  for(; i>=0; i--)
1945  {
1946  intvec *iv;
1947  int j;
1948  LL->m[i].rtyp=LIST_CMD;
1950  LLL->Init(2);
1951  LLL->m[0].rtyp=STRING_CMD;
1952  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1953 
1954  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
1955  {
1956  assume( r->block0[i] == r->block1[i] );
1957  const int s = r->block0[i];
1958  assume( -2 < s && s < 2);
1959 
1960  iv=new intvec(1);
1961  (*iv)[0] = s;
1962  }
1963  else if (r->block1[i]-r->block0[i] >=0 )
1964  {
1965  int bl=j=r->block1[i]-r->block0[i];
1966  if (r->order[i]==ringorder_M)
1967  {
1968  j=(j+1)*(j+1)-1;
1969  bl=j+1;
1970  }
1971  else if (r->order[i]==ringorder_am)
1972  {
1973  j+=r->wvhdl[i][bl+1];
1974  }
1975  iv=new intvec(j+1);
1976  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1977  {
1978  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
1979  }
1980  else switch (r->order[i])
1981  {
1982  case ringorder_dp:
1983  case ringorder_Dp:
1984  case ringorder_ds:
1985  case ringorder_Ds:
1986  case ringorder_lp:
1987  for(;j>=0; j--) (*iv)[j]=1;
1988  break;
1989  default: /* do nothing */;
1990  }
1991  }
1992  else
1993  {
1994  iv=new intvec(1);
1995  }
1996  LLL->m[1].rtyp=INTVEC_CMD;
1997  LLL->m[1].data=(void *)iv;
1998  LL->m[i].data=(void *)LLL;
1999  }
2000  L->m[2].rtyp=LIST_CMD;
2001  L->m[2].data=(void *)LL;
2002  // ----------------------------------------
2003  // 3: qideal
2004  L->m[3].rtyp=IDEAL_CMD;
2005  if (r->qideal==NULL)
2006  L->m[3].data=(void *)idInit(1,1);
2007  else
2008  L->m[3].data=(void *)idCopy(r->qideal);
2009  // ----------------------------------------
2010 #ifdef HAVE_PLURAL // NC! in rDecompose
2011  if (rIsPluralRing(r))
2012  {
2013  L->m[4].rtyp=MATRIX_CMD;
2014  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2015  L->m[5].rtyp=MATRIX_CMD;
2016  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2017  }
2018 #endif
2019  return L;
2020 }
2021 #endif
2022 
2023 lists rDecompose(const ring r)
2024 {
2025  assume( r != NULL );
2026  const coeffs C = r->cf;
2027  assume( C != NULL );
2028 
2029  // sanity check: require currRing==r for rings with polynomial data
2030  if ( (r!=currRing) && (
2031  (nCoeff_is_algExt(C) && (C != currRing->cf))
2032  || (r->qideal != NULL)
2033 #ifdef HAVE_PLURAL
2034  || (rIsPluralRing(r))
2035 #endif
2036  )
2037  )
2038  {
2039  WerrorS("ring with polynomial data must be the base ring or compatible");
2040  return NULL;
2041  }
2042  // 0: char/ cf - ring
2043  // 1: list (var)
2044  // 2: list (ord)
2045  // 3: qideal
2046  // possibly:
2047  // 4: C
2048  // 5: D
2050  if (rIsPluralRing(r))
2051  L->Init(6);
2052  else
2053  L->Init(4);
2054  // ----------------------------------------
2055  // 0: char/ cf - ring
2056  if (rField_is_numeric(r))
2057  {
2058  rDecomposeC(&(L->m[0]),r);
2059  }
2060  else if (rField_is_Ring(r))
2061  {
2062  rDecomposeRing(&(L->m[0]),r);
2063  }
2064  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2065  {
2066  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2067  }
2068  else if(rField_is_GF(r))
2069  {
2071  Lc->Init(4);
2072  // char:
2073  Lc->m[0].rtyp=INT_CMD;
2074  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2075  // var:
2077  Lv->Init(1);
2078  Lv->m[0].rtyp=STRING_CMD;
2079  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2080  Lc->m[1].rtyp=LIST_CMD;
2081  Lc->m[1].data=(void*)Lv;
2082  // ord:
2084  Lo->Init(1);
2086  Loo->Init(2);
2087  Loo->m[0].rtyp=STRING_CMD;
2088  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2089 
2090  intvec *iv=new intvec(1); (*iv)[0]=1;
2091  Loo->m[1].rtyp=INTVEC_CMD;
2092  Loo->m[1].data=(void *)iv;
2093 
2094  Lo->m[0].rtyp=LIST_CMD;
2095  Lo->m[0].data=(void*)Loo;
2096 
2097  Lc->m[2].rtyp=LIST_CMD;
2098  Lc->m[2].data=(void*)Lo;
2099  // q-ideal:
2100  Lc->m[3].rtyp=IDEAL_CMD;
2101  Lc->m[3].data=(void *)idInit(1,1);
2102  // ----------------------
2103  L->m[0].rtyp=LIST_CMD;
2104  L->m[0].data=(void*)Lc;
2105  }
2106  else
2107  {
2108  L->m[0].rtyp=INT_CMD;
2109  L->m[0].data=(void *)(long)r->cf->ch;
2110  }
2111  // ----------------------------------------
2112  // 1: list (var)
2114  LL->Init(r->N);
2115  int i;
2116  for(i=0; i<r->N; i++)
2117  {
2118  LL->m[i].rtyp=STRING_CMD;
2119  LL->m[i].data=(void *)omStrDup(r->names[i]);
2120  }
2121  L->m[1].rtyp=LIST_CMD;
2122  L->m[1].data=(void *)LL;
2123  // ----------------------------------------
2124  // 2: list (ord)
2126  i=rBlocks(r)-1;
2127  LL->Init(i);
2128  i--;
2129  lists LLL;
2130  for(; i>=0; i--)
2131  {
2132  intvec *iv;
2133  int j;
2134  LL->m[i].rtyp=LIST_CMD;
2136  LLL->Init(2);
2137  LLL->m[0].rtyp=STRING_CMD;
2138  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2139 
2140  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
2141  {
2142  assume( r->block0[i] == r->block1[i] );
2143  const int s = r->block0[i];
2144  assume( -2 < s && s < 2);
2145 
2146  iv=new intvec(1);
2147  (*iv)[0] = s;
2148  }
2149  else if (r->block1[i]-r->block0[i] >=0 )
2150  {
2151  int bl=j=r->block1[i]-r->block0[i];
2152  if (r->order[i]==ringorder_M)
2153  {
2154  j=(j+1)*(j+1)-1;
2155  bl=j+1;
2156  }
2157  else if (r->order[i]==ringorder_am)
2158  {
2159  j+=r->wvhdl[i][bl+1];
2160  }
2161  iv=new intvec(j+1);
2162  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2163  {
2164  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2165  }
2166  else switch (r->order[i])
2167  {
2168  case ringorder_dp:
2169  case ringorder_Dp:
2170  case ringorder_ds:
2171  case ringorder_Ds:
2172  case ringorder_lp:
2173  for(;j>=0; j--) (*iv)[j]=1;
2174  break;
2175  default: /* do nothing */;
2176  }
2177  }
2178  else
2179  {
2180  iv=new intvec(1);
2181  }
2182  LLL->m[1].rtyp=INTVEC_CMD;
2183  LLL->m[1].data=(void *)iv;
2184  LL->m[i].data=(void *)LLL;
2185  }
2186  L->m[2].rtyp=LIST_CMD;
2187  L->m[2].data=(void *)LL;
2188  // ----------------------------------------
2189  // 3: qideal
2190  L->m[3].rtyp=IDEAL_CMD;
2191  if (r->qideal==NULL)
2192  L->m[3].data=(void *)idInit(1,1);
2193  else
2194  L->m[3].data=(void *)idCopy(r->qideal);
2195  // ----------------------------------------
2196 #ifdef HAVE_PLURAL // NC! in rDecompose
2197  if (rIsPluralRing(r))
2198  {
2199  L->m[4].rtyp=MATRIX_CMD;
2200  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2201  L->m[5].rtyp=MATRIX_CMD;
2202  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2203  }
2204 #endif
2205  return L;
2206 }
2207 
2208 void rComposeC(lists L, ring R)
2209 /* field is R or C */
2210 {
2211  // ----------------------------------------
2212  // 0: char/ cf - ring
2213  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2214  {
2215  WerrorS("invalid coeff. field description, expecting 0");
2216  return;
2217  }
2218 // R->cf->ch=0;
2219  // ----------------------------------------
2220  // 1:
2221  if (L->m[1].rtyp!=LIST_CMD)
2222  {
2223  WerrorS("invalid coeff. field description, expecting precision list");
2224  return;
2225  }
2226  lists LL=(lists)L->m[1].data;
2227  if (((LL->nr!=2)
2228  || (LL->m[0].rtyp!=INT_CMD)
2229  || (LL->m[1].rtyp!=INT_CMD))
2230  && ((LL->nr!=1)
2231  || (LL->m[0].rtyp!=INT_CMD)))
2232  {
2233  WerrorS("invalid coeff. field description list");
2234  return;
2235  }
2236  int r1=(int)(long)LL->m[0].data;
2237  int r2=(int)(long)LL->m[1].data;
2238  if (L->nr==2) // complex
2239  R->cf = nInitChar(n_long_C, NULL);
2240  else if ((r1<=SHORT_REAL_LENGTH)
2241  && (r2=SHORT_REAL_LENGTH))
2242  R->cf = nInitChar(n_R, NULL);
2243  else
2244  {
2246  p->float_len=r1;
2247  p->float_len2=r2;
2248  R->cf = nInitChar(n_long_R, NULL);
2249  }
2250 
2251  if ((r1<=SHORT_REAL_LENGTH) // should go into nInitChar
2252  && (r2=SHORT_REAL_LENGTH))
2253  {
2254  R->cf->float_len=SHORT_REAL_LENGTH/2;
2255  R->cf->float_len2=SHORT_REAL_LENGTH;
2256  }
2257  else
2258  {
2259  R->cf->float_len=si_min(r1,32767);
2260  R->cf->float_len2=si_min(r2,32767);
2261  }
2262  // ----------------------------------------
2263  // 2: list (par)
2264  if (L->nr==2)
2265  {
2266  //R->cf->extRing->N=1;
2267  if (L->m[2].rtyp!=STRING_CMD)
2268  {
2269  WerrorS("invalid coeff. field description, expecting parameter name");
2270  return;
2271  }
2272  //(rParameter(R))=(char**)omAlloc0(rPar(R)*sizeof(char_ptr));
2273  rParameter(R)[0]=omStrDup((char *)L->m[2].data);
2274  }
2275  // ----------------------------------------
2276 }
2277 
2278 #ifdef HAVE_RINGS
2279 void rComposeRing(lists L, ring R)
2280 /* field is R or C */
2281 {
2282  // ----------------------------------------
2283  // 0: string: integer
2284  // no further entries --> Z
2285  mpz_ptr modBase = NULL;
2286  unsigned int modExponent = 1;
2287 
2288  modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
2289  if (L->nr == 0)
2290  {
2291  mpz_init_set_ui(modBase,0);
2292  modExponent = 1;
2293  }
2294  // ----------------------------------------
2295  // 1:
2296  else
2297  {
2298  if (L->m[1].rtyp!=LIST_CMD) WerrorS("invalid data, expecting list of numbers");
2299  lists LL=(lists)L->m[1].data;
2300  if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2301  {
2302  number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2303  // assume that tmp is integer, not rational
2304  n_MPZ (modBase, tmp, coeffs_BIGINT);
2305  }
2306  else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2307  {
2308  mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2309  }
2310  else
2311  {
2312  mpz_init_set_ui(modBase,0);
2313  }
2314  if (LL->nr >= 1)
2315  {
2316  modExponent = (unsigned long) LL->m[1].data;
2317  }
2318  else
2319  {
2320  modExponent = 1;
2321  }
2322  }
2323  // ----------------------------------------
2324  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
2325  {
2326  WerrorS("Wrong ground ring specification (module is 1)");
2327  return;
2328  }
2329  if (modExponent < 1)
2330  {
2331  WerrorS("Wrong ground ring specification (exponent smaller than 1)");
2332  return;
2333  }
2334  // module is 0 ---> integers
2335  if (mpz_cmp_ui(modBase, 0) == 0)
2336  {
2337  R->cf=nInitChar(n_Z,NULL);
2338  }
2339  // we have an exponent
2340  else if (modExponent > 1)
2341  {
2342  //R->cf->ch = R->cf->modExponent;
2343  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2344  {
2345  /* this branch should be active for modExponent = 2..32 resp. 2..64,
2346  depending on the size of a long on the respective platform */
2347  R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2348  omFreeSize (modBase, sizeof(mpz_t));
2349  }
2350  else
2351  {
2352  //ringtype 3
2353  ZnmInfo info;
2354  info.base= modBase;
2355  info.exp= modExponent;
2356  R->cf=nInitChar(n_Znm,(void*) &info);
2357  }
2358  }
2359  // just a module m > 1
2360  else
2361  {
2362  //ringtype = 2;
2363  //const int ch = mpz_get_ui(modBase);
2364  ZnmInfo info;
2365  info.base= modBase;
2366  info.exp= modExponent;
2367  R->cf=nInitChar(n_Zn,(void*) &info);
2368  }
2369 }
2370 #endif
2371 
2372 static void rRenameVars(ring R)
2373 {
2374  int i,j;
2375  BOOLEAN ch;
2376  do
2377  {
2378  ch=0;
2379  for(i=0;i<R->N-1;i++)
2380  {
2381  for(j=i+1;j<R->N;j++)
2382  {
2383  if (strcmp(R->names[i],R->names[j])==0)
2384  {
2385  ch=TRUE;
2386  Warn("name conflict var(%d) and var(%d): `%s`, rename to `@%s`",i+1,j+1,R->names[i],R->names[i]);
2387  omFree(R->names[j]);
2388  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2389  sprintf(R->names[j],"@%s",R->names[i]);
2390  }
2391  }
2392  }
2393  }
2394  while (ch);
2395  for(i=0;i<rPar(R); i++)
2396  {
2397  for(j=0;j<R->N;j++)
2398  {
2399  if (strcmp(rParameter(R)[i],R->names[j])==0)
2400  {
2401  Warn("name conflict par(%d) and var(%d): `%s`, renaming the VARIABLE to `@@(%d)`",i+1,j+1,R->names[j],i+1);
2402 // omFree(rParameter(R)[i]);
2403 // rParameter(R)[i]=(char *)omAlloc(10);
2404 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2405  omFree(R->names[j]);
2406  R->names[j]=(char *)omAlloc(10);
2407  sprintf(R->names[j],"@@(%d)",i+1);
2408  }
2409  }
2410  }
2411 }
2412 
2413 static inline BOOLEAN rComposeVar(const lists L, ring R)
2414 {
2415  assume(R!=NULL);
2416  if (L->m[1].Typ()==LIST_CMD)
2417  {
2418  lists v=(lists)L->m[1].Data();
2419  R->N = v->nr+1;
2420  if (R->N<=0)
2421  {
2422  WerrorS("no ring variables");
2423  return TRUE;
2424  }
2425  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2426  int i;
2427  for(i=0;i<R->N;i++)
2428  {
2429  if (v->m[i].Typ()==STRING_CMD)
2430  R->names[i]=omStrDup((char *)v->m[i].Data());
2431  else if (v->m[i].Typ()==POLY_CMD)
2432  {
2433  poly p=(poly)v->m[i].Data();
2434  int nr=pIsPurePower(p);
2435  if (nr>0)
2436  R->names[i]=omStrDup(currRing->names[nr-1]);
2437  else
2438  {
2439  Werror("var name %d must be a string or a ring variable",i+1);
2440  return TRUE;
2441  }
2442  }
2443  else
2444  {
2445  Werror("var name %d must be `string`",i+1);
2446  return TRUE;
2447  }
2448  }
2449  }
2450  else
2451  {
2452  WerrorS("variable must be given as `list`");
2453  return TRUE;
2454  }
2455  return FALSE;
2456 }
2457 
2458 static inline BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
2459 {
2460  assume(R!=NULL);
2461  long bitmask=0L;
2462  if (L->m[2].Typ()==LIST_CMD)
2463  {
2464  lists v=(lists)L->m[2].Data();
2465  int n= v->nr+2;
2466  int j_in_R,j_in_L;
2467  // do we have an entry "L",... ?: set bitmask
2468  for (int j=0; j < n-1; j++)
2469  {
2470  if (v->m[j].Typ()==LIST_CMD)
2471  {
2472  lists vv=(lists)v->m[j].Data();
2473  if ((vv->nr==1)
2474  &&(vv->m[0].Typ()==STRING_CMD)
2475  &&(strcmp((char*)vv->m[0].Data(),"L")==0))
2476  {
2477  number nn=(number)vv->m[1].Data();
2478  if (vv->m[1].Typ()==BIGINT_CMD)
2479  bitmask=n_Int(nn,coeffs_BIGINT);
2480  else if (vv->m[1].Typ()==INT_CMD)
2481  bitmask=(long)nn;
2482  else
2483  {
2484  Werror("illegal argument for pseudo ordering L: %d",vv->m[1].Typ());
2485  return TRUE;
2486  }
2487  break;
2488  }
2489  }
2490  }
2491  if (bitmask!=0) n--;
2492 
2493  // initialize fields of R
2494  R->order=(int *)omAlloc0(n*sizeof(int));
2495  R->block0=(int *)omAlloc0(n*sizeof(int));
2496  R->block1=(int *)omAlloc0(n*sizeof(int));
2497  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
2498  // init order, so that rBlocks works correctly
2499  for (j_in_R= n-2; j_in_R>=0; j_in_R--)
2500  R->order[j_in_R] = (int) ringorder_unspec;
2501  // orderings
2502  for(j_in_R=0,j_in_L=0;j_in_R<n-1;j_in_R++,j_in_L++)
2503  {
2504  // todo: a(..), M
2505  if (v->m[j_in_L].Typ()!=LIST_CMD)
2506  {
2507  WerrorS("ordering must be list of lists");
2508  return TRUE;
2509  }
2510  lists vv=(lists)v->m[j_in_L].Data();
2511  if ((vv->nr==1)
2512  && (vv->m[0].Typ()==STRING_CMD))
2513  {
2514  if (strcmp((char*)vv->m[0].Data(),"L")==0)
2515  {
2516  j_in_R--;
2517  continue;
2518  }
2519  if ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD))
2520  {
2521  PrintS(lString(vv));
2522  WerrorS("ordering name must be a (string,intvec)(1)");
2523  return TRUE;
2524  }
2525  R->order[j_in_R]=rOrderName(omStrDup((char*)vv->m[0].Data())); // assume STRING
2526 
2527  if (j_in_R==0) R->block0[0]=1;
2528  else
2529  {
2530  int jj=j_in_R-1;
2531  while((jj>=0)
2532  && ((R->order[jj]== ringorder_a)
2533  || (R->order[jj]== ringorder_aa)
2534  || (R->order[jj]== ringorder_am)
2535  || (R->order[jj]== ringorder_c)
2536  || (R->order[jj]== ringorder_C)
2537  || (R->order[jj]== ringorder_s)
2538  || (R->order[jj]== ringorder_S)
2539  ))
2540  {
2541  //Print("jj=%, skip %s\n",rSimpleOrdStr(R->order[jj]));
2542  jj--;
2543  }
2544  if (jj<0) R->block0[j_in_R]=1;
2545  else R->block0[j_in_R]=R->block1[jj]+1;
2546  }
2547  intvec *iv;
2548  if (vv->m[1].Typ()==INT_CMD)
2549  iv=new intvec((int)(long)vv->m[1].Data(),(int)(long)vv->m[1].Data());
2550  else
2551  iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC
2552  int iv_len=iv->length();
2553  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+iv_len-1);
2554  if (R->block1[j_in_R]>R->N)
2555  {
2556  R->block1[j_in_R]=R->N;
2557  iv_len=R->block1[j_in_R]-R->block0[j_in_R]+1;
2558  }
2559  //Print("block %d from %d to %d\n",j,R->block0[j], R->block1[j]);
2560  int i;
2561  switch (R->order[j_in_R])
2562  {
2563  case ringorder_ws:
2564  case ringorder_Ws:
2565  R->OrdSgn=-1;
2566  case ringorder_aa:
2567  case ringorder_a:
2568  case ringorder_wp:
2569  case ringorder_Wp:
2570  R->wvhdl[j_in_R] =( int *)omAlloc(iv_len*sizeof(int));
2571  for (i=0; i<iv_len;i++)
2572  {
2573  R->wvhdl[j_in_R][i]=(*iv)[i];
2574  }
2575  break;
2576  case ringorder_am:
2577  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length()+1)*sizeof(int));
2578  for (i=0; i<iv_len;i++)
2579  {
2580  R->wvhdl[j_in_R][i]=(*iv)[i];
2581  }
2582  R->wvhdl[j_in_R][i]=iv->length() - iv_len;
2583  //printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
2584  for (; i<iv->length(); i++)
2585  {
2586  R->wvhdl[j_in_R][i+1]=(*iv)[i];
2587  }
2588  break;
2589  case ringorder_M:
2590  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length())*sizeof(int));
2591  for (i=0; i<iv->length();i++) R->wvhdl[j_in_R][i]=(*iv)[i];
2592  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+(int)sqrt((double)(iv->length()-1)));
2593  if (R->block1[j_in_R]>R->N)
2594  {
2595  WerrorS("ordering matrix too big");
2596  return TRUE;
2597  }
2598  break;
2599  case ringorder_ls:
2600  case ringorder_ds:
2601  case ringorder_Ds:
2602  case ringorder_rs:
2603  R->OrdSgn=-1;
2604  case ringorder_lp:
2605  case ringorder_dp:
2606  case ringorder_Dp:
2607  case ringorder_rp:
2608  break;
2609  case ringorder_S:
2610  break;
2611  case ringorder_c:
2612  case ringorder_C:
2613  R->block1[j_in_R]=R->block0[j_in_R]=0;
2614  break;
2615 
2616  case ringorder_s:
2617  break;
2618 
2619  case ringorder_IS:
2620  {
2621  R->block1[j_in_R] = R->block0[j_in_R] = 0;
2622  if( iv->length() > 0 )
2623  {
2624  const int s = (*iv)[0];
2625  assume( -2 < s && s < 2 );
2626  R->block1[j_in_R] = R->block0[j_in_R] = s;
2627  }
2628  break;
2629  }
2630  case 0:
2631  case ringorder_unspec:
2632  break;
2633  }
2634  delete iv;
2635  }
2636  else
2637  {
2638  PrintS(lString(vv));
2639  WerrorS("ordering name must be a (string,intvec)");
2640  return TRUE;
2641  }
2642  }
2643  // sanity check
2644  j_in_R=n-2;
2645  if ((R->order[j_in_R]==ringorder_c)
2646  || (R->order[j_in_R]==ringorder_C)
2647  || (R->order[j_in_R]==ringorder_unspec)) j_in_R--;
2648  if (R->block1[j_in_R] != R->N)
2649  {
2650  if (((R->order[j_in_R]==ringorder_dp) ||
2651  (R->order[j_in_R]==ringorder_ds) ||
2652  (R->order[j_in_R]==ringorder_Dp) ||
2653  (R->order[j_in_R]==ringorder_Ds) ||
2654  (R->order[j_in_R]==ringorder_rp) ||
2655  (R->order[j_in_R]==ringorder_rs) ||
2656  (R->order[j_in_R]==ringorder_lp) ||
2657  (R->order[j_in_R]==ringorder_ls))
2658  &&
2659  R->block0[j_in_R] <= R->N)
2660  {
2661  R->block1[j_in_R] = R->N;
2662  }
2663  else
2664  {
2665  Werror("ordering incomplete: size (%d) should be %d",R->block1[j_in_R],R->N);
2666  return TRUE;
2667  }
2668  }
2669  if (R->block0[j_in_R]>R->N)
2670  {
2671  Werror("not enough variables (%d) for ordering block %d, scanned so far:",R->N,j_in_R+1);
2672  for(int ii=0;ii<=j_in_R;ii++)
2673  Werror("ord[%d]: %s from v%d to v%d",ii+1,rSimpleOrdStr(R->order[ii]),R->block0[ii],R->block1[ii]);
2674  return TRUE;
2675  }
2676  if (check_comp)
2677  {
2678  BOOLEAN comp_order=FALSE;
2679  int jj;
2680  for(jj=0;jj<n;jj++)
2681  {
2682  if ((R->order[jj]==ringorder_c) ||
2683  (R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
2684  }
2685  if (!comp_order)
2686  {
2687  R->order=(int*)omRealloc0Size(R->order,n*sizeof(int),(n+1)*sizeof(int));
2688  R->block0=(int*)omRealloc0Size(R->block0,n*sizeof(int),(n+1)*sizeof(int));
2689  R->block1=(int*)omRealloc0Size(R->block1,n*sizeof(int),(n+1)*sizeof(int));
2690  R->wvhdl=(int**)omRealloc0Size(R->wvhdl,n*sizeof(int_ptr),(n+1)*sizeof(int_ptr));
2691  R->order[n-1]=ringorder_C;
2692  R->block0[n-1]=0;
2693  R->block1[n-1]=0;
2694  R->wvhdl[n-1]=NULL;
2695  n++;
2696  }
2697  }
2698  }
2699  else
2700  {
2701  WerrorS("ordering must be given as `list`");
2702  return TRUE;
2703  }
2704  if (bitmask!=0) R->bitmask=bitmask*2;
2705  return FALSE;
2706 }
2707 
2708 ring rCompose(const lists L, const BOOLEAN check_comp)
2709 {
2710  if ((L->nr!=3)
2711 #ifdef HAVE_PLURAL
2712  &&(L->nr!=5)
2713 #endif
2714  )
2715  return NULL;
2716  int is_gf_char=0;
2717  // 0: char/ cf - ring
2718  // 1: list (var)
2719  // 2: list (ord)
2720  // 3: qideal
2721  // possibly:
2722  // 4: C
2723  // 5: D
2724 
2725  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2726 
2727  // ------------------------------------------------------------------
2728  // 0: char:
2729 #ifdef SINGULAR_4_1
2730  if (L->m[0].Typ()==CRING_CMD)
2731  {
2732  R->cf=(coeffs)L->m[0].Data();
2733  R->cf->ref++;
2734  }
2735  else
2736 #endif
2737  if (L->m[0].Typ()==INT_CMD)
2738  {
2739  int ch = (int)(long)L->m[0].Data();
2740  assume( ch >= 0 );
2741 
2742  if (ch == 0) // Q?
2743  R->cf = nInitChar(n_Q, NULL);
2744  else
2745  {
2746  int l = IsPrime(ch); // Zp?
2747  if( l != ch )
2748  {
2749  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2750  ch = l;
2751  }
2752  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2753  }
2754  }
2755  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2756  {
2757  lists LL=(lists)L->m[0].Data();
2758 
2759 #ifdef HAVE_RINGS
2760  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2761  {
2762  rComposeRing(LL, R); // Ring!?
2763  }
2764  else
2765 #endif
2766  if (LL->nr < 3)
2767  rComposeC(LL,R); // R, long_R, long_C
2768  else
2769  {
2770  if (LL->m[0].Typ()==INT_CMD)
2771  {
2772  int ch = (int)(long)LL->m[0].Data();
2773  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2774  if (fftable[is_gf_char]==0) is_gf_char=-1;
2775 
2776  if(is_gf_char!= -1)
2777  {
2778  GFInfo param;
2779 
2780  param.GFChar = ch;
2781  param.GFDegree = 1;
2782  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2783 
2784  // nfInitChar should be able to handle the case when ch is in fftables!
2785  R->cf = nInitChar(n_GF, (void*)&param);
2786  }
2787  }
2788 
2789  if( R->cf == NULL )
2790  {
2791  ring extRing = rCompose((lists)L->m[0].Data(),FALSE);
2792 
2793  if (extRing==NULL)
2794  {
2795  WerrorS("could not create the specified coefficient field");
2796  goto rCompose_err;
2797  }
2798 
2799  if( extRing->qideal != NULL ) // Algebraic extension
2800  {
2801  AlgExtInfo extParam;
2802 
2803  extParam.r = extRing;
2804 
2805  R->cf = nInitChar(n_algExt, (void*)&extParam);
2806  }
2807  else // Transcendental extension
2808  {
2809  TransExtInfo extParam;
2810  extParam.r = extRing;
2811  assume( extRing->qideal == NULL );
2812 
2813  R->cf = nInitChar(n_transExt, &extParam);
2814  }
2815  }
2816  }
2817  }
2818  else
2819  {
2820  WerrorS("coefficient field must be described by `int` or `list`");
2821  goto rCompose_err;
2822  }
2823 
2824  if( R->cf == NULL )
2825  {
2826  WerrorS("could not create coefficient field described by the input!");
2827  goto rCompose_err;
2828  }
2829 
2830  // ------------------------- VARS ---------------------------
2831  if (rComposeVar(L,R)) goto rCompose_err;
2832  // ------------------------ ORDER ------------------------------
2833  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2834 
2835  // ------------------------ ??????? --------------------
2836 
2837  rRenameVars(R);
2838  rComplete(R);
2839 
2840  // ------------------------ Q-IDEAL ------------------------
2841 
2842  if (L->m[3].Typ()==IDEAL_CMD)
2843  {
2844  ideal q=(ideal)L->m[3].Data();
2845  if (q->m[0]!=NULL)
2846  {
2847  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2848  {
2849  #if 0
2850  WerrorS("coefficient fields must be equal if q-ideal !=0");
2851  goto rCompose_err;
2852  #else
2853  ring orig_ring=currRing;
2854  rChangeCurrRing(R);
2855  int *perm=NULL;
2856  int *par_perm=NULL;
2857  int par_perm_size=0;
2858  nMapFunc nMap;
2859 
2860  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2861  {
2862  if (rEqual(orig_ring,currRing))
2863  {
2864  nMap=n_SetMap(currRing->cf, currRing->cf);
2865  }
2866  else
2867  // Allow imap/fetch to be make an exception only for:
2868  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2871  ||
2872  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2873  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2874  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2875  {
2876  par_perm_size=rPar(orig_ring);
2877 
2878 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2879 // naSetChar(rInternalChar(orig_ring),orig_ring);
2880 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2881 
2882  nSetChar(currRing->cf);
2883  }
2884  else
2885  {
2886  WerrorS("coefficient fields must be equal if q-ideal !=0");
2887  goto rCompose_err;
2888  }
2889  }
2890  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2891  if (par_perm_size!=0)
2892  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2893  int i;
2894  #if 0
2895  // use imap:
2896  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2897  currRing->names,currRing->N,currRing->parameter, currRing->P,
2898  perm,par_perm, currRing->ch);
2899  #else
2900  // use fetch
2901  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2902  {
2903  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2904  }
2905  else if (par_perm_size!=0)
2906  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2907  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
2908  #endif
2909  ideal dest_id=idInit(IDELEMS(q),1);
2910  for(i=IDELEMS(q)-1; i>=0; i--)
2911  {
2912  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
2913  par_perm,par_perm_size);
2914  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
2915  pTest(dest_id->m[i]);
2916  }
2917  R->qideal=dest_id;
2918  if (perm!=NULL)
2919  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
2920  if (par_perm!=NULL)
2921  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2922  rChangeCurrRing(orig_ring);
2923  #endif
2924  }
2925  else
2926  R->qideal=idrCopyR(q,currRing,R);
2927  }
2928  }
2929  else
2930  {
2931  WerrorS("q-ideal must be given as `ideal`");
2932  goto rCompose_err;
2933  }
2934 
2935 
2936  // ---------------------------------------------------------------
2937  #ifdef HAVE_PLURAL
2938  if (L->nr==5)
2939  {
2940  if (nc_CallPlural((matrix)L->m[4].Data(),
2941  (matrix)L->m[5].Data(),
2942  NULL,NULL,
2943  R,
2944  true, // !!!
2945  true, false,
2946  currRing, FALSE)) goto rCompose_err;
2947  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
2948  }
2949  #endif
2950  return R;
2951 
2952 rCompose_err:
2953  if (R->N>0)
2954  {
2955  int i;
2956  if (R->names!=NULL)
2957  {
2958  i=R->N-1;
2959  while (i>=0) { if (R->names[i]!=NULL) omFree(R->names[i]); i--; }
2960  omFree(R->names);
2961  }
2962  }
2963  if (R->order!=NULL) omFree(R->order);
2964  if (R->block0!=NULL) omFree(R->block0);
2965  if (R->block1!=NULL) omFree(R->block1);
2966  if (R->wvhdl!=NULL) omFree(R->wvhdl);
2967  omFree(R);
2968  return NULL;
2969 }
2970 
2971 // from matpol.cc
2972 
2973 /*2
2974 * compute the jacobi matrix of an ideal
2975 */
2977 {
2978  int i,j;
2979  matrix result;
2980  ideal id=(ideal)a->Data();
2981 
2982  result =mpNew(IDELEMS(id),rVar(currRing));
2983  for (i=1; i<=IDELEMS(id); i++)
2984  {
2985  for (j=1; j<=rVar(currRing); j++)
2986  {
2987  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
2988  }
2989  }
2990  res->data=(char *)result;
2991  return FALSE;
2992 }
2993 
2994 /*2
2995 * returns the Koszul-matrix of degree d of a vectorspace with dimension n
2996 * uses the first n entrees of id, if id <> NULL
2997 */
2999 {
3000  int n=(int)(long)b->Data();
3001  int d=(int)(long)c->Data();
3002  int k,l,sign,row,col;
3003  matrix result;
3004  ideal temp;
3005  BOOLEAN bo;
3006  poly p;
3007 
3008  if ((d>n) || (d<1) || (n<1))
3009  {
3010  res->data=(char *)mpNew(1,1);
3011  return FALSE;
3012  }
3013  int *choise = (int*)omAlloc(d*sizeof(int));
3014  if (id==NULL)
3015  temp=idMaxIdeal(1);
3016  else
3017  temp=(ideal)id->Data();
3018 
3019  k = binom(n,d);
3020  l = k*d;
3021  l /= n-d+1;
3022  result =mpNew(l,k);
3023  col = 1;
3024  idInitChoise(d,1,n,&bo,choise);
3025  while (!bo)
3026  {
3027  sign = 1;
3028  for (l=1;l<=d;l++)
3029  {
3030  if (choise[l-1]<=IDELEMS(temp))
3031  {
3032  p = pCopy(temp->m[choise[l-1]-1]);
3033  if (sign == -1) p = pNeg(p);
3034  sign *= -1;
3035  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3036  MATELEM(result,row,col) = p;
3037  }
3038  }
3039  col++;
3040  idGetNextChoise(d,n,&bo,choise);
3041  }
3042  if (id==NULL) idDelete(&temp);
3043 
3044  res->data=(char *)result;
3045  return FALSE;
3046 }
3047 
3048 // from syz1.cc
3049 /*2
3050 * read out the Betti numbers from resolution
3051 * (interpreter interface)
3052 */
3054 {
3055  syStrategy syzstr=(syStrategy)u->Data();
3056 
3057  BOOLEAN minim=(int)(long)w->Data();
3058  int row_shift=0;
3059  int add_row_shift=0;
3060  intvec *weights=NULL;
3061  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3062  if (ww!=NULL)
3063  {
3064  weights=ivCopy(ww);
3065  add_row_shift = ww->min_in();
3066  (*weights) -= add_row_shift;
3067  }
3068 
3069  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3070  //row_shift += add_row_shift;
3071  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3072  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3073 
3074  return FALSE;
3075 }
3077 {
3078  sleftv tmp;
3079  memset(&tmp,0,sizeof(tmp));
3080  tmp.rtyp=INT_CMD;
3081  tmp.data=(void *)1;
3082  return syBetti2(res,u,&tmp);
3083 }
3084 
3085 /*3
3086 * converts a resolution into a list of modules
3087 */
3088 lists syConvRes(syStrategy syzstr,BOOLEAN toDel,int add_row_shift)
3089 {
3090  resolvente fullres = syzstr->fullres;
3091  resolvente minres = syzstr->minres;
3092 
3093  const int length = syzstr->length;
3094 
3095  if ((fullres==NULL) && (minres==NULL))
3096  {
3097  if (syzstr->hilb_coeffs==NULL)
3098  { // La Scala
3099  fullres = syReorder(syzstr->res, length, syzstr);
3100  }
3101  else
3102  { // HRES
3103  minres = syReorder(syzstr->orderedRes, length, syzstr);
3104  syKillEmptyEntres(minres, length);
3105  }
3106  }
3107 
3108  resolvente tr;
3109  int typ0=IDEAL_CMD;
3110 
3111  if (minres!=NULL)
3112  tr = minres;
3113  else
3114  tr = fullres;
3115 
3116  resolvente trueres=NULL; intvec ** w=NULL;
3117 
3118  if (length>0)
3119  {
3120  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3121  for (int i=(length)-1;i>=0;i--)
3122  {
3123  if (tr[i]!=NULL)
3124  {
3125  trueres[i] = idCopy(tr[i]);
3126  }
3127  }
3128  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3129  typ0 = MODUL_CMD;
3130  if (syzstr->weights!=NULL)
3131  {
3132  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3133  for (int i=length-1;i>=0;i--)
3134  {
3135  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3136  }
3137  }
3138  }
3139 
3140  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3141  w, add_row_shift);
3142 
3143  if (w != NULL) omFreeSize(w, length*sizeof(intvec*));
3144 
3145  if (toDel)
3146  syKillComputation(syzstr);
3147  else
3148  {
3149  if( fullres != NULL && syzstr->fullres == NULL )
3150  syzstr->fullres = fullres;
3151 
3152  if( minres != NULL && syzstr->minres == NULL )
3153  syzstr->minres = minres;
3154  }
3155  return li;
3156 }
3157 
3158 /*3
3159 * converts a list of modules into a resolution
3160 */
3162 {
3163  int typ0;
3165 
3166  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3167  if (fr != NULL)
3168  {
3169 
3170  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3171  for (int i=result->length-1;i>=0;i--)
3172  {
3173  if (fr[i]!=NULL)
3174  result->fullres[i] = idCopy(fr[i]);
3175  }
3176  result->list_length=result->length;
3177  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3178  }
3179  else
3180  {
3181  omFreeSize(result, sizeof(ssyStrategy));
3182  result = NULL;
3183  }
3184  return result;
3185 }
3186 
3187 /*3
3188 * converts a list of modules into a minimal resolution
3189 */
3191 {
3192  int typ0;
3194 
3195  resolvente fr = liFindRes(li,&(result->length),&typ0);
3196  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3197  for (int i=result->length-1;i>=0;i--)
3198  {
3199  if (fr[i]!=NULL)
3200  result->minres[i] = idCopy(fr[i]);
3201  }
3202  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3203  return result;
3204 }
3205 // from weight.cc
3207 {
3208  ideal F=(ideal)id->Data();
3209  intvec * iv = new intvec(rVar(currRing));
3210  polyset s;
3211  int sl, n, i;
3212  int *x;
3213 
3214  res->data=(char *)iv;
3215  s = F->m;
3216  sl = IDELEMS(F) - 1;
3217  n = rVar(currRing);
3218  double wNsqr = (double)2.0 / (double)n;
3220  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3221  wCall(s, sl, x, wNsqr, currRing);
3222  for (i = n; i!=0; i--)
3223  (*iv)[i-1] = x[i + n + 1];
3224  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3225  return FALSE;
3226 }
3227 
3229 {
3230  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3231  if (res->data==NULL)
3232  res->data=(char *)new intvec(rVar(currRing));
3233  return FALSE;
3234 }
3235 /*==============================================================*/
3236 // from clapsing.cc
3237 #if 0
3238 BOOLEAN jjIS_SQR_FREE(leftv res, leftv u)
3239 {
3240  BOOLEAN b=singclap_factorize((poly)(u->CopyD()), &v, 0);
3241  res->data=(void *)b;
3242 }
3243 #endif
3244 
3246 {
3247  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3248  (poly)w->CopyD(), currRing);
3249  return errorreported;
3250 }
3251 
3253 {
3254  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3255  return (res->data==NULL);
3256 }
3257 
3258 // from semic.cc
3259 #ifdef HAVE_SPECTRUM
3260 
3261 // ----------------------------------------------------------------------------
3262 // Initialize a spectrum deep from a singular lists
3263 // ----------------------------------------------------------------------------
3264 
3265 void copy_deep( spectrum& spec, lists l )
3266 {
3267  spec.mu = (int)(long)(l->m[0].Data( ));
3268  spec.pg = (int)(long)(l->m[1].Data( ));
3269  spec.n = (int)(long)(l->m[2].Data( ));
3270 
3271  spec.copy_new( spec.n );
3272 
3273  intvec *num = (intvec*)l->m[3].Data( );
3274  intvec *den = (intvec*)l->m[4].Data( );
3275  intvec *mul = (intvec*)l->m[5].Data( );
3276 
3277  for( int i=0; i<spec.n; i++ )
3278  {
3279  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3280  spec.w[i] = (*mul)[i];
3281  }
3282 }
3283 
3284 // ----------------------------------------------------------------------------
3285 // singular lists constructor for spectrum
3286 // ----------------------------------------------------------------------------
3287 
3288 spectrum /*former spectrum::spectrum ( lists l )*/
3290 {
3291  spectrum result;
3292  copy_deep( result, l );
3293  return result;
3294 }
3295 
3296 // ----------------------------------------------------------------------------
3297 // generate a Singular lists from a spectrum
3298 // ----------------------------------------------------------------------------
3299 
3300 /* former spectrum::thelist ( void )*/
3302 {
3304 
3305  L->Init( 6 );
3306 
3307  intvec *num = new intvec( spec.n );
3308  intvec *den = new intvec( spec.n );
3309  intvec *mult = new intvec( spec.n );
3310 
3311  for( int i=0; i<spec.n; i++ )
3312  {
3313  (*num) [i] = spec.s[i].get_num_si( );
3314  (*den) [i] = spec.s[i].get_den_si( );
3315  (*mult)[i] = spec.w[i];
3316  }
3317 
3318  L->m[0].rtyp = INT_CMD; // milnor number
3319  L->m[1].rtyp = INT_CMD; // geometrical genus
3320  L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3321  L->m[3].rtyp = INTVEC_CMD; // numerators
3322  L->m[4].rtyp = INTVEC_CMD; // denomiantors
3323  L->m[5].rtyp = INTVEC_CMD; // multiplicities
3324 
3325  L->m[0].data = (void*)(long)spec.mu;
3326  L->m[1].data = (void*)(long)spec.pg;
3327  L->m[2].data = (void*)(long)spec.n;
3328  L->m[3].data = (void*)num;
3329  L->m[4].data = (void*)den;
3330  L->m[5].data = (void*)mult;
3331 
3332  return L;
3333 }
3334 // from spectrum.cc
3335 // ----------------------------------------------------------------------------
3336 // print out an error message for a spectrum list
3337 // ----------------------------------------------------------------------------
3338 
3339 typedef enum
3340 {
3343 
3346 
3353 
3358 
3364 
3367 
3370 
3371 } semicState;
3372 
3373 void list_error( semicState state )
3374 {
3375  switch( state )
3376  {
3377  case semicListTooShort:
3378  WerrorS( "the list is too short" );
3379  break;
3380  case semicListTooLong:
3381  WerrorS( "the list is too long" );
3382  break;
3383 
3385  WerrorS( "first element of the list should be int" );
3386  break;
3388  WerrorS( "second element of the list should be int" );
3389  break;
3391  WerrorS( "third element of the list should be int" );
3392  break;
3394  WerrorS( "fourth element of the list should be intvec" );
3395  break;
3397  WerrorS( "fifth element of the list should be intvec" );
3398  break;
3400  WerrorS( "sixth element of the list should be intvec" );
3401  break;
3402 
3403  case semicListNNegative:
3404  WerrorS( "first element of the list should be positive" );
3405  break;
3407  WerrorS( "wrong number of numerators" );
3408  break;
3410  WerrorS( "wrong number of denominators" );
3411  break;
3413  WerrorS( "wrong number of multiplicities" );
3414  break;
3415 
3416  case semicListMuNegative:
3417  WerrorS( "the Milnor number should be positive" );
3418  break;
3419  case semicListPgNegative:
3420  WerrorS( "the geometrical genus should be nonnegative" );
3421  break;
3422  case semicListNumNegative:
3423  WerrorS( "all numerators should be positive" );
3424  break;
3425  case semicListDenNegative:
3426  WerrorS( "all denominators should be positive" );
3427  break;
3428  case semicListMulNegative:
3429  WerrorS( "all multiplicities should be positive" );
3430  break;
3431 
3432  case semicListNotSymmetric:
3433  WerrorS( "it is not symmetric" );
3434  break;
3436  WerrorS( "it is not monotonous" );
3437  break;
3438 
3439  case semicListMilnorWrong:
3440  WerrorS( "the Milnor number is wrong" );
3441  break;
3442  case semicListPGWrong:
3443  WerrorS( "the geometrical genus is wrong" );
3444  break;
3445 
3446  default:
3447  WerrorS( "unspecific error" );
3448  break;
3449  }
3450 }
3451 // ----------------------------------------------------------------------------
3452 // this is the main spectrum computation function
3453 // ----------------------------------------------------------------------------
3454 
3456 {
3466 };
3467 
3468 // from splist.cc
3469 // ----------------------------------------------------------------------------
3470 // Compute the spectrum of a spectrumPolyList
3471 // ----------------------------------------------------------------------------
3472 
3473 /* former spectrumPolyList::spectrum ( lists*, int) */
3475 {
3476  spectrumPolyNode **node = &speclist.root;
3478 
3479  poly f,tmp;
3480  int found,cmp;
3481 
3482  Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3483  ( fast==2 ? 2 : 1 ) );
3484 
3485  Rational weight_prev( 0,1 );
3486 
3487  int mu = 0; // the milnor number
3488  int pg = 0; // the geometrical genus
3489  int n = 0; // number of different spectral numbers
3490  int z = 0; // number of spectral number equal to smax
3491 
3492  while( (*node)!=(spectrumPolyNode*)NULL &&
3493  ( fast==0 || (*node)->weight<=smax ) )
3494  {
3495  // ---------------------------------------
3496  // determine the first normal form which
3497  // contains the monomial node->mon
3498  // ---------------------------------------
3499 
3500  found = FALSE;
3501  search = *node;
3502 
3503  while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3504  {
3505  if( search->nf!=(poly)NULL )
3506  {
3507  f = search->nf;
3508 
3509  do
3510  {
3511  // --------------------------------
3512  // look for (*node)->mon in f
3513  // --------------------------------
3514 
3515  cmp = pCmp( (*node)->mon,f );
3516 
3517  if( cmp<0 )
3518  {
3519  f = pNext( f );
3520  }
3521  else if( cmp==0 )
3522  {
3523  // -----------------------------
3524  // we have found a normal form
3525  // -----------------------------
3526 
3527  found = TRUE;
3528 
3529  // normalize coefficient
3530 
3531  number inv = nInvers( pGetCoeff( f ) );
3532  pMult_nn( search->nf,inv );
3533  nDelete( &inv );
3534 
3535  // exchange normal forms
3536 
3537  tmp = (*node)->nf;
3538  (*node)->nf = search->nf;
3539  search->nf = tmp;
3540  }
3541  }
3542  while( cmp<0 && f!=(poly)NULL );
3543  }
3544  search = search->next;
3545  }
3546 
3547  if( found==FALSE )
3548  {
3549  // ------------------------------------------------
3550  // the weight of node->mon is a spectrum number
3551  // ------------------------------------------------
3552 
3553  mu++;
3554 
3555  if( (*node)->weight<=(Rational)1 ) pg++;
3556  if( (*node)->weight==smax ) z++;
3557  if( (*node)->weight>weight_prev ) n++;
3558 
3559  weight_prev = (*node)->weight;
3560  node = &((*node)->next);
3561  }
3562  else
3563  {
3564  // -----------------------------------------------
3565  // determine all other normal form which contain
3566  // the monomial node->mon
3567  // replace for node->mon its normal form
3568  // -----------------------------------------------
3569 
3570  while( search!=(spectrumPolyNode*)NULL )
3571  {
3572  if( search->nf!=(poly)NULL )
3573  {
3574  f = search->nf;
3575 
3576  do
3577  {
3578  // --------------------------------
3579  // look for (*node)->mon in f
3580  // --------------------------------
3581 
3582  cmp = pCmp( (*node)->mon,f );
3583 
3584  if( cmp<0 )
3585  {
3586  f = pNext( f );
3587  }
3588  else if( cmp==0 )
3589  {
3590  search->nf = pSub( search->nf,
3591  ppMult_nn( (*node)->nf,pGetCoeff( f ) ) );
3592  pNorm( search->nf );
3593  }
3594  }
3595  while( cmp<0 && f!=(poly)NULL );
3596  }
3597  search = search->next;
3598  }
3599  speclist.delete_node( node );
3600  }
3601 
3602  }
3603 
3604  // --------------------------------------------------------
3605  // fast computation exploits the symmetry of the spectrum
3606  // --------------------------------------------------------
3607 
3608  if( fast==2 )
3609  {
3610  mu = 2*mu - z;
3611  n = ( z > 0 ? 2*n - 1 : 2*n );
3612  }
3613 
3614  // --------------------------------------------------------
3615  // compute the spectrum numbers with their multiplicities
3616  // --------------------------------------------------------
3617 
3618  intvec *nom = new intvec( n );
3619  intvec *den = new intvec( n );
3620  intvec *mult = new intvec( n );
3621 
3622  int count = 0;
3623  int multiplicity = 1;
3624 
3625  for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3626  ( fast==0 || search->weight<=smax );
3627  search=search->next )
3628  {
3629  if( search->next==(spectrumPolyNode*)NULL ||
3630  search->weight<search->next->weight )
3631  {
3632  (*nom) [count] = search->weight.get_num_si( );
3633  (*den) [count] = search->weight.get_den_si( );
3634  (*mult)[count] = multiplicity;
3635 
3636  multiplicity=1;
3637  count++;
3638  }
3639  else
3640  {
3641  multiplicity++;
3642  }
3643  }
3644 
3645  // --------------------------------------------------------
3646  // fast computation exploits the symmetry of the spectrum
3647  // --------------------------------------------------------
3648 
3649  if( fast==2 )
3650  {
3651  int n1,n2;
3652  for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3653  {
3654  (*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
3655  (*den) [n2] = (*den)[n1];
3656  (*mult)[n2] = (*mult)[n1];
3657  }
3658  }
3659 
3660  // -----------------------------------
3661  // test if the spectrum is symmetric
3662  // -----------------------------------
3663 
3664  if( fast==0 || fast==1 )
3665  {
3666  int symmetric=TRUE;
3667 
3668  for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3669  {
3670  if( (*mult)[n1]!=(*mult)[n2] ||
3671  (*den) [n1]!= (*den)[n2] ||
3672  (*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
3673  {
3674  symmetric = FALSE;
3675  }
3676  }
3677 
3678  if( symmetric==FALSE )
3679  {
3680  // ---------------------------------------------
3681  // the spectrum is not symmetric => degenerate
3682  // principal part
3683  // ---------------------------------------------
3684 
3685  *L = (lists)omAllocBin( slists_bin);
3686  (*L)->Init( 1 );
3687  (*L)->m[0].rtyp = INT_CMD; // milnor number
3688  (*L)->m[0].data = (void*)(long)mu;
3689 
3690  return spectrumDegenerate;
3691  }
3692  }
3693 
3694  *L = (lists)omAllocBin( slists_bin);
3695 
3696  (*L)->Init( 6 );
3697 
3698  (*L)->m[0].rtyp = INT_CMD; // milnor number
3699  (*L)->m[1].rtyp = INT_CMD; // geometrical genus
3700  (*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3701  (*L)->m[3].rtyp = INTVEC_CMD; // nominators
3702  (*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3703  (*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3704 
3705  (*L)->m[0].data = (void*)(long)mu;
3706  (*L)->m[1].data = (void*)(long)pg;
3707  (*L)->m[2].data = (void*)(long)n;
3708  (*L)->m[3].data = (void*)nom;
3709  (*L)->m[4].data = (void*)den;
3710  (*L)->m[5].data = (void*)mult;
3711 
3712  return spectrumOK;
3713 }
3714 
3716 {
3717  int i;
3718 
3719  #ifdef SPECTRUM_DEBUG
3720  #ifdef SPECTRUM_PRINT
3721  #ifdef SPECTRUM_IOSTREAM
3722  cout << "spectrumCompute\n";
3723  if( fast==0 ) cout << " no optimization" << endl;
3724  if( fast==1 ) cout << " weight optimization" << endl;
3725  if( fast==2 ) cout << " symmetry optimization" << endl;
3726  #else
3727  fprintf( stdout,"spectrumCompute\n" );
3728  if( fast==0 ) fprintf( stdout," no optimization\n" );
3729  if( fast==1 ) fprintf( stdout," weight optimization\n" );
3730  if( fast==2 ) fprintf( stdout," symmetry optimization\n" );
3731  #endif
3732  #endif
3733  #endif
3734 
3735  // ----------------------
3736  // check if h is zero
3737  // ----------------------
3738 
3739  if( h==(poly)NULL )
3740  {
3741  return spectrumZero;
3742  }
3743 
3744  // ----------------------------------
3745  // check if h has a constant term
3746  // ----------------------------------
3747 
3748  if( hasConstTerm( h, currRing ) )
3749  {
3750  return spectrumBadPoly;
3751  }
3752 
3753  // --------------------------------
3754  // check if h has a linear term
3755  // --------------------------------
3756 
3757  if( hasLinearTerm( h, currRing ) )
3758  {
3759  *L = (lists)omAllocBin( slists_bin);
3760  (*L)->Init( 1 );
3761  (*L)->m[0].rtyp = INT_CMD; // milnor number
3762  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3763 
3764  return spectrumNoSingularity;
3765  }
3766 
3767  // ----------------------------------
3768  // compute the jacobi ideal of (h)
3769  // ----------------------------------
3770 
3771  ideal J = NULL;
3772  J = idInit( rVar(currRing),1 );
3773 
3774  #ifdef SPECTRUM_DEBUG
3775  #ifdef SPECTRUM_PRINT
3776  #ifdef SPECTRUM_IOSTREAM
3777  cout << "\n computing the Jacobi ideal...\n";
3778  #else
3779  fprintf( stdout,"\n computing the Jacobi ideal...\n" );
3780  #endif
3781  #endif
3782  #endif
3783 
3784  for( i=0; i<rVar(currRing); i++ )
3785  {
3786  J->m[i] = pDiff( h,i+1); //j );
3787 
3788  #ifdef SPECTRUM_DEBUG
3789  #ifdef SPECTRUM_PRINT
3790  #ifdef SPECTRUM_IOSTREAM
3791  cout << " ";
3792  #else
3793  fprintf( stdout," " );
3794  #endif
3795  pWrite( J->m[i] );
3796  #endif
3797  #endif
3798  }
3799 
3800  // --------------------------------------------
3801  // compute a standard basis stdJ of jac(h)
3802  // --------------------------------------------
3803 
3804  #ifdef SPECTRUM_DEBUG
3805  #ifdef SPECTRUM_PRINT
3806  #ifdef SPECTRUM_IOSTREAM
3807  cout << endl;
3808  cout << " computing a standard basis..." << endl;
3809  #else
3810  fprintf( stdout,"\n" );
3811  fprintf( stdout," computing a standard basis...\n" );
3812  #endif
3813  #endif
3814  #endif
3815 
3816  ideal stdJ = kStd(J,currRing->qideal,isNotHomog,NULL);
3817  idSkipZeroes( stdJ );
3818 
3819  #ifdef SPECTRUM_DEBUG
3820  #ifdef SPECTRUM_PRINT
3821  for( i=0; i<IDELEMS(stdJ); i++ )
3822  {
3823  #ifdef SPECTRUM_IOSTREAM
3824  cout << " ";
3825  #else
3826  fprintf( stdout," " );
3827  #endif
3828 
3829  pWrite( stdJ->m[i] );
3830  }
3831  #endif
3832  #endif
3833 
3834  idDelete( &J );
3835 
3836  // ------------------------------------------
3837  // check if the h has a singularity
3838  // ------------------------------------------
3839 
3840  if( hasOne( stdJ, currRing ) )
3841  {
3842  // -------------------------------
3843  // h is smooth in the origin
3844  // return only the Milnor number
3845  // -------------------------------
3846 
3847  *L = (lists)omAllocBin( slists_bin);
3848  (*L)->Init( 1 );
3849  (*L)->m[0].rtyp = INT_CMD; // milnor number
3850  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3851 
3852  return spectrumNoSingularity;
3853  }
3854 
3855  // ------------------------------------------
3856  // check if the singularity h is isolated
3857  // ------------------------------------------
3858 
3859  for( i=rVar(currRing); i>0; i-- )
3860  {
3861  if( hasAxis( stdJ,i, currRing )==FALSE )
3862  {
3863  return spectrumNotIsolated;
3864  }
3865  }
3866 
3867  // ------------------------------------------
3868  // compute the highest corner hc of stdJ
3869  // ------------------------------------------
3870 
3871  #ifdef SPECTRUM_DEBUG
3872  #ifdef SPECTRUM_PRINT
3873  #ifdef SPECTRUM_IOSTREAM
3874  cout << "\n computing the highest corner...\n";
3875  #else
3876  fprintf( stdout,"\n computing the highest corner...\n" );
3877  #endif
3878  #endif
3879  #endif
3880 
3881  poly hc = (poly)NULL;
3882 
3883  scComputeHC( stdJ,currRing->qideal, 0,hc );
3884 
3885  if( hc!=(poly)NULL )
3886  {
3887  pGetCoeff(hc) = nInit(1);
3888 
3889  for( i=rVar(currRing); i>0; i-- )
3890  {
3891  if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
3892  }
3893  pSetm( hc );
3894  }
3895  else
3896  {
3897  return spectrumNoHC;
3898  }
3899 
3900  #ifdef SPECTRUM_DEBUG
3901  #ifdef SPECTRUM_PRINT
3902  #ifdef SPECTRUM_IOSTREAM
3903  cout << " ";
3904  #else
3905  fprintf( stdout," " );
3906  #endif
3907  pWrite( hc );
3908  #endif
3909  #endif
3910 
3911  // ----------------------------------------
3912  // compute the Newton polygon nph of h
3913  // ----------------------------------------
3914 
3915  #ifdef SPECTRUM_DEBUG
3916  #ifdef SPECTRUM_PRINT
3917  #ifdef SPECTRUM_IOSTREAM
3918  cout << "\n computing the newton polygon...\n";
3919  #else
3920  fprintf( stdout,"\n computing the newton polygon...\n" );
3921  #endif
3922  #endif
3923  #endif
3924 
3925  newtonPolygon nph( h, currRing );
3926 
3927  #ifdef SPECTRUM_DEBUG
3928  #ifdef SPECTRUM_PRINT
3929  cout << nph;
3930  #endif
3931  #endif
3932 
3933  // -----------------------------------------------
3934  // compute the weight corner wc of (stdj,nph)
3935  // -----------------------------------------------
3936 
3937  #ifdef SPECTRUM_DEBUG
3938  #ifdef SPECTRUM_PRINT
3939  #ifdef SPECTRUM_IOSTREAM
3940  cout << "\n computing the weight corner...\n";
3941  #else
3942  fprintf( stdout,"\n computing the weight corner...\n" );
3943  #endif
3944  #endif
3945  #endif
3946 
3947  poly wc = ( fast==0 ? pCopy( hc ) :
3948  ( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
3949  /* fast==2 */computeWC( nph,
3950  ((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
3951 
3952  #ifdef SPECTRUM_DEBUG
3953  #ifdef SPECTRUM_PRINT
3954  #ifdef SPECTRUM_IOSTREAM
3955  cout << " ";
3956  #else
3957  fprintf( stdout," " );
3958  #endif
3959  pWrite( wc );
3960  #endif
3961  #endif
3962 
3963  // -------------
3964  // compute NF
3965  // -------------
3966 
3967  #ifdef SPECTRUM_DEBUG
3968  #ifdef SPECTRUM_PRINT
3969  #ifdef SPECTRUM_IOSTREAM
3970  cout << "\n computing NF...\n" << endl;
3971  #else
3972  fprintf( stdout,"\n computing NF...\n" );
3973  #endif
3974  #endif
3975  #endif
3976 
3977  spectrumPolyList NF( &nph );
3978 
3979  computeNF( stdJ,hc,wc,&NF, currRing );
3980 
3981  #ifdef SPECTRUM_DEBUG
3982  #ifdef SPECTRUM_PRINT
3983  cout << NF;
3984  #ifdef SPECTRUM_IOSTREAM
3985  cout << endl;
3986  #else
3987  fprintf( stdout,"\n" );
3988  #endif
3989  #endif
3990  #endif
3991 
3992  // ----------------------------
3993  // compute the spectrum of h
3994  // ----------------------------
3995 // spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
3996 
3997  return spectrumStateFromList(NF, L, fast );
3998 }
3999 
4000 // ----------------------------------------------------------------------------
4001 // this procedure is called from the interpreter
4002 // ----------------------------------------------------------------------------
4003 // first = polynomial
4004 // result = list of spectrum numbers
4005 // ----------------------------------------------------------------------------
4006 
4008 {
4009  switch( state )
4010  {
4011  case spectrumZero:
4012  WerrorS( "polynomial is zero" );
4013  break;
4014  case spectrumBadPoly:
4015  WerrorS( "polynomial has constant term" );
4016  break;
4017  case spectrumNoSingularity:
4018  WerrorS( "not a singularity" );
4019  break;
4020  case spectrumNotIsolated:
4021  WerrorS( "the singularity is not isolated" );
4022  break;
4023  case spectrumNoHC:
4024  WerrorS( "highest corner cannot be computed" );
4025  break;
4026  case spectrumDegenerate:
4027  WerrorS( "principal part is degenerate" );
4028  break;
4029  case spectrumOK:
4030  break;
4031 
4032  default:
4033  WerrorS( "unknown error occurred" );
4034  break;
4035  }
4036 }
4037 
4039 {
4040  spectrumState state = spectrumOK;
4041 
4042  // -------------------
4043  // check consistency
4044  // -------------------
4045 
4046  // check for a local ring
4047 
4048  if( !ringIsLocal(currRing ) )
4049  {
4050  WerrorS( "only works for local orderings" );
4051  state = spectrumWrongRing;
4052  }
4053 
4054  // no quotient rings are allowed
4055 
4056  else if( currRing->qideal != NULL )
4057  {
4058  WerrorS( "does not work in quotient rings" );
4059  state = spectrumWrongRing;
4060  }
4061  else
4062  {
4063  lists L = (lists)NULL;
4064  int flag = 1; // weight corner optimization is safe
4065 
4066  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4067 
4068  if( state==spectrumOK )
4069  {
4070  result->rtyp = LIST_CMD;
4071  result->data = (char*)L;
4072  }
4073  else
4074  {
4075  spectrumPrintError(state);
4076  }
4077  }
4078 
4079  return (state!=spectrumOK);
4080 }
4081 
4082 // ----------------------------------------------------------------------------
4083 // this procedure is called from the interpreter
4084 // ----------------------------------------------------------------------------
4085 // first = polynomial
4086 // result = list of spectrum numbers
4087 // ----------------------------------------------------------------------------
4088 
4090 {
4091  spectrumState state = spectrumOK;
4092 
4093  // -------------------
4094  // check consistency
4095  // -------------------
4096 
4097  // check for a local polynomial ring
4098 
4099  if( currRing->OrdSgn != -1 )
4100  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4101  // or should we use:
4102  //if( !ringIsLocal( ) )
4103  {
4104  WerrorS( "only works for local orderings" );
4105  state = spectrumWrongRing;
4106  }
4107  else if( currRing->qideal != NULL )
4108  {
4109  WerrorS( "does not work in quotient rings" );
4110  state = spectrumWrongRing;
4111  }
4112  else
4113  {
4114  lists L = (lists)NULL;
4115  int flag = 2; // symmetric optimization
4116 
4117  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4118 
4119  if( state==spectrumOK )
4120  {
4121  result->rtyp = LIST_CMD;
4122  result->data = (char*)L;
4123  }
4124  else
4125  {
4126  spectrumPrintError(state);
4127  }
4128  }
4129 
4130  return (state!=spectrumOK);
4131 }
4132 
4133 // ----------------------------------------------------------------------------
4134 // check if a list is a spectrum
4135 // check for:
4136 // list has 6 elements
4137 // 1st element is int (mu=Milnor number)
4138 // 2nd element is int (pg=geometrical genus)
4139 // 3rd element is int (n =number of different spectrum numbers)
4140 // 4th element is intvec (num=numerators)
4141 // 5th element is intvec (den=denomiantors)
4142 // 6th element is intvec (mul=multiplicities)
4143 // exactly n numerators
4144 // exactly n denominators
4145 // exactly n multiplicities
4146 // mu>0
4147 // pg>=0
4148 // n>0
4149 // num>0
4150 // den>0
4151 // mul>0
4152 // symmetriy with respect to numberofvariables/2
4153 // monotony
4154 // mu = sum of all multiplicities
4155 // pg = sum of all multiplicities where num/den<=1
4156 // ----------------------------------------------------------------------------
4157 
4158 semicState list_is_spectrum( lists l )
4159 {
4160  // -------------------
4161  // check list length
4162  // -------------------
4163 
4164  if( l->nr < 5 )
4165  {
4166  return semicListTooShort;
4167  }
4168  else if( l->nr > 5 )
4169  {
4170  return semicListTooLong;
4171  }
4172 
4173  // -------------
4174  // check types
4175  // -------------
4176 
4177  if( l->m[0].rtyp != INT_CMD )
4178  {
4180  }
4181  else if( l->m[1].rtyp != INT_CMD )
4182  {
4184  }
4185  else if( l->m[2].rtyp != INT_CMD )
4186  {
4188  }
4189  else if( l->m[3].rtyp != INTVEC_CMD )
4190  {
4192  }
4193  else if( l->m[4].rtyp != INTVEC_CMD )
4194  {
4196  }
4197  else if( l->m[5].rtyp != INTVEC_CMD )
4198  {
4200  }
4201 
4202  // -------------------------
4203  // check number of entries
4204  // -------------------------
4205 
4206  int mu = (int)(long)(l->m[0].Data( ));
4207  int pg = (int)(long)(l->m[1].Data( ));
4208  int n = (int)(long)(l->m[2].Data( ));
4209 
4210  if( n <= 0 )
4211  {
4212  return semicListNNegative;
4213  }
4214 
4215  intvec *num = (intvec*)l->m[3].Data( );
4216  intvec *den = (intvec*)l->m[4].Data( );
4217  intvec *mul = (intvec*)l->m[5].Data( );
4218 
4219  if( n != num->length( ) )
4220  {
4222  }
4223  else if( n != den->length( ) )
4224  {
4226  }
4227  else if( n != mul->length( ) )
4228  {
4230  }
4231 
4232  // --------
4233  // values
4234  // --------
4235 
4236  if( mu <= 0 )
4237  {
4238  return semicListMuNegative;
4239  }
4240  if( pg < 0 )
4241  {
4242  return semicListPgNegative;
4243  }
4244 
4245  int i;
4246 
4247  for( i=0; i<n; i++ )
4248  {
4249  if( (*num)[i] <= 0 )
4250  {
4251  return semicListNumNegative;
4252  }
4253  if( (*den)[i] <= 0 )
4254  {
4255  return semicListDenNegative;
4256  }
4257  if( (*mul)[i] <= 0 )
4258  {
4259  return semicListMulNegative;
4260  }
4261  }
4262 
4263  // ----------------
4264  // check symmetry
4265  // ----------------
4266 
4267  int j;
4268 
4269  for( i=0, j=n-1; i<=j; i++,j-- )
4270  {
4271  if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
4272  (*den)[i] != (*den)[j] ||
4273  (*mul)[i] != (*mul)[j] )
4274  {
4275  return semicListNotSymmetric;
4276  }
4277  }
4278 
4279  // ----------------
4280  // check monotony
4281  // ----------------
4282 
4283  for( i=0, j=1; i<n/2; i++,j++ )
4284  {
4285  if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
4286  {
4287  return semicListNotMonotonous;
4288  }
4289  }
4290 
4291  // ---------------------
4292  // check Milnor number
4293  // ---------------------
4294 
4295  for( mu=0, i=0; i<n; i++ )
4296  {
4297  mu += (*mul)[i];
4298  }
4299 
4300  if( mu != (int)(long)(l->m[0].Data( )) )
4301  {
4302  return semicListMilnorWrong;
4303  }
4304 
4305  // -------------------------
4306  // check geometrical genus
4307  // -------------------------
4308 
4309  for( pg=0, i=0; i<n; i++ )
4310  {
4311  if( (*num)[i]<=(*den)[i] )
4312  {
4313  pg += (*mul)[i];
4314  }
4315  }
4316 
4317  if( pg != (int)(long)(l->m[1].Data( )) )
4318  {
4319  return semicListPGWrong;
4320  }
4321 
4322  return semicOK;
4323 }
4324 
4325 // ----------------------------------------------------------------------------
4326 // this procedure is called from the interpreter
4327 // ----------------------------------------------------------------------------
4328 // first = list of spectrum numbers
4329 // second = list of spectrum numbers
4330 // result = sum of the two lists
4331 // ----------------------------------------------------------------------------
4332 
4334 {
4335  semicState state;
4336 
4337  // -----------------
4338  // check arguments
4339  // -----------------
4340 
4341  lists l1 = (lists)first->Data( );
4342  lists l2 = (lists)second->Data( );
4343 
4344  if( (state=list_is_spectrum( l1 )) != semicOK )
4345  {
4346  WerrorS( "first argument is not a spectrum:" );
4347  list_error( state );
4348  }
4349  else if( (state=list_is_spectrum( l2 )) != semicOK )
4350  {
4351  WerrorS( "second argument is not a spectrum:" );
4352  list_error( state );
4353  }
4354  else
4355  {
4356  spectrum s1= spectrumFromList ( l1 );
4357  spectrum s2= spectrumFromList ( l2 );
4358  spectrum sum( s1+s2 );
4359 
4360  result->rtyp = LIST_CMD;
4361  result->data = (char*)(getList(sum));
4362  }
4363 
4364  return (state!=semicOK);
4365 }
4366 
4367 // ----------------------------------------------------------------------------
4368 // this procedure is called from the interpreter
4369 // ----------------------------------------------------------------------------
4370 // first = list of spectrum numbers
4371 // second = integer
4372 // result = the multiple of the first list by the second factor
4373 // ----------------------------------------------------------------------------
4374 
4376 {
4377  semicState state;
4378 
4379  // -----------------
4380  // check arguments
4381  // -----------------
4382 
4383  lists l = (lists)first->Data( );
4384  int k = (int)(long)second->Data( );
4385 
4386  if( (state=list_is_spectrum( l ))!=semicOK )
4387  {
4388  WerrorS( "first argument is not a spectrum" );
4389  list_error( state );
4390  }
4391  else if( k < 0 )
4392  {
4393  WerrorS( "second argument should be positive" );
4394  state = semicMulNegative;
4395  }
4396  else
4397  {
4398  spectrum s= spectrumFromList( l );
4399  spectrum product( k*s );
4400 
4401  result->rtyp = LIST_CMD;
4402  result->data = (char*)getList(product);
4403  }
4404 
4405  return (state!=semicOK);
4406 }
4407 
4408 // ----------------------------------------------------------------------------
4409 // this procedure is called from the interpreter
4410 // ----------------------------------------------------------------------------
4411 // first = list of spectrum numbers
4412 // second = list of spectrum numbers
4413 // result = semicontinuity index
4414 // ----------------------------------------------------------------------------
4415 
4417 {
4418  semicState state;
4419  BOOLEAN qh=(((int)(long)w->Data())==1);
4420 
4421  // -----------------
4422  // check arguments
4423  // -----------------
4424 
4425  lists l1 = (lists)u->Data( );
4426  lists l2 = (lists)v->Data( );
4427 
4428  if( (state=list_is_spectrum( l1 ))!=semicOK )
4429  {
4430  WerrorS( "first argument is not a spectrum" );
4431  list_error( state );
4432  }
4433  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4434  {
4435  WerrorS( "second argument is not a spectrum" );
4436  list_error( state );
4437  }
4438  else
4439  {
4440  spectrum s1= spectrumFromList( l1 );
4441  spectrum s2= spectrumFromList( l2 );
4442 
4443  res->rtyp = INT_CMD;
4444  if (qh)
4445  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4446  else
4447  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4448  }
4449 
4450  // -----------------
4451  // check status
4452  // -----------------
4453 
4454  return (state!=semicOK);
4455 }
4457 {
4458  sleftv tmp;
4459  memset(&tmp,0,sizeof(tmp));
4460  tmp.rtyp=INT_CMD;
4461  /* tmp.data = (void *)0; -- done by memset */
4462 
4463  return semicProc3(res,u,v,&tmp);
4464 }
4465 
4466 #endif
4467 
4469 {
4470  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4471  return FALSE;
4472 }
4473 
4475 {
4476  if ( !(rField_is_long_R(currRing)) )
4477  {
4478  WerrorS("Ground field not implemented!");
4479  return TRUE;
4480  }
4481 
4482  simplex * LP;
4483  matrix m;
4484 
4485  leftv v= args;
4486  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4487  return TRUE;
4488  else
4489  m= (matrix)(v->CopyD());
4490 
4491  LP = new simplex(MATROWS(m),MATCOLS(m));
4492  LP->mapFromMatrix(m);
4493 
4494  v= v->next;
4495  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4496  return TRUE;
4497  else
4498  LP->m= (int)(long)(v->Data());
4499 
4500  v= v->next;
4501  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4502  return TRUE;
4503  else
4504  LP->n= (int)(long)(v->Data());
4505 
4506  v= v->next;
4507  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4508  return TRUE;
4509  else
4510  LP->m1= (int)(long)(v->Data());
4511 
4512  v= v->next;
4513  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4514  return TRUE;
4515  else
4516  LP->m2= (int)(long)(v->Data());
4517 
4518  v= v->next;
4519  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4520  return TRUE;
4521  else
4522  LP->m3= (int)(long)(v->Data());
4523 
4524 #ifdef mprDEBUG_PROT
4525  Print("m (constraints) %d\n",LP->m);
4526  Print("n (columns) %d\n",LP->n);
4527  Print("m1 (<=) %d\n",LP->m1);
4528  Print("m2 (>=) %d\n",LP->m2);
4529  Print("m3 (==) %d\n",LP->m3);
4530 #endif
4531 
4532  LP->compute();
4533 
4534  lists lres= (lists)omAlloc( sizeof(slists) );
4535  lres->Init( 6 );
4536 
4537  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4538  lres->m[0].data=(void*)LP->mapToMatrix(m);
4539 
4540  lres->m[1].rtyp= INT_CMD; // found a solution?
4541  lres->m[1].data=(void*)(long)LP->icase;
4542 
4543  lres->m[2].rtyp= INTVEC_CMD;
4544  lres->m[2].data=(void*)LP->posvToIV();
4545 
4546  lres->m[3].rtyp= INTVEC_CMD;
4547  lres->m[3].data=(void*)LP->zrovToIV();
4548 
4549  lres->m[4].rtyp= INT_CMD;
4550  lres->m[4].data=(void*)(long)LP->m;
4551 
4552  lres->m[5].rtyp= INT_CMD;
4553  lres->m[5].data=(void*)(long)LP->n;
4554 
4555  res->data= (void*)lres;
4556 
4557  return FALSE;
4558 }
4559 
4560 BOOLEAN nuMPResMat( leftv res, leftv arg1, leftv arg2 )
4561 {
4562  ideal gls = (ideal)(arg1->Data());
4563  int imtype= (int)(long)arg2->Data();
4564 
4565  uResultant::resMatType mtype= determineMType( imtype );
4566 
4567  // check input ideal ( = polynomial system )
4568  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4569  {
4570  return TRUE;
4571  }
4572 
4573  uResultant *resMat= new uResultant( gls, mtype, false );
4574  if (resMat!=NULL)
4575  {
4576  res->rtyp = MODUL_CMD;
4577  res->data= (void*)resMat->accessResMat()->getMatrix();
4578  if (!errorreported) delete resMat;
4579  }
4580  return errorreported;
4581 }
4582 
4583 BOOLEAN nuLagSolve( leftv res, leftv arg1, leftv arg2, leftv arg3 )
4584 {
4585 
4586  poly gls;
4587  gls= (poly)(arg1->Data());
4588  int howclean= (int)(long)arg3->Data();
4589 
4590  if ( !(rField_is_R(currRing) ||
4591  rField_is_Q(currRing) ||
4594  {
4595  WerrorS("Ground field not implemented!");
4596  return TRUE;
4597  }
4598 
4601  {
4602  unsigned long int ii = (unsigned long int)arg2->Data();
4603  setGMPFloatDigits( ii, ii );
4604  }
4605 
4606  if ( gls == NULL || pIsConstant( gls ) )
4607  {
4608  WerrorS("Input polynomial is constant!");
4609  return TRUE;
4610  }
4611 
4612  int ldummy;
4613  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4614  int i,vpos=0;
4615  poly piter;
4616  lists elist;
4617  lists rlist;
4618 
4619  elist= (lists)omAlloc( sizeof(slists) );
4620  elist->Init( 0 );
4621 
4622  if ( rVar(currRing) > 1 )
4623  {
4624  piter= gls;
4625  for ( i= 1; i <= rVar(currRing); i++ )
4626  if ( pGetExp( piter, i ) )
4627  {
4628  vpos= i;
4629  break;
4630  }
4631  while ( piter )
4632  {
4633  for ( i= 1; i <= rVar(currRing); i++ )
4634  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4635  {
4636  WerrorS("The input polynomial must be univariate!");
4637  return TRUE;
4638  }
4639  pIter( piter );
4640  }
4641  }
4642 
4643  rootContainer * roots= new rootContainer();
4644  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4645  piter= gls;
4646  for ( i= deg; i >= 0; i-- )
4647  {
4648  if ( piter && pTotaldegree(piter) == i )
4649  {
4650  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4651  //nPrint( pcoeffs[i] );PrintS(" ");
4652  pIter( piter );
4653  }
4654  else
4655  {
4656  pcoeffs[i]= nInit(0);
4657  }
4658  }
4659 
4660 #ifdef mprDEBUG_PROT
4661  for (i=deg; i >= 0; i--)
4662  {
4663  nPrint( pcoeffs[i] );PrintS(" ");
4664  }
4665  PrintLn();
4666 #endif
4667 
4668  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4669  roots->solver( howclean );
4670 
4671  int elem= roots->getAnzRoots();
4672  char *dummy;
4673  int j;
4674 
4675  rlist= (lists)omAlloc( sizeof(slists) );
4676  rlist->Init( elem );
4677 
4679  {
4680  for ( j= 0; j < elem; j++ )
4681  {
4682  rlist->m[j].rtyp=NUMBER_CMD;
4683  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4684  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4685  }
4686  }
4687  else
4688  {
4689  for ( j= 0; j < elem; j++ )
4690  {
4691  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4692  rlist->m[j].rtyp=STRING_CMD;
4693  rlist->m[j].data=(void *)dummy;
4694  }
4695  }
4696 
4697  elist->Clean();
4698  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4699 
4700  // this is (via fillContainer) the same data as in root
4701  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4702  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4703 
4704  delete roots;
4705 
4706  res->rtyp= LIST_CMD;
4707  res->data= (void*)rlist;
4708 
4709  return FALSE;
4710 }
4711 
4712 BOOLEAN nuVanderSys( leftv res, leftv arg1, leftv arg2, leftv arg3)
4713 {
4714  int i;
4715  ideal p,w;
4716  p= (ideal)arg1->Data();
4717  w= (ideal)arg2->Data();
4718 
4719  // w[0] = f(p^0)
4720  // w[1] = f(p^1)
4721  // ...
4722  // p can be a vector of numbers (multivariate polynom)
4723  // or one number (univariate polynom)
4724  // tdg = deg(f)
4725 
4726  int n= IDELEMS( p );
4727  int m= IDELEMS( w );
4728  int tdg= (int)(long)arg3->Data();
4729 
4730  res->data= (void*)NULL;
4731 
4732  // check the input
4733  if ( tdg < 1 )
4734  {
4735  WerrorS("Last input parameter must be > 0!");
4736  return TRUE;
4737  }
4738  if ( n != rVar(currRing) )
4739  {
4740  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4741  return TRUE;
4742  }
4743  if ( m != (int)pow((double)tdg+1,(double)n) )
4744  {
4745  Werror("Size of second input ideal must be equal to %d!",
4746  (int)pow((double)tdg+1,(double)n));
4747  return TRUE;
4748  }
4749  if ( !(rField_is_Q(currRing) /* ||
4750  rField_is_R() || rField_is_long_R() ||
4751  rField_is_long_C()*/ ) )
4752  {
4753  WerrorS("Ground field not implemented!");
4754  return TRUE;
4755  }
4756 
4757  number tmp;
4758  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4759  for ( i= 0; i < n; i++ )
4760  {
4761  pevpoint[i]=nInit(0);
4762  if ( (p->m)[i] )
4763  {
4764  tmp = pGetCoeff( (p->m)[i] );
4765  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4766  {
4767  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4768  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4769  return TRUE;
4770  }
4771  } else tmp= NULL;
4772  if ( !nIsZero(tmp) )
4773  {
4774  if ( !pIsConstant((p->m)[i]))
4775  {
4776  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4777  WerrorS("Elements of first input ideal must be numbers!");
4778  return TRUE;
4779  }
4780  pevpoint[i]= nCopy( tmp );
4781  }
4782  }
4783 
4784  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4785  for ( i= 0; i < m; i++ )
4786  {
4787  wresults[i]= nInit(0);
4788  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4789  {
4790  if ( !pIsConstant((w->m)[i]))
4791  {
4792  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4793  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4794  WerrorS("Elements of second input ideal must be numbers!");
4795  return TRUE;
4796  }
4797  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4798  }
4799  }
4800 
4801  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4802  number *ncpoly= vm.interpolateDense( wresults );
4803  // do not free ncpoly[]!!
4804  poly rpoly= vm.numvec2poly( ncpoly );
4805 
4806  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4807  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4808 
4809  res->data= (void*)rpoly;
4810  return FALSE;
4811 }
4812 
4814 {
4815  leftv v= args;
4816 
4817  ideal gls;
4818  int imtype;
4819  int howclean;
4820 
4821  // get ideal
4822  if ( v->Typ() != IDEAL_CMD )
4823  return TRUE;
4824  else gls= (ideal)(v->Data());
4825  v= v->next;
4826 
4827  // get resultant matrix type to use (0,1)
4828  if ( v->Typ() != INT_CMD )
4829  return TRUE;
4830  else imtype= (int)(long)v->Data();
4831  v= v->next;
4832 
4833  if (imtype==0)
4834  {
4835  ideal test_id=idInit(1,1);
4836  int j;
4837  for(j=IDELEMS(gls)-1;j>=0;j--)
4838  {
4839  if (gls->m[j]!=NULL)
4840  {
4841  test_id->m[0]=gls->m[j];
4842  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4843  if (dummy_w!=NULL)
4844  {
4845  WerrorS("Newton polytope not of expected dimension");
4846  delete dummy_w;
4847  return TRUE;
4848  }
4849  }
4850  }
4851  }
4852 
4853  // get and set precision in digits ( > 0 )
4854  if ( v->Typ() != INT_CMD )
4855  return TRUE;
4856  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4858  {
4859  unsigned long int ii=(unsigned long int)v->Data();
4860  setGMPFloatDigits( ii, ii );
4861  }
4862  v= v->next;
4863 
4864  // get interpolation steps (0,1,2)
4865  if ( v->Typ() != INT_CMD )
4866  return TRUE;
4867  else howclean= (int)(long)v->Data();
4868 
4869  uResultant::resMatType mtype= determineMType( imtype );
4870  int i,count;
4871  lists listofroots= NULL;
4872  number smv= NULL;
4873  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4874 
4875  //emptylist= (lists)omAlloc( sizeof(slists) );
4876  //emptylist->Init( 0 );
4877 
4878  //res->rtyp = LIST_CMD;
4879  //res->data= (void *)emptylist;
4880 
4881  // check input ideal ( = polynomial system )
4882  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4883  {
4884  return TRUE;
4885  }
4886 
4887  uResultant * ures;
4888  rootContainer ** iproots;
4889  rootContainer ** muiproots;
4890  rootArranger * arranger;
4891 
4892  // main task 1: setup of resultant matrix
4893  ures= new uResultant( gls, mtype );
4894  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
4895  {
4896  WerrorS("Error occurred during matrix setup!");
4897  return TRUE;
4898  }
4899 
4900  // if dense resultant, check if minor nonsingular
4901  if ( mtype == uResultant::denseResMat )
4902  {
4903  smv= ures->accessResMat()->getSubDet();
4904 #ifdef mprDEBUG_PROT
4905  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
4906 #endif
4907  if ( nIsZero(smv) )
4908  {
4909  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
4910  return TRUE;
4911  }
4912  }
4913 
4914  // main task 2: Interpolate specialized resultant polynomials
4915  if ( interpolate_det )
4916  iproots= ures->interpolateDenseSP( false, smv );
4917  else
4918  iproots= ures->specializeInU( false, smv );
4919 
4920  // main task 3: Interpolate specialized resultant polynomials
4921  if ( interpolate_det )
4922  muiproots= ures->interpolateDenseSP( true, smv );
4923  else
4924  muiproots= ures->specializeInU( true, smv );
4925 
4926 #ifdef mprDEBUG_PROT
4927  int c= iproots[0]->getAnzElems();
4928  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
4929  c= muiproots[0]->getAnzElems();
4930  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
4931 #endif
4932 
4933  // main task 4: Compute roots of specialized polys and match them up
4934  arranger= new rootArranger( iproots, muiproots, howclean );
4935  arranger->solve_all();
4936 
4937  // get list of roots
4938  if ( arranger->success() )
4939  {
4940  arranger->arrange();
4941  listofroots= listOfRoots(arranger, gmp_output_digits );
4942  }
4943  else
4944  {
4945  WerrorS("Solver was unable to find any roots!");
4946  return TRUE;
4947  }
4948 
4949  // free everything
4950  count= iproots[0]->getAnzElems();
4951  for (i=0; i < count; i++) delete iproots[i];
4952  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
4953  count= muiproots[0]->getAnzElems();
4954  for (i=0; i < count; i++) delete muiproots[i];
4955  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
4956 
4957  delete ures;
4958  delete arranger;
4959  nDelete( &smv );
4960 
4961  res->data= (void *)listofroots;
4962 
4963  //emptylist->Clean();
4964  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
4965 
4966  return FALSE;
4967 }
4968 
4969 // from mpr_numeric.cc
4970 lists listOfRoots( rootArranger* self, const unsigned int oprec )
4971 {
4972  int i,j;
4973  int count= self->roots[0]->getAnzRoots(); // number of roots
4974  int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
4975 
4976  lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
4977 
4978  if ( self->found_roots )
4979  {
4980  listofroots->Init( count );
4981 
4982  for (i=0; i < count; i++)
4983  {
4984  lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
4985  onepoint->Init(elem);
4986  for ( j= 0; j < elem; j++ )
4987  {
4988  if ( !rField_is_long_C(currRing) )
4989  {
4990  onepoint->m[j].rtyp=STRING_CMD;
4991  onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
4992  }
4993  else
4994  {
4995  onepoint->m[j].rtyp=NUMBER_CMD;
4996  onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
4997  }
4998  onepoint->m[j].next= NULL;
4999  onepoint->m[j].name= NULL;
5000  }
5001  listofroots->m[i].rtyp=LIST_CMD;
5002  listofroots->m[i].data=(void *)onepoint;
5003  listofroots->m[j].next= NULL;
5004  listofroots->m[j].name= NULL;
5005  }
5006 
5007  }
5008  else
5009  {
5010  listofroots->Init( 0 );
5011  }
5012 
5013  return listofroots;
5014 }
5015 
5016 // from ring.cc
5018 {
5019  ring rg = NULL;
5020  if (h!=NULL)
5021  {
5022 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5023  rg = IDRING(h);
5024  if (rg==NULL) return; //id <>NULL, ring==NULL
5025  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5026  if (IDID(h)) // OB: ????
5027  omCheckAddr((ADDRESS)IDID(h));
5028  rTest(rg);
5029  }
5030 
5031  // clean up history
5033  {
5035  memset(&sLastPrinted,0,sizeof(sleftv));
5036  }
5037 
5038  if ((rg!=currRing)&&(currRing!=NULL))
5039  {
5041  if (DENOMINATOR_LIST!=NULL)
5042  {
5043  if (TEST_V_ALLWARN)
5044  Warn("deleting denom_list for ring change to %s",IDID(h));
5045  do
5046  {
5047  n_Delete(&(dd->n),currRing->cf);
5048  dd=dd->next;
5050  DENOMINATOR_LIST=dd;
5051  } while(DENOMINATOR_LIST!=NULL);
5052  }
5053  }
5054 
5055  // test for valid "currRing":
5056  if ((rg!=NULL) && (rg->idroot==NULL))
5057  {
5058  ring old=rg;
5059  rg=rAssure_HasComp(rg);
5060  if (old!=rg)
5061  {
5062  rKill(old);
5063  IDRING(h)=rg;
5064  }
5065  }
5066  /*------------ change the global ring -----------------------*/
5067  rChangeCurrRing(rg);
5068  currRingHdl = h;
5069 }
5070 
5072 {
5073  // change some bad orderings/combination into better ones
5074  leftv h=ord;
5075  while(h!=NULL)
5076  {
5077  BOOLEAN change=FALSE;
5078  intvec *iv = (intvec *)(h->data);
5079  // ws(-i) -> wp(i)
5080  if ((*iv)[1]==ringorder_ws)
5081  {
5082  BOOLEAN neg=TRUE;
5083  for(int i=2;i<iv->length();i++)
5084  if((*iv)[i]>=0) { neg=FALSE; break; }
5085  if (neg)
5086  {
5087  (*iv)[1]=ringorder_wp;
5088  for(int i=2;i<iv->length();i++)
5089  (*iv)[i]= - (*iv)[i];
5090  change=TRUE;
5091  }
5092  }
5093  // Ws(-i) -> Wp(i)
5094  if ((*iv)[1]==ringorder_Ws)
5095  {
5096  BOOLEAN neg=TRUE;
5097  for(int i=2;i<iv->length();i++)
5098  if((*iv)[i]>=0) { neg=FALSE; break; }
5099  if (neg)
5100  {
5101  (*iv)[1]=ringorder_Wp;
5102  for(int i=2;i<iv->length();i++)
5103  (*iv)[i]= -(*iv)[i];
5104  change=TRUE;
5105  }
5106  }
5107  // wp(1) -> dp
5108  if ((*iv)[1]==ringorder_wp)
5109  {
5110  BOOLEAN all_one=TRUE;
5111  for(int i=2;i<iv->length();i++)
5112  if((*iv)[i]!=1) { all_one=FALSE; break; }
5113  if (all_one)
5114  {
5115  intvec *iv2=new intvec(3);
5116  (*iv2)[0]=1;
5117  (*iv2)[1]=ringorder_dp;
5118  (*iv2)[2]=iv->length()-2;
5119  delete iv;
5120  iv=iv2;
5121  h->data=iv2;
5122  change=TRUE;
5123  }
5124  }
5125  // Wp(1) -> Dp
5126  if ((*iv)[1]==ringorder_Wp)
5127  {
5128  BOOLEAN all_one=TRUE;
5129  for(int i=2;i<iv->length();i++)
5130  if((*iv)[i]!=1) { all_one=FALSE; break; }
5131  if (all_one)
5132  {
5133  intvec *iv2=new intvec(3);
5134  (*iv2)[0]=1;
5135  (*iv2)[1]=ringorder_Dp;
5136  (*iv2)[2]=iv->length()-2;
5137  delete iv;
5138  iv=iv2;
5139  h->data=iv2;
5140  change=TRUE;
5141  }
5142  }
5143  // dp(1)/Dp(1)/rp(1) -> lp(1)
5144  if (((*iv)[1]==ringorder_dp)
5145  || ((*iv)[1]==ringorder_Dp)
5146  || ((*iv)[1]==ringorder_rp))
5147  {
5148  if (iv->length()==3)
5149  {
5150  if ((*iv)[2]==1)
5151  {
5152  (*iv)[1]=ringorder_lp;
5153  change=TRUE;
5154  }
5155  }
5156  }
5157  // lp(i),lp(j) -> lp(i+j)
5158  if(((*iv)[1]==ringorder_lp)
5159  && (h->next!=NULL))
5160  {
5161  intvec *iv2 = (intvec *)(h->next->data);
5162  if ((*iv2)[1]==ringorder_lp)
5163  {
5164  leftv hh=h->next;
5165  h->next=hh->next;
5166  hh->next=NULL;
5167  if ((*iv2)[0]==1)
5168  (*iv)[2] += 1; // last block unspecified, at least 1
5169  else
5170  (*iv)[2] += (*iv2)[2];
5171  hh->CleanUp();
5172  omFree(hh);
5173  change=TRUE;
5174  }
5175  }
5176  // -------------------
5177  if (!change) h=h->next;
5178  }
5179  return ord;
5180 }
5181 
5182 
5184 {
5185  int last = 0, o=0, n = 1, i=0, typ = 1, j;
5186  ord=rOptimizeOrdAsSleftv(ord);
5187  sleftv *sl = ord;
5188 
5189  // determine nBlocks
5190  while (sl!=NULL)
5191  {
5192  intvec *iv = (intvec *)(sl->data);
5193  if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
5194  i++;
5195  else if ((*iv)[1]==ringorder_L)
5196  {
5197  R->bitmask=(*iv)[2];
5198  n--;
5199  }
5200  else if (((*iv)[1]!=ringorder_a)
5201  && ((*iv)[1]!=ringorder_a64)
5202  && ((*iv)[1]!=ringorder_am))
5203  o++;
5204  n++;
5205  sl=sl->next;
5206  }
5207  // check whether at least one real ordering
5208  if (o==0)
5209  {
5210  WerrorS("invalid combination of orderings");
5211  return TRUE;
5212  }
5213  // if no c/C ordering is given, increment n
5214  if (i==0) n++;
5215  else if (i != 1)
5216  {
5217  // throw error if more than one is given
5218  WerrorS("more than one ordering c/C specified");
5219  return TRUE;
5220  }
5221 
5222  // initialize fields of R
5223  R->order=(int *)omAlloc0(n*sizeof(int));
5224  R->block0=(int *)omAlloc0(n*sizeof(int));
5225  R->block1=(int *)omAlloc0(n*sizeof(int));
5226  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
5227 
5228  int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
5229 
5230  // init order, so that rBlocks works correctly
5231  for (j=0; j < n-1; j++)
5232  R->order[j] = (int) ringorder_unspec;
5233  // set last _C order, if no c/C order was given
5234  if (i == 0) R->order[n-2] = ringorder_C;
5235 
5236  /* init orders */
5237  sl=ord;
5238  n=-1;
5239  while (sl!=NULL)
5240  {
5241  intvec *iv;
5242  iv = (intvec *)(sl->data);
5243  if ((*iv)[1]!=ringorder_L)
5244  {
5245  n++;
5246 
5247  /* the format of an ordering:
5248  * iv[0]: factor
5249  * iv[1]: ordering
5250  * iv[2..end]: weights
5251  */
5252  R->order[n] = (*iv)[1];
5253  typ=1;
5254  switch ((*iv)[1])
5255  {
5256  case ringorder_ws:
5257  case ringorder_Ws:
5258  typ=-1;
5259  case ringorder_wp:
5260  case ringorder_Wp:
5261  R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
5262  R->block0[n] = last+1;
5263  for (i=2; i<iv->length(); i++)
5264  {
5265  R->wvhdl[n][i-2] = (*iv)[i];
5266  last++;
5267  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5268  }
5269  R->block1[n] = si_min(last,R->N);
5270  break;
5271  case ringorder_ls:
5272  case ringorder_ds:
5273  case ringorder_Ds:
5274  case ringorder_rs:
5275  typ=-1;
5276  case ringorder_lp:
5277  case ringorder_dp:
5278  case ringorder_Dp:
5279  case ringorder_rp:
5280  R->block0[n] = last+1;
5281  if (iv->length() == 3) last+=(*iv)[2];
5282  else last += (*iv)[0];
5283  R->block1[n] = si_min(last,R->N);
5284  if (rCheckIV(iv)) return TRUE;
5285  for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
5286  {
5287  if (weights[i]==0) weights[i]=typ;
5288  }
5289  break;
5290 
5291  case ringorder_s: // no 'rank' params!
5292  {
5293 
5294  if(iv->length() > 3)
5295  return TRUE;
5296 
5297  if(iv->length() == 3)
5298  {
5299  const int s = (*iv)[2];
5300  R->block0[n] = s;
5301  R->block1[n] = s;
5302  }
5303  break;
5304  }
5305  case ringorder_IS:
5306  {
5307  if(iv->length() != 3) return TRUE;
5308 
5309  const int s = (*iv)[2];
5310 
5311  if( 1 < s || s < -1 ) return TRUE;
5312 
5313  R->block0[n] = s;
5314  R->block1[n] = s;
5315  break;
5316  }
5317  case ringorder_S:
5318  case ringorder_c:
5319  case ringorder_C:
5320  {
5321  if (rCheckIV(iv)) return TRUE;
5322  break;
5323  }
5324  case ringorder_aa:
5325  case ringorder_a:
5326  {
5327  R->block0[n] = last+1;
5328  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5329  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
5330  for (i=2; i<iv->length(); i++)
5331  {
5332  R->wvhdl[n][i-2]=(*iv)[i];
5333  last++;
5334  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5335  }
5336  last=R->block0[n]-1;
5337  break;
5338  }
5339  case ringorder_am:
5340  {
5341  R->block0[n] = last+1;
5342  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5343  R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
5344  if (R->block1[n]- R->block0[n]+2>=iv->length())
5345  WarnS("missing module weights");
5346  for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
5347  {
5348  R->wvhdl[n][i-2]=(*iv)[i];
5349  last++;
5350  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5351  }
5352  R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
5353  for (; i<iv->length(); i++)
5354  {
5355  R->wvhdl[n][i-1]=(*iv)[i];
5356  }
5357  last=R->block0[n]-1;
5358  break;
5359  }
5360  case ringorder_a64:
5361  {
5362  R->block0[n] = last+1;
5363  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5364  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
5365  int64 *w=(int64 *)R->wvhdl[n];
5366  for (i=2; i<iv->length(); i++)
5367  {
5368  w[i-2]=(*iv)[i];
5369  last++;
5370  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5371  }
5372  last=R->block0[n]-1;
5373  break;
5374  }
5375  case ringorder_M:
5376  {
5377  int Mtyp=rTypeOfMatrixOrder(iv);
5378  if (Mtyp==0) return TRUE;
5379  if (Mtyp==-1) typ = -1;
5380 
5381  R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
5382  for (i=2; i<iv->length();i++)
5383  R->wvhdl[n][i-2]=(*iv)[i];
5384 
5385  R->block0[n] = last+1;
5386  last += (int)sqrt((double)(iv->length()-2));
5387  R->block1[n] = si_min(last,R->N);
5388  for(i=R->block1[n];i>=R->block0[n];i--)
5389  {
5390  if (weights[i]==0) weights[i]=typ;
5391  }
5392  break;
5393  }
5394 
5395  case ringorder_no:
5396  R->order[n] = ringorder_unspec;
5397  return TRUE;
5398 
5399  default:
5400  Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
5401  R->order[n] = ringorder_unspec;
5402  return TRUE;
5403  }
5404  }
5405  if (last>R->N)
5406  {
5407  Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
5408  R->N,last);
5409  return TRUE;
5410  }
5411  sl=sl->next;
5412  }
5413  // find OrdSgn:
5414  R->OrdSgn = 1;
5415  for(i=1;i<=R->N;i++)
5416  { if (weights[i]<0) { R->OrdSgn=-1;break; }}
5417  omFree(weights);
5418 
5419  // check for complete coverage
5420  while ( n >= 0 && (
5421  (R->order[n]==ringorder_c)
5422  || (R->order[n]==ringorder_C)
5423  || (R->order[n]==ringorder_s)
5424  || (R->order[n]==ringorder_S)
5425  || (R->order[n]==ringorder_IS)
5426  )) n--;
5427 
5428  assume( n >= 0 );
5429 
5430  if (R->block1[n] != R->N)
5431  {
5432  if (((R->order[n]==ringorder_dp) ||
5433  (R->order[n]==ringorder_ds) ||
5434  (R->order[n]==ringorder_Dp) ||
5435  (R->order[n]==ringorder_Ds) ||
5436  (R->order[n]==ringorder_rp) ||
5437  (R->order[n]==ringorder_rs) ||
5438  (R->order[n]==ringorder_lp) ||
5439  (R->order[n]==ringorder_ls))
5440  &&
5441  R->block0[n] <= R->N)
5442  {
5443  R->block1[n] = R->N;
5444  }
5445  else
5446  {
5447  Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5448  R->N,R->block1[n]);
5449  return TRUE;
5450  }
5451  }
5452  return FALSE;
5453 }
5454 
5456 {
5457 
5458  while(sl!=NULL)
5459  {
5460  if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5461  {
5462  *p = omStrDup(sl->Name());
5463  }
5464  else if (sl->name!=NULL)
5465  {
5466  *p = (char*)sl->name;
5467  sl->name=NULL;
5468  }
5469  else if (sl->rtyp==POLY_CMD)
5470  {
5471  sleftv s_sl;
5472  iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5473  if (s_sl.name != NULL)
5474  {
5475  *p = (char*)s_sl.name; s_sl.name=NULL;
5476  }
5477  else
5478  *p = NULL;
5479  sl->next = s_sl.next;
5480  s_sl.next = NULL;
5481  s_sl.CleanUp();
5482  if (*p == NULL) return TRUE;
5483  }
5484  else return TRUE;
5485  p++;
5486  sl=sl->next;
5487  }
5488  return FALSE;
5489 }
5490 
5491 const short MAX_SHORT = 32767; // (1 << (sizeof(short)*8)) - 1;
5492 
5493 ////////////////////
5494 //
5495 // rInit itself:
5496 //
5497 // INPUT: pn: ch & parameter (names), rv: variable (names)
5498 // ord: ordering (all !=NULL)
5499 // RETURN: currRingHdl on success
5500 // NULL on error
5501 // NOTE: * makes new ring to current ring, on success
5502 // * considers input sleftv's as read-only
5503 ring rInit(leftv pn, leftv rv, leftv ord)
5504 {
5505 #ifdef HAVE_RINGS
5506  //unsigned int ringtype = 0;
5507  mpz_ptr modBase = NULL;
5508  unsigned int modExponent = 1;
5509 #endif
5510  int float_len=0;
5511  int float_len2=0;
5512  ring R = NULL;
5513  //BOOLEAN ffChar=FALSE;
5514 
5515  /* ch -------------------------------------------------------*/
5516  // get ch of ground field
5517 
5518  // allocated ring
5519  R = (ring) omAlloc0Bin(sip_sring_bin);
5520 
5521  coeffs cf = NULL;
5522 
5523  assume( pn != NULL );
5524  const int P = pn->listLength();
5525 
5526  #ifdef SINGULAR_4_1
5527  if (pn->Typ()==CRING_CMD)
5528  {
5529  cf=(coeffs)pn->CopyD();
5530  leftv pnn=pn;
5531  if(P>1) /*parameter*/
5532  {
5533  pnn = pnn->next;
5534  const int pars = pnn->listLength();
5535  assume( pars > 0 );
5536  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5537 
5538  if (rSleftvList2StringArray(pnn, names))
5539  {
5540  WerrorS("parameter expected");
5541  goto rInitError;
5542  }
5543 
5544  TransExtInfo extParam;
5545 
5546  extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5547  for(int i=pars-1; i>=0;i--)
5548  {
5549  omFree(names[i]);
5550  }
5551  omFree(names);
5552 
5553  cf = nInitChar(n_transExt, &extParam);
5554  }
5555  assume( cf != NULL );
5556  }
5557  else
5558  #endif
5559  if (pn->Typ()==INT_CMD)
5560  {
5561  int ch = (int)(long)pn->Data();
5562  leftv pnn=pn;
5563 
5564  /* parameter? -------------------------------------------------------*/
5565  pnn = pnn->next;
5566 
5567  if (pnn == NULL) // no params!?
5568  {
5569  if (ch!=0)
5570  {
5571  int ch2=IsPrime(ch);
5572  if ((ch<2)||(ch!=ch2))
5573  {
5574  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5575  ch=32003;
5576  }
5577  cf = nInitChar(n_Zp, (void*)(long)ch);
5578  }
5579  else
5580  cf = nInitChar(n_Q, (void*)(long)ch);
5581  }
5582  else
5583  {
5584  const int pars = pnn->listLength();
5585 
5586  assume( pars > 0 );
5587 
5588  // predefined finite field: (p^k, a)
5589  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5590  {
5591  GFInfo param;
5592 
5593  param.GFChar = ch;
5594  param.GFDegree = 1;
5595  param.GFPar_name = pnn->name;
5596 
5597  cf = nInitChar(n_GF, &param);
5598  }
5599  else // (0/p, a, b, ..., z)
5600  {
5601  if ((ch!=0) && (ch!=IsPrime(ch)))
5602  {
5603  WerrorS("too many parameters");
5604  goto rInitError;
5605  }
5606 
5607  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5608 
5609  if (rSleftvList2StringArray(pnn, names))
5610  {
5611  WerrorS("parameter expected");
5612  goto rInitError;
5613  }
5614 
5615  TransExtInfo extParam;
5616 
5617  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5618  for(int i=pars-1; i>=0;i--)
5619  {
5620  omFree(names[i]);
5621  }
5622  omFree(names);
5623 
5624  cf = nInitChar(n_transExt, &extParam);
5625  }
5626  }
5627 
5628  //if (cf==NULL) ->Error: Invalid ground field specification
5629  }
5630  else if ((pn->name != NULL)
5631  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5632  {
5633  leftv pnn=pn->next;
5634  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5635  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5636  {
5637  float_len=(int)(long)pnn->Data();
5638  float_len2=float_len;
5639  pnn=pnn->next;
5640  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5641  {
5642  float_len2=(int)(long)pnn->Data();
5643  pnn=pnn->next;
5644  }
5645  }
5646 
5647  if (!complex_flag)
5648  complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
5649  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5650  cf=nInitChar(n_R, NULL);
5651  else // longR or longC?
5652  {
5653  LongComplexInfo param;
5654 
5655  param.float_len = si_min (float_len, 32767);
5656  param.float_len2 = si_min (float_len2, 32767);
5657 
5658  // set the parameter name
5659  if (complex_flag)
5660  {
5661  if (param.float_len < SHORT_REAL_LENGTH)
5662  {
5665  }
5666  if ((pnn == NULL) || (pnn->name == NULL))
5667  param.par_name=(const char*)"i"; //default to i
5668  else
5669  param.par_name = (const char*)pnn->name;
5670  }
5671 
5672  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5673  }
5674  assume( cf != NULL );
5675  }
5676 #ifdef HAVE_RINGS
5677  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5678  {
5679  // TODO: change to use coeffs_BIGINT!?
5680  modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
5681  mpz_init_set_si(modBase, 0);
5682  if (pn->next!=NULL)
5683  {
5684  leftv pnn=pn;
5685  if (pnn->next->Typ()==INT_CMD)
5686  {
5687  pnn=pnn->next;
5688  mpz_set_ui(modBase, (int)(long) pnn->Data());
5689  if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5690  {
5691  pnn=pnn->next;
5692  modExponent = (long) pnn->Data();
5693  }
5694  while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5695  {
5696  pnn=pnn->next;
5697  mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
5698  }
5699  }
5700  else if (pnn->next->Typ()==BIGINT_CMD)
5701  {
5702  number p=(number)pnn->next->CopyD();
5703  nlGMP(p,(number)modBase,coeffs_BIGINT); // TODO? // extern void nlGMP(number &i, number n, const coeffs r); // FIXME: n_MPZ( modBase, p, coeffs_BIGINT); ?
5704  n_Delete(&p,coeffs_BIGINT);
5705  }
5706  }
5707  else
5708  cf=nInitChar(n_Z,NULL);
5709 
5710  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
5711  {
5712  WerrorS("Wrong ground ring specification (module is 1)");
5713  goto rInitError;
5714  }
5715  if (modExponent < 1)
5716  {
5717  WerrorS("Wrong ground ring specification (exponent smaller than 1");
5718  goto rInitError;
5719  }
5720  // module is 0 ---> integers ringtype = 4;
5721  // we have an exponent
5722  if (modExponent > 1 && cf == NULL)
5723  {
5724  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5725  {
5726  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5727  depending on the size of a long on the respective platform */
5728  //ringtype = 1; // Use Z/2^ch
5729  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5730  mpz_clear(modBase);
5731  omFreeSize (modBase, sizeof (mpz_t));
5732  }
5733  else
5734  {
5735  if (mpz_cmp_ui(modBase,0)==0)
5736  {
5737  WerrorS("modulus must not be 0 or parameter not allowed");
5738  goto rInitError;
5739  }
5740  //ringtype = 3;
5741  ZnmInfo info;
5742  info.base= modBase;
5743  info.exp= modExponent;
5744  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5745  }
5746  }
5747  // just a module m > 1
5748  else if (cf == NULL)
5749  {
5750  if (mpz_cmp_ui(modBase,0)==0)
5751  {
5752  WerrorS("modulus must not be 0 or parameter not allowed");
5753  goto rInitError;
5754  }
5755  //ringtype = 2;
5756  ZnmInfo info;
5757  info.base= modBase;
5758  info.exp= modExponent;
5759  cf=nInitChar(n_Zn,(void*) &info);
5760  }
5761  assume( cf != NULL );
5762  }
5763 #endif
5764  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5765  else if ((pn->Typ()==RING_CMD) && (P == 1))
5766  {
5767  TransExtInfo extParam;
5768  extParam.r = (ring)pn->Data();
5769  cf = nInitChar(n_transExt, &extParam);
5770  }
5771  //else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5772  //{
5773  // AlgExtInfo extParam;
5774  // extParam.r = (ring)pn->Data();
5775 
5776  // cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5777  //}
5778  else
5779  {
5780  WerrorS("Wrong or unknown ground field specification");
5781 #if 0
5782 // debug stuff for unknown cf descriptions:
5783  sleftv* p = pn;
5784  while (p != NULL)
5785  {
5786  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5787  PrintLn();
5788  p = p->next;
5789  }
5790 #endif
5791  goto rInitError;
5792  }
5793 
5794  /*every entry in the new ring is initialized to 0*/
5795 
5796  /* characteristic -----------------------------------------------*/
5797  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5798  * 0 1 : Q(a,...) *names FALSE
5799  * 0 -1 : R NULL FALSE 0
5800  * 0 -1 : R NULL FALSE prec. >6
5801  * 0 -1 : C *names FALSE prec. 0..?
5802  * p p : Fp NULL FALSE
5803  * p -p : Fp(a) *names FALSE
5804  * q q : GF(q=p^n) *names TRUE
5805  */
5806  if (cf==NULL)
5807  {
5808  WerrorS("Invalid ground field specification");
5809  goto rInitError;
5810 // const int ch=32003;
5811 // cf=nInitChar(n_Zp, (void*)(long)ch);
5812  }
5813 
5814  assume( R != NULL );
5815 
5816  R->cf = cf;
5817 
5818  /* names and number of variables-------------------------------------*/
5819  {
5820  int l=rv->listLength();
5821 
5822  if (l>MAX_SHORT)
5823  {
5824  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5825  goto rInitError;
5826  }
5827  R->N = l; /*rv->listLength();*/
5828  }
5829  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5830  if (rSleftvList2StringArray(rv, R->names))
5831  {
5832  WerrorS("name of ring variable expected");
5833  goto rInitError;
5834  }
5835 
5836  /* check names and parameters for conflicts ------------------------- */
5837  rRenameVars(R); // conflicting variables will be renamed
5838  /* ordering -------------------------------------------------------------*/
5839  if (rSleftvOrdering2Ordering(ord, R))
5840  goto rInitError;
5841 
5842  // Complete the initialization
5843  if (rComplete(R,1))
5844  goto rInitError;
5845 
5846 /*#ifdef HAVE_RINGS
5847 // currently, coefficients which are ring elements require a global ordering:
5848  if (rField_is_Ring(R) && (R->OrdSgn==-1))
5849  {
5850  WerrorS("global ordering required for these coefficients");
5851  goto rInitError;
5852  }
5853 #endif*/
5854 
5855  rTest(R);
5856 
5857  // try to enter the ring into the name list
5858  // need to clean up sleftv here, before this ring can be set to
5859  // new currRing or currRing can be killed beacuse new ring has
5860  // same name
5861  pn->CleanUp();
5862  rv->CleanUp();
5863  ord->CleanUp();
5864  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5865  // goto rInitError;
5866 
5867  //memcpy(IDRING(tmp),R,sizeof(*R));
5868  // set current ring
5869  //omFreeBin(R, ip_sring_bin);
5870  //return tmp;
5871  return R;
5872 
5873  // error case:
5874  rInitError:
5875  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
5876  pn->CleanUp();
5877  rv->CleanUp();
5878  ord->CleanUp();
5879  return NULL;
5880 }
5881 
5882 ring rSubring(ring org_ring, sleftv* rv)
5883 {
5884  ring R = rCopy0(org_ring);
5885  int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
5886  int n = rBlocks(org_ring), i=0, j;
5887 
5888  /* names and number of variables-------------------------------------*/
5889  {
5890  int l=rv->listLength();
5891  if (l>MAX_SHORT)
5892  {
5893  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5894  goto rInitError;
5895  }
5896  R->N = l; /*rv->listLength();*/
5897  }
5898  omFree(R->names);
5899  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5900  if (rSleftvList2StringArray(rv, R->names))
5901  {
5902  WerrorS("name of ring variable expected");
5903  goto rInitError;
5904  }
5905 
5906  /* check names for subring in org_ring ------------------------- */
5907  {
5908  i=0;
5909 
5910  for(j=0;j<R->N;j++)
5911  {
5912  for(;i<org_ring->N;i++)
5913  {
5914  if (strcmp(org_ring->names[i],R->names[j])==0)
5915  {
5916  perm[i+1]=j+1;
5917  break;
5918  }
5919  }
5920  if (i>org_ring->N)
5921  {
5922  Werror("variable %d (%s) not in basering",j+1,R->names[j]);
5923  break;
5924  }
5925  }
5926  }
5927  //Print("perm=");
5928  //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
5929  /* ordering -------------------------------------------------------------*/
5930 
5931  for(i=0;i<n;i++)
5932  {
5933  int min_var=-1;
5934  int max_var=-1;
5935  for(j=R->block0[i];j<=R->block1[i];j++)
5936  {
5937  if (perm[j]>0)
5938  {
5939  if (min_var==-1) min_var=perm[j];
5940  max_var=perm[j];
5941  }
5942  }
5943  if (min_var!=-1)
5944  {
5945  //Print("block %d: old %d..%d, now:%d..%d\n",
5946  // i,R->block0[i],R->block1[i],min_var,max_var);
5947  R->block0[i]=min_var;
5948  R->block1[i]=max_var;
5949  if (R->wvhdl[i]!=NULL)
5950  {
5951  omFree(R->wvhdl[i]);
5952  R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
5953  for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
5954  {
5955  if (perm[j]>0)
5956  {
5957  R->wvhdl[i][perm[j]-R->block0[i]]=
5958  org_ring->wvhdl[i][j-org_ring->block0[i]];
5959  //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
5960  }
5961  }
5962  }
5963  }
5964  else
5965  {
5966  if(R->block0[i]>0)
5967  {
5968  //Print("skip block %d\n",i);
5969  R->order[i]=ringorder_unspec;
5970  if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
5971  R->wvhdl[i]=NULL;
5972  }
5973  //else Print("keep block %d\n",i);
5974  }
5975  }
5976  i=n-1;
5977  while(i>0)
5978  {
5979  // removed unneded blocks
5980  if(R->order[i-1]==ringorder_unspec)
5981  {
5982  for(j=i;j<=n;j++)
5983  {
5984  R->order[j-1]=R->order[j];
5985  R->block0[j-1]=R->block0[j];
5986  R->block1[j-1]=R->block1[j];
5987  if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
5988  R->wvhdl[j-1]=R->wvhdl[j];
5989  }
5990  R->order[n]=ringorder_unspec;
5991  n--;
5992  }
5993  i--;
5994  }
5995  n=rBlocks(org_ring)-1;
5996  while (R->order[n]==0) n--;
5997  while (R->order[n]==ringorder_unspec) n--;
5998  if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
5999  if (R->block1[n] != R->N)
6000  {
6001  if (((R->order[n]==ringorder_dp) ||
6002  (R->order[n]==ringorder_ds) ||
6003  (R->order[n]==ringorder_Dp) ||
6004  (R->order[n]==ringorder_Ds) ||
6005  (R->order[n]==ringorder_rp) ||
6006  (R->order[n]==ringorder_rs) ||
6007  (R->order[n]==ringorder_lp) ||
6008  (R->order[n]==ringorder_ls))
6009  &&
6010  R->block0[n] <= R->N)
6011  {
6012  R->block1[n] = R->N;
6013  }
6014  else
6015  {
6016  Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
6017  R->N,R->block1[n],n);
6018  return NULL;
6019  }
6020  }
6021  omFree(perm);
6022  // find OrdSgn:
6023  R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
6024  //for(i=1;i<=R->N;i++)
6025  //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
6026  //omFree(weights);
6027  // Complete the initialization
6028  if (rComplete(R,1))
6029  goto rInitError;
6030 
6031  rTest(R);
6032 
6033  if (rv != NULL) rv->CleanUp();
6034 
6035  return R;
6036 
6037  // error case:
6038  rInitError:
6039  if (R != NULL) rDelete(R);
6040  if (rv != NULL) rv->CleanUp();
6041  return NULL;
6042 }
6043 
6044 void rKill(ring r)
6045 {
6046  if ((r->ref<=0)&&(r->order!=NULL))
6047  {
6048 #ifdef RDEBUG
6049  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6050 #endif
6051  if (r->qideal!=NULL)
6052  {
6053  id_Delete(&r->qideal, r);
6054  r->qideal = NULL;
6055  }
6056  int j;
6057  for (j=0;j<myynest;j++)
6058  {
6059  if (iiLocalRing[j]==r)
6060  {
6061  if (j==0) WarnS("killing the basering for level 0");
6062  iiLocalRing[j]=NULL;
6063  }
6064  }
6065 // any variables depending on r ?
6066  while (r->idroot!=NULL)
6067  {
6068  r->idroot->lev=myynest; // avoid warning about kill global objects
6069  killhdl2(r->idroot,&(r->idroot),r);
6070  }
6071  if (r==currRing)
6072  {
6073  // all dependend stuff is done, clean global vars:
6074  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6076  {
6078  }
6079  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6080  //{
6081  // WerrorS("return value depends on local ring variable (export missing ?)");
6082  // iiRETURNEXPR.CleanUp();
6083  //}
6084  currRing=NULL;
6085  currRingHdl=NULL;
6086  }
6087 
6088  /* nKillChar(r); will be called from inside of rDelete */
6089  rDelete(r);
6090  return;
6091  }
6092  r->ref--;
6093 }
6094 
6095 void rKill(idhdl h)
6096 {
6097  ring r = IDRING(h);
6098  int ref=0;
6099  if (r!=NULL)
6100  {
6101  // avoid, that sLastPrinted is the last reference to the base ring:
6102  // clean up before killing the last "named" refrence:
6103  if ((sLastPrinted.rtyp==RING_CMD)
6104  && (sLastPrinted.data==(void*)r))
6105  {
6106  sLastPrinted.CleanUp(r);
6107  }
6108  ref=r->ref;
6109  rKill(r);
6110  }
6111  if (h==currRingHdl)
6112  {
6113  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6114  else
6115  {
6117  }
6118  }
6119 }
6120 
6122 {
6123  idhdl h=root;
6124  while (h!=NULL)
6125  {
6126  if ((IDTYP(h)==RING_CMD)
6127  && (h!=n)
6128  && (IDRING(h)==r)
6129  )
6130  {
6131  return h;
6132  }
6133  h=IDNEXT(h);
6134  }
6135  return NULL;
6136 }
6137 
6138 extern BOOLEAN jjPROC(leftv res, leftv u, leftv v);
6139 ideal kGroebner(ideal F, ideal Q)
6140 {
6141  //test|=Sy_bit(OPT_PROT);
6142  idhdl save_ringhdl=currRingHdl;
6143  ideal resid;
6144  idhdl new_ring=NULL;
6145  if ((currRingHdl==NULL) || (IDRING(currRingHdl)!=currRing))
6146  {
6147  currRingHdl=enterid(omStrDup(" GROEBNERring"),0,RING_CMD,&IDROOT,FALSE);
6148  new_ring=currRingHdl;
6150  }
6151  sleftv v; memset(&v,0,sizeof(v)); v.rtyp=IDEAL_CMD; v.data=(char *) F;
6152  idhdl h=ggetid("groebner");
6153  sleftv u; memset(&u,0,sizeof(u)); u.rtyp=IDHDL; u.data=(char *) h;
6154  u.name=IDID(h);
6155 
6156  sleftv res; memset(&res,0,sizeof(res));
6157  if(jjPROC(&res,&u,&v))
6158  {
6159  resid=kStd(F,Q,testHomog,NULL);
6160  }
6161  else
6162  {
6163  //printf("typ:%d\n",res.rtyp);
6164  resid=(ideal)(res.data);
6165  }
6166  // cleanup GROEBNERring, save_ringhdl, u,v,(res )
6167  if (new_ring!=NULL)
6168  {
6169  idhdl h=IDROOT;
6170  if (h==new_ring) IDROOT=h->next;
6171  else
6172  {
6173  while ((h!=NULL) &&(h->next!=new_ring)) h=h->next;
6174  if (h!=NULL) h->next=h->next->next;
6175  }
6176  if (h!=NULL) omFreeSize(h,sizeof(*h));
6177  }
6178  currRingHdl=save_ringhdl;
6179  u.CleanUp();
6180  v.CleanUp();
6181  return resid;
6182 }
6183 
6184 static void jjINT_S_TO_ID(int n,int *e, leftv res)
6185 {
6186  if (n==0) n=1;
6187  ideal l=idInit(n,1);
6188  int i;
6189  poly p;
6190  for(i=rVar(currRing);i>0;i--)
6191  {
6192  if (e[i]>0)
6193  {
6194  n--;
6195  p=pOne();
6196  pSetExp(p,i,1);
6197  pSetm(p);
6198  l->m[n]=p;
6199  if (n==0) break;
6200  }
6201  }
6202  res->data=(char*)l;
6203  setFlag(res,FLAG_STD);
6204  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6205 }
6207 {
6208  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6209  int n=pGetVariables((poly)u->Data(),e);
6210  jjINT_S_TO_ID(n,e,res);
6211  return FALSE;
6212 }
6213 
6215 {
6216  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6217  ideal I=(ideal)u->Data();
6218  int i;
6219  int n=0;
6220  for(i=I->nrows*I->ncols-1;i>=0;i--)
6221  {
6222  int n0=pGetVariables(I->m[i],e);
6223  if (n0>n) n=n0;
6224  }
6225  jjINT_S_TO_ID(n,e,res);
6226  return FALSE;
6227 }
6228 
6229 void paPrint(const char *n,package p)
6230 {
6231  Print(" %s (",n);
6232  switch (p->language)
6233  {
6234  case LANG_SINGULAR: PrintS("S"); break;
6235  case LANG_C: PrintS("C"); break;
6236  case LANG_TOP: PrintS("T"); break;
6237  case LANG_NONE: PrintS("N"); break;
6238  default: PrintS("U");
6239  }
6240  if(p->libname!=NULL)
6241  Print(",%s", p->libname);
6242  PrintS(")");
6243 }
6244 
6246 {
6247  intvec *aa=(intvec*)a->Data();
6248  sleftv tmp_out;
6249  sleftv tmp_in;
6250  leftv curr=res;
6251  BOOLEAN bo=FALSE;
6252  for(int i=0;i<aa->length(); i++)
6253  {
6254  memset(&tmp_in,0,sizeof(tmp_in));
6255  tmp_in.rtyp=INT_CMD;
6256  tmp_in.data=(void*)(long)(*aa)[i];
6257  if (proc==NULL)
6258  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6259  else
6260  bo=jjPROC(&tmp_out,proc,&tmp_in);
6261  if (bo)
6262  {
6263  res->CleanUp(currRing);
6264  Werror("apply fails at index %d",i+1);
6265  return TRUE;
6266  }
6267  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6268  else
6269  {
6270  curr->next=(leftv)omAllocBin(sleftv_bin);
6271  curr=curr->next;
6272  memcpy(curr,&tmp_out,sizeof(tmp_out));
6273  }
6274  }
6275  return FALSE;
6276 }
6278 {
6279  WerrorS("not implemented");
6280  return TRUE;
6281 }
6283 {
6284  WerrorS("not implemented");
6285  return TRUE;
6286 }
6288 {
6289  lists aa=(lists)a->Data();
6290  sleftv tmp_out;
6291  sleftv tmp_in;
6292  leftv curr=res;
6293  BOOLEAN bo=FALSE;
6294  for(int i=0;i<=aa->nr; i++)
6295  {
6296  memset(&tmp_in,0,sizeof(tmp_in));
6297  tmp_in.Copy(&(aa->m[i]));
6298  if (proc==NULL)
6299  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6300  else
6301  bo=jjPROC(&tmp_out,proc,&tmp_in);
6302  tmp_in.CleanUp();
6303  if (bo)
6304  {
6305  res->CleanUp(currRing);
6306  Werror("apply fails at index %d",i+1);
6307  return TRUE;
6308  }
6309  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6310  else
6311  {
6312  curr->next=(leftv)omAllocBin(sleftv_bin);
6313  curr=curr->next;
6314  memcpy(curr,&tmp_out,sizeof(tmp_out));
6315  }
6316  }
6317  return FALSE;
6318 }
6320 {
6321  memset(res,0,sizeof(sleftv));
6322  res->rtyp=a->Typ();
6323  switch (res->rtyp /*a->Typ()*/)
6324  {
6325  case INTVEC_CMD:
6326  case INTMAT_CMD:
6327  return iiApplyINTVEC(res,a,op,proc);
6328  case BIGINTMAT_CMD:
6329  return iiApplyBIGINTMAT(res,a,op,proc);
6330  case IDEAL_CMD:
6331  case MODUL_CMD:
6332  case MATRIX_CMD:
6333  return iiApplyIDEAL(res,a,op,proc);
6334  case LIST_CMD:
6335  return iiApplyLIST(res,a,op,proc);
6336  }
6337  WerrorS("first argument to `apply` must allow an index");
6338  return TRUE;
6339 }
6340 
6342 {
6343  // assume a: level
6344  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6345  {
6346  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6347  char assume_yylinebuf[80];
6348  strncpy(assume_yylinebuf,my_yylinebuf,79);
6349  int lev=(long)a->Data();
6350  int startlev=0;
6351  idhdl h=ggetid("assumeLevel");
6352  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6353  if(lev <=startlev)
6354  {
6355  BOOLEAN bo=b->Eval();
6356  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6357  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6358  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6359  }
6360  }
6361  b->CleanUp();
6362  a->CleanUp();
6363  return FALSE;
6364 }
6365 
6366 #include "libparse.h"
6367 
6368 BOOLEAN iiARROW(leftv r, char* a, char *s)
6369 {
6370  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6371  // find end of s:
6372  int end_s=strlen(s);
6373  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6374  s[end_s+1]='\0';
6375  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6376  sprintf(name,"%s->%s",a,s);
6377  // find start of last expression
6378  int start_s=end_s-1;
6379  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6380  if (start_s<0) // ';' not found
6381  {
6382  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6383  }
6384  else // s[start_s] is ';'
6385  {
6386  s[start_s]='\0';
6387  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6388  }
6389  memset(r,0,sizeof(*r));
6390  // now produce procinfo for PROC_CMD:
6391  r->data = (void *)omAlloc0Bin(procinfo_bin);
6392  ((procinfo *)(r->data))->language=LANG_NONE;
6393  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6394  ((procinfo *)r->data)->data.s.body=ss;
6395  omFree(name);
6396  r->rtyp=PROC_CMD;
6397  //r->rtyp=STRING_CMD;
6398  //r->data=ss;
6399  return FALSE;
6400 }
6401 
6403 {
6404  char* ring_name=omStrDup((char*)r->Name());
6405  int t=arg->Typ();
6406  if (t==RING_CMD)
6407  {
6408  sleftv tmp;
6409  memset(&tmp,0,sizeof(tmp));
6410  tmp.rtyp=IDHDL;
6411  tmp.data=(char*)rDefault(ring_name);
6412  if (tmp.data!=NULL)
6413  {
6414  BOOLEAN b=iiAssign(&tmp,arg);
6415  if (b) return TRUE;
6416  rSetHdl(ggetid(ring_name));
6417  omFree(ring_name);
6418  return FALSE;
6419  }
6420  else
6421  return TRUE;
6422  }
6423  #ifdef SINGULAR_4_1
6424  else if (t==CRING_CMD)
6425  {
6426  sleftv tmp;
6427  sleftv n;
6428  memset(&n,0,sizeof(n));
6429  n.name=ring_name;
6430  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6431  if (iiAssign(&tmp,arg)) return TRUE;
6432  //Print("create %s\n",r->Name());
6433  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6434  return FALSE;
6435  }
6436  #endif
6437  //Print("create %s\n",r->Name());
6438  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6439  return TRUE;// not handled -> error for now
6440 }
6441 
6442 static void iiReportTypes(int nr,int t,const short *T)
6443 {
6444  char *buf=(char*)omAlloc(250);
6445  buf[0]='\0';
6446  if (nr==0)
6447  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6448  else
6449  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6450  for(int i=1;i<=T[0];i++)
6451  {
6452  strcat(buf,"`");
6453  strcat(buf,Tok2Cmdname(T[i]));
6454  strcat(buf,"`");
6455  if (i<T[0]) strcat(buf,",");
6456  }
6457  WerrorS(buf);
6458 }
6459 
6460 BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
6461 {
6462  if (args==NULL)
6463  {
6464  if (type_list[0]==0) return TRUE;
6465  else
6466  {
6467  if (report) WerrorS("no arguments expected");
6468  return FALSE;
6469  }
6470  }
6471  int l=args->listLength();
6472  if (l!=(int)type_list[0])
6473  {
6474  if (report) iiReportTypes(0,l,type_list);
6475  return FALSE;
6476  }
6477  for(int i=1;i<=l;i++,args=args->next)
6478  {
6479  short t=type_list[i];
6480  if (t!=ANY_TYPE)
6481  {
6482  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6483  || (t!=args->Typ()))
6484  {
6485  if (report) iiReportTypes(i,args->Typ(),type_list);
6486  return FALSE;
6487  }
6488  }
6489  }
6490  return TRUE;
6491 }
mpz_ptr base
Definition: rmodulon.h:19
int status int void size_t count
Definition: si_signals.h:59
int & rows()
Definition: matpol.h:24
int length
Definition: syz.h:60
BOOLEAN jjCHARSERIES(leftv res, leftv u)
Definition: ipshell.cc:3252
intvec ** weights
Definition: syz.h:45
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition: ring.h:99
CanonicalForm map(const CanonicalForm &primElem, const Variable &alpha, const CanonicalForm &F, const Variable &beta)
map from to such that is mapped onto
Definition: cf_map_ext.cc:400
int iiRETURNEXPR_len
Definition: iplib.cc:472
int hMu2
Definition: hdegree.cc:22
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:65
#define IDLIST(a)
Definition: ipid.h:134
void VoiceBackTrack()
Definition: fevoices.cc:77
ip_package * package
Definition: structs.h:46
#define omRealloc0Size(addr, o_size, size)
Definition: omAllocDecl.h:221
#define pIsPurePower(p)
Definition: polys.h:231
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:812
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:35
const CanonicalForm int s
Definition: facAbsFact.cc:55
unsigned si_opt_1
Definition: options.c:5
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:292
sleftv * m
Definition: lists.h:45
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:33
unsigned char * proc[NUM_PROC]
Definition: checklibs.c:14
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
for int64 weights
Definition: ring.h:79
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
#define TRACE_SHOW_RINGS
Definition: reporter.h:35
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:29
int Eval()
Definition: subexpr.cc:1744
spectrumPolyNode * next
Definition: splist.h:39
#define pSetm(p)
Definition: polys.h:253
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:846
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition: syz1.cc:1653
number * interpolateDense(const number *q)
Solves the Vandermode linear system {i=1}^{n} x_i^k-1 w_i = q_k, k=1,..,n.
Definition: mpr_numeric.cc:159
matrix mapToMatrix(matrix m)
ring rSubring(ring org_ring, sleftv *rv)
Definition: ipshell.cc:5882
spectrumState
Definition: ipshell.cc:3455
int yylineno
Definition: febase.cc:45
const poly a
Definition: syzextra.cc:212
int sdb_flags
Definition: sdb.cc:32
void PrintLn()
Definition: reporter.cc:310
void compute()
#define ANY_TYPE
Definition: tok.h:30
#define Print
Definition: emacs.cc:83
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:62
only used if HAVE_RINGS is defined
Definition: coeffs.h:44
scfmon hwork
Definition: hutil.cc:19
void mu(int **points, int sizePoints)
Definition: tok.h:94
ring r
Definition: algext.h:40
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:496
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
int hNexist
Definition: hutil.cc:22
int * varset
Definition: hutil.h:21
idhdl currPackHdl
Definition: ipid.cc:61
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:28
const short MAX_SHORT
Definition: ipshell.cc:5491
int hCo
Definition: hdegree.cc:22
Definition: attrib.h:15
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:312
Subexpr e
Definition: subexpr.h:107
#define idDelete(H)
delete an ideal
Definition: ideals.h:31
Rational weight
Definition: splist.h:41
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:518
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5455
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2413
Definition: lists.h:22
CanonicalForm num(const CanonicalForm &f)
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int line, long pos, BOOLEAN pstatic)
Definition: iplib.cc:883
#define IDINTVEC(a)
Definition: ipid.h:125
ring rCompose(const lists L, const BOOLEAN check_comp)
Definition: ipshell.cc:2708
only used if HAVE_RINGS is defined
Definition: coeffs.h:46
BOOLEAN mpKoszul(leftv res, leftv c, leftv b, leftv id)
Definition: ipshell.cc:2998
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:39
loop
Definition: myNF.cc:98
if(0 > strat->sl)
Definition: myNF.cc:73
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8422
#define IDID(a)
Definition: ipid.h:119
#define pSetExp(p, i, v)
Definition: polys.h:42
static int si_min(const int a, const int b)
Definition: auxiliary.h:124
BOOLEAN jjVARIABLES_P(leftv res, leftv u)
Definition: ipshell.cc:6206
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6121
#define FALSE
Definition: auxiliary.h:97
Linear Programming / Linear Optimization using Simplex - Algorithm.
Definition: mpr_numeric.h:194
Compatiblity layer for legacy polynomial operations (over currRing)
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5183
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:360
attr * Attribute()
Definition: subexpr.cc:1376
Definition: tok.h:38
return P p
Definition: myNF.cc:203
opposite of ls
Definition: ring.h:100
int exprlist_length(leftv v)
Definition: ipshell.cc:546
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4416
void syMinimizeResolvente(resolvente res, int length, int first)
Definition: syz.cc:360
Matrices of numbers.
Definition: bigintmat.h:51
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:587
Rational * s
Definition: semic.h:70
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3289
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1602
lists syConvRes(syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
Definition: ipshell.cc:3088
BOOLEAN jjRESULTANT(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:3245
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:507
scmon * scfmon
Definition: hutil.h:20
int rows() const
Definition: bigintmat.h:146
#define pTest(p)
Definition: polys.h:399
char * filename
Definition: fevoices.h:62
void list_error(semicState state)
Definition: ipshell.cc:3373
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:440
static poly last
Definition: hdegree.cc:1077
#define pDecrExp(p, i)
Definition: polys.h:44
sleftv iiRETURNEXPR
Definition: iplib.cc:471
rational (GMP) numbers
Definition: coeffs.h:31
#define V_DEF_RES
Definition: options.h:48
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
const char * GFPar_name
Definition: coeffs.h:96
static FORCE_INLINE BOOLEAN nCoeff_is_Ring_Z(const coeffs r)
Definition: coeffs.h:759
int rows() const
Definition: intvec.h:88
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define IDNEXT(a)
Definition: ipid.h:115
int pg
Definition: semic.h:68
scfmon hexist
Definition: hutil.cc:19
Definition: grammar.cc:270
{p < 2^31}
Definition: coeffs.h:30
proclevel * procstack
Definition: ipid.cc:58
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:922
#define IDROOT
Definition: ipid.h:20
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:580
void id_Delete(ideal *h, ring r)
deletes an ideal/module/matrix
#define pNeg(p)
Definition: polys.h:181
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
BOOLEAN siq
Definition: subexpr.cc:58
static int * multiplicity
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:317
const char sNoName[]
Definition: subexpr.cc:56
char buffer[1024]
Definition: run.c:54
int listLength()
Definition: subexpr.cc:61
monf hCreate(int Nvar)
Definition: hutil.cc:1002
long int64
Definition: auxiliary.h:69
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1005
int hNvar
Definition: hutil.cc:22
intvec * id_QHomWeight(ideal id, const ring r)
int get_den_si()
Definition: GMPrat.cc:159
BOOLEAN nuVanderSys(leftv res, leftv arg1, leftv arg2, leftv arg3)
COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consi...
Definition: ipshell.cc:4712
resolvente res
Definition: syz.h:47
#define pCmp(p1, p2)
pCmp: args may be NULL returns: (p2==NULL ? 1 : (p1 == NULL ? -1 : p_LmCmp(p1, p2))) ...
Definition: polys.h:115
BOOLEAN spectrumProc(leftv result, leftv first)
Definition: ipshell.cc:4038
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:528
BOOLEAN jjVARIABLES_ID(leftv res, leftv u)
Definition: ipshell.cc:6214
#define TRUE
Definition: auxiliary.h:101
#define nIsOne(n)
Definition: numbers.h:25
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:89
uResultant::resMatType determineMType(int imtype)
ideal kStd(ideal F, ideal Q, tHomog h, intvec **w, intvec *hilb, int syzComp, int newIdeal, intvec *vw, s_poly_proc_t sp)
Definition: kstd1.cc:2231
BOOLEAN maApplyFetch(int what, map theMap, leftv res, leftv w, ring preimage_r, int *perm, int *par_perm, int P, nMapFunc nMap)
Definition: maps_ip.cc:49
void type_cmd(leftv v)
Definition: ipshell.cc:244
BOOLEAN iiAssignCR(leftv r, leftv arg)
Definition: ipshell.cc:6402
#define IDIDEAL(a)
Definition: ipid.h:130
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1430
poly iiHighCorner(ideal I, int ak)
Definition: ipshell.cc:1485
void * ADDRESS
Definition: auxiliary.h:118
int hNrad
Definition: hutil.cc:22
intvec * zrovToIV()
int hNpure
Definition: hutil.cc:22
sleftv * leftv
Definition: structs.h:60
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:449
void pWrite(poly p)
Definition: polys.h:291
BOOLEAN spmulProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4375
BOOLEAN hasConstTerm(poly h, const ring r)
Definition: spectrum.h:28
scmon hpure
Definition: hutil.cc:20
void WerrorS(const char *s)
Definition: feFopen.cc:24
int k
Definition: cfEzgcd.cc:93
#define nIsMOne(n)
Definition: numbers.h:26
int min_in()
Definition: intvec.h:113
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:510
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:613
void nlGMP(number &i, number n, const coeffs r)
Definition: longrat.cc:1465
#define Q
Definition: sirandom.c:25
char * lString(lists l, BOOLEAN typed, int dim)
Definition: lists.cc:377
int getAnzElems()
Definition: mpr_numeric.h:95
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4557
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:320
syStrategy syConvList(lists li)
Definition: ipshell.cc:3161
int get_num_si()
Definition: GMPrat.cc:145
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition: hutil.cc:417
int traceit
Definition: febase.cc:47
static FORCE_INLINE BOOLEAN nCoeff_is_long_C(const coeffs r)
Definition: coeffs.h:908
#define WarnS
Definition: emacs.cc:81
rootContainer ** specializeInU(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:3059
CanonicalForm Lc(const CanonicalForm &f)
coeffs coeffs_BIGINT
Definition: ipid.cc:54
int hasOne(ideal J, const ring r)
Definition: spectrum.cc:96
int Typ()
Definition: subexpr.cc:979
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN exitBuffer(feBufferTypes typ)
Definition: fevoices.cc:241
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:147
poly numvec2poly(const number *q)
Definition: mpr_numeric.cc:106
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2208
#define Sy_bit(x)
Definition: options.h:30
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6184
const char * Name()
Definition: subexpr.h:122
scfmon hrad
Definition: hutil.cc:19
void Print(leftv store=NULL, int spaces=0)
Called by type_cmd (e.g. "r;") or as default in jPRINT.
Definition: subexpr.cc:73
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:762
static int pLength(poly a)
Definition: p_polys.h:189
Creation data needed for finite fields.
Definition: coeffs.h:92
BOOLEAN iiExport(leftv v, int toLev)
Definition: ipshell.cc:1385
Definition: idrec.h:34
Definition: semic.h:63
#define IDHDL
Definition: tok.h:31
Definition: mpr_base.h:98
idhdl iiCurrProc
Definition: ipshell.cc:79
idhdl rDefault(const char *s)
Definition: ipshell.cc:1523
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:163
idhdl get(const char *s, int lev)
Definition: ipid.cc:91
real floating point (GMP) numbers
Definition: coeffs.h:34
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6277
BITSET validOpts
Definition: kstd1.cc:63
BOOLEAN iiParameter(leftv p)
Definition: ipshell.cc:1251
short float_len2
additional char-flags, rInit
Definition: coeffs.h:102
#define pGetVariables(p, e)
Definition: polys.h:234
bool found
Definition: facFactorize.cc:56
const char * currid
Definition: grammar.cc:171
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1755
intvec ** hilb_coeffs
Definition: syz.h:46
omBin procinfo_bin
Definition: subexpr.cc:51
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
lists getList(spectrum &spec)
Definition: ipshell.cc:3301
void ipListFlag(idhdl h)
Definition: ipid.cc:519
int iiRegularity(lists L)
Definition: ipshell.cc:958
void * data
Definition: subexpr.h:90
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1594
void hDelete(scfmon ev, int ev_length)
Definition: hutil.cc:146
#define pIter(p)
Definition: monomials.h:44
poly res
Definition: myNF.cc:322
BOOLEAN iiTestAssume(leftv a, leftv b)
Definition: ipshell.cc:6341
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4158
Definition: subexpr.h:21
BOOLEAN kWeight(leftv res, leftv id)
Definition: ipshell.cc:3206
#define IDPACKAGE(a)
Definition: ipid.h:136
int myynest
Definition: febase.cc:46
#define omReallocSize(addr, o_size, size)
Definition: omAllocDecl.h:220
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
char * char_ptr
Definition: structs.h:56
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define IDTYP(a)
Definition: ipid.h:116
indset ISet
Definition: hdegree.cc:279
single prescision (6,6) real numbers
Definition: coeffs.h:32
void * CopyA()
Definition: subexpr.cc:1941
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:259
spectrumPolyNode * root
Definition: splist.h:60
BOOLEAN hasLinearTerm(poly h, const ring r)
Definition: spectrum.h:30
static int rBlocks(ring r)
Definition: ring.h:556
BOOLEAN syBetti1(leftv res, leftv u)
Definition: ipshell.cc:3076
Definition: tok.h:55
int RingDependend(int t)
Definition: gentable.cc:23
spectrumState spectrumStateFromList(spectrumPolyList &speclist, lists *L, int fast)
Definition: ipshell.cc:3474
char my_yylinebuf[80]
Definition: febase.cc:48
BOOLEAN nuLagSolve(leftv res, leftv arg1, leftv arg2, leftv arg3)
find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial us...
Definition: ipshell.cc:4583
short float_len
additional char-flags, rInit
Definition: coeffs.h:101
const ring r
Definition: syzextra.cc:208
poly p_PermPoly(poly p, const int *perm, const ring oldRing, const ring dst, nMapFunc nMap, const int *par_perm, int OldPar, BOOLEAN use_mult)
Definition: p_polys.cc:3939
Coefficient rings, fields and other domains suitable for Singular polynomials.
resolvente orderedRes
Definition: syz.h:48
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:356
BOOLEAN RingDependend()
Definition: subexpr.cc:391
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2458
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:924
intvec * posvToIV()
Definition: intvec.h:14
#define pSub(a, b)
Definition: polys.h:270
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
static FORCE_INLINE long n_Int(number &n, const coeffs r)
conversion of n to an int; 0 if not possible in Z/pZ: the representing int lying in (-p/2 ...
Definition: coeffs.h:551
void hKill(monf xmem, int Nvar)
Definition: hutil.cc:1016
void rKill(ring r)
Definition: ipshell.cc:6044
BOOLEAN rComplete(ring r, int force)
this needs to be called whenever a new ring is created: new fields in ring are created (like VarOffse...
Definition: ring.cc:3435
for(int i=0;i< R->ExpL_Size;i++) Print("%09lx "
Definition: cfEzgcd.cc:66
varset hvar
Definition: hutil.cc:21
ideal maMapIdeal(const ideal map_id, const ring preimage_r, const ideal image_id, const ring image_r, const nMapFunc nMap)
polynomial map for ideals/module/matrix map_id: the ideal to map map_r: the base ring for map_id imag...
Definition: gen_maps.cc:88
BOOLEAN mapFromMatrix(matrix m)
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition: ipshell.cc:415
void computeNF(ideal stdJ, poly hc, poly wc, spectrumPolyList *NF, const ring r)
Definition: spectrum.cc:309
int j
Definition: myNF.cc:70
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
Definition: tok.h:57
Definition: ipid.h:56
const char * name
Definition: subexpr.h:89
#define omFree(addr)
Definition: omAllocDecl.h:261
static long pTotaldegree(poly p)
Definition: polys.h:265
static leftv rOptimizeOrdAsSleftv(leftv ord)
Definition: ipshell.cc:5071
#define assume(x)
Definition: mod2.h:403
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:404
int search(const CFArray &A, const CanonicalForm &F, int i, int j)
search for F in A between index i and j
The main handler for Singular numbers which are suitable for Singular polynomials.
BOOLEAN iiBranchTo(leftv, leftv args)
Definition: ipshell.cc:1181
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:82
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:313
double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:28
int status int void * buf
Definition: si_signals.h:59
ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
Definition: ring.cc:1321
indlist * indset
Definition: hutil.h:33
int GFDegree
Definition: coeffs.h:95
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition: hutil.cc:627
const ExtensionInfo & info
< [in] sqrfree poly
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:73
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1718
BOOLEAN hasAxis(ideal J, int k, const ring r)
Definition: spectrum.cc:81
const ring R
Definition: DebugPrint.cc:36
void killlocals(int v)
Definition: ipshell.cc:376
complex floating point (GMP) numbers
Definition: coeffs.h:42
static FORCE_INLINE char * nCoeffName(const coeffs cf)
Definition: coeffs.h:977
Definition: grammar.cc:269
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
ip_smatrix * matrix
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:329
bool success()
Definition: mpr_numeric.h:162
#define IDSTRING(a)
Definition: ipid.h:133
#define rTest(r)
Definition: ring.h:775
idhdl currRingHdl
Definition: ipid.cc:65
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:857
BOOLEAN nuUResSolve(leftv res, leftv args)
solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing-...
Definition: ipshell.cc:4813
omBin indlist_bin
Definition: hdegree.cc:23
void Copy(leftv e)
Definition: subexpr.cc:660
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6442
#define setFlag(A, F)
Definition: ipid.h:110
BOOLEAN rCheckIV(const intvec *iv)
Definition: ring.cc:185
indset JSet
Definition: hdegree.cc:279
int cols() const
Definition: bigintmat.h:145
#define pSetComp(p, v)
Definition: polys.h:38
void arrange()
Definition: mpr_numeric.cc:895
int rOrderName(char *ordername)
Definition: ring.cc:508
omBin sip_sring_bin
Definition: ring.cc:54
const unsigned short fftable[]
Definition: ffields.cc:61
int m
Definition: cfEzgcd.cc:119
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:221
proclevel * next
Definition: ipid.h:59
#define pMult_nn(p, n)
Definition: polys.h:183
int * scmon
Definition: hutil.h:19
struct for passing initialization parameters to naInitChar
Definition: transext.h:92
only used if HAVE_RINGS is defined
Definition: coeffs.h:43
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6287
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4007
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:312
const char * iiTwoOps(int t)
Definition: ipshell.cc:86
static int si_max(const int a, const int b)
Definition: auxiliary.h:123
unsigned long exp
Definition: rmodulon.h:19
static FORCE_INLINE BOOLEAN nCoeff_is_transExt(const coeffs r)
TRUE iff r represents a transcendental extension field.
Definition: coeffs.h:932
idrec * idhdl
Definition: ring.h:18
virtual ideal getMatrix()
Definition: mpr_base.h:31
FILE * f
Definition: checklibs.c:7
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
ring rInit(leftv pn, leftv rv, leftv ord)
Definition: ipshell.cc:5503
Induced (Schreyer) ordering.
Definition: ring.h:101
void PrintS(const char *s)
Definition: reporter.cc:284
BOOLEAN iiDebugMarker
Definition: ipshell.cc:984
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1398
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:501
lists rDecompose(const ring r)
Definition: ipshell.cc:2023
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6282
idhdl next
Definition: idrec.h:38
BOOLEAN spectrumfProc(leftv result, leftv first)
Definition: ipshell.cc:4089
int IsPrime(int p)
Definition: prime.cc:61
S?
Definition: ring.h:83
#define pOne()
Definition: polys.h:298
char name(const Variable &v)
Definition: factory.h:178
gmp_complex * getRoot(const int i)
Definition: mpr_numeric.h:88
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1568
void iiDebug()
Definition: ipshell.cc:986
Definition: tok.h:99
void solve_all()
Definition: mpr_numeric.cc:870
#define IDELEMS(i)
Definition: simpleideals.h:24
BOOLEAN loSimplex(leftv res, leftv args)
Implementation of the Simplex Algorithm.
Definition: ipshell.cc:4474
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:853
BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
returns TRUE, if r1 equals r2 FALSE, otherwise Equality is determined componentwise, if qr == 1, then qrideal equality is tested, as well
Definition: ring.cc:1634
static FORCE_INLINE nMapFunc n_SetMap(const coeffs src, const coeffs dst)
set the mapping function pointers for translating numbers from src to dst
Definition: coeffs.h:725
lists scIndIndset(ideal S, BOOLEAN all, ideal Q)
Definition: ipshell.cc:1024
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3715
CFList tmp2
Definition: facFqBivar.cc:70
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)
void idSkipZeroes(ideal ide)
gives an ideal/module the minimal possible size
void iiMakeResolv(resolvente r, int length, int rlen, char *name, int typ0, intvec **weights)
Definition: ipshell.cc:768
rootContainer ** interpolateDenseSP(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:2921
#define IDLEV(a)
Definition: ipid.h:118
resolvente fullres
Definition: syz.h:57
static void rRenameVars(ring R)
Definition: ipshell.cc:2372
const char * VoiceName()
Definition: fevoices.cc:66
#define nDelete(n)
Definition: numbers.h:16
semicState
Definition: ipshell.cc:3339
#define IDMAP(a)
Definition: ipid.h:132
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1683
#define FLAG_STD
Definition: ipid.h:106
ideal idCopy(ideal A)
Definition: ideals.h:62
short errorreported
Definition: feFopen.cc:23
int n
Definition: semic.h:69
leftv next
Definition: subexpr.h:88
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:534
#define rHasLocalOrMixedOrdering_currRing()
Definition: ring.h:754
void test_cmd(int i)
Definition: ipshell.cc:508
void rChangeCurrRing(ring r)
Definition: polys.cc:12
resolvente minres
Definition: syz.h:58
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:495
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:571
#define BVERBOSE(a)
Definition: options.h:33
INLINE_THIS void Init(int l=0)
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:48
CanonicalForm buf2
Definition: facFqBivar.cc:71
#define nInvers(a)
Definition: numbers.h:33
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3053
Definition: tok.h:34
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1124
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:311
int GFChar
Definition: coeffs.h:94
#define IDPROC(a)
Definition: ipid.h:137
void paPrint(const char *n, package p)
Definition: ipshell.cc:6229
BOOLEAN iiCheckRing(int i)
Definition: ipshell.cc:1465
#define pi
Definition: libparse.cc:1143
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
BOOLEAN nc_CallPlural(matrix cc, matrix dd, poly cn, poly dn, ring r, bool bSetupQuotient, bool bCopyInput, bool bBeQuiet, ring curr, bool dummy_ring=false)
returns TRUE if there were errors analyze inputs, check them for consistency detects nc_type...
Definition: old.gring.cc:2747
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
BOOLEAN kQHWeight(leftv res, leftv v)
Definition: ipshell.cc:3228
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1287
ring * iiLocalRing
Definition: iplib.cc:470
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
int nr
Definition: lists.h:43
int & cols()
Definition: matpol.h:25
void maFindPerm(char const *const *const preim_names, int preim_n, char const *const *const preim_par, int preim_p, char const *const *const names, int n, char const *const *const par, int nop, int *perm, int *par_perm, n_coeffType ch)
Definition: maps.cc:169
#define ppMult_nn(p, n)
Definition: polys.h:182
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2279
int mu
Definition: semic.h:67
CanonicalForm cf
Definition: cfModGcd.cc:4024
#define MATCOLS(i)
Definition: matpol.h:28
Definition: tok.h:115
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition: minpoly.cc:649
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:985
#define nIsZero(n)
Definition: numbers.h:19
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:477
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1784
#define NULL
Definition: omList.c:10
attr attribute
Definition: idrec.h:41
poly * polyset
Definition: hutil.h:15
slists * lists
Definition: mpr_numeric.h:146
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1767
int getAnzRoots()
Definition: mpr_numeric.h:97
package req_packhdl
Definition: subexpr.h:108
int length() const
Definition: intvec.h:86
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1168
{p^n < 2^16}
Definition: coeffs.h:33
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of &#39;n&#39;
Definition: coeffs.h:455
CanonicalForm den(const CanonicalForm &f)
struct for passing initialization parameters to naInitChar
Definition: algext.h:40
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:116
BOOLEAN semicProc(leftv res, leftv u, leftv v)
Definition: ipshell.cc:4456
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:448
BOOLEAN nuMPResMat(leftv res, leftv arg1, leftv arg2)
returns module representing the multipolynomial resultant matrix Arguments 2: ideal i...
Definition: ipshell.cc:4560
#define IDINT(a)
Definition: ipid.h:122
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
#define IDPOLY(a)
Definition: ipid.h:127
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic ...
Definition: coeffs.h:36
Voice * currentVoice
Definition: fevoices.cc:57
BOOLEAN iiWRITE(leftv, leftv v)
Definition: ipshell.cc:582
BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
check a list of arguemys against a given field of types return TRUE if the types match return FALSE (...
Definition: ipshell.cc:6460
BOOLEAN jjBETTI(leftv res, leftv u)
Definition: ipshell.cc:888
package basePack
Definition: ipid.cc:64
coeffs basecoeffs() const
Definition: bigintmat.h:147
void copy_new(int)
Definition: semic.cc:54
static BOOLEAN rField_is_Ring_Z(const ring r)
Definition: ring.h:474
void pNorm(poly p, const ring R=currRing)
Definition: polys.h:346
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:531
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:215
denominator_list next
Definition: kutil.h:67
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
monf radmem
Definition: hutil.cc:24
#define IDRING(a)
Definition: ipid.h:124
int rTypeOfMatrixOrder(const intvec *order)
Definition: ring.cc:195
const CanonicalForm & w
Definition: facAbsFact.cc:55
strat ak
Definition: myNF.cc:321
#define pDelete(p_ptr)
Definition: polys.h:169
package currPack
Definition: ipid.cc:63
int iiOpsTwoChar(const char *s)
Definition: ipshell.cc:119
leftv iiCurrArgs
Definition: ipshell.cc:78
Variable x
Definition: cfModGcd.cc:4023
int rtyp
Definition: subexpr.h:93
BOOLEAN jjMINRES(leftv res, leftv v)
Definition: ipshell.cc:867
#define nCopy(n)
Definition: numbers.h:15
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:320
void Clean(ring r=currRing)
Definition: lists.h:25
#define pNext(p)
Definition: monomials.h:43
void * Data()
Definition: subexpr.cc:1121
int * w
Definition: semic.h:71
#define nSetMap(R)
Definition: numbers.h:43
const char * par_name
parameter name
Definition: coeffs.h:103
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition: prCopy.cc:193
lists rDecompose_list_cf(const ring r)
Definition: ipshell.cc:1890
int typ
Definition: idrec.h:43
short list_length
Definition: syz.h:62
#define pSetCoeff0(p, n)
Definition: monomials.h:67
static int rInternalChar(const ring r)
Definition: ring.h:677
Definition: tok.h:116
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:75
ideal * resolvente
Definition: ideals.h:20
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:171
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6245
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:206
attr attribute
Definition: subexpr.h:91
omBin slists_bin
Definition: lists.cc:23
BOOLEAN iiARROW(leftv r, char *a, char *s)
Definition: ipshell.cc:6368
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461
BOOLEAN spaddProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4333
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
attr get(const char *s)
Definition: attrib.cc:96
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:717
Definition: tok.h:155
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:791
int hisModule
Definition: hutil.cc:23
leftv iiMap(map theMap, const char *what)
Definition: ipshell.cc:609
size_t gmp_output_digits
Definition: mpr_complex.cc:44
#define pDiff(a, b)
Definition: polys.h:279
idhdl packFindHdl(package r)
Definition: ipid.cc:730
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:459
void iiCheckPack(package &p)
Definition: ipshell.cc:1509
ideal singclap_factorize(poly f, intvec **v, int with_exps, const ring r)
Definition: clapsing.cc:784
#define MATROWS(i)
Definition: matpol.h:27
void wrp(poly p)
Definition: polys.h:293
void setGMPFloatDigits(size_t digits, size_t rest)
Set size of mantissa digits - the number of output digits (basis 10) the size of mantissa consists of...
Definition: mpr_complex.cc:62
int icase
Definition: mpr_numeric.h:201
kBucketDestroy & P
Definition: myNF.cc:191
static jList * T
Definition: janet.cc:37
polyrec * poly
Definition: hilb.h:10
#define IDDATA(a)
Definition: ipid.h:123
virtual IStateType initState() const
Definition: mpr_base.h:41
void rSetHdl(idhdl h)
Definition: ipshell.cc:5017
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
BITSET kOptions
Definition: kstd1.cc:48
BOOLEAN rDecompose_CF(leftv res, const coeffs C)
Definition: ipshell.cc:1817
#define nInit(i)
Definition: numbers.h:24
Rational pow(const Rational &a, int e)
Definition: GMPrat.cc:418
unsigned si_opt_2
Definition: options.c:6
int perm[100]
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:210
int * int_ptr
Definition: structs.h:57
static Poly * h
Definition: janet.cc:978
s?
Definition: ring.h:84
int BOOLEAN
Definition: auxiliary.h:88
#define IMATELEM(M, I, J)
Definition: intvec.h:77
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1243
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
const poly b
Definition: syzextra.cc:213
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:901
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2209
BOOLEAN iiApply(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6319
int mult_spectrum(spectrum &)
Definition: semic.cc:396
package cPack
Definition: ipid.h:61
lists listOfRoots(rootArranger *self, const unsigned int oprec)
Definition: ipshell.cc:4970
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:504
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
scfmon hInit(ideal S, ideal Q, int *Nexist, ring tailRing)
Definition: hutil.cc:34
#define V_REDEFINE
Definition: options.h:43
static int sign(int x)
Definition: ring.cc:3412
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3265
void delete_node(spectrumPolyNode **)
Definition: splist.cc:256
int binom(int n, int r)
void Werror(const char *fmt,...)
Definition: reporter.cc:189
virtual number getSubDet()
Definition: mpr_base.h:37
ideal kGroebner(ideal F, ideal Q)
Definition: ipshell.cc:6139
#define TEST_V_ALLWARN
Definition: options.h:135
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1497
void * CopyD(int t)
Definition: subexpr.cc:679
const char * lastreserved
Definition: ipshell.cc:80
int hMu
Definition: hdegree.cc:22
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
int atyp
Definition: attrib.h:22
static FORCE_INLINE void n_MPZ(mpz_t result, number &n, const coeffs r)
conversion of n to a GMP integer; 0 if not possible
Definition: coeffs.h:555
#define omAlloc0(size)
Definition: omAllocDecl.h:211
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:285
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:94
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight0.c:78
#define IDMATRIX(a)
Definition: ipid.h:131
BOOLEAN loNewtonP(leftv res, leftv arg1)
compute Newton Polytopes of input polynomials
Definition: ipshell.cc:4468
#define pCopy(p)
return a copy of the poly
Definition: polys.h:168
#define MATELEM(mat, i, j)
Definition: matpol.h:29
poly computeWC(const newtonPolygon &np, Rational max_weight, const ring r)
Definition: spectrum.cc:142
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:329
syStrategy syForceMin(lists li)
Definition: ipshell.cc:3190
ssyStrategy * syStrategy
Definition: syz.h:35
utypes data
Definition: idrec.h:40
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8830
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition: hutil.cc:180
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1780
BOOLEAN mpJacobi(leftv res, leftv a)
Definition: ipshell.cc:2976
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263