0
$\begingroup$

Is numerical solving of the problem in the picture below even possible? Picture of the eq syste

Edit: The code does not output anything, it just runs for 20min+

(eqs[p1_, p2_, p3_, p4_] = 
{0 == G lk Cos[p1] + 7/2 mk g lk Cos[p1] - k 4 lk (Sin[p1] + Sin[p2] - Sin[p3] - Sin[p4]) Cos[p1], 
0 == G lk Cos[p2] + 5/2 mk g lk Cos[p2] - kt p2 - kt (p2 + p3) - k 4 lk (Sin[p1] + Sin[p2] - Sin[p3] - Sin[p4]) Cos[p2], 
0 == -3/2 mk g lk Cos[p3] - kt p3 - kt (p2 + p3) - k 4 lk (Sin[p1] + Sin[p2] - Sin[p3] - Sin[p4]) Cos[p3], 
0 == -1/2 mk g lk Cos[p4] - k 4 lk (Sin[p1] + Sin[p2] - Sin[p3] - Sin[p4]) Cos[p4]}) // 
TableForm

Edit 2: Thank you for trying to help me. So after looking at my assignment again, i am not sure that posted equations are okay. So I tried to simplify it. My code now is:

mk = 240; (*kg*)
G = 41200;(*N*)
Iu = 15*10^-7; (*m4*)
lk = 69/100;(*m*)
Eu = 210*10^9; (*Pa = N/m^2*)
k = 1*10^7 ;(*N/m*)
g = 981*10^-2;(*m/s^2*)
EI = Eu Iu;
P = 4;
kt = (EI/lk)(*Nm/rad*)

Equations:

Q1[\[Phi]1_, \[Phi]2_, \[Phi]3_, \[Phi]4_] = 
  G lk Cos[\[Phi]1]  + 7/2 mk g lk Cos[\[Phi]1] - kt \[Phi]1 + 
   kt \[Phi]2;
Q2[\[Phi]1_, \[Phi]2_, \[Phi]3_, \[Phi]4_] = 
  G lk Cos[\[Phi]2] + 5/2 mk g lk Cos[\[Phi]2] + kt \[Phi]1 - 
   2 kt \[Phi]2 - kt \[Phi]3;
Q3 [\[Phi]1_, \[Phi]2_, \[Phi]3_, \[Phi]4_] = - (3/2)
      mk g lk Cos[\[Phi]3] - kt \[Phi]2 - 2 kt \[Phi]3 + kt \[Phi]4;
Q4[\[Phi]1_, \[Phi]2_, \[Phi]3_, \[Phi]4_] =  - (1/2)
      mk g lk Cos[\[Phi]4] - kt \[Phi]4 + kt \[Phi]3;

And my only half successful attempt:

r = FindRoot[{
   Q1[\[Phi]1, \[Phi]2, \[Phi]3, \[Phi]4] ,
   Q2 [\[Phi]1, \[Phi]2, \[Phi]3, \[Phi]4],
   Q3 [\[Phi]1, \[Phi]2, \[Phi]3, \[Phi]4],
   Q4[\[Phi]1, \[Phi]2, \[Phi]3, \[Phi]4]}, {{\[Phi]1, 
    0.001}, {\[Phi]2, 0.001}, {\[Phi]3, 0.001}, {\[Phi]4, 0.001}}]

The result that i get is not what i was expecting (3/2pi, 3/2pi, -3/2pi, -3/2pi). Any hints ? I tried also NSolve, Solve, Find.....

Grateful for any help.

$\endgroup$
  • 6
    $\begingroup$ Welcome to MSE. Please post code, not images. $\endgroup$ – Rohit Namjoshi Mar 26 at 16:18
  • 2
    $\begingroup$ G=1;lk=2;mk=3;g=4;kt=5;k=6;FindRoot[{q1==0,q2==0,q3==0,q4==0},{{p1,1},{p2,1},{p3,1},{p4,1}}] instantly returns a solution for your system. Substitute your actual values for your parameters and see if it works. Substitute better starting values for p1,p2,p3,p4 if you are looking for a solution near some known point. $\endgroup$ – Bill Mar 26 at 18:12
  • $\begingroup$ -1. The code still is not presented. $\endgroup$ – user64494 Mar 27 at 10:12
  • $\begingroup$ Closing this until the OP provides copyable code. $\endgroup$ – J. M.'s discontentment Mar 27 at 11:53
  • $\begingroup$ @J. M.'s technical difficulties, in my answer there is copyable code. $\endgroup$ – Akku14 Mar 27 at 12:01
4
$\begingroup$

Seems to be impossible to solve with NSolve. Even elimination of Sin[pi] or Cos[pi] didn't improve it.

With different starting points for FindRoot, it can be observed, that p1 and p4 alyways end in multiples of Pi/2. I can't proove this generally, but it seems plausible, since p1 and p4 only appear in sin and cos in equations. Maybe some clever guy can show it.

Inserting only multiples of Pi/2 for p1 and p4, you can find all solutions for p2, p3 graphically as starting points for FindRoot.

(eqs[p1_, p2_, p3_, p4_] = 
{0 == G lk Cos[p1] + 7/2 mk g lk Cos[p1] - 
  k 4 lk (Sin[p1] + Sin[p2] - Sin[p3] - Sin[p4]) Cos[p1], 
0 == G lk Cos[p2] + 5/2 mk g lk Cos[p2] - kt p2 - kt (p2 + p3) - 
  k 4 lk (Sin[p1] + Sin[p2] - Sin[p3] - Sin[p4]) Cos[p2], 
0 == -3/2 mk g lk Cos[p3] - kt p3 - kt (p2 + p3) - 
  k 4 lk (Sin[p1] + Sin[p2] - Sin[p3] - Sin[p4]) Cos[p3], 
0 == -1/2 mk g lk Cos[p4] - 
  k 4 lk (Sin[p1] + Sin[p2] - Sin[p3] - Sin[p4]) Cos[
    p4]}) // TableForm

FindRoot[eqs[p1, p2, p3, p4] /. {G -> 1, lk -> 2, mk -> 3, g -> 4, 
    kt -> 5, k -> 6}, {{p1, 1}, {p2, 1}, {p3, 1}, {p4, 1}}]

(*   {p1 -> 1.5708, p2 -> 1.13895, p3 -> 2.28885, p4 -> 1.5708}   *)

{p1, p2, p3, p4}/Pi /. 
   FindRoot[eqs[p1, p2, p3, p4] /. {G -> 1, lk -> 2, mk -> 3, g -> 4, 
kt -> 5, k -> 6}, {{p1, 2}, {p2, 4}, {p3, 1}, {p4, 0}}]

(*    {0.5, 1.6984, -1.66635, 1.5}   multiples of Pi   *)

{p1, p2, p3, p4}/Pi /. 
   FindRoot[eqs[p1, p2, p3, p4] /. {G -> 1, lk -> 2, mk -> 3, g -> 4, 
kt -> 5, k -> 6}, {{p1, 7}, {p2, 1}, {p3, 1}, {p4, 5}}]

(*   {2.5, 0.0223505, 0.565737, 1.5}   *)

Evaluate for given parameters and multiples of Pi/2. If equation yields True, it is valid for all pi. In this case no graph appears.

Solutions for p2,p3 are where all appearing graphes intersect.

Edit

Now taking into account, that overdetermined equations do not give a solution. there remain only 4 combinations.

soleqs = Select[
  Flatten[Table[{{p1, p4}, 
 DeleteCases[
  Evaluate[
   eqs[p1, p2, p3, p4] /. {G -> 1, lk -> 2, mk -> 3, g -> 4, 
     kt -> 5, k -> 6}], True]}, {p1, 0, 2 Pi, Pi/2}, {p4, 0, 2 Pi,
  Pi/2}], 1], Length[#[[2]]] == 2 &]

ContourPlot[Evaluate[#[[2]]], {p2, 0, 2 Pi}, {p3, 0, 2 Pi}, 
  ContourStyle -> {Red, Green, Blue, Magenta}, 
  PlotLabel -> {{"p1=", #[[1, 1]]}, {"p4=", #[[1, 2]]}}, 
  GridLines -> Automatic, ImageSize -> 150] & /@ soleqs

enter image description here

| improve this answer | |
$\endgroup$

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.