2
$\begingroup$

I am trying to illustrate regions based on conditions in a ternary. I got help with a ternary template and I would like to include the regions now.

  • Template

      Clear[A, B, F, ternary, reg, sol, reg2, sol2, tern]
      F = {1, 0, 0};
      B = {0, 1, 0};
      A = {0, 0, 1};
      TernaryListPlot[{{A -> ""}, {B -> ""}, {F -> ""}}, 
       PlotStyle -> {Blue, Blue, Blue}, 
       FrameTicksStyle -> Directive[FontFamily -> "Times", FontSize -> 14], 
       GridLines -> True, GridLinesStyle -> LightGray, 
       FrameTicks -> Range[0, 1, .2], 
       Prolog -> {{Black, Thick, Line[{{0, 0.5, 0.5}, {0.5, 0, 0.5}}]}, 
      {Black, Thick, Line[{{0.5, 0, 0.5}, {0.5, 0.5, 0}}]}, 
      {Black, Thick, Line[{{0, 0.5, 0.5}, {0.5, 0.5, 0}}]}, 
      {Text[Style["A", 15, FontColor -> Blue], {0, 0, 1}, {3, 1}]}, 
      {Text[Style["B", 15, FontColor -> Blue], {1, 0, 0}, {-3, 1}]}, 
      {Text[Style["C", 15, FontColor -> Blue], {0, 1, 0}, {0, -4}]}}, 
      PlotRangePadding -> 0.2]
    

enter image description here

  • Regions/Conditions

      ternary[{p1_, p2_, p3_}] = {p1 + 1/2 p2, Sqrt[3]/2 p2};
      reg[a_, b_] := ImplicitRegion[{a*x + b*z >= 0.5, {x, y, z} >= 0, x + y + z == 1}, {x, y, z}];
      sol[a_, b_] := {x, y, z} /. FindInstance[{x, y, z} \[Element] reg[a, b], {x, y, z}, 1];
      reg2[c_] := ImplicitRegion[{c*y >= 0.25, {x, y, z} >= 0, x + y + z == 1}, {x, y, z}];
      sol2[c_] := {x, y, z} /. FindInstance[{x, y, z} \[Element] reg2[c], {x, y, z}, 1];
      tern[a_, b_, c_] := TernaryListPlot[sol[a, b], 
      Prolog -> {{Blue,DiscretizeRegion[TransformedRegion[reg[a, b], ternary], MaxCellMeasure -> 1/100000]}, 
      {Red, DiscretizeRegion[TransformedRegion[reg2[c], ternary], MaxCellMeasure -> 1/100000]}},         
      PlotStyle -> Transparent]
      tern[0.51, 0.5, 0.6]
    

enter image description here

*** Question 1**

Where do I place the template and/or graph when combining both?

*** Question 2**

How do I avoid the error messages "DiscretizeRegion was unable to discretize the region
ParametricRegion[<<2>>]" when a<=0.5 and b<=0.5 and get a blank ternary indicating no solution?

Thank you!

$\endgroup$
3
  • $\begingroup$ If you name the first TernaryListPlot in the template pl1 i.e. pl1=TernaryListPlot[{{A -> ""}, {B -> ""}, {F -> ""}},...,PlotRangePadding -> 0.2] and then do Show[{tern[0.51, 0.5, 0.6], pl1}], is this what you want? Also, for your Question 2, I do not get any error messages. $\endgroup$
    – demm
    Sep 27, 2022 at 21:26
  • $\begingroup$ The error message appears if used for example tern[0.25,0.25,0.6]. $\endgroup$
    – Tom
    Sep 27, 2022 at 21:38
  • $\begingroup$ It only provides the grid lines and the corner points - but no corner labels and no black triangle. The formatting follows the second triangle/output/picture. $\endgroup$
    – Tom
    Sep 27, 2022 at 21:47

1 Answer 1

3
$\begingroup$
  • When a=0.25,b=0.25,c=0.6, some region is EmptyRegion[3], so DiscretizeRegion gave warning message.
  • Here we also recommend to directly use Simplex and HalfSpace.
Clear["Global`*"];
reg1[a_, b_] = 
  RegionIntersection[Simplex[IdentityMatrix[3]], 
   HalfSpace[-{a, 0, b}, -.5]];
polys1[a_, b_] := 
  If[reg1[a, b] === EmptyRegion[3], Nothing, 
   MeshPrimitives[DiscretizeRegion[reg1[a, b]], 2]];
reg2[c_] = 
  RegionIntersection[Simplex[IdentityMatrix[3]], 
   HalfSpace[-{0, c, 0}, -.25]];
polys2[c_] := 
  If[reg2[c] === EmptyRegion[3], Nothing, 
   MeshPrimitives[DiscretizeRegion[reg2[c]], 2]];
tern[a_, b_, c_] := 
 TernaryListPlot[{}, 
  Prolog -> {{Blue, polys1[a, b]}, {Red, polys2[c]}}, 
  PlotStyle -> Transparent]
Manipulate[tern[a, b, .5], {{a, .25}, 0.1, 1}, {{b, .25}, .1, 1}, 
 ControlPlacement -> Top]

enter image description here

  • To combine the two figures, we can add all of them to Prolog or Epilog.
Clear["Global`*"];
reg1[a_, b_] = 
  RegionIntersection[Simplex[IdentityMatrix[3]], 
   HalfSpace[-{a, 0, b}, -.5]];
polys1[a_, b_] := 
  If[reg1[a, b] === EmptyRegion[3], Nothing, 
   MeshPrimitives[DiscretizeRegion[reg1[a, b]], 2]];
reg2[c_] = 
  RegionIntersection[Simplex[IdentityMatrix[3]], 
   HalfSpace[-{0, c, 0}, -.25]];
polys2[c_] := 
  If[reg2[c] === EmptyRegion[3], Nothing, 
   MeshPrimitives[DiscretizeRegion[reg2[c]], 2]];
F = {1, 0, 0};
B = {0, 1, 0};
A = {0, 0, 1};
ternaryplot[a_, b_, c_] := 
  TernaryListPlot[{{A -> ""}, {B -> ""}, {F -> ""}}, 
   PlotStyle -> {Blue, Blue, Blue}, 
   FrameTicksStyle -> 
    Directive[FontFamily -> "Times", FontSize -> 14], 
   GridLines -> True, GridLinesStyle -> LightGray, 
   FrameTicks -> Range[0, 1, .2], 
   Prolog -> {{Blue, polys1[a, b]}, {Red, polys2[c]}}, 
   Epilog -> {{Black, Thick, 
      Line[{{0, 0.5, 0.5}, {0.5, 0, 0.5}}]}, {Black, Thick, 
      Line[{{0.5, 0, 0.5}, {0.5, 0.5, 0}}]}, {Black, Thick, 
      Line[{{0, 0.5, 0.5}, {0.5, 0.5, 0}}]}, {Text[
       Style["A", 15, FontColor -> Blue], {0, 0, 1}, {3, 1}]}, {Text[
       Style["B", 15, FontColor -> Blue], {1, 0, 0}, {-3, 1}]}, {Text[
       Style["C", 15, FontColor -> Blue], {0, 1, 0}, {0, -4}]}}, 
   PlotRangePadding -> 0.2];
ternaryplot[.81, .5, .6]
Clear["Global`*"];
reg1[a_, b_] := 
  ParametricRegion[{{x + y/2, (Sqrt[3] y)/2}, 
     a*x + b*(1 - x - y) >= 0.5 && x + y <= 1}, {{x, 0, 1}, {y, 0, 
      1}}] // DiscretizeRegion;
reg2[c_] := 
  ParametricRegion[{{x + y/2, (Sqrt[3] y)/2}, 
     c*y >= 0.25 && x + y <= 1}, {{x, 0, 1}, {y, 0, 1}}] // 
   DiscretizeRegion;
F = {1, 0, 0};
B = {0, 1, 0};
A = {0, 0, 1};
ternaryplot[a_, b_, c_] := 
  TernaryListPlot[{{A -> ""}, {B -> ""}, {F -> ""}}, 
   PlotStyle -> {Blue, Blue, Blue}, 
   FrameTicksStyle -> 
    Directive[FontFamily -> "Times", FontSize -> 14], 
   GridLines -> True, GridLinesStyle -> LightGray, 
   FrameTicks -> Range[0, 1, .2], 
   Prolog -> {{Blue, reg1[a, b]}, {Red, reg2[c]}}, 
   Epilog -> {{Black, Thick, 
      Line[{{0, 0.5, 0.5}, {0.5, 0, 0.5}}]}, {Black, Thick, 
      Line[{{0.5, 0, 0.5}, {0.5, 0.5, 0}}]}, {Black, Thick, 
      Line[{{0, 0.5, 0.5}, {0.5, 0.5, 0}}]}, {Text[
       Style["A", 15, FontColor -> Blue], {0, 0, 1}, {3, 1}]}, {Text[
       Style["B", 15, FontColor -> Blue], {1, 0, 0}, {-3, 1}]}, {Text[
       Style["C", 15, FontColor -> Blue], {0, 1, 0}, {0, -4}]}}, 
   PlotRangePadding -> 0.2];
ternaryplot[.81, .5, .6]

enter image description here

$\endgroup$
5
  • $\begingroup$ reg[a_, b_] := ParametricRegion[{{x + y/2, (Sqrt[3] y)/2}, a*x + b*(1 - x - y) >= 0.5 && x + y <= 1}, {{x, 0, 1}, {y, 0, 1}}] // DiscretizeRegion; reg2[c_] := ParametricRegion[{{x + y/2, (Sqrt[3] y)/2}, c*y >= 0.25 && x + y <= 1}, {{x, 0, 1}, {y, 0, 1}}] // DiscretizeRegion; tern[a_, b_, c_] := TernaryListPlot[{}, Prolog -> {{Blue, reg[a, b]}, {Red, reg2[c]}}, PlotStyle -> Transparent] tern[0.51, 0.5, 0.6] $\endgroup$
    – cvgmt
    Sep 28, 2022 at 14:35
  • $\begingroup$ Thank you! Depending on the two approaches - simplex/halfspace vs. conditions (comment) - the black triangle is on top (picture) or below the blue/red area. reg[a_, b_] := ParametricRegion[{{x + y/2, (Sqrt[3] y)/2}, ax + b*(1 - x - y) >= 0.5 && x + y <= 1}, {{x, 0, 1}, {y, 0, 1}}] // DiscretizeRegion; reg[c_] := ParametricRegion[{{x + y/2, (Sqrt[3] y)/2}, cy >= 0.25 && x + y <= 1}, {{x, 0, 1}, {y, 0, 1}}] // DiscretizeRegion; $\endgroup$
    – Tom
    Sep 28, 2022 at 16:01
  • $\begingroup$ tern[a_, b_, c_] := TernaryListPlot[{{A -> ""}, {B -> ""}, {F -> ""}}, PlotStyle -> {Blue, Blue, Blue}, FrameTicksStyle -> Directive[FontFamily -> "Times", FontSize -> 14], GridLines -> True, GridLinesStyle -> LightGray, FrameTicks -> Range[0, 1, .2], Epilog -> {{Blue, reg[a, b]}, {Red, reg[c]}}, $\endgroup$
    – Tom
    Sep 28, 2022 at 16:02
  • $\begingroup$ Prolog -> {{Black, Thick, Line[{{0, 0.5, 0.5}, {0.5, 0, 0.5}}]}, {Black, Thick, Line[{{0.5, 0, 0.5}, {0.5, 0.5, 0}}]}, {Black, Thick, Line[{{0, 0.5, 0.5}, {0.5, 0.5, 0}}]}, {Text[ Style["A", 15, FontColor -> Blue], {0, 0, 1}, {3, 1}]}, {Text[ Style["B", 15, FontColor -> Blue], {1, 0, 0}, {-3, 1}]}, {Text[ Style["C", 15, FontColor -> Blue], {0, 1, 0}, {0, -4}]}}, PlotRangePadding -> 0.2] tern[0.51, 0.5, 0.6] $\endgroup$
    – Tom
    Sep 28, 2022 at 16:02
  • $\begingroup$ I would prefer the second solution as it would allow me to expand the number of conditions - compared to the halfspace method. $\endgroup$
    – Tom
    Sep 28, 2022 at 16:03

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.