Re: [R] optim error - repost

From: Katharine Mullen <kate_at_few.vu.nl>
Date: Mon, 02 Jun 2008 00:19:37 +0200 (CEST)

try:

vol <- rep(c(0.03, 0.5, 2, 4, 8, 16, 32), 3)
time <- rep(c(2,4,8),each=7)
p.mated <- c(0.47, 0.48, 0.43, 0.43, 0.26, 0.23, NA, 0.68, 0.62, 0.64,
0.58, 0.53, 0.47, 0.24, 0.8, 0.79, 0.71, 0.56, 0.74, 0.8, 0.47)

eury <- data.frame(vol=vol, time=time, p.mated=p.mated) eury <- na.omit(eury)

p0 <- c(f=0.87, b=0.1, d=10)
eury.fit <- function(p, time, vol, p.mated) {

  f <- p[1]
  b <- p[2]
  d <- p[3]

  xx <- f*(1-exp(-b*time)-(b/(b-d/vol))*(exp(-d/vol*time)-exp(-b*time)))   ## minimize sum of square differences
  sum((p.mated - xx)^2)
}

eury.opt <- optim(par=p0, fn=eury.fit, method = "BFGS", hessian = TRUE,

                  time=eury$time, vol=eury$vol,
                  p.mated=eury$p.mated, control=list(trace=1))
## done with nls
eury.newfit1 <- nls(p.mated ~ f * ( 1 -
exp(-b*time)-(b/(b-d/vol))*(exp(-d/vol*time)-exp(-b*time))),
                    data=eury, start=list(f=.87, b=0.1, d=10),
                    trace=TRUE)

coef(eury.newfit1)

eury.opt$par

On Sun, 1 Jun 2008 keunhchoi_at_gmail.com wrote:

> Here is a clean version. I did this with nls and it works (see below), but
> I need to do it with optim. Keun-Hyung
>
> # optim
> vol<-rep(c(0.03, 0.5, 2, 4, 8, 16, 32), 3)
> time<-rep(c(2,4,8),each=7)
> p.mated<-c(0.47, 0.48, 0.43, 0.43, 0.26, 0.23, NA, 0.68, 0.62, 0.64, 0.58,
> 0.53, 0.47,
> 0.24, 0.8, 0.79, 0.71, 0.56, 0.74, 0.8, 0.47)
> eury<-data.frame(vol=vol, time=time, p.mated=p.mated)
> eury<-na.omit(eury); eury
>
> p0<- c(f=0.87, b=0.1, d=10)
> eury.fit <- function (f, time, vol)
> {
> f<-p[1]; b<-p[2]; d<-p[3]
> p.mated = p[1] * ( (1 -
> exp(-p[2]*time))-(p[2]/(p[2]-(p[3]/vol)))
> * (exp(-p[3]/vol*time)-exp(-p[2]*time)))
> }
> eury.opt<- optim(p0, fn=eury.fit, NULL, method = "BFGS", hessian = TRUE)
>
> # I received the following error message.
> Error in fn(par, ...) : argument "time" is missing, with no default
>
> ## done with nls - this works
> eury.newfit1 <- nls(p.mated ~ f * ( 1 -
> exp(-b*time)-(b/(b-d/vol))*(exp(-d/vol*time)-exp(-b*time))),
> data=eury, start=list(f=.87,
> b=0.1, d=10))
> v <- log10(range(eury$vol))
> y <- expand.grid(vol=10^seq(min(v), max(v), length=100), time=c(2,4,8))
> y$pred.mate.new <- predict(eury.newfit1,y)
>
> plot (eury$vol, eury$p.mated, type="n", log="x", xlab="Volume L", ylab =
> "Fraction Mating")
> for (i in c(2, 4, 8))
> {
> points(eury$vol[eury$time==i], eury$p.mated[eury$time==i], pch=16,
> col=(i/2)+1)
> lines(y$vol[y$time==i], y$pred.mate.new[y$time==i], lwd=3, col=i)
> }
> legend(.005,.2, c(" 2h","4h","8h"), col=c(2,4,8), lwd=3)
>
> [[alternative HTML version deleted]]
>
> ______________________________________________
> R-help_at_r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>



R-help_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide http://www.R-project.org/posting-guide.html and provide commented, minimal, self-contained, reproducible code. Received on Mon 02 Jun 2008 - 04:24:18 GMT

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Mon 02 Jun 2008 - 04:30:40 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-help. Please read the posting guide before posting to the list.

list of date sections of archive