การเติมพื้นที่ระหว่างสี่ Halflines ใน ProbabilityScalePlot

Question

ภาพต่อไปนี้แสดงให้เห็นว่าฉันสร้างกราฟ Weibull เพื่อให้เห็นภาพความแข็งแกร่งของตัวอย่างได้อย่างไร

รหัสและข้อมูลที่จำเป็นอยู่ด้านล่าง ใน Epilog ของ ProbabilityScalePlot ฉันกำลังวางแผนช่วงความเชื่อมั่นของข้อมูล ฉันกำลังทำสิ่งนี้กับ HalfLines 4 แบบ

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}]

ฉันต้องการเติมระหว่าง HalfLines สี่เส้นที่มีความทึบต่ำเพื่อการนำเสนอที่ดีกว่า ขอบคุณล่วงหน้า!

Answer 1

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 สองConicHullRegions จากคู่ที่สองของ halflines และใช้RegionIntersectionของRegionDifferenceS จากรูปสี่เหลี่ยมผืนผ้า:

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.สร้างPiecewiseฟังก์ชันโดยใช้RegionMember+ RegionUnionสำหรับแต่ละคู่ของ halflines สองคู่และPlotมีตัวเลือก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.ดำเนินการhalflinesเพื่อรับพิกัดเส้นและเรียงลำดับใหม่เพื่อใช้กับPolygonหรือ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]}]

ภาพเดียวกัน

Answer 2

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

อัปเดตแล้ว

เราสามารถสร้างพื้นที่โดยเปลี่ยนรูปเส้นโค้งพาราเมตริกเป็นเส้นโค้ง{f[y],y}พาราเมตริกอื่น{g[y],y}โดย(1-t)*{f[y],y} + t*{g[y],y}แสดงดังต่อไปนี้:

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]