Sean - generated signals and stock data for backtests Jianbo - ran back tests and generated results Xavier - Did research on strategies to include

Code:

library(tidyverse) library(magrittr) library(Quandl) library(moments) library(data.table)

snp <- read.csv("Adjusted_close_prices.csv")

colnames(snp)[1] <- "Date" snp$Date <- as.Date(snp$Date) snp_melted <- snp %>% melt(id = "Date") colnames(snp_melted) <- c("Date", "Stock", "Price") snp_tidy <- snp_melted %>% group_by(Date) %>% mutate(exist = ifelse(is.na(Price) == 1, 0, 1)) %>% filter(sum(exist) > 10)

snp_tidy <- snp_melted %>%

na.fill(0) %>% as.data.frame

snp_tidy$Price <- as.numeric(as.character(snp_tidy$Price))

snp_tidy <- snp_tidy %>% group_by(Stock) %>% mutate(Price = na.locf(Price, na.rm = F)) snp_tidy <- snp_tidy %>% group_by(Stock) %>% mutate(past_price = shift(Price)) %>% mutate(returns = (Price - past_price)/past_price, tcost = 0.0005) snp_tidy$Date <- as.Date(snp_tidy$Date)

snp500 <- read.csv("Adjusted_close_prices_with_SnP_index.csv") %>% select(1,102) snp500 <- snp500 %>% mutate(SnP500 = na.locf(SnP500, na.rm = F)) %>% mutate(snp500_past = shift(SnP500)) %>% mutate(snp500 = (SnP500 - snp500_past)/snp500_past)

stocks <- colnames(snp) stocks <- stocks[-1] y <- data.frame(matrix(nrow = 0, ncol = 10)) colnames(y) <- c("datekey","ticker", "de", "divyield","marketcap", "ncfo", "netmargin","payoutratio","pb","pe1") for(i in stocks){ Quandl.api_key("Tu_djozePNhyxDs1ij4C") a <- Quandl.datatable('SHARADAR/SF1', ticker=i) a <- a %>% filter(dimension == "ARQ") %>% select("datekey","ticker", "de", "divyield","marketcap", "ncfo", "netmargin","payoutratio","pb","pe1") y <- rbind(y,a)

} colnames(y) <- c("Date", "Stock", "de", "divyield","marketcap", "ncfo", "netmargin","payoutratio","pb","pe1")

snp_use <- snp_tidy %>% left_join(y, by= c("Date","Stock")) snp_use <- snp_use %>% group_by(Stock) %>% mutate(vol = rollapply(returns, width = 250, FUN= sd, fill = NA, align = "right")) snp_use[,8:16] <- na.locf(snp_use[,8:16], na.rm = F)

calculate_cost <- function(x){ x <- x %>% group_by(Date) %>% mutate(weight_drift = (weight*(1+returns))/(1+sum(weight * returns, na.rm = T))) %>% ungroup() %>% group_by(Stock) %>% mutate(weight_drift = shift(weight_drift)) %>% mutate(turnover = abs(weight - weight_drift)) %>% mutate(cost = tcost * turnover) }

gen_returns <- function(x){ x <- x %>% group_by(Date) %>% mutate(daily_ret = weight * returns - cost) %>% mutate(precost = weight * returns) %>% summarise(Return = sum(daily_ret, na.rm = T), precost = sum(precost, na.rm = T)) %>% mutate(Return = na.fill(Return,0)) }

gen_stats <- function(x){ x %>% summarise(SR = mean(x$Return, na.rm = T)/sd(x$Return, na.rm = T)sqrt(252), mean = mean(x$Return, na.rm = T)*252, Vol = sd(x$Return, na.rm = T)*sqrt(252),
precostSR = mean(x$precost, na.rm = T)/sd(x$precost, na.rm = T)
sqrt(252), precostmean = mean(x$precost, na.rm = T)*252 ) }

gen_debtratio_wts <- function(data){ data <- data %>% filter(exist == 1) %>% group_by(Date) %>% mutate(debt = rank(abs(de), na.last = "keep")) %>% mutate(weight = ifelse(debt <= 0.2*sum(exist, na.rm = T), -1, ifelse(debt >= 0.8*sum(exist, na.rm = T), 1, 0))) %>% #mutate(weight = debt - median(debt, na.rm = T)) %>% mutate(weight = weight/vol) %>% mutate(weight = weight/sum(abs(weight), na.rm = T)) %>% ungroup() %>% group_by(Stock) %>% mutate(weight = shift(weight, 3))%>% ungroup() %>% mutate(strat = "debtratio")

}

debtratio_wts <- gen_debtratio_wts(snp_use) debtratio_cost <- calculate_cost(debtratio_wts) debtratio_returns <- gen_returns(debtratio_cost) gen_stats(debtratio_returns)

gen_size_wts <- function(data){ data <- data %>% filter(exist == 1) %>% group_by(Date) %>% mutate(size = rank(abs(marketcap), na.last = "keep")) %>% mutate(weight = ifelse(size <= 0.2*sum(exist, na.rm = T), 1, ifelse(size >= 0.8*sum(exist, na.rm = T), -1, 0))) %>% #mutate(weight = size - median(size, na.rm = T)) %>% mutate(weight = weight/vol) %>% mutate(weight = weight/sum(abs(weight), na.rm = T)) %>% ungroup() %>% group_by(Stock) %>% mutate(weight = shift(weight, 3))%>% ungroup() %>% mutate(strat = "size")

}

size_wts <- gen_size_wts(snp_use) size_cost <- calculate_cost(size_wts) size_returns <- gen_returns(size_cost) gen_stats(size_returns)

gen_payout_wts <- function(data){ data <- data %>% filter(exist == 1) %>% group_by(Date) %>% mutate(payout = rank(abs(payoutratio), na.last = "keep")) %>% mutate(weight = ifelse(payout <= 0.2*sum(exist, na.rm = T), 1, ifelse(payout >= 0.8*sum(exist, na.rm = T), -1, 0))) %>% #mutate(weight = median(payout, na.rm = T) - payout) %>% mutate(weight = weight/vol) %>% mutate(weight = weight/sum(abs(weight), na.rm = T)) %>% ungroup() %>% group_by(Stock) %>% mutate(weight = shift(weight, 3))%>% ungroup() %>% mutate(strat = "payout")

}

payout_wts <- gen_payout_wts(snp_use) payout_cost <- calculate_cost(payout_wts) payout_returns <- gen_returns(payout_cost) gen_stats(payout_returns)

gen_mom_wts <- function(data){ data <- data %>% filter(exist == 1) %>% group_by(Stock) %>% mutate(mom = rollapply(returns, width = 250, FUN = function(x) mean(x)/sd(x), fill = NA, align = "right")) %>% group_by(Date) %>% mutate(rank = rank(abs(mom), na.last = "keep")) %>% mutate(weight = ifelse(rank <= 0.2*sum(exist, na.rm = T), -1, ifelse(rank >= 0.8*sum(exist, na.rm = T), 1, 0))) %>% mutate(weight = mom/vol) %>% mutate(weight = weight/sum(abs(weight), na.rm = T)) %>% ungroup() %>% group_by(Stock) %>% mutate(weight = shift(weight, 3))%>% ungroup() %>% mutate(strat = "mom")

}

mom_wts <- gen_mom_wts(snp_use) mom_cost <- calculate_cost(mom_wts) mom_returns <- gen_returns(mom_cost) gen_stats(mom_returns)

gen_trend_wts <- function(data){ data <- data %>% filter(exist == 1) %>% group_by(Stock) %>% mutate(longmom = rollapply(returns, width = 250, FUN = function(x) mean(x)/sd(x), fill = NA, align = "right")) %>% mutate(shortmom = rollapply(returns, width = 21, FUN = function(x) mean(x)/sd(x), fill = NA, align = "right")) %>% group_by(Date) %>% mutate(weight = ifelse(shortmom > longmom, 1, -1)) %>% mutate(weight = weight/vol) %>% mutate(weight = weight/sum(abs(weight), na.rm = T)) %>% ungroup() %>% group_by(Stock) %>% mutate(weight = shift(weight, 3))%>% ungroup() %>% mutate(strat = "trend")

}

trend_wts <- gen_trend_wts(snp_use) trend_cost <- calculate_cost(trend_wts) trend_returns <- gen_returns(trend_cost) gen_stats(trend_returns)

snpbeta <- read.csv("tidy_Beta.csv") colnames(snpbeta) <- c("X", "Date", "Stock", "Beta") snpbeta <- snpbeta %>% group_by(Stock) %>% mutate(Beta = na.locf(Beta, na.rm = F), Date = as.Date(Date)) %>% select(Date, Stock, Beta)

snpalpha <- read.csv("tidy_ST_Alpha.csv") %>% select(2:4) colnames(snpalpha) <- c("Date", "Stock", "STalpha") snpalpha1 <- read.csv("tidy_LT_Alpha.csv") %>% select(2:4) colnames(snpalpha1) <- c("Date", "Stock", "LTalpha") snpalpha <- snpalpha %>% left_join(snpalpha1, by = c("Date", "Stock")) %>% group_by(Stock) %>% mutate(STalpha = na.locf(STalpha, na.rm = F), Date = as.Date(Date), LTalpha = na.locf(LTalpha, na.rm = F))

gen_bab_wts <- function(x,y){ x <- x %>% left_join(y, by = c("Date", "Stock")) x <- x %>% filter(exist == 1) %>% group_by(Date) %>% mutate(Beta = na.locf(Beta, na.rm = F)) %>% mutate(rank = rank(Beta, na.last = "keep")) %>% mutate(weight = ifelse(rank <= 0.2*sum(exist, na.rm = T), -1, ifelse(rank >= 0.8*sum(exist, na.rm = T), 1, 0))) %>% mutate(weight = weight/vol) %>% mutate(weight = weight/sum(abs(weight))) %>% ungroup() %>% group_by(Stock) %>% mutate(weight = shift(weight,3)) %>% ungroup() %>% mutate(strat = "bab")

}

bab_wts <- gen_bab_wts(snp_use, snpbeta) bab_cost <- calculate_cost(bab_wts) bab_returns <- gen_returns(bab_cost) gen_stats(bab_returns)

gen_baa_wts <- function(x,y){ x <- x %>% left_join(y, by = c("Date", "Stock")) x <- x %>% filter(exist == 1) %>% group_by(Stock) %>% mutate(STalpha = na.locf(STalpha, na.rm = F), LTalpha = na.locf(LTalpha, na.rm = F)) %>% ungroup() %>% group_by(Date) %>% mutate(ltrank = rank(LTalpha, na.last = "keep")) %>% mutate(sign = ifelse(ltrank <= 0.3*sum(exist, na.rm = T), -1, ifelse(ltrank >= 0.7*sum(exist, na.rm = T), 1, NA))) %>% filter(sign == 1 | sign == -1) %>% group_by(Date, sign) %>% mutate(strank = rank(STalpha, na.last = "keep")) %>% mutate(weight = ifelse(sign == 1 & strank <= 0.3*sum(exist, na.rm = T), 1, ifelse(sign == -1 & strank >= 0.7*sum(exist, na.rm = T), -1, 0))) %>% mutate(weight = weight/vol) %>% #mutate(weight = weight/sum(abs(weight)+0.0000000001, na.rm = T)) %>% ungroup() %>% group_by(Date) %>% mutate(weight = weight/sum(abs(weight)+0.0000000001, na.rm = T)) %>% ungroup() %>% group_by(Stock) %>% mutate(weight = shift(weight,3)) %>% ungroup() %>% mutate(strat = "baa")

}

baa_wts <- gen_baa_wts(snp_use, snpalpha) baa_cost <- calculate_cost(baa_wts) baa_returns <- gen_returns(baa_cost) gen_stats(baa_returns)

gen_stats(mom_returns) gen_stats(debtratio_returns) gen_stats(payout_returns) gen_stats(bab_returns)

mom_returns1 <- mom_returns %>% mutate(vol = rollapply(Return, width = 250, FUN= sd, fill = NA, align = "right")) %>% mutate(sweight = 1/vol, strat = "mom") debtratio_returns1 <- mom_returns %>% mutate(vol = rollapply(Return, width = 250, FUN= sd, fill = NA, align = "right")) %>% mutate(sweight = 0.2/vol, strat = "debtratio") payout_returns1 <- mom_returns %>% mutate(vol = rollapply(Return, width = 250, FUN= sd, fill = NA, align = "right")) %>% mutate(sweight = 0.2/vol, strat = "payout") bab_returns1 <- mom_returns %>% mutate(vol = rollapply(Return, width = 250, FUN= sd, fill = NA, align = "right")) %>% mutate(sweight = 0.2/vol, strat = "bab")

stratreturns <- rbind(mom_returns1, debtratio_returns1, payout_returns1, bab_returns1) mom_wts1 <- mom_wts %>% select(Date, Stock, returns, weight, strat) debtratio_wts1 <- debtratio_wts %>% select(Date, Stock, returns, weight, strat) payout_wts1 <- payout_wts %>% select(Date, Stock, returns, weight, strat) bab_wts1 <- bab_wts %>% select(Date, Stock, returns, weight, strat) stratwts <- rbind(mom_wts1, debtratio_wts1, payout_wts1, bab_wts1) stratwts <- stratwts %>% left_join(stratreturns, by = c("Date", "strat")) %>% mutate(weight = weight * sweight) %>% group_by(Date, Stock) %>% summarise(weight = sum(weight, na.rm = T), tcost = 0.0005, returns =mean(returns, na.rm = T)) %>% ungroup() %>% group_by(Date) %>% mutate(weight = weight/sum(abs(weight),na.rm = T))

stratcost <- calculate_cost(stratwts) strat_ret <- gen_returns(stratcost) gen_stats(strat_ret%>% filter(Date > "1980-01-01"))

strat_vol <- strat_ret %>% mutate(portvol = rollapply(Return, width = 60, FUN= sd, fill = NA, align = "right")) %>% mutate(fweight = 0.02/portvol) %>% select(Date, fweight) port_wt <- stratwts %>% left_join(strat_vol, by = "Date") %>% mutate(weight = weight * fweight) port_cost <- calculate_cost(port_wt) port_returns <- gen_returns(port_cost) gen_stats(port_returns %>% filter(Date > "1980-01-01"))

z <- data.frame(matrix(nrow = 0, ncol = 4)) colnames(z) <- c("date","ticker","sentiment", "news_buzz") for(i in stocks){ Quandl.api_key('Tu_djozePNhyxDs1ij4C') a <- Quandl.datatable('IFT/NSA', ticker=i, paginate=TRUE) a <- a %>% select("date","ticker", "sentiment", "news_buzz") z <- rbind(z,a)

} colnames(z) <- c("Date", "Stock","sentiment", "news_buzz") z <- z %>% group_by(Stock) %>% arrange(Stock, Date) snp_news <- snp_tidy %>% left_join(z, by= c("Date","Stock")) snp_news <- snp_news %>% group_by(Stock) %>% mutate(vol = rollapply(returns, width = 250, FUN= sd, fill = NA, align = "right")) snp_news <- snp_news %>% filter(Date > "2013-01-01")

gen_sentiment_wts <- function(data){ data <- data %>% filter(exist == 1) %>% group_by(Date) %>% mutate(rank = rank(sentiment, na.last = "keep")) %>% mutate(weight = ifelse(rank <= 0.2*sum(exist, na.rm = T), -1, ifelse(rank >= 0.8*sum(exist, na.rm = T), 1, 0))) %>% mutate(weight = weight/vol) %>% mutate(weight = weight/sum(abs(weight), na.rm = T)) %>% ungroup() %>% group_by(Stock) %>% mutate(weight = shift(weight, 3)) %>% mutate(weight = rollapply(weight, width = 20, FUN= mean, fill = NA, align = "right"))%>% ungroup()

}

sentiment_wts <- gen_sentiment_wts(snp_news) sentiment_cost <- calculate_cost(sentiment_wts) sentiment_returns <- gen_returns(sentiment_cost) gen_stats(sentiment_returns)

gen_buzz_wts <- function(data){ data <- data %>% filter(exist == 1) %>% group_by(Date) %>% mutate(rank = rank(news_buzz, na.last = "keep")) %>% mutate(weight = ifelse(rank <= 0.2*sum(exist, na.rm = T), -1, ifelse(rank >= 0.8*sum(exist, na.rm = T), 1, 0))) %>% mutate(weight = weight/vol) %>% mutate(weight = weight/sum(abs(weight), na.rm = T)) %>% ungroup() %>% group_by(Stock) %>% mutate(weight = shift(weight, 3)) %>% mutate(weight = rollapply(weight, width = 20, FUN= mean, fill = NA, align = "right"))%>% ungroup()

}

buzz_wts <- gen_buzz_wts(snp_news) buzz_cost <- calculate_cost(buzz_wts) buzz_returns <- gen_returns(buzz_cost) gen_stats(buzz_returns)

Built With

Share this project:
×

Updates