Re: Venn diagrams?
- To: mathgroup at smc.vnet.net
- Subject: [mg118373] Re: Venn diagrams?
- From: DrMajorBob <btreat1 at austin.rr.com>
- Date: Mon, 25 Apr 2011 07:27:16 -0400 (EDT)
NSolve can be eliminated, as Solve gives:
{x, -I y} /.
Last@Solve[{Norm[{x, y}] == s13,
Norm[{x, y} - {d12, 0}] == s23}, {x, y}] /. Sqrt[x_] :> Sqrt[-x]
{(d12^2 + s13^2 - s23^2)/(
2 d12), Sqrt[-d12^4 + 2 d12^2 s13^2 - s13^4 + 2 d12^2 s23^2 +
2 s13^2 s23^2 - s23^4]/(2 d12)}
hence the code becomes
Clear[areaOverlap, separation, venn, r1, r2, d]
areaOverlap[r1_, r2_, d_] =
r2^2*ArcCos[(d^2 + r2^2 - r1^2)/(2 d r2)] +
r1^2*ArcCos[(d^2 + r1^2 - r2^2)/(2 d r1)] -
Sqrt[(-d + r2 + r1) (d + r2 - r1) (d - r2 + r1) (d + r2 + r1)]/2;
separation[r1_?Positive, r2_?Positive, overlap_?NonNegative] /;
overlap <= (Min[r1, r2]^2*Pi) :=
Chop[d /.
FindRoot[
areaOverlap[r1, r2, d] == overlap, {d, Max[r1, r2]}][[1]]];
venn[area1_?Positive, area2_?Positive, area3_?Positive,
overlap12_?NonNegative, overlap13_?NonNegative,
overlap23_?NonNegative] /; (overlap12 <= Min[area1, area2] &&
overlap13 <= Min[area1, area3] &&
overlap23 <= Min[area2, area3]) :=
Module[{s12, s13, s23, x, y, r1 = Sqrt[area1/Pi],
r2 = Sqrt[area2/Pi], r3 = Sqrt[area3/Pi]},
s12 = separation[r1, r2, overlap12];
s13 = separation[r1, r3, overlap13];
s23 = separation[r2, r3, overlap23];
{x, y} = {(s12^2 + s13^2 - s23^2)/(2 s12),
Sqrt[-s12^4 + 2 s12^2 s13^2 - s13^4 + 2 s12^2 s23^2 +
2 s13^2 s23^2 - s23^4]/(2 s12)};
Graphics[{Red, Circle[{0, 0}, r1], Blue, Circle[{s12, 0}, r2],
Green, Circle[{x, y}, r3]}]];
Bobby
On Thu, 21 Apr 2011 02:12:06 -0500, Bob Hanlon <hanlonr at cox.net> wrote:
> It's just more of the same.
>
> areaOverlap[r1_, r2_, d_] =
> r2^2 * ArcCos[(d^2 + r2^2 - r1^2)/(2 d r2)] +
> r1^2 * ArcCos[(d^2 + r1^2 - r2^2)/(2 d r1)] -
> Sqrt[(-d + r2 + r1) (d + r2 - r1) (d - r2 + r1) (d + r2 + r1)]/2;
>
>
> separation[r1_?Positive, r2_?Positive, overlap_?NonNegative] /;
> overlap <= (Min[r1, r2]^2 * Pi) :=
> Chop[d /. FindRoot[
> areaOverlap[r1, r2, d] == overlap,
> {d, Max[r1, r2]}][[1]]];
>
>
> venn[area1_?Positive, area2_?Positive, area3_?Positive,
> overlap12_?NonNegative, overlap13_?NonNegative,
> overlap23_?NonNegative] /;
> (overlap12 <= Min[area1, area2] &&
> overlap13 <= Min[area1, area3] &&
> overlap23 <= Min[area2, area3]) :=
> Module[{d12, d13, d23, x, y,
> r1 = Sqrt[area1/Pi], r2 = Sqrt[area2/Pi], r3 = Sqrt[area3/Pi]},
> d12 = separation[r1, r2, overlap12];
> {x, y} = ({x, y} /. NSolve[{
> Norm[{x, y}] == separation[r1, r3, overlap13],
> Norm[{x, y} - {d12, 0}] == separation[r2, r3, overlap23]},
> {x, y}][[1]]);
> Graphics[{
> Red, Circle[{0, 0}, r1],
> Blue, Circle[{d12, 0}, r2],
> Green, Circle[{x, y}, r3]}]];
>
>
> venn[25, 16, 9, 0, 0, 0]
>
> venn[25, 16, 9, 4, 3, 1]
>
> With[{c = Pi/3 - Sqrt[3]/2}, venn[Pi, Pi, Pi, c, c, c]]
>
>
> Bob Hanlon
>
> ---- dantimatter <google at dantimatter.com> wrote:
>
> =============
> Thanks DrMajorBob, Murray, and Bob Hanlon! To the Bobs especially:
> your math and coding chops are most impressive. :)
>
> Any thoughts on extensions to three sets? At first I had hoped that it
> would be straight-forward, but after fiddling a bit myself I'm not so
> sure.
>
> I'm kinda surprised that Mathematica doesn't have this as a built-in
> function ....
>
> Cheers
> dan
>
>
>
--
DrMajorBob at yahoo.com