Question

我想知道我是否可以使用data.table有效地执行此操作。我有一个数据集，包含不同的样本，不同的时期（日期）和不同的组（id）。

    #the data
    require(data.table)
    dt <- data.table(id=c(rep(1,50),rep(2,50),rep(1,50),rep(2,50)),date=c(rep("2004-01-01",100),rep("2004-02-01",100)),A=c(rnorm(50,1,3),rnorm(50,2,3),rnorm(50,1,4),rnorm(50,1.5,3)),
             B=c(rnorm(50,1.3,2.9),rnorm(50,1.8,3.1),rnorm(50,1.6,4),rnorm(50,1.7,2.4)))

我想应用以下功能。

    #the function which should be applied
    function(a, ie1, b, a1, ie2, b2, ...) {
    ipf <- function(a, b, ...) {
    m <- length(a)
    n <- length(b)
    if (m < n) {
        r <- rank(c(a, b), ...)[1:m] - 1:m
    } else {
        r <- rank(c(a, b), ...)[(m + 1):(m + n)] - 1:n
    }
    s <- ifelse((n + m)^2 > 2^31, sum(as.double(r)), sum(r))/(as.double(m) * n)
    return(ifelse(m < n, s, 1 - s))
}

expand.grid.alt <- function(seq1, seq2) {
    cbind(rep.int(seq1, length(seq2)), c(t(matrix(rep.int(seq2, length(seq1)), nrow = length(seq2)))))
}

if (missing(a1) | missing(b2) | missing(ie2)) {
    if (ie1 == ">") {
        return(ipf(a, b))
    } else {
        return(ipf(b, a))
    }
} else {
    if (ie1 == ">") {
        if (ie2 == ">") {
            return(ipf(a, apply(expand.grid.alt(b, b2), 1, max))/ipf(a1, b2))
        } else {
            return(1 - ipf(apply(expand.grid.alt(b, b2), 1, min), a)/(1 - ipf(a1, b2)))
        }
    } else {
        if (ie2 == ">") {
            return(1 - ipf(a, apply(expand.grid.alt(b, b2), 1, max))/ipf(a1, b2))
        } else {
            return(ipf(apply(expand.grid.alt(b, b2), 1, min), a)/(1 - ipf(a1, b2)))
        }
    }
}

}

此功能可比较不同的样本;鉴于我们有三个样品A，B，C，它允许例如如果样品A的抽取大于样品C的抽取，则计算样品A的抽取大于样品抽取的概率。我想使用data.tables以某种方式应用此函数。以下示例应说明您要执行的操作：

    #example - what I want to do
    dt1 <-  dt[date=="2004-01-01"]
    ow <-   dt1[id==1,A]
    ot <-   dt1[id!=1,A]
    cs  <-  dt1[,B]
    ex <- expand.grid(unique(ow),unique(ot),unique(cs))
    names(ex) <- c("ow","ot","cs")
    sum(ex$ow > ex$ot & ex$ow > ex$cs)/sum(ex$ow > ex$ot)

    #check if the result is correct
    all.equal(prob(ow,">",cs,ow,">",ot),sum(ex$ow > ex$ot & ex$ow > ex$cs)/sum(ex$ow > ex$ot))
    [1] TRUE

我希望使用data.table为所有ID和所有日期自动化上述过程。在单词中：我想计算id = 1的变量A的绘制大于变量B的绘制的概率，假设来自id = 1的变量A的绘制大于来自id！= 1的变量的绘制（使用expand.grid意味着查看所有可能组合的强力方法，上面的prob（）函数使用更优雅的秩和方法。）

这意味着我需要子集中的某种子集。直觉上我玩过类似的东西：

    dt[,.SD[,prob(A,">",B,A,">",.SD[!.BY,A]),key=id],key=date]

然而，这种方法会导致错误消息。谁能帮我解决这个问题？任何评论都非常感谢！

Answer 1

重要：在上面的示例中，请注意您要回收A值以匹配B值的长度。目前尚不清楚这是否是你实际想要的，如果答案是错误的，或者答案是否正确，但更多是由于对称而不是实际方法。您可能想要仔细检查您的示例。与此同时，这将以有效的方式完成您的工作

## USING CJ
setkey(dt, id)
dt[, {
      .SD1 <- .SD;
      .SD1[, {.B <- unlist(.BY);
              CJ( ow=.SD1[.(.B)][["A"]], 
                  ot=.SD1[!.(.B)][["A"]], 
                  cs=.SD1[["B"]]
                )[
                  , sum(ow>ot & ow>cs) / sum(ow > ot)] 
             }
    , by=id ]
    }
  , by=date
  ]

## USING PROB
setkey(dt, id)
dt[, {
      .SD1 <- .SD;
      .SD1[, {.B <- unlist(.BY);
              ow <- .SD1[.(.B)][["A"]] 
              ot <- .SD1[!.(.B)][["A"]]
              cs <- .SD1[["B"]]
              prob(ow,">",cs,ow,">",ot)
             }
    , by=id ]
    }
  , by=date
  ]

基准：

你是对的，概率函数更快（顺便说一句，不是太多）。

usingProb <- quote(dt[, {.SD1 <- .SD;.SD1[, {.B <- unlist(.BY);ow <- .SD1[.(.B)][["A"]] ;ot <- .SD1[!.(.B)][["A"]];cs <- .SD1[["B"]];prob(ow,">",cs,ow,">",ot)}, by=id ]}, by=date  ])
usingCJ <- quote(dt[, {.SD1 <- .SD;.SD1[, {.B <- unlist(.BY);CJ( ow=.SD1[.(.B)][["A"]], ot=.SD1[!.(.B)][["A"]], cs=.SD1[["B"]])[, sum(ow>ot & ow>cs) / sum(ow > ot)] }, by=id ]}, by=date])

eval(usingProb)
eval(usingCJ)
all.equal(eval(usingProb), eval(usingCJ))

library(microbenchmark)
microbenchmark(PROB=eval(usingProb), CJ=eval(usingCJ), times=20L)

Unit: milliseconds
 expr      min       lq   median       uq      max neval
 PROB 50.59504 53.62986 62.78143 80.64911 106.2133    20
   CJ 67.63520 69.59654 74.56110 79.45636 136.6357    20

子集内的子集

1 个答案:

基准：