RE: automatischer ContourStyle

["Wolf, Hartmut" <Hartmut.Wolf@XXXXXXX.com>]

>-----Original Message-----
>From: Jens Bredenbeck
>Sent: Monday, August 25, 2003 2:26 PM
>To: dmug@XXXXXXX.ch
>Subject: automatischer ContourStyle
>
>
>Liebe Liste,
>
>gibt es eine Möglichkeit, den ContourStyle automatisch erzeugen zu 
>lassen - also zum Beispiel durchgezogene Linien für positive 
>ContourLevels, eine dickere Linie für die Null und gestrichelte Linien 
>für negative Levels?
>
>Gruss,
>Jens
>
>

Hier ein Schritt-für-Schritt Beispiel, wie man es machen könnte; du kannst
es ja selbst in eine User-Funktion umbauen:

Zunächst, das Problem existiert nur bei einer Spezifikation Contours ->
ncont (eine positive ganze Zahl), der Default für ncont ist 10.

In[1]:= f[x_, y_] := Sin[x y]

(unser Beispiel)

In[2]:= ncont = 11;

(unsere Spezification)

Klareweise kennen wir die Höhe der Contour-Linien erst, nachdem wir sie
berechnet haben. Na, ja, Tom Wickham-Jones hat in seinem Buch über
"Mathematica Graphics" eine Formel angegeben, die vielleicht richtig ist
oder nicht, weiß nicht, hab's grade nicht zur Hand, ich mach's mir
einfacher, empirisch:

In[3]:=
c = ContourPlot[f[x, y], {x, 0, 5}, {y, 0, 5}, ContourShading -> False, 
    Contours -> ncont, 
    ContourStyle -> ({GrayLevel[#/ncont]} & /@ Range[ncont]), 
    PlotPoints -> 100, DisplayFunction -> Identity]

Out[3]= \[SkeletonIndicator]ContourGraphics\[SkeletonIndicator]

Die Höhe der Contouren können wir diesem Objekt nicht entnehmen, wir
konvertieren es deshalb:

In[4]:= g = Graphics[c]

Out[4]= \[SkeletonIndicator]Graphics\[SkeletonIndicator]

...und mitteln über die Funktionswerte an den Eckpunkten der Linienzüge,
dabei benutzen wir, daß die Contourlinien geordnet sind (falls irgendwann
einmal nicht, einfach sortieren), deshalb funktioniert das Split.

In[5]:=
cv = {#[[1, 1]], Plus @@ #/Length[#] &[Join @@ #[[All, 2]]]} & /@ 
    Split[{#[[1, 1]], f @@@ #[[3, 1]]} & /@ g[[1]], First[#1] === First[#2]
&]
Out[5]=
{{1., 0.8735229109436901}, {0.9090909090909091, 
   0.6996073932477883}, {0.8181818181818182, 
   0.5248240781097675}, {0.7272727272727273, 
   0.3499171480416311}, {0.6363636363636364, 
   0.17498270175890238}, {0.5454545454545454, 
   -1.975530654508524*^-7}, {0.45454545454545453, 
   -0.17496357752653577}, {0.36363636363636365, 
   -0.3499077091065955}, {0.2727272727272727, 
   -0.5248247594070939}, {0.18181818181818182, 
   -0.6996416711494473}, {0.09090909090909091, 
   -0.8733593273799668}}

Dies ist ein "Toleranzband" in dem die Null-Contour liegen muß (nicht immer
gibt es eine solche), kannst du auch kleiner machen, wie du's brauchst; hier
bin ich großzügig.

In[6]:= d = (cv[[1, 2]] - cv[[-1, 2]])/ncont/2

Out[6]= 0.0794037

Wir ermitteln die Anzahl der positiven, der Null- und der negativen
Contouren:

In[7]:=
ll = Length @ Cases[cv, {_, h_} /; #] & /@ {h > d, d >= h > -d, d > h}

Out[7]=  {5, 1, 6}

Dies sind unsere Wunsch-Styles für die positiven, Null- und negativen
Contouren:

In[8]:= 
styleclass = {{Dashing[{}], 
        Hue[2/3]}, {AbsoluteThickness[2.]}, {Dashing[{.01}], Hue[0]}};

In[9]:=
newstyles = Flatten[MapThread[Table[#1, {#2}] &, {styleclass, ll}], 1];

So haben wir uns die gewünschte Option generiert, wir müssen also nur noch
die Show machen:

In[10]:=
Show[c, ContourStyle -> newstyles, DisplayFunction -> $DisplayFunction]
Out[10]=
\[SkeletonIndicator]ContourGraphics\[SkeletonIndicator]


Es kann natürlich sein, daß du viel einfacher das Maximum und das Minimum
deiner Funktion im Plot-Bereich bestimmen kannst, und die Countours explizit
bestimmst (z.B. eine auf 0 setzt) und deine Styles entsprechend bestimmsts
(z.B. wie In[9]); so würde ich es jedenfalls erstmal versuchen, aber
vielleicht willst du ja blind, will heißen, automatisiert arbeiten...


Ach, noch was: ich habe ContourShading -> False gesetzt (was mir in diesem
Zusammehang sinnvoll erscheint). Wenn, nicht, heißt True, dann bekommst du
noch Polygone in deine Graphic, dann solltest du erst die Lines herausziehen
(die Indizierungen ändern sich etwas).

--
Hartmut