# How can I get high precision circle drawing in Graphics, across ten orders of magnitude

I need to visualize some fractal circle arrangements where tangent circles can vary by ten orders of magnitude. In such cases the circles are not being drawn as tangent.

Example: The red and blue circles generated below are tangent at {0,0}, but with large red radius they are not drawn so, and the drawing error changes with PlotRange.

Manipulate[
Graphics[{Red, Disk[{-(10^logR), -(10^logR)}/Sqrt[2], 10^logR]
,Blue, Disk[{1, 1}/Sqrt[2], 1]}
,Axes -> True
,ImageSize -> 200
,PlotRange -> {{-plotRange, plotRange}, {-plotRange, plotRange}}
,PlotRangeClipping -> True]
,{{logR, 6}, 0, 10, 1, Appearance -> "Labeled"}
,{plotRange, 1, 100, 1, Appearance -> "Labeled"}
]


-- Is there a way to fix this?

Note it breaks even here, where all inputs to Graphics are exact numbers (have also tried SetPrecision on those inputs, to no avail.)

UPDATE - sample output per request:

Here are some sample outputs, tho not integer logR values to show some partial misbehavior. The first and last are fine, the middle ones broken.

Note that simply changing the ImageSize also changes the error, as does even selecting and enlarging the Graphics by hand in the nb.

Here is a picture from my actual context, one particular asymptotic neighborhood of interest. I need the blue circle to be tangent to all those green ones, not overlapping.

FYI: The large blue circle and the green one at the end of the zig-zag dotted line are essentially generated by

Module[{xyGreen = {0.9383640, 0.3462440}},
Graphics[{Darker@Darker@Blue, Disk[{0, 0}, 1]
, Darker@Green,
Disk[xyGreen, EuclideanDistance[{0, 0}, xyGreen] - 1]},
PlotRange -> {{0.93514, 0.94175}, {0.34259, 0.34921}}]
]


(The EuclideanDistance calculation and the 40 precision mean these circles should really be tangent well beyond the precision needed)

• Can you include images of the problem result, together with the exact values that generated them? Apr 3, 2019 at 17:08
• I recall a related question tagged with [bug]. But I can't find it. It has a blue half-disk and a red triangle. Another related question is this one. Apr 3, 2019 at 17:21
• @Silvia I remember it, too. I may have answered it, but I cannot find it either. The problem is in numerics in the GPU Apr 3, 2019 at 22:27
• I will submit a bug report. Apr 10, 2019 at 23:25
• MetaPoint - There has been considerable effort to make MMA handle exact and arbitrary precision calculations. It would be cool if the graphics could also do so, e.g., when given PerformanceGoal->"Quality". (Is it conceivable that GPU's could be programmed to handle arbitrary precision??) Vastly multiscale representations are increasingly important in science and engineering, and everybody seems to want dynamic interactive graphics to explore things... Apr 10, 2019 at 23:25

I believe it's a numerics issue, possibly in the GPU, which would make an easy fix difficult. Here's one way to avoid the issues:

Manipulate[Graphics[{
Red,
If[Or @@
Negative[{-plotRange, -plotRange} - {-(10^logR), -(10^logR)}/
Sqrt[2]],
Disk[{-(10^logR), -(10^logR)}/Sqrt[2], 10^logR],
Polygon@Append[
Table[
N[{-(10^logR), -(10^logR)}/Sqrt[2] +
10^logR {Cos[t], Sin[t]}], {t,
Subdivide[##, 20] & @@
ArcTan[{plotRange, -plotRange} - {-(10^logR), -(10^logR)}/
Sqrt[2], {-plotRange,
plotRange} - {-(10^logR), -(10^logR)}/Sqrt[2]]}
],
{-plotRange, -plotRange}]
],
Blue, Disk[{1, 1}/Sqrt[2], 1]}, Axes -> True, ImageSize -> 200,
PlotRange -> {{-plotRange, plotRange}, {-plotRange, plotRange}},
PlotRangeClipping -> True],
{{logR, 6}, 0, 10, 1, Appearance -> "Labeled"}, {plotRange, 1, 100,
1, Appearance -> "Labeled"}]


It's slightly better if the points are computed accurately with N[p, {prec, acc}] instead of just N[p], but the difference is barely noticeable:

N@N[{-(10^logR), -(10^logR)}/Sqrt[2] + 10^logR {Cos[t], Sin[t]}, {8, 8}]

• P.S. I believe this issue has come up before, which I mentioned below the OP, but I couldn't find it. Apr 3, 2019 at 23:03
• Good trick, but unfortunately it is not feasible for my case. Im looking at the geometry of circle packing deep in fractal Apollonian Gaskets. Many circles of vast ranges of sizes are tangent to one another at all orientations, and I will be panning and zooming around all sorts of neighborhoods. Im interested in things approaching asymptotic structure and I have to go deep, and, it is extremely common for circles to have at least one of their "parent" tangent circles vastly larger, but other things going on locally at smaller scales as well. I'll be sad if it is a GPU issue :-( Apr 4, 2019 at 19:39

This post is not meant to completely solve your problem, but perhaps start a discussion. For me, one circle with radius order of magnitude 100 times another circle's radius is just barely visible. I've fixed the red circle, and adjusted the PlotRange accordingly. Probably there are other approaches.

Manipulate[plotRange = 2 10^logR;
Graphics[{Red, Disk[{-(10^logR), -(10^logR)}/Sqrt[2], 10^logR], Blue,
Disk[{1, 1}/Sqrt[2], 1]}, Axes -> False, Frame -> True,
FrameTicks -> None, ImageSize -> 400,
PlotRange -> {{-plotRange, plotRange}, {-plotRange, plotRange}}],
{{logR, 1}, 0, 2, .01, Appearance -> "Labeled"}]


Well, just change the plotRange to be fixed at 2 (to have the blue smaller circle completely in the frame. I've also increased the maximum radius from 100 to 1000. At 1000, the larger circle locally resembles a straight line.

Manipulate[plotRange = 2;
Graphics[{Red, Disk[{-(10^logR), -(10^logR)}/Sqrt[2], 10^logR], Blue,
Disk[{1, 1}/Sqrt[2], 1]}, Axes -> False, Frame -> True,
FrameTicks -> None, ImageSize -> 400,
PlotRange -> {{-plotRange, plotRange}, {-plotRange, plotRange}}],
{{logR, 1}, 0, 3, .01, Appearance -> "Labeled"}]


• Thank you for your thoughts, but Im concerned with the case where the smaller circle is show in its entirety, and the larger circle has its center far, far outside the plot range. Apr 4, 2019 at 19:30
• Right, showing the full smaller circle, and keeping plotRange` fixed at 2, we can grow the larger circle until r=1000, when the larger circle appears as a straight line. I've adjusted the code, and added a picture.
– mjw
Apr 4, 2019 at 20:39
• If you keep the plotRange at 2, but you increase your logR range, you run into my problem just before logR=6. Apr 5, 2019 at 0:38
• Yes, I also saw that happening. Once the circle gets larger than a certain size, Mathematica has trouble drawing it. I think that if you check if Log10[r]>~4, and if so, replace your circle by a plane, this will produce a nice plot.
– mjw
Apr 5, 2019 at 1:52
• What I mean is find the line that best approximates the circle by fitting it to two or more points of tangency of the smaller circles.
– mjw
Apr 5, 2019 at 1:59