Changeset da408f in git


Ignore:
Timestamp:
Jul 8, 1999, 12:18:13 PM (24 years ago)
Author:
Moritz Wenk <wenk@…>
Branches:
(u'spielwiese', '828514cf6e480e4bafc26df99217bf2a1ed1ef45')
Children:
b719a30005f8bcbcca9d638b7908dda038ffee56
Parents:
4deddb979be065737d63e926fc05f264a6b1078a
Message:
*wenk: changed uressolve CMD_3 -> CMD_M (4)
	       laguerre  CMD2_ -> CMD_3
       removed "setFloatDigits" in extra.cc
       fixed output (2.2e33 -> 2.2e+33)
       adapted solve.lib to uressolve, laguerre, extended examples


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

Legend:

Unmodified
Added
Removed

  • Singular/LIB/solve.lib

    r4deddb rda408f  
    11///////////////////////////////////////////////////////////////////////////////
    22
    3 version="$Id: solve.lib,v 1.11 1999-07-07 16:38:28 obachman Exp $";
     3version="$Id: solve.lib,v 1.12 1999-07-08 10:18:13 wenk Exp $";
    44info="
    55LIBRARY: solve.lib     PROCEDURES TO SOLVE POLYNOMIAL SYSTEMS
    … …  
    6767  }
    6868
    69   int digits= system("setFloatDigits",prec);
    70 
    71   return(uressolve(gls,typ,polish));
     69  return(uressolve(gls,typ,prec,polish));
    7270
    7371}
    … …  
    8179  // result is a list (x,y)-coordinates as strings
    8280
    83   // now with complex coefficient field, precision is 10 digits
    84   ring rsc= (real,10,I),(x,y),lp;
     81  // now with complex coefficient field, precision is 20 digits
     82  ring rsc= (real,20,I),(x,y),lp;
    8583  ideal i = (2+3*I)*x2 + (0.35+I*45.0e-2)*y2 - 8, x2 + xy + (42.7)*y2;
    86   ures_solve(i);
     84  list l= ures_solve(i);
    8785  // result is a list of (x,y)-coordinates of complex numbers
     86  l;
     87  // check the result
     88  subst(subst(i[1],x,l[1][1]),y,l[1][2]);
    8889}
    8990///////////////////////////////////////////////////////////////////////////////
    … …  
    126127  }
    127128
    128   int digits= system("setFloatDigits",prec);
    129 
    130   return(laguerre(f,polish));
     129  return(laguerre(f,prec,polish));
    131130
    132131}
    … …  
    147146  list l = laguerre_solve(f);
    148147  l;
     148  // check result, value of substituted poly should be near to zero
     149  subst(f,x,l[1]);
     150  subst(f,x,l[2]);
    149151}
    150152///////////////////////////////////////////////////////////////////////////////
    … …  
    244246  ideal p = 2,3;
    245247  ideal v= 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16;
    246   interpolate( p,v,3 );
    247 }
    248 ///////////////////////////////////////////////////////////////////////////////
     248  poly ip= interpolate( p,v,3 );
     249  ip;
     250  // compute poly at point 2,3, result must be 2
     251  subst(subst(ip,x,2),y,3);
     252  // compute poly at point 2^15,3^15, result must be 16
     253  subst(subst(ip,x,2^15),y,3^15);
     254}
     255///////////////////////////////////////////////////////////////////////////////

  • Singular/extra.cc

    r4deddb rda408f  
    22*  Computer Algebra System SINGULAR      *
    33*****************************************/
    4 /* $Id: extra.cc,v 1.94 1999-06-28 12:48:07 wenk Exp $ */
     4/* $Id: extra.cc,v 1.95 1999-07-08 10:18:07 wenk Exp $ */
    55/*
    66* ABSTRACT: general interface to internals of Singular ("system" command)
    … …  
    409409    char *sys_cmd=(char *)(h->Data());
    410410    h=h->next;
    411 /*==================== setFloatDigits ================================*/
    412     if(strcmp(sys_cmd,"setFloatDigits")==0)
    413     {
    414       if ((h!=NULL) && (h->Typ()==INT_CMD))
    415         {
    416           if ( !(rField_is_R()||rField_is_long_R()||rField_is_long_C()) )
    417           {
    418             setGMPFloatDigits( (unsigned long int)h->Data() );
    419             res->rtyp=INT_CMD;
    420             res->data=(void*)getGMPFloatDigits();
    421           }
    422           else
    423           {
    424             res->rtyp=INT_CMD;
    425             res->data=(void*)0;
    426           }
    427           return FALSE;
    428         }
    429       else
    430         {
    431           WerrorS("int expected as second parameter");
    432         }
    433     }
    434     else
    435411/*==================== pcv ==================================*/
    436412#ifndef HAVE_DYNAMIC_LOADING

  • Singular/gnumpc.h

    r4deddb rda408f  
    44*  Computer Algebra System SINGULAR     *
    55****************************************/
    6 /* $Id: gnumpc.h,v 1.2 1999-06-24 07:46:49 wenk Exp $ */
     6/* $Id: gnumpc.h,v 1.3 1999-07-08 10:18:08 wenk Exp $ */
    77/*
    88* ABSTRACT: computations with GMP floating-point numbers
    … …  
    1010#include "structs.h"
    1111
    12 BOOLEAN  ngcGreaterZero(number za);
     12BOOLEAN  ngcGreaterZero(number za);      // !!! MAY NOT WORK AS EXPECTED !!!
    1313BOOLEAN  ngcGreater(number a, number b);
    1414BOOLEAN  ngcEqual(number a, number b);

  • Singular/iparith.cc

    r4deddb rda408f  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: iparith.cc,v 1.155 1999-06-30 14:41:04 pohl Exp $ */
     4/* $Id: iparith.cc,v 1.156 1999-07-08 10:18:09 wenk Exp $ */
    55
    66/*
    … …  
    196196  { "killattrib",  0, KILLATTR_CMD ,      CMD_12},
    197197  { "koszul",      0, KOSZUL_CMD ,        CMD_23},
    198   { "laguerre",    0, LAGSOLVE_CMD,       CMD_2},
     198  { "laguerre",    0, LAGSOLVE_CMD,       CMD_3},
    199199  { "lead",        0, LEAD_CMD ,          CMD_1},
    200200  { "leadcoef",    0, LEADCOEF_CMD ,      CMD_1},
    … …  
    295295  { "unload",      0, UNLOAD_CMD ,        CMD_M},
    296296#endif
    297   { "uressolve",   0, URSOLVE_CMD,        CMD_3},
     297  { "uressolve",   0, URSOLVE_CMD,        CMD_M},
    298298  { "vandermonde", 0, VANDER_CMD,         CMD_3},
    299299  { "var",         0, VAR_CMD ,           CMD_1},
    … …  
    22782278,{jjWEDGE,     WEDGE_CMD,      MATRIX_CMD,     MATRIX_CMD, INT_CMD PROFILER}
    22792279,{jjLOAD_E,    LOAD_CMD,       NONE,           STRING_CMD, STRING_CMD PROFILER}
    2280 ,{nuLagSolve,  LAGSOLVE_CMD,   LIST_CMD,       POLY_CMD,   INT_CMD PROFILER}
    22812280,{nuMPResMat,  MPRES_CMD,      MODUL_CMD,      IDEAL_CMD,  INT_CMD PROFILER}
    22822281,{NULL,        0,              0,              0,          0 PROFILER}
    … …  
    42984297,{jjSUBST_Id,       SUBST_CMD,  MODUL_CMD,  MODUL_CMD,  POLY_CMD,   POLY_CMD }
    42994298,{jjSUBST_Id,       SUBST_CMD,  MATRIX_CMD, MATRIX_CMD, POLY_CMD,   POLY_CMD }
    4300 ,{jjCALL3MANY,      SYSTEM_CMD, NONE,       STRING_CMD, DEF_CMD,    DEF_CMD }
    4301 ,{nuUResSolve,      URSOLVE_CMD,LIST_CMD,   IDEAL_CMD,  INT_CMD,    INT_CMD }
    4302 ,{nuVanderSys,      VANDER_CMD, POLY_CMD,   IDEAL_CMD,  IDEAL_CMD,  INT_CMD }
     4299,{jjCALL3MANY,      SYSTEM_CMD, NONE,       STRING_CMD, DEF_CMD,    DEF_CMD  }
     4300,{nuLagSolve,       LAGSOLVE_CMD,LIST_CMD,  POLY_CMD,   INT_CMD,    INT_CMD }
     4301,{nuVanderSys,      VANDER_CMD, POLY_CMD,   IDEAL_CMD,  IDEAL_CMD,  INT_CMD  }
    43034302,{NULL,             0,          0,          0,          0,          0 }
    43044303};
    … …  
    48144813,{jjUNLOAD,    UNLOAD_CMD,      NONE,               -2 }
    48154814#endif /* HAVE_NAMESPACES */
    4816 ,{NULL,        0,               0,                  0  }
     4815,{nuUResSolve, URSOLVE_CMD,     LIST_CMD,            4 }
     4816,{NULL,        0,               0,                   0 }
    48174817};
    48184818#ifdef MDEBUG

  • Singular/mpr_base.cc

    r4deddb rda408f  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: mpr_base.cc,v 1.6 1999-06-30 11:54:31 Singular Exp $ */
     4/* $Id: mpr_base.cc,v 1.7 1999-07-08 10:18:10 wenk Exp $ */
    55
    66/*
    … …  
    5050#define MAXINITELEMS   256
    5151#define LIFT_COOR      100000000
    52 #define SCALEDOWN      10000.0
     52#define SCALEDOWN      100000.0
    5353#define MAXSEED        1024 //512
    5454#define MINVDIST       0.0
    … …  
    26152615//-----------------------------------------------------------------------------
    26162616
    2617 #define MAXEVPOINT 1000000.0
     2617#define MAXEVPOINT 1.0e+6
    26182618
    26192619//-> unsigned long over(unsigned long n,unsigned long d)

  • Singular/mpr_complex.cc

    r4deddb rda408f  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: mpr_complex.cc,v 1.12 1999-07-02 16:43:19 wenk Exp $ */
     4/* $Id: mpr_complex.cc,v 1.13 1999-07-08 10:18:11 wenk Exp $ */
    55
    66/*
    … …  
    6969  size_t bits= 1 + (size_t) (digits / (log(2)/log(10)));
    7070  bits= bits>64?bits:64;
    71   //  gmp_float::setPrecision( bits+EXTRABYTES*8 );
    72   gmp_float::setPrecision( bits+(bits/2) );
     71  //gmp_float::setPrecision( bits+EXTRABYTES*8 );
     72  gmp_float::setPrecision( bits+(bits/5) );
    7373  gmp_float::setEqualBits( bits );
    7474  gmp_output_digits= digits;
    … …  
    338338      out= (char*)AllocL(*size);
    339339      memset(out,0,*size);
    340       sprintf(out,"%s0.%se%d",csign,in+sign,(unsigned int)exponent);
     340      sprintf(out,"%s0.%se%s%d",csign,in+sign,exponent>=0?"+":"",(int)exponent);
    341341//      }
    342342//      else

  • Singular/mpr_inout.cc

    r4deddb rda408f  
    33****************************************/
    44
    5 /* $Id: mpr_inout.cc,v 1.3 1999-06-29 09:03:45 wenk Exp $ */
     5/* $Id: mpr_inout.cc,v 1.4 1999-07-08 10:18:12 wenk Exp $ */
    66
    77/*
    … …  
    166166//<-
    167167
    168 //-> BOOLEAN nuUResSolve( leftv res, leftv arg1, leftv arg2, leftv arg3 )
    169 BOOLEAN nuUResSolve( leftv res, leftv arg1, leftv arg2, leftv arg3 )
    170 {
     168//-> BOOLEAN nuUResSolve( leftv res, leftv args )
     169BOOLEAN nuUResSolve( leftv res, leftv args )
     170{
     171  leftv v= args;
     172
    171173  ideal gls;
    172   gls= (ideal)(arg1->Data());
    173   int imtype= (int)arg2->Data();
    174   int howclean= (int)arg3->Data();
     174  int imtype;
     175  int howclean;
     176
     177  // get ideal
     178  if ( v->Typ() != IDEAL_CMD )
     179    return TRUE;
     180  else gls= (ideal)(args->Data());
     181  v= v->next;
     182
     183  // get resultant matrix type to use (0,1)
     184  if ( v->Typ() != INT_CMD )
     185    return TRUE;
     186  else imtype= (int)v->Data();
     187  v= v->next;
     188
     189  // get and set precision in digits ( > 0 )
     190  if ( v->Typ() != INT_CMD )
     191    return TRUE;
     192  else if ( !(rField_is_R()||rField_is_long_R()||rField_is_long_C()) )
     193  {
     194    setGMPFloatDigits( (unsigned long int)v->Data() );
     195  }
     196  v= v->next;
     197
     198  // get interpolation steps (0,1,2)
     199  if ( v->Typ() != INT_CMD )
     200    return TRUE;
     201  else howclean= (int)v->Data();
    175202
    176203  uResultant::resMatType mtype= determineMType( imtype );
    … …  
    181208  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
    182209
    183   emptylist= (lists)Alloc( sizeof(slists) );
    184   emptylist->Init( 0 );
    185 
    186   res->rtyp = LIST_CMD;
    187   res->data= (void *)emptylist;
     210  //emptylist= (lists)Alloc( sizeof(slists) );
     211  //emptylist->Init( 0 );
     212
     213  //res->rtyp = LIST_CMD;
     214  //res->data= (void *)emptylist;
    188215
    189216  TIMING_START(mpr_overall);
    190217
    191218  // check input ideal ( = polynomial system )
    192   if ( mprIdealCheck( gls, arg1->Name(), mtype ) != mprOk )
     219  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
    193220  {
    194221    return TRUE;
    … …  
    265292  else
    266293  {
    267     WerrorS("Solver was unable to find any root!");
     294    WerrorS("Solver was unable to find any roots!");
    268295    return TRUE;
    269296  }
    … …  
    283310  res->data= (void *)listofroots;
    284311
    285   emptylist->Clean();
    286   //Free( (ADDRESS) emptylist, sizeof(slists) );
     312  //emptylist->Clean();
     313  //  Free( (ADDRESS) emptylist, sizeof(slists) );
    287314
    288315  TIMING_EPR(mpr_overall,"overall time\t\t")
    … …  
    318345//<-
    319346
    320 //-> BOOLEAN nuLagSolve( leftv res, leftv arg1, leftv arg2 )
    321 BOOLEAN nuLagSolve( leftv res, leftv arg1, leftv arg2 )
     347//-> BOOLEAN nuLagSolve( leftv res, leftv arg1, leftv arg2, leftv arg3 )
     348BOOLEAN nuLagSolve( leftv res, leftv arg1, leftv arg2, leftv arg3 )
    322349{
    323350
    324351  poly gls;
    325352  gls= (poly)(arg1->Data());
    326   int howclean= (int)arg2->Data();
     353  int howclean= (int)arg3->Data();
     354
     355  if ( !(rField_is_R()||rField_is_long_R()||rField_is_long_C()) )
     356  {
     357    setGMPFloatDigits( (unsigned long int)arg2->Data() );
     358  }
    327359
    328360  int deg= pTotaldegree( gls );

  • Singular/mpr_inout.h

    r4deddb rda408f  
    55****************************************/
    66
    7 /* $Id: mpr_inout.h,v 1.3 1999-06-29 09:03:45 wenk Exp $ */
     7/* $Id: mpr_inout.h,v 1.4 1999-07-08 10:18:13 wenk Exp $ */
    88
    99/*
    … …  
    2222 * dense homogeneous polynoms) or MPR_SPARSE, which uses Sparse Resultant
    2323 * (Gelfand, Kapranov, Zelevinsky).
    24  * If interpolate == true then the determinant of the u-resultant will be
    25  * numerically interpolatet using a Vandermonde System.
    26  * Otherwise, the Sparse Bareiss will be used (faster!).
     24 * Arguments 4: ideal i, int k, int l, int m
     25 *   k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky
     26 *   k=1: use resultant matrix of Macaulay (k=0 is default)
     27 *   l>0: defines precision of fractional part if ground field is Q
     28 *   m=0,1,2: number of iterations for approximation of roots (default=2)
    2729 * Returns a list containing the roots of the system.
    2830 */
    29 BOOLEAN nuUResSolve( leftv res, leftv arg1, leftv arg2, leftv arg3 );
     31BOOLEAN nuUResSolve( leftv res, leftv args );
    3032
    31 /** build resultant matrix from ideal
    32  * Make sure that IDELEMS(ideal) == pVariables+1.
     33/** returns module representing the multipolynomial resultant matrix
     34 * Arguments 2: ideal i, int k
     35 *   k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky
     36 *   k=1: use resultant matrix of Macaulay (k=0 is default)
    3337 */
    3438BOOLEAN nuMPResMat( leftv res, leftv arg1, leftv arg2 );
    … …  
    3741 * Determines the roots of an univariate polynomial using Laguerres'
    3842 * root-solver. Good for polynomials with low and middle degree (<40).
    39  * Returns a list containing the roots of the polynomial.
     43 * Arguments 3: poly arg1 , int arg2 , int arg3
     44 *  arg2>0: defines precision of fractional part if ground field is Q
     45 *  arg3: number of iterations for approximation of roots (default=2)
     46 * Returns a list of all (complex) roots of the polynomial arg1
    4047 */
    41 BOOLEAN nuLagSolve( leftv res, leftv arg1, leftv arg2 );
     48BOOLEAN nuLagSolve( leftv res, leftv arg1, leftv arg2, leftv arg3 );
    4249
    4350/**
     51 * COMPUTE: polynomial p with values given by v at points p1,..,pN derived
     52 * from p; more precisely: consider p as point in K^n and v as N elements in K,
     53 * let p1,..,pN be the points in K^n obtained by evaluating all monomials
     54 * of degree 0,1,...,N at p in lexicographical order, then the procedure
     55 * computes the polynomial f satisfying f(pi) = v[i]
     56 * RETURN:  polynomial f of degree d
    4457 */
    4558BOOLEAN nuVanderSys( leftv res, leftv arg1, leftv arg2, leftv arg3 );
Note: See TracChangeset for help on using the changeset viewer.