Установите значения ячеек тиббла в единицу, если в столбцах есть «вложенные» - PullRequest
Новая
       72

Установите значения ячеек тиббла в единицу, если в столбцах есть «вложенные»

0 голосов
/ 27 сентября 2019

Я работаю над отчетом, который берет данные из некоторых файлов, создает сводную таблицу и вычисляет, какой id является "живым" в определенный период.Однако я обнаружил проблему с отсутствующими данными в некоторых исходных файлах, и мне нужно ее исправить.

Это проще объяснить на примере:

Все файлы импортированы водин тиббл, который выглядит следующим образом: 

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 в столбце означает, чтоидентификатор «жив», а значение 0 подразумевает, что идентификатор «не жив» (либо потому, что он «не родился», либо потому, что он «умер»)

Это будетработать как заклинание, если каждый «живой» 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

Давайте возьмем идентификатор 3989, например: он присутствует в отчете 2019-08-14, в нем отсутствуют следующие дваотчеты, а затем он появляется в отчетах с 2019-09-04 и далее.

Что мне нужно, в частности, для каждой строки:

  1. Проверьте, есть ли последовательности типа1, 0, 1 (где может быть любое количество нулей между единицами.
  2. Присвойте значение 1 любым найденным промежуточным нулям

Я успешно нашел идентификаторы с проблемамииспользуя это (возможно, не элегантное решение, но я думаю, что оно работает): 

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

Но я не нашел, как справиться со вторым шагом решения.

Можете ли вы указать мне

То, что я думал, могло бы работать:

  • Добавить строки в исходную таблицу (df.data), чтобы убедиться, что есть записи, соответствующиеидентификаторы с проблемами.
    Я бы предпочел не делать этого, потому что это было бы дляМы перерабатываем входные данные, и хотя сейчас данные небольшие, ожидается, что они скоро вырастут.

1 Ответ

1 голос
/ 27 сентября 2019

Имитация данных 

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