Evaluating Value and Momentum-Based Timing Strategies Using CAPE and Excess Returns
ting
2025-05-10
library(readxl)
library(dplyr)
library(zoo)
library(scales)
library(purrr)
library(ggplot2)
library(tidyr)
library(PerformanceAnalytics)
library(xts)
library(texreg)
library(dplyr)This project investigates timing strategies based on valuation (CAPE ratios) and momentum indicators to enhance investment performance. Using historical S&P 500 data adjusted for inflation, I compute real total return prices, CAPE ratios, and excess returns. The goal is to assess whether dynamic weighting strategies based on valuation or momentum can outperform a simple buy-and-hold approach.
Data and Preprocessing
Data Source: S&P 500 index, CPI for inflation adjustment.
Adjustment: Real total return prices were calculated by adjusting for inflation and reinvesting dividends.
CAPE Ratio: Price divided by 10-year average inflation-adjusted earnings
Excess return: Excess returns were calculated as the difference between the real total return of the S&P 500 and the 10-year Treasury yield (GS10) over multiple horizons—1 month, 3 months, 1 year, 5 years, and 10 years
Chart 1 U.S. Equity 10-year returns sorted by starting CAPE Valuation, 1900–2024.
Chart 1 shows a clear negative relationship between starting CAPE valuations and subsequent 10-year excess returns, with the lowest CAPE quantiles delivering the highest average returns and the highest CAPE quantile yielding near-zero performance.
Chart 2 U.S. equity returns sorted by starting CAPE, 1965–2024
Chart 2 shows that across various excess return horizons—from 1 month to 10 years—lower (cheaper) starting CAPE valuations consistently correspond to higher returns, with the effect most pronounced at shorter horizons, reinforcing the use of CAPE yield as a weighting signal for next month’s equity allocation.
Table 1 Shiller EP as explanatory variable of future equity returns 1900–2015
Table 1 The OLS results indicate that CAPE yield (Shiller EP) has a positive and statistically significant impact on future excess returns, with the effect becoming stronger at shorter return horizons—reinforcing the negative relationship between CAPE levels and subsequent equity performance
- Momentum: Momentum was measured as the cumulative real total return over past periods (e.g., 6 or 12 months).
Table 2 Momentum as explanatory variable of future 1-month equity returns
Table 2 shows a consistently negative relationship between past momentum (3, 6, 12 and18 months) and future 1-month excess returns, although most coefficients are not statistically significant
Table 3 Momentum as explanatory variable of future 10-Years equity returns
Table 3 consistents with Table 2, shows a negative relationship between momentum and future 10-year excess returns, with the 12-month and 18-month momentum variables exhibiting statistically significant and strong negative coefficients, indicating long-term mean reversion in past return trends.
Therefore, although the regression results reveal a statistically significant negative relationship between momentum and future excess returns—suggesting that lower momentum should imply higher future returns—applying this inversely in practice (i.e., allocating higher weights to assets with lower momentum, shown as Chart 8) leads to underperformance in cumulative returns. This contradiction may arise because the negative relationship reflects long-term mean reversion, which does not effectively translate into short-term timing advantages. Additionally, allocating more weight to low-momentum assets may increase exposure to persistently weak trends or value traps, thereby reducing overall return potential despite the theoretical predictive signal observed in regressions.
Methodology
This study evaluates five distinct equity timing strategies based on valuation and momentum signals. Each approach adjusts equity exposure dynamically to improve risk-adjusted performance relative to a buy-and-hold benchmark.
1. Buy-and-Hold
A passive strategy maintaining a constant 100% allocation to equities throughout the entire sample period, serving as the baseline for comparison.
2. Time valuing strategy01
The timing strategy01 from the paper applies a weight of 100% + (trimmed Shiller EP−median Shiller EP)/(95th–5th percentile range), with a floor at 50% and a cap at 150%.
Formula 1 Weights for time valuing strategy01
Formula 1 The raw weight is clipped between 0.5 and 1.5. The Timing Weight is normalized so that its average position equals 1. This strategy increases equity exposure when CAPE valuations are low (i.e., high EP) and reduces exposure when CAPE valuations are high (i.e., low EP) , aiming to capture undervaluation opportunities while smoothing risk over time.
Chart 3 TOP: Cumulative excess return of buy-and-hold and timing strategie01, 1900–2024. Bottom: Cumulative excess return of buy-and-hold and timing strategie01, 1965–2024.
Charts 3 shows that while the value timing strategy (Strategy 01) outperformed buy-and-hold in cumulative excess return over the full 1900–2024 period, the buy-and-hold approach delivered relatively better performance in the recent 60 years (1965–2024).
Table 4 Performance of buy-and-hold and timing strategie01
Table 4 Although the value timing strategy (5.16%) achieved slightly higher annualized returns than the buy-and-hold strategy (4.94%) over the full 1900–2024 period, its higher volatility (16.77%) resulted in a lower Sharpe ratio (0.308), and across both the full and recent 1965–2024 periods, buy-and-hold delivered superior risk-adjusted performance with higher Sharpe ratio (0.324 and 0.275)—indicating that the timing strategy did not outperform passive investment.
3. Time valuing strategy02-Cheapest 10% CAPE Timing Strategy
This simple valuation strategy assigns higher equity weights (e.g., 150%) only during months when the CAPE ratio falls into the lowest 10% of historical values.
Formula 2 Weights for time valuing strategy02
Why choose the lowest 10% as the higher equity weights?
Chart 4 TOP: U.S. Equity 1-monthreturns sorted by 10 group CAPE Valuation. Bottom: U.S. Equity 1-monthreturns sorted by 20 group CAPE Valuation.
Chart 4 shows that the exceptionally high 1-month excess return is concentrated solely in the cheapest CAPE quantile—particularly the lowest 10%—while returns across all other valuation groups remain relatively flat with minimal variation. Therefore, that’s why I try only with higher weights with highest cape yield (cheapest cape).
Chart 5 TOP: Cumulative excess return of buy-and-hold and timing strategies, 1900–2024. Bottom: Cumulative excess return of buy-and-hold and timing strategies, 1965–2024.
Table 5 Performance of buy-and-hold and timing strategies
From Chart 5 and Table 5, a simple value timing strategy—overweighting equities only during the cheapest 10% CAPE periods—outperforms the more complex 5–95% formula-based approach by achieving a comparable Sharpe ratio with fewer trades, lower volatility. Therefore, choosing the cheapest 10% CAPE as the time value strategy
4. Timing Strategy + Momentum (12m)
A momentum-based approach that uses the past 12-month cumulative return to guide monthly equity exposure.
This strategy adjusts monthly equity exposure based on two signals:
Value Signal: Investors are more likely to increase exposure when the CAPE Yield is in the top 10% of historical observations.
Momentum Signal: Exposure is also increased if the12-month momentum is above the 60th percentile, indicating positive price trends.
Formula 3 Weights for Timing Strategy + Momentum (12m)
Chart 6 Top: Cumulative excess return of Timing Strategy + Momentum (12m), 1900–2024. Bottom: Cumulative excess return of Timing Strategy + Momentum (12m), 1965–2024.
Chart 6 The Value + Momentum (12m) timing strategy consistently outperforms other approaches across both long (1900–2024) and post-war (1965–2024) periods, delivering superior cumulative returns while maintaining comparable drawdown and monthly return volatility.
5. Timing Strategy + Momentum (6m)
This variation shortens the Momentum lookback window to 6 months, aiming to enhance responsiveness to recent market trends.
Mechanism: Similar quantile-based weighting method as the previous 12-month strategy.
Purpose: Evaluate whether a shorter momentum signal improves short-term forecasting effectiveness.
Chart 7 Top: Cumulative excess return of Timing Strategy + Momentum (6m), 1900–2024. Bottom: Cumulative excess return of Timing Strategy + Momentum (6m), 1965–2024.
Chart 7 The 6-month momentum strategy delivers the highest cumulative excess return in both the full (1900–2024) and recent (1965–2024) periods. Therefore, the optimal approach combines value timing—overweighting equities during the cheapest 10% CAPE periods—with momentum, assigning higher weights when recent 6-month returns are strong. This hybrid strategy captures long-term undervaluation while exploiting short-term price trends.
Table 6 Performance of buy-and-hold, timing strategy, and momentum
As shown in Table 6, the 6-month momentum strategy (VM_6Mom) consistently delivers the highest annualized return and Sharpe ratio across both the 1900–2024 and 1965–2024 periods. It outperforms all other strategies while maintaining relatively low volatility and the smallest maximum drawdown, demonstrating strong risk-adjusted performance and effective downside protection.
Chart 8 Trying the lower momentum (<20%) with higher weight (1.5), following the negative relationship, inversely in practice
R code with all strategies
excel_sheets("data/ie_data.xls")## [1] "Disclaimer" "Index Plot"
## [3] "PE (CAPE) Plot" "Excess CAPE Yield (ECY)"
## [5] "Data"sp500= read_excel("data/ie_data.xls", sheet = "Data",skip = 7)
sp500[,c(1:5,7)] %>% na.omit() -> data
data %>% head()## # A tibble: 6 × 6
## Date P D E CPI `Rate GS10`
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1871. 4.44 0.26 0.4 12.5 5.32
## 2 1871. 4.5 0.26 0.4 12.8 5.32
## 3 1871. 4.61 0.26 0.4 13.0 5.33
## 4 1871. 4.74 0.26 0.4 12.6 5.33
## 5 1871. 4.86 0.26 0.4 12.3 5.33
## 6 1871. 4.82 0.26 0.4 12.1 5.34data = data%>%
rename(GS10='Rate GS10')
last_cpi= tail(data,1)$CPI #using the 12/2024 CPI as the base CPI
data %>% mutate( Adjusted_Price= round(P*last_cpi/CPI,2),
Adjusted_Dividend = round(D*last_cpi/CPI, 2),
Adjusted_Earnings= round(E*last_cpi/CPI,2)
)-> data
data %>% head()## # A tibble: 6 × 9
## Date P D E CPI GS10 Adjusted_Price Adjusted_Dividend
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1871. 4.44 0.26 0.4 12.5 5.32 112. 6.58
## 2 1871. 4.5 0.26 0.4 12.8 5.32 111. 6.39
## 3 1871. 4.61 0.26 0.4 13.0 5.33 112. 6.3
## 4 1871. 4.74 0.26 0.4 12.6 5.33 119. 6.53
## 5 1871. 4.86 0.26 0.4 12.3 5.33 125. 6.69
## 6 1871. 4.82 0.26 0.4 12.1 5.34 126. 6.79
## # ℹ 1 more variable: Adjusted_Earnings <dbl>Real total return price
The real total return price is the inflation-adjusted stock price that assumes all dividends are reinvested, reflecting the full compounded return to investors.
## # A tibble: 6 × 11
## Date P D E CPI GS10 Adjusted_Price Adjusted_Dividend
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2024. 5538. 72.5 198. 315. 4.25 5557. 72.7
## 2 2024. 5478. 72.9 199. 315. 3.87 5492. 73.1
## 3 2024. 5621. 73.4 200. 315. 3.72 5627. 73.5
## 4 2024. 5792. 73.9 204. 316. 4.1 5791. 73.9
## 5 2024. 5930. 74.4 207. 315. 4.36 5932. 74.4
## 6 2024. 6011. 74.8 210. 316. 4.39 6011. 74.8
## # ℹ 3 more variables: Adjusted_Earnings <dbl>, Real_TR_Price <dbl>,
## # Real_TR_Scale_Earnings <dbl>CAPE ratio
data %>% mutate(
Adjusted_Earnings_Avg_10yr= lag(round(rollapply(Adjusted_Earnings, width=120, FUN=mean,
align="right", fill="NA"),2)),
CAPE = round(Adjusted_Price/Adjusted_Earnings_Avg_10yr,2)
) -> data
data %>% filter( floor(Date) %in% c(1881, 2024))## # A tibble: 24 × 13
## Date P D E CPI GS10 Adjusted_Price Adjusted_Dividend
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1881. 6.19 0.265 0.486 9.42 3.7 207. 8.88
## 2 1881. 6.17 0.27 0.482 9.51 3.69 205. 8.96
## 3 1881. 6.24 0.275 0.478 9.51 3.69 207. 9.12
## 4 1881. 6.22 0.28 0.473 9.61 3.68 204. 9.2
## 5 1881. 6.5 0.285 0.469 9.51 3.67 216. 9.45
## 6 1881. 6.58 0.29 0.465 9.51 3.67 218. 9.62
## 7 1881. 6.35 0.295 0.461 9.61 3.66 209. 9.69
## 8 1881. 6.2 0.3 0.457 9.8 3.65 200. 9.66
## 9 1881. 6.25 0.305 0.452 10.2 3.65 194. 9.46
## 10 1881. 6.15 0.31 0.448 10.3 3.64 189. 9.52
## # ℹ 14 more rows
## # ℹ 5 more variables: Adjusted_Earnings <dbl>, Real_TR_Price <dbl>,
## # Real_TR_Scale_Earnings <dbl>, Adjusted_Earnings_Avg_10yr <dbl>, CAPE <dbl>Excess CAPE yiled
The Excess CAPE Yield (ECY) is an estimate of expected equity return minus the risk-free rate (often the 10-year Treasury yield). Then, the excess yield adjusts for:
Inflation expectations (based on CPI)
Long-term government bond yields (GS10)
data %>% mutate(
# First 10-year lagged CPI
CPI_lag_10yr=lag(CPI,120),
# Annulized inflation over 10 years
Inflation_10yr=(CPI/CPI_lag_10yr)^(1/10)-1,
# ECY: Excess CAPE yield
Excess_CAPE_Yield = percent(1/CAPE- GS10/100+ Inflation_10yr, accuracy=0.01)
) -> data
data %>%
mutate(
# Detect dates where decimal part is exactly 0.1 (which should be October)
Date = ifelse((Date %% 1) == 0.1, floor(Date) + 10 / 100, Date) # make sure it's numeric again if ifelse converts it
)-> dataReal total bonds return
1. Monthly Total Bond Return → monthly
The Monthly Total Bond Return formula estimates the total return from holding a long-term (10-year) Treasury bond over one month.
It combines: the income return (coupon yield), and the price return (from yield changes)
This is important because bonds give both income + price movements
2. Real Total Bond Return → cumulative
This is the running, cumulative total return on bonds, adjusted for inflation.
It tells you how much your investment has grown from the start until now, in real (inflation-adjusted) terms.
data %>% mutate(
Monthly_TR_Bond_Return = ( GS10/ lead(GS10,1) +
GS10/1200 +
((1+lead(GS10,1)/1200)^-119) * (1-GS10/lead(GS10,1))
),
Real_TR_Bond_Return =NA_real_
) -> data
# Set the first value equal to the first Monthly Total Bond Return
data$Real_TR_Bond_Return[1] = 1
# Loop through rows to calculate recursively
for (i in 2:nrow(data)) {
data$Real_TR_Bond_Return[i] = data$Real_TR_Bond_Return[i-1] *
data$Monthly_TR_Bond_Return[i-1] *
(data$CPI[i-1]/ data$CPI[i])
}
data %>% filter( floor(Date) %in% c(1871, 2024)) %>% select(Date,
CPI,
Monthly_TR_Bond_Return,
Real_TR_Bond_Return)## # A tibble: 24 × 4
## Date CPI Monthly_TR_Bond_Return Real_TR_Bond_Return
## <dbl> <dbl> <dbl> <dbl>
## 1 1871. 12.5 1.00 1
## 2 1871. 12.8 1.00 0.974
## 3 1871. 13.0 1.00 0.964
## 4 1871. 12.6 1.00 1.00
## 5 1871. 12.3 1.00 1.03
## 6 1871. 12.1 1.00 1.05
## 7 1871. 12.1 1.00 1.06
## 8 1871. 11.9 1.00 1.08
## 9 1871. 12.2 1.00 1.06
## 10 1871. 12.4 1.00 1.05
## # ℹ 14 more rowsReal 10yr Excess Annualized returns
Real 10yr Excess Annualized returns tells you the average real annual outperformance of stocks over bonds over a 10-year period.
Firstly, get stock 10-yr annualized real return, giving the average
annual real stock return over 10 years. Secondly, bond 10-yr annualized
real return, giving the average annual real stock return over 10 years.
Lastly, real 10-Year Excess Annualized Return. 
data %>% mutate(
Stock_10yr_Ann_Return = (lead(Real_TR_Price,120)/
Real_TR_Price)^(1/10)-1,
Bond_10yr_Ann_Return = (lead(Real_TR_Bond_Return,120) /
Real_TR_Bond_Return)^(1/10)-1,
Real_10yr_Excess_Return = Stock_10yr_Ann_Return - Bond_10yr_Ann_Return
) -> data
data %>% filter( floor(Date) %in% c(1871, 2014)) %>% select( Date,
Stock_10yr_Ann_Return,
Bond_10yr_Ann_Return,
Real_10yr_Excess_Return
)## # A tibble: 24 × 4
## Date Stock_10yr_Ann_Return Bond_10yr_Ann_Return Real_10yr_Excess_Return
## <dbl> <dbl> <dbl> <dbl>
## 1 1871. 0.131 0.0925 0.0381
## 2 1871. 0.131 0.0946 0.0362
## 3 1871. 0.131 0.0962 0.0348
## 4 1871. 0.122 0.0910 0.0311
## 5 1871. 0.123 0.0895 0.0332
## 6 1871. 0.123 0.0877 0.0354
## 7 1871. 0.120 0.0866 0.0335
## 8 1871. 0.112 0.0827 0.0293
## 9 1871. 0.110 0.0810 0.0290
## 10 1871. 0.115 0.0817 0.0331
## # ℹ 14 more rowsquantile=5
results_10y <- map_dfr(quantile, function(q) {
cape_vals <- data %>%
filter(floor(Date) >= 1900) %>%
pull(CAPE)
cape_quantiles <- quantile(cape_vals, probs = seq(0, 1, length.out = q + 1), na.rm = TRUE)
# Create labels like "10.9–14.05", "<10.9", ">44.2"
lower_bounds <- round(head(cape_quantiles, -1), 2)
upper_bounds <- round(tail(cape_quantiles, -1), 2)
range_labels <- paste0(lower_bounds, "–", upper_bounds)
range_labels[1] <- paste0("<", upper_bounds[1])
range_labels[q] <- paste0(">", lower_bounds[q])
data %>%
filter(floor(Date) >= 1900) %>%
mutate(CAPE_group = ntile(CAPE, q)) %>%
group_by(CAPE_group) %>%
summarise(
avg_excess_return = percent(mean(Real_10yr_Excess_Return, na.rm = TRUE), accuracy = 0.01),
count = n(),
.groups = "drop"
) %>%
mutate(
quantile_range_upper = upper_bounds,
quantile_range_label = range_labels
)
})
results_10y## # A tibble: 5 × 5
## CAPE_group avg_excess_return count quantile_range_upper quantile_range_label
## <int> <chr> <int> <dbl> <chr>
## 1 1 6.36% 300 10.9 <10.9
## 2 2 7.30% 300 14.0 10.9–14.05
## 3 3 5.22% 300 18.5 14.05–18.46
## 4 4 3.30% 300 23.6 18.46–23.58
## 5 5 -0.05% 300 44.2 >23.58ggplot(results_10y, aes(
x = factor(quantile_range_label, levels = rev(quantile_range_label)),
y = as.numeric(gsub("%", "", avg_excess_return)) / 100
)) +
geom_col(fill = "steelblue", width = 0.5) +
labs(
title = "U.S. Equity 10-Year Returns Sorted by Starting CAPE Valuation, 1900–2024",
x = "CAPE Range",
y = "Average Annual Excess Return"
) +
scale_y_continuous(labels = scales::percent, expand = expansion(mult = c(0, 0.1))) +
theme_minimal()
Try different Years Excess Annualized returns
Foe time zone 1965-2024, recent 60 years Real 10yr Excess Annualized returns tells you the average real annual outperformance of stocks over bonds over a 10-year period.
Then I will try 5yr, 1yr, and 3 months
data %>% mutate(
Real_30yr_Excess_Return = (lead(Real_TR_Price,360)/
Real_TR_Price)^(1/30) - (lead(Real_TR_Bond_Return,360) /
Real_TR_Bond_Return)^(1/30),
Real_5yr_Excess_Return = (lead(Real_TR_Price,60)/
Real_TR_Price)^(1/5) - (lead(Real_TR_Bond_Return,60) /
Real_TR_Bond_Return)^(1/5),
Real_1yr_Excess_Return = lead(Real_TR_Price,12)/
Real_TR_Price - lead(Real_TR_Bond_Return,12) /
Real_TR_Bond_Return,
Real_3m_Excess_Return = (lead(Real_TR_Price,3)/
Real_TR_Price)^4 - (lead(Real_TR_Bond_Return,3) /
Real_TR_Bond_Return)^4,
Real_1m_Excess_Return = (lead(Real_TR_Price,1)/
Real_TR_Price)^12 - (lead(Real_TR_Bond_Return,1) /
Real_TR_Bond_Return)^12
) -> data
results_multip_y <- map_dfr(quantile, function(q) {
cape_vals <- data %>%
filter(floor(Date) >= 1960) %>%
pull(CAPE)
cape_quantiles <- quantile(cape_vals, probs = seq(0, 1, length.out = q + 1), na.rm = TRUE)
# Create labels like "10.9–14.05", "<10.9", ">44.2"
lower_bounds <- round(head(cape_quantiles, -1), 2)
upper_bounds <- round(tail(cape_quantiles, -1), 2)
range_labels <- paste0(lower_bounds, "–", upper_bounds)
range_labels[1] <- paste0("<", upper_bounds[1])
range_labels[q] <- paste0(">", lower_bounds[q])
data %>% filter(floor(Date) >=1900 ) %>%
mutate(CAPE_group = ntile(CAPE, q)) %>%
group_by(CAPE_group) %>%
summarise( avg_10y_excess_return =
percent(mean(Real_10yr_Excess_Return, na.rm = TRUE), accuracy=0.01),
avg_5y_excess_return =
percent(mean(Real_5yr_Excess_Return, na.rm = TRUE), accuracy=0.01),
avg_1y_excess_return =
percent(mean(Real_1yr_Excess_Return, na.rm = TRUE), accuracy=0.01),
avg_3m_excess_return =
percent(mean(Real_3m_Excess_Return, na.rm = TRUE), accuracy=0.01),
avg_1m_excess_return =
percent(mean(Real_1m_Excess_Return, na.rm = TRUE), accuracy=0.01),
.groups = "drop") %>%
mutate(
quantile_range_label = range_labels
)
})
results_multip_y## # A tibble: 5 × 7
## CAPE_group avg_10y_excess_return avg_5y_excess_return avg_1y_excess_return
## <int> <chr> <chr> <chr>
## 1 1 6.36% 9.27% 12.24%
## 2 2 7.30% 7.32% 10.20%
## 3 3 5.22% 3.27% 4.00%
## 4 4 3.30% 4.69% 3.59%
## 5 5 -0.05% 0.06% 3.59%
## # ℹ 3 more variables: avg_3m_excess_return <chr>, avg_1m_excess_return <chr>,
## # quantile_range_label <chr>results_long <- results_multip_y %>%
pivot_longer(
cols = starts_with("avg_"),
names_to = "Horizon",
values_to = "Excess_Return"
) %>%
mutate(
Horizon = recode(Horizon,
"avg_10y_excess_return" = "10-Year",
"avg_5y_excess_return" = "5-Year",
"avg_1y_excess_return" = "1-Year",
"avg_3m_excess_return" = "3-Month",
"avg_1m_excess_return" = "1-Month"
),
Horizon = factor(Horizon, levels = c("10-Year", "5-Year", "1-Year", "3-Month","1-Month")),
Excess_Return = as.numeric(gsub("%", "", Excess_Return)) / 100,
quantile_range_label = factor(quantile_range_label, levels = rev(unique(quantile_range_label))) # Reverse for richest to cheapest
)
ggplot(results_long, aes(x = quantile_range_label, y = Excess_Return, fill = Horizon)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
scale_fill_manual(
values = c(
"10-Year" = "#5B4E9B", # purple
"5-Year" = "#B07AA1", # optional (light purple/pink)
"1-Year" = "#4CAF50", # green
"3-Month" = "#FDBE46", # orange/yellow
"1-Month" = "pink" # orange/yellow
)
) +
scale_y_continuous(labels = scales::percent, expand = expansion(mult = c(0, 0.1))) +
labs(
title = "U.S. equity returns sorted by starting valuation based on recent 60-year window, 1965–2024.",
x = "CAPE Quantile Range (Richest → Cheapest)",
y = "Average Annualized Excess Return",
fill = "Return Horizon"
) +
theme_minimal() +
theme(
text = element_text(size = 12),
axis.text.x = element_text(angle = 0, vjust = 0.5)
)
We can see CAPE is optimal for next month return. Thus, using the CAPE yiled to be the weight for next month.
Then, what if I seperate to 10 or 15 groups to see next month’s return
quantile=10
results_10group <- map_dfr(quantile, function(q) {
cape_vals <- data %>%
filter(floor(Date) >= 1900) %>%
pull(CAPE)
cape_quantiles <- quantile(cape_vals, probs = seq(0, 1, length.out = q + 1), na.rm = TRUE)
# Create labels like "10.9–14.05", "<10.9", ">44.2"
lower_bounds <- round(head(cape_quantiles, -1), 2)
upper_bounds <- round(tail(cape_quantiles, -1), 2)
range_labels <- paste0(lower_bounds, "–", upper_bounds)
range_labels[1] <- paste0("<", upper_bounds[1])
range_labels[q] <- paste0(">", lower_bounds[q])
data %>%
filter(floor(Date) >= 1900) %>%
mutate(CAPE_group = ntile(CAPE, q)) %>%
group_by(CAPE_group) %>%
summarise(
avg_excess_return = percent(mean(Real_1m_Excess_Return, na.rm = TRUE), accuracy = 0.01),
count = n(),
.groups = "drop"
) %>%
mutate(
quantile_range_upper = upper_bounds,
quantile_range_label = range_labels
)
})
results_10group## # A tibble: 10 × 5
## CAPE_group avg_excess_return count quantile_range_upper quantile_range_label
## <int> <chr> <int> <dbl> <chr>
## 1 1 133.86% 150 9.01 <9.01
## 2 2 15.32% 150 10.9 9.01–10.9
## 3 3 16.30% 150 12.2 10.9–12.19
## 4 4 16.54% 150 14.0 12.19–14.05
## 5 5 15.64% 150 16.4 14.05–16.38
## 6 6 15.82% 150 18.5 16.38–18.46
## 7 7 6.57% 150 20.9 18.46–20.93
## 8 8 14.81% 150 23.6 20.93–23.58
## 9 9 13.67% 150 28.4 23.58–28.38
## 10 10 12.12% 150 44.2 >28.38ggplot(results_10group, aes(
x = factor(quantile_range_label, levels = rev(quantile_range_label)),
y = as.numeric(gsub("%", "", avg_excess_return)) / 100
)) +
geom_col(fill = "steelblue", width = 0.5) +
labs(
title = "U.S. Equity 1 MONTH Returns Sorted by Starting CAPE Valuation with 10 groups, 1900–2024",
x = "CAPE Range",
y = "Average Annual Excess Return"
) +
scale_y_continuous(labels = scales::percent, expand = expansion(mult = c(0, 0.1))) +
theme_minimal()
quantile=20
results_20group <- map_dfr(quantile, function(q) {
cape_vals <- data %>%
filter(floor(Date) >= 1900) %>%
pull(CAPE)
cape_quantiles <- quantile(cape_vals, probs = seq(0, 1, length.out = q + 1), na.rm = TRUE)
# Create labels like "10.9–14.05", "<10.9", ">44.2"
lower_bounds <- round(head(cape_quantiles, -1), 2)
upper_bounds <- round(tail(cape_quantiles, -1), 2)
range_labels <- paste0(lower_bounds, "–", upper_bounds)
range_labels[1] <- paste0("<", upper_bounds[1])
range_labels[q] <- paste0(">", lower_bounds[q])
data %>%
filter(floor(Date) >= 1900) %>%
mutate(CAPE_group = ntile(CAPE, q)) %>%
group_by(CAPE_group) %>%
summarise(
avg_excess_return = percent(mean(Real_1m_Excess_Return, na.rm = TRUE), accuracy = 0.01),
count = n(),
.groups = "drop"
) %>%
mutate(
quantile_range_upper = upper_bounds,
quantile_range_label = range_labels
)
})
results_20group## # A tibble: 20 × 5
## CAPE_group avg_excess_return count quantile_range_upper quantile_range_label
## <int> <chr> <int> <dbl> <chr>
## 1 1 218.50% 75 7.59 <7.59
## 2 2 49.22% 75 9.01 7.59–9.01
## 3 3 9.92% 75 9.97 9.01–9.97
## 4 4 20.73% 75 10.9 9.97–10.9
## 5 5 21.46% 75 11.5 10.9–11.53
## 6 6 11.15% 75 12.2 11.53–12.19
## 7 7 24.16% 75 13.2 12.19–13.16
## 8 8 8.92% 75 14.0 13.16–14.05
## 9 9 26.07% 75 15.2 14.05–15.15
## 10 10 5.20% 75 16.4 15.15–16.38
## 11 11 18.47% 75 17.6 16.38–17.56
## 12 12 13.17% 75 18.5 17.56–18.46
## 13 13 5.43% 75 19.8 18.46–19.77
## 14 14 7.71% 75 20.9 19.77–20.93
## 15 15 14.99% 75 22.0 20.93–22.04
## 16 16 14.63% 75 23.6 22.04–23.58
## 17 17 15.89% 75 26.0 23.58–25.95
## 18 18 11.45% 75 28.4 25.95–28.38
## 19 19 12.81% 75 32.6 28.38–32.55
## 20 20 11.42% 75 44.2 >32.55ggplot(results_20group, aes(
x = factor(quantile_range_label, levels = rev(quantile_range_label)),
y = as.numeric(gsub("%", "", avg_excess_return)) / 100
)) +
geom_col(fill = "steelblue", width = 0.5) +
labs(
title = "U.S. Equity 1 MONTH Returns Sorted by Starting CAPE Valuation with 20 gorups, 1965–2024",
x = "CAPE Range",
y = "Average Annual Excess Return"
) +
scale_y_continuous(labels = scales::percent, expand = expansion(mult = c(0, 0.1))) +
theme_minimal()
OLS model to predict the different Years Excess Annualized returns using the Shiller EP
using the time zone 1900-2015 as the training factor, the 2016-2024 as the predict
# Step 1: Add CAPE_Yield to the dataset
data <- data %>%
mutate(
CAPE_Yield = 1 / CAPE * 100
)
# Step 3: View the summary
OLS_10y= lm( (100*Real_10yr_Excess_Return)~CAPE_Yield,
data = data %>% filter(Date>=1900 & Date<=2015))
OLS_5y= lm( (100*Real_5yr_Excess_Return)~CAPE_Yield,
data = data %>% filter(Date>=1900 & Date<=2015))
OLS_1y= lm( (100*Real_1yr_Excess_Return)~CAPE_Yield,
data = data %>% filter(Date>=1900 & Date<=2015))
OLS_3m= lm( (100*Real_3m_Excess_Return)~CAPE_Yield,
data = data %>% filter(Date>=1900 & Date<=2015))
OLS_1m= lm( (100*Real_1m_Excess_Return)~CAPE_Yield,
data = data %>% filter(Date>=1900 & Date<=2015))
summary(OLS_10y)##
## Call:
## lm(formula = (100 * Real_10yr_Excess_Return) ~ CAPE_Yield, data = data %>%
## filter(Date >= 1900 & Date <= 2015))
##
## Residuals:
## Min 1Q Median 3Q Max
## -13.1679 -3.3191 -0.6209 2.9695 12.6559
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.4860 0.3252 1.494 0.135
## CAPE_Yield 0.5991 0.0411 14.578 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.923 on 1378 degrees of freedom
## Multiple R-squared: 0.1336, Adjusted R-squared: 0.133
## F-statistic: 212.5 on 1 and 1378 DF, p-value: < 2.2e-16summary(OLS_5y)##
## Call:
## lm(formula = (100 * Real_5yr_Excess_Return) ~ CAPE_Yield, data = data %>%
## filter(Date >= 1900 & Date <= 2015))
##
## Residuals:
## Min 1Q Median 3Q Max
## -24.3499 -5.2716 -0.2069 5.5314 19.7430
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.49670 0.50575 -4.937 8.92e-07 ***
## CAPE_Yield 1.01418 0.06391 15.869 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.656 on 1378 degrees of freedom
## Multiple R-squared: 0.1545, Adjusted R-squared: 0.1539
## F-statistic: 251.8 on 1 and 1378 DF, p-value: < 2.2e-16summary(OLS_1y)##
## Call:
## lm(formula = (100 * Real_1yr_Excess_Return) ~ CAPE_Yield, data = data %>%
## filter(Date >= 1900 & Date <= 2015))
##
## Residuals:
## Min 1Q Median 3Q Max
## -78.254 -13.350 1.104 12.242 119.561
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.4133 1.3362 -2.555 0.0107 *
## CAPE_Yield 1.3384 0.1688 7.927 4.6e-15 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 20.23 on 1378 degrees of freedom
## Multiple R-squared: 0.04361, Adjusted R-squared: 0.04292
## F-statistic: 62.84 on 1 and 1378 DF, p-value: 4.597e-15summary(OLS_3m)##
## Call:
## lm(formula = (100 * Real_3m_Excess_Return) ~ CAPE_Yield, data = data %>%
## filter(Date >= 1900 & Date <= 2015))
##
## Residuals:
## Min 1Q Median 3Q Max
## -158.96 -23.28 -0.97 19.62 899.91
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -4.6339 3.3142 -1.398 0.162
## CAPE_Yield 2.0881 0.4188 4.986 6.94e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 50.17 on 1378 degrees of freedom
## Multiple R-squared: 0.01772, Adjusted R-squared: 0.01701
## F-statistic: 24.86 on 1 and 1378 DF, p-value: 6.942e-07summary(OLS_1m)##
## Call:
## lm(formula = (100 * Real_1m_Excess_Return) ~ CAPE_Yield, data = data %>%
## filter(Date >= 1900 & Date <= 2015))
##
## Residuals:
## Min 1Q Median 3Q Max
## -291.0 -51.3 -12.9 25.2 15480.2
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -58.972 28.162 -2.094 0.036443 *
## CAPE_Yield 11.860 3.559 3.333 0.000883 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 426.3 on 1378 degrees of freedom
## Multiple R-squared: 0.007995, Adjusted R-squared: 0.007275
## F-statistic: 11.11 on 1 and 1378 DF, p-value: 0.0008832screenreg(list(OLS_10y, OLS_5y, OLS_1y, OLS_3m, OLS_1m),
custom.model.names=c("Next 10y excess return", "Next 5y excess return",
"Next 1y excess return", "Next 3M excess return",
"Next 1M excess return"),
caption = "OLS Regressions: Predictive Power of CAPE Yield on Future Excess Returns")##
## ===============================================================================================================================
## Next 10y excess return Next 5y excess return Next 1y excess return Next 3M excess return Next 1M excess return
## -------------------------------------------------------------------------------------------------------------------------------
## (Intercept) 0.49 -2.50 *** -3.41 * -4.63 -58.97 *
## (0.33) (0.51) (1.34) (3.31) (28.16)
## CAPE_Yield 0.60 *** 1.01 *** 1.34 *** 2.09 *** 11.86 ***
## (0.04) (0.06) (0.17) (0.42) (3.56)
## -------------------------------------------------------------------------------------------------------------------------------
## R^2 0.13 0.15 0.04 0.02 0.01
## Adj. R^2 0.13 0.15 0.04 0.02 0.01
## Num. obs. 1380 1380 1380 1380 1380
## ===============================================================================================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05Buy and hold vs. Time strategy
Value Timing Strategy01:
the timing strategy applies a weight of 100% + (trimmed Shiller EP−median Shiller EP)/(95th–5th percentile range), with a floor at 50% and a cap at 150%
Adjusts equity exposure based on Shiller EP
The timing weight is determined by:
Sys.setlocale("LC_TIME", "C") # or use "English_United States" on Windows## [1] "C"ep_median <- median(data$CAPE_Yield, na.rm = TRUE)
ep_p5 <- quantile(data$CAPE_Yield, 0.05, na.rm = TRUE)
ep_p95 <- quantile(data$CAPE_Yield, 0.95, na.rm = TRUE)
data <- data %>%
mutate(
raw_weight = pmax(pmin(100 + ( CAPE_Yield- ep_median) / (ep_p95 - ep_p5) * 100, 150), 50) / 100, # scale to [0.5, 1.5]
timing_weight = raw_weight/mean(raw_weight, na.rm = T) # normalized to average weight=1
)
data <- data %>%
arrange(Date) %>%
mutate(
Return_Buy_Hold = Real_TR_Price / lag(Real_TR_Price)-Real_TR_Bond_Return/lag(Real_TR_Bond_Return),
Value_Timg_5_95_FC = lag(timing_weight) * Return_Buy_Hold
)
data %>% filter( floor(Date) %in% c(1900,1950, 2000)) %>% select( Date, Real_TR_Price, raw_weight ,timing_weight, Return_Buy_Hold, Value_Timg_5_95_FC) ## # A tibble: 36 × 6
## Date Real_TR_Price raw_weight timing_weight Return_Buy_Hold
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1900. 1096. 0.927 0.883 0.0140
## 2 1900. 1106. 0.926 0.882 0.0179
## 3 1900. 1118. 0.924 0.881 0.00817
## 4 1900. 1136. 0.919 0.876 0.0130
## 5 1900. 1112. 0.935 0.892 -0.0482
## 6 1900. 1097. 0.948 0.904 -0.0296
## 7 1900. 1087. 0.958 0.914 0.000752
## 8 1900. 1120. 0.946 0.902 0.0147
## 9 1900. 1085. 0.970 0.925 -0.0224
## 10 1900. 1142. 0.945 0.901 0.0378
## # ℹ 26 more rows
## # ℹ 1 more variable: Value_Timg_5_95_FC <dbl># Filter 1900 onward
data_1900 <- data %>%
filter(floor(Date) >= 1900)
ret_xts <- xts(
data_1900[, c("Return_Buy_Hold", "Value_Timg_5_95_FC")],
order.by = as.Date(as.yearmon(formatC(data_1900$Date, format = "f", digits = 2), format = "%Y.%m"))
)
charts.PerformanceSummary(ret_xts,
main = "Cumulative excess return of Buy-and-Hold vs Value Timing Strategy from 1900-2024")
# Filter 1965 onward
data_1965 <- data %>%
filter(floor(Date) >= 1965)
ret_xts <- xts(
data_1965[, c("Return_Buy_Hold", "Value_Timg_5_95_FC")],
order.by = as.Date(as.yearmon(formatC(data_1965$Date, format = "f", digits = 2), format = "%Y.%m"))
)
charts.PerformanceSummary(ret_xts,
main = "Cumulative excess return of Buy-and-Hold vs Value Timing Strategy from 1965-2024")
Value Timing Strategy02:
Exploit high return periods when the market is extremely cheap (based on CAPE) by overweighting during those times, while keeping total exposure neutral on average (i.e., average position = 100%). Normalize weights so the average over time = 1.0
# Assuming you already have a data frame with CAPE_Yield
# Step 1: Compute the 90th percentile of CAPE_Yield (i.e., cheapest 10% of CAPE)
ep_p90 <- quantile(data$CAPE_Yield, 0.90, na.rm = TRUE)
# Step 2: Assign raw weights — overweight only when market is historically cheap
data <- data %>%
mutate(
raw_weight02 = ifelse(CAPE_Yield > ep_p90, 1.5, 1.0)
)
# Step 3: Normalize so the average position = 1.0
data <- data %>%
mutate(
timing_weight02 = raw_weight02 / mean(raw_weight02, na.rm = TRUE)
)
data <- data %>%
arrange(Date) %>%
mutate(
Value_Timg_90_HighWeight = lag(timing_weight02) * Return_Buy_Hold
)
# 1900 onward
data_1900 <- data %>%
filter(floor(Date) >= 1900)
ret_xts <- xts(
data_1900[, c("Value_Timg_90_HighWeight", "Value_Timg_5_95_FC","Return_Buy_Hold")],
order.by = as.Date(as.yearmon(formatC(data_1900$Date, format = "f", digits = 2), format = "%Y.%m"))
)
charts.PerformanceSummary(ret_xts,
main = "Cumulative excess return of Buy-and-Hold vs Value Timing Strategy from 1900-2024")
# Filter 1965 onward
data_1965 <- data %>%
filter(floor(Date) >= 1965)
ret_xts <- xts(
data_1965[, c("Value_Timg_90_HighWeight", "Value_Timg_5_95_FC","Return_Buy_Hold")],
order.by = as.Date(as.yearmon(formatC(data_1965$Date, format = "f", digits = 2), format = "%Y.%m"))
)
charts.PerformanceSummary(ret_xts,
main = "Cumulative excess return of Buy-and-Hold vs Value Timing Strategy from 1965-2024")
Therefore, a simple value timing strategy—overweighting equities only during the cheapest 10% of CAPE periods (i.e., when CAPE Yield is highest) and keeping neutral weights otherwise—outperforms a more complex 5–95% weighting scheme. This approach not only delivers a higher Sharpe ratio (0.4238 vs. 0.3971) but also significantly reduces trading frequency and potential transaction costs, as weights change in only about 10% of the periods. By focusing on extreme undervaluation and normalizing the average position to 100%. ### Try not use the CAPE future info, but with ex post adjustments and Zero Net Valuation Change
Combine the Momentue Strategy
data <- data %>%
arrange(Date) %>%
mutate(
Momentum_12m = Real_TR_Price / lag(Real_TR_Price, 12) - 1
)
data <- data %>%
mutate(
value_score = ifelse(CAPE_Yield > quantile(CAPE_Yield, 0.9, na.rm = TRUE), 1, 0),
momentum_score = ifelse(Momentum_12m > quantile(Momentum_12m, 0.6, na.rm = TRUE), 1, 0),
raw_weight = 1 + 0.5 * (value_score + momentum_score) # ranges from 1.0 to 2.0
) %>%
mutate(
timing_weight_vm = raw_weight / mean(raw_weight, na.rm = TRUE) # normalize to avg 1.0
)
data <- data %>%
arrange(Date) %>%
mutate(
VM_12Mom = lag(timing_weight_vm) * Return_Buy_Hold
)
data_1900 <- data %>%
filter(floor(Date) >= 1900)
ret_xts <- xts(
data_1900[, c("Value_Timg_90_HighWeight", "Value_Timg_5_95_FC",
"Return_Buy_Hold","VM_12Mom")],
order.by = as.Date(as.yearmon(formatC(data_1900$Date, format = "f", digits = 2), format = "%Y.%m"))
)
charts.PerformanceSummary(ret_xts,
main = "Cumulative excess return of Buy-and-Hold vs Value Timing Strategy from 1900-2024")
# Filter 1965 onward
data_1965 <- data %>%
filter(floor(Date) >= 1965)
ret_xts <- xts(
data_1965[, c("Value_Timg_90_HighWeight", "Value_Timg_5_95_FC","Return_Buy_Hold","VM_12Mom")],
order.by = as.Date(as.yearmon(formatC(data_1965$Date, format = "f", digits = 2), format = "%Y.%m"))
)
charts.PerformanceSummary(ret_xts,
main = "Cumulative excess return of Buy-and-Hold vs Value Timing Strategy from 1965-2024")
data <- data %>%
arrange(Date) %>%
mutate(
Momentum_3m = Real_TR_Price / lag(Real_TR_Price, 3) - 1,
Momentum_6m = Real_TR_Price / lag(Real_TR_Price, 6) - 1,
Momentum_18m = Real_TR_Price / lag(Real_TR_Price, 18) - 1
)
### Try another 6m momument
data <- data %>%
mutate(
momentum_score02 = ifelse(Momentum_6m > quantile(Momentum_6m, 0.6, na.rm = TRUE), 1, 0)
) %>%
mutate(
timing_weight_VM_6Mom = (1 + 0.5 * (value_score + momentum_score02) )/ mean((1 +
0.5 * (value_score + momentum_score02)) , na.rm = TRUE) # normalize to avg 1.0
)
data <- data %>%
arrange(Date) %>%
mutate(
VM_6Mom = lag(timing_weight_VM_6Mom) * Return_Buy_Hold
)
data_1900 <- data %>%
filter(floor(Date) >= 1900)
ret_xts_1900 <- xts(
data_1900[, c("Value_Timg_90_HighWeight", "Value_Timg_5_95_FC",
"Return_Buy_Hold","VM_12Mom","VM_6Mom")],
order.by = as.Date(as.yearmon(formatC(data_1900$Date, format = "f", digits = 2), format = "%Y.%m"))
)
charts.PerformanceSummary(ret_xts_1900,
main = "Cumulative excess return of Buy-and-Hold vs Value Timing Strategy from 1900-2024")
annualized_excess_return=table.AnnualizedReturns(ret_xts_1900) %>% as.data.frame()
df_max_drawdown <- data.frame(
Value_Timg_90_HighWeight =
table.Drawdowns(ret_xts_1900$Value_Timg_90_HighWeight)$Depth %>%min(),
Value_Timg_5_95_FC=
table.Drawdowns(ret_xts_1900$Value_Timg_5_95_FC)$Depth %>%min(),
Return_Buy_Hold =
table.Drawdowns(ret_xts_1900$Return_Buy_Hold)$Depth %>%min(),
VM_12Mom = table.Drawdowns(ret_xts_1900$VM_12Mom)$Depth %>%min(),
VM_6Mom = table.Drawdowns(ret_xts_1900$VM_6Mom)$Depth %>%min()
)
# Set the row name
rownames(df_max_drawdown) <- c("maxdrawdown")
position <- data.frame(
Value_Timg_90_HighWeight = mean(data$timing_weight, na.rm = TRUE),
Value_Timg_5_95_FC = mean(data$timing_weight02, na.rm = TRUE),
Return_Buy_Hold = 1,
VM_12Mom = mean(data$timing_weight_vm, na.rm = TRUE),
VM_6Mom = mean(data$timing_weight_VM_6Mom, na.rm = TRUE)
)
rownames(position)="Average Position"
bind_rows(annualized_excess_return,
df_max_drawdown,
position)-> performance_1900
performance_1900## Value_Timg_90_HighWeight Value_Timg_5_95_FC
## Annualized Return 0.0518 0.0516
## Annualized Std Dev 0.1652 0.1677
## Annualized Sharpe (Rf=0%) 0.3136 0.3076
## maxdrawdown -0.8428 -0.8569
## Average Position 1.0000 1.0000
## Return_Buy_Hold VM_12Mom VM_6Mom
## Annualized Return 0.0494 0.0636 0.0646
## Annualized Std Dev 0.1528 0.1615 0.1585
## Annualized Sharpe (Rf=0%) 0.3235 0.3938 0.4076
## maxdrawdown -0.8355 -0.8212 -0.8294
## Average Position 1.0000 1.0000 1.0000# Filter 1965 onward
data_1965 <- data %>%
filter(floor(Date) >= 1965)
ret_xts_1965 <- xts(
data_1965[, c("Value_Timg_90_HighWeight", "Value_Timg_5_95_FC","Return_Buy_Hold","VM_12Mom","VM_6Mom")],
order.by = as.Date(as.yearmon(formatC(data_1965$Date, format = "f", digits = 2), format = "%Y.%m"))
)
charts.PerformanceSummary(ret_xts_1965,
main = "Cumulative excess return of Buy-and-Hold vs Value Timing Strategy from 1965-2024")
table.AnnualizedReturns(ret_xts_1965)## Value_Timg_90_HighWeight Value_Timg_5_95_FC
## Annualized Return 0.0391 0.0327
## Annualized Std Dev 0.1389 0.1289
## Annualized Sharpe (Rf=0%) 0.2811 0.2538
## Return_Buy_Hold VM_12Mom VM_6Mom
## Annualized Return 0.0376 0.0437 0.0506
## Annualized Std Dev 0.1365 0.1376 0.1336
## Annualized Sharpe (Rf=0%) 0.2752 0.3179 0.3787annualized_excess_return=table.AnnualizedReturns(ret_xts_1965) %>% as.data.frame()
# Assuming all max drawdowns are already computed
df_max_drawdown <- data.frame(
Value_Timg_90_HighWeight =
table.Drawdowns(ret_xts_1965$Value_Timg_90_HighWeight)$Depth %>%min(),
Value_Timg_5_95_FC=
table.Drawdowns(ret_xts_1965$Value_Timg_5_95_FC)$Depth %>%min(),
Return_Buy_Hold =
table.Drawdowns(ret_xts_1965$Return_Buy_Hold)$Depth %>%min(),
VM_12Mom = table.Drawdowns(ret_xts_1965$VM_12Mom)$Depth %>%min(),
VM_6Mom = table.Drawdowns(ret_xts_1965$VM_6Mom)$Depth %>%min()
)
# Set the row name
rownames(df_max_drawdown) <- c("maxdrawdown")
bind_rows(annualized_excess_return,
df_max_drawdown,
position)-> performance_1965
performance_1965## Value_Timg_90_HighWeight Value_Timg_5_95_FC
## Annualized Return 0.0391 0.0327
## Annualized Std Dev 0.1389 0.1289
## Annualized Sharpe (Rf=0%) 0.2811 0.2538
## maxdrawdown -0.6942 -0.6107
## Average Position 1.0000 1.0000
## Return_Buy_Hold VM_12Mom VM_6Mom
## Annualized Return 0.0376 0.0437 0.0506
## Annualized Std Dev 0.1365 0.1376 0.1336
## Annualized Sharpe (Rf=0%) 0.2752 0.3179 0.3787
## maxdrawdown -0.7139 -0.6213 -0.6015
## Average Position 1.0000 1.0000 1.0000Then, to find out what’s the best nth momentum with optimal quantile group, previously, we try 12 months momentum with >0.6 quantile as the weight 1, else 0 Therefore, let’s try 6, 18, 24 months momentum with quantile group to see their next momth assess return.
OLS_6m= lm( (100*Real_1m_Excess_Return)~Momentum_6m,
data = data %>% filter(Date>=1900))
OLS_12m= lm( (100*Real_1m_Excess_Return)~Momentum_12m,
data = data %>% filter(Date>=1900))
OLS_18m= lm( (100*Real_1m_Excess_Return)~Momentum_18m,
data = data %>% filter(Date>=1900))
OLS_3m= lm( (100*Real_1m_Excess_Return)~Momentum_3m,
data = data %>% filter(Date>=1900))
cat("OLS Regressions: Predictive Power of Momentum on 1-Month Excess Return \n\n")## OLS Regressions: Predictive Power of Momentum on 1-Month Excess Returnscreenreg(list(OLS_18m, OLS_12m, OLS_6m, OLS_3m),
custom.model.names=c("18M", "12M",
"6M", "3M"),
caption = "OLS Regressions: Predictive Power of different Momentum on Future 1 Month Excess Returns")##
## =============================================================
## 18M 12M 6M 3M
## -------------------------------------------------------------
## (Intercept) 40.01 *** 37.01 ** 33.37 ** 29.03 **
## (11.89) (11.50) (11.13) (10.89)
## Momentum_18m -107.20 *
## (41.69)
## Momentum_12m -128.50 *
## (52.55)
## Momentum_6m -178.84 *
## (83.38)
## Momentum_3m -146.91
## (121.80)
## -------------------------------------------------------------
## R^2 0.00 0.00 0.00 0.00
## Adj. R^2 0.00 0.00 0.00 0.00
## Num. obs. 1499 1499 1499 1499
## =============================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05OLS_6m_10yr= lm( (100*Real_10yr_Excess_Return)~Momentum_6m,
data = data %>% filter(Date>=1900))
OLS_12m_10yr= lm( (100*Real_10yr_Excess_Return)~Momentum_12m,
data = data %>% filter(Date>=1900))
OLS_18m_10yr= lm( (100*Real_10yr_Excess_Return)~Momentum_18m,
data = data %>% filter(Date>=1900))
OLS_3m_10yr= lm( (100*Real_10yr_Excess_Return)~Momentum_3m,
data = data %>% filter(Date>=1900))
cat("OLS Regressions: Predictive Power of Momentum on 10-Year Excess Return \n\n")## OLS Regressions: Predictive Power of Momentum on 10-Year Excess Returnscreenreg(list(OLS_18m_10yr, OLS_12m_10yr, OLS_6m_10yr, OLS_3m_10yr),
custom.model.names=c("18M", "12M",
"6M", "3M"),
caption = "OLS Regressions: Predictive Power of different Momentum on Future 10 year Excess Returns")##
## ================================================================
## 18M 12M 6M 3M
## ----------------------------------------------------------------
## (Intercept) 5.23 *** 5.07 *** 4.91 *** 4.86 ***
## (0.16) (0.15) (0.15) (0.15)
## Momentum_18m -3.22 ***
## (0.54)
## Momentum_12m -3.04 ***
## (0.68)
## Momentum_6m -2.47 *
## (1.09)
## Momentum_3m -2.41
## (1.60)
## ----------------------------------------------------------------
## R^2 0.03 0.01 0.00 0.00
## Adj. R^2 0.02 0.01 0.00 0.00
## Num. obs. 1380 1380 1380 1380
## ================================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05quantile=10
results_30yr <- map_dfr(quantile, function(q) {
mom12_vals <- data %>%
filter(floor(Date) >= 1900) %>%
pull(Momentum_12m)
mom12_quantiles <- quantile(mom12_vals, probs = seq(0, 1, length.out = q + 1), na.rm = TRUE)
# Create labels like "10.9–14.05", "<10.9", ">44.2"
lower_bounds <- round(head(mom12_quantiles, -1), 2)
upper_bounds <- round(tail(mom12_quantiles, -1), 2)
range_labels <- paste0(lower_bounds, "–", upper_bounds)
range_labels[1] <- paste0("<", upper_bounds[1])
range_labels[q] <- paste0(">", lower_bounds[q])
data %>%
filter(floor(Date) >= 1900) %>%
mutate(mom12_group = ntile(Momentum_12m, q)) %>%
group_by(mom12_group) %>%
summarise(
avg_excess_return = percent(mean(Real_30yr_Excess_Return, na.rm = TRUE), accuracy = 0.01),
count = n(),
.groups = "drop"
) %>%
mutate(
quantile_range_upper = upper_bounds,
quantile_range_label = range_labels
)
})
results_30yr## # A tibble: 10 × 5
## mom12_group avg_excess_return count quantile_range_upper quantile_range_label
## <int> <chr> <int> <dbl> <chr>
## 1 1 6.49% 150 -0.17 <-0.17
## 2 2 4.98% 150 -0.08 -0.17–-0.08
## 3 3 4.30% 150 -0.01 -0.08–-0.01
## 4 4 4.66% 150 0.04 -0.01–0.04
## 5 5 4.02% 150 0.09 0.04–0.09
## 6 6 4.21% 150 0.13 0.09–0.13
## 7 7 4.46% 150 0.18 0.13–0.18
## 8 8 4.72% 150 0.24 0.18–0.24
## 9 9 4.95% 150 0.33 0.24–0.33
## 10 10 5.63% 150 1.51 >0.33results_10yr <- map_dfr(quantile, function(q) {
mom12_vals <- data %>%
filter(floor(Date) >= 1900) %>%
pull(Momentum_12m)
mom12_quantiles <- quantile(mom12_vals, probs = seq(0, 1, length.out = q + 1), na.rm = TRUE)
# Create labels like "10.9–14.05", "<10.9", ">44.2"
lower_bounds <- round(head(mom12_quantiles, -1), 2)
upper_bounds <- round(tail(mom12_quantiles, -1), 2)
range_labels <- paste0(lower_bounds, "–", upper_bounds)
range_labels[1] <- paste0("<", upper_bounds[1])
range_labels[q] <- paste0(">", lower_bounds[q])
data %>%
filter(floor(Date) >= 1900) %>%
mutate(mom12_group = ntile(Momentum_12m, q)) %>%
group_by(mom12_group) %>%
summarise(
avg_excess_return = percent(mean(Real_10yr_Excess_Return, na.rm = TRUE), accuracy = 0.01),
count = n(),
.groups = "drop"
) %>%
mutate(
quantile_range_upper = upper_bounds,
quantile_range_label = range_labels
)
})
results_10yr## # A tibble: 10 × 5
## mom12_group avg_excess_return count quantile_range_upper quantile_range_label
## <int> <chr> <int> <dbl> <chr>
## 1 1 6.07% 150 -0.17 <-0.17
## 2 2 5.07% 150 -0.08 -0.17–-0.08
## 3 3 4.96% 150 -0.01 -0.08–-0.01
## 4 4 5.80% 150 0.04 -0.01–0.04
## 5 5 3.85% 150 0.09 0.04–0.09
## 6 6 4.61% 150 0.13 0.09–0.13
## 7 7 5.66% 150 0.18 0.13–0.18
## 8 8 4.66% 150 0.24 0.18–0.24
## 9 9 4.44% 150 0.33 0.24–0.33
## 10 10 3.12% 150 1.51 >0.33results_1m <- map_dfr(quantile, function(q) {
mom12_vals <- data %>%
filter(floor(Date) >= 1900) %>%
pull(Momentum_12m)
mom12_quantiles <- quantile(mom12_vals, probs = seq(0, 1, length.out = q + 1), na.rm = TRUE)
# Create labels like "10.9–14.05", "<10.9", ">44.2"
lower_bounds <- round(head(mom12_quantiles, -1), 2)
upper_bounds <- round(tail(mom12_quantiles, -1), 2)
range_labels <- paste0(lower_bounds, "–", upper_bounds)
range_labels[1] <- paste0("<", upper_bounds[1])
range_labels[q] <- paste0(">", lower_bounds[q])
data %>%
filter(floor(Date) >= 1900) %>%
mutate(mom12_group = ntile(Momentum_12m, q)) %>%
group_by(mom12_group) %>%
summarise(
avg_excess_return = percent(mean(Real_1m_Excess_Return, na.rm = TRUE), accuracy = 0.01),
count = n(),
.groups = "drop"
) %>%
mutate(
quantile_range_upper = upper_bounds,
quantile_range_label = range_labels
)
})
results_1m## # A tibble: 10 × 5
## mom12_group avg_excess_return count quantile_range_upper quantile_range_label
## <int> <chr> <int> <dbl> <chr>
## 1 1 113.87% 150 -0.17 <-0.17
## 2 2 6.45% 150 -0.08 -0.17–-0.08
## 3 3 9.55% 150 -0.01 -0.08–-0.01
## 4 4 10.53% 150 0.04 -0.01–0.04
## 5 5 13.90% 150 0.09 0.04–0.09
## 6 6 10.79% 150 0.13 0.09–0.13
## 7 7 10.53% 150 0.18 0.13–0.18
## 8 8 17.52% 150 0.24 0.18–0.24
## 9 9 38.44% 150 0.33 0.24–0.33
## 10 10 29.25% 150 1.51 >0.33ggplot(results_30yr , aes(
x = factor(quantile_range_label, levels = quantile_range_label),
y = as.numeric(gsub("%", "", avg_excess_return)) / 100
)) +
geom_col(fill = "steelblue", width = 0.5) +
labs(
title = "U.S. Equity 30-year return Sorted by Starting momumtum 12m Valuation, 1965–2024",
x = "12m momumtum",
y = "Average Annual Excess Return"
) +
scale_y_continuous(labels = scales::percent, expand = expansion(mult = c(0, 0.1))) +
theme_minimal()
ggplot(results_10yr , aes(
x = factor(quantile_range_label, levels = quantile_range_label),
y = as.numeric(gsub("%", "", avg_excess_return)) / 100
)) +
geom_col(fill = "steelblue", width = 0.5) +
labs(
title = "U.S. Equity 10year return Sorted by Starting momumtum 12m Valuation, 1965–2024",
x = "12m momumtum",
y = "Average Annual Excess Return"
) +
scale_y_continuous(labels = scales::percent, expand = expansion(mult = c(0, 0.1))) +
theme_minimal()
ggplot(results_1m , aes(
x = factor(quantile_range_label, levels = quantile_range_label),
y = as.numeric(gsub("%", "", avg_excess_return)) / 100
)) +
geom_col(fill = "steelblue", width = 0.5) +
labs(
title = "U.S. Equity 1-month Returns Sorted by Starting momumtum 12m Valuation, 1965–2024",
x = "12m momumtum",
y = "Average Annual Excess Return"
) +
scale_y_continuous(labels = scales::percent, expand = expansion(mult = c(0, 0.1))) +
theme_minimal()
However, I find the momumtum trendency is negatively related with the next 1 month average annual excess return. so the stratege-larger 12 month momentum with more weights is not reasonable, but the cumlative return from previous plot with this momentum strategy is excceeding the time-value alone significantly.
data <- data %>%
mutate(
momentum_score03 = ifelse(Momentum_6m < quantile(Momentum_6m, 0.2, na.rm = TRUE), 1, 0)
) %>%
mutate(
timing_weight_VM_converse = (1 + 0.5 * (value_score + momentum_score03) )/ mean((1 +
0.5 * (value_score + momentum_score03)) , na.rm = TRUE) # normalize to avg 1.0
)
data <- data %>%
arrange(Date) %>%
mutate(
VM_6Mom_converse = lag(timing_weight_VM_converse) * Return_Buy_Hold
)
data_1900 <- data %>%
filter(floor(Date) >= 1900)
ret_xts_1900 <- xts(
data_1900[, c("Value_Timg_90_HighWeight", "Value_Timg_5_95_FC",
"Return_Buy_Hold","VM_12Mom","VM_6Mom","VM_6Mom_converse")],
order.by = as.Date(as.yearmon(formatC(data_1900$Date, format = "f", digits = 2), format = "%Y.%m"))
)
charts.PerformanceSummary(ret_xts_1900,
main = "Cumulative excess return of Buy-and-Hold vs Value Timing Strategy from 1900-2024")
library(dplyr)
Finnal_data <- data %>%
transmute(
Date, P, D, E, CPI, GS10,
Adjusted_Price, Adjusted_Dividend, Adjusted_Earnings, Real_TR_Price,
CAPE, Monthly_TR_Bond_Return, Real_TR_Bond_Return, CAPE_Yield,
Real_1m_Excess_Return, Real_3m_Excess_Return, Real_1yr_Excess_Return, Real_10yr_Excess_Return,
Return_Buy_Hold,
timing_weight02 = lag(timing_weight02),
Value_Timg_90_HighWeight,
timing_weight = lag(timing_weight),
Value_Timg_5_95_FC,
timing_weight_vm = lag(timing_weight_vm),
VM_12Mom,
timing_weight_VM_6Mom = lag(timing_weight_VM_6Mom),
VM_6Mom
)
tail(Finnal_data)## # A tibble: 6 × 27
## Date P D E CPI GS10 Adjusted_Price Adjusted_Dividend
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2024. 5538. 72.5 198. 315. 4.25 5557. 72.7
## 2 2024. 5478. 72.9 199. 315. 3.87 5492. 73.1
## 3 2024. 5621. 73.4 200. 315. 3.72 5627. 73.5
## 4 2024. 5792. 73.9 204. 316. 4.1 5791. 73.9
## 5 2024. 5930. 74.4 207. 315. 4.36 5932. 74.4
## 6 2024. 6011. 74.8 210. 316. 4.39 6011. 74.8
## # ℹ 19 more variables: Adjusted_Earnings <dbl>, Real_TR_Price <dbl>,
## # CAPE <dbl>, Monthly_TR_Bond_Return <dbl>, Real_TR_Bond_Return <dbl>,
## # CAPE_Yield <dbl>, Real_1m_Excess_Return <dbl>, Real_3m_Excess_Return <dbl>,
## # Real_1yr_Excess_Return <dbl>, Real_10yr_Excess_Return <dbl>,
## # Return_Buy_Hold <dbl>, timing_weight02 <dbl>,
## # Value_Timg_90_HighWeight <dbl>, timing_weight <dbl>,
## # Value_Timg_5_95_FC <dbl>, timing_weight_vm <dbl>, VM_12Mom <dbl>, …write.csv(Finnal_data, "data/finnal_data.csv")
colnames(data)## [1] "Date" "P"
## [3] "D" "E"
## [5] "CPI" "GS10"
## [7] "Adjusted_Price" "Adjusted_Dividend"
## [9] "Adjusted_Earnings" "Real_TR_Price"
## [11] "Real_TR_Scale_Earnings" "Adjusted_Earnings_Avg_10yr"
## [13] "CAPE" "CPI_lag_10yr"
## [15] "Inflation_10yr" "Excess_CAPE_Yield"
## [17] "Monthly_TR_Bond_Return" "Real_TR_Bond_Return"
## [19] "Stock_10yr_Ann_Return" "Bond_10yr_Ann_Return"
## [21] "Real_10yr_Excess_Return" "Real_30yr_Excess_Return"
## [23] "Real_5yr_Excess_Return" "Real_1yr_Excess_Return"
## [25] "Real_3m_Excess_Return" "Real_1m_Excess_Return"
## [27] "CAPE_Yield" "raw_weight"
## [29] "timing_weight" "Return_Buy_Hold"
## [31] "Value_Timg_5_95_FC" "raw_weight02"
## [33] "timing_weight02" "Value_Timg_90_HighWeight"
## [35] "Momentum_12m" "value_score"
## [37] "momentum_score" "timing_weight_vm"
## [39] "VM_12Mom" "Momentum_3m"
## [41] "Momentum_6m" "Momentum_18m"
## [43] "momentum_score02" "timing_weight_VM_6Mom"
## [45] "VM_6Mom" "momentum_score03"
## [47] "timing_weight_VM_converse" "VM_6Mom_converse"data## # A tibble: 1,848 × 48
## Date P D E CPI GS10 Adjusted_Price Adjusted_Dividend
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1871. 4.44 0.26 0.4 12.5 5.32 112. 6.58
## 2 1871. 4.5 0.26 0.4 12.8 5.32 111. 6.39
## 3 1871. 4.61 0.26 0.4 13.0 5.33 112. 6.3
## 4 1871. 4.74 0.26 0.4 12.6 5.33 119. 6.53
## 5 1871. 4.86 0.26 0.4 12.3 5.33 125. 6.69
## 6 1871. 4.82 0.26 0.4 12.1 5.34 126. 6.79
## 7 1871. 4.73 0.26 0.4 12.1 5.34 124. 6.79
## 8 1871. 4.79 0.26 0.4 11.9 5.34 127. 6.9
## 9 1871. 4.84 0.26 0.4 12.2 5.35 125. 6.74
## 10 1871. 4.59 0.26 0.4 12.4 5.35 117. 6.63
## # ℹ 1,838 more rows
## # ℹ 40 more variables: Adjusted_Earnings <dbl>, Real_TR_Price <dbl>,
## # Real_TR_Scale_Earnings <dbl>, Adjusted_Earnings_Avg_10yr <dbl>, CAPE <dbl>,
## # CPI_lag_10yr <dbl>, Inflation_10yr <dbl>, Excess_CAPE_Yield <chr>,
## # Monthly_TR_Bond_Return <dbl>, Real_TR_Bond_Return <dbl>,
## # Stock_10yr_Ann_Return <dbl>, Bond_10yr_Ann_Return <dbl>,
## # Real_10yr_Excess_Return <dbl>, Real_30yr_Excess_Return <dbl>, …