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$
0

4 Answers 4

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$
3
  • $\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$ Oct 15, 2013 at 7:25
  • $\begingroup$ @IstvánZachar The method turn out to be very simple. Thanks for nice editing! $\endgroup$
    – ybeltukov
    Oct 15, 2013 at 9:40
  • $\begingroup$ Ha, that is indeed simple! (I was fiddling with the offset of Arrow) $\endgroup$ Oct 15, 2013 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$
2
  • $\begingroup$ Your first code fits me well too, but unfortunately it does not work (( $\endgroup$ Oct 15, 2013 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, 2013 at 12:07

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.