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 [EMAIL PROTECTED] 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@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@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.