2016-12-06 55 views
1

我试图清理我的代码。目前我使用不同的参数组合多次运行rollapplyr。下面是我使用它的功能:使用不同参数多次滚动

library('assertthat') 
var_sums <- function(x, sign) { 
    assert_that(length(x) > 0) 

    if (sign == "pos") { 
    sum(x[which(x > 0)]) 
    } else if (sign == "neg") { 
    sum(x[which(x < 0)]) 
    } else { 
    stop("variable sign must have value of 'pos' or 'neg'") 
    } 
} 

它发生在一个矢量-1和1之间的正数和负数的x,总结要么只是取决于在正面的或只是消极因素值为sign。目前,我已经做实现了它:

library('zoo') 
set.seed(1) 
vec <- round(runif(100, min = -1), digits = 2) 
pos_4 <- rollapplyr(vec, 4, var_sums, sign = "pos", fill = NA) 
neg_4 <- rollapplyr(vec, 4, var_sums, sign = "neg", fill = NA) 
pos_12 <- rollapplyr(vec, 12, var_sums, sign = "pos", fill = NA) 
neg_12 <- rollapplyr(vec, 12, var_sums, sign = "neg", fill = NA) 

y <- data.frame(pos_4, neg_4, pos_12, neg_12) 

肯定有这样做的,我只是没有看到,使用do.callmapply什么的更优雅的方式。

回答

2
# Data 
set.seed(1) 
x <- runif(20) - 0.5 

# Parameters 
signs <- c("neg", "pos") 
n <- c(4, 12) 
pars <- expand.grid(n=n, sign=signs, stringsAsFactors = FALSE) 
pars$name <- paste(pars$sign, pars$n, sep="_") 
pars 
# n sign name 
#1 4 neg neg_4 
#2 12 neg neg_12 
#3 4 pos pos_4 
#4 12 pos pos_12 

# Function 
f <- function(n, sign)rollapplyr(x, n, var_sums, sign = sign, fill = NA) 
y <- mapply(f, pars$n, pars$sign) 
colnames(m) <- pars$name 
#    neg_4 neg_12  pos_4 pos_12 
# [1,]   NA  NA  NA  NA 
# [2,]   NA  NA  NA  NA 
# [3,]   NA  NA  NA  NA 
# [4,] -0.362367437  NA 0.4810612  NA 
# [5,] -0.426194169  NA 0.4810612  NA 
# [6,] -0.298318069  NA 0.8794508  NA 
# [7,] -0.298318069  NA 1.2512727  NA 
# [8,] -0.298318069  NA 1.0038627  NA 
# [9,] 0.000000000  NA 1.1329768  NA 
#[10,] -0.438213730  NA 0.7345871  NA 
#[11,] -0.732239155  NA 0.2899118  NA 
#[12,] -1.055682402 -1.716368 0.1291140 1.614038 
#[13,] -1.055682402 -1.481877 0.1870228 1.801061 
#[14,] -0.733364954 -1.469897 0.1870228 1.801061 
#[15,] -0.439339529 -1.469897 0.4568643 1.998049 
#[16,] -0.118197040 -1.472198 0.4568643 1.589841 
#[17,] -0.118197040 -1.173879 0.4874599 1.807460 
#[18,] -0.002300758 -1.173879 0.9793660 1.900976 
#[19,] -0.122265578 -1.293844 0.7095246 1.456301 
#[20,] -0.119964821 -1.293844 0.9869698 1.572948 
+1

这是一个小的变化:'g < - expand.grid(sign = c(“pos”,“neg”),width = c(4,12)); (g,rollapplyr(x,width,var_sums,sign = sign,fill = NA)); sapply(split(g,do.call(“interaction”,g)),roll) ' –

相关问题