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檢查。