# How to stretch this Venn diagram?

I am trying to duplicate (approximately) the following Venn diagram in Mathematica: I have used the top of this page as a guide, which showcases the following Venn diagram triplet:

a = Disk[{0, 1}];
b = Disk[{-0.5, 0}];
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[
Map[
ColorData,
Range], {1, 4}]];
RegionPlot[Evaluate[DiscretizeRegion[
RegionDifference[
BooleanRegion[And, #],
BooleanRegion[Or, Complement[{a, b, c, EmptyRegion}, #]]
]
] & /@ subsets],
PlotLabels ->
Callout[(StringJoin @@@ Subsets[{"A", "B", "C"}, {1, 3}]),
Center], Sequence[
PlotStyle -> subsetscolors, BoundaryStyle -> Directive[
Thickness[0.01], White], Frame -> False, LabelStyle -> {24},
PerformanceGoal -> "Speed", ImageSize -> 450]] Attempted code:

a = Disk[{0, 1}];
b = Disk[{-0.5, 0}];
c = Disk[{0.5, 0}];
subsets = Subsets[{b, c}, {1, 2}];
subsetscolors =
Map[Function[{c},
Blend[Flatten[
Map[Table[Map[Append[#, 1.5/Length[c]] &, c], 2] &, c]]]],
Subsets[Map[ColorData, Range], {1, 4}]];
RegionPlot[
Evaluate[DiscretizeRegion[
RegionDifference[BooleanRegion[And, #],
BooleanRegion[Or, Complement[{b, c, EmptyRegion}, #]]]] & /@
subsets],
PlotLabels ->
Callout[{"Vive", "Linux", "Vive\n\[Intersection]\nLinux"}, Center],
Sequence[PlotStyle -> subsetscolors,
BoundaryStyle -> Directive[Thickness[0.01], White], Frame -> False,
LabelStyle -> {24}, PerformanceGoal -> "Speed",
ImageSize -> Automatic]] The problem is that it is squashed, and I can't figure out why. How to fix?

• Try setting the Aspect Ratio->... option by hand. – N.J.Evans Dec 11 '19 at 14:57
• Setting AspectRatio -> 0.7 somewhat fixes the issue, but the circles are now "jagged". Is there not a way for Mathematica to interpolate this automatically? – George Dec 11 '19 at 15:06
• You also have PerformanceGoal->"Speed" which is going to make the plot fast, and rough. When you've got what you want change that to "Quality" and you should see the edges sharpen up. – N.J.Evans Dec 11 '19 at 16:11

I get a decent looking result with:

RegionPlot[
Evaluate[DiscretizeRegion[
RegionDifference[BooleanRegion[And, #],
BooleanRegion[Or, Complement[{b, c, EmptyRegion}, #]]],
MaxCellMeasure -> {"Length" -> 0.1}] & /@ subsets],
PlotLabels ->
Callout[{"Vive", "Linux", "Vive\n\[Intersection]\nLinux"}, Center],
Sequence[PlotStyle -> subsetscolors,
BoundaryStyle -> Directive[Thickness[0.01], White], Frame -> False,
LabelStyle -> {24}, PerformanceGoal -> "Speed",
ImageSize -> Automatic, AspectRatio -> Automatic]]


which has two changes from your code:

• adds MaxCellMeasure -> {"Length" -> 0.1} to the call the DiscretizeRegion to have a finer discretization

• uses AspectRatio -> Automatic to automatically get the aspect ratio that makes the disks not be stretched Graphics[{
Opacity[0.5],
Red, Disk[{-0.66, 0}],
Blue, Disk[{0.66, 0}],
Opacity, White,
Text[Style["Vive Users", 18], {-0.8, 0}],
Text[Style["Linux Users", 18], {0.85, 0}],
Text[Style["Vive\n⋂\nLinux", 18], {0, 0}]}] 