Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.soft-sys.math.mathematica > #1659 > unrolled thread

FindFit[] Blues

Back to article view | Back to comp.soft-sys.math.mathematica

Contents

  FindFit[] Blues "Ernest Jackson" <ernestrjackson2@verizon.net> - 2011-04-14 08:58 +0000
    Re: FindFit[] Blues Peter Pein <petsie@dordos.net> - 2011-04-15 07:55 +0000

#1659 — FindFit[] Blues

Hi,

I have been struggling with a situation where FindFit[]  gives me correct answers when the model includes either
Nest[] or Total[] but not when Nest[] is inside Total[] .  I DON'T THINK THIS IS A CASE WHERE FindFit[]
IS STUCK IN A LOCAL SOLUTION (see the simplified example code below).  It appears to me that either
I have made a dumb error which I cannot see or I do not understand some critical aspects of the problem/code. 
The problem is demonstrated with code for a two element system with simple interactions modeled in discrete
time.  Any help would be greatly appreciated.

(*--------------------------------------------------------*)
(*  DEFINE FUNCTIONS TO MODEL SYSTEM    *)
(* the state of each element depends on the  *)
(* the state of the other during the prior time *)
(* and the value of the parameters, a and b    *)
(*--------------------------------------------------------*)
toNextFu = {a Sin[#[[2]]],b Cos[#[[1]]] }&;   (* calculate next 2-value state from current state *)
toLaterFu= Function[{s1,s2,laterNum},Flatten[Nest[toNextFu,{s1,s2},Round[laterNum]] ]]; (* calculate state laterNum of time units after current state *)
errorFu=Function[{s1,s2, laterNum,n1,n2},Total[(toLaterFu[s1,s2, laterNum]-{n1,n2})^2]]; (* convert calculated state to an error so the function can be used inside FindFit[] *)

(*----------------------------------------------------------------------------------------------------------------*)
(* GENERATE 100 TRAINING DATA POINTS                                     *)
(*  of {state1, state2, laterNum,  nextState1, nextState2, 0} when a= 0.5 and b 0.3         *)(*  0 added at the end because I want the model's error for each training point to be 0   *)
(*---------------------------------------------------------------------------------------------------------------*)
pSub={a->.5,b->.3}; (* parameter values selected to produce training dataset --*)
data=Table[Flatten[{s1=RandomReal[{0,8}],s2=RandomReal[{0,8}],laterNum=RandomInteger[{1,2}],toLaterFu[s1,s2,laterNum]/.pSub,0}],{100}];

(*-----------------------------*)
(*        FIT THE DATA      *)
(*-----------------------------*)
Clear[a,b,s1,s2,laterNum,n1,n2];
Quiet[fit=FindFit[data,errorFu[s1,s2, laterNum,n1,n2],{a,b},{s1,s2, laterNum,n1,n2}]];
Print["Fitted parameters: ",fit];
Print["Correct parameters: ",pSub];

(*------------------------------------------------------------------------------------------*)
(* SHOW A SMOOTH TOTAL ERROR SURFACE AROUND THE SOLUTION *)
(*------------------------------------------------------------------------------------------*)
(*--fitPoint - {fit for parm-A, fit for parm-B, total error at fit} --*)
fitPoint=Flatten[{fit[[All,2]],Total[Map[(errorFu[Drop[#,-1]/.List->Sequence]/.fit)&,data]] }];

 (*--targPoint - {actual parm-A, parm-B, total error with correct parms} --*)
targPoint=Flatten[{{0.5,0.3},0}];

(*-- Start and end a and b parameter values to be plotted --*)
{startA, startB}=fit[[All,2]];
{endA, endB}= {startA, startB} +0.4;

 (*-------------------------------------------------------------------*)
(*The  total error surface plot around the fitted (RED)  *)
(* and correct parameter values (BLACK)                      *)
(* THIS TAKES ABOUT 17 SEC ON MY COMPUTER        *)
(*--------------------------------------------------------------------*)
p=Plot3D[Total[ParallelMap[(errorFu[Drop[#,-1]/.List->Sequence]/.{a->valueA,b->valueB})&,data]],{valueA,startA,endA},{valueB,startB,endB},AxesLabel->Automatic];
Show[p,Graphics3D[{{PointSize[0.02],Black,Point[targPoint]},{PointSize[0.02],Red,Point[fitPoint]}}] ]

Finally, if FindFit[] is forced to start the search with a and b parameters values from -10 to 10 the same wrong solution is found suggesting further that a local solution
is not being found. So where have I gone wrong?  Again, any help will be greatly appreciated!

Thanks

Ernie Jackson

[toc] | [next] | [standalone]

#1685

Hi Ernest,

two minor changes gave me fitted values (0.5,0.3):

1.) define errorFu as follows:
errorFu[s1_?NumericQ, s2_?NumericQ,
         laterNum_?NumericQ,
         n1_?NumericQ, n2_?NumericQ] :=
    Total[(toLaterFu[s1, s2, laterNum] - {n1, n2})^2];

2.) Use the Option Method->NMinimize in Fit.
(this was my first attempt; maybe other methods are suitable too.

hth,
  Peter

Am 14.04.2011 10:58, schrieb Ernest Jackson:
> Hi,
>
> I have been struggling with a situation where FindFit[]  gives me correct answers when the model includes either
> Nest[] or Total[] but not when Nest[] is inside Total[] .  I DON'T THINK THIS IS A CASE WHERE FindFit[]
> IS STUCK IN A LOCAL SOLUTION (see the simplified example code below).  It appears to me that either
> I have made a dumb error which I cannot see or I do not understand some critical aspects of the problem/code.
> The problem is demonstrated with code for a two element system with simple interactions modeled in discrete
> time.  Any help would be greatly appreciated.
>
> (*--------------------------------------------------------*)
> (*  DEFINE FUNCTIONS TO MODEL SYSTEM    *)
> (* the state of each element depends on the  *)
> (* the state of the other during the prior time *)
> (* and the value of the parameters, a and b    *)
> (*--------------------------------------------------------*)
> toNextFu = {a Sin[#[[2]]],b Cos[#[[1]]] }&;   (* calculate next 2-value state from current state *)
> toLaterFu= Function[{s1,s2,laterNum},Flatten[Nest[toNextFu,{s1,s2},Round[laterNum]] ]]; (* calculate state laterNum of time units after current state *)
> errorFu=Function[{s1,s2, laterNum,n1,n2},Total[(toLaterFu[s1,s2, laterNum]-{n1,n2})^2]]; (* convert calculated state to an error so the function can be used inside FindFit[] *)
>
> (*----------------------------------------------------------------------------------------------------------------*)
> (* GENERATE 100 TRAINING DATA POINTS                                     *)
> (*  of {state1, state2, laterNum,  nextState1, nextState2, 0} when a= 0.5 and b 0.3         *)(*  0 added at the end because I want the model's error for each training point to be 0   *)
> (*---------------------------------------------------------------------------------------------------------------*)
> pSub={a->.5,b->.3}; (* parameter values selected to produce training dataset --*)
> data=Table[Flatten[{s1=RandomReal[{0,8}],s2=RandomReal[{0,8}],laterNum=RandomInteger[{1,2}],toLaterFu[s1,s2,laterNum]/.pSub,0}],{100}];
>
> (*-----------------------------*)
> (*        FIT THE DATA      *)
> (*-----------------------------*)
> Clear[a,b,s1,s2,laterNum,n1,n2];
> Quiet[fit=FindFit[data,errorFu[s1,s2, laterNum,n1,n2],{a,b},{s1,s2, laterNum,n1,n2}]];
> Print["Fitted parameters: ",fit];
> Print["Correct parameters: ",pSub];
>
> (*------------------------------------------------------------------------------------------*)
> (* SHOW A SMOOTH TOTAL ERROR SURFACE AROUND THE SOLUTION *)
> (*------------------------------------------------------------------------------------------*)
> (*--fitPoint - {fit for parm-A, fit for parm-B, total error at fit} --*)
> fitPoint=Flatten[{fit[[All,2]],Total[Map[(errorFu[Drop[#,-1]/.List->Sequence]/.fit)&,data]] }];
>
>   (*--targPoint - {actual parm-A, parm-B, total error with correct parms} --*)
> targPoint=Flatten[{{0.5,0.3},0}];
>
> (*-- Start and end a and b parameter values to be plotted --*)
> {startA, startB}=fit[[All,2]];
> {endA, endB}= {startA, startB} +0.4;
>
>   (*-------------------------------------------------------------------*)
> (*The  total error surface plot around the fitted (RED)  *)
> (* and correct parameter values (BLACK)                      *)
> (* THIS TAKES ABOUT 17 SEC ON MY COMPUTER        *)
> (*--------------------------------------------------------------------*)
> p=Plot3D[Total[ParallelMap[(errorFu[Drop[#,-1]/.List->Sequence]/.{a->valueA,b->valueB})&,data]],{valueA,startA,endA},{valueB,startB,endB},AxesLabel->Automatic];
> Show[p,Graphics3D[{{PointSize[0.02],Black,Point[targPoint]},{PointSize[0.02],Red,Point[fitPoint]}}] ]
>
> Finally, if FindFit[] is forced to start the search with a and b parameters values from -10 to 10 the same wrong solution is found suggesting further that a local solution
> is not being found. So where have I gone wrong?  Again, any help will be greatly appreciated!
>
> Thanks
>
> Ernie Jackson

[toc] | [prev] | [standalone]

Back to top | Article view | comp.soft-sys.math.mathematica

csiph-web