有没有办法比 R Plotly (Shiny) 中的现有数据更进一步地扩展趋势线？

Question

我希望使用 Plotly 来展示一些数据的趋势线。我设法做到了，因此用户可以根据 dateRangeInput 控制 X 轴的长度，但是当日期范围增加到超出现有数据的范围时，趋势线不会继续。我知道这可以通过 ggplot 实现，因为我已经在那里完成了，但是，我希望能够使用 Plotly 来实现其广泛的可定制性。

library(shiny)

df <- data.frame (date = seq(as.Date("2021/01/01"), by = "day", length.out = 365),
                  type = letters[1:5]
)
df$amount <- ifelse(df$type == "a", rexp(365, 1/10),
                    ifelse(df$type == "b", rexp(365, 1/20),
                           ifelse(df$type == "c", rexp(365, 1/30),
                                  ifelse(df$type == "d", rexp(365, 1/40),
                                         ifelse(df$type == "e", rexp(365, 1/50), 0
)))))
# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("All Sales Forecast by Source"),
  sidebarLayout(
    sidebarPanel(
      dateRangeInput("date", "Period", start = min(df$date), end = max(df$date)),
    ),
    mainPanel(
      tabsetPanel(
        tabPanel('Plotly',
                 plotlyOutput("Plotly_plot"), height = "auto", width = "auto")
      )
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
output$Plotly_plot <- renderPlotly({
  df$fv <- df %>%
    filter(!is.na(date))%>%
    lm(amount ~ date*type,.) %>%
    fitted.values()
  
  fig <- plot_ly(df, x = ~date, y = ~amount, type = 'scatter', alpha = 0.65, mode = 'markers', color = ~type)
  fig <- fig %>% add_trace(x = ~date, y = ~fv, name = ~type, mode = 'lines', alpha = 1)
  fig <- fig %>% layout(plot_bgcolor='#e5ecf6',
                        xaxis = list(zerolinecolor = '#ffff',
                                     zerolinewidth = 2,
                                     gridcolor = 'ffff',
                                     range = input$date))
})
}

# Run the application 
shinyApp(ui = ui, server = server)

这是我在 Whosebug 上的第一个问题，如果您需要我提供更多信息，请告诉我！

Answer 1

归根结底，这确实不是一个阴谋问题。您需要以某种方式将新数据传递给绘图。

您可以根据提供的日期范围在您的线模型上使用 predict 生成此数据：

library(shiny)
library(plotly)

training_df <- data.frame(date = seq(as.Date("2021/01/01"), by = "day", length.out = 365), type = letters[1:5])

training_df$amount <- ifelse(df$type == "a", rexp(365, 1/10),
                    ifelse(df$type == "b", rexp(365, 1/20),
                           ifelse(df$type == "c", rexp(365, 1/30),
                                  ifelse(df$type == "d", rexp(365, 1/40),
                                         ifelse(df$type == "e", rexp(365, 1/50), 0
                                         )))))

linear_model <- training_df %>% filter(!is.na(date)) %>% lm(amount ~ date*type,.)

ui <- fluidPage(
  titlePanel("All Sales Forecast by Source"),
  sidebarLayout(
    sidebarPanel(
      dateRangeInput("date", "Period", start = min(training_df$date), end = max(training_df$date)),
    ),
    mainPanel(
      tabsetPanel(
        tabPanel('Plotly',
                 plotlyOutput("Plotly_plot"), height = "auto", width = "auto")
      )
    )
  )
)

server <- function(input, output, session) {
  predicted_df <- reactive({
    date_range <- seq(from = min(input$date), to = max(input$date), by = "day")
    DF <- data.frame(date = date_range, type = rep(letters[1:5], length.out = length(date_range)))
    DF$predicted_amount <- predict(object = linear_model, newdata = DF)
    DF
  })
  
  output$Plotly_plot <- renderPlotly({
    fig <- plot_ly(training_df, x = ~date, y = ~amount, type = 'scatter', alpha = 0.65, mode = 'markers', color = ~type)
    fig <- fig %>% add_trace(data = predicted_df(), x = ~date, y = ~predicted_amount, name = ~type, mode = 'lines', alpha = 1)
    fig <- fig %>% layout(plot_bgcolor='#e5ecf6',
                          xaxis = list(zerolinecolor = '#ffff',
                                       zerolinewidth = 2,
                                       gridcolor = 'ffff',
                                       range = input$date))
  })
}

shinyApp(ui = ui, server = server)

有没有办法比 R Plotly (Shiny) 中的现有数据更进一步地扩展趋势线？

Is there a way to extend a trend line further than existing data in R Plotly (Shiny)?

r

linear-regression

shiny

plotly

r-plotly