source: git/Singular/dyn_modules/syzextra/mod_main.cc @ db7f1f

spielwiese
Last change on this file since db7f1f was db7f1f, checked in by Hans Schoenemann <hannes@…>, 16 months ago
simplify syzextra
  • Property mode set to 100644
File size: 10.1 KB
Line 
1#include "kernel/mod2.h"
2
3#include "misc/intvec.h"
4#include "misc/options.h"
5
6#include "coeffs/coeffs.h"
7
8#include "polys/PolyEnumerator.h"
9
10#include "polys/monomials/p_polys.h"
11#include "polys/monomials/ring.h"
12#include "polys/simpleideals.h"
13
14#include "kernel/GBEngine/kstd1.h"
15
16#include "kernel/polys.h"
17
18#include "kernel/GBEngine/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
32#include "syzextra.h"
33
34
35#include "Singular/mod_lib.h"
36
37
38#include <stdio.h>
39#include <stdlib.h>
40#include <string.h>
41
42#include "polys/monomials/ring.h"
43
44
45// returns TRUE, if idRankFreeModule(m) > 0 ???
46/// test whether this input has vectors among entries or no enties
47/// result must be FALSE for only 0-entries
48static BOOLEAN id_IsModule(ideal id, ring r)
49{
50  id_Test(id, r);
51
52  if( id->rank != 1 ) return TRUE;
53
54  if (rRing_has_Comp(r))
55  {
56    const int l = IDELEMS(id);
57
58    for (int j=0; j<l; j++)
59      if (id->m[j] != NULL && p_GetComp(id->m[j], r) > 0)
60        return TRUE;
61
62    return FALSE; // rank: 1, only zero or no entries? can be an ideal OR module... BUT in the use-case should better be an ideal!
63  }
64
65  return FALSE;
66}
67
68
69
70
71static inline void NoReturn(leftv& res)
72{
73  res->rtyp = NONE;
74  res->data = NULL;
75}
76
77/// wrapper around n_ClearContent
78static BOOLEAN _ClearContent(leftv res, leftv h)
79{
80  NoReturn(res);
81
82  const char *usage = "'ClearContent' needs a (non-zero!) poly or vector argument...";
83
84  if( h == NULL )
85  {
86    WarnS(usage);
87    return TRUE;
88  }
89
90  assume( h != NULL );
91
92  if( !( h->Typ() == POLY_CMD || h->Typ() == VECTOR_CMD) )
93  {
94    WarnS(usage);
95    return TRUE;
96  }
97
98  assume (h->Next() == NULL);
99
100  poly ph = reinterpret_cast<poly>(h->Data());
101
102  if( ph == NULL )
103  {
104    WarnS(usage);
105    return TRUE;
106  }
107
108  const ring r =  currRing;
109  assume( r != NULL ); assume( r->cf != NULL ); const coeffs C = r->cf;
110
111  number n;
112
113  // experimentall (recursive enumerator treatment) of alg. ext
114  CPolyCoeffsEnumerator itr(ph);
115  n_ClearContent(itr, n, C);
116
117  res->data = n;
118  res->rtyp = NUMBER_CMD;
119
120  return FALSE;
121}
122
123/// wrapper around n_ClearDenominators
124static BOOLEAN _ClearDenominators(leftv res, leftv h)
125{
126  NoReturn(res);
127
128  const char *usage = "'ClearDenominators' needs a (non-zero!) poly or vector argument...";
129
130  if( h == NULL )
131  {
132    WarnS(usage);
133    return TRUE;
134  }
135
136  assume( h != NULL );
137
138  if( !( h->Typ() == POLY_CMD || h->Typ() == VECTOR_CMD) )
139  {
140    WarnS(usage);
141    return TRUE;
142  }
143
144  assume (h->Next() == NULL);
145
146  poly ph = reinterpret_cast<poly>(h->Data());
147
148  if( ph == NULL )
149  {
150    WarnS(usage);
151    return TRUE;
152  }
153
154  const ring r =  currRing;
155  assume( r != NULL ); assume( r->cf != NULL ); const coeffs C = r->cf;
156
157  number n;
158
159  // experimentall (recursive enumerator treatment) of alg. ext.
160  CPolyCoeffsEnumerator itr(ph);
161  n_ClearDenominators(itr, n, C);
162
163  res->data = n;
164  res->rtyp = NUMBER_CMD;
165
166  return FALSE;
167}
168
169
170/// try to get an optional (simple) integer argument out of h
171/// or return the default value
172static int getOptionalInteger(const leftv& h, const int _n)
173{
174  if( h!= NULL && h->Typ() == INT_CMD )
175  {
176    int n = (int)(long)(h->Data());
177
178    if( n < 0 )
179      Warn("Negative (%d) optional integer argument", n);
180
181    return (n);
182  }
183
184  return (_n);
185}
186
187static inline number jjLONG2N(long d)
188{
189  return n_Init(d, coeffs_BIGINT);
190}
191
192static inline void view(const intvec* v)
193{
194#ifndef SING_NDEBUG
195  v->view();
196#else
197  // This code duplication is only due to Hannes's #ifndef SING_NDEBUG!
198  Print ("intvec: {rows: %d, cols: %d, length: %d, Values: \n", v->rows(), v->cols(), v->length());
199
200  for (int i = 0; i < v->rows(); i++)
201  {
202    Print ("Row[%3d]:", i);
203    for (int j = 0; j < v->cols(); j++)
204      Print (" %5d", (*v)[j + i * (v->cols())] );
205    PrintLn ();
206  }
207  PrintS ("}\n");
208#endif
209
210}
211
212
213
214/// Get leading component
215static BOOLEAN leadcomp(leftv res, leftv h)
216{
217  if ((h!=NULL) && (h->Typ()==VECTOR_CMD || h->Typ()==POLY_CMD))
218  {
219    const ring r = currRing;
220
221    const poly p = (poly)(h->Data());
222
223    if (p != NULL )
224    {
225      assume( p != NULL );
226      p_LmTest(p, r);
227
228      const unsigned long iComp = p_GetComp(p, r);
229
230  //    assume( iComp > 0 ); // p is a vector
231
232      res->data = reinterpret_cast<void *>(jjLONG2N(iComp));
233    }
234    else
235      res->data = reinterpret_cast<void *>(jjLONG2N(0));
236
237
238    res->rtyp = BIGINT_CMD;
239    return FALSE;
240  }
241
242  WerrorS("`leadcomp(<poly/vector>)` expected");
243  return TRUE;
244}
245
246/// Same for Induced Schreyer ordering (ordering on components is defined by sign!)
247static BOOLEAN MakeInducedSchreyerOrdering(leftv res, leftv h)
248{
249  int sign = 1;
250  if ((h!=NULL) && (h->Typ()==INT_CMD))
251  {
252    const int s = (int)((long)(h->Data()));
253
254    if( s != -1 && s != 1 )
255    {
256      WerrorS("`MakeInducedSchreyerOrdering(<int>)` called with wrong integer argument (must be +-1)!");
257      return TRUE;
258    }
259
260    sign = s;
261  }
262
263  assume( sign == 1 || sign == -1 );
264  res->data = reinterpret_cast<void *>(rAssure_InducedSchreyerOrdering(currRing, TRUE, sign));
265  res->rtyp = RING_CMD; // return new ring!
266  // QRING_CMD?
267  return FALSE;
268}
269
270
271/// ?
272static BOOLEAN GetInducedData(leftv res, leftv h)
273{
274  const ring r = currRing;
275
276  int p = 0; // which IS-block? p^th!
277
278  if ((h!=NULL) && (h->Typ()==INT_CMD))
279  {
280    p = (int)((long)(h->Data())); h=h->next;
281    assume(p >= 0);
282  }
283
284  const int pos = rGetISPos(p, r);
285
286  if(  /*(*/ -1 == pos /*)*/  )
287  {
288    WerrorS("`GetInducedData([int])` called on incompatible ring (not created by 'MakeInducedSchreyerOrdering'!)");
289    return TRUE;
290  }
291
292
293  const int iLimit = r->typ[pos].data.is.limit;
294  const ideal F = r->typ[pos].data.is.F;
295
296  ideal FF = id_Copy(F, r);
297
298  lists l=(lists)omAllocBin(slists_bin);
299  l->Init(2);
300
301  l->m[0].rtyp = INT_CMD;
302  l->m[0].data = reinterpret_cast<void *>(iLimit);
303
304
305  //        l->m[1].rtyp = MODUL_CMD;
306
307  if( id_IsModule(FF, r) ) // ???
308  {
309    l->m[1].rtyp = MODUL_CMD;
310
311    //          Print("before: %d\n", FF->nrows);
312    //          FF->nrows = id_RankFreeModule(FF, r); // ???
313    //          Print("after: %d\n", FF->nrows);
314  }
315  else
316    l->m[1].rtyp = IDEAL_CMD;
317
318  l->m[1].data = reinterpret_cast<void *>(FF);
319
320  res->rtyp = LIST_CMD; // list of int/module
321  res->data = reinterpret_cast<void *>(l);
322
323  return FALSE;
324
325}
326
327/// Returns old SyzCompLimit, can set new limit
328static BOOLEAN SetInducedReferrence(leftv res, leftv h)
329{
330  res->Init();
331  NoReturn(res);
332
333  const ring r = currRing;
334
335  if( !( (h!=NULL) && ( (h->Typ()==IDEAL_CMD) || (h->Typ()==MODUL_CMD))) )
336  {
337    WerrorS("`SetInducedReferrence(<ideal/module>, [int[, int]])` expected");
338    return TRUE;
339  }
340
341  const ideal F = (ideal)h->Data(); ; // No copy!
342  h=h->next;
343
344  int rank = 0;
345
346  if ((h!=NULL) && (h->Typ()==INT_CMD))
347  {
348    rank = (int)((long)(h->Data())); h=h->next;
349    assume(rank >= 0);
350  } else
351    rank = id_RankFreeModule(F, r); // Starting syz-comp (1st: i+1)
352
353  int p = 0; // which IS-block? p^th!
354
355  if ((h!=NULL) && (h->Typ()==INT_CMD))
356  {
357    p = (int)((long)(h->Data())); h=h->next;
358    assume(p >= 0);
359  }
360
361  const int posIS = rGetISPos(p, r);
362
363  if(  /*(*/ -1 == posIS /*)*/  )
364  {
365    WerrorS("`SetInducedReferrence(<ideal/module>, [int[, int]])` called on incompatible ring (not created by 'MakeInducedSchreyerOrdering'!)");
366    return TRUE;
367  }
368
369  // F & componentWeights belong to that ordering block of currRing now:
370  rSetISReference(r, F, rank, p); // F will be copied!
371  return FALSE;
372}
373
374
375/// Get raw syzygies (idPrepare)
376static BOOLEAN idPrepare(leftv res, leftv h)
377{
378  //        extern int rGetISPos(const int p, const ring r);
379
380  const ring r = currRing;
381
382  const bool isSyz = rIsSyzIndexRing(r);
383  const int posIS = rGetISPos(0, r);
384
385
386  if ( !( (h!=NULL) && (h->Typ()==MODUL_CMD) && (h->Data() != NULL) ) )
387  {
388    WerrorS("`idPrepare(<module>)` expected");
389    return TRUE;
390  }
391
392  const ideal I = reinterpret_cast<ideal>(h->Data());
393
394  assume( I != NULL );
395  idTest(I);
396
397  int iComp = -1;
398
399  h=h->next;
400  if ( (h!=NULL) && (h->Typ()==INT_CMD) )
401  {
402    iComp = (int)((long)(h->Data()));
403  }
404  else
405  {
406      if( (!isSyz) && (-1 == posIS) )
407      {
408        WerrorS("`idPrepare(<...>)` called on incompatible ring (not created by 'MakeSyzCompOrdering' or 'MakeInducedSchreyerOrdering'!)");
409        return TRUE;
410      }
411
412    if( isSyz )
413      iComp = rGetCurrSyzLimit(r);
414    else
415      iComp = id_RankFreeModule(r->typ[posIS].data.is.F, r); // ;
416  }
417
418  assume(iComp >= 0);
419
420
421  intvec* w = reinterpret_cast<intvec *>(atGet(h, "isHomog", INTVEC_CMD));
422  tHomog hom = testHomog;
423
424  //           int add_row_shift = 0;
425  //
426  if (w!=NULL)
427  {
428    w = ivCopy(w);
429  //             add_row_shift = ww->min_in();
430  //
431  //             (*ww) -= add_row_shift;
432  //
433  //             if (idTestHomModule(I, currRing->qideal, ww))
434  //             {
435    hom = isHomog;
436  //               w = ww;
437  //             }
438  //             else
439  //             {
440  //               //WarnS("wrong weights");
441  //               delete ww;
442  //               w = NULL;
443  //               hom=testHomog;
444  //             }
445  }
446
447
448  // computes syzygies of h1,
449  // works always in a ring with ringorder_s
450  // NOTE: rSetSyzComp(syzcomp) should better be called beforehand
451  //        ideal idPrepare (ideal  h1, tHomog hom, int syzcomp, intvec **w);
452
453  ideal J = // idPrepare( I, hom, iComp, &w);
454           kStd(I, currRing->qideal, hom, &w, NULL, iComp);
455
456  idTest(J);
457
458  if (w!=NULL)
459    atSet(res, omStrDup("isHomog"), w, INTVEC_CMD);
460  //             if (w!=NULL) delete w;
461
462  res->rtyp = MODUL_CMD;
463  res->data = reinterpret_cast<void *>(J);
464  return FALSE;
465}
466
467extern "C" int SI_MOD_INIT(syzextra)(SModulFunctions* psModulFunctions)
468{
469
470#define ADD(C,D,E) \
471  psModulFunctions->iiAddCproc((currPack->libname? currPack->libname: ""), (char*)C, D, E);
472
473
474  ADD("ClearContent", FALSE, _ClearContent);
475  ADD("ClearDenominators", FALSE, _ClearDenominators);
476
477  ADD("leadcomp", FALSE, leadcomp);
478
479  ADD("SetInducedReferrence", FALSE, SetInducedReferrence);
480  ADD("GetInducedData", FALSE, GetInducedData);
481  ADD("MakeInducedSchreyerOrdering", FALSE, MakeInducedSchreyerOrdering);
482
483  ADD("idPrepare", FALSE, idPrepare);
484
485#undef ADD
486  return MAX_TOK;
487}
Note: See TracBrowser for help on using the repository browser.