Arraste dinamicamente os vértices do gráfico

Question

É possível fazer um gráfico dinâmico com capacidade de arrastar vértices?

Em outras palavras, deixe os vértices se comportarem como se Locatoraltere suas VertexCoordinatesanotações e mantenha VertexShapeFunctione EdgeShapeFunctionrenderize.

Answer 1

SeedRandom[1]
rg = RandomGraph[{5, 8}]

rg1 = Graph[rg, 
  VertexShapeFunction -> (GraphElementData["Star"][#, #2, {1, 1} /15] &), 
  EdgeShapeFunction -> "CurvedArc", 
  ImageSize -> Large, 
  PlotRangePadding -> Scaled[.2], 
  PlotRange -> CoordinateBounds[GraphEmbedding[rg]]]

DynamicModule[{pts = GraphEmbedding[rg1]}, 
 LocatorPane[Dynamic[pts], 
  Dynamic[Graph[rg1, VertexCoordinates -> pts]], 
  Appearance -> None]]

Answer 2

Aqui está algo para apenas atualizar VertexCoordinates/ manter todos os Graphestilos. Parece que kglr respondeu enquanto eu escrevia isso, mas é importante notar que isso permite que você também use Graphicsopções para definir um PlotRangee semelhantes

interactiveGraph // ClearAll
Options[interactiveGraph] =
  DeleteDuplicatesBy[First]@
   Join[
    Options[LocatorPane],
    Options[Graphics]
    ];
Format[
  interactiveGraph[g : Dynamic[data_, ops___], 
   locopts : OptionsPattern[]], StandardForm] :=
 DynamicModule[
  {
   coords,
   updateFuncs,
   pr
   },
  coords = (VertexCoordinates /. AbsoluteOptions[data, VertexCoordinates]);
  pr = Replace[
    OptionValue[Graphics, FilterRules[{locopts}, Options[Graphics]], PlotRange],
    {
     All | Automatic -> Dynamic[{{-.1, -.1}, {.1, .1}} + CoordinateBoundingBox[coords]],
     {ymin_?NumericQ, ymax_?NumericQ} :>
      Transpose[{CoordinateBounds[coords][[1]], {ymin, ymax}}],
     {x_List, y_List} :> Transpose[{x, y}]
     }
    ];
  LocatorPane[
   Dynamic[
    coords, 
    Function[
     Set[coords, #];
     Set[data, Graph[data, VertexCoordinates -> coords]]
     ]
    ],
   Graphics[
    Dynamic@First[Show@data],
    Sequence @@ FilterRules[{locopts}, Options[Graphics]]
    ],
   pr,
   Sequence @@ FilterRules[{locopts, Appearance -> None}, Options[LocatorPane]]
   ]
  ]