abel
在Rmetrics中,有一个函数rollFun[滚动计算?]
使用的是利用循环和cbind生成一个矩阵,
rollFun
function (x, n, trim = TRUE, na.rm = FALSE, FUN, ...)
{
x.orig = x
if (is.timeSeries(x)) {
stopifnot(isUnivariate(x))
TS = TRUE
}
else {
TS = FALSE
}
if (TS) {
positions = x.orig@positions
x = x.orig@Data[, 1]
}
else {
x = as.vector(x.orig)
names(x) = NULL
}
if (na.rm) {
if (TS)
positions = positions[!is.na(x)]
x = as.vector(na.omit(x))
}
start = 1
end = length(x) - n + 1
m = x[start:end]
# 核心部分
if (n > 1) {
for (i in 2:n) {
start = start + 1
end = end + 1
m = cbind(m, x[start:end])
}
}
else {
m = matrix(m)
}
ans = apply(m, MARGIN = 1, FUN = FUN, ...)
if (!trim)
ans = c(rep(NA, (n - 1)), ans)
if (trim & TS)
positions = positions[-(1:(n - 1))]
if (TS) {
ans = timeSeries(as.matrix(ans), positions, recordIDs = data.frame(),
units = x.orig@units, FinCenter = x.orig@FinCenter)
}
ans
}
-------------------------------------------------------------------------------------
Splus中的
rollMin
function(x, n = 9, trim = T, na.rm = F)
{
n <- as.integer(n)
if(n < 1) {
warning("Doing nothing, since n < 1 ")
return(x)
}
if(isTS <- is(x, "seriesVirtual")) {
oldSer <- x
x <- seriesData(x)
}
isVec <- is.null(dim(x))
isDF <- is.data.frame(x)
isBig <- is(x, "bdObject")
if(isBig)
x <- as.bdFrame(x)
else x <- as.matrix(x)
nk <- numCols(x)
na <- which.na(x)
if(length(na)) {
if(!na.rm) {
stop("NAs are not allowed for rollMax when na.rm is FALS
E"
)
}
na <- ((na - 1) %% nrow(x)) + 1
x <- x[ - na, , drop = F]
if(isTS) {
oldSer <- oldSer[ - na, , drop = F]
}
}
if(trim && isTS)
oldSer <- oldSer[ - (1:(n - 1)), , drop = F]
nx <- numRows(x)
# splus针对大数据的特殊处理
if(isBig) {
ans <- bd.block.apply(x, bd.internal.finmetrics.moving, args =
list(n = n, fun = "fe_rmin"))
}
else {
# 此处感觉怪怪的,呵呵
storage.mode(x) <- "double"
xhat <- matrix(double(1), nx, nk)
ans <- .C("fe_rmin",
as.double(x),
as.integer(nx),
as.integer(n),
xhat = xhat,
as.integer(nk),
COPY = c(rep(F, 3), T, F))$xhat
}
if(trim) {
ans <- ans[ - (1:(n - 1)), , drop = F]
}
else ans[1:(n - 1), ] <- NA
if(isVec) {
ans <- ans[, 1, drop = T]
}
else if(isDF)
ans <- as.data.frame(ans)
if(isTS) {
seriesData(oldSer) <- ans
ans <- oldSer
}
ans
}
类似这种功能,如何实现更好!?
大伙儿找个办法提高下速度哈?一般我不太重视运算速度,现在遇到一个实际问题,需要大量这种计算,看看能想出什么好办法来不。
我曾经整了一个直接用for,中间不再使用cbind的,感觉也不太好。