将 ifelse 语句与 R 中的 shift data.table 函数相结合答案

【问题标题】：Combining an ifelse statement with shift data.table function in R将 ifelse 语句与 R 中的 shift data.table 函数相结合
【发布时间】：2019-02-01 19:27:30
【问题描述】：

我正在尝试研究如何将 ifelse 语句与 data.table 中的 shift 函数结合起来。我的数据如下所示：

DF <- structure(list(CHR = c(1, 1, 1, 1, 1,1), 
SNP = c("rs2494631", "rs4648637", "rs2494627", "rs11122119", "rs1844583","rs2292242"), 
BP = c(2399149, 2401364, 2402499, 6768856, 8383469, 8385059), 
KBdist= c(NA, 2215, 1135, 4366357, 1614613, 1590), 
locus = c(1, NA, NA, NA, NA, NA)), 
.Names = c("CHR","SNP","BP","KBdist","locus"), 
row.names = c(NA, 6L), 
class = "data.frame")

> df

CHR SNP        BP       KBdist   locus
1   rs2494631  2399149  NA       1
1   rs4648637  2401364  2215     NA
1   rs2494627  2402499  1135     NA
1   rs11122119 6768856  4366357  NA
1   rs1844583  8383469  1614613  NA
1   rs2292242  8385059  1590     NA

我想要实现的是： “如果 CHR 等于上一行，并且 KBdist 小于 500,000，则使轨迹等于上一行，否则在上一行的值上加一”。这将产生如下所示的输出：

CHR SNP        BP       KBdist   locus
1   rs2494631  2399149  NA       1
1   rs4648637  2401364  2215     1
1   rs2494627  2402499  1135     1
1   rs11122119 6768856  4366357  2
1   rs1844583  8383469  1614613  3
1   rs2292242  8385059  1590     3

我知道我可以使用 shift 来访问上面一行中的值，例如：

DF<-DF[ , KBdist := BP - shift(BP, 1L, type="lag")]

因为这就是我创建其中一列的方式。但我不明白您如何将其扩展到包括上面的 ifelse 语句条件。

任何帮助将不胜感激。

提前致谢。

【问题讨论】：

你能dput你的样本数据吗？另外，需要明确的是，else add one 意味着在当前值上加一（即NA）？
希望解决评论的两个部分，感谢您指出 re: dput 和 else！
完美。最后一个问题：您是专门寻找使用data.table::shift 的解决方案还是寻找该任务的通用解决方案？
不具体！我只是认为这是一个合乎逻辑的起点，因为它是我在生成其他列时访问上一行的方式。

标签： r if-statement data.table data-manipulation

【解决方案1】：

这是一个解决base R 中任务的解决方案 - data.table 未在此处使用。

# logical vector with our condition tested
ind <- (diff(DF$CHR) == 0 & DF$KBdist[-1] < 5e+5)
# populating the 'locus' column   ---   notice the '<<-'
vapply(2:nrow(DF), function (k) DF$locus[k] <<- DF$locus[k-1] + 1 - ind[k-1], numeric(1)) 
# [1] 1 1 2 3 3
DF
#   CHR        SNP      BP  KBdist locus
# 1   1  rs2494631 2399149      NA     1
# 2   1  rs4648637 2401364    2215     1
# 3   1  rs2494627 2402499    1135     1
# 4   1 rs11122119 6768856 4366357     2
# 5   1  rs1844583 8383469 1614613     3
# 6   1  rs2292242 8385059    1590     3

vapply(...) 返回locus 列并覆盖它。

备注

请注意，我在函数内部使用了<<- 以覆盖DF$locus[k] 值。如果您不喜欢这方面，只需将<<- 替换为<- 并将vapply(...) 替换为DF$locus[-1] <- vapply(...)。

【讨论】：

这是一种享受！我只是在挑选它并处理它正在做的事情，因为我以前没有遇到过函数 (k)。这个超级聪明！谢谢你让我的星期五晚上变得更好:)
@Lynsey 请accept as answer 如果这是解决方案，那么我们对您的问题进行了关闭。

【解决方案2】：

另一种可能是使用cumsum:

setDT(DF)[, locus := cumsum(c(1L, (CHR!=shift(CHR,1L) | KBdist>=500e3)[-1L]))]

输出：

   CHR        SNP      BP  KBdist locus
1:   1  rs2494631 2399149      NA     1
2:   1  rs4648637 2401364    2215     1
3:   1  rs2494627 2402499    1135     1
4:   1 rs11122119 6768856 4366357     2
5:   1  rs1844583 8383469 1614613     3
6:   1  rs2292242 8385059    1590     3

【讨论】：