1
$\begingroup$

This is a follow up to my previous question posted here

The following is an excerpt of the solution provided here to set the edge length of a graph equal to the edge weights

edges = {1 <-> 2, 1 <-> 3, 1 <-> 4, 2 <-> 5, 2 <-> 6, 5 <-> 6, 
   3 <-> 4, 3 <-> 7, 6 <-> 7, 7 <-> 8, 2 <-> 9};

vd = {{75., 25., 0}, {115., 45., 0}, {10., 5., 0}, {45., 0, 0}, 
  {90., 60., 0}, {45., 55., 0}, {0, 25., 0}, {10., 50., 0}, {115.,  25.,0}};

vl = Range[Length@vd];

vcoords = MapIndexed[#2[[1]] -> # &, vd];
ew = {1 \[UndirectedEdge] 2 -> 49.6, 1 \[UndirectedEdge] 3 -> 74.4, 
 1 \[UndirectedEdge] 4 -> 49.6, 2 \[UndirectedEdge] 5 -> 37.2, 
 2 \[UndirectedEdge] 6 -> 74.4, 5 \[UndirectedEdge] 6 -> 49.6, 
 3 \[UndirectedEdge] 4 -> 37.2, 3 \[UndirectedEdge] 7 -> 24.8, 
 6 \[UndirectedEdge] 7 -> 62, 7 \[UndirectedEdge] 8 -> 37.2, 
 2 \[UndirectedEdge] 9 -> 24.8}

g3d = Graph3D[vl, edges, VertexCoordinates -> vcoords, 
  EdgeWeight -> ew, VertexLabels -> Placed["Name", Center], 
  EdgeLabels -> {e_ :> Placed["EdgeWeight", Center]}, 
  VertexSize -> .3, VertexStyle -> Red]
vars3d = Array[Through[{x, y, z}@#] &, Length @ vd];

λ = 1/100.;

obj3d = Total[(Norm[vars3d[[First@#]] - vars3d[[Last@#]]] - # /. ew)^2 & /@ 
  EdgeList[g3d]] +  λ Total[Norm /@ (vars3d - vd)];

lbnd = 0;
ubnd = 500;

solution3d = Last@Minimize[{obj3d, And @@ Thread[lbnd <= Join @@ vars3d <= ubnd]}, 
    Join @@ vars3d];

edgeLengths3d = # -> Norm[vars3d[[First@#]] - vars3d[[Last@#]]] /. 
     solution3d & /@ EdgeList[g3d];

Grid[Prepend[{#, # /. ew, # /. edgeLengths3d} & /@ 
   EdgeList[g3d], {"edge", "EdgeWeight", "Edge Length"}], 
 Dividers -> All]

I would like to know how to modify the above when the nodes of the graph aren't numbered consecutively.

I tried the following,

edges = {1 <-> 2, 1 <-> 3, 1 <-> 4, 2 <-> 11, 2 <-> 6, 11 <-> 6, 
   3 <-> 4, 3 <-> 7, 6 <-> 7, 7 <-> 8, 2 <-> 10};
vd = {{75., 25., 0}, {115., 45., 0}, {10., 5., 0}, {45., 0, 0}, {90., 
    60., 0}, {45., 55., 0}, {0, 25., 0}, {10., 50., 0}, {115., 25., 
    0}};

vl = {1, 2, 3, 4, 11, 6, 7, 8, 10};

vcoords = Thread[vl -> vd];

ew = {1 \[UndirectedEdge] 2 -> 49.6`, 1 \[UndirectedEdge] 3 -> 74.4`, 
  1 \[UndirectedEdge] 4 -> 49.6`, 2 \[UndirectedEdge] 11 -> 37.2`, 
  2 \[UndirectedEdge] 6 -> 74.4`, 11 \[UndirectedEdge] 6 -> 49.6`, 
  3 \[UndirectedEdge] 4 -> 37.2`, 3 \[UndirectedEdge] 7 -> 24.8`, 
  6 \[UndirectedEdge] 7 -> 62, 7 \[UndirectedEdge] 8 -> 37.2`, 
  2 \[UndirectedEdge] 10 -> 24.8`};

g3d = Graph3D[vl, edges, VertexCoordinates -> vcoords, 
  EdgeWeight -> ew, VertexLabels -> Placed["Name", Center], 
  EdgeLabels -> {e_ :> Placed["EdgeWeight", Center]}, 
  VertexSize -> .3, VertexStyle -> Red]

vars3d = Array[Through@{x, y, z}@vl[[#]] &, Length@vl];

λ = 1/100.;

obj3d = Total[(Norm[vars3d[[First@#]] - vars3d[[Last@#]]] - # /. 
         ew)^2 & /@ EdgeList[g3d]] + \[Lambda] Total[
     Norm /@ (vars3d - vd)];

I couldn't execute obj3d successfully, the following is displayed

Part::partw: Part 11 of {{x[1],y[1],z[1]},{x[2],y[2],z[2]},{x[3],y[3],z[3]},{x[4],y[4],z[4]},{x[11],y[11],z[11]},{x[6],y[6],z[6]},{x[7],y[7],z[7]},{x[8],y[8],z[8]},{x[10],y[10],z[10]}} does not exist.

Suggestions on how to modify the expression for obj3d and the lines below it to successfully use the solution provided in the previous post for the new input will be highly appreciated.

Notebook

EDIT: The suggestion provided below resolved the error reported above. Next, I did the same modification for line

edgeLengths3d = # -> 
Norm[[Through@{x, y, z}@First[#] -  Through@{x, y, z}@Last[#]]] /. solution3d & /@ EdgeList[g3d];

and the following error occurs

Part::pkspec1: The expression {x[1]-x[2],y[1]-y[2],z[1]-z[2]} cannot be used as a part specification.

Could you please suggest how this line has to be modified?

$\endgroup$
1
$\begingroup$

Change the definition of obj3d to

obj3dB = Total[(Norm[Through @ {x, y, z} @ First[#] - 
           Through@{x, y, z} @ Last[#]] - # /. ew)^2 & /@ EdgeList[g3d]] + 
    λ Total[Norm /@ (vars3d - vd)]
| improve this answer | |
$\endgroup$
  • $\begingroup$ Thank you, this helped. I tried to make the same change edgeLengths3d = # -> Norm[[Through@{x, y, z}@First[#] - Through@{x, y, z}@Last[#]]] /. solution3d & /@ EdgeList[g3d]; and the following error occurs Part::pkspec1: The expression {x[1]-x[2],y[1]-y[2],z[1]-z[2]} cannot be used as a part specification. Could you please suggest how this line has to be modified? $\endgroup$ – Natasha Jul 14 at 9:03
  • 1
    $\begingroup$ @Natasha, change Norm[[Through...]] to Norm[Through...] $\endgroup$ – kglr Jul 14 at 17:45
  • $\begingroup$ Ahh, thanks. That was my mistake. $\endgroup$ – Natasha Jul 15 at 2:36
  • $\begingroup$ Could you please explain a bit on how to decide on the values of upper bound and lower bound? For one problem, it worked when lbnd = 0 and ubnd = 500; for another it worked when lbnd = 0 and ubnd = 3500. I'm not sure on what basis this range can be set $\endgroup$ – Natasha Jul 17 at 6:08

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.