13
$\begingroup$

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

$\endgroup$
1
  • $\begingroup$ But those pictures are fully saturated. That's what was confusing us! $\endgroup$ Oct 4, 2012 at 20:54

6 Answers 6

6
$\begingroup$

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

$\endgroup$
2
  • $\begingroup$ Looks like you nailed it. +1 $\endgroup$
    – Mr.Wizard
    Oct 5, 2012 at 11:40
  • $\begingroup$ The retention of color dominance is extremely informative and useful. $\endgroup$ Oct 5, 2012 at 20:07
11
$\begingroup$

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!

$\endgroup$
2
  • $\begingroup$ +1 very nice adaptation to the example given. $\endgroup$
    – DavidC
    Oct 4, 2012 at 23:01
  • $\begingroup$ @DavidCarraher thanks! It took me some time to understand the OP's need, and only realized it by looking at that example $\endgroup$ Oct 4, 2012 at 23:05
6
$\begingroup$

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

$\endgroup$
1
  • $\begingroup$ Brilliant! This is exactly what I was trying to figure out. Thanks! $\endgroup$ Oct 4, 2012 at 21:37
4
$\begingroup$

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

$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – user484
    Oct 5, 2012 at 3:09
  • $\begingroup$ @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. $\endgroup$
    – Mr.Wizard
    Oct 5, 2012 at 9:10
2
$\begingroup$

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

$\endgroup$
4
  • 2
    $\begingroup$ 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. $\endgroup$ Oct 4, 2012 at 18:41
  • $\begingroup$ Ah, whoops. Missed that. $\endgroup$
    – Eli Lansey
    Oct 4, 2012 at 18:42
  • $\begingroup$ 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. :) $\endgroup$
    – rm -rf
    Oct 5, 2012 at 5:11
  • $\begingroup$ @rm-rf yeah, i know. hopefully i'll try to fix it this afternoon. $\endgroup$
    – Eli Lansey
    Oct 5, 2012 at 14:33
2
$\begingroup$

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

$\endgroup$

Your Answer

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

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