4
$\begingroup$

I was able to plot most of the parts of the figure. But I have a problem with some legend items. Here is my code:

θ = 0.30853753872598694`;
c[x_] := CDF[NormalDistribution[0, 1], x];
cc[x_] := InverseCDF[NormalDistribution[0, 1], x];
c1[x_] := (θ/(1 - θ))*(1 - x)
c2[x_] := (-x + θ + x θ)/θ
c3[x_] := 2*θ - x
c4[x_] := θ*DiracDelta[θ - x]
d[x_] := c[cc[1 - x] - 1];

p1 = 
  Plot[{d[x], c1[x], c2[x], c3[x]}, {x, 0, 1}, 
   GridLines -> Automatic, 
   GridLinesStyle -> LightGray, 
   PerformanceGoal -> "Quality", 
   PlotLegends -> 
     Placed[
       LineLegend[{
         Style[Subscript[P, M], FontSize -> 21], 
         Style[Subscript[l, 1], FontSize -> 21], 
         Style[Subscript[l, 2], FontSize -> 21], 
         Style[Subscript[l, 3], FontSize -> 21]}, 
         LegendFunction -> (Framed[#, RoundingRadius -> 2, FrameStyle -> LightGray] &), 
         BaseStyle -> 18], 
       {Right, Top}], 
   Filling -> {2 -> {3}}, 
   FillingStyle -> LightOrange, 
   PlotStyle -> {Blue, Directive[Dashed, Black], Directive[Dashed, Black], Red}, 
   PlotRange -> {0, 1}, 
   AxesLabel -> 
     {Style[Subscript[P, F], FontSize -> 21], Style[Subscript[P, M], FontSize -> 21]}, 
   BaseStyle -> 18, 
   AxesStyle -> Arrowheads[0.03], 
   AspectRatio -> .7];

Show[p1, Graphics[{PointSize[0.02], Black, Point[{θ, θ}]}]]

What I couldn't do:

  1. The intersection of the butterfly area and the area below the red line should be dotted on the light orange color. Namely the area below the red line and the intersection of this area with the butterfly area needs to be dotted and on light orange.

  2. I want to put the butterfly area as $\mathcal{B}_{\theta}$ into the legend. Like a square area dvided into two equal areas with light orange and dotted light orange

  3. I want to put $\mathcal{S}_{\theta}$, which is just the dotted area into the legend as well. A square area with dotted lightorange.

  4. I want to put the black point in the figure into the legend as $(\theta,\theta)$

I dont know how to do these things, although I spent time on it, and therefore I need help.

enter image description here

The final version:

enter image description here

Improve this question
$\endgroup$
7
  • $\begingroup$ What do you mean by 'dotted and on light orange'? Do you mean the indicated area should be colored with light orange dots? $\endgroup$
    – m_goldberg
    Commented Mar 8, 2015 at 2:48
  • 1
    $\begingroup$ Suggest you don't use Show. Rather, add your black point using the option Epilog -> {PointSize[0.02], Black, Point[{θ, θ}]}. $\endgroup$
    – m_goldberg
    Commented Mar 8, 2015 at 2:52
  • $\begingroup$ @m_goldberg no just say black dots on the orange region. I tried to rule out the possibility of only a dotted region without orange backgound with the explanation in the question. $\endgroup$
    – Seyhmus Güngören
    Commented Mar 8, 2015 at 10:42
  • $\begingroup$ @m_goldberg thank you very much for the suggestion. I also wanted not to make two graphy and my idea was to just plot a single point giving its coordinates in the original plot. This didnt work out, because I couldnt scale it up or put a suitable mark-> this is usually what I was doing in Matlab. I used previously epilog but to add another figure, now I got the point, with epilog, live long epilog)) $\endgroup$
    – Seyhmus Güngören
    Commented Mar 8, 2015 at 10:46
  • $\begingroup$ Re 1: Do you mean Graphics[{Texture[ Graphics[Disk[], Background -> LightOrange, PlotRangePadding -> Scaled[.25]]], Polygon[{{0.5, 0}, {2 \[Theta], 0}, {0, 2 \[Theta]}, {0, 0.5}, {\[Theta], \[Theta]}}, VertexTextureCoordinates -> 50 {{0.5, 0}, {2 \[Theta], 0}, {0, 2 \[Theta]}, {0, 0.5}, {\[Theta], \[Theta]}}]}]? $\endgroup$
    – Michael E2
    Commented Mar 9, 2015 at 13:28

2 Answers 2

Reset to default
9
$\begingroup$

First, a function to produce dots to be used as filling:

dotsF[n_: {50, 50}, sz_: Medium, clr_: LightGray] := 
 With[{g = Tuples[{Range[n[[1]]], Range[n[[2]]]}]}, Graphics[{clr, PointSize[sz], Point@g},
   ImagePadding -> 0, PlotRangeClipping -> False, PlotRangePadding -> 0, AspectRatio -> 1]]
dotsF[{10, 10}, .1, Green]

enter image description here

It will be more convenient to render the pieces separately so that we can generate legend icons for various components:

pltc3 = Plot[c3[u], {u, 0, 1}, PlotStyle -> Directive[Thick, Opacity[1], Red], Axes -> False, 
   Frame -> False, AspectRatio -> 1];
pltd = Plot[d[u], {u, 0, 1}, PlotStyle -> Directive[Thick, Opacity[1], Blue], Axes -> False, 
   Frame -> False, AspectRatio -> 1];
pltc1c2 = Plot[{c1[u], c2[u]}, {u, 0, 1}, 
   PlotStyle -> Directive[Thick, Dashed, Black], Mesh -> {{\[Theta]}},
    MeshStyle -> PointSize[.03], Axes -> False, Frame -> False, AspectRatio -> 1];

ParametricPlot with dotted filling:

prmplt = ParametricPlot[{{u, (1 - v) Min[c1[u], c2[u]] + v c3[u]}, 
         {u, (1 - v) Max[c1[u], c2[u]] + v c3[u]}}, {u, 0, 1}, {v, 0, 1}, 
   Mesh -> None, PlotRange -> {{0, 1}, {0, 1}},
   AspectRatio -> 1, BoundaryStyle -> Opacity[0], Axes -> False, 
   Frame -> False, AspectRatio -> (ar = .7),
   PlotStyle -> {Directive[{Opacity[.7], 
    Texture[ImageMultiply[dotsF[{120, 120}, Tiny, Red], Orange]]}], 
     Directive[Opacity[.7], Orange]}, 
   TextureCoordinateFunction -> ({#, ar #2} &), 
   TextureCoordinateScaling -> False];

show = Show[prmplt, pltd, pltc3, pltc1c2, PlotRange -> {{0, 1}, {0, 1}}, 
 Axes -> True, Frame -> False, BaseStyle -> 18, AspectRatio -> .7, 
 AxesStyle -> Arrowheads[0.03`], GridLines -> Automatic, GridLinesStyle -> GrayLevel[0.85`], 
 AxesLabel -> {Style[Subscript[P, F], 21], Style[Subscript[P, M], 21]}, ImageSize -> 600]

enter image description here

Legend icons and labels:

labels = Style[#, 20, Bold] & /@ {Subscript["P", "M"], Subscript["\[ScriptL]", "3"], 
    Subscript["\[ScriptCapitalB]", "\[Theta]"], 
    Subscript["\[ScriptCapitalS]", "\[Theta]"], 
    Subscript["\[ScriptL]", "1|2"], "{\[Theta],\[Theta]}"};

icons = {pltd /. Thickness[_] :> Thickness[.05], pltc3 /. Thickness[_] :> Thickness[.05], 
   prmplt , ImageMultiply[dotsF[{7, 7}, .075, Orange], Orange], 
   pltc1c2 /. {Thickness[_] :> Thickness[.02], 
               Dashing[_] :> Dashing[.1], PointSize[_] :> PointSize[0]}, 
   pltc1c2 /. {Thickness[_] :> Thickness[.01], PointSize[_] :> PointSize[.2]}};

legends = Labeled[#, #2, Right] & @@@ Transpose[{Thumbnail[#, 32] & /@ icons, labels}];

enter image description here

All together:

Legended[show, Placed[Panel@Column[legends, Spacings -> 1], {0.85, 0.6}]]

enter image description here

Update: New requirements from the comments:

I want to add this : LegendFunction -> (Framed[#, RoundingRadius -> 2, FrameStyle -> LightGray] &)

... make the box roundings a bit different and the legend transparent? so that the figure (and gridlines) staying at the background can be seen from the legend

prmplt2 = ParametricPlot[{{u, (1 - v) Min[c1[u], c2[u]] +  v c3[u]}, 
   {u, (1 - v) Max[c1[u], c2[u]] + v c3[u]}}, {u, 0,  1}, {v, 0, 1},
   Mesh -> None, 
   PlotRange -> {{0.2, c2[.2]}, {.2, c2[.2]}}, AspectRatio -> 1, 
   BoundaryStyle -> Opacity[0], Axes -> False, Frame -> False, 
   AspectRatio -> (ar = .7), 
   PlotStyle -> {Directive[{Opacity[.7], 
       Texture[ImageMultiply[dotsF[{40, 40}, Medium, Darker@Red], 
         Orange]]}], Directive[Opacity[.7], Orange]}, 
   TextureCoordinateFunction -> ({#, ar #2} &), 
   TextureCoordinateScaling -> False, PlotPoints -> 100];

icons = {Show[pltd, Background -> Transparent] /. 
    Thickness[_] :> Thickness[.05], 
   Show[pltc3, Background -> Transparent] /. 
    Thickness[_] :> Thickness[.05], 
   Show[prmplt2, Background -> Transparent], 
   ImageMultiply[dotsF[{7, 7}, .075, Orange], Orange], 
   Show[pltc1c2, 
     Background -> Transparent] /. {Thickness[_] :> Thickness[.02], 
     Dashing[_] :> Dashing[.1], PointSize[_] :> PointSize[0]}, 
   Show[pltc1c2, 
     Background -> Transparent] /. {Thickness[_] :> Thickness[.01], 
     PointSize[_] :> PointSize[.2]}};

legends = 
 Labeled[#, #2, Right] & @@@ 
  Transpose[{Thumbnail[#, 32] & /@ icons, labels}];

Legended[show, 
 Placed[Framed[Column[legends, Spacings -> .75], RoundingRadius -> 2, 
   FrameStyle -> LightGray], {0.85, 0.6}]]

enter image description here

... if one could make (one of the icons) a bit bigger:

legends2 = Labeled[#, #2, Right] & @@@ 
   Transpose[{ReplacePart[Show[#, ImageSize -> 30] & /@ icons, {3} -> 
       Show[icons[[3]], ImageSize -> 50]], labels}];
Legended[show, 
 Placed[Framed[Column[legends2, Spacings -> .75], RoundingRadius -> 2,
    FrameStyle -> LightGray], {0.85, 0.6}]]

enter image description here

Improve this answer
$\endgroup$
7
  • $\begingroup$ This is something much better than I could expect. Some issues are about the beauty but I can definitely adjust them. Thank you very much for the answer. I will let you know. $\endgroup$
    – Seyhmus Güngören
    Commented Mar 9, 2015 at 14:29
  • $\begingroup$ Finally I am back to this question. I think I have done almost all. There is one little point. $\mathcal{B}_{\theta}$. It is just iconized version of the parametric plot and I was wondering if one could make it a bit bigger. Like via zooming and moving to the origin? $\endgroup$
    – Seyhmus Güngören
    Commented Apr 11, 2015 at 21:39
  • $\begingroup$ One more point, where I failed: I cannot manipulate the legend. I want to add this : LegendFunction -> (Framed[#, RoundingRadius -> 2, FrameStyle -> LightGray] &)] but how? I tried many possibilities and all was wrong. In other words, is there a way to make the box roundings a bit different and the legend transparant? so that the figure (and gridlines) staying at the background can be seen from the legend? $\endgroup$
    – Seyhmus Güngören
    Commented Apr 11, 2015 at 22:32
  • $\begingroup$ @Seyhmus, hope the update answers the new questions in the comments. $\endgroup$
    – kglr
    Commented Apr 11, 2015 at 23:22
  • $\begingroup$ thank you very much. I tried them, so both have little problems and I rolled back to the previous version, which is quite okay. They are not so important I guess. Have a look at the final version, I am putting to the question for a while. $\endgroup$
    – Seyhmus Güngören
    Commented Apr 11, 2015 at 23:41
6
$\begingroup$

I post for illustrative purposes only. I also suggest looking at LegendFunction documentation.

rp = RegionPlot[0 < y < Exp[-x^2] && x > 1, {x, -2, 2}, {y, 0, 1}, 
   BoundaryStyle -> None, PlotStyle -> LightBlue, PlotPoints -> 40];
p = Plot[Exp[-x^2], {x, -2, 2}, Epilog -> Point[{1, Exp[-1]}]];
Legended[Show[p, rp], 
 Placed[Column[{LineLegend[{Blue}, {e^-z^2}], 
    SwatchLegend[{LightBlue}, {HoldForm[\!\(
\*SubsuperscriptBox[\(\[Integral]\), \(1\), \(\[Infinity]\)]\(
\*SuperscriptBox[\(e\), \(-
\*SuperscriptBox[\(z\), \(2\)]\)] \[DifferentialD]z\)\)]}], 
    PointLegend[{Black}, \
{"(1,\!\(\*SuperscriptBox[\(\[ExponentialE]\), \(-1\)]\))"}]}, 
   Frame -> True], {0.85, 0.7}]]

enter image description here

Improve this answer
$\endgroup$
3
  • $\begingroup$ Here are some differences: For example how to fill a region of intersection of three curves? as is the case in the question. Is it not possible to use plotlegends? $\endgroup$
    – Seyhmus Güngören
    Commented Mar 8, 2015 at 14:20
  • 1
    $\begingroup$ @SeyhmusGüngören The option LegendMarkers seems to allow you to use any expression in a legend, including arbitrary graphics. $\endgroup$
    – Michael E2
    Commented Mar 8, 2015 at 20:05
  • $\begingroup$ @MichaelE2 how to select and fill the region on the intersection of three curves? the item 1 of the question. $\endgroup$
    – Seyhmus Güngören
    Commented Mar 9, 2015 at 13:08

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.