# Forecasting Disney Stock Prices as the Latest Earnings Beat Estimates

**DataGeeek**, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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.

**leave a comment**for the author, please follow the link and comment on their blog:

**DataGeeek**.

R-bloggers.com offers

**daily e-mail updates**about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.