在 xts 对象中将每一列彼此相减

Question

我是一个学习编码的新手，有一个 1000 行 10 列的 xts 对象。我需要将每一列彼此相减，创建一个保留日期列的新 xts 对象。我试过使用 combn 但无法让它创建 B-A 结果，因为它是 A-B。我要找的是下面。

 DATA                                           RESULT
            A  B   C     --->               A-B   A-C  B-A  B-C  C-A  C-B
2010-01-01  1  3   5           2010-01-01   -2    -4    2    -2    4    2 
2010-01-02  2  4   6           2010-01-02   -2    -4    2    -2    4    2
2010-01-03  3  5   2           2010-01-03   -2     1    2     3   -1   -3

Answer 1

我们可以使用outer得到列名的成对组合，subset数据集'xt1'基于列名，得到list中的差异.

f1 <- Vectorize(function(x,y) list(setNames(xt1[,x]-xt1[,y],
                                         paste(x,y, sep='_'))))
lst <- outer(colnames(xt1), colnames(xt1), FUN = f1)

我们 Filter 取出具有 sum=0 的 list 个元素，即列 A-A、B-B 和 C-C 之间的差异，和 cbind 以获得预期的输出。

 res <- do.call(cbind,Filter(sum, lst))
 res[,order(colnames(res))]
 #            A_B A_C B_A B_C C_A C_B
 #2010-01-01  -2  -4   2  -2   4   2
 #2010-01-02  -2  -4   2  -2   4   2
 #2010-01-03  -2   1   2   3  -1  -3

数据

 d1 <- data.frame(A=1:3, B=3:5, C=c(5,6,2))
 library(xts)
  xt1 <- xts(d1, order.by=as.Date(c('2010-01-01', '2010-01-02', '2010-01-03')))

Answer 2

我使用以下方法构建数据：

x <- zoo::zoo(
    data.frame(
        A = c(1, 2, 3), 
        B = c(3, 4, 5), 
        C = c(5, 6, 2)), 
    order.by = as.Date(c("2010-01-01", "2010-01-02", "2010-01-03")))

然后我定义了一个函数来创建所有可能的两组对：

cross <- function(x, y = x) {

    result <- list()

    for (a in unique(x)) {

        for (b in unique(y)) {

            result <- append(result, list(list(left = a, right = b)))
        }
    }

    result
}

回答你的问题：

# Build a list of column combinations
combinations <- cross(names(x), setdiff(names(x), names(x)[1]))

# Remove any entries where the left equals the right
combinations <- combinations[vapply(combinations, function(x) { x$left != x$right }, logical(1))]

# Build a user friendly list of names
names(combinations) <- vapply(combinations, function(x) { paste0(x$left, "-", x$right) }, character(1))

# Do the actual computation and combine the results into one object 
do.call(cbind, lapply(combinations, function(x, data) { data[, x$left, drop = T] - data[, x$right, drop = T] }, data = x))

在 xts 对象中将每一列彼此相减

Subtract every column from each other in an xts object

r

xts

数据