0
votes

I am trying to build an R shiny page that displays a plot based on inputs from the side panel. However, I would like the inputs on the sidebar to be reactive, meaning the choices in one input are based on the choices of prior inputs. For example, since Test 1 was not conducted in May, by selecting dates prior to may it would filter out Test 1 for the relevant input selection.

My guess is that each sidebar would filter the subsequent responses, but I'm not sure how to do this. Here is what I have so far, and I've included an example of what the dataframe I'm using looks like.

The ultimate goal is to be able to generate a reactive plot that demonstrates Test Results as a scatter or line plot, by comparing a single result over time or by comparing results to each other (ie., Result X on the X axis and result Y on the Y axis).

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)
2

2 Answers

0
votes

To filter for only the rows you want to appear on the plot, use the 'subset' command within the renderPlot reactive function. In the example below, it filters just on the name. You can add additional 'subset' commands to filter by date range, etc.

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

Alright, your example wasn't really reproducible since a) you didn't use dput and it was a bit annoying having to copy the df, and b) your code has some errors.

I made a bunch of changes just to make it easier to work with your example, but the structure is basically the same. Also I didn't really understand exactly what were you looking to show with the plot, but hopefully the answer will give you some ideas about how to do what you want to do.

Let's break it down a bit. Since you wanted only to display the tests that were between X and Y date, I decided to move the test selectInput to be on the server side. This way, we can dynamically generate the options that are available to the user.

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

Next, I created a reactive object that is the one that actually gives the options to the previous selectInput. Basically, this object filters the data frame to only show the data that is available between the dates selected by the user.

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

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

Note that this solution isn't necessarily robust. You'll have to implement the logic that decides what to do if for example the user selects a date in which a participant didn't have any test.

In any case, I hope this answer more or less helps you to achieve what you want to do.

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)