阅读csv闪亮模块?

时间:2016-04-19 14:02:37

标签: r shiny

我正在尝试学习如何使用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)

0 个答案:

没有答案