TransWikia.com

Three-Set Venn Diagram with Varying Radii not Drawing Full Circles

Mathematica Asked by Robjobbob on December 23, 2020

Here is the code that I have:

a = Disk[{0, 1}, 0.7];
b = Disk[{-0.5, 0}, 1.3];
c = Disk[{0.5, 0}];

subsets = Subsets[{a, b, c}, {1, 3}];

subsetscolors = Map[
   Function[
    {c},
    Blend[
     Flatten[
      Map[
       Table[
         Map[
          Append[#, 1.5/Length[c]] &,
          c
          ], 2
         ] &,
       c
       ]
      ]
     ]
    ],
   Subsets[{RGBColor["#f839ff"], RGBColor["#fff839"], 
     RGBColor["#40ff39"]}, {1, 4}]
   ];

RegionPlot[
 Evaluate[
  DiscretizeRegion[RegionDifference[
      BooleanRegion[And, #],
      BooleanRegion[Or, 
       Complement[{a, b, c, EmptyRegion[2]}, #]]]] & /@ subsets
  ],
 PlotLabels -> Callout[
   (Apply[
     StringJoin, {{"a"}, {"b"}, {"c"}, {"d"}, {"e"}, {"f"}, {"g"}}, 
{1}]),
   Center
   ],
 Sequence[
  PlotStyle -> subsetscolors,
  BoundaryStyle -> Directive[Thickness[0.01], Black],
  Frame -> True,
  LabelStyle -> {20},
  PerformanceGoal -> "Quality",
  ImageSize -> 400
  ]
 ]

Producing this output:

enter image description here

Because I vary the radii, not all of the circles are being drawn in full.

Sometimes (but I have been unable to reproduce this for StackExchange) varying the radii for the three disks will change the areas where the disks are not fully rendered.

I am guessing my issue is with the maybe to do with PerformanceGoal ->, but as I have this set to "Quality" I do not know what the problem is.

3 Answers

I refer to this similar post to solve your problem(just use the plotrange as bounding box via the second argument of DiscretizeRegion).

a = Disk[{0, 1}, 0.7];
b = Disk[{-0.5, 0}, 1.3];
c = Disk[{0.5, 0}];

subsets = Subsets[{a, b, c}, {1, 3}];

subsetscolors = 
  Map[Function[{c}, 
    Blend[Flatten[
      Map[Table[Map[Append[#, 1.5/Length[c]] &, c], 2] &, c]]]], 
   Subsets[{RGBColor["#f839ff"], RGBColor["#fff839"], 
     RGBColor["#40ff39"]}, {1, 4}]];

RegionPlot[
 Evaluate[DiscretizeRegion[
     RegionDifference[BooleanRegion[And, #], 
      BooleanRegion[Or, 
       Complement[{a, b, c, EmptyRegion[2]}, #]]], {{-2, 2}, {-2, 
       2}}] & /@ subsets], 
 PlotLabels -> 
  Callout[(Apply[
     StringJoin, {{"a"}, {"b"}, {"c"}, {"d"}, {"e"}, {"f"}, {"g"}}, 
{1}]), Center], 
 Sequence[PlotStyle -> subsetscolors, 
  BoundaryStyle -> Directive[Thickness[0.01], Black], Frame -> True, 
  LabelStyle -> {20}, PerformanceGoal -> "Quality", ImageSize -> 400],
  PlotRange -> Full]

enter image description here

It should be noted that the editor does not allow us to manually adjust the display size of the image, which is too inconvenient.

Correct answer by A little mouse on the pampas on December 23, 2020

Are the radius values important? This works for me:

a = Disk[{0, 1}, 0.5];
b = Disk[{-0.5, 0}];
c = Disk[{0.5, 0}];

Moving the centers by 0.1 also works:

a = Disk[{0, 1}, 0.7];
b = Disk[{-0.4, 0}, 1.3];
c = Disk[{0.6, 0}];

Answered by Rodrigo on December 23, 2020

It's just a simple test.

{p, q, r} = {x^2 + (y - 1)^2 - 0.7^2 > 0, (x + 0.5)^2 + y^2 - 1.3^2 > 
    0, (x - 0.5)^2 + y^2 - 1^2 > 0};
boolean = 
  Reverse[List @@ 
    Distribute[And[Or[p, ! p], Or[q, ! q], Or[r, ! r]], Or, And]];
RegionPlot[boolean, {x, -2, 2}, {y, -2, 2}, 
 PlotLabels -> Placed[{"a", "b", "c", "d", "e", "f", "g"}, Center], 
 PlotStyle -> {Red, Orange, Yellow, Green, Blue, Cyan, Purple, Brown},
  PlotPoints -> 30, Frame -> False] 

enter image description here

Answered by cvgmt on December 23, 2020

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP