Coordination Sequence

Bradley Klee

V.3, Nov. 26

(3/2Sqrt[3])^2+(1/2)^2

functions

AXIOM={{1,0}};

ExpandVertices = Join[
IdentityMatrix[2],
-IdentityMatrix[2],
{{1,1},{-1,-1}}
];

Filter[CList_]:=Select[
DeleteDuplicates[CList] ,
!And@@(
IntegerQ/@(Inverse[Transpose[{{1,3},{2,-1}}]].#)
)&
]

Coordinates[n_]:= NestList[
Filter[
Join[
Function[{a},
Flatten[#,1]&@Outer[Plus,a,ExpandVertices ,1]
][#],
#]]&,
AXIOM,
n];

grid[gen_,n_,l_]:=Outer[
Line[{
gen[[#1/.{1->2,2->3,3->1} ]]#2+l gen[[#1]],
gen[[#1/.{1->2,2->3,3->1} ]]#2-l gen[[#1]]
}]&,Range[3],Range[-n,n]
]

counting

Function[{NNN},
NestList[Subtract@@Reverse[#]&/@Partition[#,2,1]&,Length/@Coordinates[NNN],3]//ColumnForm
][20]

UnitGen = {Cos[2 Pi # / 3 ],Sin[2 Pi # / 3 ]}&/@Range[0,2];

Sqrt7Gen= ( 2 UnitGen[[ # ]] - UnitGen[[ #/.{1->2,2->3,3->1} ]] )&/@Range[3];

CList = Coordinates[30];

Graphics[{
grid[UnitGen,60,40],
Dashed,
grid[Sqrt7Gen,60,40],
EdgeForm[Thickness[.001]],
{Purple,Disk[{1,0},.3]},
Function[{NNN},{Mod[NNN,5]/.{
0->Orange,
1->Red,
2->Blue,
3->Green,
4->Yellow},
Disk[#.UnitGen[[1;;2]],.3]}&/@Complement[ CList[[NNN]],CList[[NNN-1]] ]
][#]&/@Range[2,30]
},
PlotRange->4{{-7,7.5},{-4Sqrt[3],4Sqrt[3]}},
ImageSize->800
]

Graphics[{
grid[UnitGen,60,40],
Dashed,
grid[Sqrt7Gen,60,40],
EdgeForm[Thickness[.001]],
{Purple,Disk[{1,0},.3]},
Function[{NNN},{Mod[NNN,5]/.{
0->Orange,
1->Red,
2->Blue,
3->Green,
4->Yellow},
Disk[#.UnitGen[[1;;2]],.3]}&/@Complement[ CList[[NNN]],CList[[NNN-1]] ]
][#]&/@Range[2,17]
},
PlotRange->{2{-7,8.5},9{-Sqrt[3],Sqrt[3]}},
ImageSize->800
]