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],n_Copy((number)(r->qideal->m[0]),R->cf));
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
1889static void rDecomposeRing_41(leftv h,const coeffs C)
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
2896 R->cf = nInitChar(n_transExt, &extParam);
2897 }
2898 }
2899 }
2900 }
2901 else
2902 {
2903 WerrorS("coefficient field must be described by `int` or `list`");
2904 goto rCompose_err;
2905 }
2906
2907 if( R->cf == NULL )
2908 {
2909 WerrorS("could not create coefficient field described by the input!");
2910 goto rCompose_err;
2911 }
2912
2913 // ------------------------- VARS ---------------------------
2914 if (rComposeVar(L,R)) goto rCompose_err;
2915 // ------------------------ ORDER ------------------------------
2916 if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2917
2918 // ------------------------ ??????? --------------------
2919
2920 if (!isLetterplace) rRenameVars(R);
2921 #ifdef HAVE_SHIFTBBA
2922 else
2923 {
2924 R->isLPring=isLetterplace;
2925 R->ShortOut=FALSE;
2926 R->CanShortOut=FALSE;
2927 }
2928 #endif
2929 if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
2930 rComplete(R);
2931
2932 // ------------------------ Q-IDEAL ------------------------
2933
2934 if (L->m[3].Typ()==IDEAL_CMD)
2935 {
2936 ideal q=(ideal)L->m[3].Data();
2937 if (q->m[0]!=NULL)
2938 {
2939 if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2940 {
2941 #if 0
2942 WerrorS("coefficient fields must be equal if q-ideal !=0");
2943 goto rCompose_err;
2944 #else
2945 ring orig_ring=currRing;
2947 int *perm=NULL;
2948 int *par_perm=NULL;
2949 int par_perm_size=0;
2950 nMapFunc nMap;
2951
2952 if ((nMap=nSetMap(orig_ring->cf))==NULL)
2953 {
2954 if (rEqual(orig_ring,currRing))
2955 {
2956 nMap=n_SetMap(currRing->cf, currRing->cf);
2957 }
2958 else
2959 // Allow imap/fetch to be make an exception only for:
2960 if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2964 ||
2965 (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2966 (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2967 rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2968 {
2969 par_perm_size=rPar(orig_ring);
2970
2971// if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2972// naSetChar(rInternalChar(orig_ring),orig_ring);
2973// else ntSetChar(rInternalChar(orig_ring),orig_ring);
2974
2975 nSetChar(currRing->cf);
2976 }
2977 else
2978 {
2979 WerrorS("coefficient fields must be equal if q-ideal !=0");
2980 goto rCompose_err;
2981 }
2982 }
2983 perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2984 if (par_perm_size!=0)
2985 par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2986 int i;
2987 #if 0
2988 // use imap:
2989 maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2990 currRing->names,currRing->N,currRing->parameter, currRing->P,
2991 perm,par_perm, currRing->ch);
2992 #else
2993 // use fetch
2994 if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2995 {
2996 for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2997 }
2998 else if (par_perm_size!=0)
2999 for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
3000 for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
3001 #endif
3002 ideal dest_id=idInit(IDELEMS(q),1);
3003 for(i=IDELEMS(q)-1; i>=0; i--)
3004 {
3005 dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
3006 par_perm,par_perm_size);
3007 // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
3008 pTest(dest_id->m[i]);
3009 }
3010 R->qideal=dest_id;
3011 if (perm!=NULL)
3012 omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
3013 if (par_perm!=NULL)
3014 omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
3015 rChangeCurrRing(orig_ring);
3016 #endif
3017 }
3018 else
3019 R->qideal=idrCopyR(q,currRing,R);
3020 }
3021 }
3022 else
3023 {
3024 WerrorS("q-ideal must be given as `ideal`");
3025 goto rCompose_err;
3026 }
3027
3028
3029 // ---------------------------------------------------------------
3030 #ifdef HAVE_PLURAL
3031 if (L->nr==5)
3032 {
3033 if (nc_CallPlural((matrix)L->m[4].Data(),
3034 (matrix)L->m[5].Data(),
3035 NULL,NULL,
3036 R,
3037 true, // !!!
3038 true, false,
3039 currRing, FALSE)) goto rCompose_err;
3040 // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3041 }
3042 #endif
3043 return R;
3044
3045rCompose_err:
3046 if (R->N>0)
3047 {
3048 int i;
3049 if (R->names!=NULL)
3050 {
3051 i=R->N-1;
3052 while (i>=0) { omfree(R->names[i]); i--; }
3053 omFree(R->names);
3054 }
3055 }
3056 omfree(R->order);
3057 omfree(R->block0);
3058 omfree(R->block1);
3059 omfree(R->wvhdl);
3060 omFree(R);
3061 return NULL;
3062}
3063
3064// from matpol.cc
3065
3066/*2
3067* compute the jacobi matrix of an ideal
3068*/
3070{
3071 int i,j;
3072 matrix result;
3073 ideal id=(ideal)a->Data();
3074
3076 for (i=1; i<=IDELEMS(id); i++)
3077 {
3078 for (j=1; j<=rVar(currRing); j++)
3079 {
3080 MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3081 }
3082 }
3083 res->data=(char *)result;
3084 return FALSE;
3085}
3086
3087/*2
3088* returns the Koszul-matrix of degree d of a vectorspace with dimension n
3089* uses the first n entrees of id, if id <> NULL
3090*/
3092{
3093 int n=(int)(long)b->Data();
3094 int d=(int)(long)c->Data();
3095 int k,l,sign,row,col;
3096 matrix result;
3097 ideal temp;
3098 BOOLEAN bo;
3099 poly p;
3100
3101 if ((d>n) || (d<1) || (n<1))
3102 {
3103 res->data=(char *)mpNew(1,1);
3104 return FALSE;
3105 }
3106 int *choise = (int*)omAlloc(d*sizeof(int));
3107 if (id==NULL)
3108 temp=idMaxIdeal(1);
3109 else
3110 temp=(ideal)id->Data();
3111
3112 k = binom(n,d);
3113 l = k*d;
3114 l /= n-d+1;
3115 result =mpNew(l,k);
3116 col = 1;
3117 idInitChoise(d,1,n,&bo,choise);
3118 while (!bo)
3119 {
3120 sign = 1;
3121 for (l=1;l<=d;l++)
3122 {
3123 if (choise[l-1]<=IDELEMS(temp))
3124 {
3125 p = pCopy(temp->m[choise[l-1]-1]);
3126 if (sign == -1) p = pNeg(p);
3127 sign *= -1;
3128 row = idGetNumberOfChoise(l-1,d,1,n,choise);
3129 MATELEM(result,row,col) = p;
3130 }
3131 }
3132 col++;
3133 idGetNextChoise(d,n,&bo,choise);
3134 }
3135 omFreeSize(choise,d*sizeof(int));
3136 if (id==NULL) idDelete(&temp);
3137
3138 res->data=(char *)result;
3139 return FALSE;
3140}
3141
3142// from syz1.cc
3143/*2
3144* read out the Betti numbers from resolution
3145* (interpreter interface)
3146*/
3148{
3149 syStrategy syzstr=(syStrategy)u->Data();
3150
3151 BOOLEAN minim=(int)(long)w->Data();
3152 int row_shift=0;
3153 int add_row_shift=0;
3154 intvec *weights=NULL;
3155 intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3156 if (ww!=NULL)
3157 {
3158 weights=ivCopy(ww);
3159 add_row_shift = ww->min_in();
3160 (*weights) -= add_row_shift;
3161 }
3162
3163 res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3164 //row_shift += add_row_shift;
3165 //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3166 atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3167
3168 return FALSE;
3169}
3171{
3172 sleftv tmp;
3173 tmp.Init();
3174 tmp.rtyp=INT_CMD;
3175 tmp.data=(void *)1;
3176 return syBetti2(res,u,&tmp);
3177}
3178
3179/*3
3180* converts a resolution into a list of modules
3181*/
3182lists syConvRes(syStrategy syzstr,BOOLEAN toDel,int add_row_shift)
3183{
3184 resolvente fullres = syzstr->fullres;
3185 resolvente minres = syzstr->minres;
3186
3187 const int length = syzstr->length;
3188
3189 if ((fullres==NULL) && (minres==NULL))
3190 {
3191 if (syzstr->hilb_coeffs==NULL)
3192 { // La Scala
3193 fullres = syReorder(syzstr->res, length, syzstr);
3194 }
3195 else
3196 { // HRES
3197 minres = syReorder(syzstr->orderedRes, length, syzstr);
3198 syKillEmptyEntres(minres, length);
3199 }
3200 }
3201
3202 resolvente tr;
3203 int typ0=IDEAL_CMD;
3204
3205 if (minres!=NULL)
3206 tr = minres;
3207 else
3208 tr = fullres;
3209
3210 resolvente trueres=NULL;
3211 intvec ** w=NULL;
3212
3213 if (length>0)
3214 {
3215 trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3216 for (int i=length-1;i>=0;i--)
3217 {
3218 if (tr[i]!=NULL)
3219 {
3220 trueres[i] = idCopy(tr[i]);
3221 }
3222 }
3223 if ( id_RankFreeModule(trueres[0], currRing) > 0)
3224 typ0 = MODUL_CMD;
3225 if (syzstr->weights!=NULL)
3226 {
3227 w = (intvec**)omAlloc0(length*sizeof(intvec*));
3228 for (int i=length-1;i>=0;i--)
3229 {
3230 if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3231 }
3232 }
3233 }
3234
3235 lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3236 w, add_row_shift);
3237
3238 if (toDel)
3239 syKillComputation(syzstr);
3240 else
3241 {
3242 if( fullres != NULL && syzstr->fullres == NULL )
3243 syzstr->fullres = fullres;
3244
3245 if( minres != NULL && syzstr->minres == NULL )
3246 syzstr->minres = minres;
3247 }
3248 return li;
3249}
3250
3251/*3
3252* converts a list of modules into a resolution
3253*/
3255{
3256 int typ0;
3258
3259 resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3260 if (fr != NULL)
3261 {
3262
3263 result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3264 for (int i=result->length-1;i>=0;i--)
3265 {
3266 if (fr[i]!=NULL)
3267 result->fullres[i] = idCopy(fr[i]);
3268 }
3269 result->list_length=result->length;
3270 omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3271 }
3272 else
3273 {
3274 omFreeSize(result, sizeof(ssyStrategy));
3275 result = NULL;
3276 }
3277 return result;
3278}
3279
3280#if 0
3281/*3
3282* converts a list of modules into a minimal resolution
3283*/
3284syStrategy syForceMin(lists li)
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#endif
3300// from weight.cc
3302{
3303 ideal F=(ideal)id->Data();
3304 intvec * iv = new intvec(rVar(currRing));
3305 polyset s;
3306 int sl, n, i;
3307 int *x;
3308
3309 res->data=(char *)iv;
3310 s = F->m;
3311 sl = IDELEMS(F) - 1;
3312 n = rVar(currRing);
3313 double wNsqr = (double)2.0 / (double)n;
3315 x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3316 wCall(s, sl, x, wNsqr, currRing);
3317 for (i = n; i!=0; i--)
3318 (*iv)[i-1] = x[i + n + 1];
3319 omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3320 return FALSE;
3321}
3322
3324{
3325 res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3326 if (res->data==NULL)
3327 res->data=(char *)new intvec(rVar(currRing));
3328 return FALSE;
3329}
3330/*==============================================================*/
3331// from clapsing.cc
3332#if 0
3333BOOLEAN jjIS_SQR_FREE(leftv res, leftv u)
3334{
3335 BOOLEAN b=singclap_factorize((poly)(u->CopyD()), &v, 0);
3336 res->data=(void *)b;
3337}
3338#endif
3339
3341{
3342 res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3343 (poly)w->CopyD(), currRing);
3344 return errorreported;
3345}
3346
3348{
3349 res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3350 return (res->data==NULL);
3351}
3352
3353// from semic.cc
3354#ifdef HAVE_SPECTRUM
3355
3356// ----------------------------------------------------------------------------
3357// Initialize a spectrum deep from a singular lists
3358// ----------------------------------------------------------------------------
3359
3361{
3362 spec.mu = (int)(long)(l->m[0].Data( ));
3363 spec.pg = (int)(long)(l->m[1].Data( ));
3364 spec.n = (int)(long)(l->m[2].Data( ));
3365
3366 spec.copy_new( spec.n );
3367
3368 intvec *num = (intvec*)l->m[3].Data( );
3369 intvec *den = (intvec*)l->m[4].Data( );
3370 intvec *mul = (intvec*)l->m[5].Data( );
3371
3372 for( int i=0; i<spec.n; i++ )
3373 {
3374 spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3375 spec.w[i] = (*mul)[i];
3376 }
3377}
3378
3379// ----------------------------------------------------------------------------
3380// singular lists constructor for spectrum
3381// ----------------------------------------------------------------------------
3382
3383spectrum /*former spectrum::spectrum ( lists l )*/
3385{
3387 copy_deep( result, l );
3388 return result;
3389}
3390
3391// ----------------------------------------------------------------------------
3392// generate a Singular lists from a spectrum
3393// ----------------------------------------------------------------------------
3394
3395/* former spectrum::thelist ( void )*/
3397{
3399
3400 L->Init( 6 );
3401
3402 intvec *num = new intvec( spec.n );
3403 intvec *den = new intvec( spec.n );
3404 intvec *mult = new intvec( spec.n );
3405
3406 for( int i=0; i<spec.n; i++ )
3407 {
3408 (*num) [i] = spec.s[i].get_num_si( );
3409 (*den) [i] = spec.s[i].get_den_si( );
3410 (*mult)[i] = spec.w[i];
3411 }
3412
3413 L->m[0].rtyp = INT_CMD; // milnor number
3414 L->m[1].rtyp = INT_CMD; // geometrical genus
3415 L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3416 L->m[3].rtyp = INTVEC_CMD; // numerators
3417 L->m[4].rtyp = INTVEC_CMD; // denomiantors
3418 L->m[5].rtyp = INTVEC_CMD; // multiplicities
3419
3420 L->m[0].data = (void*)(long)spec.mu;
3421 L->m[1].data = (void*)(long)spec.pg;
3422 L->m[2].data = (void*)(long)spec.n;
3423 L->m[3].data = (void*)num;
3424 L->m[4].data = (void*)den;
3425 L->m[5].data = (void*)mult;
3426
3427 return L;
3428}
3429// from spectrum.cc
3430// ----------------------------------------------------------------------------
3431// print out an error message for a spectrum list
3432// ----------------------------------------------------------------------------
3433
3434typedef enum
3435{
3438
3441
3448
3453
3459
3462
3465
3467
3469{
3470 switch( state )
3471 {
3472 case semicListTooShort:
3473 WerrorS( "the list is too short" );
3474 break;
3475 case semicListTooLong:
3476 WerrorS( "the list is too long" );
3477 break;
3478
3480 WerrorS( "first element of the list should be int" );
3481 break;
3483 WerrorS( "second element of the list should be int" );
3484 break;
3486 WerrorS( "third element of the list should be int" );
3487 break;
3489 WerrorS( "fourth element of the list should be intvec" );
3490 break;
3492 WerrorS( "fifth element of the list should be intvec" );
3493 break;
3495 WerrorS( "sixth element of the list should be intvec" );
3496 break;
3497
3498 case semicListNNegative:
3499 WerrorS( "first element of the list should be positive" );
3500 break;
3502 WerrorS( "wrong number of numerators" );
3503 break;
3505 WerrorS( "wrong number of denominators" );
3506 break;
3508 WerrorS( "wrong number of multiplicities" );
3509 break;
3510
3512 WerrorS( "the Milnor number should be positive" );
3513 break;
3515 WerrorS( "the geometrical genus should be nonnegative" );
3516 break;
3518 WerrorS( "all numerators should be positive" );
3519 break;
3521 WerrorS( "all denominators should be positive" );
3522 break;
3524 WerrorS( "all multiplicities should be positive" );
3525 break;
3526
3528 WerrorS( "it is not symmetric" );
3529 break;
3531 WerrorS( "it is not monotonous" );
3532 break;
3533
3535 WerrorS( "the Milnor number is wrong" );
3536 break;
3537 case semicListPGWrong:
3538 WerrorS( "the geometrical genus is wrong" );
3539 break;
3540
3541 default:
3542 WerrorS( "unspecific error" );
3543 break;
3544 }
3545}
3546// ----------------------------------------------------------------------------
3547// this is the main spectrum computation function
3548// ----------------------------------------------------------------------------
3549
3551{
3562
3563// from splist.cc
3564// ----------------------------------------------------------------------------
3565// Compute the spectrum of a spectrumPolyList
3566// ----------------------------------------------------------------------------
3567
3568/* former spectrumPolyList::spectrum ( lists*, int) */
3570{
3571 spectrumPolyNode **node = &speclist.root;
3573
3574 poly f,tmp;
3575 int found,cmp;
3576
3577 Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3578 ( fast==2 ? 2 : 1 ) );
3579
3580 Rational weight_prev( 0,1 );
3581
3582 int mu = 0; // the milnor number
3583 int pg = 0; // the geometrical genus
3584 int n = 0; // number of different spectral numbers
3585 int z = 0; // number of spectral number equal to smax
3586
3587 while( (*node)!=(spectrumPolyNode*)NULL &&
3588 ( fast==0 || (*node)->weight<=smax ) )
3589 {
3590 // ---------------------------------------
3591 // determine the first normal form which
3592 // contains the monomial node->mon
3593 // ---------------------------------------
3594
3595 found = FALSE;
3596 search = *node;
3597
3598 while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3599 {
3600 if( search->nf!=(poly)NULL )
3601 {
3602 f = search->nf;
3603
3604 do
3605 {
3606 // --------------------------------
3607 // look for (*node)->mon in f
3608 // --------------------------------
3609
3610 cmp = pCmp( (*node)->mon,f );
3611
3612 if( cmp<0 )
3613 {
3614 f = pNext( f );
3615 }
3616 else if( cmp==0 )
3617 {
3618 // -----------------------------
3619 // we have found a normal form
3620 // -----------------------------
3621
3622 found = TRUE;
3623
3624 // normalize coefficient
3625
3626 number inv = nInvers( pGetCoeff( f ) );
3627 search->nf=__p_Mult_nn( search->nf,inv,currRing );
3628 nDelete( &inv );
3629
3630 // exchange normal forms
3631
3632 tmp = (*node)->nf;
3633 (*node)->nf = search->nf;
3634 search->nf = tmp;
3635 }
3636 }
3637 while( cmp<0 && f!=(poly)NULL );
3638 }
3639 search = search->next;
3640 }
3641
3642 if( found==FALSE )
3643 {
3644 // ------------------------------------------------
3645 // the weight of node->mon is a spectrum number
3646 // ------------------------------------------------
3647
3648 mu++;
3649
3650 if( (*node)->weight<=(Rational)1 ) pg++;
3651 if( (*node)->weight==smax ) z++;
3652 if( (*node)->weight>weight_prev ) n++;
3653
3654 weight_prev = (*node)->weight;
3655 node = &((*node)->next);
3656 }
3657 else
3658 {
3659 // -----------------------------------------------
3660 // determine all other normal form which contain
3661 // the monomial node->mon
3662 // replace for node->mon its normal form
3663 // -----------------------------------------------
3664
3665 while( search!=(spectrumPolyNode*)NULL )
3666 {
3667 if( search->nf!=(poly)NULL )
3668 {
3669 f = search->nf;
3670
3671 do
3672 {
3673 // --------------------------------
3674 // look for (*node)->mon in f
3675 // --------------------------------
3676
3677 cmp = pCmp( (*node)->mon,f );
3678
3679 if( cmp<0 )
3680 {
3681 f = pNext( f );
3682 }
3683 else if( cmp==0 )
3684 {
3685 search->nf = pSub( search->nf,
3686 __pp_Mult_nn( (*node)->nf,pGetCoeff( f ),currRing ) );
3687 pNorm( search->nf );
3688 }
3689 }
3690 while( cmp<0 && f!=(poly)NULL );
3691 }
3692 search = search->next;
3693 }
3694 speclist.delete_node( node );
3695 }
3696
3697 }
3698
3699 // --------------------------------------------------------
3700 // fast computation exploits the symmetry of the spectrum
3701 // --------------------------------------------------------
3702
3703 if( fast==2 )
3704 {
3705 mu = 2*mu - z;
3706 n = ( z > 0 ? 2*n - 1 : 2*n );
3707 }
3708
3709 // --------------------------------------------------------
3710 // compute the spectrum numbers with their multiplicities
3711 // --------------------------------------------------------
3712
3713 intvec *nom = new intvec( n );
3714 intvec *den = new intvec( n );
3715 intvec *mult = new intvec( n );
3716
3717 int count = 0;
3718 int multiplicity = 1;
3719
3720 for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3721 ( fast==0 || search->weight<=smax );
3722 search=search->next )
3723 {
3724 if( search->next==(spectrumPolyNode*)NULL ||
3725 search->weight<search->next->weight )
3726 {
3727 (*nom) [count] = search->weight.get_num_si( );
3728 (*den) [count] = search->weight.get_den_si( );
3729 (*mult)[count] = multiplicity;
3730
3731 multiplicity=1;
3732 count++;
3733 }
3734 else
3735 {
3736 multiplicity++;
3737 }
3738 }
3739
3740 // --------------------------------------------------------
3741 // fast computation exploits the symmetry of the spectrum
3742 // --------------------------------------------------------
3743
3744 if( fast==2 )
3745 {
3746 int n1,n2;
3747 for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3748 {
3749 (*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
3750 (*den) [n2] = (*den)[n1];
3751 (*mult)[n2] = (*mult)[n1];
3752 }
3753 }
3754
3755 // -----------------------------------
3756 // test if the spectrum is symmetric
3757 // -----------------------------------
3758
3759 if( fast==0 || fast==1 )
3760 {
3761 int symmetric=TRUE;
3762
3763 for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3764 {
3765 if( (*mult)[n1]!=(*mult)[n2] ||
3766 (*den) [n1]!= (*den)[n2] ||
3767 (*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
3768 {
3769 symmetric = FALSE;
3770 }
3771 }
3772
3773 if( symmetric==FALSE )
3774 {
3775 // ---------------------------------------------
3776 // the spectrum is not symmetric => degenerate
3777 // principal part
3778 // ---------------------------------------------
3779
3780 *L = (lists)omAllocBin( slists_bin);
3781 (*L)->Init( 1 );
3782 (*L)->m[0].rtyp = INT_CMD; // milnor number
3783 (*L)->m[0].data = (void*)(long)mu;
3784
3785 return spectrumDegenerate;
3786 }
3787 }
3788
3789 *L = (lists)omAllocBin( slists_bin);
3790
3791 (*L)->Init( 6 );
3792
3793 (*L)->m[0].rtyp = INT_CMD; // milnor number
3794 (*L)->m[1].rtyp = INT_CMD; // geometrical genus
3795 (*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3796 (*L)->m[3].rtyp = INTVEC_CMD; // nominators
3797 (*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3798 (*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3799
3800 (*L)->m[0].data = (void*)(long)mu;
3801 (*L)->m[1].data = (void*)(long)pg;
3802 (*L)->m[2].data = (void*)(long)n;
3803 (*L)->m[3].data = (void*)nom;
3804 (*L)->m[4].data = (void*)den;
3805 (*L)->m[5].data = (void*)mult;
3806
3807 return spectrumOK;
3808}
3809
3811{
3812 int i;
3813
3814 #ifdef SPECTRUM_DEBUG
3815 #ifdef SPECTRUM_PRINT
3816 #ifdef SPECTRUM_IOSTREAM
3817 cout << "spectrumCompute\n";
3818 if( fast==0 ) cout << " no optimization" << endl;
3819 if( fast==1 ) cout << " weight optimization" << endl;
3820 if( fast==2 ) cout << " symmetry optimization" << endl;
3821 #else
3822 fputs( "spectrumCompute\n",stdout );
3823 if( fast==0 ) fputs( " no optimization\n", stdout );
3824 if( fast==1 ) fputs( " weight optimization\n", stdout );
3825 if( fast==2 ) fputs( " symmetry optimization\n", stdout );
3826 #endif
3827 #endif
3828 #endif
3829
3830 // ----------------------
3831 // check if h is zero
3832 // ----------------------
3833
3834 if( h==(poly)NULL )
3835 {
3836 return spectrumZero;
3837 }
3838
3839 // ----------------------------------
3840 // check if h has a constant term
3841 // ----------------------------------
3842
3843 if( hasConstTerm( h, currRing ) )
3844 {
3845 return spectrumBadPoly;
3846 }
3847
3848 // --------------------------------
3849 // check if h has a linear term
3850 // --------------------------------
3851
3852 if( hasLinearTerm( h, currRing ) )
3853 {
3854 *L = (lists)omAllocBin( slists_bin);
3855 (*L)->Init( 1 );
3856 (*L)->m[0].rtyp = INT_CMD; // milnor number
3857 /* (*L)->m[0].data = (void*)0;a -- done by Init */
3858
3859 return spectrumNoSingularity;
3860 }
3861
3862 // ----------------------------------
3863 // compute the jacobi ideal of (h)
3864 // ----------------------------------
3865
3866 ideal J = NULL;
3867 J = idInit( rVar(currRing),1 );
3868
3869 #ifdef SPECTRUM_DEBUG
3870 #ifdef SPECTRUM_PRINT
3871 #ifdef SPECTRUM_IOSTREAM
3872 cout << "\n computing the Jacobi ideal...\n";
3873 #else
3874 fputs( "\n computing the Jacobi ideal...\n",stdout );
3875 #endif
3876 #endif
3877 #endif
3878
3879 for( i=0; i<rVar(currRing); i++ )
3880 {
3881 J->m[i] = pDiff( h,i+1); //j );
3882
3883 #ifdef SPECTRUM_DEBUG
3884 #ifdef SPECTRUM_PRINT
3885 #ifdef SPECTRUM_IOSTREAM
3886 cout << " ";
3887 #else
3888 fputs(" ", stdout );
3889 #endif
3890 pWrite( J->m[i] );
3891 #endif
3892 #endif
3893 }
3894
3895 // --------------------------------------------
3896 // compute a standard basis stdJ of jac(h)
3897 // --------------------------------------------
3898
3899 #ifdef SPECTRUM_DEBUG
3900 #ifdef SPECTRUM_PRINT
3901 #ifdef SPECTRUM_IOSTREAM
3902 cout << endl;
3903 cout << " computing a standard basis..." << endl;
3904 #else
3905 fputs( "\n", stdout );
3906 fputs( " computing a standard basis...\n", stdout );
3907 #endif
3908 #endif
3909 #endif
3910
3911 ideal stdJ = kStd(J,currRing->qideal,isNotHomog,NULL);
3912 idSkipZeroes( stdJ );
3913
3914 #ifdef SPECTRUM_DEBUG
3915 #ifdef SPECTRUM_PRINT
3916 for( i=0; i<IDELEMS(stdJ); i++ )
3917 {
3918 #ifdef SPECTRUM_IOSTREAM
3919 cout << " ";
3920 #else
3921 fputs( " ",stdout );
3922 #endif
3923
3924 pWrite( stdJ->m[i] );
3925 }
3926 #endif
3927 #endif
3928
3929 idDelete( &J );
3930
3931 // ------------------------------------------
3932 // check if the h has a singularity
3933 // ------------------------------------------
3934
3935 if( hasOne( stdJ, currRing ) )
3936 {
3937 // -------------------------------
3938 // h is smooth in the origin
3939 // return only the Milnor number
3940 // -------------------------------
3941
3942 *L = (lists)omAllocBin( slists_bin);
3943 (*L)->Init( 1 );
3944 (*L)->m[0].rtyp = INT_CMD; // milnor number
3945 /* (*L)->m[0].data = (void*)0;a -- done by Init */
3946
3947 return spectrumNoSingularity;
3948 }
3949
3950 // ------------------------------------------
3951 // check if the singularity h is isolated
3952 // ------------------------------------------
3953
3954 for( i=rVar(currRing); i>0; i-- )
3955 {
3956 if( hasAxis( stdJ,i, currRing )==FALSE )
3957 {
3958 return spectrumNotIsolated;
3959 }
3960 }
3961
3962 // ------------------------------------------
3963 // compute the highest corner hc of stdJ
3964 // ------------------------------------------
3965
3966 #ifdef SPECTRUM_DEBUG
3967 #ifdef SPECTRUM_PRINT
3968 #ifdef SPECTRUM_IOSTREAM
3969 cout << "\n computing the highest corner...\n";
3970 #else
3971 fputs( "\n computing the highest corner...\n", stdout );
3972 #endif
3973 #endif
3974 #endif
3975
3976 poly hc = (poly)NULL;
3977
3978 scComputeHC( stdJ,currRing->qideal, 0,hc );
3979
3980 if( hc!=(poly)NULL )
3981 {
3982 pGetCoeff(hc) = nInit(1);
3983
3984 for( i=rVar(currRing); i>0; i-- )
3985 {
3986 if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
3987 }
3988 pSetm( hc );
3989 }
3990 else
3991 {
3992 return spectrumNoHC;
3993 }
3994
3995 #ifdef SPECTRUM_DEBUG
3996 #ifdef SPECTRUM_PRINT
3997 #ifdef SPECTRUM_IOSTREAM
3998 cout << " ";
3999 #else
4000 fputs( " ", stdout );
4001 #endif
4002 pWrite( hc );
4003 #endif
4004 #endif
4005
4006 // ----------------------------------------
4007 // compute the Newton polygon nph of h
4008 // ----------------------------------------
4009
4010 #ifdef SPECTRUM_DEBUG
4011 #ifdef SPECTRUM_PRINT
4012 #ifdef SPECTRUM_IOSTREAM
4013 cout << "\n computing the newton polygon...\n";
4014 #else
4015 fputs( "\n computing the newton polygon...\n", stdout );
4016 #endif
4017 #endif
4018 #endif
4019
4020 newtonPolygon nph( h, currRing );
4021
4022 #ifdef SPECTRUM_DEBUG
4023 #ifdef SPECTRUM_PRINT
4024 cout << nph;
4025 #endif
4026 #endif
4027
4028 // -----------------------------------------------
4029 // compute the weight corner wc of (stdj,nph)
4030 // -----------------------------------------------
4031
4032 #ifdef SPECTRUM_DEBUG
4033 #ifdef SPECTRUM_PRINT
4034 #ifdef SPECTRUM_IOSTREAM
4035 cout << "\n computing the weight corner...\n";
4036 #else
4037 fputs( "\n computing the weight corner...\n", stdout );
4038 #endif
4039 #endif
4040 #endif
4041
4042 poly wc = ( fast==0 ? pCopy( hc ) :
4043 ( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
4044 /* fast==2 */computeWC( nph,
4045 ((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
4046
4047 #ifdef SPECTRUM_DEBUG
4048 #ifdef SPECTRUM_PRINT
4049 #ifdef SPECTRUM_IOSTREAM
4050 cout << " ";
4051 #else
4052 fputs( " ", stdout );
4053 #endif
4054 pWrite( wc );
4055 #endif
4056 #endif
4057
4058 // -------------
4059 // compute NF
4060 // -------------
4061
4062 #ifdef SPECTRUM_DEBUG
4063 #ifdef SPECTRUM_PRINT
4064 #ifdef SPECTRUM_IOSTREAM
4065 cout << "\n computing NF...\n" << endl;
4066 #else
4067 fputs( "\n computing NF...\n", stdout );
4068 #endif
4069 #endif
4070 #endif
4071
4072 spectrumPolyList NF( &nph );
4073
4074 computeNF( stdJ,hc,wc,&NF, currRing );
4075
4076 #ifdef SPECTRUM_DEBUG
4077 #ifdef SPECTRUM_PRINT
4078 cout << NF;
4079 #ifdef SPECTRUM_IOSTREAM
4080 cout << endl;
4081 #else
4082 fputs( "\n", stdout );
4083 #endif
4084 #endif
4085 #endif
4086
4087 // ----------------------------
4088 // compute the spectrum of h
4089 // ----------------------------
4090// spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
4091
4092 return spectrumStateFromList(NF, L, fast );
4093}
4094
4095// ----------------------------------------------------------------------------
4096// this procedure is called from the interpreter
4097// ----------------------------------------------------------------------------
4098// first = polynomial
4099// result = list of spectrum numbers
4100// ----------------------------------------------------------------------------
4101
4103{
4104 switch( state )
4105 {
4106 case spectrumZero:
4107 WerrorS( "polynomial is zero" );
4108 break;
4109 case spectrumBadPoly:
4110 WerrorS( "polynomial has constant term" );
4111 break;
4113 WerrorS( "not a singularity" );
4114 break;
4116 WerrorS( "the singularity is not isolated" );
4117 break;
4118 case spectrumNoHC:
4119 WerrorS( "highest corner cannot be computed" );
4120 break;
4121 case spectrumDegenerate:
4122 WerrorS( "principal part is degenerate" );
4123 break;
4124 case spectrumOK:
4125 break;
4126
4127 default:
4128 WerrorS( "unknown error occurred" );
4129 break;
4130 }
4131}
4132
4134{
4135 spectrumState state = spectrumOK;
4136
4137 // -------------------
4138 // check consistency
4139 // -------------------
4140
4141 // check for a local ring
4142
4143 if( !ringIsLocal(currRing ) )
4144 {
4145 WerrorS( "only works for local orderings" );
4146 state = spectrumWrongRing;
4147 }
4148
4149 // no quotient rings are allowed
4150
4151 else if( currRing->qideal != NULL )
4152 {
4153 WerrorS( "does not work in quotient rings" );
4154 state = spectrumWrongRing;
4155 }
4156 else
4157 {
4158 lists L = (lists)NULL;
4159 int flag = 1; // weight corner optimization is safe
4160
4161 state = spectrumCompute( (poly)first->Data( ),&L,flag );
4162
4163 if( state==spectrumOK )
4164 {
4165 result->rtyp = LIST_CMD;
4166 result->data = (char*)L;
4167 }
4168 else
4169 {
4170 spectrumPrintError(state);
4171 }
4172 }
4173
4174 return (state!=spectrumOK);
4175}
4176
4177// ----------------------------------------------------------------------------
4178// this procedure is called from the interpreter
4179// ----------------------------------------------------------------------------
4180// first = polynomial
4181// result = list of spectrum numbers
4182// ----------------------------------------------------------------------------
4183
4185{
4186 spectrumState state = spectrumOK;
4187
4188 // -------------------
4189 // check consistency
4190 // -------------------
4191
4192 // check for a local polynomial ring
4193
4194 if( currRing->OrdSgn != -1 )
4195 // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4196 // or should we use:
4197 //if( !ringIsLocal( ) )
4198 {
4199 WerrorS( "only works for local orderings" );
4200 state = spectrumWrongRing;
4201 }
4202 else if( currRing->qideal != NULL )
4203 {
4204 WerrorS( "does not work in quotient rings" );
4205 state = spectrumWrongRing;
4206 }
4207 else
4208 {
4209 lists L = (lists)NULL;
4210 int flag = 2; // symmetric optimization
4211
4212 state = spectrumCompute( (poly)first->Data( ),&L,flag );
4213
4214 if( state==spectrumOK )
4215 {
4216 result->rtyp = LIST_CMD;
4217 result->data = (char*)L;
4218 }
4219 else
4220 {
4221 spectrumPrintError(state);
4222 }
4223 }
4224
4225 return (state!=spectrumOK);
4226}
4227
4228// ----------------------------------------------------------------------------
4229// check if a list is a spectrum
4230// check for:
4231// list has 6 elements
4232// 1st element is int (mu=Milnor number)
4233// 2nd element is int (pg=geometrical genus)
4234// 3rd element is int (n =number of different spectrum numbers)
4235// 4th element is intvec (num=numerators)
4236// 5th element is intvec (den=denomiantors)
4237// 6th element is intvec (mul=multiplicities)
4238// exactly n numerators
4239// exactly n denominators
4240// exactly n multiplicities
4241// mu>0
4242// pg>=0
4243// n>0
4244// num>0
4245// den>0
4246// mul>0
4247// symmetriy with respect to numberofvariables/2
4248// monotony
4249// mu = sum of all multiplicities
4250// pg = sum of all multiplicities where num/den<=1
4251// ----------------------------------------------------------------------------
4252
4254{
4255 // -------------------
4256 // check list length
4257 // -------------------
4258
4259 if( l->nr < 5 )
4260 {
4261 return semicListTooShort;
4262 }
4263 else if( l->nr > 5 )
4264 {
4265 return semicListTooLong;
4266 }
4267
4268 // -------------
4269 // check types
4270 // -------------
4271
4272 if( l->m[0].rtyp != INT_CMD )
4273 {
4275 }
4276 else if( l->m[1].rtyp != INT_CMD )
4277 {
4279 }
4280 else if( l->m[2].rtyp != INT_CMD )
4281 {
4283 }
4284 else if( l->m[3].rtyp != INTVEC_CMD )
4285 {
4287 }
4288 else if( l->m[4].rtyp != INTVEC_CMD )
4289 {
4291 }
4292 else if( l->m[5].rtyp != INTVEC_CMD )
4293 {
4295 }
4296
4297 // -------------------------
4298 // check number of entries
4299 // -------------------------
4300
4301 int mu = (int)(long)(l->m[0].Data( ));
4302 int pg = (int)(long)(l->m[1].Data( ));
4303 int n = (int)(long)(l->m[2].Data( ));
4304
4305 if( n <= 0 )
4306 {
4307 return semicListNNegative;
4308 }
4309
4310 intvec *num = (intvec*)l->m[3].Data( );
4311 intvec *den = (intvec*)l->m[4].Data( );
4312 intvec *mul = (intvec*)l->m[5].Data( );
4313
4314 if( n != num->length( ) )
4315 {
4317 }
4318 else if( n != den->length( ) )
4319 {
4321 }
4322 else if( n != mul->length( ) )
4323 {
4325 }
4326
4327 // --------
4328 // values
4329 // --------
4330
4331 if( mu <= 0 )
4332 {
4333 return semicListMuNegative;
4334 }
4335 if( pg < 0 )
4336 {
4337 return semicListPgNegative;
4338 }
4339
4340 int i;
4341
4342 for( i=0; i<n; i++ )
4343 {
4344 if( (*num)[i] <= 0 )
4345 {
4346 return semicListNumNegative;
4347 }
4348 if( (*den)[i] <= 0 )
4349 {
4350 return semicListDenNegative;
4351 }
4352 if( (*mul)[i] <= 0 )
4353 {
4354 return semicListMulNegative;
4355 }
4356 }
4357
4358 // ----------------
4359 // check symmetry
4360 // ----------------
4361
4362 int j;
4363
4364 for( i=0, j=n-1; i<=j; i++,j-- )
4365 {
4366 if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
4367 (*den)[i] != (*den)[j] ||
4368 (*mul)[i] != (*mul)[j] )
4369 {
4370 return semicListNotSymmetric;
4371 }
4372 }
4373
4374 // ----------------
4375 // check monotony
4376 // ----------------
4377
4378 for( i=0, j=1; i<n/2; i++,j++ )
4379 {
4380 if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
4381 {
4383 }
4384 }
4385
4386 // ---------------------
4387 // check Milnor number
4388 // ---------------------
4389
4390 for( mu=0, i=0; i<n; i++ )
4391 {
4392 mu += (*mul)[i];
4393 }
4394
4395 if( mu != (int)(long)(l->m[0].Data( )) )
4396 {
4397 return semicListMilnorWrong;
4398 }
4399
4400 // -------------------------
4401 // check geometrical genus
4402 // -------------------------
4403
4404 for( pg=0, i=0; i<n; i++ )
4405 {
4406 if( (*num)[i]<=(*den)[i] )
4407 {
4408 pg += (*mul)[i];
4409 }
4410 }
4411
4412 if( pg != (int)(long)(l->m[1].Data( )) )
4413 {
4414 return semicListPGWrong;
4415 }
4416
4417 return semicOK;
4418}
4419
4420// ----------------------------------------------------------------------------
4421// this procedure is called from the interpreter
4422// ----------------------------------------------------------------------------
4423// first = list of spectrum numbers
4424// second = list of spectrum numbers
4425// result = sum of the two lists
4426// ----------------------------------------------------------------------------
4427
4429{
4430 semicState state;
4431
4432 // -----------------
4433 // check arguments
4434 // -----------------
4435
4436 lists l1 = (lists)first->Data( );
4437 lists l2 = (lists)second->Data( );
4438
4439 if( (state=list_is_spectrum( l1 )) != semicOK )
4440 {
4441 WerrorS( "first argument is not a spectrum:" );
4442 list_error( state );
4443 }
4444 else if( (state=list_is_spectrum( l2 )) != semicOK )
4445 {
4446 WerrorS( "second argument is not a spectrum:" );
4447 list_error( state );
4448 }
4449 else
4450 {
4451 spectrum s1= spectrumFromList ( l1 );
4452 spectrum s2= spectrumFromList ( l2 );
4453 spectrum sum( s1+s2 );
4454
4455 result->rtyp = LIST_CMD;
4456 result->data = (char*)(getList(sum));
4457 }
4458
4459 return (state!=semicOK);
4460}
4461
4462// ----------------------------------------------------------------------------
4463// this procedure is called from the interpreter
4464// ----------------------------------------------------------------------------
4465// first = list of spectrum numbers
4466// second = integer
4467// result = the multiple of the first list by the second factor
4468// ----------------------------------------------------------------------------
4469
4471{
4472 semicState state;
4473
4474 // -----------------
4475 // check arguments
4476 // -----------------
4477
4478 lists l = (lists)first->Data( );
4479 int k = (int)(long)second->Data( );
4480
4481 if( (state=list_is_spectrum( l ))!=semicOK )
4482 {
4483 WerrorS( "first argument is not a spectrum" );
4484 list_error( state );
4485 }
4486 else if( k < 0 )
4487 {
4488 WerrorS( "second argument should be positive" );
4489 state = semicMulNegative;
4490 }
4491 else
4492 {
4494 spectrum product( k*s );
4495
4496 result->rtyp = LIST_CMD;
4497 result->data = (char*)getList(product);
4498 }
4499
4500 return (state!=semicOK);
4501}
4502
4503// ----------------------------------------------------------------------------
4504// this procedure is called from the interpreter
4505// ----------------------------------------------------------------------------
4506// first = list of spectrum numbers
4507// second = list of spectrum numbers
4508// result = semicontinuity index
4509// ----------------------------------------------------------------------------
4510
4512{
4513 semicState state;
4514 BOOLEAN qh=(((int)(long)w->Data())==1);
4515
4516 // -----------------
4517 // check arguments
4518 // -----------------
4519
4520 lists l1 = (lists)u->Data( );
4521 lists l2 = (lists)v->Data( );
4522
4523 if( (state=list_is_spectrum( l1 ))!=semicOK )
4524 {
4525 WerrorS( "first argument is not a spectrum" );
4526 list_error( state );
4527 }
4528 else if( (state=list_is_spectrum( l2 ))!=semicOK )
4529 {
4530 WerrorS( "second argument is not a spectrum" );
4531 list_error( state );
4532 }
4533 else
4534 {
4535 spectrum s1= spectrumFromList( l1 );
4536 spectrum s2= spectrumFromList( l2 );
4537
4538 res->rtyp = INT_CMD;
4539 if (qh)
4540 res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4541 else
4542 res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4543 }
4544
4545 // -----------------
4546 // check status
4547 // -----------------
4548
4549 return (state!=semicOK);
4550}
4552{
4553 sleftv tmp;
4554 tmp.Init();
4555 tmp.rtyp=INT_CMD;
4556 /* tmp.data = (void *)0; -- done by Init */
4557
4558 return semicProc3(res,u,v,&tmp);
4559}
4560
4561#endif
4562
4564{
4565 res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4566 return FALSE;
4567}
4568
4570{
4571 if ( !(rField_is_long_R(currRing)) )
4572 {
4573 WerrorS("Ground field not implemented!");
4574 return TRUE;
4575 }
4576
4577 simplex * LP;
4578 matrix m;
4579
4580 leftv v= args;
4581 if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4582 return TRUE;
4583 else
4584 m= (matrix)(v->CopyD());
4585
4586 LP = new simplex(MATROWS(m),MATCOLS(m));
4587 LP->mapFromMatrix(m);
4588
4589 v= v->next;
4590 if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4591 return TRUE;
4592 else
4593 LP->m= (int)(long)(v->Data());
4594
4595 v= v->next;
4596 if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4597 return TRUE;
4598 else
4599 LP->n= (int)(long)(v->Data());
4600
4601 v= v->next;
4602 if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4603 return TRUE;
4604 else
4605 LP->m1= (int)(long)(v->Data());
4606
4607 v= v->next;
4608 if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4609 return TRUE;
4610 else
4611 LP->m2= (int)(long)(v->Data());
4612
4613 v= v->next;
4614 if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4615 return TRUE;
4616 else
4617 LP->m3= (int)(long)(v->Data());
4618
4619#ifdef mprDEBUG_PROT
4620 Print("m (constraints) %d\n",LP->m);
4621 Print("n (columns) %d\n",LP->n);
4622 Print("m1 (<=) %d\n",LP->m1);
4623 Print("m2 (>=) %d\n",LP->m2);
4624 Print("m3 (==) %d\n",LP->m3);
4625#endif
4626
4627 LP->compute();
4628
4629 lists lres= (lists)omAlloc( sizeof(slists) );
4630 lres->Init( 6 );
4631
4632 lres->m[0].rtyp= MATRIX_CMD; // output matrix
4633 lres->m[0].data=(void*)LP->mapToMatrix(m);
4634
4635 lres->m[1].rtyp= INT_CMD; // found a solution?
4636 lres->m[1].data=(void*)(long)LP->icase;
4637
4638 lres->m[2].rtyp= INTVEC_CMD;
4639 lres->m[2].data=(void*)LP->posvToIV();
4640
4641 lres->m[3].rtyp= INTVEC_CMD;
4642 lres->m[3].data=(void*)LP->zrovToIV();
4643
4644 lres->m[4].rtyp= INT_CMD;
4645 lres->m[4].data=(void*)(long)LP->m;
4646
4647 lres->m[5].rtyp= INT_CMD;
4648 lres->m[5].data=(void*)(long)LP->n;
4649
4650 res->data= (void*)lres;
4651
4652 return FALSE;
4653}
4654
4656{
4657 ideal gls = (ideal)(arg1->Data());
4658 int imtype= (int)(long)arg2->Data();
4659
4660 uResultant::resMatType mtype= determineMType( imtype );
4661
4662 // check input ideal ( = polynomial system )
4663 if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4664 {
4665 return TRUE;
4666 }
4667
4668 uResultant *resMat= new uResultant( gls, mtype, false );
4669 if (resMat!=NULL)
4670 {
4671 res->rtyp = MODUL_CMD;
4672 res->data= (void*)resMat->accessResMat()->getMatrix();
4673 if (!errorreported) delete resMat;
4674 }
4675 return errorreported;
4676}
4677
4679{
4680 poly gls;
4681 gls= (poly)(arg1->Data());
4682 int howclean= (int)(long)arg3->Data();
4683
4684 if ( gls == NULL || pIsConstant( gls ) )
4685 {
4686 WerrorS("Input polynomial is constant!");
4687 return TRUE;
4688 }
4689
4691 {
4692 int* r=Zp_roots(gls, currRing);
4693 lists rlist;
4694 rlist= (lists)omAlloc( sizeof(slists) );
4695 rlist->Init( r[0] );
4696 for(int i=r[0];i>0;i--)
4697 {
4698 rlist->m[i-1].data=n_Init(r[i],currRing->cf);
4699 rlist->m[i-1].rtyp=NUMBER_CMD;
4700 }
4701 omFree(r);
4702 res->data=rlist;
4703 res->rtyp= LIST_CMD;
4704 return FALSE;
4705 }
4706 if ( !(rField_is_R(currRing) ||
4710 {
4711 WerrorS("Ground field not implemented!");
4712 return TRUE;
4713 }
4714
4717 {
4718 unsigned long int ii = (unsigned long int)arg2->Data();
4719 setGMPFloatDigits( ii, ii );
4720 }
4721
4722 int ldummy;
4723 int deg= currRing->pLDeg( gls, &ldummy, currRing );
4724 int i,vpos=0;
4725 poly piter;
4726 lists elist;
4727
4728 elist= (lists)omAlloc( sizeof(slists) );
4729 elist->Init( 0 );
4730
4731 if ( rVar(currRing) > 1 )
4732 {
4733 piter= gls;
4734 for ( i= 1; i <= rVar(currRing); i++ )
4735 if ( pGetExp( piter, i ) )
4736 {
4737 vpos= i;
4738 break;
4739 }
4740 while ( piter )
4741 {
4742 for ( i= 1; i <= rVar(currRing); i++ )
4743 if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4744 {
4745 WerrorS("The input polynomial must be univariate!");
4746 return TRUE;
4747 }
4748 pIter( piter );
4749 }
4750 }
4751
4752 rootContainer * roots= new rootContainer();
4753 number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4754 piter= gls;
4755 for ( i= deg; i >= 0; i-- )
4756 {
4757 if ( piter && pTotaldegree(piter) == i )
4758 {
4759 pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4760 //nPrint( pcoeffs[i] );PrintS(" ");
4761 pIter( piter );
4762 }
4763 else
4764 {
4765 pcoeffs[i]= nInit(0);
4766 }
4767 }
4768
4769#ifdef mprDEBUG_PROT
4770 for (i=deg; i >= 0; i--)
4771 {
4772 nPrint( pcoeffs[i] );PrintS(" ");
4773 }
4774 PrintLn();
4775#endif
4776
4777 roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4778 roots->solver( howclean );
4779
4780 int elem= roots->getAnzRoots();
4781 char *dummy;
4782 int j;
4783
4784 lists rlist;
4785 rlist= (lists)omAlloc( sizeof(slists) );
4786 rlist->Init( elem );
4787
4789 {
4790 for ( j= 0; j < elem; j++ )
4791 {
4792 rlist->m[j].rtyp=NUMBER_CMD;
4793 rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4794 //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4795 }
4796 }
4797 else
4798 {
4799 for ( j= 0; j < elem; j++ )
4800 {
4801 dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4802 rlist->m[j].rtyp=STRING_CMD;
4803 rlist->m[j].data=(void *)dummy;
4804 }
4805 }
4806
4807 elist->Clean();
4808 //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4809
4810 // this is (via fillContainer) the same data as in root
4811 //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4812 //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4813
4814 delete roots;
4815
4816 res->data= (void*)rlist;
4817
4818 return FALSE;
4819}
4820
4822{
4823 int i;
4824 ideal p,w;
4825 p= (ideal)arg1->Data();
4826 w= (ideal)arg2->Data();
4827
4828 // w[0] = f(p^0)
4829 // w[1] = f(p^1)
4830 // ...
4831 // p can be a vector of numbers (multivariate polynom)
4832 // or one number (univariate polynom)
4833 // tdg = deg(f)
4834
4835 int n= IDELEMS( p );
4836 int m= IDELEMS( w );
4837 int tdg= (int)(long)arg3->Data();
4838
4839 res->data= (void*)NULL;
4840
4841 // check the input
4842 if ( tdg < 1 )
4843 {
4844 WerrorS("Last input parameter must be > 0!");
4845 return TRUE;
4846 }
4847 if ( n != rVar(currRing) )
4848 {
4849 Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4850 return TRUE;
4851 }
4852 if ( m != (int)pow((double)tdg+1,(double)n) )
4853 {
4854 Werror("Size of second input ideal must be equal to %d!",
4855 (int)pow((double)tdg+1,(double)n));
4856 return TRUE;
4857 }
4858 if ( !(rField_is_Q(currRing) /* ||
4859 rField_is_R() || rField_is_long_R() ||
4860 rField_is_long_C()*/ ) )
4861 {
4862 WerrorS("Ground field not implemented!");
4863 return TRUE;
4864 }
4865
4866 number tmp;
4867 number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4868 for ( i= 0; i < n; i++ )
4869 {
4870 pevpoint[i]=nInit(0);
4871 if ( (p->m)[i] )
4872 {
4873 tmp = pGetCoeff( (p->m)[i] );
4874 if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4875 {
4876 omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4877 WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4878 return TRUE;
4879 }
4880 } else tmp= NULL;
4881 if ( !nIsZero(tmp) )
4882 {
4883 if ( !pIsConstant((p->m)[i]))
4884 {
4885 omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4886 WerrorS("Elements of first input ideal must be numbers!");
4887 return TRUE;
4888 }
4889 pevpoint[i]= nCopy( tmp );
4890 }
4891 }
4892
4893 number *wresults= (number *)omAlloc( m * sizeof( number ) );
4894 for ( i= 0; i < m; i++ )
4895 {
4896 wresults[i]= nInit(0);
4897 if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4898 {
4899 if ( !pIsConstant((w->m)[i]))
4900 {
4901 omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4902 omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4903 WerrorS("Elements of second input ideal must be numbers!");
4904 return TRUE;
4905 }
4906 wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4907 }
4908 }
4909
4910 vandermonde vm( m, n, tdg, pevpoint, FALSE );
4911 number *ncpoly= vm.interpolateDense( wresults );
4912 // do not free ncpoly[]!!
4913 poly rpoly= vm.numvec2poly( ncpoly );
4914
4915 omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4916 omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4917
4918 res->data= (void*)rpoly;
4919 return FALSE;
4920}
4921
4923{
4924 leftv v= args;
4925
4926 ideal gls;
4927 int imtype;
4928 int howclean;
4929
4930 // get ideal
4931 if ( v->Typ() != IDEAL_CMD )
4932 return TRUE;
4933 else gls= (ideal)(v->Data());
4934 v= v->next;
4935
4936 // get resultant matrix type to use (0,1)
4937 if ( v->Typ() != INT_CMD )
4938 return TRUE;
4939 else imtype= (int)(long)v->Data();
4940 v= v->next;
4941
4942 if (imtype==0)
4943 {
4944 ideal test_id=idInit(1,1);
4945 int j;
4946 for(j=IDELEMS(gls)-1;j>=0;j--)
4947 {
4948 if (gls->m[j]!=NULL)
4949 {
4950 test_id->m[0]=gls->m[j];
4951 intvec *dummy_w=id_QHomWeight(test_id, currRing);
4952 if (dummy_w!=NULL)
4953 {
4954 WerrorS("Newton polytope not of expected dimension");
4955 delete dummy_w;
4956 return TRUE;
4957 }
4958 }
4959 }
4960 }
4961
4962 // get and set precision in digits ( > 0 )
4963 if ( v->Typ() != INT_CMD )
4964 return TRUE;
4965 else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4967 {
4968 unsigned long int ii=(unsigned long int)v->Data();
4969 setGMPFloatDigits( ii, ii );
4970 }
4971 v= v->next;
4972
4973 // get interpolation steps (0,1,2)
4974 if ( v->Typ() != INT_CMD )
4975 return TRUE;
4976 else howclean= (int)(long)v->Data();
4977
4978 uResultant::resMatType mtype= determineMType( imtype );
4979 int i,count;
4980 lists listofroots= NULL;
4981 number smv= NULL;
4982 BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4983
4984 //emptylist= (lists)omAlloc( sizeof(slists) );
4985 //emptylist->Init( 0 );
4986
4987 //res->rtyp = LIST_CMD;
4988 //res->data= (void *)emptylist;
4989
4990 // check input ideal ( = polynomial system )
4991 if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4992 {
4993 return TRUE;
4994 }
4995
4996 uResultant * ures;
4997 rootContainer ** iproots;
4998 rootContainer ** muiproots;
4999 rootArranger * arranger;
5000
5001 // main task 1: setup of resultant matrix
5002 ures= new uResultant( gls, mtype );
5003 if ( ures->accessResMat()->initState() != resMatrixBase::ready )
5004 {
5005 WerrorS("Error occurred during matrix setup!");
5006 return TRUE;
5007 }
5008
5009 // if dense resultant, check if minor nonsingular
5010 if ( mtype == uResultant::denseResMat )
5011 {
5012 smv= ures->accessResMat()->getSubDet();
5013#ifdef mprDEBUG_PROT
5014 PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
5015#endif
5016 if ( nIsZero(smv) )
5017 {
5018 WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
5019 return TRUE;
5020 }
5021 }
5022
5023 // main task 2: Interpolate specialized resultant polynomials
5024 if ( interpolate_det )
5025 iproots= ures->interpolateDenseSP( false, smv );
5026 else
5027 iproots= ures->specializeInU( false, smv );
5028
5029 // main task 3: Interpolate specialized resultant polynomials
5030 if ( interpolate_det )
5031 muiproots= ures->interpolateDenseSP( true, smv );
5032 else
5033 muiproots= ures->specializeInU( true, smv );
5034
5035#ifdef mprDEBUG_PROT
5036 int c= iproots[0]->getAnzElems();
5037 for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
5038 c= muiproots[0]->getAnzElems();
5039 for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
5040#endif
5041
5042 // main task 4: Compute roots of specialized polys and match them up
5043 arranger= new rootArranger( iproots, muiproots, howclean );
5044 arranger->solve_all();
5045
5046 // get list of roots
5047 if ( arranger->success() )
5048 {
5049 arranger->arrange();
5050 listofroots= listOfRoots(arranger, gmp_output_digits );
5051 }
5052 else
5053 {
5054 WerrorS("Solver was unable to find any roots!");
5055 return TRUE;
5056 }
5057
5058 // free everything
5059 count= iproots[0]->getAnzElems();
5060 for (i=0; i < count; i++) delete iproots[i];
5061 omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
5062 count= muiproots[0]->getAnzElems();
5063 for (i=0; i < count; i++) delete muiproots[i];
5064 omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
5065
5066 delete ures;
5067 delete arranger;
5068 if (smv!=NULL) nDelete( &smv );
5069
5070 res->data= (void *)listofroots;
5071
5072 //emptylist->Clean();
5073 // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
5074
5075 return FALSE;
5076}
5077
5078// from mpr_numeric.cc
5079lists listOfRoots( rootArranger* self, const unsigned int oprec )
5080{
5081 int i,j;
5082 int count= self->roots[0]->getAnzRoots(); // number of roots
5083 int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
5084
5085 lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
5086
5087 if ( self->found_roots )
5088 {
5089 listofroots->Init( count );
5090
5091 for (i=0; i < count; i++)
5092 {
5093 lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
5094 onepoint->Init(elem);
5095 for ( j= 0; j < elem; j++ )
5096 {
5097 if ( !rField_is_long_C(currRing) )
5098 {
5099 onepoint->m[j].rtyp=STRING_CMD;
5100 onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
5101 }
5102 else
5103 {
5104 onepoint->m[j].rtyp=NUMBER_CMD;
5105 onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5106 }
5107 onepoint->m[j].next= NULL;
5108 onepoint->m[j].name= NULL;
5109 }
5110 listofroots->m[i].rtyp=LIST_CMD;
5111 listofroots->m[i].data=(void *)onepoint;
5112 listofroots->m[j].next= NULL;
5113 listofroots->m[j].name= NULL;
5114 }
5115
5116 }
5117 else
5118 {
5119 listofroots->Init( 0 );
5120 }
5121
5122 return listofroots;
5123}
5124
5125// from ring.cc
5127{
5128 ring rg = NULL;
5129 if (h!=NULL)
5130 {
5131// Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5132 rg = IDRING(h);
5133 if (rg==NULL) return; //id <>NULL, ring==NULL
5134 omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5135 if (IDID(h)) // OB: ????
5137 rTest(rg);
5138 }
5139 else return;
5140
5141 // clean up history
5142 if (currRing!=NULL)
5143 {
5145 {
5147 }
5148
5149 if (rg!=currRing)/*&&(currRing!=NULL)*/
5150 {
5151 if (rg->cf!=currRing->cf)
5152 {
5155 {
5156 if (TEST_V_ALLWARN)
5157 Warn("deleting denom_list for ring change to %s",IDID(h));
5158 do
5159 {
5160 n_Delete(&(dd->n),currRing->cf);
5161 dd=dd->next;
5164 } while(DENOMINATOR_LIST!=NULL);
5165 }
5166 }
5167 }
5168 }
5169
5170 // test for valid "currRing":
5171 if ((rg!=NULL) && (rg->idroot==NULL))
5172 {
5173 ring old=rg;
5174 rg=rAssure_HasComp(rg);
5175 if (old!=rg)
5176 {
5177 rKill(old);
5178 IDRING(h)=rg;
5179 }
5180 }
5181 /*------------ change the global ring -----------------------*/
5182 rChangeCurrRing(rg);
5183 currRingHdl = h;
5184}
5185
5187{
5188 // change some bad orderings/combination into better ones
5189 leftv h=ord;
5190 while(h!=NULL)
5191 {
5192 BOOLEAN change=FALSE;
5193 intvec *iv = (intvec *)(h->data);
5194 // ws(-i) -> wp(i)
5195 if ((*iv)[1]==ringorder_ws)
5196 {
5197 BOOLEAN neg=TRUE;
5198 for(int i=2;i<iv->length();i++)
5199 if((*iv)[i]>=0) { neg=FALSE; break; }
5200 if (neg)
5201 {
5202 (*iv)[1]=ringorder_wp;
5203 for(int i=2;i<iv->length();i++)
5204 (*iv)[i]= - (*iv)[i];
5205 change=TRUE;
5206 }
5207 }
5208 // Ws(-i) -> Wp(i)
5209 if ((*iv)[1]==ringorder_Ws)
5210 {
5211 BOOLEAN neg=TRUE;
5212 for(int i=2;i<iv->length();i++)
5213 if((*iv)[i]>=0) { neg=FALSE; break; }
5214 if (neg)
5215 {
5216 (*iv)[1]=ringorder_Wp;
5217 for(int i=2;i<iv->length();i++)
5218 (*iv)[i]= -(*iv)[i];
5219 change=TRUE;
5220 }
5221 }
5222 // wp(1) -> dp
5223 if ((*iv)[1]==ringorder_wp)
5224 {
5225 BOOLEAN all_one=TRUE;
5226 for(int i=2;i<iv->length();i++)
5227 if((*iv)[i]!=1) { all_one=FALSE; break; }
5228 if (all_one)
5229 {
5230 intvec *iv2=new intvec(3);
5231 (*iv2)[0]=1;
5232 (*iv2)[1]=ringorder_dp;
5233 (*iv2)[2]=iv->length()-2;
5234 delete iv;
5235 iv=iv2;
5236 h->data=iv2;
5237 change=TRUE;
5238 }
5239 }
5240 // Wp(1) -> Dp
5241 if ((*iv)[1]==ringorder_Wp)
5242 {
5243 BOOLEAN all_one=TRUE;
5244 for(int i=2;i<iv->length();i++)
5245 if((*iv)[i]!=1) { all_one=FALSE; break; }
5246 if (all_one)
5247 {
5248 intvec *iv2=new intvec(3);
5249 (*iv2)[0]=1;
5250 (*iv2)[1]=ringorder_Dp;
5251 (*iv2)[2]=iv->length()-2;
5252 delete iv;
5253 iv=iv2;
5254 h->data=iv2;
5255 change=TRUE;
5256 }
5257 }
5258 // dp(1)/Dp(1)/rp(1) -> lp(1)
5259 if (((*iv)[1]==ringorder_dp)
5260 || ((*iv)[1]==ringorder_Dp)
5261 || ((*iv)[1]==ringorder_rp))
5262 {
5263 if (iv->length()==3)
5264 {
5265 if ((*iv)[2]==1)
5266 {
5267 if(h->next!=NULL)
5268 {
5269 intvec *iv2 = (intvec *)(h->next->data);
5270 if ((*iv2)[1]==ringorder_lp)
5271 {
5272 (*iv)[1]=ringorder_lp;
5273 change=TRUE;
5274 }
5275 }
5276 }
5277 }
5278 }
5279 // lp(i),lp(j) -> lp(i+j)
5280 if(((*iv)[1]==ringorder_lp)
5281 && (h->next!=NULL))
5282 {
5283 intvec *iv2 = (intvec *)(h->next->data);
5284 if ((*iv2)[1]==ringorder_lp)
5285 {
5286 leftv hh=h->next;
5287 h->next=hh->next;
5288 hh->next=NULL;
5289 if ((*iv2)[0]==1)
5290 (*iv)[2] += 1; // last block unspecified, at least 1
5291 else
5292 (*iv)[2] += (*iv2)[2];
5293 hh->CleanUp();
5295 change=TRUE;
5296 }
5297 }
5298 // -------------------
5299 if (!change) h=h->next;
5300 }
5301 return ord;
5302}
5303
5304
5306{
5307 int last = 0, o=0, n = 1, i=0, typ = 1, j;
5308 ord=rOptimizeOrdAsSleftv(ord);
5309 sleftv *sl = ord;
5310
5311 // determine nBlocks
5312 while (sl!=NULL)
5313 {
5314 intvec *iv = (intvec *)(sl->data);
5315 if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
5316 i++;
5317 else if ((*iv)[1]==ringorder_L)
5318 {
5319 R->wanted_maxExp=(*iv)[2]*2+1;
5320 n--;
5321 }
5322 else if (((*iv)[1]!=ringorder_a)
5323 && ((*iv)[1]!=ringorder_a64)
5324 && ((*iv)[1]!=ringorder_am))
5325 o++;
5326 n++;
5327 sl=sl->next;
5328 }
5329 // check whether at least one real ordering
5330 if (o==0)
5331 {
5332 WerrorS("invalid combination of orderings");
5333 return TRUE;
5334 }
5335 // if no c/C ordering is given, increment n
5336 if (i==0) n++;
5337 else if (i != 1)
5338 {
5339 // throw error if more than one is given
5340 WerrorS("more than one ordering c/C specified");
5341 return TRUE;
5342 }
5343
5344 // initialize fields of R
5345 R->order=(rRingOrder_t *)omAlloc0(n*sizeof(rRingOrder_t));
5346 R->block0=(int *)omAlloc0(n*sizeof(int));
5347 R->block1=(int *)omAlloc0(n*sizeof(int));
5348 R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
5349
5350 int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
5351
5352 // init order, so that rBlocks works correctly
5353 for (j=0; j < n-1; j++)
5354 R->order[j] = ringorder_unspec;
5355 // set last _C order, if no c/C order was given
5356 if (i == 0) R->order[n-2] = ringorder_C;
5357
5358 /* init orders */
5359 sl=ord;
5360 n=-1;
5361 while (sl!=NULL)
5362 {
5363 intvec *iv;
5364 iv = (intvec *)(sl->data);
5365 if ((*iv)[1]!=ringorder_L)
5366 {
5367 n++;
5368
5369 /* the format of an ordering:
5370 * iv[0]: factor
5371 * iv[1]: ordering
5372 * iv[2..end]: weights
5373 */
5374 R->order[n] = (rRingOrder_t)((*iv)[1]);
5375 typ=1;
5376 switch ((*iv)[1])
5377 {
5378 case ringorder_ws:
5379 case ringorder_Ws:
5380 typ=-1; // and continue
5381 case ringorder_wp:
5382 case ringorder_Wp:
5383 R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
5384 R->block0[n] = last+1;
5385 for (i=2; i<iv->length(); i++)
5386 {
5387 R->wvhdl[n][i-2] = (*iv)[i];
5388 last++;
5389 if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5390 }
5391 R->block1[n] = si_min(last,R->N);
5392 break;
5393 case ringorder_ls:
5394 case ringorder_ds:
5395 case ringorder_Ds:
5396 case ringorder_rs:
5397 typ=-1; // and continue
5398 case ringorder_lp:
5399 case ringorder_dp:
5400 case ringorder_Dp:
5401 case ringorder_rp:
5402 R->block0[n] = last+1;
5403 if (iv->length() == 3) last+=(*iv)[2];
5404 else last += (*iv)[0];
5405 R->block1[n] = si_min(last,R->N);
5406 if (rCheckIV(iv)) return TRUE;
5407 for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
5408 {
5409 if (weights[i]==0) weights[i]=typ;
5410 }
5411 break;
5412
5413 case ringorder_s: // no 'rank' params!
5414 {
5415
5416 if(iv->length() > 3)
5417 return TRUE;
5418
5419 if(iv->length() == 3)
5420 {
5421 const int s = (*iv)[2];
5422 R->block0[n] = s;
5423 R->block1[n] = s;
5424 }
5425 break;
5426 }
5427 case ringorder_IS:
5428 {
5429 if(iv->length() != 3) return TRUE;
5430
5431 const int s = (*iv)[2];
5432
5433 if( 1 < s || s < -1 ) return TRUE;
5434
5435 R->block0[n] = s;
5436 R->block1[n] = s;
5437 break;
5438 }
5439 case ringorder_S:
5440 case ringorder_c:
5441 case ringorder_C:
5442 {
5443 if (rCheckIV(iv)) return TRUE;
5444 break;
5445 }
5446 case ringorder_aa:
5447 case ringorder_a:
5448 {
5449 R->block0[n] = last+1;
5450 R->block1[n] = si_min(last+iv->length()-2 , R->N);
5451 R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
5452 for (i=2; i<iv->length(); i++)
5453 {
5454 R->wvhdl[n][i-2]=(*iv)[i];
5455 last++;
5456 if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5457 }
5458 last=R->block0[n]-1;
5459 break;
5460 }
5461 case ringorder_am:
5462 {
5463 R->block0[n] = last+1;
5464 R->block1[n] = si_min(last+iv->length()-2 , R->N);
5465 R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
5466 if (R->block1[n]- R->block0[n]+2>=iv->length())
5467 WarnS("missing module weights");
5468 for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
5469 {
5470 R->wvhdl[n][i-2]=(*iv)[i];
5471 last++;
5472 if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5473 }
5474 R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
5475 for (; i<iv->length(); i++)
5476 {
5477 R->wvhdl[n][i-1]=(*iv)[i];
5478 }
5479 last=R->block0[n]-1;
5480 break;
5481 }
5482 case ringorder_a64:
5483 {
5484 R->block0[n] = last+1;
5485 R->block1[n] = si_min(last+iv->length()-2 , R->N);
5486 R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
5487 int64 *w=(int64 *)R->wvhdl[n];
5488 for (i=2; i<iv->length(); i++)
5489 {
5490 w[i-2]=(*iv)[i];
5491 last++;
5492 if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5493 }
5494 last=R->block0[n]-1;
5495 break;
5496 }
5497 case ringorder_M:
5498 {
5499 int Mtyp=rTypeOfMatrixOrder(iv);
5500 if (Mtyp==0) return TRUE;
5501 if (Mtyp==-1) typ = -1;
5502
5503 R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
5504 for (i=2; i<iv->length();i++)
5505 R->wvhdl[n][i-2]=(*iv)[i];
5506
5507 R->block0[n] = last+1;
5508 last += (int)sqrt((double)(iv->length()-2));
5509 R->block1[n] = si_min(last,R->N);
5510 for(i=R->block1[n];i>=R->block0[n];i--)
5511 {
5512 if (weights[i]==0) weights[i]=typ;
5513 }
5514 break;
5515 }
5516
5517 case ringorder_no:
5518 R->order[n] = ringorder_unspec;
5519 return TRUE;
5520
5521 default:
5522 Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
5523 R->order[n] = ringorder_unspec;
5524 return TRUE;
5525 }
5526 }
5527 if (last>R->N)
5528 {
5529 Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
5530 R->N,last);
5531 return TRUE;
5532 }
5533 sl=sl->next;
5534 }
5535 // find OrdSgn:
5536 R->OrdSgn = 1;
5537 for(i=1;i<=R->N;i++)
5538 { if (weights[i]<0) { R->OrdSgn=-1;break; }}
5539 omFree(weights);
5540
5541 // check for complete coverage
5542 while ( n >= 0 && (
5543 (R->order[n]==ringorder_c)
5544 || (R->order[n]==ringorder_C)
5545 || (R->order[n]==ringorder_s)
5546 || (R->order[n]==ringorder_S)
5547 || (R->order[n]==ringorder_IS)
5548 )) n--;
5549
5550 assume( n >= 0 );
5551
5552 if (R->block1[n] != R->N)
5553 {
5554 if (((R->order[n]==ringorder_dp) ||
5555 (R->order[n]==ringorder_ds) ||
5556 (R->order[n]==ringorder_Dp) ||
5557 (R->order[n]==ringorder_Ds) ||
5558 (R->order[n]==ringorder_rp) ||
5559 (R->order[n]==ringorder_rs) ||
5560 (R->order[n]==ringorder_lp) ||
5561 (R->order[n]==ringorder_ls))
5562 &&
5563 R->block0[n] <= R->N)
5564 {
5565 R->block1[n] = R->N;
5566 }
5567 else
5568 {
5569 Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5570 R->N,R->block1[n]);
5571 return TRUE;
5572 }
5573 }
5574 return FALSE;
5575}
5576
5578{
5579
5580 while(sl!=NULL)
5581 {
5582 if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5583 {
5584 *p = omStrDup(sl->Name());
5585 }
5586 else if (sl->name!=NULL)
5587 {
5588 *p = (char*)sl->name;
5589 sl->name=NULL;
5590 }
5591 else if (sl->rtyp==POLY_CMD)
5592 {
5593 sleftv s_sl;
5594 iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5595 if (s_sl.name != NULL)
5596 {
5597 *p = (char*)s_sl.name; s_sl.name=NULL;
5598 }
5599 else
5600 *p = NULL;
5601 sl->next = s_sl.next;
5602 s_sl.next = NULL;
5603 s_sl.CleanUp();
5604 if (*p == NULL) return TRUE;
5605 }
5606 else return TRUE;
5607 p++;
5608 sl=sl->next;
5609 }
5610 return FALSE;
5611}
5612
5613const short MAX_SHORT = 32767; // (1 << (sizeof(short)*8)) - 1;
5614
5615////////////////////
5616//
5617// rInit itself:
5618//
5619// INPUT: pn: ch & parameter (names), rv: variable (names)
5620// ord: ordering (all !=NULL)
5621// RETURN: currRingHdl on success
5622// NULL on error
5623// NOTE: * makes new ring to current ring, on success
5624// * considers input sleftv's as read-only
5625ring rInit(leftv pn, leftv rv, leftv ord)
5626{
5627 int float_len=0;
5628 int float_len2=0;
5629 ring R = NULL;
5630 //BOOLEAN ffChar=FALSE;
5631
5632 /* ch -------------------------------------------------------*/
5633 // get ch of ground field
5634
5635 // allocated ring
5636 R = (ring) omAlloc0Bin(sip_sring_bin);
5637
5638 coeffs cf = NULL;
5639
5640 assume( pn != NULL );
5641 const int P = pn->listLength();
5642
5643 if (pn->Typ()==CRING_CMD)
5644 {
5645 cf=(coeffs)pn->CopyD();
5646 leftv pnn=pn;
5647 if(P>1) /*parameter*/
5648 {
5649 pnn = pnn->next;
5650 const int pars = pnn->listLength();
5651 assume( pars > 0 );
5652 char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5653
5654 if (rSleftvList2StringArray(pnn, names))
5655 {
5656 WerrorS("parameter expected");
5657 goto rInitError;
5658 }
5659
5660 TransExtInfo extParam;
5661
5662 extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5663 for(int i=pars-1; i>=0;i--)
5664 {
5665 omFree(names[i]);
5666 }
5667 omFree(names);
5668
5669 cf = nInitChar(n_transExt, &extParam);
5670 }
5671 assume( cf != NULL );
5672 }
5673 else if (pn->Typ()==INT_CMD)
5674 {
5675 int ch = (int)(long)pn->Data();
5676 leftv pnn=pn;
5677
5678 /* parameter? -------------------------------------------------------*/
5679 pnn = pnn->next;
5680
5681 if (pnn == NULL) // no params!?
5682 {
5683 if (ch!=0)
5684 {
5685 int ch2=IsPrime(ch);
5686 if ((ch<2)||(ch!=ch2))
5687 {
5688 Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5689 ch=32003;
5690 }
5691 #ifndef TEST_ZN_AS_ZP
5692 cf = nInitChar(n_Zp, (void*)(long)ch);
5693 #else
5694 mpz_t modBase;
5695 mpz_init_set_ui(modBase, (long)ch);
5696 ZnmInfo info;
5697 info.base= modBase;
5698 info.exp= 1;
5699 cf=nInitChar(n_Zn,(void*) &info);
5700 cf->is_field=1;
5701 cf->is_domain=1;
5702 cf->has_simple_Inverse=1;
5703 #endif
5704 }
5705 else
5706 cf = nInitChar(n_Q, (void*)(long)ch);
5707 }
5708 else
5709 {
5710 const int pars = pnn->listLength();
5711
5712 assume( pars > 0 );
5713
5714 // predefined finite field: (p^k, a)
5715 if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5716 {
5717 GFInfo param;
5718
5719 param.GFChar = ch;
5720 param.GFDegree = 1;
5721 param.GFPar_name = pnn->name;
5722
5723 cf = nInitChar(n_GF, &param);
5724 }
5725 else // (0/p, a, b, ..., z)
5726 {
5727 if ((ch!=0) && (ch!=IsPrime(ch)))
5728 {
5729 WerrorS("too many parameters");
5730 goto rInitError;
5731 }
5732
5733 char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5734
5735 if (rSleftvList2StringArray(pnn, names))
5736 {
5737 WerrorS("parameter expected");
5738 goto rInitError;
5739 }
5740
5741 TransExtInfo extParam;
5742
5743 extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5744 for(int i=pars-1; i>=0;i--)
5745 {
5746 omFree(names[i]);
5747 }
5748 omFree(names);
5749
5750 cf = nInitChar(n_transExt, &extParam);
5751 }
5752 }
5753
5754 //if (cf==NULL) ->Error: Invalid ground field specification
5755 }
5756 else if ((pn->name != NULL)
5757 && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5758 {
5759 leftv pnn=pn->next;
5760 BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5761 if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5762 {
5763 float_len=(int)(long)pnn->Data();
5764 float_len2=float_len;
5765 pnn=pnn->next;
5766 if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5767 {
5768 float_len2=(int)(long)pnn->Data();
5769 pnn=pnn->next;
5770 }
5771 }
5772
5773 if (!complex_flag)
5774 complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
5775 if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5776 cf=nInitChar(n_R, NULL);
5777 else // longR or longC?
5778 {
5779 LongComplexInfo param;
5780
5781 param.float_len = si_min (float_len, 32767);
5782 param.float_len2 = si_min (float_len2, 32767);
5783
5784 // set the parameter name
5785 if (complex_flag)
5786 {
5787 if (param.float_len < SHORT_REAL_LENGTH)
5788 {
5791 }
5792 if ((pnn == NULL) || (pnn->name == NULL))
5793 param.par_name=(const char*)"i"; //default to i
5794 else
5795 param.par_name = (const char*)pnn->name;
5796 }
5797
5798 cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5799 }
5800 assume( cf != NULL );
5801 }
5802#ifdef HAVE_RINGS
5803 else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5804 {
5805 // TODO: change to use coeffs_BIGINT!?
5806 mpz_t modBase;
5807 unsigned int modExponent = 1;
5808 mpz_init_set_si(modBase, 0);
5809 if (pn->next!=NULL)
5810 {
5811 leftv pnn=pn;
5812 if (pnn->next->Typ()==INT_CMD)
5813 {
5814 pnn=pnn->next;
5815 mpz_set_ui(modBase, (long) pnn->Data());
5816 if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5817 {
5818 pnn=pnn->next;
5819 modExponent = (long) pnn->Data();
5820 }
5821 while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5822 {
5823 pnn=pnn->next;
5824 mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
5825 }
5826 }
5827 else if (pnn->next->Typ()==BIGINT_CMD)
5828 {
5829 number p=(number)pnn->next->CopyD();
5830 n_MPZ(modBase,p,coeffs_BIGINT);
5832 }
5833 }
5834 else
5836
5837 if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
5838 {
5839 WerrorS("Wrong ground ring specification (module is 1)");
5840 goto rInitError;
5841 }
5842 if (modExponent < 1)
5843 {
5844 WerrorS("Wrong ground ring specification (exponent smaller than 1");
5845 goto rInitError;
5846 }
5847 // module is 0 ---> integers ringtype = 4;
5848 // we have an exponent
5849 if (modExponent > 1 && cf == NULL)
5850 {
5851 if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5852 {
5853 /* this branch should be active for modExponent = 2..32 resp. 2..64,
5854 depending on the size of a long on the respective platform */
5855 //ringtype = 1; // Use Z/2^ch
5856 cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5857 }
5858 else
5859 {
5860 if (mpz_sgn1(modBase)==0)
5861 {
5862 WerrorS("modulus must not be 0 or parameter not allowed");
5863 goto rInitError;
5864 }
5865 //ringtype = 3;
5866 ZnmInfo info;
5867 info.base= modBase;
5868 info.exp= modExponent;
5869 cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5870 }
5871 }
5872 // just a module m > 1
5873 else if (cf == NULL)
5874 {
5875 if (mpz_sgn1(modBase)==0)
5876 {
5877 WerrorS("modulus must not be 0 or parameter not allowed");
5878 goto rInitError;
5879 }
5880 //ringtype = 2;
5881 ZnmInfo info;
5882 info.base= modBase;
5883 info.exp= modExponent;
5884 cf=nInitChar(n_Zn,(void*) &info);
5885 }
5886 assume( cf != NULL );
5887 mpz_clear(modBase);
5888 }
5889#endif
5890 // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5891 else if ((pn->Typ()==RING_CMD) && (P == 1))
5892 {
5893 ring r=(ring)pn->Data();
5894 if (r->qideal==NULL)
5895 {
5896 TransExtInfo extParam;
5897 extParam.r = r;
5898 extParam.r->ref++;
5899 cf = nInitChar(n_transExt, &extParam); // R(a)
5900 }
5901 else if (IDELEMS(r->qideal)==1)
5902 {
5903 AlgExtInfo extParam;
5904 extParam.r=r;
5905 extParam.r->ref++;
5906 cf = nInitChar(n_algExt, &extParam); // R[a]/<minideal>
5907 }
5908 else
5909 {
5910 WerrorS("algebraic extension ring must have one minpoly");
5911 goto rInitError;
5912 }
5913 }
5914 else
5915 {
5916 WerrorS("Wrong or unknown ground field specification");
5917#if 0
5918// debug stuff for unknown cf descriptions:
5919 sleftv* p = pn;
5920 while (p != NULL)
5921 {
5922 Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5923 PrintLn();
5924 p = p->next;
5925 }
5926#endif
5927 goto rInitError;
5928 }
5929
5930 /*every entry in the new ring is initialized to 0*/
5931
5932 /* characteristic -----------------------------------------------*/
5933 /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5934 * 0 1 : Q(a,...) *names FALSE
5935 * 0 -1 : R NULL FALSE 0
5936 * 0 -1 : R NULL FALSE prec. >6
5937 * 0 -1 : C *names FALSE prec. 0..?
5938 * p p : Fp NULL FALSE
5939 * p -p : Fp(a) *names FALSE
5940 * q q : GF(q=p^n) *names TRUE
5941 */
5942 if (cf==NULL)
5943 {
5944 WerrorS("Invalid ground field specification");
5945 goto rInitError;
5946// const int ch=32003;
5947// cf=nInitChar(n_Zp, (void*)(long)ch);
5948 }
5949
5950 assume( R != NULL );
5951
5952 R->cf = cf;
5953
5954 /* names and number of variables-------------------------------------*/
5955 {
5956 int l=rv->listLength();
5957
5958 if (l>MAX_SHORT)
5959 {
5960 Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5961 goto rInitError;
5962 }
5963 R->N = l; /*rv->listLength();*/
5964 }
5965 R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5966 if (rSleftvList2StringArray(rv, R->names))
5967 {
5968 WerrorS("name of ring variable expected");
5969 goto rInitError;
5970 }
5971
5972 /* check names and parameters for conflicts ------------------------- */
5973 rRenameVars(R); // conflicting variables will be renamed
5974 /* ordering -------------------------------------------------------------*/
5975 if (rSleftvOrdering2Ordering(ord, R))
5976 goto rInitError;
5977
5978 // Complete the initialization
5979 if (rComplete(R,1))
5980 goto rInitError;
5981
5982/*#ifdef HAVE_RINGS
5983// currently, coefficients which are ring elements require a global ordering:
5984 if (rField_is_Ring(R) && (R->OrdSgn==-1))
5985 {
5986 WerrorS("global ordering required for these coefficients");
5987 goto rInitError;
5988 }
5989#endif*/
5990
5991 rTest(R);
5992
5993 // try to enter the ring into the name list
5994 // need to clean up sleftv here, before this ring can be set to
5995 // new currRing or currRing can be killed beacuse new ring has
5996 // same name
5997 pn->CleanUp();
5998 rv->CleanUp();
5999 ord->CleanUp();
6000 //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
6001 // goto rInitError;
6002
6003 //memcpy(IDRING(tmp),R,sizeof(*R));
6004 // set current ring
6005 //omFreeBin(R, ip_sring_bin);
6006 //return tmp;
6007 return R;
6008
6009 // error case:
6010 rInitError:
6011 if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
6012 pn->CleanUp();
6013 rv->CleanUp();
6014 ord->CleanUp();
6015 return NULL;
6016}
6017
6018ring rSubring(ring org_ring, sleftv* rv)
6019{
6020 ring R = rCopy0(org_ring);
6021 int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
6022 int n = rBlocks(org_ring), i=0, j;
6023
6024 /* names and number of variables-------------------------------------*/
6025 {
6026 int l=rv->listLength();
6027 if (l>MAX_SHORT)
6028 {
6029 Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
6030 goto rInitError;
6031 }
6032 R->N = l; /*rv->listLength();*/
6033 }
6034 omFree(R->names);
6035 R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
6036 if (rSleftvList2StringArray(rv, R->names))
6037 {
6038 WerrorS("name of ring variable expected");
6039 goto rInitError;
6040 }
6041
6042 /* check names for subring in org_ring ------------------------- */
6043 {
6044 i=0;
6045
6046 for(j=0;j<R->N;j++)
6047 {
6048 for(;i<org_ring->N;i++)
6049 {
6050 if (strcmp(org_ring->names[i],R->names[j])==0)
6051 {
6052 perm[i+1]=j+1;
6053 break;
6054 }
6055 }
6056 if (i>org_ring->N)
6057 {
6058 Werror("variable %d (%s) not in basering",j+1,R->names[j]);
6059 break;
6060 }
6061 }
6062 }
6063 //Print("perm=");
6064 //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
6065 /* ordering -------------------------------------------------------------*/
6066
6067 for(i=0;i<n;i++)
6068 {
6069 int min_var=-1;
6070 int max_var=-1;
6071 for(j=R->block0[i];j<=R->block1[i];j++)
6072 {
6073 if (perm[j]>0)
6074 {
6075 if (min_var==-1) min_var=perm[j];
6076 max_var=perm[j];
6077 }
6078 }
6079 if (min_var!=-1)
6080 {
6081 //Print("block %d: old %d..%d, now:%d..%d\n",
6082 // i,R->block0[i],R->block1[i],min_var,max_var);
6083 R->block0[i]=min_var;
6084 R->block1[i]=max_var;
6085 if (R->wvhdl[i]!=NULL)
6086 {
6087 omFree(R->wvhdl[i]);
6088 R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
6089 for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
6090 {
6091 if (perm[j]>0)
6092 {
6093 R->wvhdl[i][perm[j]-R->block0[i]]=
6094 org_ring->wvhdl[i][j-org_ring->block0[i]];
6095 //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
6096 }
6097 }
6098 }
6099 }
6100 else
6101 {
6102 if(R->block0[i]>0)
6103 {
6104 //Print("skip block %d\n",i);
6105 R->order[i]=ringorder_unspec;
6106 if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
6107 R->wvhdl[i]=NULL;
6108 }
6109 //else Print("keep block %d\n",i);
6110 }
6111 }
6112 i=n-1;
6113 while(i>0)
6114 {
6115 // removed unneded blocks
6116 if(R->order[i-1]==ringorder_unspec)
6117 {
6118 for(j=i;j<=n;j++)
6119 {
6120 R->order[j-1]=R->order[j];
6121 R->block0[j-1]=R->block0[j];
6122 R->block1[j-1]=R->block1[j];
6123 if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
6124 R->wvhdl[j-1]=R->wvhdl[j];
6125 }
6126 R->order[n]=ringorder_unspec;
6127 n--;
6128 }
6129 i--;
6130 }
6131 n=rBlocks(org_ring)-1;
6132 while (R->order[n]==0) n--;
6133 while (R->order[n]==ringorder_unspec) n--;
6134 if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
6135 if (R->block1[n] != R->N)
6136 {
6137 if (((R->order[n]==ringorder_dp) ||
6138 (R->order[n]==ringorder_ds) ||
6139 (R->order[n]==ringorder_Dp) ||
6140 (R->order[n]==ringorder_Ds) ||
6141 (R->order[n]==ringorder_rp) ||
6142 (R->order[n]==ringorder_rs) ||
6143 (R->order[n]==ringorder_lp) ||
6144 (R->order[n]==ringorder_ls))
6145 &&
6146 R->block0[n] <= R->N)
6147 {
6148 R->block1[n] = R->N;
6149 }
6150 else
6151 {
6152 Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
6153 R->N,R->block1[n],n);
6154 return NULL;
6155 }
6156 }
6157 omFree(perm);
6158 // find OrdSgn:
6159 R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
6160 //for(i=1;i<=R->N;i++)
6161 //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
6162 //omFree(weights);
6163 // Complete the initialization
6164 if (rComplete(R,1))
6165 goto rInitError;
6166
6167 rTest(R);
6168
6169 if (rv != NULL) rv->CleanUp();
6170
6171 return R;
6172
6173 // error case:
6174 rInitError:
6175 if (R != NULL) rDelete(R);
6176 if (rv != NULL) rv->CleanUp();
6177 return NULL;
6178}
6179
6180void rKill(ring r)
6181{
6182 if ((r->ref<=0)&&(r->order!=NULL))
6183 {
6184#ifdef RDEBUG
6185 if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6186#endif
6187 int j;
6188 for (j=0;j<myynest;j++)
6189 {
6190 if (iiLocalRing[j]==r)
6191 {
6192 if (j==0) WarnS("killing the basering for level 0");
6194 }
6195 }
6196// any variables depending on r ?
6197 while (r->idroot!=NULL)
6198 {
6199 r->idroot->lev=myynest; // avoid warning about kill global objects
6200 killhdl2(r->idroot,&(r->idroot),r);
6201 }
6202 if (r==currRing)
6203 {
6204 // all dependend stuff is done, clean global vars:
6205 if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6207 {
6209 }
6210 //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6211 //{
6212 // WerrorS("return value depends on local ring variable (export missing ?)");
6213 // iiRETURNEXPR.CleanUp();
6214 //}
6215 currRing=NULL;
6217 }
6218
6219 /* nKillChar(r); will be called from inside of rDelete */
6220 rDelete(r);
6221 return;
6222 }
6223 rDecRefCnt(r);
6224}
6225
6227{
6228 ring r = IDRING(h);
6229 int ref=0;
6230 if (r!=NULL)
6231 {
6232 // avoid, that sLastPrinted is the last reference to the base ring:
6233 // clean up before killing the last "named" refrence:
6235 && (sLastPrinted.data==(void*)r))
6236 {
6238 }
6239 ref=r->ref;
6240 if ((ref<=0)&&(r==currRing))
6241 {
6242 // cleanup DENOMINATOR_LIST
6244 {
6246 if (TEST_V_ALLWARN)
6247 Warn("deleting denom_list for ring change from %s",IDID(h));
6248 do
6249 {
6250 n_Delete(&(dd->n),currRing->cf);
6251 dd=dd->next;
6254 } while(DENOMINATOR_LIST!=NULL);
6255 }
6256 }
6257 rKill(r);
6258 }
6259 if (h==currRingHdl)
6260 {
6261 if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6262 else
6263 {
6265 }
6266 }
6267}
6268
6269static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n)
6270{
6271 idhdl h=root;
6272 while (h!=NULL)
6273 {
6274 if ((IDTYP(h)==RING_CMD)
6275 && (h!=n)
6276 && (IDRING(h)==r)
6277 )
6278 {
6279 return h;
6280 }
6281 h=IDNEXT(h);
6282 }
6283 return NULL;
6284}
6285
6286extern BOOLEAN jjPROC(leftv res, leftv u, leftv v);
6287
6288static void jjINT_S_TO_ID(int n,int *e, leftv res)
6289{
6290 if (n==0) n=1;
6291 ideal l=idInit(n,1);
6292 int i;
6293 poly p;
6294 for(i=rVar(currRing);i>0;i--)
6295 {
6296 if (e[i]>0)
6297 {
6298 n--;
6299 p=pOne();
6300 pSetExp(p,i,1);
6301 pSetm(p);
6302 l->m[n]=p;
6303 if (n==0) break;
6304 }
6305 }
6306 res->data=(char*)l;
6308 omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6309}
6311{
6312 int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6313 int n=pGetVariables((poly)u->Data(),e);
6314 jjINT_S_TO_ID(n,e,res);
6315 return FALSE;
6316}
6317
6319{
6320 int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6321 ideal I=(ideal)u->Data();
6322 int i;
6323 int n=0;
6324 for(i=I->nrows*I->ncols-1;i>=0;i--)
6325 {
6326 int n0=pGetVariables(I->m[i],e);
6327 if (n0>n) n=n0;
6328 }
6329 jjINT_S_TO_ID(n,e,res);
6330 return FALSE;
6331}
6332
6333void paPrint(const char *n,package p)
6334{
6335 Print(" %s (",n);
6336 switch (p->language)
6337 {
6338 case LANG_SINGULAR: PrintS("S"); break;
6339 case LANG_C: PrintS("C"); break;
6340 case LANG_TOP: PrintS("T"); break;
6341 case LANG_MAX: PrintS("M"); break;
6342 case LANG_NONE: PrintS("N"); break;
6343 default: PrintS("U");
6344 }
6345 if(p->libname!=NULL)
6346 Print(",%s", p->libname);
6347 PrintS(")");
6348}
6349
6351{
6352 intvec *aa=(intvec*)a->Data();
6353 sleftv tmp_out;
6354 sleftv tmp_in;
6355 leftv curr=res;
6356 BOOLEAN bo=FALSE;
6357 for(int i=0;i<aa->length(); i++)
6358 {
6359 tmp_in.Init();
6360 tmp_in.rtyp=INT_CMD;
6361 tmp_in.data=(void*)(long)(*aa)[i];
6362 if (proc==NULL)
6363 bo=iiExprArith1(&tmp_out,&tmp_in,op);
6364 else
6365 bo=jjPROC(&tmp_out,proc,&tmp_in);
6366 if (bo)
6367 {
6368 res->CleanUp(currRing);
6369 Werror("apply fails at index %d",i+1);
6370 return TRUE;
6371 }
6372 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6373 else
6374 {
6376 curr=curr->next;
6377 memcpy(curr,&tmp_out,sizeof(tmp_out));
6378 }
6379 }
6380 return FALSE;
6381}
6383{
6384 WerrorS("not implemented");
6385 return TRUE;
6386}
6388{
6389 WerrorS("not implemented");
6390 return TRUE;
6391}
6393{
6394 lists aa=(lists)a->Data();
6395 if (aa->nr==-1) /* empty list*/
6396 {
6398 l->Init();
6399 res->data=(void *)l;
6400 return FALSE;
6401 }
6402 sleftv tmp_out;
6403 sleftv tmp_in;
6404 leftv curr=res;
6405 BOOLEAN bo=FALSE;
6406 for(int i=0;i<=aa->nr; i++)
6407 {
6408 tmp_in.Init();
6409 tmp_in.Copy(&(aa->m[i]));
6410 if (proc==NULL)
6411 bo=iiExprArith1(&tmp_out,&tmp_in,op);
6412 else
6413 bo=jjPROC(&tmp_out,proc,&tmp_in);
6414 tmp_in.CleanUp();
6415 if (bo)
6416 {
6417 res->CleanUp(currRing);
6418 Werror("apply fails at index %d",i+1);
6419 return TRUE;
6420 }
6421 if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6422 else
6423 {
6425 curr=curr->next;
6426 memcpy(curr,&tmp_out,sizeof(tmp_out));
6427 }
6428 }
6429 return FALSE;
6430}
6432{
6433 res->Init();
6434 res->rtyp=a->Typ();
6435 switch (res->rtyp /*a->Typ()*/)
6436 {
6437 case INTVEC_CMD:
6438 case INTMAT_CMD:
6439 return iiApplyINTVEC(res,a,op,proc);
6440 case BIGINTMAT_CMD:
6441 return iiApplyBIGINTMAT(res,a,op,proc);
6442 case IDEAL_CMD:
6443 case MODUL_CMD:
6444 case MATRIX_CMD:
6445 return iiApplyIDEAL(res,a,op,proc);
6446 case LIST_CMD:
6447 return iiApplyLIST(res,a,op,proc);
6448 }
6449 WerrorS("first argument to `apply` must allow an index");
6450 return TRUE;
6451}
6452
6454{
6455 // assume a: level
6456 if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6457 {
6458 if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6459 char assume_yylinebuf[80];
6460 strncpy(assume_yylinebuf,my_yylinebuf,79);
6461 int lev=(long)a->Data();
6462 int startlev=0;
6463 idhdl h=ggetid("assumeLevel");
6464 if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6465 if(lev <=startlev)
6466 {
6467 BOOLEAN bo=b->Eval();
6468 if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6469 if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6470 if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6471 }
6472 }
6473 b->CleanUp();
6474 a->CleanUp();
6475 return FALSE;
6476}
6477
6478#include "libparse.h"
6479
6480BOOLEAN iiARROW(leftv r, char* a, char *s)
6481{
6482 char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6483 // find end of s:
6484 int end_s=strlen(s);
6485 while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6486 s[end_s+1]='\0';
6487 char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6488 sprintf(name,"%s->%s",a,s);
6489 // find start of last expression
6490 int start_s=end_s-1;
6491 while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6492 if (start_s<0) // ';' not found
6493 {
6494 sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6495 }
6496 else // s[start_s] is ';'
6497 {
6498 s[start_s]='\0';
6499 sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6500 }
6501 r->Init();
6502 // now produce procinfo for PROC_CMD:
6503 r->data = (void *)omAlloc0Bin(procinfo_bin);
6504 ((procinfo *)(r->data))->language=LANG_NONE;
6506 ((procinfo *)r->data)->data.s.body=ss;
6507 omFree(name);
6508 r->rtyp=PROC_CMD;
6509 //r->rtyp=STRING_CMD;
6510 //r->data=ss;
6511 return FALSE;
6512}
6513
6515{
6516 char* ring_name=omStrDup((char*)r->Name());
6517 int t=arg->Typ();
6518 if (t==RING_CMD)
6519 {
6520 sleftv tmp;
6521 tmp.Init();
6522 tmp.rtyp=IDHDL;
6523 idhdl h=rDefault(ring_name);
6524 tmp.data=(char*)h;
6525 if (h!=NULL)
6526 {
6527 tmp.name=h->id;
6528 BOOLEAN b=iiAssign(&tmp,arg);
6529 if (b) return TRUE;
6530 rSetHdl(ggetid(ring_name));
6531 omFree(ring_name);
6532 return FALSE;
6533 }
6534 else
6535 return TRUE;
6536 }
6537 else if (t==CRING_CMD)
6538 {
6539 sleftv tmp;
6540 sleftv n;
6541 n.Init();
6542 n.name=ring_name;
6543 if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6544 if (iiAssign(&tmp,arg)) return TRUE;
6545 //Print("create %s\n",r->Name());
6546 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6547 return FALSE;
6548 }
6549 //Print("create %s\n",r->Name());
6550 //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6551 return TRUE;// not handled -> error for now
6552}
6553
6554static void iiReportTypes(int nr,int t,const short *T)
6555{
6556 char buf[250];
6557 buf[0]='\0';
6558 if (nr==0)
6559 sprintf(buf,"wrong length of parameters(%d), expected ",t);
6560 else
6561 sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6562 for(int i=1;i<=T[0];i++)
6563 {
6564 strcat(buf,"`");
6565 strcat(buf,Tok2Cmdname(T[i]));
6566 strcat(buf,"`");
6567 if (i<T[0]) strcat(buf,",");
6568 }
6569 WerrorS(buf);
6570}
6571
6572BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
6573{
6574 int l=0;
6575 if (args==NULL)
6576 {
6577 if (type_list[0]==0) return TRUE;
6578 }
6579 else l=args->listLength();
6580 if (l!=(int)type_list[0])
6581 {
6582 if (report) iiReportTypes(0,l,type_list);
6583 return FALSE;
6584 }
6585 for(int i=1;i<=l;i++,args=args->next)
6586 {
6587 short t=type_list[i];
6588 if (t!=ANY_TYPE)
6589 {
6590 if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6591 || (t!=args->Typ()))
6592 {
6593 if (report) iiReportTypes(i,args->Typ(),type_list);
6594 return FALSE;
6595 }
6596 }
6597 }
6598 return TRUE;
6599}
6600
6601void iiSetReturn(const leftv source)
6602{
6603 if ((source->next==NULL)&&(source->e==NULL))
6604 {
6605 if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6606 {
6607 memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6608 source->Init();
6609 return;
6610 }
6611 if (source->rtyp==IDHDL)
6612 {
6613 if ((IDLEV((idhdl)source->data)==myynest)
6614 &&(IDTYP((idhdl)source->data)!=RING_CMD))
6615 {
6617 iiRETURNEXPR.rtyp=IDTYP((idhdl)source->data);
6618 iiRETURNEXPR.data=IDDATA((idhdl)source->data);
6619 iiRETURNEXPR.flag=IDFLAG((idhdl)source->data);
6621 IDATTR((idhdl)source->data)=NULL;
6622 IDDATA((idhdl)source->data)=NULL;
6623 source->name=NULL;
6624 source->attribute=NULL;
6625 return;
6626 }
6627 }
6628 }
6629 iiRETURNEXPR.Copy(source);
6630}
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:4082
int p
Definition: cfModGcd.cc:4078
CanonicalForm cf
Definition: cfModGcd.cc:4083
CanonicalForm b
Definition: cfModGcd.cc:4103
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: variable.h:52
char * buffer
Definition: fevoices.h:69
char * filename
Definition: fevoices.h:63
long fptr
Definition: fevoices.h:70
Matrices of numbers.
Definition: bigintmat.h:51
Definition: idrec.h:35
idhdl get(const char *s, int lev)
Definition: ipid.cc:72
int typ
Definition: idrec.h:43
idhdl next
Definition: idrec.h:38
attr attribute
Definition: idrec.h:41
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:2137
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:1019
const char * name
Definition: subexpr.h:87
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1162
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:1462
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:3060
rootContainer ** interpolateDenseSP(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:2922
@ 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:544
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of 'n'
Definition: coeffs.h:448
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:836
static FORCE_INLINE BOOLEAN nCoeff_is_Z(const coeffs r)
Definition: coeffs.h:813
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:829
static FORCE_INLINE void n_MPZ(mpz_t result, number &n, const coeffs r)
conversion of n to a GMP integer; 0 if not possible
Definition: coeffs.h:548
static FORCE_INLINE nMapFunc n_SetMap(const coeffs src, const coeffs dst)
set the mapping function pointers for translating numbers from src to dst
Definition: coeffs.h:697
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:775
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:413
const unsigned short fftable[]
Definition: ffields.cc:27
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:437
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:727
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:452
static FORCE_INLINE char * nCoeffName(const coeffs cf)
Definition: coeffs.h:960
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition: coeffs.h:539
static FORCE_INLINE number n_Init(long i, const coeffs r)
a number representing i in the given coeff field/ring r
Definition: coeffs.h:535
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:907
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:891
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:915
Creation data needed for finite fields.
Definition: coeffs.h:93
#define Print
Definition: emacs.cc:80
#define Warn
Definition: emacs.cc:77
#define WarnS
Definition: emacs.cc:78
return result
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
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:9523
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:9113
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1617
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1963
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:435
idhdl ggetid(const char *n)
Definition: ipid.cc:581
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:445
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:279
VAR package basePack
Definition: ipid.cc:58
void ipListFlag(idhdl h)
Definition: ipid.cc:619
VAR proclevel * procstack
Definition: ipid.cc:52
VAR idhdl currRingHdl
Definition: ipid.cc:59
VAR package currPack
Definition: ipid.cc:57
VAR idhdl currPackHdl
Definition: ipid.cc:55
idhdl packFindHdl(package r)
Definition: ipid.cc:831
VAR coeffs coeffs_BIGINT
Definition: ipid.cc:50
#define IDMAP(a)
Definition: ipid.h:135
#define IDMATRIX(a)
Definition: ipid.h:134
#define IDSTRING(a)
Definition: ipid.h:136
#define IDNEXT(a)
Definition: ipid.h:118
EXTERN_VAR omBin sleftv_bin
Definition: ipid.h:145
#define IDDATA(a)
Definition: ipid.h:126
#define IDPROC(a)
Definition: ipid.h:140
#define setFlag(A, F)
Definition: ipid.h:113
#define IDINTVEC(a)
Definition: ipid.h:128
#define IDIDEAL(a)
Definition: ipid.h:133
#define IDFLAG(a)
Definition: ipid.h:120
#define IDPOLY(a)
Definition: ipid.h:130
#define IDID(a)
Definition: ipid.h:122
#define IDROOT
Definition: ipid.h:19
#define IDINT(a)
Definition: ipid.h:125
#define FLAG_QRING_DEF
Definition: ipid.h:109
#define IDPACKAGE(a)
Definition: ipid.h:139
#define IDLEV(a)
Definition: ipid.h:121
#define IDRING(a)
Definition: ipid.h:127
#define IDTYP(a)
Definition: ipid.h:119
#define FLAG_STD
Definition: ipid.h:106
#define IDLIST(a)
Definition: ipid.h:137
#define IDATTR(a)
Definition: ipid.h:123
VAR int iiRETURNEXPR_len
Definition: iplib.cc:475
INST_VAR sleftv iiRETURNEXPR
Definition: iplib.cc:474
VAR ring * iiLocalRing
Definition: iplib.cc:473
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:197
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition: iplib.cc:1049
lists rDecompose(const ring r)
Definition: ipshell.cc:2161
semicState
Definition: ipshell.cc:3435
@ semicListWrongNumberOfNumerators
Definition: ipshell.cc:3450
@ semicListPGWrong
Definition: ipshell.cc:3464
@ semicListFirstElementWrongType
Definition: ipshell.cc:3442
@ semicListPgNegative
Definition: ipshell.cc:3455
@ semicListSecondElementWrongType
Definition: ipshell.cc:3443
@ semicListMilnorWrong
Definition: ipshell.cc:3463
@ semicListMulNegative
Definition: ipshell.cc:3458
@ semicListFourthElementWrongType
Definition: ipshell.cc:3445
@ semicListWrongNumberOfDenominators
Definition: ipshell.cc:3451
@ semicListNotMonotonous
Definition: ipshell.cc:3461
@ semicListNotSymmetric
Definition: ipshell.cc:3460
@ semicListNNegative
Definition: ipshell.cc:3449
@ semicListDenNegative
Definition: ipshell.cc:3457
@ semicListTooShort
Definition: ipshell.cc:3439
@ semicListTooLong
Definition: ipshell.cc:3440
@ semicListThirdElementWrongType
Definition: ipshell.cc:3444
@ semicListMuNegative
Definition: ipshell.cc:3454
@ semicListNumNegative
Definition: ipshell.cc:3456
@ semicMulNegative
Definition: ipshell.cc:3437
@ semicListWrongNumberOfMultiplicities
Definition: ipshell.cc:3452
@ semicOK
Definition: ipshell.cc:3436
@ semicListFifthElementWrongType
Definition: ipshell.cc:3446
@ semicListSixthElementWrongType
Definition: ipshell.cc:3447
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6350
BOOLEAN jjVARIABLES_P(leftv res, leftv u)
Definition: ipshell.cc:6310
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:4428
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:6180
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:6572
BOOLEAN iiApply(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6431
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:5625
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:6480
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4511
BOOLEAN syBetti1(leftv res, leftv u)
Definition: ipshell.cc:3170
void killlocals(int v)
Definition: ipshell.cc:386
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6392
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:3091
poly iiHighCorner(ideal I, int ak)
Definition: ipshell.cc:1606
BOOLEAN spectrumfProc(leftv result, leftv first)
Definition: ipshell.cc:4184
lists listOfRoots(rootArranger *self, const unsigned int oprec)
Definition: ipshell.cc:5079
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6288
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:3347
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1729
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6387
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:149
void list_error(semicState state)
Definition: ipshell.cc:3468
BOOLEAN mpJacobi(leftv res, leftv a)
Definition: ipshell.cc:3069
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:3551
@ spectrumWrongRing
Definition: ipshell.cc:3558
@ spectrumOK
Definition: ipshell.cc:3552
@ spectrumDegenerate
Definition: ipshell.cc:3557
@ spectrumUnspecErr
Definition: ipshell.cc:3560
@ spectrumNotIsolated
Definition: ipshell.cc:3556
@ spectrumBadPoly
Definition: ipshell.cc:3554
@ spectrumNoSingularity
Definition: ipshell.cc:3555
@ spectrumZero
Definition: ipshell.cc:3553
@ spectrumNoHC
Definition: ipshell.cc:3559
BOOLEAN iiTestAssume(leftv a, leftv b)
Definition: ipshell.cc:6453
void iiSetReturn(const leftv source)
Definition: ipshell.cc:6601
BOOLEAN iiAssignCR(leftv r, leftv arg)
Definition: ipshell.cc:6514
BOOLEAN spmulProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4470
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3810
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1701
void iiDebug()
Definition: ipshell.cc:1065
syStrategy syConvList(lists li)
Definition: ipshell.cc:3254
BOOLEAN spectrumProc(leftv result, leftv first)
Definition: ipshell.cc:4133
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
static void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1889
spectrumState spectrumStateFromList(spectrumPolyList &speclist, lists *L, int fast)
Definition: ipshell.cc:3569
const short MAX_SHORT
Definition: ipshell.cc:5613
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3147
ring rSubring(ring org_ring, sleftv *rv)
Definition: ipshell.cc:6018
BOOLEAN kWeight(leftv res, leftv id)
Definition: ipshell.cc:3301
static leftv rOptimizeOrdAsSleftv(leftv ord)
Definition: ipshell.cc:5186
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5305
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2491
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3384
static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n)
Definition: ipshell.cc:6269
void test_cmd(int i)
Definition: ipshell.cc:514
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6554
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1917
BOOLEAN jjRESULTANT(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:3340
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:3360
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:330
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4253
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:4551
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:6382
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:5577
lists syConvRes(syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
Definition: ipshell.cc:3182
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:6333
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:936
void rSetHdl(idhdl h)
Definition: ipshell.cc:5126
BOOLEAN kQHWeight(leftv res, leftv v)
Definition: ipshell.cc:3323
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:4102
lists getList(spectrum &spec)
Definition: ipshell.cc:3396
BOOLEAN jjVARIABLES_ID(leftv res, leftv u)
Definition: ipshell.cc:6318
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:2447
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:2690
char * lString(lists l, BOOLEAN typed, int dim)
Definition: lists.cc:403
VAR omBin slists_bin
Definition: lists.cc:23
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:222
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:338
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:239
void maFindPerm(char const *const *const preim_names, int preim_n, char const *const *const preim_par, int preim_p, char const *const *const names, int n, char const *const *const par, int nop, int *perm, int *par_perm, n_coeffType ch)
Definition: maps.cc:163
BOOLEAN maApplyFetch(int what, map theMap, leftv res, leftv w, ring preimage_r, int *perm, int *par_perm, int P, nMapFunc nMap)
Definition: maps_ip.cc:45
static matrix mu(matrix A, const ring R)
Definition: matpol.cc:2025
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:37
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:57
#define MATELEM(mat, i, j)
1-based access to matrix
Definition: matpol.h:29
ip_smatrix * matrix
Definition: matpol.h:43
#define MATROWS(i)
Definition: matpol.h:26
#define MATCOLS(i)
Definition: matpol.h:27
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition: minpoly.cc:647
#define assume(x)
Definition: mod2.h:389
#define pIter(p)
Definition: monomials.h:37
#define pNext(p)
Definition: monomials.h:36
#define pSetCoeff0(p, n)
Definition: monomials.h:59
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition: monomials.h:44
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3191
@ mprOk
Definition: mpr_base.h:98
EXTERN_VAR size_t gmp_output_digits
Definition: mpr_base.h:115
uResultant::resMatType determineMType(int imtype)
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
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:4678
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:4821
BOOLEAN nuMPResMat(leftv res, leftv arg1, leftv arg2)
returns module representing the multipolynomial resultant matrix Arguments 2: ideal i,...
Definition: ipshell.cc:4655
BOOLEAN loSimplex(leftv res, leftv args)
Implementation of the Simplex Algorithm.
Definition: ipshell.cc:4569
BOOLEAN loNewtonP(leftv res, leftv arg1)
compute Newton Polytopes of input polynomials
Definition: ipshell.cc:4563
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:4922
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:50
#define BVERBOSE(a)
Definition: options.h:35
#define TEST_V_ALLWARN
Definition: options.h:144
#define Sy_bit(x)
Definition: options.h:31
#define V_REDEFINE
Definition: options.h:45
poly p_PermPoly(poly p, const int *perm, const ring oldRing, const ring dst, nMapFunc nMap, const int *par_perm, int OldPar, BOOLEAN use_mult)
Definition: p_polys.cc:4130
poly p_One(const ring r)
Definition: p_polys.cc:1313
static int pLength(poly a)
Definition: p_polys.h:188
#define __pp_Mult_nn(p, n, r)
Definition: p_polys.h:1000
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:486
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:231
static void p_Delete(poly *p, const ring r)
Definition: p_polys.h:899
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1318
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition: p_polys.h:844
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1505
#define __p_Mult_nn(p, n, r)
Definition: p_polys.h:969
void rChangeCurrRing(ring r)
Definition: polys.cc:15
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Compatibility layer for legacy polynomial operations (over currRing)
static long pTotaldegree(poly p)
Definition: polys.h:282
#define pTest(p)
Definition: polys.h:414
#define pDelete(p_ptr)
Definition: polys.h:186
#define pSetm(p)
Definition: polys.h:271
#define pIsConstant(p)
like above, except that Comp must be 0
Definition: polys.h:238
#define pNeg(p)
Definition: polys.h:198
#define pDiff(a, b)
Definition: polys.h:296
void pNorm(poly p)
Definition: polys.h:362
#define pSub(a, b)
Definition: polys.h:287
#define pCmp(p1, p2)
pCmp: args may be NULL returns: (p2==NULL ? 1 : (p1 == NULL ? -1 : p_LmCmp(p1, p2)))
Definition: polys.h:115
#define pGetVariables(p, e)
Definition: polys.h:251
#define pSetComp(p, v)
Definition: polys.h:38
void wrp(poly p)
Definition: polys.h:310
void pWrite(poly p)
Definition: polys.h:308
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pIsPurePower(p)
Definition: polys.h:248
#define pSetExp(p, i, v)
Definition: polys.h:42
#define pCopy(p)
return a copy of the poly
Definition: polys.h:185
#define pOne()
Definition: polys.h:315
poly * polyset
Definition: polys.h:259
#define pDecrExp(p, i)
Definition: polys.h:44
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition: prCopy.cc:192
int IsPrime(int p)
Definition: prime.cc:61
void PrintS(const char *s)
Definition: reporter.cc:284
void PrintLn()
Definition: reporter.cc:310
void Werror(const char *fmt,...)
Definition: reporter.cc:189
EXTERN_VAR int traceit
Definition: reporter.h:24
#define TRACE_SHOW_RINGS
Definition: reporter.h:36
BOOLEAN rComplete(ring r, int force)
this needs to be called whenever a new ring is created: new fields in ring are created (like VarOffse...
Definition: ring.cc:3450
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:4625
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:5086
static int sign(int x)
Definition: ring.cc:3427
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:518
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:529
static BOOLEAN rField_is_Z(const ring r)
Definition: ring.h:509
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:500
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:545
static int rBlocks(const ring r)
Definition: ring.h:568
static ring rIncRefCnt(ring r)
Definition: ring.h:837
static BOOLEAN rField_is_Zn(const ring r)
Definition: ring.h:512
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:599
static int rInternalChar(const ring r)
Definition: ring.h:689
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:539
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:506
static void rDecRefCnt(ring r)
Definition: ring.h:838
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:625
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:542
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:515
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:521
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:592
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:760
#define rTest(r)
Definition: ring.h:782
#define rField_is_Ring(R)
Definition: ring.h:485
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:2198
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
int name
New type name for int.
Definition: templateForC.h:21
#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