Finding the shortest distance between a point and a general quadratic polynomial over an interval

Question

Suppose that I have a point $(p,q) \in \mathbb{R}^{2}$ and the quadratic polynomial $ax^2 + bx+c$ over the interval $[\alpha_{1}, \alpha_{2}] \in \mathbb{R}$. With the distance formula I get this $\sqrt{\left|-x^2-2x-c+q\right|^2+|p-x|^2}$, but I don't know how to find the minimum of this function over that interval because it is too complicated to solve the derivative when it is equal to $0$.

Answer 1

Below is a solution in Mathematica. I drew out the code to make sure it is very readable. Many people will think it is asinine, but I like it.

   is2DPoint[list_] := 
   Module[
     {isValidLength, areElementsReal},
                            
     isValidLength = Length[list] == 2;
     areElementsReal = AllTrue[list, Element[#, Reals] &];
                          
     If[!isValidLength || !areElementsReal||!AllTrue[list,NumericQ],
       Print["Argument is not a 2D point."]
     ]
   ]
                        
   isQuadraticPolynomial[expr_] := 
   Module[
     {degree},
                
   degree = Exponent[expr, x];
            
   If[!PolynomialQ[expr, x] || degree != 2||!AllTrue[CoefficientList[expr, x],NumericQ],
     Print["Not a numeric quadratic polynomial in terms of x."];
   ];
 ]
                        
 isRealInterval[list_] := 
 Module[
   {isValidLength, areElementsRealAndNumeric, isOrderedProperly},
                            
   isValidLength = Length[list] == 2;
   areElementsRealAndNumeric = AllTrue[list, NumericQ[#] && Element[#, Reals] &];
   isOrderedProperly = If[areElementsRealAndNumeric, list[[2]] > list[[1]], False];
                          
   If[!(isValidLength && areElementsRealAndNumeric && isOrderedProperly),
     Print["Not a Real Interval"];
   ]  
 ]
                        
MinValuePointsOnRealInterval[poly_, realInterval_] :=
Module[
  {firstDerivative, secondDerivative, criticalPoints, validCriticalPoints, endpointValues, allValues, minY,  minimumPoints},
                    
  firstDerivative = D[poly, x];
  secondDerivative = D[firstDerivative, x];
  criticalPoints = x /. Solve[firstDerivative == 0 && realInterval[[1]] <= x <= realInterval[[2]], x, Reals];
                    validCriticalPoints = 
  If[Length[criticalPoints] > 0, 
    Select[criticalPoints, (secondDerivative /. x -> #) > 0 &],
    {}
  ];
  endpointValues = {{realInterval[[1]], poly /. x -> realInterval[[1]]}, {realInterval[[2]], poly /. x -> realInterval[[2]]}};
  allValues = Join[endpointValues, ({#, poly /. x -> #} & /@ validCriticalPoints)];
  minY = Min[allValues[[All, 2]]];
  minimumPoints = DeleteDuplicates[Select[allValues, #[[2]] == minY &]];
  minimumPoints
];
                
MinimumDistanceFind[point_, poly_, solutions_] := 
Module[
  {polyPoints, distances},
                
  (* Generate points on the polynomial curve based on the x-values from solutions *)
  polyPoints = ({#[[1]], poly /. x -> #[[1]]} & /@ solutions);
                
  (* Calculate Euclidean distances between the given point and each point in 'polyPoints' *)
  distances = EuclideanDistance[point, #] & /@ polyPoints;
                
  (* Find the minimum distance *)
  Min[distances]
];
        
    findShortestDistancePointQuadraticOverInterval[pointList_,quadraticX_,interval_]:=
    Module[
      {pointQuadraticDistance,pointQuadraticDistanceSquared, solutions, minimumDistance},
              
       is2DPoint[pointList];
       isQuadraticPolynomial[quadraticX];
       isRealInterval[interval];
       pointQuadraticDistance=EuclideanDistance[pointList,{x,quadraticX}];       
       pointQuadraticDistanceSquared = Collect[ComplexExpand[pointQuadraticDistance^2],x];
       solutions = MinValuePointsOnRealInterval[pointQuadraticDistanceSquared, interval];
       minimumDistance = N[First[minimumDistanceFunction[pointList, pointQuadraticDistanceSquared, solutions]]];
       minimumDistance
  ]
  
   

For example:

findShortestDistancePointQuadraticOverInterval[{0,-1},4x^2+x+2,{0,4}]

gives: $$10.$$