-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathQuillenSuslin.m2
2725 lines (2277 loc) · 113 KB
/
QuillenSuslin.m2
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
--------------------------------------------------------------------------
-- PURPOSE : QuillenSuslin package for Macaulay2 provides the ability to
-- compute a free basis for a projective module over a polynomial ring
-- with coefficients in Q, Z or Z/p for a prime integer p.
--
-- Copyright (C) 2011 Brett Barwick and Branden Stone
--
-- This program is free software; you can redistribute it and/or
-- modify it under the terms of the GNU General Public License version 2
-- as published by the Free Software Foundation.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--------------------------------------------------------------------------
newPackage(
"QuillenSuslin",
Version => "1.1",
Date => "July 03, 2012",
Authors => {
{Name => "Brett Barwick", Email => "[email protected]", HomePage => "http://www.math.sc.edu/~barwicjb/"},
{Name => "Branden Stone", Email => "[email protected]", HomePage => "http://www.math.ku.edu/~bstone/"}
},
Headline => "QuillenSuslin",
DebuggingMode => false
)
export {
-- Options
"CheckProjective",
"CheckUnimodular",
-- Helper methods
"isProjective",
"isUnimodular",
"maxMinors",
-- Main methods for QuillenSuslin algorithm
"changeVar",
"computeFreeBasis",
"completeMatrix",
"getMaxIdeal",
"horrocks",
"patch",
"qsAlgorithm"
}
------------------------------------------------------------
-- Small helper methods ------------------------------------
------------------------------------------------------------
-- Method: coeffVarFF
-- Input: (RingElement,RingElement) -- (rational function, variable)
-- Output: List -- list of {coeff,degree} where f is treated as a polynomial
-- in var with coefficients in the the rational function field of the
-- other variables.
-- Description:
-- As long as the denominator of f does not involve var, this method
-- computes a list of the coefficients of f and the corresponding degree
-- in var when f is treated as a polynomial in var with coefficients in the
-- rational function field defined by the other variables.
coeffVarFF = method()
coeffVarFF(RingElement,RingElement) := (f,var) -> (
local coeffList; local degList; local denom; local num; local R;
R = ring var;
if f == 0 then return {{0_R,0}}; -- If f is identically zero, then return {{0,0}}.
f = sub(f,frac R);
num = numerator f;
coeffList = flatten entries transpose last coefficients(num,Variables => {var});
degList = flatten (degrees (coefficients(num,Variables => {var}))#1)#0;
denom = denominator f;
return apply(#coeffList, i -> {(coeffList#i)/denom,degList#i});
)
-- Method: commonDenom
-- Input: Matrix
-- Output: RingElement
-- Description:
-- Finds the least common denominator of all entries of a matrix
-- over a fraction field by finding the lcm of all denominators.
commonDenom = method()
commonDenom(Matrix) := M -> (
return lcm flatten apply(numrows M, i -> apply(numcols M, j -> denominator M_(i,j))); -- Make a list of the denominators of each element of the matrix, then find the lcm.
)
-- Method: degVar
-- Input: (RingElement, RingElement)
-- Output: ZZ
-- Description:
-- Returns the degree of a multivariate polynomial
-- with respect to a particular variable. Also works over certain fraction
-- fields where the denominator does not involve the variable.
degVar = method()
degVar(RingElement,RingElement) := (f,var) -> (
local R;
R = ring var;
if f == 0 then return 0; -- Just return 0 if f is identically zero.
f = sub(f,frac R); -- This is just to make the method work over fraction fields.
return (((degrees((coefficients(numerator f,Variables => {var}))#0))#1)#0)#0; -- If f is just a polynomial, then numerator(f) = f.
)
-- Method: factorList
-- Input: RingElement - polynomial to obtain factors of
-- Output: List - list of factors of given polynomial
-- Description:
-- Returns the factors of a polynomial in a polynomial ring
-- as a list. Does not include multiplicities.
-- If the polynomial has a constant factor and the polynomial
-- ring is over the integers, then this method also factors
-- the constant factor into primes. If the polynomial ring is
-- over a field, then any constant factors are disregarded.
factorList = method()
factorList(RingElement) := f -> (
local factors; local constantFactor; local primeFactors;
factors = apply(toList factor f, i -> i#0); -- List the factors of f.
if coefficientRing(ring f) === ZZ then (
constantFactor = position(factors, i-> isConstant i); -- Determine the index, if it exists, of a constant factor in factors.
if constantFactor =!= null then (
primeFactors = factorList(sub(factors#constantFactor,ZZ)); -- Obtain the prime factors of the constant factor.
factors = delete(factors#constantFactor,factors); -- Delete the original constant factor from the list (it may not be prime).
scan(reverse primeFactors, i -> factors = prepend(sub(i,ring f),factors)); -- This line just makes sure all of the integer factors are considered as elements of the original ring when the list is returned.
);
);
if isField coefficientRing(ring f) then scan(factors, i -> if isConstant i then factors = delete(i,factors)); -- If we are working over a field, get rid of any constant factors.
return factors;
)
factorList(ZZ) := f -> (
return apply(toList factor f,i -> i#0);
)
-- Method: findAlmostMonicPoly
-- Input: (Ideal,List) - (ideal, list of variables for term order)
-- Output: RingElement - almost monic polynomial in the ideal
-- Description:
-- Given an ideal (of height at least 2) in the polynomial
-- ring ZZ[varList], this method returns an "almost monic"
-- polynomial in the ideal, where "almost monic" means that
-- it becomes monic in the last variable after an invertible
-- change of variables.
-- Note: It may seem unnecessary to substitute all of the
-- variables in reverse order, run all of the computations,
-- then switch them back, but this is to avoid an issue
-- in Macaulay2 with substituting elements between ZZ[x,y,z]
-- and ZZ[z,y,x]. If you have an element of ZZ[z,y,x] and
-- you use sub(f,ZZ[x,y,z]), Macaulay2 now seems to treat
-- x as z, at least when using the command 'coefficients()'.
findAlmostMonicPoly = method(Options => {Verbose => 0})
findAlmostMonicPoly(Ideal,List) := opts -> (I,varList) -> (
local amList; local genList; local I'; local genListS;
local minAMDegPos; local ringVars; local ringVarsS; local R;
local s; local S; local subs; local verbosity; local subR1;
local subS1; local subsMap;
if #varList == 0 then error "List of variables expected as second argument.";
R = ring I;
verbosity = opts.Verbose;
genList = flatten entries gens I;
if verbosity >= 2 then print("findAlmostMonicPoly: Finding an 'almost monic polynomial' with respect to "|toString varList|" in "|toString I|".");
s = scan(genList, i -> if isAlmostMonic(i,varList) then break sub(i,R)); -- If one of the generators is already almost monic, just return it.
if s =!= null then (
if verbosity >= 2 then print "findAlmostMonicPoly: One of the generators was already 'almost monic' with respect to the given variables.";
s;
);
ringVars = gens ring I;
subR1 = map(R,ring first ringVars);
varList = apply(varList, i -> subR1 i);
S = ZZ(monoid [ringVars,MonomialOrder => Lex]); -- Force the polynomial ring to use the Lex ordering.
subS1 = map(S,ring first ringVars);
ringVarsS = apply(ringVars, i -> subS1 i);
subs = mutableMatrix(S,1,#ringVars);
-- The next line creates the change of variables that treats the last entry of varList as the "heaviest" variable in the term order (turns it into x), and so on.
scan(varList, i -> subs_(0,position(ringVars,j -> j == i)) = subS1((reverse ringVars)#(position(varList,j -> j == i))));
subsMap = map(S,S,matrix subs)*map(S,R);
I' = sub(ideal apply(genList,i -> subsMap i),S); -- Change variables and substitute into S.
genListS = flatten entries gens gb I'; -- One can prove that a strong G.B. for I' must contain an almost monic polynomial w.r.t. reverse ringVars.
amList = delete(,apply(genListS, i -> if isAlmostMonic(i,reverse ringVarsS) then sub(sub(i,matrix{reverse ringVarsS}),R)));
if amList == {} then error "Check that the ideal has height at least two in the polynomial ring.";
minAMDegPos = minPosition apply(amList, i -> degVar(i,last varList)); -- Find the position of the almost monic polynomial of smallest degree in last varList.
return amList#minAMDegPos;
)
-- Method: isAlmostMonic
-- Input: (RingElement,List) - (polynomial, order of variables)
-- Output: Boolean
-- Description:
-- Given a polynomial f in R[varList], this method
-- determines whether it is "almost monic" in the sense
-- that the leading coefficient with respect to the block
-- order is 1.
isAlmostMonic = method()
isAlmostMonic(RingElement,List) := (f,varList) -> (
local R; local ringVars; local S; local subs; local subR1;
local subS1;
R = ring f;
ringVars = gens ring f;
subR1 = map(R,ring first varList);
varList = apply(varList, i -> subR1 i);
S = (coefficientRing R)(monoid [ringVars,MonomialOrder => Lex]); -- Force the polynomial ring to use the Lex ordering.
subs = mutableMatrix(S,1,#ringVars);
subS1 = map(S,ring first varList);
-- The next line creates the change of variables that treats the last entry of varList as the "heaviest" variable in the term order (turns it into x), and so on.
scan(varList, i -> subs_(0,position(ringVars,j -> j == i)) = subS1((reverse ringVars)#(position(varList,j -> j == i))));
return leadCoefficient sub(sub(f,matrix subs),S) == 1; -- Check whether the leading coefficient with respect to this term order is 1.
)
-- Method: isLocalUnit
-- Input: (RingElement,Ideal) -- (rational function,ideal)
-- Output: Boolean
-- Description:
-- Determines whether the given rational function in frac(R) is a unit
-- in the localization R_I.
isLocalUnit = method()
isLocalUnit(RingElement,Ideal) := (f,I) -> (
local R;
R = ring I;
f = sub(f,frac R);
return ((numerator f) % I != 0 and (denominator f) % I != 0);
)
-- Method: isMonic
-- Input: (RingElement, RingElement) - (polynomial, variable)
-- Output: Boolean
-- Description:
-- Given a polynomial f in R[x_1,...,x_n], this method
-- determines whether f is monic with respect to a
-- particular variable.
isMonic = method()
isMonic(RingElement,RingElement) := (f,var) -> (
return leadCoeffVar(f,var) == 1;
)
-- Method: isProjective -- Test 0
-- Input: Module
-- Output: Boolean
-- Description:
-- Output: Returns 'true' if P is projective, 'false'
-- if P is not projective.
isProjective = method()
isProjective(Module) := P -> (
return maxMinors presentation P == ideal(1_(ring P)); -- If the maximal minors of the presentation matrix generate the unit ideal then the module is projective, see for example Bruns-Herzog Prop. 1.4.9.
)
-- Method: isUnimodular -- Test 1
-- Input: Matrix
-- Output: Boolean
-- Description:
-- Checks whether a given matrix is unimodular. (ie. its
-- maximal minors generate the unit ideal.)
isUnimodular = method()
isUnimodular(Matrix) := M -> (
return minors(min(numcols M,numrows M),M) == ideal(1_(ring M));
)
-- Method: laurentCoeffList
-- Input: (RingElement,RingElement) - (polynomial,variable)
-- Output: List - List of lists of the form {deg in var, coefficient}
-- Description:
-- For a Laurent polynomial, this method returns a list of lists
-- {{i,coeff(var^i)}} of degrees of the given variable that appear
-- in f and also the corresponding coefficients.
laurentCoeffList = method()
laurentCoeffList(RingElement,RingElement) := (f,var) -> (
local coeff; local coeffDenom; local coeffList; local degreeList;
local denom; local denomDeg; local num; local R;
R = frac((coefficientRing ring f)(monoid [gens ring f]));
f = sub(f,R);
var = sub(var,R);
num = numerator f;
denom = denominator f;
denomDeg = degVar(denom,var);
coeffDenom = denom*(var^(-denomDeg)); -- Get rid of the variable from the denominator.
coeff = coefficients(num,Variables => {var});
degreeList = apply(reverse flatten entries (coeff)#0, i -> degVar(i,var) - denomDeg);
coeffList = apply(reverse flatten entries transpose (coeff)#1, i -> i*(coeffDenom)^-1);
return apply(#degreeList, i -> {degreeList#i,coeffList#i});
)
-- Method: laurentNormalize
-- Input: (Matrix,RingElement) - (matrix,variable to normalize with respect to)
-- Output: (Matrix,Matrix,Matrix) - (an invertible matrix of Laurent polynomials,
-- change of variables, inverse change of variables.)
-- Description:
-- Given a matrix over a Laurent polynomial ring, this method computes
-- an invertible matrix of Laurent polynomials and an invertible change
-- of variables so that multiplying by the matrix and applying the change
-- of variables makes the original matrix into a matrix with polynomial
-- entries.
laurentNormalize = method()
laurentNormalize(Matrix,RingElement) := (f,var) -> (
local D; local degSeqList; local denom; local denomDegSeq;
local dotList; local E; local Etemp; local f2; local f3; local j;
local invSubList; local invSubs; local invSubs1; local invSubs2;
local l; local leastDegTerm; local lVector; local minCoeff;
local minExp; local minSolList; local numDegSeq; local numTerms;
local R; local S; local subList; local subMatrix; local subs;
local subs1; local subs2; local usedVars; local varList;
R = ring f;
S = frac((coefficientRing ring f)(monoid [gens ring f]));
f = sub(f,S);
var = sub(var,S);
varList = gens S;
usedVars = unique support f_(0,0); -- Need to use 'unique support' since for a rational function, the 'support' command returns the concatenation of the support of the numerator and the support of the denominator.
if not member(var,usedVars) then error "Error: Expected the given variable to be in the support of the first polynomial.";
if numcols f < 2 then error "Error: Expected the given row to have at least 2 columns.";
-- The following code creates a list of lists where each interior list is the degree vector of a term of
-- the Laurent polynomial f_(0,0).
numTerms = terms numerator f_(0,0);
denom = denominator f_(0,0);
denomDegSeq = apply(#numTerms, i -> apply(varList, j -> degVar(denom,j)));
numDegSeq = apply(numTerms, i -> apply(varList, j -> degVar(i,j)));
degSeqList = numDegSeq - denomDegSeq;
lVector = matrix{apply(#usedVars, i -> 1)};
dotList = apply(degSeqList, i -> (matrix{i}*transpose lVector)_(0,0)); -- Create a list of the dot product of the current lVector with each degree vector.
l = 1;
while dotList != unique dotList do (
l = l+1;
lVector = matrix{apply(#usedVars, i -> l^i)};
dotList = apply(degSeqList, i -> (matrix{i}*transpose lVector)_(0,0)); -- Create a list of the dot product of the current lVector with each degree vector.
);
-- Once we exit the while loop, the terms of f_(0,0) will have all distinct powers of var with Laurent monomial coefficients.
-- Now we construct the appropriate change of variables.
subList = gens ring f;
invSubList = gens ring f;
j = 1;
scan(subList, i -> if member(i,usedVars) and i != var then (
i = i*var^(l^j);
j = j+1;
));
j = 1;
scan(invSubList, i -> if member(i,usedVars) and i != var then (
i = i*var^(-l^j);
j = j+1;
));
subs1 = matrix{subList};
invSubs1 = matrix{invSubList};
f2 = sub(f,subs1); -- Now each term of f2_(0,0) has a unique power of var.
minCoeff = (laurentCoeffList(f2_(0,0),var))#0; -- Get the smallest power of var occuring in f2_(0,0) and also its coefficient.
D = mutableIdentity(ring f,numcols f);
-- Need numcols f >= 2 here.
D_(0,0) = (sub(minCoeff#1,S) * var^(minCoeff#0))^-1;
D_(1,1) = (sub(minCoeff#1,S) * var^(minCoeff#0));
f3 = f2*matrix(D); -- Now f3_(0,0) has constant term 1 in var and only positive powers of var. (ie. it's a polynomial in var whose coefficients are Laurent polynomials in the other variables.)
-- Since the constant term of f3_(0,0) is 1, we can use elementary column operations to make all other polynomials have strictly positive degree in var.
E = matrix mutableIdentity(ring f,numcols f);
scan(1..(numcols f - 1), i -> (
leastDegTerm = (laurentCoeffList(f3_(0,i),var))#0;
while leastDegTerm#0 < 1 do (
Etemp = mutableIdentity(ring f,numcols f);
Etemp_(0,i) = -sub(leastDegTerm#1,S) * var^(leastDegTerm#0); -- Make an elementary matrix to kill the lowest degree term in f3_(0,i).
Etemp = matrix Etemp;
f3 = f3*Etemp;
E = E*Etemp;
leastDegTerm = (laurentCoeffList(f3_(0,i),var))#0;
);
));
-- After this scan, every entry of f3 except the first has strictly positive degree in var.
-- Now we construct the invertible change of variables which makes f3 become a matrix of polynomials.
usedVars = delete(var,usedVars);
if #usedVars > 0 then (
minSolList = {};
scan(drop(laurentCoeffList(f3_(0,0),var),1), i ->
minSolList = minSolList|apply(usedVars, j -> -(((laurentCoeffList(i#1,j))#0)#0)/(i#0))
);
scan(1..(numcols f - 1), i ->
scan(laurentCoeffList(f3_(0,i),var), j ->
minSolList = minSolList|apply(usedVars, k -> -(((laurentCoeffList(j#1,k))#0)#0)/(j#0))
)
);
minExp = max(ceiling max minSolList,0);
) else minExp = 0;
subMatrix = vars ring f;
subs2 = sub(subMatrix,{var => var*(product usedVars)^minExp});
invSubs2 = sub(subMatrix,{var => var*(product usedVars)^-minExp});
subs = sub(subs1,subs2);
invSubs = sub(invSubs2,invSubs1);
return (sub(sub(matrix(D)*E,invSubs1),R),sub(subs,R),sub(invSubs,R));
)
-- Method: leadCoeffVar
-- Input: (RingElement,RingElement) - (polynomial, variable)
-- Output: RingElement -- leading coefficient with respect to given variable
-- Description:
-- Returns the leading coefficient of a multivariate
-- polynomial with respect to a particular variable.
leadCoeffVar = method()
leadCoeffVar(RingElement,RingElement) := (f,var) -> (
if f == 0 then return 0_(ring f); -- If f is identically zero, then return 0.
return (last coefficients(f,Variables => {var}))_(0,0);
)
-- Method: leadCoeffVarFF
-- Input: (RingElement,RingElement) -- (polynomial, variable)
-- Output: RingElement -- leading coefficient of f with respect to var
-- Description:
-- This method returns the leading coefficient of f with respect to var
-- when f is viewed as a polynomial in var with coefficients in the
-- rational function field of the other variables. (Assumes that var
-- does not appear in the denominator of f.
leadCoeffVarFF = method()
leadCoeffVarFF(RingElement,RingElement) := (f,var) -> (
return ((coeffVarFF(f,var))#0)#0;
)
-- Method: maxMinors -- Test 2
-- Input: Matrix
-- Output: Ideal
-- Description:
-- Computes the ideal of maximal minors of the given matrix.
maxMinors = method()
maxMinors(Matrix) := M -> (
return scan(reverse (0..min(numrows M,numcols M)), i -> if minors(i,M) != 0 then break minors(i,M));
)
------------------------------------------------------------
------------------------------------------------------------
------------------------------------------------------------
-- Core methods in the QuillenSuslin package ---------------
------------------------------------------------------------
-- Method: applyRowShortcut
-- Input: Matrix (unimodular row over a polynomial ring)
-- Output: Matrix or null (solves the unimodular row problem if a shortcut is applicable)
-- Description:
-- Implements shortcuts from Fabianska's PhD thesis for solving the
-- unimodular row problem.
applyRowShortcut = method(Options => {Verbose => 0})
applyRowShortcut(Matrix) := opts -> g -> (
local f; local gSwap; local h; local l; local lSwap; local M1;
local M2; local M3; local M4; local n; local p1; local p2;
local R; local s; local S; local verbosity;
R = ring g;
f = flatten entries g;
n = #f;
verbosity = opts.Verbose;
if verbosity >= 1 then print("applyRowShortcut: Checking whether any shortcut methods apply to "|toString g|".");
-- Fabianska shortcut 2.2.1(1).
-- Test if any element of f is a unit in R.
s = scan(n, i -> if ideal(f_i) == ideal(1_R) then break i);
if s =!= null then (
if verbosity >=1 then print "applyRowShortcut: An element of the row was a unit. Using shortcut 2.2.1(1) from Fabianska's thesis.";
-- Swap g1 and gs.
M1 = mutableIdentity(R,n);
M1 = columnSwap(M1,0,s);
gSwap = g*matrix(M1); -- Now g1 is a unit.
S = map(R^1) // matrix{{gSwap_(0,0)}};
M2 = mutableIdentity(R,n);
M2_(0,0) = S_(0,0);
scan(1..(n-1), i -> M2_(0,i) = -S_(0,0)*gSwap_(0,i));
return matrix(M1)*matrix(M2);
);
-- Fabianska shortcut 2.2.1(2).
-- Check if any pair of elements already generate the unit ideal.
S = subsets(f,2);
s = scan (subsets(f,2), i -> if ideal i == ideal(1_R) then break i);
if s =!= null then (
if verbosity >= 1 then print "applyRowShortcut: A pair of elements in the row generated the unit ideal. Using shortcut 2.2.1(2) from Fabianska's thesis.";
p1 = position(f, i -> i == s_0);
p2 = position(f, i -> i == s_1);
M1 = map(R^1) // matrix{s};
M2 = mutableIdentity(R,n);
-- Swap so that the first two elements of g generate R.
M2 = columnSwap(M2,0,p1);
if p2 == 0 then M2 = columnSwap(M2,1,p1) else M2 = columnSwap(M2,1,p2);
M3 = mutableIdentity(R,n);
gSwap = g*matrix(M2);
M3_(0,0) = M1_(0,0);
M3_(1,0) = M1_(1,0);
M3_(0,1) = -gSwap_(0,1);
M3_(1,1) = gSwap_(0,0);
M4 = mutableIdentity(R,n);
scan(2..(n-1), i -> M4_(0,i) = -gSwap_(0,i));
return matrix(M2)*matrix(M3)*matrix(M4);
);
-- Fabianska shortcut 2.2.1(3).
-- Check if any element of the row is redundant. ie. if any
-- smaller subset of the row already generates the unit ideal.
s = scan(n, i -> if ideal submatrix'(g,,{i}) == ideal(1_R) then break i);
if s =!= null then (
if verbosity >= 1 then print "A smaller subset of the row was unimodular. Using shortcut 2.2.1(3) from Fabianska's thesis.";
M1 = mutableIdentity(R,n);
M1 = columnSwap(M1,0,s);
gSwap = g*matrix(M1);
h = map(R^1) // submatrix'(gSwap,,{0});
M2 = mutableIdentity(R,n);
scan(1..(n-1), i -> M2_(i,0) = (1-gSwap_(0,0))*h_(i-1,0));
M3 = mutableIdentity(R,n);
scan(1..(n-1), i -> M3_(0,i) = -gSwap_(0,i));
return matrix(M1)*matrix(M2)*matrix(M3);
);
-- Fabianska shortcut 2.2.2(1).
-- Check if any of the coefficients that give 1 as a linear combination
-- of the elements of the unimodular row are units.
l = flatten entries (map(target g) // g);
s = scan(n, i -> if ideal l_i == ideal(1_R) then break i);
if s =!= null then (
if verbosity >= 1 then print "applyRowShortcut: The right inverse to the row contained a unit. Using shortcut 2.2.2(1) from Fabianska's thesis.";
M1 = mutableIdentity(R,n);
M1 = columnSwap(M1,0,s);
M2 = mutableIdentity(R,n);
scan(n, i -> M2_(i,0) = (matrix{l}*matrix(M1))_(0,i));
M3 = mutableIdentity(R,n);
apply(1..(n-1), i -> M3_(0,i) = -(g*matrix(M1))_(0,i));
return matrix(M1)*matrix(M2)*matrix(M3);
);
-- Fabianska shortcut 2.2.2(2).
-- Check if any pair of coefficients expressing 1 as a linear
-- combination of the elements of the row generate the unit ideal.
S = subsets(l,2);
s = scan(S, i -> if ideal i == ideal(1_R) then break i);
if s =!= null then (
if verbosity >= 1 then print "applyRowShortcut: Two elements of the right inverse to the row generated the unit ideal. Using shortcut 2.2.2(2) from Fabianska's thesis.";
p1 = position(l, i -> i == s_0);
p2 = position(l, i -> i == s_1);
M1 = map(R^1) // matrix{s};
M2 = mutableIdentity(R,n);
-- Swap so that the first two elements of l generate R.
M2 = columnSwap(M2,0,p1);
if p2 == 0 then M2 = columnSwap(M2,1,p1) else M2 = columnSwap(M2,1,p2);
M3 = mutableIdentity(R,n);
lSwap = matrix{l}*matrix(M2);
gSwap = g*matrix(M2);
scan(n, i -> M3_(i,0) = lSwap_(0,i));
M3_(0,1) = -M1_(1,0);
M3_(1,1) = M1_(0,0);
M4 = mutableIdentity(R,n);
M4_(0,1) = -(-M1_(1,0)*gSwap_(0,0)+M1_(0,0)*gSwap_(0,1));
scan(2..(n-1), i -> M4_(0,i) = -(gSwap)_(0,i));
return matrix(M2)*matrix(M3)*matrix(M4);
);
if verbosity >= 1 then print "applyRowShortcut: No shortcut method applied.";
return null;
)
-- Method: changeVar
-- Input: (Matrix,List) - (unimodular row, list of variables)
-- Output: (Matrix, Matrix, Matrix) - (unimodular matrix that when
-- multiplied by the row will make the first entry monic
-- after the change of variables, change of variables,
-- inverse change of variables)
-- Description:
-- Given a unimodular row, this method produces a unimodular matrix U
-- and a change of variables so that the first entry in f*U becomes
-- monic in last(varList) after applying the change of variables.
-- The underlying ideas for proof of existence of this matrix and
-- change of variables can be found in a 1976 paper of Suslin-Vaserstein.
changeVar = method(Options => {Verbose => 0})
changeVar(Matrix, List) := opts -> (f,varList) -> (
local A; local almostMonic; local coefficientMap; local commonFactors;
local currDeg; local currVar; local degList; local degMatrix;
local degToBeat; local factorMap; local factors; local fSwap;
local g; local h; local invSubs; local leastFactors; local m;
local M; local M1; local M2; local M3; local minCol; local minDeg;
local minDegPolyList; local minEntry; local minTerms;
local mostCommonFactors; local n; local neededFactors;
local notCommonFactors; local r; local R; local s; local S;
local subs; local tempCoeff; local transVar; local u; local v; local verbosity;
local subMap; local invSubMap;
R = ring f;
currVar = last varList;
n = numcols f; -- n = number of columns in f.
m = #varList; -- m = number of variables currently being considered.
verbosity = opts.Verbose;
if verbosity >= 1 then print("changeVar: Computing a unimodular matrix and change of variables to make the first entry of the new row monic in "|toString(last varList)|".");
-- If n = 2, then we can easily transform f to [1,0].
if n == 2 then (
if verbosity >= 2 then print "changeVar: The row had two columns. Using n = 2 shortcut for normalization.";
g = map(R^1) // f;
M = mutableIdentity(R,2);
M_(0,0) = g_(0,0);
M_(1,0) = g_(1,0);
M_(0,1) = -f_(0,1);
M_(1,1) = f_(0,0);
return (matrix M,vars R,vars R);
);
-- If a component already equals 1, then move it to the front.
-- This is just to make the degMatrix in the next step
-- work out nicely. i.e. This removes the possibility that
-- a component of f is monic of degree zero.
s = scan(n, i -> if f_(0,i) == 1 then break i);
if s =!= null then (
if verbosity >= 2 then print "changeVar: One of the elements was already 1. Moving it to the front.";
M = mutableIdentity(R,n);
M = columnSwap(M,0,s);
return (matrix M,vars R,vars R);
);
-- If none of the components are the constant 1, we create
-- a matrix (degMatrix) whose (i,j)th entry is zero if
-- f_(0,j) is not monic in varList#i (currVar counts as i = m-1)
-- and if degMatrix_(i,j) != 0, then degMatrix_(i,j) is the
-- degree of f_(0,j) viewed as a polynomial in varList#i.
-- The goal is to move the smallest degree monic component
-- to the front of f.
degMatrix = mutableMatrix(R,m,n);
scan(m, i ->
scan(n, j ->
if leadCoeffVar(f_(0,j),varList#i) == 1 then degMatrix_(i,j) = degVar(f_(0,j),varList#i)
)
);
-- Now that degMatrix has been constructed, go through
-- and check if any nonzero entries exist (a nonzero
-- entry represents a row element which is monic in
-- one of the variables.)
minEntry = (null,null,null);
scan(m, i ->
scan(n, j ->
if degMatrix_(i,j) > 0 then ( minEntry = (i,j,degMatrix_(i,j)); break;)
)
);
if minEntry =!= (null,null,null) then (
if verbosity >= 2 then print "changeVar: One of the entries of the row was monic in one of the variables. Permuting the variables.";
scan(minEntry#0..(m-1), i ->
scan(n, j ->
if degMatrix_(i,j) > 0 and degMatrix_(i,j) < minEntry#2 then minEntry = (i,j,degMatrix_(i,j))
)
);
M = mutableIdentity(R,n);
M = columnSwap(M,0,minEntry#1);
subs = mutableMatrix vars R;
subs = columnSwap(subs,minEntry#0,m-1); -- This map just transposes the two variables. It is its own inverse.
return (matrix M,matrix subs,matrix subs);
);
if verbosity >= 2 then print "No component of the row was already monic in any of the variables.";
-- The last normalization shortcut is to check whether
-- a smaller subset of the row elements generate the
-- entire ring. If so, then we can use a unimodular
-- transformation to get 1 in the first position of f.
-- This is the same as shortcut 2.2.1(3) in applyRowShortcut.
s = scan(n, i -> if ideal submatrix'(f,,{i}) == ideal(1_R) then break i);
if s =!= null then (
if verbosity >= 2 then print "changeVar: A smaller subset of the row was unimodular. Using a shortcut for normalization.";
M1 = mutableIdentity(R,n);
M1 = columnSwap(M1,0,s);
fSwap = f*matrix(M1);
h = map(R^1) // submatrix'(fSwap,,{0});
M2 = mutableIdentity(R,n);
scan(1..(n-1), i -> M2_(i,0) = (1-fSwap_(0,0))*h_(i-1,0));
M3 = mutableIdentity(R,n);
scan(1..(n-1), i -> M3_(0,i) = -fSwap_(0,i));
return (matrix(M1)*matrix(M2)*matrix(M3),vars R,vars R);
);
-- We will split into two cases, based on whether the
-- coefficient ring is a field or ZZ.
if isField(coefficientRing R) then (
if verbosity >= 2 then print "changeVar: Normalizing over a field.";
-- Find the component of smallest degree.
minCol = minPosition apply(n, i -> degVar(f_(0,i),currVar));
if verbosity >= 3 then print("changeVar: Found polynomial of minimal degree in "|toString currVar|": "|toString f_(0,minCol)|".");
tempCoeff = leadCoeffVar(f_(0,minCol),currVar);
scan(reverse (0..m-1), i -> tempCoeff = leadCoeffVar(tempCoeff,varList#i)); -- After this loop, tempCoeff is the coefficient of the leading term of f_(0,minCol) with respect to the block order induced by varList.
M1 = mutableIdentity(R,n);
M1 = columnSwap(M1,0,minCol);
M1_(minCol,0) = tempCoeff^-1; -- When f is multiplied by M1, f_(0,0) is now almost monic with respect to varList.
(subs,invSubs) = monicPolySubs(tempCoeff^-1 * f_(0,minCol),varList,Verbose => verbosity);
return (matrix M1,subs,invSubs);
);
if coefficientRing(R) === ZZ then (
if verbosity >= 2 then print "changeVar: Normalizing over ZZ.";
S = subsets(flatten entries f,2);
s = scan(S, i -> if gcd(i#0,i#1) == 1_R then break i);
-- If s == null here, we need to multiply by a unimodular matrix to make 2 elements be relatively prime.
A = mutableIdentity(R,n);
if s === null then (
-- This uses a constructive prime avoidance technique
-- to guarantee that two elements of the row generate
-- a height 2 ideal.
if verbosity >= 2 then print "changeVar: No pair of elements in the row are relatively prime. Using constructive prime avoidance algorithm.";
factors = apply(n, i-> factorList f_(0,i));
-- Finds entry with least number of factors.
leastFactors = minPosition apply(factors, i -> #i);
-- Finds entry with most number of common factors with position leastFactors.
commonFactors = new MutableList from apply(apply(factors, i -> set i), j -> (set factors#leastFactors)*j);
commonFactors#leastFactors = set{}; -- Don't compare the one with the least number of factors to itself.
mostCommonFactors = maxPosition apply(commonFactors, i -> #i);
notCommonFactors = toList(set factors#leastFactors - set factors#mostCommonFactors); -- Create a list of irreducible factors which are not common between the two.
coefficientMap = map(R^1) // f;
neededFactors = apply(factors, i -> toList(set notCommonFactors - set i));
scan(n,i -> A_(i,mostCommonFactors) = coefficientMap_(i,0)*product(neededFactors#i));
A_(mostCommonFactors,mostCommonFactors) = 1;
A_(leastFactors,mostCommonFactors) = 0;
u = leastFactors;
v = mostCommonFactors;
);
if s =!= null then (
u = position(flatten entries f,i -> i == s#0); -- u is the position of the first polynomial.
v = position(flatten entries f,i -> i == s#1); -- v is the position of the second polynomial.
);
g = mutableMatrix (f*matrix A);
M = mutableIdentity(R,n);
g = columnSwap(g,1,u); -- Put the first polynomial in column 2.
M = columnSwap(M,1,u);
if v == 1 then (
g = columnSwap(g,u,2); -- Put the second polynomial in column 3.
M = columnSwap(M,u,2);
) else (
g = columnSwap(g,2,v); -- Put the second polynomial in column 3.
M = columnSwap(M,2,v);
);
almostMonic = findAlmostMonicPoly(ideal(g_(0,1),g_(0,2)),varList,Verbose => verbosity);
if verbosity >= 3 then print("changeVar: Output from findAlmostMonicPoly: "|toString almostMonic|".");
(subs,invSubs) = monicPolySubs(almostMonic,varList,Verbose => verbosity);
subMap = map(R,R,subs);
invSubMap = map(R,R,invSubs);
if verbosity >= 3 then print("changeVar: Change of variable and inverse change of variable from monicPolySubs: "|toString(subs,invSubs)|".");
degList = drop(apply(n, i -> {i,degVar(subMap g_(0,i),last varList),#(terms subMap g_(0,i))}),{1,2}); -- Make a list of the degrees of the polynomials other than g2 and g3.
minDeg = min apply(degList, i -> i#1); -- Find the minimal degree.
minDegPolyList = {};
scan(degList, i -> if i#1 == minDeg then minDegPolyList = append(minDegPolyList,{i#0,i#2}));
-- Now find the position of the polynomial with minimal degree and the least number of terms after the substitution.
minTerms = min apply(minDegPolyList, i -> i#1); -- Find the minimal number of terms among these polynomials.
r = (minDegPolyList#(position(minDegPolyList, i -> i#1 == minTerms)))#0; -- g_(0,r) is the 'best' polynomial to put at the front.
g = columnSwap(g,0,r); -- Move g_(0,r) to the g_(0,0) position.
M = columnSwap(M,0,r);
degToBeat = degVar(subMap g_(0,0),last varList); -- We need to multiply the monic polynomial in (f2,f3) by a sufficient power of the last variable to beat this power.
currDeg = degVar(subMap almostMonic,last varList);
factorMap = matrix{{almostMonic}} // matrix{{g_(0,1),g_(0,2)}};
transVar = (vars R)_(0,position(flatten entries subs, i -> sub(i,R) == sub(last varList,R)));
factorMap = sub(matrix{{(transVar)^(max(0,degToBeat-currDeg+1)),0},{0,(transVar)^(max(0,degToBeat-currDeg+1))}},R)*sub(factorMap,R);
M2 = mutableIdentity(R,n);
M2_(1,0) = factorMap_(0,0);
M2_(2,0) = factorMap_(1,0);
return (matrix(A)*matrix(M)*matrix(M2),subs,invSubs);
);
error "Unsupported coefficient ring. Try QQ, ZZ/p, or ZZ.";
)
-- Method: completeMatrix
-- Input: Matrix - a unimodular m x n matrix over a polynomial ring (m \leq n).
-- Output: Matrix - a completion of the matrix to a square invertible matrix over the polynomial ring.
-- Description:
-- This method just computes the inverse of the matrix returned by qsAlgorithm, which is an extension of
-- the given matrix to a square invertible matrix.
completeMatrix = method(Options => {Verbose => 0})
completeMatrix(Matrix) := opts -> M -> (
local R;
R = ring M;
if R.monoid.Options.Inverses == true then return sub(inverse sub(qsAlgorithm M,frac((coefficientRing R)(monoid [gens R]))),R) else return inverse qsAlgorithm(M,Verbose => opts.Verbose);
)
-- Method: computeFreeBasis
-- Input: Module -- projective module over a supported polynomial ring.
-- Output: Matrix -- free generating set for the given module.
-- Description:
-- This method computes a free basis for a projective module over a
-- polynomial ring with coefficients in QQ, ZZ, or ZZ/p.
computeFreeBasis = method(Options => {Verbose => 0,CheckProjective => false})
computeFreeBasis(Module) := opts -> M -> (
local A; local B; local F; local ident; local ncol; local nrowB;
local nrowU; local p; local R; local tA; local U; local V;
local verbosity; local numRowsA; local numColsA;
local G; local K; local C; local C1;
verbosity = opts.Verbose;
if opts#CheckProjective == true then (
if verbosity >= 2 then print "computeFreeBasis: Checking whether the given module is projective.";
if not isProjective M then error "Error: The given module is not projective.";
);
--if syz gens M == 0 then return gens M; -- *** May need to put this back in.
-- This method inductively trims the length of the free resolution
-- of M until it arrives at an isomorphism between M and a free
-- R-module, from which it can read off a free generating set for
-- M as a R-module. This algorithm is directly taken from the
-- Logar-Sturmfels paper under the 'reduction to the stably free
-- case' section.
R = ring M;
F = res M;
p = length F;
A = F.dd_p;
print A;
scan(p-2, i -> (
tA = transpose A;
ident = map(target tA,target tA,1_R);
B = transpose (ident // tA);
U = qsAlgorithm(B,Verbose => verbosity);
print(B,U);
nrowB = numrows B;
nrowU = numrows U;
ncol = nrowU-nrowB;
V = submatrix(U,0..(nrowU-1),nrowB..(nrowU-1));
A = F.dd_(p-i-1)*V;
print A;
));
numRowsA = numrows A;
numColsA = numcols A;
C = submatrix'(transpose completeMatrix transpose A,,{0..(numcols A - 1)});
return C;
-- Fix this so it reliably returns mingens.
--return mingens((image map(R^(numRowsA),R^(numRowsA - numColsA),C))/(image map(R^numRowsA,R^numColsA,A)));
--return C;
-- This is the old code that sort of works at least for things presented as images/kernels.
-- Modify this code to work in general. Make options for Presentation => Kernel, etc.?
-- Other option is to use the inverse of the pruning map if we can
-- get it working.
scan(p-1, i -> (
tA = transpose A;
ident = map(target tA,target tA,1_R);
B = transpose (ident // tA);
U = qsAlgorithm(B,Verbose => verbosity);
nrowB = numrows B;
nrowU = numrows U;
ncol = nrowU-nrowB;
V = submatrix(U,0..(nrowU-1),nrowB..(nrowU-1));
A = F.dd_(p-i-1)*V;
));
return A;
)
computeFreeBasis(Ideal) := I -> (
return computeFreeBasis module I;
)
-- Method: getLocalSolutions
-- Input: (Matrix,List,RingElement) -- (matrix, list of variables, current variable)
-- Output: List -- List of local solutions to the unimodular row problem
-- over various localizations at maximal ideals.
-- Description:
-- This computes a set of local solutions for a given unimodular row f
-- as part of the "local loop" of the Logar-Sturmfels algorithm. The
-- first element of the unimodular row must be monic in the given
-- variable. This can be achieved by using the changeVar method.
getLocalSolutions = method(Options => {Verbose => 0})
getLocalSolutions(Matrix,List,RingElement) := opts -> (f,ringVars,currVar) -> (
local I; local localSolutions; local maxIdeal; local R; local S;
local U; local verbosity; local subR; local subS;
verbosity = opts.Verbose;
if verbosity >= 1 then print("getLocalSolutions: Computing local solutions for "|toString f|".");
R = coefficientRing(ring f)(monoid [ringVars]);
S = ring f;
I = ideal(0_R);
subR = map(R,S);
subS = map(S,R);
maxIdeal = subS getMaxIdeal(I,ringVars,Verbose => verbosity);
localSolutions = {};
U = horrocks(f,currVar,maxIdeal,Verbose => verbosity); -- Find the first local solution.
I = ideal(subR commonDenom U); -- Let I be the ideal generated by the common denominator of elements of U.
localSolutions = append(localSolutions,U); -- Add the local solution to localSolutions.
-- Repeat the following "local loop" until the ideal of denominators generates the entire ring.
-- This is guaranteed to terminate after finitely many steps by the
-- Hilbert Basis Theorem.
while I != ideal(1_R) do (
maxIdeal = subS getMaxIdeal(I,ringVars,Verbose => verbosity);
if verbosity >= 2 then print "getLocalSolutions: Denominators did not generate the unit ideal. Repeating horrocks.";
U = horrocks(f,currVar,maxIdeal,Verbose => verbosity);
I = I+ideal(subR commonDenom U);
localSolutions = append(localSolutions,U);
);
return localSolutions;
)
-- Method: getMaxIdeal
-- Input: (Ideal,List) -- (ideal, list of variables)
-- Output: Ideal -- maximal ideal containing the given ideal.
-- Description:
-- Given an ideal I and a list of variables varList,
-- this method computes a maximal ideal in
-- coefficientRing(ring I)[varList] containing I.
getMaxIdeal = method(Options => {Verbose => 0})
getMaxIdeal(Ideal,List) := opts -> (I,varList) -> (
local c; local genList; local k; local indepVar; local m;
local maxIdeal; local n; local p; local pp; local primeElement;
local R; local s; local S; local verbosity;
verbosity = opts.Verbose;
if verbosity >= 1 then print("getMaxIdeal: Computing a maximal ideal containing "|toString I|".");
R = ring I;
if I == ideal(1_R) then error "Error: Expected a proper ideal.";
-- If the ring is just the integers, then just return any prime factor of the generator.
if R === ZZ then (
return sub(ideal(((factor((gens gb I)_(0,0)))#0)#0),R);
);
p = char coefficientRing R;
S = (coefficientRing R)(monoid [varList]);
n = #varList;
m = sub(I,S);
-- The algorithm over finite fields ZZ/p.
if (isField(coefficientRing R) and p > 0) then (
if verbosity >= 2 then print "getMaxIdeal: Using algorithm over a finite field.";
if m == 0 then return sub(ideal(varList),R);
-- Keep adding elements to cut down the dimension of the ideal.
while dim m > 0 do (
if verbosity >= 3 then print("getMaxIdeal: dim(m) = "|toString(dim m)|".");
c = 0;
k = 1;
indepVar = (support (independentSets(m, Limit => 1))#0)#0;
while m+sub(indepVar^k+c,S) == ideal(1_S) do (
c = c+1;
if c == p then (k=k+1;c=0;);
);
m = m+sub(ideal(indepVar^k+c),S);
if verbosity >= 3 then print("getMaxIdeal: Added the element "|toString(indepVar^k+c)|" to cut down the dimension of m.");
);
-- Once the ideal is zero-dimensional, the associated primes are the maximal ideals containing it, so return one of them.
if verbosity >= 2 then print "getMaxIdeal: Ideal is now zero-dimensional, computing associated primes.";
return sub((minimalPrimes m)_0,R);
);