File: systems.m2

package info (click to toggle)
macaulay2 1.24.11%2Bds-5
  • links: PTS, VCS
  • area: main
  • in suites: forky, trixie
  • size: 171,648 kB
  • sloc: cpp: 107,850; ansic: 16,307; javascript: 4,188; makefile: 3,947; lisp: 682; yacc: 604; sh: 476; xml: 177; perl: 114; lex: 65; python: 33
file content (135 lines) | stat: -rw-r--r-- 5,641 bytes parent folder | download | duplicates (2)
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
------------------------------------------------------
-- routines for 0-dim solution sets 
-- not included in other files
-- (loaded by  ../NumericalAlgebraicGeometry.m2)
------------------------------------------------------

-- helper functions for "square down":
-- orthonormal basis for col(L) using SVD
ONB = L -> (
    (S,U,Vt) := SVD L;
    r := # select(S,s->not areEqual(s,0));
    U_{0..r-1}
    )
-- orthonormal basis for subspace of col(L) that is perpendicular to col(M)
perp = (M, L) -> if areEqual(norm L, 0) then M else (
    Lortho := ONB L;
    Lperp := M-Lortho*conjugate transpose Lortho * M;
    ONB Lperp
    )
-- finding a square subsystem of maximal rank
rowSelector = method(Options=>{"block size"=>1,"target rank"=>null,Verbose=>false})
rowSelector (AbstractPoint, AbstractPoint, System) := o -> (y0, c0, GS) -> (
    (n, m, N) := (numVariables GS, numParameters GS, numFunctions GS);
    blockSize := o#"block size";
    numBlocks := ceiling(N/blockSize);
    numIters := 0;
    L := matrix{for i from 1 to n list 0_CC}; -- initial "basis" for row space
    r := 0;
    goodRows := {};
    diffIndices := {};
    while (r < n and numIters < numBlocks) do (
    	diffIndices = for j from numIters*blockSize to min((numIters+1)*blockSize, N)-1 list j;
	if o.Verbose then << "processing rows " << first diffIndices << " thru " << last diffIndices << endl;
    	newRows := evaluateJacobian(GS^diffIndices, y0, c0);
    	for j from 0 to numrows newRows - 1 do (
	    tmp := transpose perp(transpose newRows^{j}, transpose L);
	    if not areEqual(0, norm tmp) then (
		if o.Verbose then << "added row " << blockSize*numIters+j << endl;
	    	if areEqual(norm L^{0}, 0) then L = tmp else L = L || tmp;
	    	goodRows = append(goodRows, blockSize*numIters+j);
		);
    	    );
    	r = numericalRank L;
    	numIters = numIters+1;
	);
    if o.Verbose then << "the rows selected are " << goodRows << endl;
    goodRows
    )

-- stashes and returns "squared up" subsystem, according to given strategy
squareUp = method(Options => {Field => null, Strategy => null, "block size"=>1, "target rank" => null, Verbose=>false}) -- squares up a polynomial system (presented as a one-column matrix)
squareUp System := o -> P -> if P.?SquaredUpSystem then P.SquaredUpSystem else squareUp(P, numVariables P, o)
squareUp (System, ZZ) := o -> (P, n) -> (
    m := numFunctions P;
    if m<=n then "expect more equations than second argument";
    C := if instance(o.Field, Nothing) then (
	if instance(P, PolySystem) then coefficientRing ring P
	else default CC
	) else o.Field;
    if instance(o.Strategy, Nothing) or o.Strategy == "random matrix" then (
    	M := if class C === ComplexField then sub(randomOrthonormalRows(n,m), C) else random(C^n,C^m);
    	squareUp(P,M,o)
	) 
    else if o.Strategy == "slack variables" then error "strategy not implemented"
    else error "strategy not implemented"
    )
squareUp(System, Matrix) := o -> (P, M) -> (
    P.SquareUpMatrix = M;
    P.SquaredUpSystem = if instance(P, PolySystem) then polySystem (M*P.PolyMap) else gateSystem(parameters P, vars P, M * gateMatrix P)
    )
-- todo: squareUp(System, ...) not implemented, override w/ PolySystem and GateSystem

--- is this ever used???
squareUpMatrix = method()
squareUpMatrix System := P -> if P.?SquareUpMatrix then P.SquareUpMatrix else (
    n := P.NumberOfVariables;
    C := coefficientRing ring P;
    map(C^n)
    )

---------------------------------------------------
-- below is what was formerly known as "squareDown"
-- (needs a point for evaluation of the jacobian; uses rowSelector above)
squareUp (AbstractPoint, AbstractPoint, GateSystem) := o -> (p0, x0, F) -> (
    keptRows := rowSelector(p0, x0, F, "block size" => o#"block size", Verbose=>o.Verbose);
    F.SquaredUpSystem = F^keptRows
    )
squareUp (AbstractPoint, GateSystem) := o -> (x0, F) -> squareUp(point{{}}, x0, F, o)

TEST ///
needsPackage "NumericalSchubertCalculus"
needsPackage "NumericalAlgebraicGeometry"
-- Schubert calculus on the Grassmannian of m-planes in C^2m
-- derksen example
k = 1 -- k=2 (more interesting)
n = 3 -- n=4 (...)
m = 2*k
p = 2*n - m
assert(m+p == 2*n)
prob1 = apply(4, i -> apply(k, j -> n-k))
-- synthesize solution
prob1Instance = randomSchubertProblemInstance(prob1, m, m+p)
K0s = last \ prob1Instance
p0 = fold(apply(K0s, K0 -> matrix{flatten entries K0}), (a,b) -> a|b)
elapsedTime X0s = solveSchubertProblem(prob1Instance, m, m+p);
length realPoints apply(X0s, m -> point matrix{flatten entries m})
X0 = first X0s
X0 = X0 * (inverse X0^{0..m-1})
x0 = matrix{flatten entries X0^{m..m+p-1}}
allMinors = (k, M) -> (
    (m, n) := (numrows M, numcols M);
    flatten apply(subsets(m,k), R -> apply(subsets(n,k), C -> det(M_C^R)))
    )
-- setup equations
X = gateMatrix for i from 1 to p list for j from 1 to m list x_(i,j)
P = gateMatrix{vars flatten flatten for i from 1 to #prob1 list for j from 1 to m+p list for k from 1 to m+p list K_(i,j,k)}
O = inputGate 1
Z = inputGate 0
I = gateMatrix apply(m, i-> apply(m,j->if i==j then O else Z))
Ks = for i from 1 to #prob1 list matrix for j from 1 to m+p list for k from 1 to m+p list K_(i,j,k)
elapsedTime rankConstraints = transpose gateMatrix{flatten flatten apply(prob1, Ks, (S, K) -> apply(#S, i -> (
	j := S#i;
	M := (I || X) | K_{0..p+i-j}; 
	allMinors(m+p-j+1, M)
	)
    )
)};
G = gateSystem(P, matrix{flatten entries X}, rankConstraints)
norm evaluate(G, p0, x0)
assert (numericalRank evaluateJacobian(G, p0, x0)==numVariables G)
GSq = squareUp(point p0, point x0, G)
assert(numVariables GSq == numFunctions GSq)
assert(norm evaluate(GSq, p0, x0) < 1e-8)
///