/
PHCpack.m2
1457 lines (1301 loc) · 50.9 KB
/
PHCpack.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
newPackage(
"PHCpack",
Version => "1.6",
Date => "6 May 2013",
Authors => {
{Name => "Elizabeth Gross",
Email => "egross7@uic.edu",
HomePage => "http://www.math.uic.edu/~lizgross"},
{Name => "Sonja Petrovic",
Email => "Sonja.Petrovic@iit.edu",
HomePage => "http://mypages.iit.edu/~spetrov1/"},
{Name => "Jan Verschelde",
Email => "jan@math.uic.edu",
HomePage => "http://www.math.uic.edu/~jan"},
{Name => "Contributing Author: Anton Leykin",
HomePage => "http://www.math.gatech.edu/~leykin"}
},
Headline => "Interface to PHCpack",
Configuration => {
"path" => "",
"PHCexe"=>"phc",
"keep files" => true
},
DebuggingMode => false,
AuxiliaryFiles => true,
CacheExampleOutput => true,
PackageImports => {"SimpleDoc"},
PackageExports => {"NAGtypes"}
)
--Copyright 2013 Elizabeth Gross, Sonja Petrovic, Jan Verschelde.
-- You may redistribute this file under the terms of the GNU General
-- Public License as published by the Free Software Foundation,
-- either version 2 of the License, or any later version.
export {
"cascade",
"constructEmbedding",
"gamma",
"factorWitnessSet",
"isCoordinateZero",
"isWitnessSetMember",
"mixedVolume",
"nonZeroFilter",
"numericalIrreducibleDecomposition",
"refineSolutions",
"solveRationalSystem",
"solveSystem",
"StableMixedVolume",
"StartDimension",
"StartSystem",
"tDegree",
"toLaurentPolynomial",
"topWitnessSet",
"trackPaths",
"zeroFilter"
}
protect ErrorTolerance, protect Iterations,
protect Bits, protect ResidualTolerance,
protect Append
--##########################################################################--
-- GLOBAL VARIABLES
--##########################################################################--
DBG = 0; -- debug level (10=keep temp files)
path'PHC = (options PHCpack).Configuration#"path";
PHCexe=path'PHC|(options PHCpack).Configuration#"PHCexe";
-- this is the executable string that make sures that calls to PHCpack run:
-- NOTE: the absolute path should be put into the init-PHCpack.m2 file
--##########################################################################--
-- INTERNAL METHODS
--##########################################################################--
----------------------------------
-- NumericalVariety
----------------------------------
--the following defines the type NumericalVariety
--if the user is using an old version of NAGtypes.
if not((class(NumericalVariety))===Type) then
(--export {generalEquations, "IsIrreducible"};
--protect generalEquations;
protect IsIrreducible;
NumericalVariety = new Type of MutableHashTable;
NumericalVariety.synonym = "numerical variety";
dim NumericalVariety := V -> max select(keys V, k->class k === ZZ);
degree NumericalVariety := V -> (
d := dim V;
sum(keys V, k->if k =!= d then 0 else sum(V#k,degree))
);
numericalVariety = method(TypicalValue=>NumericalVariety);
numericalVariety List := Ws -> (
V := new NumericalVariety;
scan(Ws, W->(
d := dim W;
if V#?d then V#d = V#d | {W} else V#d = {W};
));
check V;
V
);
check NumericalVariety := o-> V -> (
if any(keys V, k->(class k =!= ZZ or k<0))
then error "the keys of a NumericalVariety should be nonnegative integers";
scan(keys V, k->if class k === ZZ then scan(V#k, W->(
if dim W != k then
error "dimension of a witness set does not match the key in NumericalVariety";
)));
);
net NumericalVariety := V -> (
out := "A variety of dimension " | net dim V |" with components in";
scan(keys V, k->if class k === ZZ then (
row := "dim "|net k|": ";
scan(V#k, W->row = row|" "|net W);
out = out || row;
));
out
)
)
----------------------------------
--- File read/write operations ---
----------------------------------
getFilename = () -> (
filename := temporaryFileName();
while fileExists(filename)
or fileExists(filename|"PHCinput")
or fileExists(filename|"PHCoutput") do filename = temporaryFileName();
filename
)
parseSolutions = method(TypicalValue => Sequence, Options => {Bits => 53})
parseSolutions (String,Ring) := o -> (s,R) -> (
-- parses solutions in PHCpack format
-- IN: s = string of solutions in PHCmaple format
-- V = list of variable names
-- OUT: List of solutions, each of type Point,
-- carrying also other diagnostic information about each.
oldprec := defaultPrecision;
defaultPrecision = o.Bits;
L := get s;
L = replace("=", "=>", L);
L = replace("I", "ii", L);
L = replace("E\\+","e",L);
L = replace("E", "e", L);
L = replace("time", "\"time\"", L);
L = replace("rco", "\"rco\"", L);
L = replace("multiplicity", "\"mult\"", L);
L = replace("\\bres\\b", "\"residual\"", L);
L = replace("\\bresolution\\b", "\"residual\"", L);
-- because M2 automatically thinks "res"=resolution
sols := toList apply(value L, sol->new HashTable from toList sol);
defaultPrecision = oldprec;
apply(sols, sol->point( {apply(gens R, v->sol#v)} | outputToPoint sol ))
)
pointsToFile = method(TypicalValue => Nothing, Options => {Append => false})
pointsToFile (List,Ring,String) := o -> (S,R,name) -> (
-- writes list of points to file in PHCpack format
-- IN: S, list of points, e.g.: obtained as points(WitnessSet);
-- R, ring (with symbols for the variables);
-- name, string with file name.
file := if o.Append then openOutAppend name else openOut name;
if o.Append then
file << endl << "THE SOLUTIONS :" << endl;
file << #S << " " << numgens R << endl <<
"===========================================================" << endl;
scan(#S, i->(
file << "solution " << i+1 << " :" << endl <<
"t : 0.00000000000000E+00 0.00000000000000E+00" << endl <<
"m : 1" << endl <<
"the solution for t :" << endl;
scan(numgens R, v->(
L := " "|toString R_v|" : "|
format(0,-1,9,9,realPart toCC S#i#v)|" "|
format(0,-1,9,9,imaginaryPart toCC S#i#v);
file << L << endl;
));
file << "== err : 0 = rco : 1 = res : 0 ==" << endl;
));
close file;
)
solutionsToFile = method(TypicalValue => Nothing, Options => {Append => false})
solutionsToFile (List,Ring,String) := o -> (S,R,name) -> (
-- writes solutions to file in PHCpack format
-- IN: S, list of solutions;
-- R, ring (with symbols for the variables);
-- name, string with file name.
file := if o.Append then openOutAppend name else openOut name;
if o.Append then
file << endl << "THE SOLUTIONS :" << endl;
file << #S << " " << numgens R << endl <<
"===========================================================" << endl;
scan(#S, i->(
file << "solution " << i << " :" << endl <<
"t : 0.00000000000000E+00 0.00000000000000E+00" << endl <<
"m : 1" << endl <<
"the solution for t :" << endl;
scan(numgens R, v->(
L := " "|toString R_v|" : "|
format(0,-1,9,9,realPart toCC S#i#Coordinates#v)|" "|
format(0,-1,9,9,imaginaryPart toCC S#i#Coordinates#v);
file << L << endl;
));
file << "== err : 0 = rco : 1 = res : 0 ==" << endl;
));
close file;
)
startSystemFromFile = method(TypicalValue => List)
startSystemFromFile (String) := (name) -> (
-- IN: file name starting with a random coefficient start system
-- OUT: list of polynomials in a ring with coefficients in CC
-- REQUIRED: the format of the system on file is a random coefficient
-- system produced by phc -m, every term starts on a separate line
-- with the "+" sign. The coefficient field must be CC.
s := get name;
s = replace("i","ii",s);
s = replace("E","e",s);
L := lines(s);
n := value L_0;
result := {};
i := 0; j := 1;
local stop;
local term;
local p;
while i < n do (
stop = false; p = 0;
while not stop do (
if #L_j != 0 then (
-- we have to bite off the first "+" sign of the term
if (L_j_(#L_j-1) != ";") then (
term = value substring(1,#L_j-1,L_j); p = p + term;
) else ( -- in this case (L_j_(#L_j-1) == ";") holds
term = value substring(1,#L_j-2,L_j); p = p + term;
stop = true; result = result | {p}
);
); j = j + 1;
stop = stop or (j >= #L);
);
i = i + 1;
);
result
)
systemFromFile = method(TypicalValue => List)
systemFromFile (String) := (name) -> (
-- IN: file name starting with a polynomial system
-- OUT: list of polynomials in a ring with coefficients in CC
-- NOTE: the format of the system on file may be such that the
-- first term starts with +1*x which cannot be digested by M2.
-- In contrast to the startSystemFromFile, the first term could
-- also be "-1*x" so we must be a bit more careful...
-- Another problem are constants as "3.0e+00", at least on a Mac.
s := get name;
s = replace("i","ii",s);
s = replace("E","e",s);
--s = replace("e+00","",s); -- on Mac: M2 crashes at 3.0e+00 as constant
L := lines(s);
n := value L_0;
result := {};
i := 0; j := 1;
local stop;
local term;
local p;
while i < n do (
stop = false; p = 0;
while not stop do (
if #L_j != 0 then (
if (L_j_(#L_j-1) != ";") then (
-- we have to bite off the first "+" sign of the term
term =
value substring(1,#L_j-1,L_j);
if (L_j_0 == "+") then p = p + term else p = p - term;
) else ( -- in this case (L_j_(#L_j-1) == ";") holds
term = value substring(1,#L_j-2,L_j);
if (L_j_0 == "+") then p = p + term else p = p - term;
stop = true; result = result | {p}
);
); j = j + 1;
stop = stop or (j >= #L);
);
i = i + 1;
);
result
)
systemToFile = method(TypicalValue => Nothing)
systemToFile (List,String) := (F,name) -> (
file := openOut name;
if (#F == numgens ring F#0)
then file << #F << endl
else file << #F << " " << numgens ring F#0 << endl;
scan(F, f->(
L := toExternalString f;
L = replace("ii", "I", L);
L = replace("e", "E", L);
L = replace("p53","",L);
L = replace("p[0-9]+","",L);
file << L << ";" << endl;
));
close file;
)
witnessSetFromFile = method(TypicalValue => WitnessSet)
witnessSetFromFile (String) := (name) -> (
-- IN: file name which contains a witness set in PHCpack format
-- OUT: a witness set
e := systemFromFile(name);
d := dimEmbedding(e);
witnessPointsFile := temporaryFileName() | "PHCwitnessPoints";
if fileExists witnessPointsFile then removeFile witnessPointsFile;
run(PHCexe|" -z " | name | " "|witnessPointsFile);
eR := ring first e;
g := parseSolutions(witnessPointsFile,eR);
w := witnessSet(ideal(take(e,{0,#e-d-1})),ideal(take(e,{#e-d,#e-1})),g);
return w;
)
witnessSetToFile = method()
witnessSetToFile (WitnessSet,String) := (witset,name) -> (
-- IN: name, a file name where to write a witness set to,
-- witset, a witness set.
R := ring ideal(witset);
s := equations(witset)|slice(witset);
p := points(witset);
systemToFile(s,name);
pointsToFile(p,R,name,Append=>true);
)
----------------------------
-- embedding dimension -----
----------------------------
dimEmbedding = method(TypicalValue => ZZ)
dimEmbedding (List) := (system) -> (
-- IN: embedded system with slack variables.
-- OUT: returns the number of slack variables = the dimension.
eR := ring first system;
v := gens eR;
slack := v_(#v-1);
zz := toString(slack);
ds := substring(2,#zz-1,zz);
dimension := if (value(ds)===null) then 0 else value(ds);
return dimension;
)
-----------------------------
--- conversion to Point ---
-----------------------------
outputToPoint = method()
outputToPoint HashTable := (H)->{
SolutionStatus => if H#"mult" == 1 then Regular else Singular,
ConditionNumber => (H#"rco")^(-1),
LastT => H#"time"
}
----------------------------------
----add slack variables-----------
----------------------------------
addSlackVars = method()
addSlackVars WitnessSet := (W) -> (
-- creates a new system of polynomials, in variables:
-- old set of variables, and zz1, ..., zzd, where
-- d is the dimension of W.
R := ring W;
n := numgens R;
d := dim W; -- this will be the number of slack variables to add
W1 := generalEquations W;
-- Add in new variables zz1, ..., zzd,
-- this changes the equations, the slice, and the points
slackvars := apply(d, i->getSymbol("zz"|toString (i+1)));
newR := (coefficientRing R)[gens R, slackvars];
newvars := (vars newR)_{n..n+d-1};
-- new slice:
newSlice := apply(d, i -> sub(W1.Slice#i,newR) + newR_(n + i));
-- add a linear matrix
A := random(newR^(d),newR^(n-d));
AZ := newvars * A;
newEqns := (sub(gens ideal W1, newR) + AZ) | newvars;
-- new points
zeros := toList apply(d, i -> 0_(coefficientRing R));
newPoints := apply(W1.Points, pt -> point({join(coordinates(pt),zeros)}));
witnessSet(ideal newEqns, ideal newSlice, newPoints)
)
-------------------------------------------------------
------------ Witness Superset Filters ---------------
-------------------------------------------------------
witnessSuperSetFilter = method()
witnessSuperSetFilter (WitnessSet,List) := (witset,pts) -> (
-- This is an auxiliary procedure to witnessSuperSetsFilter,
-- applying isWitnessSetMember to filter points in a witness superset.
-- IN: witset, a witness set to represent a witness set;
-- pts, a list of points to be tested for membership.
-- OUT: a list of points in pts for which isWitnessSetMember is false.
result := new MutableList from {};
for p in pts do (
if not isWitnessSetMember(witset,p)
then result = append(result,p);
);
return result;
)
witnessSuperSetsFilter = method()
witnessSuperSetsFilter (MutableList,List) := (witsets,pts) -> (
-- This is an auxiliary procedure to cascade,
-- applying witnessSuperFilter to filter points in the
-- witness supersets given in the list.
-- IN: witsets, a list of tuples (dimension,witness set),
-- pts, a list of points to be tested for membership.
-- OUT: a list of points in pts for which isWitnessSetMember is false.
result := new MutableList from {};
local c;
for p in pts do (
found := false;
if instance(p,Point)
then c = p
else c = point{p};
for w in witsets when (not found) do (
ws := w#1;
found = isWitnessSetMember(ws,c);
);
if not found then result = append(result,p);
);
return toList(result);
)
--##########################################################################--
-- EXPORTED METHODS
--
-- NOTE:
-- trackPaths and refineSolutions are methods adapted
-- from NumericalAlgebraicGEometry/PHCpack.interface.m2
--##########################################################################--
-----------------------------------------------
------------ CASCADE ------------------------
-----------------------------------------------
cascade = method(TypicalValue => NumericalVariety, Options => {StartDimension => -1,Verbose => false})
cascade (List) := o -> (system) -> (
-- IN: system, a polynomial system;
-- dimension, top dimension of the solution set.
-- OUT: a hash table with keys the dimension of each component,
-- values are witness sets for positive dimensions,
-- or a list of isolated solutions for key equal to zero.
if not(class coefficientRing ring ideal system===ComplexField) then
error "coefficient ring is not complex";
R := ring ideal system;
if # system > numgens R then error "the system is overdetermined";
if o.StartDimension==-1 then startdim:=(numgens R)-1
else startdim=o.StartDimension;
PHCinputFile := temporaryFileName() | "PHCinput";
PHCoutputFile := temporaryFileName() | "PHCoutput";
PHCbatchFile := temporaryFileName() | "PHCbatch";
PHCsolsFile := temporaryFileName() | "PHCsols";
PHCsessionFile := temporaryFileName() | "PHCsession";
for f in {PHCinputFile, PHCoutputFile, PHCbatchFile, PHCsolsFile, PHCsessionFile} do if fileExists f then removeFile f;
toList (0..startdim) / (i->if fileExists (PHCoutputFile | "_sw" | i)
then removeFile (PHCoutputFile | "_sw" | i) );
if o.Verbose then
stdio << "writing output to file " << PHCoutputFile << endl;
systemToFile(system,PHCinputFile);
s := concatenate("0\ny\n",PHCinputFile);
s = concatenate(s,"\n",PHCoutputFile);
s = concatenate(s,"\n");
s = concatenate(s,toString(startdim));
s = concatenate(s,"\nn\n");
bat := openOut PHCbatchFile;
bat << s;
close bat;
if o.Verbose then
( stdio << "calling phc -c < " << PHCbatchFile;
stdio << " > " << PHCsessionFile << endl
);
run(PHCexe|" -c < " | PHCbatchFile | " > " | PHCsessionFile);
if o.Verbose then
( stdio << "output of phc -c is in file " << PHCoutputFile << endl;
stdio << "... constructing witness sets ... " << endl
);
local slackvars;
local RwithSlack;
--get solutions
result := new MutableList from {};
dims:=select(toList (0..startdim),j->(fileExists (PHCoutputFile | "_sw" | j) and
match("THE SOLUTIONS",get (PHCoutputFile | "_sw" | j))));
topdimension := max dims;
i := topdimension;
while i>=0 do
( if member(i,dims) then (
fil := (PHCoutputFile | "_sw" | i);
if i > 0 then
(
slackvars = apply(i, k->getSymbol("zz"|toString(k+1)));
RwithSlack = (coefficientRing R)monoid(gens R | slackvars);
use RwithSlack;
supwit := witnessSetFromFile(fil);
if i == topdimension then (
result = append(result,(i,supwit));
) else (
supsols := points(supwit);
genpts := witnessSuperSetsFilter(result,supsols);
g := toList(apply(genpts,x->point{x}));
ws := witnessSet(ideal(equations(supwit)),ideal(slice(supwit)),g);
if #g!=0 then result = append(result,(i,ws));
);
) else (
run(PHCexe | " -z " | fil | " " | PHCsolsFile);
use R;
supwit = witnessSetFromFile(fil);
psols := parseSolutions(PHCsolsFile,R);
isols := witnessSuperSetsFilter(result,psols);
ws = witnessSet(ideal(equations(supwit)),ideal(slice(supwit)),isols);
if #isols!=0 then result = append(result,(0,ws));
);
);
i = i-1
);
use R;
numericalVariety(toList (apply(result,i-> last i)))
)
-----------------------------------------------
-------- CONSTRUCT EMBEDDING ------------------
-----------------------------------------------
constructEmbedding = method(TypicalValue => List,Options => {Verbose => false})
constructEmbedding (List, ZZ) := o-> (system, dimension) -> (
-- IN: system, a polynomial system with complex coefficients;
-- dimension, expected dimension of the solution set.
-- OUT: system with as many random hyperplanes at the end
-- as the value of dimension.
if not(class coefficientRing ring first system===ComplexField) then
error "coefficient ring of system is not complex";
PHCinputFile := temporaryFileName() | "PHCinput";
PHCoutputFile := temporaryFileName() | "PHCoutput";
PHCbatchFile := temporaryFileName() | "PHCbatch";
PHCsessionFile := temporaryFileName() | "PHCsession";
for f in {PHCinputFile, PHCoutputFile, PHCbatchFile, PHCsessionFile} do if fileExists f then removeFile f;
systemToFile(system,PHCinputFile);
s := concatenate("1\ny\n",PHCinputFile);
s = concatenate(s,"\n",PHCoutputFile);
s = concatenate(s,"\n");
s = concatenate(s,toString(dimension));
s = concatenate(s,"\nn\n");
bat := openOut PHCbatchFile;
bat << s;
close bat;
if o.Verbose then
( stdio << "calling phc -c < " << PHCbatchFile;
stdio << " > " << PHCsessionFile << endl
);
run(PHCexe|" -c < " | PHCbatchFile | " > " | PHCsessionFile);
if o.Verbose then
stdio << "output of phc -c is in file " << PHCoutputFile << endl;
-- extending the ring with slack variables
slackvars := apply(dimension, i->getSymbol("zz"|toString(i+1)));
R := ring ideal system;
-- surplus variables are used when the initial system is overconstrained
nv := numgens R;
nq := #system;
nbss := nq - nv;
local RwithSlack;
if (nbss > 0) then (
surplusvars := apply(nbss, i->getSymbol("ss"|toString(i+1)));
RwithSlack = (coefficientRing R)[gens R, surplusvars, slackvars];
) else (
RwithSlack = (coefficientRing R)[gens R, slackvars];
);
use RwithSlack;
return systemFromFile(PHCoutputFile);
)
---------------------------------------------
----------- FACTOR WITNESS SET --------------
---------------------------------------------
factorWitnessSet = method(TypicalValue=>List, Options => {Verbose => false})
factorWitnessSet (WitnessSet ) := o-> w -> (
-- IN: a witness set properly embedded with slack variables.
-- OUT: a list of witness sets, every element is irreducible.
PHCinputFile := temporaryFileName() | "PHCinput";
PHCoutputFile := temporaryFileName() | "PHCoutput";
PHCbatchFile := temporaryFileName() | "PHCbatch";
PHCsessionFile := temporaryFileName() | "PHCsession";
if o.Verbose then
stdio << "preparing input file to " << PHCinputFile << endl;
system := equations(w) | slice(w);
systemToFile(system,PHCinputFile);
R := ring first system;
use R;
L := toList(points(w));
pointsToFile(L,R,PHCinputFile,Append=>true);
if o.Verbose then
stdio << "preparing batch file to " << PHCbatchFile << endl;
s := concatenate("2\n",PHCinputFile); -- option 2 of phc -f
s = concatenate(s,"\n",PHCoutputFile);
s = concatenate(s,"\n1\n"); -- use monodromy to factor
s = concatenate(s,"0\n"); -- default settings of path trackers
bat := openOut PHCbatchFile;
bat << s;
close bat;
if o.Verbose then
stdio << "... calling monodromy breakup ..." << endl;
run(PHCexe|" -f < " | PHCbatchFile | " > " | PHCsessionFile);
if o.Verbose then
(stdio << "session information of phc -f is in " << PHCsessionFile << endl;
stdio << "output of phc -f is in file " << PHCoutputFile << endl
);
-- counting the number of factors
count := 0;
result := new MutableList from {};
name := PHCinputFile | "_f" | toString(count+1);
while (fileExists name) do (
result = append(result,witnessSetFromFile(name));
count = count + 1;
name = PHCinputFile | "_f" | toString(count+1);
);
stdio << "found " << count << " irreducible factors " << endl;
for ws in result do ws#IsIrreducible=true;
return numericalVariety(toList(result));
)
----------------------------
---- IS COORDINATE ZERO ----
----------------------------
isCoordinateZero = method(TypicalValue => Boolean)
isCoordinateZero (Point,ZZ,RR) := (sol,k,tol) -> (
-- IN: sol, a solution of a polynomial system;
-- k, index to a coordinate must be within range;
-- tol, tolerance for the absolute value of the k-th coordinate.
-- OUT: true, if the k-th coordinate has abs less than tol;
-- false, otherwise.
L := sol#Coordinates;
return abs(L_k)<=tol;
)
----------------------------------------------
----------IS WITNESS SET MEMBER -------------
----------------------------------------------
isWitnessSetMember = method(TypicalValue => Boolean, Options => {Verbose => false})
isWitnessSetMember (WitnessSet,Point) := o-> (witset,testpoint) -> (
-- IN: witset, a witness set for a positive dimensional solution set,
-- testpoint, does it belong to the solution set?
-- OUT: true if testpoint is a member of the solution set,
-- false otherwise.
PHCwitnessFile := temporaryFileName() | "PHCwitset";
PHCtestpointFile := temporaryFileName() | "PHCtestpoint";
PHCbatchFile := temporaryFileName() | "PHCbatch";
PHCoutputFile := temporaryFileName() | "PHCoutput";
PHCsessionFile := temporaryFileName() | "PHCsession";
if o.Verbose then
stdio << "writing witness set to file " << PHCwitnessFile << endl;
witnessSetToFile(witset,PHCwitnessFile);
d := dim(witset); -- pad test point with zero values for slack variables
dzeros := toList(apply(0..d,i->0));
L := {coordinates(testpoint)|dzeros};
R := ring ideal(witset);
if o.Verbose then
stdio << "writing test point to file " << PHCtestpointFile << endl;
pointsToFile(L,R,PHCtestpointFile);
s := concatenate("1\n",PHCwitnessFile);
s = concatenate(s,"\n",PHCtestpointFile);
s = concatenate(s,"\n",PHCoutputFile);
s = concatenate(s,"\n0\n");
bat := openOut PHCbatchFile;
bat << s;
close bat;
if o.Verbose then (
stdio << "calling phc -f < " << PHCbatchFile;
stdio << " > " << PHCsessionFile << endl;
);
run(PHCexe|" -f < " | PHCbatchFile | " > " | PHCsessionFile);
if o.Verbose then
stdio << "output of phc -f is in file " << PHCoutputFile << endl;
-- if the point does not belong to the witness set,
-- then the output file contains the word "not"
r := get PHCoutputFile;
result := not match("not",r);
return result;
)
-----------------------------------
-------- MIXED VOLUME -------------
-----------------------------------
mixedVolume = method(Options => {StableMixedVolume => false, StartSystem => false, Verbose => false})
mixedVolume List := Sequence => opt -> system -> (
-- IN: system = list of polynomials in the system
-- OUT: mixed volume of the system. if optional inputs specified, then output is
-- a sequence containing a subset of: mixed volume, stable mixed volume,
-- start system, and solutions to start system.
-- Calls an Ada translation of ACM TOMS Algorithm 846:
-- "MixedVol: a software package for mixed-volume computation"
-- by Tangan Gao, T. Y. Li, Mengnien Wu, ACM TOMS 31(4):555-560, 2005.
R := ring ideal system;
n := #system;
if n < numgens R then error "the system is underdetermined";
if n > numgens R then error "the system is overdetermined";
if not(class coefficientRing R===ComplexField) then
error "coefficient ring is not complex";
filename := getFilename();
if opt.Verbose then
stdio << "using temporary files " << filename|"PHCinput" << " and " << filename|"PHCoutput" << endl;
infile := filename|"PHCinput";
outfile := filename|"PHCoutput";
cmdfile := filename|"PHCcommands";
sesfile := filename|"PHCsession";
if opt.StartSystem then startfile := filename|"PHCstart";
-- writing data to the corresponding files
file := openOut cmdfile;
file << "4" << endl; -- call MixedVol in PHCpack
if opt.StableMixedVolume
then (file << "y" << endl) -- stable mixed volume wanted
else (file << "n" << endl); -- no stable mixed volume
file << "n" << endl; -- no mixed-cell configuration on file
if opt.StartSystem then (
file << "y" << endl; -- random coefficient start system wanted
file << startfile << endl;
file << "0" << endl << "1" << endl;
)
else (file << "n" << endl); -- no random coefficient start system
close file;
systemToFile(system,infile);
-- launching mixed volume calculator :
execstr := PHCexe|" -m "|infile|" "|outfile|" < "|cmdfile|" > "|sesfile;
ret := run(execstr);
if ret =!= 0 then
error "error occurred while executing PHCpack command: phc -m";
F := get outfile;
-- search lines of outfile for: " mixed volume : "
-- once found, extract just the number and return its value:
local mixvol;
scanLines(line ->
if substring(0,21,line) == "common mixed volume :" then (
mixvol = value replace("common mixed volume : ","",line);
break
), outfile);
local stabmv;
if opt.StableMixedVolume then (
scanLines(line ->
if substring(0,21,line) == "stable mixed volume :" then (
stabmv = value replace("stable mixed volume : ","",line);
break
), outfile);
);
local result;
if not opt.StartSystem then (
if opt.StableMixedVolume then result = (mixvol, stabmv) else result = mixvol;
)
else (
solsfile := startfile | ".sols";
p := startSystemFromFile(startfile);
execstr = PHCexe|" -z "|startfile|" "|solsfile;
ret = run(execstr);
if ret =!= 0 then
error "error occurred while executing PHCpack command: phc -z";
sols := parseSolutions(solsfile, ring ideal system);
if opt.StableMixedVolume
then result = (mixvol,stabmv,p,sols)
else result = (mixvol,p,sols);
);
result
)
-------------------------------------------
------------NON ZERO FILTER----------------
-------------------------------------------
nonZeroFilter = method(TypicalValue => List)
nonZeroFilter (List,ZZ,RR) := (sols,k,tol) -> (
-- IN: sols, solutions of a polynomial system;
-- k, index to a coordinate of a solution
-- tol, tolerance for the absolute value of k-th coordinate
-- OUT: list of solutions in sols where the k-th coordinate
-- is less than the tolerance.
return select(sols,t->(not isCoordinateZero(t,k,tol)));
)
-------------------------------------------
--NUMERICAL IRREDUCIBLE DECOMPOSITION------
-------------------------------------------
numericalIrreducibleDecomposition=method(TypicalValue=>NumericalVariety, Options=>{StartDimension=>-1})
numericalIrreducibleDecomposition (List) := o -> (L) -> (
--IN: an ideal, top dimension
--OUT: a NumericalVariety
setRandomSeed(random ZZ);
startdim:=o.StartDimension;
W:=cascade(L,StartDimension=>startdim);
witsets:=apply(keys W, i->if i!=0 then (factorWitnessSet((W#i)_0))#i else W#i);
numericalVariety(flatten witsets)
)
-----------------------------------
----- REFINING SOLUTIONS ----------
-----------------------------------
refineSolutions = method(TypicalValue=>List, Options => {Verbose => false})
refineSolutions (List,List,ZZ) := o-> (f,sols,dp) -> (
-- IN: f, a polynomial system with complex coefficients;
-- sols, list of points, initial approximations for the solutions of f;
-- dp, number of decimal places in the working precision.
-- OUT: a list of refined solutions.
if not(class coefficientRing ring first f===ComplexField) then
error "coefficient ring of system is not complex";
PHCinputFile := temporaryFileName() | "PHCinput";
PHCoutputFile := temporaryFileName() | "PHCoutput";
PHCbatchFile := temporaryFileName() | "PHCbatch";
PHCsessionFile := temporaryFileName() | "PHCsession";
PHCsolutions := temporaryFileName() | "PHCsolutions";
if o.Verbose then
stdio << "writing input system to " << PHCinputFile << endl;
systemToFile(f,PHCinputFile);
if o.Verbose then
stdio << "appending solutions to " << PHCinputFile << endl;
R := ring first f;
solutionsToFile(sols, R, PHCinputFile, Append=>true);
if o.Verbose then
stdio << "preparing input data for phc -v in " << PHCbatchFile << endl;
s := concatenate("3\n",PHCinputFile);
s = concatenate(s,"\n");
s = concatenate(s,PHCoutputFile);
s = concatenate(s,"\n3\n1.0E-");
s = concatenate(s,toString(dp-4)); -- tolerance for correction term
s = concatenate(s,"\n4\n1.0E-");
s = concatenate(s,toString(dp+16)); -- tolerance for residual
s = concatenate(s,"\n6\n");
nit := ceiling(dp/10.0);
s = concatenate(s,toString(nit)); -- number of Newton iterations
s = concatenate(s,"\n7\n");
s = concatenate(s,toString(dp)); -- decimal places in working precision
s = concatenate(s,"\n0\n");
bat := openOut PHCbatchFile;
bat << s;
close bat;
-- stdio << "running phc -v, writing output to " << PHCsessionFile << endl;
run(PHCexe|" -v < " | PHCbatchFile | " > " | PHCsessionFile);
if o.Verbose then
( stdio << "using temporary file " << PHCoutputFile;
stdio << " for storing refined solutions " << endl;
stdio << "solutions in Maple format in " << PHCsolutions << endl
);
run(PHCexe|" -z " | PHCoutputFile | " " | PHCsolutions);
b := ceiling(log_2(10^dp));
result := parseSolutions(PHCsolutions,R,Bits=>b);
result
)
----------------------------------
------ SOLVE SYSTEM --------------
----------------------------------
solveSystem = method(TypicalValue => List, Options => {Verbose => false})
solveSystem List := List => o->system -> (
-- IN: system = list of polynomials with complex coeffiecients,
-- i.e. the system to solved
-- OUT: solutions to the system, a list of Points
if instance(ring ideal system, FractionField) then
error "ring is a fraction field, use solveRationalSystem";
if not(class coefficientRing ring first system===ComplexField) then
error "coefficient ring is not complex";
filename := getFilename();
if o.Verbose then
stdio << "using temporary files " << filename|"PHCinput" << " and " << filename|"PHCoutput" << endl;
infile := filename|"PHCinput";
outfile := filename|"PHCoutput";
solnsfile := filename|"PHCsolns";
R := ring ideal system;
n := #system;
if n < numgens R then
error "the system is underdetermined, positive dimensional";
-- add slack variables if needed (i.e. if system is overdetermined)
if n > numgens R then (
nSlacks := n - numgens R;
slackVars := apply(nSlacks, i->getSymbol("OOOO"|toString i));
newR := CC(monoid[gens R, slackVars]);
rM := random(CC^n,CC^nSlacks);
system = apply(#system, i->sub(system#i,newR)
+(rM^{i}*transpose submatrix'(vars newR,toList(0..numgens R - 1)))_(0,0))
) else newR=R;
-- writing data to the corresponding files:
systemToFile(system,infile);
-- launching blackbox solver:
execstr := PHCexe|" -b " |infile|" "|outfile;
ret := run(execstr);
if ret =!= 0 then
error "error occurred while executing PHCpack command: phc -b";
execstr = PHCexe|" -z "|infile|" " |solnsfile;
ret = run(execstr);
if ret =!= 0 then
error "error occurred while executing PHCpack command: phc -z";
-- parse and output the solutions:
result := parseSolutions(solnsfile, R);
result
)
------------------------------------
------SOLVE RATIONAL SYSTEM--------
-----------------------------------
solveRationalSystem = method(TypicalValue => List, Options => {Verbose => false})
solveRationalSystem List := o-> system -> (
-- IN: system = list of rational equations with complex coeffiecients,
-- i.e. the system to solved
-- OUT: solutions to the system, a list of Points
origRing := ring ideal system;
--convert to laurent polynomial
if instance(ring ideal system, FractionField)
then system = toLaurentPolynomial(system, getSymbol "LLLL");
filename := getFilename();
if o.Verbose then
stdio << "using temporary files " << filename|"PHCinput" << " and " << filename|"PHCoutput" << endl;
infile := filename|"PHCinput";
outfile := filename|"PHCoutput";
solnsfile := filename|"PHCsolns";
R := ring ideal system;
vars R;
n := #system;
if n < numgens R then
error "the system is underdetermined, positive dimensional";
-- add slack variables if needed (i.e. if system is overdetermined)
if n > numgens R then (
nSlacks := n - numgens R;
slackVars := apply(nSlacks, i->getSymbol("OOOO"|toString i));
newR := QQ(monoid(gens R | slackVars, Inverses=>true, MonomialOrder=>RevLex));
rM := random(QQ^n,QQ^nSlacks);
system = apply(#system, i->sub(system#i,newR)
+(rM^{i}*transpose submatrix'(vars newR,toList(0..numgens R - 1)))_(0,0))
) else newR=R;
-- writing data to the corresponding files:
systemToFile(system,infile);
-- launching blackbox solver:
execstr := PHCexe|" -b " |infile|" "|outfile;
ret := run(execstr);
if ret =!= 0 then
error "error occurred while executing PHCpack command: phc -b";
execstr = PHCexe|" -z "|infile|" " |solnsfile;
ret = run(execstr);
if ret =!= 0 then
error "error occurred while executing PHCpack command: phc -z";
-- parse and output the solutions:
result := parseSolutions(solnsfile, QQ[gens origRing]);
result
)