R/mod_read_qc_boxplot_fct.R

In teofiln/gene.editing.dash: VOR Gene Editing Dashboard

read_qc_boxplot <-
  function(.data,
           .group_var,
           .sort_var = NULL,
           .facet_var = NULL,
           .colors = c("#706699", "#8498b9"),
           .dims = c(500, 500),
           .interactive = TRUE) {

    data_columns <- c("ReadsTotal",
                      "Unmodified",
                      "Modified",
                      "UnmodifiedPct",
                      "ModifiedPct")
    required_columns <-
      c(.group_var)

    shiny::validate(shiny::need(
      checkmate::test_subset(required_columns, c(colnames(.data), "none")),
      message = "A selected configuration variable is not among the columns in the data for this project. Please choose another option."
    ))

    .grp <- rlang::sym(.group_var)

    if (is.null(.sort_var) | .sort_var == "none") {
      .srt <- NULL
    } else {
      .srt <- rlang::sym(.sort_var)
      required_columns <- unique(append(required_columns, .sort_var))
    }

    if (is.null(.facet_var) | .facet_var == "none") {
      .fct <- NULL
    } else {
      .fct <- rlang::sym(.facet_var)
      required_columns <- unique(append(required_columns, .facet_var))
    }

    all_required_columns <- c(required_columns, data_columns)

    .data_sub <-
      .data %>%
      dplyr::select(dplyr::all_of(all_required_columns)) %>%
      dplyr::group_by(!!!rlang::syms(required_columns)) %>%
      dplyr::mutate(dplyr::across(data_columns, as.numeric)) %>%
      dplyr::mutate(dplyr::across(data_columns, mean, na.rm = TRUE)) %>%
      dplyr::mutate(dplyr::across(data_columns, round, 2)) %>%
      dplyr::distinct(!!.grp, .keep_all = TRUE) %>%
      dplyr::mutate(UnmodifiedPct = paste(UnmodifiedPct, "%")) %>%
      dplyr::mutate(ModifiedPct = paste(ModifiedPct, "%"))

    .counts <-
      .data_sub %>%
      dplyr::select(!!.grp, !!.srt, !!.fct, Unmodified, Modified) %>%
      tidyr::pivot_longer(
        names_to = "Category",
        values_to = "Count",
        cols = c("Unmodified", "Modified")
      )

    .percents <- .data_sub %>%
      dplyr::select(!!.grp, !!.srt, !!.fct, UnmodifiedPct, ModifiedPct) %>%
      tidyr::pivot_longer(
        names_to = "Category",
        values_to = "Percent",
        cols = c("UnmodifiedPct", "ModifiedPct")
      ) %>%
      dplyr::mutate(Category = stringr::str_remove(Category, "Pct"))

    join_by <- unique(c(.group_var, .sort_var, .facet_var, "Category")) %>%
      purrr::keep(~ . %in% names(.counts))

    .data_long <- dplyr::left_join(.counts, .percents, by = join_by)

    if (!is.null(.srt) && .sort_var %in% names(.data_long)) {
      .data_long <- .data_long %>%
        dplyr::arrange(!!rlang::sym(.sort_var)) %>%
        dplyr::mutate(!!.grp := factor(!!.grp, levels = unique(!!.grp)))

      GG <-
        .data_long %>%
        ggplot2::ggplot() +
        ggplot2::aes(
          x = interaction(!!.grp, !!.srt),
          y = Count,
          fill = Category,
          label = Percent
        )
    } else {
      GG <-
        .data_long %>%
        ggplot2::ggplot() +
        ggplot2::aes(
          x = !!.grp,
          y = Count,
          fill = Category,
          label = Percent
        )
    }



     GG <- GG +
      ggplot2::geom_col(position = "stack", color = "white") +
      # ggplot2::geom_text() +
      ggplot2::scale_fill_manual(values = list("Unmodified" = .colors[[1]], "Modified" = .colors[[2]])) +
      ggplot2::scale_y_continuous(
        n.breaks = 6,
        labels = scales::label_number(
          scale = 0.001,
          accuracy = 0.1,
          suffix = "k"
        )
      ) +
      ggplot2::theme_bw() +
      ggplot2::labs(x = "")

    if (!is.null(.facet_var) && .facet_var %in% names(.data_long)) {
     GG <- GG + ggplot2::facet_wrap(.facet_var, scales = "free_x")
    }

    if (.interactive) {
      GG <- plotly::ggplotly(GG, width = .dims[[1]], height = .dims[[2]]) %>%
        plotly::config(displaylogo = FALSE)
    }

    GG
  }


# unused but potentially useful
# plotly stacked barchart
# plotly::plot_ly(data = .data_sub) %>%
#   plotly::add_trace(
#     y = ~ SampleName,
#     x = ~ Unmodified,
#     type = 'bar',
#     name = '% Unmodified',
#     marker = list(color = .colors[[1]]),
#     orientation = "h",
#     text = ~ UnmodifiedPct,
#     textposition = 'auto'
#   ) %>%
#   plotly::add_trace(
#     y = ~ SampleName,
#     x = ~ Modified,
#     type = "bar",
#     orientation = "h",
#     name = "% Modified",
#     marker = list(color = .colors[[2]]),
#     text = ~ ModifiedPct,
#     textposition = 'auto'
#   ) %>%
#   plotly::layout(
#     xaxis = list(title = ''),
#     xaxis = list(title = ''),
#     barmode = 'stack'
#   )