R闪亮过滤反应输入

Question

我正在尝试构建一个基于侧面板输入显示绘图的 R 闪亮页面。但是，我希望侧边栏上的输入具有反应性，这意味着一个输入中的选择基于先前输入的选择。例如，由于测试 1 不是在 5 月进行的，因此通过选择 5 月之前的日期，它将过滤掉测试 1 的相关输入选择。

我的猜测是每个侧边栏都会过滤后续响应，但我不确定如何执行此操作。这是我到目前为止所拥有的，我已经包含了一个我正在使用的数据框的示例。

最终目标是能够生成一个反应图，将测试结果显示为散点图或线图，通过随时间推移比较单个结果或将结果相互比较（即 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

要仅过滤要在绘图上显示的行，请使用 renderPlot 反应函数中的“子集”命令。在下面的示例中，它只过滤名称。您可以添加额外的“子集”命令以按日期范围等进行过滤。

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

Answer 2

好吧，您的示例实际上无法重现，因为 a) 您没有使用 dput，而且复制 df 有点烦人，并且 b) 您的代码有一些错误。

我做了很多更改，只是为了让您的示例更易于使用，但结构基本相同。此外，我并没有真正理解您希望通过情节展示什么，但希望答案能给您一些关于如何做您想做的事情的想法。

让我们稍微分解一下。由于您只想显示 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)
    })

请注意，此解决方案不一定可靠。例如，如果用户选择参与者没有进行任何测试的日期，您必须实现决定要做什么的逻辑。

无论如何，我希望这个答案或多或少能帮助你实现你想做的事情。

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)