2m3ptBSD.nb

Description: 
We compute a type D structure for the (2,-3)-pretzel tangle. Compare this to the calculation in ‘2m3ptmutBSD.nb’, where we use a different parametrization. Exchanging the two parametrizations corresponds to mutation.

Load package BSFH.m

<<BSFH.m

Input data from nice Heegaard diagram

regionsInput= (({{1, 1, 65, \[Placeholder], \[Placeholder]}, {2, 2, 1, 65, 66}, {3, 3, 2, 66, 67}, {4, 4, 3, 67, 68}, {5, 5, 4, 68, 69}, {6, 6, 5, 69, 70}, {7, 8, 7, 10, 9}, {8, 9, 8, \[Placeholder], \[Placeholder]}, {9, 9, 10, 11, 12}, {10, 10, 11, \[Placeholder], \[Placeholder]}, {11, 15, 16, 13, 14}, {12, 14, 15, \[Placeholder], \[Placeholder]}, {13, 8, 16, \[Placeholder], \[Placeholder]}, {14, 7, 8, 16, 15}, {15, 6, 7, 15, 14}, {16, 5, 6, 14, 13}, {17, 4, 5, 13, 12}, {18, 3, 4, 12, 11}, {19, 17, 1, \[Placeholder], \[Placeholder]}, {20, 18, 17, 1, 2}, {21, 64, 17, \[Placeholder], \[Placeholder]}, {22, 17, 18, 63, 64}, {23, 18, 19, 62, 63}, {24, 19, 20, 61, 62}, {25, 20, 21, 60, 61}, {26, 21, 22, 59, 60}, {27, 22, 23, 58, 59}, {28, 24, 25, 39, 40}, {29, 25, 26, 38, 39}, {30, 26, 27, 37, 38}, {31, 27, 37, \[Placeholder], \[Placeholder]}, {32, 28, 27, \[Placeholder], \[Placeholder]}, {33, 29, 28, 27, 26}, {34, 30, 29, 26, 25}, {35, 31, 30, 25, 24}, {36, 32, 31, 24, 23}, {37, 33, 32, 23, 22}, {38, 34, 33, 22, 21}, {39, 35, 34, 21, 20}, {40, 36, 35, 20, 19}, {41, 36, 57, \[Placeholder], \[Placeholder]}, {42, 35, 36, 57, 56}, {43, 34, 35, 56, 55}, {44, 33, 34, 55, 54}, {45, 32, 33, 54, 53}, {46, 31, 32, 53, 52}, {47, 30, 31, 52, 51}, {48, 29, 30, 51, 50}, {49, 28, 29, 50, 49}, {50, 38, 37, 44, 43}, {51, 39, 38, 43, 42}, {52, 40, 39, 42, 41}, {53, 41, 40, \[Placeholder], \[Placeholder]}, {54, 41, 42, 104, 103}, {55, 42, 43, 88, 104}, {56, 43, 44, 89, 88}, {57, 44, 45, 90, 89}, {58, 45, 46, 91, 90}, {59, 46, 45, \[Placeholder], \[Placeholder]}, {60, 46, 47, 92, 91}, {61, 47, 48, 93, 92}, {62, 48, 47, \[Placeholder], \[Placeholder]}, {63, 48, 49, 94, 93}, {64, 49, 50, 95, 94}, {65, 50, 51, 96, 95}, {66, 51, 52, 97, 96}, {67, 52, 53, 98, 97}, {68, 53, 54, 99, 98}, {69, 54, 55, 100, 99}, {70, 55, 56, 101, 100}, {71, 56, 57, 102, 101}, {72, 58, 71, \[Placeholder], \[Placeholder]}, {73, 59, 58, 71, 72}, {74, 60, 59, 72, 73}, {75, 61, 60, 73, 74}, {76, 62, 61, 74, 75}, {77, 63, 62, 75, 76}, {78, 64, 63, 76, 77}, {79, 66, 65, 82, 83}, {80, 67, 66, 83, 84}, {81, 68, 67, 84, 85}, {82, 69, 68, 85, 86}, {83, 70, 69, 86, 87}, {84, 87, 70, \[Placeholder], \[Placeholder]}, {85, 72, 71, 88, 89}, {86, 73, 72, 89, 90}, {87, 74, 73, 90, 91}, {88, 75, 74, 91, 92}, {89, 76, 75, 92, 93}, {90, 77, 76, 93, 94}, {91, 78, 77, 94, 95}, {92, 78, 79, \[Placeholder], \[Placeholder]}, {93, 79, 78, 95, 96}, {94, 80, 79, 96, 97}, {95, 80, 81, \[Placeholder], \[Placeholder]}, {96, 81, 80, 97, 98}, {97, 82, 81, 98, 99}, {98, 83, 82, 99, 100}, {99, 84, 83, 100, 101}, {100, 85, 84, 101, 102}, {101, 86, 85, 102, 103}, {102, 87, 86, 103, 104}}));
alphaarcsInput=(({{1, {17,18,19,20,21,22,23,24,25,26,27}}, {2, {1,2,3,4,5,6,7,8}}, {3, {9,10,11,12,13,14,15,16}}, {4, {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}}, {5, {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}}}));
alphacurvesInput=(({{6, {88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104}}}));
betacurvesInput=(({{1, {89,44,37,27,28,49,94,77,64,17,1,65,82,99,54,33,22,59,72}}, {2, {2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,18,19,20,21,23,24,25,26,29,30,31,32,34,35,36,38,39,40,41,42,43,45,46,47,48,50,51,52,53,55,56,57,58,60,61,62,63,66,67,68,69,70,71,73,74,75,76,78,79,80,81,83,84,85,86,87,88,90,91,92,93,95,96,97,98,100,101,102,103,104}}}));
CancellationSortListInput=(({{46, 45}, {91, 90}, {74, 73}, {61, 60}, {20, 21}, {35, 34}, {56, 55}, {101, 100}, {84, 83}, {67, 66}, {3, 2}, {48, 47}, {93, 92}, {76, 75}, {63, 62}, {18, 19}, {78, 79}, {95, 96}, {50, 51}, {29, 30}, {26, 25}, {38, 39}, {43, 42}, {88, 104}, {80, 81}, {97, 98}, {52, 53}, {31, 32}, {24, 23}, {14, 15}, {6, 7}, {13, 16}, {5, 8}, {10, 11}, {9, 12}, {87, 70}, {86, 69}, {85, 68}, {82, 65}, {58, 71}, {59, 72}, {64, 77}, {36, 57}, {33, 54}, {28, 49}, {41, 40}, {44, 37}}));
RelevantGeneratorQ[v_]:=True;
RelevantGeneratorGenerationQ[listOfAlphas_]:=True;
S1BoundaryInput={{13,8},{1,19,21},{31,32}};
TypeS1=TypeD;
S2BoundaryInput={};
TypeS2=TypeD;
ArcDiagram1MatchingsInput={{6,9},{2,5},{1,3},{8,10},{4,7}};
ArcDiagram2MatchingsInput={};
S1AlwaysOccupiedAlphaArcs={};
S2AlwaysOccupiedAlphaArcs={};
S1PotentiallyOccupiedAlphaArcs={1,2,3,4,5};
S2PotentiallyOccupiedAlphaArcs={};
S1NeverOccupiedAlphaArcs={};
S2NeverOccupiedAlphaArcs={};
NS1oaa=1;
NS2oaa=0;
NR=102;
NI=104;
Step0Preparation;

Setup for backups

(* BackupFilePath=<path for backup>;
To save all variables, use: DumpSave[BackupFilePath<>".mx","Global`"];
To load all variables from this file, use: <<(BackupFilePath<>".mx");
*)
BackupFilePath=NotebookDirectory[]<>"Backups/"<>StringDrop[FileNameTake[NotebookFileName[]],-3]

Calculation of bordered sutured algebra

Step1x1Algebra;

(* Naming idempotents (choose any variable you find appropriate); *)
S1IdemNames={r,e,t,d,c};
S2IdemNames={x};

(* SANITY CHECK: test for multiplication in strands algebra;
S1Reeb[z__] takes a sequence (Subscript[z, 1]),(Subscript[z, 2]),... of an even number of integers and computes the element in the strands algebra for the surface S1 which has a moving strand from the (Subscript[z, 2i+1])st to the (Subscript[z, 2i+2])nd level;
MorH1AlgComp[a_,b_] computes (Subscript[μ, 2]) of two elements a and b in the strands algebra and displays the result using the function 'S1H', see 'Step 5: Basic graphical outputs' in manual;
*)
MorH1AlgComp[S1Reeb[2,3,4,5],S1Reeb[3,4,6,9]];

Step1x2Algebra;

(* Define subalgebra of glueing algebras *)
S1SubalgebraGensInput=(({{"(Subscript[τ, 1])", "\\tau_{1}", 4, {1,2}, 3}, {"(Subscript[τ, 2])", "\\tau_{2}", 3, {2,3}, 4}, {"(Subscript[ρ, 2])", "\\rho_{2}", 5, {5,6}, 4}, {"(Subscript[ρ, 13])", "\\rho_{13}", 4, {4,5,6,7}, 5}, {"(Subscript[ϵ, 1])", "\\varepsilon_{1}", 5, {8,9}, 2}, {"(Subscript[ϵ, 2])", "\\varepsilon_{2}", 2, {9,10}, 5}}));
S2SubalgebraGensInput={};
Step1x3Algebra;

Step1x4Algebra;

Step1x5Algebra;

Calculation of generators

Step2Generators;

Calculation of domains and structure maps

Step3x1Domains;

<<(BackupFilePath<>"_AfterDomains1.mx")

The next two steps can take quite a while for large diagrams, for 250 000 generators up to a week or more. Parallel processing is possible, so consider using a computer with multiple kernels to speed up.

Step3x2Domains;

Step3x3Domains;

Step3x4Domains;

<<(BackupFilePath<>"_BeforeCancellation.mx");

(* SANITY CHECK; you might want to check if you can find some differentials computed here in your nice Heegaard diagram;
SparseNiceFindAllArrowsStartingAt[n_] lists all arrows that start at generator of index 'n' in the list 'generators';
SparseNiceFindAllArrowsStartingAt[n_] lists all arrows that end at generator of index 'n' in the list 'generators';
*)
SparseNiceFindAllArrowsStartingAt[2]
SparseNiceFindAllArrowsEndingAt[3]

Initial cancellation (de-niceification)

Step4CancellationPreparation;

The next step can take quite a while for large diagrams. Consider using a computer with a single fast kernel to speed up, as no parallel evaluation is possible.

BackToStart=CancellationSparse[StructureMapsSparse,generators];
MMit=BackToStart[[1]];
generatorsit=BackToStart[[2]];
(* backup *)
DumpSave[BackupFilePath<>"_AfterCancellation.mx","Global`"];Print[" << backup saved at: " ,BackupFilePath<>"_AfterCancellation.mx >>"];

<<(BackupFilePath<>"_AfterCancellation.mx");

Post-processing: Further cancellations and homotopies

Step5PostProcessing;

PlotGraph[MMit];
(* 
GenTableWithIdems[gens_] displays a list of idempotents and their generators;
*)
GenTableWithIdems[generatorsit]

Evaluate the next function only if the result above is reasonably small, i.e. if it has fewer than 50 generators, say. Otherwise, this can take quite a while and might use a lot of memory.

(* SANITY CHECK;
AInftyQ[mat_] checks that the structure map 'mat' satisfy "D^2=0". If it does not return 'True', something went wrong;
*)
AInftyQ[MMit]

CarefulCancel1=CarefulCancellation[MMit,generatorsit];
MM1=CarefulCancel1[[1]];
GG1=CarefulCancel1[[2]];

ShowGraph[MM1,GG1]

AutoCleanPosns1= AutoCleanPosns[MM1,GG1,Tuples[{Range[9],Range[9]}],50];
MM2=AutoCleanPosns1[[1]];
GG2=GG1;

List of homotopies performed automatically in the previous step:

AutoCleanPosns1[[2]]

ShowGraph[MM2,GG2]

ListOfAllLabels[MM2]

S1H/@{147,148,167,168,170};