如果列中有 "enclosing" 个，则将 tibble 单元格的值设置为 1

Question

我正在编写一份报告，该报告从一些文件中获取数据，制作一个数据透视表 table 并计算在特定时间段内哪个 id 是 "alive"。但是，我发现了一些源文件丢失数据的问题，我需要修复它。

举个例子更容易解释：

所有文件都导入到一个小标题中，如下所示：

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

导入后，我创建了一个枢轴 table，如下所示：

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 为 "alive"，值 0 表示 ID 为 "not alive"（或者因为它没有 "been born" 或者因为它有 "died")

如果每个 "alive" 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

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

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

检查是否存在 1, 0, 1 类型的序列（其中 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 对应的记录。
我宁愿不这样做，因为它会强制重新处理输入，虽然现在数据很小，但预计很快就会增长。

Answer 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

定义函数

定义将模式 1,...,1（其中 ... 应为任意长度的 0）转换为全 1(1,....,1).[=20= 的函数的棘手部分]

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))

如果列中有 "enclosing" 个，则将 tibble 单元格的值设置为 1

Set values of tibble cells to one if there are "enclosing" ones in columns

r

dplyr

tidyr

tibble

模拟数据

定义函数

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

结果

数据