Add arrows over matrix

Question

How can I plot this graph

g1 = Table[x[i, j], {i, 5}, {j, 5}] // Grid;
Rasterize@g1

I added these arrows by Ctrl+D's graphics tool.

This way maybe hard to adjust the positions of x and arrows to a precise consistent level, also we need make arrows parallel..

One way is define the coordinates of x and then use Graphics to add Text and Arrow..

Any other good methods/choices?

I think this could be one general job, because sometimes we may add other objects/marks over matrix. This is the diagonal of Fibonacci Numbers over Pascal Triangle

enter image description here

@belisarius I think this could be one general job, because sometimes we may add other objects/marks over matrix. This is the diagonal of fibonacci numbers over Pascal Triangle — HyperGroups, Jul 08 '13 at 02:24
Unless someone shows super simple method, all can be reduced to efficient and simple sorting vertices and then drawing is not a problem. Maybe You have to create a question for searching such sorting algorithms for diffrent graphs You've presented? — Kuba, Jul 08 '13 at 11:11
@Kuba en, One way I'll use and used before is that get coordinates of entries in the graphics of matrix with order, and then obtain the sorting vertices. And you use ImageSize to control the fitness of two objects, that's good and simple way. — HyperGroups, Jul 08 '13 at 12:04

Rod · Answer 1 · 2013-07-08T12:16:39.663

5

I think this could be an approach:

Clear["Global`*"]
length = 5;(*choose here the matrix size!*)img = 
Rasterize@Grid[Table[x[i, j], {i, length}, {j, length}]];
{x, y} = ImageDimensions@img;
listx = x/length*# & /@ Range[0, length];
listy = y/length*# & /@ Range[0, length];
f[i_, j_] := {{0, listy[[i]]}, {listx[[-j]], y}}
temp = MapThread[f, {Range[length], Range[length]}];
img2 = Graphics[{Red, Arrowheads[Medium], Arrow[temp]}, ImageSize -> ImageDimensions@img,
PlotRangePadding -> None, PlotRangeClipping -> False, ImagePadding -> 0, 
AxesOrigin -> {0, 0}];
Overlay[{img, img2}]

Results:

5x5 matrix:

enter image description here

6x6 matrix:

enter image description here

7x7 matrix:

enter image description here

8x8 matrix:

enter image description here

And so on...

edited Jul 08 '13 at 12:16

answered Jul 08 '13 at 04:54

Rod

3,318
2
24
40

hi, nice work, maybe you are also interested the more general question. – HyperGroups Jul 08 '13 at 07:57
@HyperGroups Have you seen this post? – Rod Jul 08 '13 at 17:11
ha, I see, thanks, the next goal is to add red lines over Pascal Triangle. – HyperGroups Jul 09 '13 at 15:09

Kuba · Accepted Answer · 2013-07-08T09:58:17.590

Since You have updated question to be more general I'm going to show method which is good to take under consideration as a general approach :)

one of OP's examples

First, it is good to set vertices in proper order:

dia[1, k_] := Table[{1 + i, (k - i)}, {i, 0, k - 1}] // If[EvenQ@k, Reverse, # &]
mx = {#1, -#2} & @@@Select[
                           Join @@ Table[dia[1, i], {i, 1, 8}],
                           First@# <= 4 \[And] Last@# <= 4 &
                          ]

If You don't want to play with VertexShape then Graph can be a upper layer in Overlay with Your Grid:

graph = Graph[Table[i \[UndirectedEdge] i + 1, {i, 15}],
              VertexCoordinates -> mx, VertexSize -> 0, 
              EdgeStyle -> Directive[{Thick, Red}],
              EdgeShapeFunction -> GraphElementData["FilledArrow"], 
              ImageSize -> {400, 400}, ImagePadding -> 40];

grid = GraphicsGrid[Table[
         Style[StringForm["x[``,``]", a, b], GrayLevel@.6, Bold, 25]
         , {a, 4}, {b, 4}], ImageSize -> 400];

Overlay[{grid, graph}]

enter image description here

dia[1, k_] := Table[{1 + i, (k - i)}, {i, 0, k - 1}] // Reverse;
mx = {#1, -#2} & @@@ Select[
                            Join @@ Table[dia[1, i], {i, 1, 8}],
                            First@# <= 4 \[And] Last@# <= 4 &];

enter image description here

General case

It's about Graph and the trick is to set unwanted edges style Transparent.

mx[a_, b_] :=Table[{{b1, a + 1 - a1},Style[StringForm["x[``,``]", a1, b1], Bold]}, 
                   {a1, a}, {b1, b}] // Flatten[#, 1] &

Graph[Table[i \[UndirectedEdge] i + 1, {i, 24}],
      VertexCoordinates -> mx[5, 5][[ ;; , 1]],
      VertexLabels -> Table[i -> Placed[mx[5, 5][[ i, 2]], Center], {i, 25}], 
      VertexSize -> 0.5, VertexShapeFunction -> "Square",
      EdgeStyle -> (Table[(i \[UndirectedEdge] i + 1) -> Blue, {i, 1, 23, 2}
                         ]~Join~
                    Table[(i \[UndirectedEdge] i + 1) -> Transparent, {i, 2, 24, 2}]),
      EdgeShapeFunction -> GraphElementData["FilledArrow", "ArrowSize" -> .1]]

Add arrows over matrix

How can I plot this graph

2 Answers2