Changeset d609e1 in git


Ignore:
Timestamp:
Feb 8, 2001, 2:13:06 PM (23 years ago)
Author:
Hans Schönemann <hannes@…>
Branches:
(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')
Children:
cd9bd11338310a68a7f540822564453a1bdc9889
Parents:
4cbe5ddf85f8cae8cfd990f0d4cde7d588643de9
Message:
*hannes/mschulze: invunit stuff


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

Legend:

Unmodified
Added
Removed

  • Singular/extra.cc

    r4cbe5d rd609e1  
    22*  Computer Algebra System SINGULAR      *
    33*****************************************/
    4 /* $Id: extra.cc,v 1.157 2001-02-02 14:40:13 Singular Exp $ */
     4/* $Id: extra.cc,v 1.158 2001-02-08 13:12:58 Singular Exp $ */
    55/*
    66* ABSTRACT: general interface to internals of Singular ("system" command)
    … …  
    9898#endif
    9999#endif /* not HAVE_DYNAMIC_LOADING */
    100 
    101 // procedures to compute with units
    102 #ifdef HAVE_UNITS
    103 #include "units.h"
    104 #endif
    105100
    106101// see clapsing.cc for a description of the `FACTORY_*' options
    … …  
    11621157    }
    11631158    else
    1164 #ifdef HAVE_UNITS
    1165 /*==================== units ==================================*/
    1166     if(strcmp(sys_cmd,"invunit")==0)
    1167     {
    1168       return invunit(res,h);
    1169     }
    1170     else
    1171     if(strcmp(sys_cmd,"series")==0)
    1172     {
    1173       return series(res,h);
    1174     }
    1175     else
    1176     if(strcmp(sys_cmd,"rednf")==0)
    1177     {
    1178       return rednf(res,h);
    1179     }
    1180     else
    1181 #endif
    11821159#ifdef HAVE_PLURAL
    11831160/*==================== PLURAL =================*/

  • Singular/ideals.cc

    r4cbe5d rd609e1  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: ideals.cc,v 1.120 2001-01-30 08:55:47 pohl Exp $ */
     4/* $Id: ideals.cc,v 1.121 2001-02-08 13:12:59 Singular Exp $ */
    55/*
    66* ABSTRACT - all basic methods to manipulate ideals
    … …  
    19821982
    19831983  ideal s_h4 = idInitializeQuot (h1,h2,h1IsStb,&addOnlyOne,&kmax);
    1984  
     1984
    19851985  hom = (tHomog)idHomModule(s_h4,currQuotient,&weights1);
    19861986
    … …  
    22862286  for (j=0;j<pVariables;j++)
    22872287    if (pGetExp(delVar,j+1)!=0) wv[0][j]=1;
    2288   // use this special ordering: like ringorder_a, except that pFDeg, pWeights 
     2288  // use this special ordering: like ringorder_a, except that pFDeg, pWeights
    22892289  // ignore it
    22902290  ord[0] = ringorder_aa;
    … …  
    24652465}
    24662466#endif
    2467 
    2468 /*2
    2469 *returns TRUE if p is a unit element in the current ring
    2470 */
    2471 BOOLEAN pIsUnit(poly p)
    2472 {
    2473   int i;
    2474 
    2475   if (p == NULL) return FALSE;
    2476   i = 1;
    2477   while (i<=pVariables && pGetExp(p,i) == 0) i++;
    2478   if (i > pVariables && (pGetComp(p) == 0))
    2479   {
    2480     if (currRing->OrdSgn == 1 && pNext(p) !=NULL) return FALSE;
    2481     return TRUE;
    2482   }
    2483   return FALSE;
    2484 }
    24852467
    24862468/*2
    … …  
    26722654    sBucketClearMerge(bucket, &(result->m[j]), &l);
    26732655  }
    2674  
     2656
    26752657  // obachman: need to clean this up
    26762658  idDelete((ideal*) &mat);
    … …  
    28982880  for(k=(i->nrows)*(i->ncols)-1;k>=0; k--)
    28992881  {
    2900     r->m[k]=pJet(i->m[k],d);
     2882    r->m[k]=ppJet(i->m[k],d);
    29012883  }
    29022884  return r;
    … …  
    29162898    for(k=0; k<IDELEMS(i); k++)
    29172899    {
    2918       r->m[k]=pJetW(i->m[k],d,w);
     2900      r->m[k]=ppJetW(i->m[k],d,w);
    29192901    }
    29202902    omFreeSize((ADDRESS)w,(pVariables+1)*sizeof(short));
    29212903  }
    29222904  return r;
     2905}
     2906
     2907ideal idSeries(int n,ideal M,matrix U=NULL)
     2908{
     2909  for(int i=IDELEMS(M)-1;i>=0;i--)
     2910  {
     2911    if(U==NULL)
     2912      M->m[i]=pSeries(n,M->m[i]);
     2913    else
     2914    {
     2915      M->m[i]=pSeries(n,M->m[i],MATELEM(U,i+1,i+1));
     2916      MATELEM(U,i+1,i+1)=NULL;
     2917    }
     2918  }
     2919  if(U!=NULL)
     2920    idDelete((ideal*)&U);
     2921  return M;
    29232922}
    29242923
    … …  
    34323431}
    34333432
     3433BOOLEAN idIsZeroDim(ideal I)
     3434{
     3435  BOOLEAN *UsedAxis=(BOOLEAN *)omAlloc0(pVariables*sizeof(BOOLEAN));
     3436  int i,n;
     3437  poly po;
     3438  BOOLEAN res=TRUE;
     3439  for(i=IDELEMS(I)-1;i>=0;i--)
     3440  {
     3441    po=I->m[i];
     3442    if ((po!=NULL) &&((n=pIsPurePower(po))!=0)) UsedAxis[n-1]=TRUE;
     3443  }
     3444  for(i=pVariables-1;i>=0;i--)
     3445  {
     3446    if(UsedAxis[i]==FALSE) {res=FALSE; break;} // not zero-dim.
     3447  }
     3448  omFreeSize(UsedAxis,pVariables*sizeof(BOOLEAN));
     3449  return res;
     3450}

  • Singular/ideals.h

    r4cbe5d rd609e1  
    44*  Computer Algebra System SINGULAR     *
    55****************************************/
    6 /* $Id: ideals.h,v 1.30 2000-11-08 15:34:56 obachman Exp $ */
     6/* $Id: ideals.h,v 1.31 2001-02-08 13:13:00 Singular Exp $ */
    77/*
    88* ABSTRACT - all basic methods to manipulate ideals
    … …  
    129129ideal   idJet(ideal i,int d);
    130130ideal   idJetW(ideal i,int d, intvec * iv);
     131ideal   idSeries(int n,ideal M,matrix U=NULL);
    131132
     133BOOLEAN idIsZeroDim(ideal i);
    132134matrix  idDiff(matrix i, int k);
    133135matrix  idDiffOp(ideal I, ideal J,BOOLEAN multiply=TRUE);

  • Singular/iparith.cc

    r4cbe5d rd609e1  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: iparith.cc,v 1.253 2001-02-06 13:16:20 Singular Exp $ */
     4/* $Id: iparith.cc,v 1.254 2001-02-08 13:13:01 Singular Exp $ */
    55
    66/*
    … …  
    4444#include "sparsmat.h"
    4545#include "algmap.h"
     46#include "units.h"
    4647#ifdef HAVE_FACTORY
    4748#include "clapsing.h"
    … …  
    18051806static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
    18061807{
    1807   res->data = (char *)pJet((poly)u->Data(),(int)v->Data());
     1808  res->data = (char *)pJet((poly)u->CopyD(), (int)v->Data());
    18081809  return FALSE;
    18091810}
    … …  
    41544155{
    41554156  short *iw=iv2array((intvec *)w->Data());
    4156   res->data = (char *)pJetW((poly)u->Data(),(int)v->Data(),iw);
     4157  res->data = (char *)ppJetW((poly)u->Data(),(int)v->Data(),iw);
    41574158  omFreeSize((ADDRESS)iw,(pVariables+1)*sizeof(short));
     4159  return FALSE;
     4160}
     4161static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
     4162{
     4163  poly ww=(poly)w->Data();
     4164  if (!pIsUnit(ww))
     4165  {
     4166    WerrorS("3rd argument must be a unit");
     4167    return TRUE;
     4168  }
     4169  res->data = (char *)pSeries((int)v->Data(),(poly)u->CopyD(),(poly)w->CopyD());
    41584170  return FALSE;
    41594171}
    … …  
    41624174  res->data = (char *)idJetW((ideal)u->Data(),(int)v->Data(),
    41634175                             (intvec *)w->Data());
     4176  return FALSE;
     4177}
     4178static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
     4179{
     4180  matrix ww=(matrix)w->Data();
     4181  if (!mpIsDiagUnit(ww))
     4182  {
     4183    WerrorS("3rd argument must be a diagonal matrix of units");
     4184    return TRUE;
     4185  }
     4186  res->data = (char *)idSeries((int)v->Data(),(ideal)u->CopyD(),
     4187                               (matrix)w->CopyD());
    41644188  return FALSE;
    41654189}
    … …  
    44004424  res->data = (char *)idModule2formatedMatrix(m,ul,vl);
    44014425  test=save_test;
     4426  return FALSE;
     4427}
     4428static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
     4429{
     4430  assumeStdFlag(v);
     4431  if (!idIsZeroDim((ideal)v->Data()))
     4432  {
     4433    Werror("`%s` must be 0-dimensional",v->Name());
     4434    return TRUE;
     4435  } 
     4436  res->data = (char *)rednf((ideal)v->CopyD(),(poly)u->CopyD(),
     4437    (poly)w->CopyD());
     4438  return FALSE;
     4439}
     4440static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
     4441{
     4442  assumeStdFlag(v);
     4443  if (!idIsZeroDim((ideal)v->Data()))
     4444  {
     4445    Werror("`%s` must be 0-dimensional",v->Name());
     4446    return TRUE;
     4447  } 
     4448  res->data = (char *)rednf((ideal)v->CopyD(),(ideal)u->CopyD(),
     4449    (matrix)w->CopyD());
    44024450  return FALSE;
    44034451}
    … …  
    45214569,{jjJET_P_IV,       JET_CMD,    VECTOR_CMD, VECTOR_CMD, INT_CMD,    INTVEC_CMD }
    45224570,{jjJET_ID_IV,      JET_CMD,    MODUL_CMD,  MODUL_CMD,  INT_CMD,    INTVEC_CMD }
     4571,{jjJET_P_P,        JET_CMD,    POLY_CMD,   POLY_CMD,   INT_CMD,    POLY_CMD }
     4572,{jjJET_P_P,        JET_CMD,    VECTOR_CMD, VECTOR_CMD, INT_CMD,    POLY_CMD }
     4573,{jjJET_ID_M,       JET_CMD,    IDEAL_CMD,  IDEAL_CMD,  INT_CMD,    MATRIX_CMD }
     4574,{jjJET_ID_M,       JET_CMD,    MODUL_CMD,  MODUL_CMD,  INT_CMD,    MATRIX_CMD }
    45234575,{mpKoszul,         KOSZUL_CMD, MATRIX_CMD, INT_CMD,    INT_CMD,    IDEAL_CMD }
    45244576,{jjCALL3MANY,      LIST_CMD,   LIST_CMD,   DEF_CMD,    DEF_CMD,    DEF_CMD }
    … …  
    45434595,{jjREDUCE3_ID,     REDUCE_CMD, MODUL_CMD,  MODUL_CMD,  MODUL_CMD,  INT_CMD }
    45444596,{jjREDUCE3_ID,     REDUCE_CMD, MODUL_CMD,  MODUL_CMD,  IDEAL_CMD,  INT_CMD }
     4597,{jjREDUCE3_CP,     REDUCE_CMD, POLY_CMD,   POLY_CMD,   IDEAL_CMD,  POLY_CMD }
     4598,{jjREDUCE3_CP,     REDUCE_CMD, VECTOR_CMD, VECTOR_CMD, MODUL_CMD,  POLY_CMD }
     4599,{jjREDUCE3_CID,    REDUCE_CMD, IDEAL_CMD,  IDEAL_CMD,  IDEAL_CMD,  MATRIX_CMD }
     4600,{jjREDUCE3_CID,    REDUCE_CMD, MODUL_CMD,  MODUL_CMD,  MODUL_CMD,  MATRIX_CMD }
    45454601#ifdef OLD_RES
    45464602,{jjRES3,           RES_CMD,    NONE,       IDEAL_CMD,  INT_CMD,    ANY_TYPE }

  • Singular/ipshell.cc

    r4cbe5d rd609e1  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: ipshell.cc,v 1.61 2001-01-18 16:21:17 Singular Exp $ */
     4/* $Id: ipshell.cc,v 1.62 2001-02-08 13:13:02 Singular Exp $ */
    55/*
    66* ABSTRACT:
    … …  
    11211121poly    iiHighCorner(ideal I, int ak)
    11221122{
    1123   BOOLEAN *UsedAxis=(BOOLEAN *)omAlloc0(pVariables*sizeof(BOOLEAN));
    1124   int i,n;
    1125   poly po;
    1126   for(i=IDELEMS(I)-1;i>=0;i--)
    1127   {
    1128     po=I->m[i];
    1129     if ((po!=NULL) &&((n=pIsPurePower(po))!=0)) UsedAxis[n-1]=TRUE;
    1130   }
    1131   for(i=pVariables-1;i>=0;i--)
    1132   {
    1133     if(UsedAxis[i]==FALSE) return NULL; // not zero-dim.
    1134   }
    1135   po=NULL;
     1123  int i;
     1124  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
     1125  poly po=NULL;
    11361126  if (currRing->OrdSgn== -1)
    11371127  {

  • Singular/matpol.cc

    r4cbe5d rd609e1  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: matpol.cc,v 1.38 2001-01-12 12:30:32 Singular Exp $ */
     4/* $Id: matpol.cc,v 1.39 2001-02-08 13:13:03 Singular Exp $ */
    55
    66/*
    … …  
    18711871  }
    18721872}
     1873
     1874BOOLEAN mpIsDiagUnit(matrix U)
     1875{
     1876  if(MATROWS(U)!=MATCOLS(U))
     1877    return FALSE;
     1878  for(int i=MATCOLS(U);i>=1;i--)
     1879  {
     1880    for(int j=MATCOLS(U); j>=1; j--)
     1881    {
     1882      if (i==j)
     1883      {
     1884        if (!pIsUnit(MATELEM(U,i,i))) return FALSE;
     1885      }
     1886      else if (MATELEM(U,i,j)!=NULL) return FALSE;
     1887    } 
     1888  }
     1889  return TRUE;
     1890}
     1891

  • Singular/matpol.h

    r4cbe5d rd609e1  
    44*  Computer Algebra System SINGULAR     *
    55****************************************/
    6 /* $Id: matpol.h,v 1.13 2000-08-14 12:56:38 obachman Exp $ */
     6/* $Id: matpol.h,v 1.14 2001-02-08 13:13:03 Singular Exp $ */
    77/*
    88* ABSTRACT
    … …  
    6969void mpMinorToResult(ideal, int &, matrix, int, int, ideal);
    7070
     71BOOLEAN mpIsDiagUnit(matrix U);
     72
    7173extern omBin ip_smatrix_bin;
    7274#endif

  • Singular/pInline1.h

    r4cbe5d rd609e1  
    77 *  Author:  obachman (Olaf Bachmann)
    88 *  Created: 8/00
    9  *  Version: $Id: pInline1.h,v 1.16 2001-02-07 12:37:51 Singular Exp $
     9 *  Version: $Id: pInline1.h,v 1.17 2001-02-08 13:13:03 Singular Exp $
    1010 *******************************************************************/
    1111#ifndef PINLINE1_H
    … …  
    514514}
    515515
     516PINLINE1 BOOLEAN p_IsUnit(const poly p, const ring r)
     517{
     518  if (p == NULL) return FALSE;
     519  return p_LmIsConstant(p, r);
     520}
     521
    516522PINLINE1 BOOLEAN p_LmExpVectorAddIsOk(const poly p1, const poly p2,
    517523                                      const ring r)

  • Singular/polys.h

    r4cbe5d rd609e1  
    44*  Computer Algebra System SINGULAR     *
    55****************************************/
    6 /* $Id: polys.h,v 1.53 2001-02-07 12:45:14 Singular Exp $ */
     6/* $Id: polys.h,v 1.54 2001-02-08 13:13:04 Singular Exp $ */
    77/*
    88* ABSTRACT - all basic methods to manipulate polynomials of the
    … …  
    237237// like above, except that Comp might be != 0
    238238#define   pIsConstant(p)            p_IsConstant(p,currRing)
     239// return true if the Lm is a constant <>0
     240#define   pIsUnit(p)            p_IsUnit(p,currRing)
    239241// like above, except that p must be != NULL
    240242#define   pLmIsConstantComp(p)      p_LmIsConstantComp(p, currRing)
    … …  
    398400void      pNorm(poly p);
    399401poly      pSubst(poly p, int n, poly e);
     402poly      ppJet(poly p, int m);
    400403poly      pJet(poly p, int m);
    401 poly      pJetW(poly p, int m, short * iv);
     404poly      ppJetW(poly p, int m, short * iv);
     405poly      pSeries(int n,poly p,poly u=NULL);
     406poly      pInvers(int n, poly p);
    402407// maximum weigthed degree of all monomials of p, w is indexed from
    403408// 1..pVariables

  • Singular/polys1.cc

    r4cbe5d rd609e1  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: polys1.cc,v 1.62 2001-01-09 15:40:13 Singular Exp $ */
     4/* $Id: polys1.cc,v 1.63 2001-02-08 13:13:04 Singular Exp $ */
    55
    66/*
    … …  
    11061106#endif
    11071107
    1108 poly pJet(poly p, int m)
     1108poly ppJet(poly p, int m)
    11091109{
    11101110  poly r=NULL;
    … …  
    11341134}
    11351135
    1136 poly pJetW(poly p, int m, short *w)
     1136poly pJet(poly p, int m)
     1137{
     1138  poly r=p;
     1139  poly t=NULL;
     1140
     1141  while (p!=NULL)
     1142  {
     1143    if (pTotaldegree(p)>m)
     1144    {
     1145      if (p==r)
     1146      {
     1147        pLmDelete(&p);
     1148        r=p;
     1149      }
     1150      else
     1151      {
     1152        pLmDelete(&p);
     1153      }
     1154    }
     1155    pIter(p);
     1156  }
     1157  return r;
     1158}
     1159
     1160poly ppJetW(poly p, int m, short *w)
    11371161{
    11381162  poly r=NULL;
    … …  
    11641188  ecartWeights=wsave;
    11651189  return r;
     1190}
     1191
     1192poly pSeries(int n,poly p,poly u=NULL)
     1193{
     1194  if(p!=NULL)
     1195  {
     1196    if(u==NULL)
     1197      p=pJet(p,n);
     1198    else
     1199      p=pJet(pMult(p,pInvers(n-pTotaldegree(p),u)),n);
     1200  }
     1201  return p;
     1202}
     1203
     1204poly pInvers(int n,poly u)
     1205{
     1206  if(n<0)
     1207    return NULL;
     1208  number u0=nInvers(pGetCoeff(u));
     1209  poly v=pNSet(u0);
     1210  if(n==0)
     1211    return v;
     1212  /* u0 is pGetCoeff(v) */ 
     1213  poly u1=pJet(pSub(pOne(),pMult_nn(u,u0)),n);
     1214  if(u1==NULL)
     1215    return v;
     1216  poly v1=pMult_nn(pCopy(u1),u0);
     1217  v=pAdd(v,pCopy(v1));
     1218  for(int i=n/pTotaldegree(u1);i>1;i--)
     1219  {
     1220    v1=pJet(pMult(v1,pCopy(u1)),n);
     1221    v=pAdd(v,pCopy(v1));
     1222  }
     1223  pDelete(&u1);
     1224  pDelete(&v1);
     1225  return v;
    11661226}
    11671227

  • Singular/units.cc

    r4cbe5d rd609e1  
    22*  Computer Algebra System SINGULAR      *
    33*****************************************/
    4 /* $Id: units.cc,v 1.5 2001-02-07 12:48:27 Singular Exp $ */
     4/* $Id: units.cc,v 1.6 2001-02-08 13:13:05 Singular Exp $ */
    55/*
    66* ABSTRACT: procedures to compute with units
    … …  
    1818#include <units.h>
    1919
    20 BOOLEAN isunit(poly u)
    21 {
    22   return (u!=NULL) && pIsConstant(u);
    23 //  if(u==NULL||pTotaldegree(u)>0)
    24 //    return FALSE;
    25 //  return TRUE;
    26 }
    27 
    28 BOOLEAN isunit(matrix U)
    29 {
    30   if(MATROWS(U)!=MATCOLS(U))
    31     return FALSE;
    32   for(int i=MATCOLS(U);i>=1;i--)
    33     if(!isunit(MATELEM(U,i,i)))
    34       return FALSE;
    35   return TRUE;
    36 }
    37 
    38 BOOLEAN invunit(leftv res,leftv h)
    39 {
    40   if(h!=NULL&&h->Typ()==INT_CMD)
    41   {
    42     int n=(int)h->Data();
    43     h=h->next;
    44     if(h!=NULL)
    45     {
    46       if(h->Typ()==POLY_CMD)
    47       {
    48         poly u=(poly)h->Data();
    49         if(!isunit(u))
    50         {
    51           WerrorS("unit expected");
    52           return TRUE;
    53         }
    54         res->rtyp=POLY_CMD;
    55         res->data=(void*)invunit(n,pCopy(u));
    56         return FALSE;
    57       }
    58       if(h->Typ()==MATRIX_CMD)
    59       {
    60         matrix U=(matrix)h->Data();
    61         if(!isunit(U))
    62         {
    63           WerrorS("diagonal matrix of units expected");
    64           return TRUE;
    65         }
    66         res->rtyp=MATRIX_CMD;
    67         res->data=(void*)invunit(n,mpCopy(U));
    68         return FALSE;
    69       }
    70     }
    71  }
    72   WerrorS("<int>,[<poly>|<matrix>] expected");
    73   return TRUE;
    74 }
    75 
    76 poly pjet(int n,poly p)
    77 {
    78   poly p0=pJet(p,n);
    79   pDelete(&p);
    80   return p0;
    81 }
    82 
    83 poly invunit(int n,poly u)
    84 {
    85   if(n<0)
    86     return NULL;
    87   number u0=nInvers(pGetCoeff(u));
    88   poly v=pNSet(u0);
    89   if(n==0)
    90     return v;
    91   poly u1=pjet(n,pSub(pOne(),pMult_nn(u,u0)));
    92   if(u1==NULL)
    93     return v;
    94   poly v1=pMult_nn(pCopy(u1),u0);
    95   v=pAdd(v,pCopy(v1));
    96   for(int i=n/pTotaldegree(u1);i>1;i--)
    97   {
    98     v1=pjet(n,pMult(v1,pCopy(u1)));
    99     v=pAdd(v,pCopy(v1));
    100   }
    101   pDelete(&u1);
    102   pDelete(&v1);
    103   return v;
    104 }
    105 
    10620matrix invunit(int n,matrix U)
    10721{
    108   assume(MATCOLS(u)==MATROWS(U));
     22  assume(MATCOLS(U)==MATROWS(U));
    10923  for(int i=MATCOLS(U);i>=1;i--)
    110     MATELEM(U,i,i)=invunit(n,MATELEM(U,i,i));
     24    MATELEM(U,i,i)=pInvers(n,MATELEM(U,i,i));
    11125  return U;
    112 }
    113 
    114 BOOLEAN series(leftv res,leftv h)
    115 {
    116   if(h!=NULL&&h->Typ()==INT_CMD)
    117   {
    118     int n=(int)h->Data();
    119     h=h->next;
    120     if(h!=NULL)
    121     {
    122       if(h->Typ()==POLY_CMD||h->Typ()==VECTOR_CMD)
    123       {
    124         int typ=h->Typ();
    125         poly p=(poly)h->Data();
    126         h=h->next;
    127         if(h==NULL)
    128         {
    129           res->rtyp=typ;
    130           res->data=(void*)series(n,pCopy(p));
    131           return FALSE;
    132         }
    133         if(h->Typ()==POLY_CMD)
    134         {
    135           poly u=(poly)h->Data();
    136           if(!isunit(u))
    137           {
    138             WerrorS("unit expected");
    139             return TRUE;
    140           }
    141           res->rtyp=typ;
    142           res->data=(void*)series(n,pCopy(p),pCopy(u));
    143           return FALSE;
    144         }
    145       }
    146       if(h->Typ()==IDEAL_CMD||h->Typ()==MODUL_CMD)
    147       {
    148         int typ=h->Typ();
    149         ideal M=(ideal)h->Data();
    150         h=h->next;
    151         if(h==NULL)
    152         {
    153           res->rtyp=typ;
    154           res->data=(void*)series(n,idCopy(M));
    155           return FALSE;
    156         }
    157         if(h->Typ()==MATRIX_CMD)
    158         {
    159           matrix U=(matrix)h->Data();
    160           if(!isunit(U))
    161           {
    162             WerrorS("diagonal matrix of units expected");
    163             return TRUE;
    164           }
    165           if(IDELEMS(M)!=MATROWS(U))
    166           {
    167             WerrorS("incompatible matrix size");
    168             return TRUE;
    169           }
    170           res->rtyp=typ;
    171           res->data=(void*)series(n,idCopy(M),mpCopy(U));
    172           return FALSE;
    173         }
    174       }
    175     }
    176   }
    177   WerrorS("<int>,[<poly>[,<poly>]|<ideal>[,<matrix>]] expected");
    178   return TRUE;
    179 }
    180 
    181 poly series(int n,poly p,poly u=NULL)
    182 {
    183   if(p!=NULL)
    184     if(u==NULL)
    185       p=pjet(n,p);
    186     else
    187       p=pjet(n,pMult(p,invunit(n-pTotaldegree(p),u)));
    188   return p;
    189 }
    190 
    191 ideal series(int n,ideal M,matrix U=NULL)
    192 {
    193   for(int i=IDELEMS(M)-1;i>=0;i--)
    194     if(U==NULL)
    195       M->m[i]=series(n,M->m[i]);
    196     else
    197     {
    198       M->m[i]=series(n,M->m[i],MATELEM(U,i+1,i+1));
    199       MATELEM(U,i+1,i+1)=NULL;
    200     }
    201   if(U!=NULL)
    202     idDelete((ideal*)&U);
    203   return M;
    204 }
    205 
    206 BOOLEAN rednf(leftv res,leftv h)
    207 {
    208   if(h!=NULL)
    209   {
    210     assumeStdFlag(h);
    211     if(h->Typ()==IDEAL_CMD||h->Typ()==MODUL_CMD)
    212     {
    213       int typ=h->Typ();
    214       ideal N=(ideal)h->Data();
    215       h=h->next;
    216       if(h!=NULL&&h->Typ()==typ)
    217       {
    218         ideal M=(ideal)h->Data();
    219         h=h->next;
    220         if(h==NULL)
    221         {
    222           res->rtyp=typ;
    223           res->data=(void*)rednf(idCopy(N),idCopy(M));
    224           return FALSE;
    225         }
    226         if(h->Typ()==MATRIX_CMD)
    227         {
    228           matrix U=(matrix)h->Data();
    229           if(!isunit(U))
    230           {
    231             WerrorS("diagonal matrix of units expected");
    232             return TRUE;
    233           }
    234           if(IDELEMS(M)!=MATROWS(U))
    235           {
    236             WerrorS("incompatible matrix size");
    237             return TRUE;
    238           }
    239           res->rtyp=typ;
    240           res->data=(void*)rednf(idCopy(N),idCopy(M),mpCopy(U));
    241           return FALSE;
    242         }
    243       }
    244       if(typ==IDEAL_CMD&&h->Typ()==POLY_CMD||
    245          typ==MODUL_CMD&&h->Typ()==VECTOR_CMD)
    246       {
    247         typ=h->Typ();
    248         poly p=(poly)h->Data();
    249         h=h->next;
    250         if(h==NULL)
    251         {
    252           res->rtyp=typ;
    253           res->data=(void*)rednf(idCopy(N),pCopy(p));
    254           return FALSE;
    255         }
    256         if(h->Typ()==POLY_CMD)
    257         {
    258           poly u=(poly)h->Data();
    259           if(!isunit(u))
    260           {
    261             WerrorS("unit expected");
    262             return TRUE;
    263           }
    264           res->rtyp=typ;
    265           res->data=(void*)rednf(idCopy(N),pCopy(p),pCopy(u));
    266           return FALSE;
    267         }
    268       }
    269     }
    270   }
    271   WerrorS("<ideal>,[<ideal>[,<matrix>]|<poly>[,<poly>]] expected");
    272   return TRUE;
    27326}
    27427

  • Singular/units.h

    r4cbe5d rd609e1  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: units.h,v 1.3 2001-02-01 15:54:46 mschulze Exp $ */
     4/* $Id: units.h,v 1.4 2001-02-08 13:13:05 Singular Exp $ */
    55/*
    66* ABSTRACT: procedures to compute with units
    … …  
    1313poly invunit(int n,poly u);
    1414matrix invunit(int n,matrix U);
    15 BOOLEAN series(leftv res,leftv h);
    16 poly series(int n,poly p,poly u=NULL);
    17 ideal series(int n,ideal M,matrix U=NULL);
    18 BOOLEAN rednf(leftv res,leftv h);
    1915ideal rednf(ideal N,ideal M,matrix U=NULL);
    2016poly rednf(ideal N,poly p,poly u=NULL);
Note: See TracChangeset for help on using the changeset viewer.