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

Question

I am hoping to use Plotly to showcase a trendline over some data. I have managed to make it so the user can control the length of the X-Axis based on a dateRangeInput but when the date range is increased to beyond that of existing data, the trendline doesn't continue. I know this is possible through ggplot as I have done it there, however, I want to be able to use Plotly for its vast customisability.

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)

This is my first question on StackOverflow so let me know if there is more information you need from me!

user_9841389 · Answer

In the end this really isn't a plotly question. Somehow you need to pass new data to the plot.

You can generate this data using predict on your line model based on the provided date range:

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)

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

1 Answers