# 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 thisNow 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.
11 months ago
5 Replies
 Gianluca Gorni 1 Vote 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}] 
11 months ago
 Slightly modified the list given in the question. Your solution gives me the following. Could you please help me understand what is going on in this plot ?
 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}] 
 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.