Computing X-variables for exceptional types

Mutation functions

(**Preliminary functions**)
sgn[a_, b_] := Which[a*b≤ 0, 0, a *b>0, Abs[a]*b]; 
neg[i_, j_, k_] := If[i == k || j == k, -1, 1]; 
b[B_, i_, j_, k_] := neg[i, j, k]*B[[i,j]] + sgn[B[[i,k]], B[[k,j]]]; 
entrypos[B_, k_] := Flatten[Position[Positive[B[[k]]], True]]; 
entryneg[B_, k_] := Flatten[Position[Negative[B[[k]]], True]]; 



(**Mutation functions for X-variables. Note that "list of n variables" means a list enclosed in braces**)
mutmat[B_, k_]:=
Table[b[B,i, j, k],{i, Length[B]},{j, Length[B[[1]]]}]; (** Mutation of matrix B at k. Input: m x n matrix, mutation direction k between 1 and n. Output: m x n matrix**)

xvar[var_, B_]:=Table[Product[var[[i]]^B[[i, j]], {i, Length[B]}], {j, Length[B[[1]]]}]; (** Given a seed in an A-seed pattern S of geometric type, this outputs the X-cluster of the corresponding seed in (OverHat[S]). Input: list of m variables, m x n exchange matrix. Output: list of n variables**)

xmutvar[xvar_, B_,k_]:=Insert[ Table[Together[xvar[[j]](((1+((xvar[[k]])^(-Sign[B[[k, j]]]))))^(-B[[k, j]]))], {j,Delete[Range[Length[B[[1]]]], k] }], ((xvar[[k]])^(-1)), k]; (**X-variable mutation over the universal semifield. Input: list of n X-variables, n x n matrix B, mutation direction k between 1 and n. Output: list of n X-variables.**)

xmutseed[xseed_, k_]:={xmutvar[xseed[[1]], xseed[[2]], k], mutmat[xseed[[2]], k]};  (**X-seed mutation. Input: {list of n variables, n x n exchange matrix},  mutation direction k. Output: (Subscript[μ, k])(xseed)={list of n variables, n x n matrix}**)

xmutseedseq1[xseed_, mutseq_]:=Drop[NestList[{ (Subscript[μ, mutseq[[#[[2]]]]]),#[[2]]+1,xmutseed[#[[3]],mutseq[[#[[2]]]]]}&, {0, 1, xseed}, Length[mutseq]] , None, {2}];  (**Input: {list of n variables, n x n exchange matrix}, list mutseq={(Subscript[i, 1]), ..., (Subscript[i, m])} of mutation directions. Output: A list of length |mutseq|+1 whose jth entry has the form {(Subscript[μ, (Subscript[i, j-1])]), (Subscript[μ, (Subscript[i, j-1])])(Subscript[μ, (Subscript[i, j-2])])...(Subscript[μ, (Subscript[i, 2])])(Subscript[μ, (Subscript[i, 1])])(xseed)}**)

xmutseedseq[xseed_, mutseq_]:=Flatten[Drop[NestList[{#[[1]]+1,xmutseed[#[[2]],mutseq[[#[[1]]]]]}&, {1, xseed}, Length[mutseq]] , None, 1], 1]; (**Input: {list of n variables, n x n exchange matrix}, list {(Subscript[i, 1]), ..., (Subscript[i, m])} of mutation directions. Output: A list of length |mutseq|+1 whose jth entry is the seed (Subscript[μ, (Subscript[i, j-1])])(Subscript[μ, (Subscript[i, j-2])])...(Subscript[μ, (Subscript[i, 2])])(Subscript[μ, (Subscript[i, 1])])(xseed)={list of variables, matrix}**)

xseedtable[xseed_, mutseq_]:=TextGrid[Insert[Map[MatrixForm,xmutseedseq1[xseed, mutseq],{3}], {"Mutation", "Seed"}, 1], Frame->All]; 
(** Input: {list of n variables, n x n exchange matrix}, list mutseq={(Subscript[i, 1]), ..., (Subscript[i, m])} of mutation directions. Outputs a table with 2 columns, whose jth row is: col 1= (Subscript[μ, (Subscript[i, j-1])]), col2= (Subscript[μ, (Subscript[i, j-1])])(Subscript[μ, (Subscript[i, j-2])])...(Subscript[μ, (Subscript[i, 2])])(Subscript[μ, (Subscript[i, 1])])(xseed). **)

xvarlist[xseed_, mutseq_]:=Union[Flatten[xmutseedseq[xseed, mutseq][[All, 1]]]];  (**Input: {list of n variables, n x n exchange matrix}, list mutseq={(Subscript[i, 1]), ..., (Subscript[i, m])} of mutation directions. Output: list of all X-variables appearing in seeds (Subscript[μ, (Subscript[i, j])])(Subscript[μ, (Subscript[i, j])])...(Subscript[μ, (Subscript[i, 2])])(Subscript[μ, (Subscript[i, 1])])(xseed) for j in [1, m]**)

positionDuplicates[list_]:=GatherBy[Range@Length[list],list[[#]]&]; (** Input a list. Output is in format {{positions of entries =1st entry in list},{positions of entries=2nd distinct entry in list}, etc.}**)

(**A-variable analogs (for geometric type only, where frozen variables are listed after mutable variables.)**)
mutvar[var_, B_, k_]:=Together[(Product[var[[i]]^(B[[i, k]]), {i, entrypos[ Transpose[B], k]}]+Product[var[[i]]^(-B[[i, k]]), {i, entryneg[Transpose[B],k]}])/var[[k]]]; (**A-variable mutation. Input: list of m variables, m x n exchange matrix, direction of mutation. Output: mutation of (Subscript[a, k]). Together[] puts everything over a common demoninator; Factor[] may also be appropriate**)

mutseed[seed_, k_]:={ReplacePart[seed[[1]], k-> mutvar[seed[[1]], seed[[2]], k]],mutmat[seed[[2]], k]};(** A-seed mutation. Input:{list of m variables, m x n exchange matrix}, direction of mutation k in [1, n]. Output: (Subscript[μ, k])(seed)={list of m variables, m x n matrix}**)

(**These are exactly the same as the x-versions, but with A-variables instead.**)
mutseedseq1[seed_, mutseq_]:=Drop[NestList[{ (Subscript[μ, mutseq[[#[[2]]]]]),#[[2]]+1,mutseed[#[[3]],mutseq[[#[[2]]]]]}&, {0, 1, seed}, Length[mutseq]] , None, {2}]; 
mutseedseq[seed_, mutseq_]:=Flatten[Drop[NestList[{#[[1]]+1,mutseed[#[[2]],mutseq[[#[[1]]]]]}&, {1, seed}, Length[mutseq]] , None, 1], 1]; 
seedtable[seed_, mutseq_]:=TextGrid[Insert[Map[MatrixForm,mutseedseq1[seed, mutseq],{3}], {"Mutation", "Seed"}, 1], Frame->All]; 
varlist[seed_, mutseq_]:=Union[Flatten[mutseedseq[seed, mutseq][[All, 1]]]];

Type (Subscript[E, 6])

(**Checking that under the specialization of initial A-variables (Subscript[a, 1])-> 2, (Subscript[a, 2])-> 4, (Subscript[a, 3])-> 6, (Subscript[a, 4])-> 8, (Subscript[a, 5])->10, (Subscript[a, 6])->12, every A-variable in an A-seed pattern of type (Subscript[E, 6]) with trivial coefficients will have a unique value. We use mutation along the "bipartite belt" to get a list of seeds containing all 42 A-variables**)

bipE6={{0, 1, 0, 0, 0, 0},{-1, 0, -1, 0, 0, 0},{0, 1, 0, 1, 0, 1},{0, 0, -1, 0, -1, 0},{0, 0, 0, 1, 0, 0},{0, 0, -1, 0, 0, 0}};
bipBeltMut={2, 4, 6, 1, 3, 5,2, 4, 6, 1, 3, 5,2, 4, 6, 1, 3, 5,2, 4, 6, 1, 3, 5,2, 4, 6, 1, 3, 5,2, 4, 6, 1, 3, 5,2, 4, 6, 1, 3, 5};
varlist[{{(Subscript[x, 1]), (Subscript[x, 2]), (Subscript[x, 3]), (Subscript[x, 4]), (Subscript[x, 5]), (Subscript[x, 6])},bipE6}, bipBeltMut]/.{(Subscript[x, 1])-> 2, (Subscript[x, 2])-> 4, (Subscript[x, 3])-> 6, (Subscript[x, 4])-> 8, (Subscript[x, 5])->10, (Subscript[x, 6])->12}
Length[%]

(**Finding a mutation sequence that reaches all 833 seeds in a type (Subscript[E, 6]) A-seed pattern. Since the exchange graph of the A-seed pattern covers the exchange graph of any X-seed pattern, this mutation sequence will also reach all seeds of the X-seed pattern.**)

e6SeedsLong=Sort/@mutseedseq[{{2, 4, 6, 8, 10, 12},bipE6},Flatten@Table[{1, 2, 3, 4, 5, 6, 3, 2},{i,799}]][[All, 1]]; (**This is a list of A-clusters with many duplicates, with initial variables specialized as above, and individual seeds sorted with variables from least to greatest**)
e6DistinctSeeds=positionDuplicates[e6SeedsLong][[All, 1]]; (**This list contains the positions of the distinct seeds from e6SeedsLong**)
Length[%]

e6AllXSeeds=xmutseedseq[{{(Subscript[x, 1]), (Subscript[x, 2]), (Subscript[x, 3]), (Subscript[x, 4]), (Subscript[x, 5]), (Subscript[x, 6])},bipE6}, Flatten@Table[{1, 2, 3, 4, 5, 6, 3, 2},{i,799}]][[e6DistinctSeeds, 1]]; (**This is a list containing the X-clusters of seeds from the mutation sequence that produced e6SeedsLong in positions given by e6DistinctSeeds**)

Union[ExpandNumerator@ExpandDenominator@Flatten@e6AllXSeeds] (**Applying extra simplification on variables in e6AllXSeeds and deleting duplicates from the list of variables appearing in e6AllXSeeds**)
Length[%]

Type (Subscript[E, 7])

boxE7={{0, 0, 1, -1, 0, 0, -1},{0, 0, 1, 0, 1, 0, -1},{-1, -1, 0, 1, 0, 0, 1},{1, 0, -1, 0, 0, 1, 0},{0, -1, 0, 0, 0, 0, 1},{0, 0, 0, -1, 0, 0, 0},{1, 1, -1, 0, -1, 0, 0}}; (**A matrix mutation equivalent to a matrix with Cartan companion of type (Subscript[E, 7]). Starting with this exchange matrix produces particularly simple expressions for A- and X-variables.**)

e7SeedsLong=Sort/@mutseedseq[{{2, 4, 6, 8, 10, 12, 14},boxE7},Flatten@{5, 2, 3, 4, 7, 5, 2, 6, 1,Table[{7, 3, 4, 5, 6, 2, 1, 5, 4, 3},{i,4002}]}][[All, 1]]; (**List of A-seeds, with initial variables specialized to 2, 4, 6, 8, 10, 12, 14. The variables in each seed are listed from least to greatest.**)

Length@DeleteDuplicates[%] (**Checking that the above list of seeds contains all 4160 seeds**)

e7DistinctSeeds=positionDuplicates[e7SeedsLong][[All, 1]]; (**Positions of distinct seeds in e7SeedsLong**)

e7AllXSeeds=xmutseedseq[{{(Subscript[x, 1]), (Subscript[x, 2]), (Subscript[x, 3]), (Subscript[x, 4]), (Subscript[x, 5]), (Subscript[x, 6]), (Subscript[x, 7])},boxE7}, Flatten@{5, 2, 3, 4, 7, 5, 2, 6, 1,Table[{7, 3, 4, 5, 6, 2, 1, 5, 4, 3},{i,4002}]}][[e7DistinctSeeds, 1]];  (**List of X-seeds, generated by taking the same mutation sequence as in e7SeedsLong and then picking the elements in positions given by e7DistinctSeeds**)

Union[ExpandNumerator@ExpandDenominator@Flatten@e7AllXSeeds](**Applying extra simplification on variables in e7AllXSeeds and deleting duplicates from the list of variables appearing in e7AllXSeeds**)

Length[%]

Type (Subscript[E, 8])

boxE8={{0, 0, -1, 1, 0, 0, 0, 0},{0, 0, 0, 0,-1, 0, 0, 1},{1, 0, 0, -1, 0, 1, 0, 0},{-1, 0, 1, 0, 0, -1, 1, 0},{0, 1, 0, 0, 0, -1, 1, -1},{0, 0, -1, 1, 1, 0, -1, 0},{0, 0, 0, -1, -1, 1, 0, 1},{0, -1, 0, 0, 1, 0, -1, 0}};(**A matrix mutation equivalent to a matrix with Cartan companion of type (Subscript[E, 8]). Starting with this exchange matrix produces particularly simple expressions for A- and X-variables.**)

e8SeedsLong=Sort/@mutseedseq[{{2, 4, 6, 8, 10, 12, 14, 16},boxE8},Flatten[ {2,8,5,7,5, 3,8, 4, 5, 3, 6, 2, 7, 1, Table[{1, 2, 3, 4, 5, 6, 7, 8, 5, 4, 3, 2},{i,22500}]}]][[All, 1]];
(**List of A-seeds, with initial variables specialized to 2, 4, 6, 8, 10, 12, 14, 16. The variables in each seed are listed from least to greatest.**)

Length[DeleteDuplicates[%]](**Checking that the above list of seeds contains all 25080 seeds**)
e8DistinctSeeds=positionDuplicates[e8SeedsLong][[All, 1]];(**Positions of distinct seeds in e8SeedsLong**)

(**Note: this section of code was run on APPSA, a high performance computing server, and took a few days to finish.**)

e8AllXSeeds=xmutseedseq[{{(Subscript[x, 1]), (Subscript[x, 2]), (Subscript[x, 3]), (Subscript[x, 4]), (Subscript[x, 5]), (Subscript[x, 6]), (Subscript[x, 7]), (Subscript[x, 8])},boxE8},Flatten[ {2,8,5,7,5, 3,8, 4, 5, 3, 6, 2, 7, 1, Table[{1, 2, 3, 4, 5, 6, 7, 8, 5, 4, 3, 2},{i,22500}]}]][[e8DistinctSeeds, 1]](**List of X-seeds, generated by taking the same mutation sequence as in e8SeedsLong and then picking the elements in positions given by e8DistinctSeeds**)

Union[ExpandNumerator@ExpandDenominator@Flatten@e8AllXSeeds] (**Applying extra simplification on variables in e8AllXSeeds and deleting duplicates from the list of variables appearing in e8AllXSeeds**)
Length[%]

Type (Subscript[F, 4])

(**Checking that under the specialization of initial A-variables (Subscript[a, 1])->1, (Subscript[a, 2])->2, (Subscript[a, 3])->4, (Subscript[a, 4])->8, every A-variable in an A-seed pattern of type (Subscript[F, 4]) has a unique value. We specialize to numbers so that Mathematica can easily distinguish between seeds.**)
varlist[{{1, 2, 4, 8},{{0, 1, 0, 0},{-1, 0, 1, 0},{0, -2, 0, 1},{0, 0, -1, 0}}}, {1, 2,3, 4, 3, 2, 1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3,2, 1, 2, 3, 2,3, 2, 1, 3, 4, 3, 2, 1, 2, 3, 4 , 3, 2, 1, 3, 2, 4, 3, 2, 3, 2}]
Length[%]

(**Finding a mutation sequence that reaches all 105 seeds in a type (Subscript[F, 4]) A-seed pattern. We check this by sorting every seed from least to greatest and then counting how many distinct seeds were reached.**)
f4seq={1, 2,3, 4, 3, 2, 1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3,2, 1, 2, 3, 2,3, 2, 1, 3, 4, 3, 2, 1, 2, 3, 4 , 3, 2, 1, 3, 2, 4, 3, 2, 3, 2 ,1, 2,3, 4, 3, 2, 1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3,2, 1, 2, 3, 2,3, 2, 1, 3, 4, 3, 2, 1, 2, 3, 4 , 3, 2, 1, 3, 2, 4, 3, 2, 3, 2 , 1, 2,3, 4, 3, 2, 1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3,2, 1, 2, 3, 2,3, 2, 1, 3, 4, 3, 2, 1, 2, 3, 4 , 3, 2, 1, 3, 2, 4, 3, 2, 3, 2, 1, 2,3, 4, 3, 2, 1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3,2, 1, 2, 3, 2,3, 2, 1, 3, 4, 3, 2, 1, 2, 3, 4 , 3, 2, 1, 3, 2, 4, 3, 2, 3, 2 , 1, 2, 3, 4, 3, 2, 3,1, 2, 3, 4, 3, 2, 1, 4, 3, 1 ,1, 2,3, 4, 3, 2, 1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3,2, 1, 2, 3, 2,3, 2, 1, 3, 4, 3, 2, 1, 2, 3, 4 , 3, 2, 1, 3, 2, 4, 3, 2, 3, 2 ,1, 2,3, 4, 3, 2, 1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3,2, 1, 2, 3, 2,3, 2, 1, 3, 4, 3, 2, 1, 2, 3, 4 , 3, 2, 1, 3, 2, 4, 3, 2, 3, 2 , 1, 2,3, 4, 3, 2, 1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3,2, 1, 2, 3, 2,3, 2, 1, 3, 4, 3, 2, 1, 2, 3, 4 , 3, 2, 1, 3, 2, 4, 3, 2, 3, 2, 1, 2,3, 4, 3, 2, 1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3,2, 1, 2};

Sort/@mutseedseq[{{1, 2, 4, 8},{{0, 1, 0, 0},{-1, 0, 1, 0},{0, -2, 0, 1},{0, 0, -1, 0}}}, f4seq][[All, 1]];

Length[DeleteDuplicates[%]]

(**Computing the number of X-variables contained in the seeds of a type (Subscript[F, 4]) X-seed pattern**)
xvarlist[{{(Subscript[y, 1]), (Subscript[y, 2]), (Subscript[y, 3]), (Subscript[y, 4])},{{0, 1, 0, 0},{-1, 0, 1, 0},{0, -2, 0, 1},{0, 0, -1, 0}}}, f4seq];
Length[%]

Type (Subscript[G, 2])

(** Type (Subscript[G, 2]) A-seed patterns have 8 seeds, so type (Subscript[G, 2]) X-seed patterns have at most 8 seeds. The mutation sequence listed below reaches all possible seeds**)
xvarlist[{{(Subscript[x, 1]), (Subscript[x, 2])},{{0, 3},{-1, 0}}},{1, 2, 1, 2, 1, 2, 1, 2}];
Length[%]