Tidyr: Ferramentas de patch de conjunto de dados

Eu gosto da ideia, mas essa forma de patch parece um pouco frágil para mim - se a ordem das linhas mudar, você silenciosamente corrigirá os valores errados. Acho que seria melhor fornecer o valor de algumas chaves:

mtcars2 <- tibble::rownames_to_column(mtcars, "model")

patches <- frame_data(
  ~ model, ~ column, ~value, ~comment,
  "Mazda RX4", "mpg", 20, "Bad copy & paste"
)

mtcars %>% patch(patches)

Isso exigiria as funções de verificação de chave ainda não implementadas do dplyr para garantir que houvesse uma correspondência exclusiva para cada chave.

@jennybc , você já pensou sobre isso?

Eu só pensei nisso até ... concordar que seria realmente útil ter ferramentas melhores para patching!

Tenho fluxos de trabalho realmente estranhos para isso e parece bom pensar nisso como uma junção de novidade, que é como interpreto seu comentário.

Eu estava planejando mergulhar no novo dplyr::case_when() na próxima vez que isso surgisse. Mas relembrar esse problema (https://github.com/hadley/dplyr/issues/631) e ler o arquivo de ajuda me faz pensar que case_when() realmente não o resolve? Acabei de lembrar que o patching apareceu explicitamente ali .

Por que isso iria em tidyr vs dplyr ?

Hmmm, interessante - que patch() parece mais um "mutate_when", no qual não sou muito fã. Este patch() parece mais com o tipo de coisa que você deseja criar (manualmente ou com um suplemento) quando você descobre alguns valores incorretos em sua entrada.

O que quero dizer com "junção de novidade:" como junção à esquerda, mas em vez de obter mpg.x , mpg.y , wt.x e wt.y , obtemos apenas mpg e wt no resultado, com os valores em patches tendo precedência. As propostas são muito diferentes em termos de como corrigir mais de uma variável.

library(dplyr)
(mtcars2 <- tibble::rownames_to_column(mtcars, "model") %>%
  head(3) %>% select(model, mpg, cyl, hp, drat, wt))
#>           model  mpg cyl  hp drat    wt
#> 1     Mazda RX4 21.0   6 110 3.90 2.620
#> 2 Mazda RX4 Wag 21.0   6 110 3.90 2.875
#> 3    Datsun 710 22.8   4  93 3.85 2.320

patches <- frame_data(
      ~ model, ~ mpg, ~ wt,
  "Mazda RX4",   500,  200
)

## fiction!
mtcars2 %>%
  patch(patches, by = "model")
#>           model   mpg cyl  hp drat    wt
#> 1     Mazda RX4 500.0   6 110 3.90 200.0
#> 2 Mazda RX4 Wag  21.0   6 110 3.90 2.875
#> 3    Datsun 710  22.8   4  93 3.85 2.320

_BTW, supondo que eu entenda o que você quer dizer com "mutate_when", acho que um desses acabou de surgir no SO ._

@jennybc sim, isso é o que eu estava imaginando também - exceto que não tenho certeza se você deseja corrigir variáveis ​​individuais ou linhas inteiras. Em seu cenário, acho que você usaria NA em patches para indicar que não deseja substituir o valor. Posso imaginar o patch de células ou linhas para ser útil em diferentes cenários. Seria fácil converter entre os dois formulários com reunir / espalhar, então não importaria muito qual era o principal.

Gravando um link para uma discussão relacionada no Twitter . Acho que é outro exemplo do tipo de problema resolvido pelo patching discutido aqui: "juntar e atualizar colunas, em vez de duplicá-las". É um exemplo em que é natural atualizar várias variáveis ​​de uma vez.

Em #Rstats, como mesclar DFs (X, Y) com colunas de Y substituindo (sobrescrevendo) aquelas com o mesmo nome em X?
X tem 10 cols AJ. Y tem 3 cols F, G, H. Quer cols de Y para substituir cols em X que têm o mesmo nome; mantenha outras colunas de X.
A mesclagem padrão me dará novas colunas Fy, Gy e Hy

Hmm, estou tendo que corrigir muitos em meu projeto atual que é uma combinação de um processo ETL e entrada manual de dados para variáveis ​​que meu pipeline de ETL não captura. São patches no topo dos patches.

Aqui está minha melhor e mais recente função de patch. patch_fun controla o comportamento do patch. O padrão é a função coalesce . Uma função personalizada pode ser adicionada para outros casos de uso, vida se, por exemplo, você deseja apenas corrigir NA 's. As colunas para corrigir podem ser especificadas em ... , caso contrário, o patch corrige todas as colunas comuns a data e patch_data menos as colunas listadas em by . by não pode ser nulo. A correção do patch é verificada em alguns lugares. Um patch deve ser injetado nos dados que estão sendo corrigidos (ou seja, uma relação um-para-um). Normalmente, tenho que agrupar e resumos para colocar meus patches do mundo real em um relacionamento um a um.

O exemplo

require(dplyr)
require(lazyeval)

patch <- function(data, patch_data, ..., by = NULL, na_only=FALSE, patch_fun=coalesce) {
  patch_cols <- unname(dplyr::select_vars(colnames(data), ...))
  if(length(patch_cols) == 0) patch_cols <- NULL
  patch_(data, patch_data, patch_cols, by, na_only, patch_fun)
}

patch_ <- function(data, patch_data, patch_cols = NULL, by = NULL, na_only=FALSE, patch_fun=coalesce) {
  if(is.null(by)) {
    error("`by` must be specified")
  }

  # Find common cols
  common_cols  <- intersect(colnames(data), colnames(patch_data))

  if(is.null(patch_cols)) {
    patch_cols <- common_cols %>% setdiff(by)
    # TODO fire off a warning 
  }

  # No missing columns 
  missing_cols <- setdiff(c(patch_cols, by), common_cols) 
  if( length(missing_cols) > 0 ) {
    stop("Can not apply patch, columns ", paste(missing_cols, sep=", "),
         "must be in both the original data and the patch")
  }

  # No columns being patched, warn and return data as-is
  if( length(patch_cols) == 0 ) {
      warning("No rows in y to patch onto x")
      return(data)
  }

  # Can not join by a patching column
  if( length(intersect(by, patch_cols)) != 0 ) {
    stop("Cannot patch a joining column")
  }

  # Builds each term of transmute expressions for colname of x
  build_expr <- function(colname) {
    if(colname %in% patch_cols) {
      # coalesce the two columns together x = coalesce(y, x)
      interp(~patch_fun(colname_y, colname), 
             colname   = as.name(paste(colname, "x", sep=".")),
             colname_y = as.name(paste(colname, "y",sep="."))
      )
    } else {
      # identity x = x 
      interp( ~colname, colname=as.name(colname) ) 
    }
  }

  expr <- Map(build_expr, colnames(data)) 

  # number of rows produced by join should be unchanged,
  # keep only needed columns and use only distinct rows

  joined <- left_join(
    data,
    patch_data %>% select(one_of(union(patch_cols, by))) %>% distinct,
    by=by
  )

  if( nrow(data) != nrow(joined)) {
    stop("patch cannot be many-to-one with respect to data")
  }

  joined %>% transmute_(.dots=expr)
}

Apenas uma nota para dizer que upsert() parece ser o nome certo para um desses comportamentos.

Eu comecei a usar esse tipo de update_join ao agregar dados para um pacote (chegando ao GitHub assim que alguns bugs são eliminados). É basicamente uma junção à esquerda ou completa e, em seguida, coalesce ing as colunas duplicadas, mas surge um problema relacionado:

Tenho colunas de chave redundantes, mas estão incompletas. Tentar atualizar colunas-chave com NA s antes de tentar juntar tudo requer eliminar casos com NA s de uma das tabelas de antemão para evitar uma junção cruzada de NA s. Tudo bem, mas sugere a possibilidade de atualizar as chaves: se uma for NA , use a outra para unir e atualizar, combinando as chaves por | vez de & .

Isso pode se encaixar com join_by , talvez como uma função auxiliar funcionando como nesting dentro de expand ou complete , por exemplo, o que atualmente levaria algo como

library(tidyverse)
set.seed(47)

df1 <- data_frame(key1a = c(1, 1, NA, NA, 3, 3),
                  key1b = c('a', 'a', 'b', 'b', NA, NA),
                  key2 = c(1:2, 1:2, 1:2),
                  var1 = rnorm(6))

df2 <- data_frame(key1a = c(1, 1, 2, 2, 3, 3),
                  key1b = c(NA, NA, 'b', 'b', 'c', 'c'),
                  key2 = c(1:2, 1:2, 1:2),
                  var2 = runif(6))

df1 %>% drop_na(key1a) %>% 
    full_join(df2, by = c('key1a', 'key2')) %>% 
    mutate(key1b = coalesce(key1b.x, key1b.y)) %>% 
    select(-var1, -contains('.')) %>% 
    left_join(df1, by = c('key1a', 'key2')) %>% 
    mutate(key1b = key1b.x) %>% 
    left_join(df1, by = c('key1b', 'key2')) %>% 
    mutate(key1a = key1a.x, 
           var1 = coalesce(var1.x, var1.y)) %>% 
    select(!!!rlang::syms(union(names(df1), names(df2))))

#> # A tibble: 6 × 5
#>   key1a key1b  key2       var1       var2
#>   <dbl> <chr> <int>      <dbl>      <dbl>
#> 1     1     a     1  1.9946963 0.16219364
#> 2     1     a     2  0.7111425 0.59930702
#> 3     3     c     1  0.1087755 0.40050280
#> 4     3     c     2 -1.0857375 0.03094497
#> 5     2     b     1  0.1854053 0.50603611
#> 6     2     b     2 -0.2817650 0.90197352

ou pode ser escrito com junções de atualização como algo como

df1 <- df1 %>% 
    update_join(df2, by = c('key1b', 'key2')) %>% 
    update_join(df2, by = c('key1a', 'key2'))
df2 <- df2 %>% 
    update_join(df1, by = c('key1b', 'key2')) %>% 
    update_join(df1, by = c('key1a', 'key2'))

left_join(df1, df2, by = c('key1a', 'key1b', 'key2'))

poderia ser apenas

left_join(df1, df2 by = join_by(updating(key1a, key1b), key2))

Em essência, então, é apenas uma série de junções de atualização cruzadas em colunas-chave antes da junção final e, portanto, não deve exigir muito mais código.

Resumindo a discussão, acho que há pelo menos casos de patch descritos aqui:

• Corrija valores individuais descritos por um local (variáveis-chave + nome da variável a ser corrigida), o novo valor e um comentário.

• Combine dois quadros de dados onde y contém algumas das mesmas variáveis ​​de x . Combine as variáveis-chave, então sempre assume os valores de y , ou apenas os assume se x for NA .

• Combine dois quadros de dados com variáveis ​​idênticas. Substitua as linhas correspondentes em x por y e também adicione novas linhas. Isso se parece mais com upsert() .

Eu me pergunto se eles poderiam ser chamados de patch_val() , patch_col() e patch_row() .

Não tenho certeza se apenas a substituição de valores ausentes é uma característica central ou um detalhe incidental.

Eu tenho um caso de uso que é o seu segundo caso de patch ("Combine dois quadros de dados onde y contém algumas das mesmas variáveis ​​que x . Combine as variáveis-chave, então qualquer um sempre obtém os valores de y , ou apenas pegue-os se x for NA . ") E for uma variante disso. (Da conversa iniciada no problema dplyr que acabamos de criar um link.)

O que você descreveu como patch_col() generaliza ainda mais como, "Se houver valores ausentes em column_1, substitua-os pelos valores em column_2." E mais ainda, permita um número arbitrário de colunas e grupos de colunas. Meu caso de uso para essa generalização é que eu faço meta-análises e, quando as faço, geralmente tenho várias colunas que representam o número potencial de medições em uma observação. geralmente eu trabalho com estudos clínicos, então o N é o número de indivíduos em um ensaio clínico, os vários NI podem ter disponíveis, incluindo do mais ao menos preferido:

• número de assuntos que contribuem para uma média observada
• número de indivíduos no braço de tratamento atual do estudo
• número de indivíduos no estudo dividido pelo número de braços de tratamento

O que você acha do seguinte como uma implementação:

#' Patch missing values in a set of columns to fill in the first column.
#'
#' <strong i="18">@param</strong> data A data frame.
#' <strong i="19">@param</strong> ... Column names (as used by
#'   \code{\link[tidyselect]{vars_select}}).  These cannot be paired
#'   with the \code{suffix} argument.
#' <strong i="20">@param</strong> remove If \code{TRUE}, remove all columns but the first from
#'   the output data frame.
#' <strong i="21">@param</strong> na Values which should be replaced.
#' <strong i="22">@param</strong> suffix A character vector of column name suffixes to combine.
#'   (Useful if a \code{merge} or \code{join} generated the data frame
#'   and multiple pairs of columns share the suffix).
#' <strong i="23">@return</strong> The data frame with values merged into the first requested
#'   column.
#' <strong i="24">@importFrom</strong> tidyselect vars_select
#' <strong i="25">@export</strong>
patch_col <- function(data, ..., remove=TRUE, na=NA, suffix=c()) {
  vars <- tidyselect::vars_select(names(data), ..., .strict=TRUE)
  if (length(vars) > 0 & length(suffix) > 0) {
    stop("Cannot use ... and suffix at the same time.")
  }
  if (length(suffix) > 0) {
    patch_col_suffix(data=data, remove=remove, na=na, suffix=suffix)
  } else {
    patch_col_set(data=data, remove=remove, na=na, vars=vars)
  }
}

patch_col_set <- function(data, vars=c(), remove=TRUE, na=NA, newname=vars[1]) {
  if (length(vars) < 2) {
    stop("At least two columns must be provided to merge")
  }
  # Apply appropriate coercion tests here; for now, errors occur on
  # attempted patching if not possible.
  missing_val <- data[[vars[[1]]]] %in% na
  data[[newname]] <- data[[vars[[1]]]]
  idx <- 2
  while (any(missing_val) & idx <= length(vars)) {
    data[[newname]][missing_val] <- data[[vars[[idx]]]][missing_val]
    idx <- idx + 1
    missing_val <- data[[newname]] %in% na
  }
  if (remove) {
    data[,setdiff(names(data), setdiff(vars, newname)), drop=FALSE]
  } else {
    data
  }
}

#' <strong i="26">@importFrom</strong> purrr reduce
patch_col_suffix <- function(data, remove=TRUE, na=NA, suffix=c()) {
  trim_suffix <- function(current_suffix, cols) {
    mask_match <- endsWith(cols, current_suffix)
    if (any(mask_match)) {
      substring(cols[mask_match], 1, nchar(cols[mask_match]) - nchar(current_suffix))
    } else {
      character(0)
    }
  }
  if (length(suffix) < 2) {
    stop("Must have at least two suffixes to combine.")
  }
  trimmed_columns <-
    lapply(suffix,
           trim_suffix,
           cols=names(data))
  duplicated_columns <- purrr::reduce(.x=trimmed_columns, .f=intersect)
  if (length(duplicated_columns)) {
    for (i in seq_along(duplicated_columns)) {
      data <- patch_col_set(data=data,
                            vars=paste0(duplicated_columns[i],
                                        suffix),
                            remove=remove,
                            na=na,
                            newname=duplicated_columns[i])
    }
    data
  } else {
    stop("No duplicated columns with the provided suffixes")
  }
}

library(dplyr)
# Without patching
full_join(data.frame(A = 1, B = 2, C = 3), data.frame(A = 4, B = 5, C = 6), 
  by = "A")
#>   A B.x C.x B.y C.y
#> 1 1   2   3  NA  NA
#> 2 4  NA  NA   5   6

# With patching by name (values go into 'B.x')
full_join(data.frame(A = 1, B = 2, C = 3), data.frame(A = 4, B = 5, C = 6), 
  by = "A") %>% patch_col(B.x, B.y)
#>   A B.x C.x C.y
#> 1 1   2   3  NA
#> 2 4   5  NA   6

# With patching by suffix (values go into 'B' and 'C')
full_join(data.frame(A = 1, B = 2, C = 3), data.frame(A = 4, B = 5, C = 6), 
  by = "A") %>% patch_col(suffix = c(".x", ".y"))
#>   A B C
#> 1 1 2 3
#> 2 4 5 6

Já que estou nisso, que tal isso por patch_val . Uma extensão para isso teria os argumentos ou uma lista nomeada (que procuraria igualdade; versão atual) ou uma fórmula (que seria avaliada e forçada a uma lógica no ambiente de data.frame):

#' Update one or more values in a data frame
#'
#' <strong i="7">@param</strong> data A data frame
#' <strong i="8">@param</strong> ... Named arguments to match.  The value of the argument is
#'   compared against all values in \code{data[[nm]]} with \code{%in%},
#'   so argument values may be a scalar or a vector.
#' <strong i="9">@param</strong> .new_val A named list of new values to put in the row(s) found.
#' <strong i="10">@return</strong> \code{data} with updated values.
#' <strong i="11">@export</strong>
patch_val <- function(data, ..., .new_val) {
  args <- list(...)
  if (length(args) == 0 & nrow(data) != 1) {
    stop("Must give at least one row to match unless there is only one row of data.")
  } else if (length(args) && (is.null(names(args)) | any(names(args) %in% ""))) {
    stop("All arguments must be named.")
  } else if (is.null(names(.new_val)) || any(names(.new_val %in% ""))) {
    stop(".new_val must be a named list.")
  }
  mask_match <- rep(TRUE, nrow(data))
  for (nm in names(args)) {
    mask_match <- mask_match & data[[nm]] %in% args[[nm]]
  }
  if (any(mask_match)) {
    for (nm in names(.new_val)) {
      data[[nm]][mask_match] <- .new_val[[nm]]
    }
  }
  data
}
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
data.frame(A = 1:5, B = 6:10, C = 11:15, D = c(LETTERS[1:4], NA), stringsAsFactors = FALSE)
#>   A  B  C    D
#> 1 1  6 11    A
#> 2 2  7 12    B
#> 3 3  8 13    C
#> 4 4  9 14    D
#> 5 5 10 15 <NA>

data.frame(A = 1:5, B = 6:10, C = 11:15, D = c(LETTERS[1:4], NA), stringsAsFactors = FALSE) %>% 
  patch_val(A = 1, .new_val = list(D = "Q"))
#>   A  B  C    D
#> 1 1  6 11    Q
#> 2 2  7 12    B
#> 3 3  8 13    C
#> 4 4  9 14    D
#> 5 5 10 15 <NA>

Eu me contentaria em adicionar uma opção de substituição para left_join (replace.with.y = TRUE)

Há uma implementação em https://github.com/tidyverse/dplyr/issues/4595#issuecomment -547420916

Eu implementei essa ideia de patch no meu pacote safejoin , que envolve as funções de junção do dplyr .

Eu tenho um argumento conflict , que é uma função de 2 argumentos que será aplicada em cada nome presente em pares de colunas conflitantes (mesmo nome e não incluído em "por").

O patch que você descreve aqui pode ser feito usando conflict = ~dplyr::coalesce(.y, .x) . Se quisermos que os valores NA do segundo quadro de dados tenham precedência sobre os valores não NA do quadro 1, usamos o valor especial conflict = "patch" (que parece estar quebrado em meu pacote, mas isso é outro problema).

Faz mais sentido para mim integrar isso em operações de junção do que em novos verbos, porque podemos querer usá-lo com full_join (equivalente a insert @hadley em https://github.com/tidyverse/dplyr / questões / 4654), semi_join (perto de @hadley 's update no https://github.com/tidyverse/dplyr/issues/4654), left_join (patch como descrito aqui), ou inner_join etc.

coalescer é a solicitação mais comum (veja todas essas perguntas do SO: https://stackoverflow.com/search?q=safejoin), mas ter um argumento conflict permite adicionar valores em alguns casos ou criar uma lista elemento, ou para empacotar colunas conflitantes com conflict = ~tibble(x=.x,y=.y) . conflict = ~.x significa que apenas mantemos o primeiro valor, então é seguro e não temos um nome de coluna desaparecendo misteriosamente dependendo do que temos no segundo data.frame (o que leva a uma depuração frustrante).

Com o exemplo de @billdenney acima:

df1 <- tibble::tibble(A = 1, B = 2, C = 3)
df2 <- tibble::tibble(A = 4, B = 5, C = 6)

# patching as defined above
safejoin::safe_full_join(df1, df2, by = "A", conflict = ~dplyr::coalesce(.y, .x))
#> # A tibble: 2 x 3
#>       A     B     C
#>   <dbl> <dbl> <dbl>
#> 1     1     2     3
#> 2     4     5     6

# packing
safejoin::safe_full_join(df1, df2, by = "A", conflict = ~tibble::tibble(x=.x, y=.y))
#> # A tibble: 2 x 3
#>       A   B$x    $y   C$x    $y
#>   <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1     1     2    NA     3    NA
#> 2     4    NA     5    NA     6

# nesting
safejoin::safe_full_join(df1, df2, by = "A", conflict = ~purrr::map2(.x,.y, list))
#> # A tibble: 2 x 3
#>       A B          C         
#>   <dbl> <list>     <list>    
#> 1     1 <list [2]> <list [2]>
#> 2     4 <list [2]> <list [2]>

# ignoring right side df conflicting columns
safejoin::safe_full_join(df1, df2, by = "A", conflict = ~.x)
#> # A tibble: 2 x 3
#>       A     B     C
#>   <dbl> <dbl> <dbl>
#> 1     1     2     3
#> 2     4    NA    NA

^{Criado em 12/12/2019 pelo pacote reprex (v0.3.0)}

Prefiro ver esses recursos no dplyr do que no safejoin .

Provavelmente será implementado como parte de https://github.com/tidyverse/dplyr/issues/4654