Find parameters that minimize the distance between two curves in terms of the infinite norm
The following is fast and suggests an almost straight and horizontal line:
p = Range[0, 1, 1/100];
v[x_] := v[x] = ChebyshevT[6, x]
f[x_?NumericQ, a_?NumericQ, b_?NumericQ, c_?NumericQ] := a x x + b x + c
abs[x_?NumericQ, a_?NumericQ, b_?NumericQ, c_?NumericQ] := (v[x] - f[x, a, b, c])^2
maxabs[a_?NumericQ, b_?NumericQ, c_?NumericQ] := Max[abs[#, a, b, c] & /@ p]
n = Monitor[NMinimize[maxabs[a, b, c], {a, b, c}], {a, b, c}]
(* {1.00244, {a -> 0.00419288, b -> 0.00395157, c -> -0.00424115}}*)
While this "analytical" solution gets the same result (only more horizontal and straighter):
es[a_, b_, c_, x_] = (ChebyshevT[6, x] - (a x x + b x + c))^2 // Expand;
extrema[a_, b_, c_] := Join[{0, 1},
Select[x /. Solve[D[es[a, b, c, x], x] == 0, x] // N,
Head[#] =!= Complex && 0 < # < 1 &]]
maxabs[a_?NumericQ, b_?NumericQ, c_?NumericQ]:=Max[es[a, b, c, #] & /@ extrema[a, b, c]]
sol = NMinimize[maxabs[a, b, c], {a, b, c}, Method -> "NelderMead"]
(* {1.00014, {a -> -0.00256894, b -> 0.00390044, c -> -0.00137957}} *)
My approach.. first do a least squares fit, which gives a global minimum, although with a different error measure:
f[x_, a_, b_, c_] := a (x)^2 + b (x) + c;
s1 = First@
Solve[(D[
Simplify[
Total[((f[#, a, b, c] - v[#])^2 & /@
Range[0, 1, .001])]] , #] & /@ {a, b, c, d}) == 0, {a, b,
c}]
Plot[{v[y], f[y, a, b, c] /. s1 }, {y, 0, 1}]
Then use that solution as a start point for FindMinimum
:
crit[a_?NumericQ, b_?NumericQ, c_?NumericQ] :=
Norm[f[#, a, b, c] - v[#] & /@ Range[0, 1, .001], Infinity]
{a0, b0, c0} = {a, b, c} /. s1;
s2 = Last@FindMinimum[ crit[a, b, c] , {{a, a0}, {b, b0}, {c, c0}}]
ep = First@
MaximalBy[Range[0, 1, .2], ({Abs[v[#] - f[#, a, b, c] /. s2]}) &]
Plot[{v[y], f[y, a, b, c] /. s1, f[y, a, b, c] /. s2 }, {y, 0, 1},
Epilog -> Arrow[{{ep, v[ep]}, {ep, f[ep, a, b, c] /. s2 }}]]
The max error is 1.3822 @ x=1
(Which we can see see straight away is not a global minimum since the line y=0
has a max error of 1
. )