Grainy 2D RegionIntersection Plot: How can I make it smoother?

Question

I have the following code to display three coloured disks and their coloured intersections. However, the result does not appear to have been anti-aliased enough. How can I make it smoother?

rDisk = Disk[{Cos[60 Degree], Sin[60 Degree]}];
gDisk = Disk[{1, 0}];
bDisk = Disk[{0, 0}];

rgbDisk = RegionIntersection[rDisk, gDisk, bDisk];
rgDisk = RegionIntersection[rDisk, gDisk];
rbDisk = RegionIntersection[rDisk, bDisk];
gbDisk = RegionIntersection[gDisk, bDisk];

Show[
 Graphics[{Red, rDisk}],
 Graphics[{Blue, bDisk}],
 Graphics[{Green, gDisk}],
 Graphics[{Blend[{Red, Blue}, 0.5], DiscretizeRegion[rbDisk]}],
 Graphics[{Blend[{Red, Green}, 0.5], DiscretizeRegion[rgDisk]}],
 Graphics[{Blend[{Green, Blue}, 0.5], DiscretizeRegion[gbDisk]}],
 Graphics[{White, DiscretizeRegion[rgbDisk]}]
 ]

I tried adding Antialiasing->True to the Graphics, but: a) it didn't help; b) it added a mesh to the regions, which I don't like to have.

Answer 1

In addtion to Carl's answer, you can also force to rasterize the image with customized resolution. Takes longer but creates higher resolution bitmap images.

g = Show[Graphics[{Red, rDisk}], Graphics[{Blue, bDisk}], 
   Graphics[{Green, gDisk}], 
   Graphics[{Blend[{Red, Blue}, 0.5], BoundaryDiscretizeRegion[rbDisk]}], 
   Graphics[{Blend[{Red, Green}, 0.5], BoundaryDiscretizeRegion[rgDisk]}], 
   Graphics[{Blend[{Green, Blue}, 0.5], BoundaryDiscretizeRegion[gbDisk]}], 
   Graphics[{White, BoundaryDiscretizeRegion[rgbDisk]}]];

Show[
 Rasterize[g, ImageResolution -> 1000],
 ImageSize -> Medium
 ]

Answer 2

You can use BoundaryDiscretizeRegion instead of DiscretizeRegion to avoid the mesh lines when using Antialiasing->True:

Graphics[{
    {Red, rDisk},
    {Blue, bDisk},
    {Green, gDisk},
    Antialiasing->True,
    BoundaryDiscretizeRegion[rbDisk, MeshCellStyle->{2->Blend[{Red, Blue}]}],
    BoundaryDiscretizeRegion[rgDisk, MeshCellStyle->{2->Blend[{Red, Green}]}],
    BoundaryDiscretizeRegion[gbDisk, MeshCellStyle->{2->Blend[{Green, Blue}]}],
    BoundaryDiscretizeRegion[rgbDisk, MeshCellStyle->{2->White}]
}]

Answer 3

pts={AngleVector[60°],{1,0},{0,0}};

colors=Join[{r,g,b}={Red,Green,Blue},Blend[#,0.5]&/@{{r,g},{r,b},{g,b}},{White}];

regions=BoundaryDiscretizeRegion/@RegionIntersection/@Rest@Subsets[Disk/@pts];

Graphics[Thread[{EdgeForm/@colors,colors,regions}]]

or

Graphics[Thread[{colors, MeshPrimitives[#,2]&/@regions}]]

If need faster speed, I prefer use Graphics`PolygonUtils`PolygonIntersection

Manipulate[
  Graphics[{
    Thread[{{Red,Green,Blue,Yellow,Magenta,Cyan,White},
    Rest@Subsets[Polygon@CirclePoints[#,1,100.]&/@pts]
  }]/.{c_, p:{_Polygon,__}}:>{EdgeForm[c],c,Graphics`PolygonUtils`PolygonIntersection[p]}
},PlotRange->2.5,Background->Black,ImageSize->Large],
{{pts,CirclePoints[1/√3,3]},Locator}]

Answer 4

If we represent each part as a piecewise spline we'll have an exact representation, as opposed to DiscretizeRegion which approximates the regions with polygons.

I'll use splineCircle defined here.

rDisk2 = FilledCurve[{splineCircle[rDisk[[1]], 1, {0, π}], 
  MapAt[Reverse, splineCircle[bDisk[[1]], 1, {π/3, 2 π/3}], {1}], 
  MapAt[Reverse, splineCircle[gDisk[[1]], 1, {π/3, 2 π/3}], {1}]}];
bDisk2 = GeometricTransformation[rDisk2, RotationTransform[2 π/3, {1/2, 1/(2 Sqrt[3])}]];
gDisk2 = GeometricTransformation[rDisk2, RotationTransform[-2 π/3, {1/2, 1/(2 Sqrt[3])}]];

rgDisk2 = FilledCurve[{splineCircle[rDisk[[1]], 1, {-π/3, 0}], 
  splineCircle[gDisk[[1]], 1, {π/3, 2 π/3}], 
  MapAt[Reverse, splineCircle[bDisk[[1]], 1, {0, π/3}], {1}]}];
rbDisk2 = GeometricTransformation[rgDisk2, RotationTransform[2 π/3, {1/2, 1/(2 Sqrt[3])}]];
gbDisk2 = GeometricTransformation[rgDisk2, RotationTransform[-2 π/3, {1/2, 1/(2 Sqrt[3])}]];

rgbDisk2 = FilledCurve[{splineCircle[bDisk[[1]], 1, {0, π/3}], 
  splineCircle[gDisk[[1]], 1, {2 π/3, π}], 
  splineCircle[rDisk[[1]], 1, {4 π/3, 5 π/3}]}];

edgeFaceStyle[c_] := Directive[EdgeForm[c], FaceForm[c]]

Graphics[{
  {edgeFaceStyle[Red], rDisk2}, 
  {edgeFaceStyle[Blue], bDisk2}, 
  {edgeFaceStyle[Green], gDisk2}, 
  {edgeFaceStyle[Blend[{Red, Blue}]], rbDisk2}, 
  {edgeFaceStyle[Blend[{Red, Green}]], rgDisk2}, 
  {edgeFaceStyle[Blend[{Green, Blue}]], gbDisk2}, 
  {edgeFaceStyle[White], rgbDisk2}
}]

Answer 5

Another approach is to rasterize each region with RegionImage.

outerdisks = RegionDifference[#1, RegionUnion[##2]]& @@@ NestList[RotateRight, {rDisk, bDisk, gDisk}, 2];

diskints = {rgDisk, rbDisk, gbDisk};

complement = RegionDifference[FullRegion[2], RegionUnion[rDisk, bDisk, gDisk]];

Image[ImageAdd @@ MapThread[
  ImageMultiply[
    RegionImage[#1, RegionBounds[Disk[{1/2, 1/(2 Sqrt[3])}, 2]], RasterSize -> 2048], #2]&, 
  {
    Join[outerdisks, diskints, {complement}], 
    {Red, Green, Blue, Blend[{Red, Green}], Blend[{Red, Blue}], Blend[{Green, Blue}], White}
  }], 
  ImageSize -> 1024
]