R将行值与多列中的列名匹配并获取列值

R match rowwise values with column names in multiple columns and get column value

我需要按行匹配一列中的字符值与多个列的名称,这些列的名称不完全匹配但部分包含这些字符,并在新列中从字符串匹配的列中获取相应的值。我的数据:

Name_A Name_B Name_C Name_D PartName
5.1    3.5    1.4    0.2    A
4.9    3.0    1.4    0.2    A
4.7    3.2    1.3    0.2    C
4.6    3.1    1.5    0.2    D
5.0    3.6    1.4    0.2    B
5.4    3.9    1.7    0.4    C

期望的输出:

Name_A Name_B Name_C Name_D PartName New_Col
5.1    3.5    1.4    0.2    A        5.1
4.9    3.0    1.4    0.2    A        4.9
4.7    3.2    1.3    0.2    C        1.3
4.6    3.1    1.5    0.2    D        0.2
5.0    3.6    1.4    0.2    B        3.6
5.4    3.9    1.7    0.4    C        1.7

尝试的代码:

df %>%
  mutate(New_Col = purrr::map2_dbl(row_number(),~df[Name_A,Name_B,Name_C, Name_D]))

感谢帮助!

match 去掉Name_前缀的部分名称到全名,然后使用矩阵索引(2列矩阵中的行+列索引)获取每一行的对应值):

df$new_col <- df[-ncol(df)][cbind(
  seq_len(nrow(df)),
  match(df$PartName, sub("^Name_", "", names(df)[-ncol(df)]))
)]

df
#  Name_A Name_B Name_C Name_D PartName new_col
#1    5.1    3.5    1.4    0.2        A     5.1
#2    4.9    3.0    1.4    0.2        A     4.9
#3    4.7    3.2    1.3    0.2        C     1.3
#4    4.6    3.1    1.5    0.2        D     0.2
#5    5.0    3.6    1.4    0.2        B     3.6
#6    5.4    3.9    1.7    0.4        C     1.7

Base R 中的另一个选项是 split-unsplit:

data$New_Col <- unsplit(Map(`[`, 
                            data[paste0("Name_", LETTERS[1:4])],
                            split(seq_len(nrow(data)), data$PartName)),
                        data$PartName)

它比使用 cbind(i, j) 形式的矩阵索引数据框更好。由于数据帧到矩阵的中间强制转换,后一种方法具有显着的开销,这涉及所有变量的深层复制。

如果你选择 split-unsplit,那么确保 PartName 是一个适合 levels 的因子,因为你需要第二个和第三个参数Map 的元素对应。在这种情况下,最好从以下内容开始:

data$PartName <- factor(data$PartName, levels = LETTERS[1:4])

好奇者:

set.seed(1L)
n <- 1e+06L
r <- 25L
x <- as.data.frame(replicate(r, rnorm(n), simplify = FALSE))
names(x) <- paste0("Name_", LETTERS[1:r])
x$PartName <- LETTERS[1:r][sample.int(r, n, TRUE)]

library("data.table")
setDTthreads(4L)
y <- as.data.table(x)

f1 <- function(x) {
    n <- length(x)
    i <- seq_len(nrow(x))
    j <- match(x$PartName, sub("^Name_", "", names(x)[-n]))
    x[-n][cbind(i, j)]
}
f2 <- function(x) {
    nms <- names(x)[-length(x)]
    g <- factor(x$PartName, levels = sub("^Name_", "", nms))
    unsplit(Map(`[`, x[nms], split(seq_len(nrow(x)), g)), g)
}
f3 <- function(x) {
    x[, New_Col := .SD[[paste0("Name_", .BY[[1L]])]], by = PartName]
}

bench::mark(f1(x), f2(x), f3(y), iterations = 100L, check = FALSE, filter_gc = FALSE)
## # A tibble: 3 × 13
##   expression      min  median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory     time       gc      
##   <bch:expr> <bch:tm> <bch:t>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>     <list>     <list>  
## 1 f1(x)        86.1ms  92.3ms      10.9   225.1MB    6.95    100    64      9.21s <NULL> <Rprofmem> <bench_tm> <tibble>
## 2 f2(x)        43.4ms  45.8ms      21.2    61.1MB    3.60    100    17      4.73s <NULL> <Rprofmem> <bench_tm> <tibble>
## 3 f3(y)        77.9ms  79.7ms      12.4    21.1MB    0.247   100     2      8.08s <NULL> <Rprofmem> <bench_tm> <tibble>