R блестящая фильтрация реактивных входов

Question

Я пытаюсь создать блестящую страницу R, которая отображает график на основе входных данных с боковой панели. Однако я хотел бы, чтобы входные данные на боковой панели были реактивными, то есть выбор в одном входе основан на выборе предыдущих входов. Например, поскольку тест 1 не проводился в мае, при выборе дат до мая он отфильтровывает тест 1 для соответствующего выбора ввода.

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

Конечная цель состоит в том, чтобы иметь возможность создать реактивный график, который демонстрирует результаты теста в виде точечного или линейного графика, сравнивая один результат во времени или сравнивая результаты друг с другом (ie., Результат X на оси X и результат Y на оси Y).

Dataframe
  Name         Test        Date     Result X  Result Y  Result Z
John Smith    Test 1   2020-03-01     1.5      1.7        10
Sally Smith   Test 2   2020-04-01     2.2      5.2        11
John Smith    Test 3   2020-05-01     3.1      3.4        14
Sally Smith   Test 2   2020-05-01     1.4      4.2        12
John Smith    Test 3   2020-04-01     1.5      4.4        15
John Smith    Test 1   2020-04-01     1.6      5.5        23
Sally Smith   Test 1   2020-03-01     1.6      6.6        12

library(tidyverse)
library(shiny)

# Define UI for application
ui <- navbarPage("Title",

    tabPanel("Title 1",
             sidebarPanel(
                 h4("Title 1"),
                 selectInput("Name_Select", label = "Select Name", choices = df$Name),
                 dateRangeInput("dates", label = "Dates",
                 start = max(df$Date),
                 end = min(df$Date),
                 min = min(df$Date),
                 max = max(df$Date)),
                 selectInput("Test_Select", label = "Select Test", choices = df$Test),
                 selectInput("x_axis", label = "Variable 1", choices = select(df, Date, Result X:Result Z)),
                 selectInput("y_axis", label = "Variable 2", choices = select(df, Date, Result X:Result Z))),

        mainPanel(plotOutput("Title1graph"))),

    tabPanel("Title 2",
             sidebarPanel(
                 h4("Title 2")))
)

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

    output$Title1graph <- renderPlot({
        plot(input$x_axis, input$y_axis)
    })
}

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

Answer 1

Хорошо, ваш пример не был на самом деле воспроизводимым, так как а) вы не использовали dput, и вам было немного неприятно копировать df, и б) ваш код содержит некоторые ошибки.

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

Давайте разберемся с этим немного. Поскольку вы хотели отображать только тесты между датами X и Y, я решил перенести тест selectInput на серверную часть. Таким образом, мы можем динамически генерировать опции, которые доступны пользователю.

    output$test_select <- renderUI({
        selectInput("test_select", label = "Select Test", choices = unique(filtered()$test), selected = filtered()$test[1])
    })  

Затем я создал реактивный объект, который фактически предоставляет опции предыдущему selectInput. По сути, этот объект фильтрует фрейм данных, чтобы показать только те данные, которые доступны между датами, выбранными пользователем.

    filtered <- reactive({
        min_date <- input$dates[1]
        max_date <- input$dates[2]

        df %>% 
            filter(date >= min_date & date <= max_date)
    })

Обратите внимание, что это решение не обязательно надежно. Вам нужно будет реализовать логику c, которая решает, что делать, если, например, пользователь выбирает дату, когда у участника не было никакого теста.

В любом случае, я надеюсь, что этот ответ более или менее поможет вам достичь того, что вы хотите сделать.

library(tidyverse)
library(shiny)

df <- tibble(
    name = c("Sally", "John", "Sally", "John", "Sally", "John"),
    test = c(1, 2, 3, 2 , 1, 2),
    date = c("2020-03-01", "2020-04-01", "2020-05-01", "2020-04-15", "2020-03-15", "2020-03-15"),
    result_x = c(4.5, 3.5, 6.7, 2.5, 4.4, 1.4),
    result_y = c(1.4, 4.2, 2.2, 3.5, 6.7, 3.2),
    result_z = c(4.4, 2.3, 6.3, 0.1, 3.3, 6.6)
)


# Define UI for application
ui <- navbarPage("Title",

                 tabPanel("Title 1",
                          sidebarPanel(
                              h4("Title 1"),
                              selectInput("name_select", label = "Select Name", choices = unique(df$name), selected = "Sally"),
                              dateRangeInput("dates", label = "Dates",
                                             start = min(df$date),
                                             end = max(df$date),
                                             min = min(df$date),
                                             max = max(df$date)),
                              uiOutput("test_select"),
                              selectInput("x_axis", label = "Variable 1", choices = c("result_x", "result_y", "result_z")),
                              selectInput("y_axis", label = "Variable 2", choices = c("result_x", "result_y", "result_z"))),

                          mainPanel(plotOutput("Title1graph")),
                          tabPanel("Title 2",
                                   sidebarPanel(
                                       h4("Title 2"))))
)

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

    filtered <- reactive({
        min_date <- input$dates[1]
        max_date <- input$dates[2]

        df %>% 
            filter(date >= min_date & date <= max_date)
    })

    output$test_select <- renderUI({
        selectInput("test_select", label = "Select Test", choices = unique(filtered()$test))
    })  

    output$Title1graph <- renderPlot({
        req(input$test_select)

        x_axis <- input$x_axis
        y_axis <- input$y_axis
        test_select <- input$test_select


        df <- df %>% 
            filter(test == test_select)

        plot(df[[x_axis]], df[[y_axis]])
    })

}

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

Answer 2

Чтобы отфильтровать только те строки, которые вы хотите отобразить на графике, используйте команду «subset» в реактивной функции renderPlot. В приведенном ниже примере он фильтрует только по имени. Вы можете добавить дополнительные команды «подмножество» для фильтрации по диапазону дат, например c.

  output$Title1graph <- renderPlot({
    plotData <- subset(df,df$Name == input$Name_Select)
    print (plotData)
    plot(plotData$Test, plotData$Result.X)
  })