How to plot Venn diagrams with Mathematica?

Question

How does one plot Venn diagrams with Mathematica? I've searched quite a bit and I've found one source at MathWorld which provides the source code for doing them.

But I don't understand this code, can someone help me?

Answer 1

Based on that outdated notebook, I did the following function:

VennDiagram2[n_, ineqs_: {}] := 
 Module[{i, r = .6, R = 1, v, grouprules, x, y, x1, x2, y1, y2, ve},
  v = Table[Circle[r {Cos[#], Sin[#]} &[2 Pi (i - 1)/n], R], {i, n}];
  {x1, x2} = {Min[#], Max[#]} &[
    Flatten@Replace[v, 
      Circle[{xx_, yy_}, rr_] :> {xx - rr, xx + rr}, {1}]];
  {y1, y2} = {Min[#], Max[#]} &[
    Flatten@Replace[v, 
      Circle[{xx_, yy_}, rr_] :> {yy - rr, yy + rr}, {1}]];
  ve[x_, y_, i_] := 
   v[[i]] /. Circle[{xx_, yy_}, rr_] :> (x - xx)^2 + (y - yy)^2 < rr^2;
  grouprules[x_, y_] = 
   ineqs /. 
    Table[With[{is = i}, Subscript[_, is] :> ve[x, y, is]], {i, n}];
  Show[
   If[MatchQ[ineqs, {} | False], {},
    RegionPlot[grouprules[x, y],
     {x, x1, x2}, {y, y1, y2}, Axes -> False]
    ],
   Graphics[v]
   , PlotLabel -> 
    TraditionalForm[Replace[ineqs, {} | False -> \[EmptySet]]], 
   Frame -> False
   ]
  ]

Which can have as inequallity any logical expression with subscripts:

EDIT: It works with more than 3 groups!

EDIT2: As Brett says, some cases of 5 doesn't work, like VennDiagram2[5, Subscript[A, 1] && ! (Subscript[A, 2] || Subscript[A, 5]) && Subscript[A, 3] && Subscript[A, 4]], but for example if you change the order to something else it works: VennDiagram2[5, Subscript[A, 1] && ! (Subscript[A, 3] || Subscript[A, 4]) && Subscript[A, 2] && Subscript[A, 5]]. So an intelligent way of sorting the circles should be needed for complex cases.

Answer 2

You get nice Venn diagrams using W|A, eg.:

= (A inter B) un (C inter D)

the inter is esc inter esc and the un is esc un esc

or skipping the opening = which doesn't work in the midst of a program:

WolframAlpha["(A \[Intersection] B) \[Union] (C \[Intersection] D)", \
{{"VennDiagram", 1}, "Content"}]

Answer 3

This is DrMajorBob's solution from MathGroup:

area[r1_, r2_, 
   d_] := -(1/2)*
    Sqrt[(d + r1 - r2) (d - r1 + r2) (-d + r1 + r2) (d + r1 + r2)] + 
   r1^2 ArcCos[(d^2 + r1^2 - r2^2)/(2 d r1)] + 
   r2^2 ArcCos[(d^2 - r1^2 + r2^2)/(2 d r2)];

VennDiagram[area1_?Positive, area2_?Positive, overlap_?NonNegative] /;
    overlap <= Min[area1, area2] := Module[
   {x2, r1 = Sqrt[area1/Pi], r2 = Sqrt[area2/Pi], d, colors, circles},
   d = Which[overlap == 0, r1 + r2, overlap == Min[area1, area2], 
     r1 - r2, True, 
     Chop[d /. FindRoot[area[r1, r2, d] == overlap, {d, r1}]]];
   colors = {Pink, Lighter@Lighter@Blue};
   circles = {{{0, 0}, r1}, {{d, 0}, r2}};
   Graphics[
    MapThread[{AbsoluteThickness@3, #1, Opacity@.3, Disk @@ #2, 
       Opacity@1, Circle @@ #2} &, {colors, circles}]]
   ];

VennDiagram[5, 3, 1]

And here is a more straightforward way using RegionPlot, building on the code of Eric W. Weisstein (link in OP):

xx = -1; yy = 0; rr = 1;
SetOptions[RegionPlot, Epilog -> {Circle[], Circle[{xx, yy}, rr]}, 
  AspectRatio -> 1, Frame -> False, ImageSize -> 150];
GraphicsGrid[{{
   RegionPlot[0 < x^2 + y^2 < 1, {x, -2.5, 1.5}, {y, -2, 2}],
   RegionPlot[
    0 < (x - xx)^2 + (y + yy)^2 < 1, {x, -2.5, 1.5}, {y, -2, 2}],
   RegionPlot[
    0 < x^2 + y^2 < 1 \[Or] 0 < (x - xx)^2 + (y + yy)^2 < 1, {x, -2.5,
      1.5}, {y, -2, 2}],
   RegionPlot[
    0 < x^2 + y^2 < 1 \[And] 
     0 < (x - xx)^2 + (y + yy)^2 < 1, {x, -2.5, 1.5}, {y, -2, 2}]
   }}]

Answer 4

I am taking the approach of helping the OP understand the code he's already found, to explain how to re-implement obsolete code, rather than just re-implenting it. FJRA's answer already does this perfectly well. The core of the code in the linked notebook is the following. It uses the obsolete InequalityPlot in the Graphics`InequalityGraphics` package.

VennDiagram[n_, ineqs_: {}] := Module[{i, r = .6, R = 1, v},
  v = Table[Circle[r {Cos[#], Sin[#]} &[2 Pi (i - 1)/n], R], {i, n}];
  {
   If[ineqs == {}, {},
    InequalityPlot[(v /. 
         Circle[{xx_, yy_}, rr_] :> (x - xx)^2 + (y - yy)^2 < rr^2)[[ineqs]],
      {x}, {y}, Axes -> False,
      Curves -> None,
      DisplayFunction -> Identity][[1]]
    ],
   v
   }
  ]

The first main line of the function, defining v, sets up a set of circles, spaced out nicely according to the number of circles to include in the diagram.

The second main line users InequalityPlot to work out which bits of the overlapping circles to color in. This functionality has now been superseded by RegionPlot. So you can do something like the following. I increased the number of PlotPoints to ensure that the little corners were fully colored in.

Show[Graphics[Circle[{2, 1}, 1]], Graphics[Circle[{1, 1}, 1]], 
 RegionPlot[{(x - 2)^2 + (y - 1)^2 < 1 && (x - 1.0)^2 + (y - 1)^2 < 
     1}, {x, -3, 3}, {y, -3, 3}, PlotPoints -> 200]]

Converting the Weisstein code to something that is usable in version 8 is a little more involved. Nothing has to change about the bit that creates circles, but it would be more efficient to create the Circles and the inequality code from the same sequence.

Module[{i, r = .6, R = 1, v, p, n = 3}, 
 Show@Table[
   Graphics[Circle[r {Cos[#], Sin[#]} &[2 Pi (i - 1)/n], R]], {i, n}]]

So we can imagine something like:

Module[{i, r = .6, R = 1, v, p, n = 3, coords, circles, conds},
 coords = Table[r {Cos[#], Sin[#]} &[2 Pi (i - 1)/n], {i, n}];
 circles = Graphics[Circle[#, R]] & /@ coords;
 conds = (x - #1)^2 + (y - #2)^2 < R & @@@ coords;

 Show[circles, 
  RegionPlot[And @@ conds, {x, -n, n}, {y, -n, n}, PlotPoints -> 200] ]]

Now we need to set up the connections in the RegionPlot so that it shows the specified set-theoretic connections, not just a single Intersection for all of them. Consider the following. This replacement rule preserves the intersections and unions but distributes a range of inequalities into it. The use of RuleDelayed rather than Rule is essential for it to work.

testv = {x^2 > 1, y^2  < 2, z^2 < 1};

A[1] && (A[2] || A[3]) /. _[x_Integer] :> testv[[x]]

x^2 > 1 && (y^2 < 2 || z^2 < 1)

Putting it all together:

newVennDiagram[n_, ineqs_: {}] := 
 Module[{i, r = .6, R = 1, v, p, coords, circles, conds, groupconds},
  coords = Table[r {Cos[#], Sin[#]} &[2 Pi (i - 1)/n], {i, n}];
  circles = Graphics[Circle[#, R]] & /@ coords;
  conds = (x - #1)^2 + (y - #2)^2 < R & @@@ coords;
  groupconds = ineqs /. _[x_Integer] :> conds[[x]];
  Show[circles, 
   RegionPlot[groupconds, {x, -n, n}, {y, -n, n}, PlotPoints -> 200], 
   circles ]]

The reason I have put the circles twice in the final Show is that by putting them first, their placement and options determine the sizing of the final graphic. So you don't have to mess around removing the Frame from the RegionPlot or worry too much about its PlotRange. But then the inequality regions draw on top of the circles, obscuring any lines underneath. You could fix this with appropriate Opacity settings for the PlotStyle in the RegionPlot, but just drawing the circles a second time is just as easy and the final graphic can be exported to formats (eg EPS) that don't support Opacity.

newVennDiagram[3, A[1] && (A[2] || A[3])]