2
$\begingroup$

This is a follow up to my previous question posted here

The code below is from the answer provided here

Clear[solution3d];
solution3d[uedges_, edgeweight_] := 
 Module[{ew, graph, dmat, newcoords, vcoords3, newLayout, vars, 
   weights, objective, min, vals, newercoords, xyz, 
   DistanceMatrixDimensionReduce}, 
  ew = KeyMap[UndirectedEdge @@ # &, edgeweight];
  graph = 
   Graph3D[Keys[ew], EdgeWeight -> Normal[ew], 
    VertexLabels -> Placed["Name", Center], 
    EdgeLabels -> {e_ :> Placed["EdgeWeight", Center]}, 
    VertexSize -> .3, VertexStyle -> Red];
  dmat = GraphDistanceMatrix[graph];
  DistanceMatrixDimensionReduce[(dmat_)?MatrixQ, dim_ : 3] := 
   With[{len = Length[dmat]}, 
    Module[{diffs, dist2mat, onevec, hmat, bmat, uu, ww, vv}, 
      onevec = ConstantArray[{1}, len];
      hmat = IdentityMatrix[len] - onevec.Transpose[onevec]/len;
      dist2mat = -dmat/2;
      bmat = hmat.dist2mat.hmat; {uu, ww, vv} = 
       SingularValueDecomposition[bmat, dim]; uu.Sqrt[ww]] /; 
     dim <= Length[dmat[[1]]] && MatchQ[Flatten[dmat], {_Real ..}]];
  newcoords = DistanceMatrixDimensionReduce[dmat];
  newLayout = 
   Graph[Keys[ew], VertexCoordinates -> newcoords, EdgeWeight -> ew, 
    VertexLabels -> Placed["Name", Center], 
    EdgeLabels -> {e_ :> Placed["EdgeWeight", Center]}, 
    VertexSize -> .3, VertexStyle -> Red];
  vars = Array[xyz, {VertexCount[graph], 3}];
  weights = Normal[WeightedAdjacencyMatrix[graph]];
  objective = 
   Sum[If[weights[[i, j]] > 
      0, ((vars[[i]] - vars[[j]]).(vars[[i]] - vars[[j]]) - 
        weights[[i, j]]^2)^2, 0], {i, Length[weights] - 1}, {j, i + 1,
      Length[weights]}];
  {min, vals} = 
   Quiet@FindMinimum[objective, 
     Flatten[MapThread[List, {vars, newcoords}, 2], 1]];
  newercoords = vars /. vals;
  vcoords3 = MapIndexed[#2[[1]] -> # &, newercoords];
  newLayout = 
   Graph3D[Keys[ew], VertexCoordinates -> vcoords3, EdgeWeight -> ew, 
    VertexLabels -> Placed["Name", Center], 
    EdgeLabels -> {e_ :> Placed["EdgeWeight", Center]}, 
    VertexSize -> .3, VertexStyle -> Red];
  Return[<|"newcoords" -> newcoords, "error" -> min|>]]

For the edges and ew specified below the code works well for repositioning the nodes of the network to meet the distance requirements provided as edge weights.To create a layout that meets the distance requirements, an inital layout, which created using multidimensional scaling, is used for optimization via FindMinimum.

edges = {{1, 2}, {1, 3}, {1, 4}, {2, 5}, {2, 6}, {5, 6}, {3, 4}, {3, 
     7}, {6, 7}, {7, 8}, {2, 9}};
 ew = <|{1, 2} -> 49.6, {1, 3} -> 74.4, {1, 4} -> 49.6, {2, 5} -> 
     37.2, {2, 6} -> 74.4, {5, 6} -> 49.6, {3, 4} -> 37.2, {3, 7} -> 
     24.8, {6, 7} -> 62, {7, 8} -> 37.2, {2, 9} -> 24.8|>;
result = solution3d[edges, ew]
Print[result];

But the error for the following input (added externally due to the limitation in characters that can be added here) is really large. I'd like to know if there are other methods to create better initial layouts that can be supplied to FindMinimum.

Error returned from the code for the below edges and ew is error->4.53978*10^11.

edges, ew (also shared here)

$\endgroup$
2
  • $\begingroup$ Couldn't you just make the edges in the Graph3D thinner tubes? $\endgroup$
    – flinty
    Dec 28, 2020 at 21:19
  • $\begingroup$ @flinty I'm sorry, I started the bounty in the wrong post by mistake. I have updated the right question here. The question for which you have commented is here. Thank you $\endgroup$
    – Natasha
    Dec 29, 2020 at 3:17

0

Your Answer

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