2
$\begingroup$

I have some circles placed at random within a region (here, the region is a circle-circle intersection).

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]

Each circle covers some portion of another circle-circle intersection, as in this picture:

enter image description here

The regions in the right "lens" (circle-circle intersection) which are covered by 3 circles are in deep blue, by 2 circles in light blue and by 1 in yellow. The remaining region is left white. This is done with Paintbrush.

Can I get Mathematica to colour the continuum of points automatically, like this, with $n$ colours if there are $n$ points in pts1?

It appears easy to do this with a Plot of function, and then ColorFunction, but with some property of a set of points in Graphics?

$\endgroup$
2
$\begingroup$
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}]

enter image description here

Construct RegionMemberFunctions using the disks:

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

rmfs = RegionMember /@ dsks;

Define a predicate function numDisks[k, rfs][{x, y}] using BooleanCountingFunction that gives True when the point {x,y} lies in in dsk1 or indsk2 and satisfies exactly k ($k = 1, 2, \ldots, n$) of predicates rfs:

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

Use numDisks to define n ImplicitRegions and use them with RegionPlot:

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

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

enter image description here

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

enter image description here

For n = 5 we get

enter image description here

$\endgroup$
2
$\begingroup$

Proof of concept with 3 points (nothing automatic):

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]

graphic

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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