情节线性趋势线不更新闪亮
plotly linear trend line not updating in shiny
我正在尝试将线性趋势线添加到闪亮应用程序中的绘图中。当我更改选择参数时,我看到线性模型的系数发生了变化(使用 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)
问题出在 add_trace
功能上。您需要为其提供 x-axis 才能正确绘制 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-axis 为 c(0:7)
。我猜它是传递给 add_trace
的默认值,但我没有深入研究它的 'why'。数据集 df
有八个点。相反,您需要在 x-axis 上给出实际的 Relative.Time.Progress
值才能正确绘制 fitted(y)
w.r.t。实际 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)
问题出在 add_trace
功能上。您需要为其提供 x-axis 才能正确绘制 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-axis 为 c(0:7)
。我猜它是传递给 add_trace
的默认值,但我没有深入研究它的 'why'。数据集 df
有八个点。相反,您需要在 x-axis 上给出实际的 Relative.Time.Progress
值才能正确绘制 fitted(y)
w.r.t。实际 x
值。希望这能澄清。