我正在尝试学习如何使用shiny modules。我从一个简单的应用程序开始,它与the documentation中的应用程序非常相似。该应用程序要求您选中一个框,然后您可以上传一个csv文件,它会显示一个包含数据的表格:
## app.R ##
library(shiny)
library(shinydashboard)
library(shinyjs)
# Header
header <- dashboardHeader()
# Sidebar
sidebar <- dashboardSidebar(
checkboxInput("agree", p("I read ",
a("the very important stuff",
href="http://stackoverflow.com/",
target="_blank")), FALSE),
fileInput(
"chosenfile",
label = h4("File input"),
accept = ".csv"
))
# Body
body <- dashboardBody(
useShinyjs(),
box(
title = "Test",
width = 12,
solidHeader = TRUE,
status = "warning",
dataTableOutput('tbl')
)
)
# ui
ui <- dashboardPage(header, sidebar, body)
# server
server <- function(input, output) {
#Load the chosen dataset
data <- reactive({
dfile <-
input$chosenfile[1, 4] # <- filename with path is the [1,4] cell in obj
if (!is.null(dfile))
readr::read_csv(dfile)
})
output$tbl <- renderDataTable(data(),
options = list(scrollX = TRUE,
pageLength = 10,
searching = FALSE))
observe({
if (input$agree == T) {
# enable the download button
shinyjs::enable("chosenfile")
}
})
observe({
if (input$agree == F) {
# enable the download button
shinyjs::disable("chosenfile")
}
})
}
#run
shinyApp(ui, server)
我想创建一个包含复选框的模块,上传应用程序的文件部分。
现在我有这个:
# Module
# Module UI function
csvFileInput <- function(id, label = "CSV file") {
# Create a namespace function using the provided id
ns <- NS(id)
tagList(
checkboxInput(ns("agree"), p("I read ",
a("the very important stuff",
href="http://stackoverflow.com/",
target="_blank"))),
fileInput(ns("file"), label)
)
}
# Module server function
csvFile <- function(input, output, session) {
# The selected file, if any
userFile <- reactive({
# If no file is selected, don't do anything
validate(need(input$file, message = FALSE))
input$file
})
# The user's data, parsed into a data frame
dataframe <- reactive({
readr::read_csv(userFile()$datapath)
})
# We can run observers in here if we want to
observe({
msg <- sprintf("File %s was uploaded", userFile()$name)
cat(msg, "\n")
})
# Return the reactive that yields the data frame
return(dataframe)
}
## app.R ##
library(shiny)
library(shinydashboard)
library(shinyjs)
# Header
header <- dashboardHeader()
# Sidebar
sidebar <- dashboardSidebar(
csvFileInput("datafile", "CSV file")
)
# Body
body <- dashboardBody(
useShinyjs(),
box(
title = "Test",
width = 12,
solidHeader = TRUE,
status = "warning",
dataTableOutput("table")
)
)
# ui
ui <- dashboardPage(header, sidebar, body)
# server
server <- function(input, output) {
datafile <- callModule(csvFile, "datafile")
output$table <- renderDataTable({
datafile()
})
}
#run
shinyApp(ui, server)
我不确定如何实现模块的启用/禁用部分。
我尝试了这个,但应用程序崩溃了:
# Module
# Module UI function
csvFileInput <- function(id, label = "CSV file") {
# Create a namespace function using the provided id
ns <- NS(id)
tagList(
checkboxInput(ns("agree"), p("I read ",
a("the very important stuff",
href="http://stackoverflow.com/",
target="_blank"))),
fileInput(ns("file"), label)
)
}
# Module server function
csvFile <- function(input, output, session) {
# The selected file, if any
userFile <- reactive({
# If no file is selected, don't do anything
validate(need(input$file, message = FALSE))
input$file
})
# The user's data, parsed into a data frame
dataframe <- reactive({
readr::read_csv(userFile()$datapath)
})
# We can run observers in here if we want to
observe({
msg <- sprintf("File %s was uploaded", userFile()$name)
cat(msg, "\n")
})
# Return the reactive that yields the data frame
return(dataframe)
}
diable_button <- function(input, output, session, button, agree){
observe({
if (agree == T) {
# enable the download button
shinyjs::enable(button)
}
})
observe({
if (agree == F) {
# enable the download button
shinyjs::disable(button)
}
})
}
## app.R ##
library(shiny)
library(shinydashboard)
library(shinyjs)
# Header
header <- dashboardHeader()
# Sidebar
sidebar <- dashboardSidebar(
csvFileInput("datafile", "CSV file")
)
# Body
body <- dashboardBody(
useShinyjs(),
box(
title = "Test",
width = 12,
solidHeader = TRUE,
status = "warning",
dataTableOutput("table")
)
)
# ui
ui <- dashboardPage(header, sidebar, body)
# server
server <- function(input, output) {
datafile <- callModule(csvFile, "datafile")
callModule(diable_button, "datafile",
button = input$chosenfile,
agree = input$agree)
output$table <- renderDataTable({
datafile()
})
}
#run
shinyApp(ui, server)