r - создать реактивный фильтр, который применяется к загруженному CSV-файлу

Question

Я пытаюсь создать блестящее приложение, в котором пользователь сможет загрузить файл .csv, а затем применить фильтр к этому фрейму данных и затем построить график, используя ggplot2.К сожалению, я наткнулся на проблему при попытке создать меню выбора ввода из переменной, исходящей из .csv, который должен быть загружен.

Чтобы создать простой пример, мы можем экспортировать набор данных diamonds из ggplot2 как файл .csv:

write.csv(diamonds, "diamonds.csv")

Затем создать блестящее приложение:

library(shiny)
library(shinyWidgets)
library(ggplot2)

ui <- fluidPage(
    titlePanel("test shiny"),

    # Sidebar with a slider input for number of bins
    sidebarLayout(sidebarPanel(
        fileInput('file1', 'Choose file to upload',
                  accept = c(
                      'text/csv',
                      'text/comma-separated-values',
                      'text/tab-separated-values',
                      'text/plain',
                      '.csv',
                      '.tsv'
                  )
        ),
        tags$hr(),
        pickerInput(
            inputId = "caratx",
            label = "Choose carat",
            choices = c("Select all", unique(user_data$carat)),
            multiple = TRUE
        ),
        selectInput(
            inputId = "clarityx",
            label = "Choose distance: ",
            choices = unique(user_data$clarity)
        )
    ),
    mainPanel(plotOutput("endplot"))
    ))

# Define server logic 
server <- function(input, output) {

    output$endplot <- renderPlot({
        inFile <- input$file1

        if (is.null(inFile))
            return(NULL)

        user_data <- read.csv(inFile$datapath, header = T,
                              sep = ",", quote = input$quote)

        validate(
            need(input$entityx, 'Please select at least one carat'),
            need(input$indicatorx, 'Please select at least one clarity')
        )

        if (input$caratx %in% "Select all") {
            user_data <- user_data %>%
                filter(carat %in% input$caratx)
        } else {
            user_data <- user_data %>%
                filter(carat %in% input$caratx) %>%
                filter(clarity %in% input$clarityx) 
        }

        user_data %>% 
            ggplot(aes(x = `cut`)) +
            geom_point(aes(y = price), color = "red") +
            geom_point(aes(y = depth), color = "blue")
        })
}

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

Это вывод:

Error in unique(user_data$carat) : object 'user_data' not found

Есть лиспособ сделать эту работу?

Большое спасибо!

Answer 1

Фактический вопрос, который вы задаете, должен быть решен путем превращения user_data в реактив и рендеринга входных данных с использованием uiOutput + renderUI, как правильно прокомментировал @kwiscion.

Но, к сожалению, в вашем коде есть несколькодругие ошибки, которые делают его невоспроизводимым:

• Пример набора данных должен быть diamonds, а не cars
• input$quote не существует в вашем коде, поэтому я удалилссылка на него
• Вам нужно включить library(dplyr) для некоторых функций в вашем коде
• input$entityx и input$indicatorx не существует

Вышеуказанные 4 ошибки не связаны с вашим вопросом, но затрудняют и дольше отвечают на ваш вопрос.В будущем, пожалуйста, постарайтесь убедиться, что код, который вы публикуете, является правильным и воспроизводимым.

Ниже приведен ответ на ваш вопрос, который решил 4 вышеуказанных вопроса и реализовал два предложения @ kwiscion

library(shiny)
library(shinyWidgets)
library(ggplot2)
library(dplyr)

ui <- fluidPage(
  titlePanel("test shiny"),

  # Sidebar with a slider input for number of bins
  sidebarLayout(sidebarPanel(
    fileInput('file1', 'Choose file to upload',
              accept = c(
                'text/csv',
                'text/comma-separated-values',
                'text/tab-separated-values',
                'text/plain',
                '.csv',
                '.tsv'
              )
    ),
    tags$hr(),
    uiOutput("caratx_input"),
    uiOutput("clarityx_input")
  ),
  mainPanel(plotOutput("endplot"))
  ))

# Define server logic 
server <- function(input, output) {
  file_data <- reactive({
    req(input$file1)
    read.csv(input$file1$datapath, header = TRUE,
             sep = ",")
  })

  output$caratx_input <- renderUI({
    req(file_data())
    pickerInput(
      inputId = "caratx",
      label = "Choose carat",
      choices = c("Select all", unique(file_data()$carat)),
      multiple = TRUE
    )
  })

  output$clarityx_input <- renderUI({
    req(file_data())
    selectInput(
      inputId = "clarityx",
      label = "Choose distance: ",
      choices = unique(file_data()$clarity)
    )
  })

  output$endplot <- renderPlot({
    req(file_data())

    validate(
      need(input$caratx, 'Please select at least one carat'),
      need(input$clarityx, 'Please select at least one clarity')
    )

    user_data <- file_data()
    if (input$caratx %in% "Select all") {
      user_data <- user_data %>%
        filter(carat %in% input$caratx)
    } else {
      user_data <- user_data %>%
        filter(carat %in% input$caratx) %>%
        filter(clarity %in% input$clarityx) 
    }

    user_data %>% 
      ggplot(aes(x = `cut`)) +
      geom_point(aes(y = price), color = "red") +
      geom_point(aes(y = depth), color = "blue")
  })
}

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

Answer 2

Вам нужно

1. user_data для реактивного выражения (https://shiny.rstudio.com/tutorial/written-tutorial/lesson6/)
2. Отображать pickerInput с renderUI (https://shiny.rstudio.com/articles/dynamic-ui.html).

(Полный код ниже)

1. Когда вы хотите вычислить и в дальнейшем использовать значение, зависящее от пользовательского ввода (в вашем случае user_data), вы должны сделать его реактивным выражением, поместив вычисление в reactive({ })Затем вы можете обратиться к значению, как к функции, т.е. user_data(). Так что в вашем случае это будет:

user_data <- reactive({
      read.csv(input$file1$datapath, header = T,
               sep = ",", quote = input$quote)
    })

user_data() %>% ...

Кроме того, оно должно быть извлечено из renderPlot()работать как реактивный.

Чтобы иметь ввод в зависимости от значения, рассчитанного во время выполнения, его необходимо отобразить на стороне сервера с помощью renderUI():

ui.R

...
uiOutput('caratxui'),
...

сервер.R

...
output$caratxui <- renderUI({
        pickerInput(
            inputId = "caratx",
            label = "Choose carat",
            choices = c("Select all", unique(user_data()$carat)),
            multiple = TRUE
        )

    })
...

Полный код:

library(shiny)
library(shinyWidgets)
library(ggplot2)

ui <- fluidPage(
    titlePanel("test shiny"),

    # Sidebar with a slider input for number of bins
    sidebarLayout(sidebarPanel(
        fileInput('file1', 'Choose file to upload',
                  accept = c(
                      'text/csv',
                      'text/comma-separated-values',
                      'text/tab-separated-values',
                      'text/plain',
                      '.csv',
                      '.tsv'
                  )
        ),
        tags$hr(),
        uiOutput('caratxui'),
        selectInput(
            inputId = "clarityx",
            label = "Choose distance: ",
            choices = unique(user_data$clarity)
        )
    ),
    mainPanel(plotOutput("endplot"))
    ))

# Define server logic 
server <- function(input, output) {
    user_data <- reactive({
      read.csv(input$file1$datapath, header = T,
               sep = ",", quote = input$quote)
    })

    output$caratxui <- renderUI({
        pickerInput(
            inputId = "caratx",
            label = "Choose carat",
            choices = c("Select all", unique(user_data()$carat)),
            multiple = TRUE
        )

    })

    output$endplot <- renderPlot({
        validate(
            need(input$entityx, 'Please select at least one carat'),
            need(input$indicatorx, 'Please select at least one clarity')
        )

        user_data() %>%
            filter(carat %in% input$caratx) %>%
            filter(clarity %in% input$clarityx | 
                    input$caratx == "Select all") %>% 
            ggplot(aes(x = `cut`)) +
            geom_point(aes(y = price), color = "red") +
            geom_point(aes(y = depth), color = "blue")
        })
}

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