In[]:=
EquationsFromSequences[seqs_List]:=Module[{u=Expand[Fold[{n,i}|->1+{a+bI,a-bI}[[i]]n,1,#]]&/@seqs,eqns},eqns=Thread[#==0]&/@(ComplexExpand[ReIm[First[#]]]&/@Union[SubtractSides/@DeleteCases[Flatten[Outer[Equal,u,u]],True|False]])]
In[]:=
AssociationPairings[func_,assoc_]:=With[{keys=Keys[assoc]},Association[#->func[assoc[#[[1]]],assoc[#[[2]]]]&/@Tuples[keys,2]]]
In[]:=
EquationsFromSequencesX[seqs_List]:=Module[{u=Association[#->Expand[Fold[{n,i}|->1+{a+bI,a-bI}[[i]]n,1,#]]&/@seqs],eqns},eqns=Thread[#==0]&/@(ComplexExpand[ReIm[First[#]]]&/@Union[SubtractSides/@DeleteCases[AssociationPairings[Equal,u],True|False]])]
In[]:=
EquationsFromSequencesX[Tuples[{1,2},2]]
Out[]=
{{1,1},{1,2}}{-20,2b+2ab0},{{1,1},{2,1}}{-20,2ab0},{{1,1},{2,2}}{True,2b+4ab0},{{1,2},{1,1}}{20,-2b-2ab0},{{1,2},{2,1}}{True,-2b0},{{1,2},{2,2}}{20,2ab0},{{2,1},{1,1}}{20,-2ab0},{{2,1},{1,2}}{True,2b0},{{2,1},{2,2}}{20,2b+2ab0},{{2,2},{1,1}}{True,-2b-4ab0},{{2,2},{1,2}}{-20,-2ab0},{{2,2},{2,1}}{-20,-2b-2ab0}
2
b
2
b
2
b
2
b
2
b
2
b
2
b
2
b
In[]:=
Association[First/@GatherBy[Normal[Solve[#,{a,b},Reals]&/@EquationsFromSequencesX[Tuples[{1,2},2]]],Last]]
Out[]=
{{1,1},{1,2}}{{b0}},{{1,1},{2,2}}a,{b0}
In[]:=
Fold[{n,u}|->1+{a+bI,a-bI}[[u]]n,{1,1}]
Out[]=
1+a+b
In[]:=
Fold[{n,u}|->1+{a+bI,a-bI}[[u]]n,{2,2}]
Out[]=
1+2(a-b)
In[]:=
Expand[%]
Out[]=
1+2a-2b
In[]:=
Quiet[Association[First/@GatherBy[Normal[Solve[#,{a,b},Reals]&/@EquationsFromSequencesX[Catenate[Table[Tuples[{1,2},m],{m,3}]]]],Last]]]
Out[]=
{{1},{2}}{{b0}},{{1},{1,1}}{{a0,b0}},{{1},{2,2}}{{a-1,b-1},{a-1,b1},{a0,b0}},{{1},{1,1,1}}{{a-1,b0},{a0,b0}},{{1},{1,1,2}}{{a-1,b-1},{a-1,b0},{a-1,b1},{a0,b0}},{{1},{2,2,2}}{a-1,b0},{a0,b0},a,b,a,b,{{1,1},{2,2}}a,{b0},{{1,1},{1,1,2}}a-,b-,a-,b,{a0,b0},{{1,1},{2,2,2}}{a0,b0},a0,b-,b,a,b,{{1,1,1},{1,1,2}}b,a-,b0,a-,b-,a-,b,{{1,1,1},{2,2,1}}a-,b,{{1,1,1},{2,2,2}}{b0},b-,b,b
2
3
2
3
2
3
2
3
2
,a0,b2
,{{1,2},{1,1,1}}{a0,b0},a1
2
1
2
3
2
1
2
3
2
1
2
1+2a+3
,b2
a
1+2a+3
,{{1,1,2},{2,2,1}}b2
a
In[]:=
{Map[Row,First[#]],a+bI/.res[First[#]][[Last[#]]]}&/@{{{1},{2,2}}->2,{{1},{1,1,2}}->1,{{1},{2,2,2}}->3,{{1,1},{1,1,2}}->2,{{1,1},{2,2,2}}->3,{{1,2},{1,1,1}}->2,{{1,1,1},{1,1,2}}->4,{{1,1,1},{2,2,2}}->3,{{1,1,2},{2,2,1}}->3}
Out[]=
{{1,22},-1+},{{1,112},-1-},{1,222},+,{11,112},-+,{11,222},+,{111,112},-+,{111,222},a+
2
3
2
3
2
,{12,111},1
2
3
2
1+2a+3
,{112,221},2
a
{{{1,1,2},{2,2,1}},3}
In[]:=
In[]:=
Out[]=
-2+5-36+16&
2
#1
4
#1
6
#1
In[]:=
N[%]
Out[]=
-1.45975
In[]:=
MinimalPolynomial
Out[]=
-3-16-16+16&
2
#1
4
#1
6
#1
In[]:=
Out[]//InputForm=
Root[{1 + 4*#1 + 4*#1^2 + 4*#1^3 & , 2 + 2*#1 + 3*#1^2 - #2^2 & }, {1, 1}]
Root
In[]:=
ToRadicals
Out[]=
-
1
2
3
4++
64
2/3
(1+3
57
)2/3
(1+3
57
)In[]:=
Simplify[%592]
Out[]=
-
1
2
3
4++
64
2/3
(1+3
57
)2/3
(1+3
57
)In[]:=
FullSimplify[%]
Out[]=
In[]:=
Withz=-+I,NestGraphTagged[n|->Together[{1+zn,1+Conjugate[z]n}],1,3,"StateLabeling"->True,GraphLayout->{"LayeredDigraphEmbedding","RootVertex"->1}]
1
2
Out[]=
In[]:=
Labeled[With[{z=Last[#]},NestGraphTagged[n|->Together[{1+zn,1+Conjugate[z]n}],1,3,"StateLabeling"->True,GraphLayout->{"LayeredDigraphEmbedding","RootVertex"->1}]],#]&/@{{1,22},-1+},{{1,112},-1-},{1,222},+,{11,112},-+,{11,222},+,{111,112},-+,{111,222},a+
2
3
2
3
2
,{12,111},1
2
3
2
1+2a+3
,{112,221},2
a
Out[]=
,
,
,
,
,
,
,
,
{{1,22},-1+} |
{{1,112},-1-} |
{1,222}, |
{11,112},- 2 3 2 3 |
{11,222}, 2 |
{12,111}, |
{111,112},- 1 2 3 2 |
{111,222},a+ 1+2a+3 2 a |
{112,221}, |