R/plotting.R

Defines functions fitness_penalties_vs_iteration fitness_vs_iteration

Documented in fitness_penalties_vs_iteration fitness_vs_iteration

# 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)
}

Try the Certara.DarwinReporter package in your browser

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

Certara.DarwinReporter documentation built on April 4, 2025, 2:22 a.m.