r - ggplotly 在散点图中 Shiny 的生产线

Question

在下面的代码中，绘图会根据是否选择“所有打字员”而变化。选择它后，应用程序看起来像这样，带有趋势线的散点图:

但是，当取消选中该复选框时，绘图将如下所示，在点之间添加线条。应该注意的是，这不是趋势线。当有更多点时，所有点之间都会有线:

这是 ggplotly 中的错误吗？还是我的代码有问题？我在下面提供了一个最小的示例

library(tidyr)
library(dplyr)
library(reshape)
library(shiny)
library(plotly)
library(ggplot2)

df <- as.data.frame(list("UserID"=c(1,1,1,1,2,2,2,2), 
                          "QuestionID"=c(4,4,5,5,4,4,6,6),
                          "KeystrokeRate"=c(8,4,6,15,8,6,7,8),
                          "cumul.ans.keystroke"=c(3,7,4,5,11,14,3,9),
                          "Relative.Time.Progress"=c(0.1,1.0,0.4,1.0,0.8,1.0,0.8,1.0)
                    ))

trendLineOptions = c("All Selected User's Answers"="allThisUser", 
                     "All Typists"="allTypists"#, 
                    )

ui <- (fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("userInput","Select User", sort(unique(df$UserID)),
                  selected = sort(unique(df$UserID))[1]),
      uiOutput("answerOutput"),
      checkboxGroupInput("trendsInput", "Add Trend Lines",
                         choices=trendLineOptions,
                         selected="allTypists")#,
    ),

    mainPanel(
      plotlyOutput("mainPlot")#,
    )
  )
))

server <- function(input, output, session) {

  # filter only based on selected user
  filteredForUser <- reactive({
    try(
      df %>%
        filter(
          UserID == input$userInput
        ), silent=T)
  })

  # filter for both user and answer
  filteredFull <- reactive({
    try (
      df %>% 
        filter(
          UserID == input$userInput,
          QuestionID == input$answerInput
        ), silent=T)
  })

  # filter answer choices based on user
  output$answerOutput <- renderUI({
    df.u <- filteredForUser()
    if(!is.null(df)) {
      selectInput("answerInput", "Select A Typing Session",
                  sort(unique(df.u$QuestionID)))
    }
  })

  output$mainPlot <- renderPlotly({

    # add trend line based on this user's data
    addUserTrendLine <- reactive({
      if (class(filteredForUser()) == "try-error" ||
          class(filteredFull()) == "try-error") {
        return(geom_blank())
      }
      if ("allThisUser" %in% input$trendsInput) {
        g <- geom_smooth(data=filteredFull(), inherit.aes=F, 
                         aes(x=Relative.Time.Progress,y=cumul.ans.keystroke), 
                         method='lm')
      } else {
        g <- geom_blank()
      }
      return (g)
    })

    # add trend line based on all data
    addAllUsersTrendLine <- reactive({
      if (class(filteredForUser()) == "try-error" ||
          class(filteredFull()) == "try-error") {
        return(geom_blank())
      }
      if ("allTypists" %in% input$trendsInput) {
        g <- geom_smooth(data=df, inherit.aes=F, 
                         aes(x=Relative.Time.Progress,y=cumul.ans.keystroke), 
                         method='lm')
      } else {
        g <- geom_blank(inherit.aes=F)
      }
      return (g)
    })

    if (class(filteredForUser()) == "try-error" ||
        class(filteredFull()) == "try-error") {
      return(geom_blank())
    } else {
      # plot scatter points and add trend lines
      gplot <- ggplot(data=filteredFull(), 
                      aes(x=Relative.Time.Progress,y=cumul.ans.keystroke)) + 
        geom_point(aes(size=KeystrokeRate,colour=KeystrokeRate)) +
        addUserTrendLine() +
        addAllUsersTrendLine()
      g <- ggplotly(p=gplot, source="main")
    }
  })

}

shinyApp(ui, server)

Answer 1

毫无疑问，这是一个错误。这是一个最小的示例，它指出了根本问题:

gplot <- ggplot(data = data.frame(a = 1:2, b = 1:2), aes(x = a, y = b)) + geom_point()

ggplotly(p=gplot, source="main")
ggplotly(p=gplot + geom_blank(), source="main")
ggplotly(p=gplot + geom_blank() + geom_blank(), source="main")

我认为，如果您向plotly 项目提交错误报告，那就太好了。

关于您 Shiny 的应用程序，我建议将 addAllUsersTrendLine 和 addUserTrendLine 组合为一个 reactive 或插入一个双 检查geom_blank。