Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

How can I plot this graph


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

Rasterize@g1

Mathematica graphics

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 enter image description here enter image description here

share|improve this question
    
Is this a one time only task? –  belisarius Jul 8 '13 at 2:00
    
@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 8 '13 at 2: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 8 '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 8 '13 at 12:04

2 Answers 2

up vote 5 down vote accepted

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]]

enter image description here

share|improve this answer
    
good point---+1 –  HyperGroups Jul 8 '13 at 7:56

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...

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

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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