[英]Filtering data in shinydashboard
我的 R Shinydashboard 應用程序中的過濾器選項有問題。 我能夠過濾數據框列(padj < 1),但是當我將這個相同的過濾器合並到應用程序中時,數據丟失了非常小的 padj 行,例如 1.41103072458963E-14。 我得到最多 4 個小數位(0.00011014)的所有行,但不是 padj 小於那個的行。 這會切斷幾十個想要的行。
我可能編碼錯誤,並嘗試搜索類似的問題,但沒有找到任何問題。 我選擇的選擇輸入是:
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)
})
非常感謝任何幫助/建議。
要在此處加載的數據: 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)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.