我需要通过start-row和end-row标准来识别data.table中的行块。在下面的MWE中，起始行由colA ==＆＃34; d＆＃34;定义，并且该组一直持续到colA ==＆＃34; a＆＃34;
library(data.table)
in.data <- data.table(colA=c("b", "f", "b", "k", "d", "b", "a", "s", "a", "n", "d", "f", "d", "a", "t"))
in.data$wanted.column <- c(NA, NA, NA, NA, 1, 1, 1, NA, NA, NA, 2, 2, 2, 2, NA)
in.data
# colA wanted.column
# 1: b NA
# 2: f NA
# 3: b NA
# 4: k NA
# 5: d 1
# 6: b 1
# 7: a 1
# 8: s NA
# 9: a NA
# 10: n NA
# 11: d 2
# 12: f 2
# 13: d 2
# 14: a 2
# 15: t NA
（如果组外值为NA，零或任何其他可识别结果，则无关紧要）
答案 0 :(得分：5)
答案的原始版本寻找最短的序列，这是不对的，因为它们可以在中间包含起始符号，例如c('d','f','d','a')。已编辑的答案版本修复了此问题
我被告知当两个序列相互跟随时（例如in.data <- data.table(colA=c("b", "f", "b", "k", "d", "b", "a", "d", "f", "d", "a", "t"))），它们被枚举为一个解决方案，这是错误的。在这里，我通过跟踪symbol.stop中colA符号的出现来解决此问题。
<强>设置
library(data.table)
in.data <- data.table(colA=c("b", "f", "b", "k", "d", "b", "a", "s", "a", "n", "d", "f", "d", "a", "t"))
symbol.start='d'
symbol.stop='a'
实际代码
in.data[,y := rev(cumsum(rev(colA)==symbol.stop))][,out:=(!match(symbol.start,colA,nomatch=.N+1)>1:.N),by=y]
in.data$out[in.data$out] <- as.factor(max(in.data$y)-in.data$y[in.data$out])
此处，[,y := rev(cumsum(rev(colA)==symbol.stop))]会创建一个列y，可用于根据背面symbol.stop的出现次数对数据集进行分组。 [,out:=(!match(symbol.start,colA,nomatch=.N+1)>1:.N),by=y]表达式返回一个布尔向量，用于指示行是否属于start.symbol...end.symbol序列。需要下一行来枚举这些序列。
清理并输出
in.data$y <- NULL
in.data
# colA out
# 1: b 0
# 2: f 0
# 3: b 0
# 4: k 0
# 5: d 1
# 6: b 1
# 7: a 1
# 8: s 0
# 9: a 0
# 10: n 0
# 11: d 2
# 12: f 2
# 13: d 2
# 14: a 2
# 15: t 0
以防有人需要，单线解决方案：
in.data[ , y := rev(cumsum(rev(colA)==symbol.stop))
][ , z:=(!match(symbol.start,colA,nomatch=.N+1)>1:.N), by=y
][ z==T, out:=as.numeric(factor(y,levels=unique(y)))
][ , c('z','y'):=list(NULL,NULL)]
答案 1 :(得分：4)
我相信有人会提出一个很好的data.table解决方案。在等待时，这是另一种base可能性：
in.df <- as.data.frame(in.data)
# index of "d", start index
start <- which(in.df$colA == "d")
# index of "a"
idx_a <- which(in.df$colA == "a")
# end index: for each start index, select the first index of "a" which is larger
end <- a[sapply(start, function(x) which.max(x < idx_a))]
# check if runs overlap and create groups of runs
lag_end <- c(0, head(end, -1))
run <- cumsum(start >= lag_end)
df <- data.frame(start, end, run)
# within each run, expand the sequence of idx, from min(start) to max(end)
df2 <- do.call(rbind,
by(df, df$run, function(x){
data.frame(run = x$run, idx = min(x$start):max(x$end))
})
)
# add an empty 'run' variable to in.df
in.df$run <- NA
# assign df2$run at idx in in.data
in.df$run[df2$idx] <- df2$run
# idx colA wanted.column run
# 1 1 b NA NA
# 2 2 f NA NA
# 3 3 b NA NA
# 4 4 k NA NA
# 5 5 d 1 1
# 6 6 b 1 1
# 7 7 a 1 1
# 8 8 s NA NA
# 9 9 a NA NA
# 10 10 n NA NA
# 11 11 d 2 2
# 12 12 f 2 2
# 13 13 d 2 2
# 14 14 a 2 2
# 15 15 t NA NA
答案 2 :(得分：4)
同样，在base-R中，有点讨厌，但迭代次数较少，而且没有。
library(data.table)
in.data <- data.table(colA=c("b", "f", "b", "k", "d", "b", "a", "s", "a", "n", "d", "f", "d", "a", "t"))
in.data$out <- rep(NA,nrow(in.data))
d <- which(in.data$colA=="d")
a <- which(in.data$colA=="a")
end <- rep(NA, length(d))
for (i in seq_along(d)){
begin <- d[i]
if(begin>=max(a)) # this cdn accomodates a case where no "a" appears after some "d"
break
end[i] <- min(a[d[i]<a])
in.data$out[begin: end[i]] <- sum(!is.na(unique(end)))
}
in.data
# colA out
# 1: b NA
# 2: f NA
# 3: b NA
# 4: k NA
# 5: d 1
# 6: b 1
# 7: a 1
# 8: s NA
# 9: a NA
#10: n NA
#11: d 2
#12: f 2
#13: d 2
#14: a 2
#15: t NA
答案 3 :(得分：4)
事实证明这很复杂，但它没有循环或匹配（因此应该很快）：
library(zoo)
in.data[, newcol := (colA=='d') - (colA=='a')
][newcol == 0 & 1:.N > 1, newcol := NA
][, newcol := na.locf(newcol, F)
][newcol < 0, newcol := 0
][, newcol := newcol * cumsum(diff(c(0, newcol)) != 0)
][newcol == 0 & c(NA, head(newcol, -1)), newcol := NA
][, newcol := na.locf(newcol, F)
][newcol != 0, newcol := .GRP, by = newcol][]
# colA wanted.column newcol
# 1: b NA 0
# 2: f NA 0
# 3: b NA 0
# 4: k NA 0
# 5: d 1 1
# 6: b 1 1
# 7: a 1 1
# 8: s NA 0
# 9: a NA 0
#10: n NA 0
#11: d 2 2
#12: f 2 2
#13: d 2 2
#14: a 2 2
#15: t NA 0
每一步都非常简单，如果你一步一步地运行它，应该是不言自明的。
答案 4 :(得分：3)
说实话有点讨厌，但它对我有用：
library(data.table)
in.data <- data.table(colA=c("b", "f", "b", "k", "d", "b", "a", "s", "a", "n", "d", "f", "d", "a", "t"))
in.data$out <- rep(NA,nrow(in.data))
activator <- FALSE
counter <- 1
for (i in 1:nrow(in.data)) {
if (activator == TRUE & in.data$colA[i] !='a') {
in.data$out[i] <- counter
next
}
if( in.data$colA[i]=='d') {
activator <- TRUE
in.data$out[i] <- counter
} else if (in.data$colA[i]=='a' & activator==TRUE ) {
in.data$out[i] <- counter
counter <- counter + 1
activator <- FALSE
} else {next}
}
in.data
输出：
> in.data
colA out
1: b NA
2: f NA
3: b NA
4: k NA
5: d 1
6: b 1
7: a 1
8: s NA
9: a NA
10: n NA
11: d 2
12: f 2
13: d 2
14: a 2
15: t NA
如果您愿意，可以执行sapply，但if语句非常多，for-loop可能更清楚地阅读...
答案 5 :(得分：1)
没有经过严格的测试，但是这里还有另外一个：
require(data.table)
cj_dt = CJ(which(in.data$colA == "d"), which(in.data$colA == "a"))[V1 <= V2]
idx1 = cj_dt[, if (.N > 1) list(V2 = V2[1L]), by=V1]
idx2 = cj_dt[!idx1][, list(V1 = V1[1L]), by=V2]
ans = rbind(idx1, idx2)
# V1 V2
# 1: 5 7
# 2: 11 14
现在我们要做的就是用5:7, 11:14替换wanted.column 1。
有没有人看到这会破坏的情景？