r语言 - 将正值分隔为多个列上的多个行

Question

假设我有这样一个数据集:

dat <- tibble(id = 1:4, 
col1 = c(0, 1, 1, 0),
col2 = c(1, 0, 1, 0),
col3 = c(1, 1, 0, 1))
> dat
# A tibble: 4 × 4
id  col1  col2  col3
<int> <dbl> <dbl> <dbl>
1     1     0     1     1
2     2     1     0     1
3     3     1     1     0
4     4     0     0     1

我想分开，对于每个唯一的id，多个1成多行，即预期的输出是:

# A tibble: 7 × 4
id  col1  col2  col3
<dbl> <dbl> <dbl> <dbl>
1     1     0     1     0
2     1     0     0     1
3     2     1     0     0
4     2     0     0     1
5     3     1     0     0
6     3     0     1     0
7     4     0     0     1

对于第一个id (id = 1)， col2和col3都是1，所以我想为它们每个单独的行。这有点像一行的一次性编码。

Answer 1

在Ritchie Sacramento和RobertoT的帮助下

library(tidyverse)
dat <- tibble(id = 1:4, 
col1 = c(0, 1, 1, 0),
col2 = c(1, 0, 1, 0),
col3 = c(1, 1, 0, 1))
dat %>%  
pivot_longer(-id) %>% 
filter(value != 0) %>% 
mutate(rows = 1:nrow(.)) %>% 
pivot_wider(values_fill = 0, 
names_sort = TRUE) %>% 
select(-rows)
# A tibble: 7 × 4
id  col1  col2  col3
<int> <dbl> <dbl> <dbl>
1     1     0     1     0
2     1     0     0     1
3     2     1     0     0
4     2     0     0     1
5     3     1     0     0
6     3     0     1     0
7     4     0     0     1

Answer 2

这是使用model.matrix()的另一种方法:

从文档中:model.matrix创建一个设计(或模型)矩阵，例如，通过将因素扩展为一组虚拟变量(取决于对比)并类似地扩展交互。

library(dplyr)
library(tidyr)
dat %>% 
pivot_longer(-id) %>% 
filter(value == 1) %>% 
cbind((model.matrix(~ name + 0, .) == 1)*1)

id name value namecol1 namecol2 namecol3
1  1 col2     1        0        1        0
2  1 col3     1        0        0        1
3  2 col1     1        1        0        0
4  2 col3     1        0        0        1
5  3 col1     1        1        0        0
6  3 col2     1        0        1        0
7  4 col3     1        0        0        1

Answer 3

你可以做

arrange(bind_rows(lapply(2:4, function(x) {
d <- dat[dat[[x]] == 1,]
d[-c(1, x)] <- 0
d})), id)
#> # A tibble: 7 x 4
#>      id  col1  col2  col3
#>   <int> <dbl> <dbl> <dbl>
#> 1     1     0     1     0
#> 2     1     0     0     1
#> 3     2     1     0     0
#> 4     2     0     0     1
#> 5     3     1     0     0
#> 6     3     0     1     0
#> 7     4     0     0     1

^{由reprex包(v2.0.1)创建于2022-07-14}

Answer 4

使用显式循环:

nullrow <- rep(0, ncol(dat)-1)
data <- dat[,-1]
rowsums <- apply(data, 1, sum)
res <- data[0,]
ids <- c()
for(i in 1:nrow(data)) {
if(rowsums[i]>0) {
for(j in 1:rowsums[i]) {
thisrow <- nullrow
thiscolumn <- which(data[i,]==1)[j]
thisrow[thiscolumn] <- 1
res <- rbind(res, thisrow)
}
ids <- c(ids, rep(dat$id[i], rowsums[i]))
}  
}
names(res) <- colnames(data)
res$id <- ids
> res
col1 col2 col3 id
1    0    1    0  1
2    0    0    1  1
3    1    0    0  2
4    0    0    1  2
5    1    0    0  3
6    0    1    0  3
7    0    0    1  4

Answer 5

一个可能的解决方案，基于purrr:pmap_dfr和以下想法:

1. 遍历所有数据帧行。

2. 使用每一行创建一个对角线矩阵，对角线的内容为数据框行。

3. 过滤掉只有0的行。

library(tidyverse)
pmap_dfr(dat, ~ data.frame(id = ..1, diag(c(...)[-1]))) %>% 
filter(if_any(X1:X3, ~ .x != 0))
#>   id X1 X2 X3
#> 1  1  0  1  0
#> 2  1  0  0  1
#> 3  2  1  0  0
#> 4  2  0  0  1
#> 5  3  1  0  0
#> 6  3  0  1  0
#> 7  4  0  0  1

---

另一种可能的解决方案，基于Matrix::sparseMatrix:

1. 首先，它获取有1的索引(which)。
2. 第二，它调整行索引，每行强制一个1。
第三，它创建一个稀疏矩阵，将1放在调整后的索引指定的地方。

library(tidyverse)
library(Matrix)
which(dat[-1] == 1, arr.ind = T) %>% 
as.data.frame %>% 
arrange(row) %>% 
mutate(id = dat[row,"id"], row = 1:n()) %>% 
{data.frame(id = .$id, as.matrix( sparseMatrix(i = .$row, j= .$col, x= 1)))}
#>   id X1 X2 X3
#> 1  1  0  1  0
#> 2  1  0  0  1
#> 3  2  1  0  0
#> 4  2  0  0  1
#> 5  3  1  0  0
#> 6  3  0  1  0
#> 7  4  0  0  1

---

另一个可能的解决方案:

library(tidyverse)
f <- function(df)
{
got <- 0

for (i in 1:nrow(df))
{
got <- which.max(df[i, (got+1):ncol(df)]) + got
df[i, -got] <- 0
}

df  
}
dat %>% 
slice(map(1:nrow(dat), ~ rep(.x, rowSums(dat[-1])[.x])) %>% unlist) %>% 
group_by(id) %>% 
group_modify(~ f(.)) %>% 
ungroup
#> # A tibble: 7 × 4
#>      id  col1  col2  col3
#>   <int> <dbl> <dbl> <dbl>
#> 1     1     0     1     0
#> 2     1     0     0     1
#> 3     2     1     0     0
#> 4     2     0     0     1
#> 5     3     1     0     0
#> 6     3     0     1     0
#> 7     4     0     0     1