In davidsbutcher/GUPPI: Summarize, expand, and visualize top-down analysis results

# knitr::opts_knit$set(base.dir = normalizePath(tempdir(), winslash = '/'))

library(flexdashboard)
library(knitr)
library(magrittr)
library(stringr)
library(purrr)
library(forcats)
library(UpSetR)
library(ggplot2)
library(DT)
library(plotly)
library(ggthemes)
library(viridis)
library(waffle)
library(dplyr)
library(sessioninfo)
library(fontawesome)

if (is.null(fractionAssignments) == TRUE) {
  fracAss = "Automatic"
} else {
  fracAss = "Manual"
}

GUPPI_version <- 
  sessioninfo::session_info()$packages %>%
  dplyr::filter(package == "GUPPI") %>%
  .$loadedversion

if (any(purrr::as_vector(fileType) == "tdreport")) {

  unique_PTMs <- 
    results_proteoform_modcounts %>% 
    dplyr::group_by(results_file_name) %>% 
    dplyr::summarize(UniquePTMs = length(unique(ModificationName)))

  unique_PTMs2 <- 
    map(fileList, basename) %>% 
    unlist() %>% 
    {tibble(results_file_name = .)} %>% 
    left_join(unique_PTMs) %>% 
    pull(UniquePTMs)

  most_popular_name <- 
    results_proteoform_modcounts %>% 
    dplyr::group_by(results_file_name) %>% 
    dplyr::filter(Count == max(Count))

  most_popular_name2 <- 
    map(fileList, basename) %>% 
    unlist() %>% 
    {tibble(results_file_name = .)} %>% 
    left_join(most_popular_name) %>% 
    pull(ModificationName)

  most_popular_count <- 
    results_proteoform_modcounts %>% 
    dplyr::group_by(results_file_name) %>% 
    dplyr::filter(Count == max(Count)) %>% 
    dplyr::pull(Count)

} else {

  unique_PTMs2 <- 
    rep(NA, length(fileList))

  most_popular_name2 <- 
    rep(NA, length(fileList))

}

Summary

Row

`r htmltools::tags$h4("Files analyzed")`

tibble(
  `Results File Name` = map(fileList, basename) %>% unlist(),
  `Protein Count` = map(results_protein[1:length(fileList)], nrow) %>%
    map_if(is.null, ~NA) %>% 
    unlist(),
  `Proteoform Count` = 
    map(results_proteoform[1:length(fileList)], nrow) %>%
    map_if(is.null, ~NA) %>% 
    unlist(),
  `Unique PTM Count` = unique_PTMs2,
  `Most common PTM` = most_popular_name2
) %>% 
  knitr::kable()

`r htmltools::tags$h4("GUPPI analysis parameters")`

False detection rate: r fdr*100%

Taxon number of UniProt database: r as.integer(taxonNumber)

Taxon for determination of subcellular locations: r GOLocType

Fraction assignment: r fracAss

GUPPI version: r GUPPI_version

GUPPI report type: r if (staticDashboard == FALSE) "Dynamic (includes HTML widgets)" else "Static"

knitr::asis_output("\n")
knitr::asis_output("Row {data-height:400}\n")
knitr::asis_output("-------------------------------------\n")
knitr::asis_output("### `r htmltools::tags$h4('PTM summary')`")

PTM_summary_table <- 
  results_proteoform_modcounts %>% 
  dplyr::select(results_file_name, dplyr::everything())

if (staticDashboard == FALSE) {

  PTM_summary_table %>% 
    DT::datatable(
      extensions = c("Buttons", "Scroller"),
      class = "wrap",
      options = list(
        autoWidth = TRUE,
        deferRender = TRUE,
        scrollY = "350px",
        scrollX = "600px",
        scroller = FALSE,
        columnDefs = list(
          list(
            className = 'dt-center'
          )
        ),
        dom = "Bfrtip",
        buttons = c("copy", "csv", "excel", "colvis")
      )
    ) %>% 
    DT::formatStyle(
      1:length(results_resultparameters),
      fontSize = "9"
    ) %>% 
    DT::formatStyle(
      3,
      columnWidth = "100px",
      fontSize = "6"
    )

} else {

  knitr::kable(PTM_summary_table) 

}

Row {data-height:400}

`r htmltools::tags$h4("Search parameters")`

knitr::asis_output("\n")
knitr::asis_output("Row {data-height:400}\n")
knitr::asis_output("-------------------------------------\n")
knitr::asis_output("### `r htmltools::tags$h4('Search parameters')`")

search_parameters_table <- 
  results_resultparameters %>% 
  dplyr::mutate(
    Value = 
      stringr::str_replace_all(Value, stringr::fixed(","), ";")
  ) %>% 
  dplyr::select(
    results_file_name, ResultSet, Name, Value, IsActive, GroupName, dplyr::everything()
  )

if (staticDashboard == FALSE) {

  search_parameters_table %>% 
    DT::datatable(
      extensions = c("Buttons", "Scroller"),
      class = "wrap",
      options = list(
        autoWidth = TRUE,
        deferRender = TRUE,
        scrollY = "350px",
        scrollX = "600px",
        scroller = FALSE,
        columnDefs = list(
          list(
            className = 'dt-center'
          )
        ),
        dom = "Bfrtip",
        buttons = c("copy", "csv", "excel", "colvis")
      )
    ) %>% 
    DT::formatStyle(
      1:length(results_resultparameters),
      fontSize = "9"
    ) %>% 
    DT::formatStyle(
      3,
      columnWidth = "100px",
      fontSize = "6"
    )

} else {

  knitr::kable(search_parameters_table)

}

knitr::asis_output("\n")
knitr::asis_output("Row \n")
knitr::asis_output("-------------------------------------\n")
knitr::asis_output("### `r htmltools::tags$h4('Protein ID UpSet for analyzed results files')`")

proteins_list <- 
  results_protein %>%
  .[1:(length(.) - 1)] %>% 
  map(~.$UNIPROTKB) %>% 
  set_names(
    map(fileList, basename) %>% 
      map(tools::file_path_sans_ext) %>% 
      map(str_wrap, width = 15)
  )

UpSetR::upset(
  UpSetR::fromList(proteins_list),
  nintersects = NA,
  sets.x.label = "Total Protein IDs",
  keep.order = T,
  mainbar.y.label = "Unique Protein IDs in Intersection",
  text.scale =  c(2, 2.5, 2, 2, 1.5, 2),
  point.size = 4,
  line.size = 1.5,
  group.by = "degree"
)

knitr::asis_output("\n")
knitr::asis_output("Row \n")
knitr::asis_output("-------------------------------------\n")
knitr::asis_output("### `r htmltools::tags$h4('Proteoform ID UpSet for analyzed results files')`")


pfrms_list <-
  results_proteoform %>%
  .[1:(length(.) - 1)] %>%
  map(~.$ProteoformRecordNum) %>%
  set_names(
    map(fileList, basename) %>%
      map(tools::file_path_sans_ext) %>%
      map(str_wrap, width = 15)
  )

UpSetR::upset(
  UpSetR::fromList(pfrms_list),
  nintersects = NA,
  sets.x.label = "Total Proteoform IDs",
  keep.order = T,
  mainbar.y.label = "Unique Proteoform IDs in Intersection",
  text.scale =  c(2, 2.5, 2, 2, 1.5, 2),
  point.size = 4,
  line.size = 1.5,
  group.by = "degree"
)

out <- NULL

options(knitr.duplicate.label = 'allow')

for (i in seq_along(fileList)) {

  out <- c(
    out, 
    knitr::knit_child(
      system.file(
        "rmd",
        if (staticDashboard == FALSE) {
          "generate_dashboard_child.Rmd"
        } else {
          "generate_dashboard_child_static.Rmd"
        },
        package = "GUPPI"
      )    
    )
  )

}

r paste(knitr::knit_child(text = out), collapse = '')

About

This report was generated using GUPPI, which is developed by David S. Butcher and provided as a service by the biological applications subgroup of the ICR User Facility at the National High Magnetic Field Laboratory.

GUPPI development is supported by the National Science Foundation Division of Chemistry through DMR-1644779 and the State of Florida. All packages used in the creation of GUPPI are licensed as stated in their documentation and their inclusion does not imply support or endorsement from their respective developers.

NHMFL Logo NSF Logo