在 shinydashboard 中过滤数据

Question

我的 R shinydashboard 应用程序中的过滤器选项有问题。我能够过滤数据框列 (padj < 1)，但是当我将这个相同的过滤器合并到应用程序中时，数据丢失了非常小的 padj 行，如 1.41103072458963E-14。我得到最多 4 个小数位 (0.00011014) 的所有行，但没有 padj 小于该值的行。这切断了几十个想要的行。

我可能编码有误，我尝试搜索类似的问题，但没有找到任何问题。我选择的 select 输入是：

pickerInput("FDR", "False Discovery Rate", choices = c(1, 0.1, 0.05, 0.01))

当我尝试使用以上输入进行过滤时：

genes1 <- reactive({
    genes <- DEG2 %>% dplyr::filter(padj <= input$FDR) %>% dplyr::filter(log2FoldChange >= input$FC | log2FoldChange <= -input$FC)
  })

非常感谢help/advice。

这里要加载的数据： datafile.

请参阅下面的应用程序代码。

library(shinydashboard)
library(dashboardthemes)
library(shiny)
library(shinythemes)
library(shinyWidgets)
library(shinycssloaders)
library(shinyjs)
library(htmlTable)
library(DT)
library(dplyr)
library(ggpubr)
library(ggplot2)
library(htmlwidgets)
library(plotly)
library(table1)


# load dataset
DEG2 <- read.csv("DEG2.csv")


# to add color to the spinner 
options(spinner.color="#287894")

#############################################
### HEADER #################################
#############################################

header <- dashboardHeader(title = tagList(
  tags$span(class = "logo-mini", "Cell"),
  tags$span( class = "logo-lg", "My 1st App" )), 
  titleWidth = 300)


#############################################
### SIDEBAR #################################
#############################################

sidebar <- dashboardSidebar(width = 300, sidebarMenu(id = "sidebar", # id important for updateTabItems
                                                     menuItem("Pipeline", tabName = "pipe", icon = icon("bezier-curve")),
                                                     menuItem("Something", tabName = "plot", icon = icon("braille")),
                                                     menuItem("Something else", tabName = "pathways", icon = icon("connectdevelop")),
                                                     menuItem("Contact", tabName = "contact", icon = icon("address-card"))
)
)

#############################################
### BODY #################################
#############################################

body <- dashboardBody(
  useShinyjs(), # Set up shinyjs
  # changing theme
  shinyDashboardThemes(theme = "blue_gradient"),
  tabItems(
  
  #########  Tab 1 #########################################
  tabItem("pipe",
            fluidPage(
              h2("Pipeline"),
              
              #### STEP 1 ####
              box(width = 12, title = "Step1: Filter for DEGs", collapsible = TRUE, collapsed = FALSE, status = "primary", solidHeader = TRUE,
                  fluidRow(
                    column(4, offset = 0,
                           sliderTextInput("FC", "Fold-Change (absolute value)", choices = seq(from= 0, to= 5, by=0.5), grid = TRUE),
                           pickerInput("FDR", "False Discovery Rate", choices = c(1, 0.1, 0.05, 0.01)),
                           setSliderColor(color = '#EE9B00', sliderId = 1),),
                    column(6, offset= 1,
                           valueBoxOutput("genes_filtered", width = 4))),
                  br(),
                  fluidRow(
                    column(10, offset =0,
                           DT::dataTableOutput("genetable") %>% withSpinner(type = 8, size=1))),
                  br(),
                  actionBttn("step1", "Select to advance:step 2", color = "warning", style = "fill", icon = icon("angle-double-down" ))
              )),
            #### STEP 2 ####
            conditionalPanel(
              condition = "input.step1 == 1",
              fluidPage(
                box(width = 12, title = "Step2: Filter for gene regulation", collapsible = TRUE, collapsed = FALSE, status = "primary", solidHeader = TRUE,
                    "Choose to subset the genes that are up or down regulated",
                    br(),
                    br(),
                    fluidRow(
                      column(6, offset = 0,
                             prettyRadioButtons("reg", "Choose:", choices = c("Up-regulated", "Down-regulated", "All"), status = "success", fill=TRUE, inline = TRUE))
                    ),
                    br(),
                    fluidRow(
                      column(6, offset = 0,
                             valueBoxOutput("value", width = 6)))
                ) # box
              )
            ) # conditional panel
            
    )# end tab3
  ) # end tabItems
)#dashboardBody        



ui <- dashboardPage(header = header,
                    sidebar = sidebar,
                    body = body
)

server <- function(input, output, session) {
  
  ############################################
  ###### TAB1    ##################
  ############################################  
  
  # step 1
  genes1 <- reactive({
    genes <- DEG2 %>% dplyr::filter(padj <= input$FDR) %>% dplyr::filter(log2FoldChange >= input$FC | log2FoldChange <= -input$FC)
  })
  
  output$genes_filtered <- renderValueBox({
    valueBox(value=length(genes1()$symbol), subtitle = "Filtered genes", color = "purple", icon=icon("filter"))
  })
  
  
  output$genetable <- DT::renderDataTable({
    genes1() }, server = FALSE, extensions =c("Responsive", "Buttons"), rownames = FALSE, options = list(dom = 'Blfrtip', buttons = list('copy', list(extend = "collection",
                                                                                                                                      buttons = c("csv", "excel", "pdf"),
                                                                                                                                      text = "Download")))
    
    )
  
  # step 2
  genes2 <- reactive({
    g2 <- if (input$reg == "Up-regulated"){
      genes1() %>% filter(log2FoldChange > 0)
    } else if (input$reg == "Down-regulated"){
      genes1() %>% filter(log2FoldChange < 0)
    } else {
      genes1()
    }
  })
  
  
  output$value <- renderValueBox({
    if (input$reg == "Up-regulated"){
      valueBox(value = length(genes2()$symbol), subtitle = "Up-regulated genes", color = "red", icon = icon("hand-point-up"))
    } else if (input$reg == "Down-regulated"){
      valueBox(value = length(genes2()$symbol), subtitle = "Down-regulated genes", color = "blue", icon = icon("hand-point-down"))
    } else {
      valueBox(value = length(genes2()$symbol), subtitle = "All genes", color = "orange", icon = icon("record-vinyl"))
    }
  })

} #server

shinyApp(ui, server)

Answer 1

在您的过滤器中尝试 as.numeric(input$FDR)，如下所示。

genes <- DEG2 %>% dplyr::filter(padj <= as.numeric(input$FDR))

在 shinydashboard 中过滤数据

Filtering data in shinydashboard

r

shiny

dplyr

shinydashboard