source: git/Singular/LIB/schreyer.lib @ 789d6f

spielwiese
Last change on this file since 789d6f was 789d6f, checked in by Oleksandr Motsak <motsak@…>, 9 years ago
More formatting for schreyer.lib
  • Property mode set to 100644
File size: 30.8 KB
Line 
1///////////////////////////////////////////////////////////////////////////
2version="version schreyer.lib 4.0.0.0 Jun_2013 "; // $Id$
3category="General purpose";
4info="
5LIBRARY: schreyer.lib     Helpers for computing a Schreyer resolution in @code{derham.lib}
6AUTHOR:  Oleksandr Motsak <U@D>, where U={motsak}, D={mathematik.uni-kl.de}
7KEYWORDS: Schreyer ordering; Schreyer resolution; syzygy
8
9PROCEDURES:
10Sres(M,len)     compute Schreyer resolution of module M of maximal length len
11Ssyz(M)         compute Schreyer resolution of module M of length 1
12Scontinue(len)  extend currently active resolution by (at most) len syszygies
13
14NOTE:  requires the dynamic or built-in module: syzextra
15";
16
17static proc prepareSyz( module I, list # )
18{
19  int i;
20  int k = 0;
21  int r = nrows(I);
22  int c = ncols(I);
23
24
25  if( size(#) > 0 )
26  {
27    if( typeof(#[1]) == "int" || typeof(#[1]) == "bigint" )
28    {
29      k = #[1];
30    }
31  }
32
33  if( k < r )
34  {
35    "// *** Wrong k: ", k, " < nrows: ", r, " => setting k = r = ", r;
36    k = r;
37  }
38
39//   "k: ", k;  "c: ", c;   "I: ", I;
40
41  for( i = c; i > 0; i-- )
42  {
43    I[i] = I[i] + gen(k + i);
44  }
45
46//  DetailedPrint(I);
47
48  return(I);
49}
50
51static proc separateSyzGB( module J, int c )
52{
53  module II, G; vector v; int i;
54
55  J = simplify(J, 2);
56
57  for( i = ncols(J); i > 0; i-- )
58  {
59    v = J[i];
60    if( leadcomp(v) > c )
61    {
62      II[i] = v;
63    } else
64    {
65      G[i] = v; // leave only gen(i): i <= c
66    }
67  }
68
69  II = simplify(II, 2);
70  G = simplify(G, 2);
71
72  return (list(G, II));
73}
74
75static proc splitSyzGB( module J, int c )
76{
77  module JJ; vector v, vv; int i;
78
79  for( i = ncols(J); i > 0; i-- )
80  {
81    v = J[i];
82
83    vv = 0;
84   
85    while( leadcomp(v) <= c )
86    {
87      vv = vv + lead(v);
88      v  = v  - lead(v);
89    }
90
91    J[i] = vv;
92    JJ[i] = v;
93  }
94
95  J = simplify(J, 2);
96  JJ = simplify(JJ, 2);
97
98  return (list(J, JJ));
99}
100
101
102static proc Sinit(module M)
103{
104  def @save = basering;
105 
106  int @DEBUG = !system("with", "ndebug");
107  if( @DEBUG )
108  {
109    "Sinit::Input";
110    type(M);
111    DetailedPrint(M);
112    attrib(M);
113  }
114
115  int @RANK = nrows(M); int @SIZE = ncols(M);
116
117  int @IS_A_SB = attrib(M, "isSB"); // ??? only if all weights were zero?!
118
119  if( !@IS_A_SB )
120  {
121    M = std(M); // this should be faster than computing std in S (later on)
122  }
123
124  def S = MakeInducedSchreyerOrdering(1); // 1 puts history terms to the back
125  // TODO: NOTE: +1 causes trouble to Singular interpreter!!!???
126  setring S; // a new ring with a Schreyer ordering
127
128  if( @DEBUG )
129  {
130    "Sinit::StartingISRing";
131    basering;
132//    DetailedPrint(basering);
133  }
134
135  // Setup the leading syzygy^{-1} module to zero:
136  module Z = 0; Z[@RANK] = 0; attrib(Z, "isHomog", intvec(0)); 
137
138  module MRES = Z;
139 
140  list RES; RES[1] = Z;
141
142  module F = freemodule(@RANK);
143  intvec @V = deg(F[1..@RANK]);
144 
145  module M = imap(@save, M);
146 
147  attrib(M, "isHomog", @V);
148  attrib(M, "isSB", 1);
149
150 
151  if( @DEBUG )
152  {
153    "Sinit::SB_Input: ";
154    type(M);
155    attrib(M);
156    attrib(M, "isHomog");
157    DetailedPrint(M);
158  }
159
160  if( @DEBUG )
161  {
162    // 0^th syz. property
163    if( size(module(transpose( transpose(M) * transpose(MRES) ))) > 0 )
164    {
165      transpose( transpose(M) * transpose(MRES) );
166      "transpose( transpose(M) * transpose(MRES) ) != 0!!!";
167      $
168    }
169  }
170
171  RES[size(RES)+1] = M; // list of all syzygy modules
172  MRES = MRES, M;
173
174  attrib(MRES, "isHomog", @V); 
175
176  attrib(S, "InducionLeads", lead(M));
177  attrib(S, "InducionStart", @RANK); 
178 
179  if( @DEBUG )
180  {
181    "Sinit::MRES";
182    DetailedPrint(MRES);
183    attrib(MRES, "isHomog");
184    attrib(S);
185  }
186
187  export RES;
188  export MRES;
189  return (S);
190}
191
192static proc Sstep()
193{
194  int @DEBUG = !system("with", "ndebug");
195
196  if( @DEBUG )
197  {
198    "Sstep::NextInducedRing";
199    DetailedPrint(basering);
200
201    attrib(basering, "InducionLeads");
202    attrib(basering, "InducionStart");
203
204    GetInducedData();
205  }
206
207  // syzygy step:
208
209/*
210  // is initial weights are all zeroes!
211  def L =  lead(M);
212  intvec @V = deg(M[1..ncols(M)]);  @W;  @V;  @W = @V;  attrib(L, "isHomog", @W); 
213  SetInducedReferrence(L, @RANK, 0);
214*/
215
216//  def L =  lead(MRES);
217//  @W = @W, @V;
218//  attrib(L, "isHomog", @W); 
219
220
221  // General setting:
222//  SetInducedReferrence(MRES, 0, 0); // limit: 0!
223  int @l = size(RES);
224
225  module M = RES[@l];
226
227  module L = attrib(basering, "InducionLeads");
228  int limit = attrib(basering, "InducionStart");
229
230//  L;  limit;
231 
232  int @RANK = ncols(MRES) - ncols(M); // nrows(M); // what if M is zero?!
233
234/*
235  if( @RANK !=  nrows(M) )
236  {
237    type(MRES);
238    @RANK;
239    type(M);
240    pause();
241  }
242*/
243 
244  intvec @W = attrib(M, "isHomog");
245  intvec @V = deg(M[1..ncols(M)]);
246  @V = @W, @V;
247   
248  if( @DEBUG )
249  {
250    "Sstep::NextInput: ";
251    M;
252    deg(M[1..ncols(M)]); // no use of @W :(?
253    @RANK;   
254    DetailedPrint(MRES);
255    attrib(MRES, "isHomog"); @W;
256    deg(MRES[1..ncols(MRES)]);
257  }
258
259 
260     
261  SetInducedReferrence(L, limit, 0);
262 
263  def K = prepareSyz(M, @RANK);
264//  K;
265 
266//   attrib(K, "isHomog", @V);   DetailedPrint(K, 1000);
267
268//  pause();
269 
270  K = idPrepare(K, @RANK); // std(K); // ?
271  K = simplify(K, 2);
272
273//  K;
274
275  module N = separateSyzGB(K, @RANK)[2]; // 1^st syz. module: vectors which start in lower part (comp >= @RANK)
276
277// "N_0: "; N; DetailedPrint(N, 10);
278
279//  basering; print(@V); type(N);
280//  attrib(N, "isHomog", @V);  // TODO: fix "wrong weights"!!!? deg is wrong :(((
281  N = std(N);
282  attrib(N, "isHomog", @V);
283
284//  N;
285 
286  if( @DEBUG )
287  {
288    if( size(N) > 0 )
289    {
290      // next syz. property
291      if( size(module(transpose( transpose(N) * transpose(MRES) ))) > 0 )
292      {
293        MRES;
294
295        "N: "; N; DetailedPrint(N, 10);
296
297        "K:"; K; DetailedPrint(K, 10);
298
299        "RANKS: ", @RANK;
300
301        "transpose( transpose(N) * transpose(MRES) ) != 0!!!";
302        transpose( transpose(N) * transpose(MRES) );
303
304        "transpose(N) * transpose(MRES): ";
305        transpose(N) * transpose(MRES);
306        DetailedPrint(module(_), 2);
307        $
308      }
309    }
310  }
311 
312  RES[@l + 1] = N; // list of all syzygy modules
313 
314  MRES = MRES, N;
315  attrib(MRES, "isHomog", @V);
316
317
318  L = L, lead(N);
319  attrib(basering, "InducionLeads", L);
320
321  if( @DEBUG )
322  {
323    "Sstep::NextSyzOutput: ";
324    DetailedPrint(N);
325    attrib(N, "isHomog");
326  }
327
328}
329
330proc Scontinue(int l)
331"USAGE:  Scontinue(int len)
332RETURN:  nothing, instead it changes the currently active resolution
333PURPOSE: extends the currently active resolution by at most len syzygies
334NOTE:    must be used within a ring returned by Sres or Ssyz
335EXAMPLE: example Scontinue; shows an example
336"
337{
338  def data = GetInducedData();
339           
340  if( (!defined(RES)) || (!defined(MRES)) || (typeof(data) != "list") || (size(data) != 2) )
341  {
342    ERROR("Sorry, but basering does not seem to be returned by Sres or Ssyz");
343  }
344  for (;  (l != 0) && (size(RES[size(RES)]) > 0); l-- )
345  {
346    Sstep();
347  }
348}
349example
350{ "EXAMPLE:"; echo = 2;
351  ring r;
352  module M = maxideal(1); M;
353  def S = Ssyz(M); setring S; S;
354  "Only the first syzygy: ";
355  RES; MRES;
356  "More syzygies: ";
357  Scontinue(10);
358  RES; MRES;
359}
360
361proc Ssyz(module M)
362"USAGE:  Ssyz(module M)
363RETURN:  ring, containing a Schreyer resolution
364PURPOSE: computes a Schreyer resolution of M of length 1
365NOTE:    the output is explained in Sres
366EXAMPLE: example Ssyz; shows an example
367"
368{
369  def S = Sinit(M); setring S;
370 
371  Sstep(); // NOTE: what if M is zero?
372
373  return (S);
374}
375example
376{ "EXAMPLE:"; echo = 2;
377  ring r;
378  module M = maxideal(1); M;
379  def S = Ssyz(M); setring S; S;
380  "Only the first syzygy: ";
381  RES;
382  MRES; // Note gen(i)
383  kill S;
384  setring r; kill M;
385
386  module M = 0;
387  def S = Ssyz(M); setring S; S;
388  "Only the first syzygy: ";
389  RES;
390  MRES;
391}
392
393proc Sres(module M, int l)
394"USAGE:  Sres(module M, int len)
395RETURN:  ring, containing a Schreyer resolution
396PURPOSE: computes a Schreyer resolution of (basering^rank(M))/M with at most len syzygy modules
397NOTE:    input is a set of vectors M over a basering. The ring basering may be non-commutative.
398@*       If given len is zero then nvars(basering) + 1 is used instead.
399@*       Schreyer resolution is represented by a list of modules RES and a module MRES
400         belonging to a specially constructed ring, which is endowed with a Schreyer ordering.
401@*       The list of modules RES contains the images of maps (also called syzygies) subsituting the
402         computed beginning of a Schreyer free resolution of (baseRing^rank(M))/M.
403@*       The leading zero map RES[1] with rank(M) zero generators indicates that the image of
404         the first differential map is zero. The second map RES[2] is given by M, which indicates that
405         the resolution is of (baseRing^rank(M))/M is being computed.
406@*       The module MRES is a direct sum of modules from RES and comprises all computed differential maps.
407@*       Syzygies are shifted so that gen(i) is mapped to MRES[i] under the differential.
408@*       Schreyer ordering extends an arbitrary starting module ordeing (defined by basering)
409         and is extended to higher syzygt modules using the following definition:
410@*       a < b if and only if (d(a) < d(b)) OR ( (d(a) = d(b) AND (comp(a) < comp(b)) ),
411@*       where d(a) is the image of a under the differential (given by MRES),
412         and comp(a) is the mod. component, for any module terms a and b.
413@*       Syzygies are given by Groebner bases with respect to corresponding Schreyer orderings.
414EXAMPLE: example Sres; shows an example
415"
416{
417  def S = Sinit(M); setring S;
418
419  if (l == 0)
420  {
421    l = nvars(basering) + 1; // not really an estimate...?!
422  }
423 
424  Sstep(); l = l - 1;
425 
426  Scontinue(l);
427 
428  return (S);
429}
430example
431{ "EXAMPLE:"; echo = 2;
432  ring r;
433  module M = maxideal(1); M;
434  def S = Sres(M, 0); setring S; S;
435  RES;
436  MRES;
437  kill S;
438  setring r; kill M;
439
440  def A = nc_algebra(-1,0); setring A;
441  ideal Q = var(1)^2, var(2)^2, var(3)^2;
442  qring SCA = twostd(Q);
443  basering;
444
445  module M = maxideal(1);
446  def S = Sres(M, 2); setring S; S;
447  RES;
448  MRES;
449}
450
451
452
453// ================================================================== //
454
455
456LIB "general.lib"; // for sort
457
458/* static proc Tail(def M) // DONE: in C++ (dyn. module: syzextra)!
459{
460  int i = ncols(M); def m;
461  while (i > 0)
462  {
463    m = M[i];
464    m = m - lead(m); // m = tail(m)   
465    M[i] = m;   
466    i--;
467  }
468  return (M);
469}*/
470
471
472/* static */ proc SSinit(def M)
473{
474  if( (typeof(M) != "module") && (typeof(M) != "ideal") )
475  {
476    ERROR("Sorry: need an ideal or a module for input");
477  }
478
479  // TODO! DONE?
480  def @save = basering;
481 
482  int @DEBUG = !system("with", "ndebug");
483  int @SYZCHECK = 1 || @DEBUG; // TODO: only for now!!
484 
485  if( @DEBUG )
486  {
487    "SSinit::Input";
488    type(M);
489//    DetailedPrint(M);
490    attrib(M);
491  }
492
493  int @RANK = nrows(M); int @SIZE = ncols(M);
494
495  int @IS_A_SB = attrib(M, "isSB"); // ??? only if all weights were zero?!
496
497  if( !@IS_A_SB )
498  {
499    def opts = option(get);
500    option(redSB); option(redTail);
501    M = std(M);
502    option(set, opts);
503    kill opts;
504  } else
505  {
506    M = simplify(M, 2 + 4 + 32);
507  }
508
509  def LEAD = lead(M);
510
511  // sort wrt neg.deg.rev.lex!
512  intvec iv_ds = sort(LEAD, "ds", 1)[2]; // ,1 => reversed!
513
514  M = M[iv_ds]; // sort M wrt ds on current leading terms
515  LEAD = LEAD[iv_ds];
516 
517  def TAIL = Tail(M);
518 
519  intvec @DEGS = deg(M[1..@SIZE]); // store actuall degrees of input elements
520 
521  // TODO: what about real modules? weighted ones?
522 
523  list @l = ringlist(@save);
524
525  int @z = 0; ideal @m = maxideal(1); intvec @wdeg = deg(@m[1..ncols(@m)]);
526
527  // NOTE: @wdeg will be ignored anyway :(
528  @l[3] = list(list("C", @z), list("lp", @wdeg));
529
530  kill @z, @wdeg; // since these vars are ring independent!
531
532  def S = ring(@l); // --MakeInducedSchreyerOrdering(1);
533
534  module F = freemodule(@RANK);
535  intvec @V = deg(F[1..@RANK]);
536 
537  setring S; // ring with an easy divisibility test ("C, lex")
538
539  if( @DEBUG )
540  {
541    "SSinit::NewRing(C, lex)";
542    basering;
543//    DetailedPrint(basering);
544  }
545
546  // Setup the leading syzygy^{-1} module to zero:
547  module Z = 0; Z[@RANK] = 0; attrib(Z, "isHomog", intvec(0)); 
548
549  module MRES = Z;
550 
551  list RES;  RES[1] = Z;
552  list LRES; LRES[1] = Z;
553  list TRES; TRES[1] = Z;
554 
555  def M = imap(@save, M);
556
557  attrib(M, "isHomog", @V);
558  attrib(M, "isSB", 1);
559  attrib(M, "degrees", @DEGS); 
560 
561  def LEAD = imap(@save, LEAD);
562 
563  attrib(LEAD, "isHomog", @V);
564  attrib(LEAD, "isSB", 1); 
565 
566  def TAIL = imap(@save, TAIL);
567
568  if( @DEBUG )
569  {
570    "SSinit::(sorted) SB_Input: ";
571    type(M);
572    attrib(M);
573    attrib(M, "isHomog");
574//    DetailedPrint(M);
575  }
576
577  if( @SYZCHECK )
578  {
579    // 0^th syz. property
580    if( size(module(transpose( transpose(M) * transpose(MRES) ))) > 0 )
581    {
582      transpose( transpose(M) * transpose(MRES) );
583      "ERROR: transpose( transpose(M) * transpose(MRES) ) != 0!!!";
584      $
585    }
586  }
587
588  RES[size(RES)+1] = M; // list of all syzygy modules
589  LRES[size(LRES)+1] = LEAD; // list of all syzygy modules
590  TRES[size(TRES)+1] = TAIL; // list of all syzygy modules
591 
592  MRES = MRES, M; //?
593
594  attrib(MRES, "isHomog", @V);
595 
596//  attrib(S, "InducionStart", @RANK);
597  attrib(S, "LEAD2SYZ", 1);
598  attrib(S, "TAILREDSYZ", 0);
599  attrib(S, "DEBUG", @DEBUG);
600  attrib(S, "SYZCHECK", @SYZCHECK);
601 
602  if( @DEBUG )
603  {
604    "SSinit::MRES";
605    MRES;
606//    DetailedPrint(MRES);
607    attrib(MRES, "isHomog");
608    attrib(S);
609  }
610
611  export RES;
612  export MRES;
613  export LRES;
614  export TRES;
615  return (S);
616}
617example
618{ "EXAMPLE:"; echo = 2;
619  ring R = 0, (w, x, y, z), dp;
620
621  def M = maxideal(1);
622  def S = SSinit(M); setring S; S;
623 
624  "Only the first initialization: ";
625  RES; LRES; TRES;
626  MRES;
627
628  kill S; setring R; kill M;
629 
630  ideal M = w^2 - x*z,  w*x - y*z,  x^2 - w*y, x*y - z^2, y^2 - w*z;
631  def S = SSinit(M); setring S; S;
632
633  "Only the first initialization: ";
634  RES; LRES; TRES;
635  MRES;
636
637  kill S; setring R; kill M;
638}
639
640
641LIB "poly.lib"; // for lcm
642
643
644
645/// Compute L(Syz(L))
646proc SSComputeLeadingSyzygyTerms(def L)
647{
648  if( typeof( attrib(basering, "DEBUG") ) == "int" )
649  {
650    int @DEBUG = attrib(basering, "DEBUG");
651  } else
652  {
653    int @DEBUG = !system("with", "ndebug");
654  }
655
656  if( @DEBUG )
657  {
658    "SSComputeLeadingSyzygyTerms::Input: ";
659    L;
660  }
661
662  int i, j, r; intvec iv_ds;
663  int N = ncols(L);
664  def a, b;
665  poly aa, bb;
666
667  bigint c;
668
669  ideal M;
670
671  module S = 0;
672 
673  for(i = 1; i <= N; i++)
674  {
675    a = L[i];
676//    "a: ", a;
677    c = leadcomp(a);
678    r = int(c);
679
680    if(r > 0)
681    {
682      aa = a[r];
683    } else
684    {
685      aa = a;
686    }
687
688    M = 0;
689   
690    for(j = i-1; j > 0; j--)
691    {
692      b = L[j];
693//      "b: ", b;
694
695      if( leadcomp(b) == c )
696      {
697        if(r > 0)
698        {
699          bb = b[r];
700        } else
701        {
702          bb = b;
703        }
704
705        M[j] = (lcm(aa, bb) / aa);
706      }
707    }
708   
709    // TODO: add quotient relations here...
710
711    M = simplify(M, 1 + 2 + 32);
712
713    iv_ds = sort(M, "ds", 1)[2]; // ,1 => reversed!
714
715    M = M[iv_ds];
716   
717    S = S, M * gen(i);
718  }
719
720  S = simplify(S, 2);
721
722  S = sort(S, "ds", 1)[1]; // ,1 => reversed! // TODO: not needed?
723 
724  if( @DEBUG )
725  {
726    "SSComputeLeadingSyzygyTerms::Output: ";
727    S;
728  } 
729
730  attrib(S, "isSB", 1);
731
732  return (S);
733}
734
735/// Compute Syz(L), where L is a monomial (leading) module
736proc SSCompute2LeadingSyzygyTerms(def L, int @TAILREDSYZ)
737{
738  if( typeof( attrib(basering, "DEBUG") ) == "int" )
739  {
740    int @DEBUG = attrib(basering, "DEBUG");
741  } else
742  {
743    int @DEBUG = !system("with", "ndebug");
744  }
745
746  if( typeof( attrib(basering, "SYZCHECK") ) == "int" )
747  {
748    int @SYZCHECK = attrib(basering, "SYZCHECK");
749  } else
750  {
751    int @SYZCHECK = @DEBUG;
752  }
753 
754
755  if( @DEBUG )
756  {
757    "SSCompute2LeadingSyzygyTerms::Input: ";
758    L;
759    "@TAILREDSYZ: ", @TAILREDSYZ;
760  }
761
762  int i, j, r;
763  int N = ncols(L);
764  def a, b;
765
766  poly aa, bb, @lcm;
767
768  bigint c;
769
770  module M;
771
772  module S = 0;
773
774  for(i = 1; i <= N; i++)
775  {
776    a = L[i];
777//    "a: ", a;
778    c = leadcomp(a);
779    r = int(c);
780
781    aa = leadmonomial(a);
782
783    M = 0;
784
785    for(j = i-1; j > 0; j--)
786    {
787      b = L[j];
788//      "b: ", b;
789
790      if( leadcomp(b) == c )
791      {
792        bb = leadmonomial(b);
793        @lcm = lcm(aa, bb);
794
795        M[j] = (@lcm / aa)* gen(i) - (@lcm / bb)* gen(j);
796      }
797    }
798   
799    M = simplify(M, 2);
800
801    // TODO: add quotient relations here...
802    S = S, M;
803  }
804
805  if( @TAILREDSYZ )
806  {
807    // Make sure that 2nd syzygy terms are not reducible by 1st
808    def opts = option(get);
809    option(redSB); option(redTail);
810    S = std(S); // binomial module
811    option(set, opts);
812    //  kill opts;
813  } else
814  {
815    S = simplify(S, 2 + 32);
816  }
817
818  S = sort(S, "ds", 1)[1]; // ,1 => reversed!
819
820  if( @DEBUG )
821  {
822    "SSCompute2LeadingSyzygyTerms::Syz(LEAD): "; S;
823  }
824
825  if( @SYZCHECK )
826  {
827    if( size(S) > 0 and size(L) > 0 )
828    {
829      if( size(module(transpose( transpose(S) * transpose(L) ))) > 0 )
830      {
831        transpose( transpose(S) * transpose(L) );
832        "ERROR: transpose( transpose(S) * transpose(L) ) != 0!!!";
833        $
834      }
835    }
836  }
837
838  module S2 = Tail(S);
839  S = lead(S); // (C,lp) on base ring!
840             
841  if( @DEBUG )
842  {
843    "SSCompute2LeadingSyzygyTerms::Output: "; S; S2;
844  } 
845 
846  attrib(S, "isSB", 1);
847
848  return (S, S2);
849}
850
851// -------------------------------------------------------- //
852
853/// TODO: save shortcut LM(m) * "t" -> ?
854proc SSReduceTerm(poly m, def t, def L, def T, list #)
855{
856  if( typeof( attrib(basering, "DEBUG") ) == "int" )
857  {
858    int @DEBUG = attrib(basering, "DEBUG");
859  } else
860  {
861    int @DEBUG = !system("with", "ndebug");
862  }
863
864  if( @DEBUG )
865  {
866    "SSReduce::Input: ";
867
868    "mult: ", m;
869    "term: ", t;
870    "L: ", L;
871    "T: ", T;
872    if( size(#) > 0 )
873    {
874      "LSyz: ", #;
875    }
876//    "attrib(LS, 'isSB')", attrib(LS, "isSB");
877  }
878 
879  vector s = 0;
880
881  if( t == 0 )
882  {
883    return (s);
884  }
885
886  def product = m * t;
887
888  bigint c = leadcomp(t);
889  int r = int(c);
890 
891  def a, b, nf, bb;
892
893  // looking for an appropriate reducer
894  for( int k = ncols(L); k > 0; k-- )
895  {
896    a = L[k];
897    // with the same mod. component
898    if( leadcomp(a) == c )
899    {
900      b = - (leadmonomial(product) / leadmonomial(L[k]));
901     
902      // which divides the product
903      if( b != 0 )
904      {
905//        "b: ", b;
906        bb = b * gen(k);
907        nf = bb;
908
909        if( size(#) > 0 )
910        {
911          if( typeof(#[1]) == "module" )
912          {
913            nf = NF(bb, #[1]);
914//        "NF: ", nf;
915          }
916        }
917
918        // while the complement (the fraction) is not reducible by leading syzygies
919        if( nf != 0 )
920        {
921          /// TODO: save shortcut LM(m) * T[i] -> ?
922
923          // choose ANY such reduction... (with the biggest index?)
924          s = bb + SSTraverseTail(b, T[k], L, T, #);
925          break;
926        }
927      }
928    }
929  } 
930  if( @DEBUG )
931  {
932    "SSReduceTerm::Output: ", s;
933  }
934  return (s);
935}
936
937// TODO: store m * @tail -.-^-.-^-.--> ?
938proc SSTraverseTail(poly m, def @tail, def L, def T, list #)
939{
940  if( typeof( attrib(basering, "DEBUG") ) == "int" )
941  {
942    int @DEBUG = attrib(basering, "DEBUG");
943  } else
944  {
945    int @DEBUG = !system("with", "ndebug");
946  }
947
948  if( @DEBUG )
949  {
950    "SSTraverse::Input: ";
951
952    "mult: ", m;
953    "tail: ", @tail; // T[i];
954
955    if( size(#) > 0 )
956    {
957      "LSyz: "; #[1];
958    }
959  }
960
961  vector s = 0;
962
963  def @l;
964
965  // iterate tail-terms in ANY order!
966  while( size(@tail) > 0 )
967  {
968    @l = lead(@tail);
969    s = s + SSReduceTerm(m, @l, L, T, #);
970    @tail = @tail - @l;
971  }
972
973  if( @DEBUG )
974  {
975    "SSTraverseTail::Output: ", s;
976  }
977  return (s);
978}
979
980// -------------------------------------------------------- //
981
982// module (N, LL, TT) = SSComputeSyzygy(L, T);
983// Compute Syz(L ++ T) = N = LL ++ TT
984proc SSComputeSyzygy(def L, def T)
985{
986  if( typeof( attrib(basering, "DEBUG") ) == "int" )
987  {
988    int @DEBUG = attrib(basering, "DEBUG");
989  } else
990  {
991    int @DEBUG = !system("with", "ndebug");
992  }
993 
994  if( @DEBUG )
995  {
996    "SSComputeSyzygy::Input";
997    "basering: ", basering; attrib(basering);
998//    DetailedPrint(basering);
999
1000//    "iCompShift: ", iCompShift;
1001
1002    "L: "; L;
1003    "T: "; T;
1004  }
1005
1006  def a; bigint c; int r, k; poly aa;
1007
1008  int @LEAD2SYZ = 0;
1009  if( typeof( attrib(basering, "LEAD2SYZ") ) == "int" )
1010  {
1011    @LEAD2SYZ = attrib(basering, "LEAD2SYZ");
1012  }
1013
1014  int @TAILREDSYZ = 1;
1015  if( typeof( attrib(basering, "TAILREDSYZ") ) == "int" )
1016  {
1017    @TAILREDSYZ = attrib(basering, "TAILREDSYZ");
1018//    @TAILREDSYZ;
1019  }
1020 
1021  /// Get the critical leading syzygy terms
1022  if( @LEAD2SYZ ) // & 2nd syz. term
1023  {
1024    def a2; int r2; poly aa2; 
1025    module LL, LL2;
1026    (LL, LL2) = SSCompute2LeadingSyzygyTerms(L, @TAILREDSYZ); // ++
1027  } else
1028  {
1029    module LL = SSComputeLeadingSyzygyTerms(L);
1030  }
1031
1032  module TT, SYZ;
1033
1034  if( size(LL) > 0 )
1035  {
1036    list LS;
1037
1038    if( @TAILREDSYZ )
1039    {
1040      LS = list(LL);
1041    }
1042   
1043    vector @tail;
1044
1045    for(k = ncols(LL); k > 0; k-- )
1046    {
1047      // leading syz. term:
1048      a = LL[k]; c = leadcomp(a); r = int(c); aa = leadmonomial(a);
1049      //    "A: ", a, " --->>>> ", aa, " **** [", r, "]: ";
1050
1051      /// TODO: save shortcut (aa) * T[r] -> ?
1052      @tail = SSTraverseTail(aa, T[r], L, T, LS);
1053             
1054      // get the 2nd syzygy term...
1055     
1056      if( @LEAD2SYZ ) // with the 2nd syz. term:
1057      {     
1058        a2 = LL2[k]; c = leadcomp(a2); r2 = int(c); aa2 = leadmonomial(a2);
1059        @tail = @tail +
1060             /// TODO: save shortcut (aa2) * T[r2] -> ?
1061             a2 + SSTraverseTail(aa2, T[r2], L, T, LS);
1062      } else
1063      {
1064        @tail = @tail + SSReduceTerm(aa, L[r], L, T, LS);
1065      }
1066     
1067     
1068      TT[k] = @tail;
1069      SYZ[k] = a + @tail;
1070    }
1071  }
1072
1073/*
1074  def opts = option(get); option(redSB); option(redTail);
1075  module SYZ = std(syz(M));
1076  option(set, opts); kill opts;
1077 
1078  module LL = lead(SYZ); // TODO: WRONG ORDERING!!!!!!!!
1079  module TT = Tail(SYZ);
1080*/
1081 
1082  if( @DEBUG )
1083  {
1084    "SSComputeSyzygy::Output";
1085
1086    "SYZ: "; SYZ;
1087    "LL: "; LL;
1088    "TT: "; TT;
1089  }
1090
1091  return (SYZ, LL, TT);
1092}
1093
1094// resolution/syzygy step:
1095static proc SSstep()
1096{
1097  if( typeof( attrib(basering, "DEBUG") ) == "int" )
1098  {
1099    int @DEBUG = attrib(basering, "DEBUG");
1100  } else
1101  {
1102    int @DEBUG = !system("with", "ndebug");
1103  }
1104
1105
1106  if( typeof( attrib(basering, "SYZCHECK") ) == "int" )
1107  {
1108    int @SYZCHECK = attrib(basering, "SYZCHECK");
1109  } else
1110  {
1111    int @SYZCHECK = @DEBUG;
1112  }
1113
1114  if( @DEBUG )
1115  {
1116    "SSstep::NextInducedRing";
1117    "basering: ", basering; attrib(basering);
1118  }
1119
1120/*
1121  // is initial weights are all zeroes!
1122  def L =  lead(M);
1123  intvec @V = deg(M[1..ncols(M)]);  @W;  @V;  @W = @V;  attrib(L, "isHomog", @W); 
1124  SetInducedReferrence(L, @RANK, 0);
1125*/
1126
1127//  def L =  lead(MRES);
1128//  @W = @W, @V;
1129//  attrib(L, "isHomog", @W); 
1130
1131
1132  // General setting:
1133//  SetInducedReferrence(MRES, 0, 0); // limit: 0!
1134  int @l = size(RES);
1135
1136  def M =  RES[@l];
1137
1138  def L = LRES[@l];
1139  def T = TRES[@l];
1140
1141
1142  //// TODO: wrong !!!!!
1143  int @RANK = ncols(MRES) - ncols(M); // nrows(M); // what if M is zero?!
1144
1145 
1146
1147/*
1148  if( @RANK !=  nrows(M) )
1149  {
1150    type(MRES);
1151    @RANK;
1152    type(M);
1153    pause();
1154  }
1155*/
1156 
1157  intvec @W = attrib(M, "isHomog"); intvec @V = attrib(M, "degrees"); @V = @W, @V;
1158   
1159  if( @DEBUG )
1160  {
1161    "Sstep::NextInput: ";
1162    M;
1163    L;
1164    @V;
1165    @RANK;
1166//    DetailedPrint(MRES);
1167    attrib(MRES, "isHomog");
1168  }
1169
1170     
1171  // TODO: N  = SYZ( M )!!!
1172  module N, LL, TT;
1173  (N, LL, TT) = SSComputeSyzygy(/*M, */L, T/*, @RANK*/);
1174
1175  // shift syz.comp by @RANK:
1176  module Z;
1177  Z = 0; Z[@RANK] = 0; Z = Z, transpose(LL);   LL = transpose(Z);
1178  Z = 0; Z[@RANK] = 0; Z = Z, transpose(TT);   TT = transpose(Z);
1179  Z = 0; Z[@RANK] = 0; Z = Z, transpose(N);     N = transpose(Z);
1180
1181
1182  if( @SYZCHECK )
1183  {
1184    if( size(N) > 0 )
1185    {
1186      // next syz. property
1187      if( size(module(transpose( transpose(N) * transpose(MRES) ))) > 0 )
1188      {
1189        "MRES", MRES;
1190
1191        "N: "; N; // DetailedPrint(N, 2);
1192
1193        "LL:"; LL; // DetailedPrint(LL, 1);
1194        "TT:"; TT; // DetailedPrint(TT, 10);
1195
1196        "RANKS: ", @RANK;
1197
1198        "transpose( transpose(N) * transpose(MRES) ) != 0!!!";
1199        transpose( transpose(N) * transpose(MRES) );
1200
1201        "transpose(N) * transpose(MRES): ";
1202        transpose(N) * transpose(MRES);
1203        // DetailedPrint(module(_), 2);
1204        $
1205      }
1206    }
1207  }
1208
1209  attrib(N, "isHomog", @V);
1210
1211  // TODO: correct the following:
1212  intvec @DEGS = deg(N[1..ncols(N)]); // no mod. comp. weights :(
1213
1214 
1215  attrib(N, "degrees", @DEGS);
1216 
1217   RES[@l + 1] = N; // list of all syzygy modules
1218  LRES[@l + 1] = LL; // list of all syzygy modules
1219  TRES[@l + 1] = TT; // list of all syzygy modules
1220
1221  MRES = MRES, N;
1222 
1223  attrib(MRES, "isHomog", @V);
1224
1225//  L = L, lead(N);  attrib(basering, "InducionLeads", L);
1226
1227  if( @DEBUG )
1228  {
1229    "SSstep::NextSyzOutput: ";
1230    N;
1231//    DetailedPrint(N);
1232    attrib(N);
1233  }
1234
1235}
1236
1237proc SScontinue(int l)
1238"USAGE:  SScontinue(l)
1239RETURN:  nothing, instead it changes RES and MRES variables in the current ring
1240PURPOSE: computes further (at most l) syzygies
1241NOTE:    must be used within a ring returned by Sres or Ssyz. RES and MRES are
1242         explained in Sres
1243EXAMPLE: example Scontinue; shows an example
1244"
1245{
1246
1247  /// TODO!
1248//  def data = GetInducedData();
1249
1250  if( (!defined(RES)) || (!defined(MRES)) ) /* || (typeof(data) != "list") || (size(data) != 2) */
1251  {
1252    ERROR("Sorry, but basering does not seem to be returned by Sres or Ssyz");
1253  }
1254  for (;  (l != 0) && (size(RES[size(RES)]) > 0); l-- )
1255  {
1256    SSstep();
1257  }
1258}
1259example
1260{ "EXAMPLE:"; echo = 2;
1261  ring r;
1262  module M = maxideal(1); M;
1263  def S = SSsyz(M); setring S; S;
1264  "Only the first syzygy: ";
1265  RES; MRES;
1266  "More syzygies: ";
1267  SScontinue(10);
1268  RES; MRES;
1269}
1270
1271proc SSsyz(def M)
1272"USAGE:  SSsyz(M)
1273RETURN:  ring, containing a list of modules RES and a module MRES
1274PURPOSE: computes the first syzygy module of M (wrt some Schreyer ordering)?
1275NOTE:    The output is explained in Sres
1276EXAMPLE: example Ssyz; shows an example
1277"
1278{
1279  if( (typeof(M) != "module") && (typeof(M) != "ideal") )
1280  {
1281    ERROR("Sorry: need an ideal or a module for input");
1282  }
1283
1284  def SS = SSinit(M); setring SS;
1285 
1286  SSstep(); // NOTE: what if M is zero?
1287
1288  return (SS);
1289}
1290example
1291{ "EXAMPLE:"; echo = 2;
1292  ring r;
1293
1294/*  ideal M = 0;
1295  def S = SSsyz(M); setring S; S;
1296  "Only the first syzygy: ";
1297  RES; LRES; TRES;
1298  MRES;
1299 
1300  kill S; setring r; kill M;
1301*/ 
1302
1303  module M = maxideal(1); M;
1304  def S = SSres(M, 0); setring S; S;
1305  MRES;
1306  RES;
1307  "";
1308  LRES;
1309  "";
1310  TRES;
1311
1312  kill S; setring r; kill M;
1313
1314  kill r;
1315 
1316  ring R = 0, (w, x, y, z), dp;
1317  ideal M = w^2 - x*z,  w*x - y*z,  x^2 - w*y, x*y - z^2, y^2 - w*z;
1318 
1319  def S = SSres(M, 0); setring S; S;
1320  MRES;
1321  RES;
1322  "";
1323  LRES;
1324  "";
1325  TRES;
1326}
1327
1328proc SSres(def M, int l)
1329"USAGE:  SSres(I, l)
1330RETURN:  ring, containing a list of modules RES and a module MRES
1331PURPOSE: computes (at most l) syzygy modules of M wrt the classical Schreyer
1332         induced ordering with gen(i) > gen(j) if i > j, provided both gens
1333         are from the same syzygy level.???
1334NOTE:    RES contains the images of maps subsituting the beginning of the
1335         Schreyer free resolution of baseRing^r/M, while MRES is a sum of
1336         these images in a big free sum, containing all the syzygy modules.
1337         The syzygy modules are shifted so that gen(i) correspons to MRES[i].
1338         The leading zero module RES[0] indicates the fact that coker of the
1339         first map is zero. The number of zeroes inducates the rank of input.
1340NOTE:    If l == 0 then l is set to be nvars(basering) + 1
1341EXAMPLE: example SSres; shows an example
1342"
1343{
1344  if( (typeof(M) != "module") && (typeof(M) != "ideal") )
1345  {
1346    ERROR("Sorry: need an ideal or a module for input");
1347  }
1348
1349  def SS = SSinit(M); setring SS;
1350
1351  if (l == 0)
1352  {
1353    l = nvars(basering) + 1; // not really an estimate...?!
1354  }
1355
1356  SSstep(); l = l - 1;
1357
1358  SScontinue(l);
1359
1360  return (SS);
1361}
1362example
1363{ "EXAMPLE:"; echo = 2;
1364  ring r;
1365  module M = maxideal(1); M;
1366  def S = SSres(M, 0); setring S; S;
1367  RES;
1368  MRES;
1369  kill S;
1370  setring r; kill M;
1371
1372  def A = nc_algebra(-1,0); setring A;
1373  ideal Q = var(1)^2, var(2)^2, var(3)^2;
1374  qring SCA = twostd(Q);
1375  basering;
1376
1377  module M = maxideal(1);
1378  def S = SSres(M, 2); setring S; S;
1379  RES;
1380  MRES;
1381}
1382
1383
1384
1385static proc loadme()
1386{
1387  int @DEBUG = !system("with", "ndebug");
1388
1389  if( @DEBUG )
1390  {
1391   
1392    "ndebug?: ", system("with", "ndebug");
1393    "om_ndebug?: ", system("with", "om_ndebug");
1394
1395    listvar(Top);
1396    listvar(Schreyer);
1397  }
1398//  listvar(Syzextra); listvar(Syzextra_g);
1399
1400  if( !defined(DetailedPrint) )
1401  {
1402    if( 1 )
1403    {
1404
1405      if( @DEBUG )
1406      {
1407        "Loading the Release version!";
1408      }
1409      load("syzextra.so");
1410
1411      if( @DEBUG )
1412      {
1413        listvar(Syzextra);
1414      }
1415
1416      exportto(Top, Syzextra::ClearContent);
1417      exportto(Top, Syzextra::ClearDenominators);
1418     
1419//      export Syzextra;
1420
1421//      exportto(Schreyer, Syzextra::noop);
1422      exportto(Schreyer, Syzextra::DetailedPrint);
1423      exportto(Schreyer, Syzextra::leadmonomial);
1424      exportto(Schreyer, Syzextra::leadcomp);
1425//      exportto(Schreyer, Syzextra::leadrawexp);
1426//      exportto(Schreyer, Syzextra::ISUpdateComponents);
1427      exportto(Schreyer, Syzextra::SetInducedReferrence);
1428      exportto(Schreyer, Syzextra::GetInducedData);
1429//      exportto(Schreyer, Syzextra::GetAMData);
1430//      exportto(Schreyer, Syzextra::SetSyzComp);
1431      exportto(Schreyer, Syzextra::MakeInducedSchreyerOrdering);
1432//      exportto(Schreyer, Syzextra::MakeSyzCompOrdering);
1433      exportto(Schreyer, Syzextra::idPrepare);
1434//      exportto(Schreyer, Syzextra::reduce_syz);
1435//      exportto(Schreyer, Syzextra::p_Content);
1436
1437      exportto(Schreyer, Syzextra::ProfilerStart); exportto(Schreyer, Syzextra::ProfilerStop);
1438
1439      exportto(Schreyer, Syzextra::Tail);
1440
1441      exportto(Schreyer, Syzextra::m2_end);
1442    }
1443/*
1444    else
1445    {
1446      if( @DEBUG )
1447      {
1448        "Loading the Debug version!";
1449      }
1450
1451      load("syzextra.so");
1452
1453      if( @DEBUG )
1454      {     
1455        listvar(Syzextra_g);
1456      }
1457     
1458      exportto(Top, Syzextra_g::ClearContent);
1459      exportto(Top, Syzextra_g::ClearDenominators);
1460
1461//      export Syzextra_g;
1462//      exportto(Schreyer, Syzextra_g::noop);
1463      exportto(Schreyer, Syzextra_g::DetailedPrint);
1464      exportto(Schreyer, Syzextra_g::leadmonomial);
1465      exportto(Schreyer, Syzextra_g::leadcomp);
1466//      exportto(Schreyer, Syzextra_g::leadrawexp);
1467//      exportto(Schreyer, Syzextra_g::ISUpdateComponents);
1468      exportto(Schreyer, Syzextra_g::SetInducedReferrence);
1469      exportto(Schreyer, Syzextra_g::GetInducedData);
1470//      exportto(Schreyer, Syzextra_g::GetAMData);
1471//      exportto(Schreyer, Syzextra_g::SetSyzComp);
1472      exportto(Schreyer, Syzextra_g::MakeInducedSchreyerOrdering);
1473//      exportto(Schreyer, Syzextra_g::MakeSyzCompOrdering);
1474      exportto(Schreyer, Syzextra_g::idPrepare);
1475//      exportto(Schreyer, Syzextra_g::reduce_syz);
1476//      exportto(Schreyer, Syzextra_g::p_Content);
1477
1478      exportto(Schreyer, Syzextra_g::ProfilerStart); exportto(Schreyer, Syzextra_g::ProfilerStop);
1479
1480      exportto(Schreyer, Syzextra_g::Tail);
1481     
1482     
1483      exportto(Schreyer, Syzextra_g::m2_end);
1484    }
1485*/
1486
1487    exportto(Top, DetailedPrint);
1488    exportto(Top, GetInducedData);
1489
1490    if( @DEBUG )
1491    {
1492      listvar(Top);
1493      listvar(Schreyer);
1494    }
1495  }
1496 
1497  if( !defined(GetInducedData) )
1498  {
1499    ERROR("Sorry but we are missing the dynamic module (syzextra.so)...");
1500  }
1501
1502}
1503
1504static proc mod_init()
1505{
1506  loadme();
1507}
1508
1509
1510proc testallSexamples()
1511{
1512  example Ssyz;
1513  example Scontinue;
1514  example Sres; 
1515}
1516
1517proc testallSSexamples()
1518{
1519  example SSsyz;
1520  example SScontinue;
1521  example SSres; 
1522}
1523
1524example
1525{ "EXAMPLE:"; echo = 2;
1526  testallSexamples();
1527  testallSSexamples();
1528}
Note: See TracBrowser for help on using the repository browser.