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