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