Changeset 32ed4f in git


Ignore:
Timestamp:
Jun 7, 2006, 8:44:24 PM (17 years ago)
Author:
Oliver Wienand <wienand@…>
Branches:
(u'spielwiese', 'd1ba061a762c62d3a25159d8da8b6e17332291fa')
Children:
8dee806bede9bf5ad46984badc31c4ca67932402
Parents:
fde597007f11fbf16445cfd215c8d3ab696801a0
Message:
kstd2.cc:
deactivate zero reduction

kutil.cc:
chain crit restricted, need to be unleashed again

p_Mult_nn__T.cc:
Error in multiplication routine fixed

pInline1.h:
comments added


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

Legend:

Unmodified
Added
Removed
  • kernel/kstd2.cc

    rfde597 r32ed4f  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: kstd2.cc,v 1.16 2006-05-19 13:33:26 Singular Exp $ */
     4/* $Id: kstd2.cc,v 1.17 2006-06-07 18:44:23 wienand Exp $ */
    55/*
    66*  ABSTRACT -  Kernel: alg. of Buchberger
     
    343343  loop
    344344  {
    345     zeroPoly = kFindDivisibleByZeroPoly(h);
     345    zeroPoly = NULL; //kFindDivisibleByZeroPoly(h);
    346346    if (zeroPoly != NULL)
    347347    {
  • kernel/kutil.cc

    rfde597 r32ed4f  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: kutil.cc,v 1.23 2006-05-19 10:22:36 Singular Exp $ */
     4/* $Id: kutil.cc,v 1.24 2006-06-07 18:44:23 wienand Exp $ */
    55/*
    66* ABSTRACT: kernel: utils for kStd
     
    15961596  }
    15971597  else
     1598  {
     1599    for (j=strat->Ll; j>=0; j--)
     1600    {
     1601      if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
     1602      {
     1603        if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
     1604        {
     1605          deleteInL(strat->L,&strat->Ll,j,strat);
     1606          strat->c3++;
     1607        }
     1608      }
     1609    }
     1610    /*
     1611    *this is our MODIFICATION of GEBAUER-MOELLER:
     1612    *First the elements of B enter L,
     1613    *then we fix a lcm and the "best" element in L
     1614    *(i.e the last in L with this lcm and of type (s,p))
     1615    *and cancel all the other elements of type (r,p) with this lcm
     1616    *except the case the element (s,r) has also the same lcm
     1617    *and is on the worst position with respect to (s,p) and (r,p)
     1618    */
     1619    /*
     1620    *B enters to L/their order with respect to B is permutated for elements
     1621    *B[i].p with the same leading term
     1622    */
     1623    j = strat->Ll;
     1624    for (i=strat->Bl; i>=0; i--)
     1625    {
     1626      j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
     1627      enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
     1628    }
     1629    strat->Bl = -1;
     1630    j = strat->Ll;
     1631    loop  /*cannot be changed into a for !!! */
     1632    {
     1633      if (j <= 0)
     1634      {
     1635        /*now L[0] cannot be canceled any more and the tail can be removed*/
     1636        if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
     1637        break;
     1638      }
     1639      if (strat->L[j].p2 == p)
     1640      {
     1641        i = j-1;
     1642        loop
     1643        {
     1644          if (i < 0)  break;
     1645          if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm)
     1646#ifdef HAVE_RING2TOM
     1647            && pDivisibleBy(strat->L[j].lcm, strat->L[i].lcm)
     1648#endif
     1649          )
     1650          {
     1651            /*L[i] could be canceled but we search for a better one to cancel*/
     1652            strat->c3++;
     1653            if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
     1654            && (pNext(strat->L[l].p) == strat->tail)
     1655            && (!pLmEqual(strat->L[i].p,strat->L[l].p))
     1656#ifdef HAVE_RING2TOM
     1657            && 1 == 0
     1658#endif
     1659            && pDivisibleBy(p,strat->L[l].lcm))
     1660            {
     1661              /*
     1662              *"NOT equal(...)" because in case of "equal" the element L[l]
     1663              *is "older" and has to be from theoretical point of view behind
     1664              *L[i], but we do not want to reorder L
     1665              */
     1666              strat->L[i].p2 = strat->tail;
     1667              /*
     1668              *L[l] will be canceled, we cannot cancel L[i] later on,
     1669              *so we mark it with "tail"
     1670              */
     1671              deleteInL(strat->L,&strat->Ll,l,strat);
     1672              i--;
     1673            }
     1674            else
     1675            {
     1676              deleteInL(strat->L,&strat->Ll,i,strat);
     1677            }
     1678            j--;
     1679          }
     1680          i--;
     1681        }
     1682      }
     1683      else if (strat->L[j].p2 == strat->tail)
     1684      {
     1685        /*now L[j] cannot be canceled any more and the tail can be removed*/
     1686        strat->L[j].p2 = p;
     1687      }
     1688      j--;
     1689    }
     1690  }
     1691}
     1692
     1693/*2
     1694*(s[0],h),...,(s[k],h) will be put to the pairset L
     1695*/
     1696void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
     1697{
     1698
     1699  if ((strat->syzComp==0)
     1700  || (pGetComp(h)<=strat->syzComp))
     1701  {
     1702    int j;
     1703    BOOLEAN new_pair=FALSE;
     1704
     1705    if (pGetComp(h)==0)
     1706    {
     1707      /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
     1708      if ((isFromQ)&&(strat->fromQ!=NULL))
     1709      {
     1710        for (j=0; j<=k; j++)
     1711        {
     1712          if (!strat->fromQ[j])
     1713          {
     1714            new_pair=TRUE;
     1715            enterOnePair(j,h,ecart,isFromQ,strat, atR);
     1716          //Print("j:%d, Ll:%d\n",j,strat->Ll);
     1717          }
     1718        }
     1719      }
     1720      else
     1721      {
     1722        new_pair=TRUE;
     1723        for (j=0; j<=k; j++)
     1724        {
     1725          enterOnePair(j,h,ecart,isFromQ,strat, atR);
     1726          //Print("j:%d, Ll:%d\n",j,strat->Ll);
     1727        }
     1728      }
     1729    }
     1730    else
     1731    {
     1732      for (j=0; j<=k; j++)
     1733      {
     1734        if ((pGetComp(h)==pGetComp(strat->S[j]))
     1735        || (pGetComp(strat->S[j])==0))
     1736        {
     1737          new_pair=TRUE;
     1738          enterOnePair(j,h,ecart,isFromQ,strat, atR);
     1739        //Print("j:%d, Ll:%d\n",j,strat->Ll);
     1740        }
     1741      }
     1742    }
     1743
     1744    if (new_pair) chainCrit(h,ecart,strat);
     1745
     1746  }
     1747}
     1748
     1749#ifdef HAVE_RING2TOM
     1750/*2
     1751*the pairset B of pairs of type (s[i],p) is complete now. It will be updated
     1752*using the chain-criterion in B and L and enters B to L
     1753*/
     1754void chainCritRing (poly p,int ecart,kStrategy strat)
     1755{
     1756  int i,j,l;
     1757
     1758  /*
     1759  *pairtest[i] is TRUE if spoly(S[i],p) == 0.
     1760  *In this case all elements in B such
     1761  *that their lcm is divisible by the leading term of S[i] can be canceled
     1762  */
     1763  if (strat->pairtest!=NULL)
     1764  {
     1765    {
     1766      /*- i.e. there is an i with pairtest[i]==TRUE -*/
     1767      for (j=0; j<=strat->sl; j++)
     1768      {
     1769        if (strat->pairtest[j])
     1770        {
     1771          for (i=strat->Bl; i>=0; i--)
     1772          {
     1773            if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
     1774            {
     1775              deleteInL(strat->B,&strat->Bl,i,strat);
     1776              strat->c3++;
     1777            }
     1778          }
     1779        }
     1780      }
     1781    }
     1782    omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
     1783    strat->pairtest=NULL;
     1784  }
     1785  if (strat->Gebauer || strat->fromT)
     1786  {
     1787    WarnS("Gebauer or fromT not tested yet in chainCritRing.");
     1788    if (strat->sugarCrit)
     1789    {
     1790        WarnS("Sugar Criterion not yet available for coefficient rings.");
     1791    }
     1792    else /*sugarCrit*/
     1793    {
     1794      /*
     1795      *suppose L[j] == (s,r) and p/lcm(s,r)
     1796      *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
     1797      *and in case the sugar is o.k. then L[j] can be canceled
     1798      */
     1799      for (j=strat->Ll; j>=0; j--)
     1800      {
     1801        if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
     1802        {
     1803          if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
     1804          {
     1805            deleteInL(strat->L,&strat->Ll,j,strat);
     1806            strat->c3++;
     1807          }
     1808        }
     1809      }
     1810      /*
     1811      *this is GEBAUER-MOELLER:
     1812      *in B all elements with the same lcm except the "best"
     1813      *(i.e. the last one in B with this property) will be canceled
     1814      */
     1815      j = strat->Bl;
     1816      loop   /*cannot be changed into a for !!! */
     1817      {
     1818        if (j <= 0) break;
     1819        for(i=j-1; i>=0; i--)
     1820        {
     1821          if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
     1822          {
     1823            strat->c3++;
     1824            deleteInL(strat->B,&strat->Bl,i,strat);
     1825            j--;
     1826          }
     1827        }
     1828        j--;
     1829      }
     1830    }
     1831    /*
     1832    *the elements of B enter L/their order with respect to B is kept
     1833    *j = posInL(L,j,B[i]) would permutate the order
     1834    *if once B is ordered different from L
     1835    *then one should use j = posInL(L,Ll,B[i])
     1836    */
     1837    j = strat->Ll+1;
     1838    for (i=strat->Bl; i>=0; i--)
     1839    {
     1840      j = strat->posInL(strat->L,j-1,&(strat->B[i]),strat);
     1841      enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
     1842    }
     1843    strat->Bl = -1;
     1844  }
     1845  else /* Gebauer or fromT */
    15981846  {
    15991847    for (j=strat->Ll; j>=0; j--)
     
    16841932}
    16851933
    1686 /*2
    1687 *(s[0],h),...,(s[k],h) will be put to the pairset L
    1688 */
    1689 void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
    1690 {
    1691 
    1692   if ((strat->syzComp==0)
    1693   || (pGetComp(h)<=strat->syzComp))
    1694   {
    1695     int j;
    1696     BOOLEAN new_pair=FALSE;
    1697 
    1698     if (pGetComp(h)==0)
    1699     {
    1700       /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
    1701       if ((isFromQ)&&(strat->fromQ!=NULL))
    1702       {
    1703         for (j=0; j<=k; j++)
    1704         {
    1705           if (!strat->fromQ[j])
    1706           {
    1707             new_pair=TRUE;
    1708             enterOnePair(j,h,ecart,isFromQ,strat, atR);
    1709           //Print("j:%d, Ll:%d\n",j,strat->Ll);
    1710           }
    1711         }
    1712       }
    1713       else
    1714       {
    1715         new_pair=TRUE;
    1716         for (j=0; j<=k; j++)
    1717         {
    1718           enterOnePair(j,h,ecart,isFromQ,strat, atR);
    1719           //Print("j:%d, Ll:%d\n",j,strat->Ll);
    1720         }
    1721       }
    1722     }
    1723     else
    1724     {
    1725       for (j=0; j<=k; j++)
    1726       {
    1727         if ((pGetComp(h)==pGetComp(strat->S[j]))
    1728         || (pGetComp(strat->S[j])==0))
    1729         {
    1730           new_pair=TRUE;
    1731           enterOnePair(j,h,ecart,isFromQ,strat, atR);
    1732         //Print("j:%d, Ll:%d\n",j,strat->Ll);
    1733         }
    1734       }
    1735     }
    1736 
    1737     if (new_pair) chainCrit(h,ecart,strat);
    1738 
    1739   }
    1740 }
    1741 
    1742 #ifdef HAVE_RING2TOM
    1743 /*2
    1744 *the pairset B of pairs of type (s[i],p) is complete now. It will be updated
    1745 *using the chain-criterion in B and L and enters B to L
    1746 */
    1747 void chainCritRing (poly p,int ecart,kStrategy strat)
    1748 {
    1749   int i,j,l;
    1750 
    1751   /*
    1752   *pairtest[i] is TRUE if spoly(S[i],p) == 0.
    1753   *In this case all elements in B such
    1754   *that their lcm is divisible by the leading term of S[i] can be canceled
    1755   */
    1756   if (strat->pairtest!=NULL)
    1757   {
    1758     {
    1759       /*- i.e. there is an i with pairtest[i]==TRUE -*/
    1760       for (j=0; j<=strat->sl; j++)
    1761       {
    1762         if (strat->pairtest[j])
    1763         {
    1764           for (i=strat->Bl; i>=0; i--)
    1765           {
    1766             if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
    1767             {
    1768               deleteInL(strat->B,&strat->Bl,i,strat);
    1769               strat->c3++;
    1770             }
    1771           }
    1772         }
    1773       }
    1774     }
    1775     omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
    1776     strat->pairtest=NULL;
    1777   }
    1778   if (strat->Gebauer || strat->fromT)
    1779   {
    1780     WarnS("Gebauer or fromT not tested yet in chainCritRing.");
    1781     if (strat->sugarCrit)
    1782     {
    1783         WarnS("Sugar Criterion not yet available for coefficient rings.");
    1784     }
    1785     else /*sugarCrit*/
    1786     {
    1787       /*
    1788       *suppose L[j] == (s,r) and p/lcm(s,r)
    1789       *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
    1790       *and in case the sugar is o.k. then L[j] can be canceled
    1791       */
    1792       for (j=strat->Ll; j>=0; j--)
    1793       {
    1794         if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
    1795         {
    1796           if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
    1797           {
    1798             deleteInL(strat->L,&strat->Ll,j,strat);
    1799             strat->c3++;
    1800           }
    1801         }
    1802       }
    1803       /*
    1804       *this is GEBAUER-MOELLER:
    1805       *in B all elements with the same lcm except the "best"
    1806       *(i.e. the last one in B with this property) will be canceled
    1807       */
    1808       j = strat->Bl;
    1809       loop   /*cannot be changed into a for !!! */
    1810       {
    1811         if (j <= 0) break;
    1812         for(i=j-1; i>=0; i--)
    1813         {
    1814           if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
    1815           {
    1816             strat->c3++;
    1817             deleteInL(strat->B,&strat->Bl,i,strat);
    1818             j--;
    1819           }
    1820         }
    1821         j--;
    1822       }
    1823     }
    1824     /*
    1825     *the elements of B enter L/their order with respect to B is kept
    1826     *j = posInL(L,j,B[i]) would permutate the order
    1827     *if once B is ordered different from L
    1828     *then one should use j = posInL(L,Ll,B[i])
    1829     */
    1830     j = strat->Ll+1;
    1831     for (i=strat->Bl; i>=0; i--)
    1832     {
    1833       j = strat->posInL(strat->L,j-1,&(strat->B[i]),strat);
    1834       enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
    1835     }
    1836     strat->Bl = -1;
    1837   }
    1838   else /* Gebauer or fromT */
    1839   {
    1840     for (j=strat->Ll; j>=0; j--)
    1841     {
    1842       if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
    1843       {
    1844         if ((pNext(strat->L[j].p) == strat->tail)||(pOrdSgn==1))
    1845         {
    1846           deleteInL(strat->L,&strat->Ll,j,strat);
    1847           strat->c3++;
    1848         }
    1849       }
    1850     }
    1851     /*
    1852     *this is our MODIFICATION of GEBAUER-MOELLER:
    1853     *First the elements of B enter L,
    1854     *then we fix a lcm and the "best" element in L
    1855     *(i.e the last in L with this lcm and of type (s,p))
    1856     *and cancel all the other elements of type (r,p) with this lcm
    1857     *except the case the element (s,r) has also the same lcm
    1858     *and is on the worst position with respect to (s,p) and (r,p)
    1859     */
    1860     /*
    1861     *B enters to L/their order with respect to B is permutated for elements
    1862     *B[i].p with the same leading term
    1863     */
    1864     j = strat->Ll;
    1865     for (i=strat->Bl; i>=0; i--)
    1866     {
    1867       j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
    1868       enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
    1869     }
    1870     strat->Bl = -1;
    1871     j = strat->Ll;
    1872     loop  /*cannot be changed into a for !!! */
    1873     {
    1874       if (j <= 0)
    1875       {
    1876         /*now L[0] cannot be canceled any more and the tail can be removed*/
    1877         if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
    1878         break;
    1879       }
    1880       if (strat->L[j].p2 == p)
    1881       {
    1882         i = j-1;
    1883         loop
    1884         {
    1885           if (i < 0)  break;
    1886           if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
    1887           {
    1888             /*L[i] could be canceled but we search for a better one to cancel*/
    1889             strat->c3++;
    1890             if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
    1891             && (pNext(strat->L[l].p) == strat->tail)
    1892             && (!pLmEqual(strat->L[i].p,strat->L[l].p))
    1893             && pDivisibleBy(p,strat->L[l].lcm))
    1894             {
    1895               /*
    1896               *"NOT equal(...)" because in case of "equal" the element L[l]
    1897               *is "older" and has to be from theoretical point of view behind
    1898               *L[i], but we do not want to reorder L
    1899               */
    1900               strat->L[i].p2 = strat->tail;
    1901               /*
    1902               *L[l] will be canceled, we cannot cancel L[i] later on,
    1903               *so we mark it with "tail"
    1904               */
    1905               deleteInL(strat->L,&strat->Ll,l,strat);
    1906               i--;
    1907             }
    1908             else
    1909             {
    1910               deleteInL(strat->L,&strat->Ll,i,strat);
    1911             }
    1912             j--;
    1913           }
    1914           i--;
    1915         }
    1916       }
    1917       else if (strat->L[j].p2 == strat->tail)
    1918       {
    1919         /*now L[j] cannot be canceled any more and the tail can be removed*/
    1920         strat->L[j].p2 = p;
    1921       }
    1922       j--;
    1923     }
    1924   }
    1925 }
    1926 
    19271934long twoPow(long arg)
    19281935{
     
    19521959            new_pair=TRUE;
    19531960            enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
    1954             //Print("j:%d, Ll:%d\n",j,strat->Ll);
     1961            Print("j:%d, Ll:%d\n",j,strat->Ll);
    19551962          }
    19561963        }
     
    19621969        {
    19631970          enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
    1964           //Print("j:%d, Ll:%d\n",j,strat->Ll);
     1971          // Print("j:%d, Ll:%d\n",j,strat->Ll);
    19651972        }
    19661973      }
     
    19741981          new_pair=TRUE;
    19751982          enterOnePairRing(j,h,ecart,isFromQ,strat, atR);
    1976           //Print("j:%d, Ll:%d\n",j,strat->Ll);
     1983          Print("j:%d, Ll:%d\n",j,strat->Ll);
    19771984        }
    19781985      }
     
    20442051        if (pNext(p) != NULL)
    20452052        {
    2046           pShallowCopyDeleteProc p_shallow_copy_delete
    2047                = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
    2048           pNext(p) = p_shallow_copy_delete(pNext(p),
    2049                        currRing, strat->tailRing, strat->tailRing->PolyBin);
     2053          // What does this? (Oliver)
     2054          // pShallowCopyDeleteProc p_shallow_copy_delete
     2055          //      = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
     2056          // pNext(p) = p_shallow_copy_delete(pNext(p),
     2057          //              currRing, strat->tailRing, strat->tailRing->PolyBin);
    20502058        }
    20512059        enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
     
    20862094    initenterpairsRing(h, k, ecart, 0, strat, atR);
    20872095  }
    2088   else 
     2096  else
    20892097  {
    20902098    initenterpairs(h, k, ecart, 0, strat, atR);
  • kernel/pInline1.h

    rfde597 r32ed4f  
    77 *  Author:  obachman (Olaf Bachmann)
    88 *  Created: 8/00
    9  *  Version: $Id: pInline1.h,v 1.5 2006-02-15 13:00:21 Singular Exp $
     9 *  Version: $Id: pInline1.h,v 1.6 2006-06-07 18:44:24 wienand Exp $
    1010 *******************************************************************/
    1111#ifndef PINLINE1_H
     
    407407      rside = rside / 2;
    408408    }
    409     return (lside%2 != 0);
     409    return (lside%2 != 0);     // Is lside, i.e. LC(a), a unit?
    410410  }
    411411  return FALSE;
  • kernel/p_Mult_nn__T.cc

    rfde597 r32ed4f  
    77 *  Author:  obachman (Olaf Bachmann)
    88 *  Created: 8/00
    9  *  Version: $Id: p_Mult_nn__T.cc,v 1.5 2006-02-28 17:50:33 wienand Exp $
     9 *  Version: $Id: p_Mult_nn__T.cc,v 1.6 2006-06-07 18:44:24 wienand Exp $
    1010 *******************************************************************/
    1111
     
    2323
    2424  poly q = p;
     25#ifdef HAVE_RING2TOM
     26  poly old = NULL;
     27#endif
    2528  while (p != NULL)
    2629  {
     
    3538    {
    3639       p_SetCoeff(p, tmp, r);
     40       old = p;
    3741       pIter(p);
    3842    }
     
    4044    {
    4145      n_Delete(&tmp, r);
    42       if (p == q) { q = pNext(q); }
    43       p = pNext(p);    // TODO Free Monom OLIVER
     46      if (old == NULL) { q = pNext(q); }
     47      else { pNext(old) = pNext(p); }
     48      pIter(p);    // TODO Free Monom OLIVER
    4449    }
    4550#endif
Note: See TracChangeset for help on using the changeset viewer.