My Project
Loading...
Searching...
No Matches
extra.cc File Reference
#include <errno.h>
#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 TEST_FOR(A)
 
#define SINGULAR_PROCS_DIR   "/libexec/singular/MOD"
 
#define HAVE_SHEAFCOH_TRICKS   1
 

Functions

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

Variables

EXTERN_VAR BOOLEAN FE_OPT_NO_SHELL_FLAG
 

Macro Definition Documentation

◆ 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 2392 of file extra.cc.

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

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

210{
211 poly result = NULL;
212 for (int i = 0; i <= degree; i++)
213 {
214 if ((int)polyCoeffs[i] != 0)
215 {
216 poly term = p_ISet((int)polyCoeffs[i], currRing);
217 if (i > 0)
218 {
219 p_SetExp(term, 1, i, currRing);
221 }
223 }
224 }
225 return result;
226}
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:938
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:490
static void p_Setm(poly p, const ring r)
Definition p_polys.h:235

◆ singularMatrixToLongMatrix()

unsigned long ** singularMatrixToLongMatrix ( matrix singularMatrix)

Definition at line 177 of file extra.cc.

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