Re: Plot[] - Sprünge nicht als Line darstellen?

[Hartmut Wolf <hwolf@XXXXXXX.com>]

> Lars Denkewitz schrieb:
>> 
>> Ich hätte gerne gewußt, ob es in Mathematica 3.0 möglich ist, stückweise
>> stetige Funktionen so zu zeichnen, daß bei auftretenden Sprüngen die
>> beiden betreffenden Funktionswerte nicht verbunden werden. Wenn die
>> Funktionen als einzeln definierte Funktionen vorliegen, ist dies ja
>> durch Zusammensetzen (Show[]) leicht möglich. Wenn ich aber z.B. die
>> UnitStep[]-Funktion mit Plot[] zeichne, wird der charakteristische
>> Sprung als Linie dargestellt, was ja so nicht stimmt. Kann man das
>> irgendwie verhindern?
>> 


Hartmut Wolf schrieb:
> 
> In[22]:= Unprotect[Plot]
> 
> In[23]:=
> Plot[f_, {var_Symbol, min_, singularit\[ADoubleDot]ten__, max_},
> opts___] :=
>   Module[{ranges = (Prepend[#1, var] & ) /@
>       Partition[{min, singularit\[ADoubleDot]ten, max}, 2, 1], g, df},
>    g = (Plot[f, #1, DisplayFunction -> Identity, opts] & ) /@ ranges;
>    df = DisplayFunction /. Flatten[{opts}] /.
>       Options[Plot, DisplayFunction];
>    Show[g, DisplayFunction -> df]]
> 
>  In[24]:= Protect[Plot]
>


Lars Denkewitz schrieb:

> Das funktioniert schon ziemlich gut. Das Problem ist nun, daß man die
> Singularität explizit angeben muß. Wäre es denkbar, die Singularitäten
> automatisch erkennen zu lassen? Da die Funktion in einer selbstgebauten
> anderen Funktion genutzt wird, sollte der Nutzer dies nicht unbedingt wissen
> müssen.
> 

Lieber Lars,

betrachte mal die harmlose Funktion 

In[1]:=
cc[x_] := Which[x > 1, 1,
                x > 1/2,  (1 +  cc[2x - 1])/2,
                  x > 0, 1/2,
                  True, 0 ]
In[2]:=
Plot[cc[x], {x, -0.1, 1.1}, PlotRange -> {0, 1}]

Welche der "charakteristischen Sprünge" sollen da als Linie dargestellt
werden, welche nicht?


Ich denke bei dieser Problemlage hilft nur ein pragmatisches Vorgehen.
Dazu schlage ich einen anderen Ansatz vor:


In[4]:= Attributes[suppressSteep] = {HoldFirst};
In[5]:=
suppressSteep[g_, limit_] := 
  Module[{pts, posLine, steep, pp, seqs}, 
   posLine = Position[g, Line[_]]//First;
   pts = Part[g, Sequence@@posLine, 1] ; 
   steep = (#1[[2]]/#1[[1]] & ) /@ 
      (Subtract @@ Reverse[#1] & ) /@ Partition[pts, 2, 1]; 
   pp = Flatten[Position[steep, x_ /; Abs[x] > limit]]; 
   seqs = Transpose[
      {Prepend[pp + 1, 1], Append[pp, Length[pts]]}]; 
   ReplacePart[g, Line /@ (Take[pts, #1] & ) /@ seqs, posLine]
  ]

In[6]:=
suppressSteep[Plot[f_List, range_, opts___], limits_List] /; Length[f]
== Length[limits]:= 
  Module[{g, df, pstyles}, 
   pstyles = PlotStyle /. Flatten[{opts}] /. 
   Options[Plot, PlotStyle];
   pstyles = Replace[{pstyles}, {{x__}} -> {x}];
   PadRight[pstyles, Length[f], pstyles];
   g = Plot[#1, range, PlotStyle -> #2, 
            DisplayFunction -> Identity, opts]& 
       @@@ Transpose[{f, pstyles}];
   df = DisplayFunction /. Flatten[{opts}] /. 
        Options[Plot, DisplayFunction];  
   Show[MapThread[suppressSteep,{g, limits}], 
        DisplayFunction -> df]
  ]

In[7]:=
suppressSteep[Plot[f_List, range_, opts___], limits_] := 
  Module[{ll = Flatten[{limits}]},
  ll = PadRight[ll, Length[f], ll];
  suppressSteep[Plot[f, range, opts], ll]
  ]

In[8]:=
suppressSteep[Plot[f_, range_, opts___], limit_?Positive] := 
  Module[{g, df},
   g = Plot[f, range, DisplayFunction -> Identity, opts];
   df = DisplayFunction /. Flatten[{opts}] /. 
        Options[Plot, DisplayFunction];  
   Show[suppressSteep[g, limit], DisplayFunction -> df]
  ]

Hier werden die Plots generiert und danach in der Graphik die
generierten Linien dort unterbrochen, wo die absolute Steigung das Maß
"limit" übersteigt. So kannst du also versuchen:

 

suppressSteep[Plot[cc[x], {x, -0.1, 1.1}], 5]

und mit

f1 = 1/((1 - x)(2 - x)); f2 = 5 UnitStep[x - 0.5]UnitStep[2.5 - x];

suppressSteep[
  Plot[{f1, f2}, {x, 0, 3}, PlotRange -> {All, {-10, 10}}, 
    PlotStyle -> {{Hue[1/3, 1., 0.5]}, {Thickness[0.02], 
          Hue[0., 1., 0.7]}}], {100, 5}]

suppressSteep[
  Plot[f2, {x, 0, 3}, PlotRange -> {All, {-10, 10}}, 
    PlotStyle -> {Thickness[0.02], Hue[0., 1., 0.7]}], 5]

suppressSteep[
  Plot[f1, {x, 0, 3}, PlotRange -> {All, {-10, 10}}, 
    PlotStyle -> {{Hue[1/3, 1., 0.5]}, {Thickness[0.02], 
          Hue[0., 1., 0.7]}}], 100]

suppressSteep[
  Plot[{f1}, {x, 0, 3}, PlotRange -> {All, {-10, 10}}, 
    PlotStyle -> {{Hue[1/3, 1., 0.5]}}], 100]

suppressSteep[
  Plot[{f1}, {x, 0, 3}, PlotRange -> {All, {-10, 10}}, 
    PlotStyle -> {{Hue[1/3, 1., 0.5]}}], {100}]


Die Limits hängen von der Funktion ab, mußt du gegebenenfalls
ausprobieren -- kannst aber auch das Programm verbessern, oder 'ne neue
Plot-Funktion schreiben (hängt mit dem Mechanismus MaxBend und
PlotDivision zusammen).

Gruß, Hartmut