Walt Disney (NYSE: DIS) recently announced significant labor cuts to ease shareholders’ pressure on reducing costs due to rising streaming investment. These cuts and some structural changes in the company have provided some boost to stock prices.

We will examine these price changes based on earnings per share (EPS) and their consensus forecasts. But these EPSs are announced two months after the interested quarter, so their effect reflects on the next quarter. Hence, we will use the lagged values of EPS in our model.

library(tidyverse)
library(tidyquant)
library(fable)
library(feasts)
library(tsibble)
library(scales)
library(sysfonts)
library(showtext)
library(ggtext)

#Getting the daily Disney stock prices from yahoo finance
df_dis <- 
  tq_get("DIS") %>% 
  #converting daily prices to a quarterly format
  tq_transmute(select = adjusted,
               mutate_fun = to.quarterly,
               col_rename = "price") %>% 
  mutate(date = 
           as.character(date) %>% 
           yearquarter()
         ) %>% 
  slice_head(n=-1)
  

#The quarterly DIS EPS prices 
df_eps <- 
  read_csv("https://raw.githubusercontent.com/mesdi/blog/main/eps.csv") %>% 
  #converting string to quarterly tsibble date
  mutate(date = 
           parse_date(date, "%b-%y") %>%
           yearquarter(),
         fc_eps = 
           #remove the hexadecimal character set
           str_replace_all(fc_eps, regex("\uFFFD"), "") %>% 
           as.numeric()
         )

 
#Merging the data frames   
df <- 
  df_dis %>% 
  left_join(df_eps) %>% 
  #lagged values of the EPS prices
  mutate(lag_eps = lag(eps)) %>% 
  na.omit()

We will model our data with dynamic regression ARIMA errors.

#Modeling 
fit <- 
  df %>% 
  as_tsibble() %>% 
  model(ARIMA(price ~ lag_eps))

#Testing  
fit %>%  
  gg_tsresiduals() 

The above ACF chart of the model shows that all autocorrelation values are inside the 95% limits (dashed lines), which means the ARIMA estimated error distribution (the innovation residuals) that follows a white noise series. I would like to check this with the Ljung–Box test to be sure.

augment(fit) |>
  features(.innov, ljung_box)

# A tibble: 1 x 3
#  .model                 lb_stat lb_pvalue
#  <chr>                    <dbl>     <dbl>
#1 ARIMA(price ~ lag_eps)   0.530     0.466

Because the p-value is higher than 0.05, we would reject the alternative hypothesis, which means there is a correlation in residuals. Hence, our model is valid. As the residuals are similar to those normally distributed, we don’t have to obtain a bootstrapped version of the prediction intervals.

Now, we will forecast the prices for the next two quarters. To do that, we will use the last released EPS value for the 2022 Q4 and the consensus forecast value for the 2023 Q1 as predictors. Remember the lagged effects of the EPS values.

#Forecasting
df_future <- 
  df %>% 
  as_tsibble() %>% 
  new_data(2) %>% 
  mutate(lag_eps = c(0.99, 1.19))

fc <- forecast(fit, new_data = df_future) 

#The upper values of the 80% and 95% prediction intervals
fc_PI <- 
  fc %>% 
  hilo() %>% 
  mutate(
    `80%` = `80%`$upper,
    `95%` = `95%`$upper
  ) %>% 
  as_tibble() %>% 
  pivot_longer(c(6,7), 
               names_to = "PI",
               values_to = "upper") %>% 
  mutate(PI = fct_reorder(PI, upper, .desc = TRUE))


#load fonts(google)
font_add_google("Roboto Mono", "Mono")
showtext_auto()

#Comparison DIS stock prices where EPS values are below or above forecasts
#with prediction values for the next two quarters
df %>% 
  ggplot(aes(date, price)) +
  geom_segment(aes(x = date, xend = date, y = 0, yend = price),
               color = "#9d9897") +
  geom_point(aes(color = ifelse(lag_eps >= fc_eps, "#ffff00", "#b80f0a")),
             size = 3) +
  geom_bar(data = fc_PI,
           stat = "identity",
           aes(x =date, y= upper, fill = PI)) +
  geom_text(data = fc_PI, 
            mapping = aes(date,
                          upper,
                          label = number(round(upper,2), prefix = "$"),
                          fill = PI),
            position = position_stack(vjust = 0.5),
            size = 7,
            family = "Mono") +
  scale_y_continuous(labels = label_dollar()) +
  scale_x_yearquarter(date_breaks = "1 year") +
  scale_color_identity() +
  scale_fill_manual(values = c("#5e9cd4", "#9ACD32")) +
  labs(
    x = "",
    y = "",
    title = "Comparison DIS stock prices where EPS values are <span style = 'color:#b80f0a'><b>below</b></span> or <span style = 'color:#ffff00'><b>above</b></span> forecasts",
    subtitle = "The upper values of the <span style = 'color:#9ACD32'><b>80%</b></span> and <span style = 'color:#5e9cd4'><b>95%</b></span> prediction intervals") +
  coord_flip() +
  theme_minimal() +
  theme(
    legend.position = "none",
    text = element_text(family = "Mono", size = 20),
    plot.title = element_markdown(hjust = 0.5),
    plot.subtitle = element_markdown(hjust = 0.5),
    panel.grid.minor.y = element_blank(),
    plot.background = element_rect(fill = "#f9cb9c", color = NA)
  )

The above graph shows the stock prices where EPS values are below or above the consensus EPS forecasts, and the upper values of 80% and 95% prediction intervals for 2023 Q1 and 2023 Q2.