0
$\begingroup$

I have an optimization problem for this 4 bar-linkage.

enter image description here

Nothing is known(a,b,c,d,x,y) except The Tip of the triangle's co-ordinate which is known for some value of phi (angle between a and d). For Example when phi is 0 Trangle tip is at (1.22,3.66) See the table below.

enter image description here

The system of equation I ended up with is known as Freudenstein equation:

φ[ϕ_, a_, b_, c_, d_] := 
 ArcSec[(2 c^2 (d - a Cos[ϕ]) (a^2 + d^2 - 
    2 a d Cos[ϕ]))/(c (d - a Cos[ϕ])^2 (a^2 - b^2 + 
     c^2 + d^2 - 2 a d Cos[ϕ]) - 
  a c √(-(d - 
         a Cos[ϕ])^2 (a^4 + (b - c - d) (b + c - d) (b - c + 
           d) (b + c + d) - 2 a^2 (b^2 + c^2 - 2 d^2) + 
        2 a d (2 (-a^2 + b^2 + c^2 - d^2) Cos[ϕ] + 
           a d Cos[2 ϕ]))) Sin[ϕ])]; 

A[ϕ_, a_] := a {Cos[ϕ], Sin[ϕ]};

B[ϕ_, a_, b_, c_, d_] := {d - c Cos[φ[ϕ, a, b, c, d]], 
c Sin[φ[ϕ, a, b, c, d]]};

λ[ϕ_, a_, b_, c_, d_] := ArcTan @@ (B[ϕ, a, b, c, d] - A[ϕ, a]);

W[ϕ_, a_, b_, c_, d_] := A[ϕ, a] + x {Cos[λ[ϕ, a, b, c, d] + y], 
Sin[λ[ϕ, a, b, c, d] + y]};

Should look like this picture if you run the code on Mathematica

Should look like this

Then I run this code to get 24 equation for the triangle tip co-ordinate(see the 2nd image (phi, x, y table ))

System = W[#, a, b, c, d] & /@ {0, π/6, π/3, π/2, (
 2 π)/3, (5 π)/6, π, (7 π)/6, (4 π)/3, (
 3 π)/2, (5 π)/3, (11 π)/6} // Simplify // Flatten

The problem is when I am trying to solve this using

NSolve

NSolve[System == {1.22`, 3.66`, 0.9`, 2.7`, 1.2`, 1.93`, 1.93`, 1.48`,
3.1`, 1.46`, 4.58`, 1.85`, 5.8`, 2.36`, 6.12`, 3.2`, 5.62`, 4.06`,
4.57`, 4.8`, 3.24`, 4.9`, 2.04`, 4.45`}, {x, y, a, b, c, d}, Reals]

It runs for eternity. Can any one tell me if I have any other option to solve this in Mathematica? Thanks

Update The table has changed because I made a mistake, instead of taking phi from 0-360, I took it from 0-180. The table has been changed. so Is the corresponding code(code block 2)

$\endgroup$
2
  • 1
    $\begingroup$ You can try FindRoot if you know some initial guess. $\endgroup$
    – Sumit
    Nov 22, 2017 at 10:58
  • $\begingroup$ Reduce is generally the most powerful equation solving function in Mathematica. Be sure to add constraints if you have any. (e.g, all your variables are positive; that's useful to include in the problem). Short of that: like the above comment says, try FindRoot with an initial guess. $\endgroup$ Nov 22, 2017 at 16:52

1 Answer 1

1
$\begingroup$

You should use NMinimize!

Assuming the modelled behavior of your system gives xModel[PHI,para],yModel[PHI,para] with para={x, y, a, b, c, d} then you have to minimize

J=Sum[#.#&[ {xModel[PHI,para],yModel[PHI,para]}-{xTable[PHI],yTable[PHI}],{PHI}]
NMinimize[J,para]
$\endgroup$

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.