Stuck getting reactive plot to update with choice from a reactive table

shiny
,
1

I am struggling with my first non-trivial Shiny app. I am trying to get a reactive graphic to update with and end-user selection from a reactive table. I can get everything to work up to the point of updating the graphic. I suspect the problem is something simple and I am missing a concept. A reprex follows.

Thanks!

#################################################################################
## Goal: Create a reactive table of values of sensitivity and specificity based
##       the users choice of coutry name.  Present a plot of sensitivity and
##       specificity based on that choice.  Finally, allow users to select a
##       single row from that and then: 1) reactively update the plot to show the
##       selected combination of sensitivity and specificity, and 2) capture the
##       contents of the selected row for future computation.
##
## Note: Everything works up to the line in server() beginning with
##       s = input$thresholds
#################################################################################
library(tidyverse)
library(shiny)

cdat <- structure(list(country = c("Somewhere", "Elsewhere")), class = "data.frame",
                  row.names = c(NA, -2L))

adat <- structure(list(country = c("Somewhere", "Somewhere", "Somewhere", "Somewhere",
                                   "Somewhere", "Somewhere", "Somewhere", "Somewhere",
                                   "Somewhere", "Somewhere", "Somewhere", "Somewhere",
                                   "Somewhere", "Elsewhere", "Elsewhere", "Elsewhere",
                                   "Elsewhere", "Elsewhere", "Elsewhere", "Elsewhere",
                                   "Elsewhere", "Elsewhere", "Elsewhere", "Elsewhere",
                                   "Elsewhere", "Elsewhere"),
                       Sensitivity = c(89.82, 85.03, 80.24, 74.85, 70.06, 65.27,
                                       59.88, 55.09, 50.3, 44.91, 40.12, 34.73,
                                       29.94, 90.12, 85.19, 80.25, 75.31, 69.75,
                                       64.81, 59.88, 54.94, 50, 45.06, 40.12, 35.19,
                                       30.25),
                       Specificity = c(44.72, 50.22, 58.86, 70.25, 76.89, 80.57,
                                       86.04, 89.27, 91.54, 94.11, 95.81, 96.65,
                                       97.85, 21.7, 32.61, 39.02, 44.08, 49.85,
                                       54.54, 58.92, 66.68, 75.22, 79.35, 83.85,
                                       89.39, 92.69),
                       Threshold = c(0.0239, 0.0271, 0.0331, 0.043, 0.0522, 0.0583,
                                     0.0706, 0.0794, 0.0902, 0.1052, 0.1208, 0.1343,
                                     0.1565, 0.0216, 0.0261, 0.0291, 0.0316, 0.0352,
                                     0.0379, 0.0413, 0.0484, 0.0596, 0.0666, 0.076,
                                     0.0947, 0.1107)),
                  class = "data.frame", row.names = c(NA, -26L))



ui <- shiny::navbarPage(
                 tabPanel("Settings",
                          sidebarLayout(
                              sidebarPanel(width = 5,
                                           selectInput("country", "Select country and  threshold",
                                                       choices = cdat$country),
                                           helpText("Select threshold based on sensitivity and specificity"),
                                           DT::dataTableOutput("thresholds")
                                           ),
                              mainPanel(width = 7,
                                        plotOutput("rocplot", width = 700, height = 700))
                          ) )
             )

server <- function(input, output,  session) {
    countrydat <- reactive({
        filter(cdat, country == cdat$country)
    })
    observeEvent(countrydat(), {
        choices <- countrydat()$country
        updateSelectInput(inputId = "thresholds")
    })

    thresholds <- reactive({
        adat %>%
            filter(country == input$country) %>%
            select(Sensitivity, Specificity, Threshold) %>%
            mutate(Threshold = round(Threshold, digits = 6)) %>%
            bind_rows(data.frame(Sensitivity = c(100, 0),
                                 Specificity = c(0, 100 ),
                                 Threshold = c(NA, NA))) %>%
            arrange(Sensitivity)
    })

    output$thresholds <- DT::renderDT(thresholds(), selection = "single",
                                      server = FALSE, options = list(dom = 'pt'))

    output$rocplot <- renderPlot({
        ggplot(thresholds(), aes(x = Specificity,  y = Sensitivity)) +
            scale_x_reverse( ) +
        ggtitle("Receiver-operating characteristic curve with selected threshold") +
        theme(plot.title=element_text(size=16),
              axis.title.x = element_text(size = 18),
              axis.title.y = element_text(size = 18),
              axis.text.x = element_text(size = 16),
              axis.text.y = element_text(size = 16)) +
        annotate("segment", x = 100, y = 0, xend = 0, yend = 100,
                     linetype = 2, linewidth = 0.5) +
        geom_line(col =  "black") +
        geom_point(shape = 21, size = 6, col =  "black", fill = "white" ) +
        xlim(100, 0) + ylim(0, 100) +
            xlab("Specificity (%)") + ylab("Sensitivity (%)")
        ## s = input$thresholds                                 ## FAILS!
        ## if (length(s)) geom_point(aes(x = s$Specificity, y = s$Sensitivity),
        ##                           shape = 21, size = 4, col =  "black",
        ##                           fill = "blue")
    })
}

shinyApp(ui = ui, server = server)
2

Hi @steve.g, thank you for your post.

Your example appeared to work for me.

The one thing I changed was to add all your outputs and other reactive expressions within the server() function. It wasn't clear from the way the reprex was displayed if this was what you've done:

# libraries --------------------------------------------------------------------
library(tidyverse)
library(shiny)

# data -------------------------------------------------------------------------
cdat <- structure(list(country = c("Somewhere", "Elsewhere")), class = "data.frame",
                  row.names = c(NA, -2L))

adat <- structure(list(country = c("Somewhere", "Somewhere", "Somewhere", "Somewhere",
                                   "Somewhere", "Somewhere", "Somewhere", "Somewhere",
                                   "Somewhere", "Somewhere", "Somewhere", "Somewhere",
                                   "Somewhere", "Elsewhere", "Elsewhere", "Elsewhere",
                                   "Elsewhere", "Elsewhere", "Elsewhere", "Elsewhere",
                                   "Elsewhere", "Elsewhere", "Elsewhere", "Elsewhere",
                                   "Elsewhere", "Elsewhere"),
                       Sensitivity = c(89.82, 85.03, 80.24, 74.85, 70.06, 65.27,
                                       59.88, 55.09, 50.3, 44.91, 40.12, 34.73,
                                       29.94, 90.12, 85.19, 80.25, 75.31, 69.75,
                                       64.81, 59.88, 54.94, 50, 45.06, 40.12, 35.19,
                                       30.25),
                       Specificity = c(44.72, 50.22, 58.86, 70.25, 76.89, 80.57,
                                       86.04, 89.27, 91.54, 94.11, 95.81, 96.65,
                                       97.85, 21.7, 32.61, 39.02, 44.08, 49.85,
                                       54.54, 58.92, 66.68, 75.22, 79.35, 83.85,
                                       89.39, 92.69),
                       Threshold = c(0.0239, 0.0271, 0.0331, 0.043, 0.0522, 0.0583,
                                     0.0706, 0.0794, 0.0902, 0.1052, 0.1208, 0.1343,
                                     0.1565, 0.0216, 0.0261, 0.0291, 0.0316, 0.0352,
                                     0.0379, 0.0413, 0.0484, 0.0596, 0.0666, 0.076,
                                     0.0947, 0.1107)),
                  class = "data.frame", row.names = c(NA, -26L))

# ui ---------------------------------------------------------------------------
ui <- shiny::navbarPage(
  tabPanel("Settings",
           sidebarLayout(
             sidebarPanel(width = 5,
                          selectInput("country", "Select country and threshold",
                                      choices = cdat$country),
                          helpText("Select threshold based on sensitivity and specificity"),
                          DT::dataTableOutput("thresholds")
             ),
             mainPanel(width = 7,
                       plotOutput("rocplot", width = 700, height = 700))
           ) )
)

# server -----------------------------------------------------------------------
server <- function(input, output, session) {
  countrydat <- reactive({
    filter(cdat, country == cdat$country)
  })
  observeEvent(countrydat(), {
    choices <- countrydat()$country
    updateSelectInput(inputId = "thresholds")
  })
  
  thresholds <- reactive({
    adat %>%
      filter(country == input$country) %>%
      select(Sensitivity, Specificity, Threshold) %>%
      mutate(Threshold = round(Threshold, digits = 6)) %>%
      bind_rows(data.frame(Sensitivity = c(100, 0),
                           Specificity = c(0, 100 ),
                           Threshold = c(NA, NA))) %>%
      arrange(Sensitivity)
  })
  
  output$thresholds <- DT::renderDT(thresholds(), selection = "single",
                                    server = FALSE, options = list(dom = 'pt'))
  
  output$rocplot <- renderPlot({
    ggplot(thresholds(), aes(x = Specificity,  y = Sensitivity)) +
      scale_x_reverse( ) +
      ggtitle("Receiver-operating characteristic curve with selected threshold") +
      theme(plot.title=element_text(size=16),
            axis.title.x = element_text(size = 18),
            axis.title.y = element_text(size = 18),
            axis.text.x = element_text(size = 16),
            axis.text.y = element_text(size = 16)) +
      annotate("segment", x = 100, y = 0, xend = 0, yend = 100,
               linetype = 2, linewidth = 0.5) +
      geom_line(col =  "black") +
      geom_point(shape = 21, size = 6, col =  "black", fill = "white" ) +
      xlim(100, 0) + ylim(0, 100) +
      xlab("Specificity (%)") + ylab("Sensitivity (%)")
  })
}

# run --------------------------------------------------------------------------
shinyApp(ui = ui, server = server)

When I run the above I see an app with a drop-down select input with 'Somewhere' and 'Elsewhere' as choices, a DT table showing details and a ggplot showing the ROC curve. Switching between 'Somewhere' and 'Elsewhere' updates the DT table and ggplot chart.

3

Thanks for taking a look!

It seems that commented lines were removed from the reprex after I pasted it. The code that you ran does indeed work on my end. The code fails with the line beginning with s <- input$thresholds. The un-commented lines appear below.

The goal is to create a reactive table of values of sensitivity and specificity based the users choice of country name. Present a plot of sensitivity and specificity based on that choice. Finally, allow users to select a single row from that and then: 1) reactively update the plot to show the selected combination of sensitivity and specificity, and 2) capture the contents of the selected row for future computation.

Again, thanks!

server <- function(input, output,  session) {
    countrydat <- reactive({
        filter(cdat, country == cdat$country)
    })
    observeEvent(countrydat(), {
        choices <- countrydat()$country
        updateSelectInput(inputId = "thresholds")
    })

    thresholds <- reactive({
        adat %>%
            filter(country == input$country) %>%
            select(Sensitivity, Specificity, Threshold) %>%
            mutate(Threshold = round(Threshold, digits = 6)) %>%
            bind_rows(data.frame(Sensitivity = c(100, 0),
                                 Specificity = c(0, 100 ),
                                 Threshold = c(NA, NA))) %>%
            arrange(Sensitivity)
    })

    output$thresholds <- DT::renderDT(thresholds(), selection = "single",
                                      server = FALSE, options = list(dom = 'pt'))

    output$rocplot <- renderPlot({
        ggplot(thresholds(), aes(x = Specificity,  y = Sensitivity)) +
            scale_x_reverse( ) +
        ggtitle("Receiver-operating characteristic curve with selected threshold") +
        theme(plot.title=element_text(size=16),
              axis.title.x = element_text(size = 18),
              axis.title.y = element_text(size = 18),
              axis.text.x = element_text(size = 16),
              axis.text.y = element_text(size = 16)) +
        annotate("segment", x = 100, y = 0, xend = 0, yend = 100,
                     linetype = 2, linewidth = 0.5) +
        geom_line(col =  "black") +
        geom_point(shape = 21, size = 6, col =  "black", fill = "white" ) +
        xlim(100, 0) + ylim(0, 100) +
            xlab("Specificity (%)") + ylab("Sensitivity (%)")
        s = input$thresholds                                 ## FAILS!
        if (length(s)) geom_point(aes(x = s$Specificity, y = s$Sensitivity),
                                  shape = 21, size = 4, col =  "black",
                                  fill = "blue")
    })
}
4

Please format your code for the forum
Use three backticks on their own line to initiate a code block

Like this
5

Hi @steve.g ,

Thanks for replying to clarify. I think I see what you're after now - you wish to highlight the selected row in the DT table in the ggplot.

In the output$rocplot() where you render the ggplot I've added a conditional section (labelled 'NEW') which checks that a row has been selected, and if so then gathers data from the selected row and highlights within the ggplot.

Note, I've switched from geom_point to annotate in response to a warning message about mis-matched aesthetics lengths, but the effect is the same and is probably a more appropriate way to do this kind of highlight.

# libraries --------------------------------------------------------------------
library(tidyverse)
library(shiny)

# data -------------------------------------------------------------------------
cdat <- structure(list(country = c("Somewhere", "Elsewhere")), class = "data.frame",
                  row.names = c(NA, -2L))

adat <- structure(list(country = c("Somewhere", "Somewhere", "Somewhere", "Somewhere",
                                   "Somewhere", "Somewhere", "Somewhere", "Somewhere",
                                   "Somewhere", "Somewhere", "Somewhere", "Somewhere",
                                   "Somewhere", "Elsewhere", "Elsewhere", "Elsewhere",
                                   "Elsewhere", "Elsewhere", "Elsewhere", "Elsewhere",
                                   "Elsewhere", "Elsewhere", "Elsewhere", "Elsewhere",
                                   "Elsewhere", "Elsewhere"),
                       Sensitivity = c(89.82, 85.03, 80.24, 74.85, 70.06, 65.27,
                                       59.88, 55.09, 50.3, 44.91, 40.12, 34.73,
                                       29.94, 90.12, 85.19, 80.25, 75.31, 69.75,
                                       64.81, 59.88, 54.94, 50, 45.06, 40.12, 35.19,
                                       30.25),
                       Specificity = c(44.72, 50.22, 58.86, 70.25, 76.89, 80.57,
                                       86.04, 89.27, 91.54, 94.11, 95.81, 96.65,
                                       97.85, 21.7, 32.61, 39.02, 44.08, 49.85,
                                       54.54, 58.92, 66.68, 75.22, 79.35, 83.85,
                                       89.39, 92.69),
                       Threshold = c(0.0239, 0.0271, 0.0331, 0.043, 0.0522, 0.0583,
                                     0.0706, 0.0794, 0.0902, 0.1052, 0.1208, 0.1343,
                                     0.1565, 0.0216, 0.0261, 0.0291, 0.0316, 0.0352,
                                     0.0379, 0.0413, 0.0484, 0.0596, 0.0666, 0.076,
                                     0.0947, 0.1107)),
                  class = "data.frame", row.names = c(NA, -26L))

# ui ---------------------------------------------------------------------------
ui <- shiny::navbarPage(
  tabPanel("Settings",
           sidebarLayout(
             sidebarPanel(width = 5,
                          selectInput("country", "Select country and threshold",
                                      choices = cdat$country),
                          helpText("Select threshold based on sensitivity and specificity"),
                          DT::dataTableOutput("thresholds")
             ),
             mainPanel(width = 7,
                       plotOutput("rocplot", width = 700, height = 700))
           ) )
)

# server -----------------------------------------------------------------------
server <- function(input, output, session) {
  countrydat <- reactive({
    filter(cdat, country == cdat$country)
  })
  observeEvent(countrydat(), {
    choices <- countrydat()$country
    updateSelectInput(inputId = "thresholds")
  })
  
  thresholds <- reactive({
    adat %>%
      filter(country == input$country) %>%
      select(Sensitivity, Specificity, Threshold) %>%
      mutate(Threshold = round(Threshold, digits = 6)) %>%
      bind_rows(data.frame(Sensitivity = c(100, 0),
                           Specificity = c(0, 100 ),
                           Threshold = c(NA, NA))) %>%
      arrange(Sensitivity)
  })
  
  output$thresholds <- DT::renderDT(thresholds(), selection = "single",
                                    server = FALSE, options = list(dom = 'pt'))
  
  output$rocplot <- renderPlot({
    p <- ggplot(thresholds(), aes(x = Specificity,  y = Sensitivity)) +
      scale_x_reverse( ) +
      ggtitle("Receiver-operating characteristic curve with selected threshold") +
      theme(plot.title=element_text(size=16),
            axis.title.x = element_text(size = 18),
            axis.title.y = element_text(size = 18),
            axis.text.x = element_text(size = 16),
            axis.text.y = element_text(size = 16)) +
      annotate("segment", x = 100, y = 0, xend = 0, yend = 100,
               linetype = 2, linewidth = 0.5) +
      geom_line(col =  "black") +
      geom_point(shape = 21, size = 6, col =  "black", fill = "white" ) +
      xlim(100, 0) + ylim(0, 100) +
      xlab("Specificity (%)") + ylab("Sensitivity (%)")
    
    # NEW ----------------------------------------------------------------------
    # add conditional based on thresholds
    if (!is.null(input$thresholds_rows_selected)) {
      
      # get details for the selected row
      selected_row <- thresholds()[input$thresholds_rows_selected, ]
      
      # update the plot to highlight selected data
      p <- p +
        annotate(
          geom = 'point', 
          x = selected_row$Specificity,
          y = selected_row$Sensitivity,
          shape = 21, size = 4, col = 'black', fill = 'blue'
        )
    }
    
    # return the ggplot object
    return(p)
  })
}

# run --------------------------------------------------------------------------
shinyApp(ui = ui, server = server)
6

Thank you Craig! Problem solved. I knew I was missing something basic.

7

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.