4
$\begingroup$

Suppose I am calculating the correlation of a a set of vectors.

Correlation[RandomReal[1, {5,5}]]

I would like to display the output using TableForm or Grid and use either Style or Background to highlight the entries that exceed some threshold (say > .5 and < -.5)

I found How can I add row and column header images to my TableForm output? which highlights the minimum in each row using:

    TableForm[With[{min = Min[#]}, # /. min -> Style[min, Red]] & /@ data, 
TableHeadings -> {ConstantArray[lena, 3], ConstantArray[lena, 9]}]

Can someone help me adapt this for my purpose?

Edit:

Of course I can do it this way:

 data = RandomReal[1,{5,5}];
 cors = Round[Correlation[data], .01];
 Table[Style[cors[[i, j]], 
 If[Abs[cors[[i, j]]] > .35, Red, Black]], {i, 1, 5}, {j, 1, 5}] // TableForm

but I would like to understand how to do it in one line

Edit #2:

Here is the inelegant solution I came up with:

 cors = Correlation[RandomReal[1, {5, 5}]];
 headers = Table["Header " <> ToString[j], {j, 1, 5}];
 backs = Table[ If[cors[[i, j]] > .35, {i + 1, j + 1} -> Green, 
 If[cors[[i, j]] < -.35, {i + 1, j + 1} -> Red]], {i, 1, 
 Length[cors]}, {j, 1, Length[cors]}] // Flatten;

 Grid[MapThread[Prepend[#2, #1] &, {Join[{""}, headers], Prepend[
(Round[cors, .01]), headers]}], 
 Background -> {LightGray, LightGray, backs}, Frame -> All]

Which produces enter image description here

$\endgroup$
1
$\begingroup$

Not a one liner but a little bit more straight forward than what you are doing:

1: Get your data and make your headers.

cors = Correlation[RandomReal[1, {5, 5}]];
headers = Table[{"Header " <> ToString[j]}, {j, 1, 5}];

2: I am assuming that your columns will always be the same as the headers as per your example. In that case:

Grid[
 grid = Join[{Flatten[{"", headers}]}, Join[headers, cors, 2]],
 Background -> {White, White, 
   Flatten[{Thread[Position[grid, x_Real /; x > 0.35] -> Green], 
     Thread[Position[grid, x_Real /; x < -0.35] -> Red]}]}
 ]

This code makes the table/grid (called grid) and then finds the positions in grid that match the criteria.

enter image description here

You can turn this into something dynamic that adjusts whenever you change cors:

Dynamic[
 Grid[
  grid = Join[{Flatten[{"", headers}]}, Join[headers, cors, 2]],
  Background -> {White, White, 
    Flatten[{Thread[Position[grid, x_Real /; x > 0.35] -> Green], 
      Thread[Position[grid, x_Real /; x < -0.35] -> Red]}]}
  ],
 TrackedSymbols :> {cors}]
$\endgroup$
1
$\begingroup$

Not really that different, the ReplaceAll approach together with PatternTest and Condition is quite versatile...

m = MapIndexed[Prepend[#, "Row " <> ToString@#2[[1]]] &, 
   Correlation[RandomReal[1, {5, 5}]]];

Grid[m /. {x_?NumericQ /; x < -.35 :> Style[x, Red], 
   x_?NumericQ /; x > .35 :> Style[x, Green]}, Frame -> All, 
 Background -> LightGray]

Mathematica graphics

Should be adaptable for the Grid backgrounds - the contrast here is really awful.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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