I am trying to fit some data by minimizing a function of four parameters. However, this function appears to have a bunch of local minima. To mitigate this, I wrote a function that forms a grid and systematically moves to the minimum until the minimum is at the center of the grid (this is a very inefficient method of grid searching, but simple). I then plug the values found by the grid into FindMinimum as starting values. Unfortunately, FindMinimum returns to the original point, even though this point is definitely higher than the one I found. The frustrating thing about this is that if I manually copy the parameter values found by the grid search into FindMinimum as start values, it finds a completely different, much lower point (even though all the options are the same). Anyone know why this is happening? Here is the code:
Clear[detailedsearch];
detailedsearch[i_, rstart_: 1.4*10^-5, Rstart_: 12*10^-5, Crstart_: 0,
CRstart_: 0, rdelta_: .01*10^-5, Rdelta_: .5*10^-5, Crdelta_: .1,
CRdelta_: .1, klist_: Range[50]] :=
Module[{r, rold, R, Rold, Cr, Crold, CR, CRold, set, block, out,
index, x, y, z, w},
rold = rstart; Rold = Rstart; Crold = Crstart; CRold = CRstart;
Print[{rold, Rold, Crold, CRold}];
set = FindMinimum[\[Chi]o[i, rp, Crp, klist] + \[Chi][i, rp, Rp,
Crp, klist], {rp, rold}, {Rp, Rold}, {Crp, Crold}, {CRp, CRold},
MaxIterations -> 10000, Method -> "Newton"];
{rold, Rold, Crold, CRold} = Table[set[[2]][[j, 2]], {j, 4}];
set = FindMinimum[\[Chi]o[i, rp, Crp, klist] + \[Chi][i, rp, Rp,
Crp, klist], {rp, rold}, {Rp, Rold}, {Crp, Crold}, {CRp, CRold},
MaxIterations -> 10000, AccuracyGoal -> 8, Method -> "Newton"];
{rold, Rold, Crold, CRold} = Table[set[[2]][[j, 2]], {j, 4}];
Print[{rold, Rold, Crold, CRold}];
While[True,
block =
Table[\[Chi][i, rold + rdelta*x, Rold + Rdelta*y,
CRold + CRdelta*w, klist] + \[Chi]o[i, rold + rdelta*x,
Crold + Crdelta*z, klist],
{x, -1, 1}, {y, -1, 1}, {z, -1, 1}, {w, -1, 1}];
Print[Min[block]];
index = Position[block, _?(# == Min[block] &)];
Print[index];
If[index == {{2, 2, 2, 2}},
Break[],
{
{{x, y, z, w}} = index - {{2, 2, 2, 2}};
Print[{x, y, z, w}];
rold += x*rdelta; Rold += y*Rdelta; Crold += z*Crdelta;
CRold += w*CRdelta;
}];
];
Print[{rold, Rold, Crold, CRold}];
set = FindMinimum[\[Chi]o[i, rp, Crp] + \[Chi][i, rp, Rp,
Crp], {rp, rold}, {Rp, Rold}, {Crp, Crold}, {CRp, CRold},
MaxIterations -> 10000, AccuracyGoal -> 8, Method -> "Newton",
PrecisionGoal -> 8];
{rold, Rold, Crold, CRold} = Table[set[[2]][[j, 2]], {j, 4}];
{rold, Rold, Crold, CRold}
];
