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