Return to Question

Searching for similar questions I only found How to avoid the wiggly text on Ticks and Labels when rotating 3D objects but that one is about text and I could not figure out whether it might be useful in any way here.

As requested by Alexey Popkov I've tried to isolate one simple case of the phenomenon. With wiggling I don't even realize how to proceed, however with circle crossings there is a very clear case: I've tried

Searching for similar questions I only found How to avoid the wiggly text on Ticks and Labels when rotating 3D objects but that one is about text and I could not figure out whether it might be useful in any way here.

As requested by Alexey Popkov I've tried to isolate one simple case of the phenomenon. With wiggling I don't even realize how to proceed, however with circle crossings there is a very clear case: I've tried

Update 3

As requested by Alexey Popkov I've tried to isolate one simple case of the phenomenon. With wiggling I don't even realize how to proceed, however with circle crossings there is a very clear case: I've tried

Manipulate[ Show[Graphics[{Circle[{0, 1/2}, 1/2], Circle[{1/q, 1/(2 q^2)}, 1/(2 q^2)]}], PlotRange -> {{1/q - 1/(2 q^2), 1/q + 1/(2 q^2)}, {0, 1/q^2}} ], {q, 1, 100, 1} ] 

and discovered that already starting from q=4 the crossing is clearly visible. Here is a snapshot with q=21, together with a calculation showing that these circles must intersect in only one point

With[{center = 1/π, zoomstep = 1.04, start = 60, size = 504}, Module[{d = 3 zoomstep^start, maxden = 0, rats = {}, outrats, inrats, newrats, den}, Do[ With[{left = center - 2/d, right = center + 2/d, height = 2/d, bottom = -1/40/d}, outrats = Select[Select[rats, 2 Last[#]^2 height <= 1 &], With[{oden = Last[#], pm = Sqrt[height (1 - Last[#]^2 height)]}, left oden - pm < First[#] < right oden + pm] &]; inrats = Select[Select[rats, 2 Last[#]^2 height > 1 &], With[{iden = Last[#], pm = 1/(2 Last[#])}, left iden - pm < First[#] < right iden + pm] &]; For[den = maxden + 1; newrats = {}, den^2 <= d size, den++, newrats = Union[newrats, Map[{#, den} &, Select[Range[Ceiling[left den - 1/(2 den)], Floor[right den + 1/(2 den)]], CoprimeQ[#, den] &]]] ]; rats = Union[outrats, inrats, newrats]; maxden = Max[Map[Last, rats]]; d *= zoomstep; AppendTo[frames, Graphics[ { Line[{{0, 0}, {1, 0}}], Map[With[{r = 1/(2 Last[#]^2)}, Circle[{Divide @@ #, r}, r]] &, rats] }, ImageSize -> size, PlotRange -> {{left, right}, {bottom, height}} ] ] ], 900 ] ] ] 

frames = {}; With[{center = 1/π, zoomstep = 1.04, start = 60, size = 504}, Module[{d = 3 zoomstep^start, maxden = 0, rats = {}, outrats, inrats, newrats, den}, Do[ With[{left = center - 2/d, right = center + 2/d, height = 2/d, bottom = -1/40/d}, outrats = Select[Select[rats, 2 Last[#]^2 height <= 1 &], With[{oden = Last[#], pm = Sqrt[height (1 - Last[#]^2 height)]}, left oden - pm < First[#] < right oden + pm] &]; inrats = Select[Select[rats, 2 Last[#]^2 height > 1 &], With[{iden = Last[#], pm = 1/(2 Last[#])}, left iden - pm < First[#] < right iden + pm] &]; For[den = maxden + 1; newrats = {}, den^2 <= d size, den++, newrats = Union[newrats, Map[{#, den} &, Select[Range[Ceiling[left den - 1/(2 den)], Floor[right den + 1/(2 den)]], CoprimeQ[#, den] &]]] ]; rats = Union[outrats, inrats, newrats]; maxden = Max[Map[Last, rats]]; d *= zoomstep; AppendTo[frames, Graphics[ { Line[{{0, 0}, {1, 0}}], Map[With[{r = 1/(2 Last[#]^2)}, Circle[{Divide @@ #, r}, r]] &, rats] }, ImageSize -> size, PlotRange -> {{left, right}, {bottom, height}} ] ] ], 900 ] ] ]