Edit
For r=Sqrt[53], there are 148 squares in the curve, and there are 56 outside the curve, and 16*16-148-56=52 on the curve.
Clear["Global`*"];
lines0 =
Flatten[{Table[
Line[{{i, j}, {i, j} + {1, 0}}], {i, -8, 7}, {j, -8, 8}],
Table[Line[{{i, j}, {i, j} + {0, 1}}], {i, -8, 8}, {j, -8, 7}]}];
p = {0, 0};
r = Sqrt[53];
range1 = Disk[p, r];
range2 = Annulus[p, {r, 4 r}];
intersec[range_] := Module[{lines, pts, edges, g, faces, squares},
lines =
Cases[RegionIntersection[range, #] & /@ lines0, _Line, Infinity];
pts = DeleteDuplicates[Flatten[lines[[;; , 1]], {2, 1}]];
edges =
Table[UndirectedEdge @@ Flatten[FirstPosition[pts, #] & /@ d], {d,
lines[[;; , 1]]}];
g = Graph[edges,
VertexCoordinates -> Thread[Range@Length@pts -> pts]];
faces = PlanarFaceList[g];
squares = Select[faces, Length[#] == 4 &];
{MeshRegion[pts, Polygon /@ squares], Length[squares]}];
Labeled[Graphics[{lines0, {FaceForm[], EdgeForm[Cyan],
range1}, {FaceForm[Yellow], EdgeForm[Red],
intersec[range2] // First}, {FaceForm[Green], EdgeForm[Red],
intersec[range1] // First}}], {Style[intersec[range1] // Last,
Green, 20], Style[intersec[range2] // Last, Darker@Yellow],
Style[2*8*2*8 - intersec[range1][[2]] - intersec[range2][[2]],
20]}]
Original
Edit
For r=Sqrt[53], there are 148 squares in the curve, and there are 56 outside the curve, and 16*16-148-56=52 on the curve.
Clear["Global`*"];
lines0 =
Flatten[{Table[
Line[{{i, j}, {i, j} + {1, 0}}], {i, -8, 7}, {j, -8, 8}],
Table[Line[{{i, j}, {i, j} + {0, 1}}], {i, -8, 8}, {j, -8, 7}]}];
p = {0, 0};
r = Sqrt[53];
range1 = Disk[p, r];
range2 = Annulus[p, {r, 4 r}];
intersec[range_] := Module[{lines, pts, edges, g, faces, squares},
lines =
Cases[RegionIntersection[range, #] & /@ lines0, _Line, Infinity];
pts = DeleteDuplicates[Flatten[lines[[;; , 1]], {2, 1}]];
edges =
Table[UndirectedEdge @@ Flatten[FirstPosition[pts, #] & /@ d], {d,
lines[[;; , 1]]}];
g = Graph[edges,
VertexCoordinates -> Thread[Range@Length@pts -> pts]];
faces = PlanarFaceList[g];
squares = Select[faces, Length[#] == 4 &];
{MeshRegion[pts, Polygon /@ squares], Length[squares]}];
Labeled[Graphics[{lines0, {FaceForm[], EdgeForm[Cyan],
range1}, {FaceForm[Yellow], EdgeForm[Red],
intersec[range2] // First}, {FaceForm[Green], EdgeForm[Red],
intersec[range1] // First}}], {Style[intersec[range1] // Last,
Green, 20], Style[intersec[range2] // Last, Darker@Yellow],
Style[2*8*2*8 - intersec[range1][[2]] - intersec[range2][[2]],
20]}]
Original
- Similar with https://mathematica.stackexchange.com/a/280656/72111, we list all of the segments, and intersection such lines with a region.
- Then we construct a
Planar Graphand calculate all the 4-cycles.
lines0 =
Flatten[{Table[
Line[{{i, j}, {i, j} + {1, 0}}], {i, -8, 7}, {j, -8, 8}],
Table[Line[{{i, j}, {i, j} + {0, 1}}], {i, -8, 8}, {j, -8, 7}]}];
Manipulate[Module[{range, lines, pts, edges, g, faces, squares},
range = Disk[p, Sqrt[59]];
(* range=Annulus[p,{3,Sqrt[59]}]; *)
lines =
Cases[RegionIntersection[range, #] & /@ lines0, _Line, Infinity];
pts = DeleteDuplicates[Flatten[lines[[;; , 1]], {2, 1}]];
edges =
Table[UndirectedEdge @@ Flatten[FirstPosition[pts, #] & /@ d], {d,
lines[[;; , 1]]}];
g = Graph[edges,
VertexCoordinates -> Thread[Range@Length@pts -> pts]];
faces = PlanarFaceList[g];
squares = Select[faces, Length[#] == 4 &];
Labeled[
Show[Graphics[lines0],
Graphics[{EdgeForm[Cyan], FaceForm[], range, EdgeForm[Red],
FaceForm[Green], MeshRegion[pts, Polygon /@ squares]}],
PlotRange -> 10], Framed@Length@squares]], {{p, {0, 0}}, Locator,
Appearance -> None}]