wolfram-mathematica - vectores - graficas 3d mathematica

¿Cómo dibujar el diagrama de estado clásico usando Mathematica?

Question

¿Es posible y práctico para Mathematica dibujar algo como esto (creado por Graphviz):

Esto es lo mejor que puedo obtener (pero la forma y el estilo no son satisfactorios):

Código:

GraphPlot[{{A -> C, "go"}, {C -> B, "gone"}, {C -> D, 
   "went"}, {C -> C, "loop"}}, VertexLabeling -> True, 
 DirectedEdges -> True]

Answer 1

No hay necesidad de una ubicación interactiva para obtener sus vértices en la ubicación deseada como sugiere mr.Wizard en su respuesta . Puedes usar VertexCoordinateRules para eso:

GraphPlot[{{A -> C, "go"}, {C -> B, "gone"}, {C -> D, "went"}, {C -> C, "loop"}}, 
    DirectedEdges -> True, 
    VertexRenderingFunction -> 
          ({{White, Disk[#, 0.15]}, AbsoluteThickness[2], Circle[#, 0.15], 
           If[MatchQ[#2, A | B], Circle[#, 0.12], {}], Text[#2, #]} &),
    VertexCoordinateRules -> 
          {A -> {0, 0}, C -> {0.75, 0},B -> {1.5, 0.25}, D -> {1.5, -0.25}}
]

Answer 2

Puedes hacer algo como esto usando VertexRenderingFunction .

GraphPlot[{{A -> C, "go"}, {C -> B, "gone"}, {C -> D, "went"}, {C -> C, "loop"}}, 
 DirectedEdges -> True, 
 VertexRenderingFunction -> ({{White, Disk[#, 0.15]}, 
     AbsoluteThickness[2], Circle[#, 0.15], 
     If[MatchQ[#2, A | B], Circle[#, 0.12], {}], Text[#2, #]} &)]

Método actualizado febrero 2015

Para preservar la capacidad de reorganizar interactivamente el gráfico con las herramientas de dibujo (doble clic), debe mantener los gráficos de vértice dentro de GraphicsComplex , con índices en lugar de coordenadas. Creo que se podría hacer esto desde VertexRenderingFunction utilizando una variable incremental, pero parece más fácil y posiblemente más robusto que hacerlo con el posprocesamiento. Esto funciona en las versiones 7 y 10 de Mathematica , probablemente 8 y 9 también:

GraphPlot[
  {{A -> C, "go"}, {C -> B, "gone"}, {C -> D, "went"}, {C -> C, "loop"}},
  DirectedEdges -> True
] /.
 Tooltip[Point[n_Integer], label_] :>
   {{White, Disk[n, 0.15]},
    Black, AbsoluteThickness[2], Circle[n, 0.15], 
    If[MatchQ[label, A | B], Circle[n, 0.12], {}], Text[label, n]}