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 two ArrayPlot[]s. One is in redscale and the other is in greenscale, such that the lowest value is white and the highest value is pure red or green. How do I overlap the two ArrayPlot[]s such that intersections are a combination of red and green to give a yellow intensity dependent on the "red" and "green" values?

Edit

I understand that maybe the question is not so clear. I got my idea from a common technique in biology where red fluorescent and green fluorescent signals are captured separately, then merged together.
Areas of red and green together become yellow, but regions of red only or green only are just those colors in the merged image.

I am aiming to translate this to data arranged in arrays such that the final merged image will show areas of red and green "signals" as yellow and red/green alone is still red/green alone.

Example:
enter image description here

share|improve this question
    
But those pictures are fully saturated. That's what was confusing us! –  belisarius Oct 4 '12 at 20:54
add comment

6 Answers 6

up vote 6 down vote accepted

You can use ArrayPlot with 3 dimensional data (i.e. where each element of the 2D array is a pair of values {r,g}), and a ColorFunction which returns a single colour from such a pair.

In the first example the ColorFunction varies the hue continuously from red to green, so that the colour reflects the dominance of red or green in the data. In the second example the Hue is pinned to yellow whenever the data is non-zero in both channels.

Create some data:

r = ConstantArray[Flatten[ConstantArray[#, 20] & /@ {0, 1, 0, 0.67, 0, 0.33, 0}], 140];
g = Transpose[r];

GraphicsRow[{
  ArrayPlot[r, ColorFunction -> (Blend[{White, Red}, #] &)],
  ArrayPlot[g, ColorFunction -> (Blend[{White, Green}, #] &)]}]

enter image description here

Example 1:

rgcol[{r_, g_}] := Hue[1/6 + ((g - r)/(10^-6 + Max[g, r]))/6, Max[r, g], 1];

ArrayPlot[Transpose[{r, g}, {3, 1, 2}], ColorFunction -> rgcol]

enter image description here

Example 2:

rgcol[{r_, g_}] := Hue[Clip[Sign[g]/3 - Sign[r]/6, {0, 1}], Max[r, g], 1];

ArrayPlot[Transpose[{r, g}, {3, 1, 2}], ColorFunction -> rgcol]

enter image description here

share|improve this answer
    
Looks like you nailed it. +1 –  Mr.Wizard Oct 5 '12 at 11:40
    
The retention of color dominance is extremely informative and useful. –  Christopher Bowman Oct 5 '12 at 20:07
add comment

Load your example images:

imgF = Import["http://fivephoton.com/image/MultipanelIFbApril2011.png"];
it = ImageTake[imgF, -300, 608];
{r, g, b} =  Join[ImagePartition[it, {304, 300}][[1]], 
                 {Image[Table[{0, 0, 0}, {300}, {304}]]}];
GraphicsRow@{r, g, b}

Mathematica graphics

Now see the result of

  ColorCombine@Diagonal[ColorSeparate /@ {r, g, b}]

Side by side with the desired outcome

Mathematica graphics

Not bad!

share|improve this answer
    
+1 very nice adaptation to the example given. –  David Carraher Oct 4 '12 at 23:01
    
@DavidCarraher thanks! It took me some time to understand the OP's need, and only realized it by looking at that example –  belisarius Oct 4 '12 at 23:05
add comment

Some Data

Here are two arrays, each of which have about 1/3 of their cells completely white (i.e. zero).

t1 = {{0, 0.9879420302163389`, 0, 0, 0.1849135890743674`}, {0.5742726088623453`, 0, 0.7914989802131724`, 0.19955892383000506`, 0.5597205682260553`}, {0.2783414505391293`, 0, 0.9748372906416929`, 0.08279443406565345`, 0.2832336389395025`}, {0.08577104927374801`, 0.7063421364586411`, 0, 0.5527067781783652`, 0.6623671920909151`}, {0.894385628016626`, 0.9220701552898367`, 0, 0, 0}}
t2 = {{0, 0.12518558916583622`, 0.7837612564671677`, 0, 0.3613465765727111`}, {0, 0.5040126862416661`, 0.7678471080216887`,0.8343516601886358`, 0.8591413788042153`}, {0.02105789348188214`, 0, 0.28409400830761267`, 0, 0}, {0.6511904278640404`, 0.5489190727738871`, 0.1852029426833548`, 0, 0.2908999228718716`}, {0.9793706128289879`, 0.5649780777815978`, 0.3898922119375319`, 0.24108312672016763`, 0.03651079793179979`}}

t3 is the sum of t1, t2, with the constraint that non-zero values are rapped in r or g, to later be interpreted as red and green.

t3 = (t1 /. {x_?NumberQ /; x != 0 :>  r[x]}) + (t2 /. {x_?NumberQ /; x != 0 :>  g[x]}) 
/. {g[x_] + r[y_] :> (x + y)/2, g[x_] :> Blend[{White, Green}, x], r[x_] 
:> Blend[{White, Red}, x]};

When red intersects with green, they make yellow (with an intensity that corresponds to the average of their hues); when red intersects with white, red prevails; when green intersects with white, green prevails. (I used Chop to ensure that a portion of the cells would remain white. )

t1 and t2 are plotted as red and green Arrays.

t3 is plotted in red, green, white, and yellow (where red and green intersect).

a1 = ArrayPlot[t1, ColorFunction -> (Blend[{White, Red},#] &), ImageSize -> 150, PlotLabel -> "a1"];
a2 = ArrayPlot[t2, ColorFunction -> (Blend[{White, Green}, #] &), ImageSize -> 150, PlotLabel -> "a2"];
a3 = ArrayPlot[t3, ImageSize -> 150,  ColorFunction -> (Blend[{White, Yellow}, #] &), PlotLabel -> "a3"];
GraphicsGrid[{{a1, a2, a3}}]    

array plots

share|improve this answer
    
Brilliant! This is exactly what I was trying to figure out. Thanks! –  Christopher Bowman Oct 4 '12 at 21:37
add comment

The question is quite confusing as the text specifies a white-to-color scale while the example is black-to-color. Nevertheless the example convinces me that indeed ImageAdd is what you want.

Import["http://fivephoton.com/image/MultipanelIFbApril2011.png"];
{{a, b}, {c, d}} = ImagePartition[%, {304, 300}];

Mathematica graphics

Row@{c, d, ImageAdd[c, d]}

Mathematica graphics

The first row requires some adjustment to handle the blue channel as shown.

Either average the blue channels:

Row@{a, b, ImageAdd @@ (ImageApply[{#, #2, #3/2} & @@ # &, #] & /@ {a, b})}

Or use only the first:

Row@{a, b, ImageAdd[a, ImageApply[{#, #2, 0} & @@ # &, b]]}

Mathematica graphics


You may find utility in ImageAdd. It would be helpful if you more clearly defined the overlap behavior that you desire.

Table[ArrayPlot[RandomReal[{0, 1}, {10, 10}], 
  ColorFunction -> (Blend[{White, color}, #] &)], {color, {Red, 
   Green}}]

ImageAdjust[ImageAdd @@ %, {0, 0, 2}]

Mathematica graphics

Mathematica graphics

All sorts of transformation are possible depending on what you want:

Table[ArrayPlot[RandomReal[{0, 1}, {10, 10}], 
  ColorFunction -> (Blend[{White, color}, #] &)], {color, {Red, 
   Green}}]
Image[Plus @@ (ImageData[#, "Real"] & /@ %)/2]
ImageApply[{1, 1, 0} (1 - 2 Abs[#[[1]] - #[[2]]]) &, %]

Mathematica graphics

Mathematica graphics

share|improve this answer
    
I think this is exactly the right idea; you just need to use Blend[{Black,color},#]& instead of White for your example to show the results the OP wants. –  Rahul Narain Oct 5 '12 at 3:09
    
@Rahul yes, thank you. The question is confusing because it explicitly states white. I'm still not sure if the OP wants that or not so I left it in the answer. –  Mr.Wizard Oct 5 '12 at 9:10
add comment

You can use ColorFunction with a fourth argument in RGBColor. This argument sets the transparency of the color. For example, this blends a transparent Red (ie white) into full on Red:

transRed = (Blend[{RGBColor[1, 0, 0, 0], RGBColor[1, 0, 0, 1]}, #] &);

Similarly,

transGreen = (Blend[{RGBColor[0, 1, 0, 0], RGBColor[0, 1 , 0, 1]}, #] &);

Then, you can use these as the ColorFunction in an ArrayPlot (or DensityPlot, etc). For example:

redplot = ArrayPlot[RandomReal[{0, 1}, {20, 20}], ColorFunction -> transRed]
greenplot = ArrayPlot[RandomReal[{0, 1}, {20, 20}], ColorFunction -> transGreen]

Mathematica graphics Mathematica graphics

If you want to overlay them, you can do it with Show:

Show[redplot,greenplot]

Mathematica graphics

share|improve this answer
2  
Yes, this is a good example, EXCEPT the heart of my question is how to specifically get YELLOW intersections where red and green intersect. "Stronger" overlap (defined by red and green addition) yields a "stronger" yellow color. –  Christopher Bowman Oct 4 '12 at 18:41
    
Ah, whoops. Missed that. –  Eli Lansey Oct 4 '12 at 18:42
    
Since this isn't what the question asked for and you've written the same answer at the right place (the other question), I would suggest deleting it (or correcting it), as it might be misleading. :) –  rm -rf Oct 5 '12 at 5:11
    
@rm-rf yeah, i know. hopefully i'll try to fix it this afternoon. –  Eli Lansey Oct 5 '12 at 14:33
add comment

Perhaps :

 t1 = Table[Sin@x Sin@y, {x, 0, 2 Pi, 2 Pi/100}, {y, 0, 2 Pi, 2 Pi/100}];
 t2 = Table[(x - Pi)^2 + (y - Pi)^2, {x, 0, 2 Pi, 2 Pi/100}, {y, 0, 2 Pi, 2 Pi/100}];

 Panel@GraphicsRow[
   ArrayPlot[#[[1]], ColorFunction -> #[[2]]] & /@ 
                                       {{t1, (Hue[1,   1-#, 1] &)},
                                        {t2, (Hue[1/3, 1-#, 1] &)},
                                        {Total[Rescale/@ {t1, t2}], (Hue[1/8, 1-#, 1] &)}}]  

Mathematica graphics

share|improve this answer
add comment

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.