Farbbereich durch eine Eigenschaft

Question

Ich habe einige Kreise zufällig innerhalb einer Region platziert (hier ist die Region ein Kreis-Kreis-Schnittpunkt).

pts1 = RandomPoint[
   ImplicitRegion[
    EuclideanDistance[{x, y}, 0] < 1 && 
     EuclideanDistance[{x, y}, {2.5, 0}] < 2, {x, y}], 3];
pts2 = RandomPoint[
   ImplicitRegion[
    EuclideanDistance[{x, y}, 0] < 2 && 
     EuclideanDistance[{x, y}, {2.5, 0}] < 1, {x, y}], 3];
Graphics[Prepend[
  Join[Circle[#, 1] & /@ pts1, Disk[#, 0.01] & /@ pts1, 
   Disk[#, 0.01] & /@ pts2], {Circle[{0, 0}, 1], Circle[{2.5, 0}, 1], 
   Circle[{0, 0}, 2], Circle[{2.5, 0}, 2], Opacity[0.4]}], 
 ImageSize -> Full]

Jeder Kreis bedeckt einen Teil eines anderen Kreis-Kreis-Schnittpunkts, wie in diesem Bild dargestellt:

Die Bereiche in der rechten "Linse" (Kreis-Kreis-Schnittpunkt), die von 3 Kreisen bedeckt sind, sind tiefblau, 2 Kreise hellblau und 1 gelb. Der verbleibende Bereich bleibt weiß. Dies geschieht mit Paintbrush.

Kann ich Mathematica dazu bringen, das Kontinuum von Punkten automatisch so zu färben? $n$ Farben, wenn es gibt $n$Punkte in pts1?

Es scheint einfach zu sein, dies mit einer PlotFunktion zu tun , und dann ColorFunction, aber mit einer Eigenschaft einer Reihe von Punkten in Grafiken?

Answer 1

dsk1 = Disk[{0, 0}, 1];
dsk2 = Disk[{2.5, 0}, 1];

n = 3;

SeedRandom[11]

pts = RandomPoint[ImplicitRegion[EuclideanDistance[{x, y}, 0] < 1 && 
     EuclideanDistance[{x, y}, {2.5, 0}] < 2, {x, y}], n];

dsks = Disk[#, 1] & /@ pts;

g1 = Graphics[{FaceForm[], EdgeForm[Gray], dsks, 
   EdgeForm[{Thick, Purple}], dsk1,  EdgeForm[{Thick, Cyan}], dsk2, 
   PointSize[Large], Point @ pts}]

Konstruieren Sie RegionMemberFunctions mit den Datenträgern:

{rmf1, rmf2} = RegionMember /@ {dsk1, dsk2};

rmfs = RegionMember /@ dsks;

Definieren Sie eine Prädikatfunktion numDisks[k, rfs][{x, y}], BooleanCountingFunctiondie angibt, Truewann der Punkt {x,y}in dsk1oder in liegt dsk2und genau erfüllt k($k = 1, 2, \ldots, n$) von Prädikaten rfs:

ClearAll[numDisks]
numDisks[k_, rfs_][{x_, y_}] := (rmf1[{x, y}] || rmf2[{x, y}]) && 
   BooleanConvert @ BooleanCountingFunction[{k}, Length @ rfs] @@ 
     Through[rfs @ {x, y}]

Verwenden Sie numDisksdiese Option , um ns zu definieren ImplicitRegionund sie zu verwenden mit RegionPlot:

irs = ImplicitRegion[numDisks[#, rmfs][{x, y}], {x, y}] & /@ Range[n];

rp = RegionPlot[Evaluate @ irs, PlotStyle -> 97, PlotLegends -> Range[n]]

Show[rp, g1, PlotRange -> All, AspectRatio -> Automatic, ImageSize -> Large]

Denn n = 5wir bekommen

Answer 2

Proof of Concept mit 3 Punkten (nichts Automatisches):

pts1 = RandomPoint[
   ImplicitRegion[
    EuclideanDistance[{x, y}, 0] < 1 && 
     EuclideanDistance[{x, y}, {2.5, 0}] < 2, {x, y}], 3];
pts2 = RandomPoint[
   ImplicitRegion[
    EuclideanDistance[{x, y}, 0] < 2 && 
     EuclideanDistance[{x, y}, {2.5, 0}] < 1, {x, y}], 3];
c1 = Disk[#, 1] & /@ pts1;
circ1 = Region[Disk[{0, 0}, 1]];
circ2 = Region[Disk[{2.5, 0}, 1]];

(* 3 circles intersection *)

R3 = ImplicitRegion[({x, y} \[Element] circ2 && {x, y} \[Element] 
      c1[[1]] && {x, y} \[Element] c1[[2]] && {x, y} \[Element] 
      c1[[3]]), {x, y}];
bR3 = ImplicitRegion[{x, y} \[Element] circ1 && {x, y} \[Element] 
     c1[[1]] && {x, y} \[Element] c1[[2]] && {x, y} \[Element] 
     c1[[3]], {x, y}];

(* 2 circle intersection *)

R21 = ImplicitRegion[{x, y} \[Element] 
     circ2 && (({x, y} \[Element] c1[[1]] && {x, y} \[Element] 
         c1[[2]]) || ({x, y} \[Element] c1[[1]] && {x, y} \[Element] 
         c1[[3]]) || ({x, y} \[Element] c1[[2]] && {x, y} \[Element] 
         c1[[3]] )), {x, y}];
bR21 = ImplicitRegion[{x, y} \[Element] 
     circ1 && (({x, y} \[Element] c1[[1]] && {x, y} \[Element] 
         c1[[2]]) || ({x, y} \[Element] c1[[1]] && {x, y} \[Element] 
         c1[[3]]) || ({x, y} \[Element] c1[[2]] && {x, y} \[Element] 
         c1[[3]] )), {x, y}];

(* 1 circle intersection *)

RY = ImplicitRegion[{x, y} \[Element] 
     circ2 && ({x, y} \[Element] c1[[1]] \[Xor] {x, y} \[Element] 
       c1[[2]] \[Xor] {x, y} \[Element] c1[[3]]), {x, y}];
bRY = ImplicitRegion[{x, y} \[Element] 
     circ1 && ({x, y} \[Element] c1[[1]] \[Xor] {x, y} \[Element] 
       c1[[2]] \[Xor] {x, y} \[Element] c1[[3]]), {x, y}];

(* Region plots *)
RY2 = RegionPlot[RY, PlotStyle -> Yellow];
RP = RegionPlot[R21, PlotStyle -> RGBColor[0, 1, 1]]];
RP3 = RegionPlot[R3, PlotStyle -> Blue];

bRY2 = RegionPlot[bRY, PlotStyle -> Yellow];
bRP = RegionPlot[bR21, PlotStyle -> RGBColor[0, 1, 1]];
bRP3 = RegionPlot[bR3, PlotStyle -> Blue];

d1 = Graphics[Disk[#, 0.01] & /@ pts1];
d3 = Graphics[Disk[#, 0.01] & /@ pts2];

gr = Graphics[
   Prepend[Join[Circle[#, 1] & /@ pts1], {Circle[{0, 0}, 1], 
     Circle[{2.5, 0}, 1], Circle[{0, 0}, 2], Circle[{2.5, 0}, 2], 
     Opacity[0.4]}], ImageSize -> Full];

Show[gr, RY2, RP, RP3, bRY2, bRP, bRP3, d1, d3, PlotRange -> All]