This code verifies that my rigid rationally braced nonagon really is rigid. Represent the nine sides viewed as unit vectors through their Weierstrass parameters, fixing one side…
In[]:=
vars=Array[&,8]
t
#
Out[]=
{,,,,,,,}
t
1
t
2
t
3
t
4
t
5
t
6
t
7
t
8
…the values they assume in the (putatively) rigid bracing are then tangents of multiples of . For speed we put them all into the same number field using the multiple-angle formula for tangents.
tan(π/9)
In[]:=
z=AlgebraicNumber[Tan[Pi/9],{0,1}];
In[]:=
mz[m_]:=Sum[(-1)^((k-1)/2)Binomial[m,k]z^k,{k,1,m,2}]/Sum[(-1)^(k/2)Binomial[m,k]z^k,{k,0,m,2}]
In[]:=
x0=Array[->mz[#]&,8];
t
#
In[]:=
evars=Prepend[vars,0];
These are the actual side vectors.
In[]:=
vecs={1-#^2,2#}/(1+#^2)&/@evars
Out[]=
{1,0},,,,,,,,,,,,,,,,
1-
2
t
1
1+
2
t
1
2
t
1
1+
2
t
1
1-
2
t
2
1+
2
t
2
2
t
2
1+
2
t
2
1-
2
t
3
1+
2
t
3
2
t
3
1+
2
t
3
1-
2
t
4
1+
2
t
4
2
t
4
1+
2
t
4
1-
2
t
5
1+
2
t
5
2
t
5
1+
2
t
5
1-
2
t
6
1+
2
t
6
2
t
6
1+
2
t
6
1-
2
t
7
1+
2
t
7
2
t
7
1+
2
t
7
1-
2
t
8
1+
2
t
8
2
t
8
1+
2
t
8
Now we define six constraints, functions that are zero when the constraint is satisfied, corresponding to the six strips of length 19/6 and expressing that certain linear combinations of the vectors must have the prescribed length.
In[]:=
R60=ToNumberField[RotationMatrix[Pi/3],z];
In[]:=
cpart[k_,1]:=Module[{svecs=RotateRight[vecs,3k],va},va=R60.svecs[[1]]/2-svecs[[1]]/3+svecs[[2]]+svecs[[3]]+svecs[[4]]-2svecs[[5]];va.va-(19/6)^2]
In[]:=
cpart[k_,-1]:=Module[{svecs=RotateRight[vecs,3k],va},va=-2svecs[[6]]+svecs[[7]]+svecs[[8]]+svecs[[9]]-svecs[[1]]/3+R60.svecs[[1]]/2;va.va-(19/6)^2]
The nine side vectors forming a loop gives the two remaining constraints needed to theoretically fully determine the system.
In[]:=
f=Join[{Total[(1-evars^2)/(1+evars^2)],Total[2evars/(1+evars^2)]},Flatten[cpart@@@{{0,1},{0,-1},{1,1},{1,-1},{2,1},{2,-1}}]];
Verify that the regular nonagon satisfies the constraints…
In[]:=
f/.x0
Out[]=
{0,0,0,0,0,0,0,0}
…then compute the nullspace of the Jacobian at that point. Since it is zero-dimensional, the braced nonagon is indeed first-order rigid.
In[]:=
NullSpace[D[f,{vars}]/.x0]
Out[]=
{}
For good measure here’s the unit cube rationally braced with just 6 extra strips!
In[]:=
cSignAbs3[v_]:=With[{Nv=RootReduce[Normalize[v]],Av=RootReduce[Norm[v]]},RootReduce[{Nv,Av}Order[Nv,-Nv]]]
In[]:=
ratgraph3[verts_]:=Module[{n=Length[verts],G,vrange,vects,nedge,rods={}},G=Graph3D[Range[n],{},VertexCoordinates->verts];Do[vrange=Select[Range[i+1,n],Function[j,NoneTrue[rods,SubsetQ[#,{i,j}]&]]];vects=Table[Append[cSignAbs3[verts[[j]]-verts[[i]]],j],{j,vrange}];vects=Select[vects,#[[2]]∈Rationals&];vects=SortBy[Append[#[[All,2;;]],{0,i}],First]&/@GatherBy[vects,First];Do[Do[nedge=UndirectedEdge@@pair[[All,2]];G=EdgeAdd[G,nedge];AnnotationValue[{G,nedge},EdgeLabels]=-Subtract@@pair[[All,1]];AnnotationValue[{G,nedge},EdgeWeight]=Length[rods],{pair,Partition[rod,2,1]}];AppendTo[rods,rod[[All,2]]],{rod,vects}],{i,n-1}];G]
In[]:=
EdgeDelete[ratgraph3[Join[Tuples[{0,1},3],{{3/4,0,0},{0,0,1/4},{0,3/4,0},{1/4,0,0},{0,0,3/4},{0,1/4,0}}]],{39,410,211,612,513,714}]
Out[]=
