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