7
$\begingroup$

Let's say I have 100 polygons that are all different but most of them overlap. All I want to do is to draw/plot them in one single graphic with linearly adding gray values; i.e., a point with n overlapping polygons(or other graphics) should have a grayvalue of n/100.

I wish

Graphics[{Opacity[1/10], Table[Disk[{i/10, 0}], {i, 10}]}]

would work, but Opacity doesn't add up linearly, and I don't find any easy way to do what I want.

My current idea is to go via Image[Graphics[...]], ImageData and ArrayPlot, but I might lose a lot of precision that way.

$\endgroup$

3 Answers 3

12
$\begingroup$

I'm not very familiar with but I do not think you could get both, high precission and high performance, at once.

This is straightforward approach. With Image processing functions avalible in Mathematica. Also, I'm not going to use Opacity, I do not know how does it work inside.

First, there is a function to to create an image, you can set resulution like you need.

f = ColorConvert[Image[Graphics[#, PlotRange -> 1], 
                       "Bit", ImageResolution -> 96, ImageSize -> 500], 
                 "GrayScale"] &;

Lets create some triangles:

pics = f /@ (Polygon /@ Table[{{0, -1}, RandomReal[1, 2],RandomReal[{-1, 0}, 2]}, 
                              {100}]);

ImageMultiply[Fold[ImageAdd, First@pics, Rest@pics], 1/100]

enter image description here

Stealing examples with Disks (generating disk images last longer but not so much):

f = ColorConvert[Image[Graphics[#, PlotRange -> {{-1, 1}, {-.5, .5}}], "Bit", 
                       ImageResolution -> 96, ImageSize -> 500], "GrayScale"] &;

pics = f /@ Table[Disk[{-.5 + i/100, 0}, .5], {i, 100}];

ob = ImageMultiply[Fold[ImageAdd, First@pics, Rest@pics], 1/100]
ColorNegate@ob

enter image description here

enter image description here

As you can see, everything is linear:

ListPlot[ImageData[ColorNegate@ob][[ 130]]] 

enter image description here

$\endgroup$
2
  • $\begingroup$ So you are just adding up all Images and divide by #Images. Sounds simple, but those ways are often the best. I think I tried this before as well, but for some reasons it didn't work. €:thx, this (probably) was what I wanted $\endgroup$
    – A Rizona
    Jul 23, 2013 at 11:09
  • $\begingroup$ @ARizona Thank you, I'm glad you like it. Fold with ImageAdd is quite handy. If you want high precission you may try to work with inequalities which are describing polygons and Piecewise etc. but this is going to be so slow... :) $\endgroup$
    – Kuba
    Jul 23, 2013 at 11:14
6
$\begingroup$

In theory, the only way that overlaying $N$ objects with constant opacity will yield a completely opaque intersection is when $N \to \infty$. Therefore, it will be hard to get exactly what you want without resorting to image processing.

Here is a way to get the linear addition effect of intersecting gray-level objects using image tools:

With[{threshold = .05, n = 10},
 t = Table[
   Image[
    Graphics[
     {GrayLevel[threshold^(1/n)], Disk[{i/n, 0}]},
     PlotRange -> {{-1.1, 2.1}, {-1.1, 1.1}}
     ],
    ImageResolution -> 200
    ],
   {i, n}
   ];
 im = First[t //. {a___, x_, y_, b___} :> {a, ImageMultiply[x, y], b}];
 ImageApply[Log[Max[#, threshold]/threshold]/Log[1/threshold] &, im]]

gray intersections

Here I set n to be the number of overlapping shapes, and used your Disk example. The ImageResolution option can be used to your taste, to avoid the pixelated appearance you're worried about.

What I do is use ImageMultiply with a set of small GrayLevels for each shape. This is then subjected to ImageMultiply, leading initially to (undesirable) unequal steps in gray scale for the intersections. The darkest color that I can get with the multiplication of n shapes is set by threshold.

To get the threshold value to display as truly Black, I post-process the resulting multiplied images with ImageApply by taking the Log of the pixel values, to undo the exponentially varying GrayLevel of the individual intersecting shapes. The Log is scaled such that its result varies between 0 and 1.

By combining this geometric sequence of image gray levels with a Log, I end up with something that looks like addition of gray levels but achieves the full dynamic range between 0 and 1.

$\endgroup$
2
  • $\begingroup$ Okay thanks for your answer, but I do not understand why your first sentence should hold. Your approach looks a lot better then Opacity[] but gets quite slow for a few hundreds of Images and the ImageApply needs to be adjusted to give a darker black for a larger n. $\endgroup$
    – A Rizona
    Jul 23, 2013 at 7:39
  • $\begingroup$ It gets slow, but never slower than @Kuba's approach, as far as I can tell. Mathematically, you'll get GrayLevel zero exactly when there are n overlapping shapes. You can't get any blacker than 0, so I don't see the problem. $\endgroup$
    – Jens
    Jul 23, 2013 at 17:06
4
$\begingroup$

A simple approach, but perhaps not meeting your precision requirement, is to create the Graphics using Opacity as you did, and then use image processing to adjust the levels.

op = 1/10;
m = 10;
gr = Graphics[{Opacity[op], Table[Disk[{i/10, 0}], {i, 10}]}]

enter image description here

The gray level from combining $n$ layers of opacity $\text{op}$ is $\text{col}=(1-\text{op})^n$, so to convert to a gray level of $n/m$ requires:

ImageApply[Log[#]/(m Log[1 - op]) &, Image[gr]]

enter image description here

To confirm that the resulting image has a gray level of $n/10$:

ListPlot[ImageData[%][[130, All, 1]]]

enter image description here

$\endgroup$
5
  • $\begingroup$ I tried with 100 Disks and something is not correct. Do you confirm or I'm making a mistake somewhere? $\endgroup$
    – Kuba
    Jul 23, 2013 at 8:35
  • $\begingroup$ @Kuba, op = 1/50; m = 100; gr = Graphics[{Opacity[op], Table[Disk[{i/50, 0}], {i, 100}]}] doesn't look too bad. This approach is fundamentally limited by Mathematica's 8-bit rasterization of course, with enough disks you reach a point where n layers and n+1 layers map to the same gray level. $\endgroup$ Jul 23, 2013 at 8:54
  • $\begingroup$ Oh, it works. I've tried with op=1/100 but it doesn't seem to be a problem you've mentioned, does it or I'm wrong again? :). Also, for 1/50 it looks good but it is not equal to 1 inside common area. $\endgroup$
    – Kuba
    Jul 23, 2013 at 9:00
  • $\begingroup$ @Kuba, yes that's the result of my assuming continuously variable opacity when the rasterization is really done with 8 bits. I could probably tweak it to make it a little better, but really I just wanted to show that something close to linear could be recovered from the combined graphics rather than rasterizing each disk individually. Yours or Jens' is definitely the method to use if precision is important. $\endgroup$ Jul 23, 2013 at 21:34
  • $\begingroup$ The idea is great (+1ed), unfortunately I have no knowledge about opacity and rasterization at this level so I will not say more. :) $\endgroup$
    – Kuba
    Jul 23, 2013 at 22:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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