source: git/Singular/ring.cc @ 0dac37

spielwiese
Last change on this file since 0dac37 was 0dac37, checked in by Hans Schönemann <hannes@…>, 25 years ago
*hannes: fixed rInit git-svn-id: file:///usr/local/Singular/svn/trunk@3046 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 45.4 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ring.cc,v 1.54 1999-05-19 15:17:01 Singular Exp $ */
5
6/*
7* ABSTRACT - the interpreter related ring operations
8*/
9
10/* includes */
11#include <math.h>
12#include "mod2.h"
13#include "mmemory.h"
14#include "tok.h"
15#include "polys.h"
16#include "numbers.h"
17#include "febase.h"
18#include "ipid.h"
19#include "ipshell.h"
20#include "ipconv.h"
21#include "intvec.h"
22#include "longalg.h"
23#include "ffields.h"
24#include "spolys.h"
25#include "subexpr.h"
26#include "ideals.h"
27#include "lists.h"
28#include "ring.h"
29
30/* global variables */
31#ifdef RDEBUG
32short rNumber=0;
33#endif
34
35// static procedures
36// unconditionally deletes fields in r
37static void rDelete(ring r);
38
39/*0 implementation*/
40int rBlocks(ring r)
41{
42  int i=0;
43  while (r->order[i]!=0) i++;
44  return i+1;
45}
46
47// internally changes the gloabl ring and resets the relevant
48// global variables:
49// complete == FALSE : only delete operations are enabled
50// complete == TRUE  : full reset of all variables
51#ifdef DRING
52void rChangeCurrRing(ring r, BOOLEAN complete, idhdl h)
53#else
54void rChangeCurrRing(ring r, BOOLEAN complete)
55#endif
56{
57  /*------------ set global ring vars --------------------------------*/
58  currRing = r;
59  currQuotient=NULL;
60
61  if (r != NULL)
62  {
63    rTest(r);
64    if (complete)
65    {
66      /*------------ set global ring vars --------------------------------*/
67      currQuotient=r->qideal;
68      /*------------ set redTail, except reset by nSetChar or pChangeRing */
69      test |= Sy_bit(OPT_REDTAIL);
70    }
71
72    /*------------ global variables related to coefficients ------------*/
73    nSetChar(r, complete);
74
75    /*------------ global variables related to polys -------------------*/
76    pSetGlobals(r, complete);
77
78
79    if (complete)
80    {
81    /*------------ set naMinimalPoly -----------------------------------*/
82      if (r->minpoly!=NULL)
83      {
84        naMinimalPoly=((lnumber)r->minpoly)->z;
85      }
86
87#ifdef DRING
88      pDRING=FALSE;
89      pSDRING=FALSE;
90      if ((h!=NULL) && (hasFlag(h,FLAG_DRING))) rDSet();
91#endif // DRING
92
93#ifdef SRING
94      if ((currRing->partN<=currRing->N)
95#ifdef DRING
96          && ((h==NULL) || (!hasFlag(h,FLAG_DRING)))
97#endif
98          )
99      {
100        pAltVars=currRing->partN;
101        pSRING=TRUE;
102        pSDRING=TRUE;
103      }
104      else
105      {
106        pAltVars=currRing->N+1;
107      }
108#endif // SRING
109
110    /*------------ set spolys ------------------------------------------*/
111      spSet(r);
112    }
113  }
114}
115
116void rSetHdl(idhdl h, BOOLEAN complete)
117{
118  int i;
119  ring rg = NULL;
120  if (h!=NULL)
121  {
122    rg = IDRING(h);
123    mmTestP((ADDRESS)h,sizeof(idrec));
124    mmTestLP((ADDRESS)IDID(h));
125    mmTestP(rg,sizeof(ip_sring));
126#ifdef MDEBUG
127    i=rBlocks(rg);
128#endif
129    mmTestP(rg->order,i*sizeof(int));
130    mmTestP(rg->block0,i*sizeof(int));
131    mmTestP(rg->block1,i*sizeof(int));
132    mmTestP(rg->wvhdl,i*sizeof(short *));
133  }
134  else complete=FALSE;
135
136  // clean up history
137    if (((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
138        || ((sLastPrinted.rtyp==LIST_CMD)&&(lRingDependend((lists)sLastPrinted.data))))
139    {
140      sLastPrinted.CleanUp();
141      memset(&sLastPrinted,0,sizeof(sleftv));
142    }
143
144   /*------------ change the global ring -----------------------*/
145  #ifdef DRING
146  rChangeCurrRing(rg,complete,h);
147  #else
148  rChangeCurrRing(rg,complete);
149  #endif
150  currRingHdl = h;
151
152    /*------------ set pShortOut -----------------------*/
153  if (complete /*&&(h!=NULL)*/)
154  {
155    #ifdef HAVE_TCL
156    if (tclmode)
157    {
158      PrintTCLS('R',IDID(h));
159      pShortOut=(int)FALSE;
160    }
161    else
162    #endif
163    {
164      pShortOut=(int)TRUE;
165      if ((rg->parameter!=NULL) && (rg->ch<2))
166      {
167        for (i=0;i<rPar(rg);i++)
168        {
169          if(strlen(rg->parameter[i])>1)
170          {
171            pShortOut=(int)FALSE;
172            break;
173          }
174        }
175      }
176      if (pShortOut)
177      {
178        for (i=(rg->N-1);i>=0;i--)
179        {
180          if(strlen(rg->names[i])>1)
181          {
182            pShortOut=(int)FALSE;
183            break;
184          }
185        }
186      }
187    }
188  }
189
190}
191
192idhdl rDefault(char *s)
193{
194  idhdl tmp=NULL;
195
196  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
197  if (tmp==NULL) return NULL;
198
199  if (ppNoether!=NULL) pDelete(&ppNoether);
200  if ((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
201  {
202    sLastPrinted.CleanUp();
203    memset(&sLastPrinted,0,sizeof(sleftv));
204  }
205
206  currRing = IDRING(tmp);
207
208  currRing->ch    = 32003;
209  currRing->N     = 3;
210  /*currRing->P     = 0; Alloc0 in idhdl::set, ipid.cc*/
211#ifdef RDEBUG
212  rNumber++;
213  currRing->no    =rNumber;
214#endif
215#ifdef SRING
216  currRing->partN = 4;
217#endif
218  /*names*/
219  currRing->names = (char **) Alloc(3 * sizeof(char *));
220  currRing->names[0]  = mstrdup("x");
221  currRing->names[1]  = mstrdup("y");
222  currRing->names[2]  = mstrdup("z");
223  /*weights: entries for 3 blocks: NULL*/
224  currRing->wvhdl = (short **)Alloc0(3 * sizeof(short *));
225  /*order: dp,C,0*/
226  currRing->order = (int *) Alloc(3 * sizeof(int *));
227  currRing->block0 = (int *)Alloc(3 * sizeof(int *));
228  currRing->block1 = (int *)Alloc(3 * sizeof(int *));
229  /* ringorder dp for the first block: var 1..3 */
230  currRing->order[0]  = ringorder_dp;
231  currRing->block0[0] = 1;
232  currRing->block1[0] = 3;
233  /* ringorder C for the second block: no vars */
234  currRing->order[1]  = ringorder_C;
235  currRing->block0[1] = 0;
236  currRing->block1[1] = 0;
237  /* the last block: everything is 0 */
238  currRing->order[2]  = 0;
239  currRing->block0[2] = 0;
240  currRing->block1[2] = 0;
241  /*polynomial ring*/
242  currRing->OrdSgn    = 1;
243
244  /* complete ring intializations */
245  rComplete(currRing);
246  rSetHdl(tmp,TRUE);
247  return currRingHdl;
248}
249
250///////////////////////////////////////////////////////////////////////////
251//
252// rInit: define a new ring from sleftv's
253//
254
255/////////////////////////////
256// Auxillary functions
257//
258
259// check intvec, describing the ordering
260static BOOLEAN rCheckIV(intvec *iv)
261{
262  if ((iv->length()!=2)&&(iv->length()!=3))
263  {
264    WerrorS("weights only for orderings wp,ws,Wp,Ws,a,M");
265    return TRUE;
266  }
267  return FALSE;
268}
269
270static int rTypeOfMatrixOrder(intvec * order)
271{
272  int i=0,j,typ=1;
273  int sz = (int)sqrt((double)(order->length()-2));
274
275  while ((i<sz) && (typ==1))
276  {
277    j=0;
278    while ((j<sz) && ((*order)[j*sz+i+2]==0)) j++;
279    if (j>=sz)
280    {
281      typ = 0;
282      WerrorS("Matrix order not complete");
283    }
284    else if ((*order)[j*sz+i+2]<0)
285      typ = -1;
286    else
287      i++;
288  }
289  return typ;
290}
291
292// set R->order, R->block, R->wvhdl, r->OrdSgn from sleftv
293static BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
294{
295  int last = 0, o=0, n = 1, i=0, typ = 1, j;
296  sleftv *sl = ord;
297
298  // determine nBlocks
299  while (sl!=NULL)
300  {
301    intvec *iv = (intvec *)(sl->data);
302    if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C)) i++;
303    else if ((*iv)[1]!=ringorder_a) o++;
304    n++;
305    sl=sl->next;
306  }
307  // check whether at least one real ordering
308  if (o==0)
309  {
310    WerrorS("invalid combination of orderings");
311    return TRUE;
312  }
313  // if no c/C ordering is given, increment n
314  if (i==0) n++;
315  else if (i != 1)
316  {
317    // throw error if more than one is given
318    WerrorS("more than one ordering c/C specified");
319    return TRUE;
320  }
321
322  // initialize fields of R
323  R->order=(int *)Alloc0(n*sizeof(int));
324  R->block0=(int *)Alloc0(n*sizeof(int));
325  R->block1=(int *)Alloc0(n*sizeof(int));
326  R->wvhdl=(short**)Alloc0(n*sizeof(short*));
327
328  // init order, so that rBlocks works correctly
329  for (j=0; j < n-1; j++)
330    R->order[j] = (int) ringorder_unspec;
331  // set last _C order, if no c/C order was given
332  if (i == 0) R->order[n-2] = ringorder_C;
333
334  /* init orders */
335  sl=ord;
336  n=-1;
337  while (sl!=NULL)
338  {
339    intvec *iv;
340    iv = (intvec *)(sl->data);
341    n++;
342
343    /* the format of an ordering:
344     *  iv[0]: factor
345     *  iv[1]: ordering
346     *  iv[2..end]: weights
347     */
348    R->order[n] = (*iv)[1];
349    switch ((*iv)[1])
350    {
351        case ringorder_ws:
352        case ringorder_Ws:
353          typ=-1;
354        case ringorder_wp:
355        case ringorder_Wp:
356          R->wvhdl[n]=(short*)AllocL((iv->length()-1)*sizeof(short));
357          for (i=2; i<iv->length(); i++)
358            R->wvhdl[n][i-2] = (short)(*iv)[i];
359          R->block0[n] = last+1;
360          last += iv->length()-2;
361          R->block1[n] = last;
362          break;
363        case ringorder_ls:
364        case ringorder_ds:
365        case ringorder_Ds:
366          typ=-1;
367        case ringorder_lp:
368        case ringorder_dp:
369        case ringorder_Dp:
370          R->block0[n] = last+1;
371          if (iv->length() == 3) last+=(*iv)[2];
372          else last += (*iv)[0];
373          R->block1[n] = last;
374          if (rCheckIV(iv)) return TRUE;
375          break;
376        case ringorder_c:
377        case ringorder_C:
378          if (rCheckIV(iv)) return TRUE;
379          break;
380        case ringorder_a:
381          R->block0[n] = last+1;
382          R->block1[n] = last + iv->length() - 2;
383          R->wvhdl[n] = (short*)AllocL((iv->length()-1)*sizeof(short));
384          for (i=2; i<iv->length(); i++)
385          {
386            R->wvhdl[n][i-2]=(short)(*iv)[i];
387            if ((*iv)[i]<0) typ=-1;
388          }
389          break;
390        case ringorder_M:
391        {
392          int Mtyp=rTypeOfMatrixOrder(iv);
393          if (Mtyp==0) return TRUE;
394          if (Mtyp==-1) typ = -1;
395
396          R->wvhdl[n] =( short*)AllocL((iv->length()-1)*sizeof(short));
397          for (i=2; i<iv->length();i++)
398            R->wvhdl[n][i-2]=(short)(*iv)[i];
399
400          R->block0[n] = last+1;
401          last += (int)sqrt((double)(iv->length()-2));
402          R->block1[n] = last;
403          break;
404        }
405
406        case ringorder_no:
407           R->order[n] = ringorder_unspec;
408           return TRUE;
409
410        default:
411          Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
412          R->order[n] = ringorder_unspec;
413          return TRUE;
414    }
415    sl=sl->next;
416  }
417
418  // check for complete coverage
419  if ((R->order[n]==ringorder_c) ||  (R->order[n]==ringorder_C)) n--;
420  if (R->block1[n] != R->N)
421  {
422    if (((R->order[n]==ringorder_dp) ||
423         (R->order[n]==ringorder_ds) ||
424         (R->order[n]==ringorder_Dp) ||
425         (R->order[n]==ringorder_Ds) ||
426         (R->order[n]==ringorder_lp) ||
427         (R->order[n]==ringorder_ls))
428        &&
429        R->block0[n] <= R->N)
430    {
431      R->block1[n] = R->N;
432    }
433    else
434    {
435      Werror("mismatch of number of vars (%d) and ordering (%d vars)",
436             R->N,R->block1[n]);
437      return TRUE;
438    }
439  }
440  R->OrdSgn = typ;
441  return FALSE;
442}
443
444// get array of strings from list of sleftv's
445static BOOLEAN rSleftvList2StringArray(sleftv* sl, char** p)
446{
447
448  while(sl!=NULL)
449  {
450    if (sl->Name() == sNoName)
451    {
452      if (sl->Typ()==POLY_CMD)
453      {
454        sleftv s_sl;
455        iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
456        if (s_sl.Name() != sNoName)
457          *p = mstrdup(s_sl.Name());
458        else
459          *p = NULL;
460        sl->next = s_sl.next;
461        s_sl.next = NULL;
462        s_sl.CleanUp();
463        if (*p == NULL) return TRUE;
464      }
465      else
466        return TRUE;
467    }
468    else
469      *p = mstrdup(sl->Name());
470    p++;
471    sl=sl->next;
472  }
473  return FALSE;
474}
475
476
477////////////////////
478//
479// rInit itself:
480//
481// INPUT:  s: name, pn: ch & parameter (names), rv: variable (names)
482//         ord: ordering
483// RETURN: currRingHdl on success
484//         NULL        on error
485// NOTE:   * makes new ring to current ring, on success
486//         * considers input sleftv's as read-only
487idhdl rInit(char *s, sleftv* pn, sleftv* rv, sleftv* ord,
488            BOOLEAN isDRing)
489{
490  int ch;
491  int float_len=0;
492  ring R = NULL;
493  idhdl tmp = NULL;
494  BOOLEAN ffChar=FALSE;
495
496  /* ch -------------------------------------------------------*/
497  // get ch of ground field
498  if (pn->Typ()==INT_CMD)
499  {
500    ch=(int)pn->Data();
501  }
502  else if (pn->name != NULL && strcmp(pn->name,"real")==0)
503  {
504    ch=-1;
505    if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
506    {
507      float_len=(int)pn->next->Data();
508      pn=pn->next;
509    }
510  }
511  else
512  {
513    Werror("Wrong ground field specification");
514    goto rInitError;
515  }
516  pn=pn->next;
517
518  /* characteristic -----------------------------------------------*/
519  /* input: 0 ch=0 : Q     parameter=NULL    ffChar=FALSE
520   *         0    1 : Q(a,...)        *names         FALSE
521   *         0   -1 : R               NULL           FALSE
522   *         0   -1 : C               *names         FALSE
523   *         p    p : Fp              NULL           FALSE
524   *         p   -p : Fp(a)           *names         FALSE
525   *         q    q : GF(q=p^n)       *names         TRUE
526   */
527  if (ch!=-1)
528  {
529    int l = 0;
530
531    if (ch!=0 && (ch<2) || (ch > 32003))
532    {
533      Warn("%d is invalid characteristic of ground field. 32003 is used.", ch);
534      ch=32003;
535    }
536    // load fftable, if necessary
537    if (pn!=NULL)
538    {
539      while ((ch!=fftable[l]) && (fftable[l])) l++;
540      if (fftable[l]==0) ch = IsPrime(ch);
541      else
542      {
543        char *m[1]={(char *)sNoName};
544        nfSetChar(ch,m);
545        if (errorreported) goto rInitError;
546        else ffChar=TRUE;
547      }
548    }
549    else
550      ch = IsPrime(ch);
551  }
552  // allocated ring and set ch
553  R = (ring) Alloc0(sizeof(sip_sring));
554  R->ch = ch;
555  if (ch == -1)
556  {
557    R->ch_flags= float_len;
558  }
559
560  /* parameter -------------------------------------------------------*/
561  if (pn!=NULL)
562  {
563    R->P=pn->listLength();
564    //if ((ffChar|| (ch == 1)) && (R->P > 1))
565    if ((R->P > 1) && (ffChar || (ch == -1)))
566    {
567      WerrorS("too many parameters");
568      goto rInitError;
569    }
570    R->parameter=(char**)Alloc0(R->P*sizeof(char *));
571    if (rSleftvList2StringArray(pn, R->parameter))
572    {
573      WerrorS("parameter expected");
574      goto rInitError;
575    }
576    if (ch>1 && !ffChar) R->ch=-ch;
577    else if (ch==0) R->ch=1;
578  }
579  else if (ffChar)
580  {
581    WerrorS("need one parameter");
582    goto rInitError;
583  }
584
585  /* names and number of variables-------------------------------------*/
586  R->N = rv->listLength();
587  R->names   = (char **)Alloc0(R->N * sizeof(char *));
588  if (rSleftvList2StringArray(rv, R->names))
589  {
590    WerrorS("name of ring variable expected");
591    goto rInitError;
592  }
593
594  /* ordering -------------------------------------------------------------*/
595  if (rSleftvOrdering2Ordering(ord, R))
596    goto rInitError;
597
598  // Complete the initialization
599  if (rComplete(R))
600    goto rInitError;
601
602  // try to enter the ring into the name list //
603  if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
604    goto rInitError;
605
606  memcpy(IDRING(tmp),R,sizeof(*R));
607  // set current ring
608  Free(R,  sizeof(ip_sring));
609#ifdef RDEBUG
610  rNumber++;
611  R->no    =rNumber;
612#endif
613  return tmp;
614
615  // error case:
616  rInitError:
617  if  (R != NULL) rDelete(R);
618  return NULL;
619}
620
621// set those fields of the ring, which can be computed from other fields:
622// More particularly, sets r->VarOffset
623BOOLEAN rComplete(ring r, int force)
624{
625
626  int VarCompIndex, VarLowIndex, VarHighIndex;
627  // check number of vars and number of params
628  if (r->N + 1 > (int) MAX_EXPONENT_NUMBER)
629  {
630    Werror("Too many ring variables: %d is the maximum",
631           MAX_EXPONENT_NUMBER -1);
632    return TRUE;
633  }
634
635
636  r->VarOffset = (int*) Alloc((r->N + 1)*sizeof(int));
637  pGetVarIndicies(r, r->VarOffset, VarCompIndex,
638                  VarLowIndex, VarHighIndex);
639  r->VarCompIndex = VarCompIndex;
640  r->VarLowIndex = VarLowIndex;
641  r->VarHighIndex = VarHighIndex;
642  return FALSE;
643}
644
645/*2
646 * set a new ring from the data:
647 s: name, chr: ch, varnames: rv, ordering: ord, typ: typ
648 */
649#ifdef DRING
650void rDSet()
651{
652  pDRING=TRUE;
653  pSDRING=TRUE;
654  pdN=currRing->partN;
655  pdK=pVariables-pdN*2-1;
656}
657#endif
658
659int rIsRingVar(char *n)
660{
661  if ((currRing!=NULL) && (currRing->names!=NULL))
662  {
663    for (int i=0; i<currRing->N; i++)
664    {
665      if (currRing->names[i]==NULL) return -1;
666      if (strcmp(n,currRing->names[i]) == 0) return (int)i;
667    }
668  }
669  return -1;
670}
671
672char* RingVar(short i)
673{
674  return currRing->names[i];
675}
676
677void rWrite(ring r)
678{
679  if ((r==NULL)||(r->order==NULL))
680    return; /*to avoid printing after errors....*/
681
682  int nblocks=rBlocks(r);
683
684  mmTestP(r,sizeof(ip_sring));
685  mmTestP(r->order,nblocks*sizeof(int));
686  mmTestP(r->block0,nblocks*sizeof(int));
687  mmTestP(r->block1,nblocks*sizeof(int));
688  mmTestP(r->wvhdl,nblocks*sizeof(short *));
689  mmTestP(r->names,r->N*sizeof(char *));
690
691  nblocks--;
692
693
694  if (rField_is_GF(r))
695  {
696    Print("//   # ground field : %d\n",rInternalChar(r));
697    Print("//   primitive element : %s\n", r->parameter[0]);
698    if (r==currRing)
699    {
700      StringSetS("//   minpoly        : ");
701      nfShowMipo();PrintS(StringAppendS("\n"));
702    }
703  }
704  else
705  {
706    PrintS("//   characteristic : ");
707    if ( rField_is_R(r) )             PrintS("0 (real)\n");  /* R */
708    else if ( rField_is_long_R(r) )
709      Print("0 (real:%d digits)\n",r->ch_flags);  /* long R */
710    else if ( rField_is_long_C(r) )
711      Print("0 (complex:%d digits)\n",r->ch_flags);  /* long C */
712    else
713      Print ("%d\n",rChar(r)); /* Fp(a) */
714    if (r->parameter!=NULL)
715    {
716      Print ("//   %d parameter    : ",rPar(r));
717      char **sp=r->parameter;
718      int nop=0;
719      while (nop<rPar(r))
720      {
721        PrintS(*sp);
722        PrintS(" ");
723        sp++; nop++;
724      }
725      PrintS("\n//   minpoly        : ");
726      if (r->minpoly==NULL)
727      {
728        PrintS("0\n");
729      }
730      else if (r==currRing)
731      {
732        StringSetS(""); nWrite(r->minpoly); PrintS(StringAppendS("\n"));
733      }
734      else
735      {
736        PrintS("...\n");
737      }
738    }
739  }
740  Print("//   number of vars : %d",r->N);
741
742  //for (nblocks=0; r->order[nblocks]; nblocks++);
743  nblocks=rBlocks(r)-1;
744
745  for (int l=0, nlen=0 ; l<nblocks; l++)
746  {
747    int i;
748    Print("\n//        block %3d : ",l+1);
749
750    Print("ordering %c", (" acCMldDwWldDwWu")[r->order[l]]);
751    if ((r->order[l]>=ringorder_lp)&&(r->order[l]!=ringorder_unspec))
752    {
753      if (r->order[l]>=ringorder_ls)
754        PrintS("s");
755      else
756        PrintS("p");
757    }
758
759    if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
760    {
761      PrintS("\n//                  : names    ");
762      for (i = r->block0[l]-1; i<r->block1[l]; i++)
763      {
764        nlen = strlen(r->names[i]);
765        Print("%s ",r->names[i]);
766      }
767    }
768
769    if (r->wvhdl[l]!=NULL)
770    {
771      for (int j= 0;
772           j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
773           j+=i)
774      {
775        PrintS("\n//                  : weights  ");
776        for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
777        {
778          Print("%*d " ,nlen,r->wvhdl[l][i+j],i+j);
779        }
780        if (r->order[l]!=ringorder_M) break;
781      }
782    }
783  }
784  if (r->qideal!=NULL)
785  {
786    PrintS("\n// quotient ring from ideal");
787    if (r==currRing)
788    {
789      PrintLn();
790      iiWriteMatrix((matrix)r->qideal,"_",1);
791    }
792    else PrintS(" ...");
793  }
794}
795
796static void rDelete(ring r)
797{
798  int i, j;
799
800  if (r == NULL) return;
801
802  // delete order stuff
803  if (r->order != NULL)
804  {
805    i=rBlocks(r);
806    assume(r->block0 != NULL && r->block1 != NULL && r->wvhdl != NULL);
807    // delete order
808    Free((ADDRESS)r->order,i*sizeof(int));
809    Free((ADDRESS)r->block0,i*sizeof(int));
810    Free((ADDRESS)r->block1,i*sizeof(int));
811    // delete weights
812    for (j=0; j<i; j++)
813    {
814      if (r->wvhdl[j]!=NULL)
815        FreeL(r->wvhdl[j]);
816    }
817    Free((ADDRESS)r->wvhdl,i*sizeof(short *));
818  }
819  else
820  {
821    assume(r->block0 == NULL && r->block1 == NULL && r->wvhdl == NULL);
822  }
823
824  // delete varnames
825  if(r->names!=NULL)
826  {
827    for (i=0; i<r->N; i++)
828    {
829      if (r->names[i] != NULL) FreeL((ADDRESS)r->names[i]);
830    }
831    Free((ADDRESS)r->names,r->N*sizeof(char *));
832  }
833
834  // delete parameter
835  if (r->parameter!=NULL)
836  {
837    char **s=r->parameter;
838    j = 0;
839    while (j < rPar(r))
840    {
841      if (*s != NULL) FreeL((ADDRESS)*s);
842      s++;
843      j++;
844    }
845    Free((ADDRESS)r->parameter,rPar(r)*sizeof(char *));
846  }
847  if (r->VarOffset != NULL)
848    Free((ADDRESS)r->VarOffset, (r->N +1)*sizeof(int));
849  Free(r, sizeof(ip_sring));
850}
851
852void rKill(ring r)
853{
854  rTest(r);
855  if ((r->ref<=0)&&(r->order!=NULL))
856  {
857#ifdef RDEBUG
858    if (traceit &TRACE_SHOW_RINGS) Print("kill ring %d\n",r->no);
859#endif
860    if (r==currRing)
861    {
862      if (r->qideal!=NULL)
863      {
864        idDelete(&r->qideal);
865        r->qideal=NULL;
866        currQuotient=NULL;
867      }
868      if (ppNoether!=NULL) pDelete(&ppNoether);
869      if ((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
870      {
871        sLastPrinted.CleanUp();
872        memset(&sLastPrinted,0,sizeof(sleftv));
873      }
874      currRing=NULL;
875      currRingHdl=NULL;
876    }
877    else if (r->qideal!=NULL)
878    {
879      ring savecurrRing = currRing;
880      rChangeCurrRing((ring)r,FALSE);
881      idDelete(&r->qideal);
882      r->qideal=NULL;
883      rChangeCurrRing(savecurrRing,FALSE);
884    }
885    int i=1;
886    int j;
887    int *pi=r->order;
888#ifdef USE_IILOCALRING
889    for (j=0;j<iiRETURNEXPR_len;j++)
890    {
891      if (iiLocalRing[j]==r)
892      {
893        if (j<myynest) Warn("killing the basering for level %d",j);
894        iiLocalRing[j]=NULL;
895      }
896    }
897#else /* USE_IILOCALRING */
898    {
899      namehdl nshdl = namespaceroot;
900
901      for(nshdl=namespaceroot; nshdl->isroot != TRUE; nshdl = nshdl->next) {
902        //Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
903        if (nshdl->currRing==r)
904        {
905          if (nshdl->myynest<myynest)
906//            Warn("killing the basering for level %d/%d",nshdl->lev,nshdl->myynest);
907          Warn("killing the basering for level %d",nshdl->myynest);
908          nshdl->currRing=NULL;
909        }
910      }
911      if (nshdl->currRing==r)
912      {
913        //Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
914        if (nshdl->myynest<myynest)
915//          Warn("killing the basering for level %d/%d",nshdl->lev,nshdl->myynest);
916          Warn("killing the basering for level %d",nshdl->myynest);
917        nshdl->currRing=NULL;
918      }
919    }
920#endif /* USE_IILOCALRING */
921
922    rDelete(r);
923    return;
924  }
925  r->ref--;
926}
927
928void rKill(idhdl h)
929{
930#ifndef HAVE_NAMESPACES1
931  ring r = IDRING(h);
932  if (r!=NULL) rKill(r);
933  if (h==currRingHdl)
934  {
935#ifdef HAVE_NAMESPACES
936    namehdl nsHdl = namespaceroot;
937    while(nsHdl!=NULL) {
938      currRingHdl=NSROOT(nsHdl);
939#else /* HAVE_NAMESPACES */
940      currRingHdl=IDROOT;
941#endif /* HAVE_NAMESPACES */
942      while (currRingHdl!=NULL)
943      {
944        if ((currRingHdl!=h)
945            && (IDTYP(currRingHdl)==IDTYP(h))
946            && (h->data.uring==currRingHdl->data.uring))
947          break;
948        currRingHdl=IDNEXT(currRingHdl);
949      }
950#ifdef HAVE_NAMESPACES
951      if ((currRingHdl != NULL) && (currRingHdl!=h)
952          && (IDTYP(currRingHdl)==IDTYP(h))
953          && (h->data.uring==currRingHdl->data.uring))
954        break;
955      nsHdl = nsHdl->next;
956    }
957#endif /* HAVE_NAMESPACES */
958  }
959#else
960    if(currRingHdl==NULL) {
961      namehdl ns = namespaceroot;
962      BOOLEAN found=FALSE;
963
964      while(!ns->isroot) {
965        currRingHdl=NSROOT(namespaceroot->next);
966        while (currRingHdl!=NULL)
967        {
968          if ((currRingHdl!=h)
969              && (IDTYP(currRingHdl)==IDTYP(h))
970              && (h->data.uring==currRingHdl->data.uring))
971          { found=TRUE; break; }
972
973          currRingHdl=IDNEXT(currRingHdl);
974        }
975        if(found) break;
976        ns=IDNEXT(ns);
977      }
978    }
979    if(currRingHdl == NULL || IDRING(h) != IDRING(currRingHdl)) {
980      currRingHdl = namespaceroot->currRingHdl;
981
982/*      PrintS("Running rFind()\n");
983      currRingHdl = rFindHdl(IDRING(h), NULL, NULL);
984      if(currRingHdl == NULL)
985      {
986        PrintS("rFind()return 0\n");
987      }
988      else
989      {
990        PrintS("Huppi rfind return an currRingHDL\n");
991        Print("%x, %x\n", IDRING(h),IDRING(currRingHdl) );
992      }
993*/
994    }
995    else
996    {
997      //PrintS("Huppi found an currRingHDL\n");
998      //Print("%x, %x\n", IDRING(h),IDRING(currRingHdl) );
999
1000    }
1001#endif /* HAVE_NAMESPACES */
1002}
1003
1004idhdl rFindHdl(ring r, idhdl n, idhdl w)
1005{
1006#ifdef HAVE_NAMESPACES
1007  idhdl h;
1008  namehdl ns = namespaceroot;
1009
1010  while(!ns->isroot) {
1011    h = NSROOT(ns);
1012    if(w != NULL) h = w;
1013    while (h!=NULL)
1014    {
1015      if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1016          && (h->data.uring==r)
1017          && (h!=n))
1018        return h;
1019      h=IDNEXT(h);
1020    }
1021    ns = ns->next;
1022  }
1023  h = NSROOT(ns);
1024  if(w != NULL) h = w;
1025  while (h!=NULL)
1026  {
1027    if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1028        && (h->data.uring==r)
1029        && (h!=n))
1030      return h;
1031    h=IDNEXT(h);
1032  }
1033#if 0
1034  if(namespaceroot->isroot) h = IDROOT;
1035  else h = NSROOT(namespaceroot->next);
1036  if(w != NULL) h = w;
1037  while (h!=NULL)
1038  {
1039    if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1040        && (h->data.uring==r)
1041        && (h!=n))
1042      return h;
1043    h=IDNEXT(h);
1044  }
1045#endif
1046#else
1047  idhdl h=IDROOT;
1048  if(w != NULL) h = w;
1049  while (h!=NULL)
1050  {
1051    if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1052        && (h->data.uring==r)
1053        && (h!=n))
1054      return h;
1055    h=IDNEXT(h);
1056  }
1057#endif
1058  return NULL;
1059}
1060
1061int rOrderName(char * ordername)
1062{
1063  int order=0;
1064
1065  switch (*ordername)
1066  {
1067  case 'l':
1068    if (*(ordername+1)=='p') order = ringorder_lp;
1069    else if (*(ordername+1)=='s') order = ringorder_ls;
1070    break;
1071  case 'd':
1072    if (*(ordername+1)=='p') order = ringorder_dp;
1073    else if (*(ordername+1)=='s') order = ringorder_ds;
1074    break;
1075  case 'w':
1076    if (*(ordername+1)=='p') order = ringorder_wp;
1077    else if (*(ordername+1)=='s') order = ringorder_ws;
1078    break;
1079  case 'D':
1080    if (*(ordername+1)=='p') order = ringorder_Dp;
1081    else if (*(ordername+1)=='s') order = ringorder_Ds;
1082    break;
1083  case 'W':
1084    if (*(ordername+1)=='p') order = ringorder_Wp;
1085    else if (*(ordername+1)=='s') order = ringorder_Ws;
1086    break;
1087  case 'c': order = ringorder_c; break;
1088  case 'C': order = ringorder_C; break;
1089  case 'a': order = ringorder_a; break;
1090  case 'M': order = ringorder_M; break;
1091  default: break;
1092  }
1093  if (order==0) Werror("wrong ring order `%s`",ordername);
1094  FreeL((ADDRESS)ordername);
1095  return order;
1096}
1097
1098char * rOrdStr(ring r)
1099{
1100  int nblocks,l,i;
1101
1102  for (nblocks=0; r->order[nblocks]; nblocks++);
1103  nblocks--;
1104
1105  StringSetS("");
1106  for (l=0; ; l++)
1107  {
1108    StringAppend("%c",(" acCMldDwWldDwW")[r->order[l]]);
1109    if (r->order[l]>=ringorder_lp)
1110    {
1111      if (r->order[l]>=ringorder_ls)
1112        StringAppendS("s");
1113      else
1114        StringAppendS("p");
1115    }
1116    if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
1117    {
1118      if (r->wvhdl[l]!=NULL)
1119      {
1120        StringAppendS("(");
1121        for (int j= 0;
1122             j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
1123             j+=i+1)
1124        {
1125          char c=',';
1126          for (i = 0; i<r->block1[l]-r->block0[l]; i++)
1127          {
1128            StringAppend("%d," ,r->wvhdl[l][i+j]);
1129          }
1130          if (r->order[l]!=ringorder_M)
1131          {
1132            StringAppend("%d)" ,r->wvhdl[l][i+j]);
1133            break;
1134          }
1135          if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
1136            c=')';
1137          StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
1138        }
1139      }
1140      else
1141        StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
1142    }
1143    if (l==nblocks) return mstrdup(StringAppendS(""));
1144    StringAppendS(",");
1145  }
1146}
1147
1148char * rVarStr(ring r)
1149{
1150  int i;
1151  int l=2;
1152  char *s;
1153
1154  for (i=0; i<r->N; i++)
1155  {
1156    l+=strlen(r->names[i])+1;
1157  }
1158  s=(char *)AllocL(l);
1159  s[0]='\0';
1160  for (i=0; i<r->N-1; i++)
1161  {
1162    strcat(s,r->names[i]);
1163    strcat(s,",");
1164  }
1165  strcat(s,r->names[i]);
1166  return s;
1167}
1168
1169char * rCharStr(ring r)
1170{
1171  char *s;
1172  int i;
1173
1174  if (r->parameter==NULL)
1175  {
1176    i=r->ch;
1177    if(i==-1)
1178      s=mstrdup("real");                    /* R */
1179    else
1180    {
1181      s=(char *)AllocL(6);
1182      sprintf(s,"%d",i);                   /* Q, Z/p */
1183    }
1184    return s;
1185  }
1186  int l=0;
1187  for(i=0; i<rPar(r);i++)
1188  {
1189    l+=(strlen(r->parameter[i])+1);
1190  }
1191  s=(char *)AllocL(l+6);
1192  s[0]='\0';
1193  if (r->ch<0)       sprintf(s,"%d",-r->ch); /* Fp(a) */
1194  else if (r->ch==1) sprintf(s,"0");         /* Q(a)  */
1195  else
1196  {
1197    sprintf(s,"%d,%s",r->ch,r->parameter[0]); /* Fq  */
1198    return s;
1199  }
1200  char tt[2];
1201  tt[0]=',';
1202  tt[1]='\0';
1203  for(i=0; i<rPar(r);i++)
1204  {
1205    strcat(s,tt);
1206    strcat(s,r->parameter[i]);
1207  }
1208  return s;
1209}
1210
1211char * rParStr(ring r)
1212{
1213  if (r->parameter==NULL) return mstrdup("");
1214
1215  int i;
1216  int l=2;
1217
1218  for (i=0; i<rPar(r); i++)
1219  {
1220    l+=strlen(r->parameter[i])+1;
1221  }
1222  char *s=(char *)AllocL(l);
1223  s[0]='\0';
1224  for (i=0; i<rPar(r)-1; i++)
1225  {
1226    strcat(s,r->parameter[i]);
1227    strcat(s,",");
1228  }
1229  strcat(s,r->parameter[i]);
1230  return s;
1231}
1232
1233char * rString(ring r)
1234{
1235  char *ch=rCharStr(r);
1236  char *var=rVarStr(r);
1237  char *ord=rOrdStr(r);
1238  char *res=(char *)AllocL(strlen(ch)+strlen(var)+strlen(ord)+9);
1239  sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
1240  FreeL((ADDRESS)ch);
1241  FreeL((ADDRESS)var);
1242  FreeL((ADDRESS)ord);
1243  return res;
1244}
1245
1246int rChar(ring r)
1247{
1248  if (r->ch==-1)
1249    return 0;
1250  if (r->parameter==NULL) /* Q, Fp */
1251    return r->ch;
1252  if (r->ch<0)           /* Fp(a)  */
1253    return -r->ch;
1254  if (r->ch==1)          /* Q(a)  */
1255    return 0;
1256  /*else*/               /* GF(p,n) */
1257  {
1258    if ((r->ch & 1)==0) return 2;
1259    int i=3;
1260    while ((r->ch % i)!=0) i+=2;
1261    return i;
1262  }
1263}
1264
1265int    rIsExtension(ring r)
1266{
1267  if (r->parameter==NULL) /* Q, Fp */
1268    return FALSE;
1269  else
1270    return TRUE;
1271}
1272
1273int    rIsExtension()
1274{
1275  return rIsExtension( currRing );
1276}
1277
1278/*2
1279 *returns -1 for not compatible, (sum is undefined)
1280 *         0 for equal, (and sum)
1281 *         1 for compatible (and sum)
1282 */
1283int rSum(ring r1, ring r2, ring &sum)
1284{
1285  if (r1==r2)
1286  {
1287    sum=r1;
1288    r1->ref++;
1289    return 0;
1290  }
1291  ip_sring tmpR;
1292  memset(&tmpR,0,sizeof(tmpR));
1293  /* check coeff. field =====================================================*/
1294  if (rInternalChar(r1)==rInternalChar(r2))
1295  {
1296    tmpR.ch=rInternalChar(r1);
1297    if (rField_is_Q(r1)||rField_is_Zp(r1)||rField_is_GF(r1)) /*Q, Z/p, GF(p,n)*/
1298    {
1299      if (r1->parameter!=NULL)
1300      {
1301        if (strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1302        {
1303          tmpR.parameter=(char **)Alloc(sizeof(char *));
1304          tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1305          tmpR.P=1;
1306        }
1307        else
1308        {
1309          WerrorS("GF(p,n)+GF(p,n)");
1310          return -1;
1311        }
1312      }
1313    }
1314    else if ((r1->ch==1)||(r1->ch<-1)) /* Q(a),Z/p(a) */
1315    {
1316      if (r1->minpoly!=NULL)
1317      {
1318        if (r2->minpoly!=NULL)
1319        {
1320          nSetChar(r1,TRUE);
1321          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1322              && naEqual(r1->minpoly,r2->minpoly))
1323          {
1324            tmpR.parameter=(char **)Alloc(sizeof(char *));
1325            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1326            tmpR.minpoly=naCopy(r1->minpoly);
1327            tmpR.P=1;
1328            nSetChar(currRing,TRUE);
1329          }
1330          else
1331          {
1332            nSetChar(currRing,TRUE);
1333            WerrorS("different minpolys");
1334            return -1;
1335          }
1336        }
1337        else
1338        {
1339          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1340              && (rPar(r2)==1))
1341          {
1342            tmpR.parameter=(char **)Alloc0(sizeof(char *));
1343            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1344            tmpR.P=1;
1345            nSetChar(r1,TRUE);
1346            tmpR.minpoly=naCopy(r1->minpoly);
1347            nSetChar(currRing,TRUE);
1348          }
1349          else
1350          {
1351            WerrorS("different parameters and minpoly!=0");
1352            return -1;
1353          }
1354        }
1355      }
1356      else /* r1->minpoly==NULL */
1357      {
1358        if (r2->minpoly!=NULL)
1359        {
1360          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1361              && (rPar(r1)==1))
1362          {
1363            tmpR.parameter=(char **)Alloc(sizeof(char *));
1364            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1365            tmpR.P=1;
1366            nSetChar(r2,TRUE);
1367            tmpR.minpoly=naCopy(r2->minpoly);
1368            nSetChar(currRing,TRUE);
1369          }
1370          else
1371          {
1372            WerrorS("different parameters and minpoly!=0");
1373            return -1;
1374          }
1375        }
1376        else
1377        {
1378          int len=rPar(r1)+rPar(r2);
1379          tmpR.parameter=(char **)Alloc(len*sizeof(char *));
1380          int i;
1381          for (i=0;i<rPar(r1);i++)
1382          {
1383            tmpR.parameter[i]=mstrdup(r1->parameter[i]);
1384          }
1385          int j,l;
1386          for(j=0;j<rPar(r2);j++)
1387          {
1388            for(l=0;l<i;l++)
1389            {
1390              if(strcmp(tmpR.parameter[l],r2->parameter[j])==0)
1391                break;
1392            }
1393            if (l==i)
1394            {
1395              tmpR.parameter[i]=mstrdup(r2->parameter[j]);
1396              i++;
1397            }
1398          }
1399          if (i!=len)
1400          {
1401            ReAlloc(tmpR.parameter,len*sizeof(char *),i*sizeof(char *));
1402          }
1403        }
1404      }
1405    }
1406  }
1407  else /* r1->ch!=r2->ch */
1408  {
1409    if (r1->ch<-1) /* Z/p(a) */
1410    {
1411      if ((r2->ch==0) /* Q */
1412          || (r2->ch==-r1->ch)) /* Z/p */
1413      {
1414        tmpR.ch=rInternalChar(r1);
1415        tmpR.parameter=(char **)Alloc(rPar(r1)*sizeof(char *));
1416        tmpR.P=rPar(r1);
1417        memcpy(tmpR.parameter,r1->parameter,rPar(r1)*sizeof(char *));
1418        if (r1->minpoly!=NULL)
1419        {
1420          nSetChar(r1,TRUE);
1421          tmpR.minpoly=naCopy(r1->minpoly);
1422          nSetChar(currRing,TRUE);
1423        }
1424      }
1425      else  /* R, Q(a),Z/q,Z/p(a),GF(p,n) */
1426      {
1427        WerrorS("Z/p(a)+(R,Q(a),Z/q(a),GF(q,n))");
1428        return -1;
1429      }
1430    }
1431    else if (r1->ch==-1) /* R */
1432    {
1433      WerrorS("R+..");
1434      return -1;
1435    }
1436    else if (r1->ch==0) /* Q */
1437    {
1438      if ((r2->ch<-1)||(r2->ch==1)) /* Z/p(a),Q(a) */
1439      {
1440        tmpR.ch=rInternalChar(r2);
1441        tmpR.P=rPar(r2);
1442        tmpR.parameter=(char **)Alloc(rPar(r2)*sizeof(char *));
1443        memcpy(tmpR.parameter,r2->parameter,rPar(r2)*sizeof(char *));
1444        if (r2->minpoly!=NULL)
1445        {
1446          nSetChar(r1,TRUE);
1447          tmpR.minpoly=naCopy(r2->minpoly);
1448          nSetChar(currRing,TRUE);
1449        }
1450      }
1451      else if (r2->ch>1) /* Z/p,GF(p,n) */
1452      {
1453        tmpR.ch=r2->ch;
1454        if (r2->parameter!=NULL)
1455        {
1456          tmpR.parameter=(char **)Alloc(sizeof(char *));
1457          tmpR.P=1;
1458          tmpR.parameter[0]=mstrdup(r2->parameter[0]);
1459        }
1460      }
1461      else
1462      {
1463        WerrorS("Q+R");
1464        return -1; /* R */
1465      }
1466    }
1467    else if (r1->ch==1) /* Q(a) */
1468    {
1469      if (r2->ch==0) /* Q */
1470      {
1471        tmpR.ch=rInternalChar(r1);
1472        tmpR.P=rPar(r1);
1473        tmpR.parameter=(char **)Alloc0(rPar(r1)*sizeof(char *));
1474        int i;
1475        for(i=0;i<rPar(r1);i++)
1476        {
1477          tmpR.parameter[i]=mstrdup(r1->parameter[i]);
1478        }
1479        if (r1->minpoly!=NULL)
1480        {
1481          nSetChar(r1,TRUE);
1482          tmpR.minpoly=naCopy(r1->minpoly);
1483          nSetChar(currRing,TRUE);
1484        }
1485      }
1486      else  /* R, Z/p,GF(p,n) */
1487      {
1488        WerrorS("Q(a)+(R,Z/p,GF(p,n))");
1489        return -1;
1490      }
1491    }
1492    else /* r1->ch >=2 , Z/p */
1493    {
1494      if (r2->ch==0) /* Q */
1495      {
1496        tmpR.ch=r1->ch;
1497      }
1498      else if (r2->ch==-r1->ch) /* Z/p(a) */
1499      {
1500        tmpR.ch=rInternalChar(r2);
1501        tmpR.P=rPar(r2);
1502        tmpR.parameter=(char **)Alloc(rPar(r2)*sizeof(char *));
1503        int i;
1504        for(i=0;i<rPar(r2);i++)
1505        {
1506          tmpR.parameter[i]=mstrdup(r2->parameter[i]);
1507        }
1508        if (r2->minpoly!=NULL)
1509        {
1510          nSetChar(r2,TRUE);
1511          tmpR.minpoly=naCopy(r2->minpoly);
1512          nSetChar(currRing,TRUE);
1513        }
1514      }
1515      else
1516      {
1517        WerrorS("Z/p+(GF(q,n),Z/q(a),R,Q(a))");
1518        return -1; /* GF(p,n),Z/q(a),R,Q(a) */
1519      }
1520    }
1521  }
1522  /* variable names ========================================================*/
1523  int i,j,k;
1524  int l=r1->N+r2->N;
1525  char **names=(char **)Alloc0(l*sizeof(char*));
1526  k=0;
1527
1528  // collect all varnames from r1, except those which are parameters
1529  // of r2, or those which are the empty string
1530  for (i=0;i<r1->N;i++)
1531  {
1532    BOOLEAN b=TRUE;
1533
1534    if (*(r1->names[i]) == '\0')
1535      b = FALSE;
1536    else if ((r2->parameter!=NULL) && (strlen(r1->names[i])==1))
1537    {
1538      for(j=0;j<rPar(r2);j++)
1539      {
1540        if (strcmp(r1->names[i],r2->parameter[j])==0)
1541        {
1542          b=FALSE;
1543          break;
1544        }
1545      }
1546    }
1547
1548    if (b)
1549    {
1550      //Print("name : %d: %s\n",k,r1->names[i]);
1551      names[k]=mstrdup(r1->names[i]);
1552      k++;
1553    }
1554    //else
1555    //  Print("no name (par1) %s\n",r1->names[i]);
1556  }
1557  // Add variables from r2, except those which are parameters of r1
1558  // those which are empty strings, and those which equal a var of r1
1559  for(i=0;i<r2->N;i++)
1560  {
1561    BOOLEAN b=TRUE;
1562
1563    if (*(r2->names[i]) == '\0')
1564      b = FALSE;
1565    else if ((r1->parameter!=NULL) && (strlen(r2->names[i])==1))
1566    {
1567      for(j=0;j<rPar(r1);j++)
1568      {
1569        if (strcmp(r2->names[i],r1->parameter[j])==0)
1570        {
1571          b=FALSE;
1572          break;
1573        }
1574      }
1575    }
1576
1577    if (b)
1578    {
1579      for(j=0;j<r1->N;j++)
1580      {
1581        if (strcmp(r1->names[j],r2->names[i])==0)
1582        {
1583          b=FALSE;
1584          break;
1585        }
1586      }
1587      if (b)
1588      {
1589        names[k]=mstrdup(r2->names[i]);
1590        //Print("name : %d : %s\n",k,r2->names[i]);
1591        k++;
1592      }
1593      //else
1594      //  Print("no name (var): %s\n",r2->names[i]);
1595    }
1596    //else
1597    //  Print("no name (par): %s\n",r2->names[i]);
1598  }
1599  // check whether we found any vars at all
1600  if (k == 0)
1601  {
1602    names[k]=mstrdup("");
1603    k=1;
1604  }
1605  tmpR.N=k;
1606  tmpR.names=names;
1607  /* ordering *======================================================== */
1608  tmpR.OrdSgn=1;
1609  if ((r1->order[0]==ringorder_unspec)
1610      && (r2->order[0]==ringorder_unspec))
1611  {
1612    tmpR.order=(int*)Alloc(3*sizeof(int));
1613    tmpR.block0=(int*)Alloc(3*sizeof(int));
1614    tmpR.block1=(int*)Alloc(3*sizeof(int));
1615    tmpR.wvhdl=(short**)Alloc0(3*sizeof(short*));
1616    tmpR.order[0]=ringorder_unspec;
1617    tmpR.order[1]=ringorder_C;
1618    tmpR.order[2]=0;
1619    tmpR.block0[0]=1;
1620    tmpR.block1[0]=tmpR.N;
1621  }
1622  else if (l==k) /* r3=r1+r2 */
1623  {
1624    int b;
1625    ring rb;
1626    if (r1->order[0]==ringorder_unspec)
1627    {
1628      /* extend order of r2 to r3 */
1629      b=rBlocks(r2);
1630      rb=r2;
1631      tmpR.OrdSgn=r2->OrdSgn;
1632    }
1633    else if (r2->order[0]==ringorder_unspec)
1634    {
1635      /* extend order of r1 to r3 */
1636      b=rBlocks(r1);
1637      rb=r1;
1638      tmpR.OrdSgn=r1->OrdSgn;
1639    }
1640    else
1641    {
1642      b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
1643      rb=NULL;
1644    }
1645    tmpR.order=(int*)Alloc0(b*sizeof(int));
1646    tmpR.block0=(int*)Alloc0(b*sizeof(int));
1647    tmpR.block1=(int*)Alloc0(b*sizeof(int));
1648    tmpR.wvhdl=(short**)Alloc0(b*sizeof(short*));
1649    if (rb!=NULL)
1650    {
1651      for (i=0;i<b;i++)
1652      {
1653        tmpR.order[i]=rb->order[i];
1654        tmpR.block0[i]=rb->block0[i];
1655        tmpR.block1[i]=rb->block1[i];
1656        if (rb->wvhdl[i]!=NULL)
1657          WarnS("rSum: weights not implemented");
1658      }
1659      tmpR.block0[0]=1;
1660    }
1661    else /* ring sum for complete rings */
1662    {
1663      for (i=0;r1->order[i]!=0;i++)
1664      {
1665        tmpR.order[i]=r1->order[i];
1666        tmpR.block0[i]=r1->block0[i];
1667        tmpR.block1[i]=r1->block1[i];
1668        if (r1->wvhdl[i]!=NULL)
1669        {
1670          int l=mmSizeL(r1->wvhdl[i]);
1671          tmpR.wvhdl[i]=(short *)AllocL(l);
1672          memcpy(tmpR.wvhdl[i],r1->wvhdl[i],l);
1673        }
1674      }
1675      j=i;
1676      i--;
1677      if ((r1->order[i]==ringorder_c)
1678          ||(r1->order[i]==ringorder_C))
1679      {
1680        j--;
1681        tmpR.order[b-2]=r1->order[i];
1682      }
1683      for (i=0;r2->order[i]!=0;i++,j++)
1684      {
1685        if ((r2->order[i]!=ringorder_c)
1686            &&(r2->order[i]!=ringorder_C))
1687        {
1688          tmpR.order[j]=r2->order[i];
1689          tmpR.block0[j]=r2->block0[i]+r1->N;
1690          tmpR.block1[j]=r2->block1[i]+r1->N;
1691          if (r2->wvhdl[i]!=NULL)
1692          {
1693            int l=mmSizeL(r2->wvhdl[i]);
1694            tmpR.wvhdl[j]=(short *)AllocL(l);
1695            memcpy(tmpR.wvhdl[j],r2->wvhdl[i],l);
1696          }
1697        }
1698      }
1699      if((r1->OrdSgn==-1)||(r2->OrdSgn==-1))
1700        tmpR.OrdSgn=-1;
1701    }
1702  }
1703  else if ((k==r1->N) && (k==r2->N)) /* r1 and r2 are "quite" the same ring */
1704    /* copy r1, because we have the variables from r1 */
1705  {
1706    int b=rBlocks(r1);
1707
1708    tmpR.order=(int*)Alloc0(b*sizeof(int));
1709    tmpR.block0=(int*)Alloc0(b*sizeof(int));
1710    tmpR.block1=(int*)Alloc0(b*sizeof(int));
1711    tmpR.wvhdl=(short**)Alloc0(b*sizeof(short*));
1712    for (i=0;i<b;i++)
1713    {
1714      tmpR.order[i]=r1->order[i];
1715      tmpR.block0[i]=r1->block0[i];
1716      tmpR.block1[i]=r1->block1[i];
1717      if (r1->wvhdl[i]!=NULL)
1718      {
1719        int l=mmSizeL(r1->wvhdl[i]);
1720        tmpR.wvhdl[i]=(short *)AllocL(l);
1721        memcpy(tmpR.wvhdl[i],r1->wvhdl[i],l);
1722      }
1723    }
1724    tmpR.OrdSgn=r1->OrdSgn;
1725  }
1726  else
1727  {
1728    for(i=0;i<k;i++) FreeL((ADDRESS)tmpR.names[i]);
1729    Free((ADDRESS)names,tmpR.N*sizeof(char *));
1730    Werror("difficulties with variables: %d,%d -> %d",r1->N,r2->N,k);
1731    return -1;
1732  }
1733  sum=(ring)Alloc(sizeof(ip_sring));
1734  memcpy(sum,&tmpR,sizeof(ip_sring));
1735  rComplete(sum);
1736  return 1;
1737}
1738
1739/*2
1740 * create a copy of the ring r, which must be equivalent to currRing
1741 * used for qring definition,..
1742 * (i.e.: normal rings: same nCopy as currRing;
1743 *        qring:        same nCopy, same idCopy as currRing)
1744 */
1745ring rCopy(ring r)
1746{
1747  if (r == NULL) return NULL;
1748  int i,j;
1749  int *pi;
1750  ring res=(ring)Alloc(sizeof(ip_sring));
1751
1752  memcpy4(res,r,sizeof(ip_sring));
1753  res->ref=0;
1754  if (r->parameter!=NULL)
1755  {
1756    res->minpoly=nCopy(r->minpoly);
1757    int l=rPar(r);
1758    res->parameter=(char **)Alloc(l*sizeof(char *));
1759    int i;
1760    for(i=0;i<rPar(r);i++)
1761    {
1762      res->parameter[i]=mstrdup(r->parameter[i]);
1763    }
1764  }
1765  res->names   = (char **)Alloc(r->N * sizeof(char *));
1766  i=1;
1767  pi=r->order;
1768  while ((*pi)!=0) { i++;pi++; }
1769  res->wvhdl   = (short **)Alloc(i * sizeof(short *));
1770  res->order   = (int *)   Alloc(i * sizeof(int));
1771  res->block0  = (int *)   Alloc(i * sizeof(int));
1772  res->block1  = (int *)   Alloc(i * sizeof(int));
1773  for (j=0; j<i; j++)
1774  {
1775    if (r->wvhdl[j]!=NULL)
1776    {
1777      res->wvhdl[j]=(short*)AllocL(mmSizeL((ADDRESS)r->wvhdl[j]));
1778      memcpy(res->wvhdl[j],r->wvhdl[j],mmSizeL((ADDRESS)r->wvhdl[j]));
1779    }
1780    else
1781      res->wvhdl[j]=NULL;
1782  }
1783  memcpy4(res->order,r->order,i * sizeof(int));
1784  memcpy4(res->block0,r->block0,i * sizeof(int));
1785  memcpy4(res->block1,r->block1,i * sizeof(int));
1786  for (i=0; i<res->N; i++)
1787  {
1788    res->names[i] = mstrdup(r->names[i]);
1789  }
1790  res->idroot = NULL;
1791  if (r->qideal!=NULL) res->qideal= idCopy(r->qideal);
1792  res->VarOffset = (int*) Alloc((r->N + 1)*sizeof(int));
1793  memcpy4(res->VarOffset, r->VarOffset, (r->N + 1)*sizeof(int));
1794
1795#ifdef RDEBUG
1796  rNumber++;
1797  res->no=rNumber;
1798#endif
1799
1800  return res;
1801}
1802
1803rOrderType_t rGetOrderType(ring r)
1804{
1805  // check for simple ordering
1806  if (rHasSimpleOrder(r))
1807  {
1808    if ((r->order[1] == ringorder_c) || (r->order[1] == ringorder_C))
1809    {
1810      switch(r->order[0])
1811      {
1812          case ringorder_dp:
1813          case ringorder_wp:
1814          case ringorder_ds:
1815          case ringorder_ws:
1816          case ringorder_ls:
1817          case ringorder_unspec:
1818            if (r->order[1] == ringorder_C ||  r->order[0] == ringorder_unspec)
1819              return rOrderType_ExpComp;
1820            return rOrderType_Exp;
1821
1822          default:
1823            assume(r->order[0] == ringorder_lp ||
1824                   r->order[0] == ringorder_Dp ||
1825                   r->order[0] == ringorder_Wp ||
1826                   r->order[0] == ringorder_Ds ||
1827                   r->order[0] == ringorder_Ws);
1828
1829            if (r->order[1] == ringorder_c) return rOrderType_ExpComp;
1830            return rOrderType_Exp;
1831      }
1832    }
1833    else
1834    {
1835      assume((r->order[0]==ringorder_c)||(r->order[0]==ringorder_C));
1836      return rOrderType_CompExp;
1837    }
1838  }
1839  else
1840    return rOrderType_General;
1841}
1842
1843BOOLEAN rHasSimpleOrder(ring r)
1844{
1845  return
1846    (r->order[0] == ringorder_unspec) ||
1847    ((r->order[2] == 0) &&
1848     (r->order[1] != ringorder_M &&
1849      r->order[0] != ringorder_M));
1850}
1851
1852// returns TRUE, if simple lp or ls ordering
1853BOOLEAN rHasSimpleLexOrder(ring r)
1854{
1855  return rHasSimpleOrder(r) &&
1856    (r->order[0] == ringorder_ls ||
1857     r->order[0] == ringorder_lp ||
1858     r->order[1] == ringorder_ls ||
1859     r->order[1] == ringorder_lp);
1860}
1861
1862BOOLEAN rIsPolyVar(int v)
1863{
1864  int  i=0;
1865  while(currRing->order[i]!=0)
1866  {
1867    if((currRing->block0[i]<=v)
1868    && (currRing->block1[i]>=v))
1869    {
1870      switch(currRing->order[i])
1871      {
1872        case ringorder_a:
1873          return (currRing->wvhdl[i][v-currRing->block0[i]]>0);
1874        case ringorder_M:
1875          return 2; /*don't know*/
1876        case ringorder_lp:
1877        case ringorder_dp:
1878        case ringorder_Dp:
1879        case ringorder_wp:
1880        case ringorder_Wp:
1881          return TRUE;
1882        case ringorder_ls:
1883        case ringorder_ds:
1884        case ringorder_Ds:
1885        case ringorder_ws:
1886        case ringorder_Ws:
1887          return FALSE;
1888        default:
1889          break;
1890      }
1891    }
1892    i++;
1893  }
1894  return 3; /* could not find var v*/
1895}
1896
1897void rUnComplete(ring r)
1898{
1899  Free((ADDRESS)r->VarOffset,(r->N + 1)*sizeof(int));
1900  r->VarOffset=NULL;
1901}
1902
1903#ifdef RDEBUG
1904// This should eventually become a full-fledge ring check, like pTest
1905BOOLEAN rDBTest(ring r, char* fn, int l)
1906{
1907  if (r == NULL)
1908  {
1909    Werror("Null ring in %s:%l\n", fn, l);
1910    return false;
1911  }
1912
1913  if (r->N == 0) return true;
1914
1915  if (r->VarOffset == NULL)
1916  {
1917    Werror("Null ring VarOffset -- no rComplete (?) in n %s:%d\n", fn, l);
1918    assume(0);
1919    return false;
1920  }
1921
1922  int
1923    VarCompIndex = r->VarCompIndex,
1924    VarLowIndex  = r->VarLowIndex,
1925    VarHighIndex = r->VarHighIndex,
1926    i;
1927  BOOLEAN ok = false;
1928  int* VarOffset = r->VarOffset;
1929
1930  rComplete(r);
1931
1932  if (   VarCompIndex != r->VarCompIndex ||
1933         VarLowIndex  != r->VarLowIndex ||
1934         VarHighIndex != r->VarHighIndex)
1935  {
1936    Werror("Wrong ring VarIndicies -- no rComplete (?) in n %s:%d\n", fn, l);
1937    assume(0);
1938    ok = FALSE;
1939  }
1940
1941  for (i=0; i<=r->N; i++)
1942  {
1943    if (VarOffset[i] != r->VarOffset[i])
1944    {
1945      Werror("Wrong VarOffset value at %d in %s:%d\n", i, fn, l);
1946      assume(0);
1947      ok = FALSE;
1948    }
1949  }
1950  Free(r->VarOffset, (r->N + 1)*sizeof(int));
1951  r->VarOffset = VarOffset;
1952  return ok;
1953}
1954#endif
Note: See TracBrowser for help on using the repository browser.