-
Notifications
You must be signed in to change notification settings - Fork 0
/
MaxBettiNumbers.m2
2034 lines (1856 loc) · 77.9 KB
/
MaxBettiNumbers.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
-- -*- coding: utf-8 -*-
newPackage( "MaxBettiNumbers",
Headline =>
"Methods to find Maximum Betti numbers given bounds on the Hilbert function",
Version => "0.9",
Date => "July 24, 2020",
Authors => { { Name => "Jay White", Email => "[email protected]" } },
DebuggingMode => true,
HomePage => "https://github.com/JayWhite2357/maxbetti"
);
--------------------------------------------------------------------------------
--- exports
--------------------------------------------------------------------------------
--- exports and options for the main method of the package, maxBettiNumbers
export { "maxBettiNumbers" };
export { "HilbertFunctionLowerBound", "HilbertDifferenceLowerBound" };
export { "HilbertFunctionUpperBound", "HilbertDifferenceUpperBound" };
export { "HilbertPolynomial", "ResultsCount" };
--export { "Algorithm" };
--- exports for the type, MaxBetti, that is returned by maxBettiNumbers
export { "MaxBetti" };
export { "isRealizable", "BettiUpperBound", "MaximumBettiSum" };
export { "HilbertFunctions", "MaximalBettiNumbers" };
--- exports and options for the auxillary methods of the package
export { "lexBetti", "almostLexBetti" };
export { "lexsegmentIdeal", "almostLexIdeal" };
export { "AsTally" };
--------------------------------------------------------------------------------
--- end exports
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- types
--------------------------------------------------------------------------------
MaxBetti = new Type of HashTable
--------------------------------------------------------------------------------
--- end types
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- Functions to deal with the Macaulay Representation of a Number
--------------------------------------------------------------------------------
--- This is the macaulay representation of a. From this, it is easy to read off
--- the max index of a monomial as well as the Macaulay upper and lower
--- bounds.
--- The output, rep, is a sequcne of length d
--- a = binomial(rep#0, 1) + binomial(d + rep#d, d + 1)
--- Note: this is a different output from most versions of this method.
--- the reason is that this is more compact and efficient.
--- The idea is that we want to easily increment and decrement a without
--- recomputing the representation each time.
--- Incrementing rep: (increasing a)
--- Find the last element equal to rep#0.
--- Increase that element by 1 and set all preceding elements to 0
--- Decrementing rep: (decreasing a)
--- Find the first nonzero element
--- Reduce it by 1
--- Set all preceding elements to that element's new value
--- Reading off monomial:
--- The first nonzero element indicates the max index.
--- Add 1 to every other nonzero element.
--- Set all zero elements to equal the first nonzero element.
--- Take n+1-e for each element e. This is the index of the variable.
--- The product of all the variables is the ath last monomial,
--- where the 1st last is the power of the last variable.
macaulayRepresentation = ( a, d ) -> (
v := if d <= 1 then a else 0;
if d > 1 then (
while a > binomial( v - 1 + d, d ) do (
v = v + 1
)
);
reverse for i in reverse( 0 .. d - 1 ) list (
if a === 0 then 0 else if i === 0 then a else (
a = a - binomial( v + i, i + 1 );
while a < 0 do (
v = v - 1;
a = a + binomial( v + i, i );
);
v
)
)
)
macaulayAboveBound = ( a, d ) -> (
if ( a === infinity or ( d === 0 and a > 0 ) ) then infinity else (
r := macaulayRepresentation( a, d );
sum for i to #r-1 list (
binomial( r#i + i + 1, i + 2 )
)
)
);
macaulayBelowBound = ( a, d ) -> (
if ( a <= 0 or d <= 0 ) then 0 else if d === 1 then 1 else (
r := macaulayRepresentation( a, d );
sum for i to #r-1 list (
if r#i === 0 then 0 else (
binomial( r#i + i - 1, i )
)
)
)
);
decrementRep = ( rep, firstNonzeroIndex, firstNonzeroValue ) -> (
rep = join(
firstNonzeroIndex + 1 : firstNonzeroValue - 1,
drop( rep, firstNonzeroIndex + 1 )
);
if firstNonzeroValue === 1 then (
firstNonzeroIndex = firstNonzeroIndex + 1;
if rep#?firstNonzeroIndex then (
firstNonzeroValue = rep#firstNonzeroIndex;
)
) else (
firstNonzeroIndex = 0;
firstNonzeroValue = firstNonzeroValue - 1;
);
( rep, firstNonzeroIndex, firstNonzeroValue )
);
incrementRep = ( rep, lastrep0Index ) -> (
rep = join(
toList( lastrep0Index : 0 ),
{ rep#0 + 1 },
drop( rep, lastrep0Index + 1 )
);
if lastrep0Index === 0 then (
while rep#?( lastrep0Index + 1 ) and
rep#( lastrep0Index + 1 ) === rep#0 do
lastrep0Index = lastrep0Index + 1;
) else lastrep0Index = lastrep0Index - 1;
( rep, lastrep0Index )
)
--------------------------------------------------------------------------------
--- End Macaulay Representation Methods
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- Beginning of functions to Sanitize and Optimize the inputs -----------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- functions to sanitize the input bounds
--------------------------------------------------------------------------------
--- This function sanitizes g(d) so that it is a valid hilbert function.
--- This relies on the fact that h(d) is must be at least
--- macaulayAboveBound(g(d-1), d-1)
cleanUpperBound = f -> (
bound := 1;
for d to #f - 1 list (
if f#d =!= null then (
bound = min( f#d, bound )
);
bound
) do (
bound = macaulayAboveBound( bound, d )
)
);
--- This function sanitizes f(d) so that it is a valid hilbert function.
--- This relies on the fact that h(d) is must be at most
--- macaulayBelowBound(g(d+1), d+1)
cleanLowerBound = f -> if #f == 0 then f else (
bound := 0;
reverse for d in reverse( 0 .. #f - 1 ) list (
if f#d =!= null then (
bound = max( f#d, bound )
);
bound
) do (
bound = macaulayBelowBound( bound, d )
)
);
--------------------------------------------------------------------------------
--- end sanitize bounds
--------------------------------------------------------------------------------
--- function for padding lists with null
padList = ( l, f ) -> join( f, toList( l - #f : null ) );
--------------------------------------------------------------------------------
--- functions to sanitize the polynomial input
--------------------------------------------------------------------------------
--- This function gives the minimum degree at which that every saturated ideal
--- with hilbert polynomial p is guarenteed to have hilbert function match
--- hilbert polynomial
minPolyBoundDegree = p -> (
n := first degree p;
i := ( ring p )_0;
lC := 0;
while n > 0 do (
lC = leadCoefficient p;
p = p - binomial( n + i, n + 1 ) + binomial( n + i - n! * lC, n + 1 );
n = first degree p;
);
d := sub( p, ZZ );
if lC > d then error "Invalid Hilbert Polynomial.";
d
);
--- This function sets G,F,g,f to be the appropriate values to ensure that all
--- ideals in the family have the specified hilbert polynomial
--- if no polynomial is specified, nothing is done.
cleanPolynomial = ( G, F, g, f, p, d ) -> (
if p =!= null then (
i := ( ring p )_0;
pd := sub( sub( p, i => d ), ZZ );
pd' := sub( sub( p, i => d - 1 ), ZZ );
deltapd := pd - pd';
G = padList( d + 1, G );
F = padList( d + 1, F );
g = padList( d + 1, g );
f = padList( d + 1, f );
if G_d === null or G#d < pd then G = replace( d, pd, G );
if F_d === null or F#d > pd then F = replace( d, pd, F );
if g_d === null or g#d < deltapd then g = replace( d, deltapd, g );
if f_d === null or f#d > deltapd then f = replace( d, deltapd, f );
);
( G, F, g, f )
);
--------------------------------------------------------------------------------
--- end sanitize polynomial
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- functions to optimize the bounds
--------------------------------------------------------------------------------
--- This function makes an optimizations of g(d) based on the following:
--- The smallest that h(d) could be is G(d)-F(d-1)
--- Usage: g = optimizeLowerBound ( G, F, g );
optimizeLowerBound = ( G, F, g ) -> (
gprime := G - prepend( 0, drop( F, -1 ) );
max \ transpose { g, gprime }
);
--- This function makes an optimizations of f(d) based on the following:
--- The largest that h(d) could be is G(d)-G(d-1)
--- Usage: f = optimizeLowerBound ( G, F, f );
optimizeUpperBound = ( G, F, f ) -> (
fprime := F - prepend( 0, drop( G, -1 ) );
min \ transpose { f, fprime }
);
--- This function makes two optimizations on G(d) based on the following:
--- The smallest that H(d) could be is G(d) + g(d)
--- The smallest that H(d) could be is G(d+1) - f(d)
optimizeAccumulatedLowerBound = ( G, g, f ) -> (
cumulativeSum := 0;
G = for d to #G - 1 list (
cumulativeSum = max( G#d, cumulativeSum + g#d )
);
bound := 0;
reverse for d in reverse( 0 .. #G - 1 ) list (
bound = max( G#d, bound )
) do (
bound = bound - f#d
)
);
--- This function makes two optimizations on F(d) based on the following:
--- The largest that H(d) could be is F(d) + f(d)
--- The largest that H(d) could be is F(d+1) - g(d)
optimizeAccumulatedUpperBound = ( F, g, f ) -> (
cumulativeSum := 0;
F = for d to #F - 1 list (
cumulativeSum = min( F#d, cumulativeSum + f#d )
);
bound := infinity;
reverse for d in reverse( 0 .. #F - 1 ) list (
bound = min( F#d, bound )
) do (
bound = bound - g#d
)
);
--------------------------------------------------------------------------------
--- end optimize bounds
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- main function to sanitize (and optimize) the inputs
--------------------------------------------------------------------------------
sanitizeInputs = ( G, F, g, f, p, n ) -> (
--- Sanitize the polynomial input by converting it to bounds
D := if p === null then 0 else minPolyBoundDegree( p );
D = max( D, #G-1, #F-1, #g-1, #f-1 );
( G, F, g, f ) = cleanPolynomial( G, F, g, f, p, D );
--- End Sanitize polynomial
--- Sanitize the input length so that they include at least degree 1
l := max( #G, #F, #g, #f, 2 );
( G, F, g, f ) = ( G, F, g, f ) / padList_l;
--- End Sanitize input length
--- Sanitize the degree 1 upper difference bound
if ( f#1 === null or f#1 > n + 1 ) then (
f = replace( 1, n + 1, f )
);
--- End Sanitize degree 1
--- Sanitize the inputs so that they are Hilbert functions
F = cleanUpperBound F;
f = cleanUpperBound f;
G = cleanLowerBound G;
g = cleanLowerBound g;
--- End sanitize functions
--- Check validity of inputs
valid := min( min( F - G ), min( f - g ) ) >= 0;
--- End check validity
--- Optimize the bounds. This drastically improves the run time.
--- This is done by repeated application of the 4 optimization Functions.
--- Once G,F,g,f no longer change, we stop and re-sanitize the values
--- We repeat this process until G,F,g,f are stable.
--- Throughout this process we check that it is always a possible scenario.
prevGFgf := null;
while valid and prevGFgf =!= ( G, F, g, f ) do (
while valid and prevGFgf =!= ( G, F, g, f ) do (
prevGFgf = ( G, F, g, f );
f = optimizeUpperBound( G, F, f );
g = optimizeLowerBound( G, F, g );
F = optimizeAccumulatedUpperBound( F, g, f );
G = optimizeAccumulatedLowerBound( G, g, f );
valid = min( min( F - G ), min( f - g ) ) >= 0;
);
if valid then (
F = cleanUpperBound F;
f = cleanUpperBound f;
G = cleanLowerBound G;
g = cleanLowerBound g;
valid = min( min( F - G ), min( f - g ) ) >= 0;
)
);
--- End Optimize bounds
--- Throw an error if bounds don't make sense
if not valid then (
error concatenate (
"The given inputs are invalid or give impossible constraints:\nG = ",
toString G, "\nF = ", toString F, "\ng = ", toString g, "\nf = ",
toString f
);
);
if last G =!= last F then (
error concatenate (
"The given inputs don't specify constraints that eventually fix the ",
"Hilbert function:\nG = ", toString G, "\nF = ", toString F, "\ng = ",
toString g, "\nf = ", toString f );
);
--- End throw error
( G, F, g, f )
);
--------------------------------------------------------------------------------
--- end main sanitize function
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- End Sanitize and Optimize --------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- Functions to build V and lowerBound for use in the algorithms.
--------------------------------------------------------------------------------
--- We precompute the V_q values as well as the Macaulay lower bound.
--- Doing this ahead of time saves a ton of repitition.
--- We are setting V#d#(j - g#d) = V_q[d, j]
--- We are setting lowerBound#d#(j - g#d) = [j]_<d>
--- Although we could compute these directly, the following is a more efficient
--- way of computing them iteratively.
BuildVLowerBound = ( g, f, n ) -> (
--- Make a list of all possible vectors. This way we don't have to compute
--- binomials repeatedly
Vi := for i to n list (
--- The next line takes the sum of the for loop and appends it to the end;
--- there might be a neater way to do this, but I can't find one.
( v -> append( v, sum v ) ) for q to n list (
binomial( n + 1, q + 1 ) - binomial( i + 1, q + 1 )
)
);
--- This is one of our outputs that we will populate.
V := for d to #g - 1 list new MutableList from g#d .. f#d;
--- This is the other output that we will populate.
lowerBound := for d to #g - 1 list new MutableList from g#d .. f#d;
for d to #g - 1 do (
VAccumulated := Vi#n; -- This is simply the zero vector to start.
--- begin initialize the macaulay representation
rep := macaulayRepresentation( g#d, d );
--- initialize the lastrep0Index to be the last index in rep that equals
--- rep#0.
lastrep0Index := 0;
while rep#?( lastrep0Index + 1 ) and
rep#( lastrep0Index + 1 ) === rep#0 do
lastrep0Index = lastrep0Index + 1;
--- end initialize lastrep0Index
nextLowerBound := macaulayBelowBound( g#d, d );
nextrep0 := 0;
for k to f#d - g#d do (
--- the index of the monomial is n - nextrep0.
VAccumulated = VAccumulated + Vi#( n - nextrep0 );
V#d#k = VAccumulated;
lowerBound#d#k = nextLowerBound;
if #rep === 0 then continue;
nextrep0 = rep#0;
if nextrep0 === 0 then nextLowerBound = nextLowerBound + 1;
( rep, lastrep0Index ) = incrementRep( rep, lastrep0Index );
)
);
( V, lowerBound )
)
--------------------------------------------------------------------------------
--- End functions for building V and lowerBound
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- Begining of the driver methods of the Algorithms themselves ----------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- Simplified Method returning no hilbert Functions
--------------------------------------------------------------------------------
--- This is an implementation of the algorithm described in the paper
--- Note: the portions of the pseudocode in algorithm 3.1 of above are
--- written in comments beginning with --**
--- Notationally: putting a ' (prime) on a variable indicates that it is the
--- value of the variable in the previous degree.
--- Instead of using a dictionary with (d, c) keys, we opt to only use a list,
--- the dictionaries are lists of the theoretical (d, c) keys.
--- the "dictionary" in each degree is a list of all the keys, where the
--- 0th entry is the (d, G#d key). Note, to access a key with a d-1 degree,
--- we simply access the previous version of that dictionary, which is why we
--- have to keep track of that.
--- To make sense of the more compact way of storing these values, we will use
--- the shorthand b to represend c-g and i to represent j-G.
SimplifiedNone = ( G, F, g, f, V, lowerBound ) -> (
--**We initialize the base case by creating a dictionary maxVDict'
--** containing (-1, 0) => 0
--- V#0#0 is the zero vector
maxVDict' := { V#0#0 };
--- These are the correct values in degree -1.
G' := 0;
F' := 0;
maxj' := { 0 };
--**For each value of d from 0 to D do:
for d to #G - 1 do (
--- maxj#c is the max j value that we can get if we respect the Macaulay
--- bound. Although it is not necessary, we can quit looping early by
--- respecting this bound.
maxj := new MutableList from G#d .. F#d;
--**For each value of c from G(d) to F(d) do:
--- maxVDict' get's assigned only once we have looped through all c, so
--- there is no need to create a maxVDict just to reassign maxVDict'
--- notationally, it is confusing, but it works well this way.
maxVDict' = for c from G#d to F#d list (
--- max \ transpose does elementwise maximization on a bunch of lists
max \ transpose(
--**For each value of j from g(d) to f (d) do:
--- The situations where j + F' < c or j + G' > c are impossible
for j from max( g#d, c - F' ) to min( f#d, c - G' )
--- We can ignore the situations where we violate the lower bound.
--- This is done by comparing the Macaulay lower bound with the
--- maximum j in the previous degree.
when maxj'#( c - j - G' ) >= lowerBound#d#( j - g#d )
list (
maxj#( c - G#d ) = j;
--**Compute V0 = maxVDict(d', c') + Vq[d,j].
--- This next line is the potential maximum for this iteration
maxVDict'#( c - j - G' ) + V#d#( j - g#d )
)
)
--**Add the entry (d,c)=>maxV to the dictionary maxVDict
);
--- Update all of the values so that they are correct for the next degree
G' = G#d;
F' = F#d;
maxj' = maxj;
);
--**Return the value maxVDict(D, G(D), g(D))
maxVDict'#0
);
--------------------------------------------------------------------------------
--- End Simplified None
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- Simplified Method returning all hilbert functions with max betti sum
--------------------------------------------------------------------------------
--- This method is similar in structure to SimplifiedNone
--- The functions that give the maximum sum of the Vq's is returned in a
--- "raveled" format. raveledHFs contains a list of each degree, which is a
--- list of the value of the functions in that degree that give the maximum
--- sum of V. This "raveled" result can be unraveled with the
--- UnravelSimplified methods.
--- Note, the last element of the V vectors is the sum of the Vq's, which is why
--- we use that element for tracking HF.
SimplifiedSome = ( G, F, g, f, V, lowerBound ) -> (
maxVDict' := { V#0#0 };
G' := 0;
F' := 0;
maxj' := { 0 };
--- Each degree of this for loop returns all the j values in that degree with
--- max V.
raveledHFs := for d to #G - 1 list (
maxj := new MutableList from G#d .. F#d;
maxHFDict := new MutableList from G#d .. F#d;
maxVDict' = for c from G#d to F#d list (
--- Note, we need to track the maxSum so that we can collect the j values
maxSum := 0;
maxHF := { };
--- However, we can still utilize max \ transpose to maximize the vectors
maxV := max \ transpose (
for j from max( g#d, c - F' ) to min( f#d, c - G' )
when maxj'#( c - j - G' ) >= lowerBound#d#( j - g#d ) list (
maxj#( c - G#d ) = j;
V0 := maxVDict'#( c - j - G' ) + V#d#( j - g#d );
if last V0 === maxSum then (
maxHF = append( maxHF, j );
) else if last V0 > maxSum then (
maxHF = { j };
maxSum = last V0;
);
V0
)
);
maxHFDict#( c - G#d ) = maxHF;
maxV
);
G' = G#d;
F' = F#d;
maxj' = maxj;
--- This is the list of all j values that gave us max V
toList maxHFDict
);
( maxVDict'#0, raveledHFs )
);
--------------------------------------------------------------------------------
--- End Simplified Some
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- Simplified Method returning all hilbert Functions
--------------------------------------------------------------------------------
SimplifiedAll = ( G, F, g, f, V, lowerBound ) -> (
maxVDict' := { { V#0#0 } };
G' := 0;
F' := 0;
maxj' := { 0 };
raveledHFs := for d to #G - 1 list (
maxj := new MutableList from G#d .. F#d;
maxHFDict := new MutableList from G#d .. F#d;
--- Instead of being a vectors, maxVDict#c is a list of vectors.
maxVDict' = for c from G#d to F#d list (
--- maxVHF will be the collection of all V and HF that are maximal.
--- The keys of the table are the maximal values of V.
--- The values of each key are the j's that give that value of V.
maxVHF := new MutableHashTable;
for j from max( g#d, c - F' ) to min( f#d, c - G' )
when maxj'#( c - j - G' ) >= lowerBound#d#( j - g#d )
do (
maxj#( c - G#d ) = j;
--- Instead of being a vectors, maxVDict'#c' is a list of vectors.
for maxV' in maxVDict'#( c - j - G' ) do (
V0 := maxV' + V#d#( j - g#d );
if maxVHF#?V0 then (
--- In the case where V0 is already in maxVHF, add j to it's key.
maxVHF#V0 = append( maxVHF#V0, j );
) else if false =!= ( --- If max Vdiff <= 0 below is never true...
for V1 in keys maxVHF do (
Vdiff := V0 - V1;
--- If V0 is greater than V1, remove V1.
if min Vdiff >= 0 then remove( maxVHF, V1 )
--- If V0 is less than V1, break and do nothing.
else if max Vdiff <= 0 then break false
)
) then (
--- In the case where V0 is not less than any V1, add it to maxVHF.
maxVHF#V0 = { j };
)
)
);
--- We want to make maxHFDict simply a list of possible j values.
maxHFDict#( c - G#d ) = unique flatten values maxVHF;
--- maxVDict#c is a list the vectors stored in the keys of maxVHF
keys maxVHF
);
G' = G#d;
F' = F#d;
maxj' = maxj;
toList maxHFDict
);
( maxVDict'#0, raveledHFs )
);
--------------------------------------------------------------------------------
--- End Simplified All
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- Complete Method returning no hilbert Functions
--------------------------------------------------------------------------------
--- Notationally: putting a ' (prime) on a variable indicates that it is the
--- value of the variable in the previous degree.
--- Also: i is shorthand for j-g and b is shorthand for c-G, as indicated above
--- the method SimplifiedNone
--- The "dictionary" entry is thus
--- Dict#b#i instead of (d,c,j) and
--- Dict'#b'#i' instead of (d-1,c',j')
CompleteNone = ( G, F, g, f, V, lowerBound ) -> (
maxVDict' := { { V#0#0 } };
G' := 0;
g' := 0;
for d to #G - 1 do (
--- Each iteration of the following is a list of the maxV values for each j.
maxVDict' = for c from G#d to F#d list (
maxV := null;
--- We have to traverse the list in reverse order.
reverse for j in reverse( g#d .. min( f#d, c - G' ) ) list (
b' := c - j - G';
i := j - g#d;
i' := max( lowerBound#d#i - g', 0 );
if maxVDict'#?b' and maxVDict'#b'#?i' then (
V0 := maxVDict'#b'#i' + V#d#i;
if maxV === null then (
maxV = V0
) else (
Vdiff := V0 - maxV;
if min Vdiff >= 0 then (
maxV = V0
) else if max Vdiff > 0 then (
maxV = max \ transpose{ maxV, V0 }
)
)
);
--- If this value of j is impossible, we simply won't save it.
--- This won't mess up indexing because it can only happen in the
--- beginnin iterations, and we reverse the list after.
if maxV === null then continue;
--- The main difference from SimplifiedNone is that we need to save this
--- value for each j so that we can use it in the next degree
--- as a result, the loops cannot be written as compactly.
maxV
)
--- We return a list of the maxV values for each j.
);
G' = G#d;
g' = g#d;
);
maxVDict'#0#0
);
--------------------------------------------------------------------------------
--- End Complete None
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- Complete Method returning all hilbert functions with max betti sum
--------------------------------------------------------------------------------
--- This is a combination of CompleteNone and SimplifiedSome.
--- The primary difference is that the "raveled" result in each degree must be
--- a list where each entry corresponds to a c value, which in turn is a list
--- of the possible j values that give maxV for that c and d. So, it is a
--- list of lists of lists. This "raveled" result can be unraveled with the
--- UnravelComplete methods.
CompleteSome = ( G, F, g, f, V, lowerBound ) -> (
maxVDict' := { { V#0#0 } };
G' := 0;
g' := 0;
raveledHFs := for d to #G - 1 list (
maxHFDict := new MutableList from G#d .. F#d;
maxVDict' = for c from G#d to F#d list (
maxV := null;
maxHF := { };
--- In this case, we need to collect both the maxV and the maxHF.
--- The easiest way is to do it at the same time, and then just split it
--- up later.
maxVHFList := reverse for j in reverse( g#d .. min( f#d, c - G' ) ) list (
b' := c - j - G';
i := j - g#d;
i' := max( lowerBound#d#i - g', 0 );
--- We need to check that this is actually a valid value of j that has
--- any valid functions in the previous degree
if maxVDict'#?b' and maxVDict'#b'#?i' then (
V0 := maxVDict'#b'#i' + V#d#i;
if maxV === null then (
maxHF = { j };
maxV = V0;
) else (
if last V0 === last maxV then (
maxHF = append( maxHF, j );
) else if last V0 > last maxV then (
maxHF = { j };
);
Vdiff := V0 - maxV;
if min Vdiff >= 0 then (
maxV = V0
) else if max Vdiff > 0 then (
maxV = max \ transpose{ maxV, V0 }
)
);
);
if maxV === null then continue;
( maxV, maxHF )
);
--- Here we just split up the list so that maxV and maxHF are separate.
maxHFDict#( c - G#d ) = maxVHFList / last;
maxVHFList / first
);
G' = G#d;
g' = g#d;
toList maxHFDict
);
( maxVDict'#0#0, raveledHFs )
);
--------------------------------------------------------------------------------
--- End Complete Some
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- Complete Method returning all hilbert Functions
--------------------------------------------------------------------------------
--- This is by far the most complex version. However, there are no new ideas,
--- it is simply a combination of the techniques in CompleteSome and
--- SimplifiedAll.
CompleteAll = ( G, F, g, f, V, lowerBound ) -> (
maxVDict' := { { { V#0#0 } } };
G' := 0;
g' := 0;
raveledHFs := for d to #G - 1 list (
maxHFDict := new MutableList from G#d .. F#d;
maxVDict' = for c from G#d to F#d list (
maxVHF := new MutableHashTable;
maxVHFList := reverse for j in reverse( g#d .. min( f#d, c - G' ) ) list (
b' := c - j - G';
i := j - g#d;
i' := max( lowerBound#d#i - g', 0 );
if maxVDict'#?b' and maxVDict'#b'#?i' then (
for maxV' in maxVDict'#b'#i' do (
V0 := maxV' + V#d#i;
if maxVHF#?V0 then (
maxVHF#V0 = append( maxVHF#V0, j );
) else if false =!= (
for V1 in keys maxVHF do (
Vdiff := V0 - V1;
if min Vdiff >= 0 then remove( maxVHF, V1 )
else if max Vdiff <= 0 then break false
)
) then (
maxVHF#V0 = { j }
)
)
);
if #maxVHF === 0 then continue;
( keys maxVHF, unique flatten values maxVHF )
);
maxHFDict#( c - G#d ) = maxVHFList / last;
maxVHFList / first
);
G' = G#d;
g' = g#d;
toList maxHFDict
);
( maxVDict'#0#0, raveledHFs )
);
--------------------------------------------------------------------------------
--- End Complete All
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- End of the main algorithm code ---------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- functions for extracting hilbert function from the algorithm's return value
--------------------------------------------------------------------------------
--- This method unravels a single hilbert function from the raveled result
--- returned from the Simplified algorithm.
UnravelSimplifiedOne = ( HFs, G, g, lowerBound ) -> (
targetSum := last G;
lowerBound' := 0;
result := { };
for d in reverse( 0 .. #HFs - 1 ) do (
--- In this version, we take the minimum hilbert function at this degree.
--- This is guarenteed to give a valid result in the Simplified case.
--- (In the Complete case, it gives a valid result because only valid
--- results are stored in raveledHFs.)
hd := min( HFs#d#( targetSum - G#d ) );
targetSum = targetSum - hd;
result = (
--- We don't really start saving the hilbert function until the Macaulay
--- bound is a strict inequality.
if ( #result === 1 and lowerBound' === hd ) then { hd }
else prepend( hd, result )
);
lowerBound' = lowerBound#d#( hd - g#d );
);
{ result }
);
--- This is essentially the same as UnravelSimplifiedOne. The only difference is
--- that we track all possible triples (targetSum, lowerBound', result).
--- The list of these is kept in partialUnraveled, which is looped over for
--- each degree. Additionally, all possible values for the hilbert function
--- are considered, and not simply the minimum.
UnravelSimplifiedHFs = ( HFs, G, g, lowerBound ) -> (
partialUnraveled := { ( last G, 0, { } ) };
for d in reverse( 0 .. #HFs - 1 ) do (
partialUnraveled = flatten for tlr in partialUnraveled list (
( targetSum, lowerBound', result ) := tlr;
if targetSum < G#d then continue;
for hd in HFs#d#( targetSum - G#d ) list (
if hd < lowerBound' then continue;
(
targetSum - hd,
lowerBound#d#( hd - g#d ),
if ( #result === 1 and lowerBound' === hd ) then { hd }
else prepend( hd, result )
)
)
)
);
partialUnraveled / last
);
--- In this Complete case, this gives a valid result because only valid results
--- are stored in raveledHFs, since we have the extra "k" index.
--- The only difference from UnravelSimplifiedOne is the lowerBound' - g#d index
UnravelCompleteOne = ( HFs, G, g, lowerBound ) -> (
targetSum := last G;
lowerBound' := 0;
result := { };
for d in reverse( 0 .. #HFs - 1 ) do (
--- The only difference from UnravelSimplifiedOne is the lowerBound' - g#d
hd := min( HFs#d#( targetSum - G#d )#( lowerBound' - g#d ) );
( targetSum, lowerBound', result ) =
(
targetSum - hd,
lowerBound#d#( hd - g#d ),
if ( #result === 1 and lowerBound' === hd ) then { hd }
else prepend( hd, result )
)
);
{ result }
);
--- The only difference from UnravelSimplifiedHFs is the lowerBound' - g#d index
UnravelCompleteHFs = ( HFs, G, g, lowerBound ) -> (
partialUnraveled := { ( last G, 0, { } ) };
for d in reverse( 0 .. #HFs - 1 ) do (
partialUnraveled = flatten for tlr in partialUnraveled list (
( targetSum, lowerBound', result ) := tlr;
if targetSum < G#d then continue;
--- The only difference from UnravelSimplifiedHFs is the lowerBound' - g#d
for hd in HFs#d#( targetSum - G#d )#( max( lowerBound' - g#d, 0 ) ) list (
if hd < lowerBound' then continue;
(
targetSum - hd,
lowerBound#d#( hd - g#d ),
if ( #result === 1 and lowerBound' === hd ) then { hd }
else prepend( hd, result )
)
)
)
);
partialUnraveled / last
);
--------------------------------------------------------------------------------
--- End unravel functions
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--- auxillary methods
--------------------------------------------------------------------------------
--- This is an efficient way of computing the betti numbers of a lexsegment
--- Instead of computing the actual ideal, we loop through each degree and
--- use the max index of the monomial
--- once we have enough monomials in that degree, we move up to the next
--- degree
--- The returned values are the sums of the binomial coefficients of the
--- generators in each degree. They are exactly the values in the
--- Eliahou-Kervaire resolution.
lexBettiArray = ( h, n ) -> (
b := for i to n list for q to n list binomial( i, q );
zeroList := for i to n list 0;
if not h#?0 then return { zeroList } else if h#0 === 0 then return { b#0 };
if h#0 > 1 or min h < 0 then error( "Not a valid Hilbert function." );
( rep, firstNonzeroIndex, firstNonzeroValue ) :=
( { n + 1 }, 0, n + 1 );
for d to #h - 1 list if d === 0 then zeroList else (
upperBound := sum for i to #rep - 1 list binomial( rep#i + i, i + 1 );
if h#d > upperBound then error( "Not a valid Hilbert function." );
s := zeroList;
for l from h#d to upperBound - 1 do (
s = s + b#( n + 1 - firstNonzeroValue );
( rep, firstNonzeroIndex, firstNonzeroValue ) =
decrementRep( rep, firstNonzeroIndex, firstNonzeroValue );
);
s
) do if d =!= 0 then (
--- move rep up one degree
rep = prepend( 0, rep );
firstNonzeroIndex = firstNonzeroIndex + 1
--- end move rep degree
)
);
--- Note: n is one less than the number of variables.
--- Additionally, S can have many more variables than we need. We only use the
--- first n+1 variables.
--- This is exactly the same algorithm as lexBettiArray, however, we generate
--- the monomials themselves instead of just the binomial coefficients of the
--- max index.
createLexIdeal = ( S, h, n ) -> (
if not h#?0 then return ideal 0_S else if h#0 === 0 then return ideal 1_S;
if h#0 > 1 or min h < 0 then error( "Not a valid Hilbert function." );
( rep, firstNonzeroIndex, firstNonzeroValue ) :=
( { n + 1 }, 0, n + 1 );
gs := flatten for d to #h - 1 list if d === 0 then { } else (
upperBound := sum for i to #rep - 1 list binomial( rep#i + i, i + 1 );
if h#d > upperBound then error( "Not a valid Hilbert function." );
for l from h#d to upperBound - 1 list (
product for i to d - 1 list S_(
n + 1 - (
if rep#i === 0 then firstNonzeroValue
else if i === 0 or rep#( i - 1 ) === 0 then rep#i
else rep#i + 1
)
)
) do (
( rep, firstNonzeroIndex, firstNonzeroValue ) =
decrementRep( rep, firstNonzeroIndex, firstNonzeroValue )
)
) do if d =!= 0 then (
--- move rep up one degree
rep = prepend( 0, rep );
firstNonzeroIndex = firstNonzeroIndex + 1
--- end move rep degree
);