common tangent of two curves

Question

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?

Answer 1

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}]

Answer 2

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}
]