Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2009

[Date Index] [Thread Index] [Author Index]

Search the Archive

tensegrity and FindRoot for quadratic systems

  • To: mathgroup at smc.vnet.net
  • Subject: [mg100249] tensegrity and FindRoot for quadratic systems
  • From: alessio <alessio at kth.se>
  • Date: Fri, 29 May 2009 20:58:00 -0400 (EDT)

I have implemented the following code for simulating a 3x3 lattice of vertices, connected by 16 rigid bars to form 8 triangles, fixed at two points, and under the action of the gravity (the configuration can be seen in the animation that the code creates at the end). My problem is that for this particular geometry, FindRoot is not able to find a solution within the prescribed tolerance. Does this mean that I am in a local minimum? What can I do to avoid this situation?



len[p1_, p2_] := 
 
 (p2[[1]] - p1[[1]])*(p2[[1]] - p1[[1]]) +
  (p2[[2]] - p1[[2]])*(p2[[2]] - p1[[2]]) +
  (p2[[3]] - p1[[3]])*(p2[[3]] - p1[[3]])

strain[q_] := {
  
  len[q[[1]], q[[2]]] - 25,
  len[q[[2]], q[[4]]] - 25,
  len[q[[3]], q[[4]]] - 25,
  len[q[[1]], q[[3]]] - 25,
  len[q[[1]], q[[4]]] - 50,
  len[q[[2]], q[[5]]] - 25,
  len[q[[5]], q[[6]]] - 25,
  len[q[[4]], q[[6]]] - 25,
  len[q[[2]], q[[6]]] - 50,
  len[q[[6]], q[[7]]] - 25,
  len[q[[4]], q[[7]]] - 50,
  len[q[[7]], q[[8]]] - 25,
  len[q[[4]], q[[8]]] - 25,
  len[q[[3]], q[[8]]] - 50,
  len[q[[3]], q[[9]]] - 25,
  len[q[[8]], q[[9]]] - 25,
  q[[1, 1]] - 0,
  q[[1, 2]] - 0,
  q[[1, 3]] - 0,
  q[[9, 1]] - 0,
  q[[9, 2]] - 10,
  q[[9, 3]] - 0
  }

undeformed = {{0, 0, 0}, {5, 0, 0}, {0, 5, 0}, {5, 5, 0}, {10, 0, 
    0}, {10, 5, 0}, {10, 10, 0}, {5, 10, 0}, {0, 10, 0}};

force = {
   {0, 0, 98},
   {0, 0, 98},
   {0, 0, 98},
   {0, 0, 98},
   {0, 0, 98},
   {0, 0, 98},
   {0, 0, 98},
   {0, 0, 98},
   {0, 0, 98}
   };

EL[u_, p_, q_, \[Lambda]_] := Flatten[{
   
   {(q - p)/dt - (p - u)/dt} - \[Lambda] .D[
      strain[q], {q}] - {force},
   {strain[q]}
   }]

deformed = {
   {x1, y1, z1}, {x2, y2, z2}, {x3, y3, z3},
   {x4, y4, z4}, {x5, y5, z5}, {x6, y6, z6},
   {x7, y7, z7}, {x8, y8, z8}, {x9, y9, z9}
   };
dt = 1/1000;

multipliers = {
   {l1, l2, l3, l4, l5, l6, l7, l8, l9, l10, l11, l12, l13, l14, l15, 
    l16, l17, l18, l19, l20, l21, l22}
   };

hess[u_, p_, sym_, lag_] := D[
  EL[u, p, sym, lag],
  {Flatten[{sym, lag}]}
  ]

hess[undeformed, undeformed, deformed, multipliers];

step[u_, p_] := FindRoot[
  
  EL[u, p , {
    {x1, y1, z1}, {x2, y2, z2}, {x3, y3, z3},
    {x4, y4, z4}, {x5, y5, z5}, {x6, y6, z6},
    {x7, y7, z7}, {x8, y8, z8}, {x9, y9, z9}
    }, {
    {l1, l2, l3, l4, l5, l6, l7, l8, l9, l10, l11, l12, l13, l14, l15,
      l16, l17, l18, l19, l20, l21, l22}
    }],
  
  {{x1, p[[1, 1]]}, {y1, p[[1, 2]]}, {z1, p[[1, 3]]},
   {x2, p[[2, 1]]}, {y2, p[[2, 2]]}, {z2, p[[2, 3]]},
   {x3, p[[3, 1]]}, {y3, p[[3, 2]]}, {z3, p[[3, 3]]},
   {x4, p[[4, 1]]}, {y4, p[[4, 2]]}, {z4, p[[4, 3]]},
   {x5, p[[5, 1]]}, {y5, p[[5, 2]]}, {z5, p[[5, 3]]},
   {x6, p[[6, 1]]}, {y6, p[[6, 2]]}, {z6, p[[6, 3]]},
   {x7, p[[7, 1]]}, {y7, p[[7, 2]]}, {z7, p[[7, 3]]},
   {x8, p[[8, 1]]}, {y8, p[[8, 2]]}, {z8, p[[8, 3]]},
   {x9, p[[9, 1]]}, {y9, p[[9, 2]]}, {z9, p[[9, 3]]},
   {l1, 0}, {l2, 0}, {l3, 0}, {l4, 0},
   {l5, 0}, {l6, 0}, {l7, 0}, {l8, 0},
   {l9, 0}, {l10, 0}, {l11, 0}, {l12, 0},
   {l13, 0}, {l14, 0}, {l15, 0},
   {l16, 0}, {l17, 0}, {l18, 0},
   {l19, 0}, {l20, 0}, {l21, 0}, {l22, 0}}
  
  , Jacobian -> hess[u, p, {
     {x1, y1, z1},
     {x2, y2, z2},
     {x3, y3, z3},
     {x4, y4, z4},
     {x5, y5, z5},
     {x6, y6, z6},
     {x7, y7, z7},
     {x8, y8, z8},
     {x9, y9, z9}
     }, {
     {l1, l2, l3, l4, l5, l6, l7, l8, l9, l10, l11, l12, l13, l14, 
      l15, l16, l17, l18, l19, l20, l21, l22}
     }]
]

tri = {
   {0, 0, 0}, {x2, y2, z2}, {x4, y4, z4},
   {x3, y3, z3}, {0, 0, 0}, {x4, y4, z4},
   {x6, y6, z6}, {x2, y2, z2}, {x5, y5, z5},
   {x6, y6, z6}, {x7, y7, z7}, {x4, y4, z4},
   {x8, y8, z8}, {x3, y3, z3}, {x9, y9, z9},
   {x8, y8, z8}, {x7, y7, z7}
   };

edgeT = {tri} /. {
    x2 -> 5, y2 -> 0, z2 -> 0,
    x3 -> 0, y3 -> 5, z3 -> 0,
    x4 -> 5, y4 -> 5, z4 -> 0,
    x6 -> 10, y6 -> 5, z6 -> 0,
    x5 -> 10, y5 -> 0, z5 -> 0,
    x7 -> 10, y7 -> 10, z7 -> 0,
    x8 -> 5, y8 -> 10, z8 -> 0,
    x9 -> 0, y9 -> 10, z9 -> 0
    };

vtx = {
   {x1, y1, z1}, {x2, y2, z2}, {x3, y3, z3},
   {x4, y4, z4}, {x5, y5, z5}, {x6, y6, z6},
   {x7, y7, z7}, {x8, y8, z8}, {x9, y9, z9}
   };

vold = undeformed
vnew = undeformed;

For[i = 0, i < 10, i++,
 
 sol = step[vold, vnew];
 vold = vnew;
 vnew = vtx /. sol;
 edge = tri /. sol;
 
 Print[i];
 AppendTo[edgeT, edge];
 ]

Animate[
 Graphics3D[Line[edgeT[[i]]],
  PlotRange -> {{-2, 12}, {-2, 12}, {-1, 10}}],
 {i, 1, 10},
 AnimationRunning -> False
 ]


  • Prev by Date: Mollier
  • Next by Date: Re: formatting of string in input vs. output cells
  • Previous by thread: Mollier
  • Next by thread: Better version of V3 of Mathematica Book?