inst/Shiny-apps/app.R

In jonotuke/painBiomarkR: This package gives easy access to the compiled data on pain biomarkers

# https://shiny.rstudio.com/gallery/basic-datatable.html

library(tidyverse)
library(painBiomarkR)

paper_biomarker  <- left_join(papers, biomarkers, by = c("Study PMID" = "STUDY (PMID)"))

ui <- fluidPage(
  title = "Pain biomarker viewer",
  titlePanel("Pain bioMarker datasets"),
  sidebarLayout(
    sidebarPanel(
      conditionalPanel(
        'input.sheet === "biomarker"',
        selectInput("biomark",
                    "Biomarker:",
                    c("All",
                      unique(as.character(biomarkers$BIOMARKER)))),
        selectInput("tissue",
                    "Tissue:",
                    c("All",
                      unique(as.character(biomarkers$TISSUE)))),
        selectInput("mrna",
                    "mRNA:",
                    c("All",
                      unique(as.character(biomarkers$mRNA)))),
        selectInput("protein",
                    "Protein:",
                    c("All",
                      unique(as.character(biomarkers$PROTEIN)))),
        selectInput("response",
                    "Response:",
                    c("All",
                      unique(as.character(biomarkers$RESPONSE)))),
        downloadButton("downloadData", "Export to CSV")
      ),


      conditionalPanel(
        'input.sheet === "papers"',
        textInput('pain_measures', "Pain measures:"),
        radioButtons("pain_models",
                     "Choose Measured Pain Type",
                     c("All" = "All",
                       "Model 1" = "1",
                       "Model 2" = "2",
                       "Model 3" = "3",
                       "Model 4" = "4",
                       "Model 5" = "5"
                       ),
                     inline = TRUE),
        textInput('model_init', "Model Initiator"),
        selectInput("nerve",
                    "Nerve/Immune model:",
                    c("All",
                      unique(as.character(papers$`Nerve/immune model`)))),
        selectInput("blind",
                    "Blinded:",
                    c("All",
                      unique(as.character(papers$blinded)))),
        selectInput("species",
                    "Species:",
                    c("All",
                      unique(as.character(papers$Species)))),
        selectInput("strain",
                    "Strain:",
                    c("All",
                      unique(as.character(papers$Strain)))),
        selectInput("sex",
                    "Sex:",
                    c("All",
                      unique(as.character(papers$Sex))))
      ),

      # Figures selectors
      conditionalPanel(
        'input.sheet === "figures"',
        selectInput("pred",
                    "Variable:",
                    unique(colnames(biomarkers)[-c(1,6)])),
        sliderInput("n",
                    "Number of groups:",
                    min = 5, max = 20, value = 10),
      radioButtons("plot_type",
                   label = "Type of plot",
                   choices = c("Univariate", "Bivariate")),
      radioButtons("response_type",
                   label = "Response level:",
                   choices = c("Increase", "Decrease", "No Change"))
      )
    ),

    mainPanel(
      tabsetPanel(
        id = 'sheet',
        tabPanel("papers", DT::dataTableOutput("papers")),
        tabPanel("biomarker", DT::dataTableOutput("biomarker")),
        tabPanel("figures",
                 h3("Figure of biomarker groups"),
                 plotOutput("summaryPlot"),
                 h3("Table of biomarker groups"),
                 tableOutput("summaryTable"))
      )

    )
  )
)
server  <- function(input, output) {

  # Filter data based on selections

  PMIDs  <- reactive({
    if (input$biomark != "All") {
      paper_biomarker  <- dplyr::filter(paper_biomarker, BIOMARKER == input$biomark)
    }
    if (input$tissue != "All") {
      paper_biomarker  <- dplyr::filter(paper_biomarker, TISSUE == input$tissue)
    }
    if (input$mrna != "All") {
      paper_biomarker  <- dplyr::filter(paper_biomarker, mRNA == input$mrna)
    }
    if (input$protein != "All") {
      paper_biomarker  <- dplyr::filter(paper_biomarker, PROTEIN == input$protein)
    }
    if (input$response != "All") {
      paper_biomarker  <- dplyr::filter(paper_biomarker, RESPONSE == input$response)
    }
    if(input$pain_measures != ""){
      paper_biomarker  <- dplyr::filter(paper_biomarker, stringr::str_detect(`Pain Measures`, input$pain_measures))
    }
    if(input$pain_models != "All"){
      paper_biomarker  <- dplyr::filter(paper_biomarker, stringr::str_detect(`Measured pain type`, input$pain_models))
    }
    if(input$model_init != ""){
      paper_biomarker  <- dplyr::filter(paper_biomarker, stringr::str_detect(`Model Initiator`, input$model_init))
    }
    if(input$nerve != "All"){
      paper_biomarker  <- dplyr::filter(paper_biomarker, `Nerve/immune model` == input$nerve)
    }
    if(input$blind != "All"){
      paper_biomarker  <- dplyr::filter(paper_biomarker, blinded == input$blind)
    }
    if(input$species != "All"){
      paper_biomarker  <- dplyr::filter(paper_biomarker, Species == input$species)
    }
    if(input$strain != "All"){
      paper_biomarker  <- dplyr::filter(paper_biomarker, Strain == input$strain)
    }
    if(input$sex != "All"){
      paper_biomarker  <- dplyr::filter(paper_biomarker, Sex == input$sex)
    }
    return(paper_biomarker$`Study PMID`)
  })

  biomarker  <- reactive({
    data <- biomarkers
    data  <- dplyr::filter(data, `STUDY (PMID)` %in% PMIDs())
    data  <- dplyr::mutate(data,
                           `STUDY (PMID)` = stringr::str_c(
                             "<a href='https://www.ncbi.nlm.nih.gov/pubmed/",
                             `STUDY (PMID)`,
                             "'>",`STUDY (PMID)`,"</a>"))
    return(data)
  })

  # Clean biomarker is biomarker table without live url link
  biomarker_clean  <- reactive({
    data <- biomarkers
    data  <- dplyr::filter(data, `STUDY (PMID)` %in% PMIDs())
    return(data)
  })

  paper  <- reactive({
    data <- papers
    data  <- dplyr::filter(data, `Study PMID` %in% PMIDs())
    data  <- dplyr::mutate(data,
                           EntrezUID = stringr::str_c(
                             "<a href='https://www.ncbi.nlm.nih.gov/pubmed/",
                             `Study PMID`,
                             "'>",`Study PMID`,"</a>"))
    return(data)
  })

  output$biomarker <- DT::renderDataTable(
    DT::datatable(biomarker(), escape = FALSE)
  )

  # Code to export the biomarker dataset as a csv
  output$downloadData <- downloadHandler(
    filename = function() {
      return("biomarker.csv")
    },
    content = function(file) {
      write.csv(biomarker_clean(), file, row.names = FALSE)
    }
  )
  output$papers <- DT::renderDataTable(
    DT::datatable(paper(),
                  options = list(columnDefs = list(list(
                    targets = c(2,3),
                    render = DT::JS(
                      "function(data, type, row, meta) {",
                      "return type === 'display' && data.length > 20 ?",
                      "'<span title=\"' + data + '\">' + data.substr(0, 20) + '...</span>' : data;",
                      "}")
                  ))),
                  escape = FALSE))

  output$summaryTable  <- renderTable(
    {
      if(input$plot_type == "Univariate"){
        biomarker() %>%
          select(pred = input$pred, RESPONSE) %>%
          mutate(Levels = fct_lump(pred, n = input$n)) %>%
          count(Levels) %>%
          rename(Frequency = n)
      } else {
        biomarker() %>%
          select(pred = input$pred, RESPONSE) %>%
          mutate(Levels = fct_lump(pred, n = input$n)) %>%
          group_by(Levels, RESPONSE) %>%
          summarise(n = n()) %>%
          group_by(Levels) %>%
          mutate(
            p = n / sum(n),
            N = sum(n)) %>%
          select(-n) %>%
          spread(RESPONSE, p, fill = 0) %>%
          select(-N, bioeverything(), N)
      }
    })
  output$summaryPlot  <- renderPlot(
    {
      if(input$plot_type == "Univariate"){
        biomarker() %>%
          select(pred = input$pred, RESPONSE) %>%
          mutate(pred = fct_lump(pred, n = input$n)) %>%
          count(pred) %>%
          ggplot(aes(fct_reorder(pred, n), n, fill = pred)) +
          geom_bar(stat = 'identity', show.legend = FALSE) +
          labs(x = NULL, y = "Count") +
          theme_bw() +
          theme(axis.text.x = element_text(angle = -90, hjust=0))
      } else {

        levels  <- c("Decrease", "Increase", "No Change")
        i  <- which(levels == input$response_type)
        levels  <- c(levels[-i], levels[i])

        biomarkers %>%
          select(pred = input$pred, RESPONSE) %>%
          mutate(LEVELS = fct_lump(pred, n = input$n)) %>%
          group_by(LEVELS) %>%
          mutate(n = sum(RESPONSE == input$response_type) / n()) %>%
          ungroup() %>%
          mutate(LEVELS = fct_reorder(LEVELS, n)) %>%
          mutate(RESPONSE = factor(RESPONSE, levels = levels)) %>%
          ggplot(aes(LEVELS, fill = RESPONSE)) + geom_bar(position = "fill") +
          coord_flip() +
          theme_bw() +
          labs(x = NULL, y = "Proportion") +
          scale_fill_manual(values = c("Increase" = "Dodgerblue",
                                       "Decrease" = "Red",
                                       "No Change" = "Orange"))

      }
    })

}
shinyApp(ui = ui, server = server)