pivots[A_]:=Flatten[FirstPosition[1]/@Transpose[A]]

pMatrix[n_]:=Table[
Which[i==2&&j==1||i==1&&j==2,-1/2,
i==j&&i>2,1,
True,0],{i, n},{j,n}]

gramMatrix[W_]:=Simplify[Transpose[W].pMatrix[Length[W]].W]

linearRelationsMatrix[G_]:=RowReduce[G][[1;;MatrixRank[G]]]//Transpose

linearRelations[L_]:=Select[
Table[Equal[(Subscript[b, i]),L[[i]].Table[(Subscript[b, i]),{i,pivots[L]}]],{i,Length[L]}],Not[BooleanQ[#]]&]

linearRelationsFromW=linearRelations@*linearRelationsMatrix@*gramMatrix;

inverseLinearRelations[G_]:=Table[If[i==#,1,0],{i,Length[G[[1]]]}]&/@Flatten[FirstPosition[#,1]&/@(RowReduce[G]//Select[Not[AllTrue[#,#==0&]]&])]

quadraticFormMatrix[G_,L_]:=Inverse[Table[G[[i, j]],{i,pivots[L]},{j,pivots[L]}]]

quadraticForm[Q_,L_]:=Module[{v=Table[(Subscript[b, i]),{i,pivots[L]}]},Simplify[v.Q.v==0]]

quadform[W_]:=Module[{G=gramMatrix[W]},Module[{L=linearRelationsMatrix[G]},quadraticForm[quadraticFormMatrix[G,L],L]]]

quadformFromG[G_]:=Module[{L=linearRelationsMatrix[G]},quadraticForm[quadraticFormMatrix[G,L],L]]

graphFromG[G_]:=PlanarGraph[AdjacencyGraph[If[#==-1,1,0]&/@#&/@G,VertexLabels->"Name"]]

nextCandidate[s_,t_,adj_]:=Block[{length,pos},length=Length[adj];
pos=Mod[Position[adj,s][[1,1]]+1,length,1];
{t,adj[[pos]]}];

FindFace[g_?PlanarGraphQ]:=Block[{emb},emb=GraphEmbedding[g,"PlanarEmbedding"];
FindFace[g,emb]];

FindFace[g_?PlanarGraphQ,emb_]:=Block[{m,orderings,pAdj,rightF,s,t,initial,face},m=AdjacencyMatrix[g];
Table[pAdj[v]=SortBy[Pick[VertexList[g],m[[v]],1],ArcTan@@(emb[[v]]-emb[[#]])&],{v,VertexList[g]}];
rightF[_]:=False;
Reap[Table[If[!rightF[e],s=e[[1]];
t=e[[2]];
initial=s;
face={s};
While[t=!=initial,rightF[UndirectedEdge[s,t]]=True;
{s,t}=nextCandidate[s,t,pAdj[t]];
face=Join[face,{s}];];
Sow[face];],{e,EdgeList[g]}]][[2,1]]]

findGenerators[faces_,vertices_,G_]:=Table[Block[{face,otherVertex,verticesOnFace,allVertices,Gp,P,Gnew,L,Q,Qform,sol1,sol2,sols,coeff,coeffTable,small,Li,P2},
face=faces[[i]];
verticesOnFace=Sort[RandomSample[face,3]];
otherVertex=RandomChoice[Select[vertices,Not[MemberQ[face,#]]&]];
allVertices=Append[verticesOnFace,otherVertex];
P=Transpose[IdentityMatrix[Length[vertices]][[#]]&/@DeleteDuplicates[Join[allVertices,vertices]]];
Gnew=Transpose[P].G.P;
L=linearRelationsMatrix[Gnew];
Gp=Table[G[[i,j]],{i,allVertices},{j,allVertices}];
Q=Inverse[Gp];
Qform=(#.Q.#&[Table[(Subscript[b, j]),{j,allVertices}]])==0;
sols=Expand[FullSimplify[Total[#[[1]][[2]]&/@Solve[Qform,(Subscript[b, otherVertex])]]]];
coeff=Table[sols/.Table[(Subscript[b, i])->If[i==curr,1,0],{i,allVertices}],{curr,allVertices}];
small=IdentityMatrix[Length[allVertices]];
small[[-1]]=Table[If[j==4,-1,If[MemberQ[verticesOnFace,allVertices[[j]]],coeff[[j]],0]],{j,Length[allVertices]}];
Li=Table[Table[If[j==k,1,0],{j,Length[vertices]}],{k,allVertices}];
P2=Table[If[j==k,1,0],{j,Length[vertices]},{k,DeleteDuplicates[Join[allVertices,vertices]]}];
P2.L.small.Li
],{i,Length[faces]}]

findGeneratorsN[faces_,vertices_,G_]:=Table[Block[{face,otherVertex,verticesOnFace,allVertices,Gp,P,Gnew,L,Q,Qform,sol1,sol2,sols,coeff,coeffTable,small,Li,P2},
face=faces[[i]];
verticesOnFace=Sort[RandomSample[face,3]];
otherVertex=RandomChoice[Select[vertices,Not[MemberQ[face,#]]&]];
allVertices=Append[verticesOnFace,otherVertex];
P=Transpose[IdentityMatrix[Length[vertices]][[#]]&/@DeleteDuplicates[Join[allVertices,vertices]]];
Gnew=Transpose[P].G.P;
L=linearRelationsMatrix[Gnew];
Gp=Table[G[[i,j]],{i,allVertices},{j,allVertices}];
Q=Inverse[Gp];
Qform=(#.Q.#&[Table[(Subscript[b, j]),{j,allVertices}]])==0;
sols=Expand[FullSimplify[Total[#[[1]][[2]]&/@NSolve[Qform,(Subscript[b, otherVertex])]]]];
coeff=Table[sols/.Table[(Subscript[b, i])->If[i==curr,1,0],{i,allVertices}],{curr,allVertices}];
small=IdentityMatrix[Length[allVertices]];
small[[-1]]=Table[If[j==4,-1,If[MemberQ[verticesOnFace,allVertices[[j]]],coeff[[j]],0]],{j,Length[allVertices]}];
Li=Table[Table[If[j==k,1,0],{j,Length[vertices]}],{k,allVertices}];
P2=Table[If[j==k,1,0],{j,Length[vertices]},{k,DeleteDuplicates[Join[allVertices,vertices]]}];
P2.L.small.Li
],{i,Length[faces]}]

findGeneratorsFromG[G_]:=findGeneratorsN[FindFace[PlanarGraph[AdjacencyGraph[If[#==-1,1,0]&/@#&/@G,VertexLabels->"Name"]]],Range[Length[G]],G]

search[generators_,current_,lastgen_,upperBound_,faces_]:=Block[{totals,invalid},
invalid[σ_,face_]:=σ==lastgen||AllTrue[Delete[σ.current,{#}&/@face],#>upperBound&];
totals[i_]:=If[invalid[generators[[i]],faces[[i]]],0,
Length[current]-Length[faces[[i]]]-Length[Select[Delete[current,{#}&/@faces[[i]]],#>upperBound&]]+search[generators,generators[[i]].current,generators[[i]],upperBound,faces]];
Total[totals/@Range[Length[generators]]]]

$RecursionLimit=16384

fractalDimensionFromG[G_,max_,delta_,root_]:=Block[{xs,ys,data,graph,faces,sigmas,nlm,params},
xs=Range[1,max,delta];
graph=graphFromG[G];
faces=FindFace[graph];
sigmas=findGeneratorsFromG[G];
ys=search[sigmas,root,{},#,faces]+Length[root]&/@xs;
data={xs[[#]],ys[[#]]}&/@Range[Length[ys]];
nlm=NonlinearModelFit[data,a (x^b),{a,b},x];
params=nlm["BestFitParameters"];
b/.params
]

pyramidG[n_]:=Table[Which[i==0&&j==0,1,i==0||j==0,-1,True,1-((2((Sin[((Abs[i-j]π)/n)])^2))/((Sin[(π/n)])^2))],{i,0,n},{j,0,n}]

pyramidFractalDimension[n_,max_,delta_]:=fractalDimensionFromG[N[pyramidG[n]],max,delta,N[Table[If[i==n+1,-1,((Sec[(π/n)]+Tan[(π/n)])/(Tan[(π/n)]))],{i,n+1}]]]

(*Timing[pyramidFractalDimension[11,100000,10000]]*)

G=RootApproximant[{{1.0000000000000004`,-4.603875471609728`,-17.195669358089372`,-27.293504037134028`,-27.293504037134024`,-17.195669358089397`,-4.603875471609722`,-1.0000000000000415`,-1.0000000000000464`,-11.097834679044736`,-23.68962856552439`,-29.29350403713411`,-23.689628565524348`,-11.097834679044773`,-1.0000000000000546`,-2.1099162641748395`},{-4.603875471609728`,0.9999999999999993`,-4.603875471609711`,-17.195669358089315`,-27.293504037133978`,-27.29350403713407`,-17.19566935808935`,-11.09783467904471`,-1.0000000000000389`,-1.0000000000000369`,-11.097834679044713`,-23.689628565524337`,-29.293504037134017`,-23.689628565524426`,-1.0000000000000546`,-2.109916264174834`},{-17.195669358089372`,-4.603875471609711`,0.9999999999999978`,-4.603875471609712`,-17.19566935808932`,-27.293504037134067`,-27.29350403713402`,-23.689628565524316`,-11.097834679044697`,-1.0000000000000435`,-1.0000000000000424`,-11.097834679044714`,-23.689628565524323`,-29.293504037134156`,-1.0000000000000537`,-2.109916264174835`},{-27.293504037134028`,-17.195669358089315`,-4.603875471609712`,0.999999999999999`,-4.603875471609698`,-17.195669358089347`,-27.29350403713398`,-29.293504037133978`,-23.68962856552428`,-11.097834679044709`,-1.0000000000000397`,-1.0000000000000369`,-11.09783467904469`,-23.68962856552439`,-1.0000000000000524`,-2.1099162641748315`},{-27.293504037134024`,-27.293504037133978`,-17.19566935808932`,-4.603875471609698`,0.9999999999999971`,-4.603875471609718`,-17.195669358089315`,-23.689628565524277`,-29.293504037133978`,-23.689628565524316`,-11.097834679044704`,-1.000000000000044`,-1.0000000000000373`,-11.097834679044743`,-1.0000000000000517`,-2.109916264174833`},{-17.195669358089397`,-27.29350403713407`,-27.293504037134067`,-17.195669358089347`,-4.603875471609718`,1.000000000000002`,-4.60387547160972`,-11.097834679044714`,-23.689628565524355`,-29.29350403713411`,-23.689628565524387`,-11.09783467904475`,-1.0000000000000386`,-1.000000000000049`,-1.000000000000056`,-2.1099162641748386`},{-4.603875471609722`,-17.19566935808935`,-27.29350403713402`,-27.29350403713398`,-17.195669358089315`,-4.60387547160972`,0.9999999999999964`,-1.0000000000000377`,-11.09783467904471`,-23.689628565524345`,-29.293504037134056`,-23.689628565524348`,-11.097834679044695`,-1.000000000000048`,-1.0000000000000544`,-2.109916264174834`},{-1.0000000000000415`,-11.09783467904471`,-23.689628565524316`,-29.293504037133978`,-23.689628565524277`,-11.097834679044714`,-1.0000000000000377`,1.0000000000000029`,-4.6038754716097054`,-17.19566935808932`,-27.293504037133985`,-27.29350403713398`,-17.195669358089283`,-4.603875471609719`,-2.1099162641748332`,-1.0000000000000515`},{-1.0000000000000464`,-1.0000000000000389`,-11.097834679044697`,-23.68962856552428`,-29.293504037133978`,-23.689628565524355`,-11.09783467904471`,-4.6038754716097054`,0.9999999999999983`,-4.603875471609701`,-17.195669358089315`,-27.293504037133978`,-27.293504037133946`,-17.195669358089383`,-2.109916264174833`,-1.000000000000051`},{-11.097834679044736`,-1.0000000000000369`,-1.0000000000000435`,-11.097834679044709`,-23.689628565524316`,-29.29350403713411`,-23.689628565524345`,-17.19566935808932`,-4.603875471609701`,1.`,-4.603875471609716`,-17.19566935808934`,-27.29350403713399`,-27.293504037134106`,-2.1099162641748364`,-1.0000000000000524`},{-23.68962856552439`,-11.097834679044713`,-1.0000000000000424`,-1.0000000000000397`,-11.097834679044704`,-23.689628565524387`,-29.293504037134056`,-27.293504037133985`,-17.195669358089315`,-4.603875471609716`,0.9999999999999998`,-4.60387547160971`,-17.195669358089326`,-27.293504037134106`,-2.1099162641748364`,-1.0000000000000524`},{-29.29350403713411`,-23.689628565524337`,-11.097834679044714`,-1.0000000000000369`,-1.000000000000044`,-11.09783467904475`,-23.689628565524348`,-27.29350403713398`,-27.293504037133978`,-17.19566935808934`,-4.60387547160971`,0.9999999999999984`,-4.603875471609714`,-17.195669358089404`,-2.109916264174836`,-1.0000000000000533`},{-23.689628565524348`,-29.293504037134017`,-23.689628565524323`,-11.09783467904469`,-1.0000000000000373`,-1.0000000000000386`,-11.097834679044695`,-17.195669358089283`,-27.293504037133946`,-27.29350403713399`,-17.195669358089326`,-4.603875471609714`,1.0000000000000047`,-4.60387547160972`,-2.109916264174833`,-1.0000000000000515`},{-11.097834679044773`,-23.689628565524426`,-29.293504037134156`,-23.68962856552439`,-11.097834679044743`,-1.000000000000049`,-1.000000000000048`,-4.603875471609719`,-17.195669358089383`,-27.293504037134106`,-27.293504037134106`,-17.195669358089404`,-4.60387547160972`,1.0000000000000004`,-2.109916264174844`,-1.0000000000000555`},{-1.0000000000000546`,-1.0000000000000546`,-1.0000000000000537`,-1.0000000000000524`,-1.0000000000000517`,-1.000000000000056`,-1.0000000000000544`,-2.1099162641748332`,-2.109916264174833`,-2.1099162641748364`,-2.1099162641748364`,-2.109916264174836`,-2.109916264174833`,-2.109916264174844`,1.`,-1.3418303776543883`},{-2.1099162641748395`,-2.109916264174834`,-2.109916264174835`,-2.1099162641748315`,-2.109916264174833`,-2.1099162641748386`,-2.109916264174834`,-1.0000000000000515`,-1.000000000000051`,-1.0000000000000524`,-1.0000000000000524`,-1.0000000000000533`,-1.0000000000000515`,-1.0000000000000555`,-1.3418303776543883`,0.9999999999999996`}}];

root=-{-2.6755033759230464`,-2.6755033759230358`,-2.6755033759230473`,-2.6755033759230344`,-2.6755033759230398`,-2.6755033759230433`,-3.71077955633303`,-3.7107795563330153`,-3.7107795563330184`,-3.71077955633302`,-3.7107795563330255`,-3.710779556333014`,0.6213743677192812`,-1.6093357755815325`};

(*fractalDimensionFromG[G,100000,5000,root]*)

W=({{0, 0, 0, -1}, {2, 0, 0, 1}, {0, 3, 0, 1}, {2, 3, (Sqrt[3]), 2}});

P=({{0, -1/2, 0, 0}, {-1/2, 0, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}});

G=({{1, -1, -1, -2}, {-1, 1, -2, -1}, {-1, -2, 1, -1}, {-2, -1, -1, 1}});

W.P.Transpose[W]//MatrixForm

v=Table[(Subscript[b, i]),{i,4}]

eq=Simplify[v.Inverse[G].v]==0

Total[Solve[eq,(Subscript[b, 4])]/.{(Subscript[b, 4])->x_}->x]

sigmas={
({{-1, 2, 2, 0}, {0, 1, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}}),({{1, 0, 0, 0}, {2, -1, 0, 2}, {0, 0, 1, 0}, {0, 0, 0, 1}}),({{1, 0, 0, 0}, {0, 1, 0, 0}, {2, 0, -1, 2}, {0, 0, 0, 1}}),({{1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, 1, 0}, {0, 2, 2, -1}})
};

faces={{2,3,4},{1,3,4},{1,2,4},{1,2,3}};

root={-2,4,5,9};

Total[sigmas[[1]].v]

eq/.{(Subscript[b, 1])->-2,(Subscript[b, 2])->4,(Subscript[b, 3])->5}//Simplify

(*search[sigmas,N[root],-1,20]*)

(*sigmas={
({{-1, 2, 2, 2}, {0, 1, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}}),({{1, 0, 0, 0}, {2, -1, 2, 2}, {0, 0, 1, 0}, {0, 0, 0, 1}}),({{1, 0, 0, 0}, {0, 1, 0, 0}, {2, 2, -1, 2}, {0, 0, 0, 1}}),({{1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, 1, 0}, {2, 2, 2, -1}})
};
faces={{2,3,4},{1,3,4},{1,2,4},{1,2,3}};
root={-6,11,14,23};
Timing[search[sigmas,N[root],{},100000,faces]+Length[root]]*)

sigmas[[1]].root

sigmas[[2]].sigmas[[3]].sigmas[[2]].root//Total

Total[root]

Total[sigmas[[4]].sigmas[[3]].sigmas[[4]].root]

(*search[generators_,current_,lastgen_,upperBound_]:=
Total[Table[If[(generators[[i]].current)[[i]]≥upperBound||Total[generators[[i]].current]≤Total[current],0,1+search[generators,generators[[i]].current,i,upperBound]],{i,4}]]*)

sigmas[[3]].root

(*search[sigmas,N[root],{},10,faces]*)

(*max=100;
delta=10;
xs=Range[1,max,delta];
ys=search[sigmas,N[root],-1,#]+Length[root]&/@xs;
data={xs[[#]],ys[[#]]}&/@Range[Length[ys]];
nlm=NonlinearModelFit[data,a (x^b),{a,b},x];
params=nlm["BestFitParameters"];
b/.params*)

nlm["RSquared"]