# common tangent of two curves

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?

## 2 Answers

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


• May I ask how "?NumberQ" works in the function? The function also works without "?NumberQ". Dec 4 '17 at 11:17
• 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. Dec 5 '17 at 13:47

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