MathGroup Archive 2005

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: How smooth graphs?

  • To: mathgroup at smc.vnet.net
  • Subject: [mg61565] Re: How smooth graphs?
  • From: Maxim <ab_def at prontomail.com>
  • Date: Sat, 22 Oct 2005 03:24:05 -0400 (EDT)
  • References: <200510170629.CAA16338@smc.vnet.net> <dj4qd2$j1a$1@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

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?
>>
>


  • Prev by Date: Re: Baffling change to partial derivative in version 5.1
  • Next by Date: Re: Warning from Piecewise
  • Previous by thread: Re: How smooth graphs?
  • Next by thread: Re: Re: How smooth graphs?