【问题标题】：Set values of tibble cells to one if there are "enclosing" ones in columns如果列中有“封闭”单元格，则将 tibble 单元格的值设置为 1
【发布时间】：2020-01-27 23:34:00
【问题描述】：

我正在编写一份报告，该报告从一些文件中获取数据、制作数据透视表并计算在某个时间段内哪个id 处于“活动状态”。但是，我发现一些源文件存在数据丢失的问题，我需要修复它。

举个例子更容易解释：

所有文件都被导入到一个 tibble 中，如下所示：

df.data %>% head()

### A tibble: 6 x 2
##  ID     REPORT_DATE
##  <chr>  <date>       
##1 9495   2019-08-14   
##2 1678   2019-08-14   
##3 0944   2019-08-14   
##4 6046   2019-08-14   
##5 7758   2019-08-14   
##6 2403   2019-08-14

导入后，我创建了一个如下所示的数据透视表：

df.pivot <- df.data %>% select(ID, REPORT_DATE) %>% 
  mutate(IN_REPORT=1) %>% arrange(ID, REPORT_DATE) %>% 
  spread(REPORT_DATE, IN_REPORT, fill=0) %>% head()

print(df.pivot %>% head)

### A tibble: 6 x 8
##  ID     `2019-08-14` `2019-08-21` `2019-08-28` `2019-09-04` `2019-09-11` `2019-09-18` `2019-09-25`
##  <chr>        <dbl>        <dbl>        <dbl>        <dbl>        <dbl>        <dbl>        <dbl>
##1 8123            1            1            1            1            1            1            1
##2 0236            1            1            1            1            1            1            1
##3 0624            1            1            1            1            1            1            1
##4 1278            1            1            1            1            1            1            1
##5 2870            1            1            1            0            0            0            0
##6 5469            1            1            1            1            1            1            1

列中的值1 表示该ID 是“活着的”，而值0 表示该ID 是“不活跃的”（因为它还没有“出生”或因为它已经“死”了）

如果每个“活着的”ID 都出现在每个报告中，这将非常有用。但是，我发现有些 ID 丢失了，它们看起来像这样：

print(df.pivot %>% 
  filter(ID %in% c('3989', '4188', '9941', '8996')))

### A tibble: 4 x 8
##  ID    `2019-08-14` `2019-08-21` `2019-08-28` `2019-09-04` `2019-09-11` `2019-09-18` `2019-09-25`
##  <chr>        <dbl>        <dbl>        <dbl>        <dbl>        <dbl>        <dbl>        <dbl>
##1 4188             1            1            0            0            1            1            1
##2 9941             1            1            1            0            1            1            1
##3 3989             1            0            0            1            1            1            1
##4 8996             1            1            1            0            0            0            1

我们以 ID 3989 为例：它出现在 2019-08-14 报告中，它缺少以下两个报告，然后在 2019-09-04 以后的报告中重新出现。

具体来说，我需要的是，对于每一行：

检查是否有 1, 0, 1 类型的序列（其中可以有任意数量的零。
将值 1 分配给找到的任何中间零

我已经成功地找到了使用这个问题的 ID（可能不是一个优雅的解决方案，但我认为它有效）：

df.ids_with_issues <- NULL

for(t in 2:(ncol(df.pivot)-1)) {
  df.temp <- df.pivot %>% 
    filter(
      .[t]==1, 
      .[t+1]==0,
      pmap_dbl(.[(t+1):ncol(df.pivot)], max)==1
    ) %>% select(ICCID)
  if(is.null(df.ids_with_issues)) {
    df.ids_with_issues <- df.temp
  } else {
    df.ids_with_issues <- df.ids_with_issues %>% union(df.temp)
  }
}

print(df.ids_with_issues)

### A tibble: 4 x 1
##  ICCID              
##  <chr>              
##1 3989
##2 4188
##3 9941
##4 8996

但是我还没有找到解决方案的第二步如何处理。

你能指点我吗？

我认为可能可行的方法：

将行添加到源 tibble (df.data) 以确保存在与有问题的 ID 对应的记录。
我宁愿不这样做，因为它会强制重新处理输入，虽然现在数据很小，但预计很快就会增长。

【问题讨论】：

标签： r dplyr tidyr tibble

【解决方案1】：

模拟数据

# the data frame
# A tibble: 7 x 8
     ID `2019-08-14` `2019-08-21` `2019-08-28` `2019-09-04` `2019-09-11` `2019-09-18` `2019-09-25`
  <int>        <int>        <int>        <int>        <int>        <int>        <int>        <int>
1  4188            1            1            0            0            1            1            1
2  9941            1            1            1            0            1            1            1
3  3989            1            0            0            1            1            1            1
4  8996            1            1            1            0            0            0            1
5  1234            1            1            1            1            1            1            1
6  2345            1            1            1            1            1            0            0
7  2345            0            0            1            1            1            0            0

定义函数

定义一个 fcutnion 的棘手部分，它将模式 1,...,1（其中... 应该是任意长度的 0）转换为全 1（1,....,1）。

rle 在这种情况下似乎派上用场了。

replace_pattern_101 <- function(vec){
  stopifnot(length(setdiff(vec,c(0L,1L))) == 0L) # vec should only contain 0,1
  # with rle(Run Length Encoding)
  row_rle <- rle(vec)
  row_rle_val <- row_rle$values

  # patterns to find in `rle`, since the original vector has been already converted
  # in rle, so numbe of 0s or 1s doesn't matter now.
  pattern_101 <- c(1L,0L,1L)

  # structure the original vector to a vec which we can used to find the pattern
  # e.g c(1,0,1,0) to list(c(1,0,1),c(0,1,0))
  rolling <- map(
    seq(1:(length(row_rle_val) - length(pattern_101) + 1L)),
    ~ c(row_rle_val[.x:(.x+length(pattern_101)-1L)])
  )

  # find position that follows patter 1,0,1
  match_index <- which(map_lgl(rolling, ~ identical(pattern_101,.x)))

  if(length(match_index) > 0L) {
    row_rle_val[match_index + 1L] <- 1L
    row_rle$values <- row_rle_val
    # inverse rle
    inverse.rle(row_rle)
  } else {
    # otherwise return the original vector
    return(vec)
  }
}

> replace_pattern_101(c(0,0,1,1,0,0,0,1,0,1,0,0))
> [1] 0 0 1 1 1 1 1 1 1 1 0 0

使用 pmap 按数据框中的行进行迭代。

一旦你有一个函数来进行模式替换，剩下的步骤就很简单了。

library(tidyverse)
pmap_df(df,function(...){
  vals <- unlist(list(...))
  num_vals <- as.integer(vals[-1])
  num_vals
  # restructure to a data.frame
  as.list(c(
    vals[1],
    replace_pattern_101(num_vals) %>% setNames(names(vals)[-1])
  ))
})

结果

# A tibble: 7 x 8
     ID `2019-08-14` `2019-08-21` `2019-08-28` `2019-09-04` `2019-09-11` `2019-09-18` `2019-09-25`
  <int>        <int>        <int>        <int>        <int>        <int>        <int>        <int>
1  4188            1            1            1            1            1            1            1
2  9941            1            1            1            1            1            1            1
3  3989            1            1            1            1            1            1            1
4  8996            1            1            1            1            1            1            1
5  1234            1            1            1            1            1            1            1
6  2345            1            1            1            1            1            0            0
7  2345            0            0            1            1            1            0            0

数据

df <- structure(list(ID = c(4188L, 9941L, 3989L, 8996L, 1234L, 2345L, 
2345L), `2019-08-14` = c(1L, 1L, 1L, 1L, 1L, 1L, 0L), `2019-08-21` = c(1L, 
1L, 0L, 1L, 1L, 1L, 0L), `2019-08-28` = c(0L, 1L, 0L, 1L, 1L, 
1L, 1L), `2019-09-04` = c(0L, 0L, 1L, 0L, 1L, 1L, 1L), `2019-09-11` = c(1L, 
1L, 1L, 0L, 1L, 1L, 1L), `2019-09-18` = c(1L, 1L, 1L, 0L, 1L, 
0L, 0L), `2019-09-25` = c(1L, 1L, 1L, 1L, 1L, 0L, 0L)), class = c("spec_tbl_df", 
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -7L))

【讨论】：

谢谢，但它不起作用。当我使用您的示例逐步执行此操作时，match_index 变量采用Empty，因此，length(match_index) 返回零。
找不到匹配项时应该为0。在这种情况下，将返回原始向量。你能粘贴这个函数不起作用的那行数据吗？
我会在我的问题中发布相关的sn-ps...请稍等
我想我找到了问题，模式必须是c(1, 0, 1)，而不是c(1L, 0L, 1L)。我正在测试它
您可以将数据框中的数字列强制转换为整数列吗？因为，尽管值看起来像 1,0，但它们的类型实际上是 double。在某些情况下，1 == 1L 可能是 FALSE。