How to plot Venn diagrams with Mathematica?
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 -> ∅]],
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.
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"}]
A series of n cosine functions at successively doubled frequencies can be phased so their signs produce a Gray Code (– for 0, + for 1).
If these cosines are also scaled to successively halved amplitudes, they partition the plane over one major cycle into 2^n non-overlapping regions, just like the circles of a Venn diagram. These regions cover the angle axis in equal intervals of width 2 Pi / 2^n.
When wrapped around the origin in a polar plot, all but one of the regions is bounded, as in a typical Venn diagram.
grayCosines =
Table[If[i == 0, -Cos[θ - π/2], -(
Cos[2^(i - 1) θ]/2^(i - 1))], {i, 0, 5 - 1}];
Plot[grayCosines, {θ, 0, 2 π}]
ArrayPlot@Transpose@Table[UnitStep/@grayCosines,{θ,2^-5/2,2π,2^-5 2π}]
PolarPlot[Evaluate[1 + 0.6 grayCosines], {θ, 0, 2 π}]
Then the regions can be shaded according to some logical expression, as suggested by Alan.
Here’s everything bundled into an interactive form. "expression" is the logical expression used to shade the diagram. "scale" controls the overall amplitude of the cosines, while "zoom" controls local amplitude near the unit circle, which is handy when there are several variables.
ClearAll@grayCosines;
DynamicModule[
{nMax, θ, grayCosines, thicknesses, lineColors, labelPosns,
zoomF, expression, zoom, scale, n},
nMax = 8;
grayCosines =
Table[If[i == 0, -Cos[θ - π/2], -(
Cos[2^(i - 1) θ]/2^(i - 1))], {i, 0, nMax - 1}];
labelPosns =
Prepend[{1, (3 π)/2}]@
Table[{2^(1 - i), 2^(1 - i) π}, {i, nMax - 1}];
thicknesses =
Thickness /@ (0.003 Prepend[1]@
Table[1.0 - 0.7 (i - 1)/(nMax - 2), {i, nMax - 1}]);
lineColors =
Prepend[Hue[0, 1, 1]]@
Table[Hue[FractionalPart@N[i/GoldenRatio], 1, (3 + i - 2 nMax)/(
4 - 2 nMax)], {i, nMax - 1}];
zoomF[r_, k_] := 1/2 - 1/π ArcTan[k Cot[(π r)/2]];
Manipulate[Module[
{input, variables, varsPadded, predicates, regionPredicate,
regionGraphics, boundaryGraphics, labelGraphics},
input = BooleanConvert[expression // FullSimplify, "ANF"];
variables = BooleanVariables[input];
n = Length@variables;
varsPadded = PadRight[variables, nMax, "??"];
predicates = (r <
zoomF[1 + scale #, zoom] /. {r -> Sqrt[
x^2 + y^2], θ -> ArcTan[x, y]}) & /@ grayCosines;
regionPredicate = input /. Thread[varsPadded -> predicates];
regionGraphics = RegionPlot[
regionPredicate,
{x, -1.05, 1.05}, {y, -1.05, 1.05},
MaxRecursion -> ControlActive[2, 5],
BoundaryStyle -> None,
PlotStyle -> LightGray,
ImageSize -> Full,
Frame -> False
];
boundaryGraphics = PolarPlot[
zoomF[1 + scale #[[1]], zoom],
{θ, 0, 2 π},
PlotStyle -> {#[[2]], #[[3]]},
Axes -> False
] & /@ ({grayCosines, thicknesses, lineColors}\[Transpose][[
1 ;; n]]);
labelGraphics = Graphics[
Text[Style[#[[1]], {Bold, #[[3]], FontSize -> 14}], #[[2]]] & /@
Transpose[{
varsPadded,
(1.08 zoomF[1 + scale #[[1]], zoom] {Cos[#[[2]]],
Sin[#[[2]]]} & /@ labelPosns),
lineColors
}][[1 ;; n]]
];
Show[regionGraphics, boundaryGraphics, labelGraphics]
],
Column[{
Deploy@
Control[{expression, (b ⊻ (a \[Implies] c)) && d,
InputField}],
Row@{
Control[{{zoom, 3.0}, 1.0, 9.999}], Spacer[10],
Dynamic@NumberForm[zoom, {3, 2}], Spacer[30],
Dynamic@Plot[zoomF[r, zoom], {r, 0.0, 2.0}, Axes -> False]
},
Row@{
Control[{{scale, 0.4}, 0.0, 1.0}], Spacer[10],
Dynamic@NumberForm[scale, {3, 2}]
}
}]
],
SaveDefinitions -> True
]
Up to nMax variables (set to 8 here) are supported, but more variables take more time. Relations can also be used in place of variables, but I haven't tried to ensure that equivalent terms are treated as one.