ggplotly在散点图中有光泽的生产线

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

我认为这将是一件好事，如果你提交一个bug报告，plotly项目。

关于你闪亮的应用程序，我建议要么合并addAllUsersTrendLine和addUserTrendLine一个reactive或插入双geom_blank检查。