RE: More accuracy in Disk
- To: mathgroup at smc.vnet.net
- Subject: [mg33827] RE: [mg33796] More accuracy in Disk
- From: "David Park" <djmp at earthlink.net>
- Date: Fri, 19 Apr 2002 02:27:58 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Lorenzo,
It is a long standing graphics problem. Mathematica will clip Lines to the
Frame but it won't clip polygons to the frame. Nor will it clip Circle and
Disk.
If you want to draw unfilled circles, then you could extract the Lines from
a ParametricPlot of circles and plot the lines. They will be clipped. But if
you convert the Lines to Polygons, they won't be clipped.
Nevertheless, it is possible to make the plot by doing our own clipping. I
find it easiest to make the plot using my DrawGraphics package, available at
my web site. Here is the code and an explanation of how it works. I will
send you a .gif image of the plot separately, so you can see if it is worth
trying DrawGraphics.
Needs["DrawGraphics`DrawingMaster`"]
This is a routine that will draw a circle at a given center and of a given
radius. ParametricDraw is the same as ParametricPlot except that it simply
extracts the primitive graphics without making a side plot.
mydisk[center_, radius_] :=
ParametricDraw[radius{Cos[t], Sin[t]} + center // Evaluate, {t, 0, 2Pi},
PlotPoints -> 100]
This generates the graphics for 10 random circles.
circles =
Flatten[Table[
mydisk[{Random[Real, {-150, 150}], Random[Real, {-150, 150}]},
Random[Real, {50, 200}]], {10}]];
This converts the circles to polygons.
tab1 = Polygon @@ # & /@ circles;
This clips the polygons.
tab2 = tab1 /. {x_?NumberQ, y_?NumberQ} /; Abs[x] > 200 :> {200Sign[x], y};
tab2 = tab2 /. {x_?NumberQ, y_?NumberQ} /; Abs[y] > 200 :> {x, 200Sign[y]};
I decided the plot would look better if each circle had a random hue and was
outlined. The following line does that.
tab3 = Table[{Hue[Random[]], tab2[[i]], Black, tab2[[i]] /. Polygon ->
Line},
{i, 1, Length[tab2]}];
Finally, this draws all of the disks and their outlines, clipped to the
frame.
Draw2D[{tab3},
Frame -> True, AspectRatio -> Automatic,
PlotRange -> {{-200, 200}, {-200, 200}},
PlotLabel -> "Clipping Disks to a Rectangular Region", Background ->
Linen,
AxesFront -> True, ImageSize -> 400];
If anyone wants to see the resulting image in .gif format I will send it to
them.
David Park
djmp at earthlink.net
http://home.earthlink.net/~djmp/
> From: Lorenzo Pesce [mailto:fish at chem.northwestern.edu]
To: mathgroup at smc.vnet.net
>
> Hi to all,
> I am trying to plot a series of disks but I do not manage to make
> mathematica plot my disks with higher accuracy (some of the small ones
> look really bad).
> How can I alter the number of points in a graphic of this sort to have
> more precise disks?
>
> TableDisk =
> Table[Disk[{Random[Real, {-200, 200}], Random[Real, {-200, 200}]},
> RandomNormal[10, 1]], {n, 40}];
>
> Show[
> Graphics[ TableDisk],
> Frame -> True,
> AspectRatio -> 1,
> PlotRange -> {{-200, +200}, {-200, +200}},
> PlotRegion -> {{0, 1}, {0, 1}},
> ImageSize -> {500, 500}
> ]
>
> Thanks a lot,
>
> Lorenzo
>
>