Message Boards Message Boards

Find all pairs of common tangents to a curve?

GROUPS:

My question is kind of an extension of a question asked previously (https://mathematica.stackexchange.com/questions/25892/common-tangent-to-a-curve) . The difference is that(instead of just one pair) I need to find all pairs of common tangents to a plot. The list is

normalizedfplot={{0.01, 0.}, {0.02, -0.0000539749}, {0.03, -0.000101768}, {0.04, \
-0.000147006}, {0.05, -0.000191386}, {0.06, -0.000235889}, {0.07, \
-0.000281142}, {0.08, -0.000327577}, {0.09, -0.000375499}, {0.1, \
-0.000425131}, {0.11, -0.000476637}, {0.12, -0.000530134}, {0.13, \
-0.000585708}, {0.14, -0.000643418}, {0.15, -0.000703296}, {0.16, \
-0.00076536}, {0.17, -0.000829608}, {0.18, -0.000896023}, {0.19, \
-0.000964576}, {0.2, -0.00103522}, {0.21, -0.0011079}, {0.22, \
-0.00118255}, {0.23, -0.00125909}, {0.24, -0.00133741}, {0.25, \
-0.00141742}, {0.26, -0.00149898}, {0.27, -0.00158197}, {0.28, \
-0.00166622}, {0.29, -0.00175156}, {0.3, -0.0018378}, {0.31, \
-0.00192473}, {0.32, -0.00201211}, {0.33, -0.00209968}, {0.34, \
-0.00218713}, {0.35, -0.00227415}, {0.36, -0.00236037}, {0.37, \
-0.00244538}, {0.38, -0.00252871}, {0.39, -0.00260987}, {0.4, \
-0.00268827}, {0.41, -0.00276326}, {0.42, -0.00283413}, {0.43, \
-0.00290008}, {0.44, -0.00296023}, {0.45, -0.00301362}, {0.46, \
-0.00305925}, {0.47, -0.00309612}, {0.48, -0.00312327}, {0.49, \
-0.00313991}, {0.5, -0.00314552}, {0.51, -0.00313991}, {0.52, \
-0.00312327}, {0.53, -0.00309612}, {0.54, -0.00305925}, {0.55, \
-0.00301362}, {0.56, -0.00296023}, {0.57, -0.00290008}, {0.58, \
-0.00283413}, {0.59, -0.00276326}, {0.6, -0.00268827}, {0.61, \
-0.00260987}, {0.62, -0.00252871}, {0.63, -0.00244538}, {0.64, \
-0.00236037}, {0.65, -0.00227415}, {0.66, -0.00218713}, {0.67, \
-0.00209968}, {0.68, -0.00201211}, {0.69, -0.00192473}, {0.7, \
-0.0018378}, {0.71, -0.00175156}, {0.72, -0.00166622}, {0.73, \
-0.00158197}, {0.74, -0.00149898}, {0.75, -0.00141742}, {0.76, \
-0.00133741}, {0.77, -0.00125909}, {0.78, -0.00118255}, {0.79, \
-0.0011079}, {0.8, -0.00103522}, {0.81, -0.000964576}, {0.82, \
-0.000896023}, {0.83, -0.000829608}, {0.84, -0.00076536}, {0.85, \
-0.000703296}, {0.86, -0.000643418}, {0.87, -0.000585708}, {0.88, \
-0.000530134}, {0.89, -0.000476637}, {0.9, -0.000425131}, {0.91, \
-0.000375499}, {0.92, -0.000327577}, {0.93, -0.000281142}, {0.94, \
-0.000235889}, {0.95, -0.000191386}, {0.96, -0.000147006}, {0.97, \
-0.000101768}, {0.98, -0.0000539749}, {0.99, 0.}}

The plot looks like this

enter image description here

Now when I use the code used in the solution to the previous problem, it gives me only one solution.

fo = Interpolation[normalizedfplot, Method -> "Spline"];
boundary = FindRoot[{y1==fo[x1],y2==fo[x2], fo'[x1]==fo'[x2], fo'[x1]==(y2-y1)/(x2-x1)},
  {x1,0.01},{x2,0.5},{y1,-0.025},{y2,-0.0275}]
{x1 -> 0.00124073, x2 -> 0.419065, y1 -> 0.000055584, 
 y2 -> -0.0028277}

This gives me only one pair of solution (if lucky). I need a code that will work for any plot and give me all pairs of common tangents (like there are two pairs in the above plot-one pair given above and the other pair approximately 0.6-0.99). Using NSolve did not help either.

POSTED BY: Deb Chicago
Answer
3 months ago

I cannot see common tangents in your plot, unless they are very close together near 0 or near 1. The common tangents should appear as crossings in the following plot:

ContourPlot[{fo'[x1] == fo'[x2], 
  fo'[x2] == (fo[x1] - fo[x2])/(x1 - x2)}, {x1, 0.01, 0.99}, {x2, 
  0.01, 0.99}]
POSTED BY: Gianluca Gorni
Answer
3 months ago

Slightly modified the list given in the question. Your solution gives me the following. enter image description here

Could you please help me understand what is going on in this plot ?

POSTED BY: Deb Chicago
Answer
3 months ago

Common tangents happen when at two points x1,x2 the derivative is the same and it coincides with the increment ratio, i.e.,

fo'[x1] == fo'[x2]== (fo[x1] - fo[x2])/(x1 - x2)

I divide this condition into two equations in two variables, and plot the solutions with ContourPlot. The crossing points outside the diagonal (x1==x2) should give values x1,x2 that give common tangents.

In your case the solution curves for the two equations only cross on the diagonal. Try for example with the Sin function:

fo = Sin;
ContourPlot[{fo'[x1] == fo'[x2],
  fo'[x2] == (fo[x1] - fo[x2])/(x1 - x2)},
 {x1, 0, 4 Pi}, {x2, 0, 2 Pi},
 Exclusions -> x1 == x2, AspectRatio -> Automatic,
 GridLines -> {Range[16] Pi/2, Range[8] Pi/2}]

You will see a few crossing outside the diagonal which corresponds to common tangents. You can close in on those solutions first with the Drawing Tool palette, which gives me a value {{"10.74", "1.826"}}, and then using FindRoot on the graphical solution

FindRoot[{fo'[x1] == fo'[x2],
  fo'[x2] == (fo[x1] - fo[x2])/(x1 - x2)},
 {x1, 10.74}, {x2, 1.826}]

Then I can plot a common tangent:

Plot[{fo[x],
  fo[x1] + fo'[x1] (x - x1) /. x1 -> 10.776594765088651`},
 {x, 0, 4 Pi}]
POSTED BY: Gianluca Gorni
Answer
3 months ago

Thanks for explaining your code to me. I used the same code (FindRoot) earlier. However, this only gives one solution. Also, I want to sort of automate the process that is my code should be able to find all common tangent pairs for a general curve. The reason for doing so is I will be looking at many curves (free energy curves) and checking it manually is something I can ill-afford.

POSTED BY: Deb Chicago
Answer
3 months ago

Solve and NSolve attempt to find all solutions, but they are mainly concerned with polynomial or analytical functions. I doubt they work with interpolation functions. Here is an attempt at automation of the graphical part, that works, although slowly, in the Sin case:

fo[x] = Sin[x];
firstEq = Cases[ContourPlot[fo'[x2] == (fo[x1] - fo[x2])/(x1 - x2),
      {x1, 0, 16}, {x2, 0, 8}][[1]] // Normal, _Line, All];
secondEq = Cases[ContourPlot[fo'[x1] == fo'[x2],
      {x1, 0, 16}, {x2, 0, 8}][[1]] // Normal, _Line, All];
Complement[Flatten@Outer[RegionIntersection, firstEq, secondEq],
 {EmptyRegion[2]}]

It converts the ContourPlots of the two equations into Line object, and then finds the RegionIntersection of the couples of lines. After that you can start FindRoot from the points you have found. I don't know if this solution is practical in your situation.

POSTED BY: Gianluca Gorni
Answer
3 months ago

Group Abstract Group Abstract