[This article was first published on [R] tricks, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
The GenEstim function presented here uses a very simple genetic algorithm to estimate parameters. The function returns the best estimated set of parameters ($estim), the AIC ($information) at each generation, and the cost of the best model ($bestcost) at each generation.
Results of running the program with a logistic function :
Logis = function(x,p) p[[1]]/(1+p[[2]]*exp(-p[[3]]*x)) RSS = function(par) sum((Logis(X,par)-Y)^2) aic <- function(yvalues,rss,par) { k <- length(par) n <- length(yvalues) aic <- 2*k+n*log(rss/n) return(aic) } P <- list(2,10,4) X <- seq(from=-5,to=5,by=0.1) Y <- Logis(X,P) + rnorm(length(X),sd=0.1) plot(X,Y,pch=19,col='grey') GenEstim <- function( start.pars, cost = RSS, ..., numiter = 1e3, npop = 1e2) { bestcost <- NULL cur.AIC <- NULL for(it in 1:numiter) { pop <- matrix(0,ncol=length(start.pars),nrow=npop) for(p in 1:length(start.pars)) { pop[,p] <- rnorm(npop,start.pars[[p]],sd=1) pop[1,p] <- start.pars[[p]] } Costs <- NULL for(i in 1:nrow(pop)) { li <- as.list(pop[i,]) Costs[i] <- cost(li) } bestcost <- c(bestcost,min(Costs)) best <-which.min(Costs) start.pars <- as.list(pop[best,]) cur.AIC <- c(cur.AIC,aic(Y,RSS(start.pars),start.pars)) } return(list(estim=start.pars,information=cur.AIC,convergence=bestcost)) } simul <- GenEstim(list(0,0,0)) x.control <- seq(from=-6,to=6,by=0.1) lines(x.control,Logis(x.control,simul$estim),col='orange',lwd=3)
To leave a comment for the author, please follow the link and comment on their blog: [R] tricks.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.