This Project aims at calculating the average arithmetic and geometric historical mean rate of return for daily, monthly, yearly and 6-year return of S&P 500 index. Also,the tables following contains the excess return for daily,30-days,1yr and 5 yr treasury Rates.
The data was extracted from WRDS, including CRSP- SP500 with dividend data, Federal Effective Rate and different time Range Treasury Bill Rate. The time range is from 1/1/1973 through 1/1/2015.
| Arithmetic Average Return(Annualized) | Geometric Average Return(Annualized) | |
|---|---|---|
| Daily | 11.54% | 10.66% |
| Monthly | 11.31% | 10.67% |
| Annually | 12.13% | 10.67% |
| 5-Year | 18.34% | 12.15% |
| Arithmetic Average Excess Return(Annualized) | Geometric Average excess Return(Annualized) | |
|---|---|---|
| Daily | 7.12% | 5.80% |
| Monthly | 4.29% | 4.33% |
| Annually | 4.62% | 4.53% |
| 5-Year | 5.19% | 4.47% |
\[\bar{R}^C = \prod^{T}_{i = 1}(1+r_i)-1\]
\[\bar{R}^G = \left(\prod^{T}_{i = 1}(1+r_i)\right)^{\frac{1}{T}}\]
\[\bar{R} = \frac{\sum^{nT}_{i=1}r_i}{nT}\]
sp500 <- read.csv("p5-sp500.csv")
sp500 <- sp500[complete.cases(sp500),]
sp500$caldt <-lubridate::ymd(sp500$caldt)
rtn <- xts(sp500$vwretd, order.by = sp500$caldt)
rtn_daily <- rtn
rtn_monthly <- period.prod(1+rtn,endpoints(rtn,"months"))-1
rtn_annual <- period.prod(1+rtn,endpoints(rtn,"years"))-1
y5 <- endpoints(rtn_annual,"years",5)
rtn_5yr <- vector()
for (i in 1:(length(y5)-2)){
rtn_5yr[i] <- prod(rtn_annual[(y5[i+1]+1):(y5[i+2])]+1)-1
}
#Arithmetic Average Return
sp500_daily_ari <- percent(Return.annualized(rtn_daily,
scale = 252,geometric = FALSE),.01)
sp500_monthly_ari <- percent(Return.annualized(rtn_monthly,
scale = 12,geometric = FALSE),.01)
sp500_annually_ari <- percent(Return.annualized(rtn_annual,
scale = 1,geometric = FALSE),.01)
sp500_5year_ari <- percent(Return.annualized(rtn_5yr,
scale = 1/5,geometric = FALSE),.01)
rtn_ari <- matrix(c(sp500_daily_ari,sp500_monthly_ari,
sp500_annually_ari,sp500_5year_ari),ncol=1)
rownames(rtn_ari) <- c("Daily","Monthly","Annually","5-Year")
colnames(rtn_ari) <- "Arithmetic Average Return(Annualized)"
#Geometric Average Return
sp500_daily_geo <- percent(Return.annualized(rtn_daily,
scale = 252,geometric = TRUE),.01)
sp500_monthly_geo <- percent(Return.annualized(rtn_monthly,
scale = 12,geometric = TRUE),.01)
sp500_annually_geo <- percent(Return.annualized(rtn_annual,
scale = 1,geometric = TRUE),.01)
sp500_5year_geo <- percent(Return.annualized(rtn_5yr,
scale = 1/5,geometric = TRUE),.01)
rtn_geo <- matrix(c(sp500_daily_geo,sp500_monthly_geo,
sp500_annually_geo,sp500_5year_geo),ncol=1)
rownames(rtn_geo) <- c("Daily","Monthly","Annually","5-Year")
colnames(rtn_geo) <- "Geometric Average Return(Annualized)"
#excess return calculation
tRate <- read.csv("Treasury.csv")
tRate <- tRate %>%
select(CALDT,TDYLD)
tRate <- tRate[complete.cases(tRate),]
tRate$CALDT <- mdy(tRate$CALDT)
tRate.ts<- xts(tRate$TDYLD, order.by =tRate$CALDT)
tRate_daily <- tRate %>%
group_by(CALDT,.groups = 'keep') %>%
summarise(mean= mean(TDYLD))
tRate_daily <- xts(tRate_daily$mean,order.by = tRate_daily$CALDT)
excess_rtn <- rtn-tRate_daily
#Daily Excess Rtn
excess_rtn_daily <- excess_rtn
daily_excess_ari <- percent(Return.annualized(excess_rtn_daily,
scale=252,geometric = FALSE),.01)
daily_excess_geo <- percent(Return.annualized(excess_rtn_daily,
scale=252,geometric = TRUE),.01)
#Monthly
tRate_monthly <- period.prod(1+excess_rtn,endpoints(excess_rtn,"months"))-1
excess_rtn_daily <- rtn_monthly-tRate_monthly
monthly_excess_ari <- percent(Return.annualized(excess_rtn_daily,
scale=12,geometric = FALSE),.01)
monthly_excess_geo <- percent(Return.annualized(excess_rtn_daily,
scale=12,geometric = TRUE),.01)
#YEARLY
tRate_yearly <- period.prod(1+excess_rtn,endpoints(excess_rtn,"years"))-1
excess_rtn_yearly <- rtn_annual - tRate_yearly
yearly_excess_ari <- percent(Return.annualized(excess_rtn_yearly,
scale=1,geometric = FALSE),.01)
yearly_excess_geo <- percent(Return.annualized(excess_rtn_yearly,
scale=1,geometric = TRUE),.01)
#5 yr
tRate_index <- seq(5,nrow(tRate_yearly),by=5)
tRate_yr5 <- period.prod(1+excess_rtn,endpoints(excess_rtn,"years",5))-1
excess_rtn_yr5 <- rtn_5yr - tRate_yr5
yr5_excess_ari <- percent(Return.annualized(excess_rtn_yr5,
scale=.2,geometric = FALSE),.01)
yr5_excess_geo <- percent(Return.annualized(excess_rtn_yr5,
scale=.2,geometric = TRUE),.01)
#Ari vector
ex_rtn_ari <- matrix(c(daily_excess_ari,monthly_excess_ari,
yearly_excess_ari,yr5_excess_ari),ncol=1)
rownames(ex_rtn_ari) <- c("Daily","Monthly","Annually","5-Year")
colnames(ex_rtn_ari) <- "Arithmetic Average Excess Return(Annualized)"
#geo vector
ex_rtn_geo <- matrix(c(daily_excess_geo,monthly_excess_geo,
yearly_excess_geo,yr5_excess_geo),ncol=1)
#in matrix output
rownames(ex_rtn_ari) <- c("Daily","Monthly","Annually","5-Year")
colnames(ex_rtn_ari) <- " Geometric Average excess Return(Annualized)"
By looking at the excess return table, we can see the the daily excess return outperformed both in arithmetic mean and geometric mean, which means the strategy of long daily sp500 index and short daily Treasury Rate will give a better result than other strategies. Therefore, overlapping longer-term series does not lead to diffenet indifference.