17
$\begingroup$

This may have been asked somewhere else, but I couldn't find an answer by searching. I'm trying to create a correlation table that colors the background behind the numbers as a heatmap. I've been trying to use ArrayPlot with ColorFunction -> "TemperatureMap", but I'm kind of stuck.

Example:

data = {{1, 0., -0.8}, {0., 1, 0.}, {-0.8, 0., 1}};
ArrayPlot[data, ColorFunction -> "TemperatureMap", Frame -> None, Mesh -> True]

enter image description here

$\endgroup$
5
  • $\begingroup$ Welcome to Mathematica at Stack exchange. Regarding your question, it would help if you would show the code you are using for the correlation table and also the code for ArrayPlot that you tried. $\endgroup$
    – DavidC
    Sep 12, 2012 at 15:33
  • $\begingroup$ Sure, this is a very simplified example but I figure I can extend a solution. data = {{1, 2, 3, 4}, {1.5, 1.7, 1.2, .5}}; ArrayPlot[Correlation[data[Transpose]], ColorFunction -> "TemperatureMap", Frame -> None, Mesh -> True] The data is made up, but basically I want deep blue to represent -1 and red to represent 1 with gradient in between if possible. $\endgroup$ Sep 12, 2012 at 15:35
  • $\begingroup$ as David told if you have the table already mathematica.stackexchange.com/questions/6081/… can be of some help to you. $\endgroup$ Sep 12, 2012 at 15:35
  • $\begingroup$ I added a slightly better example to my original post, hopefully that helps. This would produce roughly what I'm looking for but with a couple of important issues. 1) the gradient isn't indexed properly (in the example -0.8 is the same as -1 in color) and 2) I'd like some way of including the values on top of the colors. $\endgroup$ Sep 12, 2012 at 16:09
  • $\begingroup$ Thanks @PlatoManiac for the editing help. $\endgroup$ Sep 12, 2012 at 17:13

2 Answers 2

20
$\begingroup$

Let's do real world application. Give the members of the Dow Jones Industrial Average:

mem = FinancialData["^DJI", "Members"]

{"AA", "AXP", "BA", "BAC", "CAT", "CSCO", "CVX", "DD", "DIS", "GE", "HD", "HPQ", "IBM", "INTC", "JNJ", "JPM", "KFT", "KO", "MCD", "MMM", "MRK", "MSFT", "PFE", "PG", "T", "TRV", "UTX", "VZ", "WMT", "XOM"}

Get monthly prices for the last 10 members for the last decade:

findata=FinancialData[#, "Price", {{2000}, {2010}, "Month"}][[All, 2]] & /@ mem[[-10;;-1]];

Find correlation matrix:

fincm = Correlation[Transpose@findata];

Overlay Grid over ArayPlot with precise ImageSize control:

Column[{
  GraphicsRow[mem[[-10 ;; -1]], ImageSize -> 500, Frame -> All],
  Row[{
    GraphicsColumn[mem[[-10 ;; -1]], ImageSize -> 50, Frame -> All],
    Overlay[{
      ArrayPlot[fincm, ColorFunction -> (ColorData["TemperatureMap"][(1 + #)/2] &), 
       Frame -> None, Mesh -> True, PlotRangePadding -> 0, 
       ImageSize -> 500, ColorFunctionScaling -> False], 
      GraphicsGrid[Map[NumberForm[#, 2] &, fincm, {2}], 
       ImageSize -> 500]}]
    }]}, Alignment -> Right, Spacings -> 0]

enter image description here

"PG" and "PFE" seem highly anti-correlated. Lets verify, indeed

DateListLogPlot[FinancialData[#, "Price", {{2000}, {2010}, "Month"}] & /@ {"PG", 
   "PFE"}, Joined -> True, Filling -> Bottom]

enter image description here

While "XOM" and "UTX" are highly correlated, and indeed:

DateListLogPlot[FinancialData[#, "Price", {{2000}, {2010}, "Month"}] & /@ {"XOM", 
   "UTX"}, Joined -> True, Filling -> Bottom]

enter image description here

$\endgroup$
6
  • $\begingroup$ Thank you, that looks quite close. Is there a good way to rescale the gradient so that 0. would be white(ish) and -1 (if it existed) would be the darkest shade of blue with negative numbers of blue hues and positive numbers red hues? $\endgroup$ Sep 12, 2012 at 16:12
  • $\begingroup$ Perhaps I'm not understanding the image posted above but it appears that the plot is using the smallest number (-0.28) as the gradient limit which shows as a dark blue while 0.16 is showing as the most neutral (rather than values closer to 0). $\endgroup$ Sep 12, 2012 at 16:26
  • $\begingroup$ @MatthewMcMaster I updated the code to do what you need. $\endgroup$ Sep 12, 2012 at 16:51
  • $\begingroup$ Thank you, that looks like what I was trying to do. Greatly appreciate the work! $\endgroup$ Sep 12, 2012 at 16:57
  • 2
    $\begingroup$ Just wanted to add that in the ColorFunction you could use Rescale[#, {-1, 1}]. Of course its the same transformation but just for clarity sake. $\endgroup$ Sep 12, 2012 at 17:54
17
$\begingroup$

Based on Vitaliy Kaurov's code, I would like to present another approach for making the matrix, which does not depend on Overlay:

mem = FinancialData["^DJI", "Members"];
findata = 
  FinancialData[#, "Price", {{2000}, {2010}, "Month"}][[All, 2]] & /@ 
   mem[[-10 ;; -1]];
fincm = Correlation[Transpose@findata];

tb = Map[Item[NumberForm[#, 2], 
     Background -> 
      ColorData["TemperatureMap"][Rescale[#, {-1, 1}]]] &, 
   fincm, {2}];
tb = Prepend[tb, mem[[-10 ;; -1]]];
tb = Join[List /@ Prepend[mem[[-10 ;; -1]], ""], tb, 2];
GraphicsGrid[tb, ImageSize -> 500, Frame -> All]

matrix

Styling the dividers, removing the unnecessary dot after 1 and switching off the SingleLetterItalics->True default Cell option by wrapping with Style:

headings = Item[Style[#], Frame -> True] & /@ mem[[-10 ;; -1]];
tb = Map[Item[NumberForm[# /. x_ /; x == 1 -> 1, 2], Frame -> True, 
     FrameStyle -> Gray, 
     Background -> 
      ColorData["TemperatureMap"][Rescale[#, {-1, 1}]]] &, 
   fincm, {2}];
tb = Prepend[tb, headings];
tb = Join[List /@ Prepend[headings, ""], tb, 2];
GraphicsGrid[tb, ImageSize -> 500]

matrix

$\endgroup$
0

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.