Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question

3 Answers 3

up vote 8 down vote accepted

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

share|improve this answer
    
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 –  A Rizona Jul 23 '13 at 11:09
    
@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... :) –  Kuba Jul 23 '13 at 11:14

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.

share|improve this answer
    
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. –  A Rizona Jul 23 '13 at 7:39
    
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. –  Jens Jul 23 '13 at 17:06

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

share|improve this answer
    
I tried with 100 Disks and something is not correct. Do you confirm or I'm making a mistake somewhere? –  Kuba Jul 23 '13 at 8:35
    
@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. –  Simon Woods Jul 23 '13 at 8:54
    
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. –  Kuba Jul 23 '13 at 9:00
    
@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. –  Simon Woods Jul 23 '13 at 21:34
    
The idea is great (+1ed), unfortunately I have no knowledge about opacity and rasterization at this level so I will not say more. :) –  Kuba Jul 23 '13 at 22:14

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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