Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2012

[Date Index] [Thread Index] [Author Index]

Search the Archive

Dancing "a la Levenberg-Marquardt" to get the best Logistic Model.

  • To: mathgroup at smc.vnet.net
  • Subject: [mg124829] Dancing "a la Levenberg-Marquardt" to get the best Logistic Model.
  • From: Gilmar Rodriguez-pierluissi <peacenova at yahoo.com>
  • Date: Wed, 8 Feb 2012 05:33:58 -0500 (EST)
  • Delivered-to: l-mathgroup@mail-archive0.wolfram.com
  • Reply-to: Gilmar Rodriguez-pierluissi <peacenova at yahoo.com>

Dear Math Group:
(**I start with the following population values between 1972 to 2008:**)
In[2]:= popvalues = {217928, 219129, 221577, 227481, 231748, 233514, 
   232857, 233664, 235228, 240526, 243310, 249587, 250128, 253383, 
   257751, 261999, 258229, 262567, 263272, 267643, 272468, 274035, 
   276154, 278323, 282606, 289505, 295243, 293956, 294410, 296399, 
   297382, 298289, 299248, 296785, 299359, 300184, 299993};
In[3]:= L = Length[popvalues];
(** The highest (projected) value that the population can reach is: **)
In[4]:= pop2020 = 304909;
(** Assemble the data to do build a "scatter plot" **)
In[5]:= popvalues2D = 
  Join[Table[{i, popvalues[[i]]}, {i, 1, L}], {{49, pop2020}}];
In[6]:= plt1 = ListPlot[popvalues2D]
Out[6]= (** Plot ommited **)
(** Let: **)
In[7]:= K = pop2020
Out[7]= 304909
In[8]:=
 Subscript[P, 1] = popvalues[[1]]
Out[8]= 217928
(** I'm attempting to use a Population Logistic model similar to one \
found in (where else?) Wikipedia:
http://en.wikipedia.org/wiki/Logistic_function under the title: "In \
ecology: modeling population growth". **)
(** Since I need this model to satisfy Logistic[1]= Subscript[P, 1] \
and Lim t -> Infinity Logistic[t] = K; I came up with the following \
version of the Logistic Model to handle the above data set \
appropriately: **)
(** Logistic[t_]=(K Subscript[P, 1]Exp[rt])/(K Exp[r]+ Subscript[P, \
1](Exp[er]-Exp[r])); **)
(** If you inspect this model ("by hand") you will see that \
Logistic[1]= Subscript[P, 1] (the first population data point). Using \
L'Hopital's Rule; one can show that Lim t -> Infinity (Logistic[t]) = \
K; by taking the derivative of the numerator and denominator with \
respect to t and performing the appropriate cancellations. Again; K \
is the highest value that the population can reach "by design".  **) 
(** Logistic[t_]=(Subscript[P, 1] E^(r*t))/(E^r+ Subscript[P, 1] \
(E^(r*t)- E^r)/K); **)
(** The model is equivalent to: **)\[AliasDelimiter]
In[13]:= Logistic[t_] = ( Subscript[P, 1] Exp[r t])/(
  Exp[r] + Subscript[P, 1] (Exp[r t] - Exp[r])/K);
(** I' m expecting Logistic[1] = 217928 and indeed : )
In[14]:= Logistic[1]
Out[14]= 217928
(** but, unfortunately; **)
In[16]:= Limit[Logistic[t], t -> Infinity]
 Out[16]= Limit[(217928 E^(r t))/(
 E^r + (217928 (-E^r + E^(r t)))/304909), t -> \[Infinity]]
(** and: **)
In[15]:= Logistic[49]
Out[15]=
= (217928 E^(49 r))/(E^r + (217928 (-E^r + E^(49 r)))/304909)
(** I can see the the function Logistic[t] requires to be "herded" \
(somehow) so that cancellations of terms can take place. Perhaps \
using "Hold[]" and "ReleaseHold[]; I just don't know how. **)
(** I need to overcome the above hurdle before evaluating:  **)
logisticnlm = NonlinearModelFit[popvalues2D, Logistic[t, r], {r}, t]
(** I want to use the initial point Subscript[P, 1] and end point \
Subscript[P, 49] as "pivot points" and use NonlinearModelFit to get \
the Best Fit Non-Linear Regression via a "dance a la Levenberg-Marquardt" \
similar to the dance shown here:
http://www.numerit.com/samples/nlfit/doc.htm **)
(** Thank you for your help! **)


  • Prev by Date: Re: Getting stuck with finding an elegant solution without global variables
  • Next by Date: Re: need to find polyhedrons with less than a 24 vertex array in PolyhedronData[]
  • Previous by thread: Re: Kolmogorov Smirnov in two or more dimensions
  • Next by thread: Re: Dancing "a la Levenberg-Marquardt" to get the best Logistic Model.