2
$\begingroup$

Using the following code, I am able to generate a grayscale Voronoi diagram:

numpts = 12;
pts = RandomReal[{0, 1}, {numpts, 2}];
mesh = VoronoiMesh[pts, {{0, 1}, {0, 1}}]

mps = MeshPrimitives[mesh, 2];
vvv = {};
For[i = 1, i <= Length[mps], i++,
col = GrayLevel[  RandomReal[{0, 1}]  ] ;
graphicGrain = Graphics[{col, Polygon[mps[[ i ]] [[1]]  ]} ];

AppendTo[vvv, graphicGrain];

]

img = Show[vvv, ImageSize -> 1000, "ShrinkWrap" -> True];
img = ImageCrop[img, {950}]
Export["img_q.pdf", img]

enter image description here

As we can see from the image below, some of the grain boundaries seem to have a white edge going through them

enter image description here

Is there any way to generate a Voronoi diagram in such a way that these edges are not present? I have looked at similar posts regarding this 'white edge' problem but have not been successful at removing them myself.

$\endgroup$
  • $\begingroup$ No white edges on 10.0 for Mac OS X x86 (64-bit) (December 4, 2014) and NVIDIA GeForce GTX 680MX 2048 MB. $\endgroup$ – user9660 Apr 25 '15 at 5:34
  • $\begingroup$ Possibly related: mathematica.stackexchange.com/questions/1400/… Please mention your OS. $\endgroup$ – Szabolcs Apr 25 '15 at 14:27
3
$\begingroup$

Your issue appears to be the related to the Thickness of the edges of the polygons. It shows up most when adjacent colours are dark. By increasing the thickness of the edges using Thickness and setting the colour of the edges to the colour of the polygon using EdgeForm you can make the edges overlap slightly and remove the white lines.

I would also use the Graphics object for the export to get a better resolution in the PDF file.

I've made a slight refactoring of the code to remove the loop so it is more in Mma style.

numpts = 12;
pts = RandomReal[{0, 1}, {numpts, 2}];
mesh = VoronoiMesh[pts, {{0, 1}, {0, 1}}];
mps = MeshPrimitives[mesh, 2];

colourDirectives = {#, EdgeForm[#]} & /@ (GrayLevel[RandomReal[{0, 1}]] & /@ 
     Range[First@Dimensions@mps]);
img = Graphics[
   {Thickness[0.02]}~Append~Flatten@Riffle[colourDirectives, mps], ImageSize -> 400]

colourDirectives gets a list of pairs of GrayLevel and EdgeForm of that colour for the polygons. These are Riffled with the polygons in mps and Flatten into a single list for Graphic. That list has the Thickness Appended to it so all edges are drawn that thickness.

Hope this helps.

$\endgroup$
  • $\begingroup$ You can use colourDirectives = {#, EdgeForm[#]} & /@ Table[GrayLevel[RandomReal[{0, 1}]], {First@Dimensions@mps}]; as well if that is easier to read when you come back to it later. $\endgroup$ – Edmund Apr 25 '15 at 13:03
3
$\begingroup$

As discussed previously this is an artifact of antialiasing by way of transparancy.

Along the margins the transparency of the overlaid polygons is not complete and the background shows through. A solution is to turn off Antialiasing, which can be done inline as a directive with:

Graphics[{col, Antialiasing -> False, Polygon[mps[[i]][[1]]]}]

The result:

enter image description here

However this leaves rough edges between cells. A better result may be had by eliminating the transparency that causes the problem. A hackish but effective method is to draw multiple copies of each polygon until the stack is virtually opaque:

Show[{vvv, vvv, vvv}]

enter image description here

If rasterization is allowed, or preferred, one can use SetAlphaChannel to make the image solid, but for this to be effective one must also set Background -> None in Show or the default white background will be used when the image is flattened, making this ineffectual.

SetAlphaChannel[Show[vvv, Background -> None, ImageSize -> 500]] ~ImageCrop~ 450

enter image description here

$\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.