使用另一列的位置子集数据表中的字符串列

Question

我有一个数据 table，其中包含以下类型的多个列：

   attr1 attr2
1: 01001 01000
2: 11000 10000
3: 00100 00100
4: 01100 01000

DT = setDT(structure(list(attr1 = c("01001", "11000", "00100", "01100"), 
    attr2 = c("01000", "10000", "00100", "01000")), .Names = c("attr1", 
"attr2"), row.names = c(NA, -4L), class = "data.frame"))

所有列都是字符串而不是数字。我想要实现的是：

1) 我想找到“1”在attr1的字符串中出现的位置

2) 在这些位置取attr2的值

我在这种情况下的结果是：

[1] "10" "10" "1"  "10"

作为第一行中的示例，attr1 在位置 2 和 5 中有“1”，我将 attr2 的第一行在位置 2 和 5 中进行子集化，并以“10”结尾。

我想做的是 strsplit 列然后使用它，但我真的希望有更好的方法。

Answer 1

您可以使用基数 R 的 regmatches 来提供不同的字符串进行匹配和替换：

dt[, matches := sapply(regmatches(attr2, gregexpr('1+', attr1)), paste, collapse = '')][]
#>    attr1 attr2 matches
#> 1: 01001 01000      10
#> 2: 11000 10000      10
#> 3: 00100 00100       1
#> 4: 01100 01000      10

数据

dt <- structure(list(attr1 = c("01001", "11000", "00100", "01100"), 
        attr2 = c("01000", "10000", "00100", "01000")), .Names = c("attr1", 
    "attr2"), row.names = c(NA, -4L), class = "data.frame")

setDT(dt)

Answer 2

您可以使用 @alistaire 的 regmatches 答案的变体，因为还有一个替换函数 regmatches<-。因此，不是提取 1 值，而是将 0 值替换为 "":

dt[, matches := `regmatches<-`(attr2, gregexpr("0+", attr1), value="")]

#   attr1 attr2 matches
#1: 01001 01000      10
#2: 11000 10000      10
#3: 00100 00100       1
#4: 01100 01000      10

你的想法strsplit和比较也是可行的：

dt[, matches := mapply(function(x,y) paste(y[x==1],collapse=""), strsplit(attr1,""), strsplit(attr2,""))]

Answer 3

一直在研究这个然后看到@latemail 评论

library(data.table)
DT = setDT(structure(list(attr1 = c("01001", "11000", "00100", "01100"),
    attr2 = c("01000", "10000", "00100", "01000")), .Names = c("attr1",
        "attr2"), row.names = c(NA, -4L), class = "data.frame"))

set.seed(0L)
N <- 1e5
dt <- data.table(attr1=do.call(paste0, data.frame(matrix(sample(0:1, N*5, replace=TRUE), ncol=5))),
    attr2=do.call(paste0, data.frame(matrix(sample(0:1, N*5, replace=TRUE), ncol=5))))

func_woSapply <- function() {
    dt1 <- copy(dt)
    dt1[, matches := `regmatches<-`(attr2, gregexpr("0+", attr1), value="")]
    dt1
}

func_withSapply <- function() {
    dt2 <- copy(dt)
    dt2[, matches := sapply(regmatches(attr2, gregexpr('1+', attr1)), paste, collapse = '')]
    dt2
}

func_useLogical <- function() {
    dt3 <- copy(dt)
    dt3[, matches := {
            d <- lapply(.SD, strsplit, "")
            lapply(mapply(function(x, y) y[as.logical(as.numeric(x))],
                d[["attr1"]], d[["attr2"]], SIMPLIFY=TRUE), paste, collapse="")
        }]
    dt3
}

library(stringi)
func_stringi <- function() {
    dt4 <- copy(dt)
    dt4[, matches := stri_c_list(Map(stri_sub, attr2, stri_locate_all_regex(attr1, '1+')))]
    dt4
}

func_indexing <- function() {
    dt[, mapply(function(x,y) paste(y[x==1],collapse=""), strsplit(attr1,""), strsplit(attr2,""))]
}

library(microbenchmark)
microbenchmark(
    func_woSapply=func_woSapply(),
    func_withSapply=func_withSapply(),
    func_useLogical=func_useLogical(),
    func_stringi=func_stringi(),
    func_indexing=func_indexing(),
    times=10L)

# Unit: milliseconds
#            expr       min        lq      mean    median        uq       max neval
#   func_woSapply 2167.8063 2167.8063 2167.8063 2167.8063 2167.8063 2167.8063     1
# func_withSapply 1693.5539 1693.5539 1693.5539 1693.5539 1693.5539 1693.5539     1
# func_useLogical 1317.5950 1317.5950 1317.5950 1317.5950 1317.5950 1317.5950     1
#    func_stringi  598.3469  598.3469  598.3469  598.3469  598.3469  598.3469     1
#   func_indexing  816.8548  816.8548  816.8548  816.8548  816.8548  816.8548     1

使用另一列的位置子集数据表中的字符串列

Subsetting string column in datatable using positions from another column

r

stringr

data.table