3
$\begingroup$

In a certain way, it's certainly a duplicate question. But I did not find the original.

I have adapted an old code to obtain the following nice presentation of the matrix

mtc = {{0, 2784, 2788, 2720, 2766}, {3034, 0, 2780, 2748, 2637}, {3030, 
  3038, 0, 2932, 3028}, {3098, 3070, 2886, 0, 2795}, {3052, 3181, 
  2790, 3023, 0}}

Here is the code:

 Grid[Join[{Join[{"(x,y)"}, l]}, Flatten /@ Transpose[{l, mtc}]], 
 Alignment -> Center, 
 Background -> {{1 -> LightGray}, {1 -> LightGray}, {1, 1} -> None}, 
 Dividers -> {{2 -> True}, {2 -> True}}, 
 ItemStyle -> Directive[FontSize -> 16], Frame -> True, 
 Spacings -> {1.5, 1.5}]

But now I would like that, if a number say $x[i, j]$ is greater than a number $x[j, i]$, the backgroud be lightreded, and, lightblued in the contrary.

$\endgroup$
0

3 Answers 3

5
$\begingroup$

Just another way:

With[{sgn = Sign[mtc - Transpose[mtc]]},
 Grid[mtc, 
  Background -> {Automatic, Automatic, 
    Thread[Position[sgn, 1] -> LightRed]~Join~
     Thread[Position[sgn, -1] -> LightBlue]}, Frame -> All]
 ]

enter image description here

$\endgroup$
4
$\begingroup$

The OP didn't specify what l is, so:

mtc = {{0, 2784, 2788, 2720, 2766}, {3034, 0, 2780, 2748, 
    2637}, {3030, 3038, 0, 2932, 3028}, {3098, 3070, 2886, 0, 
    2795}, {3052, 3181, 2790, 3023, 0}};
l = CharacterRange["a", "e"];

Then, it's not clear what should happen with the diagonal elements, so:

back = Flatten[#, 1] &@
  Table[Which[mtc[[i, j]] > mtc[[j, i]], {i + 1, j + 1} -> LightRed, 
    mtc[[i, j]] < mtc[[j, i]], {i + 1, j + 1} -> LightGreen, 
    i == j, {i + 1, j + 1} -> None], {i, Length@mtc}, {j, 
    Length@mtc[[1]]}]

and

plot = Grid[
  Join[{Join[{"(x,y)"}, l]}, Flatten /@ Transpose[{l, mtc}]], 
  Alignment -> Center, 
  Background -> {{1 -> LightGray}, {1 -> LightGray}, {{1, 1} -> None}~
     Join~back}, Dividers -> {{2 -> True}, {2 -> True}}, 
  ItemStyle -> Directive[FontSize -> 16], Frame -> True, 
  Spacings -> {1.5, 1.5}]

enter image description here


If the diagonal is to be in either of the classes, an If statement is a bit shorter:

back = Flatten[#, 1] &@
  Table[If[mtc[[i, j]] > mtc[[j, i]], {i + 1, j + 1} -> 
     LightRed, {i + 1, j + 1} -> LightGreen], {i, Length@mtc}, {j, 
    Length@mtc[[1]]}]

Then

enter image description here

$\endgroup$
1
  • $\begingroup$ Super Thanks to all $\endgroup$ Nov 20, 2016 at 14:51
3
$\begingroup$

Here is a generic approach to position based styling. MapIndexed is a natural tool to use in conjunction with a styling function.

Module[
 {l = Range@Length@mtc,    (* labels *)
  bg},                     (* background function *)
 bg[xy_, pos_] := With[{yx = Extract[mtc, Reverse@pos]},
   Switch[Sign[xy - yx]    (* similar condition as @udpdqn *)
    , -1, LightBlue
    , 1, LightRed
    , _, None]
   ];
 Grid[
  Join[{Join[{"(x,y)"}, l]}, Flatten /@ Transpose[{l, mtc}]],
  Background -> {LightGray, LightGray,
    Join[
     {{1, 1} -> None}, Flatten@MapIndexed[1 + #2 -> bg[##] &, mtc, {2}]
     ]},
  Frame -> All]
 ]

Mathematica graphics

It might also be more convenient in some cases to precompute a matrix that indicates the styling, as @udpdqn did with sgn. Here is that idea adapted to the MapIndexed approach above:

Module[
 {condition = Sign[mtc - Transpose[mtc]], (* conditions for background (= udpdqn's sgn) *)
  l = Range@Length@mtc,                   (* labels *)
  bg},                                    (* background function *)
 bg[-1, pos_] := LightBlue;
 bg[1, pos_] := LightRed;
 bg[_, _] := None;
 Grid[
  Join[{Join[{"(x,y)"}, l]}, Flatten /@ Transpose[{l, mtc}]],
  Background -> {LightGray, 
    LightGray, {{1, 1} -> None}~Join~
     Flatten@MapIndexed[1 + #2 -> bg[##] &, condition, {2}]}, 
  Frame -> All]
 ]
$\endgroup$

Your Answer

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

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