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