r - بلوتلي خط الاتجاه الخطي لا تحديث في لامعة



plot ggplot2 (1)

المشكلة هي مع وظيفة add_trace . تحتاج إلى توفيره المحور س لتكون قادرة على مؤامرة بشكل صحيح نتيجة لم.

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) بشكل صحيح ولكن باستخدام المحور س ليكون c(0:7) . أنا التخمين هو تمرير الافتراضي ل add_trace ، ولكن لم أكن قد نظرت بعمق من 'لماذا' من هذا. مجموعة البيانات df لديها ثماني نقاط. تحتاج بدلا من ذلك لإعطاء قيم ريلاتيف .Time.Progress الفعلية على المحور س لتخطيط صحيح fitted(y) ورت قيم x الفعلية. نأمل أن يوضح هذا.

أحاول إضافة خط الاتجاه الخطي إلى مؤامرة مؤامرة في التطبيق لامعة. عند تغيير معلمات التحديد، أرى أن معاملات تغيير النموذج الخطي (باستخدام 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)