Re: Re: How smooth graphs?
- To: mathgroup at smc.vnet.net
- Subject: [mg61595] Re: [mg61565] Re: How smooth graphs?
- From: Chris Chiasson <chris.chiasson at gmail.com>
- Date: Sun, 23 Oct 2005 05:45:59 -0400 (EDT)
- References: <200510170629.CAA16338@smc.vnet.net> <dj4qd2$j1a$1@smc.vnet.net> <200510220724.DAA12396@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Impressive
On 10/22/05, Maxim <ab_def at prontomail.com> wrote:
> Another way is to plot several overlapping (or adjacent) polygons with
> smoothly varying colors:
>
> aa[gr_Graphics,
> {$colfg : _RGBColor | _GrayLevel, $colbg : _RGBColor | _GrayLevel},
> ndeg_Integer, $h : (_?NumericQ) : 0] :=
> gr /. Line[Lpt_] :> Module[
> {Lnv, rng, ar, h = $h, colfg = $colfg, colbg = $colbg},
> {rng, ar} = {PlotRange, AspectRatio} /. AbsoluteOptions[gr];
> ar = 1/(ar*Divide @@ Subtract @@@ rng);
> If[h == 0, h = -.0005*Subtract @@ rng[[1]]];
> Lnv = Cross /@ (RotateLeft@ Lpt - Lpt);
> Lnv[[-1]] = Lnv[[-2]];
> Lnv = #/Norm[#]&[{1, ar}*#]& /@ Lnv;
> {colfg, colbg} = List @@@ ({colfg, colbg} /.
> GrayLevel[g_] :> RGBColor[g, g, g]);
> Table[
> {RGBColor @@ ((colbg - colfg)*k/(ndeg + 1) + colfg),
> Polygon[Join[
> Lpt + (k*h*{1, ar}*#& /@ Lnv),
> Reverse[Lpt - (k*h*{1, ar}*#& /@ Lnv)]]]},
> {k, ndeg, 1, -1}]
> ]
>
> p[x_, L_] := (50.*L)/((1000. - 1.*x)*(-9.025*^8 + L + 1000.*x^2))
>
> <<graphics`
> Animate[Plot[p[x, L], {x, 0, 950},
> PlotPoints -> 200, PlotDivision -> 200, MaxBend -> .5,
> PlotRange -> {{0, 1000}, {.1, .7}},
> PlotStyle -> {AbsoluteThickness[3]},
> AxesLabel -> {"Inspection Rate", "Robustness"},
> AxesStyle -> {RGBColor[0, 0, 1], Thickness[0.02]},
> ImageSize -> 600, Background -> RGBColor[.1, .2, .7]] //
> aa[#, {Yellow, RGBColor[.1, .2, .7]}, 20]&,
> {L, 1000000000., 1000000000. + 700000000., 10000000}]
>
> This will work even for curves with corner points. The arguments to aa are
> the graphic object, the foreground and background colors and the number of
> gradations. The optional argument $h determines the margin between
> successive steps.
>
> Maxim Rytin
> m.r at inbox.ru
>
> On Wed, 19 Oct 2005 06:51:14 +0000 (UTC), Murray Eisenberg
> <murray at math.umass.edu> wrote:
>
> > Thanks to suggestions from several folks, my colleague did the following
> > to eliminate the apparent anti-aliasing of his plots:
> >
> > "...I am using os x. Did the plotting at 200, reset to 100, and then
> > exported to QuickTime and dragged onto Keynote. It worked well. The
> > graph is significantly less jagged when viewing the QuickTime movies
> > side by side on the screen. Thanks ... to the poster for this useful
> > idea. Plan to use it again."
> >
> > Murray Eisenberg wrote:
> >> A colleague, L.J. Moffitt, asked me how the graphs produced by the
> >> following code might be smoothed so as to avoid the jaggedness,
> >> especially the "staircasing".
> >>
> >> (This is going to be projected, and at a typical projection resolution
> >> of 1024 x 768, it looks even worse.)
> >>
> >> I tried all sorts of ploys, like drastically increasing PlotPoints and
> >> PlotDivision; lowering the Thickness in PlotStyle; and even breaking up
> >> the domain into two subintervals, one where the graph is more level and
> >> the other where the graph is rising rapidly. Nothing seemed to help.
> >>
> >> p[x_, L_] := (50.*L)/((1000. - 1.*x)*(-9.025*^8 + L + 1000.*x^2))
> >>
> >> <<Graphics`Animation`
> >>
> >> Animate[
> >> Plot[p[x,L],{x, 0, 950},
> >> PlotStyle->{AbsoluteThickness[3]},
> >> PlotRange->{.1,.7},
> >> AxesLabel->{"Inspection Rate","Robustness"},
> >> PlotPoints->10000, PlotDivision->50,
> >> AxesStyle->{RGBColor[0,0,1],Thickness[0.02]},
> >> ImageSize->600,
> >> Background->RGBColor[.1,.2,.7]],
> >> {L,1000000000., 1000000000.+700000000., 10000000}]
> >>
> >> Any suggestions that I might pass along to him?
> >>
> >
>
>
--
Chris Chiasson
http://chrischiasson.com/contact/chris_chiasson
- References:
- How smooth graphs?
- From: Murray Eisenberg <murray@math.umass.edu>
- Re: How smooth graphs?
- From: Maxim <ab_def@prontomail.com>
- How smooth graphs?