1#  Copyright (c) 1997-2021
2#  Ewgenij Gawrilow, Michael Joswig, and the polymake team
3#  Technische Universität Berlin, Germany
4#  https://polymake.org
5#
6#  This program is free software; you can redistribute it and/or modify it
7#  under the terms of the GNU General Public License as published by the
8#  Free Software Foundation; either version 2, or (at your option) any
9#  later version: http://www.gnu.org/licenses/gpl.txt.
10#
11#  This program is distributed in the hope that it will be useful,
12#  but WITHOUT ANY WARRANTY; without even the implied warranty of
13#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14#  GNU General Public License for more details.
15#-------------------------------------------------------------------------------
16
17# @Category Combinatorics
18object Patchwork {
19
20  # Sign distribution on the support of the [[POLYNOMIAL]].
21  # Indices correspond to row indices of [[MONOMIALS]].
22  property SIGNS : Array<Bool>;
23
24  # Facets of the real part of the patchworked hypersurface.
25  # Row indices correspond to orthants (ordered lexicographically),
26  # column indices correspond to facets of the original hypersurface.
27  # This is the transpose of [[REAL_PHASE]].
28  property REAL_FACETS : IncidenceMatrix<NonSymmetric>;
29
30  # Real phase structure of the patchworked hypersurface.
31  # Row indices correspond to facets of the original hypersurface,
32  # column indices correspond to orthants (ordered lexicographically).
33  # I.e., a copy of facet i appears in orthant j,
34  # iff the j-th entry in the i-th row is 1.
35  # This is the transpose of [[REAL_FACETS]].
36  # @example
37  # > $h = new tropical::Hypersurface<Max>(MONOMIALS=>unit_matrix(3),COEFFICIENTS=>ones_vector(3));
38  # > $p = $h->PATCHWORK(SIGNS=>[0,1,0]);
39  # > print $p->REAL_PHASE;
40  # | {0 2}
41  # | {2 3}
42  # | {0 3}
43  # > $p->realize->VISUAL;
44  property REAL_PHASE : IncidenceMatrix<NonSymmetric>;
45
46  permutation TermPerm : PermBase;
47
48  permutation ConesPerm : PermBase;
49
50  rule SIGNS : TermPerm.SIGNS, TermPerm.PERMUTATION {
51    $this->SIGNS=permuted($this->TermPerm->SIGNS, $this->TermPerm->PERMUTATION);
52  }
53  # weight 1.10;
54
55  rule REAL_FACETS : ConesPerm.REAL_FACETS, ConesPerm.PERMUTATION {
56    $this->REAL_FACETS=permuted_cols($this->ConesPerm->REAL_FACETS, $this->ConesPerm->PERMUTATION);
57  }
58  # weight 1.10;
59
60  rule REAL_PHASE : ConesPerm.REAL_PHASE, ConesPerm.PERMUTATION {
61    $this->REAL_PHASE=permuted_rows($this->ConesPerm->REAL_PHASE, $this->ConesPerm->PERMUTATION);
62  }
63  # weight 1.10;
64
65  # The real part of the patchworked hypersurface,
66  # realized as a polyhedral hypersurface in IR^dim.
67  # The vertices of each of the 2^dim copies of the hypersurface
68  # will be moved to the interior of the respective orthant
69  # (according to method), and relevant unbounded facets will be joined.
70  # If method is "rigid" (default), vertices will be translated to the positive orthant,
71  # and then reflected to their corresponding orthant.
72  # If method is "uniform", vertices will be moved to the barycenter
73  # of the respective dual cell in the dual subdivision of the support,
74  # and then reflected to their corresponding orthant
75  # (this only works if the hypersurface is simplicial, e.g. for curves).
76  # @param String method "rigid" (default) or "uniform"
77  # @return fan::PolyhedralComplex<Rational>
78  # @example Visualize a patchworked plane:
79  # > $h1 = new tropical::Hypersurface<Max>(POLYNOMIAL=>toTropicalPolynomial("max(a,b,c,d)"));
80  # > $p1 = $h1->PATCHWORK(SIGNS=>[1,0,1,0]);
81  # > $p1->realize->VISUAL;
82  # @example A "nice" visualization for a curve:
83  # > $h2 = harnack_curve(3);
84  # > $p2 = $h2->PATCHWORK;
85  # > $p2->realize("uniform")->VISUAL;
86  user_method realize(;String = "rigid") : REAL_FACETS {
87    my ($this, $method) = @_;
88    return real_part_realize($this->parent->MONOMIALS, $this->parent->COEFFICIENTS, $this->parent->VERTICES, $this->parent->MAXIMAL_POLYTOPES, $this->parent->FAR_VERTICES, $this->REAL_FACETS, $method);
89  }
90
91  # The cellular chain complex with Z_2 coefficients
92  # of the patchworked hypersurface.
93  # The d-th entry represents the d-th boundary matrix,
94  # i.e., the one mapping (d+1)-chains to d-chains.
95  # It is computed directly from the dual subdivision,
96  # which means that, instead of a tropical polynomial,
97  # one may initiate the Hypersurface object via its
98  # dual subdivision, which in turn allows this computation
99  # to be carried out on non-regular subdivisions.
100  # @example A patchworked line in the real projective plane is combinatorially a triangle:
101  # > $h = new tropical::Hypersurface<Max>(MONOMIALS=>unit_matrix(3),COEFFICIENTS=>ones_vector(3));
102  # > $p = $h->PATCHWORK(SIGNS=>[0,1,0]);
103  # > $c = $p->CHAIN_COMPLEX_Z2;
104  # > $b = $c->boundary_matrix(1);
105  # > print $b->rows, "x", $b->cols;
106  # | 3x3
107  # > print rank($b);
108  # | 2
109  # @example A non-regular example:
110  # > $points = [[1,4,0,0],[1,0,4,0],[1,0,0,4],[1,2,1,1],[1,1,2,1],[1,1,1,2]];
111  # > $cells = [[0,1,3],[0,2,5],[0,3,5],[1,2,4],[1,3,4],[2,4,5],[3,4,5]];
112  # > $moae = new fan::SubdivisionOfPoints(POINTS=>$points, MAXIMAL_CELLS=>$cells);
113  # > $h = new Hypersurface<Min>(DUAL_SUBDIVISION=>$moae);
114  # > $p = $h->PATCHWORK(SIGNS=>[0,0,0,0,0,0]);
115  # > print $p->CHAIN_COMPLEX_Z2->type->full_name;
116  # | ChainComplex<SparseMatrix<GF2, NonSymmetric>>
117  property CHAIN_COMPLEX_Z2 : topaz::ChainComplex<SparseMatrix<GF2>>;
118
119  # The Z_2 Betti numbers of the patchworked hypersurface.
120  # See the documentation of CHAIN_COMPLEX_Z2 for details.
121  # @example A patchworked hyperplane in n-dimensional real projective space
122  # is topologically the (n-1)-dimensional real projective space:
123  # > $h = new tropical::Hypersurface<Max>(POLYNOMIAL=>toTropicalPolynomial("max(a,b,c,d,e,f)"));
124  # > $p = $h->PATCHWORK(SIGNS=>[0,0,0,0,0,0]);
125  # > print $p->BETTI_NUMBERS_Z2;
126  # | 1 1 1 1 1
127  property BETTI_NUMBERS_Z2 : Array<Int>;
128
129}
130
131object Hypersurface {
132
133# property GENERIC : Bool;
134
135# @Category Combinatorics
136# This encodes a patchworking structure on a tropical hypersurface.
137# Its lone input property is [[SIGNS]] - a sign distribution on the vertices
138# of the induced regular subdivision of the corresponding Newton polytope.
139# As it is a multiple subobject, you can create multiple patchworking structures
140# (for different sign distributions) on the same tropical hypersurface object.
141# @example
142# > $h = new tropical::Hypersurface<Max>(POLYNOMIAL=>toTropicalPolynomial("max(a,b,c)"));
143# > $p1 = $h->PATCHWORK(SIGNS=>[0,1,0]);
144# > $p2 = $h->PATCHWORK(SIGNS=>[1,1,1]);
145property PATCHWORK : Patchwork : multiple;
146
147rule PATCHWORK.REAL_FACETS : PATCHWORK.SIGNS, MONOMIALS, COEFFICIENTS, VERTICES, MAXIMAL_POLYTOPES {
148  if ($this->MONOMIALS->rows() != $this->PATCHWORK->SIGNS->size()) {
149    die "Error: dimension mismatch between signs and monomials";
150  }
151  $this->PATCHWORK->REAL_FACETS = real_facets($this->PATCHWORK->SIGNS, $this->MONOMIALS, $this->COEFFICIENTS, $this->VERTICES, $this->MAXIMAL_POLYTOPES);
152}
153weight 5.05;
154
155rule PATCHWORK.REAL_FACETS : PATCHWORK.REAL_PHASE {
156  $this->PATCHWORK->REAL_FACETS = transpose($this->PATCHWORK->REAL_PHASE);
157}
158
159rule PATCHWORK.REAL_PHASE : PATCHWORK.SIGNS, MONOMIALS, COEFFICIENTS, VERTICES, MAXIMAL_POLYTOPES {
160  if ($this->MONOMIALS->rows() != $this->PATCHWORK->SIGNS->size()) {
161    die "Error: dimension mismatch between signs and monomials";
162  }
163  $this->PATCHWORK->REAL_PHASE = real_phase($this->PATCHWORK->SIGNS, $this->MONOMIALS, $this->COEFFICIENTS, $this->VERTICES, $this->MAXIMAL_POLYTOPES);
164}
165weight 5.05;
166
167rule PATCHWORK.REAL_PHASE : PATCHWORK.REAL_FACETS {
168  $this->PATCHWORK->REAL_PHASE = transpose($this->PATCHWORK->REAL_FACETS);
169}
170
171rule PATCHWORK.CHAIN_COMPLEX_Z2 : PATCHWORK.SIGNS, DUAL_SUBDIVISION.POLYHEDRAL_COMPLEX.VERTICES, DUAL_SUBDIVISION.POLYHEDRAL_COMPLEX.HASSE_DIAGRAM {
172  # $this->PATCHWORK->CHAIN_COMPLEX_Z2 = new topaz::ChainComplex<SparseMatrix<GF2>>(chain_complex_from_dualsub($this,$this->PATCHWORK->SIGNS));
173  my $cc = chain_complex_from_dualsub($this->PATCHWORK->SIGNS, $this->DUAL_SUBDIVISION->POLYHEDRAL_COMPLEX->HASSE_DIAGRAM, $this->DUAL_SUBDIVISION->POLYHEDRAL_COMPLEX->VERTICES);
174  $this->PATCHWORK->CHAIN_COMPLEX_Z2 = new topaz::ChainComplex<SparseMatrix<GF2>>($cc);
175  # $this->PATCHWORK->CHAIN_COMPLEX_Z2 = new topaz::ChainComplex<SparseMatrix<GF2>>(chain_complex_from_dualsub($this->PATCHWORK->SIGNS, $this->DUAL_SUBDIVISION->POLYHEDRAL_COMPLEX->HASSE_DIAGRAM, $this->DUAL_SUBDIVISION->POLYHEDRAL_COMPLEX->VERTICES));
176}
177weight 5.10;
178
179rule PATCHWORK.BETTI_NUMBERS_Z2 : PATCHWORK.CHAIN_COMPLEX_Z2 {
180  $this->PATCHWORK->BETTI_NUMBERS_Z2 = topaz::betti_numbers<GF2>($this->PATCHWORK->CHAIN_COMPLEX_Z2);
181}
182
183rule PATCHWORK.TermPerm.PERMUTATION = TermPerm.PERMUTATION;
184
185rule PATCHWORK.ConesPerm.PERMUTATION = ConesPerm.PERMUTATION;
186
187}
188
189### examples:
190
191# This returns a Hypersurface object, and a unique attached [[PATCHWORK]] property
192# which represents an M-curve of given degree with Harnack's configuration.
193# @param Int d the degree of the curve
194# @return tropical::Hypersurface<Min>
195# @example Create a Harnack curve of degree 6:
196# > $h = harnack_curve(6);
197# > $p = $h->PATCHWORK;
198# > print $p->BETTI_NUMBERS_Z2;
199# | 11 11
200# > $p->realize("uniform")->VISUAL;
201user_function harnack_curve( Int ) {
202  my $n = shift;
203  my @monoms;
204  my @weights;
205  my @signs;
206  foreach my $i (0 .. $n) {
207    foreach my $j (0 .. $n-$i) {
208      push @weights, ($i*$j+$i*$i+$j*$j);
209      push @monoms, [$n-$i-$j, $i, $j];
210      push @signs, ($i*$j+$i+$j)%2;
211    }
212  }
213
214  my $m = new Matrix<Int>(\@monoms);
215  my $c = new Vector<TropicalNumber<Min>>(\@weights);
216  my $s = new Array<Bool>(\@signs);
217  my $h = new Hypersurface<Min>(MONOMIALS=>$m, COEFFICIENTS=>$c);
218  $h->PATCHWORK(SIGNS=>$s);
219  return $h;
220}
221
222# This returns a Hypersurface object, and a unique attached [[PATCHWORK]] property
223# which represents an M-curve of degree 6 with Gudkov's configuration.
224# @return tropical::Hypersurface<Min>
225# @example
226# > $h = gudkov_curve;
227# > $p = $h->PATCHWORK;
228# > print $p->BETTI_NUMBERS_Z2;
229# | 11 11
230# > $p->realize("uniform")->VISUAL;
231user_function gudkov_curve {
232  my @monoms;
233  my $n = 6;
234  foreach my $i (0 .. $n) {
235    foreach my $j (0 .. $n-$i) {
236      push @monoms, [$n-$i-$j, $i, $j];
237    }
238  }
239  my $signs = [
240    1, 0, 0, 0, 0, 0, 1,
241    0, 0, 1, 0, 1, 0,
242    1, 0, 1, 0, 0,
243    0, 0, 0, 0,
244    1, 0, 1,
245    0, 0,
246    1
247  ];
248  my $weights = [
249    0,   0,   66,  156, 252, 369, 507,
250    0,   6,   23,  95,  200, 332,
251    66,  23,  24,  61,  178,
252    156, 95,  61,  45,
253    252, 200, 178,
254    369, 332,
255    507
256  ];
257  my $m = new Matrix<Int>(\@monoms);
258  my $c = new Vector<TropicalNumber<Min>>($weights);
259  my $s = new Array<Bool>($signs);
260  my $h = new Hypersurface<Min>(MONOMIALS=>$m, COEFFICIENTS=>$c);
261  $h->PATCHWORK(SIGNS=>$s);
262  return $h;
263}
264
265# This returns a Hypersurface object, and a unique attached [[PATCHWORK]] property
266# which represents a curve of degree 10 that is a counterexample
267# to Ragsdale's conjecture.
268# @return tropical::Hypersurface<Min>
269# @example
270# > $h = ragsdale_counterexample;
271# > $p = $h->PATCHWORK;
272# > $p->realize("uniform")->VISUAL;
273user_function ragsdale_counterexample {
274  my @monoms;
275  foreach my $i (0 .. 10) {
276    foreach my $j (0 .. 10-$i) {
277      push @monoms, [10-$i-$j, $i, $j];
278    }
279  }
280  my $weights = [ # yes these were done by hand
281    224, 142, 76,  12,  76, 142, 224, 311, 401, 494, 600,
282    144, 58,  22,  6,   22, 58,  144, 232, 324, 419,
283    66,  34,  10,  2,   10, 34,  66,  156, 250,
284    48,  18,  2,   0,   2,  18,  48,  140,
285    66,  34,  10,  2,   10, 34,  68,
286    144, 58,  22,  6,   22, 55,
287    224, 142, 76,  12,  44,
288    310, 232, 167, 104,
289    402, 326, 262,
290    498, 424,
291    600
292  ];
293  my $signs = [
294    1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1,
295    0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
296    1, 0, 0, 0, 0, 0, 1, 0, 1,
297    0, 0, 1, 1, 1, 0, 0, 0,
298    1, 0, 0, 0, 0, 0, 1,
299    0, 0, 0, 1, 0, 0,
300    1, 0, 1, 0, 1,
301    0, 0, 0, 0,
302    1, 0, 1,
303    0, 0,
304    1
305  ];
306
307  my $m = new Matrix<Int>(\@monoms);
308  my $c = new Vector<TropicalNumber<Min>>($weights);
309  my $s = new Array<Bool>($signs);
310  my $h = new Hypersurface<Min>(MONOMIALS=>$m, COEFFICIENTS=>$c);
311  $h->PATCHWORK(SIGNS=>$s);
312  return $h;
313}
314
315# Local Variables:
316# mode: perl
317# cperl-indent-level:3
318# indent-tabs-mode:nil
319# End:
320