My Project
Macros | Functions
extra.cc File Reference
#include "kernel/mod2.h"
#include "misc/sirandom.h"
#include "resources/omFindExec.h"
#include "factory/factory.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 "resources/feResource.h"
#include "polys/monomials/ring.h"
#include "kernel/polys.h"
#include "polys/monomials/maps.h"
#include "polys/matpol.h"
#include "polys/weight.h"
#include "polys/shiftop.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/kverify.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 "links/ssiLink.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/fglm.h"
#include "hc_newton.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 SINGULAR_PROCS_DIR   "/libexec/singular/MOD"
 
#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

◆ HAVE_EXTENDED_SYSTEM

#define HAVE_EXTENDED_SYSTEM   1

Definition at line 141 of file extra.cc.

◆ HAVE_SHEAFCOH_TRICKS

#define HAVE_SHEAFCOH_TRICKS   1

◆ HAVE_WALK

#define HAVE_WALK   1

Definition at line 11 of file extra.cc.

◆ SINGULAR_PROCS_DIR

#define SINGULAR_PROCS_DIR   "/libexec/singular/MOD"

◆ TEST_FOR

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

Function Documentation

◆ jjEXTENDED_SYSTEM()

static BOOLEAN jjEXTENDED_SYSTEM ( leftv  res,
leftv  h 
)
static

Definition at line 2377 of file extra.cc.

2378 {
2379  if(h->Typ() == STRING_CMD)
2380  {
2381  char *sys_cmd=(char *)(h->Data());
2382  h=h->next;
2383  /*==================== test syz strat =================*/
2384  if (strcmp(sys_cmd, "syz") == 0)
2385  {
2386  if ((h!=NULL) && (h->Typ()==STRING_CMD))
2387  {
2388  const char *s=(const char *)h->Data();
2389  if (strcmp(s,"posInT_EcartFDegpLength")==0)
2391  else if (strcmp(s,"posInT_FDegpLength")==0)
2393  else if (strcmp(s,"posInT_pLength")==0)
2395  else if (strcmp(s,"posInT0")==0)
2397  else if (strcmp(s,"posInT1")==0)
2399  else if (strcmp(s,"posInT2")==0)
2401  else if (strcmp(s,"posInT11")==0)
2403  else if (strcmp(s,"posInT110")==0)
2405  else if (strcmp(s,"posInT13")==0)
2407  else if (strcmp(s,"posInT15")==0)
2409  else if (strcmp(s,"posInT17")==0)
2411  else if (strcmp(s,"posInT17_c")==0)
2413  else if (strcmp(s,"posInT19")==0)
2415  else PrintS("valid posInT:0,1,2,11,110,13,15,17,17_c,19,_EcartFDegpLength,_FDegpLength,_pLength,_EcartpLength\n");
2416  }
2417  else
2418  {
2419  test_PosInT=NULL;
2420  test_PosInL=NULL;
2421  }
2422  si_opt_2|=Sy_bit(23);
2423  return FALSE;
2424  }
2425  else
2426  /*==================== locNF ======================================*/
2427  if(strcmp(sys_cmd,"locNF")==0)
2428  {
2429  const short t[]={4,VECTOR_CMD,MODUL_CMD,INT_CMD,INTVEC_CMD};
2430  if (iiCheckTypes(h,t,1))
2431  {
2432  poly f=(poly)h->Data();
2433  h=h->next;
2434  ideal m=(ideal)h->Data();
2435  assumeStdFlag(h);
2436  h=h->next;
2437  int n=(int)((long)h->Data());
2438  h=h->next;
2439  intvec *v=(intvec *)h->Data();
2440 
2441  /* == now the work starts == */
2442 
2443  int * iv=iv2array(v, currRing);
2444  poly r=0;
2445  poly hp=ppJetW(f,n,iv);
2446  int s=MATCOLS(m);
2447  int j=0;
2448  matrix T=mp_InitI(s,1,0, currRing);
2449 
2450  while (hp != NULL)
2451  {
2452  if (pDivisibleBy(m->m[j],hp))
2453  {
2454  if (MATELEM(T,j+1,1)==0)
2455  {
2456  MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
2457  }
2458  else
2459  {
2460  pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
2461  }
2462  hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
2463  j=0;
2464  }
2465  else
2466  {
2467  if (j==s-1)
2468  {
2469  r=pAdd(r,pHead(hp));
2470  hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
2471  j=0;
2472  }
2473  else
2474  {
2475  j++;
2476  }
2477  }
2478  }
2479 
2482  for (int k=1;k<=MATROWS(Temp);k++)
2483  {
2484  MATELEM(R,k,1)=MATELEM(Temp,k,1);
2485  }
2486 
2488  L->Init(2);
2489  L->m[0].rtyp=MATRIX_CMD; L->m[0].data=(void *)R;
2490  L->m[1].rtyp=MATRIX_CMD; L->m[1].data=(void *)T;
2491  res->data=L;
2492  res->rtyp=LIST_CMD;
2493  // iv aufraeumen
2494  omFree(iv);
2495  return FALSE;
2496  }
2497  else
2498  return TRUE;
2499  }
2500  else
2501  /*==================== poly debug ==================================*/
2502  if(strcmp(sys_cmd,"p")==0)
2503  {
2504 # ifdef RDEBUG
2505  p_DebugPrint((poly)h->Data(), currRing);
2506 # else
2507  WarnS("Sorry: not available for release build!");
2508 # endif
2509  return FALSE;
2510  }
2511  else
2512  /*==================== setsyzcomp ==================================*/
2513  if(strcmp(sys_cmd,"setsyzcomp")==0)
2514  {
2515  if ((h!=NULL) && (h->Typ()==INT_CMD))
2516  {
2517  int k = (int)(long)h->Data();
2518  if ( currRing->order[0] == ringorder_s )
2519  {
2521  }
2522  }
2523  }
2524  /*==================== ring debug ==================================*/
2525  if(strcmp(sys_cmd,"r")==0)
2526  {
2527 # ifdef RDEBUG
2528  rDebugPrint((ring)h->Data());
2529 # else
2530  WarnS("Sorry: not available for release build!");
2531 # endif
2532  return FALSE;
2533  }
2534  else
2535  /*==================== changeRing ========================*/
2536  /* The following code changes the names of the variables in the
2537  current ring to "x1", "x2", ..., "xN", where N is the number
2538  of variables in the current ring.
2539  The purpose of this rewriting is to eliminate indexed variables,
2540  as they may cause problems when generating scripts for Magma,
2541  Maple, or Macaulay2. */
2542  if(strcmp(sys_cmd,"changeRing")==0)
2543  {
2544  int varN = currRing->N;
2545  char h[10];
2546  for (int i = 1; i <= varN; i++)
2547  {
2548  omFree(currRing->names[i - 1]);
2549  sprintf(h, "x%d", i);
2550  currRing->names[i - 1] = omStrDup(h);
2551  }
2553  res->rtyp = INT_CMD;
2554  res->data = (void*)0L;
2555  return FALSE;
2556  }
2557  else
2558  /*==================== mtrack ==================================*/
2559  if(strcmp(sys_cmd,"mtrack")==0)
2560  {
2561  #ifdef OM_TRACK
2562  om_Opts.MarkAsStatic = 1;
2563  FILE *fd = NULL;
2564  int max = 5;
2565  while (h != NULL)
2566  {
2568  if (fd == NULL && h->Typ()==STRING_CMD)
2569  {
2570  char *fn=(char*) h->Data();
2571  fd = fopen(fn, "w");
2572  if (fd == NULL)
2573  Warn("Can not open %s for writing og mtrack. Using stdout",fn);
2574  }
2575  else if (h->Typ() == INT_CMD)
2576  {
2577  max = (int)(long)h->Data();
2578  }
2579  h = h->Next();
2580  }
2581  omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2582  if (fd != NULL) fclose(fd);
2583  om_Opts.MarkAsStatic = 0;
2584  return FALSE;
2585  #else
2586  WerrorS("system(\"mtrack\",..) is not implemented in this version");
2587  return TRUE;
2588  #endif
2589  }
2590  else
2591  /*==================== backtrace ==================================*/
2592  #ifndef OM_NDEBUG
2593  if(strcmp(sys_cmd,"backtrace")==0)
2594  {
2595  omPrintCurrentBackTrace(stdout);
2596  return FALSE;
2597  }
2598  else
2599  #endif
2600 
2601 #if !defined(OM_NDEBUG)
2602  /*==================== omMemoryTest ==================================*/
2603  if (strcmp(sys_cmd,"omMemoryTest")==0)
2604  {
2605 
2606 #ifdef OM_STATS_H
2607  PrintS("\n[om_Info]: \n");
2608  omUpdateInfo();
2609 #define OM_PRINT(name) Print(" %-22s : %10ld \n", #name, om_Info . name)
2610  OM_PRINT(MaxBytesSystem);
2611  OM_PRINT(CurrentBytesSystem);
2612  OM_PRINT(MaxBytesSbrk);
2613  OM_PRINT(CurrentBytesSbrk);
2614  OM_PRINT(MaxBytesMmap);
2615  OM_PRINT(CurrentBytesMmap);
2616  OM_PRINT(UsedBytes);
2617  OM_PRINT(AvailBytes);
2618  OM_PRINT(UsedBytesMalloc);
2619  OM_PRINT(AvailBytesMalloc);
2620  OM_PRINT(MaxBytesFromMalloc);
2621  OM_PRINT(CurrentBytesFromMalloc);
2622  OM_PRINT(MaxBytesFromValloc);
2623  OM_PRINT(CurrentBytesFromValloc);
2624  OM_PRINT(UsedBytesFromValloc);
2625  OM_PRINT(AvailBytesFromValloc);
2626  OM_PRINT(MaxPages);
2627  OM_PRINT(UsedPages);
2628  OM_PRINT(AvailPages);
2629  OM_PRINT(MaxRegionsAlloc);
2630  OM_PRINT(CurrentRegionsAlloc);
2631 #undef OM_PRINT
2632 #endif
2633 
2634 #ifdef OM_OPTS_H
2635  PrintS("\n[om_Opts]: \n");
2636 #define OM_PRINT(format, name) Print(" %-22s : %10" format"\n", #name, om_Opts . name)
2637  OM_PRINT("d", MinTrack);
2638  OM_PRINT("d", MinCheck);
2639  OM_PRINT("d", MaxTrack);
2640  OM_PRINT("d", MaxCheck);
2641  OM_PRINT("d", Keep);
2642  OM_PRINT("d", HowToReportErrors);
2643  OM_PRINT("d", MarkAsStatic);
2644  OM_PRINT("u", PagesPerRegion);
2645  OM_PRINT("p", OutOfMemoryFunc);
2646  OM_PRINT("p", MemoryLowFunc);
2647  OM_PRINT("p", ErrorHook);
2648 #undef OM_PRINT
2649 #endif
2650 
2651 #ifdef OM_ERROR_H
2652  Print("\n\n[om_ErrorStatus] : '%s' (%s)\n",
2655  Print("[om_InternalErrorStatus]: '%s' (%s)\n",
2658 
2659 #endif
2660 
2661 // omTestMemory(1);
2662 // omtTestErrors();
2663  return FALSE;
2664  }
2665  else
2666 #endif
2667  /*==================== pDivStat =============================*/
2668  #if defined(PDEBUG) || defined(PDIV_DEBUG)
2669  if(strcmp(sys_cmd,"pDivStat")==0)
2670  {
2671  extern void pPrintDivisbleByStat();
2673  return FALSE;
2674  }
2675  else
2676  #endif
2677  /*==================== red =============================*/
2678  #if 0
2679  if(strcmp(sys_cmd,"red")==0)
2680  {
2681  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2682  {
2683  res->rtyp=IDEAL_CMD;
2684  res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2685  setFlag(res,FLAG_STD);
2686  return FALSE;
2687  }
2688  else
2689  WerrorS("ideal expected");
2690  }
2691  else
2692  #endif
2693  /*==================== fastcomb =============================*/
2694  if(strcmp(sys_cmd,"fastcomb")==0)
2695  {
2696  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2697  {
2698  if (h->next!=NULL)
2699  {
2700  if (h->next->Typ()!=POLY_CMD)
2701  {
2702  WarnS("Wrong types for poly= comb(ideal,poly)");
2703  }
2704  }
2705  res->rtyp=POLY_CMD;
2706  res->data=(void *) fglmLinearCombination(
2707  (ideal)h->Data(),(poly)h->next->Data());
2708  return FALSE;
2709  }
2710  else
2711  WerrorS("ideal expected");
2712  }
2713  else
2714  /*==================== comb =============================*/
2715  if(strcmp(sys_cmd,"comb")==0)
2716  {
2717  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2718  {
2719  if (h->next!=NULL)
2720  {
2721  if (h->next->Typ()!=POLY_CMD)
2722  {
2723  WarnS("Wrong types for poly= comb(ideal,poly)");
2724  }
2725  }
2726  res->rtyp=POLY_CMD;
2727  res->data=(void *)fglmNewLinearCombination(
2728  (ideal)h->Data(),(poly)h->next->Data());
2729  return FALSE;
2730  }
2731  else
2732  WerrorS("ideal expected");
2733  }
2734  else
2735  #if 0 /* debug only */
2736  /*==================== listall ===================================*/
2737  if(strcmp(sys_cmd,"listall")==0)
2738  {
2739  void listall(int showproc);
2740  int showproc=0;
2741  if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2742  listall(showproc);
2743  return FALSE;
2744  }
2745  else
2746  #endif
2747  #if 0 /* debug only */
2748  /*==================== proclist =================================*/
2749  if(strcmp(sys_cmd,"proclist")==0)
2750  {
2751  void piShowProcList();
2752  piShowProcList();
2753  return FALSE;
2754  }
2755  else
2756  #endif
2757  /* ==================== newton ================================*/
2758  #ifdef HAVE_NEWTON
2759  if(strcmp(sys_cmd,"newton")==0)
2760  {
2761  if ((h->Typ()!=POLY_CMD)
2762  || (h->next->Typ()!=INT_CMD)
2763  || (h->next->next->Typ()!=INT_CMD))
2764  {
2765  WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2766  return TRUE;
2767  }
2768  poly p=(poly)(h->Data());
2769  int l=pLength(p);
2770  short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
2771  int i,j,k;
2772  k=0;
2773  poly pp=p;
2774  for (i=0;pp!=NULL;i++)
2775  {
2776  for(j=1;j<=currRing->N;j++)
2777  {
2778  points[k]=pGetExp(pp,j);
2779  k++;
2780  }
2781  pIter(pp);
2782  }
2783  hc_ERG r=hc_KOENIG(currRing->N, // dimension
2784  l, // number of points
2785  (short*) points, // points: x_1, y_1,z_1, x_2,y_2,z2,...
2786  currRing->OrdSgn==-1,
2787  (int) (h->next->Data()), // 1: Milnor, 0: Newton
2788  (int) (h->next->next->Data()) // debug
2789  );
2790  //----<>---Output-----------------------
2791 
2792 
2793  // PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2794 
2795 
2797  L->Init(6);
2798  L->m[0].rtyp=STRING_CMD; // newtonnumber;
2799  L->m[0].data=(void *)omStrDup(r.nZahl);
2800  L->m[1].rtyp=INT_CMD;
2801  L->m[1].data=(void *)(long)r.achse; // flag for unoccupied axes
2802  L->m[2].rtyp=INT_CMD;
2803  L->m[2].data=(void *)(long)r.deg; // #degenerations
2804  if ( r.deg != 0) // only if degenerations exist
2805  {
2806  L->m[3].rtyp=INT_CMD;
2807  L->m[3].data=(void *)(long)r.anz_punkte; // #points
2808  //---<>--number of points------
2809  int anz = r.anz_punkte; // number of points
2810  int dim = (currRing->N); // dimension
2811  intvec* v = new intvec( anz*dim );
2812  for (i=0; i<anz*dim; i++) // copy points
2813  (*v)[i] = r.pu[i];
2814  L->m[4].rtyp=INTVEC_CMD;
2815  L->m[4].data=(void *)v;
2816  //---<>--degenerations---------
2817  int deg = r.deg; // number of points
2818  intvec* w = new intvec( r.speicher ); // necessary memory
2819  i=0; // start copying
2820  do
2821  {
2822  (*w)[i] = r.deg_tab[i];
2823  i++;
2824  }
2825  while (r.deg_tab[i-1] != -2); // mark for end of list
2826  L->m[5].rtyp=INTVEC_CMD;
2827  L->m[5].data=(void *)w;
2828  }
2829  else
2830  {
2831  L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2832  L->m[4].rtyp=DEF_CMD;
2833  L->m[5].rtyp=DEF_CMD;
2834  }
2835 
2836  res->data=(void *)L;
2837  res->rtyp=LIST_CMD;
2838  // free all pointer in r:
2839  delete[] r.nZahl;
2840  delete[] r.pu;
2841  delete[] r.deg_tab; // Ist das ein Problem??
2842 
2843  omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
2844  return FALSE;
2845  }
2846  else
2847  #endif
2848  /*==== connection to Sebastian Jambor's code ======*/
2849  /* This code connects Sebastian Jambor's code for
2850  computing the minimal polynomial of an (n x n) matrix
2851  with entries in F_p to SINGULAR. Two conversion methods
2852  are needed; see further up in this file:
2853  (1) conversion of a matrix with long entries to
2854  a SINGULAR matrix with number entries, where
2855  the numbers are coefficients in currRing;
2856  (2) conversion of an array of longs (encoding the
2857  coefficients of the minimal polynomial) to a
2858  SINGULAR poly living in currRing. */
2859  if (strcmp(sys_cmd, "minpoly") == 0)
2860  {
2861  if ((h == NULL) || (h->Typ() != MATRIX_CMD) || h->next != NULL)
2862  {
2863  Werror("expected exactly one argument: %s",
2864  "a square matrix with number entries");
2865  return TRUE;
2866  }
2867  else
2868  {
2869  matrix m = (matrix)h->Data();
2870  int n = m->rows();
2871  unsigned long p = (unsigned long)n_GetChar(currRing->cf);
2872  if (n != m->cols())
2873  {
2874  WerrorS("expected exactly one argument: "
2875  "a square matrix with number entries");
2876  return TRUE;
2877  }
2878  unsigned long** ml = singularMatrixToLongMatrix(m);
2879  unsigned long* polyCoeffs = computeMinimalPolynomial(ml, n, p);
2880  poly theMinPoly = longCoeffsToSingularPoly(polyCoeffs, n);
2881  res->rtyp = POLY_CMD;
2882  res->data = (void *)theMinPoly;
2883  for (int i = 0; i < n; i++) delete[] ml[i];
2884  delete[] ml;
2885  delete[] polyCoeffs;
2886  return FALSE;
2887  }
2888  }
2889  else
2890  /*==================== sdb_flags =================*/
2891  #ifdef HAVE_SDB
2892  if (strcmp(sys_cmd, "sdb_flags") == 0)
2893  {
2894  if ((h!=NULL) && (h->Typ()==INT_CMD))
2895  {
2896  sdb_flags=(int)((long)h->Data());
2897  }
2898  else
2899  {
2900  WerrorS("system(\"sdb_flags\",`int`) expected");
2901  return TRUE;
2902  }
2903  return FALSE;
2904  }
2905  else
2906  #endif
2907  /*==================== sdb_edit =================*/
2908  #ifdef HAVE_SDB
2909  if (strcmp(sys_cmd, "sdb_edit") == 0)
2910  {
2911  if ((h!=NULL) && (h->Typ()==PROC_CMD))
2912  {
2913  procinfov p=(procinfov)h->Data();
2914  sdb_edit(p);
2915  }
2916  else
2917  {
2918  WerrorS("system(\"sdb_edit\",`proc`) expected");
2919  return TRUE;
2920  }
2921  return FALSE;
2922  }
2923  else
2924  #endif
2925  /*==================== GF =================*/
2926  #if 0 // for testing only
2927  if (strcmp(sys_cmd, "GF") == 0)
2928  {
2929  if ((h!=NULL) && (h->Typ()==POLY_CMD))
2930  {
2931  int c=rChar(currRing);
2932  setCharacteristic( c,nfMinPoly[0], currRing->parameter[0][0] );
2933  CanonicalForm F( convSingGFFactoryGF( (poly)h->Data(), currRing ) );
2934  res->rtyp=POLY_CMD;
2935  res->data=convFactoryGFSingGF( F, currRing );
2936  return FALSE;
2937  }
2938  else { WerrorS("wrong typ"); return TRUE;}
2939  }
2940  else
2941  #endif
2942  /*==================== SVD =================*/
2943  #ifdef HAVE_SVD
2944  if (strcmp(sys_cmd, "svd") == 0)
2945  {
2946  extern lists testsvd(matrix M);
2947  res->rtyp=LIST_CMD;
2948  res->data=(char*)(testsvd((matrix)h->Data()));
2949  return FALSE;
2950  }
2951  else
2952  #endif
2953  /*==================== redNF_ring =================*/
2954  #ifdef HAVE_RINGS
2955  if (strcmp(sys_cmd, "redNF_ring")==0)
2956  {
2957  ring r = currRing;
2958  poly f = (poly) h->Data();
2959  h = h->next;
2960  ideal G = (ideal) h->Data();
2961  res->rtyp=POLY_CMD;
2962  res->data=(poly) ringRedNF(f, G, r);
2963  return(FALSE);
2964  }
2965  else
2966  #endif
2967  /*==================== Roune Hilb =================*/
2968  if (strcmp(sys_cmd, "hilbroune") == 0)
2969  {
2970  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2971  {
2972  slicehilb((ideal)h->Data());
2973  }
2974  else return TRUE;
2975  return FALSE;
2976  }
2977  else
2978  /*==================== F5 Implementation =================*/
2979  #ifdef HAVE_F5
2980  if (strcmp(sys_cmd, "f5")==0)
2981  {
2982  if (h->Typ()!=IDEAL_CMD)
2983  {
2984  WerrorS("ideal expected");
2985  return TRUE;
2986  }
2987 
2988  ring r = currRing;
2989  ideal G = (ideal) h->Data();
2990  h = h->next;
2991  int opt;
2992  if(h != NULL) {
2993  opt = (int) (long) h->Data();
2994  }
2995  else {
2996  opt = 2;
2997  }
2998  h = h->next;
2999  int plus;
3000  if(h != NULL) {
3001  plus = (int) (long) h->Data();
3002  }
3003  else {
3004  plus = 0;
3005  }
3006  h = h->next;
3007  int termination;
3008  if(h != NULL) {
3009  termination = (int) (long) h->Data();
3010  }
3011  else {
3012  termination = 0;
3013  }
3014  res->rtyp=IDEAL_CMD;
3015  res->data=(ideal) F5main(G,r,opt,plus,termination);
3016  return FALSE;
3017  }
3018  else
3019  #endif
3020  /*==================== Testing groebner basis =================*/
3021  #ifdef HAVE_RINGS
3022  if (strcmp(sys_cmd, "NF_ring")==0)
3023  {
3024  ring r = currRing;
3025  poly f = (poly) h->Data();
3026  h = h->next;
3027  ideal G = (ideal) h->Data();
3028  res->rtyp=POLY_CMD;
3029  res->data=(poly) ringNF(f, G, r);
3030  return(FALSE);
3031  }
3032  else
3033  if (strcmp(sys_cmd, "spoly")==0)
3034  {
3035  poly f = pCopy((poly) h->Data());
3036  h = h->next;
3037  poly g = pCopy((poly) h->Data());
3038 
3039  res->rtyp=POLY_CMD;
3040  res->data=(poly) plain_spoly(f,g);
3041  return(FALSE);
3042  }
3043  else
3044  if (strcmp(sys_cmd, "testGB")==0)
3045  {
3046  ideal I = (ideal) h->Data();
3047  h = h->next;
3048  ideal GI = (ideal) h->Data();
3049  res->rtyp = INT_CMD;
3050  res->data = (void *)(long) testGB(I, GI);
3051  return(FALSE);
3052  }
3053  else
3054  #endif
3055  /*==================== sca:AltVar ==================================*/
3056  #ifdef HAVE_PLURAL
3057  if ( (strcmp(sys_cmd, "AltVarStart") == 0) || (strcmp(sys_cmd, "AltVarEnd") == 0) )
3058  {
3059  ring r = currRing;
3060 
3061  if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
3062  {
3063  WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
3064  return TRUE;
3065  }
3066 
3067  res->rtyp=INT_CMD;
3068 
3069  if (rIsSCA(r))
3070  {
3071  if(strcmp(sys_cmd, "AltVarStart") == 0)
3072  res->data = (void*)(long)scaFirstAltVar(r);
3073  else
3074  res->data = (void*)(long)scaLastAltVar(r);
3075  return FALSE;
3076  }
3077 
3078  WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
3079  return TRUE;
3080  }
3081  else
3082  #endif
3083  /*==================== RatNF, noncomm rational coeffs =================*/
3084  #ifdef HAVE_RATGRING
3085  if (strcmp(sys_cmd, "intratNF") == 0)
3086  {
3087  poly p;
3088  poly *q;
3089  ideal I;
3090  int is, k, id;
3091  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3092  {
3093  p=(poly)h->CopyD();
3094  h=h->next;
3095  // PrintS("poly is done\n");
3096  }
3097  else return TRUE;
3098  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3099  {
3100  I=(ideal)h->CopyD();
3101  q = I->m;
3102  h=h->next;
3103  // PrintS("ideal is done\n");
3104  }
3105  else return TRUE;
3106  if ((h!=NULL) && (h->Typ()==INT_CMD))
3107  {
3108  is=(int)((long)(h->Data()));
3109  // res->rtyp=INT_CMD;
3110  // PrintS("int is done\n");
3111  // res->rtyp=IDEAL_CMD;
3112  if (rIsPluralRing(currRing))
3113  {
3114  id = IDELEMS(I);
3115  int *pl=(int*)omAlloc0(IDELEMS(I)*sizeof(int));
3116  for(k=0; k < id; k++)
3117  {
3118  pl[k] = pLength(I->m[k]);
3119  }
3120  PrintS("starting redRat\n");
3121  //res->data = (char *)
3122  redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
3123  res->data=p;
3124  res->rtyp=POLY_CMD;
3125  // res->data = ncGCD(p,q,currRing);
3126  }
3127  else
3128  {
3129  res->rtyp=POLY_CMD;
3130  res->data=p;
3131  }
3132  }
3133  else return TRUE;
3134  return FALSE;
3135  }
3136  else
3137  /*==================== RatNF, noncomm rational coeffs =================*/
3138  if (strcmp(sys_cmd, "ratNF") == 0)
3139  {
3140  poly p,q;
3141  int is, htype;
3142  if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3143  {
3144  p=(poly)h->CopyD();
3145  h=h->next;
3146  htype = h->Typ();
3147  }
3148  else return TRUE;
3149  if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3150  {
3151  q=(poly)h->CopyD();
3152  h=h->next;
3153  }
3154  else return TRUE;
3155  if ((h!=NULL) && (h->Typ()==INT_CMD))
3156  {
3157  is=(int)((long)(h->Data()));
3158  res->rtyp=htype;
3159  // res->rtyp=IDEAL_CMD;
3160  if (rIsPluralRing(currRing))
3161  {
3162  res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
3163  // res->data = ncGCD(p,q,currRing);
3164  }
3165  else res->data=p;
3166  }
3167  else return TRUE;
3168  return FALSE;
3169  }
3170  else
3171  /*==================== RatSpoly, noncomm rational coeffs =================*/
3172  if (strcmp(sys_cmd, "ratSpoly") == 0)
3173  {
3174  poly p,q;
3175  int is;
3176  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3177  {
3178  p=(poly)h->CopyD();
3179  h=h->next;
3180  }
3181  else return TRUE;
3182  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3183  {
3184  q=(poly)h->CopyD();
3185  h=h->next;
3186  }
3187  else return TRUE;
3188  if ((h!=NULL) && (h->Typ()==INT_CMD))
3189  {
3190  is=(int)((long)(h->Data()));
3191  res->rtyp=POLY_CMD;
3192  // res->rtyp=IDEAL_CMD;
3193  if (rIsPluralRing(currRing))
3194  {
3195  res->data = nc_rat_CreateSpoly(p,q,is,currRing);
3196  // res->data = ncGCD(p,q,currRing);
3197  }
3198  else res->data=p;
3199  }
3200  else return TRUE;
3201  return FALSE;
3202  }
3203  else
3204  #endif // HAVE_RATGRING
3205  /*==================== Rat def =================*/
3206  if (strcmp(sys_cmd, "ratVar") == 0)
3207  {
3208  int start,end;
3209  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3210  {
3211  start=pIsPurePower((poly)h->Data());
3212  h=h->next;
3213  }
3214  else return TRUE;
3215  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3216  {
3217  end=pIsPurePower((poly)h->Data());
3218  h=h->next;
3219  }
3220  else return TRUE;
3221  currRing->real_var_start=start;
3222  currRing->real_var_end=end;
3223  return (start==0)||(end==0)||(start>end);
3224  }
3225  else
3226  /*==================== t-rep-GB ==================================*/
3227  if (strcmp(sys_cmd, "unifastmult")==0)
3228  {
3229  poly f = (poly)h->Data();
3230  h=h->next;
3231  poly g=(poly)h->Data();
3232  res->rtyp=POLY_CMD;
3233  res->data=unifastmult(f,g,currRing);
3234  return(FALSE);
3235  }
3236  else
3237  if (strcmp(sys_cmd, "multifastmult")==0)
3238  {
3239  poly f = (poly)h->Data();
3240  h=h->next;
3241  poly g=(poly)h->Data();
3242  res->rtyp=POLY_CMD;
3243  res->data=multifastmult(f,g,currRing);
3244  return(FALSE);
3245  }
3246  else
3247  if (strcmp(sys_cmd, "mults")==0)
3248  {
3249  res->rtyp=INT_CMD ;
3250  res->data=(void*)(long) Mults();
3251  return(FALSE);
3252  }
3253  else
3254  if (strcmp(sys_cmd, "fastpower")==0)
3255  {
3256  ring r = currRing;
3257  poly f = (poly)h->Data();
3258  h=h->next;
3259  int n=(int)((long)h->Data());
3260  res->rtyp=POLY_CMD ;
3261  res->data=(void*) pFastPower(f,n,r);
3262  return(FALSE);
3263  }
3264  else
3265  if (strcmp(sys_cmd, "normalpower")==0)
3266  {
3267  poly f = (poly)h->Data();
3268  h=h->next;
3269  int n=(int)((long)h->Data());
3270  res->rtyp=POLY_CMD ;
3271  res->data=(void*) pPower(pCopy(f),n);
3272  return(FALSE);
3273  }
3274  else
3275  if (strcmp(sys_cmd, "MCpower")==0)
3276  {
3277  ring r = currRing;
3278  poly f = (poly)h->Data();
3279  h=h->next;
3280  int n=(int)((long)h->Data());
3281  res->rtyp=POLY_CMD ;
3282  res->data=(void*) pFastPowerMC(f,n,r);
3283  return(FALSE);
3284  }
3285  else
3286  if (strcmp(sys_cmd, "bit_subst")==0)
3287  {
3288  ring r = currRing;
3289  poly outer = (poly)h->Data();
3290  h=h->next;
3291  poly inner=(poly)h->Data();
3292  res->rtyp=POLY_CMD ;
3293  res->data=(void*) uni_subst_bits(outer, inner,r);
3294  return(FALSE);
3295  }
3296  else
3297  /*==================== gcd-varianten =================*/
3298  if (strcmp(sys_cmd, "gcd") == 0)
3299  {
3300  if (h==NULL)
3301  {
3302  #if 0
3303  Print("FLINT_P:%d (use Flints gcd for polynomials in char p)\n",isOn(SW_USE_FL_GCD_P));
3304  Print("FLINT_0:%d (use Flints gcd for polynomials in char 0)\n",isOn(SW_USE_FL_GCD_0));
3305  #endif
3306  Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3307  Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3308  Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3309  #ifndef __CYGWIN__
3310  Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3311  #endif
3312  return FALSE;
3313  }
3314  else
3315  if ((h!=NULL) && (h->Typ()==STRING_CMD)
3316  && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3317  {
3318  int d=(int)(long)h->next->Data();
3319  char *s=(char *)h->Data();
3320  #if 0
3321  if (strcmp(s,"FLINT_P")==0) { if (d) On(SW_USE_FL_GCD_P); else Off(SW_USE_FL_GCD_P); } else
3322  if (strcmp(s,"FLINT_0")==0) { if (d) On(SW_USE_FL_GCD_0); else Off(SW_USE_FL_GCD_0); } else
3323  #endif
3324  if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3325  if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3326  if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3327  #ifndef __CYGWIN__
3328  if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3329  #endif
3330  return TRUE;
3331  return FALSE;
3332  }
3333  else return TRUE;
3334  }
3335  else
3336  /*==================== subring =================*/
3337  if (strcmp(sys_cmd, "subring") == 0)
3338  {
3339  if (h!=NULL)
3340  {
3341  extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3342  res->data=(char *)rSubring(currRing,h);
3343  res->rtyp=RING_CMD;
3344  return res->data==NULL;
3345  }
3346  else return TRUE;
3347  }
3348  else
3349  /*==================== HNF =================*/
3350  #ifdef HAVE_NTL
3351  if (strcmp(sys_cmd, "HNF") == 0)
3352  {
3353  if (h!=NULL)
3354  {
3355  res->rtyp=h->Typ();
3356  if (h->Typ()==MATRIX_CMD)
3357  {
3358  res->data=(char *)singntl_HNF((matrix)h->Data(), currRing);
3359  return FALSE;
3360  }
3361  else if (h->Typ()==INTMAT_CMD)
3362  {
3363  res->data=(char *)singntl_HNF((intvec*)h->Data());
3364  return FALSE;
3365  }
3366  else if (h->Typ()==INTMAT_CMD)
3367  {
3368  res->data=(char *)singntl_HNF((intvec*)h->Data());
3369  return FALSE;
3370  }
3371  else
3372  {
3373  WerrorS("expected `system(\"HNF\",<matrix|intmat|bigintmat>)`");
3374  return TRUE;
3375  }
3376  }
3377  else return TRUE;
3378  }
3379  else
3380  /*================= probIrredTest ======================*/
3381  if (strcmp (sys_cmd, "probIrredTest") == 0)
3382  {
3383  if (h!=NULL && (h->Typ()== POLY_CMD) && ((h->next != NULL) && h->next->Typ() == STRING_CMD))
3384  {
3385  CanonicalForm F= convSingPFactoryP((poly)(h->Data()), currRing);
3386  char *s=(char *)h->next->Data();
3387  double error= atof (s);
3388  int irred= probIrredTest (F, error);
3389  res->rtyp= INT_CMD;
3390  res->data= (void*)(long)irred;
3391  return FALSE;
3392  }
3393  else return TRUE;
3394  }
3395  else
3396  #endif
3397  /*==================== mpz_t loader ======================*/
3398  if(strcmp(sys_cmd, "GNUmpLoad")==0)
3399  {
3400  if ((h != NULL) && (h->Typ() == STRING_CMD))
3401  {
3402  char* filename = (char*)h->Data();
3403  FILE* f = fopen(filename, "r");
3404  if (f == NULL)
3405  {
3406  WerrorS( "invalid file name (in paths use '/')");
3407  return FALSE;
3408  }
3409  mpz_t m; mpz_init(m);
3410  mpz_inp_str(m, f, 10);
3411  fclose(f);
3412  number n = n_InitMPZ(m, coeffs_BIGINT);
3413  res->rtyp = BIGINT_CMD;
3414  res->data = (void*)n;
3415  return FALSE;
3416  }
3417  else
3418  {
3419  WerrorS( "expected valid file name as a string");
3420  return TRUE;
3421  }
3422  }
3423  else
3424  /*==================== intvec matching ======================*/
3425  /* Given two non-empty intvecs, the call
3426  'system("intvecMatchingSegments", ivec, jvec);'
3427  computes all occurences of jvec in ivec, i.e., it returns
3428  a list of int indices k such that ivec[k..size(jvec)+k-1] = jvec.
3429  If no such k exists (e.g. when ivec is shorter than jvec), an
3430  intvec with the single entry 0 is being returned. */
3431  if(strcmp(sys_cmd, "intvecMatchingSegments")==0)
3432  {
3433  if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3434  (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3435  (h->next->next == NULL))
3436  {
3437  intvec* ivec = (intvec*)h->Data();
3438  intvec* jvec = (intvec*)h->next->Data();
3439  intvec* r = new intvec(1); (*r)[0] = 0;
3440  int validEntries = 0;
3441  for (int k = 0; k <= ivec->rows() - jvec->rows(); k++)
3442  {
3443  if (memcmp(&(*ivec)[k], &(*jvec)[0],
3444  sizeof(int) * jvec->rows()) == 0)
3445  {
3446  if (validEntries == 0)
3447  (*r)[0] = k + 1;
3448  else
3449  {
3450  r->resize(validEntries + 1);
3451  (*r)[validEntries] = k + 1;
3452  }
3453  validEntries++;
3454  }
3455  }
3456  res->rtyp = INTVEC_CMD;
3457  res->data = (void*)r;
3458  return FALSE;
3459  }
3460  else
3461  {
3462  WerrorS("expected two non-empty intvecs as arguments");
3463  return TRUE;
3464  }
3465  }
3466  else
3467  /* ================== intvecOverlap ======================= */
3468  /* Given two non-empty intvecs, the call
3469  'system("intvecOverlap", ivec, jvec);'
3470  computes the longest intvec kvec such that ivec ends with kvec
3471  and jvec starts with kvec. The length of this overlap is being
3472  returned. If there is no overlap at all, then 0 is being returned. */
3473  if(strcmp(sys_cmd, "intvecOverlap")==0)
3474  {
3475  if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3476  (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3477  (h->next->next == NULL))
3478  {
3479  intvec* ivec = (intvec*)h->Data();
3480  intvec* jvec = (intvec*)h->next->Data();
3481  int ir = ivec->rows(); int jr = jvec->rows();
3482  int r = jr; if (ir < jr) r = ir; /* r = min{ir, jr} */
3483  while ((r >= 1) && (memcmp(&(*ivec)[ir - r], &(*jvec)[0],
3484  sizeof(int) * r) != 0))
3485  r--;
3486  res->rtyp = INT_CMD;
3487  res->data = (void*)(long)r;
3488  return FALSE;
3489  }
3490  else
3491  {
3492  WerrorS("expected two non-empty intvecs as arguments");
3493  return TRUE;
3494  }
3495  }
3496  else
3497  /*==================== Hensel's lemma ======================*/
3498  if(strcmp(sys_cmd, "henselfactors")==0)
3499  {
3500  if ((h != NULL) && (h->Typ() == INT_CMD) &&
3501  (h->next != NULL) && (h->next->Typ() == INT_CMD) &&
3502  (h->next->next != NULL) && (h->next->next->Typ() == POLY_CMD) &&
3503  (h->next->next->next != NULL) &&
3504  (h->next->next->next->Typ() == POLY_CMD) &&
3505  (h->next->next->next->next != NULL) &&
3506  (h->next->next->next->next->Typ() == POLY_CMD) &&
3507  (h->next->next->next->next->next != NULL) &&
3508  (h->next->next->next->next->next->Typ() == INT_CMD) &&
3509  (h->next->next->next->next->next->next == NULL))
3510  {
3511  int xIndex = (int)(long)h->Data();
3512  int yIndex = (int)(long)h->next->Data();
3513  poly hh = (poly)h->next->next->Data();
3514  poly f0 = (poly)h->next->next->next->Data();
3515  poly g0 = (poly)h->next->next->next->next->Data();
3516  int d = (int)(long)h->next->next->next->next->next->Data();
3517  poly f; poly g;
3518  henselFactors(xIndex, yIndex, hh, f0, g0, d, f, g);
3520  L->Init(2);
3521  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
3522  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
3523  res->rtyp = LIST_CMD;
3524  res->data = (char *)L;
3525  return FALSE;
3526  }
3527  else
3528  {
3529  WerrorS( "expected argument list (int, int, poly, poly, poly, int)");
3530  return TRUE;
3531  }
3532  }
3533  else
3534  /*==================== Approx_Step =================*/
3535  #ifdef HAVE_PLURAL
3536  if (strcmp(sys_cmd, "astep") == 0)
3537  {
3538  ideal I;
3539  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3540  {
3541  I=(ideal)h->CopyD();
3542  res->rtyp=IDEAL_CMD;
3543  if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
3544  else res->data=I;
3545  setFlag(res,FLAG_STD);
3546  }
3547  else return TRUE;
3548  return FALSE;
3549  }
3550  else
3551  #endif
3552  /*==================== PrintMat =================*/
3553  #ifdef HAVE_PLURAL
3554  if (strcmp(sys_cmd, "PrintMat") == 0)
3555  {
3556  int a;
3557  int b;
3558  ring r;
3559  int metric;
3560  if (h!=NULL)
3561  {
3562  if (h->Typ()==INT_CMD)
3563  {
3564  a=(int)((long)(h->Data()));
3565  h=h->next;
3566  }
3567  else if (h->Typ()==INT_CMD)
3568  {
3569  b=(int)((long)(h->Data()));
3570  h=h->next;
3571  }
3572  else if (h->Typ()==RING_CMD)
3573  {
3574  r=(ring)h->Data();
3575  h=h->next;
3576  }
3577  else
3578  return TRUE;
3579  }
3580  else
3581  return TRUE;
3582  if ((h!=NULL) && (h->Typ()==INT_CMD))
3583  {
3584  metric=(int)((long)(h->Data()));
3585  }
3586  res->rtyp=MATRIX_CMD;
3587  if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
3588  else res->data=NULL;
3589  return FALSE;
3590  }
3591  else
3592  #endif
3593 /* ============ NCUseExtensions ======================== */
3594  #ifdef HAVE_PLURAL
3595  if(strcmp(sys_cmd,"NCUseExtensions")==0)
3596  {
3597  if ((h!=NULL) && (h->Typ()==INT_CMD))
3598  res->data=(void *)(long)setNCExtensions( (int)((long)(h->Data())) );
3599  else
3600  res->data=(void *)(long)getNCExtensions();
3601  res->rtyp=INT_CMD;
3602  return FALSE;
3603  }
3604  else
3605  #endif
3606 /* ============ NCGetType ======================== */
3607  #ifdef HAVE_PLURAL
3608  if(strcmp(sys_cmd,"NCGetType")==0)
3609  {
3610  res->rtyp=INT_CMD;
3611  if( rIsPluralRing(currRing) )
3612  res->data=(void *)(long)ncRingType(currRing);
3613  else
3614  res->data=(void *)(-1L);
3615  return FALSE;
3616  }
3617  else
3618  #endif
3619 /* ============ ForceSCA ======================== */
3620  #ifdef HAVE_PLURAL
3621  if(strcmp(sys_cmd,"ForceSCA")==0)
3622  {
3623  if( !rIsPluralRing(currRing) )
3624  return TRUE;
3625  int b, e;
3626  if ((h!=NULL) && (h->Typ()==INT_CMD))
3627  {
3628  b = (int)((long)(h->Data()));
3629  h=h->next;
3630  }
3631  else return TRUE;
3632  if ((h!=NULL) && (h->Typ()==INT_CMD))
3633  {
3634  e = (int)((long)(h->Data()));
3635  }
3636  else return TRUE;
3637  if( !sca_Force(currRing, b, e) )
3638  return TRUE;
3639  return FALSE;
3640  }
3641  else
3642  #endif
3643 /* ============ ForceNewNCMultiplication ======================== */
3644  #ifdef HAVE_PLURAL
3645  if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0)
3646  {
3647  if( !rIsPluralRing(currRing) )
3648  return TRUE;
3649  if( !ncInitSpecialPairMultiplication(currRing) ) // No Plural!
3650  return TRUE;
3651  return FALSE;
3652  }
3653  else
3654  #endif
3655 /* ============ ForceNewOldNCMultiplication ======================== */
3656  #ifdef HAVE_PLURAL
3657  if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0)
3658  {
3659  if( !rIsPluralRing(currRing) )
3660  return TRUE;
3661  if( !ncInitSpecialPowersMultiplication(currRing) ) // Enable Formula for Plural (depends on swiches)!
3662  return TRUE;
3663  return FALSE;
3664  }
3665  else
3666  #endif
3667 /*==================== test64 =================*/
3668  #if 0
3669  if(strcmp(sys_cmd,"test64")==0)
3670  {
3671  long l=8;int i;
3672  for(i=1;i<62;i++)
3673  {
3674  l=l<<1;
3675  number n=n_Init(l,coeffs_BIGINT);
3676  Print("%ld= ",l);n_Print(n,coeffs_BIGINT);
3678  n_Delete(&n,coeffs_BIGINT);
3680  PrintS(" F:");
3682  PrintLn();
3683  n_Delete(&n,coeffs_BIGINT);
3684  }
3685  Print("SIZEOF_LONG=%d\n",SIZEOF_LONG);
3686  return FALSE;
3687  }
3688  else
3689  #endif
3690 /*==================== n_SwitchChinRem =================*/
3691  if(strcmp(sys_cmd,"cache_chinrem")==0)
3692  {
3694  Print("caching inverse in chines remainder:%d\n",n_SwitchChinRem);
3695  if ((h!=NULL)&&(h->Typ()==INT_CMD))
3696  n_SwitchChinRem=(int)(long)h->Data();
3697  return FALSE;
3698  }
3699  else
3700 /*==================== LU for bigintmat =================*/
3701 #ifdef SINGULAR_4_2
3702  if(strcmp(sys_cmd,"LU")==0)
3703  {
3704  if ((h!=NULL) && (h->Typ()==CMATRIX_CMD))
3705  {
3706  // get the argument:
3707  bigintmat *b=(bigintmat *)h->Data();
3708  // just for tests: simply transpose
3709  bigintmat *bb=b->transpose();
3710  // return the result:
3711  res->rtyp=CMATRIX_CMD;
3712  res->data=(char*)bb;
3713  return FALSE;
3714  }
3715  else
3716  {
3717  WerrorS("system(\"LU\",<cmatrix>) expected");
3718  return TRUE;
3719  }
3720  }
3721  else
3722 #endif
3723 /*==================== sort =================*/
3724  if(strcmp(sys_cmd,"sort")==0)
3725  {
3726  extern BOOLEAN jjSORTLIST(leftv,leftv);
3727  if (h->Typ()==LIST_CMD)
3728  return jjSORTLIST(res,h);
3729  else
3730  return TRUE;
3731  }
3732  else
3733 /*==================== uniq =================*/
3734  if(strcmp(sys_cmd,"uniq")==0)
3735  {
3736  extern BOOLEAN jjUNIQLIST(leftv, leftv);
3737  if (h->Typ()==LIST_CMD)
3738  return jjUNIQLIST(res,h);
3739  else
3740  return TRUE;
3741  }
3742  else
3743 /*==================== GF(p,n) ==================================*/
3744  if(strcmp(sys_cmd,"GF")==0)
3745  {
3746  const short t[]={3,INT_CMD,INT_CMD,STRING_CMD};
3747  if (iiCheckTypes(h,t,1))
3748  {
3749  int p=(int)(long)h->Data();
3750  int n=(int)(long)h->next->Data();
3751  char *v=(char*)h->next->next->CopyD();
3752  GFInfo param;
3753  param.GFChar = p;
3754  param.GFDegree = n;
3755  param.GFPar_name = v;
3756  coeffs cf= nInitChar(n_GF, &param);
3757  res->rtyp=CRING_CMD;
3758  res->data=cf;
3759  return FALSE;
3760  }
3761  else
3762  return TRUE;
3763  }
3764  else
3765 /*==================== power* ==================================*/
3766  #if 0
3767  if(strcmp(sys_cmd,"power1")==0)
3768  {
3769  res->rtyp=POLY_CMD;
3770  poly f=(poly)h->CopyD();
3771  poly g=pPower(f,2000);
3772  res->data=(void *)g;
3773  return FALSE;
3774  }
3775  else
3776  if(strcmp(sys_cmd,"power2")==0)
3777  {
3778  res->rtyp=POLY_CMD;
3779  poly f=(poly)h->Data();
3780  poly g=pOne();
3781  for(int i=0;i<2000;i++)
3782  g=pMult(g,pCopy(f));
3783  res->data=(void *)g;
3784  return FALSE;
3785  }
3786  if(strcmp(sys_cmd,"power3")==0)
3787  {
3788  res->rtyp=POLY_CMD;
3789  poly f=(poly)h->Data();
3790  poly p2=pMult(pCopy(f),pCopy(f));
3791  poly p4=pMult(pCopy(p2),pCopy(p2));
3792  poly p8=pMult(pCopy(p4),pCopy(p4));
3793  poly p16=pMult(pCopy(p8),pCopy(p8));
3794  poly p32=pMult(pCopy(p16),pCopy(p16));
3795  poly p64=pMult(pCopy(p32),pCopy(p32));
3796  poly p128=pMult(pCopy(p64),pCopy(p64));
3797  poly p256=pMult(pCopy(p128),pCopy(p128));
3798  poly p512=pMult(pCopy(p256),pCopy(p256));
3799  poly p1024=pMult(pCopy(p512),pCopy(p512));
3800  poly p1536=pMult(p1024,p512);
3801  poly p1792=pMult(p1536,p256);
3802  poly p1920=pMult(p1792,p128);
3803  poly p1984=pMult(p1920,p64);
3804  poly p2000=pMult(p1984,p16);
3805  res->data=(void *)p2000;
3806  pDelete(&p2);
3807  pDelete(&p4);
3808  pDelete(&p8);
3809  //pDelete(&p16);
3810  pDelete(&p32);
3811  //pDelete(&p64);
3812  //pDelete(&p128);
3813  //pDelete(&p256);
3814  //pDelete(&p512);
3815  //pDelete(&p1024);
3816  //pDelete(&p1536);
3817  //pDelete(&p1792);
3818  //pDelete(&p1920);
3819  //pDelete(&p1984);
3820  return FALSE;
3821  }
3822  else
3823  #endif
3824 /* ccluster --------------------------------------------------------------*/
3825 #ifdef HAVE_CCLUSTER
3826  if(strcmp(sys_cmd,"ccluster")==0)
3827  {
3828  if ((currRing!=NULL)
3830  {
3831  const short t[]={5,POLY_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD};
3833 
3834 // printf("test t : %d\n", h->Typ()==POLY_CMD);
3835 // printf("test t : %d\n", h->next->Typ()==POLY_CMD);
3836  int pol_with_complex_coeffs=0;
3837  if (h->next->Typ()==POLY_CMD)
3838  pol_with_complex_coeffs=1;
3839 
3840  if ( (pol_with_complex_coeffs==0 && iiCheckTypes(h,t,1))
3841  ||(pol_with_complex_coeffs==1 && iiCheckTypes(h,t2,1)) )
3842  {
3843  // convert first arg. to fmpq_poly_t
3844  fmpq_poly_t fre, fim;
3845  convSingPFlintP(fre,(poly)h->Data(),currRing); h=h->next;
3846  if (pol_with_complex_coeffs==1)
3847  { // convert second arg. to fmpq_poly_t
3848  convSingPFlintP(fim,(poly)h->Data(),currRing); h=h->next;
3849  }
3850  // convert box-center(re,im), box-size, epsilon
3851  fmpq_t center_re,center_im,boxsize,eps;
3852  convSingNFlintN(center_re,(number)h->Data(),currRing->cf); h=h->next;
3853  convSingNFlintN(center_im,(number)h->Data(),currRing->cf); h=h->next;
3854  convSingNFlintN(boxsize,(number)h->Data(),currRing->cf); h=h->next;
3855  convSingNFlintN(eps,(number)h->Data(),currRing->cf); h=h->next;
3856  // alloc arrays
3857  int n=fmpq_poly_length(fre);
3858  fmpq_t* re_part=(fmpq_t*)omAlloc(n*sizeof(fmpq_t));
3859  fmpq_t* im_part=(fmpq_t*)omAlloc(n*sizeof(fmpq_t));
3860  int *mult =(int*) omAlloc(n*sizeof(int));
3861  for(int i=0; i<n;i++)
3862  { fmpq_init(re_part[i]); fmpq_init(im_part[i]); }
3863  // call cccluster, adjust n
3864  int verbosity =0; //nothing is printed
3865  int strategy = 23; //default strategy
3866  int nn=0;
3867  long nb_threads = (long) feOptValue(FE_OPT_CPUS);
3868  strategy = strategy+(nb_threads<<6);
3869 // printf("nb threads: %ld\n", nb_threads);
3870 // printf("strategy: %ld\n", strategy);
3871  if (pol_with_complex_coeffs==0)
3872  nn=ccluster_interface_poly_real(re_part,im_part,mult,fre,center_re,center_im,boxsize,eps,strategy,verbosity);
3873  else
3874  nn=ccluster_interface_poly_real_imag(re_part,im_part,mult,fre,fim,center_re,center_im,boxsize,eps,strategy,verbosity);
3875  // convert to list
3877  l->Init(nn);
3878  for(int i=0; i<nn;i++)
3879  {
3881  l->m[i].rtyp=LIST_CMD;
3882  l->m[i].data=ll;
3883  ll->Init(3);
3884  ll->m[0].rtyp=NUMBER_CMD;
3885  ll->m[1].rtyp=NUMBER_CMD;
3886  ll->m[2].rtyp=INT_CMD;
3887  ll->m[0].data=convFlintNSingN(re_part[i],currRing->cf);
3888  ll->m[1].data=convFlintNSingN(im_part[i],currRing->cf);
3889  ll->m[2].data=(void *)(long)mult[i];
3890  }
3891  //clear re, im, mults, fre, fim
3892  for(int i=n-1;i>=0;i--) { fmpq_clear(re_part[i]); fmpq_clear(im_part[i]); }
3893  omFree(re_part);
3894  omFree(im_part);
3895  omFree(mult);
3896  fmpq_clear(center_re); fmpq_clear(center_im); fmpq_clear(boxsize); fmpq_clear(eps);
3897  fmpq_poly_clear(fre);
3898  if (pol_with_complex_coeffs==1) fmpq_poly_clear(fim);
3899  // result
3900  res->rtyp=LIST_CMD;
3901  res->data=l;
3902  return FALSE;
3903  }
3904  }
3905  return TRUE;
3906  }
3907  else
3908 #endif
3909 /* ====== maEvalAt ============================*/
3910  if(strcmp(sys_cmd,"evaluate")==0)
3911  {
3912  extern number maEvalAt(const poly p,const number* pt, const ring r);
3913  if (h->Typ()!=POLY_CMD)
3914  {
3915  WerrorS("expected system(\"evaluate\",<poly>,..)");
3916  return TRUE;
3917  }
3918  poly p=(poly)h->Data();
3919  number *pt=(number*)omAlloc(sizeof(number)*currRing->N);
3920  for(int i=0;i<currRing->N;i++)
3921  {
3922  h=h->next;
3923  if ((h==NULL)||(h->Typ()!=NUMBER_CMD))
3924  {
3925  WerrorS("system(\"evaluate\",<poly>,<number>..) - expect number");
3926  return TRUE;
3927  }
3928  pt[i]=(number)h->Data();
3929  }
3930  res->data=maEvalAt(p,pt,currRing);
3931  res->rtyp=NUMBER_CMD;
3932  return FALSE;
3933  }
3934  else
3935 /* ====== DivRem ============================*/
3936  if(strcmp(sys_cmd,"DivRem")==0)
3937  {
3938  const short t1[]={2,POLY_CMD,POLY_CMD};
3939  if (iiCheckTypes(h,t1,1))
3940  {
3941  poly p=(poly)h->CopyD();
3942  poly q=(poly)h->next->CopyD();
3943  poly rest;
3944  res->data=p_DivRem(p,q,rest,currRing);
3945  res->rtyp=POLY_CMD;
3946  Print("rest:");pWrite(rest);
3947  return FALSE;
3948  }
3949  else
3950  {
3951  WerrorS("expected system(\"DivRem\",<poly>,<poly>)");
3952  return TRUE;
3953  }
3954  }
3955  else
3956 /*==================== Error =================*/
3957  Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3958  }
3959  return TRUE;
3960 }
int BOOLEAN
Definition: auxiliary.h:87
#define TRUE
Definition: auxiliary.h:100
#define FALSE
Definition: auxiliary.h:96
void * ADDRESS
Definition: auxiliary.h:119
lists testsvd(matrix M)
Definition: calcSVD.cc:27
bool isOn(int sw)
switches
void On(int sw)
switches
void Off(int sw)
switches
CanonicalForm FACTORY_PUBLIC pp(const CanonicalForm &)
CanonicalForm pp ( const CanonicalForm & f )
Definition: cf_gcd.cc:676
void FACTORY_PUBLIC setCharacteristic(int c)
Definition: cf_char.cc:28
int l
Definition: cfEzgcd.cc:100
int m
Definition: cfEzgcd.cc:128
int i
Definition: cfEzgcd.cc:132
int k
Definition: cfEzgcd.cc:99
int p
Definition: cfModGcd.cc:4078
g
Definition: cfModGcd.cc:4090
CanonicalForm cf
Definition: cfModGcd.cc:4083
CanonicalForm b
Definition: cfModGcd.cc:4103
EXTERN_VAR int singular_homog_flag
Definition: cf_algorithm.h:65
static const int SW_USE_CHINREM_GCD
set to 1 to use modular gcd over Z
Definition: cf_defs.h:41
static const int SW_USE_FL_GCD_P
set to 1 to use Flints gcd over F_p
Definition: cf_defs.h:47
static const int SW_USE_EZGCD_P
set to 1 to use EZGCD over F_q
Definition: cf_defs.h:37
static const int SW_USE_EZGCD
set to 1 to use EZGCD over Z
Definition: cf_defs.h:35
static const int SW_USE_FL_GCD_0
set to 1 to use Flints gcd over Q/Z
Definition: cf_defs.h:49
FILE * f
Definition: checklibs.c:9
CanonicalForm convSingPFactoryP(poly p, const ring r)
Definition: clapconv.cc:136
matrix singntl_HNF(matrix m, const ring s)
Definition: clapsing.cc:1817
factory's main class
Definition: canonicalform.h:86
Matrices of numbers.
Definition: bigintmat.h:51
Definition: intvec.h:23
void resize(int new_length)
Definition: intvec.cc:106
int rows() const
Definition: intvec.h:96
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
int rtyp
Definition: subexpr.h:91
void * data
Definition: subexpr.h:88
Definition: lists.h:24
sleftv * m
Definition: lists.h:46
INLINE_THIS void Init(int l=0)
int GFDegree
Definition: coeffs.h:95
@ n_GF
\GF{p^n < 2^16}
Definition: coeffs.h:32
static FORCE_INLINE number n_convFactoryNSingN(const CanonicalForm n, const coeffs r)
Definition: coeffs.h:978
void n_Print(number &a, const coeffs r)
print a number (BEWARE of string buffers!) mostly for debugging
Definition: numbers.cc:621
static FORCE_INLINE CanonicalForm n_convSingNFactoryN(number n, BOOLEAN setChar, const coeffs r)
Definition: coeffs.h:981
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:354
static FORCE_INLINE int n_GetChar(const coeffs r)
Return the characteristic of the coeff. domain.
Definition: coeffs.h:444
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:455
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition: coeffs.h:542
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:538
const char * GFPar_name
Definition: coeffs.h:96
int GFChar
Definition: coeffs.h:94
Creation data needed for finite fields.
Definition: coeffs.h:93
poly uni_subst_bits(poly outer_uni, poly inner_multi, ring r)
Definition: digitech.cc:47
#define Print
Definition: emacs.cc:80
#define Warn
Definition: emacs.cc:77
#define WarnS
Definition: emacs.cc:78
void error(const char *fmt,...)
Definition: emacs.cc:55
poly longCoeffsToSingularPoly(unsigned long *polyCoeffs, const int degree)
Definition: extra.cc:207
unsigned long ** singularMatrixToLongMatrix(matrix singularMatrix)
Definition: extra.cc:175
ideal F5main(ideal id, ring r, int opt, int plus, int termination)
Definition: f5gb.cc:1889
const CanonicalForm int s
Definition: facAbsFact.cc:51
CanonicalForm res
Definition: facAbsFact.cc:60
const CanonicalForm & w
Definition: facAbsFact.cc:51
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:39
CFList int bool & irred
[in,out] Is A irreducible?
Definition: facFactorize.h:34
int j
Definition: facHensel.cc:110
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
poly unifastmult(poly f, poly g, ring r)
Definition: fast_mult.cc:272
poly pFastPowerMC(poly f, int n, ring r)
Definition: fast_mult.cc:588
static int max(int a, int b)
Definition: fast_mult.cc:264
poly pFastPower(poly f, int n, ring r)
Definition: fast_mult.cc:342
int Mults()
Definition: fast_mult.cc:14
poly multifastmult(poly f, poly g, ring r)
Definition: fast_mult.cc:290
void WerrorS(const char *s)
Definition: feFopen.cc:24
static void * feOptValue(feOptIndex opt)
Definition: feOpt.h:40
STATIC_VAR int nfMinPoly[16]
Definition: ffields.cc:549
void convSingPFlintP(fmpq_poly_t res, poly p, const ring r)
void convSingNFlintN(fmpz_t f, mpz_t z)
void convFlintNSingN(mpz_t z, fmpz_t f)
number maEvalAt(const poly p, const number *pt, const ring r)
evaluate the polynomial p at the pt given by the array pt
Definition: gen_maps.cc:167
#define EXTERN_VAR
Definition: globaldefs.h:6
@ IDEAL_CMD
Definition: grammar.cc:284
@ MATRIX_CMD
Definition: grammar.cc:286
@ PROC_CMD
Definition: grammar.cc:280
@ INTMAT_CMD
Definition: grammar.cc:279
@ MODUL_CMD
Definition: grammar.cc:287
@ VECTOR_CMD
Definition: grammar.cc:292
@ NUMBER_CMD
Definition: grammar.cc:288
@ POLY_CMD
Definition: grammar.cc:289
@ RING_CMD
Definition: grammar.cc:281
void slicehilb(ideal I)
Definition: hilb.cc:1168
STATIC_VAR coordinates * points
BOOLEAN jjSORTLIST(leftv, leftv arg)
Definition: iparith.cc:10190
BOOLEAN jjUNIQLIST(leftv, leftv arg)
Definition: iparith.cc:10199
VAR coeffs coeffs_BIGINT
Definition: ipid.cc:50
#define setFlag(A, F)
Definition: ipid.h:113
#define FLAG_STD
Definition: ipid.h:106
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:6566
ring rSubring(ring org_ring, sleftv *rv)
Definition: ipshell.cc:6012
STATIC_VAR jList * T
Definition: janet.cc:30
STATIC_VAR TreeM * G
Definition: janet.cc:31
STATIC_VAR Poly * h
Definition: janet.cc:971
KINLINE poly ksOldSpolyRed(poly p1, poly p2, poly spNoether)
Definition: kInline.h:1185
poly fglmLinearCombination(ideal source, poly monset)
Definition: fglmcomb.cc:415
poly fglmNewLinearCombination(ideal source, poly monset)
Definition: fglmcomb.cc:153
VAR int(* test_PosInL)(const LSet set, const int length, LObject *L, const kStrategy strat)
Definition: kstd2.cc:83
VAR int(* test_PosInT)(const TSet T, const int tl, LObject &h)
Definition: kstd2.cc:82
int posInT17(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5456
int posInT11(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5052
int posInT1(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4996
int posInT0(const TSet, const int length, LObject &)
Definition: kutil.cc:4985
int posInT2(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5024
int posInT_pLength(const TSet set, const int length, LObject &p)
Definition: kutil.cc:11783
int posInT13(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5294
int posInT17_c(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5563
int posInT_EcartFDegpLength(const TSet set, const int length, LObject &p)
Definition: kutil.cc:11692
int posInT15(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5361
int posInT110(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5205
int posInT19(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5690
int posInT_FDegpLength(const TSet set, const int length, LObject &p)
Definition: kutil.cc:11746
static bool rIsSCA(const ring r)
Definition: nc.h:190
int & getNCExtensions()
Definition: old.gring.cc:82
int setNCExtensions(int iMask)
Definition: old.gring.cc:87
static nc_type & ncRingType(nc_struct *p)
Definition: nc.h:159
matrix nc_PrintMat(int a, int b, ring r, int metric)
returns matrix with the info on noncomm multiplication
Definition: old.gring.cc:2394
bool sca_Force(ring rGR, int b, int e)
Definition: sca.cc:1161
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,...
VAR omBin slists_bin
Definition: lists.cc:23
VAR int n_SwitchChinRem
Definition: longrat.cc:3094
matrix mp_Transp(matrix a, const ring R)
Definition: matpol.cc:254
matrix mp_InitI(int r, int c, int v, const ring R)
make it a v * unit matrix
Definition: matpol.cc:129
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:37
#define MATELEM(mat, i, j)
1-based access to matrix
Definition: matpol.h:29
ip_smatrix * matrix
Definition: matpol.h:43
#define MATROWS(i)
Definition: matpol.h:26
#define MATCOLS(i)
Definition: matpol.h:27
unsigned long * computeMinimalPolynomial(unsigned long **matrix, unsigned n, unsigned long p)
Definition: minpoly.cc:428
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition: minpoly.cc:647
#define pIter(p)
Definition: monomials.h:37
slists * lists
Definition: mpr_numeric.h:146
The main handler for Singular numbers which are suitable for Singular polynomials.
bool ncInitSpecialPowersMultiplication(ring r)
Definition: ncSAFormula.cc:50
BOOLEAN ncInitSpecialPairMultiplication(ring r)
Definition: ncSAMult.cc:266
ideal Approx_Step(ideal L)
Ann: ???
Definition: nc.cc:250
#define omStrDup(s)
Definition: omAllocDecl.h:263
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define omFree(addr)
Definition: omAllocDecl.h:261
#define omAlloc0(size)
Definition: omAllocDecl.h:211
void omMarkAsStaticAddr(void *addr)
omError_t om_ErrorStatus
Definition: omError.c:13
const char * omError2String(omError_t error)
Definition: omError.c:54
const char * omError2Serror(omError_t error)
Definition: omError.c:65
omError_t om_InternalErrorStatus
Definition: omError.c:14
#define NULL
Definition: omList.c:12
omOpts_t om_Opts
Definition: omOpts.c:13
#define omPrintCurrentBackTrace(fd)
Definition: omRet2Info.h:39
VAR unsigned si_opt_2
Definition: options.c:6
#define Sy_bit(x)
Definition: options.h:31
void pPrintDivisbleByStat()
Definition: pDebug.cc:413
static unsigned pLength(poly a)
Definition: p_polys.h:191
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
poly p_DivRem(poly p, poly q, poly &rest, const ring r)
Definition: polys.cc:314
#define pAdd(p, q)
Definition: polys.h:203
#define pDelete(p_ptr)
Definition: polys.h:186
#define pHead(p)
returns newly allocated copy of Lm(p), coef is copied, next=NULL, p might be NULL
Definition: polys.h:67
#define pLmDeleteAndNext(p)
like pLmDelete, returns pNext(p)
Definition: polys.h:78
#define ppJetW(p, m, iv)
Definition: polys.h:369
#define pDivideM(a, b)
Definition: polys.h:294
#define pPower(p, q)
Definition: polys.h:204
#define pMult(p, q)
Definition: polys.h:207
void pWrite(poly p)
Definition: polys.h:308
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pIsPurePower(p)
Definition: polys.h:248
#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:138
#define pCopy(p)
return a copy of the poly
Definition: polys.h:185
#define pOne()
Definition: polys.h:315
poly nc_rat_CreateSpoly(poly pp1, poly pp2, int ishift, const ring r)
Definition: ratgring.cc:340
int redRat(poly *h, poly *reducer, int *red_length, int rl, int ishift, ring r)
Definition: ratgring.cc:593
poly nc_rat_ReduceSpolyNew(const poly p1, poly p2, int ishift, const ring r)
Definition: ratgring.cc:465
const char feNotImplemented[]
Definition: reporter.cc:54
void PrintS(const char *s)
Definition: reporter.cc:284
void PrintLn()
Definition: reporter.cc:310
void Werror(const char *fmt,...)
Definition: reporter.cc:189
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:3492
void p_DebugPrint(poly p, const ring r)
Definition: ring.cc:4369
int rChar(ring r)
Definition: ring.cc:713
void rDebugPrint(const ring r)
Definition: ring.cc:4164
void rSetSyzComp(int k, const ring r)
Definition: ring.cc:5166
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:519
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:400
@ ringorder_s
s?
Definition: ring.h:76
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:507
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:543
poly ringNF(poly f, ideal G, ring r)
Definition: ringgb.cc:199
poly plain_spoly(poly f, poly g)
Definition: ringgb.cc:168
poly ringRedNF(poly f, ideal G, ring r)
Definition: ringgb.cc:117
int testGB(ideal I, ideal GI)
Definition: ringgb.cc:226
static short scaLastAltVar(ring r)
Definition: sca.h:25
static short scaFirstAltVar(ring r)
Definition: sca.h:18
VAR int sdb_flags
Definition: sdb.cc:31
void sdb_edit(procinfo *pi)
Definition: sdb.cc:109
int status int fd
Definition: si_signals.h:59
ideal id_Vec2Ideal(poly vec, const ring R)
#define IDELEMS(i)
Definition: simpleideals.h:23
#define R
Definition: sirandom.c:27
#define M
Definition: sirandom.c:25
@ testHomog
Definition: structs.h:38
procinfo * procinfov
Definition: structs.h:60
BOOLEAN assumeStdFlag(leftv h)
Definition: subexpr.cc:1536
@ BIGINT_CMD
Definition: tok.h:38
@ CRING_CMD
Definition: tok.h:56
@ LIST_CMD
Definition: tok.h:118
@ INTVEC_CMD
Definition: tok.h:101
@ CMATRIX_CMD
Definition: tok.h:46
@ DEF_CMD
Definition: tok.h:58
@ STRING_CMD
Definition: tok.h:185
@ INT_CMD
Definition: tok.h:96
int dim(ideal I, ring r)
int * iv2array(intvec *iv, const ring R)
Definition: weight.cc:200
#define omPrintUsedTrackAddrs(F, max)
Definition: xalloc.h:266
#define omUpdateInfo()
Definition: xalloc.h:230

◆ jjSYSTEM()

BOOLEAN jjSYSTEM ( leftv  res,
leftv  args 
)

Definition at line 229 of file extra.cc.

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

◆ longCoeffsToSingularPoly()

poly longCoeffsToSingularPoly ( unsigned long *  polyCoeffs,
const int  degree 
)

Definition at line 207 of file extra.cc.

208 {
209  poly result = NULL;
210  for (int i = 0; i <= degree; i++)
211  {
212  if ((int)polyCoeffs[i] != 0)
213  {
214  poly term = p_ISet((int)polyCoeffs[i], currRing);
215  if (i > 0)
216  {
217  p_SetExp(term, 1, i, currRing);
218  p_Setm(term, currRing);
219  }
221  }
222  }
223  return result;
224 }
int degree(const CanonicalForm &f)
Definition: int_poly.h:33
poly p_ISet(long i, const ring r)
returns the poly representing the integer i
Definition: p_polys.cc:1297
static poly p_Add_q(poly p, poly q, const ring r)
Definition: p_polys.h:936
static unsigned long p_SetExp(poly p, const unsigned long e, const unsigned long iBitmask, const int VarOffset)
set a single variable exponent @Note: VarOffset encodes the position in p->exp
Definition: p_polys.h:488
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:233

◆ singularMatrixToLongMatrix()

unsigned long** singularMatrixToLongMatrix ( matrix  singularMatrix)

Definition at line 175 of file extra.cc.

176 {
177  int n = singularMatrix->rows();
178  assume(n == singularMatrix->cols());
179  unsigned long **longMatrix = 0;
180  longMatrix = new unsigned long *[n] ;
181  for (int i = 0 ; i < n; i++)
182  longMatrix[i] = new unsigned long [n];
183  number entry;
184  for (int r = 0; r < n; r++)
185  for (int c = 0; c < n; c++)
186  {
187  poly p=MATELEM(singularMatrix, r + 1, c + 1);
188  int entryAsInt;
189  if (p!=NULL)
190  {
191  entry = p_GetCoeff(p, currRing);
192  entryAsInt = n_Int(entry, currRing->cf);
193  if (entryAsInt < 0) entryAsInt += n_GetChar(currRing->cf);
194  }
195  else
196  entryAsInt=0;
197  longMatrix[r][c] = (unsigned long)entryAsInt;
198  }
199  return longMatrix;
200 }
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:547
#define assume(x)
Definition: mod2.h:387
#define p_GetCoeff(p, r)
Definition: monomials.h:50