如何提取行特征，将各行相乘并添加单个特征作为列？

Question

我有一个看起来像这样的数据集：

  id      col1    col2  col3  col4
1  1    12 ABC   Henry  Alex 13 AB
2  2       123      12 David   344
3  3      John     567  Luke  Huh8
4  4 123344567 abc 123  Paul    98
5  5  1345677.     Sam  17df   Tom
    

目标：对于每一行，我想获取不包含数值的每个单元格，并根据该行的现有值创建新列：

   Name      col1    col2 col3  col4
1 Henry    12 ABC    <NA> <NA> 13 AB
2  Alex    12 ABC    <NA> <NA> 13 AB
3 David       123      12 <NA>   344
4  John      <NA>     567 <NA>  Huh8
5  Luke      <NA>     567 <NA>  Huh8
6  Paul 123344567 abc 123 <NA>    98
7   Sam   1345677    <NA> 17df  <NA>
8   Tom   1345677    <NA> 17df  <NA>

基于这个问题的性质，我认为可以使用以下两个概念：

• 判断一列是否包含数值，可以使用如下代码：grepl("\\d", my_data$col1)

• 我认为某种形式的“pivot_wider”和“pivot_longer”可能适用，但我不确定具体如何执行此操作。

有人可以告诉我该怎么做吗？

数据

my_data <- structure(list(id = 1:5, col1 = c("12 ABC", "123", "John", "123344567", 
"1345677."), col2 = c("Henry", "12", "567", "abc 123", "Sam"), 
    col3 = c("Alex", "David", "Luke", "Paul", "17df"), col4 = c("13 AB", 
    "344", "Huh8", "98", "Tom")), class = "data.frame", row.names = c(NA, 
-5L))

Answer 1

使用apply中的grepl制作布尔矩阵bo。然后在Mapcbindwhich和replace与NA标识的名称。

bo <- apply(my_data, 1:2, (x) !grepl('\d', x))

Map((x, y, z) {
  lapply(y, (i) cbind(Name=my_data[x, i], replace(my_data[x, ], y, NA))) |>
    do.call(what=rbind)
}, 
seq_len(nrow(my_data)), 
apply(bo, 1, which)) |>
  c(make.row.names=FALSE) |>
  do.call(what=rbind)
#    Name id      col1    col2 col3  col4
# 1 Henry  1    12 ABC    <NA> <NA> 13 AB
# 2  Alex  1    12 ABC    <NA> <NA> 13 AB
# 3 David  2       123      12 <NA>   344
# 4  John  3      <NA>     567 <NA>  Huh8
# 5  Luke  3      <NA>     567 <NA>  Huh8
# 6  Paul  4 123344567 abc 123 <NA>    98
# 7   Sam  5  1345677.    <NA> 17df  <NA>
# 8   Tom  5  1345677.    <NA> 17df  <NA>

Answer 2

这很混乱，我认为必须有更简单的方法，但你可以试试

library(tidyverse)
Name <- unlist(t(my_data), use.names = F)[!grepl("\d", unlist(t(my_data)))]
key <- unname(sapply(Name, function(x) {c(1:nrow(my_data))[apply(my_data, 1, function(y) any(y %in% x))]}))
cbind(Name, my_data[key,]) %>%
  mutate(across(-Name, ~ifelse(grepl("\d", .), ., NA))) %>%
  select(-id) %>%
  `rownames<-`(1:length(key))

   Name      col1    col2 col3  col4
1 Henry    12 ABC    <NA> <NA> 13 AB
2  Alex    12 ABC    <NA> <NA> 13 AB
3 David       123      12 <NA>   344
4  John      <NA>     567 <NA>  Huh8
5  Luke      <NA>     567 <NA>  Huh8
6  Paul 123344567 abc 123 <NA>    98
7   Sam  1345677.    <NA> 17df  <NA>
8   Tom  1345677.    <NA> 17df  <NA>

Answer 3

有点低效，但更容易理解，

new_data <- cbind(Names="", my_data)
new_data <- new_data[0,]

for (row in 1:nrow(my_data)) {
    temp_row <- my_data[row,]
    names <- vector()
    for (val in 1:ncol(temp)) {
        if (!grepl("\d", temp_row[val])) {
            names <- append(temp_row[val], names)
            temp_row[val] <- NA
        }
    }
    for (name in 1:length(names)) {
        new_data[nrow(new_data)+1,] <- temp_row
        new_data[nrow(new_data),]["Names"] <- names[name]
    }
}