Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

share|improve this question
1  
1  
1  
Another possibly related question: stackoverflow.com/q/8409884/840947 –  Heike Mar 3 '12 at 10:44
    
+1 nice question. –  Babak Sorouh Apr 24 '13 at 17:30
add comment

5 Answers

up vote 23 down vote accepted

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:

enter image description here enter image description here enter image description here

EDIT: It works with more than 3 groups!

enter image description here

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.

share|improve this answer
2  
You don't have enough regions in the 5 set case. For example, there is no region corresponding to VennDiagram2[5, Subscript[A, 1] && ! (Subscript[A, 2] || Subscript[A, 5]) && Subscript[A, 3] && Subscript[A, 4]]. –  Brett Champion Mar 3 '12 at 22:12
    
@BrettChampion you are right :P. –  FJRA Mar 3 '12 at 23:48
    
Funny, maybe it should have a dynamic order of groups... and now I see that it has no labels... –  FJRA Mar 4 '12 at 0:02
3  
In response to your edit, for n=5 you can't do it with circles no matter how you sort/move them around... you'll have to use ellipses (and gets more complicated for even higher dimensions). –  rm -rf Mar 4 '12 at 9:05
    
@R.M Yes, only some cases are fine with circle. –  FJRA Mar 4 '12 at 15:02
show 1 more comment

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

Mathematica graphics

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

Mathematica graphics

share|improve this answer
    
@Sjoerd How did you manage to display the inter and union signs? –  Peter Breitfeld Mar 3 '12 at 14:38
    
I'm trying to plot it there. I want to plot this: (A intersect B) element of (D) but i don't know how to express the "element of, any clue? –  Igäria Mnagarka Mar 3 '12 at 14:59
1  
@Peter Breitfield asked how to get the intersection and union signs. In Mathematica or here? For Mathematica, with esc inter esc and esc un esc, as one can discover by selecting the characters on the Special Characters palette. Here, by embedding LaTeX mark-up, I presume. –  murray Mar 3 '12 at 16:21
    
@murray: I know how to do it in Mma, but didn't know, that I can include LaTeX markup –  Peter Breitfeld Mar 3 '12 at 17:04
1  
@PeterBreitfeld In this case I used an image, my LaTeX is a bit rusty after 19 years. Posting images is easy once you have sufficient rep to post them here. Szabolcs created a Mathematica palette to automate it all. See this question. For other tricks I used in your answer you can enter the edit mode in your answer to see the raw code. –  Sjoerd C. de Vries Mar 3 '12 at 20:09
add comment

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]

Mathematica graphics

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

Mathematica graphics

share|improve this answer
add comment

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

enter image description here

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

enter image description here

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

enter image description here

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

enter image description here

share|improve this answer
add comment

In the upcoming version (10?) there are useful BooleanRegion functions:

{a, b} = {Disk[{-1/3, 0}, 1], Disk[{1/3, 0}, 1]};
RegionPlot@BooleanRegion[Xor, {a, b}]

enter image description here

{a, b} = {Disk[{0, 0}, 2], Disk[{2, 0}, 2]};
RegionPlot[RegionDifference[a, b], Epilog -> {EdgeForm@Black, FaceForm@None, a, b}]

Mathematica graphics

Furthermore, regions can be more easily highlighted:

{a, b} = {Disk[{0, 0}, 1], Disk[{1, 0}, 1]};
Show[Graphics[{LightBlue, EdgeForm[Gray], a, b}], 
 HighlightMesh[DiscretizeRegion@RegionIntersection[a, b], 2]]

enter image description here

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.