My Project
Loading...
Searching...
No Matches
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/pCoeff.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 "misc/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)
 
#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)
 

Variables

EXTERN_VAR BOOLEAN FE_OPT_NO_SHELL_FLAG
 

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)
Value:
if(strcmp(s,A)==0) res->data=(void *)1; else
const CanonicalForm int s
Definition facAbsFact.cc:51
CanonicalForm res
Definition facAbsFact.cc:60
#define A
Definition sirandom.c:24

Function Documentation

◆ jjEXTENDED_SYSTEM()

static BOOLEAN jjEXTENDED_SYSTEM ( leftv res,
leftv h )
static

Definition at line 2391 of file extra.cc.

2392{
2393 if(h->Typ() == STRING_CMD)
2394 {
2395 char *sys_cmd=(char *)(h->Data());
2396 h=h->next;
2397 /*==================== test syz strat =================*/
2398 if (strcmp(sys_cmd, "syz") == 0)
2399 {
2400 if ((h!=NULL) && (h->Typ()==STRING_CMD))
2401 {
2402 const char *s=(const char *)h->Data();
2403 if (strcmp(s,"posInT_EcartFDegpLength")==0)
2405 else if (strcmp(s,"posInT_FDegpLength")==0)
2407 else if (strcmp(s,"posInT_pLength")==0)
2409 else if (strcmp(s,"posInT0")==0)
2411 else if (strcmp(s,"posInT1")==0)
2413 else if (strcmp(s,"posInT2")==0)
2415 else if (strcmp(s,"posInT11")==0)
2417 else if (strcmp(s,"posInT110")==0)
2419 else if (strcmp(s,"posInT13")==0)
2421 else if (strcmp(s,"posInT15")==0)
2423 else if (strcmp(s,"posInT17")==0)
2425 else if (strcmp(s,"posInT17_c")==0)
2427 else if (strcmp(s,"posInT19")==0)
2429 else PrintS("valid posInT:0,1,2,11,110,13,15,17,17_c,19,_EcartFDegpLength,_FDegpLength,_pLength,_EcartpLength\n");
2430 }
2431 else
2432 {
2435 }
2436 si_opt_2|=Sy_bit(23);
2437 return FALSE;
2438 }
2439 else
2440 /*==================== locNF ======================================*/
2441 if(strcmp(sys_cmd,"locNF")==0)
2442 {
2443 const short t[]={4,VECTOR_CMD,MODUL_CMD,INT_CMD,INTVEC_CMD};
2444 if (iiCheckTypes(h,t,1))
2445 {
2446 poly f=(poly)h->Data();
2447 h=h->next;
2448 ideal m=(ideal)h->Data();
2450 h=h->next;
2451 int n=(int)((long)h->Data());
2452 h=h->next;
2453 intvec *v=(intvec *)h->Data();
2454
2455 /* == now the work starts == */
2456
2457 int * iv=iv2array(v, currRing);
2458 poly r=0;
2459 poly hp=ppJetW(f,n,iv);
2460 int s=MATCOLS(m);
2461 int j=0;
2462 matrix T=mp_InitI(s,1,0, currRing);
2463
2464 while (hp != NULL)
2465 {
2466 if (pDivisibleBy(m->m[j],hp))
2467 {
2468 if (MATELEM(T,j+1,1)==0)
2469 {
2470 MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
2471 }
2472 else
2473 {
2474 pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
2475 }
2476 hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
2477 j=0;
2478 }
2479 else
2480 {
2481 if (j==s-1)
2482 {
2483 r=pAdd(r,pHead(hp));
2484 hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
2485 j=0;
2486 }
2487 else
2488 {
2489 j++;
2490 }
2491 }
2492 }
2493
2496 for (int k=1;k<=MATROWS(Temp);k++)
2497 {
2498 MATELEM(R,k,1)=MATELEM(Temp,k,1);
2499 }
2500
2502 L->Init(2);
2503 L->m[0].rtyp=MATRIX_CMD; L->m[0].data=(void *)R;
2504 L->m[1].rtyp=MATRIX_CMD; L->m[1].data=(void *)T;
2505 res->data=L;
2506 res->rtyp=LIST_CMD;
2507 // iv aufraeumen
2508 omFree(iv);
2509 return FALSE;
2510 }
2511 else
2512 return TRUE;
2513 }
2514 else
2515 /*==================== poly debug ==================================*/
2516 if(strcmp(sys_cmd,"p")==0)
2517 {
2518# ifdef RDEBUG
2519 p_DebugPrint((poly)h->Data(), currRing);
2520# else
2521 WarnS("Sorry: not available for release build!");
2522# endif
2523 return FALSE;
2524 }
2525 else
2526 /*==================== setsyzcomp ==================================*/
2527 if(strcmp(sys_cmd,"setsyzcomp")==0)
2528 {
2529 if ((h!=NULL) && (h->Typ()==INT_CMD))
2530 {
2531 int k = (int)(long)h->Data();
2532 if ( currRing->order[0] == ringorder_s )
2533 {
2535 }
2536 }
2537 }
2538 /*==================== ring debug ==================================*/
2539 if(strcmp(sys_cmd,"r")==0)
2540 {
2541# ifdef RDEBUG
2542 rDebugPrint((ring)h->Data());
2543# else
2544 WarnS("Sorry: not available for release build!");
2545# endif
2546 return FALSE;
2547 }
2548 else
2549 /*==================== changeRing ========================*/
2550 /* The following code changes the names of the variables in the
2551 current ring to "x1", "x2", ..., "xN", where N is the number
2552 of variables in the current ring.
2553 The purpose of this rewriting is to eliminate indexed variables,
2554 as they may cause problems when generating scripts for Magma,
2555 Maple, or Macaulay2. */
2556 if(strcmp(sys_cmd,"changeRing")==0)
2557 {
2558 int varN = currRing->N;
2559 char h[12];
2560 for (int i = 1; i <= varN; i++)
2561 {
2562 omFree(currRing->names[i - 1]);
2563 snprintf(h,10, "x%d", i);
2564 currRing->names[i - 1] = omStrDup(h);
2565 }
2567 res->rtyp = INT_CMD;
2568 res->data = (void*)0L;
2569 return FALSE;
2570 }
2571 else
2572 /*==================== mtrack ==================================*/
2573 if(strcmp(sys_cmd,"mtrack")==0)
2574 {
2575 #ifdef OM_TRACK
2576 om_Opts.MarkAsStatic = 1;
2577 FILE *fd = NULL;
2578 int max = 5;
2579 while (h != NULL)
2580 {
2582 if (fd == NULL && h->Typ()==STRING_CMD)
2583 {
2584 char *fn=(char*) h->Data();
2585 fd = fopen(fn, "w");
2586 if (fd == NULL)
2587 Warn("Can not open %s for writing og mtrack. Using stdout",fn);
2588 }
2589 else if (h->Typ() == INT_CMD)
2590 {
2591 max = (int)(long)h->Data();
2592 }
2593 h = h->Next();
2594 }
2595 omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2596 if (fd != NULL) fclose(fd);
2597 om_Opts.MarkAsStatic = 0;
2598 return FALSE;
2599 #else
2600 WerrorS("system(\"mtrack\",..) is not implemented in this version");
2601 return TRUE;
2602 #endif
2603 }
2604 else
2605 /*==================== backtrace ==================================*/
2606 #ifndef OM_NDEBUG
2607 if(strcmp(sys_cmd,"backtrace")==0)
2608 {
2610 return FALSE;
2611 }
2612 else
2613 #endif
2614
2615#if !defined(OM_NDEBUG)
2616 /*==================== omMemoryTest ==================================*/
2617 if (strcmp(sys_cmd,"omMemoryTest")==0)
2618 {
2619
2620#ifdef OM_STATS_H
2621 PrintS("\n[om_Info]: \n");
2622 omUpdateInfo();
2623#define OM_PRINT(name) Print(" %-22s : %10ld \n", #name, om_Info . name)
2624 OM_PRINT(MaxBytesSystem);
2625 OM_PRINT(CurrentBytesSystem);
2626 OM_PRINT(MaxBytesSbrk);
2627 OM_PRINT(CurrentBytesSbrk);
2628 OM_PRINT(MaxBytesMmap);
2629 OM_PRINT(CurrentBytesMmap);
2630 OM_PRINT(UsedBytes);
2631 OM_PRINT(AvailBytes);
2632 OM_PRINT(UsedBytesMalloc);
2633 OM_PRINT(AvailBytesMalloc);
2634 OM_PRINT(MaxBytesFromMalloc);
2635 OM_PRINT(CurrentBytesFromMalloc);
2636 OM_PRINT(MaxBytesFromValloc);
2637 OM_PRINT(CurrentBytesFromValloc);
2638 OM_PRINT(UsedBytesFromValloc);
2639 OM_PRINT(AvailBytesFromValloc);
2640 OM_PRINT(MaxPages);
2641 OM_PRINT(UsedPages);
2642 OM_PRINT(AvailPages);
2643 OM_PRINT(MaxRegionsAlloc);
2644 OM_PRINT(CurrentRegionsAlloc);
2645#undef OM_PRINT
2646#endif
2647
2648#ifdef OM_OPTS_H
2649 PrintS("\n[om_Opts]: \n");
2650#define OM_PRINT(format, name) Print(" %-22s : %10" format"\n", #name, om_Opts . name)
2651 OM_PRINT("d", MinTrack);
2652 OM_PRINT("d", MinCheck);
2653 OM_PRINT("d", MaxTrack);
2654 OM_PRINT("d", MaxCheck);
2655 OM_PRINT("d", Keep);
2656 OM_PRINT("d", HowToReportErrors);
2657 OM_PRINT("d", MarkAsStatic);
2658 OM_PRINT("u", PagesPerRegion);
2659 OM_PRINT("p", OutOfMemoryFunc);
2660 OM_PRINT("p", MemoryLowFunc);
2661 OM_PRINT("p", ErrorHook);
2662#undef OM_PRINT
2663#endif
2664
2665#ifdef OM_ERROR_H
2666 Print("\n\n[om_ErrorStatus] : '%s' (%s)\n",
2669 Print("[om_InternalErrorStatus]: '%s' (%s)\n",
2672
2673#endif
2674
2675// omTestMemory(1);
2676// omtTestErrors();
2677 return FALSE;
2678 }
2679 else
2680#endif
2681 /*==================== red =============================*/
2682 #if 0
2683 if(strcmp(sys_cmd,"red")==0)
2684 {
2685 if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2686 {
2687 res->rtyp=IDEAL_CMD;
2688 res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2690 return FALSE;
2691 }
2692 else
2693 WerrorS("ideal expected");
2694 }
2695 else
2696 #endif
2697 /*==================== fastcomb =============================*/
2698 if(strcmp(sys_cmd,"fastcomb")==0)
2699 {
2700 if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2701 {
2702 if (h->next!=NULL)
2703 {
2704 if (h->next->Typ()!=POLY_CMD)
2705 {
2706 WarnS("Wrong types for poly= comb(ideal,poly)");
2707 }
2708 }
2709 res->rtyp=POLY_CMD;
2710 res->data=(void *) fglmLinearCombination(
2711 (ideal)h->Data(),(poly)h->next->Data());
2712 return FALSE;
2713 }
2714 else
2715 WerrorS("ideal expected");
2716 }
2717 else
2718 /*==================== comb =============================*/
2719 if(strcmp(sys_cmd,"comb")==0)
2720 {
2721 if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2722 {
2723 if (h->next!=NULL)
2724 {
2725 if (h->next->Typ()!=POLY_CMD)
2726 {
2727 WarnS("Wrong types for poly= comb(ideal,poly)");
2728 }
2729 }
2730 res->rtyp=POLY_CMD;
2731 res->data=(void *)fglmNewLinearCombination(
2732 (ideal)h->Data(),(poly)h->next->Data());
2733 return FALSE;
2734 }
2735 else
2736 WerrorS("ideal expected");
2737 }
2738 else
2739 #if 0 /* debug only */
2740 /*==================== listall ===================================*/
2741 if(strcmp(sys_cmd,"listall")==0)
2742 {
2743 void listall(int showproc);
2744 int showproc=0;
2745 if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2746 listall(showproc);
2747 return FALSE;
2748 }
2749 else
2750 #endif
2751 #if 0 /* debug only */
2752 /*==================== proclist =================================*/
2753 if(strcmp(sys_cmd,"proclist")==0)
2754 {
2755 void piShowProcList();
2756 piShowProcList();
2757 return FALSE;
2758 }
2759 else
2760 #endif
2761 /* ==================== newton ================================*/
2762 #ifdef HAVE_NEWTON
2763 if(strcmp(sys_cmd,"newton")==0)
2764 {
2765 if ((h->Typ()!=POLY_CMD)
2766 || (h->next->Typ()!=INT_CMD)
2767 || (h->next->next->Typ()!=INT_CMD))
2768 {
2769 WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2770 return TRUE;
2771 }
2772 poly p=(poly)(h->Data());
2773 int l=pLength(p);
2774 short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
2775 int i,j,k;
2776 k=0;
2777 poly pp=p;
2778 for (i=0;pp!=NULL;i++)
2779 {
2780 for(j=1;j<=currRing->N;j++)
2781 {
2782 points[k]=pGetExp(pp,j);
2783 k++;
2784 }
2785 pIter(pp);
2786 }
2787 hc_ERG r=hc_KOENIG(currRing->N, // dimension
2788 l, // number of points
2789 (short*) points, // points: x_1, y_1,z_1, x_2,y_2,z2,...
2790 currRing->OrdSgn==-1,
2791 (int) (h->next->Data()), // 1: Milnor, 0: Newton
2792 (int) (h->next->next->Data()) // debug
2793 );
2794 //----<>---Output-----------------------
2795
2796
2797 // PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2798
2799
2801 L->Init(6);
2802 L->m[0].rtyp=STRING_CMD; // newtonnumber;
2803 L->m[0].data=(void *)omStrDup(r.nZahl);
2804 L->m[1].rtyp=INT_CMD;
2805 L->m[1].data=(void *)(long)r.achse; // flag for unoccupied axes
2806 L->m[2].rtyp=INT_CMD;
2807 L->m[2].data=(void *)(long)r.deg; // #degenerations
2808 if ( r.deg != 0) // only if degenerations exist
2809 {
2810 L->m[3].rtyp=INT_CMD;
2811 L->m[3].data=(void *)(long)r.anz_punkte; // #points
2812 //---<>--number of points------
2813 int anz = r.anz_punkte; // number of points
2814 int dim = (currRing->N); // dimension
2815 intvec* v = new intvec( anz*dim );
2816 for (i=0; i<anz*dim; i++) // copy points
2817 (*v)[i] = r.pu[i];
2818 L->m[4].rtyp=INTVEC_CMD;
2819 L->m[4].data=(void *)v;
2820 //---<>--degenerations---------
2821 int deg = r.deg; // number of points
2822 intvec* w = new intvec( r.speicher ); // necessary memory
2823 i=0; // start copying
2824 do
2825 {
2826 (*w)[i] = r.deg_tab[i];
2827 i++;
2828 }
2829 while (r.deg_tab[i-1] != -2); // mark for end of list
2830 L->m[5].rtyp=INTVEC_CMD;
2831 L->m[5].data=(void *)w;
2832 }
2833 else
2834 {
2835 L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2836 L->m[4].rtyp=DEF_CMD;
2837 L->m[5].rtyp=DEF_CMD;
2838 }
2839
2840 res->data=(void *)L;
2841 res->rtyp=LIST_CMD;
2842 // free all pointer in r:
2843 delete[] r.nZahl;
2844 delete[] r.pu;
2845 delete[] r.deg_tab; // Ist das ein Problem??
2846
2847 omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
2848 return FALSE;
2849 }
2850 else
2851 #endif
2852 /*==== connection to Sebastian Jambor's code ======*/
2853 /* This code connects Sebastian Jambor's code for
2854 computing the minimal polynomial of an (n x n) matrix
2855 with entries in F_p to SINGULAR. Two conversion methods
2856 are needed; see further up in this file:
2857 (1) conversion of a matrix with long entries to
2858 a SINGULAR matrix with number entries, where
2859 the numbers are coefficients in currRing;
2860 (2) conversion of an array of longs (encoding the
2861 coefficients of the minimal polynomial) to a
2862 SINGULAR poly living in currRing. */
2863 if (strcmp(sys_cmd, "minpoly") == 0)
2864 {
2865 if ((h == NULL) || (h->Typ() != MATRIX_CMD) || h->next != NULL)
2866 {
2867 Werror("expected exactly one argument: %s",
2868 "a square matrix with number entries");
2869 return TRUE;
2870 }
2871 else
2872 {
2873 matrix m = (matrix)h->Data();
2874 int n = m->rows();
2875 unsigned long p = (unsigned long)n_GetChar(currRing->cf);
2876 if (n != m->cols())
2877 {
2878 WerrorS("expected exactly one argument: "
2879 "a square matrix with number entries");
2880 return TRUE;
2881 }
2882 unsigned long** ml = singularMatrixToLongMatrix(m);
2883 unsigned long* polyCoeffs = computeMinimalPolynomial(ml, n, p);
2884 poly theMinPoly = longCoeffsToSingularPoly(polyCoeffs, n);
2885 res->rtyp = POLY_CMD;
2886 res->data = (void *)theMinPoly;
2887 for (int i = 0; i < n; i++) delete[] ml[i];
2888 delete[] ml;
2889 delete[] polyCoeffs;
2890 return FALSE;
2891 }
2892 }
2893 else
2894 /*==================== sdb_flags =================*/
2895 #ifdef HAVE_SDB
2896 if (strcmp(sys_cmd, "sdb_flags") == 0)
2897 {
2898 if ((h!=NULL) && (h->Typ()==INT_CMD))
2899 {
2900 sdb_flags=(int)((long)h->Data());
2901 }
2902 else
2903 {
2904 WerrorS("system(\"sdb_flags\",`int`) expected");
2905 return TRUE;
2906 }
2907 return FALSE;
2908 }
2909 else
2910 #endif
2911 /*==================== sdb_edit =================*/
2912 #ifdef HAVE_SDB
2913 if (strcmp(sys_cmd, "sdb_edit") == 0)
2914 {
2916 {
2917 WerrorS("shell execution is disallowed in restricted mode");
2918 return TRUE;
2919 }
2920 if ((h!=NULL) && (h->Typ()==PROC_CMD))
2921 {
2922 procinfov p=(procinfov)h->Data();
2923 sdb_edit(p);
2924 }
2925 else
2926 {
2927 WerrorS("system(\"sdb_edit\",`proc`) expected");
2928 return TRUE;
2929 }
2930 return FALSE;
2931 }
2932 else
2933 #endif
2934 /*==================== GF =================*/
2935 #if 0 // for testing only
2936 if (strcmp(sys_cmd, "GF") == 0)
2937 {
2938 if ((h!=NULL) && (h->Typ()==POLY_CMD))
2939 {
2940 int c=rChar(currRing);
2941 setCharacteristic( c,nfMinPoly[0], currRing->parameter[0][0] );
2942 CanonicalForm F( convSingGFFactoryGF( (poly)h->Data(), currRing ) );
2943 res->rtyp=POLY_CMD;
2944 res->data=convFactoryGFSingGF( F, currRing );
2945 return FALSE;
2946 }
2947 else { WerrorS("wrong typ"); return TRUE;}
2948 }
2949 else
2950 #endif
2951 /*==================== SVD =================*/
2952 #ifdef HAVE_SVD
2953 if (strcmp(sys_cmd, "svd") == 0)
2954 {
2955 extern lists testsvd(matrix M);
2956 res->rtyp=LIST_CMD;
2957 res->data=(char*)(testsvd((matrix)h->Data()));
2958 return FALSE;
2959 }
2960 else
2961 #endif
2962 /*==================== redNF_ring =================*/
2963 if (strcmp(sys_cmd, "redNF_ring")==0)
2964 {
2965 ring r = currRing;
2966 poly f = (poly) h->Data();
2967 h = h->next;
2968 ideal G = (ideal) h->Data();
2969 res->rtyp=POLY_CMD;
2970 res->data=(poly) ringRedNF(f, G, r);
2971 return(FALSE);
2972 }
2973 else
2974 /*==================== Roune Hilb =================*/
2975 if (strcmp(sys_cmd, "hilbroune") == 0)
2976 {
2977 if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2978 {
2979 slicehilb((ideal)h->Data());
2980 }
2981 else return TRUE;
2982 return FALSE;
2983 }
2984 else
2985 /*==================== F5 Implementation =================*/
2986 #ifdef HAVE_F5
2987 if (strcmp(sys_cmd, "f5")==0)
2988 {
2989 if (h->Typ()!=IDEAL_CMD)
2990 {
2991 WerrorS("ideal expected");
2992 return TRUE;
2993 }
2994
2995 ring r = currRing;
2996 ideal G = (ideal) h->Data();
2997 h = h->next;
2998 int opt;
2999 if(h != NULL) {
3000 opt = (int) (long) h->Data();
3001 }
3002 else {
3003 opt = 2;
3004 }
3005 h = h->next;
3006 int plus;
3007 if(h != NULL) {
3008 plus = (int) (long) h->Data();
3009 }
3010 else {
3011 plus = 0;
3012 }
3013 h = h->next;
3014 int termination;
3015 if(h != NULL) {
3016 termination = (int) (long) h->Data();
3017 }
3018 else {
3019 termination = 0;
3020 }
3021 res->rtyp=IDEAL_CMD;
3022 res->data=(ideal) F5main(G,r,opt,plus,termination);
3023 return FALSE;
3024 }
3025 else
3026 #endif
3027 /*==================== Testing groebner basis =================*/
3028 if (strcmp(sys_cmd, "NF_ring")==0)
3029 {
3030 ring r = currRing;
3031 poly f = (poly) h->Data();
3032 h = h->next;
3033 ideal G = (ideal) h->Data();
3034 res->rtyp=POLY_CMD;
3035 res->data=(poly) ringNF(f, G, r);
3036 return(FALSE);
3037 }
3038 else
3039 if (strcmp(sys_cmd, "spoly")==0)
3040 {
3041 poly f = pCopy((poly) h->Data());
3042 h = h->next;
3043 poly g = pCopy((poly) h->Data());
3044
3045 res->rtyp=POLY_CMD;
3046 res->data=(poly) plain_spoly(f,g);
3047 return(FALSE);
3048 }
3049 else
3050 if (strcmp(sys_cmd, "testGB")==0)
3051 {
3052 ideal I = (ideal) h->Data();
3053 h = h->next;
3054 ideal GI = (ideal) h->Data();
3055 res->rtyp = INT_CMD;
3056 res->data = (void *)(long) testGB(I, GI);
3057 return(FALSE);
3058 }
3059 else
3060 /*==================== sca:AltVar ==================================*/
3061 #ifdef HAVE_PLURAL
3062 if ( (strcmp(sys_cmd, "AltVarStart") == 0) || (strcmp(sys_cmd, "AltVarEnd") == 0) )
3063 {
3064 ring r = currRing;
3065
3066 if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
3067 {
3068 WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
3069 return TRUE;
3070 }
3071
3072 res->rtyp=INT_CMD;
3073
3074 if (rIsSCA(r))
3075 {
3076 if(strcmp(sys_cmd, "AltVarStart") == 0)
3077 res->data = (void*)(long)scaFirstAltVar(r);
3078 else
3079 res->data = (void*)(long)scaLastAltVar(r);
3080 return FALSE;
3081 }
3082
3083 WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
3084 return TRUE;
3085 }
3086 else
3087 #endif
3088 /*==================== RatNF, noncomm rational coeffs =================*/
3089 #ifdef HAVE_RATGRING
3090 if (strcmp(sys_cmd, "intratNF") == 0)
3091 {
3092 poly p;
3093 poly *q;
3094 ideal I;
3095 int is, k, id;
3096 if ((h!=NULL) && (h->Typ()==POLY_CMD))
3097 {
3098 p=(poly)h->CopyD();
3099 h=h->next;
3100 // PrintS("poly is done\n");
3101 }
3102 else return TRUE;
3103 if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3104 {
3105 I=(ideal)h->CopyD();
3106 q = I->m;
3107 h=h->next;
3108 // PrintS("ideal is done\n");
3109 }
3110 else return TRUE;
3111 if ((h!=NULL) && (h->Typ()==INT_CMD))
3112 {
3113 is=(int)((long)(h->Data()));
3114 // res->rtyp=INT_CMD;
3115 // PrintS("int is done\n");
3116 // res->rtyp=IDEAL_CMD;
3118 {
3119 id = IDELEMS(I);
3120 int *pl=(int*)omAlloc0(IDELEMS(I)*sizeof(int));
3121 for(k=0; k < id; k++)
3122 {
3123 pl[k] = pLength(I->m[k]);
3124 }
3125 PrintS("starting redRat\n");
3126 //res->data = (char *)
3127 redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
3128 res->data=p;
3129 res->rtyp=POLY_CMD;
3130 // res->data = ncGCD(p,q,currRing);
3131 }
3132 else
3133 {
3134 res->rtyp=POLY_CMD;
3135 res->data=p;
3136 }
3137 }
3138 else return TRUE;
3139 return FALSE;
3140 }
3141 else
3142 /*==================== RatNF, noncomm rational coeffs =================*/
3143 if (strcmp(sys_cmd, "ratNF") == 0)
3144 {
3145 poly p,q;
3146 int is, htype;
3147 if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3148 {
3149 p=(poly)h->CopyD();
3150 h=h->next;
3151 htype = h->Typ();
3152 }
3153 else return TRUE;
3154 if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3155 {
3156 q=(poly)h->CopyD();
3157 h=h->next;
3158 }
3159 else return TRUE;
3160 if ((h!=NULL) && (h->Typ()==INT_CMD))
3161 {
3162 is=(int)((long)(h->Data()));
3163 res->rtyp=htype;
3164 // res->rtyp=IDEAL_CMD;
3166 {
3167 res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
3168 // res->data = ncGCD(p,q,currRing);
3169 }
3170 else res->data=p;
3171 }
3172 else return TRUE;
3173 return FALSE;
3174 }
3175 else
3176 /*==================== RatSpoly, noncomm rational coeffs =================*/
3177 if (strcmp(sys_cmd, "ratSpoly") == 0)
3178 {
3179 poly p,q;
3180 int is;
3181 if ((h!=NULL) && (h->Typ()==POLY_CMD))
3182 {
3183 p=(poly)h->CopyD();
3184 h=h->next;
3185 }
3186 else return TRUE;
3187 if ((h!=NULL) && (h->Typ()==POLY_CMD))
3188 {
3189 q=(poly)h->CopyD();
3190 h=h->next;
3191 }
3192 else return TRUE;
3193 if ((h!=NULL) && (h->Typ()==INT_CMD))
3194 {
3195 is=(int)((long)(h->Data()));
3196 res->rtyp=POLY_CMD;
3197 // res->rtyp=IDEAL_CMD;
3199 {
3200 res->data = nc_rat_CreateSpoly(p,q,is,currRing);
3201 // res->data = ncGCD(p,q,currRing);
3202 }
3203 else res->data=p;
3204 }
3205 else return TRUE;
3206 return FALSE;
3207 }
3208 else
3209 #endif // HAVE_RATGRING
3210 /*==================== Rat def =================*/
3211 if (strcmp(sys_cmd, "ratVar") == 0)
3212 {
3213 int start,end;
3214 if ((h!=NULL) && (h->Typ()==POLY_CMD))
3215 {
3216 start=pIsPurePower((poly)h->Data());
3217 h=h->next;
3218 }
3219 else return TRUE;
3220 if ((h!=NULL) && (h->Typ()==POLY_CMD))
3221 {
3222 end=pIsPurePower((poly)h->Data());
3223 h=h->next;
3224 }
3225 else return TRUE;
3226 currRing->real_var_start=start;
3227 currRing->real_var_end=end;
3228 return (start==0)||(end==0)||(start>end);
3229 }
3230 else
3231 /*==================== t-rep-GB ==================================*/
3232 if (strcmp(sys_cmd, "unifastmult")==0)
3233 {
3234 poly f = (poly)h->Data();
3235 h=h->next;
3236 poly g=(poly)h->Data();
3237 res->rtyp=POLY_CMD;
3238 res->data=unifastmult(f,g,currRing);
3239 return(FALSE);
3240 }
3241 else
3242 if (strcmp(sys_cmd, "multifastmult")==0)
3243 {
3244 poly f = (poly)h->Data();
3245 h=h->next;
3246 poly g=(poly)h->Data();
3247 res->rtyp=POLY_CMD;
3248 res->data=multifastmult(f,g,currRing);
3249 return(FALSE);
3250 }
3251 else
3252 if (strcmp(sys_cmd, "mults")==0)
3253 {
3254 res->rtyp=INT_CMD ;
3255 res->data=(void*)(long) Mults();
3256 return(FALSE);
3257 }
3258 else
3259 if (strcmp(sys_cmd, "fastpower")==0)
3260 {
3261 ring r = currRing;
3262 poly f = (poly)h->Data();
3263 h=h->next;
3264 int n=(int)((long)h->Data());
3265 res->rtyp=POLY_CMD ;
3266 res->data=(void*) pFastPower(f,n,r);
3267 return(FALSE);
3268 }
3269 else
3270 if (strcmp(sys_cmd, "normalpower")==0)
3271 {
3272 poly f = (poly)h->Data();
3273 h=h->next;
3274 int n=(int)((long)h->Data());
3275 res->rtyp=POLY_CMD ;
3276 res->data=(void*) pPower(pCopy(f),n);
3277 return(FALSE);
3278 }
3279 else
3280 if (strcmp(sys_cmd, "MCpower")==0)
3281 {
3282 ring r = currRing;
3283 poly f = (poly)h->Data();
3284 h=h->next;
3285 int n=(int)((long)h->Data());
3286 res->rtyp=POLY_CMD ;
3287 res->data=(void*) pFastPowerMC(f,n,r);
3288 return(FALSE);
3289 }
3290 else
3291 if (strcmp(sys_cmd, "bit_subst")==0)
3292 {
3293 ring r = currRing;
3294 poly outer = (poly)h->Data();
3295 h=h->next;
3296 poly inner=(poly)h->Data();
3297 res->rtyp=POLY_CMD ;
3298 res->data=(void*) uni_subst_bits(outer, inner,r);
3299 return(FALSE);
3300 }
3301 else
3302 /*==================== gcd-varianten =================*/
3303 if (strcmp(sys_cmd, "gcd") == 0)
3304 {
3305 if (h==NULL)
3306 {
3307 #if 0
3308 Print("FLINT_P:%d (use Flints gcd for polynomials in char p)\n",isOn(SW_USE_FL_GCD_P));
3309 Print("FLINT_0:%d (use Flints gcd for polynomials in char 0)\n",isOn(SW_USE_FL_GCD_0));
3310 #endif
3311 Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3312 Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3313 Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3314 #ifndef __CYGWIN__
3315 Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3316 #endif
3317 return FALSE;
3318 }
3319 else
3320 if ((h!=NULL) && (h->Typ()==STRING_CMD)
3321 && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3322 {
3323 int d=(int)(long)h->next->Data();
3324 char *s=(char *)h->Data();
3325 #if 0
3326 if (strcmp(s,"FLINT_P")==0) { if (d) On(SW_USE_FL_GCD_P); else Off(SW_USE_FL_GCD_P); } else
3327 if (strcmp(s,"FLINT_0")==0) { if (d) On(SW_USE_FL_GCD_0); else Off(SW_USE_FL_GCD_0); } else
3328 #endif
3329 if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3330 if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3331 if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3332 #ifndef __CYGWIN__
3333 if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3334 #endif
3335 return TRUE;
3336 return FALSE;
3337 }
3338 else return TRUE;
3339 }
3340 else
3341 /*==================== subring =================*/
3342 if (strcmp(sys_cmd, "subring") == 0)
3343 {
3344 if (h!=NULL)
3345 {
3346 extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3347 res->data=(char *)rSubring(currRing,h);
3348 res->rtyp=RING_CMD;
3349 return res->data==NULL;
3350 }
3351 else return TRUE;
3352 }
3353 else
3354 /*==================== HNF =================*/
3355 #ifdef HAVE_NTL
3356 if (strcmp(sys_cmd, "HNF") == 0)
3357 {
3358 if (h!=NULL)
3359 {
3360 res->rtyp=h->Typ();
3361 if (h->Typ()==MATRIX_CMD)
3362 {
3363 res->data=(char *)singntl_HNF((matrix)h->Data(), currRing);
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 if (h->Typ()==INTMAT_CMD)
3372 {
3373 res->data=(char *)singntl_HNF((intvec*)h->Data());
3374 return FALSE;
3375 }
3376 else
3377 {
3378 WerrorS("expected `system(\"HNF\",<matrix|intmat|bigintmat>)`");
3379 return TRUE;
3380 }
3381 }
3382 else return TRUE;
3383 }
3384 else
3385 /*================= probIrredTest ======================*/
3386 if (strcmp (sys_cmd, "probIrredTest") == 0)
3387 {
3388 if (h!=NULL && (h->Typ()== POLY_CMD) && ((h->next != NULL) && h->next->Typ() == STRING_CMD))
3389 {
3390 CanonicalForm F= convSingPFactoryP((poly)(h->Data()), currRing);
3391 char *s=(char *)h->next->Data();
3392 double error= atof (s);
3393 int irred= probIrredTest (F, error);
3394 res->rtyp= INT_CMD;
3395 res->data= (void*)(long)irred;
3396 return FALSE;
3397 }
3398 else return TRUE;
3399 }
3400 else
3401 #endif
3402 /*==================== mpz_t loader ======================*/
3403 if(strcmp(sys_cmd, "GNUmpLoad")==0)
3404 {
3405 if ((h != NULL) && (h->Typ() == STRING_CMD))
3406 {
3407 char* filename = (char*)h->Data();
3408 FILE* f = fopen(filename, "r");
3409 if (f == NULL)
3410 {
3411 WerrorS( "invalid file name (in paths use '/')");
3412 return FALSE;
3413 }
3414 mpz_t m; mpz_init(m);
3415 mpz_inp_str(m, f, 10);
3416 fclose(f);
3417 number n = n_InitMPZ(m, coeffs_BIGINT);
3418 res->rtyp = BIGINT_CMD;
3419 res->data = (void*)n;
3420 return FALSE;
3421 }
3422 else
3423 {
3424 WerrorS( "expected valid file name as a string");
3425 return TRUE;
3426 }
3427 }
3428 else
3429 /*==================== intvec matching ======================*/
3430 /* Given two non-empty intvecs, the call
3431 'system("intvecMatchingSegments", ivec, jvec);'
3432 computes all occurences of jvec in ivec, i.e., it returns
3433 a list of int indices k such that ivec[k..size(jvec)+k-1] = jvec.
3434 If no such k exists (e.g. when ivec is shorter than jvec), an
3435 intvec with the single entry 0 is being returned. */
3436 if(strcmp(sys_cmd, "intvecMatchingSegments")==0)
3437 {
3438 if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3439 (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3440 (h->next->next == NULL))
3441 {
3442 intvec* ivec = (intvec*)h->Data();
3443 intvec* jvec = (intvec*)h->next->Data();
3444 intvec* r = new intvec(1); (*r)[0] = 0;
3445 int validEntries = 0;
3446 for (int k = 0; k <= ivec->rows() - jvec->rows(); k++)
3447 {
3448 if (memcmp(&(*ivec)[k], &(*jvec)[0],
3449 sizeof(int) * jvec->rows()) == 0)
3450 {
3451 if (validEntries == 0)
3452 (*r)[0] = k + 1;
3453 else
3454 {
3455 r->resize(validEntries + 1);
3456 (*r)[validEntries] = k + 1;
3457 }
3458 validEntries++;
3459 }
3460 }
3461 res->rtyp = INTVEC_CMD;
3462 res->data = (void*)r;
3463 return FALSE;
3464 }
3465 else
3466 {
3467 WerrorS("expected two non-empty intvecs as arguments");
3468 return TRUE;
3469 }
3470 }
3471 else
3472 /* ================== intvecOverlap ======================= */
3473 /* Given two non-empty intvecs, the call
3474 'system("intvecOverlap", ivec, jvec);'
3475 computes the longest intvec kvec such that ivec ends with kvec
3476 and jvec starts with kvec. The length of this overlap is being
3477 returned. If there is no overlap at all, then 0 is being returned. */
3478 if(strcmp(sys_cmd, "intvecOverlap")==0)
3479 {
3480 if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3481 (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3482 (h->next->next == NULL))
3483 {
3484 intvec* ivec = (intvec*)h->Data();
3485 intvec* jvec = (intvec*)h->next->Data();
3486 int ir = ivec->rows(); int jr = jvec->rows();
3487 int r = jr; if (ir < jr) r = ir; /* r = min{ir, jr} */
3488 while ((r >= 1) && (memcmp(&(*ivec)[ir - r], &(*jvec)[0],
3489 sizeof(int) * r) != 0))
3490 r--;
3491 res->rtyp = INT_CMD;
3492 res->data = (void*)(long)r;
3493 return FALSE;
3494 }
3495 else
3496 {
3497 WerrorS("expected two non-empty intvecs as arguments");
3498 return TRUE;
3499 }
3500 }
3501 else
3502 /*==================== Hensel's lemma ======================*/
3503 if(strcmp(sys_cmd, "henselfactors")==0)
3504 {
3505 if ((h != NULL) && (h->Typ() == INT_CMD) &&
3506 (h->next != NULL) && (h->next->Typ() == INT_CMD) &&
3507 (h->next->next != NULL) && (h->next->next->Typ() == POLY_CMD) &&
3508 (h->next->next->next != NULL) &&
3509 (h->next->next->next->Typ() == POLY_CMD) &&
3510 (h->next->next->next->next != NULL) &&
3511 (h->next->next->next->next->Typ() == POLY_CMD) &&
3512 (h->next->next->next->next->next != NULL) &&
3513 (h->next->next->next->next->next->Typ() == INT_CMD) &&
3514 (h->next->next->next->next->next->next == NULL))
3515 {
3516 int xIndex = (int)(long)h->Data();
3517 int yIndex = (int)(long)h->next->Data();
3518 poly hh = (poly)h->next->next->Data();
3519 poly f0 = (poly)h->next->next->next->Data();
3520 poly g0 = (poly)h->next->next->next->next->Data();
3521 int d = (int)(long)h->next->next->next->next->next->Data();
3522 poly f; poly g;
3523 henselFactors(xIndex, yIndex, hh, f0, g0, d, f, g);
3525 L->Init(2);
3526 L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
3527 L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
3528 res->rtyp = LIST_CMD;
3529 res->data = (char *)L;
3530 return FALSE;
3531 }
3532 else
3533 {
3534 WerrorS( "expected argument list (int, int, poly, poly, poly, int)");
3535 return TRUE;
3536 }
3537 }
3538 else
3539 /*==================== Approx_Step =================*/
3540 #ifdef HAVE_PLURAL
3541 if (strcmp(sys_cmd, "astep") == 0)
3542 {
3543 ideal I;
3544 if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3545 {
3546 I=(ideal)h->CopyD();
3547 res->rtyp=IDEAL_CMD;
3548 if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
3549 else res->data=I;
3551 }
3552 else return TRUE;
3553 return FALSE;
3554 }
3555 else
3556 #endif
3557 /*==================== PrintMat =================*/
3558 #ifdef HAVE_PLURAL
3559 if (strcmp(sys_cmd, "PrintMat") == 0)
3560 {
3561 int a=0;
3562 int b=0;
3563 ring r=NULL;
3564 int metric=0;
3565 if (h!=NULL)
3566 {
3567 if (h->Typ()==INT_CMD)
3568 {
3569 a=(int)((long)(h->Data()));
3570 h=h->next;
3571 }
3572 else if (h->Typ()==INT_CMD)
3573 {
3574 b=(int)((long)(h->Data()));
3575 h=h->next;
3576 }
3577 else if (h->Typ()==RING_CMD)
3578 {
3579 r=(ring)h->Data();
3580 h=h->next;
3581 }
3582 else
3583 return TRUE;
3584 }
3585 else
3586 return TRUE;
3587 if ((h!=NULL) && (h->Typ()==INT_CMD))
3588 {
3589 metric=(int)((long)(h->Data()));
3590 }
3591 res->rtyp=MATRIX_CMD;
3592 if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
3593 else res->data=NULL;
3594 return FALSE;
3595 }
3596 else
3597 #endif
3598/* ============ NCUseExtensions ======================== */
3599 #ifdef HAVE_PLURAL
3600 if(strcmp(sys_cmd,"NCUseExtensions")==0)
3601 {
3602 if ((h!=NULL) && (h->Typ()==INT_CMD))
3603 res->data=(void *)(long)setNCExtensions( (int)((long)(h->Data())) );
3604 else
3605 res->data=(void *)(long)getNCExtensions();
3606 res->rtyp=INT_CMD;
3607 return FALSE;
3608 }
3609 else
3610 #endif
3611/* ============ NCGetType ======================== */
3612 #ifdef HAVE_PLURAL
3613 if(strcmp(sys_cmd,"NCGetType")==0)
3614 {
3615 res->rtyp=INT_CMD;
3616 if( rIsPluralRing(currRing) )
3617 res->data=(void *)(long)ncRingType(currRing);
3618 else
3619 res->data=(void *)(-1L);
3620 return FALSE;
3621 }
3622 else
3623 #endif
3624/* ============ ForceSCA ======================== */
3625 #ifdef HAVE_PLURAL
3626 if(strcmp(sys_cmd,"ForceSCA")==0)
3627 {
3628 if( !rIsPluralRing(currRing) )
3629 return TRUE;
3630 int b, e;
3631 if ((h!=NULL) && (h->Typ()==INT_CMD))
3632 {
3633 b = (int)((long)(h->Data()));
3634 h=h->next;
3635 }
3636 else return TRUE;
3637 if ((h!=NULL) && (h->Typ()==INT_CMD))
3638 {
3639 e = (int)((long)(h->Data()));
3640 }
3641 else return TRUE;
3642 if( !sca_Force(currRing, b, e) )
3643 return TRUE;
3644 return FALSE;
3645 }
3646 else
3647 #endif
3648/* ============ ForceNewNCMultiplication ======================== */
3649 #ifdef HAVE_PLURAL
3650 if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0)
3651 {
3652 if( !rIsPluralRing(currRing) )
3653 return TRUE;
3654 if( !ncInitSpecialPairMultiplication(currRing) ) // No Plural!
3655 return TRUE;
3656 return FALSE;
3657 }
3658 else
3659 #endif
3660/* ============ ForceNewOldNCMultiplication ======================== */
3661 #ifdef HAVE_PLURAL
3662 if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0)
3663 {
3664 if( !rIsPluralRing(currRing) )
3665 return TRUE;
3666 if( !ncInitSpecialPowersMultiplication(currRing) ) // Enable Formula for Plural (depends on swiches)!
3667 return TRUE;
3668 return FALSE;
3669 }
3670 else
3671 #endif
3672/*==================== test64 =================*/
3673 #if 0
3674 if(strcmp(sys_cmd,"test64")==0)
3675 {
3676 long l=8;int i;
3677 for(i=1;i<62;i++)
3678 {
3679 l=l<<1;
3680 number n=n_Init(l,coeffs_BIGINT);
3681 Print("%ld= ",l);n_Print(n,coeffs_BIGINT);
3685 PrintS(" F:");
3687 PrintLn();
3689 }
3690 Print("SIZEOF_LONG=%d\n",SIZEOF_LONG);
3691 return FALSE;
3692 }
3693 else
3694 #endif
3695/*==================== n_SwitchChinRem =================*/
3696 if(strcmp(sys_cmd,"cache_chinrem")==0)
3697 {
3699 Print("caching inverse in chines remainder:%d\n",n_SwitchChinRem);
3700 if ((h!=NULL)&&(h->Typ()==INT_CMD))
3701 n_SwitchChinRem=(int)(long)h->Data();
3702 return FALSE;
3703 }
3704 else
3705/*==================== LU for bigintmat =================*/
3706#ifdef SINGULAR_4_2
3707 if(strcmp(sys_cmd,"LU")==0)
3708 {
3709 if ((h!=NULL) && (h->Typ()==CMATRIX_CMD))
3710 {
3711 // get the argument:
3712 bigintmat *b=(bigintmat *)h->Data();
3713 // just for tests: simply transpose
3714 bigintmat *bb=b->transpose();
3715 // return the result:
3716 res->rtyp=CMATRIX_CMD;
3717 res->data=(char*)bb;
3718 return FALSE;
3719 }
3720 else
3721 {
3722 WerrorS("system(\"LU\",<cmatrix>) expected");
3723 return TRUE;
3724 }
3725 }
3726 else
3727#endif
3728/*==================== sort =================*/
3729 if(strcmp(sys_cmd,"sort")==0)
3730 {
3731 extern BOOLEAN jjSORTLIST(leftv,leftv);
3732 if (h->Typ()==LIST_CMD)
3733 return jjSORTLIST(res,h);
3734 else
3735 return TRUE;
3736 }
3737 else
3738/*==================== uniq =================*/
3739 if(strcmp(sys_cmd,"uniq")==0)
3740 {
3741 extern BOOLEAN jjUNIQLIST(leftv, leftv);
3742 if (h->Typ()==LIST_CMD)
3743 return jjUNIQLIST(res,h);
3744 else
3745 return TRUE;
3746 }
3747 else
3748/*==================== GF(p,n) ==================================*/
3749 if(strcmp(sys_cmd,"GF")==0)
3750 {
3751 const short t[]={3,INT_CMD,INT_CMD,STRING_CMD};
3752 if (iiCheckTypes(h,t,1))
3753 {
3754 int p=(int)(long)h->Data();
3755 int n=(int)(long)h->next->Data();
3756 char *v=(char*)h->next->next->CopyD();
3757 GFInfo param;
3758 param.GFChar = p;
3759 param.GFDegree = n;
3760 param.GFPar_name = v;
3761 coeffs cf= nInitChar(n_GF, &param);
3762 res->rtyp=CRING_CMD;
3763 res->data=cf;
3764 return FALSE;
3765 }
3766 else
3767 return TRUE;
3768 }
3769 else
3770/*==================== power* ==================================*/
3771 #if 0
3772 if(strcmp(sys_cmd,"power1")==0)
3773 {
3774 res->rtyp=POLY_CMD;
3775 poly f=(poly)h->CopyD();
3776 poly g=pPower(f,2000);
3777 res->data=(void *)g;
3778 return FALSE;
3779 }
3780 else
3781 if(strcmp(sys_cmd,"power2")==0)
3782 {
3783 res->rtyp=POLY_CMD;
3784 poly f=(poly)h->Data();
3785 poly g=pOne();
3786 for(int i=0;i<2000;i++)
3787 g=pMult(g,pCopy(f));
3788 res->data=(void *)g;
3789 return FALSE;
3790 }
3791 if(strcmp(sys_cmd,"power3")==0)
3792 {
3793 res->rtyp=POLY_CMD;
3794 poly f=(poly)h->Data();
3795 poly p2=pMult(pCopy(f),pCopy(f));
3796 poly p4=pMult(pCopy(p2),pCopy(p2));
3797 poly p8=pMult(pCopy(p4),pCopy(p4));
3798 poly p16=pMult(pCopy(p8),pCopy(p8));
3799 poly p32=pMult(pCopy(p16),pCopy(p16));
3800 poly p64=pMult(pCopy(p32),pCopy(p32));
3801 poly p128=pMult(pCopy(p64),pCopy(p64));
3802 poly p256=pMult(pCopy(p128),pCopy(p128));
3803 poly p512=pMult(pCopy(p256),pCopy(p256));
3804 poly p1024=pMult(pCopy(p512),pCopy(p512));
3805 poly p1536=pMult(p1024,p512);
3806 poly p1792=pMult(p1536,p256);
3807 poly p1920=pMult(p1792,p128);
3808 poly p1984=pMult(p1920,p64);
3809 poly p2000=pMult(p1984,p16);
3810 res->data=(void *)p2000;
3811 pDelete(&p2);
3812 pDelete(&p4);
3813 pDelete(&p8);
3814 //pDelete(&p16);
3815 pDelete(&p32);
3816 //pDelete(&p64);
3817 //pDelete(&p128);
3818 //pDelete(&p256);
3819 //pDelete(&p512);
3820 //pDelete(&p1024);
3821 //pDelete(&p1536);
3822 //pDelete(&p1792);
3823 //pDelete(&p1920);
3824 //pDelete(&p1984);
3825 return FALSE;
3826 }
3827 else
3828 #endif
3829/* ccluster --------------------------------------------------------------*/
3830#ifdef HAVE_CCLUSTER
3831 if(strcmp(sys_cmd,"ccluster")==0)
3832 {
3833 if ((currRing!=NULL)
3835 {
3838
3839// printf("test t : %d\n", h->Typ()==POLY_CMD);
3840// printf("test t : %d\n", h->next->Typ()==POLY_CMD);
3841 int pol_with_complex_coeffs=0;
3842 if (h->next->Typ()==POLY_CMD)
3843 pol_with_complex_coeffs=1;
3844
3845 if ( (pol_with_complex_coeffs==0 && iiCheckTypes(h,t,1))
3846 ||(pol_with_complex_coeffs==1 && iiCheckTypes(h,t2,1)) )
3847 {
3848 // convert first arg. to fmpq_poly_t
3849 fmpq_poly_t fre, fim;
3850 convSingPFlintP(fre,(poly)h->Data(),currRing); h=h->next;
3851 if (pol_with_complex_coeffs==1)
3852 { // convert second arg. to fmpq_poly_t
3853 convSingPFlintP(fim,(poly)h->Data(),currRing); h=h->next;
3854 }
3855 // convert box-center(re,im), box-size, epsilon
3856 fmpq_t center_re,center_im,boxsize,eps;
3857 convSingNFlintN(center_re,(number)h->Data(),currRing->cf); h=h->next;
3858 convSingNFlintN(center_im,(number)h->Data(),currRing->cf); h=h->next;
3859 convSingNFlintN(boxsize,(number)h->Data(),currRing->cf); h=h->next;
3860 convSingNFlintN(eps,(number)h->Data(),currRing->cf); h=h->next;
3861 // alloc arrays
3862 int n=fmpq_poly_length(fre);
3863 fmpq_t* re_part=(fmpq_t*)omAlloc(n*sizeof(fmpq_t));
3864 fmpq_t* im_part=(fmpq_t*)omAlloc(n*sizeof(fmpq_t));
3865 int *mult =(int*) omAlloc(n*sizeof(int));
3866 for(int i=0; i<n;i++)
3867 { fmpq_init(re_part[i]); fmpq_init(im_part[i]); }
3868 // call cccluster, adjust n
3869 int verbosity =0; //nothing is printed
3870 int strategy = 23; //default strategy
3871 int nn=0;
3872 long nb_threads = (long) feOptValue(FE_OPT_CPUS);
3873 strategy = strategy+(nb_threads<<6);
3874// printf("nb threads: %ld\n", nb_threads);
3875// printf("strategy: %ld\n", strategy);
3876 if (pol_with_complex_coeffs==0)
3877 nn=ccluster_interface_poly_real(re_part,im_part,mult,fre,center_re,center_im,boxsize,eps,strategy,verbosity);
3878 else
3879 nn=ccluster_interface_poly_real_imag(re_part,im_part,mult,fre,fim,center_re,center_im,boxsize,eps,strategy,verbosity);
3880 // convert to list
3882 l->Init(nn);
3883 for(int i=0; i<nn;i++)
3884 {
3886 l->m[i].rtyp=LIST_CMD;
3887 l->m[i].data=ll;
3888 ll->Init(3);
3889 ll->m[0].rtyp=NUMBER_CMD;
3890 ll->m[1].rtyp=NUMBER_CMD;
3891 ll->m[2].rtyp=INT_CMD;
3892 ll->m[0].data=convFlintNSingN(re_part[i],currRing->cf);
3893 ll->m[1].data=convFlintNSingN(im_part[i],currRing->cf);
3894 ll->m[2].data=(void *)(long)mult[i];
3895 }
3896 //clear re, im, mults, fre, fim
3897 for(int i=n-1;i>=0;i--) { fmpq_clear(re_part[i]); fmpq_clear(im_part[i]); }
3898 omFree(re_part);
3899 omFree(im_part);
3900 omFree(mult);
3901 fmpq_clear(center_re); fmpq_clear(center_im); fmpq_clear(boxsize); fmpq_clear(eps);
3902 fmpq_poly_clear(fre);
3903 if (pol_with_complex_coeffs==1) fmpq_poly_clear(fim);
3904 // result
3905 res->rtyp=LIST_CMD;
3906 res->data=l;
3907 return FALSE;
3908 }
3909 }
3910 return TRUE;
3911 }
3912 else
3913#endif
3914/* ====== maEvalAt ============================*/
3915 if(strcmp(sys_cmd,"evaluate")==0)
3916 {
3917 extern number maEvalAt(const poly p,const number* pt, const ring r);
3918 if (h->Typ()!=POLY_CMD)
3919 {
3920 WerrorS("expected system(\"evaluate\",<poly>,..)");
3921 return TRUE;
3922 }
3923 poly p=(poly)h->Data();
3924 number *pt=(number*)omAlloc(sizeof(number)*currRing->N);
3925 for(int i=0;i<currRing->N;i++)
3926 {
3927 h=h->next;
3928 if ((h==NULL)||(h->Typ()!=NUMBER_CMD))
3929 {
3930 WerrorS("system(\"evaluate\",<poly>,<number>..) - expect number");
3931 return TRUE;
3932 }
3933 pt[i]=(number)h->Data();
3934 }
3935 res->data=maEvalAt(p,pt,currRing);
3936 res->rtyp=NUMBER_CMD;
3937 return FALSE;
3938 }
3939 else
3940/* ====== DivRem ============================*/
3941 if(strcmp(sys_cmd,"DivRem")==0)
3942 {
3943 const short t1[]={2,POLY_CMD,POLY_CMD};
3944 if (iiCheckTypes(h,t1,1))
3945 {
3946 poly p=(poly)h->CopyD();
3947 poly q=(poly)h->next->CopyD();
3948 poly rest;
3949 res->data=p_DivRem(p,q,rest,currRing);
3950 res->rtyp=POLY_CMD;
3951 PrintS("rest:");pWrite(rest);
3952 return FALSE;
3953 }
3954 else
3955 {
3956 WerrorS("expected system(\"DivRem\",<poly>,<poly>)");
3957 return TRUE;
3958 }
3959 }
3960 else
3961/* ====== DivRemId ============================*/
3962 if(strcmp(sys_cmd,"DivRemIdU")==0)
3963 {
3964 const short t1[]={2,IDEAL_CMD,IDEAL_CMD};
3965 const short t2[]={2,MODUL_CMD,MODUL_CMD};
3966 if (iiCheckTypes(h,t1,0)
3967 || iiCheckTypes(h,t2,0))
3968 {
3969 ideal p=(ideal)h->CopyD();
3970 ideal q=(ideal)h->next->CopyD();
3971 ideal factors;
3972 ideal unit;
3973 ideal rest=idDivRem(p,q,factors,&unit,0);
3974 //matrix T = id_Module2Matrix(factors,currRing);
3975 //matrix U = id_Module2Matrix(unit,currRing);
3977 L->Init(3);
3978 //L->m[0].rtyp=h->Typ(); L->m[0].data=(void *)rest;
3979 L->m[0].rtyp=MODUL_CMD; L->m[0].data=(void *)rest;
3980 L->m[1].rtyp=MODUL_CMD; L->m[1].data=(void *)factors;
3981 L->m[2].rtyp=MODUL_CMD; L->m[2].data=(void *)unit;
3982 res->rtyp=LIST_CMD;
3983 res->data=L;
3984 return FALSE;
3985 }
3986 else
3987 {
3988 WerrorS("expected system(\"DivRemId\",<ideal>,<ideal>)");
3989 return TRUE;
3990 }
3991 }
3992 else
3993 if(strcmp(sys_cmd,"DivRemId")==0)
3994 {
3995 const short t1[]={2,IDEAL_CMD,IDEAL_CMD};
3996 const short t2[]={2,MODUL_CMD,MODUL_CMD};
3997 if (iiCheckTypes(h,t1,0)
3998 || iiCheckTypes(h,t2,0))
3999 {
4000 ideal p=(ideal)h->CopyD();
4001 ideal q=(ideal)h->next->CopyD();
4002 ideal rest;
4003 ideal quot=idDivRem(p,q,rest,NULL,0);
4006 L->Init(2);
4007 L->m[0].rtyp=IDEAL_CMD; L->m[0].data=(void *)quot;
4008 L->m[1].rtyp=MATRIX_CMD; L->m[1].data=(void *)T;
4009 res->rtyp=LIST_CMD;
4010 res->data=L;
4011 return FALSE;
4012 }
4013 else
4014 {
4015 WerrorS("expected system(\"DivRemId\",<ideal>,<ideal>)");
4016 return TRUE;
4017 }
4018 }
4019 else
4020/* ====== CoeffTerm ============================*/
4021 if(strcmp(sys_cmd,"CoeffTerm")==0)
4022 {
4023 const short t1[]={2,POLY_CMD,POLY_CMD};
4024 const short t2[]={2,VECTOR_CMD,VECTOR_CMD};
4025 const short t3[]={2,IDEAL_CMD,POLY_CMD};
4026 const short t4[]={2,MODUL_CMD,VECTOR_CMD};
4027 const short t5[]={2,VECTOR_CMD,POLY_CMD};
4028 const short t6[]={2,MODUL_CMD,POLY_CMD};
4029 const short t7[]={2,VECTOR_CMD,IDEAL_CMD};
4030 const short t8[]={2,VECTOR_CMD,MODUL_CMD};
4031 if (iiCheckTypes(h,t1,0)
4032 || iiCheckTypes(h,t2,0))
4033 {
4034 poly p=(poly)h->Data();
4035 poly q=(poly)h->next->Data();
4036 res->data=p_CoeffTerm(p,q,currRing);
4037 res->rtyp=NUMBER_CMD;
4038 return FALSE;
4039 }
4040 else if (iiCheckTypes(h,t3,0)
4041 || iiCheckTypes(h,t4,0))
4042 {
4043 ideal p=(ideal)h->Data();
4044 poly q=(poly)h->next->Data();
4045 res->data=id_CoeffTerm(p,q,currRing);
4046 res->rtyp=h->Typ();
4047 return FALSE;
4048 }
4049 else if (iiCheckTypes(h,t5,0))
4050 {
4051 poly p=(poly)h->Data();
4052 poly q=(poly)h->next->Data();
4053 res->data=p_CoeffTermV(p,q,currRing);
4054 res->rtyp=VECTOR_CMD;
4055 return FALSE;
4056 }
4057 else if (iiCheckTypes(h,t6,0))
4058 {
4059 ideal p=(ideal)h->Data();
4060 poly q=(poly)h->next->Data();
4061 res->data=id_CoeffTermV(p,q,currRing);
4062 res->rtyp=MODUL_CMD;
4063 return FALSE;
4064 }
4065 else if (iiCheckTypes(h,t7,0)) /* vector,ideal*/
4066 {
4067 poly p=(poly)h->Data();
4068 ideal q=(ideal)h->next->Data();
4070 res->rtyp=VECTOR_CMD;
4071 return FALSE;
4072 }
4073 else if (iiCheckTypes(h,t8,0)) /* vector,module*/
4074 {
4075 poly p=(poly)h->Data();
4076 ideal q=(ideal)h->next->Data();
4078 res->rtyp=VECTOR_CMD;
4079 return FALSE;
4080 }
4081 else
4082 {
4083 WerrorS("expected system(\"CoeffTerm\",<poly>/<vector>,<poly>/<vector>)" "\n or <ideal>/<module>,<poly>/<vector>");
4084 return TRUE;
4085 }
4086 }
4087 else
4088/*==================== sat1 =================*/
4089 if(strcmp(sys_cmd,"sat1")==0)
4090 {
4091 ideal I= (ideal)h->Data();
4092 ideal J=(ideal)h->next->Data();
4093 res->rtyp=IDEAL_CMD;
4094 res->data=(void*)id_Sat_principal(I,J,currRing);
4095 return FALSE;
4096 }
4097 else
4098/*==================== minres_with_map =================*/
4099 if(strcmp(sys_cmd,"minres_with_map")==0)
4100 {
4101 syStrategy r= syCopy((syStrategy)h->Data());
4102 ideal trans;
4103 res->rtyp=RESOLUTION_CMD;
4104 syMinimize_with_map(r,trans);
4105 res->data=(void*)r;
4107 res->next->data=(void*)trans;
4108 res->next->rtyp=MODUL_CMD;
4109 return FALSE;
4110 }
4111 else
4112/*==================== sat =================*/
4113#if 0
4114 if(strcmp(sys_cmd,"sat_with_exp")==0)
4115 {
4116 ideal I= (ideal)h->Data();
4117 ideal J=(ideal)h->next->Data();
4118 int k;
4119 ideal S=idSaturate(I,J,k,h->Typ()==IDEAL_CMD);
4121 L->Init(2);
4122 L->m[0].rtyp = h->Typ(); L->m[0].data=(void*)S; // ideal or module
4123 setFlag(&(L->m[0]),FLAG_STD);
4124 L->m[1].rtyp = INT_CMD; L->m[1].data=(void*)(long)k;
4125 res->rtyp=LIST_CMD;
4126 res->data=(void*)L;
4127 return FALSE;
4128 }
4129 else
4130#endif
4131/*==================== Error =================*/
4132 Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
4133 }
4134 return TRUE;
4135}
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:4086
g
Definition cfModGcd.cc:4098
CanonicalForm cf
Definition cfModGcd.cc:4091
CanonicalForm b
Definition cfModGcd.cc:4111
EXTERN_VAR int singular_homog_flag
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:138
matrix singntl_HNF(matrix m, const ring s)
Definition clapsing.cc:1819
factory's main class
Matrices of numbers.
Definition bigintmat.h:51
void resize(int new_length)
Definition intvec.cc:106
int rows() const
Definition intvec.h:96
int rtyp
Definition subexpr.h:91
void * data
Definition subexpr.h:88
sleftv * m
Definition lists.h:46
INLINE_THIS void Init(int l=0)
int GFDegree
Definition coeffs.h:102
@ 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:971
void n_Print(number &a, const coeffs r)
print a number (BEWARE of string buffers!) mostly for debugging
Definition numbers.cc:655
static FORCE_INLINE CanonicalForm n_convSingNFactoryN(number n, BOOLEAN setChar, const coeffs r)
Definition coeffs.h:974
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition numbers.cc:406
static FORCE_INLINE int n_GetChar(const coeffs r)
Return the characteristic of the coeff. domain.
Definition coeffs.h:448
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition coeffs.h:459
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition coeffs.h:543
static FORCE_INLINE number n_Init(long i, const coeffs r)
a number representing i in the given coeff field/ring r
Definition coeffs.h:539
const char * GFPar_name
Definition coeffs.h:103
int GFChar
Definition coeffs.h:101
Creation data needed for finite fields.
Definition coeffs.h:100
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
unsigned long ** singularMatrixToLongMatrix(matrix singularMatrix)
Definition extra.cc:176
poly longCoeffsToSingularPoly(unsigned long *polyCoeffs, const int degree)
Definition extra.cc:208
EXTERN_VAR BOOLEAN FE_OPT_NO_SHELL_FLAG
Definition extra.cc:169
ideal F5main(ideal id, ring r, int opt, int plus, int termination)
Definition f5gb.cc:1889
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?
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...
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:545
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:170
#define EXTERN_VAR
Definition globaldefs.h:6
@ IDEAL_CMD
Definition grammar.cc:285
@ MATRIX_CMD
Definition grammar.cc:287
@ PROC_CMD
Definition grammar.cc:281
@ INTMAT_CMD
Definition grammar.cc:280
@ MODUL_CMD
Definition grammar.cc:288
@ VECTOR_CMD
Definition grammar.cc:293
@ RESOLUTION_CMD
Definition grammar.cc:291
@ NUMBER_CMD
Definition grammar.cc:289
@ POLY_CMD
Definition grammar.cc:290
@ RING_CMD
Definition grammar.cc:282
void slicehilb(ideal I)
Definition hilb.cc:666
ideal id_Sat_principal(ideal I, ideal J, const ring origR)
Definition ideals.cc:3376
ideal idSaturate(ideal I, ideal J, int &k, BOOLEAN isIdeal)
Definition ideals.cc:3456
STATIC_VAR coordinates * points
BOOLEAN jjSORTLIST(leftv, leftv arg)
Definition iparith.cc:10476
BOOLEAN jjUNIQLIST(leftv, leftv arg)
Definition iparith.cc:10485
VAR coeffs coeffs_BIGINT
Definition ipid.cc:50
EXTERN_VAR omBin sleftv_bin
Definition ipid.h:145
#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:6557
ring rSubring(ring org_ring, sleftv *rv)
Definition ipshell.cc:6000
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:1171
ideal idDivRem(ideal A, const ideal quot, ideal &factor, ideal *unit, int lazyReduce)
Definition kLiftstd.cc:347
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:5283
int posInT11(const TSet set, const int length, LObject &p)
Definition kutil.cc:4958
int posInT1(const TSet set, const int length, LObject &p)
Definition kutil.cc:4901
int posInT0(const TSet, const int length, LObject &)
Definition kutil.cc:4890
int posInT2(const TSet set, const int length, LObject &p)
Definition kutil.cc:4930
int posInT_pLength(const TSet set, const int length, LObject &p)
Definition kutil.cc:11466
int posInT13(const TSet set, const int length, LObject &p)
Definition kutil.cc:5122
int posInT17_c(const TSet set, const int length, LObject &p)
Definition kutil.cc:5389
int posInT_EcartFDegpLength(const TSet set, const int length, LObject &p)
Definition kutil.cc:11375
int posInT15(const TSet set, const int length, LObject &p)
Definition kutil.cc:5189
int posInT110(const TSet set, const int length, LObject &p)
Definition kutil.cc:5034
int posInT19(const TSet set, const int length, LObject &p)
Definition kutil.cc:5515
int posInT_FDegpLength(const TSet set, const int length, LObject &p)
Definition kutil.cc:11429
static bool rIsSCA(const ring r)
Definition nc.h:190
int & getNCExtensions()
Definition old.gring.cc:82
static nc_type & ncRingType(nc_struct *p)
Definition nc.h:159
int setNCExtensions(int iMask)
Definition old.gring.cc:87
matrix nc_PrintMat(int a, int b, ring r, int metric)
returns matrix with the info on noncomm multiplication
bool sca_Force(ring rGR, int b, int e)
Definition sca.cc:1159
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:3086
matrix mp_Transp(matrix a, const ring R)
Definition matpol.cc:247
matrix mp_InitI(int r, int c, int v, const ring R)
make it a v * unit matrix
Definition matpol.cc:122
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
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition minpoly.cc:647
unsigned long * computeMinimalPolynomial(unsigned long **matrix, unsigned n, unsigned long p)
Definition minpoly.cc:428
#define pIter(p)
Definition monomials.h:37
#define error(a)
slists * lists
The main handler for Singular numbers which are suitable for Singular polynomials.
bool ncInitSpecialPowersMultiplication(ring r)
BOOLEAN ncInitSpecialPairMultiplication(ring r)
Definition ncSAMult.cc:266
ideal Approx_Step(ideal L)
Ann: ???
Definition nc.cc:250
#define omStrDup(s)
#define omFreeSize(addr, size)
#define omAlloc(size)
#define omAllocBin(bin)
#define omAlloc0Bin(bin)
#define omFree(addr)
#define omAlloc0(size)
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
poly p_CoeffTermMo(poly v, ideal m, int n, const ring r)
find coeffs of a vector of a matrix(module) of given monomials, n>=max_comp(v)
Definition pCoeff.cc:113
poly p_CoeffTermId(poly v, ideal m, int n, const ring r)
find coeffs of a vector of a list of given monomials, n>=max_comp(v)
Definition pCoeff.cc:86
number p_CoeffTerm(poly p, poly m, const ring r)
find coeff of (polynomial) m in polynomial p find coeff of (vector) m in vector p
Definition pCoeff.cc:22
ideal id_CoeffTermV(ideal M, poly m, const ring r)
find coeffs of (polynomial) m in all vectors from I
Definition pCoeff.cc:75
ideal id_CoeffTerm(ideal I, poly m, const ring r)
find coeffs of (polynomial) m in all polynomials from I find coeffs of (vector) m in all vectors from...
Definition pCoeff.cc:63
poly p_CoeffTermV(poly v, poly m, const ring r)
find vector of coeffs of (polynomial) m in vector v
Definition pCoeff.cc:39
static int pLength(poly a)
Definition p_polys.h:190
static long p_MaxComp(poly p, ring lmRing, ring tailRing)
Definition p_polys.h:292
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:316
#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:368
#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:3465
void p_DebugPrint(poly p, const ring r)
Definition ring.cc:4358
int rChar(ring r)
Definition ring.cc:716
void rDebugPrint(const ring r)
Definition ring.cc:4153
void rSetSyzComp(int k, const ring r)
Definition ring.cc:5169
static BOOLEAN rField_is_R(const ring r)
Definition ring.h:523
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition ring.h:405
@ ringorder_s
s?
Definition ring.h:76
static BOOLEAN rField_is_Q(const ring r)
Definition ring.h:511
static BOOLEAN rField_is_long_R(const ring r)
Definition ring.h:547
poly ringNF(poly f, ideal G, ring r)
Definition ringgb.cc:196
poly plain_spoly(poly f, poly g)
Definition ringgb.cc:163
poly ringRedNF(poly f, ideal G, ring r)
Definition ringgb.cc:116
int testGB(ideal I, ideal GI)
Definition ringgb.cc:223
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:69
ideal id_Vec2Ideal(poly vec, const ring R)
matrix id_Module2Matrix(ideal mod, const ring R)
#define IDELEMS(i)
#define R
Definition sirandom.c:27
#define M
Definition sirandom.c:25
sleftv * leftv
Definition structs.h:57
@ testHomog
Definition structs.h:38
procinfo * procinfov
Definition structs.h:60
BOOLEAN assumeStdFlag(leftv h)
Definition subexpr.cc:1587
void syMinimize_with_map(syStrategy res, ideal &trans)
Definition syz.cc:1185
syStrategy syCopy(syStrategy syzstr)
Definition syz1.cc:1885
ssyStrategy * syStrategy
Definition syz.h:36
@ 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:187
@ INT_CMD
Definition tok.h:96
int dim(ideal I, ring r)
int * iv2array(intvec *iv, const ring R)
Definition weight.cc:200
#define omMarkAsStaticAddr(A)
Definition xalloc.h:245
#define omPrintUsedTrackAddrs(F, max)
Definition xalloc.h:266
#define omUpdateInfo()
Definition xalloc.h:230

◆ jjSYSTEM()

BOOLEAN jjSYSTEM ( leftv res,
leftv args )

Definition at line 230 of file extra.cc.

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

◆ longCoeffsToSingularPoly()

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

Definition at line 208 of file extra.cc.

209{
210 poly result = NULL;
211 for (int i = 0; i <= degree; i++)
212 {
213 if ((int)polyCoeffs[i] != 0)
214 {
215 poly term = p_ISet((int)polyCoeffs[i], currRing);
216 if (i > 0)
217 {
218 p_SetExp(term, 1, i, currRing);
220 }
222 }
223 }
224 return result;
225}
int degree(const CanonicalForm &f)
poly p_ISet(long i, const ring r)
returns the poly representing the integer i
Definition p_polys.cc:1298
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 176 of file extra.cc.

177{
178 int n = singularMatrix->rows();
179 assume(n == singularMatrix->cols());
180 unsigned long **longMatrix = 0;
181 longMatrix = new unsigned long *[n] ;
182 for (int i = 0 ; i < n; i++)
183 longMatrix[i] = new unsigned long [n];
184 number entry;
185 for (int r = 0; r < n; r++)
186 for (int c = 0; c < n; c++)
187 {
188 poly p=MATELEM(singularMatrix, r + 1, c + 1);
189 int entryAsInt;
190 if (p!=NULL)
191 {
192 entry = p_GetCoeff(p, currRing);
193 entryAsInt = n_Int(entry, currRing->cf);
194 if (entryAsInt < 0) entryAsInt += n_GetChar(currRing->cf);
195 }
196 else
197 entryAsInt=0;
198 longMatrix[r][c] = (unsigned long)entryAsInt;
199 }
200 return longMatrix;
201}
static FORCE_INLINE long n_Int(number &n, const coeffs r)
conversion of n to an int; 0 if not possible in Z/pZ: the representing int lying in (-p/2 ....
Definition coeffs.h:548
#define assume(x)
Definition mod2.h:387
#define p_GetCoeff(p, r)
Definition monomials.h:50

Variable Documentation

◆ FE_OPT_NO_SHELL_FLAG

EXTERN_VAR BOOLEAN FE_OPT_NO_SHELL_FLAG

Definition at line 169 of file extra.cc.