在 xts 对象中相互减去每一列

Question

我是一个学习编码的新手，并且有一个 1000 行和 10 列的 xts 对象。我需要从彼此中减去每一列，创建一个新的 xts 对象来保留日期列。我尝试使用combn，但由于它做了A-B，所以无法让它创建B-A结果。我正在寻找的内容如下。

 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))