|
|
MATHEMATICA
|
(* A291259: Minimum number of points of the square lattice falling strictly inside a circle of radius n. *)
(* The three vertices of the Explorative Triangle (ET) *)
P1={0, 0}; P2={1/2, 0}; P3={1/2, 1/2};
dd2=SquaredEuclideanDistance;
(* candidatePointQ[p, n] gives True if "p" is a candidate point, and False otherwise. A candidate point is a point belonging to a circle of radius "n" with center in the ET *)
candidatePointQ[p_, n_] := With[{dds={dd2[p, P1], dd2[p, P2], dd2[p, P3]}}, Max[dds]>=n^2>=Min[dds]];
(* Check if point "p" falls inside any circle with radius "n" and center in the ET *)
innerPointQ[p_, n_] := With[{dds={dd2[p, P1], dd2[p, P2], dd2[p, P3]}}, Max[dds]<n^2];
(* The function "candidatePoints[n]" gives the list of points with distance "n" from some point of the ET *)
candidatePoints[n_] := Select[Table[{i, j}, {i, -n, n+1}, {j, -n, n+1}]//Flatten[#, 1]&, candidatePointQ[#, n]&];
(* The function "centersFromTwoPoints[{{x1, y1}, {x2, y2}}, n]" gives the centers of the two circles with radius "n" and tangent to the pair of points {x1, y1} and {x2, y2} *) (* Note: if the distance between the two points is less than 2n then the coordinates of the centers are not integers *)
centersFromTwoPoints[{{x1_, y1_}, {x2_, y2_}}, n_] :=
Which[x1==x2,
Block[{sqrtTerm=Sqrt[4*n^2-(y1-y2)^2]/2}, {{x1-sqrtTerm, (y1+y2)/2},
{x1+sqrtTerm, (y1+y2)/2}}],
y1==y2,
Block[{sqrtTerm=Sqrt[4*n^2-(x1-x2)^2]/2}, {{(x1+x2)/2, -sqrtTerm+y1},
{(x1+x2)/2, sqrtTerm+y1}}], True,
Block[{ddxy2=dd2[{x1, y1}, {x2, y2}], sqrtTerm}, sqrtTerm=Sqrt[-(ddxy2*(-4*n^2+ddxy2)*(y1-y2)^2)]; Table[{((x1+x2)*ddxy2-sqrtTerm)/(2*ddxy2), (ddxy2*(y1^2-y2^2)+sign*(x1-x2)*sqrtTerm)/(2*ddxy2*(y1-y2))}, {sign, {1, -1}}]]];
(* The function "explorativeCenters[pairc, n]" selects the centers of circles of radius "n" of the list "pairc" lying inside the ET *)
explorativeCenters[pairc_, n_] := Select[Table[centersFromTwoPoints[pair, n], {pair, pairc}]//Flatten[#, 1]&, 0<=#[[1]]<=1/2 && 0<= #[[2]]<=#[[1]]&];
a[n_] := If[n==0, 0, Module[{points, pairc, expcent, innerpoints},
points = candidatePoints[n];
pairc = Select[Subsets[points, {2}], dd2@@#<4n^2&];
expcent = explorativeCenters[pairc, n];
innerpoints = Count[Table[{i, j}, {i, -n, n+1}, {j, -n, n+1}]//Flatten[#, 1]&, _?(innerPointQ[#, n]&)];
Min[Table[Count[points, _?(dd2[#, center]<n^2&)], {center, expcent}]] + innerpoints]];
|
