6
$\begingroup$

I have two functions of the two variables "x" and "T".

alpha[x_, T_] := 10 x (1 - x) + 8.314*10^-3 T (x Log[x] + (1 - x) Log[1 - x]) - 2 x
beta [x_, T_] := 20 x (1 - x) + 8.314*10^-3 T (x Log[x] + (1 - x) Log[1 - x]) - 4 (1 - x)

Given T value, the two functions become functions of one variable "x", and we can find the their common tangent line (function of x). I managed to obtain their common tangent line providing the T value is specified (T=600).

sol1 = FindRoot[{(alpha[x1, 600] - beta[y, 600])/(x - y) ==
D[alpha[x, 600], x] == D[beta[y, 600], y] }, {{x, 0.9}, {y, 0.1}}]
(*{x -> 0.918251, y -> 0.0124932}*)
l1[t_] = (1 - t) {x, alpha[x, 600]} + t {y, beta[y, 600]} /. sol1
(* Parametric form {0.918251 (1 - t) + 0.0124932 t, -2.49766 (1 - t) - 4.03834 t} *)

Now, I want to express the tangent line and the touching points in terms of T on the interval (600,800), not just a single value. But FindRoot function cannot accept equations that contain unknowns. Can anyone give me a hand?

$\endgroup$
3
$\begingroup$

You need to create numeric function that calculates your root:

In[2]:= Tangent[T_?NumberQ] := 
            FindRoot[{(alpha[x,T]-beta[y,T])/(x-y)==D[alpha[x,T],x]==D[beta[y,T],y]},
            {{x, 0.9}, {y, 0.1}}][[All, 2]];
        Tangent[600]

Out[2]= {0.918251, 0.0124932}

Then you will be able to call it directly

In[3]:= line[x_,{x1_,y1_},{x2_,y2_}] := y1+(x-x1)(y2-y1)/(x2-x1);
        Manipulate[ {x1, x2} = Tangent[T]; {y1, y2} = {alpha[x1, T], beta[x2, T]};
            Plot[{alpha[x, T], beta[x, T], line[x, {x1, y1}, {x2, y2}]}, {x, 0, 1}],
            {T, 600, 800}]

enter image description here

$\endgroup$
2
  • $\begingroup$ May I ask how "?NumberQ" works in the function? The function also works without "?NumberQ". $\endgroup$
    – chika
    Dec 4 '17 at 11:17
  • $\begingroup$ It tells Mathematica not to bother calculating the function if argument is not a number. It's a good practice to put it in functions using FindRoot, NDSolve etc. $\endgroup$ Dec 5 '17 at 13:47
3
$\begingroup$

An alternative to @VasilyMitch's answer is to cast the problem as an ODE and use NDSolveValue:

eq1 = Derivative[1,0][alpha][x[T], T] == Derivative[1,0][beta][y[T], T];
eq2 = alpha[x[T],T] - beta[y[T], T] == (x[T]-y[T]) Derivative[1,0][alpha][x[T], T];

initial = Values @ FindRoot[{eq1, eq2} /. T->600, {{x[600], .9}, {y[600], .1}}];

sol = NDSolveValue[
    {D[eq1, T], D[eq2, T], x[600] == initial[[1]], y[600] == initial[[2]]},
    {x, y},
    {T, 400, 800}
];

Using Vasily's nice Manipulate:

Tangent[t_] := Through @ sol[t]

line[x_, {x1_,y1_}, {x2_,y2_}] := y1+(x-x1)(y2-y1)/(x2-x1);
Manipulate[
    {x1,x2} = Tangent[T];
    {y1,y2} = {alpha[x1,T],beta[x2,T]};
    Plot[{alpha[x, T], beta[x, T], line[x, {x1,y1}, {x2,y2}]}, {x, 0, 1}],
    {T,400,800}
]

enter image description here

$\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.