# Filling the Area between four Halflines in ProbabilityScalePlot

The following picture shows how I make a Weibull Graph to visualize the strength of samples.

The code and the needed data are below. In the Epilog of ProbabilityScalePlot I am plotting the confidence intervals for the data. I am doing this with 4 different HalfLines.

halflines={HalfLine[{6.11461, 0}, {-1, -14.1021}],
HalfLine[{6.11461, 0}, {1, 22.9597}],
HalfLine[{6.15032, 0}, {1, 14.1021}],
HalfLine[{6.15032, 0}, {-1, -22.9597}]}

strength={422.918, 488.943, 436.838, 420.08, 481.187, 430.53, 433.959, \
414.308, 468.762, 470.08, 459.893, 428.151, 423.193, 421.472, \
484.492, 463.508, 428.949, 497.333, 470.477, 402.887, 471.617, \
433.492, 415.18, 420.383, 474.359, 447.246, 445.556, 480.03, 459.678, \
448.732}

ProbabilityScalePlot[strength, "Weibull", AspectRatio -> 1.25,
PlotRange -> {{300, 600}, {0.5, 99.5}},
GridLines -> {Range[300, 600, 50], {0.1, 1, 10, 50, 63, 2, 90, 99}},
Epilog -> {Orange, halflines}]


I would like to make a Filling between the four HalfLines with low Opacity for a nicer presentation. Thanks in advance!

psp = ProbabilityScalePlot[strength, "Weibull", AspectRatio -> 1.25,
PlotRange -> {{300, 600}, {0.5, 99.5}},
GridLines -> {Range[300, 600, 50], {0.1, 1, 10, 50, 63, 2, 90,  99}},
Epilog -> {Orange, halflines}];

prange = PlotRange[psp] + {{-1, 1}, {-1, 1}};


1. Construct two ConicHullRegions from the two pairs of halflines and take the RegionIntersection of their RegionDifferences from a rectangle:

chrs = ConicHullRegion[{#[[1, 1]]}, {#[[1, 2]], #[[2, 2]]}] & /@
Partition[halflines, 2];

regint = RegionIntersection @@
(RegionDifference[Rectangle @@ Transpose[prange],
DiscretizeGraphics @ Graphics[#, PlotRange -> prange]] & /@ chrs);

Show[psp,
Prolog -> {Show[regint][[1]] /. p_Polygon :>
{EdgeForm[], Opacity[.75, LightGreen], p}}]


2. Construct a Piecewise function using RegionMember + RegionUnion for each of the two pairs of halflines and Plot them with option Filling:

toPiecewise = FullSimplify[RegionMember[RegionUnion @@ #][{x, y}], {x, y} ∈  Reals] /.
And[a_, b_] :> {y /. Solve[b, y][[1]], a} /. Or -> (Piecewise[{##}] &) &;

g1[x_] := Evaluate @ toPiecewise @ halflines[[;; 2]]
g2[x_] := Evaluate @ toPiecewise @ halflines[[3 ;;]]

Show[psp, Prolog -> First @ Plot[{g1[x], g2[x]}, {x, ## & @@ prange[[1]]},
PlotStyle -> None, Filling -> {1 -> {{2}, Opacity[.5, LightGreen]}},
Exclusions -> None]]


3. Process halflines to get the line coordinates and re-order them to use with Polygon or FilledCurve:

lcoords = {#, Reverse @ #2} & @@ (SortBy[Last][MeshCoordinates @
DiscretizeGraphics[Graphics @ #, PlotRange -> prange]] & /@ Partition[halflines, 2]);

Show[psp, Prolog -> {EdgeForm[], Opacity[.5, LightGreen], Polygon[Join @@lcoords]}]


Show[psp,  Prolog -> {EdgeForm[], Opacity[.5, LightGreen], FilledCurve[Line/@ lcoords]}]


same picture

Clear["*"];
strength = {422.918, 488.943, 436.838, 420.08, 481.187, 430.53,
433.959, 414.308, 468.762, 470.08, 459.893, 428.151, 423.193,
421.472, 484.492, 463.508, 428.949, 497.333, 470.477, 402.887,
471.617, 433.492, 415.18, 420.383, 474.359, 447.246, 445.556,
480.03, 459.678, 448.732};
fig = ProbabilityScalePlot[strength, "Weibull", AspectRatio -> 1.25,
PlotRange -> {{300, 600}, {0.5, 99.5}},
GridLines -> {Range[300, 600, 50], {0.1, 1, 10, 50, 63, 2, 90,
99}}];
a0 = {6.11461, 0};
a1 = {-1, -14.1021};
a2 = {1, 22.9597};
b0 = {6.15032, 0};
b1 = {1, 14.1021};
b2 = {-1, -22.9597};
reg = RegionIntersection[RegionUnion[HalfPlane[a0, a1, {1, 0}],
HalfPlane[a0, a2, {1, 0}]],
RegionUnion[HalfPlane[b0, b1, {-1, 0}],
HalfPlane[b0, b2, {-1, 0}]]];
Show[fig,
RegionPlot[reg, BoundaryStyle -> Orange,
PlotStyle -> Directive[Yellow, Opacity[0.1]]]]


Updated

We can construct a region by deformate a parametric curves {f[y],y} to another parametric curves {g[y],y} by (1-t)*{f[y],y} + t*{g[y],y} as display as below:

Clear["*"];
f[y_] = Sin[y];
g[y_] = Sqrt[1 + y^2];
ParametricPlot[{{f[y], y}, {g[y], y}}, {y, -2 Pi, 2 Pi}]
ParametricPlot[(1 - t)*{f[y], y} + t*{g[y], y}, {t, 0,
1}, {y, -2 Pi, 2 Pi}, MeshFunctions -> (#3 &), Mesh -> 10]
GraphicsRow[{%%, %}]


Clear["*"];
strength = {422.918, 488.943, 436.838, 420.08, 481.187, 430.53,
433.959, 414.308, 468.762, 470.08, 459.893, 428.151, 423.193,
421.472, 484.492, 463.508, 428.949, 497.333, 470.477, 402.887,
471.617, 433.492, 415.18, 420.383, 474.359, 447.246, 445.556,
480.03, 459.678, 448.732};
fig = ProbabilityScalePlot[strength, "Weibull", AspectRatio -> 1.25,
PlotRange -> {{300, 600}, {0.5, 99.5}},
GridLines -> {Range[300, 600, 50], {0.1, 1, 10, 50, 63, 2, 90,
99}}];
x1 = 6.11461;
x2 = 6.15032;
k1 = 14.1021;
k2 = 22.9597;
f[y_] := Piecewise[{{x1 + y/k2, y >= 0}, {x1 + y/k1, y < 0}}];
g[y_] := Piecewise[{{x2 + y/k1, y >= 0}, {x2 + y/k2, y < 0}}];
lines = ParametricPlot[{{f[y], y}, {g[y], y}}, {y, -6, 2},
PlotStyle -> {{Thick, Orange}, {Thick, Red}}];
reg = ParametricPlot[{t*f[y] + (1 - t)*g[y], y}, {t, 0, 1}, {y, -6,
2}, PlotPoints -> 100,
PlotStyle -> Directive[Green, Opacity[0.1]]];
Show[fig, reg, lines]
`

• I want to do a comparable plot. The answers here are good to make one. I am missing one step for me that is how to get the values for the curved confidence bounds? E.g. I have the standard error (from: mathematica.stackexchange.com/questions/6498/…) Feb 28, 2021 at 14:06