FitRegularization with a user function

Question

I am trying to use FindFit with a user-defined function g[a] for FitRegularizaton as specified in the document. Say, I have parameters a1,a2,a3,a4 and define g[a] as

g[a_]:=Sum[a[[i]]*10^(4-i),{i,1,4}]

i.e. I want the parameters of the fit to decrease as powers of 10. However, when I write

FindFit[data,function,{a1,a2,a3,a4},x,FitRegularization->g],

I get the error FindFit: The fit regularization g should be a function or named regularization.

What is the correct way of writing it? I tried "g" instead of g and other variants, it is not working. I also can not find any examples of its use. Example:

data = Array[{Random[], Random[]} &, 8];
function[x_] := a1*x + a2*x^2 + a3*x^3 + a4*x^4;

FindFit[data, function[x], {a1, a2, a3, a4}, x]

{a1 -> 4.5591977, a2 -> -14.980712, a3 -> 19.958318, a4 -> -9.0979829}

g[a_] := Sum[a[[i]]*10^(4 - i), {i, 1, 4}];

FindFit[data, function[x], {a1, a2, a3, a4}, x, 
 FitRegularization -> g]

FindFit::bdfitreg: The fit regularization g should be a function or named regularization.

Answer 1

This is more of a guess as to what's going on with fit regularization. In short for the kind of fit regularization you want, you might have to write your own.

First I duplicate the use of the FitRegularization (with possible numerical round-off errors):

(* Generate some data *)
SeedRandom[12345];
data = Array[{Random[], Random[]} &, 8];

(* Define function to fit along with residuals and parameters *)
function[x_] := a1*x + a2*x^2 + a3*x^3 + a4*x^4;
residuals = Table[(data[[i, 2]] - function[data[[i, 1]]]), {i, Length[data]}];
parms = {a1, a2, a3, a4};

(* FindFit and FindMinimum with matching fit regularization *)
FindFit[data, function[x], {a1, a2, a3, a4}, x, FitRegularization -> {"Tikhonov", 1}]
(* {a1 -> 0.227725, a2 -> 0.129161, a3 -> 0.104264, a4 -> 0.0939517} *)

f = Norm[residuals, 2]^2 + Norm[parms, 2]^2;
FindMinimum[f, {{a1, 1}, {a2, 1}, {a3, 1}, {a4, 1}}][[2]]
(* {a1 -> 0.227725, a2 -> 0.129161, a3 -> 0.104264, a4 -> 0.0939517} *)

So the above results match. Now with a different kind of fit regularization:

(* FindFit and FindMinimum with matching fit regularization *)
FindFit[data, function[x], {a1, a2, a3, a4}, x, FitRegularization -> (0.1 Norm[#, 1] &)]
(* {a1 -> 0.514388, a2 -> 2.79813*10^-8, a3 -> -1.96437*10^-9, a4 -> -6.17399*10^-8} *)

f2 = Norm[residuals]^2 + 0.1 Norm[parms, 1];
FindMinimum[f2, {{a1, 1}, {a2, 1}, {a3, 1}, {a4, 1}}][[2]]
(* {a1 -> 0.514386, a2 -> 3.02638*10^-7, a3 -> 2.60468*10^-7, a4 -> 2.24268*10^-7} *)

For this latest example the values of a1 match and the rest of the parameter estimates are essentially zero. Are the differences just numerical precision issues? I don't know.

Now for the specific kind of fit regularization you started with. I think you can get the desired result by modifying the fitting function with appropriate scaling of the parameters in the following manner. (I've increased the number of data points in hopes of reducing the numerical precision differences.)

SeedRandom[12345];
data = Array[{Random[], Random[]} &, 25];

function2[x_] := (a1x*100)*x + (a2x*1000)*x^2 + (a3x*10000)*x^3 + (a4x*100000)*x^4;
solFF = FindFit[data, function2[x], {a1x, a2x, a3x, a4x}, x, FitRegularization -> (Norm[#, 1] &)];
{100, 1000, 10000, 100000}*{a1x, a2x, a3x, a4x} /. solFF
(* {2.53608, 0.346469, -9.33437, 7.34046} *)

residuals = Table[(data[[i, 2]] - function[data[[i, 1]]]), {i, Length[data]}];
parms = {a1, a2, a3, a4};
f2 = Norm[residuals]^2 + 10^(-5) Total[Abs[parms*{10^3, 10^2, 10, 1}]];
solFM = FindMinimum[f2, {{a1, 9/2}, {a2, -10}, {a3, 66/10}, {a4, -1/10}}][[2]];
parms /. solFM
(* {2.54399, 0.295711, -9.24566, 7.29396} *)

Also note that with FindMinimum I'm getting "FindMinimum::lstol: The line search decreased the step size to within the tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient decrease in the function. You may need more than MachinePrecision digits of working precision to meet these tolerances." warnings.