RScript

RScript

lagpad <- function(x, k) {
c(rep(NA, k), x)[1 : length(x)] }

repeat.before = function(x) { # repeats the last non NA value. Keeps leading NA
ind = which(!is.na(x)) # get positions of nonmissing values
if(is.na(x[1])) # if it begins with a missing, add the
ind = c(1,ind) # first position to the indices
rep(x[ind], times = diff( # repeat the values at these indices
c(ind, length(x) + 1) )) # diffing the indices + length yields how often
} # they need to be repeated

last <- function(x, na.rm=TRUE) { tail(x, n = 1) }

FactorResponse <- function(factor,response, AbsFactorBucket = FALSE)
{
if(class(factor)[1] != class(response)[1])
{
print(“Different class inputed.”)
return(NULL)
}
temp<-na.omit(cbind.data.frame(factor,response))
factor=temp[,1] response=temp[,2] if(AbsFactorBucket==TRUE)
decileLocations = min(factor) + (1:10) * (max(factor) – min(factor)) / 10
else
decileLocations <- quantile(factor,probs=seq(0.05,1,by=0.05))
groups = findInterval(factor,c(-Inf,decileLocations,Inf))

#Outputting interval group names
groupSums = c(0)
intervals = c(0)
intervalCount = c(0)
intervalGroups = c(-Inf,decileLocations,Inf)
for(i in 1:(length(decileLocations)))
{
groupSums[i] = mean(response[which(groups==i)])
intervalCount[i] = length(which(groups==i))
intervals[i] = paste(as.character(round(intervalGroups[i],4)),as.character(round(intervalGroups[i+1],4)),sep = ” to “)
}

result = data.frame(intervals,groupSums,intervalCount)
print(result[which(result$intervalCount > 20),])
}

FactorResponseQuality <- function(factor,response)
{
if(class(factor)[1] != class(response)[1])
{
print(“Different class inputed.”)
return(NULL)
}
temp<-na.omit(cbind.data.frame(factor,response))
factor=temp[,1] response=temp[,2] decileLocations <- quantile(factor,probs=seq(0.05,1,by=0.05))
groups = findInterval(factor,c(-Inf,decileLocations,Inf))

#Outputting interval group names
groupSums = c(0)
intervals = c(0)
intervalCount = c(0)
intervalGroups = c(-Inf,decileLocations,Inf)
for(i in 1:(length(decileLocations)))
{
groupSums[i] = mean(response[which(groups==i)])
intervalCount[i] = length(which(groups==i))
intervals[i] = paste(as.character(round(intervalGroups[i],4)),as.character(round(intervalGroups[i+1],4)),sep = ” to “)
}
result = summary(lm(groupSums~c(1:20)))
FactorResponseQuality = result$coefficients[2,4]

}

MultiFactorResponse <- function(fwdRet, factor1, factor2, factor1Name = ‘factor1Rg’, factor2Name = ‘factor2Rg’, fwdRetName = ‘fwdRets’)
{
resMat = matrix(nrow = 5, ncol = 5)
allData = cbind(fwdRet, factor1, factor2)
names(allData) = c(‘fwdRet’,’factor1′,’factor2′)
decileFactor1 <- quantile(factor1,probs=seq(0,1,by=0.05), na.rm = TRUE)
decileFactor2 <- quantile(factor2,probs=seq(0,1,by=0.05), na.rm = TRUE)
gg.df <- aggregate(fwdRet~cut(factor1, as.numeric(decileFactor1))+cut(factor2,as.numeric(decileFactor2)),allData,FUN=mean)
names(gg.df) = c(‘factor1Rg’,’factor2Rg’,’fwdRet’)#c(factor1Name,factor2Name,fwdRetName)
print(ggplot(gg.df,aes(factor1Rg,factor2Rg))+geom_tile(aes(fill = fwdRet))+ scale_fill_gradient(low = “white”, high = “gray”) + geom_text(aes(label = round(fwdRet, 1))) + labs(list(title = fwdRetName, x = factor1Name, y = factor2Name)))

}

 

MultiFactorResponseStd <- function(fwdRet, factor1, factor2)
{
resMat = matrix(nrow = 5, ncol = 5)
allData = cbind(fwdRet, factor1, factor2)
names(allData) = c(‘fwdRet’,’factor1′,’factor2′)
decileFactor1 <- quantile(factor1,probs=seq(0,1,by=0.2), na.rm = TRUE)
decileFactor2 <- quantile(factor2,probs=seq(0,1,by=0.2), na.rm = TRUE)
gg.df <- aggregate(fwdRet~cut(factor1, as.numeric(decileFactor1))+cut(factor2,as.numeric(decileFactor2)),allData,FUN=sd)
names(gg.df) = c(‘factor1Rg’,’factor2Rg’,’fwdRet’)
ggplot(gg.df,aes(factor1Rg,factor2Rg))+geom_tile(aes(fill = fwdRet))+ scale_fill_gradient(low = “white”, high = “gray”) + geom_text(aes(label = round(fwdRet, 1)))

}

SessionOpenTime<-function(datatime)
{
time = as.POSIXct(datatime)
hh = hour(time)
mm = minute(time)
ss = second(time)
if ( (hh==9 && mm<=5 ) || (hh==10 && mm<=35) || (hh==13 && mm<=35)|| (hh==21 && mm<=5) ) {
return(TRUE)
}
else
return(FALSE)
}

PriceSignalChart <-function(data, signalFieldName)
{
test = data.frame((sapply(dset$midprice[i:(i+1000)],c)))
test = as.xts(test, order.by = as.POSIXct(dset$date[i:(i+1000)]))
}

发表评论

电子邮件地址不会被公开。