r - 如何在 R Shiny 中更新用户数据?
问题描述
在下面的示例中,我创建了一个Import demo data
和GO
按钮来说明数据格式和输出图。我想知道如果用户上传等,我input$file1
该如何更新它。input$file2
rm(list=ls())
library(tidyverse)
library(readxl)
library(shiny)
library(shinyjs)
library(shinyWidgets)
jsResetCode <- "shinyjs.reset = function() {history.go(0)}"
ui <- fluidPage(
#reset session by reset button
useShinyjs(), # Include shinyjs in the UI
extendShinyjs(text = jsResetCode, functions="shinyjs.reset"),
#panels
tabsetPanel(
##tabPanel-Input
tabPanel("Input", fluid = TRUE,
# tab title ----
titlePanel("Upload data"),
# sidebar layout with input and output tables ----
sidebarLayout(
# sidebar panel for inputs ----
sidebarPanel(
#show ct demo
actionBttn("runexample", "Import demo data", style="simple", size="sm", color = "primary"),
# input1: Select a file ----
fileInput("file1", "Count matrix File (.xlsx)",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
#input2: select a file ----
fileInput("file2", "Manifest File (.xlsx)",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
#select column name
selectInput("design", "Column name for analysis", " "),
#select ref group
uiOutput("level0"),
#select study group
uiOutput("level1"),
#select column name
selectInput("species", "Species", c("Human"="Human", "Mouse"="Mouse")),
#action run
actionBttn("runbutton", "GO", style="simple", size="sm", color = "primary"),
actionBttn("reset", "RESET", style="simple", size="sm", color = "warning"),
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
span(textOutput("ngene"),style="color:blue"),
span(textOutput("nsample"),style="color:blue"),
tableOutput("matrix"),
tableOutput("pdat")
)
)
),
tabPanel("plot", fluid = TRUE,
plotOutput("plotxy")
)
)
)
server <- function(input, output, session) {
#tabPanel-Input
###demo data
####count
###display demo count matrix
observeEvent(input$runexample, {
set.seed(123456)
n=2000; m=6
ctobj<- reactive({
count<-cbind.data.frame(gene=letters[1:20],
sample1=rbinom(20, 50, 0.6),
sample2=rbinom(20, 50, 0.6),
sample3=rbinom(20, 50, 0.6),
sample4=rbinom(20, 50, 0.6),
sample5=rbinom(20, 50, 0.6),
sample6=rbinom(20, 50, 0.6))
return(count)
})
####manifest
pobj<- reactive({
pheno<-data.frame(ID=paste0("sample", 1:m),
Treatment=rep(c("Dose10", "Control", "Dose20"), each=2),
Gender=sample(c("F", "M"), m, T))
return(pheno)
})
#ngenes
output$ngene <- renderText({paste("Number of genes: ", dim(ctobj())[1], " [First 10 rows displayed]")})
#nsamples
output$nsample <- renderText({paste("Number of samples: ", (dim(ctobj())[2])-1, " [First 10 rows displayed]")})
#display 10rows count matrix
output$matrix <- renderTable({
head(ctobj(), 10)
})
#display10rows manifest
output$pdat <- renderTable({
head(pobj(), 10)
})
#model variables
##comparison variable
observe({
updateSelectInput(session, "design", choices="Treatment")
})
##ref0
output$level0 <- renderUI({
selectInput("ref0", "Reference group", "Control")
})
##ref1
output$level1 <- renderUI({
selectInput("ref1", "Study group", "Dose20")
})
##species
observe({
updateSelectInput(session, "species", choices="Human")
})
})
observeEvent(input$runbutton, {
output$plotxy <- renderPlot({
plot( ctobj()$gene, ctobj()$sample1)
})
})
#RESET for new analysis
observeEvent(input$reset, {js$reset()})
}
shinyApp(ui, server)
如果用户上传本地数据集,通过单击GO
按钮输出应基于以下块(而不是演示数据)。
#USER'S DATA ANALYSIS
##READ COUNT MATRIX
ctobj <- reactive({
req(input$file1)
count <- read_excel(input$file1$datapath)
return(count)
})
##READ MANIFEST
pobj <- reactive({
req(input$file2)
pheno <- read_excel(input$file2$datapath)
return(pheno)
})
##SHOW SUMMARY
output$ngene <- renderText({paste("Number of genes: ", dim(ctobj())[1], ". [First 10 rows displayed]")})
output$nsample <- renderText({paste("Number of samples: ", (dim(ctobj())[2])-1, ". [First 10 rows displayed]")})
##DISPLAY 10 ROWS
output$matrix <- renderTable({
head(ctobj(), 10)
})
output$pdat <- renderTable({
head(pobj(), 10)
})
##MODEL VARIABLES
###COMPARISON VARIALBE
observe({
updateSelectInput(session, "design", choices=names(pobj()))
})
###CONTROL
output$level0 <- renderUI({
selectInput("ref0", "Reference group", pobj()[[input$design]])
})
###TARGET
output$level1 <- renderUI({
selectInput("ref1", "Study group", pobj()[[input$design]])
})
解决方案
在我看来,您只需要将第二块放入observeEvent
环境中:
### ALL OF YOUR FIRST CHUNK
observeEvent(input$runbutton, {
## YOUR SECOND CHUNK
})
推荐阅读
- php - 如何在 preg_replace_callback 中转义特殊字符
- mongodb - 如何在 MongoDB 中对双嵌套数组进行聚合和查找?
- powershell - 如何使用 msbuild powershell 发布具有单个文件夹的多个项目 (.csproj) 文件
- javascript - 如果使用 AJAX 获取数据表,Tabledit Jquery 不起作用
- ip - IPv4 和 IPv6 如何工作?我应该优先考虑哪个?
- python - 如何在数据框中将数据时间转换为 Python 中的时间小数?
- django - 在 docker-compose build 时获取“处理 tar 文件时出错(退出状态 1):打开 /myenv/include/python3.6m/Python-ast.h:没有这样的文件或目录”
- flutter - PageController.page 在使用它构建 PageView 之前无法访问。断言失败:第 172 行 pos 7:'positions.isNotEmpty'
- reactjs - 如何在材料 UI 的自动完成框中将最小输入字符串长度添加为三个过滤器
- css - 如何在接触更大椭圆边界的情况下获得子椭圆的 cx 和 cy?