7
$\begingroup$

I'm ultimately trying to create a directed graph with some of the nodes in fixed positions and the other nodes placed around them in "acceptable" positions.

It's better if I ask the question by showing an example of the code. E.g. I have this graph: 

node = {11, 12, 13, 14, 15, 16};
edges = {11 -> 14, 11 -> 16, 12 -> 16, 12 -> 15, 13 -> 15, 13 -> 16, 
 14 -> 16, 14 -> 15, 15 -> 16, 15 -> 13, 16 -> 15, 16 -> 14};
vertexposition = {{6.51493919050084`, 44.04756585632944`}, 
                  {75.59445680043342`, 50.47455242214042`}, 
                  {87.32825501506514`, 13.395648943951699`},
                  {28.795707353492418`, 3.420138063734413`}, 
                  {60.729164933330765`, 16.915777496473908`}, 
                  {51.85158892659126`, 25.803692768150313`}};

Show[
     Graph[node, edges, VertexCoordinates -> vertexposition, Frame -> True, 
                        VertexSize -> {"Scaled", .02}, VertexLabels -> "Name"]
     , FrameTicks -> True, ImageSize -> 600]

I have these fixed critical nodes with positions that are important to me, however I have many other nodes that I want to add to the graph and connect to these nodes without having to specifically add their coordinates.

For example, I want to remove the connection between node $11$ and node $14$ but add three arbitrary nodes that link in series to connect nodes $11$ and $14$ without having to define their position, and have mathematica put an "appropriate" default position for them. That is, I don't want to add the nodes and have them all bunch up at the origin; the graph should look more organic.

Here's the kicker, I want to add edgeweights to all the nodes and don't necessarily want them to space out according to the edgeweights.

Improve this question
$\endgroup$
4
  • $\begingroup$ What do you mean by "acceptable positions" if you do not want specify them? Also, It is going to be PathGraph at the end or adding 3 posistions will create 11->x1->14, 11->x2->14, 11->x3->14 instead of 11->x1->x2->x3->14? $\endgroup$
    – Kuba
    Commented Aug 26, 2013 at 9:35
  • $\begingroup$ Next question, :) new nodes are going to replace existing connection or just create new? $\endgroup$
    – Kuba
    Commented Aug 26, 2013 at 10:10
  • $\begingroup$ Yes, yes, acceptable positions is too subjective, I should have elaborated. I meant that it would create a node that would be organically placed in between the two critical nodes and not at a random place on the plane. However this is taken care of by the last post (where the user can drag around the newly created node!). And yes, the new nodes are going to create a new connection. $\endgroup$
    – E3labs
    Commented Aug 26, 2013 at 20:44
  • $\begingroup$ I have made an edit in response to your answer. $\endgroup$
    – Kuba
    Commented Aug 26, 2013 at 23:36

2 Answers 2

Reset to default
3
$\begingroup$

The following code is made after OP's response. It fullfils what I think it should. Except that there is no way to manually delete notes, I wanted to do this neatly but I've run out of time. :)

Previous code can be found in edit history.

There is a Checkbox which will enable Locators (for additional node). It seems it can not be done easier without EventHandler and PassEventsUp/Down.

Description:

  • Click -> select a node
  • Click again -> unselect
  • Click no other node -> create new node between
  • New node can be dragged since it is a locator. (after switching checkbox)

new:

  • If you create new node, the order matters, so if you click on 11 and then 12, then the connection 11->12 will be replaced but 12->11 will not, it will create new loop.
DynamicModule[{acc, new, newEdg, newNodes, newPos, newInd},

  Grid[{{
        LocatorPane[Dynamic@newPos,

        Dynamic[
         Graph[
            Map[f, node~Join~newNodes],
            edges,
            VertexCoordinates -> (vertexposition~Join~newPos), VertexLabels -> "Name",
            VertexSize -> {Sequence @@ Thread[node -> Table[{"Scaled", .05}, {6}]],
                           {"Scaled", .02}}, 
            ImageSize -> 600, EdgeShapeFunction -> {Arrow[#, 2] &}, 
            VertexLabelStyle -> {Bold, 20}, AspectRatio -> Automatic, 
            Frame -> True, FrameTicks -> All, PlotRange -> {{0, 100}, {0, 60}}]
        ], Appearance -> None]
      ,
       Column[{
               Checkbox[Dynamic@loc],
               If[loc, "Locators on", "Locators off"]
             }]
       }}] 
 ,
Initialization :> (
    new = {}; acc = {}; newNodes = {}; newPos = {};  loc = False;
    f := If[loc, #,
            Style[Button[#,
      Which[
      acc == {#}, acc = {}
      ,
      Length@acc == 1, AppendTo[acc, #];
      AppendTo[newPos, 
      Mean[Pick[(vertexposition~Join~newPos), (node~Join~newNodes), #][[1]] & /@ acc]];
      newInd = Last[node~Join~newNodes] + 1; 
      AppendTo[newNodes, newInd];
      edges = DeleteCases[edges, Rule @@ acc]; 
      AppendTo[edges, #] & /@ {First@acc -> newInd, newInd -> Last@acc};
      acc = {};
      ,
      True, acc = {#}]
      ], If[MemberQ[acc, #], Red, Blue]]] &;

  node = {11, 12, 13, 14, 15, 16};
  edges = {11 -> 14, 11 -> 16, 12 -> 16, 12 -> 15, 13 -> 15, 
           13 -> 16, 14 -> 16, 14 -> 15, 15 -> 16, 15 -> 13, 16 -> 15, 
           16 -> 14};
 vertexposition = {{6.51, 44.04}, {75.59, 50.47}, {87.32, 13.39}, {28.79, 3.42}, 
                   {60.72, 16.91}, {51.85, 25.80}};)]

enter image description here

Improve this answer
$\endgroup$
4
  • $\begingroup$ This is great! This approach allows me to make new nodes and choose how "organic" I want the graph to look by dragging the newly created node. It would be critical if I could add a new node just as you have the program and THEN add another node that connects to a user created node. That is, just how it is but with the ability to also select created nodes just like the critical nodes (I hope this isn't too much of a stretch to do). $\endgroup$
    – E3labs
    Commented Aug 26, 2013 at 20:51
  • $\begingroup$ @e3labs I'm glad you like it, I will try to make it more handy and better suited to your needs (I can't promice how fast it will happen :)) $\endgroup$
    – Kuba
    Commented Aug 26, 2013 at 20:52
  • 1
    $\begingroup$ Thanks Kuba. And thanks RodLm. Neither of you have any idea how appreciative I am for your help. And for this community in general. I'm still learning the basics of mathematica and got pulled into this project where results are expected! If it wasn't for your help I would have to make all the nodes manually. I increase my mathematica knowledge and save lots of time! My family thanks you both too! $\endgroup$
    – E3labs
    Commented Aug 26, 2013 at 21:02
  • $\begingroup$ @e3labs I'm glad it helps :) The author of the post is notified whan you put the comment below but if you want to notify someone use "@nickname" (just remark for future) $\endgroup$
    – Kuba
    Commented Aug 26, 2013 at 21:26
5
$\begingroup$

I'm not sure if this is exactly what you want, but at least this is a starting point:

Manipulate[node = {11, 12, 13, 14, 15, 16};
 edges = {11 -> 14, 11 -> 16, 12 -> 16, 12 -> 15, 13 -> 15, 13 -> 16, 
   14 -> 16, 14 -> 15, 15 -> 16, 15 -> 13, 16 -> 15, 16 -> 14};
 vertex = {{6.51493919050084`, 
    44.04756585632944`}, {75.59445680043342`, 
    50.47455242214042`}, {87.32825501506514`, 
    13.395648943951699`}, {28.795707353492418`, 
    3.420138063734413`}, {60.729164933330765`, 
    16.915777496473908`}, {51.85158892659126`, 25.803692768150313`}}; 
 Dynamic@Show[
   Graph[node, Flatten@edges, VertexCoordinates -> vertex, 
    Frame -> True, VertexSize -> {"Scaled", .02}, 
    VertexLabels -> "Name"], FrameTicks -> True, ImageSize -> 400],
 {{x, 11, "Choose Node 1"}, node, 
  ControlType -> PopupMenu}, {{y, 14, "Choose Node 2"}, node, 
  ControlType -> PopupMenu},
 Button["New Random Node", {AppendTo[vertex, 
    RandomReal[{Min[vertex], Max[vertex]}, 2]], 
   AppendTo[node, Max[node] + 1], 
   AppendTo[edges, {Last@node -> x, Last@node -> y}]}]]

Result:

enter image description here

Please tell me if you need any improvement in the answer.

EDITED

Thanks to Kuba's comments, you might also include a Initialization in the Manipulate:

Manipulate[node := {11, 12, 13, 14, 15, 16};
 edges := {11 -> 14, 11 -> 16, 12 -> 16, 12 -> 15, 13 -> 15, 13 -> 16,
    14 -> 16, 14 -> 15, 15 -> 16, 15 -> 13, 16 -> 15, 16 -> 14};
 vertex := {{6.51493919050084`, 
    44.04756585632944`}, {75.59445680043342`, 
    50.47455242214042`}, {87.32825501506514`, 
    13.395648943951699`}, {28.795707353492418`, 
    3.420138063734413`}, {60.729164933330765`, 
    16.915777496473908`}, {51.85158892659126`, 25.803692768150313`}};
 Dynamic@Show[
   Graph[node, Flatten@edges, VertexCoordinates -> vertex, 
    Frame -> True, VertexSize -> {"Scaled", .02}, 
    VertexLabels -> "Name"], FrameTicks -> True, 
   ImageSize -> 400], {{x, 11, "Choose Node 1"}, node, 
  ControlType -> PopupMenu}, {{y, 14, "Choose Node 2"}, node, 
  ControlType -> PopupMenu}, 
 Button["New Random Node", {AppendTo[vertex, 
    RandomReal[{Min[vertex], Max[vertex]}, 2]], 
   AppendTo[node, Max[node] + 1], 
   AppendTo[edges, {Last@node -> x, Last@node -> y}]}], 
 Initialization :> {node = {11, 12, 13, 14, 15, 16};
   edges = {11 -> 14, 11 -> 16, 12 -> 16, 12 -> 15, 13 -> 15, 
     13 -> 16, 14 -> 16, 14 -> 15, 15 -> 16, 15 -> 13, 16 -> 15, 
     16 -> 14};
   vertex = {{6.51493919050084`, 
      44.04756585632944`}, {75.59445680043342`, 
      50.47455242214042`}, {87.32825501506514`, 
      13.395648943951699`}, {28.795707353492418`, 
      3.420138063734413`}, {60.729164933330765`, 
      16.915777496473908`}, {51.85158892659126`, 
      25.803692768150313`}}}]

Another option would be to included a "reset" Button:

Manipulate[node := {11, 12, 13, 14, 15, 16};
 edges := {11 -> 14, 11 -> 16, 12 -> 16, 12 -> 15, 13 -> 15, 13 -> 16,
    14 -> 16, 14 -> 15, 15 -> 16, 15 -> 13, 16 -> 15, 16 -> 14};
 vertex := {{6.51493919050084`, 
    44.04756585632944`}, {75.59445680043342`, 
    50.47455242214042`}, {87.32825501506514`, 
    13.395648943951699`}, {28.795707353492418`, 
    3.420138063734413`}, {60.729164933330765`, 
    16.915777496473908`}, {51.85158892659126`, 25.803692768150313`}};
 Dynamic@Show[
   Graph[node, Flatten@edges, VertexCoordinates -> vertex, 
    Frame -> True, VertexSize -> {"Scaled", .02}, 
    VertexLabels -> "Name"], FrameTicks -> True, 
   ImageSize -> 400], {{x, 11, "Choose Node 1"}, node, 
  ControlType -> PopupMenu}, {{y, 14, "Choose Node 2"}, node, 
  ControlType -> PopupMenu}, 
 Button["New Random Node", {AppendTo[vertex, 
    RandomReal[{Min[vertex], Max[vertex]}, 2]], 
   AppendTo[node, Max[node] + 1], 
   AppendTo[edges, {Last@node -> x, Last@node -> y}]}], 
 Button["Set initial values", {node = {11, 12, 13, 14, 15, 16};
   edges = {11 -> 14, 11 -> 16, 12 -> 16, 12 -> 15, 13 -> 15, 
     13 -> 16, 14 -> 16, 14 -> 15, 15 -> 16, 15 -> 13, 16 -> 15, 
     16 -> 14};
   vertex = {{6.51493919050084`, 
      44.04756585632944`}, {75.59445680043342`, 
      50.47455242214042`}, {87.32825501506514`, 
      13.395648943951699`}, {28.795707353492418`, 
      3.420138063734413`}, {60.729164933330765`, 
      16.915777496473908`}, {51.85158892659126`, 
      25.803692768150313`}}}]]

enter image description here

Improve this answer
$\endgroup$
7
  • $\begingroup$ @Kuba I have included only the "critical" nodes in the PopupMenu. I don't believe the OP wants all new nodes to be included in it... $\endgroup$
    – Rod
    Commented Aug 26, 2013 at 8:03
  • $\begingroup$ I think if OP wants to add 3 nodes between 11 and 14 he want to do 11->x1->x2->x3->14 rather than 11->x1->14, 11->x2->14 etc. But indeed, it is not stated clearly. $\endgroup$
    – Kuba
    Commented Aug 26, 2013 at 8:06
  • $\begingroup$ @Kuba In order to include 3 new nodes it is necessary to click the Button 3 times. BTW, I do agree that it's not clearly stated... $\endgroup$
    – Rod
    Commented Aug 26, 2013 at 8:09
  • $\begingroup$ If I delete the output and quit the kernel it does not initialize well, I think you have to put this data to Initizliation and add Dynamic to nodes in PopupMenus $\endgroup$
    – Kuba
    Commented Aug 26, 2013 at 8:12
  • $\begingroup$ @Kuba Thanks for the comments... It's also possible to put a "reset" Button inside the Manipulate... It's a matter of preference. $\endgroup$
    – Rod
    Commented Aug 26, 2013 at 8:24

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.