Re: Specifying fill color for a bounded 2D region
- To: mathgroup at smc.vnet.net
- Subject: [mg37890] Re: [mg37782] Specifying fill color for a bounded 2D region
- From: "Steven T. Hatton" <hattons at globalsymmetry.com>
- Date: Sun, 17 Nov 2002 06:44:35 -0500 (EST)
- References: <NDBBJGNHKLMPLILOIPPOCELCDEAA.djmp@earthlink.net>
- Sender: owner-wri-mathgroup at wolfram.com
On Wednesday 13 November 2002 10:12 am, David Park wrote:
> Steven,
>
> Use the Fills option.
>
> Needs["Graphics`InequalityGraphics`"]
> Needs["Graphics`Colors`"]
>
> InequalityPlot[Xor[(x + 1/2)^2 + y^2 <= 1,
> (x - 1/2)^2 + y^2 <= 1], {x}, {y},
> Fills -> {DeepSkyBlue, DeepNaplesYellow}];
>
> David Park
> djmp at earthlink.net
> http://home.earthlink.net/~djmp/
>
> From: Steven T. Hatton [mailto:hattons at globalsymmetry.com]
To: mathgroup at smc.vnet.net
>
> This is a long-standing issue for me. I would like to be able to specify a
> particular bound region of a graph and determine what collor to fill the
> region with. The InequalityGraphics does almost what I want. If I could
> specify the color with which to fill each region of the graph produced by
> code such as this example from the help browser I would have my solution:
>
> \!\(\(InequalityPlot[\
> Xor[\ \((x + 1\/2)\)\^2 + \ y\^2 <= 1, \ \((x - 1\/2)\)\^2 + \ y\^2
> <= 1], \ {x}, \ {y}\ ];\)\)
>
> This seems like it should be a no-brainer, but I have yet to find a
> solution to this. Does anybody know of a way to accomplish such a thing?
> All I want to do is produce a Ven diagram using the traditional circles
> found in textbooks, and fill the different regions with unique colors.
David,
Thanks for the help. I attempted this, but ran into problems until I followed
some advice recieved from Bob Hanlon, telling me how to use
DisplayTogether[].
This is my current project, it isn't very pretty WRT Mathematica coding styles
for packages, but it runs. Sorry about all the ugly Mathematica markup, but
I don't know of a way to remove that stuff, other than by hand. This was a
very instructive project. I started out using iteration for a lot of stuff,
then I realized that Inner[] is my friend.
The files are also available here:
http://baldur.globalsymmetry.com/projects/mma/ven-diagrams/
(* demonstration notebook *)
Needs["Graphics`Colors`"]
Needs["Graphics`Graphics`"]
Needs["Graphics`InequalityGraphics`"]
Needs["GS`venPlot`"]
(* draw one diagram *)
diagram[#1 || #2 && (! #2 && #3)]
(* generate all 256 diagrams *)
(* This takes a few minutes *)
diagramAll[]
(* Begin Package Code for venPlot.nb *)
\!\(\(\(BeginPackage["\<GS`venPlot`\>", "\<Graphics`Colors`\>", \
"\<Graphics`Graphics`\>", "\<Graphics`InequalityGraphics`\>"]\)\(\n\)
\)\[IndentingNewLine]
\(\(diagram::usage\ = "\<diagram[predicate0] creates a ven diagram of \
predicate, a three-place boolean function.\>";\)\(\n\)
\)\[IndentingNewLine]
\(\(diagramAll::usage = "\<diagramAll[showDiagram,showParts] creates all \
ven diagrams of three-place boolean functions.\>";\)\(\[IndentingNewLine]\)
\)\n
\(\(Begin["\<`Private`\>"]\)\(\[IndentingNewLine]\)
\)\[IndentingNewLine]
\(count = 0;\)\[IndentingNewLine]
\(showDiagram = True;\)\n
\(\(showParts = False;\)\(\[IndentingNewLine]\)
\)\[IndentingNewLine]
\(node[int_, lst_: {}] :=
rl[node[int - 1, {lst, True}], node[int - 1, {lst, False}]] /;
int > 0;\)\n
\(\(node[int_, lst_: {}] := Return[Flatten[lst]];\)\(\n\)
\)\[IndentingNewLine]
\(\(booleanList[int_] := List @@ Flatten[rl[node[int]]];\)\(\n\)
\)\[IndentingNewLine]
\(states = booleanList[8];\)\n
\(\(propositions = booleanList[3];\)\(\[IndentingNewLine]\)
\)\[IndentingNewLine]
\(\(nXor[arg_, bool_] := \(! Xor[bool, arg]\);\)\(\n\)
\)\[IndentingNewLine]
\(\(nifStr[bool_] :=
If[\(! bool\), "\<¬\>", "\<\>"];\)\(\[IndentingNewLine]\)
\)\n
\(\(orJoin[
strLst_] := \[IndentingNewLine]Module[{}, \
\[IndentingNewLine]StringJoin[\[IndentingNewLine]Take[strLst,
1], \[IndentingNewLine]\(\(("\< \[Or] \>" <> #1)\) &\) /@
Rest[strLst]\[IndentingNewLine]]\[IndentingNewLine]];\)\(\n\)
\)\[IndentingNewLine]
\(\(strLst = \(\((nifStr[#1] <> "\<\[Alpha] \[And] \>" <>
nifStr[#2] <> "\<\[Beta] \[And] \>" <>
nifStr[#3] <> "\<\[Gamma]\>")\) &\) @@@ propositions;\)\(\n\)
\)\n
\(\(wrap[state_, str_] :=
nifStr[state] <> "\<(\>" <> str <> "\<)\>";\)\(\n\)
\)\n
\(\(predicateString =
Function[{ol, strLst},
orJoin[Inner[wrap, ol, strLst, List]]];\)\(\[IndentingNewLine]\)
\)\n
\(\(determineState[predicate_] := \(\((predicate)\) &\) @@@
propositions;\)\(\[IndentingNewLine]\)
\)\[IndentingNewLine]
\[CapitalDelta]\[Theta] = \(-\(\(2 \[Pi]\)\/4\)\)\[IndentingNewLine]
\(\(r = 1;\)\(\[IndentingNewLine]\)
\)\[IndentingNewLine]
\(\(\[CapitalDelta]r = 1.5 r;\)\(\[IndentingNewLine]\)
\)\[IndentingNewLine]
pt = \((#1 {Cos[#2], Sin[#2]})\) &\n
\(pt0 =
pt @@ {r\/2, \(2 \[Pi]\)\/3 + \[CapitalDelta]\[Theta]};\)\
\[IndentingNewLine]
\(pt1 =
pt @@ {r\/2,
2 \( 2 \[Pi]\)\/3 + \[CapitalDelta]\[Theta]};\)\[IndentingNewLine]
\(\(pt2 =
pt @@ {r\/2, 0 + \[CapitalDelta]\[Theta]};\)\(\[IndentingNewLine]\)
\)\[IndentingNewLine]
\(thk = Thickness[0.01];\)\[IndentingNewLine]
\(cir1 =
Graphics[{thk, RGBColor[1, 0, 0],
Circle[pt0, r]}];\)\[IndentingNewLine]
\(cir2 =
Graphics[{thk, RGBColor[0, 1, 0],
Circle[pt1, r]}];\)\[IndentingNewLine]
\(\(cir3 =
Graphics[{thk, RGBColor[0, 0, 1],
Circle[pt2, r]}];\)\(\[IndentingNewLine]\)
\)\[IndentingNewLine]
\(\(staticGLst = {cir1, cir2, cir3};\)\(\[IndentingNewLine]\)
\)\[IndentingNewLine]
\(a = \((x - pt0\[LeftDoubleBracket]1\[RightDoubleBracket])\)\^2 + \((y - \
pt0\[LeftDoubleBracket]2\[RightDoubleBracket])\)\^2 <=
1;\)\[IndentingNewLine]
\(b = \((x - pt1\[LeftDoubleBracket]1\[RightDoubleBracket])\)\^2 + \((y - \
pt1\[LeftDoubleBracket]2\[RightDoubleBracket])\)\^2 <=
1;\)\[IndentingNewLine]
\(\(c = \((x - pt2\[LeftDoubleBracket]1\[RightDoubleBracket])\)\^2 + \((y -
\
pt2\[LeftDoubleBracket]2\[RightDoubleBracket])\)\^2 <=
1;\)\(\[IndentingNewLine]\)
\)\[IndentingNewLine]
\(\(flTrue = \(RGBColor @@ {\[Alpha], \[Beta], \[Gamma]} \
/. \[IndentingNewLine]{\[Alpha] :>
If[#1, 1, 0], \[IndentingNewLine]\[Beta] :>
If[#2, 1, 0], \[IndentingNewLine]\[Gamma] :>
If[#3, 1, 0]} &\) @@@ propositions;\)\(\[IndentingNewLine]\)
\)\[IndentingNewLine]
\(\(flTrue =
ReplacePart[flTrue,
RGBColor @@ {0.5, 0.5, 0.5}, \(-1\)];\)\(\[IndentingNewLine]\)
\)\[IndentingNewLine]
\(\(plts = \(Inner[nXor, {a, b, c}, #, List] &\) /@ propositions;\)\(\n\)
\)\[IndentingNewLine]
\(diagram[predicate0_, showDiagram0_: True,
showParts0_: False] := \((\[IndentingNewLine]showDiagram =
showDiagram0; \[IndentingNewLine]showParts =
showParts0; \[IndentingNewLine]If[count > 0,
Print[ToString[\(count++\)]]]; \[IndentingNewLine]Block[{predicate \
= predicate0}, \[IndentingNewLine]tLst =
determineState[
predicate]; \[IndentingNewLine]\[IndentingNewLine]fl = \(Inner[
If[#, #2, RGBColor @@ {0, 0, 0}] &, {##}, flTrue,
List] &\) @@
tLst; \[IndentingNewLine]\[IndentingNewLine]iqpLst = {}; \
\[IndentingNewLine]\[IndentingNewLine]Do[\[IndentingNewLine]iqpLst = {iqpLst,
InequalityPlot[\[IndentingNewLine]plts\[LeftDoubleBracket]i\
\[RightDoubleBracket], \[IndentingNewLine]{x, \(-2\),
2}, \[IndentingNewLine]{y, \(-2\),
2}, \[IndentingNewLine]Fills -> {fl\[LeftDoubleBracket]i\
\[RightDoubleBracket]}, \[IndentingNewLine]Axes ->
False, \[IndentingNewLine]DisplayFunction ->
If[showParts, $DisplayFunction,
Identity]\[IndentingNewLine]]}, \[IndentingNewLine]{i,
Length[plts]}]; \[IndentingNewLine]\[IndentingNewLine]ipqLst =
Flatten[iqpLst]; \[IndentingNewLine]gLst =
Flatten[{iqpLst,
staticGLst}]; \[IndentingNewLine]\[IndentingNewLine]If[
showDiagram, \[IndentingNewLine]Print["\<begin diagram \
---------------->\>"]; \[IndentingNewLine]Print[
predicateString[tLst,
strLst]]; \[IndentingNewLine]DisplayTogether[\
\[IndentingNewLine]gLst, \[IndentingNewLine]ImageSize ->
488]; \[IndentingNewLine]Print["\<<-------------- end diagram
\
\>"];, \[IndentingNewLine]Return[
gLst]\[IndentingNewLine]]\[IndentingNewLine]])\);\)\
\[IndentingNewLine]\[IndentingNewLine]
\(diagramAll[showDiagram0_: True, showParts0_: False] :=
Block[{predicateTests, predicates}, \[IndentingNewLine]showDiagram =
showDiagram0; \[IndentingNewLine]showParts =
showParts0; \[IndentingNewLine]count =
1; \[IndentingNewLine]\[IndentingNewLine]predicateTests =
And @@@ \((\(Inner[nXor, {x, y, z}, {##}, List] &\) @@@
propositions)\); \[IndentingNewLine]predicateTests =
predicateTests /. {x :> #1, y :> #2,
z :> #3}; \[IndentingNewLine]predicates = \(Inner[And,
predicateTests, {##}, Or] &\) @@@
states; \[IndentingNewLine]ret = \(diagram[#1, showDiagram,
showParts] &\) /@ predicates; \[IndentingNewLine]Return[
ret];\[IndentingNewLine]];\)\[IndentingNewLine]\n
End[]\n
EndPackage[]\)
(* End package Code for venPlot.nb *)
--
STH
Hatton's Law:
"There is only One inviolable Law."