source: git/dyn_modules/syzextra/mod_main.cc @ 204092

spielwiese
Last change on this file since 204092 was 204092, checked in by Oleksandr Motsak <motsak@…>, 12 years ago
moved/separated new functions related to Schreyer Syzygy computation chg: prefixed corresponding wrappers with underscore due to interpreter registratrar' general expectation
  • Property mode set to 100644
File size: 43.5 KB
Line 
1
2
3
4
5#include <kernel/mod2.h>
6
7#include <omalloc/omalloc.h>
8
9#include <misc/intvec.h>
10#include <misc/options.h>
11
12#include <coeffs/coeffs.h>
13
14#include <polys/PolyEnumerator.h>
15
16#include <polys/monomials/p_polys.h>
17#include <polys/monomials/ring.h>
18// #include <kernel/longrat.h>
19#include <kernel/GBEngine/kstd1.h>
20
21#include <kernel/polys.h>
22
23#include <kernel/GBEngine/syz.h>
24
25#include <Singular/tok.h>
26#include <Singular/ipid.h>
27#include <Singular/lists.h>
28#include <Singular/attrib.h>
29
30#include <Singular/ipid.h> 
31#include <Singular/ipshell.h> // For iiAddCproc
32
33// extern coeffs coeffs_BIGINT
34
35#include "singularxx_defs.h"
36
37#include "DebugPrint.h"
38#include "myNF.h"
39#include "syzextra.h"
40
41
42#include <Singular/mod_lib.h>
43
44
45#if GOOGLE_PROFILE_ENABLED
46#include <google/profiler.h>
47#endif // #if GOOGLE_PROFILE_ENABLED
48
49
50#include <stdio.h>
51#include <stdlib.h>
52#include <string.h>
53
54
55
56
57extern void pISUpdateComponents(ideal F, const intvec *const V, const int MIN, const ring r);
58// extern ring rCurrRingAssure_SyzComp();
59extern ring rAssure_InducedSchreyerOrdering(const ring r, BOOLEAN complete, int sign);
60extern int rGetISPos(const int p, const ring r);
61
62// USING_NAMESPACE_SINGULARXX;
63
64USING_NAMESPACE( SINGULARXXNAME :: DEBUG )
65USING_NAMESPACE( SINGULARXXNAME :: NF )
66USING_NAMESPACE( SINGULARXXNAME :: SYZEXTRA )
67
68
69BEGIN_NAMESPACE_NONAME
70
71
72static inline void NoReturn(leftv& res)
73{
74  res->rtyp = NONE;
75  res->data = NULL;
76}
77
78/// wrapper around n_ClearContent
79static BOOLEAN _ClearContent(leftv res, leftv h)
80{
81  NoReturn(res);
82
83  const char *usage = "'ClearContent' needs a (non-zero!) poly or vector argument...";
84 
85  if( h == NULL )
86  {
87    WarnS(usage);
88    return TRUE;
89  }
90
91  assume( h != NULL );
92
93  if( !( h->Typ() == POLY_CMD || h->Typ() == VECTOR_CMD) )
94  {
95    WarnS(usage);
96    return TRUE;
97  }
98
99  assume (h->Next() == NULL);
100 
101  poly ph = reinterpret_cast<poly>(h->Data());
102 
103  if( ph == NULL )
104  {
105    WarnS(usage);
106    return TRUE;
107  }
108 
109  const ring r =  currRing;
110  assume( r != NULL ); assume( r->cf != NULL ); const coeffs C = r->cf;
111
112  number n;
113
114  // experimentall (recursive enumerator treatment) of alg. ext
115  CPolyCoeffsEnumerator itr(ph);
116  n_ClearContent(itr, n, C);
117
118  res->data = n;
119  res->rtyp = NUMBER_CMD;
120
121  return FALSE;
122}
123
124/// wrapper around n_ClearDenominators
125static BOOLEAN _ClearDenominators(leftv res, leftv h)
126{
127  NoReturn(res);
128
129  const char *usage = "'ClearDenominators' needs a (non-zero!) poly or vector argument...";
130
131  if( h == NULL )
132  {
133    WarnS(usage);
134    return TRUE;
135  }
136
137  assume( h != NULL );
138
139  if( !( h->Typ() == POLY_CMD || h->Typ() == VECTOR_CMD) )
140  {
141    WarnS(usage);
142    return TRUE;
143  }
144
145  assume (h->Next() == NULL);
146
147  poly ph = reinterpret_cast<poly>(h->Data());
148
149  if( ph == NULL )
150  {
151    WarnS(usage);
152    return TRUE;
153  }
154
155  const ring r =  currRing;
156  assume( r != NULL ); assume( r->cf != NULL ); const coeffs C = r->cf;
157
158  number n;
159
160  // experimentall (recursive enumerator treatment) of alg. ext.
161  CPolyCoeffsEnumerator itr(ph);
162  n_ClearDenominators(itr, n, C);
163
164  res->data = n;
165  res->rtyp = NUMBER_CMD;
166
167  return FALSE;
168}
169
170
171/// try to get an optional (simple) integer argument out of h
172/// or return the default value
173static int getOptionalInteger(const leftv& h, const int _n)
174{
175  if( h!= NULL && h->Typ() == INT_CMD )
176  {
177    int n = (int)(long)(h->Data());
178
179    if( n < 0 )
180      Warn("Negative (%d) optional integer argument", n);
181
182    return (n);
183  }
184
185  return (_n); 
186}
187
188static BOOLEAN noop(leftv __res, leftv /*__v*/)
189{
190  NoReturn(__res);
191  return FALSE;
192}
193
194static BOOLEAN _ProfilerStart(leftv __res, leftv h)
195{
196  NoReturn(__res);
197#if GOOGLE_PROFILE_ENABLED
198  if( h!= NULL && h->Typ() == STRING_CMD )
199  {
200    const char* name = (char*)(h->Data());
201    assume( name != NULL );   
202    ProfilerStart(name);
203  } else
204    WerrorS("ProfilerStart requires a string [name] argument"); 
205#else
206  WarnS("Sorry no google profiler support (GOOGLE_PROFILE_ENABLE!=1)...");
207//  return TRUE; // ?
208#endif // #if GOOGLE_PROFILE_ENABLED
209  return FALSE;
210  (void)h;
211}
212static BOOLEAN _ProfilerStop(leftv __res, leftv /*__v*/)
213{
214  NoReturn(__res);
215#if GOOGLE_PROFILE_ENABLED
216  ProfilerStop();
217#else
218  WarnS("Sorry no google profiler support (GOOGLE_PROFILE_ENABLED!=1)...");
219//  return TRUE; // ?
220#endif // #if GOOGLE_PROFILE_ENABLED
221  return FALSE;
222}
223
224static inline number jjLONG2N(long d)
225{
226  return n_Init(d, coeffs_BIGINT);
227}
228
229static inline void view(const intvec* v)
230{
231#ifndef SING_NDEBUG
232  v->view();
233#else
234  // This code duplication is only due to Hannes's #ifndef SING_NDEBUG!
235  Print ("intvec: {rows: %d, cols: %d, length: %d, Values: \n", v->rows(), v->cols(), v->length());
236
237  for (int i = 0; i < v->rows(); i++)
238  {
239    Print ("Row[%3d]:", i);
240    for (int j = 0; j < v->cols(); j++)
241      Print (" %5d", (*v)[j + i * (v->cols())] );
242    PrintLn ();
243  }
244  PrintS ("}\n");
245#endif
246
247}
248
249                   
250
251static BOOLEAN DetailedPrint(leftv __res, leftv h)
252{
253  NoReturn(__res);
254
255  if( h == NULL )
256  {
257    WarnS("DetailedPrint needs an argument...");
258    return TRUE;
259  }
260
261  if( h->Typ() == NUMBER_CMD)
262  {
263    number n = (number)h->Data(); 
264
265    const ring r = currRing;
266
267#ifdef LDEBUG
268    r->cf->cfDBTest(n,__FILE__,__LINE__,r->cf);
269#endif
270
271    StringSetS("");
272    n_Write(n, r->cf);
273    PrintS(StringEndS());
274    PrintLn();
275
276    return FALSE;
277  }
278 
279  if( h->Typ() == RING_CMD)
280  {
281    const ring r = (const ring)h->Data();
282    rWrite(r, TRUE);
283    PrintLn();
284#ifdef RDEBUG
285    rDebugPrint(r);
286#endif
287    return FALSE;
288  }
289
290  if( h->Typ() == POLY_CMD || h->Typ() == VECTOR_CMD)
291  {
292    const poly p = (const poly)h->Data(); h = h->Next();
293
294    dPrint(p, currRing, currRing, getOptionalInteger(h, 3));
295
296    return FALSE;
297  }
298
299  if( h->Typ() == IDEAL_CMD || h->Typ() == MODUL_CMD)
300  {
301    const ideal id = (const ideal)h->Data(); h = h->Next(); 
302
303    dPrint(id, currRing, currRing, getOptionalInteger(h, 3));
304   
305    return FALSE;           
306  }
307
308  if( h->Typ() == RESOLUTION_CMD )
309  {
310    const syStrategy syzstr = reinterpret_cast<const syStrategy>(h->Data());
311
312    h = h->Next();
313
314    int nTerms = getOptionalInteger(h, 1);
315
316
317    Print("RESOLUTION_CMD(%p): ", reinterpret_cast<const void*>(syzstr)); PrintLn();
318
319    const ring save = currRing;
320    const ring r = syzstr->syRing;
321    const ring rr = (r != NULL) ? r: save;
322
323
324    const int iLength = syzstr->length;
325
326    Print("int 'length': %d", iLength); PrintLn();
327    Print("int 'regularity': %d", syzstr->regularity); PrintLn();
328    Print("short 'list_length': %hd", syzstr->list_length); PrintLn();
329    Print("short 'references': %hd", syzstr->references); PrintLn();
330
331
332#define PRINT_pINTVECTOR(s, v) Print("intvec '%10s'(%p)", #v, reinterpret_cast<const void*>((s)->v)); \
333if( (s)->v != NULL ){ PrintS(": "); view((s)->v); }; \
334PrintLn();
335
336    PRINT_pINTVECTOR(syzstr, resolution);
337    PRINT_pINTVECTOR(syzstr, betti);
338    PRINT_pINTVECTOR(syzstr, Tl);
339    PRINT_pINTVECTOR(syzstr, cw);
340#undef PRINT_pINTVECTOR
341
342    if (r == NULL)
343      Print("ring '%10s': NULL", "syRing");
344    else 
345      if (r == currRing)
346        Print("ring '%10s': currRing", "syRing");
347      else
348        if (r != NULL && r != save)
349        {
350          Print("ring '%10s': ", "syRing");
351          rWrite(r);
352#ifdef RDEBUG
353          //              rDebugPrint(r);
354#endif
355          // rChangeCurrRing(r);
356        }           
357    PrintLn();
358
359    const SRes rP = syzstr->resPairs;
360    Print("SRes 'resPairs': %p", reinterpret_cast<const void*>(rP)); PrintLn();
361
362    if (rP != NULL)
363      for (int iLevel = 0; (iLevel < iLength) && (rP[iLevel] != NULL) && ((*syzstr->Tl)[iLevel] >= 0); iLevel++)
364      {
365        int n = 0;
366        const int iTl = (*syzstr->Tl)[iLevel];
367        for (int j = 0; (j < iTl) && ((rP[iLevel][j].lcm!=NULL) || (rP[iLevel][j].syz!=NULL)); j++)
368        {
369          if (rP[iLevel][j].isNotMinimal==NULL)
370            n++;
371        }
372        Print("minimal-resPairs-Size[1+%d]: %d", iLevel, n); PrintLn();
373      }
374
375
376    //  const ring rrr = (iLevel > 0) ? rr : save; ?
377#define PRINT_RESOLUTION(s, v) Print("resolution '%12s': %p", #v, reinterpret_cast<const void*>((s)->v)); PrintLn(); \
378if ((s)->v != NULL) \
379  for (int iLevel = 0; (iLevel < iLength) && ( ((s)->v)[iLevel] != NULL ); iLevel++) \
380  { \
381    /* const ring rrr = (iLevel > 0) ? save : save; */ \
382    Print("id '%10s'[%d]: (%p) ncols = %d / size: %d; nrows = %d, rank = %ld / rk: %ld", #v, iLevel, reinterpret_cast<const void*>(((s)->v)[iLevel]), ((s)->v)[iLevel]->ncols, idSize(((s)->v)[iLevel]), ((s)->v)[iLevel]->nrows, ((s)->v)[iLevel]->rank, -1L/*id_RankFreeModule(((s)->v)[iLevel], rrr)*/ ); \
383    PrintLn(); \
384  } \
385  PrintLn();
386
387    // resolvente:
388    PRINT_RESOLUTION(syzstr, minres);
389    PRINT_RESOLUTION(syzstr, fullres);
390
391    assume (id_RankFreeModule (syzstr->res[1], rr) == syzstr->res[1]->rank);
392
393    PRINT_RESOLUTION(syzstr, res);
394    PRINT_RESOLUTION(syzstr, orderedRes);
395#undef PRINT_RESOLUTION
396
397#define PRINT_POINTER(s, v) Print("pointer '%17s': %p", #v, reinterpret_cast<const void*>((s)->v)); PrintLn();
398    // 2d arrays:
399    PRINT_POINTER(syzstr, truecomponents);
400    PRINT_POINTER(syzstr, ShiftedComponents);
401    PRINT_POINTER(syzstr, backcomponents);
402    PRINT_POINTER(syzstr, Howmuch);
403    PRINT_POINTER(syzstr, Firstelem);
404    PRINT_POINTER(syzstr, elemLength);
405    PRINT_POINTER(syzstr, sev);
406
407    // arrays of intvects:
408    PRINT_POINTER(syzstr, weights);
409    PRINT_POINTER(syzstr, hilb_coeffs);
410#undef PRINT_POINTER
411
412
413    if (syzstr->fullres==NULL)
414    {
415      PrintS("resolution 'fullres': (NULL) => resolution not computed yet");
416      PrintLn();
417    } else
418    {
419      Print("resolution 'fullres': (%p) => resolution seems to be computed already", reinterpret_cast<const void*>(syzstr->fullres));
420      PrintLn();
421      dPrint(*syzstr->fullres, save, save, nTerms);
422    }
423
424
425
426
427    if (syzstr->minres==NULL)
428    {
429      PrintS("resolution 'minres': (NULL) => resolution not minimized yet");
430      PrintLn();
431    } else
432    {
433      Print("resolution 'minres': (%p) => resolution seems to be minimized already", reinterpret_cast<const void*>(syzstr->minres));
434      PrintLn();
435      dPrint(*syzstr->minres, save, save, nTerms);
436    }
437
438
439
440
441    /*
442    int ** truecomponents;
443    long** ShiftedComponents;
444    int ** backcomponents;
445    int ** Howmuch;
446    int ** Firstelem;
447    int ** elemLength;
448    unsigned long ** sev;
449
450    intvec ** weights;
451    intvec ** hilb_coeffs;
452
453    SRes resPairs;               //polynomial data for internal use only
454
455    resolvente fullres;
456    resolvente minres;
457    resolvente res;              //polynomial data for internal use only
458    resolvente orderedRes;       //polynomial data for internal use only
459*/
460
461    //            if( currRing != save ) rChangeCurrRing(save);
462  }
463
464
465  return FALSE;
466}
467
468/// wrapper around p_Tail and id_Tail
469static BOOLEAN Tail(leftv res, leftv h)
470{
471  NoReturn(res);
472
473  if( h == NULL )
474  {
475    WarnS("Tail needs a poly/vector/ideal/module argument...");
476    return TRUE;
477  }
478
479  assume( h != NULL );
480
481  const ring r =  currRing;
482
483  if( h->Typ() == POLY_CMD || h->Typ() == VECTOR_CMD)
484  {
485    res->data = p_Tail( (const poly)h->Data(), r );
486    res->rtyp = h->Typ();
487
488    h = h->Next(); assume (h == NULL);
489   
490    return FALSE;
491  }
492
493  if( h->Typ() == IDEAL_CMD || h->Typ() == MODUL_CMD)
494  {
495    res->data = id_Tail( (const ideal)h->Data(), r );     
496    res->rtyp = h->Typ();
497   
498    h = h->Next(); assume (h == NULL);
499   
500    return FALSE;
501  }
502
503  WarnS("Tail needs a single poly/vector/ideal/module argument...");
504  return TRUE;
505}
506
507
508static BOOLEAN _ComputeLeadingSyzygyTerms(leftv res, leftv h)
509{
510  const ring r = currRing;
511  NoReturn(res);
512
513  if( h == NULL )
514  {
515    WarnS("ComputeLeadingSyzygyTerms needs an argument...");
516    return TRUE;
517  }
518
519  assume( h != NULL ); 
520
521#ifndef NDEBUG
522  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)TRUE)));
523#else
524  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)FALSE)));
525#endif
526
527  if( h->Typ() == IDEAL_CMD || h->Typ() == MODUL_CMD)
528  {
529    const ideal id = (const ideal)h->Data();
530
531    assume(id != NULL);
532
533    if( __DEBUG__ )
534    {
535      PrintS("ComputeLeadingSyzygyTerms::Input: \n");
536     
537      const BOOLEAN __LEAD2SYZ__ = (BOOLEAN)((long)(atGet(currRingHdl,"LEAD2SYZ",INT_CMD, (void*)0)));
538      const BOOLEAN __TAILREDSYZ__ = (BOOLEAN)((long)(atGet(currRingHdl,"TAILREDSYZ",INT_CMD, (void*)0)));
539      const BOOLEAN __SYZCHECK__ = (BOOLEAN)((long)(atGet(currRingHdl,"SYZCHECK",INT_CMD, (void*)0)));
540
541
542      Print("\nSYZCHECK: \t%d", __SYZCHECK__);
543      Print(", DEBUG: \t%d", __DEBUG__);
544      Print(", LEAD2SYZ: \t%d", __LEAD2SYZ__);
545      Print(", TAILREDSYZ: \t%d\n", __TAILREDSYZ__);
546
547      dPrint(id, r, r, 1);
548
549      assume( !__LEAD2SYZ__ );
550    }
551
552    h = h->Next(); assume (h == NULL);
553
554    const ideal newid = ComputeLeadingSyzygyTerms(id, r);
555   
556    res->data = newid; res->rtyp = MODUL_CMD;
557    return FALSE;
558  }
559
560  WarnS("ComputeLeadingSyzygyTerms needs a single ideal/module argument...");
561  return TRUE;
562}
563
564///  sorting wrt <c,ds> & reversing...
565/// change the input inplace!!!
566// TODO: use a ring with >_{c, ds}!???
567static BOOLEAN _Sort_c_ds(leftv res, leftv h)
568{
569  NoReturn(res);
570
571  const ring r = currRing;
572  NoReturn(res);
573
574  if( h == NULL )
575  {
576    WarnS("Sort_c_ds needs an argument...");
577    return TRUE;
578  }
579
580  assume( h != NULL ); 
581
582#ifndef NDEBUG
583  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)FALSE)));
584#else
585  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)FALSE)));
586#endif
587
588  if(    (h->Typ() == IDEAL_CMD || h->Typ() == MODUL_CMD)
589      && (h->rtyp  == IDHDL) // must be a variable!
590      && (h->e == NULL) // not a list element
591      ) 
592  {
593    const ideal id = (const ideal)h->Data();
594
595    assume(id != NULL);
596
597    if( __DEBUG__ )
598    {
599      PrintS("Sort_c_ds::Input: \n");
600
601      const BOOLEAN __LEAD2SYZ__ = (BOOLEAN)((long)(atGet(currRingHdl,"LEAD2SYZ",INT_CMD, (void*)0)));
602      const BOOLEAN __TAILREDSYZ__ = (BOOLEAN)((long)(atGet(currRingHdl,"TAILREDSYZ",INT_CMD, (void*)0)));
603      const BOOLEAN __SYZCHECK__ = (BOOLEAN)((long)(atGet(currRingHdl,"SYZCHECK",INT_CMD, (void*)0)));   
604
605      Print("\nSYZCHECK: \t%d", __SYZCHECK__);
606      Print(", DEBUG: \t%d", __DEBUG__);
607      Print(", LEAD2SYZ: \t%d", __LEAD2SYZ__);
608      Print(", TAILREDSYZ: \t%d\n", __TAILREDSYZ__);
609
610      dPrint(id, r, r, 1);     
611    }
612
613    assume (h->Next() == NULL);
614
615    id_Test(id, r);
616
617    Sort_c_ds(id, r); // NOT A COPY! inplace sorting!!!
618
619//    res->data = id;
620//    res->rtyp = h->Typ();
621   
622    if( __DEBUG__ )
623    {
624      PrintS("Sort_c_ds::Output: \n");
625      dPrint(id, r, r, 1);
626    }
627
628    // NOTE: nothing is to be returned!!!
629    return FALSE;
630  }
631
632  WarnS("ComputeLeadingSyzygyTerms needs a single ideal/module argument (must be a variable!)...");
633  return TRUE; 
634}
635
636
637static BOOLEAN _Compute2LeadingSyzygyTerms(leftv res, leftv h)
638{
639  const ring r = currRing;
640  NoReturn(res);
641
642  if( h == NULL )
643  {
644    WarnS("Compute2LeadingSyzygyTerms needs an argument...");
645    return TRUE;
646  }
647
648  assume( h != NULL ); 
649
650#ifndef NDEBUG
651  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)TRUE)));
652#else
653  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)FALSE)));
654#endif
655
656  const BOOLEAN __LEAD2SYZ__ = (BOOLEAN)((long)(atGet(currRingHdl,"LEAD2SYZ",INT_CMD, (void*)0)));
657 
658  assume( __LEAD2SYZ__ );
659 
660  if( h->Typ() == IDEAL_CMD || h->Typ() == MODUL_CMD)
661  {
662    const ideal id = (const ideal)h->Data();
663
664    assume(id != NULL);
665
666    if( __DEBUG__ )
667    {
668      PrintS("Compute2LeadingSyzygyTerms::Input: \n");
669      dPrint(id, r, r, 0);
670    }
671
672    h = h->Next(); assume (h == NULL);
673
674    res->data = Compute2LeadingSyzygyTerms(id, r);
675    res->rtyp = MODUL_CMD;
676
677    return FALSE;
678  }
679
680  WarnS("Compute2LeadingSyzygyTerms needs a single ideal/module argument...");
681  return TRUE;
682}
683
684
685
686/// TODO: save shortcut (syz: |-.->) LM(LM(m) * "t") -> syz?
687/// proc SSFindReducer(def product, def syzterm, def L, def T, list #)
688static BOOLEAN _FindReducer(leftv res, leftv h)
689{
690  const char* usage = "`FindReducer(<poly/vector>, <vector/0>, <ideal/module>[,<module>])` expected";
691  const ring r = currRing;
692
693  NoReturn(res);
694
695
696#ifndef NDEBUG
697  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)TRUE)));
698#else
699  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)FALSE)));
700#endif
701
702  const BOOLEAN __TAILREDSYZ__ = (BOOLEAN)((long)(atGet(currRingHdl,"TAILREDSYZ",INT_CMD, (void*)0)));
703
704  if ((h==NULL) || (h->Typ()!=VECTOR_CMD && h->Typ() !=POLY_CMD) || (h->Data() == NULL))
705  {
706    WerrorS(usage);
707    return TRUE;   
708  }
709   
710  const poly product = (poly) h->Data(); assume (product != NULL);
711
712
713  h = h->Next();
714  if ((h==NULL) || !((h->Typ()==VECTOR_CMD) || (h->Data() == NULL)) )
715  {
716    WerrorS(usage);
717    return TRUE;   
718  }
719
720  poly syzterm = NULL;
721
722  if(h->Typ()==VECTOR_CMD) 
723    syzterm = (poly) h->Data();
724
725
726
727  h = h->Next();
728  if ((h==NULL) || (h->Typ()!=IDEAL_CMD && h->Typ() !=MODUL_CMD) || (h->Data() == NULL))
729  {
730    WerrorS(usage);
731    return TRUE;   
732  }
733 
734  const ideal L = (ideal) h->Data(); h = h->Next();
735
736  assume( IDELEMS(L) > 0 );
737
738  ideal LS = NULL;
739
740  if ((h != NULL) && (h->Typ() ==MODUL_CMD) && (h->Data() != NULL))
741  {
742    LS = (ideal)h->Data();
743    h = h->Next();
744  }
745
746  if( __TAILREDSYZ__ )
747    assume (LS != NULL);
748
749  assume( h == NULL );
750
751  if( __DEBUG__ )
752  {
753    PrintS("FindReducer(product, syzterm, L, T, #)::Input: \n");
754
755    PrintS("product: "); dPrint(product, r, r, 2);
756    PrintS("syzterm: "); dPrint(syzterm, r, r, 2);
757    PrintS("L: "); dPrint(L, r, r, 0);
758//    PrintS("T: "); dPrint(T, r, r, 4);
759
760    if( LS == NULL )
761      PrintS("LS: NULL\n");
762    else
763    {
764      PrintS("LS: "); dPrint(LS, r, r, 0);
765    }
766  }
767
768  res->rtyp = VECTOR_CMD;
769  res->data = FindReducer(product, syzterm, L, LS, r);
770
771  if( __DEBUG__ )
772  {
773    PrintS("FindReducer::Output: \n");
774    dPrint((poly)res->data, r, r, 2);
775  }   
776 
777  return FALSE;   
778 
779}
780
781// proc SchreyerSyzygyNF(vector syz_lead, vector syz_2, def L, def T, list #)
782static BOOLEAN _SchreyerSyzygyNF(leftv res, leftv h)
783{
784  const char* usage = "`SchreyerSyzygyNF(<vector>, <vector>, <ideal/module>, <ideal/module>[,<module>])` expected";
785  const ring r = currRing;
786
787  NoReturn(res);
788
789#ifndef NDEBUG
790  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)TRUE)));
791#else
792  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)FALSE)));
793#endif
794
795  const BOOLEAN __TAILREDSYZ__ = (BOOLEAN)((long)(atGet(currRingHdl,"TAILREDSYZ",INT_CMD, (void*)0)));
796//  const BOOLEAN __LEAD2SYZ__ = (BOOLEAN)((long)(atGet(currRingHdl,"LEAD2SYZ",INT_CMD, (void*)0)));
797  const BOOLEAN __SYZCHECK__ = (BOOLEAN)((long)(atGet(currRingHdl,"SYZCHECK",INT_CMD, (void*)0)));   
798
799  const BOOLEAN __HYBRIDNF__ = (BOOLEAN)((long)(atGet(currRingHdl,"HYBRIDNF",INT_CMD, (void*)0)));
800
801  assume( __HYBRIDNF__ );
802 
803  if ((h==NULL) || (h->Typ() != VECTOR_CMD) || (h->Data() == NULL))
804  {
805    WerrorS(usage);
806    return TRUE;   
807  }
808
809  const poly syz_lead = (poly) h->Data(); assume (syz_lead != NULL);
810
811
812  h = h->Next();
813  if ((h==NULL) || (h->Typ() != VECTOR_CMD) || (h->Data() == NULL))
814  {
815    WerrorS(usage);
816    return TRUE;   
817  }
818
819  const poly syz_2 = (poly) h->Data(); assume (syz_2 != NULL);
820
821  h = h->Next();
822  if ((h==NULL) || (h->Typ()!=IDEAL_CMD && h->Typ() !=MODUL_CMD) || (h->Data() == NULL))
823  {
824    WerrorS(usage);
825    return TRUE;   
826  }
827
828  const ideal L = (ideal) h->Data(); assume( IDELEMS(L) > 0 );
829
830
831  h = h->Next();
832  if ((h==NULL) || (h->Typ()!=IDEAL_CMD && h->Typ() !=MODUL_CMD) || (h->Data() == NULL))
833  {
834    WerrorS(usage);
835    return TRUE;   
836  }
837
838  const ideal T = (ideal) h->Data();
839
840  assume( IDELEMS(L) == IDELEMS(T) );
841
842  ideal LS = NULL;
843
844  h = h->Next();
845  if ((h != NULL) && (h->Typ() ==MODUL_CMD) && (h->Data() != NULL))
846  {
847    LS = (ideal)h->Data();
848    h = h->Next();
849  }
850
851  if( __TAILREDSYZ__ )
852    assume (LS != NULL);
853
854  assume( h == NULL );
855
856  if( __DEBUG__ )
857  {
858    PrintS("SchreyerSyzygyNF(syz_lead, syz_2, L, T, #)::Input: \n");
859
860    PrintS("syz_lead: "); dPrint(syz_lead, r, r, 2);
861    PrintS("syz_2: "); dPrint(syz_2, r, r, 2);
862
863    PrintS("L: "); dPrint(L, r, r, 0);
864    PrintS("T: "); dPrint(T, r, r, 0);
865
866    if( LS == NULL )
867      PrintS("LS: NULL\n");
868    else
869    {
870      PrintS("LS: "); dPrint(LS, r, r, 0);
871    }
872  }
873 
874  res->rtyp = VECTOR_CMD;
875  res->data = SchreyerSyzygyNF(syz_lead, syz_2, L, T, LS, r);
876
877  if( __DEBUG__ )
878  {
879    PrintS("SchreyerSyzygyNF::Output: ");
880
881    dPrint((poly)res->data, r, r, 2);
882  }
883
884
885  return FALSE;
886}
887
888
889
890/// TODO: save shortcut (syz: |-.->) LM(m) * "t" -> ?
891/// proc SSReduceTerm(poly m, def t, def syzterm, def L, def T, list #)
892static BOOLEAN _ReduceTerm(leftv res, leftv h)
893{
894  const char* usage = "`ReduceTerm(<poly>, <poly/vector>, <vector/0>, <ideal/module>, <ideal/module>[,<module>])` expected";
895  const ring r = currRing;
896
897  NoReturn(res);
898
899#ifndef NDEBUG
900  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)TRUE)));
901#else
902  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)FALSE)));
903#endif
904
905  const BOOLEAN __TAILREDSYZ__ = (BOOLEAN)((long)(atGet(currRingHdl,"TAILREDSYZ",INT_CMD, (void*)0)));
906//  const BOOLEAN __LEAD2SYZ__ = (BOOLEAN)((long)(atGet(currRingHdl,"LEAD2SYZ",INT_CMD, (void*)0)));
907  const BOOLEAN __SYZCHECK__ = (BOOLEAN)((long)(atGet(currRingHdl,"SYZCHECK",INT_CMD, (void*)0)));   
908
909  if ((h==NULL) || (h->Typ() !=POLY_CMD) || (h->Data() == NULL))
910  {
911    WerrorS(usage);
912    return TRUE;   
913  }
914
915  const poly multiplier = (poly) h->Data(); assume (multiplier != NULL);
916
917 
918  h = h->Next();
919  if ((h==NULL) || (h->Typ()!=VECTOR_CMD && h->Typ() !=POLY_CMD) || (h->Data() == NULL))
920  {
921    WerrorS(usage);
922    return TRUE;   
923  }
924
925  const poly term4reduction = (poly) h->Data(); assume( term4reduction != NULL );
926
927 
928  poly syztermCheck = NULL;
929 
930  h = h->Next();
931  if ((h==NULL) || !((h->Typ()==VECTOR_CMD) || (h->Data() == NULL)) )
932  {
933    WerrorS(usage);
934    return TRUE;   
935  }
936
937  if(h->Typ()==VECTOR_CMD) 
938    syztermCheck = (poly) h->Data();
939
940 
941  h = h->Next();
942  if ((h==NULL) || (h->Typ()!=IDEAL_CMD && h->Typ() !=MODUL_CMD) || (h->Data() == NULL))
943  {
944    WerrorS(usage);
945    return TRUE;   
946  }
947
948  const ideal L = (ideal) h->Data(); assume( IDELEMS(L) > 0 );
949
950 
951  h = h->Next();
952  if ((h==NULL) || (h->Typ()!=IDEAL_CMD && h->Typ() !=MODUL_CMD) || (h->Data() == NULL))
953  {
954    WerrorS(usage);
955    return TRUE;   
956  }
957
958  const ideal T = (ideal) h->Data();
959
960  assume( IDELEMS(L) == IDELEMS(T) );
961
962  ideal LS = NULL;
963
964  h = h->Next();
965  if ((h != NULL) && (h->Typ() ==MODUL_CMD) && (h->Data() != NULL))
966  {
967    LS = (ideal)h->Data();
968    h = h->Next();
969  }
970
971  if( __TAILREDSYZ__ )
972    assume (LS != NULL);
973
974  assume( h == NULL );
975
976  if( __DEBUG__ )
977  {
978    PrintS("ReduceTerm(m, t, syzterm, L, T, #)::Input: \n");
979
980    PrintS("m: "); dPrint(multiplier, r, r, 2);
981    PrintS("t: "); dPrint(term4reduction, r, r, 2);
982    PrintS("syzterm: "); dPrint(syztermCheck, r, r, 2);
983   
984    PrintS("L: "); dPrint(L, r, r, 0);
985    PrintS("T: "); dPrint(T, r, r, 0);
986
987    if( LS == NULL )
988      PrintS("LS: NULL\n");
989    else
990    {
991      PrintS("LS: "); dPrint(LS, r, r, 0);
992    }
993  }
994
995
996  if (__SYZCHECK__ && syztermCheck != NULL)
997  {
998    const int c = p_GetComp(syztermCheck, r) - 1;
999    assume( c >= 0 && c < IDELEMS(L) );
1000   
1001    const poly p = L->m[c];
1002    assume( p != NULL ); assume( pNext(p) == NULL );   
1003
1004    assume( p_EqualPolys(term4reduction, p, r) ); // assume? TODO
1005
1006
1007    poly m = leadmonom(syztermCheck, r);
1008    assume( m != NULL ); assume( pNext(m) == NULL );
1009
1010    assume( p_EqualPolys(multiplier, m, r) ); // assume? TODO
1011
1012    p_Delete(&m, r);   
1013   
1014// NOTE:   leadmonomial(syzterm) == m &&  L[leadcomp(syzterm)] == t
1015  }
1016
1017  res->rtyp = VECTOR_CMD;
1018  res->data = ReduceTerm(multiplier, term4reduction, syztermCheck, L, T, LS, r);
1019
1020
1021  if( __DEBUG__ )
1022  {
1023    PrintS("ReduceTerm::Output: ");
1024
1025    dPrint((poly)res->data, r, r, 2);
1026  }
1027 
1028 
1029  return FALSE;
1030}
1031
1032
1033
1034
1035// TODO: store m * @tail -.-^-.-^-.--> ?
1036// proc SSTraverseTail(poly m, def @tail, def L, def T, list #)
1037static BOOLEAN _TraverseTail(leftv res, leftv h)
1038{
1039  const char* usage = "`TraverseTail(<poly>, <poly/vector>, <ideal/module>, <ideal/module>[,<module>])` expected";
1040  const ring r = currRing;
1041
1042  NoReturn(res);
1043
1044#ifndef NDEBUG
1045  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)TRUE)));
1046#else
1047  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)FALSE)));
1048#endif
1049
1050  const BOOLEAN __TAILREDSYZ__ = (BOOLEAN)((long)(atGet(currRingHdl,"TAILREDSYZ",INT_CMD, (void*)1)));
1051
1052  if ((h==NULL) || (h->Typ() !=POLY_CMD) || (h->Data() == NULL))
1053  {
1054    WerrorS(usage);
1055    return TRUE;   
1056  }
1057
1058  const poly multiplier = (poly) h->Data(); assume (multiplier != NULL);
1059
1060  h = h->Next();
1061  if ((h==NULL) || (h->Typ()!=VECTOR_CMD && h->Typ() !=POLY_CMD))
1062  {
1063    WerrorS(usage);
1064    return TRUE;   
1065  }
1066
1067  const poly tail = (poly) h->Data(); 
1068
1069  h = h->Next();
1070
1071  if ((h==NULL) || (h->Typ()!=IDEAL_CMD && h->Typ() !=MODUL_CMD) || (h->Data() == NULL))
1072  {
1073    WerrorS(usage);
1074    return TRUE;   
1075  }
1076
1077  const ideal L = (ideal) h->Data();
1078
1079  assume( IDELEMS(L) > 0 );
1080
1081  h = h->Next();
1082  if ((h==NULL) || (h->Typ()!=IDEAL_CMD && h->Typ() !=MODUL_CMD) || (h->Data() == NULL))
1083  {
1084    WerrorS(usage);
1085    return TRUE;   
1086  }
1087
1088  const ideal T = (ideal) h->Data();
1089
1090  assume( IDELEMS(L) == IDELEMS(T) );
1091
1092  h = h->Next();
1093 
1094  ideal LS = NULL;
1095
1096  if ((h != NULL) && (h->Typ() ==MODUL_CMD) && (h->Data() != NULL))
1097  {
1098    LS = (ideal)h->Data();
1099    h = h->Next();
1100  }
1101
1102  if( __TAILREDSYZ__ )
1103    assume (LS != NULL);
1104
1105  assume( h == NULL );
1106
1107  if( __DEBUG__ )
1108  {
1109    PrintS("TraverseTail(m, t, L, T, #)::Input: \n");
1110
1111    PrintS("m: "); dPrint(multiplier, r, r, 2);
1112    PrintS("t: "); dPrint(tail, r, r, 10);
1113
1114    PrintS("L: "); dPrint(L, r, r, 0);
1115    PrintS("T: "); dPrint(T, r, r, 0);
1116
1117    if( LS == NULL )
1118      PrintS("LS: NULL\n");
1119    else
1120    {
1121      PrintS("LS: "); dPrint(LS, r, r, 0);
1122    }
1123  }
1124
1125  res->rtyp = VECTOR_CMD;
1126  res->data = TraverseTail(multiplier, tail, L, T, LS, r);
1127
1128
1129  if( __DEBUG__ )
1130  {
1131    PrintS("TraverseTail::Output: ");
1132    dPrint((poly)res->data, r, r, 2);
1133  }
1134
1135  return FALSE;
1136}
1137
1138
1139// module (N, LL, TT) = SSComputeSyzygy(L, T);
1140// Compute Syz(L ++ T) = N = LL ++ TT
1141// proc SSComputeSyzygy(def L, def T)
1142static BOOLEAN _ComputeSyzygy(leftv res, leftv h)
1143{
1144  const char* usage = "`ComputeSyzygy(<ideal/module>, <ideal/module>])` expected";
1145  const ring r = currRing;
1146
1147  NoReturn(res);
1148
1149#ifndef NDEBUG
1150  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)TRUE)));
1151#else
1152  const BOOLEAN __DEBUG__ = (BOOLEAN)((long)(atGet(currRingHdl,"DEBUG",INT_CMD, (void*)FALSE)));
1153#endif
1154
1155  if ((h==NULL) || (h->Typ()!=IDEAL_CMD && h->Typ() !=MODUL_CMD) || (h->Data() == NULL))
1156  {
1157    WerrorS(usage);
1158    return TRUE;   
1159  }
1160
1161  const ideal L = (ideal) h->Data();
1162
1163  assume( IDELEMS(L) > 0 );
1164
1165  h = h->Next();
1166  if ((h==NULL) || (h->Typ()!=IDEAL_CMD && h->Typ() !=MODUL_CMD) || (h->Data() == NULL))
1167  {
1168    WerrorS(usage);
1169    return TRUE;   
1170  }
1171
1172  const ideal T = (ideal) h->Data();
1173  assume( IDELEMS(L) == IDELEMS(T) );
1174
1175
1176  h = h->Next(); assume( h == NULL ); 
1177
1178  if( __DEBUG__ )
1179  {
1180    PrintS("ComputeSyzygy(L, T)::Input: \n");
1181
1182    PrintS("L: "); dPrint(L, r, r, 0);
1183    PrintS("T: "); dPrint(T, r, r, 0);
1184  }
1185
1186  ideal LL, TT;
1187
1188  ComputeSyzygy(L, T, LL, TT, r);
1189
1190  lists l = (lists)omAllocBin(slists_bin); l->Init(2);
1191
1192  l->m[0].rtyp = MODUL_CMD; l->m[0].data = reinterpret_cast<void *>(LL);
1193
1194  l->m[1].rtyp = MODUL_CMD; l->m[1].data = reinterpret_cast<void *>(TT);
1195 
1196  res->data = l; res->rtyp = LIST_CMD;
1197 
1198  if( __DEBUG__ )
1199  {
1200    PrintS("ComputeSyzygy::Output: ");
1201    dPrint(LL, r, r, 0);
1202    dPrint(TT, r, r, 0);
1203  }
1204
1205  return FALSE;
1206
1207}
1208
1209/// Get leading term without a module component
1210static BOOLEAN _leadmonom(leftv res, leftv h)
1211{
1212  NoReturn(res);
1213
1214  if ((h!=NULL) && (h->Typ()==VECTOR_CMD || h->Typ()==POLY_CMD) && (h->Data() != NULL))
1215  {
1216    const ring r = currRing;
1217    const poly p = (poly)(h->Data());
1218
1219    res->data = reinterpret_cast<void *>(  leadmonom(p, r) );
1220    res->rtyp = POLY_CMD;
1221
1222    return FALSE;
1223  }
1224
1225  WerrorS("`leadmonom(<poly/vector>)` expected");
1226  return TRUE;
1227}
1228
1229/// Get leading component
1230static BOOLEAN leadcomp(leftv res, leftv h)
1231{
1232  NoReturn(res);
1233
1234  if ((h!=NULL) && (h->Typ()==VECTOR_CMD || h->Typ()==POLY_CMD))
1235  {
1236    const ring r = currRing;
1237
1238    const poly p = (poly)(h->Data());
1239
1240    if (p != NULL )
1241    {
1242      assume( p != NULL );
1243      assume( p_LmTest(p, r) );
1244
1245      const unsigned long iComp = p_GetComp(p, r);
1246
1247  //    assume( iComp > 0 ); // p is a vector
1248
1249      res->data = reinterpret_cast<void *>(jjLONG2N(iComp));
1250    } else
1251      res->data = reinterpret_cast<void *>(jjLONG2N(0));
1252     
1253
1254    res->rtyp = BIGINT_CMD;
1255    return FALSE;
1256  }
1257
1258  WerrorS("`leadcomp(<poly/vector>)` expected");
1259  return TRUE;
1260}
1261
1262
1263
1264
1265/// Get raw leading exponent vector
1266static BOOLEAN leadrawexp(leftv res, leftv h)
1267{
1268  NoReturn(res);
1269
1270  if ((h!=NULL) && (h->Typ()==VECTOR_CMD || h->Typ()==POLY_CMD) && (h->Data() != NULL))
1271  {
1272    const ring r = currRing;
1273    const poly p = (poly)(h->Data());
1274
1275    assume( p != NULL );
1276    assume( p_LmTest(p, r) );
1277
1278    const int iExpSize = r->ExpL_Size;
1279
1280//    intvec *iv = new intvec(iExpSize);
1281
1282    lists l=(lists)omAllocBin(slists_bin);
1283    l->Init(iExpSize);
1284
1285    for(int i = iExpSize-1; i >= 0; i--)
1286    {
1287      l->m[i].rtyp = BIGINT_CMD;
1288      l->m[i].data = reinterpret_cast<void *>(jjLONG2N(p->exp[i])); // longs...
1289    }
1290
1291    res->rtyp = LIST_CMD; // list of bigints
1292    res->data = reinterpret_cast<void *>(l);
1293    return FALSE;
1294  }
1295
1296  WerrorS("`leadrawexp(<poly/vector>)` expected");
1297  return TRUE;
1298}
1299
1300
1301/// Endowe the current ring with additional (leading) Syz-component ordering
1302static BOOLEAN MakeSyzCompOrdering(leftv res, leftv /*h*/)
1303{
1304
1305  NoReturn(res);
1306
1307  //    res->data = rCurrRingAssure_SyzComp(); // changes current ring! :(
1308  res->data = reinterpret_cast<void *>(rAssure_SyzComp(currRing, TRUE));
1309  res->rtyp = RING_CMD; // return new ring!
1310  // QRING_CMD?
1311
1312  return FALSE;
1313}
1314
1315
1316/// Same for Induced Schreyer ordering (ordering on components is defined by sign!)
1317static BOOLEAN MakeInducedSchreyerOrdering(leftv res, leftv h)
1318{
1319
1320  NoReturn(res);
1321
1322  int sign = 1;
1323  if ((h!=NULL) && (h->Typ()==INT_CMD))
1324  {
1325    const int s = (int)((long)(h->Data()));
1326
1327    if( s != -1 && s != 1 )
1328    {
1329      WerrorS("`MakeInducedSchreyerOrdering(<int>)` called with wrong integer argument (must be +-1)!");
1330      return TRUE;
1331    }
1332
1333    sign = s;           
1334  }
1335
1336  assume( sign == 1 || sign == -1 );
1337  res->data = reinterpret_cast<void *>(rAssure_InducedSchreyerOrdering(currRing, TRUE, sign));
1338  res->rtyp = RING_CMD; // return new ring!
1339  // QRING_CMD?
1340  return FALSE;
1341}
1342
1343
1344/// Returns old SyzCompLimit, can set new limit
1345static BOOLEAN SetSyzComp(leftv res, leftv h)
1346{
1347  NoReturn(res);
1348
1349  const ring r = currRing;
1350
1351  if( !rIsSyzIndexRing(r) )
1352  {
1353    WerrorS("`SetSyzComp(<int>)` called on incompatible ring (not created by 'MakeSyzCompOrdering'!)");
1354    return TRUE;
1355  }
1356
1357  res->rtyp = INT_CMD;
1358  res->data = reinterpret_cast<void *>(rGetCurrSyzLimit(r)); // return old syz limit
1359
1360  if ((h!=NULL) && (h->Typ()==INT_CMD))
1361  {
1362    const int iSyzComp = (int)reinterpret_cast<long>(h->Data());
1363    assume( iSyzComp > 0 );
1364    rSetSyzComp(iSyzComp, currRing);
1365  }
1366
1367  return FALSE;
1368}
1369
1370/// ?
1371static BOOLEAN GetInducedData(leftv res, leftv h)
1372{
1373  NoReturn(res);
1374
1375  const ring r = currRing;
1376
1377  int p = 0; // which IS-block? p^th!
1378
1379  if ((h!=NULL) && (h->Typ()==INT_CMD))
1380  {
1381    p = (int)((long)(h->Data())); h=h->next;
1382    assume(p >= 0);
1383  }
1384
1385  const int pos = rGetISPos(p, r);
1386
1387  if(  /*(*/ -1 == pos /*)*/  )
1388  {
1389    WerrorS("`GetInducedData([int])` called on incompatible ring (not created by 'MakeInducedSchreyerOrdering'!)");
1390    return TRUE;
1391  }
1392
1393
1394  const int iLimit = r->typ[pos].data.is.limit;
1395  const ideal F = r->typ[pos].data.is.F;
1396  ideal FF = id_Copy(F, r);
1397
1398
1399 
1400  lists l=(lists)omAllocBin(slists_bin);
1401  l->Init(2);
1402
1403  l->m[0].rtyp = INT_CMD;
1404  l->m[0].data = reinterpret_cast<void *>(iLimit);
1405
1406
1407  //        l->m[1].rtyp = MODUL_CMD;
1408
1409  if( idIsModule(FF, r) )
1410  {
1411    l->m[1].rtyp = MODUL_CMD;
1412
1413    //          Print("before: %d\n", FF->nrows);
1414    //          FF->nrows = id_RankFreeModule(FF, r); // ???
1415    //          Print("after: %d\n", FF->nrows);
1416  }
1417  else
1418    l->m[1].rtyp = IDEAL_CMD;
1419
1420  l->m[1].data = reinterpret_cast<void *>(FF);
1421
1422  res->rtyp = LIST_CMD; // list of int/module
1423  res->data = reinterpret_cast<void *>(l);
1424
1425  return FALSE;
1426
1427}
1428
1429
1430/* // the following turned out to be unnecessary...   
1431/// Finds p^th AM ordering, and returns its position in r->typ[] AND
1432/// corresponding &r->wvhdl[]
1433/// returns FALSE if something went wrong!
1434/// p - starts with 0!
1435BOOLEAN rGetAMPos(const ring r, const int p, int &typ_pos, int &wvhdl_pos, const BOOLEAN bSearchWvhdl = FALSE)
1436{
1437#if MYTEST
1438  Print("rGetAMPos(p: %d...)\nF:", p);
1439  PrintLn();
1440#endif
1441  typ_pos = -1;
1442  wvhdl_pos = -1;
1443
1444  if (r->typ==NULL)
1445    return FALSE;
1446
1447
1448  int j = p; // Which IS record to use...
1449  for( int pos = 0; pos < r->OrdSize; pos++ )
1450    if( r->typ[pos].ord_typ == ro_am)
1451      if( j-- == 0 )
1452      {
1453        typ_pos = pos;
1454
1455        if( bSearchWvhdl )
1456        {
1457          const int nblocks = rBlocks(r) - 1;
1458          const int* w = r->typ[pos].data.am.weights; // ?
1459
1460          for( pos = 0; pos <= nblocks; pos ++ )
1461            if (r->order[pos] == ringorder_am)
1462              if( r->wvhdl[pos] == w )
1463              {
1464                wvhdl_pos = pos;
1465                break;
1466              }
1467          if (wvhdl_pos < 0)
1468            return FALSE;
1469
1470          assume(wvhdl_pos >= 0);
1471        }
1472        assume(typ_pos >= 0);
1473        return TRUE;
1474      }
1475
1476  return FALSE;
1477}
1478
1479// // ?
1480// static BOOLEAN GetAMData(leftv res, leftv h)
1481// {
1482//   NoReturn(res);
1483//
1484//   const ring r = currRing;
1485//
1486//   int p = 0; // which IS-block? p^th!
1487//
1488//   if ((h!=NULL) && (h->Typ()==INT_CMD))
1489//     p = (int)((long)(h->Data())); h=h->next;
1490//
1491//   assume(p >= 0);
1492//
1493//   int d, w;
1494//   
1495//   if( !rGetAMPos(r, p, d, w, TRUE) )
1496//   {
1497//     Werror("`GetAMData([int])`: no %d^th _am block-ordering!", p);
1498//     return TRUE;
1499//   }
1500//
1501//   assume( r->typ[d].ord_typ == ro_am );
1502//   assume( r->order[w] == ringorder_am );
1503//
1504//
1505//   const short start = r->typ[d].data.am.start;  // bounds of ordering (in E)
1506//   const short end = r->typ[d].data.am.end;
1507//   const short len_gen = r->typ[d].data.am.len_gen; // i>len_gen: weight(gen(i)):=0
1508//   const int *weights = r->typ[d].data.am.weights; // pointers into wvhdl field of length (end-start+1) + len_gen
1509//   // contents w_1,... w_n, len, mod_w_1, .. mod_w_len, 0
1510//
1511//   assume( weights == r->wvhdl[w] );
1512//
1513//   
1514//   lists l=(lists)omAllocBin(slists_bin);
1515//   l->Init(2);
1516//
1517//   const short V = end-start+1;
1518//   intvec* ww_vars = new intvec(V);
1519//   intvec* ww_gens = new intvec(len_gen);
1520//
1521//   for (int i = 0; i < V; i++ )
1522//     (*ww_vars)[i] = weights[i];
1523//
1524//   assume( weights[V] == len_gen );
1525//
1526//   for (int i = 0; i < len_gen; i++ )
1527//     (*ww_gens)[i] = weights[i - V - 1];
1528//   
1529//
1530//   l->m[0].rtyp = INTVEC_CMD;
1531//   l->m[0].data = reinterpret_cast<void *>(ww_vars);
1532//
1533//   l->m[1].rtyp = INTVEC_CMD;
1534//   l->m[1].data = reinterpret_cast<void *>(ww_gens);
1535//
1536//
1537//   return FALSE;
1538//
1539// }
1540*/
1541
1542/// Returns old SyzCompLimit, can set new limit
1543static BOOLEAN SetInducedReferrence(leftv res, leftv h)
1544{
1545  NoReturn(res);
1546
1547  const ring r = currRing;
1548
1549  if( !( (h!=NULL) && ( (h->Typ()==IDEAL_CMD) || (h->Typ()==MODUL_CMD))) )
1550  {
1551    WerrorS("`SetInducedReferrence(<ideal/module>, [int[, int]])` expected");
1552    return TRUE;
1553  }
1554
1555  const ideal F = (ideal)h->Data(); ; // No copy!
1556  h=h->next;
1557
1558  int rank = 0;
1559
1560  if ((h!=NULL) && (h->Typ()==INT_CMD))
1561  {
1562    rank = (int)((long)(h->Data())); h=h->next;
1563    assume(rank >= 0);
1564  } else
1565    rank = id_RankFreeModule(F, r); // Starting syz-comp (1st: i+1)
1566
1567  int p = 0; // which IS-block? p^th!
1568
1569  if ((h!=NULL) && (h->Typ()==INT_CMD))
1570  {
1571    p = (int)((long)(h->Data())); h=h->next;
1572    assume(p >= 0);
1573  }
1574
1575  const int posIS = rGetISPos(p, r);
1576
1577  if(  /*(*/ -1 == posIS /*)*/  )
1578  {
1579    WerrorS("`SetInducedReferrence(<ideal/module>, [int[, int]])` called on incompatible ring (not created by 'MakeInducedSchreyerOrdering'!)");
1580    return TRUE;
1581  }
1582
1583
1584
1585  // F & componentWeights belong to that ordering block of currRing now:
1586  rSetISReference(r, F, rank, p); // F will be copied!
1587  return FALSE;
1588}
1589
1590
1591//    F = ISUpdateComponents( F, V, MIN );
1592//    // replace gen(i) -> gen(MIN + V[i-MIN]) for all i > MIN in all terms from F!
1593static BOOLEAN ISUpdateComponents(leftv res, leftv h)
1594{
1595  NoReturn(res);
1596
1597  PrintS("ISUpdateComponents:.... \n");
1598
1599  if ((h!=NULL) && (h->Typ()==MODUL_CMD))
1600  {
1601    ideal F = (ideal)h->Data(); ; // No copy!
1602    h=h->next;
1603
1604    if ((h!=NULL) && (h->Typ()==INTVEC_CMD))
1605    {
1606      const intvec* const V = (const intvec* const) h->Data();
1607      h=h->next;
1608
1609      if ((h!=NULL) && (h->Typ()==INT_CMD))
1610      {
1611        const int MIN = (int)((long)(h->Data()));
1612
1613        pISUpdateComponents(F, V, MIN, currRing);
1614        return FALSE;
1615      }
1616    }
1617  }
1618
1619  WerrorS("`ISUpdateComponents(<module>, intvec, int)` expected");
1620  return TRUE;
1621}
1622
1623
1624/// NF using length
1625static BOOLEAN reduce_syz(leftv res, leftv h)
1626{
1627  // const ring r = currRing;
1628
1629  if ( !( (h!=NULL) && (h->Typ()==VECTOR_CMD || h->Typ()==POLY_CMD) ) )
1630  {
1631    WerrorS("`reduce_syz(<poly/vector>!, <ideal/module>, <int>, [int])` expected");
1632    return TRUE;
1633  }
1634
1635  res->rtyp = h->Typ();
1636  const poly v = reinterpret_cast<poly>(h->Data());
1637  h=h->next;
1638
1639  if ( !( (h!=NULL) && (h->Typ()==MODUL_CMD || h->Typ()==IDEAL_CMD ) ) )
1640  {
1641    WerrorS("`reduce_syz(<poly/vector>, <ideal/module>!, <int>, [int])` expected");
1642    return TRUE;
1643  }
1644
1645  assumeStdFlag(h);
1646  const ideal M = reinterpret_cast<ideal>(h->Data()); h=h->next;
1647
1648
1649  if ( !( (h!=NULL) && (h->Typ()== INT_CMD)  ) )
1650  {
1651    WerrorS("`reduce_syz(<poly/vector>, <ideal/module>, <int>!, [int])` expected");
1652    return TRUE;
1653  }
1654
1655  const int iSyzComp = (int)((long)(h->Data())); h=h->next;
1656
1657  int iLazyReduce = 0;
1658
1659  if ( ( (h!=NULL) && (h->Typ()== INT_CMD)  ) )
1660    iLazyReduce = (int)((long)(h->Data())); 
1661
1662  res->data = (void *)kNFLength(M, currQuotient, v, iSyzComp, iLazyReduce); // NOTE: currRing :(
1663  return FALSE;
1664}
1665
1666
1667/// Get raw syzygies (idPrepare)
1668static BOOLEAN idPrepare(leftv res, leftv h)
1669{
1670  //        extern int rGetISPos(const int p, const ring r);
1671
1672  const ring r = currRing;
1673
1674  const bool isSyz = rIsSyzIndexRing(r);
1675  const int posIS = rGetISPos(0, r);
1676
1677
1678  if ( !( (h!=NULL) && (h->Typ()==MODUL_CMD) && (h->Data() != NULL) ) )
1679  {
1680    WerrorS("`idPrepare(<module>)` expected");
1681    return TRUE;
1682  }
1683
1684  const ideal I = reinterpret_cast<ideal>(h->Data());
1685
1686  assume( I != NULL );
1687  idTest(I);
1688
1689  int iComp = -1;
1690
1691  h=h->next;
1692  if ( (h!=NULL) && (h->Typ()==INT_CMD) )
1693  {
1694    iComp = (int)((long)(h->Data()));
1695  } else
1696  {
1697      if( (!isSyz) && (-1 == posIS) )
1698      {
1699        WerrorS("`idPrepare(<...>)` called on incompatible ring (not created by 'MakeSyzCompOrdering' or 'MakeInducedSchreyerOrdering'!)");
1700        return TRUE;
1701      }
1702
1703    if( isSyz )
1704      iComp = rGetCurrSyzLimit(r);
1705    else
1706      iComp = id_RankFreeModule(r->typ[posIS].data.is.F, r); // ;
1707  }
1708 
1709  assume(iComp >= 0);
1710
1711
1712  intvec* w = reinterpret_cast<intvec *>(atGet(h, "isHomog", INTVEC_CMD));
1713  tHomog hom = testHomog;
1714
1715  //           int add_row_shift = 0;
1716  //
1717  if (w!=NULL)
1718  {
1719    w = ivCopy(w);
1720  //             add_row_shift = ww->min_in();
1721  //
1722  //             (*ww) -= add_row_shift;
1723  //             
1724  //             if (idTestHomModule(I, currQuotient, ww))
1725  //             {
1726    hom = isHomog;
1727  //               w = ww;
1728  //             }
1729  //             else
1730  //             {
1731  //               //WarnS("wrong weights");
1732  //               delete ww;
1733  //               w = NULL;
1734  //               hom=testHomog;
1735  //             }
1736  }
1737
1738
1739  // computes syzygies of h1,
1740  // works always in a ring with ringorder_s
1741  // NOTE: rSetSyzComp(syzcomp) should better be called beforehand
1742  //        ideal idPrepare (ideal  h1, tHomog hom, int syzcomp, intvec **w);
1743
1744  ideal J = // idPrepare( I, hom, iComp, &w);
1745           kStd(I, currQuotient, hom, &w, NULL, iComp);
1746
1747  idTest(J);
1748
1749  if (w!=NULL)
1750    atSet(res, omStrDup("isHomog"), w, INTVEC_CMD);
1751  //             if (w!=NULL) delete w;
1752
1753  res->rtyp = MODUL_CMD;
1754  res->data = reinterpret_cast<void *>(J);
1755  return FALSE;
1756}
1757
1758/// Get raw syzygies (idPrepare)
1759static BOOLEAN _p_Content(leftv res, leftv h)
1760{
1761  if ( !( (h!=NULL) && (h->Typ()==POLY_CMD) && (h->Data() != NULL) ) )
1762  {
1763    WerrorS("`p_Content(<poly-var>)` expected");
1764    return TRUE;
1765  }
1766
1767
1768  const poly p = reinterpret_cast<poly>(h->Data());
1769
1770 
1771  pTest(p);  pWrite(p); PrintLn();
1772
1773 
1774  p_Content( p, currRing);     
1775
1776  pTest(p);
1777  pWrite(p); PrintLn();
1778 
1779  NoReturn(res);
1780  return FALSE;
1781}
1782
1783static BOOLEAN _m2_end(leftv res, leftv h)
1784{
1785  int ret = 0;
1786 
1787  if ( (h!=NULL) && (h->Typ()!=INT_CMD) )
1788  {
1789    WerrorS("`m2_end([<int>])` expected");
1790    return TRUE;
1791  }
1792  ret = (int)(long)(h->Data());
1793
1794  m2_end( ret );
1795
1796  NoReturn(res);
1797  return FALSE;
1798}
1799
1800   
1801
1802END_NAMESPACE
1803
1804
1805int SI_MOD_INIT(syzextra)(SModulFunctions* psModulFunctions) 
1806{
1807#define ADD0(A,B,C,D,E) A(B, (char*)C, D, E)
1808// #define ADD(A,B,C,D,E) ADD0(iiAddCproc, "", C, D, E)
1809  #define ADD(A,B,C,D,E) ADD0(A->iiAddCproc, B, C, D, E)
1810  ADD(psModulFunctions, currPack->libname, "ClearContent", FALSE, _ClearContent);
1811  ADD(psModulFunctions, currPack->libname, "ClearDenominators", FALSE, _ClearDenominators);
1812
1813  ADD(psModulFunctions, currPack->libname, "m2_end", FALSE, _m2_end);
1814
1815  ADD(psModulFunctions, currPack->libname, "DetailedPrint", FALSE, DetailedPrint);
1816  ADD(psModulFunctions, currPack->libname, "leadmonomial", FALSE, _leadmonom);
1817  ADD(psModulFunctions, currPack->libname, "leadcomp", FALSE, leadcomp);
1818  ADD(psModulFunctions, currPack->libname, "leadrawexp", FALSE, leadrawexp);
1819
1820  ADD(psModulFunctions, currPack->libname, "ISUpdateComponents", FALSE, ISUpdateComponents);
1821  ADD(psModulFunctions, currPack->libname, "SetInducedReferrence", FALSE, SetInducedReferrence);
1822  ADD(psModulFunctions, currPack->libname, "GetInducedData", FALSE, GetInducedData);
1823  ADD(psModulFunctions, currPack->libname, "SetSyzComp", FALSE, SetSyzComp);
1824  ADD(psModulFunctions, currPack->libname, "MakeInducedSchreyerOrdering", FALSE, MakeInducedSchreyerOrdering);
1825  ADD(psModulFunctions, currPack->libname, "MakeSyzCompOrdering", FALSE, MakeSyzCompOrdering);
1826
1827  ADD(psModulFunctions, currPack->libname, "ProfilerStart", FALSE, _ProfilerStart); ADD(psModulFunctions, currPack->libname, "ProfilerStop",  FALSE, _ProfilerStop );
1828 
1829  ADD(psModulFunctions, currPack->libname, "noop", FALSE, noop);
1830  ADD(psModulFunctions, currPack->libname, "idPrepare", FALSE, idPrepare);
1831  ADD(psModulFunctions, currPack->libname, "reduce_syz", FALSE, reduce_syz);
1832
1833  ADD(psModulFunctions, currPack->libname, "p_Content", FALSE, _p_Content);
1834
1835  ADD(psModulFunctions, currPack->libname, "Tail", FALSE, Tail);
1836 
1837  ADD(psModulFunctions, currPack->libname, "ComputeLeadingSyzygyTerms", FALSE, _ComputeLeadingSyzygyTerms);
1838  ADD(psModulFunctions, currPack->libname, "Compute2LeadingSyzygyTerms", FALSE, _Compute2LeadingSyzygyTerms);
1839 
1840  ADD(psModulFunctions, currPack->libname, "Sort_c_ds", FALSE, _Sort_c_ds);
1841  ADD(psModulFunctions, currPack->libname, "FindReducer", FALSE, _FindReducer);
1842
1843
1844  ADD(psModulFunctions, currPack->libname, "ReduceTerm", FALSE, _ReduceTerm);
1845  ADD(psModulFunctions, currPack->libname, "TraverseTail", FALSE, _TraverseTail);
1846
1847   
1848  ADD(psModulFunctions, currPack->libname, "SchreyerSyzygyNF", FALSE, _SchreyerSyzygyNF);
1849  ADD(psModulFunctions, currPack->libname, "ComputeSyzygy", FALSE, _ComputeSyzygy);
1850 
1851  //  ADD(psModulFunctions, currPack->libname, "GetAMData", FALSE, GetAMData);
1852
1853  //  ADD(psModulFunctions, currPack->libname, "", FALSE, );
1854
1855#undef ADD 
1856  return 0;
1857}
1858
1859#ifndef EMBED_PYTHON
1860extern "C" { 
1861int mod_init(SModulFunctions* psModulFunctions)
1862{ 
1863  return SI_MOD_INIT(syzextra)(psModulFunctions); 
1864}
1865}
1866#endif
Note: See TracBrowser for help on using the repository browser.