Question

我在一段时间内进行了一系列测量。测量次数通常为4.在任何测量中可以捕获的数字范围是1-5（在现实生活中，给定测试集，范围可以高达100或低至20）。

我想每天计算每个价值在当天之前发生了多少。

让我解释一些样本数据：

# test data creation
d1 = list(as.Date("2013-5-4"),  4,2)
d2 = list(as.Date("2013-5-9"),  2,5)
d3 = list(as.Date("2013-5-16"), 3,2)
d4 = list(as.Date("2013-5-30"), 1,4)

d = rbind(d1,d2,d3,d4)
colnames(d) <- c("Date", "V1", "V2")

tt = as.data.table(d)

我想运行一个可以添加5列的函数（在可能的值范围内每个值可能有1列）。在每个列中，我想要在测试日期之前出现该值的COUNT。

例如，2013-5-30的函数输出为C1=0, C2=3, C3=1, C4=1, C5=1。

它计算了多少次：

1出现在之前，不包括5/30，这是零 2出现之前，不包括5/30，这是三个 3出现在之前，不包括5/30，这是一个等。

此外，它还应包括一列，显示该数字显示的总测量值的百分比。例如在5/30上，在5/30之前有6次测量，所以

pc1 =（0/6），pc2 = 3/6，pc3 = 1/6，pc4 = 1/6，pc5 = 1/6

我想使用data.table赋值表示法（：=）一次性添加这些多列。我正在寻找的输出格式为：

Date V1 V2 C1 PC1 C2 PC2 C3 PC3 C4 PC4 C5 PC5

Answer 1

<强> 1。 data.table

首先用更常见的方法替换问题中t的奇怪构造：

library(data.table)
t <- data.table(
  Date = as.Date(c("2013-5-4", "2013-5-9", "2013-5-16", "2013-5-30")),
  V1 = c(4, 2, 3, 1),
  V2 = c(2, 5, 2, 4)
)

现在每行tabulate并使用cumsum累积前一行。 perm是一个置换向量，用于重新排列C列（nc + 1：n）和PC列（nc + n + 1：n）的列号。

nc <- ncol(t) # 3
n <- t[, max(V1, V2)] # 5

Cnames <- paste0("C", 1:n)
PCnames <- paste0("PC", 1:n)

perm <- c(1:nc, rbind(nc + 1:n, nc + n + 1:n))

t[, (Cnames) := as.list(tabulate(c(V1, V2), n)), by = 1:nrow(t)][, 
 (Cnames):=lapply(.SD, function(x) cumsum(x) - x), .SDcol=Cnames][,
 (PCnames):=lapply(.SD, function(x) x/seq(0,len=.N,by=nc-1)), .SDcols=Cnames][, 
 perm, with = FALSE]

最后一行给出：

         Date V1 V2 C1 PC1 C2 PC2 C3       PC3 C4       PC4 C5       PC5
1: 2013-05-04  4  2  0 NaN  0 NaN  0       NaN  0       NaN  0       NaN
2: 2013-05-09  2  5  0   0  1 0.5  0 0.0000000  1 0.5000000  0 0.0000000
3: 2013-05-16  3  2  0   0  2 0.5  0 0.0000000  1 0.2500000  1 0.2500000
4: 2013-05-30  1  4  0   0  3 0.5  1 0.1666667  1 0.1666667  1 0.1666667

1a.data.table备选

如果可以省略第一个日期的行（由于第一个日期之前没有日期，因此不是很有用），那么我们可以执行以下繁琐但直接的自我加入：

t <- data.table(
  Date = as.Date(c("2013-5-4", "2013-5-9", "2013-5-16", "2013-5-30")),
  V1 = c(4, 2, 3, 1),
  V2 = c(2, 5, 2, 4)
)
tt <- t[, one := 1]
setkey(tt, one)
tt[tt,,allow.cartesian=TRUE][Date > Date.1, list(
    C1 = sum(.SD == 1), PC1 = mean(.SD == 1), 
    C2 = sum(.SD == 2), PC2 = mean(.SD == 2), 
    C3 = sum(.SD == 3), PC3 = mean(.SD == 3), 
    C4 = sum(.SD == 4), PC4 = mean(.SD == 4), 
    C5 = sum(.SD == 5), PC5 = mean(.SD == 5)
), by = list(Date, V1, V2), .SDcols = c("V1.1", "V2.1")]

<强> 1b中。 data.table替代

或者我们可以更紧凑地重写1a（tt，n，Cnames和PCnames来自上方）：

tt[tt,,allow.cartesian=TRUE][Date > Date.1, setNames(as.list(rbind(
   sapply(1:n, function(i, .SD) sum(.SD==i), .SD=.SD),
   sapply(1:n, function(i, .SD) mean(.SD==i), .SD=.SD)
  )), c(rbind(Cnames, PCnames))),
  by = list(Date, V1, V2), .SDcols = c("V1.1", "V2.1")]

<强> 2。 sqldf

data.table的替代方法是将SQL与这种类似的单调但直接的自联接一起使用：

library(sqldf)
sqldf("select a.Date, a.V1, a.V2, 
sum(((b.V1 = 1) + (b.V2 = 1)) * (a.Date > b.Date)) C1,
sum(((b.V1 = 1) + (b.V2 = 1)) * (a.Date > b.Date)) / 
cast (2 * count(*) - 2 as real) PC1,
sum(((b.V1 = 2) + (b.V2 = 2)) * (a.Date > b.Date)) C2,
sum(((b.V1 = 2) + (b.V2 = 2)) * (a.Date > b.Date)) / 
cast (2 * count(*) - 2 as real) PC2,
sum(((b.V1 = 3) + (b.V2 = 3)) * (a.Date > b.Date)) C3,
sum(((b.V1 = 3) + (b.V2 = 3)) * (a.Date > b.Date)) / 
cast (2 * count(*) - 2 as real) PC3,
sum(((b.V1 = 4) + (b.V2 = 4)) * (a.Date > b.Date)) C4,
sum(((b.V1 = 4) + (b.V2 = 4)) * (a.Date > b.Date)) / 
cast (2 * count(*) - 2 as real) PC4,
sum(((b.V1 = 5) + (b.V2 = 5)) * (a.Date > b.Date)) C5,
sum(((b.V1 = 5) + (b.V2 = 5)) * (a.Date > b.Date)) / 
cast (2 * count(*) - 2 as real) PC5
from t a, t b where a.Date >= b.Date
group by a.Date")

<强> 2a上。 sqldf替代

另一种方法是使用字符串操作来创建上面的sql字符串，如下所示：

f <- function(i) {
    s <- fn$identity("sum(((b.V1 = $i) + (b.V2 = $i)) * (a.Date > b.Date))")
    fn$identity("$s C$i,\n $s /\ncast (2 * count(*) - 2 as real) PC$i")
}
s <- fn$identity("select a.Date, a.V1, a.V2, `toString(sapply(1:5, f))`
    from t a, t b where a.Date >= b.Date
    group by a.Date")

sqldf(s)

<强> 2B。第二个sqldf替代

如果我们愿意在没有第一个日期的输出行的情况下，可以大大简化sql解决方案。这可能是有道理的，因为第一个日期没有先前的日期列表：

sqldf("select a.Date, a.V1, a.V2, 
sum((b.V1 = 1) + (b.V2 = 1)) C1,
avg((b.V1 = 1) + (b.V2 = 1)) PC1,
sum((b.V1 = 2) + (b.V2 = 2)) C2,
avg((b.V1 = 2) + (b.V2 = 2)) PC2,
sum((b.V1 = 3) + (b.V2 = 3)) C3,
avg((b.V1 = 3) + (b.V2 = 3)) PC3,
sum((b.V1 = 4) + (b.V2 = 4)) C4,
avg((b.V1 = 4) + (b.V2 = 4)) PC4,
sum((b.V1 = 5) + (b.V2 = 5)) C5,
avg((b.V1 = 5) + (b.V2 = 5)) PC5
from t a, t b where a.Date > b.Date
group by a.Date")

同样可以创建sql字符串以避免重复，方法与先前解决方案中显示的方式相同。

更新：添加了PC列和一些简化

更新2：添加了其他解决方案

Answer 2

这是一个开始。我没有理由“一举一动”这样做。这可能是可能的。试试吧。

library(data.table)
DT = as.data.table(d)

DT[,i:=as.numeric(Date)]
setkey(DT,"i")

uv <- 1:max(unlist(DT[,2:3,with=FALSE]))
DT[,paste0("C",uv):=lapply(uv,function(x) x %in% unlist(.SD)),.SDcols=2:3,by=i]
DT[,paste0("C",uv):=lapply(.SD,function(x) c(NA,head(cumsum(x),-1))),.SDcols=paste0("C",uv)]
DT[,paste0("PC",uv):=lapply(.SD,function(x) x/(2*.I-2)),.SDcols=paste0("C",uv)]

#          Date V1 V2     i C1 C2 C3 C4 C5 PC1 PC2       PC3       PC4       PC5
# 1: 2013-05-04  4  2 15829 NA NA NA NA NA  NA  NA        NA        NA        NA
# 2: 2013-05-09  2  5 15834  0  1  0  1  0   0 0.5 0.0000000 0.5000000 0.0000000
# 3: 2013-05-16  3  2 15841  0  2  0  1  1   0 0.5 0.0000000 0.2500000 0.2500000
# 4: 2013-05-30  1  4 15855  0  3  1  1  1   0 0.5 0.1666667 0.1666667 0.1666667

Answer 3

您可能想要%in%运算符。

> foo<-sample(1:10,4)
> bar<-sample(1:10,3)
> foo
[1] 5 3 9 6
> bar
[1] 1 7 2
> bar2<-sample(1:10,5)
> bar2
[1] 2 9 4 8 5
> which(bar2%in%foo)
[1] 2 5   #those are the indices of the values in bar2 which appear in foo

> which(bar%in%foo)
 integer(0)

R data.table：计算电流测量之前的次数

3 个答案: