绘制线性趋势线未在闪亮中更新

Question

我正在尝试将线性趋势线添加到闪亮应用程序中的情节图中。当我更改选择参数时，我看到线性模型的系数发生了变化（使用observe(print(summary(l))。但是，绘图上的实际线似乎保持在同一个位置。

这是一个图，其中趋势线至少看起来接近与两点相交：

在另一个图中，趋势线离第一个点很远：

这是一个最小的工作示例：

library(dplyr)
library(shiny)
library(plotly)

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(1,7,1,5,1,14,1,9),
                "Relative.Time.Progress"=c(0.1,1.0,0.4,1.0,0.8,1.0,0.8,1.0)
                    ))

ui <- (fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("userInput","Select User", sort(unique(df$UserID)),
                  selected = sort(unique(df$UserID))[1]),
      uiOutput("answerOutput")#,
    ),

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

    if (class(filteredForUser()) == "try-error" ||
        class(filteredFull()) == "try-error") {
      return(geom_blank())
    } else {
      # plot scatter points and add trend lines
        p <- plot_ly(filteredFull(), x=Relative.Time.Progress, y=cumul.ans.keystroke,
                       mode='markers', color=KeystrokeRate, size=KeystrokeRate,
                       marker=list(sizeref=100), type='scatter')
        l <- lm(cumul.ans.keystroke ~ Relative.Time.Progress,
                   data=filteredFull())
        observe(print(summary(l)))
          p <- add_trace(p, y= fitted(l))
          p
    }
  })     
}

shinyApp(ui, server)

Answer 1

问题在于add_trace 功能。您需要为其提供 x 轴才能正确绘制 lm 结果。

p <- add_trace(p, y = fitted(l), x = Relative.Time.Progress)

要更清楚地看到问题，请使用整个数据集可视化结果。

p <- plot_ly(df, x=Relative.Time.Progress, y=cumul.ans.keystroke,
             mode='markers', color=KeystrokeRate, size=KeystrokeRate,
             marker=list(sizeref=100), type='scatter')
p

l <- lm(cumul.ans.keystroke ~ Relative.Time.Progress,
        data=df)
p <- add_trace(p, y = fitted(l))
p

p <- plot_ly(df, x=Relative.Time.Progress, y=cumul.ans.keystroke,
             mode='markers', color=KeystrokeRate, size=KeystrokeRate,
             marker=list(sizeref=100), type='scatter')
l <- lm(cumul.ans.keystroke ~ Relative.Time.Progress,
        data=df)
p <- add_trace(p, y = fitted(l), x = Relative.Time.Progress)
p

如您所见，add_trace 正确地绘制了fitted(y)，但使用 x 轴为c(0:7)。我猜这是传递给add_trace 的默认值，但我并没有深入研究“为什么”。数据集df 有八个点。相反，您需要在 x 轴上给出实际的 Relative.Time.Progress 值才能正确绘制 fitted(y) w.r.t。实际的x 值。希望这可以澄清。