(*Linear Algebra*)
(*matrix operations and converting into matrices ====================================================*)
e[i_, j_, m_, n_] :=
Table[If[k == i && l == j, 1, 0], {k, 1, m }, {l, 1, n}]; (*basis for matrices*)
conjugate[X_, Y_, char_] :=
If[char == 0, Inverse[Y].X.Y,
Mod[Inverse[Y, Modulus -> char].X.Y,
char]]; (*this definition of conjugate is made to apply the left representation of Gamma_Delta and hence a right representation of Pi1(L_Delta)*)
matrixify[operator_, domainbasis_, targetbasis_, char_] :=
Module[{A =
Transpose[
Table[Flatten[targetbasis[[i]]], {i, 1,
Length[targetbasis]}]]},
If[char == 0,
Transpose[
Table[LinearSolve[A, Flatten[operator[domainbasis[[i]]]]], {i,
1, Length[domainbasis]}]],
Transpose[
Table[LinearSolve[A, Flatten[operator[domainbasis[[i]]]],
Modulus -> char], {i, 1, Length[domainbasis]}]]]];
(*extracts a maximally linearly independent sublist of the given list*)
maxLinIndepSublist[list_List, char_] :=
Module[{elementsOfListAsColumns =
Transpose[Table[Flatten[list[[i]]], {i, 1, Length[list]}]],
reduced, pivotingColumns},
reduced = RowReduce[elementsOfListAsColumns, Modulus -> char];
pivotingColumns =
Flatten[Table[
FirstPosition[reduced[[i]], x_ /; x != 0, ## &[]], {i, 1,
Dimensions[reduced][[1]]}]];
list[[pivotingColumns]]]
commutatorOperator[A_, B_, char_] :=
If[char == 0, A.B - B.A, Mod[A.B - B.A, char]];
(*given a basis for a space V of m by m matrices, construct a basis \
for V^{\oplus power}. basisPower returns a list of power-tuples of \
matrices which spans the space of power-tuples of matrices*)
basisPower[m_, basis_, power_] :=
If[power == 1, basis,
Flatten[Table[
If[ k == i, basis[[j]], e[0, 0, m, m]], {i, 1, power}, {j, 1,
Length[basis]}, {k, 1, power}], 1]];
(*basisPowertest=basisPower[1, 1, {{{1}}}, 1]
basisPowertest = basisPower[2, {{{1, 0}, {0, 0}}, {{0, 1}, {0, 0}}, \
{{0, 0}, {1, 0}}, {{0, 0}, {0, 1}}}, 2]
Table[MatrixForm /@ basisPowertest[[i]], {i, 1, \
Length[basisPowertest]}]*)
(*unit test for matrixification------------------------------------------------------------------------------*)
(*testDomainBasis = Flatten[Table[e[i, j, 2, 2], {i, 1, 2}, {j, 1, 2}], 1]
testTargetBasis ={ {{1,0},{0, 1}},{{0, 1},{1,0}}}
testOperator[M_] := Module[{vectM = Flatten[M]},
{{vectM .Flatten[e[1,1,2,2]] + vectM .Flatten[e[2,2,2,2]], vectM.Flatten[e[1,2,2,2]] + vectM .Flatten[e[2,1,2,2]]},{vectM.Flatten[e[1,2,2,2]] + vectM .Flatten[e[2,1,2,2]],
vectM .Flatten[e[1,1,2,2]] + vectM .Flatten[e[2,2,2,2]]}}]
matrixify[testOperator[#]&, testDomainBasis, testTargetBasis] \
//MatrixForm
matrixify[testOperator[#]&, testDomainBasis, testTargetBasis, 0] \
//MatrixForm*)
(*end of test--------------------------------------------------------------------------------------------*)
(*========================================The Chiang Lagrangian============================================================*)
(*==============================================DEFINING MORSE DIFFERENTIALS===================================================================*)
(*Morse differential from Aprime to (A1prime, A2prime, A3prime)*)
d01[Aprime_, a_, b_, char_] :=
If[char ==
0, {-Aprime + conjugate[Aprime, b, char], +Aprime -
conjugate[Aprime, a.b, char], -Aprime +
conjugate[Aprime, a.a.b, char]},
Mod[{-Aprime + conjugate[Aprime, b, char],
Aprime - conjugate[Aprime, a.b, char], -Aprime +
conjugate[Aprime, a.a.b, char]}, char]];
(*Morse differential from (A1prime, A2prime, A3prime) to (A1, A2, A3)*)
d12[{A1prime_, A2prime_, A3prime_}, a_, b_, char_] :=
If[char ==
0, {A1prime + A2prime + conjugate[A2prime, a, char] +
conjugate[A3prime, a, char],
conjugate[A1prime, a.a.b, char] + A2prime +
conjugate[A3prime, a, char] + A3prime,
conjugate[A1prime, a.a.b, char] +
conjugate[A1prime, a.a.a.b, char] +
conjugate[A2prime, a.a.a.b, char] + A3prime },
Mod[{A1prime + A2prime + conjugate[A2prime, a, char] +
conjugate[A3prime, a, char],
conjugate[A1prime, a.a.b, char] + A2prime +
conjugate[A3prime, a, char] + A3prime,
conjugate[A1prime, a.a.b, char] +
conjugate[A1prime, a.a.a.b, char] +
conjugate[A2prime, a.a.a.b, char] + A3prime }, char]];
(*Morse differential from (A1, A2, A3) to A*)
d23[{A1_, A2_, A3_}, a_, b_, char_] :=
If[char == 0, -A1 + A2 - A3 + conjugate[A1, a.a.a.b, char] -
conjugate[A2, a.a.a.a.b, char] +
conjugate[A3, a.a.a.a.a.b, char],
Mod[-A1 + A2 - A3 + conjugate[A1, a.a.a.b, char] -
conjugate[A2, a.a.a.a.b, char] +
conjugate[A3, a.a.a.a.a.b, char], char]];
(*Defining the Floer Differentials and the Obstruction*)
(*======================================FlOER \
DIFFERENTIAL======================================================================\
*)
(*Floer Differential from (Aprime, A1, A2, A3) to (A1prime, A2prime, A3prime, A)------------------------------------------------------------*)
dF0[{Aprime_, A1_, A2_, A3_}, a_, b_, char_] := Module[{mLoc},
mLoc = Dimensions[a][[1]];
If[char ==
0, {-a.a.b.A1 + A1.a.a.a.a.b + a.a.b.A2 -
a.a.a.a.a.A2.a.a.a.a.a.b,
-a.a.b.A2 + A2.b + a.a.a.b.A3.a - A3.b,
-a.a.a.a.b.A3 + A3.b + a.A1.a.a.a.b - a.a.a.a.a.b.A1.a.a.a.a.a,
e[0, 0, mLoc, mLoc]} +
{-Aprime + conjugate[Aprime, b, char],
+Aprime - conjugate[Aprime, a.b, char],
-Aprime + conjugate[Aprime, a.a.b, char],
-A1 + conjugate[A1, a.a.a.b, char] + A2 -
conjugate[A2, a.a.a.a.b, char] - A3 +
conjugate[A3, a.a.a.a.a.b, char]},
Mod[{a.a.b.A1 - A1.a.a.a.a.b - a.a.b.A2 + a.a.a.a.a.A2.a.a.a.a.a.b,
a.a.b.A2 - A2.b - a.a.a.b.A3.a + A3.b,
a.a.a.a.b.A3 - A3.b - a.A1.a.a.a.b + a.a.a.a.a.b.A1.a.a.a.a.a,
e[0, 0, mLoc, mLoc]} +
{-Aprime + conjugate[Aprime, b, char],
Aprime - conjugate[Aprime, a.b, char],
-Aprime + conjugate[Aprime, a.a.b, char],
-A1 + conjugate[A1, a.a.a.b, char] + A2 -
conjugate[A2, a.a.a.a.b, char] - A3 +
conjugate[A3, a.a.a.a.a.b, char]}, char]]];
(*Floer Differential from (A1prime, A2prime, A3prime, A) to (Aprime, \
A1, A2, A3)--------------------------------------------------------------------------*)
dF1[{A1prime_, A2prime_, A3prime_, A_}, a_, b_, char_] :=
Module[{mLoc}, mLoc = Dimensions[a][[1]];
If[char ==
0, { b.A1prime + A2prime.a.a.a.a.b + a.a.b.A3prime - a.A -
A. a.a.a.a.a,
-A.b,
-a.a.a.a.b.A,
-A.a.a.b} +
{e[0, 0, mLoc, mLoc],
A1prime + A2prime + conjugate[A2prime, a, char] +
conjugate[A3prime, a, char],
conjugate[A1prime, a.a.b, char] + A2prime +
conjugate[A3prime, a, char] + A3prime,
conjugate[A1prime, a.a.b, char] +
conjugate[A1prime, a.a.a.b, char] +
conjugate[A2prime, a.a.a.b, char] + A3prime },
Mod[{
b.A1prime + A2prime.Inverse[a.b, Modulus -> char] +
a.a.b.A3prime - a.A - A. a.a.a.a.a,
-A.b,
-a.a.a.a.b.A,
-A.a.a.b} +
{e[0, 0, mLoc, mLoc],
A1prime + A2prime + conjugate[A2prime, a, char] +
conjugate[A3prime, a, char],
conjugate[A1prime, a.a.b, char] + A2prime +
conjugate[A3prime, a, char] + A3prime,
conjugate[A1prime, a.a.b, char] +
conjugate[A1prime, a.a.a.b, char] +
conjugate[A2prime, a.a.a.b, char] + A3prime }, char]]]
(*the obstruction endomorphism m0 \circ alpha - \alpha \circ m0 ----------------------------------------------------------------------------------------*)
obstruction0[{Aprime_, A1_, A2_, A3_}, a_, b_, obstr_, char_] :=
If[char ==
0, { (obstr.Aprime - Aprime.obstr), (obstr.A1 -
A1.obstr), (obstr.A2 - A2.obstr), (obstr.A3 - A3.obstr)},
Mod[{ ( obstr.Aprime - Aprime.obstr), ( obstr.A1 - A1.obstr), (
obstr.A2 - A2.obstr), ( obstr.A3 - A3.obstr) }, char]]
obstruction1[{A1prime_, A2prime_, A3prime_, A_}, a_, b_, obstr_,
char_] :=
If[char ==
0, { (obstr.A1prime - A1prime.obstr), (
obstr.A2prime - A2prime.obstr), (
obstr.A3prime - A3prime.obstr), (obstr.A - A.obstr)},
Mod[{ (obstr.A1prime - A1prime.obstr), (
obstr.A2prime - A2prime.obstr), (
obstr.A3prime - A3prime.obstr), (obstr.A - A.obstr )}, char]]
(*Defining and Testing Representations of the Binary Dihedral Group
characteristic = 2*)
(*a test whether something is a representation of binary dihedral - \
generated by the element a of order 6 and the element b of order 4*)
isARep[{dim_, a_, b_}, char_] :=
If[char == 0,
If[(a.a.a.a.a.a == IdentityMatrix[dim] ) && (a.b ==
b.Inverse[a]) && (b.b == a.a.a), True, False],
If[(Mod[a.a.a.a.a.a, char] ==
IdentityMatrix[dim]) && (Mod[a.b, char] ==
Mod[b.Inverse[a, Modulus -> char], char]) && (Mod[b.b, char] ==
Mod[a.a.a, char]), True, False] ] ;
(*INDECOMPOSABLE REPS OVER ZZ/2------------------------------------------------------------------------------------------------------------------*)
(*V_1 - the trivial rep:*)
a1 = IdentityMatrix[1];
b1 = IdentityMatrix[1];
(*V_2 - second indecomposable C4 - rep *)
a2 = ( {
{1, 0},
{0, 1}
} );
b2 = ( {
{1, 1},
{0, 1}
} );
(*V_3 - third indecomposable C4 - rep*)
a3 = ( {
{1, 0, 1},
{0, 1, 0},
{0, 0, 1}
} );
b3 = ( {
{1, 1, 0},
{0, 1, 1},
{0, 0, 1}
} );
(*V_4 - fourth indecomposable C4 - rep AKA the regular C4 - rep*)
a4 = ( {
{1, 0, 1, 0},
{0, 1, 0, 1},
{0, 0, 1, 0},
{0, 0, 0, 1}
} );
b4 = ( {
{1, 1, 0, 0},
{0, 1, 1, 0},
{0, 0, 1, 1},
{0, 0, 0, 1}
} );
(* D - the representation of the dihedral group *)
aD = ( {
{0, 1},
{1, 1}
} );
bD = ( {
{0, 1},
{1, 0}
} );
(* U4 - faithful indecomposable rep of dimension 4*)
cU4 = ( {
{0, 1, 0, 0},
{1, 1, 0, 0},
{0, 0, 0, 1},
{0, 0, 1, 1}
} );
bU4 = ( {
{1, 1, 1, 1},
{0, 1, 0, 1},
{0, 0, 0, 1},
{0, 0, 1, 0}
} );
aU4 = Mod[cU4.cU4.bU4.bU4, characteristic];
listOfa = {a1, a2, a3, a4, aD, aU4};
listOfb = {b1, b2, b3, b4, bD, bU4} ;
MatrixForm /@ listOfa;
MatrixForm /@ listOfb;
(*Construct a representation from a specified vector of \
multiplicities for each of the six indecomposables in the order {V1, \
V2, V3, V4, D, U4}*)
repeat[m_, n_Integer] := Sequence @@ ConstantArray[m, n];
repConstructor[multiplicities_] := Module[{useListOfa,
useListOfb, aLoc, bLoc, mLoc },
useListOfa =
Table[repeat[listOfa[[i]], multiplicities[[i]]], {i, 1,
Length[multiplicities]}];
useListOfb =
Table[repeat[listOfb[[i]], multiplicities[[i]]], {i, 1,
Length[multiplicities]}];
aLoc = Fold[ArrayFlatten[{{#1, 0}, {0, #2}}] &, useListOfa];
bLoc = Fold[ArrayFlatten[{{#1, 0}, {0, #2}}] &, useListOfb];
mLoc = Dimensions[aLoc][[1]];
{mLoc, aLoc, bLoc}
]
(*Warning: to use the repConstructor, characteristic must be 2!
Insert a vector of multiplicities of indecomposable representations in order: {V1, V2, V3, V4, D, U4}*)
(*testing the repConstructor*)
(*vectorOfMultiplicitiesTest = {7, 0, 0, 0, 0,3};
repTest =repConstructor[vectorOfMultiplicitiesTest];
Dimensions[repTest[[2]]][[1]]
MatrixForm /@ repTest
isARep[repTest,characteristic]*)
(*Matrices in the image of the group ring------------------------------------------------------------------------------------------------*)
imagesOfElements[a_, b_, char_] :=
If[char == 0,
DeleteDuplicates[
Table[MatrixPower[a, i].MatrixPower[b, Quotient[i, 6]], {i, 0,
11}]], DeleteDuplicates[
Table[Mod[MatrixPower[a, i].MatrixPower[b, Quotient[i, 6]],
char], {i, 0, 11}]]];
(*testing imagesOfElements*)(*
imagesOfElementsTest \
=imagesOfElements[repTest[[2]], repTest[[3]], characteristic];
basisTest = maxLinIndepSublist[imagesOfElementsTest, characteristic];
(*MatrixForm /@ imagesOfElementsTest
MatrixForm /@ basisTest*)
Length[imagesOfElementsTest]
Length[basisTest]*)
(*DEFINING BASES FOR MORSE COMPLEX=======================================================================================================================*)
fullBasisIndex0or3[m_] :=
Flatten[Table[e[i, j, m, m], {i, 1, m}, {j, 1, m}], 1];
fullBasisIndex1or2[m_] := basisPower[m, fullBasisIndex0or3[m], 3]
(*Flatten[Table[If[ l \[Equal]k,e[i,j, m,m], e[0,0, m, m]], {l, 1, \
3},{i,1,m}, {j,1,m},{k, 1, 3}], 2];*)
(*MatrixForm /@ \
fullBasisIndex0or3[3]
Table[MatrixForm /@ fullBasisIndex1or2[3][[i]], {i, 1, \
Length[fullBasisIndex1or2[3]]}]*)
monodromyBasisIndex0or3[a_, b_, char_] :=
maxLinIndepSublist[imagesOfElements[a, b, char], char];
(*monodromyBasisIndex0or3Test=monodromyBasisIndex0or3[repTest[[2]], \
repTest[[3]], characteristic];
monodromyBasisIndex1or2Test= basisPower[repTest[[1]], \
monodromyBasisIndex0or3Test, 3];
(*MatrixForm /@ monodromyBasisIndex0or3Test*)
\
Length[monodromyBasisIndex0or3Test]
(*Table[MatrixForm /@ monodromyBasisIndex1or2Test[[i]], {i, 1, \
Length[monodromyBasisIndex1or2Test]}]*)
\
Length[monodromyBasisIndex1or2Test]*)
(*THE OBSTRUCTION AND A BASIS FOR THE CENTRAL SUBCOMPLEX---------------------------------------------------------------------------------------\
*)
ClearAll[m0]
m0[a_, b_, char_] :=
If[char == 0, a.a.a.a .b + a.a.b + b,
Mod[a.a.a.a .b + a.a.b + b, char]]
(*m0Test = m0[repTest[[2]], repTest[[3]], characteristic];
(*Print["m0 = ",MatrixForm[m0Test]]
If[MatrixRank[m0Test, Modulus\[Rule]characteristic]\[Equal]0, \
Print[Style["m0 IS 0!", 20,Green]],Print[Style["m0 IS NOT 0!", \
20,Red]]] *)*)
centralBasisIndex0or3[a_, b_, m0_, char_] :=
Module[{commutatorWithM0matrix, mLoc},
mLoc = Dimensions[a][[1]];
commutatorWithM0matrix =
matrixify[commutatorOperator[#, m0, char] &,
fullBasisIndex0or3[mLoc], fullBasisIndex0or3[mLoc], char] ;
Partition[#, mLoc] & /@
NullSpace[commutatorWithM0matrix, Modulus -> char]
]
(*tests - to use, uncomment all previous tests*)
\
(*centralBasisIndex0or3Test = centralBasisIndex0or3[repTest[[2]], \
repTest[[3]], m0Test, characteristic];
centralBasisIndex0or3Test = centralBasisIndex0or3[a2, b2, m0[a2, b2, \
2], 2]
centralBasisIndex1or2Test = basisPower[repTest[[1]], \
centralBasisIndex0or3Test, 3];
MatrixForm[#]& /@centralBasisIndex0or3Test
Length[centralBasisIndex0or3Test]
Length[maxLinIndepSublist[centralBasisIndex0or3Test, characteristic]]
Length[centralBasisIndex1or2Test]
Length[maxLinIndepSublist[centralBasisIndex1or2Test, characteristic]]*)
\
(*Table[MatrixForm /@ centralBasisIndex1or2Test[[i]], {i, 1, \
Length[centralBasisIndex1or2Test]}]*)
(*BASES FOR Z/2-GRADED FLOER COMPLEX---------------------------------------------------------------------------------------------------------\
*)
fullBasisTotal[m_] := basisPower[m, fullBasisIndex0or3[m], 4]
(*Table[MatrixForm /@ fullBasisTotal[3][[i]], {i, 1, \
Length[fullBasisTotal[3]]}]*)
centralBasisTotal[a_, b_, m0_, char_] :=
basisPower[Dimensions[a][[1]],
centralBasisIndex0or3[a, b, m0, char], 4]
(*tests - to use uncomment all previous tests*)
\
(*centralBasisTotalTest = basisPower[repTest[[1]], \
centralBasisIndex0or3[repTest[[2]], repTest[[3]], m0Test, \
characteristic], 4];
Length[centralBasisTotalTest]*)
monodromyBasisTotal[a_, b_, char_] :=
basisPower[Dimensions[a][[1]], monodromyBasisIndex0or3[a, b, char], 4]
(*tests - to use uncomment previous tests*)
(*monodromyBasisTotalTest \
= basisPower[repTest[[1]], monodromyBasisIndex0or3[repTest[[2]], \
repTest[[3]], characteristic], 4];
Length[monodromyBasisTotalTest]
(*Table[MatrixForm /@ monodromyBasisTotalTest[[i]], {i, 1, \
Length[monodromyBasisTotalTest]}]*)*)
(*===============Calculating Morse and Floer Homologies======================================*)
(*basis code: \
1=full, 2=central, 3=monodromy*)
calculateHomologies[a_, b_, basis_, char_] :=
Module[{mLoc, m0Loc, fullBasisIndex0or3Loc, centralBasisIndex0or3Loc,
monodromyBasisIndex0or3Loc, usedBasisIndex0or3Loc,
sizeOfBasisAtaPointLoc, usedBasisIndex1or2Loc, usedBasisTotalLoc,
d01matrixLoc, d12matrixLoc, d23matrixLoc, rank01, rank12, rank23,
rankd12d01, rankd23d12, df0df1, df1df0, rankdf0df1, rankdf1df0,
dF0matrixLoc, dF1matrixLoc, obstruction0matrixLoc,
obstruction1matrixLoc, rankdf0, rankdf1, rankHM0, rankHM1,
rankHM2, rankHM3, rankHF0, rankHF1},
{mLoc = Dimensions[a][[1]],
m0Loc = m0[a, b, char],
fullBasisIndex0or3Loc = fullBasisIndex0or3[mLoc],
centralBasisIndex0or3Loc =
centralBasisIndex0or3[a, b, m0Loc, char],
monodromyBasisIndex0or3Loc = monodromyBasisIndex0or3[a, b, char],
usedBasisIndex0or3Loc =
If[basis == 1, fullBasisIndex0or3Loc,
If[basis == 2, centralBasisIndex0or3Loc,
monodromyBasisIndex0or3Loc]],
usedBasisIndex1or2Loc = basisPower[mLoc, usedBasisIndex0or3Loc, 3],
usedBasisTotalLoc = basisPower[mLoc, usedBasisIndex0or3Loc, 4],
Table[
MatrixForm /@ usedBasisTotalLoc[[i]], {i, 1,
Length[usedBasisTotalLoc]}],
sizeOfBasisAtaPointLoc = Length[usedBasisIndex0or3Loc],
Print["Size of" ,
If[basis == 1, " FULL ",
If[basis == 2, " CENTRAL ", " MONODROMY "]],
"basis at a point = ", sizeOfBasisAtaPointLoc];
(*COMPUTING MORSE DIFFERENTIALS AS MATRICES--------------------------------------------------------------------------------------------------*)
d01matrixLoc =
matrixify[d01[#, a, b, char] &, usedBasisIndex0or3Loc,
usedBasisIndex1or2Loc, char],
d12matrixLoc =
matrixify[d12[#, a, b, char] &, usedBasisIndex1or2Loc,
usedBasisIndex1or2Loc, char],
d23matrixLoc =
matrixify[d23[#, a, b, char] &, usedBasisIndex1or2Loc,
usedBasisIndex0or3Loc, char],
rank01 = MatrixRank[d01matrixLoc, Modulus -> char],
rank12 = MatrixRank[d12matrixLoc, Modulus -> char],
rank23 = MatrixRank[d23matrixLoc, Modulus -> char],
rankd12d01 =
MatrixRank[d12matrixLoc.d01matrixLoc, Modulus -> char],
rankd23d12 =
MatrixRank[d23matrixLoc.d12matrixLoc, Modulus -> char],
(*COMPUTING THE FLOER DIFFERENTIALS AS MATRICES------------------------------------------------------------------------------------------------*)
dF0matrixLoc =
If[char == 0,
matrixify[dF0[#, a, b, char] &, usedBasisTotalLoc,
usedBasisTotalLoc, char],
Mod[matrixify[dF0[#, a, b, char] &, usedBasisTotalLoc,
usedBasisTotalLoc, char], char]],
dF1matrixLoc =
If[char == 0,
matrixify[dF1[#, a, b, char] &, usedBasisTotalLoc,
usedBasisTotalLoc, char],
Mod[matrixify[dF1[#, a, b, char] &, usedBasisTotalLoc,
usedBasisTotalLoc, char], char]],
(*COMPUTING THE SQUARE OF THE FLOER DIFFERENTIAL------------------------------------------------------------------------------------------------------*)
df1df0 =
If[char == 0, dF1matrixLoc.dF0matrixLoc,
Mod[dF1matrixLoc.dF0matrixLoc, char]],
df0df1 =
If[char == 0, dF0matrixLoc.dF1matrixLoc,
Mod[dF0matrixLoc.dF1matrixLoc, char]],
rankdf0df1 =
If[char == 0, MatrixRank[df0df1],
MatrixRank[df0df1, Modulus -> char]],
rankdf1df0 =
If[char == 0, MatrixRank[df1df0],
MatrixRank[df1df0, Modulus -> char]],
(*COMPUTING OBSTRUCTION ENDOMORPHISMS AS MATRICES----------------------------------------------------------------------------------------------*)
obstruction0matrixLoc =
If[characteristic == 0,
matrixify[obstruction0[#, a, b, m0Loc, char] &,
usedBasisTotalLoc, usedBasisTotalLoc, char],
Mod[matrixify[obstruction0[#, a, b, m0Loc, char] &,
usedBasisTotalLoc, usedBasisTotalLoc, char], char]],
obstruction1matrixLoc =
If[char == 0,
matrixify[obstruction1[#, a, b, m0Loc, char] &,
usedBasisTotalLoc, usedBasisTotalLoc, char],
Mod[
matrixify[obstruction1[#, a, b, m0Loc, char] &,
usedBasisTotalLoc, usedBasisTotalLoc, char], char]],
(*RESULTS FOR MORSE----------------------------------------*)
rankHM0 = Length[usedBasisIndex0or3Loc] - rank01,
rankHM1 = Length[usedBasisIndex1or2Loc] - rank12 - rank01,
rankHM2 = Length[usedBasisIndex1or2Loc] - rank23 - rank12,
rankHM3 = Length[usedBasisIndex0or3Loc] - rank23}
(*Print["d01 = ", MatrixForm[d01matrixLoc]]
Print["rank[d01] = ",rank01]
Print["d12 = ",MatrixForm[d12matrixLoc]]
Print["rank[d12] = ",rank12]
Print["d23 = ",MatrixForm[d23matrixLoc]]
Print["rank[d23] = ",rank23]
Print["d12.d01 = ", MatrixForm[If[char\[Equal]0, Simplify[
d12matrixLoc.d01matrixLoc], Mod[Simplify[
d12matrixLoc.d01matrixLoc], char]]]]
Print["d23.d12 =", MatrixForm[If[char\[Equal]0, Simplify[
d23matrixLoc.d12matrixLoc], Mod[Simplify[
d23matrixLoc.d12matrixLoc], char]]]]
If[(rankd12d01\[Equal]0)&&(rankd23d12\[Equal]0), Print[Style[
"dM^2 = 0", 16, Green]], Print[Style["dM^2 IS NOT 0!", 16, Red]]];*)
Print[Style["rank[HM^0(E,E)] = ", 14, Orange], rankHM0];
Print[Style["rank[HM^1(E,E)] = ", 14, Orange], rankHM1];
Print[Style["rank[HM^2(E,E)] = ", 14, Orange], rankHM2];
Print[Style["rank[HM^3(E,E)] = ", 14, Orange], rankHM3];
(*RESULTS FOR FLOER--------------------------------------------------------------------------------------------------------------------*)
(*Print["dF0 = ", MatrixForm[dF0matrix]];*)
(*Print["rank dF0 = ",
rankdf0];*)
(*Print["dF1 = ",MatrixForm[dF1matrix]];*)
(*Print[
"rank dF1 = ",rankdf1];*)
(*Print["dF1.dF0 = ", MatrixForm[[
df1df0]]];
Print["dF0.dF1 = ", MatrixForm[[df0df1]]];*)
If[(rankdf0df1 == 0 && rankdf1df0 == 0),
{Print[Style["dF^2 = 0", 20, Darker[Green]]],
{rankdf0 =
If[char == 0, MatrixRank[dF0matrixLoc],
MatrixRank[dF0matrixLoc, Modulus -> char]],
rankdf1 =
If[char == 0, MatrixRank[dF1matrixLoc],
MatrixRank[dF1matrixLoc, Modulus -> char]],
rankHF0 = Length[usedBasisTotalLoc] - rankdf0 - rankdf1,
rankHF1 = Length[usedBasisTotalLoc] - rankdf0 - rankdf1},
Print[
Style["rank[HF^0(E,E)] = rank[HF^1(E,E)] = ", 16, Orange],
rankHF0]}, Print[Style["dF^2 IS NOT 0!", 20, Darker[ Red]]]]
(*COMPARISON WITH OBSTRUCTION---------------------------------------------------------------------------------*)
If[(MatrixRank[obstruction0matrixLoc, Modulus -> char] ==
0) && (MatrixRank[obstruction1matrixLoc, Modulus -> char] ==
0), Print[Style["Obstruction vanishes!", 20, Darker[Green]]],
Print[Style["OBSTRUCTED!", 20, Darker[ Red]]]];
If[(MatrixRank[df1df0 - obstruction0matrixLoc, Modulus -> char] ==
0) && (MatrixRank[df0df1 - obstruction1matrixLoc,
Modulus -> char] == 0),
Print[Style["dF^2 = obstruction", 20, Darker[Green]]],
Print[Style["dF^2 IS NOT THE CLAIMED OBSTRUCTION!", 20,
Darker[ Red]]]]
]
(*======================NUMERICAL CALCULATIONS======================================*)
\
(*basis code 1=full; 2=central; 3=monodromy*)
(*test run-------------------------------------------------------------------------*)
calculateHomologies[aU4, bU4, 2, 2]
(*using repConstructor over characteristic 2*)
(*Insert a vector of \
multiplicities of indecomposable representations in \
order:{V1,V2,V3,V4,D,U4}*)
characteristic = 2;
calculateHomologiesFromMultiplicities[vectorOfMultiplicities_,
basis_] := Module[{aLoc, bLoc},
aLoc = repConstructor[vectorOfMultiplicities][[2]];
bLoc = repConstructor[vectorOfMultiplicities][[3]];
Print["---------------------------------------------------------------------------------------------------"];
Print["Representation is ", vectorOfMultiplicities];
calculateHomologies[aLoc, bLoc, basis, characteristic]]
calculateHomologiesFromMultiplicities[{0,2,0,0,0,0}, 1]
(*(*calculating all homologies for all reps - runs for an eternity*)
listOFSingleMultiplicities = Drop[Flatten[Table[{i, j, k, l, m, n}, {n, 0, 1},{m, 0, 1},{l, 0, 1},{k, 0, 1},{j, 0, 1},{i, 0, 1}], 5], 1];
Length[listOFSingleMultiplicities]
Table[calculateHomologiesFromMultiplicities[listOFSingleMultiplicities[[i]], j], {i, 1, Length[listOFSingleMultiplicities]}, {j, 1, 3}];
Export["mynotebook.pdf",EvaluationNotebook[]]*)