icoverts=With[{signs=2Table[IntegerDigits[i,2,3],{i,8}]-1},Union[Flatten[Function[perm,(perm#1&)/@signs]/@NestList[RotateRight,{0,1,GoldenRatio},2],1]]]norm[vec_]:=&Plus@@
vec.vec
icoedges=Flatten[Table[If[norm[icoverts〚i〛-icoverts〚j〛]<3,{{i,j}},{}],{i,12},{j,i+1,12}],2]icofaces=Flatten[Table[If[MemberQ[icoedges,{a,b}]&&MemberQ[icoedges,{b,c}]&&MemberQ[icoedges,{a,c}],{{a,b,c}},{}],{a,12},{b,a+1,12},{c,b+1,12}],3]icoadjacent=Flatten[Table[If[Length[(icofaces〚i〛)⋂(icofaces〚j〛)]==2,{{i,j}},{}],{i,20},{j,i+1,20}],2]domeedges[ord_]:=Flatten[{(insideedges[#1,ord]&)/@icofaces,(edgeedges[#1,ord]&)/@icoadjacent},2]insideedges[face_,order_]:=Map[findpoint[face,#1]&,Flatten[Function[pt,({pt,pt+#1}&)/@Permutations[{2,-1,-1}]]/@(3Flatten[Table[{i,j,order+2-i-j},{i,order},{j,order+1-i}],1]-1),1],{2}]edgeedges[{faceind1_,faceind2_},order_]:=Module[{face1=icofaces〚faceind1〛,face2=icofaces〚faceind2〛,ourface1,ourface2},ourface1=Join[face1⋂face2,Complement[face1,face2]];ourface2=Join[face2⋂face1,Complement[face2,face1]];Table[(findpoint[#1,{3k+1,3(order-k)+1,1}]&)/@{ourface1,ourface2},{k,0,order}]]findpoint[face_,coords_]:=N#1
norm[#1]
(icoverts〚#1〛&)/@facecoords
Plus@@coords
NOTE: N[ ] removed in norm definition above....
spheregraph[ord_]:=Module[{d=domeedges[ord],nn},nn=Union[Flatten[d,1]];EdgesToNodes[Map[First[Flatten[Position[nn,#]]]&,d,{2}]]]
spheregraph[1]
{1{3,5,7},2{4,5,8},3{1,6,9},4{2,6,10},5{1,2,11},6{3,4,12},7{1,13,19},8{2,14,20},9{3,13,21},10{4,14,22},11{5,15,16},12{6,17,18},13{7,9,23},14{8,10,24},15{11,19,25},16{11,20,26},17{12,21,27},18{12,22,28},19{7,15,29},20{8,16,30},21{9,17,31},22{10,18,32},23{13,33,35},24{14,34,36},25{15,26,37},26{16,25,38},27{17,28,43},28{18,27,44},29{19,33,39},30{20,34,40},31{21,35,41},32{22,36,42},33{23,29,45},34{24,30,46},35{23,31,47},36{24,32,48},37{25,39,53},38{26,40,54},39{29,37,49},40{30,38,50},41{31,43,51},42{32,44,52},43{27,41,55},44{28,42,56},45{33,49,57},46{34,50,58},47{35,51,57},48{36,52,58},49{39,45,59},50{40,46,60},51{41,47,61},52{42,48,62},53{37,54,63},54{38,53,64},55{43,56,65},56{44,55,66},57{45,47,67},58{46,48,68},59{49,63,71},60{50,64,72},61{51,65,73},62{52,66,74},63{53,59,69},64{54,60,69},65{55,61,70},66{56,62,70},67{57,71,73},68{58,72,74},69{63,64,75},70{65,66,76},71{59,67,77},72{60,68,78},73{61,67,79},74{62,68,80},75{69,77,78},76{70,79,80},77{71,75,79},78{72,75,80},79{73,76,77},80{74,76,78}}
Show[NeighborsPictureR[%,{1}]];
spheregraph[2];
Show[NeighborsPictureR[%,{1}]];
spheregraph[3];
Show[NeighborsPictureR[%,{1}]];
spheregraph[4];
Show[NeighborsPictureR[%,{1}]];
spheregraph[5];
Show[NeighborsPictureR[%,{1}]];
NeighborCounts[%193,1]
{1,4,10,19,31,46,64,85,107,132,158,187,216,248,280,314,348,384,420,454,488,520,552,581,610,635,659,679,697,712,719,720,720}
ListPlot[%,PlotJoined->True];
Differences[list_]:=Drop[list,1]-Drop[list,-1]
ListPlot[Differences[%213],PlotJoined->True];
Take[Differences[%213],17]
{3,6,9,12,15,18,21,22,25,26,29,29,32,32,34,34,36}