8
$\begingroup$

I need to place ArrayPlot in the vertices of graph. i.e. in graph

 Graph[{1->2, 2->3, 3->1}]

I have to replace vertex 1 with ArrayPlot[{{0,0,1}}] and so on based on the following list

{{1,{0,0,1}},{2,{0,1,0}},{3,{1,1,0}}}
$\endgroup$
10
$\begingroup$
r := RandomReal[{0, 1}, {10, 10}]; 
Graph[{1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3, 3 \[UndirectedEdge] 1}, 
   VertexShape -> {1 -> ArrayPlot[r], 2 -> ArrayPlot[r],  3 -> ArrayPlot[r]}, 
   VertexSize -> Medium]

enter image description here

$\endgroup$
6
$\begingroup$

I think it is a bit closer than bill's answer

r = {{1, {0, 0, 1}}, {2, {0, 1, 0}}, {3, {1, 1, 0}}};

Graph[{1 -> 2, 2 -> 3, 3 -> 1}, 
  VertexShape -> (# -> ArrayPlot[{#2}, PlotRangePadding -> 0] & @@@ r),
    VertexSize -> {0.3, 0.1}]

enter image description here

$\endgroup$
  • $\begingroup$ It would be nice to have the edge arrows touch the boxes, but I could not come up with a reasonable method... I hope you don't mind my edit! $\endgroup$ – István Zachar Oct 15 '13 at 7:25
  • $\begingroup$ @IstvánZachar The method turn out to be very simple. Thanks for nice editing! $\endgroup$ – ybeltukov Oct 15 '13 at 9:40
  • $\begingroup$ Ha, that is indeed simple! (I was fiddling with the offset of Arrow) $\endgroup$ – István Zachar Oct 15 '13 at 9:50
5
$\begingroup$

I thought you may adopt this neat Demonstration by Stephen Wolfram. You can download the source code notebook right there where the link points, but the code is so small I gave it here too. Note the cool trick - when graph becomes too large, vertices become dots - may come handy.

Cellular Automaton State Transition Diagrams

enter image description here

Manipulate[
 If[icon, Labeled[#, 
     Grid[{Column[
          Map[ArrayPlot[{#}, Mesh -> True, Frame -> False, 
             ImageSize -> 8 Length[#]] &, #], Center, 
          Spacings -> .025] & /@ 
        Thread[{Tuples[{1, 0}, 3], List /@ IntegerDigits[rn, 2, 8]}]},
       Frame -> All, FrameStyle -> GrayLevel[1/GoldenRatio]]], #] &[
  GraphPlot[# -> CellularAutomaton[rn, #] & /@ Tuples[{1, 0}, w], 
   ImageSize -> {500, 375}, 
   VertexRenderingFunction -> (With[{p = {Darker[Blue, .7], 
          Point[#]}}, 
       If[! label, p, 
        If[w < 7, 
         Inset[ArrayPlot[{#2}, Mesh -> True, Frame -> False, 
           ImageSize -> 7 { Length[#2], 1}], #], 
         Tooltip[p, 
          Dynamic[ArrayPlot[{#2}, Mesh -> True, Frame -> False, 
            ImageSize -> 7 { Length[#2], 1}]]]]]] &), 
   DirectedEdges -> True]], {{rn, 110, "rule number"}, 0, 255, 1, 
  Appearance -> "Labeled"},
 {{w, 5, "width"}, 3, 12, 1, Appearance -> "Labeled"}, Delimiter,
 {{label, If[w < 7, True, False], "show states"}, {True, False}},
 {{icon, False, "show rule icon"}, {True, False}}, 
 AutorunSequencing -> {{1, 20}, {3, 5}}, SaveDefinitions -> True]
$\endgroup$
2
$\begingroup$

You can use ArrayPlot as vertices.

Graph[{ArrayPlot[{{0, 0, 1}}] -> ArrayPlot[{{0, 1, 0}}], 
  ArrayPlot[{{0, 1, 0}}] -> ArrayPlot[{{1, 1, 0}}], 
  ArrayPlot[{{1, 1, 0}}] -> ArrayPlot[{{0, 0, 1}}]}]

or replace vertices:

r = {{1, {0, 0, 1}}, {2, {0, 1, 0}}, {3, {1, 1, 0}}};
g = VertexReplace[Graph[{1 -> 2, 2 -> 3, 3 -> 1}], Rule[#, ArrayPlot[{#2}]] & @@@ r]
$\endgroup$
  • $\begingroup$ Your first code fits me well too, but unfortunately it does not work (( $\endgroup$ – Филипп Цветков Oct 15 '13 at 8:14
  • $\begingroup$ @Филипп Цветков what do you mean by it does not work? If you mean by the output, you could do this: Graph[{ArrayPlot[{{0, 0, 1}}] -> ArrayPlot[{{0, 1, 0}}], ArrayPlot[{{0, 1, 0}}] -> ArrayPlot[{{1, 1, 0}}], ArrayPlot[{{1, 1, 0}}] -> ArrayPlot[{{0, 0, 1}}]}, VertexShapeFunction -> "Name", VertexSize -> Medium] $\endgroup$ – halmir Oct 15 '13 at 12:07

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.