(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



BeginPackage["QuantumGroups`Braiding`",{"QuantumGroups`","WikiLink`","QuantumGroups`Utilities`MatrixWrapper`","QuantumGroups`Utilities`Debugging`","QuantumGroups`Utilities`DataPackage`","QuantumGroups`Representations`","QuantumGroups`MatrixPresentations`","QuantumGroups`RepresentationTensors`"}];


BR=KnotTheory`BR;


CheckBraidingData::usage="";


BraidingData::usage="";


PackageBraidingData::usage="PackageBraidingData[\[CapitalGamma]] writes currently known braiding data for the quantum group \[CapitalGamma] into a data directory in the QuantumGroups` package.";


WriteBraidingDataToWiki::usage="WriteBraidingDataToWiki[V,k] tries to calculate braiding data for the k-fold tensor power of a representation V, and saves the results in the Knot Atlas.";


LoadAllBraidingDataFromWiki::usage="LoadAllBraidingDataFromWiki[] retrieves all currently calculated braiding data from the Knot Atlas.";


Begin["`Private`"];


BR[2,{1}][\[CapitalGamma]_,{V1_,V2_},\[Beta]_]:=NormalisedBraidingMap[\[CapitalGamma],V1\[CircleTimes]V2,\[Beta]]


BR[n_,{1}][\[CapitalGamma]_,V_List,\[Beta]_]:=BR[n,{1}][\[CapitalGamma],V,\[Beta]]=Fold[#1\[CircleTimes]#2&,NormalisedBraidingMap[\[CapitalGamma],V[[1]]\[CircleTimes]V[[2]],\[Beta]],IdentityMap[\[CapitalGamma],#,\[Beta]]&/@Drop[V,2]]


BR[n_,{-1}][\[CapitalGamma]_,V_List,\[Beta]_]:=BR[n,{-1}][\[CapitalGamma],V,\[Beta]]=Inverse[BR[n,{1}][\[CapitalGamma],V,\[Beta]]]


BR[n_,{k_Integer}][\[CapitalGamma]_,V_List,\[Beta]_]/;1<k<n:=BR[n,{k}][\[CapitalGamma],V,\[Beta]]=Module[{ib,as,ias,aib,r},
DebugPrintHeld["Calculating (what a waste!) ",BR[n,{k}][\[CapitalGamma],V,\[Beta]]];
ib=IdentityMap[\[CapitalGamma],CircleTimes@@Take[V,k-1],\[Beta]]\[CircleTimes]NormalisedBraidingMap[\[CapitalGamma],V[[k]]\[CircleTimes]V[[k+1]],\[Beta]];
as=Associator[\[CapitalGamma],CircleTimes@@Take[V,k-1],V[[k]],V[[k+1]],\[Beta]];
ias=InverseAssociator[\[CapitalGamma],CircleTimes@@Take[V,k-1],V[[k]],V[[k+1]],\[Beta]];
aib=as.ib.ias;
r=Fold[#1\[CircleTimes]#2&,aib,IdentityMap[\[CapitalGamma],#,\[Beta]]&/@Drop[V,k+1]];
DebugPrint["... finished calculating, result ",ByteCount[r], " bytes"];
r
]


BR[n_,{k_Integer}][\[CapitalGamma]_,V_List,\[Beta]_]/;1<-k<n:=BR[n,{k}][\[CapitalGamma],V,\[Beta]]=Module[{ib,as,ias,aib,r},
DebugPrintHeld["Calculating (what a waste!) ",BR[n,{k}][\[CapitalGamma],V,\[Beta]]];
ib=IdentityMap[\[CapitalGamma],CircleTimes@@Take[V,(-k)-1],\[Beta]]\[CircleTimes]InverseNormalisedBraidingMap[\[CapitalGamma],V[[-k]]\[CircleTimes]V[[-k+1]],\[Beta]];
as=Associator[\[CapitalGamma],CircleTimes@@Take[V,-k-1],V[[-k]],V[[-k+1]],\[Beta]];
ias=InverseAssociator[\[CapitalGamma],CircleTimes@@Take[V,-k-1],V[[-k]],V[[-k+1]],\[Beta]];
aib=as.ib.ias;
r=Fold[#1\[CircleTimes]#2&,aib,IdentityMap[\[CapitalGamma],#,\[Beta]]&/@Drop[V,-k+1]];
DebugPrint["... finished calculating, result ",ByteCount[r], " bytes"];
r
]


BR[n_Integer,{k1_Integer,k2_Integer}][\[CapitalGamma]_,V_List,\[Beta]_]:=BR[n,{k1,k2}][\[CapitalGamma],V,\[Beta]]=Simplify[BR[n,{k1}][\[CapitalGamma],V,\[Beta]].BR[n,{k2}][\[CapitalGamma],V,\[Beta]]]


BR[n_Integer,k_][\[CapitalGamma]_,V:Irrep[\[CapitalGamma]_][_],\[Beta]_]:=BR[n,k][\[CapitalGamma],Table[V,{n}],\[Beta]]


BR[n_Integer,ks:{__Integer}][\[CapitalGamma]_,V_List,\[Beta]_]:=BR[n,ks][\[CapitalGamma],V,\[Beta]]=Simplify[BR[n,Take[ks,Floor[Length[ks]/2]]][\[CapitalGamma],V,\[Beta]].BR[n,Drop[ks,Floor[Length[ks]/2]]][\[CapitalGamma],V,\[Beta]]]


ChangeBasis[map_,basis_]:=Module[{},
DebugPrint["ChangeBasis called with ",Dimensions[map]," ",Length[basis]];
lastChangeBasisArguments={map,basis};
Together[Transpose[LinearSolve[Transpose[basis],Together[map.Transpose[basis]],Method->OneStepRowReduction]]]
]


BraidingMatrices[\[CapitalGamma]_][V_,n_Integer,\[Lambda]_]:=BraidingMatrices[\[CapitalGamma]][V,n,\[Lambda]]=Module[{a,hwv,matrices,inverses},
DebugPrintHeld["Calculating ",BraidingMatrices[\[CapitalGamma]][V,n,\[Lambda]]];
hwv=HighWeightVectors[\[CapitalGamma]][
\!\(\*SuperscriptBox[\(V\), \(\[CircleTimes]n\)]\),FundamentalBasis,\[Lambda]];
DebugPrint["Changing basis ..."];
matrices=Table[ChangeBasis[MatrixData[BR[n,{i}][\[CapitalGamma],V,FundamentalBasis][\[Lambda]]],hwv],{i,1,n-1}];
DebugPrint["Computing inverses directly ..."];
inverses=MatrixInverse/@matrices;
DebugPrint["Computing inverses again! ..."];
inverses=Table[ChangeBasis[MatrixData[BR[n,{-i}][\[CapitalGamma],V,FundamentalBasis][\[Lambda]]],hwv],{i,1,n-1}];
DebugPrint["Finished calculating braiding matrices."];
Together[{matrices,inverses}]
]


LoadBraidingData[Subscript[\[CapitalGamma]_, n_]]:=Module[{},
Off[Get::noopen,Needs::nocont];
Needs["QuantumGroups`Data`"<>SymbolName[\[CapitalGamma]]<>ToString[n]<>"`BraidingData`"];
On[Get::noopen,Needs::nocont];
LoadBraidingData[Subscript[\[CapitalGamma], n]]=False;
True
]


autosaveBraidingData=True;


BraidingData[\[CapitalGamma]_][V_,n_Integer]:=Module[{result},
BraidingData[\[CapitalGamma]][V,n]=result=
If[LoadBraidingData[\[CapitalGamma]],BraidingData[\[CapitalGamma]][V,n],
{qDimension[\[CapitalGamma]][Irrep[\[CapitalGamma]][#]],BraidingMatrices[\[CapitalGamma]][V,n,#]}&/@HighWeights[\[CapitalGamma],
\!\(\*SuperscriptBox[\(V\), \(\[CircleTimes]n\)]\)]
];
If[autosaveBraidingData,PackageBraidingData[\[CapitalGamma]]];
result
]


CheckBraidingData[m:{__?MatrixQ}]:=And@@Table[ZeroMatrixQ[Matrix[Simplify[m[[i]].m[[i+1]].m[[i]]-m[[i+1]].m[[i]].m[[i+1]]]]],{i,1,Length[m]-1}]


CheckBraidingData[{m:{__?MatrixQ},i:{__?MatrixQ}}]:=(Length[m]==Length[i])\[And](And@@Table[ZeroMatrixQ[Matrix[Simplify[m[[k]].i[[k]]-IdentityMatrix[Length[m[[k]]]]]]],{k,1,Length[m]}])\[And]CheckBraidingData[m]


CheckBraidingData[d:{{_,{{__?MatrixQ},{__?MatrixQ}}}..}]:=And@@(CheckBraidingData/@(Last/@d))


CheckBraidingData[\[CapitalGamma]_][V_,k_]:=CheckBraidingData[BraidingData[\[CapitalGamma]][V,k]]


PackageBraidingData[Subscript[\[CapitalGamma]_, n_]]:=PackageData[
BraidingData,BraidingData[Subscript[\[CapitalGamma], n]][_,_],
{ToString[\[CapitalGamma]]<>ToString[n],"BraidingData"},
"Needs"->{"QuantumGroups`","QuantumGroups`Braiding`"},
"ExtraPrivateCode"->"q=Global`q;"
]


listToString[x_List]:=listToString[x,","]


listToString[x_List,s_String]:=StringJoin[Drop[Flatten[Transpose[{ToString/@x,Table[s,{Length[x]}]}]],-1]]


WriteBraidingDataToWiki[V_,k_]:=WriteBraidingDataToWiki[V,k,200*10^6]


WriteBraidingDataToWiki[Irrep[Subscript[\[CapitalGamma]_, n_]][\[Lambda]_],k_,M_]:=MemoryConstrained[Module[{},
If[CheckBraidingData[Subscript[\[CapitalGamma], n]][Irrep[Subscript[\[CapitalGamma], n]][\[Lambda]],k]=!=True,Print["The braiding data for ",
\!\(\*SuperscriptBox[\(\(Irrep[
\*SubscriptBox[\(\[CapitalGamma]\), \(n\)]]\)[\[Lambda]]\), \("\<\[CircleTimes]\>" <> ToString[k]\)]\)," is invalid!"];Return[$Failed]];
PackageBraidingData[Subscript[\[CapitalGamma], n]];
WikiSetPageText["Data:Braiding/"<>ToString[\[CapitalGamma]]<>"_"<>ToString[n]<>"/"<>listToString[\[Lambda]]<>"/"<>ToString[k],ToString[BraidingData[Subscript[\[CapitalGamma], n]][Irrep[Subscript[\[CapitalGamma], n]][\[Lambda]],k],InputForm]]
],
M]/.$Aborted:>(Print["Aborted because the calculation exceeded the current memory limit: ",M];$Aborted)


LoadBraidingDataFromWiki[Irrep[Subscript[\[CapitalGamma]_, n_]][\[Lambda]_],k_]:=Module[{text},
text=WikiGetPageText["Data:Braiding/"<>ToString[\[CapitalGamma]]<>"_"<>ToString[n]<>"/"<>listToString[\[Lambda]]<>"/"<>ToString[k]];
If[text==""\[Or]text==$Failed,Return[$Failed]];
BraidingData[Subscript[\[CapitalGamma], n]][Irrep[Subscript[\[CapitalGamma], n]][\[Lambda]],k]=ToExpression[text,InputForm]
]


LoadAllBraidingDataFromWiki[]:=Module[{targets,irrep,results={}},
targets=WikiAllPages["http://katlas.math.toronto.edu/w/index.php","Braiding","Data",100];
StringCases[#,"Data:Braiding/"~~\[CapitalGamma]_~~"_"|" "~~n:(DigitCharacter..)~~"/"~~\[Lambda]:((DigitCharacter..~~",")...~~DigitCharacter..)~~"/"~~k:(DigitCharacter..):>
(irrep=Irrep[Subscript[ToExpression[\[CapitalGamma]], ToExpression[n]]][ToExpression["{"<>\[Lambda]<>"}"]];
Print["Loading braiding data for ",
\!\(\*SuperscriptBox[\(irrep\), \("\<\[CircleTimes]\>" <> k\)]\)];results=results~Join~{{irrep,ToExpression[k]}};
LoadBraidingDataFromWiki[irrep,ToExpression[k]])
]& /@ targets;
results
]


End[];


EndPackage[];
