如何正确分割调查回复，以r为单位

Question

在调查统计数据中，当一个问题允许多个回答时，可以在一列中记录多个回答标签。

在分析此类数据时，您可能希望将多个响应存储在单独的列中，这就需要进行字符串分割。

运行以下代码作为示例:

smp <- data.frame(
x = c("1,2,3", "2,5,9", "1,5", "2,7,8,9,10")
)
smp
#>            x
#> 1      1,2,3
#> 2      2,5,9
#> 3        1,5
#> 4 2,7,8,9,10

^{创建于2023-01-21与reprex v2.0.2}

在此数据中，每一行代表不同应答者的回答，分析人员知道总共有多少个选择，但不知道将选择哪个或多少个回答。

对其进行适当除法的结果应该是这样的

out <- data.frame(
d_1 = c(1,NA,1,NA),
d_2 = c(2,2,NA,2),
d_3 = c(3,NA,NA,NA),
d_4 = c(NA,NA,NA,NA),
d_5 = c(NA,5,5,NA),
d_6 = c(NA,NA,NA,NA),
d_7 = c(NA,NA,NA,7),
d_8 = c(NA,NA,NA,8),
d_9 = c(NA,9,NA,9),
d_10 = c(NA,NA,NA,10)
)
out
#>   d_1 d_2 d_3 d_4 d_5 d_6 d_7 d_8 d_9 d_10
#> 1   1   2   3  NA  NA  NA  NA  NA  NA   NA
#> 2  NA   2  NA  NA   5  NA  NA  NA   9   NA
#> 3   1  NA  NA  NA   5  NA  NA  NA  NA   NA
#> 4  NA   2  NA  NA  NA  NA   7   8   9   10

^{创建于2023-01-21与reprex v2.0.2}

是否有一个好的方法来安排数据到这个表格?

Answer 1

可能是一个真值表

smp <- data.frame(
x = c("1,2,3", "2,5,9", "1,5", "2,7,8,9,10")
)
smp_mtx <- matrix(NA, nrow = 4, ncol = 10)
for (i in 1:nrow(smp)) {
smp_mtx[i, which(c(1,2,3,4,5,6,7,8,9,10) %in% as.numeric(unlist(strsplit(smp[i, ], split = ','))) == TRUE)] <- TRUE
}
smp_mtx
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] TRUE TRUE TRUE   NA   NA   NA   NA   NA   NA    NA
[2,]   NA TRUE   NA   NA TRUE   NA   NA   NA TRUE    NA
[3,] TRUE   NA   NA   NA TRUE   NA   NA   NA   NA    NA
[4,]   NA TRUE   NA   NA   NA   NA TRUE TRUE TRUE  TRUE

我在这里的错误是引入了"真值表"，而不是直接针对df

填充char元素。

smp_int_df <- data.frame(matrix(NA_integer_, nrow =4, ncol = 10))
smp_int_df
X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
1 NA NA NA NA NA NA NA NA NA  NA
2 NA NA NA NA NA NA NA NA NA  NA
3 NA NA NA NA NA NA NA NA NA  NA
4 NA NA NA NA NA NA NA NA NA  NA
for (i in 1:nrow(smp_int_df)) {
smp_int_df[i, which(c(1:10) %in% as.numeric(unlist(strsplit(smp[i, ],split=','))))] <- c(1:10)[which(c(1:10) %in% as.numeric(unlist(strsplit(smp[i, ],split=','))))] 
}
smp_int_df
X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
1  1  2  3 NA NA NA NA NA NA  NA
2 NA  2 NA NA  5 NA NA NA  9  NA
3  1 NA NA NA  5 NA NA NA NA  NA
4 NA  2 NA NA NA NA  7  8  9  10

然后你可以给东西(颜色)起你想要的名字

Answer 2

这个并不优雅的函数可以给您预期的结果。

split_survey <- function(data){
df <- data

val <- df %>% 
tidyr::separate_rows(x, sep=",", convert = TRUE) %>% 
range() 

Names <- paste0("d_", seq(val[1], val[2]))
df <- data.frame(do.call(rbind, list(Names)))
names(df) <- df[1,]
df[1:nrow(data), ] <- NA

values <- lapply(strsplit(data$x, ","), function(x) paste0("d_",sub("\s+", "", x)))
for(i in seq_len(nrow(df))){
ind <- names(df) %in%  values[[i]] 
df[i, ind] <- as.integer(sub("\D+", "", values[[i]]))
}

df[] <- lapply(df, as.integer)
return(df)
}

split_survey(smp)
d_1 d_2 d_3 d_4 d_5 d_6 d_7 d_8 d_9 d_10
1   1   2   3  NA  NA  NA  NA  NA  NA   NA
2  NA   2  NA  NA   5  NA  NA  NA   9   NA
3   1  NA  NA  NA   5  NA  NA  NA  NA   NA
4  NA   2  NA  NA  NA  NA   7   8   9   10

如果smp只包含一个名为x的变量，如您的示例，它将工作。

Answer 3

这是tidyverse的解决方案，使用tidyverse族的各种函数:

library(dplyr)
library(readr)
library(tidyr)
smp %>% 
mutate(id = row_number()) %>% 
separate_rows(x) %>% 
type.convert(as.is = TRUE) %>% 
arrange(x) %>% 
complete(x = first(x):last(x)) %>% 
mutate(x = paste0("d_", x)) %>% 
count(id, x) %>% 
pivot_wider(names_from = x, values_from = n) %>%
filter(row_number() <= n()-1) %>% 
mutate(across(-id, ~case_when(. == 1 ~ readr::parse_number(cur_column())))) %>% 
select(order(readr::parse_number(names(.))), -id)

d_1   d_2   d_3   d_4   d_5   d_6   d_7   d_8   d_9  d_10
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1     1     2     3    NA    NA    NA    NA    NA    NA    NA
2    NA     2    NA    NA     5    NA    NA    NA     9    NA
3     1    NA    NA    NA     5    NA    NA    NA    NA    NA
4    NA     2    NA    NA    NA    NA     7     8     9    10

Answer 4

这里是另一种方法，我使用了join

数据

smp <- data.frame(
x = c("1,2,3", "2,5,9", "1,5", "2,7,8,9,10")
)

library(tidyverse)
dummmy <- data.frame(x=1:10) %>% mutate(x=as.character(x))

df <- tibble(x=strsplit(smp$x,',')) %>% mutate(len=row_number(), value=x) %>% 
unnest(c(x,value)) %>% 
full_join(dummmy, by='x') %>% 
mutate(name=paste0('d_',x), x=as.numeric(x), value=as.numeric(value)) %>% 
arrange(x) %>%   
pivot_wider(len, names_from = name, values_from = value) %>% select(-len) %>% 
mutate(sum=rowSums(across(starts_with('d')),na.rm=T)) %>% 
filter(sum>0) %>% select(-sum)

^{创建于2023-01-21与reprex v2.0.2}

输出

# A tibble: 4 × 10
d_1   d_2   d_3   d_4   d_5   d_6   d_7   d_8   d_9  d_10
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1     1     2     3    NA    NA    NA    NA    NA    NA    NA
2     1    NA    NA    NA     5    NA    NA    NA    NA    NA
3    NA     2    NA    NA     5    NA    NA    NA     9    NA
4    NA     2    NA    NA    NA    NA     7     8     9    10