Changeset 4eba817 in git


Ignore:
Timestamp:
Apr 30, 2002, 3:35:13 PM (22 years ago)
Author:
Viktor Levandovskyy <levandov@…>
Branches:
(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')
Children:
91b808770714f9b76e06cecd29f35a4cdf6bf00c
Parents:
2046267d83481dfd8aa02dc90f726ed6a1f158b2
Message:
Big Plural Update


git-svn-id: file:///usr/local/Singular/svn/trunk@6078 2c84dea3-7e68-4137-9b89-c4e89433aadc
Location:
Singular
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • Singular/Makefile.in

    r204626 r4eba817  
    9595# normal C++ source files
    9696CXXSOURCES=grammar.cc scanner.cc algmap.cc attrib.cc clapconv.cc \
    97     clapsing.cc mminit.cc\
     97    clapsing.cc mminit.cc eigenval.cc\
    9898    extra.cc febase.cc feread.cc fehelp.cc feResource.cc feOpt.cc \
    9999    ffields.cc hdegree.cc hilb.cc hutil.cc \

  • Singular/eigenval.h

    r204626 r4eba817  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: eigenval.h,v 1.3 2002-02-16 18:26:07 mschulze Exp $ */
     4/* $Id: eigenval.h,v 1.4 2002-04-30 13:35:09 levandov Exp $ */
    55/*
    66* ABSTRACT: eigenvalues of constant square matrices
    … …  
    99#ifndef EIGENVAL_H
    1010#define EIGENVAL_H
     11#ifdef HAVE_EIGENVAL
    1112
    1213matrix evSwap(matrix M,int i,int j);
    … …  
    2122BOOLEAN evEigenvals(leftv res,leftv h);
    2223
     24#endif /* ifdef HAVE_EIGENVAL */
    2325#endif /* EIGENVAL_H */

  • Singular/extra.cc

    r204626 r4eba817  
    22*  Computer Algebra System SINGULAR      *
    33*****************************************/
    4 /* $Id: extra.cc,v 1.181 2002-04-24 13:34:52 anne Exp $ */
     4/* $Id: extra.cc,v 1.182 2002-04-30 13:35:09 levandov Exp $ */
    55/*
    66* ABSTRACT: general interface to internals of Singular ("system" command)
    … …  
    13861386        for(j=i+1;j<=nv;j++)
    13871387        {
    1388           if (MATELEM(D,i,j)==NULL)
     1388          if (MATELEM(D,i,j)==NULL) /* quasicommutative case */
    13891389          {
    1390             currRing->nc->MTsize[UPMATELEM(i,j,currRing->N)]=0;
     1390            currRing->nc->MTsize[UPMATELEM(i,j,currRing->N)]=1;
     1391            /* 1x1 mult.matrix */
     1392            currRing->nc->MT[UPMATELEM(i,j,currRing->N)]=mpNew(1,1);
    13911393          }
    1392           else
     1394          else /* pure noncommutative case*/
    13931395          {
    13941396            MATELEM(COM,i,j)=NULL;
    13951397            currRing->nc->MTsize[UPMATELEM(i,j,currRing->N)]=DefMTsize; /* default sizes */
    13961398            currRing->nc->MT[UPMATELEM(i,j,currRing->N)]=mpNew(DefMTsize,DefMTsize);
    1397             p=pOne();
    1398             pSetCoeff(p,nCopy(pGetCoeff(MATELEM(currRing->nc->C,i,j))));
    1399             pSetExp(p,i,1);
    1400             pSetExp(p,j,1);
    1401             pSetm(p);
    1402             p=pAdd(p,pCopy(MATELEM(currRing->nc->D,i,j)));
    1403             MATELEM(currRing->nc->MT[UPMATELEM(i,j,currRing->N)],1,1)=p;
    1404           }
    1405 
    1406           /* set MT[i,j,1,1] to c_i_j*x_i*x_j + D_i_j */
    1407         }
     1399          }
     1400          p=pOne();
     1401          pSetCoeff(p,nCopy(pGetCoeff(MATELEM(currRing->nc->C,i,j))));
     1402          pSetExp(p,i,1);
     1403          pSetExp(p,j,1);
     1404          pSetm(p);
     1405          p=pAdd(p,pCopy(MATELEM(currRing->nc->D,i,j)));
     1406          MATELEM(currRing->nc->MT[UPMATELEM(i,j,currRing->N)],1,1)=p;
     1407        }
     1408        /* set MT[i,j,1,1] to c_i_j*x_i*x_j + D_i_j */
    14081409      }
    14091410

  • Singular/gr_kstd2.cc

    r204626 r4eba817  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: gr_kstd2.cc,v 1.3 2001-10-09 16:36:01 Singular Exp $ */
     4/* $Id: gr_kstd2.cc,v 1.4 2002-04-30 13:35:10 levandov Exp $ */
    55/* $Log: not supported by cvs2svn $
    6 /* Revision 1.2  2001/08/27 14:47:00  Singular
    7 /* *hannes: merge-2-0-2
     6/* Revision 1.1.2.3  2001/09/25 15:39:01  Singular
     7/* *hannes: PLURAL syntax fixes
    88/*
    99/* Revision 1.1.2.2  2001/08/16 13:17:29  Singular
    … …  
    4040#include "intvec.h"
    4141#include "tok.h"
     42#include "gring.h"
    4243
    4344/*2
    … …  
    5960
    6061/*2
     62*reduces h with elements from T choosing  the first possible
     63* element in t with respect to the given pDivisibleBy
     64*/
     65int redGrFirst (LObject* h,kStrategy strat)
     66{
     67  int at,reddeg,d,i;
     68  int pass = 0;
     69  int j = 0;
     70
     71  d = pFDeg((*h).p)+(*h).ecart;
     72  reddeg = strat->LazyDegree+d;
     73  loop
     74  {
     75    if (j > strat->sl)
     76    {
     77      if (TEST_OPT_DEBUG) PrintLn();
     78      return 0;
     79    }
     80    if (TEST_OPT_DEBUG) Print("%d",j);
     81    if (pDivisibleBy(strat->S[j],(*h).p))
     82    {
     83      if (TEST_OPT_DEBUG) PrintS("+\n");
     84      /*
     85      * the polynomial to reduce with is;
     86      * T[j].p
     87      */
     88      if (!TEST_OPT_INTSTRATEGY)
     89        pNorm(strat->S[j]);
     90      if (TEST_OPT_DEBUG)
     91      {
     92        wrp(h->p);
     93        PrintS(" with ");
     94        wrp(strat->S[j]);
     95      }
     96      (*h).p = nc_spGSpolyRed(strat->S[j],(*h).p, NULL, currRing);
     97      //spSpolyRed(strat->T[j].p,(*h).p,strat->kNoether);
     98     
     99      if (TEST_OPT_DEBUG)
     100      {
     101        PrintS(" to ");
     102        wrp(h->p);
     103      }
     104      if ((*h).p == NULL)
     105      {
     106        if (h->lcm!=NULL) p_LmFree((*h).lcm, currRing);
     107        return 0;
     108      }
     109      /*computes the ecart*/
     110      d = pLDeg((*h).p,&((*h).length));
     111      (*h).ecart = d-pFDeg((*h).p);
     112      if ((strat->syzComp!=0) && !strat->honey)
     113      {
     114        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
     115        {
     116          if (TEST_OPT_DEBUG) PrintS(" > sysComp\n");
     117          return 0;
     118        }
     119      }
     120      /*- try to reduce the s-polynomial -*/
     121      pass++;
     122      /*
     123      *test whether the polynomial should go to the lazyset L
     124      *-if the degree jumps
     125      *-if the number of pre-defined reductions jumps
     126      */
     127      // if ((strat->Ll >= 0)
     128//       && ((d >= reddeg) || (pass > strat->LazyPass))
     129//       && !strat->homog)
     130//       {
     131//         at = strat->posInL(strat->L,strat->Ll,*h,strat);
     132//         if (at <= strat->Ll)
     133//         {
     134//           i=strat->sl+1;
     135//           do
     136//           {
     137//             i--;
     138//             if (i<0) return;
     139//           } while (!pDivisibleBy(strat->S[i],(*h).p));
     140//           enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
     141//           if (TEST_OPT_DEBUG) Print(" degree jumped; ->L%d\n",at);
     142//           (*h).p = NULL;
     143//           return;
     144//         }
     145//       }
     146      if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d >= reddeg))
     147      {
     148        reddeg = d+1;
     149        Print(".%d",d);mflush();
     150      }
     151      j = 0;
     152      if TEST_OPT_DEBUG PrintLn();
     153    }
     154    else
     155    {
     156      if (TEST_OPT_DEBUG) PrintS("-");
     157      j++;
     158    }
     159  }
     160}
     161
     162/*2
    61163*  reduction procedure for the homogeneous case
    62164*  and the case of a degree-ordering
    … …  
    66168  if (strat->tl<0)
    67169  {
    68     enterTBba((*h),0,strat);
     170    enterT((*h),strat);
    69171    return 1;
    70172  }
    … …  
    88190        wrp(strat->S[j]);
    89191      }
    90       if (strat->interpt) test_int_std(strat->kIdeal);
    91192      /*- compute the s-polynomial -*/
    92       (*h).p = spSpolyRed(strat->S[j],(*h).p,strat->kNoether);
     193      (*h).p = nc_spGSpolyRed(strat->S[j],(*h).p,strat->kNoether,currRing);
    93194      if ((*h).p == NULL)
    94195      {
    … …  
    103204*        if (pMinComp((*h).p) > strat->syzComp)
    104205*        {
    105 *          enterTBba((*h),strat->tl+1,strat);
     206*          enterT((*h),strat);
    106207*          return;
    107208*        }
    … …  
    115216      if (j >= strat->sl)
    116217      {
    117         enterTBba((*h),strat->tl+1,strat);
     218        enterT((*h),strat);
    118219        return 1;
    119220      }
    … …  
    131232  if (strat->tl<0)
    132233  {
    133     enterTBba((*h),0,strat);
     234    enterT((*h),strat);
    134235    return 0;
    135236  }
    … …  
    149250    if (pDivisibleBy(strat->T[j].p,(*h).p))
    150251    {
    151       if (strat->interpt) test_int_std(strat->kIdeal);
    152252      if (TEST_OPT_DEBUG)
    153253      {
    … …  
    156256      }
    157257      /*- compute the s-polynomial -*/
    158       (*h).p = spSpolyRed(strat->T[j].p,(*h).p,strat->kNoether);
     258      (*h).p = nc_spGSpolyRed(strat->T[j].p,(*h).p,strat->kNoether,currRing);
    159259      if ((*h).p == NULL)
    160260      {
    … …  
    173273*         (*h).length=pLength0((*h).p);
    174274*/
    175           k=strat->posInT(strat->T,strat->tl,(*h));
    176           enterTBba((*h),k,strat);
     275          enterT((*h),strat);
    177276          return 0;
    178277        }
    … …  
    190289*       (*h).length=pLength0((*h).p);
    191290*/
    192         k=strat->posInT(strat->T,strat->tl,(*h));
    193         enterTBba((*h),k,strat);
     291        enterT((*h),strat);
    194292        return 0;
    195293      }
    … …  
    207305  if (strat->tl<0)
    208306  {
    209     enterTBba((*h),0,strat);
     307    enterT((*h),strat);
    210308    return 0;
    211309  }
    … …  
    227325    if (pDivisibleBy(strat->S[j],(*h).p))
    228326    {
    229       if (strat->interpt) test_int_std(strat->kIdeal);
    230327      if (TEST_OPT_DEBUG)
    231328      {
    … …  
    234331      }
    235332      /*- compute the s-polynomial -*/
    236       (*h).p = spSpolyRed(strat->S[j],(*h).p,strat->kNoether);
     333      (*h).p = nc_spGSpolyRed(strat->S[j],(*h).p,strat->kNoether,currRing);
    237334      if ((*h).p == NULL)
    238335      {
    … …  
    272369            if (i<0)
    273370            {
    274               enterTBba((*h),strat->tl+1,strat);
     371              enterT((*h),strat);
    275372              return 0;
    276373            }
    … …  
    301398          pCleardenom(h->p);// also does a pContent
    302399        }
    303         enterTBba((*h),strat->tl+1,strat);
     400        enterT((*h),strat);
    304401        return 0;
    305402      }
    … …  
    318415  if (strat->tl<0)
    319416  {
    320     enterTBba((*h),0,strat);
     417    enterT((*h),strat);
    321418    return 0;
    322419  }
    … …  
    397494      {
    398495        strat->fromT=FALSE;
    399         (*h).p = spSpolyRedNew(pi,(*h).p,strat->kNoether);
     496        (*h).p = nc_spGSpolyRedNew(pi,(*h).p,strat->kNoether,currRing);
    400497      }
    401498      else
    402         (*h).p = spSpolyRed(pi,(*h).p,strat->kNoether);
     499        (*h).p = nc_spGSpolyRed(pi,(*h).p,strat->kNoether,currRing);
    403500      if (TEST_OPT_DEBUG)
    404501      {
    … …  
    450547            if (i<0)
    451548            {
    452               at=strat->posInT(strat->T,strat->tl,(*h));
    453               enterTBba((*h),at,strat);
     549              enterT((*h),strat);
    454550              return 0;
    455551            }
    … …  
    480576          pCleardenom(h->p);// also does a pContent
    481577        }
    482         at=strat->posInT(strat->T,strat->tl,(*h));
    483         enterTBba((*h),at,strat);
     578        enterT((*h),strat);
    484579        return 0;
    485580      }
    … …  
    497592  if (strat->tl<0)
    498593  {
    499     enterTBba((*h),0,strat);
     594    enterT((*h),strat);
    500595    return 0;
    501596  }
    … …  
    513608    if (pDivisibleBy(strat->T[j].p,(*h).p))
    514609    {
    515       if (strat->interpt) test_int_std(strat->kIdeal);
    516610      /* compute the s-polynomial */
    517611      if (!TEST_OPT_INTSTRATEGY) pNorm((*h).p);
    … …  
    525619      else
    526620#endif
    527       p = spSpolyShortBba(strat->T[j].p,(*h).p);
     621      p = nc_spShort(strat->T[j].p,(*h).p);
    528622      /* computes only the first monomial of the spoly  */
    529623      if (p)
    … …  
    549643              else
    550644#endif
    551               ph = spSpolyShortBba(strat->T[j].p,(*h).p);
     645              ph = nc_spShort(strat->T[j].p,(*h).p);
    552646              if (ph==NULL)
    553647              {
    … …  
    561655                return 0;
    562656              }
    563               else if (pComp0(ph,p) == -1)
     657              else if (pLmCmp(ph,p) == -1)
    564658              {
    565659                pLmFree(p);
    … …  
    575669        }
    576670        pLmFree(p);
    577         (*h).p = spSpolyRed(strat->T[jbest].p,(*h).p,strat->kNoether);
     671        (*h).p = nc_spGSpolyRed(strat->T[jbest].p,(*h).p,strat->kNoether,currRing);
    578672      }
    579673      else
    … …  
    583677          pLmFree((*h).lcm);
    584678          (*h).lcm=NULL;
    585         }
     679        } 
    586680        (*h).p = NULL;
    587681        return 0;
    … …  
    637731          pCleardenom(h->p);// also does a pContent
    638732        }
    639         at=strat->posInT(strat->T,strat->tl,(*h));
    640         enterTBba((*h),at,strat);
     733        enterT((*h),strat);
    641734        return 0;
    642735      }
    … …  
    662755  else
    663756    strat->red = redHomog;
    664 
     757#ifdef HAVE_PLURAL
     758  if (currRing->nc!=NULL)
     759  {
     760    strat->red = redGrFirst;
     761  }
     762#endif
    665763  if (pLexOrder && strat->honey)
    666764    strat->initEcart = initEcartNormal;
    … …  
    710808
    711809  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
    712   initHilbCrit(F,Q,&hilb,strat);
     810  // initHilbCrit(F,Q,&hilb,strat);
     811  /* in plural we don't need Hilb yet */
    713812  gr_initBba(F,strat);
    714813  initBuchMoraPos(strat);
    … …  
    722821    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
    723822    if (TEST_OPT_DEBUG) messageSets(strat);
    724     test_int_std(strat->kIdeal);
    725823    if (strat->Ll== 0) strat->interpt=TRUE;
    726824    if (TEST_OPT_DEGBOUND
    … …  
    745843      pLmFree(strat->P.p);
    746844      /* the real one */
    747       strat->P.p = spSpolyCreate(strat->P.p1,strat->P.p2,strat->kNoether);
    748     }
    749 #ifdef SDRING
     845      strat->P.p = nc_spGSpolyCreate(strat->P.p1,strat->P.p2,strat->kNoether,currRing);
     846    }
    750847    if (strat->P.p != NULL)
    751 #endif
    752848    {
    753849      if (TEST_OPT_PROT)
    … …  
    763859          /* enter P.p into s and L */
    764860          {
     861            strat->P.sev=0;
    765862            int pos=posInS(strat,strat->sl,strat->P.p, strat->P.ecart);
    766863            {

  • Singular/gring.cc

    r204626 r4eba817  
    77 *  Author:  levandov (Viktor Levandovsky)
    88 *  Created: 8/00 - 11/00
    9  *  Version: $Id: gring.cc,v 1.10 2001-10-09 16:36:02 Singular Exp $
     9 *  Version: $Id: gring.cc,v 1.11 2002-04-30 13:35:10 levandov Exp $
    1010 *******************************************************************/
    1111#include "mod2.h"
    … …  
    8181  Exponent_t expP=0;
    8282  Exponent_t expOut=0;
    83 
     83 
    8484  while (p!=NULL)
    8585  {
    … …  
    8787    p_Test(v,r);
    8888    p_Test(p,r);
    89 
     89   
    9090    expP=p_GetComp(v,r);
    9191    if (expP==0)
    … …  
    9898      {
    9999        expOut=expM;
    100       }
     100      }     
    101101    }
    102102    else
    … …  
    109109      {
    110110        // REPORT_ERROR AND BREAK
    111         Print("exponent mismatch");
    112         expOut=NULL;
     111        Print("exponent mismatch %d and %d\n",expP,expM);
     112        expOut=0;
    113113      }
    114114    }
    115 
     115   
    116116    p_GetExpV(v,P,r);
    117117    cP=p_GetCoeff(v,r);
    … …  
    127127  }
    128128  freeT(P,r->N);
    129 //  freeT(M,r->N);
     129  freeT(M,r->N);
     130  p_Test(out,r);
    130131  return(out);
    131132}
    … …  
    155156  Exponent_t expP=0;
    156157  Exponent_t expOut=0;
    157 
     158 
    158159  while (p!=NULL)
    159160  {
    … …  
    161162    p_Test(v,r);
    162163    p_Test(p,r);
    163 
     164   
    164165    expP=p_GetComp(v,r);
    165166    if (expP==0)
    … …  
    172173      {
    173174        expOut=expM;
    174       }
     175      }     
    175176    }
    176177    else
    … …  
    183184      {
    184185        // REPORT_ERROR AND BREAK
    185         expOut=NULL;
     186        expOut=0;
    186187      }
    187188    }
    188 
     189   
    189190    p_GetExpV(v,P,r);
    190191    cP=p_GetCoeff(v,r);
    … …  
    199200  }
    200201  freeT(P,r->N);
    201 //  freeT(M,r->N);
     202  freeT(M,r->N);
    202203  return(out);
    203204}
    … …  
    222223  F[0]=0;
    223224  G[0]=0;
    224 
     225 
    225226  iF=r->N;
    226227  while ((F[iF]==0)&&(iF>=1)) iF--; /* last exp_num of F */
    … …  
    237238    {
    238239      F[i]=F[i]+G[i];
    239     }
     240    } 
    240241    p_SetExpV(out,F,r);
    241242    p_Setm(out,r);
    … …  
    248249// g is univariate monomial
    249250  {
    250 //    if (ri->nc->type==nc_skew) -- postpone to TU
     251//    if (ri->nc->type==nc_skew) -- postpone to TU   
    251252    out=nc_mm_Mult_uu(F,jG,G[jG],r);
    252253    freeT(F,r->N);
    … …  
    254255    return(out);
    255256  }
    256 
     257 
    257258  number n1=n_Init(1,r);
    258259  Exponent_t *Prv=(Exponent_t *)omAlloc0(ExpSize);
    … …  
    331332       p_Setm(Pn,r);
    332333       p_Test(Pn,r);
    333 
     334       
    334335//       if (pNext(D)==0)
    335336// is D a monomial? could be postponed higher
    … …  
    339340//       else
    340341//       {
    341        Rout=nc_p_Mult_mm(D,Pn,r);
     342       Rout=nc_p_Mult_mm(D,Pn,r); 
    342343//       }
    343344     }
    … …  
    347348       D=NULL;
    348349     }
    349 
     350     
    350351     if (Rout!=NULL)
    351352     {
    … …  
    395396  int i;
    396397  number num=NULL;
    397 
     398 
    398399  int iF=r->N;
    399400  while ((F[iF]==0)&&(iF>0)) iF-- ;   /* last exponent_num of F */
    … …  
    426427   return(out);
    427428  }
    428 
     429 
    429430  Exponent_t *Prv=(Exponent_t*)omAlloc0((r->N+1)*sizeof(Exponent_t));
    430431  Exponent_t *Nxt=(Exponent_t*)omAlloc0((r->N+1)*sizeof(Exponent_t));
    … …  
    518519       kk=lF[cnt+1];
    519520       On[kk]=F[kk];
    520 
     521       
    521522       Pn=pOne();
    522523       p_SetExpV(Pn,On,r);
    … …  
    562563/* leadterm and Prv-part with coef 1 */
    563564//  U[0]=exp;
    564 
     565 
    565566//  U[jG]=U[jG]+bG;  /* make leadterm */
    566567// ??????????? we have done it already :-0
    … …  
    587588}
    588589
    589 //----------pMultUU---------
     590//----------pMultUU--------- 
    590591poly nc_uu_Mult_ww (int i, int a, int j, int b, const ring r)
    591592{
    592   poly out=NULL;
     593  poly out=pOne();
    593594  number tmp_number=NULL;
    594 
    595 //Now check zero exeptions, commutativity and should we do something at all?
    596   out=pOne();
    597   p_SetExp(out,j,b,r);
    598   p_SetExp(out,i,a,r);
    599   if (i==j) p_SetExp(out,j,a+b,r);
     595 
     596//Now check zero exeptions, commutativity and should we do something at all? 
     597  if (i==j)
     598  {
     599    p_SetExp(out,j,a+b,r);
     600  }
     601  else
     602  {
     603    p_SetExp(out,j,b,r);
     604    p_SetExp(out,i,a,r);
     605  }
    600606  p_Setm(out,r);
    601607  if ((a==0)||(b==0)||(i<=j)) return(out);//zero exeptions and usual case
    602 
     608 
    603609  if (MATELEM(r->nc->COM,j,i)!=NULL)
    604610//commutative or quasicommutative case
    … …  
    607613    {
    608614      return(out);
    609     }
     615    }     
    610616    else
    611617    {
    … …  
    629635    return (out);
    630636  }
    631 
    632 //  poly C=MATELEM(r->nc->C,j,i);
    633 //  number c=p_GetCoeff(C,r); //coeff
     637 
     638//  poly C=MATELEM(r->nc->C,j,i);               
     639//  number c=p_GetCoeff(C,r); //coeff           
    634640//  p_Delete(&C,r);
    635 
     641     
    636642  int newcMTsize=0;
    637643  int k,m;
    638644  p_Delete(&out,r);//Shura thinks it is nesessary
    639645
    640 
     646 
    641647  if (a>=b) {newcMTsize=a;} else {newcMTsize=b;}
    642648  if (newcMTsize>cMTsize)
    … …  
    644650     newcMTsize = newcMTsize+cMTsize;
    645651     matrix tmp = mpNew(newcMTsize,newcMTsize);
    646 
     652     
    647653     for (k=1;k<r->N;k++)
    648654     {
    … …  
    662668  poly x=pOne();p_SetExp(x,j,1,r);p_Setm(x,r);//var(j);
    663669  poly y=pOne();p_SetExp(y,i,1,r);p_Setm(y,r);//var(i);  for convenience
    664 
     670 
    665671  poly t=NULL;
    666672/* ------------ Main Cycles ----------------------------*/
    … …  
    679685     t=NULL;
    680686  }
    681 
     687 
    682688  for (m=2;m<=b;m++)
    683689  {
    … …  
    760766poly nc_spGSpolyCreate(poly p1, poly p2,poly spNoether, const ring r)
    761767{
     768  if (p_GetComp(p1,r)!=p_GetComp(p2,r))
     769  {
     770    Print("Exponent mismatch!");   
     771    return(NULL);
     772  }
     773  else
     774  {
     775    Exponent_t eComp=p_GetComp(p1,r);
     776  }
     777
    762778  int i=0;
    763779  int nv=r->N;
    764 
     780 
    765781  Exponent_t *A1=(Exponent_t *)omAlloc0((r->N+1)*sizeof(Exponent_t));
    766782  Exponent_t *A2=(Exponent_t *)omAlloc0((r->N+1)*sizeof(Exponent_t));
    … …  
    822838  int nv=r->N;
    823839  poly a1=p_Head(p1,r);
    824   poly a2=p_Head(p_Next(q2,r),r);
     840  poly a2=p_Head(pNext(q2),r);
    825841  //HOW??????????????????
    826842  Exponent_t *A1=(Exponent_t *)omAlloc0((r->N+1)*sizeof(Exponent_t));

  • Singular/gring.h

    r204626 r4eba817  
    44*  Computer Algebra System SINGULAR     *
    55****************************************/
    6 /* $Id: gring.h,v 1.9 2002-04-26 15:49:59 Singular Exp $ */
     6/* $Id: gring.h,v 1.10 2002-04-30 13:35:11 levandov Exp $ */
    77/*
    88* ABSTRACT additional defines etc for --with-plural
    … …  
    1919// other routines we need in addition :
    2020poly nc_mm_Mult_p(const poly m, poly p, const ring r);
    21 poly nc_mm_Mult_nn (Exponent_t *F, Exponent_t *G, const ring r);
     21poly nc_mm_Mult_nn (Exponent_t *F, Exponent_t *G, const ring r); 
    2222poly nc_mm_Mult_uu (Exponent_t *F,int jG,int bG, const ring r);
    2323poly nc_uu_Mult_ww (int i, int a, int j, int b, const ring r);
    … …  
    2828poly nc_spGSpolyRedNew(poly p1, poly p2,poly spNoether, const ring r);
    2929void nc_spGSpolyRedTail(poly p1, poly q, poly q2, poly spNoether, const ring r);
    30 poly nc_spShort(poly p1, poly p2, const ring r);
     30poly nc_spShort(poly p1, poly p2, const ring r=currRing);
    3131
    3232ideal gr_bba (ideal F, ideal Q,kStrategy strat);

  • Singular/kstd1.cc

    r204626 r4eba817  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: kstd1.cc,v 1.86 2002-01-30 14:33:01 Singular Exp $ */
     4/* $Id: kstd1.cc,v 1.87 2002-04-30 13:35:11 levandov Exp $ */
    55/*
    66* ABSTRACT:
    … …  
    3131#include "timer.h"
    3232#include "lists.h"
     33#include "ring.h"
    3334
    3435//#include "ipprint.h"
    … …  
    16061607  idTest(F);
    16071608#endif
    1608 #ifdef PLURAL
     1609#ifdef HAVE_PLURAL
    16091610  if (rIsPluralRing(currRing))
    16101611  {

  • Singular/kutil.cc

    r204626 r4eba817  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: kutil.cc,v 1.103 2001-08-28 11:49:49 Singular Exp $ */
     4/* $Id: kutil.cc,v 1.104 2002-04-30 13:35:11 levandov Exp $ */
    55/*
    66* ABSTRACT: kernel: utils for kStd
    … …  
    10201020  else /*sugarcrit*/
    10211021  {
     1022#ifdef HAVE_PLURAL
     1023    if (currRing->nc==NULL)
     1024    {
     1025    // if currRing->nc_type!=quasi (or skew)
     1026#endif
     1027
    10221028    if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
    10231029    pHasNotCF(p,strat->S[i]))
    … …  
    10741080    }
    10751081  }
     1082#ifdef HAVE_PLURAL
     1083  }
     1084#endif
    10761085  /*
    10771086  *the pair (S[i],p) enters B if the spoly != 0
    … …  
    10861095  else
    10871096  {
     1097#ifdef HAVE_PLURAL
     1098    if (currRing->nc!=NULL)
     1099    {
     1100      Lp.p = nc_spGSpolyCreate(strat->S[i],p,NULL,currRing);
     1101    }
     1102    else
     1103    {
     1104#endif
    10881105    Lp.p = ksCreateShortSpoly(strat->S[i],p, strat->tailRing);
     1106#ifdef HAVE_PLURAL
     1107    }
     1108#endif
    10891109  }
    10901110  if (Lp.p == NULL)
    … …  
    11111131    Lp.p1 = strat->S[i];
    11121132    Lp.p2 = p;
    1113     pNext(Lp.p) = strat->tail;
     1133
     1134#ifdef HAVE_PLURAL
     1135    if (currRing->nc==NULL)
     1136    {
     1137#endif
     1138
     1139     pNext(Lp.p) = strat->tail;
     1140
     1141#ifdef HAVE_PLURAL
     1142    }
     1143#endif
     1144
    11141145    if (atR >= 0)
    11151146    {
    … …  
    11201151    if (TEST_OPT_INTSTRATEGY)
    11211152    {
     1153
     1154#ifdef HAVE_PLURAL
     1155      if (currRing->nc==NULL)
     1156      {
     1157#endif
     1158
    11221159      nDelete(&(Lp.p->coef));
     1160
     1161#ifdef HAVE_PLURAL
     1162      }
     1163#endif
     1164
    11231165    }
    11241166    l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
    … …  
    12061248  *that their lcm is divisible by the leading term of S[i] can be canceled
    12071249  */
    1208   if (strat->pairtest!=NULL)
    1209   {
    1210     {
    1211       /*- i.e. there is an i with pairtest[i]==TRUE -*/
    1212       for (j=0; j<=strat->sl; j++)
    1213       {
    1214         if (strat->pairtest[j])
    1215         {
    1216           for (i=strat->Bl; i>=0; i--)
     1250  if (!rIsPluralRing(currRing))
     1251  {
     1252    if (strat->pairtest!=NULL)
     1253    {
     1254      {
     1255        /*- i.e. there is an i with pairtest[i]==TRUE -*/
     1256        for (j=0; j<=strat->sl; j++)
     1257        {
     1258          if (strat->pairtest[j])
    12171259          {
    1218             if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
     1260            for (i=strat->Bl; i>=0; i--)
    12191261            {
    1220               deleteInL(strat->B,&strat->Bl,i,strat);
    1221               strat->c3++;
     1262              if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
     1263              {
     1264                deleteInL(strat->B,&strat->Bl,i,strat);
     1265                strat->c3++;
     1266              }
    12221267            }
    12231268          }
    12241269        }
    12251270      }
    1226     }
    1227     omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
    1228     strat->pairtest=NULL;
    1229   }
    1230   if (strat->Gebauer || strat->fromT)
    1231   {
    1232     if (strat->sugarCrit)
    1233     {
    1234     /*
    1235     *suppose L[j] == (s,r) and p/lcm(s,r)
    1236     *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
    1237     *and in case the sugar is o.k. then L[j] can be canceled
    1238     */
    1239       for (j=strat->Ll; j>=0; j--)
    1240       {
    1241         if (sugarDivisibleBy(ecart,strat->L[j].ecart)
    1242         && ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
    1243         && pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
    1244         {
    1245           if (strat->L[j].p == strat->tail)
    1246           {
    1247             deleteInL(strat->L,&strat->Ll,j,strat);
    1248             strat->c3++;
    1249           }
    1250         }
    1251       }
    1252       /*
    1253       *this is GEBAUER-MOELLER:
    1254       *in B all elements with the same lcm except the "best"
    1255       *(i.e. the last one in B with this property) will be canceled
    1256       */
    1257       j = strat->Bl;
    1258       loop /*cannot be changed into a for !!! */
    1259       {
    1260         if (j <= 0) break;
    1261         i = j-1;
    1262         loop
    1263         {
    1264           if (i <  0) break;
    1265           if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
    1266           {
    1267             strat->c3++;
    1268             if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
    1269             {
    1270               deleteInL(strat->B,&strat->Bl,i,strat);
    1271               j--;
    1272             }
    1273             else
    1274             {
    1275               deleteInL(strat->B,&strat->Bl,j,strat);
    1276               break;
    1277             }
    1278           }
    1279           i--;
    1280         }
    1281         j--;
    1282       }
    1283     }
    1284     else /*sugarCrit*/
    1285     {
     1271      omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
     1272      strat->pairtest=NULL;
     1273    }
     1274    if (strat->Gebauer || strat->fromT)
     1275    {
     1276      if (strat->sugarCrit)
     1277      {
    12861278      /*
    12871279      *suppose L[j] == (s,r) and p/lcm(s,r)
    … …  
    12891281      *and in case the sugar is o.k. then L[j] can be canceled
    12901282      */
     1283        for (j=strat->Ll; j>=0; j--)
     1284        {
     1285          if (sugarDivisibleBy(ecart,strat->L[j].ecart)
     1286          && ((pNext(strat->L[j].p) == strat->tail) || (pOrdSgn==1))
     1287          && pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
     1288          {
     1289            if (strat->L[j].p == strat->tail)
     1290            {
     1291              deleteInL(strat->L,&strat->Ll,j,strat);
     1292              strat->c3++;
     1293            }
     1294          }
     1295        }
     1296        /*
     1297        *this is GEBAUER-MOELLER:
     1298        *in B all elements with the same lcm except the "best"
     1299        *(i.e. the last one in B with this property) will be canceled
     1300        */
     1301        j = strat->Bl;
     1302        loop /*cannot be changed into a for !!! */
     1303        {
     1304          if (j <= 0) break;
     1305          i = j-1;
     1306          loop
     1307          {
     1308            if (i <  0) break;
     1309            if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
     1310            {
     1311              strat->c3++;
     1312              if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
     1313              {
     1314                deleteInL(strat->B,&strat->Bl,i,strat);
     1315                j--;
     1316              }
     1317              else
     1318              {
     1319                deleteInL(strat->B,&strat->Bl,j,strat);
     1320                break;
     1321              }
     1322            }
     1323            i--;
     1324          }
     1325          j--;
     1326        }
     1327      }
     1328      else /*sugarCrit*/
     1329      {
     1330        /*
     1331        *suppose L[j] == (s,r) and p/lcm(s,r)
     1332        *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
     1333        *and in case the sugar is o.k. then L[j] can be canceled
     1334        */
     1335        for (j=strat->Ll; j>=0; j--)
     1336        {
     1337          if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
     1338          {
     1339            if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
     1340            {
     1341              deleteInL(strat->L,&strat->Ll,j,strat);
     1342              strat->c3++;
     1343            }
     1344          }
     1345        }
     1346        /*
     1347        *this is GEBAUER-MOELLER:
     1348        *in B all elements with the same lcm except the "best"
     1349        *(i.e. the last one in B with this property) will be canceled
     1350        */
     1351        j = strat->Bl;
     1352        loop   /*cannot be changed into a for !!! */
     1353        {
     1354          if (j <= 0) break;
     1355          for(i=j-1; i>=0; i--)
     1356          {
     1357            if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
     1358            {
     1359              strat->c3++;
     1360              deleteInL(strat->B,&strat->Bl,i,strat);
     1361              j--;
     1362            }
     1363          }
     1364          j--;
     1365        }
     1366      }
     1367      /*
     1368      *the elements of B enter L/their order with respect to B is kept
     1369      *j = posInL(L,j,B[i]) would permutate the order
     1370      *if once B is ordered different from L
     1371      *then one should use j = posInL(L,Ll,B[i])
     1372      */
     1373      j = strat->Ll+1;
     1374      for (i=strat->Bl; i>=0; i--)
     1375      {
     1376        j = strat->posInL(strat->L,j-1,&(strat->B[i]),strat);
     1377        enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
     1378      }
     1379      strat->Bl = -1;
     1380    }
     1381    else
     1382    {
    12911383      for (j=strat->Ll; j>=0; j--)
    12921384      {
    … …  
    13011393      }
    13021394      /*
    1303       *this is GEBAUER-MOELLER:
    1304       *in B all elements with the same lcm except the "best"
    1305       *(i.e. the last one in B with this property) will be canceled
     1395      *this is our MODIFICATION of GEBAUER-MOELLER:
     1396      *First the elements of B enter L,
     1397      *then we fix a lcm and the "best" element in L
     1398      *(i.e the last in L with this lcm and of type (s,p))
     1399      *and cancel all the other elements of type (r,p) with this lcm
     1400      *except the case the element (s,r) has also the same lcm
     1401      *and is on the worst position with respect to (s,p) and (r,p)
    13061402      */
    1307       j = strat->Bl;
    1308       loop   /*cannot be changed into a for !!! */
    1309       {
    1310         if (j <= 0) break;
    1311         for(i=j-1; i>=0; i--)
    1312         {
    1313           if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
     1403      /*
     1404      *B enters to L/their order with respect to B is permutated for elements
     1405      *B[i].p with the same leading term
     1406      */
     1407      j = strat->Ll;
     1408      for (i=strat->Bl; i>=0; i--)
     1409      {
     1410        j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
     1411        enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
     1412      }
     1413      strat->Bl = -1;
     1414      j = strat->Ll;
     1415      loop  /*cannot be changed into a for !!! */
     1416      {
     1417        if (j <= 0)
     1418        {
     1419          /*now L[0] cannot be canceled any more and the tail can be removed*/
     1420          if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
     1421          break;
     1422        }
     1423        if (strat->L[j].p2 == p)
     1424        {
     1425          i = j-1;
     1426          loop
    13141427          {
    1315             strat->c3++;
    1316             deleteInL(strat->B,&strat->Bl,i,strat);
    1317             j--;
     1428            if (i < 0)  break;
     1429            if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
     1430            {
     1431              /*L[i] could be canceled but we search for a better one to cancel*/
     1432              strat->c3++;
     1433              if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
     1434              && (pNext(strat->L[l].p) == strat->tail)
     1435              && (!pLmEqual(strat->L[i].p,strat->L[l].p))
     1436              && pDivisibleBy(p,strat->L[l].lcm))
     1437              {
     1438                /*
     1439                *"NOT equal(...)" because in case of "equal" the element L[l]
     1440                *is "older" and has to be from theoretical point of view behind
     1441                *L[i], but we do not want to reorder L
     1442                */
     1443                strat->L[i].p2 = strat->tail;
     1444                /*
     1445                *L[l] will be canceled, we cannot cancel L[i] later on,
     1446                *so we mark it with "tail"
     1447                */
     1448                deleteInL(strat->L,&strat->Ll,l,strat);
     1449                i--;
     1450              }
     1451              else
     1452              {
     1453                deleteInL(strat->L,&strat->Ll,i,strat);
     1454              }
     1455              j--;
     1456            }
     1457            i--;
    13181458          }
    13191459        }
     1460        else if (strat->L[j].p2 == strat->tail)
     1461        {
     1462          /*now L[j] cannot be canceled any more and the tail can be removed*/
     1463          strat->L[j].p2 = p;
     1464        }
    13201465        j--;
    13211466      }
    13221467    }
     1468  } /* rIsPluralRing */
     1469  else
     1470  {
    13231471    /*
    13241472    *the elements of B enter L/their order with respect to B is kept
    … …  
    13341482    }
    13351483    strat->Bl = -1;
    1336   }
    1337   else
    1338   {
    1339     for (j=strat->Ll; j>=0; j--)
    1340     {
    1341       if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
    1342       {
    1343         if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
    1344         {
    1345           deleteInL(strat->L,&strat->Ll,j,strat);
    1346           strat->c3++;
    1347         }
    1348       }
    1349     }
    1350     /*
    1351     *this is our MODIFICATION of GEBAUER-MOELLER:
    1352     *First the elements of B enter L,
    1353     *then we fix a lcm and the "best" element in L
    1354     *(i.e the last in L with this lcm and of type (s,p))
    1355     *and cancel all the other elements of type (r,p) with this lcm
    1356     *except the case the element (s,r) has also the same lcm
    1357     *and is on the worst position with respect to (s,p) and (r,p)
    1358     */
    1359     /*
    1360     *B enters to L/their order with respect to B is permutated for elements
    1361     *B[i].p with the same leading term
    1362     */
    1363     j = strat->Ll;
    1364     for (i=strat->Bl; i>=0; i--)
    1365     {
    1366       j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
    1367       enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
    1368     }
    1369     strat->Bl = -1;
    1370     j = strat->Ll;
    1371     loop  /*cannot be changed into a for !!! */
    1372     {
    1373       if (j <= 0)
    1374       {
    1375         /*now L[0] cannot be canceled any more and the tail can be removed*/
    1376         if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
    1377         break;
    1378       }
    1379       if (strat->L[j].p2 == p)
    1380       {
    1381         i = j-1;
    1382         loop
    1383         {
    1384           if (i < 0)  break;
    1385           if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
    1386           {
    1387             /*L[i] could be canceled but we search for a better one to cancel*/
    1388             strat->c3++;
    1389             if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
    1390             && (pNext(strat->L[l].p) == strat->tail)
    1391             && (!pLmEqual(strat->L[i].p,strat->L[l].p))
    1392             && pDivisibleBy(p,strat->L[l].lcm))
    1393             {
    1394               /*
    1395               *"NOT equal(...)" because in case of "equal" the element L[l]
    1396               *is "older" and has to be from theoretical point of view behind
    1397               *L[i], but we do not want to reorder L
    1398               */
    1399               strat->L[i].p2 = strat->tail;
    1400               /*
    1401               *L[l] will be canceled, we cannot cancel L[i] later on,
    1402               *so we mark it with "tail"
    1403               */
    1404               deleteInL(strat->L,&strat->Ll,l,strat);
    1405               i--;
    1406             }
    1407             else
    1408             {
    1409               deleteInL(strat->L,&strat->Ll,i,strat);
    1410             }
    1411             j--;
    1412           }
    1413           i--;
    1414         }
    1415       }
    1416       else if (strat->L[j].p2 == strat->tail)
    1417       {
    1418         /*now L[j] cannot be canceled any more and the tail can be removed*/
    1419         strat->L[j].p2 = p;
    1420       }
    1421       j--;
    1422     }
    1423   }
     1484  }   
    14241485}
    14251486
    … …  
    14741535      }
    14751536    }
     1537
    14761538    if (new_pair) chainCrit(h,ecart,strat);
     1539
    14771540  }
    14781541}
    … …  
    37583821  * - in local rings, - in lex order case, -in ring over extensions */
    37593822  strat->noTailReduction = !TEST_OPT_REDTAIL;
     3823#ifdef HAVE_PLURAL
     3824  // and r is plural_ring
     3825  if (currRing->nc!=NULL)
     3826    //or it has non-quasi-comm type... later
     3827  {
     3828    strat->sugarCrit = FALSE;
     3829    strat->Gebauer = FALSE ;
     3830    strat->honey = FALSE;
     3831  }
     3832#endif
    37603833  if (TEST_OPT_DEBUG)
    37613834  {

  • Singular/ring.cc

    r204626 r4eba817  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: ring.cc,v 1.189 2002-02-26 11:38:04 Singular Exp $ */
     4/* $Id: ring.cc,v 1.190 2002-04-30 13:35:12 levandov Exp $ */
    55
    66/*
    … …  
    2929#include "prCopy.h"
    3030#include "p_Procs.h"
     31#ifdef HAVE_PLURAL
     32#include "gring.h"
     33#include "matpol.h"
     34#endif
    3135
    3236#define BITS_PER_LONG 8*SIZEOF_LONG
    … …  
    681685  omCheckAddrSize(r->wvhdl,nblocks*sizeof(int_ptr));
    682686  omCheckAddrSize(r->names,r->N*sizeof(char_ptr));
    683 
     687#ifdef HAVE_PLURAL
     688  if (r->nc!=NULL)
     689  {
     690    int nNC=r->N*(r->N-1)/2;
     691    // omCheckAddrSize(r->nc,sizeof(nc_struct));
     692//     omCheckAddrSize(r->nc->MT,nNC*sizeof(matrix));
     693    //    omCheckAddrSize(r->nc->MTsize,nNC*sizeof(int));
     694  }
     695#endif     
    684696
    685697  nblocks--;
    … …  
    785797    }
    786798  }
     799#ifdef HAVE_PLURAL
     800  if ((r->nc!=NULL) && (r==currRing))
     801  {
     802    poly pl=NULL;
     803    PrintS("\n//   noncommutative relations:");
     804    for (int i = 1; i<r->N; i++)
     805    {
     806      for (int j = i+1; j<=r->N; j++)
     807      {
     808        if (MATELEM(r->nc->COM,i,j)==NULL)
     809        {
     810          Print("\n//    %s%s=",r->names[j-1],r->names[i-1]);
     811          pl=MATELEM(r->nc->MT[UPMATELEM(i,j,r->N)],1,1);
     812          pWrite0(pl);
     813        }
     814      }
     815    }
     816  }
     817#endif
    787818  if (r->qideal!=NULL)
    788819  {

  • Singular/ring.h

    r204626 r4eba817  
    77* ABSTRACT - the interpreter related ring operations
    88*/
    9 /* $Id: ring.h,v 1.71 2002-01-20 10:01:50 Singular Exp $ */
     9/* $Id: ring.h,v 1.72 2002-04-30 13:35:13 levandov Exp $ */
    1010
    1111/* includes */
    … …  
    249249  return r->nc != NULL;
    250250}
     251#else
     252#define rIsPluralRing(r)  (0)
    251253#endif
    252254
Note: See TracChangeset for help on using the changeset viewer.