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

1 Answer 1

2
$\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)]
$\endgroup$
4
  • $\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, 2020 at 9:03
  • 2
    $\begingroup$ @Natasha, change Norm[[Through...]] to Norm[Through...] $\endgroup$
    – kglr
    Jul 14, 2020 at 17:45
  • $\begingroup$ Ahh, thanks. That was my mistake. $\endgroup$
    – Natasha
    Jul 15, 2020 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, 2020 at 6:08

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.