Возможно ли оптимизировать (векторизовать) эти две функции для повышения производительности
В моих первых попытках использовать R я написал две функции, которые не очень эффективны, я думаю, и был бы признателен, если бы я мог получить некоторые подсказки о том, как сделать их более эффективными (векторизованными). Обе функции поставляются с "тестовым случаем" в конце.
Первая функция принимает два временных ряда xts объектов x и y и возвращает ряд, содержащий данные о том, на сколько дней x выше / ниже y.require('xts')
require('quantmod')
countDaysBelowOrAbove <- function(x, y) {
x <- try.xts(x, error=as.matrix)
y <- try.xts(y, error=as.matrix)
if(is.xts(x) && is.xts(y)) {
xy <- cbind(x,y)
} else {
xy <- cbind( as.vector(x), as.vector(y) )
}
# Count NAs, ensure they're only at beginning of data, then remove.
xNAs <- sum( is.na(x) )
yNAs <- sum( is.na(y) )
NAs <- max( xNAs, yNAs )
if( NAs > 0 ) {
if( any( is.na(xy[-(1:NAs),]) ) ) stop("Series contain non-leading NAs")
}
resultDaysLower <- x
resultDaysHigher <- x
resultDaysLower[!is.na(resultDaysLower)]<-0
resultDaysHigher[!is.na(resultDaysHigher)]<-0
series<-cbind(xy, resultDaysLower, resultDaysHigher)
colnames(series) <- c(names(xy), "cumDaysLower", "cumDaysHigher")
daysLower = 0
daysHigher = 0
for (i in 1:NROW(xy)) {
if (!(is.na(series[,1][i]) | is.na(series[,2][i]))) {
if (series[,1][i] >= series[,2][i]) {
daysLower = 0
daysHigher = daysHigher + 1
}
else {
daysHigher = 0
daysLower = daysLower + 1
}
}
else {
daysLower = 0
daysHigher = 0
}
series$cumDaysLower[i] = daysLower
series$cumDaysHigher[i] = daysHigher
}
return(series)
}
getSymbols("SPY", from='2005-01-01')
SPYclose = Cl(SPY)
getSymbols("QQQQ", from='2005-01-01')
QQQQclose = Cl(QQQQ)
testData = countDaysBelowOrAbove(SPYclose, QQQQclose)
Вторая функция, которую я хотел бы использовать для оптимизации производительности, - это под. Функция принимает в качестве параметра ряд объектов xts и объект xts, представляющий длины интервалов для вычисления минимума ряда в заданное время. Функция возвращает вычисленный минимум ряда с заданным окном для минимального набора вычислений в длинах.
minimumWithVaryingLength<-function(series, lengths) {
series <- try.xts(series, error=as.matrix)
lengths <- try.xts(lengths, error=as.matrix)
if(is.xts(series) && is.xts(lengths)) {
serieslengths <- cbind(series,lengths)
} else {
serieslengths <- cbind( as.vector(series), as.vector(lengths) )
}
# Count NAs, ensure they're only at beginning of data, then remove.
seriesNAs <- sum( is.na(series) )
lengthsNAs <- sum( is.na(lengths) )
NAs <- max( seriesNAs, lengthsNAs )
if( NAs > 0 ) {
if( any( is.na(serieslengths[-(1:NAs),]) ) ) stop("Series contain non-leading NAs")
}
result <- series
result[!is.na(result)]<-0
for (i in 1:NROW(serieslengths)) {
if (lengths[i] > 0) {
result[i] <- runMin(series, n=lengths[i], cumulative=FALSE)[i]
}
else {
result[i] <- 0
}
}
return(result)
}
getSymbols("SPY", from='2005-01-01')
SPYclose = Cl(SPY)
getSymbols("QQQQ", from='2005-01-01')
QQQQclose = Cl(QQQQ)
numDaysBelow = countDaysBelowOrAbove(SPYclose, QQQQclose)
test = minimumWithVaryingLength(SPYclose, numDaysBelow)
Заранее благодарю за вашу любезную помощь.
С уважением, Само.
2 ответа:
Для первой функции вы ищете совокупное число периодов, в течение которых ряд
xниже/выше, чемy. Для этого вы можете использовать эту удобную функциюCumCount(), построенную изcummax. Сначала некоторые примеры данных:set.seed(1) x <- sample(1:5,20,T) y <- sample(1:5,20,T) CumCount <- function(x) { z <- cumsum(x) z - cummax(z*(!x)) } CumLow = CumCount(x<y) CumHigh = CumCount(x>y)Для вашего второго вычисления вы пытаетесь найти кумулятивный минимум
xзначение В течение каждого периода, в течение которогоx < y. Для этого очень полезна функцияrle("run-length-encoding").# runs equals the length of each phase (x < y or x > y) runs <- rle(CumLow > 0)$lengths # starts is the number of periods prior to each phase... starts <- c(0,cumsum(runs)[-length(runs)]) #... which we use to build "blocks", a list of indices of each phase. blocks <- mapply( function(x,y) x+y, starts, lapply(runs,seq)) # now apply the cummin function within each block: # (remember to mask it by CumLow > 0 -- # we only want to do this within the x<y phase) BlockCumMin <- unlist(sapply(blocks, function(blk) cummin(x[blk]))) * (CumLow > 0)Теперь мы ставим его все вместе:
Обратите внимание, что эта проблема связана с этим вопросом> cbind(x,y, CumLow, CumHigh, BlockCumMin) x y CumLow CumHigh BlockCumMin [1,] 3 4 1 0 3 [2,] 4 2 0 1 0 [3,] 2 2 0 0 0 [4,] 2 5 1 0 2 [5,] 4 4 0 0 0 [6,] 2 2 0 0 0 [7,] 4 1 0 1 0 [8,] 1 3 1 0 1 [9,] 2 5 2 0 1 [10,] 1 3 3 0 1 [11,] 2 5 4 0 1 [12,] 1 4 5 0 1 [13,] 4 2 0 1 0 [14,] 5 3 0 2 0 [15,] 4 1 0 3 0 [16,] 4 1 0 4 0 [17,] 3 4 1 0 3 [18,] 3 1 0 1 0 [19,] 5 3 0 2 0 [20,] 4 4 0 0 0обновление. для более общего случая, когда у вас есть вектор
series, векторlengths(той же длины, что иseries), и вы хотите получить результат под названиемBlockMins, гдеBlockMins[i]является минимумом блокаlengths[i]series, заканчивающегося в позицииi, вы можете сделать следующее. Поскольку длины произвольны, это больше не кумулятивная минута; для каждогоiу вас есть чтобы взять min изlength[i]элементовseries, заканчивающихся в позицииi:set.seed(1) series <- sample(1:5,20,T) lengths <- sample(3:5,20,T) BlockMins <- sapply(seq_along(lengths), function(i) min( series[ i : max(1, (i - lengths[i]+1)) ]) ) > cbind(series, lengths, BlockMins) series lengths BlockMins [1,] 1 5 1 [2,] 1 4 1 [3,] 3 3 1 [4,] 4 4 1 [5,] 5 3 3 [6,] 1 4 1 [7,] 1 5 1 [8,] 4 3 1 [9,] 2 5 1 [10,] 2 4 1 [11,] 1 5 1 [12,] 2 5 1 [13,] 2 3 1 [14,] 2 4 1 [15,] 4 5 1 [16,] 3 5 2 [17,] 5 3 3 [18,] 1 4 1 [19,] 5 3 1 [20,] 3 3 1
Не имея дела с аппаратом временных рядов, если у вас есть два вектора x и y и вы хотите "вернуть ряд, содержащий данные о том, сколько дней x выше / ниже y", просто сравните их:
Ключ к этому заключается в том, что при суммировании логического вектора, например (x>y), R приводит к истинности 1 и ложности 0.# Make up some data x <- seq(100) y <- x[sample(x)] # Compare x.greater <- sum(x>y) x.lesser <- sum(x<y)