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