CODEWITHSUNDEEP
rggplot2shiny
Wietze314
Wietze314

Reputation: 6020

Shiny interactive ggplot missing error bars

I have an interactive plot in my shiny app. In this plot I can mark data-points as artefact. Part of the data is plotted as a line chart and part as error bars.

I use the following ggplot code:

ggplot(plotdat,
       aes(x = time, y = value, color = type)) +
  labs(title = "vitals from test") +
  geom_errorbar(data = nibpdat, 
                aes(x = time, 
                    ymin = dianibp, 
                    ymax = sysnibp), 
                position = position_dodge(.1)) +
  scale_color_manual(values = vitalpalette) +
  geom_point() +
  geom_line(data = plotdat %>% filter(!grepl("NIBP$", type))) +
  geom_point(data = plotdat %>% filter(artefact),mapping = aes(x = time, y = value, color = type),
             shape = 4, size = 2, stroke = 2) +
  theme_bw()

When I test this plot outside the shiny app it works. All error bars stay visible. But inside the shiny app if a point in nibpdat is marked (column artefact, the error bar is not plotted.

This is the normal plot (marked points are simulated)

Normal ggplot

And this is the plot when made in shiny with the same code, when several points of the error bars are marked.

Shiny ggplot

ui.R

# load function
library(shiny)
require(dplyr)
require(ggplot2)
require(purrr)
require(tidyr)

cases <- c(1)

vitaltypes <- tribble(
  ~field, ~label, ~color,
  "sysnibp", "systolic NIBP", "0000FF",
  "meannibp", "mean NIBP", "0000FF",
  "dianibp", "diastolic NIBP", "0000FF",
  "sysabp", "systolic IBP", "730C5A",
  "meanabp", "mean IBP", "E5BFDE",
  "diaabp", "diastolic IBP", "730C5A",
  "heartrate", "heartrate", "FF0000",
  "saturation", "saturation", "42BEFF"
)

vitalpalette <- paste0("#",vitaltypes$color)
names(vitalpalette) <- vitaltypes$label




shinyUI(fluidPage(

  titlePanel("Annotate your data now"),

  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "case",
                  label = "Select case:",
                  choices = cases)
    ),

    mainPanel(
      plotOutput("VitalsPlot", click = "VitalsPlot_click"),
      h2("Marked Artefacts"),
      tableOutput("artefacts")
    )
  )
))

server.R:

shinyServer(function(input, output) {

  vitals <- reactive({

    structure(list(time = c(3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 
                            14, 15, 16, 17, 18, 19, 20, 21, 22, 3, 4, 5, 6, 7, 8, 9, 10, 
                            11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 4, 7, 10, 12, 
                            14, 16, 18, 21, 22, 23, 25, 26, 27, 29, 30, 31, 32, 34, 35, 36, 
                            4, 7, 10, 12, 14, 16, 18, 21, 22, 23, 25, 26, 27, 29, 30, 31, 
                            32, 34, 35, 36, 4, 7, 10, 12, 14, 16, 18, 21, 22, 23, 25, 26, 
                            27, 29, 30, 31, 32, 34, 35, 36), 
                   type = c("heartrate", "heartrate", 
                            "heartrate", "heartrate", "heartrate", "heartrate", "heartrate", 
                            "heartrate", "heartrate", "heartrate", "heartrate", "heartrate", 
                            "heartrate", "heartrate", "heartrate", "heartrate", "heartrate", 
                            "heartrate", "heartrate", "heartrate", "saturation", "saturation", 
                            "saturation", "saturation", "saturation", "saturation", "saturation", 
                            "saturation", "saturation", "saturation", "saturation", "saturation", 
                            "saturation", "saturation", "saturation", "saturation", "saturation", 
                            "saturation", "saturation", "saturation", "sysnibp", "sysnibp", 
                            "sysnibp", "sysnibp", "sysnibp", "sysnibp", "sysnibp", "sysnibp", 
                            "sysnibp", "sysnibp", "sysnibp", "sysnibp", "sysnibp", "sysnibp", 
                            "sysnibp", "sysnibp", "sysnibp", "sysnibp", "sysnibp", "sysnibp", 
                            "meannibp", "meannibp", "meannibp", "meannibp", "meannibp", "meannibp", 
                            "meannibp", "meannibp", "meannibp", "meannibp", "meannibp", "meannibp", 
                            "meannibp", "meannibp", "meannibp", "meannibp", "meannibp", "meannibp", 
                            "meannibp", "meannibp", "dianibp", "dianibp", "dianibp", "dianibp", 
                            "dianibp", "dianibp", "dianibp", "dianibp", "dianibp", "dianibp", 
                            "dianibp", "dianibp", "dianibp", "dianibp", "dianibp", "dianibp", 
                            "dianibp", "dianibp", "dianibp", "dianibp"), 
                   value = c(97, 101, 
                             92, 95, 85, 93, 87, 87, 87, 92, 93, 90, 88, 83, 82, 72, 68, 62, 
                             66, 83, 98.3, 98, 98.3, 98, 98.9, 98.5, 99.8, 99.2, 99, 99.4, 
                             98.8, 98.7, 99, 94.7, 98, 98.5, 95.9, 98.1, 99.1, 98.2, 142, 
                             132, 126, 128, 136, 107, 107, 108, 121, 87, 102, 107, 100, 112, 
                             115, 114, 110, 102, 103, 105, 93, 86, 86, 86, 70, 70, 82, 76, 
                             76, 51, 57, 62, 66, 63, 70, 75, 65, 64, 71, 65, 71, 64, 72, 74, 
                             57, 55, 74, 61, 59, 32, 31, 55, 50, 47, 48, 58, 48, 48, 61, 50
                   ), case = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
                               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
                               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
                               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
                               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)), 
              class = c("tbl_df", 
                        "tbl", "data.frame"), .Names = c("time", "type", "value", "case"
                        ), row.names = c(NA, -100L))
  }) 

  observe({
    n <- nrow(vitals())
    artefacts$numberofvitals <- n
    artefacts$status <- rep(FALSE,n)
  })

  artefacts <- reactiveValues(
    numberofvitals = 1,
    status = rep(FALSE, 1)
  )

  observeEvent(input$VitalsPlot_click, {
    res <- nearPoints(vitals(), input$VitalsPlot_click, allRows = TRUE)[1:artefacts$numberofvitals,]

    artefacts$status <- xor(artefacts$status, res$selected_)
  })

  output$VitalsPlot <- renderPlot({
    plotvitals <- vitals()
    plotvitals$artefact <- artefacts$status

    plotdat <- plotvitals %>% mutate(type = factor(match(type, vitaltypes$field), 
                                                   levels = seq_len(nrow(vitaltypes)), 
                                                   labels = vitaltypes$label))

    nibpdat <- plotvitals %>% filter(grepl("nibp$",type)) %>%
      spread(type, value) %>%
      mutate(type = factor(match("meannibp", vitaltypes$field), 
                           levels = seq_len(nrow(vitaltypes)), 
                           labels = vitaltypes$label),
             value = meannibp,
             artefact = FALSE)

    plotid <- "test"

    ggplot(plotdat,
           aes(x = time, y = value, color = type)) +
      labs(title = paste0("vitals from ",plotid)) +
      geom_errorbar(data = nibpdat, 
                    aes(x = time, 
                        ymin = dianibp, 
                        ymax = sysnibp), 
                    position = position_dodge(.1)) +
      scale_color_manual(values = vitalpalette) +
      geom_point() +
      geom_line(data = plotdat %>% filter(!grepl("NIBP$", type))) +
      geom_point(data = plotdat %>% filter(artefact),mapping = aes(x = time, y = value, color = type),
                 shape = 4, size = 2, stroke = 2) +
      theme_bw()

  })

  output$artefacts <- renderTable({
    vitals()[artefacts$status,] %>%
      arrange(type, time) %>%
      group_by(type) %>%
      mutate(vital = if_else(row_number()==1,unlist(vitaltypes[match(type, vitaltypes$field),"label"]),""),
             time = floor(time)) %>%
      ungroup() %>%
      select(vital, time, value)
  })
})

output from sessionInfo()

R version 3.4.1 (2017-06-30)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1

Matrix products: default

locale:
  [1] LC_COLLATE=Dutch_Netherlands.1252  LC_CTYPE=Dutch_Netherlands.1252    LC_MONETARY=Dutch_Netherlands.1252
[4] LC_NUMERIC=C                       LC_TIME=Dutch_Netherlands.1252    

attached base packages:
  [1] stats     graphics  grDevices utils     datasets  methods   base     

loaded via a namespace (and not attached):
  [1] compiler_3.4.1 tools_3.4.1

Upvotes: 2

Views: 438

Answers (1)

Wietze314
Wietze314

Reputation: 6020

The following issue occurs in this sample shiny app:

When a point is clicked, value artefact in artefact$status is changed from TRUE to FALSE.

In the following piece of code, the data is spread, but because now one of the three values belonging together has a different value for field artefact, two seperate rows are generated. Thus with geom_errorbar() at least one of the aesthetics is missing (y, ymax or ymin).

nibpdat <- plotvitals %>% filter(grepl("nibp$",type)) %>%
  spread(type, value) %>%
  mutate(type = factor(match("meannibp", vitaltypes$field), 
                       levels = seq_len(nrow(vitaltypes)), 
                       labels = vitaltypes$label),
         value = meannibp,
         artefact = FALSE)

should be changed to:

nibpdat <- plotvitals %>% filter(grepl("nibp$",type)) %>% 
  select(-artefact) %>%
  spread(type, plotvalue) %>%
  mutate(type = factor(match("meannibp", vitaltypes$field), 
                       levels = seq_len(nrow(vitaltypes)), 
                       labels = vitaltypes$label),
         plotvalue = meannibp,
         artefact = FALSE)

Upvotes: 5

Related Questions