# R/06ExtractComponent.R In metaheur: Metaheuristic Optimization Framework for Preprocessing Combinations

#### Documented in plotsearchpath

```getbestparameters <- function(x){

## FIND THE BEST OF THE MEANS OF RUNS

resulthistory <- lapply(x, function(x) x@res)
#firstresult <- lapply(resulthistory, function(z) apply(z, 2, function(z) head(z,1)))
lastresult <- lapply(resulthistory, function(z) apply(z, 2, nonNAtail))
#lasttofirst <- mapply("/", lastresult, firstresult, SIMPLIFY = FALSE)

walltime <- lapply(x, function(x) x@walltime)
walltime <- sum(unlist(walltime))

e <- t(data.frame(lastresult)) # data frame of last result rows, rows represent trials
bestmeanofruns <- apply(e, 2, mean)
bestmeans <- which.max(bestmeanofruns)
bestmeanvalue <- round(bestmeanofruns[bestmeans],2)

y <- lapply(resulthistory, function(x) x[,bestmeans])
lastresult2 <- unlist(lapply(y, nonNAtail))

bestscenario <- which.max(lastresult2)
worstscenario <- which.min(lastresult2)
medianscenario <-  which.min(abs(lastresult2 - median(lastresult2)))

c(bestmeans, bestscenario, worstscenario,medianscenario, bestmeanvalue, walltime)

}

# GET THE LAST NO-NA VALUE

nonNAtail <- function(x){
nonnas <- which(!is.na(x))
res <- tail(x[nonnas],1)
}

getbestparametername <- function(x){
name <- x[[1]]@namegrid[[getbestparameters(x)[1]]]
}

# PREPARE DATA FOR PLOTTING

prepareplotdata <- function(x){

if (class(x)=="list") {

bestmean <- getbestparameters(x)[1]
bestscenario <- getbestparameters(x)[2]
worstscenario <- getbestparameters(x)[3]
medianscenario <- getbestparameters(x)[4]
accuracy <- getbestparameters(x)[5]
walltime <- getbestparameters(x)[6]

bestmeans <- data.frame(lapply(x, function(x) x@res[,bestmean]))
colnames(bestmeans) <- seq(1,length(x))
colnames(bestmeans)[bestscenario] <- "Best run"
colnames(bestmeans)[worstscenario] <- "Worst run"
colnames(bestmeans)[medianscenario] <- "Median run"

data <- bestmeans[,c(bestscenario, worstscenario, medianscenario)]

data\$Iteration <- seq(1,nrow(x[[1]]@res))

plotdata <- reshape2::melt(data, id.vars=c("Iteration"))

name <- paste("Accuracy:",accuracy,"(",walltime,"mins)", getbestparametername(x))

}

if (class(x)=="metaheur") {

tempdata <- data.frame(fillna(x@iterationhistory))
colnames(tempdata) <- paste("start", seq(1,ncol(tempdata)))
tempdata\$Iteration <- seq(1,nrow(tempdata))
plotdata <- reshape2::melt(tempdata, id.vars="Iteration")

name <- getbestheur(x)[[1]]
accuracy <- round(getbestheur(x)[[2]],2)
walltime <- x@walltime
solution <- paste(names(name), unname(unlist(name[1,])), sep=":",collapse=";")
name <- paste("Accuracy:",accuracy," (",walltime,"mins) ", sep="")

}

list(plotdata, name)
}

#' plot search path
#'
#' Plots the search path, i.e. classification accuracy by iteration.
#' metaheur class plots (output of metaheur function) can include restarts.
#' List of metaheurhyper class objects (output of metaheurhyper function) plot
#' includes best, median and worst scenarious.
#' @param x (metaheur object or list of metaheurgrid class objects) object to be plotted
#' @examples
#' plotsearchpath(examplesearch)
#' plotsearchpath(examplehyperparam)
#' @export

plotsearchpath <- function(x){

params <- prepareplotdata(x)
plotdata <- params[[1]]
paramname <- params[[2]]

g1 <- ggplot(plotdata, aes(x=Iteration, y=value)) + geom_line() + facet_wrap(~ variable) + theme_bw() + ggtitle(paramname)
g1 <- g1 + theme(plot.title = element_text(size = 10))
g1
}
```

## Try the metaheur package in your browser

Any scripts or data that you put into this service are public.

metaheur documentation built on May 29, 2017, 2:14 p.m.