Показать вывод данных в зависимости от того, какая кнопка действия нажата - PullRequest
Новая
       10

Показать вывод данных в зависимости от того, какая кнопка действия нажата

0 голосов
/ 09 ноября 2019

Я создаю блестящее приложение, которое позволит пользователям загружать данные и отображать содержимое на главной панели. Есть две кнопки действий, одна для отображения некоторых примеров данных, а другая кнопка действий для отображения содержимого загруженного файла данных. если пользователь не загрузил какой-либо файл данных, то при нажатии на кнопку второго действия должно появиться сообщение «сначала загрузите данные». Я изо всех сил пытаюсь реализовать эту вторую кнопку действия, поэтому любая помощь очень ценится.

Я пытался использовать reactiveVal (), но он не работает со второй кнопкой действия. Я думаю, что мне нужно каким-то образом сохранить загруженный набор данных в объект, который можно получить с помощью второй кнопки действия. 

library(tidyverse)
library(shiny)
library(shinyWidgets)
library(DT)


options(shiny.maxRequestSize=30*1024^2) 

recommendation <- tibble(Account = c("Axis", "HSBC", "SBI", "ICICI", "Bandhan Bank", "Axis", "HSBC", "SBI", "ICICI", "Bandhan Bank"),
                             Product = c("Bank", "FBB", "FBB", "FBB","FBB","SIMO", "SIMO", "SIMO", "SIMO", "SIMO"),
                             Region = c("North", "South", "East", "West", "West", "North", "South", "East", "West", "West"),
                             Revenue = c(2000, 30000, 1000, 1000, 200, 200, 300, 100, 100, 200))


ui <- fluidPage(

  titlePanel("Example"),


  sidebarLayout(
    sidebarPanel(

      fileInput("Upload", "Upload your own Data"),

      actionButton("Example", "Show Example Data instead"),
      actionButton("data", "Show New data")


    ),

    mainPanel(

      column(DT::dataTableOutput('showdata'), width = 12),

    )
  )
)

# Server Logic
server <- function(input, output) {
  my_data <- reactiveVal()

  observeEvent(input$Upload, {
    tmp <- read.csv(input$Upload$datapath)
    my_data(tmp)
  })

  observeEvent(input$Example, {
    my_data(recommendation)

  })

  observeEvent(input$data, {
    my_data()

  })

  output$showdata = renderDT(my_data(), rownames = FALSE, class = "display nowrap compact", filter = "top",
                           options = list(
                             scrollX = TRUE,
                             scrollY = TRUE,
                             autoWidth = FALSE))

}



# Run the application 
shinyApp(ui = ui, server = server)

При нажатии кнопки действия «показать новые данные» должны отображаться данные, которые были простозагружено. Однако, если нет загруженных данных, то в сообщении должно быть предложено загрузить набор данных.

1 Ответ

1 голос
/ 09 ноября 2019

Кажется, что способ использования reactiveVal при нажатии кнопки возвращает пустое значение (my_data() ничего не возвращает). Кроме того, нет необходимости в первом observeEvent в коде вашего сервера, поскольку он будет обновлять my_data только при загрузке файла, а не при нажатии кнопки. Мой способ сделать это - проверить, есть ли файл, загруженный при нажатии кнопки Показать новые данные, и, если он есть, показать его. Если нет, предложите модальное диалоговое окно, чтобы сообщить пользователю сначала загрузить файл. Примерно так (запись только серверной функции, так как остальное без изменений): 

# Server Logic
server <- function(input, output) {

  my_data <- reactiveVal()

  ## Not need of this, this will be done when pressing the show data button
  # observeEvent(input$Upload, {
  #   tmp <- read.csv(input$Upload$datapath)
  #   my_data(tmp)
  # })

  # Observer to update my_data when example button is pressed
  observeEvent(input$Example, {
    my_data(recommendation)
  })

  # Observer to update my_data when data button is pressed, checking if there
  # is a file uploaded
  observeEvent(input$data, {

    # check if we have a data uploaded
    if (is.null(input$Upload)) {
      # if there is no data uploaded, reset my_data, and show a modal message
      my_data()
      showModal(
        modalDialog(title = 'No data uploaded',
                    'Please upload a file before clicking the button')
      )
    } else {
      # if there is data uploaded, read it and return it
      tmp <- read.csv(input$Upload$datapath)
      my_data(tmp)
    }
  })

  output$showdata = renderDT(my_data(), rownames = FALSE, class = "display nowrap compact", filter = "top",
                             options = list(
                               scrollX = TRUE,
                               scrollY = TRUE,
                               autoWidth = FALSE))

}

Проверено в моей системе и работает как и ожидалось в вашем вопросе.

Редактировать

Отредактировано, чтобы предложить более эффективный способ, избегая чтения каждый раз файл: 

# Server Logic
server <- function(input, output) {

  my_data <- reactiveVal()

  ## Not need of this, this will be done when pressing the show data button
  # observeEvent(input$Upload, {
  #   tmp <- read.csv(input$Upload$datapath)
  #   my_data(tmp)
  # })

  # Observer to update my_data when example button is pressed
  observeEvent(input$Example, {
    my_data(recommendation)
  })

  # reactive to store the uploaded data
  data_loaded <- reactive({
    # dont try to read if there is no upload
    shiny::validate(
      shiny::need(input$Upload, 'no data uploaded')
    )
    # read the file
    read.csv(input$Upload$datapath)
  })

  # Observer to update my_data when data button is pressed, checking if there
  # is a file uploaded
  observeEvent(input$data, {

    # check if we have a data uploaded
    if (is.null(input$Upload)) {
      # if there is no data uploaded, reset my_data, and show a modal message
      my_data()
      showModal(
        modalDialog(title = 'No data uploaded',
                    'Please upload a file before clicking the button')
      )
    } else {
      # if there is data uploaded, read it and return it
      tmp <- data_loaded()
      my_data(tmp)
    }
  })

  output$showdata = renderDT(my_data(), rownames = FALSE, class = "display nowrap compact", filter = "top",
                             options = list(
                               scrollX = TRUE,
                               scrollY = TRUE,
                               autoWidth = FALSE))

}
...