闪亮的交互式 ggplot 缺少错误栏答案

【问题标题】：Shiny interactive ggplot missing error bars闪亮的交互式 ggplot 缺少错误栏
【发布时间】：2019-07-01 16:54:50
【问题描述】：

我的闪亮应用中有一个交互式情节。在这个图中，我可以将数据点标记为人工制品。部分数据绘制为折线图，部分绘制为误差线。

我使用以下ggplot 代码：

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

当我在闪亮的应用程序之外测试这个情节时，它可以工作。所有误差线都保持可见。但是在闪亮的应用程序中，如果标记了nibpdat 中的一个点（artefact 列，则不会绘制错误栏。

这是正常的图（标记点是模拟的）

这是使用相同代码制作闪亮时的情节，当错误条的几个点被标记时。

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

服务器.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)
  })
})

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

【问题讨论】：

你能分享你的数据 plotdat 和 nibpdat 吗？
不是真的:-)。我希望有人会在没有数据的情况下看到问题。
@Wietze314 你能分享你的操作系统和R版本sessionInfo()吗？
我在我的代码中发现了这个问题。看我的回答。
@Wietze314 很遗憾听到有关机器问题的消息，但“欢呼”解决了问题。

标签： r ggplot2 shiny

【解决方案1】：

此示例闪亮应用中出现以下问题：

当点击某个点时，artefact$status 中的值artefact 会从 TRUE 变为 FALSE。

在下面的代码中，数据是分散的，但是因为现在属于一起的三个值之一具有不同的字段artefact，所以生成了两个单独的行。因此，geom_errorbar() 至少缺少一种美学（y、ymax 或 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)

应该改为：

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)

【讨论】：