R/stats_utils.R

In d2gex/seabasstfm: What the Package Does (One Line, Title Case)

generate_bar_plot <-
  function(data,
           x_col_name,
           y_col_name,
           main_title,
           legend_title,
           x_title,
           y_title,
           month_as_name = TRUE,
           do_round = TRUE,
           show_bar_values = TRUE,
           show_legend = TRUE,
           show_title = TRUE,
           show_x_axis_label = TRUE,
           p_title_size = 0.5) {
    data_ <-
      data.frame(x_axis = data[[x_col_name]], y_axis = data[[y_col_name]])
    data_[sapply(data_, is.na)] <- 0
    data_[sapply(data_, is.nan)] <- 0
    data_[sapply(data_, is.infinite)] <- 0
    
    data_ <-
      data_ %>%
      group_by(x_axis) %>%
      mutate(total_count = sum(y_axis))
    
    if (do_round) {
      data_$y_axis <- round(data_$y_axis, 2)
    }
    if (month_as_name) {
      data_ <- data_ %>%
        # Work with a known factor and assign it to the tarteted columns
        mutate(x_axis = paste(str_sub(x_axis, 1, 4),
                              month.abb[as.numeric(as.character(str_sub(x_axis, 6, 7)))],
                              sep = "-"))
      
    }
    
    top_bar_labels <- data_ %>%
      group_by(x_axis) %>%
      summarise(y_axis = sum(y_axis), .groups = "drop")
    
    g <-
      ggplot(data = data_, aes(x = reorder(x_axis,-y_axis), y = y_axis))
    if (show_title) {
      g <- g + ggtitle(main_title)
    }
    if (show_bar_values) {
      g <- g +
        geom_text(
          data = top_bar_labels,
          aes(label = y_axis, y = y_axis),
          vjust = -0.5,
          size = 2
        )
    }
    
    g <- g +
      geom_bar(stat = "identity", aes(fill = data_$total_count)) +
      scale_fill_gradient(
        low = "yellow",
        high = "red",
        na.value = NA,
        name = legend_title
      ) 
    if (show_x_axis_label) {
      g <- g + xlab(x_title)
    }
    else {
      g <- g + xlab(NULL)
    }
    g <- g + 
      ylab(y_title) +
      theme_bw() +
      theme(
        axis.text.x = element_text(angle = 90, hjust = 1),
        plot.title = element_text(hjust = p_title_size, face = "bold"),
        legend.position = ifelse(show_legend, "right", "none")
      )
    return (g)
  }


generate_cumulative_detection_plot <-
  function(df,
           main_title,
           line_legend_title,
           bar_legend_title,
           x_var,
           x_lab,
           y_lab,
           month_as_name = FALSE,
           show_x_axis_label = TRUE,
           show_legend = TRUE) {
    if (month_as_name) {
      df$workbench_col <- df[[x_var]]
      df <- df %>%
        # Work with a known factor and assign it to the tarteted columns
        mutate(!!x_var := paste(str_sub(workbench_col, 1, 4),
                                month.abb[as.numeric(as.character(str_sub(workbench_col, 6, 7)))],
                                sep = "-")) %>%
        # Get rid of the now factor as it is no longer needed
        select(c(-workbench_col))
      
    }
    
    g <-
      ggplot(data = df, aes(x = reorder(!!sym(x_var),-percentage))) +
      ggtitle(main_title) +
      geom_bar(aes(y = percentage, fill = percentage),
               width = .7,
               stat = "identity") +
      geom_text(
        aes(label = detections, y = percentage),
        vjust = -0.5,
        hjust = -0.5,
        size = 2
      ) +
      geom_line(aes(
        y = cum,
        group = 1,
        linetype = line_legend_title
      )) +
      geom_point(aes(y = cum, label = 6)) +
      geom_text(
        aes(label = paste0(cum, "%"), y = cum),
        vjust = 0,
        hjust = 1,
        size = 2
      )
    if (show_x_axis_label) {
      g <- g + xlab(x_lab)
    }
    else {
      g <- g + xlab(NULL)
    }
    
    g <- g +
      ylab(y_lab) +
      labs(fill = "", linetype = "") +
      scale_fill_gradient(
        low = "yellow",
        high = "red",
        na.value = NA,
        name = bar_legend_title
      ) +
      theme_bw() +
      theme(
        axis.text.x = element_text(angle = 90, hjust = 1),
        plot.title = element_text(hjust = 0.5, face = "bold"),
        legend.position = ifelse(show_legend, "right", "none")
      )
    
    return(g)
    
  }