source: git/dyn_modules/syzextra/mod_main.cc @ 0c86ae

spielwiese
Last change on this file since 0c86ae was 0c86ae, checked in by Oleksandr Motsak <motsak@…>, 11 years ago
For profiling: use google proftools (optionally)
  • Property mode set to 100644
File size: 23.9 KB
Line 
1#include <kernel/mod2.h>
2
3#include <omalloc/omalloc.h>
4
5#include <misc/intvec.h>
6
7#include <coeffs/coeffs.h>
8
9#include <polys/PolyEnumerator.h>
10
11#include <polys/monomials/p_polys.h>
12#include <polys/monomials/ring.h>
13// #include <kernel/longrat.h>
14#include <kernel/kstd1.h>
15
16#include <kernel/polys.h>
17
18#include <kernel/syz.h>
19
20#include <Singular/tok.h>
21#include <Singular/ipid.h>
22#include <Singular/lists.h>
23#include <Singular/attrib.h>
24
25#include <Singular/ipid.h> 
26#include <Singular/ipshell.h> // For iiAddCproc
27
28// extern coeffs coeffs_BIGINT
29
30#include "singularxx_defs.h"
31#include "DebugPrint.h"
32#include "myNF.h"
33
34
35#if GOOGLE_PROFILE_ENABLED
36#include <google/profiler.h>
37#endif // #if GOOGLE_PROFILE_ENABLED
38
39
40#include <stdio.h>
41#include <stdlib.h>
42#include <string.h>
43
44
45extern void pISUpdateComponents(ideal F, const intvec *const V, const int MIN, const ring r);
46// extern ring rCurrRingAssure_SyzComp();
47extern ring rAssure_InducedSchreyerOrdering(const ring r, BOOLEAN complete, int sign);
48extern int rGetISPos(const int p, const ring r);
49
50
51USING_NAMESPACE( SINGULARXXNAME :: DEBUG )
52USING_NAMESPACE( SINGULARXXNAME :: NF )
53
54BEGIN_NAMESPACE_NONAME
55static inline void NoReturn(leftv& res)
56{
57  res->rtyp = NONE;
58  res->data = NULL;
59}
60
61/// wrapper around n_ClearContent
62static BOOLEAN _ClearContent(leftv res, leftv h)
63{
64  NoReturn(res);
65
66  const char *usage = "'ClearContent' needs a (non-zero!) poly or vector argument...";
67 
68  if( h == NULL )
69  {
70    WarnS(usage);
71    return TRUE;
72  }
73
74  assume( h != NULL );
75
76  if( !( h->Typ() == POLY_CMD || h->Typ() == VECTOR_CMD) )
77  {
78    WarnS(usage);
79    return TRUE;
80  }
81
82  assume (h->Next() == NULL);
83 
84  poly ph = reinterpret_cast<poly>(h->Data());
85 
86  if( ph == NULL )
87  {
88    WarnS(usage);
89    return TRUE;
90  }
91 
92  const ring r =  currRing;
93  assume( r != NULL ); assume( r->cf != NULL ); const coeffs C = r->cf;
94
95  number n;
96
97  // experimentall (recursive enumerator treatment) of alg. ext
98  CPolyCoeffsEnumerator itr(ph);
99  n_ClearContent(itr, n, C);
100
101  res->data = n;
102  res->rtyp = NUMBER_CMD;
103
104  return FALSE;
105}
106
107/// wrapper around n_ClearDenominators
108static BOOLEAN _ClearDenominators(leftv res, leftv h)
109{
110  NoReturn(res);
111
112  const char *usage = "'ClearDenominators' needs a (non-zero!) poly or vector argument...";
113
114  if( h == NULL )
115  {
116    WarnS(usage);
117    return TRUE;
118  }
119
120  assume( h != NULL );
121
122  if( !( h->Typ() == POLY_CMD || h->Typ() == VECTOR_CMD) )
123  {
124    WarnS(usage);
125    return TRUE;
126  }
127
128  assume (h->Next() == NULL);
129
130  poly ph = reinterpret_cast<poly>(h->Data());
131
132  if( ph == NULL )
133  {
134    WarnS(usage);
135    return TRUE;
136  }
137
138  const ring r =  currRing;
139  assume( r != NULL ); assume( r->cf != NULL ); const coeffs C = r->cf;
140
141  number n;
142
143  // experimentall (recursive enumerator treatment) of alg. ext.
144  CPolyCoeffsEnumerator itr(ph);
145  n_ClearDenominators(itr, n, C);
146
147  res->data = n;
148  res->rtyp = NUMBER_CMD;
149
150  return FALSE;
151}
152
153
154/// try to get an optional (simple) integer argument out of h
155/// or return the default value
156static int getOptionalInteger(const leftv& h, const int _n)
157{
158  if( h!= NULL && h->Typ() == INT_CMD )
159  {
160    int n = (int)(long)(h->Data());
161
162    if( n < 0 )
163      Warn("Negative (%d) optional integer argument", n);
164
165    return (n);
166  }
167
168  return (_n); 
169}
170
171static BOOLEAN noop(leftv __res, leftv /*__v*/)
172{
173  NoReturn(__res);
174  return FALSE;
175}
176
177static BOOLEAN _ProfilerStart(leftv __res, leftv h)
178{
179  NoReturn(__res);
180#if GOOGLE_PROFILE_ENABLED
181  if( h!= NULL && h->Typ() == STRING_CMD )
182  {
183    const char* name = (char*)(h->Data());
184    assume( name != NULL );   
185    ProfilerStart(name);
186  } else
187    WerrorS("ProfilerStart requires a string [name] argument"); 
188#else
189  WarnS("Sorry no google profiler support (GOOGLE_PROFILE_ENABLE!=1)...");
190//  return TRUE; // ?
191#endif // #if GOOGLE_PROFILE_ENABLED
192  return FALSE;
193  (void)h;
194}
195static BOOLEAN _ProfilerStop(leftv __res, leftv /*__v*/)
196{
197  NoReturn(__res);
198#if GOOGLE_PROFILE_ENABLED
199  ProfilerStop();
200#else
201  WarnS("Sorry no google profiler support (GOOGLE_PROFILE_ENABLED!=1)...");
202//  return TRUE; // ?
203#endif // #if GOOGLE_PROFILE_ENABLED
204  return FALSE;
205}
206
207static inline number jjLONG2N(long d)
208{
209  return n_Init(d, coeffs_BIGINT);
210}
211
212static inline void view(const intvec* v)
213{
214#ifndef NDEBUG
215  v->view();
216#else
217  // This code duplication is only due to Hannes's #ifndef NDEBUG!
218  Print ("intvec: {rows: %d, cols: %d, length: %d, Values: \n", v->rows(), v->cols(), v->length());
219
220  for (int i = 0; i < v->rows(); i++)
221  {
222    Print ("Row[%3d]:", i);
223    for (int j = 0; j < v->cols(); j++)
224      Print (" %5d", (*v)[j + i * (v->cols())] );
225    PrintLn ();
226  }
227  PrintS ("}\n");
228#endif
229
230}
231
232                   
233
234static BOOLEAN DetailedPrint(leftv __res, leftv h)
235{
236  NoReturn(__res);
237
238  if( h == NULL )
239  {
240    WarnS("DetailedPrint needs an argument...");
241    return TRUE;
242  }
243
244  if( h->Typ() == RING_CMD)
245  {
246    const ring r = (const ring)h->Data();
247    rWrite(r, TRUE);
248    PrintLn();
249#ifdef RDEBUG
250    rDebugPrint(r);
251#endif
252    return FALSE;
253  }
254
255  if( h->Typ() == POLY_CMD || h->Typ() == VECTOR_CMD)
256  {
257    const poly p = (const poly)h->Data(); h = h->Next();
258
259    dPrint(p, currRing, currRing, getOptionalInteger(h, 3));
260
261    return FALSE;
262  }
263
264  if( h->Typ() == IDEAL_CMD || h->Typ() == MODUL_CMD)
265  {
266    const ideal id = (const ideal)h->Data(); h = h->Next(); 
267
268    dPrint(id, currRing, currRing, getOptionalInteger(h, 3));
269   
270    return FALSE;           
271  }
272
273  if( h->Typ() == RESOLUTION_CMD )
274  {
275    const syStrategy syzstr = reinterpret_cast<const syStrategy>(h->Data());
276
277    h = h->Next();
278
279    int nTerms = getOptionalInteger(h, 1);
280
281
282    Print("RESOLUTION_CMD(%p): ", reinterpret_cast<const void*>(syzstr)); PrintLn();
283
284    const ring save = currRing;
285    const ring r = syzstr->syRing;
286    const ring rr = (r != NULL) ? r: save;
287
288
289    const int iLength = syzstr->length;
290
291    Print("int 'length': %d", iLength); PrintLn();
292    Print("int 'regularity': %d", syzstr->regularity); PrintLn();
293    Print("short 'list_length': %hd", syzstr->list_length); PrintLn();
294    Print("short 'references': %hd", syzstr->references); PrintLn();
295
296
297#define PRINT_pINTVECTOR(s, v) Print("intvec '%10s'(%p)", #v, reinterpret_cast<const void*>((s)->v)); \
298if( (s)->v != NULL ){ PrintS(": "); view((s)->v); }; \
299PrintLn();
300
301    PRINT_pINTVECTOR(syzstr, resolution);
302    PRINT_pINTVECTOR(syzstr, betti);
303    PRINT_pINTVECTOR(syzstr, Tl);
304    PRINT_pINTVECTOR(syzstr, cw);
305#undef PRINT_pINTVECTOR
306
307    if (r == NULL)
308      Print("ring '%10s': NULL", "syRing");
309    else 
310      if (r == currRing)
311        Print("ring '%10s': currRing", "syRing");
312      else
313        if (r != NULL && r != save)
314        {
315          Print("ring '%10s': ", "syRing");
316          rWrite(r);
317#ifdef RDEBUG
318          //              rDebugPrint(r);
319#endif
320          // rChangeCurrRing(r);
321        }           
322    PrintLn();
323
324    const SRes rP = syzstr->resPairs;
325    Print("SRes 'resPairs': %p", reinterpret_cast<const void*>(rP)); PrintLn();
326
327    if (rP != NULL)
328      for (int iLevel = 0; (iLevel < iLength) && (rP[iLevel] != NULL) && ((*syzstr->Tl)[iLevel] >= 0); iLevel++)
329      {
330        int n = 0;
331        const int iTl = (*syzstr->Tl)[iLevel];
332        for (int j = 0; (j < iTl) && ((rP[iLevel][j].lcm!=NULL) || (rP[iLevel][j].syz!=NULL)); j++)
333        {
334          if (rP[iLevel][j].isNotMinimal==NULL)
335            n++;
336        }
337        Print("minimal-resPairs-Size[1+%d]: %d", iLevel, n); PrintLn();
338      }
339
340
341    //  const ring rrr = (iLevel > 0) ? rr : save; ?
342#define PRINT_RESOLUTION(s, v) Print("resolution '%12s': %p", #v, reinterpret_cast<const void*>((s)->v)); PrintLn(); \
343if ((s)->v != NULL) \
344  for (int iLevel = 0; (iLevel < iLength) && ( ((s)->v)[iLevel] != NULL ); iLevel++) \
345  { \
346    /* const ring rrr = (iLevel > 0) ? save : save; */ \
347    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)*/ ); \
348    PrintLn(); \
349  } \
350  PrintLn();
351
352    // resolvente:
353    PRINT_RESOLUTION(syzstr, minres);
354    PRINT_RESOLUTION(syzstr, fullres);
355
356    assume (id_RankFreeModule (syzstr->res[1], rr) == syzstr->res[1]->rank);
357
358    PRINT_RESOLUTION(syzstr, res);
359    PRINT_RESOLUTION(syzstr, orderedRes);
360#undef PRINT_RESOLUTION
361
362#define PRINT_POINTER(s, v) Print("pointer '%17s': %p", #v, reinterpret_cast<const void*>((s)->v)); PrintLn();
363    // 2d arrays:
364    PRINT_POINTER(syzstr, truecomponents);
365    PRINT_POINTER(syzstr, ShiftedComponents);
366    PRINT_POINTER(syzstr, backcomponents);
367    PRINT_POINTER(syzstr, Howmuch);
368    PRINT_POINTER(syzstr, Firstelem);
369    PRINT_POINTER(syzstr, elemLength);
370    PRINT_POINTER(syzstr, sev);
371
372    // arrays of intvects:
373    PRINT_POINTER(syzstr, weights);
374    PRINT_POINTER(syzstr, hilb_coeffs);
375#undef PRINT_POINTER
376
377
378    if (syzstr->fullres==NULL)
379    {
380      PrintS("resolution 'fullres': (NULL) => resolution not computed yet");
381      PrintLn();
382    } else
383    {
384      Print("resolution 'fullres': (%p) => resolution seems to be computed already", reinterpret_cast<const void*>(syzstr->fullres));
385      PrintLn();
386      dPrint(*syzstr->fullres, save, save, nTerms);
387    }
388
389
390
391
392    if (syzstr->minres==NULL)
393    {
394      PrintS("resolution 'minres': (NULL) => resolution not minimized yet");
395      PrintLn();
396    } else
397    {
398      Print("resolution 'minres': (%p) => resolution seems to be minimized already", reinterpret_cast<const void*>(syzstr->minres));
399      PrintLn();
400      dPrint(*syzstr->minres, save, save, nTerms);
401    }
402
403
404
405
406    /*
407    int ** truecomponents;
408    long** ShiftedComponents;
409    int ** backcomponents;
410    int ** Howmuch;
411    int ** Firstelem;
412    int ** elemLength;
413    unsigned long ** sev;
414
415    intvec ** weights;
416    intvec ** hilb_coeffs;
417
418    SRes resPairs;               //polynomial data for internal use only
419
420    resolvente fullres;
421    resolvente minres;
422    resolvente res;              //polynomial data for internal use only
423    resolvente orderedRes;       //polynomial data for internal use only
424*/
425
426    //            if( currRing != save ) rChangeCurrRing(save);
427  }
428
429
430  return FALSE;
431}
432
433
434
435
436
437
438static BOOLEAN Tail(leftv res, leftv h)
439{
440  NoReturn(res);
441
442  if( h == NULL )
443  {
444    WarnS("Tail needs an argument...");
445    return TRUE;
446  }
447
448  assume( h != NULL );
449
450  if( h->Typ() == POLY_CMD || h->Typ() == VECTOR_CMD)
451  {
452    const poly p = (const poly)h->Data();
453
454    res->rtyp = h->Typ();
455
456    if( p == NULL)
457      res->data = NULL;
458    else
459      res->data = p_Copy( pNext(p), currRing );
460
461    h = h->Next(); assume (h == NULL);
462   
463    return FALSE;
464  }
465
466  if( h->Typ() == IDEAL_CMD || h->Typ() == MODUL_CMD)
467  {
468    const ideal id = (const ideal)h->Data();
469
470    res->rtyp = h->Typ();
471
472    if( id == NULL)
473      res->data = NULL;
474    else
475    {
476      const ideal newid = idInit(IDELEMS(id),id->rank);
477      for (int i=IDELEMS(id) - 1; i >= 0; i--)
478        if( id->m[i] != NULL )
479          newid->m[i] = p_Copy(pNext(id->m[i]), currRing);
480        else
481          newid->m[i] = NULL;
482     
483      res->data = newid; 
484    }
485   
486    h = h->Next(); assume (h == NULL);
487   
488    return FALSE;
489  }
490
491  WarnS("Tail needs a single poly/vector/ideal/module argument...");
492  return TRUE;
493}
494
495
496
497/// Get leading term without a module component
498static BOOLEAN leadmonom(leftv res, leftv h)
499{
500  NoReturn(res);
501
502  if ((h!=NULL) && (h->Typ()==VECTOR_CMD || h->Typ()==POLY_CMD) && (h->Data() != NULL))
503  {
504    const ring r = currRing;
505    const poly p = (poly)(h->Data());
506
507    poly m = NULL;
508
509    if( p != NULL )
510    {
511      assume( p != NULL );
512      assume( p_LmTest(p, r) );
513
514      m = p_LmInit(p, r);
515      p_SetCoeff0(m, n_Copy(p_GetCoeff(p, r), r), r);
516
517      //            if( p_GetComp(m, r) != 0 )
518      //            {
519      p_SetComp(m, 0, r);
520      p_Setm(m, r);
521      //            }
522
523      assume( p_GetComp(m, r) == 0 );
524      assume( m != NULL );
525      assume( p_LmTest(m, r) );
526    }
527
528    res->rtyp = POLY_CMD;
529    res->data = reinterpret_cast<void *>(m);
530
531    return FALSE;
532  }
533
534  WerrorS("`leadmonom(<poly/vector>)` expected");
535  return TRUE;
536}
537
538/// Get leading component
539static BOOLEAN leadcomp(leftv res, leftv h)
540{
541  NoReturn(res);
542
543  if ((h!=NULL) && (h->Typ()==VECTOR_CMD || h->Typ()==POLY_CMD))
544  {
545    const ring r = currRing;
546
547    const poly p = (poly)(h->Data());
548
549    if (p != NULL )
550    {
551      assume( p != NULL );
552      assume( p_LmTest(p, r) );
553
554      const unsigned long iComp = p_GetComp(p, r);
555
556  //    assume( iComp > 0 ); // p is a vector
557
558      res->data = reinterpret_cast<void *>(jjLONG2N(iComp));
559    } else
560      res->data = reinterpret_cast<void *>(jjLONG2N(0));
561     
562
563    res->rtyp = BIGINT_CMD;
564    return FALSE;
565  }
566
567  WerrorS("`leadcomp(<poly/vector>)` expected");
568  return TRUE;
569}
570
571
572
573
574/// Get raw leading exponent vector
575static BOOLEAN leadrawexp(leftv res, leftv h)
576{
577  NoReturn(res);
578
579  if ((h!=NULL) && (h->Typ()==VECTOR_CMD || h->Typ()==POLY_CMD) && (h->Data() != NULL))
580  {
581    const ring r = currRing;
582    const poly p = (poly)(h->Data());
583
584    assume( p != NULL );
585    assume( p_LmTest(p, r) );
586
587    const int iExpSize = r->ExpL_Size;
588
589//    intvec *iv = new intvec(iExpSize);
590
591    lists l=(lists)omAllocBin(slists_bin);
592    l->Init(iExpSize);
593
594    for(int i = iExpSize-1; i >= 0; i--)
595    {
596      l->m[i].rtyp = BIGINT_CMD;
597      l->m[i].data = reinterpret_cast<void *>(jjLONG2N(p->exp[i])); // longs...
598    }
599
600    res->rtyp = LIST_CMD; // list of bigints
601    res->data = reinterpret_cast<void *>(l);
602    return FALSE;
603  }
604
605  WerrorS("`leadrawexp(<poly/vector>)` expected");
606  return TRUE;
607}
608
609
610/// Endowe the current ring with additional (leading) Syz-component ordering
611static BOOLEAN MakeSyzCompOrdering(leftv res, leftv /*h*/)
612{
613
614  NoReturn(res);
615
616  //    res->data = rCurrRingAssure_SyzComp(); // changes current ring! :(
617  res->data = reinterpret_cast<void *>(rAssure_SyzComp(currRing, TRUE));
618  res->rtyp = RING_CMD; // return new ring!
619  // QRING_CMD?
620
621  return FALSE;
622}
623
624
625/// Same for Induced Schreyer ordering (ordering on components is defined by sign!)
626static BOOLEAN MakeInducedSchreyerOrdering(leftv res, leftv h)
627{
628
629  NoReturn(res);
630
631  int sign = 1;
632  if ((h!=NULL) && (h->Typ()==INT_CMD))
633  {
634    const int s = (int)((long)(h->Data()));
635
636    if( s != -1 && s != 1 )
637    {
638      WerrorS("`MakeInducedSchreyerOrdering(<int>)` called with wrong integer argument (must be +-1)!");
639      return TRUE;
640    }
641
642    sign = s;           
643  }
644
645  assume( sign == 1 || sign == -1 );
646  res->data = reinterpret_cast<void *>(rAssure_InducedSchreyerOrdering(currRing, TRUE, sign));
647  res->rtyp = RING_CMD; // return new ring!
648  // QRING_CMD?
649  return FALSE;
650}
651
652
653/// Returns old SyzCompLimit, can set new limit
654static BOOLEAN SetSyzComp(leftv res, leftv h)
655{
656  NoReturn(res);
657
658  const ring r = currRing;
659
660  if( !rIsSyzIndexRing(r) )
661  {
662    WerrorS("`SetSyzComp(<int>)` called on incompatible ring (not created by 'MakeSyzCompOrdering'!)");
663    return TRUE;
664  }
665
666  res->rtyp = INT_CMD;
667  res->data = reinterpret_cast<void *>(rGetCurrSyzLimit(r)); // return old syz limit
668
669  if ((h!=NULL) && (h->Typ()==INT_CMD))
670  {
671    const int iSyzComp = (int)reinterpret_cast<long>(h->Data());
672    assume( iSyzComp > 0 );
673    rSetSyzComp(iSyzComp, currRing);
674  }
675
676  return FALSE;
677}
678
679/// ?
680static BOOLEAN GetInducedData(leftv res, leftv h)
681{
682  NoReturn(res);
683
684  const ring r = currRing;
685
686  int p = 0; // which IS-block? p^th!
687
688  if ((h!=NULL) && (h->Typ()==INT_CMD))
689  {
690    p = (int)((long)(h->Data())); h=h->next;
691    assume(p >= 0);
692  }
693
694  const int pos = rGetISPos(p, r);
695
696  if( (-1 == pos) )
697  {
698    WerrorS("`GetInducedData([int])` called on incompatible ring (not created by 'MakeInducedSchreyerOrdering'!)");
699    return TRUE;
700  }
701
702
703  const int iLimit = r->typ[pos].data.is.limit;
704  const ideal F = r->typ[pos].data.is.F;
705  ideal FF = id_Copy(F, r);
706
707  lists l=(lists)omAllocBin(slists_bin);
708  l->Init(2);
709
710  l->m[0].rtyp = INT_CMD;
711  l->m[0].data = reinterpret_cast<void *>(iLimit);
712
713
714  //        l->m[1].rtyp = MODUL_CMD;
715
716  if( idIsModule(FF, r) )
717  {
718    l->m[1].rtyp = MODUL_CMD;
719
720    //          Print("before: %d\n", FF->nrows);
721    //          FF->nrows = id_RankFreeModule(FF, r); // ???
722    //          Print("after: %d\n", FF->nrows);
723  }
724  else
725    l->m[1].rtyp = IDEAL_CMD;
726
727  l->m[1].data = reinterpret_cast<void *>(FF);
728
729  res->rtyp = LIST_CMD; // list of int/module
730  res->data = reinterpret_cast<void *>(l);
731
732  return FALSE;
733
734}
735
736
737/// Returns old SyzCompLimit, can set new limit
738static BOOLEAN SetInducedReferrence(leftv res, leftv h)
739{
740  NoReturn(res);
741
742  const ring r = currRing;
743
744  if( !( (h!=NULL) && ( (h->Typ()==IDEAL_CMD) || (h->Typ()==MODUL_CMD))) )
745  {
746    WerrorS("`SetInducedReferrence(<ideal/module>, [int[, int]])` expected");
747    return TRUE;
748  }
749
750  const ideal F = (ideal)h->Data(); ; // No copy!
751  h=h->next;
752
753  int rank = 0;
754
755  if ((h!=NULL) && (h->Typ()==INT_CMD))
756  {
757    rank = (int)((long)(h->Data())); h=h->next;
758    assume(rank >= 0);
759  } else
760    rank = id_RankFreeModule(F, r); // Starting syz-comp (1st: i+1)
761
762  int p = 0; // which IS-block? p^th!
763
764  if ((h!=NULL) && (h->Typ()==INT_CMD))
765  {
766    p = (int)((long)(h->Data())); h=h->next;
767    assume(p >= 0);
768  }
769
770  const int posIS = rGetISPos(p, r);
771
772  if( (-1 == posIS) )
773  {
774    WerrorS("`SetInducedReferrence(<ideal/module>, [int[, int]])` called on incompatible ring (not created by 'MakeInducedSchreyerOrdering'!)");
775    return TRUE;
776  }
777
778
779
780  // F & componentWeights belong to that ordering block of currRing now:
781  rSetISReference(r, F, rank, p); // F will be copied!
782  return FALSE;
783}
784
785
786//    F = ISUpdateComponents( F, V, MIN );
787//    // replace gen(i) -> gen(MIN + V[i-MIN]) for all i > MIN in all terms from F!
788static BOOLEAN ISUpdateComponents(leftv res, leftv h)
789{
790  NoReturn(res);
791
792  PrintS("ISUpdateComponents:.... \n");
793
794  if ((h!=NULL) && (h->Typ()==MODUL_CMD))
795  {
796    ideal F = (ideal)h->Data(); ; // No copy!
797    h=h->next;
798
799    if ((h!=NULL) && (h->Typ()==INTVEC_CMD))
800    {
801      const intvec* const V = (const intvec* const) h->Data();
802      h=h->next;
803
804      if ((h!=NULL) && (h->Typ()==INT_CMD))
805      {
806        const int MIN = (int)((long)(h->Data()));
807
808        pISUpdateComponents(F, V, MIN, currRing);
809        return FALSE;
810      }
811    }
812  }
813
814  WerrorS("`ISUpdateComponents(<module>, intvec, int)` expected");
815  return TRUE;
816}
817
818
819/// NF using length
820static BOOLEAN reduce_syz(leftv res, leftv h)
821{
822  // const ring r = currRing;
823
824  if ( !( (h!=NULL) && (h->Typ()==VECTOR_CMD || h->Typ()==POLY_CMD) ) )
825  {
826    WerrorS("`reduce_syz(<poly/vector>!, <ideal/module>, <int>, [int])` expected");
827    return TRUE;
828  }
829
830  res->rtyp = h->Typ();
831  const poly v = reinterpret_cast<poly>(h->Data());
832  h=h->next;
833
834  if ( !( (h!=NULL) && (h->Typ()==MODUL_CMD || h->Typ()==IDEAL_CMD ) ) )
835  {
836    WerrorS("`reduce_syz(<poly/vector>, <ideal/module>!, <int>, [int])` expected");
837    return TRUE;
838  }
839
840  assumeStdFlag(h);
841  const ideal M = reinterpret_cast<ideal>(h->Data()); h=h->next;
842
843
844  if ( !( (h!=NULL) && (h->Typ()== INT_CMD)  ) )
845  {
846    WerrorS("`reduce_syz(<poly/vector>, <ideal/module>, <int>!, [int])` expected");
847    return TRUE;
848  }
849
850  const int iSyzComp = (int)((long)(h->Data())); h=h->next;
851
852  int iLazyReduce = 0;
853
854  if ( ( (h!=NULL) && (h->Typ()== INT_CMD)  ) )
855    iLazyReduce = (int)((long)(h->Data())); 
856
857  res->data = (void *)kNFLength(M, currQuotient, v, iSyzComp, iLazyReduce);
858  return FALSE;
859}
860
861
862/// Get raw syzygies (idPrepare)
863static BOOLEAN idPrepare(leftv res, leftv h)
864{
865  //        extern int rGetISPos(const int p, const ring r);
866
867  const ring r = currRing;
868
869  const bool isSyz = rIsSyzIndexRing(r);
870  const int posIS = rGetISPos(0, r);
871
872
873  if ( !( (h!=NULL) && (h->Typ()==MODUL_CMD) && (h->Data() != NULL) ) )
874  {
875    WerrorS("`idPrepare(<module>)` expected");
876    return TRUE;
877  }
878
879  const ideal I = reinterpret_cast<ideal>(h->Data());
880
881  assume( I != NULL );
882  idTest(I);
883
884  int iComp = -1;
885
886  h=h->next;
887  if ( (h!=NULL) && (h->Typ()==INT_CMD) )
888  {
889    iComp = (int)((long)(h->Data()));
890  } else
891  {
892      if( (!isSyz) && (-1 == posIS) )
893      {
894        WerrorS("`idPrepare(<...>)` called on incompatible ring (not created by 'MakeSyzCompOrdering' or 'MakeInducedSchreyerOrdering'!)");
895        return TRUE;
896      }
897
898    if( isSyz )
899      iComp = rGetCurrSyzLimit(r);
900    else
901      iComp = id_RankFreeModule(r->typ[posIS].data.is.F, r); // ;
902  }
903 
904  assume(iComp >= 0);
905
906
907  tHomog hom=testHomog;
908  intvec *w; //  = reinterpret_cast<intvec *>(atGet(h, "isHomog", INTVEC_CMD));
909
910  //           int add_row_shift = 0;
911  //
912  //           if (w!=NULL)
913  //           {
914  //             intvec * ww = ivCopy(w);
915  //
916  //             add_row_shift = ww->min_in();
917  //
918  //             (*ww) -= add_row_shift;
919  //             
920  //             if (idTestHomModule(I, currQuotient, ww))
921  //             {
922  //               hom = isHomog;
923  //               w = ww;
924  //             }
925  //             else
926  //             {
927  //               //WarnS("wrong weights");
928  //               delete ww;
929  //               w = NULL;
930  //               hom=testHomog;
931  //             }
932  //           }
933
934
935  // computes syzygies of h1,
936  // works always in a ring with ringorder_s
937  // NOTE: rSetSyzComp(syzcomp) should better be called beforehand
938  //        ideal idPrepare (ideal  h1, tHomog hom, int syzcomp, intvec **w);
939
940  ideal J = // idPrepare( I, hom, iComp, &w);
941           kStd(I, currQuotient, hom, &w, NULL, iComp);
942
943  idTest(J);
944
945  if (w!=NULL) delete w;
946  //          if (w!=NULL)
947  //            atSet(res, omStrDup("isHomog"), w, INTVEC_CMD);
948
949  res->rtyp = MODUL_CMD;
950  res->data = reinterpret_cast<void *>(J);
951  return FALSE;
952}
953
954/// Get raw syzygies (idPrepare)
955static BOOLEAN _p_Content(leftv res, leftv h)
956{
957  if ( !( (h!=NULL) && (h->Typ()==POLY_CMD) && (h->Data() != NULL) ) )
958  {
959    WerrorS("`p_Content(<poly-var>)` expected");
960    return TRUE;
961  }
962
963
964  const poly p = reinterpret_cast<poly>(h->Data());
965
966 
967  pTest(p);  pWrite(p); PrintLn();
968
969 
970  p_Content( p, currRing);     
971
972  pTest(p);
973  pWrite(p); PrintLn();
974 
975  NoReturn(res);
976  return false;
977}
978
979static BOOLEAN _m2_end(leftv res, leftv h)
980{
981  int ret = 0;
982 
983  if ( (h!=NULL) && (h->Typ()!=INT_CMD) )
984  {
985    WerrorS("`m2_end([<int>])` expected");
986    return TRUE;
987  }
988  ret = (int)(long)(h->Data());
989
990  m2_end( ret );
991
992  NoReturn(res);
993  return FALSE;
994}
995
996   
997
998END_NAMESPACE
999
1000extern "C"
1001{
1002
1003int mod_init(SModulFunctions* psModulFunctions) 
1004{
1005#define ADD0(A,B,C,D,E) A(B, (char*)C, D, E)
1006// #define ADD(A,B,C,D,E) ADD0(iiAddCproc, "", C, D, E)
1007  #define ADD(A,B,C,D,E) ADD0(A->iiAddCproc, B, C, D, E)
1008  ADD(psModulFunctions, currPack->libname, "ClearContent", FALSE, _ClearContent);
1009  ADD(psModulFunctions, currPack->libname, "ClearDenominators", FALSE, _ClearDenominators);
1010
1011  ADD(psModulFunctions, currPack->libname, "DetailedPrint", FALSE, DetailedPrint);
1012  ADD(psModulFunctions, currPack->libname, "leadmonomial", FALSE, leadmonom);
1013  ADD(psModulFunctions, currPack->libname, "leadcomp", FALSE, leadcomp);
1014  ADD(psModulFunctions, currPack->libname, "leadrawexp", FALSE, leadrawexp);
1015
1016  ADD(psModulFunctions, currPack->libname, "Tail", FALSE, Tail);
1017
1018  ADD(psModulFunctions, currPack->libname, "ISUpdateComponents", FALSE, ISUpdateComponents);
1019  ADD(psModulFunctions, currPack->libname, "SetInducedReferrence", FALSE, SetInducedReferrence);
1020  ADD(psModulFunctions, currPack->libname, "GetInducedData", FALSE, GetInducedData);
1021  ADD(psModulFunctions, currPack->libname, "SetSyzComp", FALSE, SetSyzComp);
1022  ADD(psModulFunctions, currPack->libname, "MakeInducedSchreyerOrdering", FALSE, MakeInducedSchreyerOrdering);
1023  ADD(psModulFunctions, currPack->libname, "MakeSyzCompOrdering", FALSE, MakeSyzCompOrdering);
1024
1025  ADD(psModulFunctions, currPack->libname, "ProfilerStart", FALSE, _ProfilerStart); ADD(psModulFunctions, currPack->libname, "ProfilerStop",  FALSE, _ProfilerStop );
1026 
1027  ADD(psModulFunctions, currPack->libname, "noop", FALSE, noop);
1028  ADD(psModulFunctions, currPack->libname, "idPrepare", FALSE, idPrepare);
1029  ADD(psModulFunctions, currPack->libname, "reduce_syz", FALSE, reduce_syz);
1030
1031  ADD(psModulFunctions, currPack->libname, "p_Content", FALSE, _p_Content);
1032
1033  ADD(psModulFunctions, currPack->libname, "m2_end", FALSE, _m2_end);
1034  //  ADD(psModulFunctions, currPack->libname, "", FALSE, );
1035#undef ADD 
1036  return 0;
1037}
1038}
Note: See TracBrowser for help on using the repository browser.