[Pomp-commits] r502 - pkg/R

[noreply at r-forge.r-project.org]

Author: kingaa
Date: 2011-05-27 21:48:16 +0200 (Fri, 27 May 2011)
New Revision: 502

Modified:
   pkg/R/nlf.R
Log:
- fix newly introduced bug


Modified: pkg/R/nlf.R
===================================================================
--- pkg/R/nlf.R	2011-05-27 19:42:59 UTC (rev 501)
+++ pkg/R/nlf.R	2011-05-27 19:48:16 UTC (rev 502)
@@ -88,32 +88,50 @@
     return(-val)
   }
 
-  optimizer <- switch(
-                      method,
-                      subplex=subplex::subplex,
-                      stats::optim
-                      )
+  if (method == 'subplex') {
+    opt <- subplex::subplex(
+                            par=guess,
+                            fn=nlf.objfun,
+                            object=object,
+                            params=params,
+                            par.index=par.index, 
+                            times=times,
+                            t0=t0,
+                            lags=lags,
+                            period=period,
+                            tensor=tensor,
+                            seed=seed,
+                            transform=transform,
+                            nrbf=nrbf, 
+                            verbose=verbose,
+                            bootstrap=bootstrap,
+                            bootsamp=bootsamp,
+                            control=list(...)
+                            )
+  } else {
+    opt <- optim(
+                 par=guess,
+                 fn=nlf.objfun,
+                 gr=gr,
+                 method=method, 
+                 object=object,
+                 params=params,
+                 par.index=par.index, 
+                 times=times,
+                 t0=t0,
+                 lags=lags,
+                 period=period,
+                 tensor=tensor,
+                 seed=seed,
+                 transform=transform,
+                 nrbf=nrbf, 
+                 verbose=verbose,
+                 bootstrap=bootstrap,
+                 bootsamp=bootsamp,
+                 control=list(...)
+                 )  
+  }
 
-  opt <- optimizer(
-                   par=guess,
-                   fn=nlf.objfun,
-                   object=object,
-                   params=params,
-                   par.index=par.index, 
-                   times=times,
-                   t0=t0,
-                   lags=lags,
-                   period=period,
-                   tensor=tensor,
-                   seed=seed,
-                   transform=transform,
-                   nrbf=nrbf, 
-                   verbose=verbose,
-                   bootstrap=bootstrap,
-                   bootsamp=bootsamp,
-                   control=list(...)
-                   )
-
   opt$est <- est
   opt$value <- -opt$value
   params[par.index] <- opt$par