19
$\begingroup$ 
m = {
    {3, 5, 5, 5, 5, 5, 5, 5}, 
    {3, 6, 8, 8, 8, 8, 8, 8}, 
    {3, 6, 10, 11, 11, 11, 11, 11}, 
    {3, 6, 10, 14, 14, 14, 14, 14}, 
    {3, 6, 10, 15, 17, 17, 17, 17}, 
    {3, 6, 10, 15, 20, 20, 20, 20}, 
    {3, 6, 10, 15, 21, 23, 23, 23}, 
    {3, 6, 10, 15, 21, 26, 26, 26}, 
    {3, 6, 10, 15, 21, 28, 29, 29}
}

TableForm[m, TableHeadings -> {Table["C=" <> ToString[c], {c, 2, 10}], Table["K=" <> ToString[k], {k, 3, 10}]}]

How to add the lines (solid and dahsed) so that the table looks like this:

enter image description here

I hope that we can archive this using TableForm as it is easier to include the two TableHeadings. Using Grid is a bit difficult to do so as we have to Prepend them to the matrix (table). Or is there a way to do so using Grid but I am not aware of?

|improve this question
$\endgroup$
  • 4
    $\begingroup$ I will be watching this question with interest. The few times I've needed something like this I have resorted to drawing the entire table with Graphics primitives. (Which also circumvents bugs in Grid.) This is hardly convenient and difficult to make general however. $\endgroup$ – Mr.Wizard♦ Jan 2 '15 at 3:08
  • $\begingroup$ Why the very left edge is no dashed blue too? $\endgroup$ – Kuba♦ Jan 2 '15 at 13:07
  • $\begingroup$ @Kuba I was not quite sure what you are asking. But the red line divides the table, so that there are different patterns on each side. The blue line is a line at K=2C. $\endgroup$ – Chen Stats Yu Jan 2 '15 at 15:58
12
$\begingroup$

Using Graphics:

As suggested by Mr.Wizard in comments Graphics, inconvenient as it is, is way to get the desired output:

gF[txtopts_: {16, "Panel", Italic}, o_:{AspectRatio -> 1/GoldenRatio, ImageSize -> 500}] :=
   With[{d2 = Transpose@Reverse[Prepend[Transpose[Prepend[Transpose[#], #2]], 
    Prepend[#3, ""]]], dim = {1, 1} + Dimensions@#, prims = ##4}, 
    Graphics[{MapIndexed[Text[Style[#, ## & @@ txtopts], #2 - {.5, .5}] &, d2, {2}],
             Thick, Black, Line[{{0, Last@dim}, {#, #} &@Last[dim]}], 
             Line[{{1, First@dim}, {1, 0}}], prims}, Sequence @@ o]] &;

OP's example:

rowh = Table["C=" <> ToString[c], {c, 2, 10}];
colh = Table["K=" <> ToString[k], {k, 3, 10}];
redline = {{2, 9}, {2, 8}, {3, 8}, {3, 7}, {4, 7}, {4, 5}, {5, 5}, {5, 3}, {6, 3},
           {6, 1}, {7, 1}, {7, 0}};
blueline = {{2, 8}, {4, 8}, {4, 7}, {6, 7}, {6, 6}, {8, 6}, {8, 5}, {9, 5}};

gF[][m, rowh, colh, Red, Line[redline], Blue, Dashed, Line[blueline]]

enter image description here

Using Overlay:

ClearAll[itemF, mF, borderedF];
itemF[sides_: {{True, False}, {True, False}}, col_: Directive[Thick, Red]] := 
  Item[#, Frame -> sides, FrameStyle -> col] &;
mF = MapAt[itemF @@ #2[[1]], #1, #2[[2]]] &;
borderedF = Prepend[Transpose[Prepend[Transpose[#], #2]], Prepend[#3, ""]] &;


dat = borderedF[m, rowh, colh];
cells11 = {{4, 5}, {6, 6}, {8, 7}, {10, 8}};
cells12 = {{2, 3}, {3, 4}, {5, 5}, {7, 6}, {9, 7}};
cells21 = {{3, 3}, {4, 5}, {5, 7}, {6, 9}};
cells22 = {{3, 4}, {4, 6}, {5, 8}};
redborders = {{{{{True, False}, {False, False}}, Directive[Thick, Red]}, cells11},
              {{{{True, False}, {True, False}}, Directive[Thick, Red]}, cells12}};
blueborders ={{{{{False, False}, {False, True}}, Directive[Thick, Dashed, Blue]}, cells21},
             {{{{False, True}, {False, True}}, Directive[Thick, Dashed, Blue]}, cells22}};

opts = {ItemStyle -> Directive[16, "Panel", Italic], Spacings -> {1, 1}};

g0 = Grid[dat, Sequence @@ opts, Dividers -> {2 -> True, 2 -> True}];
g1 = Grid[Fold[mF, dat, redborders], Sequence @@ opts];
g2 = Grid[Fold[mF, dat, blueborders], Sequence @@ opts];

Overlay[{g1, g2, g0}, Alignment -> Center]

enter image description here

|improve this answer
$\endgroup$
  • $\begingroup$ By the way I would like to encourage you once again to pick a fixed avatar, or at least enter a (phony) email that will be used to generate the gravatar. $\endgroup$ – Mr.Wizard♦ Jan 3 '15 at 6:38
  • $\begingroup$ @Mr.Wizard, just picked a glyph using VLC's code. $\endgroup$ – kglr Jan 3 '15 at 7:04
7
$\begingroup$

Here is my attempt. All the borders are correct except for the dual-coloured red line with blue dashes. It's a kludgy solution but shows possible techniques. In the following code I have left in Orange & Green to show some of the tricks. They can be switched to Black to reproduce the graphic. Grid is used.

enter image description here

m = {{3, 5, 5, 5, 5, 5, 5, 5}, {3, 6, 8, 8, 8, 8, 8, 8}, {3, 6, 10, 
    11, 11, 11, 11, 11}, {3, 6, 10, 14, 14, 14, 14, 14}, {3, 6, 10, 
    15, 17, 17, 17, 17}, {3, 6, 10, 15, 20, 20, 20, 20}, {3, 6, 10, 
    15, 21, 23, 23, 23}, {3, 6, 10, 15, 21, 26, 26, 26}, {3, 6, 10, 
    15, 21, 28, 29, 29}};

m = MapThread[
   Prepend, {Prepend[m, Table["K=" <> ToString[k], {k, 3, 10}]], 
    Prepend[Table["C=" <> ToString[c], {c, 2, 10}], ""]}];

(* Frame position: {Bottom, Left, Top, Right} *)

m[[1, 3]] = 
  Item[m[[1, 3]], Frame -> {False, False, False, False}, 
   FrameStyle -> Pink];
m[[1, 4]] = 
  Item[m[[1, 4]], Frame -> {False, False, False, False}, 
   FrameStyle -> Pink];

m[[2, 2]] = 
  Item[m[[2, 2]], Frame -> {False, True, True, True}, 
   FrameStyle -> None];
m[[2, 3]] = 
  Item[m[[2, 3]], Frame -> {True, True, True, False}, 
   FrameStyle -> Red];
m[[2, 4]] = 
  Item[m[[2, 4]], Frame -> {True, False, True, False}, 
   FrameStyle -> Directive[Blue, Dashed]];

m[[3, 1]] = 
  Item[m[[3, 1]], Frame -> {False, False, False, True}, 
   FrameStyle -> Orange];
m[[3, 2]] = 
  Item[m[[3, 2]], Frame -> {False, True, False, False}, 
   FrameStyle -> None];
m[[3, 3]] = 
  Item[m[[3, 3]], Frame -> {False, False, True, True}, 
   FrameStyle -> Red];
m[[3, 9]] = Item[m[[3, 9]], Frame -> False, FrameStyle -> None];

m[[3, 5]] = 
  Item[m[[3, 5]], Frame -> {True, True, False, False}, 
   FrameStyle -> Directive[Blue, Dashed]];
m[[3, 6]] = 
  Item[m[[3, 6]], Frame -> {True, False, False, False}, 
   FrameStyle -> Directive[Blue, Dashed]];

m[[4, 2]] = 
  Item[m[[4, 2]], Frame -> {False, True, False, False}, 
   FrameStyle -> None];
m[[4, 4]] = 
  Item[m[[4, 4]], Frame -> {False, False, True, True}, 
   FrameStyle -> Red];
m[[4, 7]] = 
  Item[m[[4, 7]], Frame -> {True, True, False, False}, 
   FrameStyle -> Directive[Blue, Dashed]];
m[[4, 8]] = 
  Item[m[[4, 8]], Frame -> {True, False, False, False}, 
   FrameStyle -> Directive[Blue, Dashed]];

m[[5, 2]] = 
  Item[m[[5, 2]], Frame -> {False, True, False, False}, 
   FrameStyle -> None];
m[[5, 4]] = 
  Item[m[[5, 4]], Frame -> {False, False, False, True}, 
   FrameStyle -> Red];
m[[5, 7]] = 
  Item[m[[5, 7]], Frame -> {False, False, True, False}, 
   FrameStyle -> Directive[Blue, Dashed]];
m[[5, 8]] = 
  Item[m[[5, 8]], Frame -> {False, False, True, True}, 
   FrameStyle -> Directive[Blue, Dashed]];

m[[6, 2]] = 
  Item[m[[6, 2]], Frame -> {False, True, False, False}, 
   FrameStyle -> None];
m[[6, 5]] = 
  Item[m[[6, 5]], Frame -> {False, False, True, True}, 
   FrameStyle -> Red];
m[[6, 9]] = 
  Item[m[[6, 9]], Frame -> {False, False, True, False}, 
   FrameStyle -> Directive[Blue, Dashed]];

m[[7, 2]] = 
  Item[m[[7, 2]], Frame -> {False, True, False, False}, 
   FrameStyle -> None];
m[[7, 6]] = 
  Item[m[[7, 6]], Frame -> {True, True, False, False}, 
   FrameStyle -> Red];

m[[8, 2]] = 
  Item[m[[8, 2]], Frame -> {False, True, False, False}, 
   FrameStyle -> None];
m[[8, 6]] = 
  Item[m[[8, 6]], Frame -> {False, False, True, True}, 
   FrameStyle -> Red];

m[[9, 2]] = 
  Item[m[[9, 2]], Frame -> {False, True, False, False}, 
   FrameStyle -> None];
m[[9, 7]] = 
  Item[m[[9, 7]], Frame -> {True, True, False, False}, 
   FrameStyle -> Red];

m[[10, 2]] = 
  Item[m[[10, 2]], Frame -> {False, True, False, False}, 
   FrameStyle -> None];
m[[10, 8]] = 
  Item[m[[10, 8]], Frame -> {False, True, False, False}, 
   FrameStyle -> Red];

Grid[m, Dividers -> {{2 -> Green, 3 -> Red}, {2 -> Green, 4 -> Red}}, 
 ItemSize -> 4]
|improve this answer
$\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.