Macros | Functions
extra.cc File Reference
#include <kernel/mod2.h>
#include <misc/auxiliary.h>
#include <misc/sirandom.h>
#include <factory/factory.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include <signal.h>
#include <time.h>
#include <sys/time.h>
#include <unistd.h>
#include <misc/options.h>
#include <coeffs/coeffs.h>
#include <coeffs/mpr_complex.h>
#include "coeffs/AE.h"
#include "coeffs/AEp.h"
#include "coeffs/AEQ.h"
#include <resources/feResource.h>
#include <polys/monomials/ring.h>
#include <kernel/polys.h>
#include <polys/monomials/maps.h>
#include <polys/matpol.h>
#include <polys/prCopy.h>
#include <polys/weight.h>
#include <coeffs/bigintmat.h>
#include <kernel/fast_mult.h>
#include <kernel/digitech.h>
#include <kernel/combinatorics/stairc.h>
#include <kernel/ideals.h>
#include <kernel/GBEngine/kstd1.h>
#include <kernel/GBEngine/syz.h>
#include <kernel/GBEngine/kutil.h>
#include <kernel/GBEngine/shiftgb.h>
#include <kernel/linear_algebra/linearAlgebra.h>
#include <kernel/combinatorics/hutil.h>
#include <kernel/GBEngine/tgb.h>
#include <kernel/linear_algebra/minpoly.h>
#include <numeric/mpr_base.h>
#include "tok.h"
#include "ipid.h"
#include "lists.h"
#include "cntrlc.h"
#include "ipshell.h"
#include "sdb.h"
#include "feOpt.h"
#include "fehelp.h"
#include "distrib.h"
#include "misc_ip.h"
#include "attrib.h"
#include "links/silink.h"
#include "walk.h"
#include <Singular/newstruct.h>
#include <Singular/blackbox.h>
#include <Singular/pyobject_setup.h>
#include <kernel/GBEngine/ringgb.h>
#include <kernel/GBEngine/f5gb.h>
#include <kernel/spectrum/spectrum.h>
#include <polys/nc/nc.h>
#include <polys/nc/ncSAMult.h>
#include <polys/nc/sca.h>
#include <kernel/GBEngine/nc.h>
#include "ipconv.h"
#include <kernel/GBEngine/ratgring.h>
#include <polys/flintconv.h>
#include <polys/clapconv.h>
#include <kernel/GBEngine/kstdfac.h>
#include <polys/clapsing.h>
#include "eigenval_ip.h"
#include "gms.h"
#include "Singular/links/simpleipc.h"
#include "pcv.h"
#include <kernel/fglm/fglmcomb.cc>
#include <kernel/fglm/fglm.h>
#include <hc_newton.h>
#include <polys/mod_raw.h>

Go to the source code of this file.

Macros

#define HAVE_WALK   1
 
#define HAVE_EXTENDED_SYSTEM   1
 
#define TEST_FOR(A)   if(strcmp(s,A)==0) res->data=(void *)1; else
 
#define HAVE_SHEAFCOH_TRICKS   1
 

Functions

static BOOLEAN jjEXTENDED_SYSTEM (leftv res, leftv h)
 
unsigned long ** singularMatrixToLongMatrix (matrix singularMatrix)
 
poly longCoeffsToSingularPoly (unsigned long *polyCoeffs, const int degree)
 
BOOLEAN jjSYSTEM (leftv res, leftv args)
 

Macro Definition Documentation

#define HAVE_EXTENDED_SYSTEM   1

Definition at line 146 of file extra.cc.

#define HAVE_SHEAFCOH_TRICKS   1
#define HAVE_WALK   1

Definition at line 11 of file extra.cc.

#define TEST_FOR (   A)    if(strcmp(s,A)==0) res->data=(void *)1; else

Function Documentation

static BOOLEAN jjEXTENDED_SYSTEM ( leftv  res,
leftv  h 
)
static

Definition at line 2218 of file extra.cc.

2219 {
2220  if(h->Typ() == STRING_CMD)
2221  {
2222  char *sys_cmd=(char *)(h->Data());
2223  h=h->next;
2224  /*==================== test syz strat =================*/
2225  if (strcmp(sys_cmd, "syz") == 0)
2226  {
2227  int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p);
2228  int posInT_FDegpLength(const TSet set,const int length,LObject &p);
2229  int posInT_pLength(const TSet set,const int length,LObject &p);
2230  int posInT0(const TSet set,const int length,LObject &p);
2231  int posInT1(const TSet set,const int length,LObject &p);
2232  int posInT2(const TSet set,const int length,LObject &p);
2233  int posInT11(const TSet set,const int length,LObject &p);
2234  int posInT110(const TSet set,const int length,LObject &p);
2235  int posInT13(const TSet set,const int length,LObject &p);
2236  int posInT15(const TSet set,const int length,LObject &p);
2237  int posInT17(const TSet set,const int length,LObject &p);
2238  int posInT17_c(const TSet set,const int length,LObject &p);
2239  int posInT19(const TSet set,const int length,LObject &p);
2240  if ((h!=NULL) && (h->Typ()==STRING_CMD))
2241  {
2242  const char *s=(const char *)h->Data();
2243  if (strcmp(s,"posInT_EcartFDegpLength")==0)
2245  else if (strcmp(s,"posInT_FDegpLength")==0)
2247  else if (strcmp(s,"posInT_pLength")==0)
2249  else if (strcmp(s,"posInT0")==0)
2251  else if (strcmp(s,"posInT1")==0)
2253  else if (strcmp(s,"posInT2")==0)
2255  else if (strcmp(s,"posInT11")==0)
2257  else if (strcmp(s,"posInT110")==0)
2259  else if (strcmp(s,"posInT13")==0)
2261  else if (strcmp(s,"posInT15")==0)
2263  else if (strcmp(s,"posInT17")==0)
2265  else if (strcmp(s,"posInT17_c")==0)
2267  else if (strcmp(s,"posInT19")==0)
2269  else Print("valid posInT:0,1,2,11,110,13,15,17,17_c,19,_EcartFDegpLength,_FDegpLength,_pLength,_EcartpLength\n");
2270  }
2271  else
2272  {
2273  test_PosInT=NULL;
2274  test_PosInL=NULL;
2275  }
2276  si_opt_2|=Sy_bit(23);
2277  return FALSE;
2278  }
2279  else
2280  /*==================== locNF ======================================*/
2281  if(strcmp(sys_cmd,"locNF")==0)
2282  {
2283  const short t[]={4,VECTOR_CMD,MODUL_CMD,INT_CMD,INTVEC_CMD};
2284  if (iiCheckTypes(h,t,1))
2285  {
2286  poly f=(poly)h->Data();
2287  h=h->next;
2288  ideal m=(ideal)h->Data();
2289  assumeStdFlag(h);
2290  h=h->next;
2291  int n=(int)((long)h->Data());
2292  h=h->next;
2293  intvec *v=(intvec *)h->Data();
2294 
2295  /* == now the work starts == */
2296 
2297  short * iv=iv2array(v, currRing);
2298  poly r=0;
2299  poly hp=ppJetW(f,n,iv);
2300  int s=MATCOLS(m);
2301  int j=0;
2302  matrix T=mp_InitI(s,1,0, currRing);
2303 
2304  while (hp != NULL)
2305  {
2306  if (pDivisibleBy(m->m[j],hp))
2307  {
2308  if (MATELEM(T,j+1,1)==0)
2309  {
2310  MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
2311  }
2312  else
2313  {
2314  pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
2315  }
2316  hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
2317  j=0;
2318  }
2319  else
2320  {
2321  if (j==s-1)
2322  {
2323  r=pAdd(r,pHead(hp));
2324  hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
2325  j=0;
2326  }
2327  else
2328  {
2329  j++;
2330  }
2331  }
2332  }
2333 
2336  for (int k=1;k<=MATROWS(Temp);k++)
2337  {
2338  MATELEM(R,k,1)=MATELEM(Temp,k,1);
2339  }
2340 
2342  L->Init(2);
2343  L->m[0].rtyp=MATRIX_CMD; L->m[0].data=(void *)R;
2344  L->m[1].rtyp=MATRIX_CMD; L->m[1].data=(void *)T;
2345  res->data=L;
2346  res->rtyp=LIST_CMD;
2347  // iv aufraeumen
2348  omFree(iv);
2349  return FALSE;
2350  }
2351  else
2352  return TRUE;
2353  }
2354  else
2355  /*==================== poly debug ==================================*/
2356  if(strcmp(sys_cmd,"p")==0)
2357  {
2358 # ifdef RDEBUG
2359  p_DebugPrint((poly)h->Data(), currRing);
2360 # else
2361  Warn("Sorry: not available for release build!");
2362 # endif
2363  return FALSE;
2364  }
2365  else
2366  /*==================== setsyzcomp ==================================*/
2367  if(strcmp(sys_cmd,"setsyzcomp")==0)
2368  {
2369  if ((h!=NULL) && (h->Typ()==INT_CMD))
2370  {
2371  int k = (int)(long)h->Data();
2372  if ( currRing->order[0] == ringorder_s )
2373  {
2374  rSetSyzComp(k, currRing);
2375  }
2376  }
2377  }
2378  /*==================== ring debug ==================================*/
2379  if(strcmp(sys_cmd,"r")==0)
2380  {
2381 # ifdef RDEBUG
2382  rDebugPrint((ring)h->Data());
2383 # else
2384  Warn("Sorry: not available for release build!");
2385 # endif
2386  return FALSE;
2387  }
2388  else
2389  /*==================== changeRing ========================*/
2390  /* The following code changes the names of the variables in the
2391  current ring to "x1", "x2", ..., "xN", where N is the number
2392  of variables in the current ring.
2393  The purpose of this rewriting is to eliminate indexed variables,
2394  as they may cause problems when generating scripts for Magma,
2395  Maple, or Macaulay2. */
2396  if(strcmp(sys_cmd,"changeRing")==0)
2397  {
2398  int varN = currRing->N;
2399  char h[10];
2400  for (int i = 1; i <= varN; i++)
2401  {
2402  omFree(currRing->names[i - 1]);
2403  sprintf(h, "x%d", i);
2404  currRing->names[i - 1] = omStrDup(h);
2405  }
2407  res->rtyp = INT_CMD;
2408  res->data = (void*)0L;
2409  return FALSE;
2410  }
2411  else
2412  /*==================== mtrack ==================================*/
2413  if(strcmp(sys_cmd,"mtrack")==0)
2414  {
2415  #ifdef OM_TRACK
2416  om_Opts.MarkAsStatic = 1;
2417  FILE *fd = NULL;
2418  int max = 5;
2419  while (h != NULL)
2420  {
2421  omMarkAsStaticAddr(h);
2422  if (fd == NULL && h->Typ()==STRING_CMD)
2423  {
2424  fd = fopen((char*) h->Data(), "w");
2425  if (fd == NULL)
2426  Warn("Can not open %s for writing og mtrack. Using stdout"); // %s ???
2427  }
2428  if (h->Typ() == INT_CMD)
2429  {
2430  max = (int)(long)h->Data();
2431  }
2432  h = h->Next();
2433  }
2434  omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2435  if (fd != NULL) fclose(fd);
2436  om_Opts.MarkAsStatic = 0;
2437  return FALSE;
2438  #endif
2439  }
2440  /*==================== mtrack_all ==================================*/
2441  if(strcmp(sys_cmd,"mtrack_all")==0)
2442  {
2443  #ifdef OM_TRACK
2444  om_Opts.MarkAsStatic = 1;
2445  FILE *fd = NULL;
2446  if ((h!=NULL) &&(h->Typ()==STRING_CMD))
2447  {
2448  fd = fopen((char*) h->Data(), "w");
2449  if (fd == NULL)
2450  Warn("Can not open %s for writing og mtrack. Using stdout");
2451  omMarkAsStaticAddr(h);
2452  }
2453  // OB: TBC print to fd
2454  omPrintUsedAddrs((fd == NULL ? stdout : fd), 5);
2455  if (fd != NULL) fclose(fd);
2456  om_Opts.MarkAsStatic = 0;
2457  return FALSE;
2458  #endif
2459  }
2460  else
2461  /*==================== backtrace ==================================*/
2462  #ifndef OM_NDEBUG
2463  if(strcmp(sys_cmd,"backtrace")==0)
2464  {
2465  omPrintCurrentBackTrace(stdout);
2466  return FALSE;
2467  }
2468  else
2469  #endif
2470 
2471 #if !defined(OM_NDEBUG)
2472  /*==================== omMemoryTest ==================================*/
2473  if (strcmp(sys_cmd,"omMemoryTest")==0)
2474  {
2475 
2476 #ifdef OM_STATS_H
2477  PrintS("\n[om_Info]: \n");
2478  omUpdateInfo();
2479 #define OM_PRINT(name) Print(" %-22s : %10ld \n", #name, om_Info . name)
2480  OM_PRINT(MaxBytesSystem);
2481  OM_PRINT(CurrentBytesSystem);
2482  OM_PRINT(MaxBytesSbrk);
2483  OM_PRINT(CurrentBytesSbrk);
2484  OM_PRINT(MaxBytesMmap);
2485  OM_PRINT(CurrentBytesMmap);
2486  OM_PRINT(UsedBytes);
2487  OM_PRINT(AvailBytes);
2488  OM_PRINT(UsedBytesMalloc);
2489  OM_PRINT(AvailBytesMalloc);
2490  OM_PRINT(MaxBytesFromMalloc);
2491  OM_PRINT(CurrentBytesFromMalloc);
2492  OM_PRINT(MaxBytesFromValloc);
2493  OM_PRINT(CurrentBytesFromValloc);
2494  OM_PRINT(UsedBytesFromValloc);
2495  OM_PRINT(AvailBytesFromValloc);
2496  OM_PRINT(MaxPages);
2497  OM_PRINT(UsedPages);
2498  OM_PRINT(AvailPages);
2499  OM_PRINT(MaxRegionsAlloc);
2500  OM_PRINT(CurrentRegionsAlloc);
2501 #undef OM_PRINT
2502 #endif
2503 
2504 #ifdef OM_OPTS_H
2505  PrintS("\n[om_Opts]: \n");
2506 #define OM_PRINT(format, name) Print(" %-22s : %10" format"\n", #name, om_Opts . name)
2507  OM_PRINT("d", MinTrack);
2508  OM_PRINT("d", MinCheck);
2509  OM_PRINT("d", MaxTrack);
2510  OM_PRINT("d", MaxCheck);
2511  OM_PRINT("d", Keep);
2512  OM_PRINT("d", HowToReportErrors);
2513  OM_PRINT("d", MarkAsStatic);
2514  OM_PRINT("u", PagesPerRegion);
2515  OM_PRINT("p", OutOfMemoryFunc);
2516  OM_PRINT("p", MemoryLowFunc);
2517  OM_PRINT("p", ErrorHook);
2518 #undef OM_PRINT
2519 #endif
2520 
2521 #ifdef OM_ERROR_H
2522  Print("\n\n[om_ErrorStatus] : '%s' (%s)\n",
2525  Print("[om_InternalErrorStatus]: '%s' (%s)\n",
2528 
2529 #endif
2530 
2531 // omTestMemory(1);
2532 // omtTestErrors();
2533  return FALSE;
2534  }
2535  else
2536 #endif
2537  /*==================== pDivStat =============================*/
2538  #if defined(PDEBUG) || defined(PDIV_DEBUG)
2539  if(strcmp(sys_cmd,"pDivStat")==0)
2540  {
2541  extern void pPrintDivisbleByStat();
2543  return FALSE;
2544  }
2545  else
2546  #endif
2547  /*==================== alarm ==================================*/
2548  #ifdef unix
2549  if(strcmp(sys_cmd,"alarm")==0)
2550  {
2551  if ((h!=NULL) &&(h->Typ()==INT_CMD))
2552  {
2553  // standard variant -> SIGALARM (standard: abort)
2554  //alarm((unsigned)h->next->Data());
2555  // process time (user +system): SIGVTALARM
2556  struct itimerval t,o;
2557  memset(&t,0,sizeof(t));
2558  t.it_value.tv_sec =(unsigned)((unsigned long)h->Data());
2559  setitimer(ITIMER_VIRTUAL,&t,&o);
2560  return FALSE;
2561  }
2562  else
2563  WerrorS("int expected");
2564  }
2565  else
2566  #endif
2567  /*==================== red =============================*/
2568  #if 0
2569  if(strcmp(sys_cmd,"red")==0)
2570  {
2571  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2572  {
2573  res->rtyp=IDEAL_CMD;
2574  res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2575  setFlag(res,FLAG_STD);
2576  return FALSE;
2577  }
2578  else
2579  WerrorS("ideal expected");
2580  }
2581  else
2582  #endif
2583  /*==================== fastcomb =============================*/
2584  if(strcmp(sys_cmd,"fastcomb")==0)
2585  {
2586  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2587  {
2588  if (h->next!=NULL)
2589  {
2590  if (h->next->Typ()!=POLY_CMD)
2591  {
2592  Warn("Wrong types for poly= comb(ideal,poly)");
2593  }
2594  }
2595  res->rtyp=POLY_CMD;
2596  res->data=(void *) fglmLinearCombination(
2597  (ideal)h->Data(),(poly)h->next->Data());
2598  return FALSE;
2599  }
2600  else
2601  WerrorS("ideal expected");
2602  }
2603  else
2604  /*==================== comb =============================*/
2605  if(strcmp(sys_cmd,"comb")==0)
2606  {
2607  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2608  {
2609  if (h->next!=NULL)
2610  {
2611  if (h->next->Typ()!=POLY_CMD)
2612  {
2613  Warn("Wrong types for poly= comb(ideal,poly)");
2614  }
2615  }
2616  res->rtyp=POLY_CMD;
2617  res->data=(void *)fglmNewLinearCombination(
2618  (ideal)h->Data(),(poly)h->next->Data());
2619  return FALSE;
2620  }
2621  else
2622  WerrorS("ideal expected");
2623  }
2624  else
2625  #if 0 /* debug only */
2626  /*==================== listall ===================================*/
2627  if(strcmp(sys_cmd,"listall")==0)
2628  {
2629  void listall(int showproc);
2630  int showproc=0;
2631  if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2632  listall(showproc);
2633  return FALSE;
2634  }
2635  else
2636  #endif
2637  #if 0 /* debug only */
2638  /*==================== proclist =================================*/
2639  if(strcmp(sys_cmd,"proclist")==0)
2640  {
2641  void piShowProcList();
2642  piShowProcList();
2643  return FALSE;
2644  }
2645  else
2646  #endif
2647  /* ==================== newton ================================*/
2648  #ifdef HAVE_NEWTON
2649  if(strcmp(sys_cmd,"newton")==0)
2650  {
2651  if ((h->Typ()!=POLY_CMD)
2652  || (h->next->Typ()!=INT_CMD)
2653  || (h->next->next->Typ()!=INT_CMD))
2654  {
2655  WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2656  return TRUE;
2657  }
2658  poly p=(poly)(h->Data());
2659  int l=pLength(p);
2660  short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
2661  int i,j,k;
2662  k=0;
2663  poly pp=p;
2664  for (i=0;pp!=NULL;i++)
2665  {
2666  for(j=1;j<=currRing->N;j++)
2667  {
2668  points[k]=pGetExp(pp,j);
2669  k++;
2670  }
2671  pIter(pp);
2672  }
2673  hc_ERG r=hc_KOENIG(currRing->N, // dimension
2674  l, // number of points
2675  (short*) points, // points: x_1, y_1,z_1, x_2,y_2,z2,...
2676  currRing->OrdSgn==-1,
2677  (int) (h->next->Data()), // 1: Milnor, 0: Newton
2678  (int) (h->next->next->Data()) // debug
2679  );
2680  //----<>---Output-----------------------
2681 
2682 
2683  // PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2684 
2685 
2687  L->Init(6);
2688  L->m[0].rtyp=STRING_CMD; // newtonnumber;
2689  L->m[0].data=(void *)omStrDup(r.nZahl);
2690  L->m[1].rtyp=INT_CMD;
2691  L->m[1].data=(void *)(long)r.achse; // flag for unoccupied axes
2692  L->m[2].rtyp=INT_CMD;
2693  L->m[2].data=(void *)(long)r.deg; // #degenerations
2694  if ( r.deg != 0) // only if degenerations exist
2695  {
2696  L->m[3].rtyp=INT_CMD;
2697  L->m[3].data=(void *)(long)r.anz_punkte; // #points
2698  //---<>--number of points------
2699  int anz = r.anz_punkte; // number of points
2700  int dim = (currRing->N); // dimension
2701  intvec* v = new intvec( anz*dim );
2702  for (i=0; i<anz*dim; i++) // copy points
2703  (*v)[i] = r.pu[i];
2704  L->m[4].rtyp=INTVEC_CMD;
2705  L->m[4].data=(void *)v;
2706  //---<>--degenerations---------
2707  int deg = r.deg; // number of points
2708  intvec* w = new intvec( r.speicher ); // necessary memeory
2709  i=0; // start copying
2710  do
2711  {
2712  (*w)[i] = r.deg_tab[i];
2713  i++;
2714  }
2715  while (r.deg_tab[i-1] != -2); // mark for end of list
2716  L->m[5].rtyp=INTVEC_CMD;
2717  L->m[5].data=(void *)w;
2718  }
2719  else
2720  {
2721  L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2722  L->m[4].rtyp=DEF_CMD;
2723  L->m[5].rtyp=DEF_CMD;
2724  }
2725 
2726  res->data=(void *)L;
2727  res->rtyp=LIST_CMD;
2728  // free all pointer in r:
2729  delete[] r.nZahl;
2730  delete[] r.pu;
2731  delete[] r.deg_tab; // Ist das ein Problem??
2732 
2733  omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
2734  return FALSE;
2735  }
2736  else
2737  #endif
2738  /*==== connection to Sebastian Jambor's code ======*/
2739  /* This code connects Sebastian Jambor's code for
2740  computing the minimal polynomial of an (n x n) matrix
2741  with entries in F_p to SINGULAR. Two conversion methods
2742  are needed; see further up in this file:
2743  (1) conversion of a matrix with long entries to
2744  a SINGULAR matrix with number entries, where
2745  the numbers are coefficients in currRing;
2746  (2) conversion of an array of longs (encoding the
2747  coefficients of the minimal polynomial) to a
2748  SINGULAR poly living in currRing. */
2749  if (strcmp(sys_cmd, "minpoly") == 0)
2750  {
2751  if ((h == NULL) || (h->Typ() != MATRIX_CMD) || h->next != NULL)
2752  {
2753  Werror("expected exactly one argument: %s",
2754  "a square matrix with number entries");
2755  return TRUE;
2756  }
2757  else
2758  {
2759  matrix m = (matrix)h->Data();
2760  int n = m->rows();
2761  unsigned long p = (unsigned long)n_GetChar(currRing->cf);
2762  if (n != m->cols())
2763  {
2764  WerrorS("expected exactly one argument: "
2765  "a square matrix with number entries");
2766  return TRUE;
2767  }
2768  unsigned long** ml = singularMatrixToLongMatrix(m);
2769  unsigned long* polyCoeffs = computeMinimalPolynomial(ml, n, p);
2770  poly theMinPoly = longCoeffsToSingularPoly(polyCoeffs, n);
2771  res->rtyp = POLY_CMD;
2772  res->data = (void *)theMinPoly;
2773  for (int i = 0; i < n; i++) delete[] ml[i];
2774  delete[] ml;
2775  delete[] polyCoeffs;
2776  return FALSE;
2777  }
2778  }
2779  else
2780  /*==================== sdb_flags =================*/
2781  #ifdef HAVE_SDB
2782  if (strcmp(sys_cmd, "sdb_flags") == 0)
2783  {
2784  if ((h!=NULL) && (h->Typ()==INT_CMD))
2785  {
2786  sdb_flags=(int)((long)h->Data());
2787  }
2788  else
2789  {
2790  WerrorS("system(\"sdb_flags\",`int`) expected");
2791  return TRUE;
2792  }
2793  return FALSE;
2794  }
2795  else
2796  #endif
2797  /*==================== sdb_edit =================*/
2798  #ifdef HAVE_SDB
2799  if (strcmp(sys_cmd, "sdb_edit") == 0)
2800  {
2801  if ((h!=NULL) && (h->Typ()==PROC_CMD))
2802  {
2803  procinfov p=(procinfov)h->Data();
2804  sdb_edit(p);
2805  }
2806  else
2807  {
2808  WerrorS("system(\"sdb_edit\",`proc`) expected");
2809  return TRUE;
2810  }
2811  return FALSE;
2812  }
2813  else
2814  #endif
2815  /*==================== GF =================*/
2816  #if 0 // for testing only
2817  if (strcmp(sys_cmd, "GF") == 0)
2818  {
2819  if ((h!=NULL) && (h->Typ()==POLY_CMD))
2820  {
2821  int c=rChar(currRing);
2822  setCharacteristic( c,nfMinPoly[0], currRing->parameter[0][0] );
2823  CanonicalForm F( convSingGFFactoryGF( (poly)h->Data(), currRing ) );
2824  res->rtyp=POLY_CMD;
2825  res->data=convFactoryGFSingGF( F, currRing );
2826  return FALSE;
2827  }
2828  else { WerrorS("wrong typ"); return TRUE;}
2829  }
2830  else
2831  #endif
2832  /*==================== stdX =================*/
2833  if (strcmp(sys_cmd, "std") == 0)
2834  {
2835  ideal i1;
2836  int i2;
2837  if ((h!=NULL) && (h->Typ()==MODUL_CMD))
2838  {
2839  i1=(ideal)h->CopyD();
2840  h=h->next;
2841  }
2842  else return TRUE;
2843  if ((h!=NULL) && (h->Typ()==INT_CMD))
2844  {
2845  i2=(int)((long)h->Data());
2846  }
2847  else return TRUE;
2848  res->rtyp=MODUL_CMD;
2849  res->data=idXXX(i1,i2);
2850  return FALSE;
2851  }
2852  else
2853  /*==================== SVD =================*/
2854  #ifdef HAVE_SVD
2855  if (strcmp(sys_cmd, "svd") == 0)
2856  {
2857  extern lists testsvd(matrix M);
2858  res->rtyp=LIST_CMD;
2859  res->data=(char*)(testsvd((matrix)h->Data()));
2860  return FALSE;
2861  }
2862  else
2863  #endif
2864 
2865 
2866  /*==================== DLL =================*/
2867  #ifdef __CYGWIN__
2868  #ifdef HAVE_DL
2869  /* testing the DLL functionality under Win32 */
2870  if (strcmp(sys_cmd, "DLL") == 0)
2871  {
2872  typedef void (*Void_Func)();
2873  typedef int (*Int_Func)(int);
2874  void *hh=dynl_open("WinDllTest.dll");
2875  if ((h!=NULL) && (h->Typ()==INT_CMD))
2876  {
2877  int (*f)(int);
2878  if (hh!=NULL)
2879  {
2880  int (*f)(int);
2881  f=(Int_Func)dynl_sym(hh,"PlusDll");
2882  int i=10;
2883  if (f!=NULL) printf("%d\n",f(i));
2884  else PrintS("cannot find PlusDll\n");
2885  }
2886  }
2887  else
2888  {
2889  void (*f)();
2890  f= (Void_Func)dynl_sym(hh,"TestDll");
2891  if (f!=NULL) f();
2892  else PrintS("cannot find TestDll\n");
2893  }
2894  return FALSE;
2895  }
2896  else
2897  #endif
2898  #endif
2899  #ifdef HAVE_RING2TOM
2900  /*==================== ring-GB ==================================*/
2901  if (strcmp(sys_cmd, "findZeroPoly")==0)
2902  {
2903  ring r = currRing;
2904  poly f = (poly) h->Data();
2905  res->rtyp=POLY_CMD;
2906  res->data=(poly) kFindZeroPoly(f, r, r);
2907  return(FALSE);
2908  }
2909  else
2910  /*==================== Creating zero polynomials =================*/
2911  #ifdef HAVE_VANIDEAL
2912  if (strcmp(sys_cmd, "createG0")==0)
2913  {
2914  /* long exp[50];
2915  int N = 0;
2916  while (h != NULL)
2917  {
2918  N += 1;
2919  exp[N] = (long) h->Data();
2920  // if (exp[i] % 2 != 0) exp[i] -= 1;
2921  h = h->next;
2922  }
2923  for (int k = 1; N + k <= currRing->N; k++) exp[k] = 0;
2924 
2925  poly t_p;
2926  res->rtyp=POLY_CMD;
2927  res->data= (poly) kCreateZeroPoly(exp, -1, &t_p, currRing, currRing);
2928  return(FALSE); */
2929 
2930  res->rtyp = IDEAL_CMD;
2931  res->data = (ideal) createG0();
2932  return(FALSE);
2933  }
2934  else
2935  #endif
2936  /*==================== redNF_ring =================*/
2937  if (strcmp(sys_cmd, "redNF_ring")==0)
2938  {
2939  ring r = currRing;
2940  poly f = (poly) h->Data();
2941  h = h->next;
2942  ideal G = (ideal) h->Data();
2943  res->rtyp=POLY_CMD;
2944  res->data=(poly) ringRedNF(f, G, r);
2945  return(FALSE);
2946  }
2947  else
2948  #endif
2949  /*==================== Roune Hilb =================*/
2950  if (strcmp(sys_cmd, "hilbroune") == 0)
2951  {
2952  ideal I;
2953  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2954  {
2955  I=(ideal)h->CopyD();
2956  slicehilb(I);
2957  }
2958  else return TRUE;
2959  return FALSE;
2960  }
2961  else
2962  /*==================== F5 Implementation =================*/
2963  #ifdef HAVE_F5
2964  if (strcmp(sys_cmd, "f5")==0)
2965  {
2966  if (h->Typ()!=IDEAL_CMD)
2967  {
2968  WerrorS("ideal expected");
2969  return TRUE;
2970  }
2971 
2972  ring r = currRing;
2973  ideal G = (ideal) h->Data();
2974  h = h->next;
2975  int opt;
2976  if(h != NULL) {
2977  opt = (int) (long) h->Data();
2978  }
2979  else {
2980  opt = 2;
2981  }
2982  h = h->next;
2983  int plus;
2984  if(h != NULL) {
2985  plus = (int) (long) h->Data();
2986  }
2987  else {
2988  plus = 0;
2989  }
2990  h = h->next;
2991  int termination;
2992  if(h != NULL) {
2993  termination = (int) (long) h->Data();
2994  }
2995  else {
2996  termination = 0;
2997  }
2998  res->rtyp=IDEAL_CMD;
2999  res->data=(ideal) F5main(G,r,opt,plus,termination);
3000  return FALSE;
3001  }
3002  else
3003  #endif
3004  /*==================== Testing groebner basis =================*/
3005  #ifdef HAVE_RINGS
3006  if (strcmp(sys_cmd, "NF_ring")==0)
3007  {
3008  ring r = currRing;
3009  poly f = (poly) h->Data();
3010  h = h->next;
3011  ideal G = (ideal) h->Data();
3012  res->rtyp=POLY_CMD;
3013  res->data=(poly) ringNF(f, G, r);
3014  return(FALSE);
3015  }
3016  else
3017  if (strcmp(sys_cmd, "spoly")==0)
3018  {
3019  poly f = pCopy((poly) h->Data());
3020  h = h->next;
3021  poly g = pCopy((poly) h->Data());
3022 
3023  res->rtyp=POLY_CMD;
3024  res->data=(poly) plain_spoly(f,g);
3025  return(FALSE);
3026  }
3027  else
3028  if (strcmp(sys_cmd, "testGB")==0)
3029  {
3030  ideal I = (ideal) h->Data();
3031  h = h->next;
3032  ideal GI = (ideal) h->Data();
3033  res->rtyp = INT_CMD;
3034  res->data = (void *)(long) testGB(I, GI);
3035  return(FALSE);
3036  }
3037  else
3038  #endif
3039  /*==================== sca?AltVar ==================================*/
3040  #ifdef HAVE_PLURAL
3041  if ( (strcmp(sys_cmd, "AltVarStart") == 0) || (strcmp(sys_cmd, "AltVarEnd") == 0) )
3042  {
3043  ring r = currRing;
3044 
3045  if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
3046  {
3047  WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
3048  return TRUE;
3049  }
3050 
3051  res->rtyp=INT_CMD;
3052 
3053  if (rIsSCA(r))
3054  {
3055  if(strcmp(sys_cmd, "AltVarStart") == 0)
3056  res->data = (void*)(long)scaFirstAltVar(r);
3057  else
3058  res->data = (void*)(long)scaLastAltVar(r);
3059  return FALSE;
3060  }
3061 
3062  WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
3063  return TRUE;
3064  }
3065  else
3066  #endif
3067  /*==================== RatNF, noncomm rational coeffs =================*/
3068  #ifdef HAVE_RATGRING
3069  if (strcmp(sys_cmd, "intratNF") == 0)
3070  {
3071  poly p;
3072  poly *q;
3073  ideal I;
3074  int is, k, id;
3075  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3076  {
3077  p=(poly)h->CopyD();
3078  h=h->next;
3079  // Print("poly is done\n");
3080  }
3081  else return TRUE;
3082  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3083  {
3084  I=(ideal)h->CopyD();
3085  q = I->m;
3086  h=h->next;
3087  // Print("ideal is done\n");
3088  }
3089  else return TRUE;
3090  if ((h!=NULL) && (h->Typ()==INT_CMD))
3091  {
3092  is=(int)((long)(h->Data()));
3093  // res->rtyp=INT_CMD;
3094  // Print("int is done\n");
3095  // res->rtyp=IDEAL_CMD;
3096  if (rIsPluralRing(currRing))
3097  {
3098  id = IDELEMS(I);
3099  int *pl=(int*)omAlloc0(IDELEMS(I)*sizeof(int));
3100  for(k=0; k < id; k++)
3101  {
3102  pl[k] = pLength(I->m[k]);
3103  }
3104  Print("starting redRat\n");
3105  //res->data = (char *)
3106  redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
3107  res->data=p;
3108  res->rtyp=POLY_CMD;
3109  // res->data = ncGCD(p,q,currRing);
3110  }
3111  else
3112  {
3113  res->rtyp=POLY_CMD;
3114  res->data=p;
3115  }
3116  }
3117  else return TRUE;
3118  return FALSE;
3119  }
3120  else
3121  /*==================== RatNF, noncomm rational coeffs =================*/
3122  if (strcmp(sys_cmd, "ratNF") == 0)
3123  {
3124  poly p,q;
3125  int is, htype;
3126  if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3127  {
3128  p=(poly)h->CopyD();
3129  h=h->next;
3130  htype = h->Typ();
3131  }
3132  else return TRUE;
3133  if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3134  {
3135  q=(poly)h->CopyD();
3136  h=h->next;
3137  }
3138  else return TRUE;
3139  if ((h!=NULL) && (h->Typ()==INT_CMD))
3140  {
3141  is=(int)((long)(h->Data()));
3142  res->rtyp=htype;
3143  // res->rtyp=IDEAL_CMD;
3144  if (rIsPluralRing(currRing))
3145  {
3146  res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
3147  // res->data = ncGCD(p,q,currRing);
3148  }
3149  else res->data=p;
3150  }
3151  else return TRUE;
3152  return FALSE;
3153  }
3154  else
3155  /*==================== RatSpoly, noncomm rational coeffs =================*/
3156  if (strcmp(sys_cmd, "ratSpoly") == 0)
3157  {
3158  poly p,q;
3159  int is;
3160  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3161  {
3162  p=(poly)h->CopyD();
3163  h=h->next;
3164  }
3165  else return TRUE;
3166  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3167  {
3168  q=(poly)h->CopyD();
3169  h=h->next;
3170  }
3171  else return TRUE;
3172  if ((h!=NULL) && (h->Typ()==INT_CMD))
3173  {
3174  is=(int)((long)(h->Data()));
3175  res->rtyp=POLY_CMD;
3176  // res->rtyp=IDEAL_CMD;
3177  if (rIsPluralRing(currRing))
3178  {
3179  res->data = nc_rat_CreateSpoly(p,q,is,currRing);
3180  // res->data = ncGCD(p,q,currRing);
3181  }
3182  else res->data=p;
3183  }
3184  else return TRUE;
3185  return FALSE;
3186  }
3187  else
3188  #endif // HAVE_RATGRING
3189  /*==================== Rat def =================*/
3190  if (strcmp(sys_cmd, "ratVar") == 0)
3191  {
3192  int start,end;
3193  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3194  {
3195  start=pIsPurePower((poly)h->Data());
3196  h=h->next;
3197  }
3198  else return TRUE;
3199  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3200  {
3201  end=pIsPurePower((poly)h->Data());
3202  h=h->next;
3203  }
3204  else return TRUE;
3205  currRing->real_var_start=start;
3206  currRing->real_var_end=end;
3207  return (start==0)||(end==0)||(start>end);
3208  }
3209  else
3210  /*==================== t-rep-GB ==================================*/
3211  if (strcmp(sys_cmd, "unifastmult")==0)
3212  {
3213  poly f = (poly)h->Data();
3214  h=h->next;
3215  poly g=(poly)h->Data();
3216  res->rtyp=POLY_CMD;
3217  res->data=unifastmult(f,g,currRing);
3218  return(FALSE);
3219  }
3220  else
3221  if (strcmp(sys_cmd, "multifastmult")==0)
3222  {
3223  poly f = (poly)h->Data();
3224  h=h->next;
3225  poly g=(poly)h->Data();
3226  res->rtyp=POLY_CMD;
3227  res->data=multifastmult(f,g,currRing);
3228  return(FALSE);
3229  }
3230  else
3231  if (strcmp(sys_cmd, "mults")==0)
3232  {
3233  res->rtyp=INT_CMD ;
3234  res->data=(void*)(long) Mults();
3235  return(FALSE);
3236  }
3237  else
3238  if (strcmp(sys_cmd, "fastpower")==0)
3239  {
3240  ring r = currRing;
3241  poly f = (poly)h->Data();
3242  h=h->next;
3243  int n=(int)((long)h->Data());
3244  res->rtyp=POLY_CMD ;
3245  res->data=(void*) pFastPower(f,n,r);
3246  return(FALSE);
3247  }
3248  else
3249  if (strcmp(sys_cmd, "normalpower")==0)
3250  {
3251  poly f = (poly)h->Data();
3252  h=h->next;
3253  int n=(int)((long)h->Data());
3254  res->rtyp=POLY_CMD ;
3255  res->data=(void*) pPower(pCopy(f),n);
3256  return(FALSE);
3257  }
3258  else
3259  if (strcmp(sys_cmd, "MCpower")==0)
3260  {
3261  ring r = currRing;
3262  poly f = (poly)h->Data();
3263  h=h->next;
3264  int n=(int)((long)h->Data());
3265  res->rtyp=POLY_CMD ;
3266  res->data=(void*) pFastPowerMC(f,n,r);
3267  return(FALSE);
3268  }
3269  else
3270  if (strcmp(sys_cmd, "bit_subst")==0)
3271  {
3272  ring r = currRing;
3273  poly outer = (poly)h->Data();
3274  h=h->next;
3275  poly inner=(poly)h->Data();
3276  res->rtyp=POLY_CMD ;
3277  res->data=(void*) uni_subst_bits(outer, inner,r);
3278  return(FALSE);
3279  }
3280  else
3281  /*==================== gcd-varianten =================*/
3282  if (strcmp(sys_cmd, "gcd") == 0)
3283  {
3284  if (h==NULL)
3285  {
3286 #ifdef HAVE_PLURAL
3287  Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3288  Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3289  Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3290  Print("QGCD:%d (use QGCD for gcd of polynomials in alg. ext.)\n",isOn(SW_USE_QGCD));
3291 #endif
3292  Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3293  return FALSE;
3294  }
3295  else
3296  if ((h!=NULL) && (h->Typ()==STRING_CMD)
3297  && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3298  {
3299  int d=(int)(long)h->next->Data();
3300  char *s=(char *)h->Data();
3301 #ifdef HAVE_PLURAL
3302  if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3303  if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3304  if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3305  if (strcmp(s,"QGCD")==0) { if (d) On(SW_USE_QGCD); else Off(SW_USE_QGCD); } else
3306 #endif
3307  if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3308  return TRUE;
3309  return FALSE;
3310  }
3311  else return TRUE;
3312  }
3313  else
3314  /*==================== subring =================*/
3315  if (strcmp(sys_cmd, "subring") == 0)
3316  {
3317  if (h!=NULL)
3318  {
3319  extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3320  res->data=(char *)rSubring(currRing,h);
3321  res->rtyp=RING_CMD;
3322  return res->data==NULL;
3323  }
3324  else return TRUE;
3325  }
3326  else
3327  /*==================== HNF =================*/
3328  #ifdef HAVE_NTL
3329  if (strcmp(sys_cmd, "HNF") == 0)
3330  {
3331  if (h!=NULL)
3332  {
3333  res->rtyp=h->Typ();
3334  if (h->Typ()==MATRIX_CMD)
3335  {
3336  res->data=(char *)singntl_HNF((matrix)h->Data(), currRing);
3337  return FALSE;
3338  }
3339  else if (h->Typ()==INTMAT_CMD)
3340  {
3341  res->data=(char *)singntl_HNF((intvec*)h->Data());
3342  return FALSE;
3343  }
3344  else return TRUE;
3345  }
3346  else return TRUE;
3347  }
3348  else
3349  /*================= probIrredTest ======================*/
3350  if (strcmp (sys_cmd, "probIrredTest") == 0)
3351  {
3352  if (h!=NULL && (h->Typ()== POLY_CMD) && ((h->next != NULL) && h->next->Typ() == STRING_CMD))
3353  {
3354  CanonicalForm F= convSingPFactoryP((poly)(h->Data()), currRing);
3355  char *s=(char *)h->next->Data();
3356  double error= atof (s);
3357  int irred= probIrredTest (F, error);
3358  res->rtyp= INT_CMD;
3359  res->data= (void*)(long)irred;
3360  return FALSE;
3361  }
3362  else return TRUE;
3363  }
3364  else
3365  #endif
3366  #ifdef __CYGWIN__
3367  /*==================== Python Singular =================*/
3368  if (strcmp(sys_cmd, "python") == 0)
3369  {
3370  const char* c;
3371  if ((h!=NULL) && (h->Typ()==STRING_CMD))
3372  {
3373  c=(const char*)h->Data();
3374  if (!PyInitialized) {
3375  PyInitialized = 1;
3376  // Py_Initialize();
3377  // initPySingular();
3378  }
3379  // PyRun_SimpleString(c);
3380  return FALSE;
3381  }
3382  else return TRUE;
3383  }
3384  else
3385  /*==================== Python Singular =================
3386  if (strcmp(sys_cmd, "ipython") == 0)
3387  {
3388  const char* c;
3389  {
3390  if (!PyInitialized)
3391  {
3392  PyInitialized = 1;
3393  Py_Initialize();
3394  initPySingular();
3395  }
3396  PyRun_SimpleString(
3397  "try: \n\
3398  __IPYTHON__ \n\
3399  except NameError: \n\
3400  argv = [''] \n\
3401  banner = exit_msg = '' \n\
3402  else: \n\
3403  # Command-line options for IPython (a list like sys.argv) \n\
3404  argv = ['-pi1','In <\\#>:','-pi2',' .\\D.:','-po','Out<\\#>:'] \n\
3405  banner = '*** Nested interpreter ***' \n\
3406  exit_msg = '*** Back in main IPython ***' \n\
3407  \n\
3408  # First import the embeddable shell class \n\
3409  from IPython.Shell import IPShellEmbed \n\
3410  # Now create the IPython shell instance. Put ipshell() anywhere in your code \n\
3411  # where you want it to open. \n\
3412  ipshell = IPShellEmbed(argv,banner=banner,exit_msg=exit_msg) \n\
3413  ipshell()");
3414  return FALSE;
3415  }
3416  }
3417  else
3418  */
3419 
3420  #endif
3421  /*==================== mpz_t loader ======================*/
3422  if(strcmp(sys_cmd, "GNUmpLoad")==0)
3423  {
3424  if ((h != NULL) && (h->Typ() == STRING_CMD))
3425  {
3426  char* filename = (char*)h->Data();
3427  FILE* f = fopen(filename, "r");
3428  if (f == NULL)
3429  {
3430  WerrorS( "invalid file name (in paths use '/')");
3431  return FALSE;
3432  }
3433  mpz_t m; mpz_init(m);
3434  mpz_inp_str(m, f, 10);
3435  fclose(f);
3436  number n = n_InitMPZ(m, coeffs_BIGINT);
3437  res->rtyp = BIGINT_CMD;
3438  res->data = (void*)n;
3439  return FALSE;
3440  }
3441  else
3442  {
3443  WerrorS( "expected valid file name as a string");
3444  return TRUE;
3445  }
3446  }
3447  else
3448  /*==================== intvec matching ======================*/
3449  /* Given two non-empty intvecs, the call
3450  'system("intvecMatchingSegments", ivec, jvec);'
3451  computes all occurences of jvec in ivec, i.e., it returns
3452  a list of int indices k such that ivec[k..size(jvec)+k-1] = jvec.
3453  If no such k exists (e.g. when ivec is shorter than jvec), an
3454  intvec with the single entry 0 is being returned. */
3455  if(strcmp(sys_cmd, "intvecMatchingSegments")==0)
3456  {
3457  if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3458  (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3459  (h->next->next == NULL))
3460  {
3461  intvec* ivec = (intvec*)h->Data();
3462  intvec* jvec = (intvec*)h->next->Data();
3463  intvec* r = new intvec(1); (*r)[0] = 0;
3464  int validEntries = 0;
3465  for (int k = 0; k <= ivec->rows() - jvec->rows(); k++)
3466  {
3467  if (memcmp(&(*ivec)[k], &(*jvec)[0],
3468  sizeof(int) * jvec->rows()) == 0)
3469  {
3470  if (validEntries == 0)
3471  (*r)[0] = k + 1;
3472  else
3473  {
3474  r->resize(validEntries + 1);
3475  (*r)[validEntries] = k + 1;
3476  }
3477  validEntries++;
3478  }
3479  }
3480  res->rtyp = INTVEC_CMD;
3481  res->data = (void*)r;
3482  return FALSE;
3483  }
3484  else
3485  {
3486  WerrorS("expected two non-empty intvecs as arguments");
3487  return TRUE;
3488  }
3489  }
3490  else
3491  /* ================== intvecOverlap ======================= */
3492  /* Given two non-empty intvecs, the call
3493  'system("intvecOverlap", ivec, jvec);'
3494  computes the longest intvec kvec such that ivec ends with kvec
3495  and jvec starts with kvec. The length of this overlap is being
3496  returned. If there is no overlap at all, then 0 is being returned. */
3497  if(strcmp(sys_cmd, "intvecOverlap")==0)
3498  {
3499  if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3500  (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3501  (h->next->next == NULL))
3502  {
3503  intvec* ivec = (intvec*)h->Data();
3504  intvec* jvec = (intvec*)h->next->Data();
3505  int ir = ivec->rows(); int jr = jvec->rows();
3506  int r = jr; if (ir < jr) r = ir; /* r = min{ir, jr} */
3507  while ((r >= 1) && (memcmp(&(*ivec)[ir - r], &(*jvec)[0],
3508  sizeof(int) * r) != 0))
3509  r--;
3510  res->rtyp = INT_CMD;
3511  res->data = (void*)(long)r;
3512  return FALSE;
3513  }
3514  else
3515  {
3516  WerrorS("expected two non-empty intvecs as arguments");
3517  return TRUE;
3518  }
3519  }
3520  else
3521  /*==================== Hensel's lemma ======================*/
3522  if(strcmp(sys_cmd, "henselfactors")==0)
3523  {
3524  if ((h != NULL) && (h->Typ() == INT_CMD) &&
3525  (h->next != NULL) && (h->next->Typ() == INT_CMD) &&
3526  (h->next->next != NULL) && (h->next->next->Typ() == POLY_CMD) &&
3527  (h->next->next->next != NULL) &&
3528  (h->next->next->next->Typ() == POLY_CMD) &&
3529  (h->next->next->next->next != NULL) &&
3530  (h->next->next->next->next->Typ() == POLY_CMD) &&
3531  (h->next->next->next->next->next != NULL) &&
3532  (h->next->next->next->next->next->Typ() == INT_CMD) &&
3533  (h->next->next->next->next->next->next == NULL))
3534  {
3535  int xIndex = (int)(long)h->Data();
3536  int yIndex = (int)(long)h->next->Data();
3537  poly hh = (poly)h->next->next->Data();
3538  poly f0 = (poly)h->next->next->next->Data();
3539  poly g0 = (poly)h->next->next->next->next->Data();
3540  int d = (int)(long)h->next->next->next->next->next->Data();
3541  poly f; poly g;
3542  henselFactors(xIndex, yIndex, hh, f0, g0, d, f, g);
3544  L->Init(2);
3545  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
3546  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
3547  res->rtyp = LIST_CMD;
3548  res->data = (char *)L;
3549  return FALSE;
3550  }
3551  else
3552  {
3553  WerrorS( "expected argument list (int, int, poly, poly, poly, int)");
3554  return TRUE;
3555  }
3556  }
3557  else
3558  /*==================== neworder =============================*/
3559  if(strcmp(sys_cmd,"neworder")==0)
3560  {
3561  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
3562  {
3563  res->rtyp=STRING_CMD;
3564  res->data=(void *)singclap_neworder((ideal)h->Data(), currRing);
3565  return FALSE;
3566  }
3567  else
3568  WerrorS("ideal expected");
3569  }
3570  else
3571  /*==================== Approx_Step =================*/
3572  #ifdef HAVE_PLURAL
3573  if (strcmp(sys_cmd, "astep") == 0)
3574  {
3575  ideal I;
3576  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3577  {
3578  I=(ideal)h->CopyD();
3579  res->rtyp=IDEAL_CMD;
3580  if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
3581  else res->data=I;
3582  setFlag(res,FLAG_STD);
3583  }
3584  else return TRUE;
3585  return FALSE;
3586  }
3587  else
3588  #endif
3589  /*==================== PrintMat =================*/
3590  #ifdef HAVE_PLURAL
3591  if (strcmp(sys_cmd, "PrintMat") == 0)
3592  {
3593  int a;
3594  int b;
3595  ring r;
3596  int metric;
3597  if (h!=NULL)
3598  {
3599  if (h->Typ()==INT_CMD)
3600  {
3601  a=(int)((long)(h->Data()));
3602  h=h->next;
3603  }
3604  else if (h->Typ()==INT_CMD)
3605  {
3606  b=(int)((long)(h->Data()));
3607  h=h->next;
3608  }
3609  else if (h->Typ()==RING_CMD)
3610  {
3611  r=(ring)h->Data();
3612  h=h->next;
3613  }
3614  else
3615  return TRUE;
3616  }
3617  else
3618  return TRUE;
3619  if ((h!=NULL) && (h->Typ()==INT_CMD))
3620  {
3621  metric=(int)((long)(h->Data()));
3622  }
3623  res->rtyp=MATRIX_CMD;
3624  if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
3625  else res->data=NULL;
3626  return FALSE;
3627  }
3628  else
3629  #endif
3630 /* ============ NCUseExtensions ======================== */
3631  #ifdef HAVE_PLURAL
3632  if(strcmp(sys_cmd,"NCUseExtensions")==0)
3633  {
3634  if ((h!=NULL) && (h->Typ()==INT_CMD))
3635  res->data=(void *)(long)setNCExtensions( (int)((long)(h->Data())) );
3636  else
3637  res->data=(void *)(long)getNCExtensions();
3638  res->rtyp=INT_CMD;
3639  return FALSE;
3640  }
3641  else
3642  #endif
3643 /* ============ NCGetType ======================== */
3644  #ifdef HAVE_PLURAL
3645  if(strcmp(sys_cmd,"NCGetType")==0)
3646  {
3647  res->rtyp=INT_CMD;
3648  if( rIsPluralRing(currRing) )
3649  res->data=(void *)(long)ncRingType(currRing);
3650  else
3651  res->data=(void *)(-1L);
3652  return FALSE;
3653  }
3654  else
3655  #endif
3656 /* ============ ForceSCA ======================== */
3657  #ifdef HAVE_PLURAL
3658  if(strcmp(sys_cmd,"ForceSCA")==0)
3659  {
3660  if( !rIsPluralRing(currRing) )
3661  return TRUE;
3662  int b, e;
3663  if ((h!=NULL) && (h->Typ()==INT_CMD))
3664  {
3665  b = (int)((long)(h->Data()));
3666  h=h->next;
3667  }
3668  else return TRUE;
3669  if ((h!=NULL) && (h->Typ()==INT_CMD))
3670  {
3671  e = (int)((long)(h->Data()));
3672  }
3673  else return TRUE;
3674  if( !sca_Force(currRing, b, e) )
3675  return TRUE;
3676  return FALSE;
3677  }
3678  else
3679  #endif
3680 /* ============ ForceNewNCMultiplication ======================== */
3681  #ifdef HAVE_PLURAL
3682  if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0)
3683  {
3684  if( !rIsPluralRing(currRing) )
3685  return TRUE;
3686  if( !ncInitSpecialPairMultiplication(currRing) ) // No Plural!
3687  return TRUE;
3688  return FALSE;
3689  }
3690  else
3691  #endif
3692 /* ============ ForceNewOldNCMultiplication ======================== */
3693  #ifdef HAVE_PLURAL
3694  if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0)
3695  {
3696  if( !rIsPluralRing(currRing) )
3697  return TRUE;
3698  if( !ncInitSpecialPowersMultiplication(currRing) ) // Enable Formula for Plural (depends on swiches)!
3699  return TRUE;
3700  return FALSE;
3701  }
3702  else
3703  #endif
3704 /*==================== test64 =================*/
3705  #if 0
3706  if(strcmp(sys_cmd,"test64")==0)
3707  {
3708  long l=8;int i;
3709  for(i=1;i<62;i++)
3710  {
3711  l=l<<1;
3712  number n=n_Init(l,coeffs_BIGINT);
3713  Print("%ld= ",l);n_Print(n,coeffs_BIGINT);
3715  n_Delete(&n,coeffs_BIGINT);
3717  PrintS(" F:");
3719  PrintLn();
3720  n_Delete(&n,coeffs_BIGINT);
3721  }
3722  Print("SIZEOF_LONG=%d\n",SIZEOF_LONG);
3723  return FALSE;
3724  }
3725  else
3726  #endif
3727 /*==================== n_SwitchChinRem =================*/
3728  if(strcmp(sys_cmd,"cache_chinrem")==0)
3729  {
3730  extern int n_SwitchChinRem;
3731  Print("caching inverse in chines remainder:%d\n",n_SwitchChinRem);
3732  if ((h!=NULL)&&(h->Typ()==INT_CMD))
3733  n_SwitchChinRem=(int)(long)h->Data();
3734  return FALSE;
3735  }
3736  else
3737 /*==================== LU for bigintmat =================*/
3738 #ifdef SINGULAR_4_1
3739  if(strcmp(sys_cmd,"LU")==0)
3740  {
3741  if ((h!=NULL) && (h->Typ()==CMATRIX_CMD))
3742  {
3743  // get the argument:
3744  bigintmat *b=(bigintmat *)h->Data();
3745  // just for tests: simply transpose
3746  bigintmat *bb=b->transpose();
3747  // return the result:
3748  res->rtyp=CMATRIX_CMD;
3749  res->data=(char*)bb;
3750  return FALSE;
3751  }
3752  else
3753  {
3754  WerrorS("system(\"LU\",<cmatrix>) expected");
3755  return TRUE;
3756  }
3757  }
3758  else
3759 #endif
3760 /*==================== Error =================*/
3761  Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3762  }
3763  return TRUE;
3764 }
bigintmat * transpose()
Definition: bigintmat.cc:38
int & rows()
Definition: matpol.h:24
int status int fd
Definition: si_signals.h:59
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
int posInT_pLength(const TSet set, const int length, LObject &p)
Definition: kutil.cc:9873
#define pIsPurePower(p)
Definition: polys.h:219
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
poly pFastPower(poly f, int n, ring r)
Definition: fast_mult.cc:342
void p_DebugPrint(poly p, const ring r)
Definition: ring.cc:4240
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
const char * omError2String(omError_t error)
Definition: omError.c:52
ring rSubring(ring org_ring, sleftv *rv)
Definition: ipshell.cc:5528
void resize(int new_length)
Definition: intvec.cc:125
const poly a
Definition: syzextra.cc:212
int sdb_flags
Definition: sdb.cc:32
void PrintLn()
Definition: reporter.cc:322
int posInT2(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4345
#define Print
Definition: emacs.cc:83
Definition: tok.h:85
#define pAdd(p, q)
Definition: polys.h:174
void Off(int sw)
switches
class sLObject LObject
Definition: kutil.h:60
Definition: lists.h:22
TObject * TSet
Definition: kutil.h:61
void henselFactors(const int xIndex, const int yIndex, const poly h, const poly f0, const poly g0, const int d, poly &f, poly &g)
Computes a factorization of a polynomial h(x, y) in K[[x]][y] up to a certain degree in x...
#define FALSE
Definition: auxiliary.h:140
int posInT1(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4317
Definition: tok.h:42
return P p
Definition: myNF.cc:203
short * iv2array(intvec *iv, const ring R)
Definition: weight.cc:208
Matrices of numbers.
Definition: bigintmat.h:32
number n_convFactoryNSingN(const CanonicalForm n, const coeffs r)
Definition: numbers.cc:560
lists testsvd(matrix M)
Definition: calcSVD.cc:27
void sdb_edit(procinfo *pi)
Definition: sdb.cc:110
void slicehilb(ideal I)
Definition: hilb.cc:1095
int & getNCExtensions()
Definition: old.gring.cc:88
static const int SW_USE_EZGCD_P
set to 1 to use EZGCD over F_q
Definition: cf_defs.h:34
int setNCExtensions(int iMask)
Definition: old.gring.cc:93
int n_SwitchChinRem
Definition: longrat.cc:2753
static FORCE_INLINE number n_Init(long i, const coeffs r)
a number representing i in the given coeff field/ring r
Definition: coeffs.h:539
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
int rChar(ring r)
Definition: ring.cc:684
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
poly pFastPowerMC(poly f, int n, ring r)
Definition: fast_mult.cc:588
unsigned long ** singularMatrixToLongMatrix(matrix singularMatrix)
Definition: extra.cc:190
omError_t om_InternalErrorStatus
Definition: omError.c:12
poly nc_rat_ReduceSpolyNew(const poly p1, poly p2, int ishift, const ring r)
Definition: ratgring.cc:466
static FORCE_INLINE int n_GetChar(const coeffs r)
Return the characteristic of the coeff. domain.
Definition: coeffs.h:445
factory's main class
Definition: canonicalform.h:75
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
static coordinates * points
void * dynl_sym(void *handle, const char *symbol)
Definition: mod_raw.cc:171
g
Definition: cfModGcd.cc:4031
void WerrorS(const char *s)
Definition: feFopen.cc:23
int k
Definition: cfEzgcd.cc:93
int testGB(ideal I, ideal GI)
Definition: ringgb.cc:230
static TreeM * G
Definition: janet.cc:38
int posInT15(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4622
coeffs coeffs_BIGINT
Definition: ipid.cc:53
int Typ()
Definition: subexpr.cc:955
#define omAlloc(size)
Definition: omAllocDecl.h:210
static bool rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
#define Sy_bit(x)
Definition: options.h:30
void setCharacteristic(int c)
Definition: cf_char.cc:23
CanonicalForm n_convSingNFactoryN(number n, BOOLEAN setChar, const coeffs r)
Definition: numbers.cc:565
static int pLength(poly a)
Definition: p_polys.h:189
int posInT0(const TSet, const int length, LObject &)
Definition: kutil.cc:4306
poly pp
Definition: myNF.cc:296
void rDebugPrint(ring r)
Definition: ring.cc:4035
void * dynl_open(char *filename)
Definition: mod_raw.cc:157
omOpts_t om_Opts
Definition: omOpts.c:11
static poly fglmNewLinearCombination(ideal source, poly monset)
Definition: fglmcomb.cc:154
void * data
Definition: subexpr.h:89
#define pIter(p)
Definition: monomials.h:44
matrix mp_Transp(matrix a, const ring R)
Definition: matpol.cc:268
bool sca_Force(ring rGR, int b, int e)
Definition: sca.cc:1175
#define M
Definition: sirandom.c:24
unsigned long * computeMinimalPolynomial(unsigned long **matrix, unsigned n, unsigned long p)
Definition: minpoly.cc:430
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
int posInT11(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4375
int posInT17_c(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4744
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:16
BOOLEAN rComplete(ring r, int force)
this needs to be called whenever a new ring is created: new fields in ring are created (like VarOffse...
Definition: ring.cc:3435
matrix nc_PrintMat(int a, int b, ring r, int metric)
returns matrix with the info on noncomm multiplication
Definition: old.gring.cc:2459
int j
Definition: myNF.cc:70
static int max(int a, int b)
Definition: fast_mult.cc:264
Definition: tok.h:58
poly uni_subst_bits(poly outer_uni, poly inner_multi, ring r)
Definition: digitech.cc:47
#define omFree(addr)
Definition: omAllocDecl.h:261
poly multifastmult(poly f, poly g, ring r)
Definition: fast_mult.cc:290
omError_t om_ErrorStatus
Definition: omError.c:11
int Mults()
Definition: fast_mult.cc:14
#define pDivideM(a, b)
Definition: polys.h:265
const char feNotImplemented[]
Definition: reporter.cc:54
const char * omError2Serror(omError_t error)
Definition: omError.c:63
ip_smatrix * matrix
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition: coeffs.h:543
#define setFlag(A, F)
Definition: ipid.h:112
int m
Definition: cfEzgcd.cc:119
bool isOn(int sw)
switches
poly nc_rat_CreateSpoly(poly pp1, poly pp2, int ishift, const ring r)
Definition: ratgring.cc:341
void On(int sw)
switches
int dim(ideal I, ring r)
FILE * f
Definition: checklibs.c:7
BOOLEAN assumeStdFlag(leftv h)
Definition: subexpr.cc:1434
poly longCoeffsToSingularPoly(unsigned long *polyCoeffs, const int degree)
Definition: extra.cc:222
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:294
int posInT17(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4680
static const int SW_USE_CHINREM_GCD
set to 1 to use modular gcd over Z
Definition: cf_defs.h:38
Definition: tok.h:88
#define pHead(p)
returns newly allocated copy of Lm(p), coef is copied, next=NULL, p might be NULL ...
Definition: polys.h:67
#define IDELEMS(i)
Definition: simpleideals.h:24
matrix singntl_HNF(matrix m, const ring s)
Definition: clapsing.cc:1639
static short scaFirstAltVar(ring r)
Definition: sca.h:18
poly ringRedNF(poly f, ideal G, ring r)
Definition: ringgb.cc:121
int singular_homog_flag
Definition: cf_factor.cc:377
#define FLAG_STD
Definition: ipid.h:108
poly kFindZeroPoly(poly input_p, ring leadRing, ring tailRing)
Definition: kstd2.cc:295
leftv next
Definition: subexpr.h:87
void rSetSyzComp(int k, const ring r)
Definition: ring.cc:4991
ideal Approx_Step(ideal L)
Ann: ???
Definition: nc.cc:254
poly plain_spoly(poly f, poly g)
Definition: ringgb.cc:172
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:48
int posInT_EcartFDegpLength(const TSet set, const int length, LObject &p)
Definition: kutil.cc:9782
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int & cols()
Definition: matpol.h:25
matrix mp_InitI(int r, int c, int v, const ring R)
make it a v * unit matrix
Definition: matpol.cc:140
#define error(a)
Definition: mpr_numeric.cc:979
#define MATCOLS(i)
Definition: matpol.h:28
#define NULL
Definition: omList.c:10
CanonicalForm convSingPFactoryP(poly p, const ring r)
Definition: clapconv.cc:88
#define pDivisibleBy(a, b)
returns TRUE, if leading monom of a divides leading monom of b i.e., if there exists a expvector c > ...
Definition: polys.h:126
slists * lists
Definition: mpr_numeric.h:146
int rows() const
Definition: intvec.h:88
int probIrredTest(const CanonicalForm &F, double error)
given some error probIrredTest detects irreducibility or reducibility of F with confidence level 1-er...
Definition: facIrredTest.cc:63
BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
check a list of arguemys against a given field of types return TRUE if the types match return FALSE (...
Definition: ipshell.cc:6122
int posInT110(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4508
static const int SW_USE_QGCD
set to 1 to use Encarnacion GCD over Q(a)
Definition: cf_defs.h:40
void omUpdateInfo()
Definition: omStats.c:24
#define R
Definition: sirandom.c:26
static const int SW_USE_EZGCD
set to 1 to use EZGCD over Z
Definition: cf_defs.h:32
const CanonicalForm & w
Definition: facAbsFact.cc:55
static short scaLastAltVar(ring r)
Definition: sca.h:25
int rtyp
Definition: subexpr.h:92
static bool rIsSCA(const ring r)
Definition: nc.h:206
void * Data()
Definition: subexpr.cc:1097
BOOLEAN ncInitSpecialPairMultiplication(ring r)
Definition: ncSAMult.cc:267
CFList int bool & irred
[in,out] Is A irreducible?
Definition: facFactorize.h:31
bool ncInitSpecialPowersMultiplication(ring r)
Definition: ncSAFormula.cc:51
Definition: tok.h:96
int(* test_PosInT)(const TSet T, const int tl, LObject &h)
Definition: kstd2.cc:98
#define omPrintCurrentBackTrace(fd)
Definition: omRet2Info.h:39
static nc_type & ncRingType(nc_struct *p)
Definition: nc.h:175
KINLINE poly ksOldSpolyRed(poly p1, poly p2, poly spNoether)
Definition: kInline.h:1082
int redRat(poly *h, poly *reducer, int *red_length, int rl, int ishift, ring r)
Definition: ratgring.cc:594
#define pLmDeleteAndNext(p)
like pLmDelete, returns pNext(p)
Definition: polys.h:78
omBin slists_bin
Definition: lists.cc:23
void pPrintDivisbleByStat()
Definition: pDebug.cc:412
ideal idXXX(ideal h1, int k)
Definition: ideals.cc:704
void omPrintUsedTrackAddrs(FILE *fd, int max_frames)
Definition: omDebugCheck.c:568
#define pPower(p, q)
Definition: polys.h:175
void omMarkAsStaticAddr(void *addr)
void omPrintUsedAddrs(FILE *fd, int max_frames)
Definition: omDebugCheck.c:557
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:456
int posInT19(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4809
int(* test_PosInL)(const LSet set, const int length, LObject *L, const kStrategy strat)
Definition: kstd2.cc:99
#define MATROWS(i)
Definition: matpol.h:27
ideal createG0()
Definition: kutil.cc:3687
ideal id_Vec2Ideal(poly vec, const ring R)
static jList * T
Definition: janet.cc:37
polyrec * poly
Definition: hilb.h:10
char * singclap_neworder(ideal I, const ring r)
Definition: clapsing.cc:1487
poly ringNF(poly f, ideal G, ring r)
Definition: ringgb.cc:203
int posInT_FDegpLength(const TSet set, const int length, LObject &p)
Definition: kutil.cc:9836
unsigned si_opt_2
Definition: options.c:6
s?
Definition: ring.h:678
const poly b
Definition: syzextra.cc:213
#define ppJetW(p, m, iv)
Definition: polys.h:340
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94
int nfMinPoly[16]
Definition: ffields.cc:580
procinfo * procinfov
Definition: structs.h:63
int posInT13(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4554
poly unifastmult(poly f, poly g, ring r)
Definition: fast_mult.cc:272
static poly fglmLinearCombination(ideal source, poly monset)
Definition: fglmcomb.cc:418
#define pCopy(p)
return a copy of the poly
Definition: polys.h:156
#define MATELEM(mat, i, j)
Definition: matpol.h:29
void n_Print(number &a, const coeffs r)
print a number (BEWARE of string buffers!) mostly for debugging
Definition: numbers.cc:549
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263
ideal F5main(ideal id, ring r, int opt, int plus, int termination)
Definition: f5gb.cc:1880
BOOLEAN jjSYSTEM ( leftv  res,
leftv  args 
)

Definition at line 245 of file extra.cc.

246 {
247  if(args->Typ() == STRING_CMD)
248  {
249  const char *sys_cmd=(char *)(args->Data());
250  leftv h=args->next;
251 // ONLY documented system calls go here
252 // Undocumented system calls go down into jjEXTENDED_SYSTEM (#ifdef HAVE_EXTENDED_SYSTEM)
253 /*==================== nblocks ==================================*/
254  if (strcmp(sys_cmd, "nblocks") == 0)
255  {
256  ring r;
257  if (h == NULL)
258  {
259  if (currRingHdl != NULL)
260  {
261  r = IDRING(currRingHdl);
262  }
263  else
264  {
265  WerrorS("no ring active");
266  return TRUE;
267  }
268  }
269  else
270  {
271  if (h->Typ() != RING_CMD)
272  {
273  WerrorS("ring expected");
274  return TRUE;
275  }
276  r = (ring) h->Data();
277  }
278  res->rtyp = INT_CMD;
279  res->data = (void*) (long)(rBlocks(r) - 1);
280  return FALSE;
281  }
282 /*==================== version ==================================*/
283  if(strcmp(sys_cmd,"version")==0)
284  {
285  res->rtyp=INT_CMD;
286  res->data=(void *)SINGULAR_VERSION;
287  return FALSE;
288  }
289  else
290 /*==================== cpu ==================================*/
291  if(strcmp(sys_cmd,"cpu")==0)
292  {
293  long cpu=1; //feOptValue(FE_OPT_CPUS);
294  #ifdef _SC_NPROCESSORS_ONLN
295  cpu=sysconf(_SC_NPROCESSORS_ONLN);
296  #elif defined(_SC_NPROCESSORS_CONF)
297  cpu=sysconf(_SC_NPROCESSORS_CONF);
298  #endif
299  res->data=(void *)cpu;
300  res->rtyp=INT_CMD;
301  return FALSE;
302  }
303  else
304 
305 /*==================== sh ==================================*/
306  if(strcmp(sys_cmd,"sh")==0)
307  {
308  if (feOptValue(FE_OPT_NO_SHELL))
309  {
310  WerrorS("shell execution is disallowed in restricted mode");
311  return TRUE;
312  }
313  res->rtyp=INT_CMD;
314  if (h==NULL) res->data = (void *)(long) system("sh");
315  else if (h->Typ()==STRING_CMD)
316  res->data = (void*)(long) system((char*)(h->Data()));
317  else
318  WerrorS("string expected");
319  return FALSE;
320  }
321  else
322  #if 0
323  if(strcmp(sys_cmd,"power1")==0)
324  {
325  res->rtyp=POLY_CMD;
326  poly f=(poly)h->CopyD();
327  poly g=pPower(f,2000);
328  res->data=(void *)g;
329  return FALSE;
330  }
331  else
332  if(strcmp(sys_cmd,"power2")==0)
333  {
334  res->rtyp=POLY_CMD;
335  poly f=(poly)h->Data();
336  poly g=pOne();
337  for(int i=0;i<2000;i++)
338  g=pMult(g,pCopy(f));
339  res->data=(void *)g;
340  return FALSE;
341  }
342  if(strcmp(sys_cmd,"power3")==0)
343  {
344  res->rtyp=POLY_CMD;
345  poly f=(poly)h->Data();
346  poly p2=pMult(pCopy(f),pCopy(f));
347  poly p4=pMult(pCopy(p2),pCopy(p2));
348  poly p8=pMult(pCopy(p4),pCopy(p4));
349  poly p16=pMult(pCopy(p8),pCopy(p8));
350  poly p32=pMult(pCopy(p16),pCopy(p16));
351  poly p64=pMult(pCopy(p32),pCopy(p32));
352  poly p128=pMult(pCopy(p64),pCopy(p64));
353  poly p256=pMult(pCopy(p128),pCopy(p128));
354  poly p512=pMult(pCopy(p256),pCopy(p256));
355  poly p1024=pMult(pCopy(p512),pCopy(p512));
356  poly p1536=pMult(p1024,p512);
357  poly p1792=pMult(p1536,p256);
358  poly p1920=pMult(p1792,p128);
359  poly p1984=pMult(p1920,p64);
360  poly p2000=pMult(p1984,p16);
361  res->data=(void *)p2000;
362  pDelete(&p2);
363  pDelete(&p4);
364  pDelete(&p8);
365  //pDelete(&p16);
366  pDelete(&p32);
367  //pDelete(&p64);
368  //pDelete(&p128);
369  //pDelete(&p256);
370  //pDelete(&p512);
371  //pDelete(&p1024);
372  //pDelete(&p1536);
373  //pDelete(&p1792);
374  //pDelete(&p1920);
375  //pDelete(&p1984);
376  return FALSE;
377  }
378  else
379  #endif
380 /*==================== uname ==================================*/
381  if(strcmp(sys_cmd,"uname")==0)
382  {
383  res->rtyp=STRING_CMD;
384  res->data = omStrDup(S_UNAME);
385  return FALSE;
386  }
387  else
388 /*==================== with ==================================*/
389  if(strcmp(sys_cmd,"with")==0)
390  {
391  if (h==NULL)
392  {
393  res->rtyp=STRING_CMD;
394  res->data=(void *)versionString();
395  return FALSE;
396  }
397  else if (h->Typ()==STRING_CMD)
398  {
399  #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
400  char *s=(char *)h->Data();
401  res->rtyp=INT_CMD;
402  #ifdef HAVE_DBM
403  TEST_FOR("DBM")
404  #endif
405  #ifdef HAVE_DLD
406  TEST_FOR("DLD")
407  #endif
408  //TEST_FOR("factory")
409  //TEST_FOR("libfac")
410  #ifdef HAVE_READLINE
411  TEST_FOR("readline")
412  #endif
413  #ifdef TEST_MAC_ORDER
414  TEST_FOR("MAC_ORDER")
415  #endif
416  // unconditional since 3-1-0-6
417  TEST_FOR("Namespaces")
418  #ifdef HAVE_DYNAMIC_LOADING
419  TEST_FOR("DynamicLoading")
420  #endif
421  #ifdef HAVE_EIGENVAL
422  TEST_FOR("eigenval")
423  #endif
424  #ifdef HAVE_GMS
425  TEST_FOR("gms")
426  #endif
427  #ifdef OM_NDEBUG
428  TEST_FOR("om_ndebug")
429  #endif
430  #ifdef SING_NDEBUG
431  TEST_FOR("ndebug")
432  #endif
433  {};
434  return FALSE;
435  #undef TEST_FOR
436  }
437  return TRUE;
438  }
439  else
440  /*==================== browsers ==================================*/
441  if (strcmp(sys_cmd,"browsers")==0)
442  {
443  res->rtyp = STRING_CMD;
444  StringSetS("");
446  res->data = StringEndS();
447  return FALSE;
448  }
449  else
450  /*==================== pid ==================================*/
451  if (strcmp(sys_cmd,"pid")==0)
452  {
453  res->rtyp=INT_CMD;
454  res->data=(void *)(long) getpid();
455  return FALSE;
456  }
457  else
458  /*==================== getenv ==================================*/
459  if (strcmp(sys_cmd,"getenv")==0)
460  {
461  if ((h!=NULL) && (h->Typ()==STRING_CMD))
462  {
463  res->rtyp=STRING_CMD;
464  const char *r=getenv((char *)h->Data());
465  if (r==NULL) r="";
466  res->data=(void *)omStrDup(r);
467  return FALSE;
468  }
469  else
470  {
471  WerrorS("string expected");
472  return TRUE;
473  }
474  }
475  else
476  /*==================== setenv ==================================*/
477  if (strcmp(sys_cmd,"setenv")==0)
478  {
479  #ifdef HAVE_SETENV
480  const short t[]={2,STRING_CMD,STRING_CMD};
481  if (iiCheckTypes(h,t,1))
482  {
483  res->rtyp=STRING_CMD;
484  setenv((char *)h->Data(), (char *)h->next->Data(), 1);
485  res->data=(void *)omStrDup((char *)h->next->Data());
487  return FALSE;
488  }
489  else
490  {
491  return TRUE;
492  }
493  #else
494  WerrorS("setenv not supported on this platform");
495  return TRUE;
496  #endif
497  }
498  else
499  /*==================== Singular ==================================*/
500  if (strcmp(sys_cmd, "Singular") == 0)
501  {
502  res->rtyp=STRING_CMD;
503  const char *r=feResource("Singular");
504  if (r == NULL) r="";
505  res->data = (void*) omStrDup( r );
506  return FALSE;
507  }
508  else
509  if (strcmp(sys_cmd, "SingularLib") == 0)
510  {
511  res->rtyp=STRING_CMD;
512  const char *r=feResource("SearchPath");
513  if (r == NULL) r="";
514  res->data = (void*) omStrDup( r );
515  return FALSE;
516  }
517  else
518  /*==================== options ==================================*/
519  if (strstr(sys_cmd, "--") == sys_cmd)
520  {
521  if (strcmp(sys_cmd, "--") == 0)
522  {
524  return FALSE;
525  }
526  feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
527  if (opt == FE_OPT_UNDEF)
528  {
529  Werror("Unknown option %s", sys_cmd);
530  WerrorS("Use 'system(\"--\");' for listing of available options");
531  return TRUE;
532  }
533  // for Untyped Options (help version),
534  // setting it just triggers action
535  if (feOptSpec[opt].type == feOptUntyped)
536  {
537  feSetOptValue(opt,0);
538  return FALSE;
539  }
540  if (h == NULL)
541  {
542  if (feOptSpec[opt].type == feOptString)
543  {
544  res->rtyp = STRING_CMD;
545  const char *r=(const char*)feOptSpec[opt].value;
546  if (r == NULL) r="";
547  res->data = omStrDup(r);
548  }
549  else
550  {
551  res->rtyp = INT_CMD;
552  res->data = feOptSpec[opt].value;
553  }
554  return FALSE;
555  }
556  if (h->Typ() != STRING_CMD &&
557  h->Typ() != INT_CMD)
558  {
559  WerrorS("Need string or int argument to set option value");
560  return TRUE;
561  }
562  const char* errormsg;
563  if (h->Typ() == INT_CMD)
564  {
565  if (feOptSpec[opt].type == feOptString)
566  {
567  Werror("Need string argument to set value of option %s", sys_cmd);
568  return TRUE;
569  }
570  errormsg = feSetOptValue(opt, (int)((long) h->Data()));
571  if (errormsg != NULL)
572  Werror("Option '--%s=%d' %s", sys_cmd, (int) ((long)h->Data()), errormsg);
573  }
574  else
575  {
576  errormsg = feSetOptValue(opt, (char*) h->Data());
577  if (errormsg != NULL)
578  Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
579  }
580  if (errormsg != NULL) return TRUE;
581  return FALSE;
582  }
583  else
584  /*==================== HC ==================================*/
585  if (strcmp(sys_cmd,"HC")==0)
586  {
587  res->rtyp=INT_CMD;
588  res->data=(void *)(long) HCord;
589  return FALSE;
590  }
591  else
592  /*==================== random ==================================*/
593  if(strcmp(sys_cmd,"random")==0)
594  {
595  const short t[]={1,INT_CMD};
596  if (h!=NULL)
597  {
598  if (iiCheckTypes(h,t,1))
599  {
600  siRandomStart=(int)((long)h->Data());
603  return FALSE;
604  }
605  else
606  {
607  return TRUE;
608  }
609  }
610  res->rtyp=INT_CMD;
611  res->data=(void*)(long) siSeed;
612  return FALSE;
613  }
614  else
615  /*======================= demon_list =====================*/
616  if (strcmp(sys_cmd,"denom_list")==0)
617  {
618  res->rtyp=LIST_CMD;
619  extern lists get_denom_list();
620  res->data=(lists)get_denom_list();
621  return FALSE;
622  }
623  else
624  /*==================== complexNearZero ======================*/
625  if(strcmp(sys_cmd,"complexNearZero")==0)
626  {
627  const short t[]={2,NUMBER_CMD,INT_CMD};
628  if (iiCheckTypes(h,t,1))
629  {
630  if ( !rField_is_long_C(currRing) )
631  {
632  WerrorS( "unsupported ground field!");
633  return TRUE;
634  }
635  else
636  {
637  res->rtyp=INT_CMD;
638  res->data=(void*)complexNearZero((gmp_complex*)h->Data(),
639  (int)((long)(h->next->Data())));
640  return FALSE;
641  }
642  }
643  else
644  {
645  return TRUE;
646  }
647  }
648  else
649  /*==================== getPrecDigits ======================*/
650  if(strcmp(sys_cmd,"getPrecDigits")==0)
651  {
652  if ( (currRing==NULL)
654  {
655  WerrorS( "unsupported ground field!");
656  return TRUE;
657  }
658  res->rtyp=INT_CMD;
659  res->data=(void*)(long)gmp_output_digits;
660  //if (gmp_output_digits!=getGMPFloatDigits())
661  //{ Print("%d, %d\n",getGMPFloatDigits(),gmp_output_digits);}
662  return FALSE;
663  }
664  else
665  /*==================== lduDecomp ======================*/
666  if(strcmp(sys_cmd, "lduDecomp")==0)
667  {
668  const short t[]={1,MATRIX_CMD};
669  if (iiCheckTypes(h,t,1))
670  {
671  matrix aMat = (matrix)h->Data();
672  matrix pMat; matrix lMat; matrix dMat; matrix uMat;
673  poly l; poly u; poly prodLU;
674  lduDecomp(aMat, pMat, lMat, dMat, uMat, l, u, prodLU);
676  L->Init(7);
677  L->m[0].rtyp = MATRIX_CMD; L->m[0].data=(void*)pMat;
678  L->m[1].rtyp = MATRIX_CMD; L->m[1].data=(void*)lMat;
679  L->m[2].rtyp = MATRIX_CMD; L->m[2].data=(void*)dMat;
680  L->m[3].rtyp = MATRIX_CMD; L->m[3].data=(void*)uMat;
681  L->m[4].rtyp = POLY_CMD; L->m[4].data=(void*)l;
682  L->m[5].rtyp = POLY_CMD; L->m[5].data=(void*)u;
683  L->m[6].rtyp = POLY_CMD; L->m[6].data=(void*)prodLU;
684  res->rtyp = LIST_CMD;
685  res->data = (char *)L;
686  return FALSE;
687  }
688  else
689  {
690  return TRUE;
691  }
692  }
693  else
694  /*==================== lduSolve ======================*/
695  if(strcmp(sys_cmd, "lduSolve")==0)
696  {
697  /* for solving a linear equation system A * x = b, via the
698  given LDU-decomposition of the matrix A;
699  There is one valid parametrisation:
700  1) exactly eight arguments P, L, D, U, l, u, lTimesU, b;
701  P, L, D, and U realise the LDU-decomposition of A, that is,
702  P * A = L * D^(-1) * U, and P, L, D, and U satisfy the
703  properties decribed in method 'luSolveViaLDUDecomp' in
704  linearAlgebra.h; see there;
705  l, u, and lTimesU are as described in the same location;
706  b is the right-hand side vector of the linear equation system;
707  The method will return a list of either 1 entry or three entries:
708  1) [0] if there is no solution to the system;
709  2) [1, x, H] if there is at least one solution;
710  x is any solution of the given linear system,
711  H is the matrix with column vectors spanning the homogeneous
712  solution space.
713  The method produces an error if matrix and vector sizes do not
714  fit. */
715  const short t[]={7,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,POLY_CMD,POLY_CMD,MATRIX_CMD};
716  if (!iiCheckTypes(h,t,1))
717  {
718  return TRUE;
719  }
721  {
722  WerrorS("field required");
723  return TRUE;
724  }
725  matrix pMat = (matrix)h->Data();
726  matrix lMat = (matrix)h->next->Data();
727  matrix dMat = (matrix)h->next->next->Data();
728  matrix uMat = (matrix)h->next->next->next->Data();
729  poly l = (poly) h->next->next->next->next->Data();
730  poly u = (poly) h->next->next->next->next->next->Data();
731  poly lTimesU = (poly) h->next->next->next->next->next->next->Data();
732  matrix bVec = (matrix)h->next->next->next->next->next->next->next->Data();
733  matrix xVec; int solvable; matrix homogSolSpace;
734  if (pMat->rows() != pMat->cols())
735  {
736  Werror("first matrix (%d x %d) is not quadratic",
737  pMat->rows(), pMat->cols());
738  return TRUE;
739  }
740  if (lMat->rows() != lMat->cols())
741  {
742  Werror("second matrix (%d x %d) is not quadratic",
743  lMat->rows(), lMat->cols());
744  return TRUE;
745  }
746  if (dMat->rows() != dMat->cols())
747  {
748  Werror("third matrix (%d x %d) is not quadratic",
749  dMat->rows(), dMat->cols());
750  return TRUE;
751  }
752  if (dMat->cols() != uMat->rows())
753  {
754  Werror("third matrix (%d x %d) and fourth matrix (%d x %d) %s",
755  dMat->rows(), dMat->cols(), uMat->rows(), uMat->cols(),
756  "do not t");
757  return TRUE;
758  }
759  if (uMat->rows() != bVec->rows())
760  {
761  Werror("fourth matrix (%d x %d) and vector (%d x 1) do not fit",
762  uMat->rows(), uMat->cols(), bVec->rows());
763  return TRUE;
764  }
765  solvable = luSolveViaLDUDecomp(pMat, lMat, dMat, uMat, l, u, lTimesU,
766  bVec, xVec, homogSolSpace);
767 
768  /* build the return structure; a list with either one or
769  three entries */
771  if (solvable)
772  {
773  ll->Init(3);
774  ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)(long)solvable;
775  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
776  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
777  }
778  else
779  {
780  ll->Init(1);
781  ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)(long)solvable;
782  }
783  res->rtyp = LIST_CMD;
784  res->data=(char*)ll;
785  return FALSE;
786  }
787  else
788  /*==== countedref: reference and shared ====*/
789  if (strcmp(sys_cmd, "shared") == 0)
790  {
791  #ifndef SI_COUNTEDREF_AUTOLOAD
792  void countedref_shared_load();
794  #endif
795  res->rtyp = NONE;
796  return FALSE;
797  }
798  else if (strcmp(sys_cmd, "reference") == 0)
799  {
800  #ifndef SI_COUNTEDREF_AUTOLOAD
803  #endif
804  res->rtyp = NONE;
805  return FALSE;
806  }
807  else
808 /*==================== semaphore =================*/
809 #ifdef HAVE_SIMPLEIPC
810  if (strcmp(sys_cmd,"semaphore")==0)
811  {
812  if((h!=NULL) && (h->Typ()==STRING_CMD) && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
813  {
814  int v=1;
815  if ((h->next->next!=NULL)&& (h->next->next->Typ()==INT_CMD))
816  v=(int)(long)h->next->next->Data();
817  res->data=(char *)(long)simpleipc_cmd((char *)h->Data(),(int)(long)h->next->Data(),v);
818  res->rtyp=INT_CMD;
819  return FALSE;
820  }
821  else
822  {
823  WerrorS("Usage: system(\"semaphore\",<cmd>,int)");
824  return TRUE;
825  }
826  }
827  else
828 #endif
829 /*==================== reserved port =================*/
830  if (strcmp(sys_cmd,"reserve")==0)
831  {
832  int ssiReservePort(int clients);
833  const short t[]={1,INT_CMD};
834  if (iiCheckTypes(h,t,1))
835  {
836  res->rtyp=INT_CMD;
837  int p=ssiReservePort((int)(long)h->Data());
838  res->data=(void*)(long)p;
839  return (p==0);
840  }
841  return TRUE;
842  }
843  else
844 /*==================== reserved link =================*/
845  if (strcmp(sys_cmd,"reservedLink")==0)
846  {
847  extern si_link ssiCommandLink();
848  res->rtyp=LINK_CMD;
850  res->data=(void*)p;
851  return (p==NULL);
852  }
853  else
854 /*==================== install newstruct =================*/
855  if (strcmp(sys_cmd,"install")==0)
856  {
857  const short t[]={4,STRING_CMD,STRING_CMD,PROC_CMD,INT_CMD};
858  if (iiCheckTypes(h,t,1))
859  {
860  return newstruct_set_proc((char*)h->Data(),(char*)h->next->Data(),
861  (int)(long)h->next->next->next->Data(),
862  (procinfov)h->next->next->Data());
863  }
864  return TRUE;
865  }
866  else
867 /*==================== newstruct =================*/
868  if (strcmp(sys_cmd,"newstruct")==0)
869  {
870  const short t[]={1,STRING_CMD};
871  if (iiCheckTypes(h,t,1))
872  {
873  int id=0;
874  char *n=(char*)h->Data();
875  blackboxIsCmd(n,id);
876  if (id>0)
877  {
878  blackbox *bb=getBlackboxStuff(id);
879  if (BB_LIKE_LIST(bb))
880  {
881  newstruct_desc desc=(newstruct_desc)bb->data;
882  newstructShow(desc);
883  return FALSE;
884  }
885  else Werror("'%s' is not a newstruct",n);
886  }
887  else Werror("'%s' is not a blackbox object",n);
888  }
889  return TRUE;
890  }
891  else
892 /*==================== blackbox =================*/
893  if (strcmp(sys_cmd,"blackbox")==0)
894  {
896  return FALSE;
897  }
898  else
899  /*================= absBiFact ======================*/
900  #ifdef HAVE_NTL
901  if (strcmp(sys_cmd, "absFact") == 0)
902  {
903  const short t[]={1,POLY_CMD};
904  if (iiCheckTypes(h,t,1)
905  && (currRing!=NULL)
906  && (getCoeffType(currRing->cf)==n_transExt))
907  {
908  res->rtyp=LIST_CMD;
909  intvec *v=NULL;
910  ideal mipos= NULL;
911  int n= 0;
912  ideal f=singclap_absFactorize((poly)(h->Data()), mipos, &v, n, currRing);
913  if (f==NULL) return TRUE;
914  ivTest(v);
916  l->Init(4);
917  l->m[0].rtyp=IDEAL_CMD;
918  l->m[0].data=(void *)f;
919  l->m[1].rtyp=INTVEC_CMD;
920  l->m[1].data=(void *)v;
921  l->m[2].rtyp=IDEAL_CMD;
922  l->m[2].data=(void*) mipos;
923  l->m[3].rtyp=INT_CMD;
924  l->m[3].data=(void*) (long) n;
925  res->data=(void *)l;
926  return FALSE;
927  }
928  else return TRUE;
929  }
930  else
931  #endif
932  /* =================== LLL via NTL ==============================*/
933  #ifdef HAVE_NTL
934  if (strcmp(sys_cmd, "LLL") == 0)
935  {
936  if (h!=NULL)
937  {
938  res->rtyp=h->Typ();
939  if (h->Typ()==MATRIX_CMD)
940  {
941  res->data=(char *)singntl_LLL((matrix)h->Data(), currRing);
942  return FALSE;
943  }
944  else if (h->Typ()==INTMAT_CMD)
945  {
946  res->data=(char *)singntl_LLL((intvec*)h->Data());
947  return FALSE;
948  }
949  else return TRUE;
950  }
951  else return TRUE;
952  }
953  else
954  #endif
955  /* =================== LLL via Flint ==============================*/
956  #ifdef HAVE_FLINT
957  #ifdef FLINT_VER_2_4_5
958  if (strcmp(sys_cmd, "LLL_Flint") == 0)
959  {
960  if (h!=NULL)
961  {
962  if(h->next == NULL)
963  {
964  res->rtyp=h->Typ();
965  if (h->Typ()==BIGINTMAT_CMD)
966  {
967  res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
968  return FALSE;
969  }
970  else if (h->Typ()==INTMAT_CMD)
971  {
972  res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
973  return FALSE;
974  }
975  else return TRUE;
976  }
977  if(h->next->Typ()!= INT_CMD)
978  {
979  WerrorS("matrix,int or bigint,int expected");
980  return TRUE;
981  }
982  if(h->next->Typ()== INT_CMD)
983  {
984  if(((int)((long)(h->next->Data())) != 0) && (int)((long)(h->next->Data()) != 1))
985  {
986  WerrorS("int is different from 0, 1");
987  return TRUE;
988  }
989  res->rtyp=h->Typ();
990  if((long)(h->next->Data()) == 0)
991  {
992  if (h->Typ()==BIGINTMAT_CMD)
993  {
994  res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
995  return FALSE;
996  }
997  else if (h->Typ()==INTMAT_CMD)
998  {
999  res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
1000  return FALSE;
1001  }
1002  else return TRUE;
1003  }
1004  // This will give also the transformation matrix U s.t. res = U * m
1005  if((long)(h->next->Data()) == 1)
1006  {
1007  if (h->Typ()==BIGINTMAT_CMD)
1008  {
1009  bigintmat* m = (bigintmat*)h->Data();
1010  bigintmat* T = new bigintmat(m->rows(),m->rows(),m->basecoeffs());
1011  for(int i = 1; i<=m->rows(); i++)
1012  {
1013  n_Delete(&(BIMATELEM(*T,i,i)),T->basecoeffs());
1014  BIMATELEM(*T,i,i)=n_Init(1, T->basecoeffs());
1015  }
1016  m = singflint_LLL(m,T);
1018  L->Init(2);
1019  L->m[0].rtyp = BIGINTMAT_CMD; L->m[0].data = (void*)m;
1020  L->m[1].rtyp = BIGINTMAT_CMD; L->m[1].data = (void*)T;
1021  res->data=L;
1022  res->rtyp=LIST_CMD;
1023  return FALSE;
1024  }
1025  else if (h->Typ()==INTMAT_CMD)
1026  {
1027  intvec* m = (intvec*)h->Data();
1028  intvec* T = new intvec(m->rows(),m->rows(),(int)0);
1029  for(int i = 1; i<=m->rows(); i++)
1030  IMATELEM(*T,i,i)=1;
1031  m = singflint_LLL(m,T);
1033  L->Init(2);
1034  L->m[0].rtyp = INTMAT_CMD; L->m[0].data = (void*)m;
1035  L->m[1].rtyp = INTMAT_CMD; L->m[1].data = (void*)T;
1036  res->data=L;
1037  res->rtyp=LIST_CMD;
1038  return FALSE;
1039  }
1040  else return TRUE;
1041  }
1042  }
1043 
1044  }
1045  else return TRUE;
1046  }
1047  else
1048  #endif
1049  #endif
1050  /*==================== shift-test for freeGB =================*/
1051  #ifdef HAVE_SHIFTBBA
1052  if (strcmp(sys_cmd, "stest") == 0)
1053  {
1054  const short t[]={4,POLY_CMD,INT_CMD,INT_CMD,INT_CMD};
1055  if (iiCheckTypes(h,t,1))
1056  {
1057  poly p=(poly)h->CopyD();
1058  h=h->next;
1059  int sh=(int)((long)(h->Data()));
1060  h=h->next;
1061  int uptodeg=(int)((long)(h->Data()));
1062  h=h->next;
1063  int lVblock=(int)((long)(h->Data()));
1064  res->data = pLPshift(p,sh,uptodeg,lVblock);
1065  res->rtyp = POLY_CMD;
1066  return FALSE;
1067  }
1068  else return TRUE;
1069  }
1070  else
1071  #endif
1072  /*==================== block-test for freeGB =================*/
1073  #ifdef HAVE_SHIFTBBA
1074  if (strcmp(sys_cmd, "btest") == 0)
1075  {
1076  const short t[]={2,POLY_CMD,INT_CMD};
1077  if (iiCheckTypes(h,t,1))
1078  {
1079  poly p=(poly)h->CopyD();
1080  h=h->next;
1081  int lV=(int)((long)(h->Data()));
1082  res->rtyp = INT_CMD;
1083  res->data = (void*)(long)pLastVblock(p, lV);
1084  return FALSE;
1085  }
1086  else return TRUE;
1087  }
1088  else
1089  #endif
1090  /*==================== shrink-test for freeGB =================*/
1091  #ifdef HAVE_SHIFTBBA
1092  if (strcmp(sys_cmd, "shrinktest") == 0)
1093  {
1094  const short t[]={2,POLY_CMD,INT_CMD};
1095  if (iiCheckTypes(h,t,1))
1096  {
1097  poly p=(poly)h->Data();
1098  h=h->next;
1099  int lV=(int)((long)(h->Data()));
1100  res->rtyp = POLY_CMD;
1101  // res->data = p_mShrink(p, lV, currRing);
1102  // kStrategy strat=new skStrategy;
1103  // strat->tailRing = currRing;
1104  res->data = p_Shrink(p, lV, currRing);
1105  return FALSE;
1106  }
1107  else return TRUE;
1108  }
1109  else
1110  #endif
1111  /*==================== pcv ==================================*/
1112  #ifdef HAVE_PCV
1113  if(strcmp(sys_cmd,"pcvLAddL")==0)
1114  {
1115  return pcvLAddL(res,h);
1116  }
1117  else
1118  if(strcmp(sys_cmd,"pcvPMulL")==0)
1119  {
1120  return pcvPMulL(res,h);
1121  }
1122  else
1123  if(strcmp(sys_cmd,"pcvMinDeg")==0)
1124  {
1125  return pcvMinDeg(res,h);
1126  }
1127  else
1128  if(strcmp(sys_cmd,"pcvP2CV")==0)
1129  {
1130  return pcvP2CV(res,h);
1131  }
1132  else
1133  if(strcmp(sys_cmd,"pcvCV2P")==0)
1134  {
1135  return pcvCV2P(res,h);
1136  }
1137  else
1138  if(strcmp(sys_cmd,"pcvDim")==0)
1139  {
1140  return pcvDim(res,h);
1141  }
1142  else
1143  if(strcmp(sys_cmd,"pcvBasis")==0)
1144  {
1145  return pcvBasis(res,h);
1146  }
1147  else
1148  #endif
1149  /*==================== hessenberg/eigenvalues ==================================*/
1150  #ifdef HAVE_EIGENVAL
1151  if(strcmp(sys_cmd,"hessenberg")==0)
1152  {
1153  return evHessenberg(res,h);
1154  }
1155  else
1156  #endif
1157  /*==================== eigenvalues ==================================*/
1158  #ifdef HAVE_EIGENVAL
1159  if(strcmp(sys_cmd,"eigenvals")==0)
1160  {
1161  return evEigenvals(res,h);
1162  }
1163  else
1164  #endif
1165  /*==================== rowelim ==================================*/
1166  #ifdef HAVE_EIGENVAL
1167  if(strcmp(sys_cmd,"rowelim")==0)
1168  {
1169  return evRowElim(res,h);
1170  }
1171  else
1172  #endif
1173  /*==================== rowcolswap ==================================*/
1174  #ifdef HAVE_EIGENVAL
1175  if(strcmp(sys_cmd,"rowcolswap")==0)
1176  {
1177  return evSwap(res,h);
1178  }
1179  else
1180  #endif
1181  /*==================== Gauss-Manin system ==================================*/
1182  #ifdef HAVE_GMS
1183  if(strcmp(sys_cmd,"gmsnf")==0)
1184  {
1185  return gmsNF(res,h);
1186  }
1187  else
1188  #endif
1189  /*==================== contributors =============================*/
1190  if(strcmp(sys_cmd,"contributors") == 0)
1191  {
1192  res->rtyp=STRING_CMD;
1193  res->data=(void *)omStrDup(
1194  "Olaf Bachmann, Michael Brickenstein, Hubert Grassmann, Kai Krueger, Victor Levandovskyy, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Jens Schmidt, Mathias Schulze, Thomas Siebert, Ruediger Stobbe, Moritz Wenk, Tim Wichmann");
1195  return FALSE;
1196  }
1197  else
1198  /*==================== spectrum =============================*/
1199  #ifdef HAVE_SPECTRUM
1200  if(strcmp(sys_cmd,"spectrum") == 0)
1201  {
1202  if ((h==NULL) || (h->Typ()!=POLY_CMD))
1203  {
1204  WerrorS("poly expected");
1205  return TRUE;
1206  }
1207  if (h->next==NULL)
1208  return spectrumProc(res,h);
1209  if (h->next->Typ()!=INT_CMD)
1210  {
1211  WerrorS("poly,int expected");
1212  return TRUE;
1213  }
1214  if(((long)h->next->Data())==1L)
1215  return spectrumfProc(res,h);
1216  return spectrumProc(res,h);
1217  }
1218  else
1219  /*==================== semic =============================*/
1220  if(strcmp(sys_cmd,"semic") == 0)
1221  {
1222  if ((h->next!=NULL)
1223  && (h->Typ()==LIST_CMD)
1224  && (h->next->Typ()==LIST_CMD))
1225  {
1226  if (h->next->next==NULL)
1227  return semicProc(res,h,h->next);
1228  else if (h->next->next->Typ()==INT_CMD)
1229  return semicProc3(res,h,h->next,h->next->next);
1230  }
1231  return TRUE;
1232  }
1233  else
1234  /*==================== spadd =============================*/
1235  if(strcmp(sys_cmd,"spadd") == 0)
1236  {
1237  const short t[]={2,LIST_CMD,LIST_CMD};
1238  if (iiCheckTypes(h,t,1))
1239  {
1240  return spaddProc(res,h,h->next);
1241  }
1242  return TRUE;
1243  }
1244  else
1245  /*==================== spmul =============================*/
1246  if(strcmp(sys_cmd,"spmul") == 0)
1247  {
1248  const short t[]={2,LIST_CMD,INT_CMD};
1249  if (iiCheckTypes(h,t,1))
1250  {
1251  return spmulProc(res,h,h->next);
1252  }
1253  return TRUE;
1254  }
1255  else
1256  #endif
1257 /*==================== tensorModuleMult ========================= */
1258  #define HAVE_SHEAFCOH_TRICKS 1
1259 
1260  #ifdef HAVE_SHEAFCOH_TRICKS
1261  if(strcmp(sys_cmd,"tensorModuleMult")==0)
1262  {
1263  const short t[]={2,INT_CMD,MODUL_CMD};
1264  // WarnS("tensorModuleMult!");
1265  if (iiCheckTypes(h,t,1))
1266  {
1267  int m = (int)( (long)h->Data() );
1268  ideal M = (ideal)h->next->Data();
1269  res->rtyp=MODUL_CMD;
1270  res->data=(void *)id_TensorModuleMult(m, M, currRing);
1271  return FALSE;
1272  }
1273  return TRUE;
1274  }
1275  else
1276  #endif
1277  /*==================== twostd =================*/
1278  #ifdef HAVE_PLURAL
1279  if (strcmp(sys_cmd, "twostd") == 0)
1280  {
1281  ideal I;
1282  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
1283  {
1284  I=(ideal)h->CopyD();
1285  res->rtyp=IDEAL_CMD;
1286  if (rIsPluralRing(currRing)) res->data=twostd(I);
1287  else res->data=I;
1288  setFlag(res,FLAG_TWOSTD);
1289  setFlag(res,FLAG_STD);
1290  }
1291  else return TRUE;
1292  return FALSE;
1293  }
1294  else
1295  #endif
1296  /*==================== lie bracket =================*/
1297  #ifdef HAVE_PLURAL
1298  if (strcmp(sys_cmd, "bracket") == 0)
1299  {
1300  const short t[]={2,POLY_CMD,POLY_CMD};
1301  if (iiCheckTypes(h,t,1))
1302  {
1303  poly p=(poly)h->CopyD();
1304  h=h->next;
1305  poly q=(poly)h->Data();
1306  res->rtyp=POLY_CMD;
1308  return FALSE;
1309  }
1310  return TRUE;
1311  }
1312  else
1313  #endif
1314  /*==================== env ==================================*/
1315  #ifdef HAVE_PLURAL
1316  if (strcmp(sys_cmd, "env")==0)
1317  {
1318  if ((h!=NULL) && (h->Typ()==RING_CMD))
1319  {
1320  ring r = (ring)h->Data();
1321  res->data = rEnvelope(r);
1322  res->rtyp = RING_CMD;
1323  return FALSE;
1324  }
1325  else
1326  {
1327  WerrorS("`system(\"env\",<ring>)` expected");
1328  return TRUE;
1329  }
1330  }
1331  else
1332  #endif
1333 /* ============ opp ======================== */
1334  #ifdef HAVE_PLURAL
1335  if (strcmp(sys_cmd, "opp")==0)
1336  {
1337  if ((h!=NULL) && (h->Typ()==RING_CMD))
1338  {
1339  ring r=(ring)h->Data();
1340  res->data=rOpposite(r);
1341  res->rtyp=RING_CMD;
1342  return FALSE;
1343  }
1344  else
1345  {
1346  WerrorS("`system(\"opp\",<ring>)` expected");
1347  return TRUE;
1348  }
1349  }
1350  else
1351  #endif
1352  /*==================== oppose ==================================*/
1353  #ifdef HAVE_PLURAL
1354  if (strcmp(sys_cmd, "oppose")==0)
1355  {
1356  if ((h!=NULL) && (h->Typ()==RING_CMD)
1357  && (h->next!= NULL))
1358  {
1359  ring Rop = (ring)h->Data();
1360  h = h->next;
1361  idhdl w;
1362  if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
1363  {
1364  poly p = (poly)IDDATA(w);
1365  res->data = pOppose(Rop, p, currRing); // into CurrRing?
1366  res->rtyp = POLY_CMD;
1367  return FALSE;
1368  }
1369  }
1370  else
1371  {
1372  WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
1373  return TRUE;
1374  }
1375  }
1376  else
1377  #endif
1378  /*==================== freeGB, twosided GB in free algebra =================*/
1379  #ifdef HAVE_PLURAL
1380  #ifdef HAVE_SHIFTBBA
1381  if (strcmp(sys_cmd, "freegb") == 0)
1382  {
1383  const short t[]={3,IDEAL_CMD,INT_CMD,INT_CMD};
1384  if (iiCheckTypes(h,t,1))
1385  {
1386  ideal I=(ideal)h->CopyD();
1387  h=h->next;
1388  int uptodeg=(int)((long)(h->Data()));
1389  h=h->next;
1390  int lVblock=(int)((long)(h->Data()));
1391  res->data = freegb(I,uptodeg,lVblock);
1392  if (res->data == NULL)
1393  {
1394  /* that is there were input errors */
1395  res->data = I;
1396  }
1397  res->rtyp = IDEAL_CMD;
1398  return FALSE;
1399  }
1400  else return TRUE;
1401  }
1402  else
1403  #endif /*SHIFTBBA*/
1404  #endif /*PLURAL*/
1405  /*==================== walk stuff =================*/
1406  /*==================== walkNextWeight =================*/
1407  #ifdef HAVE_WALK
1408  #ifdef OWNW
1409  if (strcmp(sys_cmd, "walkNextWeight") == 0)
1410  {
1411  const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1412  if (!iiCheckTypes(h,t,1)) return TRUE;
1413  if (((intvec*) h->Data())->length() != currRing->N ||
1414  ((intvec*) h->next->Data())->length() != currRing->N)
1415  {
1416  Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1417  currRing->N);
1418  return TRUE;
1419  }
1420  res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1421  ((intvec*) h->next->Data()),
1422  (ideal) h->next->next->Data());
1423  if (res->data == NULL || res->data == (void*) 1L)
1424  {
1425  res->rtyp = INT_CMD;
1426  }
1427  else
1428  {
1429  res->rtyp = INTVEC_CMD;
1430  }
1431  return FALSE;
1432  }
1433  else
1434  #endif
1435  #endif
1436  /*==================== walkNextWeight =================*/
1437  #ifdef HAVE_WALK
1438  #ifdef OWNW
1439  if (strcmp(sys_cmd, "walkInitials") == 0)
1440  {
1441  if (h == NULL || h->Typ() != IDEAL_CMD)
1442  {
1443  WerrorS("system(\"walkInitials\", ideal) expected");
1444  return TRUE;
1445  }
1446  res->data = (void*) walkInitials((ideal) h->Data());
1447  res->rtyp = IDEAL_CMD;
1448  return FALSE;
1449  }
1450  else
1451  #endif
1452  #endif
1453  /*==================== walkAddIntVec =================*/
1454  #ifdef HAVE_WALK
1455  #ifdef WAIV
1456  if (strcmp(sys_cmd, "walkAddIntVec") == 0)
1457  {
1458  const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1459  if (!iiCheckTypes(h,t,1)) return TRUE;
1460  intvec* arg1 = (intvec*) h->Data();
1461  intvec* arg2 = (intvec*) h->next->Data();
1462  res->data = (intvec*) walkAddIntVec(arg1, arg2);
1463  res->rtyp = INTVEC_CMD;
1464  return FALSE;
1465  }
1466  else
1467  #endif
1468  #endif
1469  /*==================== MwalkNextWeight =================*/
1470  #ifdef HAVE_WALK
1471  #ifdef MwaklNextWeight
1472  if (strcmp(sys_cmd, "MwalkNextWeight") == 0)
1473  {
1474  const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1475  if (!iiCheckTypes(h,t,1)) return TRUE;
1476  if (((intvec*) h->Data())->length() != currRing->N ||
1477  ((intvec*) h->next->Data())->length() != currRing->N)
1478  {
1479  Werror("system(\"MwalkNextWeight\" ...) intvecs not of length %d\n",
1480  currRing->N);
1481  return TRUE;
1482  }
1483  intvec* arg1 = (intvec*) h->Data();
1484  intvec* arg2 = (intvec*) h->next->Data();
1485  ideal arg3 = (ideal) h->next->next->Data();
1486  intvec* result = (intvec*) MwalkNextWeight(arg1, arg2, arg3);
1487  res->rtyp = INTVEC_CMD;
1488  res->data = result;
1489  return FALSE;
1490  }
1491  else
1492  #endif //MWalkNextWeight
1493  #endif
1494  /*==================== Mivdp =================*/
1495  #ifdef HAVE_WALK
1496  if(strcmp(sys_cmd, "Mivdp") == 0)
1497  {
1498  if (h == NULL || h->Typ() != INT_CMD)
1499  {
1500  WerrorS("system(\"Mivdp\", int) expected");
1501  return TRUE;
1502  }
1503  if ((int) ((long)(h->Data())) != currRing->N)
1504  {
1505  Werror("system(\"Mivdp\" ...) intvecs not of length %d\n",
1506  currRing->N);
1507  return TRUE;
1508  }
1509  int arg1 = (int) ((long)(h->Data()));
1510  intvec* result = (intvec*) Mivdp(arg1);
1511  res->rtyp = INTVEC_CMD;
1512  res->data = result;
1513  return FALSE;
1514  }
1515  else
1516  #endif
1517  /*==================== Mivlp =================*/
1518  #ifdef HAVE_WALK
1519  if(strcmp(sys_cmd, "Mivlp") == 0)
1520  {
1521  if (h == NULL || h->Typ() != INT_CMD)
1522  {
1523  WerrorS("system(\"Mivlp\", int) expected");
1524  return TRUE;
1525  }
1526  if ((int) ((long)(h->Data())) != currRing->N)
1527  {
1528  Werror("system(\"Mivlp\" ...) intvecs not of length %d\n",
1529  currRing->N);
1530  return TRUE;
1531  }
1532  int arg1 = (int) ((long)(h->Data()));
1533  intvec* result = (intvec*) Mivlp(arg1);
1534  res->rtyp = INTVEC_CMD;
1535  res->data = result;
1536  return FALSE;
1537  }
1538  else
1539  #endif
1540  /*==================== MpDiv =================*/
1541  #ifdef HAVE_WALK
1542  #ifdef MpDiv
1543  if(strcmp(sys_cmd, "MpDiv") == 0)
1544  {
1545  const short t[]={2,POLY_CMD,POLY_CMD};
1546  if (!iiCheckTypes(h,t,1)) return TRUE;
1547  poly arg1 = (poly) h->Data();
1548  poly arg2 = (poly) h->next->Data();
1549  poly result = MpDiv(arg1, arg2);
1550  res->rtyp = POLY_CMD;
1551  res->data = result;
1552  return FALSE;
1553  }
1554  else
1555  #endif
1556  #endif
1557  /*==================== MpMult =================*/
1558  #ifdef HAVE_WALK
1559  #ifdef MpMult
1560  if(strcmp(sys_cmd, "MpMult") == 0)
1561  {
1562  const short t[]={2,POLY_CMD,POLY_CMD};
1563  if (!iiCheckTypes(h,t,1)) return TRUE;
1564  poly arg1 = (poly) h->Data();
1565  poly arg2 = (poly) h->next->Data();
1566  poly result = MpMult(arg1, arg2);
1567  res->rtyp = POLY_CMD;
1568  res->data = result;
1569  return FALSE;
1570  }
1571  else
1572  #endif
1573  #endif
1574  /*==================== MivSame =================*/
1575  #ifdef HAVE_WALK
1576  if (strcmp(sys_cmd, "MivSame") == 0)
1577  {
1578  const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1579  if (!iiCheckTypes(h,t,1)) return TRUE;
1580  /*
1581  if (((intvec*) h->Data())->length() != currRing->N ||
1582  ((intvec*) h->next->Data())->length() != currRing->N)
1583  {
1584  Werror("system(\"MivSame\" ...) intvecs not of length %d\n",
1585  currRing->N);
1586  return TRUE;
1587  }
1588  */
1589  intvec* arg1 = (intvec*) h->Data();
1590  intvec* arg2 = (intvec*) h->next->Data();
1591  /*
1592  poly result = (poly) MivSame(arg1, arg2);
1593  res->rtyp = POLY_CMD;
1594  res->data = (poly) result;
1595  */
1596  res->rtyp = INT_CMD;
1597  res->data = (void*)(long) MivSame(arg1, arg2);
1598  return FALSE;
1599  }
1600  else
1601  #endif
1602  /*==================== M3ivSame =================*/
1603  #ifdef HAVE_WALK
1604  if (strcmp(sys_cmd, "M3ivSame") == 0)
1605  {
1606  const short t[]={3,INTVEC_CMD,INTVEC_CMD,INTVEC_CMD};
1607  if (!iiCheckTypes(h,t,1)) return TRUE;
1608  /*
1609  if (((intvec*) h->Data())->length() != currRing->N ||
1610  ((intvec*) h->next->Data())->length() != currRing->N ||
1611  ((intvec*) h->next->next->Data())->length() != currRing->N )
1612  {
1613  Werror("system(\"M3ivSame\" ...) intvecs not of length %d\n",
1614  currRing->N);
1615  return TRUE;
1616  }
1617  */
1618  intvec* arg1 = (intvec*) h->Data();
1619  intvec* arg2 = (intvec*) h->next->Data();
1620  intvec* arg3 = (intvec*) h->next->next->Data();
1621  /*
1622  poly result = (poly) M3ivSame(arg1, arg2, arg3);
1623  res->rtyp = POLY_CMD;
1624  res->data = (poly) result;
1625  */
1626  res->rtyp = INT_CMD;
1627  res->data = (void*)(long) M3ivSame(arg1, arg2, arg3);
1628  return FALSE;
1629  }
1630  else
1631  #endif
1632  /*==================== MwalkInitialForm =================*/
1633  #ifdef HAVE_WALK
1634  if(strcmp(sys_cmd, "MwalkInitialForm") == 0)
1635  {
1636  const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1637  if (!iiCheckTypes(h,t,1)) return TRUE;
1638  if(((intvec*) h->next->Data())->length() != currRing->N)
1639  {
1640  Werror("system \"MwalkInitialForm\"...) intvec not of length %d\n",
1641  currRing->N);
1642  return TRUE;
1643  }
1644  ideal id = (ideal) h->Data();
1645  intvec* int_w = (intvec*) h->next->Data();
1646  ideal result = (ideal) MwalkInitialForm(id, int_w);
1647  res->rtyp = IDEAL_CMD;
1648  res->data = result;
1649  return FALSE;
1650  }
1651  else
1652  #endif
1653  /*==================== MivMatrixOrder =================*/
1654  #ifdef HAVE_WALK
1655  /************** Perturbation walk **********/
1656  if(strcmp(sys_cmd, "MivMatrixOrder") == 0)
1657  {
1658  if(h==NULL || h->Typ() != INTVEC_CMD)
1659  {
1660  WerrorS("system(\"MivMatrixOrder\",intvec) expected");
1661  return TRUE;
1662  }
1663  intvec* arg1 = (intvec*) h->Data();
1664  intvec* result = MivMatrixOrder(arg1);
1665  res->rtyp = INTVEC_CMD;
1666  res->data = result;
1667  return FALSE;
1668  }
1669  else
1670  #endif
1671  /*==================== MivMatrixOrderdp =================*/
1672  #ifdef HAVE_WALK
1673  if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0)
1674  {
1675  if(h==NULL || h->Typ() != INT_CMD)
1676  {
1677  WerrorS("system(\"MivMatrixOrderdp\",intvec) expected");
1678  return TRUE;
1679  }
1680  int arg1 = (int) ((long)(h->Data()));
1681  intvec* result = (intvec*) MivMatrixOrderdp(arg1);
1682  res->rtyp = INTVEC_CMD;
1683  res->data = result;
1684  return FALSE;
1685  }
1686  else
1687  #endif
1688  /*==================== MPertVectors =================*/
1689  #ifdef HAVE_WALK
1690  if(strcmp(sys_cmd, "MPertVectors") == 0)
1691  {
1692  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1693  if (!iiCheckTypes(h,t,1)) return TRUE;
1694  ideal arg1 = (ideal) h->Data();
1695  intvec* arg2 = (intvec*) h->next->Data();
1696  int arg3 = (int) ((long)(h->next->next->Data()));
1697  intvec* result = (intvec*) MPertVectors(arg1, arg2, arg3);
1698  res->rtyp = INTVEC_CMD;
1699  res->data = result;
1700  return FALSE;
1701  }
1702  else
1703  #endif
1704  /*==================== MPertVectorslp =================*/
1705  #ifdef HAVE_WALK
1706  if(strcmp(sys_cmd, "MPertVectorslp") == 0)
1707  {
1708  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1709  if (!iiCheckTypes(h,t,1)) return TRUE;
1710  ideal arg1 = (ideal) h->Data();
1711  intvec* arg2 = (intvec*) h->next->Data();
1712  int arg3 = (int) ((long)(h->next->next->Data()));
1713  intvec* result = (intvec*) MPertVectorslp(arg1, arg2, arg3);
1714  res->rtyp = INTVEC_CMD;
1715  res->data = result;
1716  return FALSE;
1717  }
1718  else
1719  #endif
1720  /************** fractal walk **********/
1721  #ifdef HAVE_WALK
1722  if(strcmp(sys_cmd, "Mfpertvector") == 0)
1723  {
1724  const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1725  if (!iiCheckTypes(h,t,1)) return TRUE;
1726  ideal arg1 = (ideal) h->Data();
1727  intvec* arg2 = (intvec*) h->next->Data();
1728  intvec* result = Mfpertvector(arg1, arg2);
1729  res->rtyp = INTVEC_CMD;
1730  res->data = result;
1731  return FALSE;
1732  }
1733  else
1734  #endif
1735  /*==================== MivUnit =================*/
1736  #ifdef HAVE_WALK
1737  if(strcmp(sys_cmd, "MivUnit") == 0)
1738  {
1739  const short t[]={1,INT_CMD};
1740  if (!iiCheckTypes(h,t,1)) return TRUE;
1741  int arg1 = (int) ((long)(h->Data()));
1742  intvec* result = (intvec*) MivUnit(arg1);
1743  res->rtyp = INTVEC_CMD;
1744  res->data = result;
1745  return FALSE;
1746  }
1747  else
1748  #endif
1749  /*==================== MivWeightOrderlp =================*/
1750  #ifdef HAVE_WALK
1751  if(strcmp(sys_cmd, "MivWeightOrderlp") == 0)
1752  {
1753  const short t[]={1,INTVEC_CMD};
1754  if (!iiCheckTypes(h,t,1)) return TRUE;
1755  intvec* arg1 = (intvec*) h->Data();
1756  intvec* result = MivWeightOrderlp(arg1);
1757  res->rtyp = INTVEC_CMD;
1758  res->data = result;
1759  return FALSE;
1760  }
1761  else
1762  #endif
1763  /*==================== MivWeightOrderdp =================*/
1764  #ifdef HAVE_WALK
1765  if(strcmp(sys_cmd, "MivWeightOrderdp") == 0)
1766  {
1767  if(h==NULL || h->Typ() != INTVEC_CMD)
1768  {
1769  WerrorS("system(\"MivWeightOrderdp\",intvec) expected");
1770  return TRUE;
1771  }
1772  intvec* arg1 = (intvec*) h->Data();
1773  //int arg2 = (int) h->next->Data();
1774  intvec* result = MivWeightOrderdp(arg1);
1775  res->rtyp = INTVEC_CMD;
1776  res->data = result;
1777  return FALSE;
1778  }
1779  else
1780  #endif
1781  /*==================== MivMatrixOrderlp =================*/
1782  #ifdef HAVE_WALK
1783  if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0)
1784  {
1785  if(h==NULL || h->Typ() != INT_CMD)
1786  {
1787  WerrorS("system(\"MivMatrixOrderlp\",int) expected");
1788  return TRUE;
1789  }
1790  int arg1 = (int) ((long)(h->Data()));
1791  intvec* result = (intvec*) MivMatrixOrderlp(arg1);
1792  res->rtyp = INTVEC_CMD;
1793  res->data = result;
1794  return FALSE;
1795  }
1796  else
1797  #endif
1798  /*==================== MkInterRedNextWeight =================*/
1799  #ifdef HAVE_WALK
1800  if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0)
1801  {
1802  const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1803  if (!iiCheckTypes(h,t,1)) return TRUE;
1804  if (((intvec*) h->Data())->length() != currRing->N ||
1805  ((intvec*) h->next->Data())->length() != currRing->N)
1806  {
1807  Werror("system(\"MkInterRedNextWeight\" ...) intvecs not of length %d\n",
1808  currRing->N);
1809  return TRUE;
1810  }
1811  intvec* arg1 = (intvec*) h->Data();
1812  intvec* arg2 = (intvec*) h->next->Data();
1813  ideal arg3 = (ideal) h->next->next->Data();
1814  intvec* result = (intvec*) MkInterRedNextWeight(arg1, arg2, arg3);
1815  res->rtyp = INTVEC_CMD;
1816  res->data = result;
1817  return FALSE;
1818  }
1819  else
1820  #endif
1821  /*==================== MPertNextWeight =================*/
1822  #ifdef HAVE_WALK
1823  #ifdef MPertNextWeight
1824  if (strcmp(sys_cmd, "MPertNextWeight") == 0)
1825  {
1826  const short t[]={3,INTVEC_CMD,IDEAL_CMD,INT_CMD};
1827  if (!iiCheckTypes(h,t,1)) return TRUE;
1828  if (((intvec*) h->Data())->length() != currRing->N)
1829  {
1830  Werror("system(\"MPertNextWeight\" ...) intvecs not of length %d\n",
1831  currRing->N);
1832  return TRUE;
1833  }
1834  intvec* arg1 = (intvec*) h->Data();
1835  ideal arg2 = (ideal) h->next->Data();
1836  int arg3 = (int) h->next->next->Data();
1837  intvec* result = (intvec*) MPertNextWeight(arg1, arg2, arg3);
1838  res->rtyp = INTVEC_CMD;
1839  res->data = result;
1840  return FALSE;
1841  }
1842  else
1843  #endif //MPertNextWeight
1844  #endif
1845  /*==================== Mivperttarget =================*/
1846  #ifdef HAVE_WALK
1847  #ifdef Mivperttarget
1848  if (strcmp(sys_cmd, "Mivperttarget") == 0)
1849  {
1850  const short t[]={2,IDEAL_CMD,INT_CMD};
1851  if (!iiCheckTypes(h,t,1)) return TRUE;
1852  ideal arg1 = (ideal) h->Data();
1853  int arg2 = (int) h->next->Data();
1854  intvec* result = (intvec*) Mivperttarget(arg1, arg2);
1855  res->rtyp = INTVEC_CMD;
1856  res->data = result;
1857  return FALSE;
1858  }
1859  else
1860  #endif //Mivperttarget
1861  #endif
1862  /*==================== Mwalk =================*/
1863  #ifdef HAVE_WALK
1864  if (strcmp(sys_cmd, "Mwalk") == 0)
1865  {
1866  const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD};
1867  if (!iiCheckTypes(h,t,1)) return TRUE;
1868  if (((intvec*) h->next->Data())->length() != currRing->N &&
1869  ((intvec*) h->next->next->Data())->length() != currRing->N )
1870  {
1871  Werror("system(\"Mwalk\" ...) intvecs not of length %d\n",
1872  currRing->N);
1873  return TRUE;
1874  }
1875  ideal arg1 = (ideal) h->Data();
1876  intvec* arg2 = (intvec*) h->next->Data();
1877  intvec* arg3 = (intvec*) h->next->next->Data();
1878  ring arg4 = (ring) h->next->next->next->Data();
1879  ideal result = (ideal) Mwalk(arg1, arg2, arg3,arg4);
1880  res->rtyp = IDEAL_CMD;
1881  res->data = result;
1882  return FALSE;
1883  }
1884  else
1885  #endif
1886  /*==================== Mpwalk =================*/
1887  #ifdef HAVE_WALK
1888  #ifdef MPWALK_ORIG
1889  if (strcmp(sys_cmd, "Mwalk") == 0)
1890  {
1891  const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD};
1892  if (!iiCheckTypes(h,t,1)) return TRUE;
1893  if ((((intvec*) h->next->Data())->length() != currRing->N &&
1894  ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
1895  (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
1896  ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N)))
1897  {
1898  Werror("system(\"Mwalk\" ...) intvecs not of length %d or %d\n",
1899  currRing->N,(currRing->N)*(currRing->N));
1900  return TRUE;
1901  }
1902  ideal arg1 = (ideal) h->Data();
1903  intvec* arg2 = (intvec*) h->next->Data();
1904  intvec* arg3 = (intvec*) h->next->next->Data();
1905  ring arg4 = (ring) h->next->next->next->Data();
1906  ideal result = (ideal) Mwalk(arg1, arg2, arg3,arg4);
1907  res->rtyp = IDEAL_CMD;
1908  res->data = result;
1909  return FALSE;
1910  }
1911  else
1912  #else
1913  if (strcmp(sys_cmd, "Mpwalk") == 0)
1914  {
1915  const short t[]={6,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
1916  if (!iiCheckTypes(h,t,1)) return TRUE;
1917  if(((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1918  ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1919  {
1920  Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",currRing->N);
1921  return TRUE;
1922  }
1923  ideal arg1 = (ideal) h->Data();
1924  int arg2 = (int) (long) h->next->Data();
1925  int arg3 = (int) (long) h->next->next->Data();
1926  intvec* arg4 = (intvec*) h->next->next->next->Data();
1927  intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1928  int arg6 = (int) (long) h->next->next->next->next->next->Data();
1929  ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5,arg6);
1930  res->rtyp = IDEAL_CMD;
1931  res->data = result;
1932  return FALSE;
1933  }
1934  else
1935  #endif
1936  #endif
1937  /*==================== Mrwalk =================*/
1938  #ifdef HAVE_WALK
1939  if (strcmp(sys_cmd, "Mrwalk") == 0)
1940  {
1941  const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,RING_CMD};
1942  if (!iiCheckTypes(h,t,1)) return TRUE;
1943  if((((intvec*) h->next->Data())->length() != currRing->N &&
1944  ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
1945  (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
1946  ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) ))
1947  {
1948  Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
1949  currRing->N,(currRing->N)*(currRing->N));
1950  return TRUE;
1951  }
1952  ideal arg1 = (ideal) h->Data();
1953  intvec* arg2 = (intvec*) h->next->Data();
1954  intvec* arg3 = (intvec*) h->next->next->Data();
1955  int arg4 = (int)(long) h->next->next->next->Data();
1956  int arg5 = (int)(long) h->next->next->next->next->Data();
1957  ring arg6 = (ring) h->next->next->next->next->next->Data();
1958  ideal result = (ideal) Mrwalk(arg1, arg2, arg3, arg4, arg5, arg6);
1959  res->rtyp = IDEAL_CMD;
1960  res->data = result;
1961  return FALSE;
1962  }
1963  else
1964  #endif
1965  /*==================== MAltwalk1 =================*/
1966  #ifdef HAVE_WALK
1967  if (strcmp(sys_cmd, "MAltwalk1") == 0)
1968  {
1969  const short t[]={5,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD};
1970  if (!iiCheckTypes(h,t,1)) return TRUE;
1971  if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1972  ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1973  {
1974  Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
1975  currRing->N);
1976  return TRUE;
1977  }
1978  ideal arg1 = (ideal) h->Data();
1979  int arg2 = (int) ((long)(h->next->Data()));
1980  int arg3 = (int) ((long)(h->next->next->Data()));
1981  intvec* arg4 = (intvec*) h->next->next->next->Data();
1982  intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1983  ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
1984  res->rtyp = IDEAL_CMD;
1985  res->data = result;
1986  return FALSE;
1987  }
1988  else
1989  #endif
1990  /*==================== MAltwalk1 =================*/
1991  #ifdef HAVE_WALK
1992  #ifdef MFWALK_ALT
1993  if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
1994  {
1995  const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
1996  if (!iiCheckTypes(h,t,1)) return TRUE;
1997  if (((intvec*) h->next->Data())->length() != currRing->N &&
1998  ((intvec*) h->next->next->Data())->length() != currRing->N )
1999  {
2000  Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2001  currRing->N);
2002  return TRUE;
2003  }
2004  ideal arg1 = (ideal) h->Data();
2005  intvec* arg2 = (intvec*) h->next->Data();
2006  intvec* arg3 = (intvec*) h->next->next->Data();
2007  int arg4 = (int) h->next->next->next->Data();
2008  ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
2009  res->rtyp = IDEAL_CMD;
2010  res->data = result;
2011  return FALSE;
2012  }
2013  else
2014  #endif
2015  #endif
2016  /*==================== Mfwalk =================*/
2017  #ifdef HAVE_WALK
2018  if (strcmp(sys_cmd, "Mfwalk") == 0)
2019  {
2020  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2021  if (!iiCheckTypes(h,t,1)) return TRUE;
2022  if (((intvec*) h->next->Data())->length() != currRing->N &&
2023  ((intvec*) h->next->next->Data())->length() != currRing->N )
2024  {
2025  Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2026  currRing->N);
2027  return TRUE;
2028  }
2029  ideal arg1 = (ideal) h->Data();
2030  intvec* arg2 = (intvec*) h->next->Data();
2031  intvec* arg3 = (intvec*) h->next->next->Data();
2032  ideal result = (ideal) Mfwalk(arg1, arg2, arg3);
2033  res->rtyp = IDEAL_CMD;
2034  res->data = result;
2035  return FALSE;
2036  }
2037  else
2038  #endif
2039  /*==================== Mfrwalk =================*/
2040  #ifdef HAVE_WALK
2041  if (strcmp(sys_cmd, "Mfrwalk") == 0)
2042  {
2043  const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,RING_CMD};
2044  if (!iiCheckTypes(h,t,1)) return TRUE;
2045  if (((intvec*) h->next->Data())->length() != currRing->N &&
2046  ((intvec*) h->next->next->Data())->length() != currRing->N)
2047  {
2048  Werror("system(\"Mfrwalk\" ...) intvecs not of length %d\n",currRing->N);
2049  return TRUE;
2050  }
2051  ideal arg1 = (ideal) h->Data();
2052  intvec* arg2 = (intvec*) h->next->Data();
2053  intvec* arg3 = (intvec*) h->next->next->Data();
2054  int arg4 = (int)(long) h->next->next->next->Data();
2055  ideal result = (ideal) Mfrwalk(arg1, arg2, arg3, arg4);
2056  res->rtyp = IDEAL_CMD;
2057  res->data = result;
2058  return FALSE;
2059  }
2060  else
2061  /*==================== Mprwalk =================*/
2062  if (strcmp(sys_cmd, "Mprwalk") == 0)
2063  {
2065  if (!iiCheckTypes(h,t,1)) return TRUE;
2066  if (((intvec*) h->next->Data())->length() != currRing->N &&
2067  ((intvec*) h->next->next->Data())->length() != currRing->N )
2068  {
2069  Werror("system(\"Mrwalk\" ...) intvecs not of length %d\n",
2070  currRing->N);
2071  return TRUE;
2072  }
2073  ideal arg1 = (ideal) h->Data();
2074  intvec* arg2 = (intvec*) h->next->Data();
2075  intvec* arg3 = (intvec*) h->next->next->Data();
2076  int arg4 = (int)(long) h->next->next->next->Data();
2077  int arg5 = (int)(long) h->next->next->next->next->Data();
2078  int arg6 = (int)(long) h->next->next->next->next->next->Data();
2079  ring arg7 = (ring) h->next->next->next->next->next->next->Data();
2080  ideal result = (ideal) Mprwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
2081  res->rtyp = IDEAL_CMD;
2082  res->data = result;
2083  return FALSE;
2084  }
2085  else
2086  #endif
2087  /*==================== TranMImprovwalk =================*/
2088  #ifdef HAVE_WALK
2089  #ifdef TRAN_Orig
2090  if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2091  {
2092  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2093  if (!iiCheckTypes(h,t,1)) return TRUE;
2094  if (((intvec*) h->next->Data())->length() != currRing->N &&
2095  ((intvec*) h->next->next->Data())->length() != currRing->N )
2096  {
2097  Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2098  currRing->N);
2099  return TRUE;
2100  }
2101  ideal arg1 = (ideal) h->Data();
2102  intvec* arg2 = (intvec*) h->next->Data();
2103  intvec* arg3 = (intvec*) h->next->next->Data();
2104  ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
2105  res->rtyp = IDEAL_CMD;
2106  res->data = result;
2107  return FALSE;
2108  }
2109  else
2110  #endif
2111  #endif
2112  /*==================== MAltwalk2 =================*/
2113  #ifdef HAVE_WALK
2114  if (strcmp(sys_cmd, "MAltwalk2") == 0)
2115  {
2116  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2117  if (!iiCheckTypes(h,t,1)) return TRUE;
2118  if (((intvec*) h->next->Data())->length() != currRing->N &&
2119  ((intvec*) h->next->next->Data())->length() != currRing->N )
2120  {
2121  Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
2122  currRing->N);
2123  return TRUE;
2124  }
2125  ideal arg1 = (ideal) h->Data();
2126  intvec* arg2 = (intvec*) h->next->Data();
2127  intvec* arg3 = (intvec*) h->next->next->Data();
2128  ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
2129  res->rtyp = IDEAL_CMD;
2130  res->data = result;
2131  return FALSE;
2132  }
2133  else
2134  #endif
2135  /*==================== MAltwalk2 =================*/
2136  #ifdef HAVE_WALK
2137  if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2138  {
2139  const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2140  if (!iiCheckTypes(h,t,1)) return TRUE;
2141  if (((intvec*) h->next->Data())->length() != currRing->N &&
2142  ((intvec*) h->next->next->Data())->length() != currRing->N )
2143  {
2144  Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2145  currRing->N);
2146  return TRUE;
2147  }
2148  ideal arg1 = (ideal) h->Data();
2149  intvec* arg2 = (intvec*) h->next->Data();
2150  intvec* arg3 = (intvec*) h->next->next->Data();
2151  int arg4 = (int) ((long)(h->next->next->next->Data()));
2152  ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
2153  res->rtyp = IDEAL_CMD;
2154  res->data = result;
2155  return FALSE;
2156  }
2157  else
2158  #endif
2159  /*==================== TranMrImprovwalk =================*/
2160  #if 0
2161  #ifdef HAVE_WALK
2162  if (strcmp(sys_cmd, "TranMrImprovwalk") == 0)
2163  {
2164  if (h == NULL || h->Typ() != IDEAL_CMD ||
2165  h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2166  h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ||
2167  h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD ||
2168  h->next->next->next == NULL || h->next->next->next->next->Typ() != INT_CMD ||
2169  h->next->next->next == NULL || h->next->next->next->next->next->Typ() != INT_CMD)
2170  {
2171  WerrorS("system(\"TranMrImprovwalk\", ideal, intvec, intvec) expected");
2172  return TRUE;
2173  }
2174  if (((intvec*) h->next->Data())->length() != currRing->N &&
2175  ((intvec*) h->next->next->Data())->length() != currRing->N )
2176  {
2177  Werror("system(\"TranMrImprovwalk\" ...) intvecs not of length %d\n", currRing->N);
2178  return TRUE;
2179  }
2180  ideal arg1 = (ideal) h->Data();
2181  intvec* arg2 = (intvec*) h->next->Data();
2182  intvec* arg3 = (intvec*) h->next->next->Data();
2183  int arg4 = (int)(long) h->next->next->next->Data();
2184  int arg5 = (int)(long) h->next->next->next->next->Data();
2185  int arg6 = (int)(long) h->next->next->next->next->next->Data();
2186  ideal result = (ideal) TranMrImprovwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2187  res->rtyp = IDEAL_CMD;
2188  res->data = result;
2189  return FALSE;
2190  }
2191  else
2192  #endif
2193  #endif
2194  /*================= Extended system call ========================*/
2195  {
2196  #ifndef MAKE_DISTRIBUTION
2197  return(jjEXTENDED_SYSTEM(res, args));
2198  #else
2199  Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
2200  #endif
2201  }
2202  } /* typ==string */
2203  return TRUE;
2204 }
feOptIndex
Definition: feOptGen.h:15
int & rows()
Definition: matpol.h:24
lists get_denom_list()
Definition: denom_list.cc:8
poly pOppose(ring Rop_src, poly p, const ring Rop_dst)
opposes a vector p from Rop to currRing (dst!)
Definition: old.gring.cc:3427
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
ideal Mfwalk(ideal G, intvec *ivstart, intvec *ivtarget)
Definition: walk.cc:6814
const CanonicalForm int s
Definition: facAbsFact.cc:55
ring rEnvelope(ring R)
Definition: ring.cc:5517
sleftv * m
Definition: lists.h:45
intvec * MivMatrixOrder(intvec *iv)
Definition: walk.cc:938
poly nc_p_Bracket_qq(poly p, const poly q, const ring r)
returns [p,q], destroys p
Definition: old.gring.cc:2308
void factoryseed(int s)
random seed initializer
Definition: cf_random.cc:176
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
int HCord
Definition: kutil.cc:227
matrix singntl_LLL(matrix m, const ring s)
Definition: clapsing.cc:1706
intvec * Mfpertvector(ideal G, intvec *ivtarget)
Definition: walk.cc:1492
Definition: tok.h:85
static void * feOptValue(feOptIndex opt)
Definition: feOpt.h:40
matrix evRowElim(matrix M, int i, int j, int k)
Definition: eigenval.cc:47
Definition: lists.h:22
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:38
char * versionString()
Definition: misc_ip.cc:783
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
intvec * MivWeightOrderlp(intvec *ivstart)
Definition: walk.cc:1416
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4092
Matrices of numbers.
Definition: bigintmat.h:32
#define SINGULAR_VERSION
Definition: mod2.h:94
static char * feResource(feResourceConfig config, int warn)
Definition: feResource.cc:252
lists pcvPMulL(poly p, lists l1)
Definition: pcv.cc:56
static FORCE_INLINE number n_Init(long i, const coeffs r)
a number representing i in the given coeff field/ring r
Definition: coeffs.h:539
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
ring rOpposite(ring src)
Definition: ring.cc:5189
#define BB_LIKE_LIST(B)
Definition: blackbox.h:54
int siRandomStart
Definition: cntrlc.cc:103
ideal id_TensorModuleMult(const int m, const ideal M, const ring rRing)
char * getenv()
BOOLEAN spectrumProc(leftv result, leftv first)
Definition: ipshell.cc:3714
#define TRUE
Definition: auxiliary.h:144
int MivSame(intvec *u, intvec *v)
Definition: walk.cc:868
intvec * MivWeightOrderdp(intvec *ivstart)
Definition: walk.cc:1436
BOOLEAN spmulProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4051
void * value
Definition: fegetopt.h:93
const char * feSetOptValue(feOptIndex opt, char *optarg)
Definition: feOpt.cc:153
g
Definition: cfModGcd.cc:4031
void WerrorS(const char *s)
Definition: feFopen.cc:23
gmp_complex numbers based on
Definition: mpr_complex.h:178
char * StringEndS()
Definition: reporter.cc:151
bool complexNearZero(gmp_complex *c, int digits)
Definition: mpr_complex.cc:778
void lduDecomp(const matrix aMat, matrix &pMat, matrix &lMat, matrix &dMat, matrix &uMat, poly &l, poly &u, poly &lTimesU)
LU-decomposition of a given (m x n)-matrix with performing only those divisions that yield zero remai...
int Typ()
Definition: subexpr.cc:955
static bool rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
ideal Mfrwalk(ideal G, intvec *ivstart, intvec *ivtarget, int weight_rad)
Definition: walk.cc:6940
const char * Name()
Definition: subexpr.h:121
matrix evSwap(matrix M, int i, int j)
Definition: eigenval.cc:25
Definition: idrec.h:34
#define ivTest(v)
Definition: intvec.h:161
idhdl get(const char *s, int lev)
Definition: ipid.cc:90
intvec * MPertVectorslp(ideal G, intvec *ivtarget, int pdeg)
Definition: walk.cc:1279
void * data
Definition: subexpr.h:89
void printBlackboxTypes()
list all defined type (for debugging)
Definition: blackbox.cc:210
void feStringAppendBrowsers(int warn)
Definition: fehelp.cc:352
poly p_Shrink(poly p, int lV, const ring r)
Definition: shiftgb.cc:510
int myynest
Definition: febase.cc:46
#define M
Definition: sirandom.c:24
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
static int rBlocks(ring r)
Definition: ring.h:516
const ring r
Definition: syzextra.cc:208
ideal MAltwalk1(ideal Go, int op_deg, int tp_deg, intvec *curr_weight, intvec *target_weight)
Definition: walk.cc:8446
#define FLAG_TWOSTD
Definition: ipid.h:109
Definition: intvec.h:16
int pcvDim(int d0, int d1)
Definition: pcv.cc:361
ideal Mprwalk(ideal Go, intvec *curr_weight, intvec *target_weight, int weight_rad, int op_deg, int tp_deg, ring baseRing)
Definition: walk.cc:8246
void newstructShow(newstruct_desc d)
Definition: newstruct.cc:829
void StringSetS(const char *st)
Definition: reporter.cc:128
static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
Definition: extra.cc:2218
int M3ivSame(intvec *temp, intvec *u, intvec *v)
Definition: walk.cc:889
ideal Mrwalk(ideal Go, intvec *orig_M, intvec *target_M, int weight_rad, int pert_deg, ring baseRing)
Definition: walk.cc:5341
poly pLPshift(poly p, int sh, int uptodeg, int lV)
Definition: shiftgb.cc:155
const char feNotImplemented[]
Definition: reporter.cc:54
struct fe_option feOptSpec[]
ideal Mpwalk(ideal Go, int op_deg, int tp_deg, intvec *curr_weight, intvec *target_weight, int nP)
Definition: walk.cc:5752
intvec * MwalkNextWeight(intvec *curr_weight, intvec *target_weight, ideal G)
ip_smatrix * matrix
intvec * MPertNextWeight(intvec *iva, ideal G, int deg)
idhdl currRingHdl
Definition: ipid.cc:64
#define setFlag(A, F)
Definition: ipid.h:112
int simpleipc_cmd(char *cmd, int id, int v)
Definition: semaphore.c:122
int m
Definition: cfEzgcd.cc:119
void fePrintOptValues()
Definition: feOpt.cc:321
poly pcvCV2P(poly cv, int d0, int d1)
Definition: pcv.cc:263
FILE * f
Definition: checklibs.c:7
int i
Definition: cfEzgcd.cc:123
intvec * Mivperttarget(ideal G, int ndeg)
BOOLEAN spectrumfProc(leftv result, leftv first)
Definition: ipshell.cc:3765
lists pcvLAddL(lists l1, lists l2)
Definition: pcv.cc:31
#define pOne()
Definition: polys.h:286
int pcvBasis(lists b, int i, poly m, int d, int n)
Definition: pcv.cc:391
Definition: tok.h:88
intvec * MPertVectors(ideal G, intvec *ivtarget, int pdeg)
Definition: walk.cc:1061
ideal freegb(ideal I, int uptodeg, int lVblock)
Definition: kstd2.cc:3406
static FORCE_INLINE n_coeffType getCoeffType(const coeffs r)
Returns the type of coeffs domain.
Definition: coeffs.h:422
#define FLAG_STD
Definition: ipid.h:108
leftv next
Definition: subexpr.h:87
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:494
intvec * Mivdp(int nR)
Definition: walk.cc:980
#define BIMATELEM(M, I, J)
Definition: bigintmat.h:117
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
int pLastVblock(poly p, int lV)
Definition: shiftgb.cc:223
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
matrix evHessenberg(matrix M)
Definition: eigenval.cc:100
int rows() const
Definition: bigintmat.h:129
int & cols()
Definition: matpol.h:25
Definition: tok.h:95
lists evEigenvals(matrix M)
Definition: eigenval_ip.cc:118
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:437
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
BOOLEAN semicProc(leftv res, leftv u, leftv v)
Definition: ipshell.cc:4132
int siSeed
Definition: sirandom.c:29
bool luSolveViaLDUDecomp(const matrix pMat, const matrix lMat, const matrix dMat, const matrix uMat, const poly l, const poly u, const poly lTimesU, const matrix bVec, matrix &xVec, matrix &H)
Solves the linear system A * x = b, where A is an (m x n)-matrix which is given by its LDU-decomposit...
ideal TranMImprovwalk(ideal G, intvec *curr_weight, intvec *target_tmp, int nP)
Definition: walk.cc:7071
#define pMult(p, q)
Definition: polys.h:178
int rows() const
Definition: intvec.h:88
BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
check a list of arguemys against a given field of types return TRUE if the types match return FALSE (...
Definition: ipshell.cc:6122
coeffs basecoeffs() const
Definition: bigintmat.h:130
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:491
#define IDRING(a)
Definition: ipid.h:126
int blackboxIsCmd(const char *n, int &tok)
used by scanner: returns ROOT_DECL for known types (and the type number in tok)
Definition: blackbox.cc:193
const CanonicalForm & w
Definition: facAbsFact.cc:55
#define pDelete(p_ptr)
Definition: polys.h:157
intvec * MivMatrixOrderdp(int nV)
Definition: walk.cc:1397
int rtyp
Definition: subexpr.h:92
#define TEST_FOR(A)
void * Data()
Definition: subexpr.cc:1097
ideal MAltwalk2(ideal Go, intvec *curr_weight, intvec *target_weight)
Definition: walk.cc:4077
poly pcvP2CV(poly p, int d0, int d1)
Definition: pcv.cc:246
Definition: tok.h:96
omBin slists_bin
Definition: lists.cc:23
BOOLEAN spaddProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4009
intvec * MivUnit(int nV)
Definition: walk.cc:1476
ideal singclap_absFactorize(poly f, ideal &mipos, intvec **exps, int &numFactors, const ring r)
Definition: clapsing.cc:1762
#define pPower(p, q)
Definition: polys.h:175
BOOLEAN newstruct_set_proc(const char *bbname, const char *func, int args, procinfov pr)
Definition: newstruct.cc:849
size_t gmp_output_digits
Definition: mpr_complex.cc:44
END_NAMESPACE const void * p2
Definition: syzextra.cc:202
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:456
lists gmsNF(ideal p, ideal g, matrix B, int D, int K)
Definition: gms.cc:22
ideal Mwalk(ideal Go, intvec *orig_M, intvec *target_M, ring baseRing)
Definition: walk.cc:5067
feOptIndex feGetOptIndex(const char *name)
Definition: feOpt.cc:104
void countedref_reference_load()
Initialize blackbox types 'reference' and 'shared', or both.
Definition: countedref.cc:700
static jList * T
Definition: janet.cc:37
polyrec * poly
Definition: hilb.h:10
#define IDDATA(a)
Definition: ipid.h:125
ideal MwalkInitialForm(ideal G, intvec *ivw)
Definition: walk.cc:736
static Poly * h
Definition: janet.cc:978
#define IMATELEM(M, I, J)
Definition: intvec.h:77
#define NONE
Definition: tok.h:170
void feReInitResources()
Definition: feResource.cc:201
void Werror(const char *fmt,...)
Definition: reporter.cc:199
intvec * MivMatrixOrderlp(int nV)
Definition: walk.cc:1381
void * CopyD(int t)
Definition: subexpr.cc:662
int pcvMinDeg(poly p)
Definition: pcv.cc:108
void countedref_shared_load()
Definition: countedref.cc:724
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:94
intvec * Mivlp(int nR)
Definition: walk.cc:995
procinfo * procinfov
Definition: structs.h:63
#define pCopy(p)
return a copy of the poly
Definition: polys.h:156
blackbox * getBlackboxStuff(const int t)
return the structure to the type given by t
Definition: blackbox.cc:20
intvec * MkInterRedNextWeight(intvec *iva, intvec *ivb, ideal G)
Definition: walk.cc:2248
ideal twostd(ideal I)
Compute two-sided GB:
Definition: nc.cc:22
#define omStrDup(s)
Definition: omAllocDecl.h:263
poly longCoeffsToSingularPoly ( unsigned long *  polyCoeffs,
const int  degree 
)

Definition at line 222 of file extra.cc.

223 {
224  poly result = NULL;
225  for (int i = 0; i <= degree; i++)
226  {
227  if ((int)polyCoeffs[i] != 0)
228  {
229  poly term = p_ISet((int)polyCoeffs[i], currRing);
230  if (i > 0)
231  {
232  p_SetExp(term, 1, i, currRing);
233  p_Setm(term, currRing);
234  }
235  result = p_Add_q(result, term, currRing);
236  }
237  }
238  return result;
239 }
Definition: int_poly.h:36
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int i
Definition: cfEzgcd.cc:123
static unsigned long p_SetExp(poly p, const unsigned long e, const unsigned long iBitmask, const int VarOffset)
set a single variable exponent : VarOffset encodes the position in p->exp
Definition: p_polys.h:484
#define NULL
Definition: omList.c:10
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:436
int degree(const CanonicalForm &f)
polyrec * poly
Definition: hilb.h:10
static poly p_Add_q(poly p, poly q, const ring r)
Definition: p_polys.h:884
poly p_ISet(long i, const ring r)
returns the poly representing the integer i
Definition: p_polys.cc:1302
return result
Definition: facAbsBiFact.cc:76
unsigned long** singularMatrixToLongMatrix ( matrix  singularMatrix)

Definition at line 190 of file extra.cc.

191 {
192  int n = singularMatrix->rows();
193  assume(n == singularMatrix->cols());
194  unsigned long **longMatrix = 0;
195  longMatrix = new unsigned long *[n] ;
196  for (int i = 0 ; i < n; i++)
197  longMatrix[i] = new unsigned long [n];
198  number entry;
199  for (int r = 0; r < n; r++)
200  for (int c = 0; c < n; c++)
201  {
202  poly p=MATELEM(singularMatrix, r + 1, c + 1);
203  int entryAsInt;
204  if (p!=NULL)
205  {
206  entry = p_GetCoeff(p, currRing);
207  entryAsInt = n_Int(entry, currRing->cf);
208  if (entryAsInt < 0) entryAsInt += n_GetChar(currRing->cf);
209  }
210  else
211  entryAsInt=0;
212  longMatrix[r][c] = (unsigned long)entryAsInt;
213  }
214  return longMatrix;
215 }
int & rows()
Definition: matpol.h:24
return P p
Definition: myNF.cc:203
const CanonicalForm CFMap CFMap int &both_non_zero int n
Definition: cfEzgcd.cc:52
static FORCE_INLINE int n_GetChar(const coeffs r)
Return the characteristic of the coeff. domain.
Definition: coeffs.h:445
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
const ring r
Definition: syzextra.cc:208
static FORCE_INLINE long n_Int(number &n, const coeffs r)
conversion of n to an int; 0 if not possible in Z/pZ: the representing int lying in (-p/2 ...
Definition: coeffs.h:548
#define assume(x)
Definition: mod2.h:405
int i
Definition: cfEzgcd.cc:123
int & cols()
Definition: matpol.h:25
#define NULL
Definition: omList.c:10
#define p_GetCoeff(p, r)
Definition: monomials.h:57
polyrec * poly
Definition: hilb.h:10
#define MATELEM(mat, i, j)
Definition: matpol.h:29