Nothing
# scale_linewidth_manual not in ggplot2 3.4.0
#' Plot best fitness by iteration.
#'
#' @param darwin_data Object of class \code{darwin_data}.
#' @param ... Additional arguments.
#'
#' @return Object of class \code{ggplot}.
#' @export
#'
#'
fitness_vs_iteration <- function(darwin_data, ...) {
args <- list(...)
if (!is.null(args$annotate)) {
annotate <- args$annotate
} else {
annotate <- TRUE
}
stopifnot(inherits(darwin_data, "darwin_data"))
algorithm <- darwin_data$options$algorithm
if (tolower(algorithm) == "ex" || tolower(algorithm) == "exhaustive") {
stop("Algorthim is exhaustive, there are no iterations for plotting in exhaustive search",
call. = FALSE)
}
crash_value <- darwin_data$options$crash_value
if (is.null(crash_value)) {
crash_value <- 99999999
}
results_df <- darwin_data$results
fitness_by_iteration <- summarise_fitness_by_iteration(darwin_data)
min_overall_fitness <- min(fitness_by_iteration$min_fitness)
min_overall_fitness_df <-
fitness_by_iteration %>% slice(match(min_overall_fitness, min_fitness)) %>%
mutate(Fitness = "min_cum_fitness")
fitness_by_iteration_long <- fitness_by_iteration %>%
select(-min_fitness) %>%
tidyr::pivot_longer(cols = !iteration, names_to = "Fitness")
gg <-
ggplot(data = fitness_by_iteration_long, aes(
x = iteration,
y = value,
group = 1,
colour = Fitness,
linetype = Fitness,
linewidth = Fitness
)) +
geom_line() +
facet_wrap(~ Fitness,
scales = "free_y",
ncol = ifelse(!is.null(args$ncol), args$ncol, 1),
nrow = args$nrow) +
labs(
title = "Fitness vs Iteration",
subtitle = paste0(
"Algorithm: ",
algorithm,
" ",
"Best Fitness: ",
min_overall_fitness_df$min_fitness,
" ",
"Iteration: ",
min_overall_fitness_df$iteration
),
caption = ifelse(is.null(args$caption), paste0("Project Directory: ", darwin_data$project_dir), args$caption),
cols = c("Mean Fitness", "Min Fitness"),
x = ifelse(is.null(args$xlab), "Iteration", args$xlab),
y = ifelse(is.null(args$ylab), "Fitness", args$ylab),
) +
scale_colour_manual(values =
if(is.null(args$line.colors)) {
c("#87CEFA", "#0000FF")
} else {
args$line.colors
},
labels = c('mean', 'minimum')) +
scale_linetype_manual(values =
if(is.null(args$line.type)) {
c("solid", "solid")
} else {
args$line.type
},
labels = c('mean', 'minimum')) +
scale_linewidth_manual(values =
if(is.null(args$line.width)) {
c(1, 1)
} else {
args$line.width
},
labels = c('mean', 'minimum'))
if (annotate) {
gg <- gg + geom_text(
data = min_overall_fitness_df,
aes(x = iteration, y = min_cum_fitness),
inherit.aes = FALSE,
label = "\u2605",
size = ifelse(is.null(args$annotate.size), 5, args$annotate.size),
parse = FALSE
)
}
gg <- gg + theme_certara(
grid = "both",
legend.position = ifelse(is.null(args$legend.position), "right", args$legend.position),
legend.direction = ifelse(
is.null(args$legend.direction),
"vertical",
args$legend.direction
),
strip.text.x = ggplot2::element_blank()
) +
theme(
axis.text.x = element_text(
angle = 90,
vjust = 0.5,
hjust = 1
),
plot.caption.position = "plot",
legend.position = ifelse(is.null(args$legend.position), "right", args$legend.position)
)
return(gg)
}
#' Plot minimum fitness by iteration with penalty composition.
#'
#' @param darwin_data Object of class \code{darwin_data}.
#' @param group_penalties Logical; defaults to \code{TRUE}.
#' @param scale_ofv Set to \code{TRUE} to rescale OFV axis limit. Used to better observe penalty effects.
#' @param ... Additional arguments.
#'
#' @return Object of class \code{ggplot}.
#' @export
#'
#'
fitness_penalties_vs_iteration <- function(darwin_data, group_penalties = TRUE, scale_ofv = TRUE, ...) {
stopifnot(inherits(darwin_data, "darwin_data"))
args <- list(...)
algorithm <- darwin_data$options$algorithm
if (tolower(algorithm) == "ex" || tolower(algorithm) == "exhaustive") {
stop("Algorthim is exhaustive, there are no iterations for plotting in exhaustive search",
call. = FALSE)
}
fitness_penalties_by_iteration <-
summarise_fitness_penalties_by_iteration(darwin_data, group_penalties)
fitness_penalties_by_iteration_long <- fitness_penalties_by_iteration %>%
select(-fitness) %>%
tidyr::pivot_longer(cols = !iteration, names_to = "fitness")
min_overall_fitness <- min(fitness_penalties_by_iteration$fitness)
min_overall_fitness_df <-
fitness_penalties_by_iteration %>%
slice(match(min_overall_fitness, fitness))
max_overall_fitness <- max(fitness_penalties_by_iteration$fitness)
#reorder factor levels for plot, make ofv last col so penalties are stacked on top
fitness_cols <-
c(colnames(fitness_penalties_by_iteration)[grep("^penalt", colnames(fitness_penalties_by_iteration))],
"ofv")
fitness_penalties_by_iteration_long$fitness <-
factor(
fitness_penalties_by_iteration_long$fitness,
levels = fitness_cols
)
if (is.null(args$fill.colors)) {
fill_colors <- c(
"#A50026",
"#D73027",
"#F46D43",
"#FDAE61",
"#FEE090",
"#FFFFBF",
"#E0F3F8",
"#ABD9E9",
"#74ADD1"
)
fill_colors <- c(fill_colors[1:length(fitness_cols) - 1], "#4575B4")
} else {
fill_colors <- args$fill.colors
}
gg <- ggplot(fitness_penalties_by_iteration_long, aes(fill=fitness, y=value, x=iteration)) +
geom_bar(position="stack", stat="identity") +
labs(
title = "Fitness-Penalties vs Iteration",
subtitle = paste0(
"Algorithm: ",
algorithm,
" ",
"Best Fitness: ",
min_overall_fitness_df$fitness,
" ",
"Iteration: ",
min_overall_fitness_df$iteration
),
caption = paste0("Project Directory: ", darwin_data$project_dir),
x = "Iteration",
y = "Min Fitness"
) +
scale_fill_manual(values = fill_colors) +
guides(fill=guide_legend(title=ifelse(is.null(args$legend.title), "Fitness", args$legend.title)))
gg <- gg + theme_certara(
grid = "both",
legend.position = ifelse(is.null(args$legend.position), "right", args$legend.position),
legend.direction = ifelse(
is.null(args$legend.direction),
"vertical",
args$legend.direction
)
) +
theme(
axis.text.x = element_text(
angle = 90,
vjust = 0.5,
hjust = 1
),
plot.caption.position = "plot"
)
#
if (scale_ofv) {
gg <- gg + ggplot2::coord_cartesian(ylim = c(round(min_overall_fitness_df$ofv * .95, -1),
max_overall_fitness))
}
return(gg)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.