如何用 R 中另一个 tibble 的估算列替换 tibble 中的 NA 列

How to replace columns with NA in a tibble with imputed columns from another tibble in R

我想用 df 中的 NA 替换 de 列,使用 df2 中的估算值来获得 df3。 我可以用 left_joincoalesce 来做,但我认为这种方法不能很好地概括。有没有更好的方法?

library(tidyverse)

df <- tibble(c = c("a", "a", "a", "b", "b", "b"),
             d = c(1, 2, 3, 1, 2, 3),
             x = c(1, NA, 3, 4, 5,6),
             y = c(1, 2, NA, 4, 5, 6),
             z = c(1, 2, 7, 4, 5, 6))

# I want to replace NA in df by df2

df2 <- tibble(c = c("a", "a", "a"),
             d = c(1, 2, 3),
             x = c(1, 2, 3),
             y = c(1, 2, 2))

# to get

df3 <- tibble(c = c("a", "a", "a", "b", "b", "b"),
             d = c(1, 2, 3, 1, 2, 3),
             x = c(1, 2, 3, 4, 5, 6),
             y = c(1, 2, 2, 4, 5, 6),
             z = c(1, 2, 7, 4, 5, 6))

# is there a better solution than coalesce?

df3 <- df %>% left_join(df2, by = c("c", "d")) %>%
  mutate(x = coalesce(x.x, x.y),
         y = coalesce(y.x, y.y)) %>%
  select(-x.x, -x.y, -y.x, -y.y)
Created on 2021-06-17 by the reprex package (v2.0.0)

这是一个合并 所有 .x.y 列的自定义函数,可选择重命名和删除列。

#' Coalesce all columns duplicated in a previous join.
#'
#' Find all columns resulting from duplicate names after a join
#' operation (e.g., `dplyr::*_join` or `base::merge`), then coalesce
#' them pairwise.
#'
#' @param x data.frame
#' @param suffix character, length 2, the same string suffixes
#'   appended to column names of duplicate columns; should be the same
#'   as provided to `dplyr::*_join(., suffix=)` or `base::merge(.,
#'   suffixes=)`
#' @param clean logical, whether to remove the suffixes from the LHS
#'   columns and remove the columns on the RHS columns
#' @param strict logical, whether to enforce same-classes in the LHS
#'   (".x") and RHS (".y") columns; while it is safer to set this to
#'   true (default), sometimes the conversion of classes might be
#'   acceptable, for instance, if one '.x' column is 'numeric' and its
#'   corresponding '.y' column is 'integer', then relaxing the class
#'   requirement might be acceptable
#' @return 'x', coalesced, optionally cleaned
#' @export
coalesce_all <- function(x, suffix = c(".x", ".y"),
                         clean = FALSE, strict = TRUE) {
  nms <- colnames(x)
  Xs <- endsWith(nms, suffix[1])
  Ys <- endsWith(nms, suffix[2])
  # x[Xs] <- Map(dplyr::coalesce, x[Xs], x[Ys])
  # x[Xs] <- Map(data.table::fcoalesce, x[Xs], x[Ys])
  x[Xs] <- Map(function(dotx, doty) {
    if (strict) stopifnot(identical(class(dotx), class(doty)))
    isna <- is.na(dotx)
    replace(dotx, isna, doty[isna])
  } , x[Xs], x[Ys])
  if (clean) {
    names(x)[Xs] <- gsub(glob2rx(paste0("*", suffix[1]), trim.head = TRUE), "", nms[Xs])
    x[Ys] <- NULL
  }
  x
}

进行中:

df %>%
  left_join(df2, by = c("c", "d")) %>%
  coalesce_all()
# # A tibble: 6 x 7
#   c         d   x.x   y.x     z   x.y   y.y
#   <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
# 1 a         1     1     1     1     1     1
# 2 a         2     2     2     2     2     2
# 3 a         3     3     2     7     3     2
# 4 b         1     4     4     4    NA    NA
# 5 b         2     5     5     5    NA    NA
# 6 b         3     6     6     6    NA    NA

df %>%
  left_join(df2, by = c("c", "d")) %>%
  coalesce_all(clean = TRUE)
# # A tibble: 6 x 5
#   c         d     x     y     z
#   <chr> <dbl> <dbl> <dbl> <dbl>
# 1 a         1     1     1     1
# 2 a         2     2     2     2
# 3 a         3     3     2     7
# 4 b         1     4     4     4
# 5 b         2     5     5     5
# 6 b         3     6     6     6

我在 Map 中包含了两个合并函数作为 base-R 的替代方法。优点之一是 strict 参数:dplyr::coalesce 将默默地允许合并 integernumeric,而 data.table::fcoalesce 则不允许。如果这是可取的,请使用您喜欢的。 (另一个优点是两个非基础合并函数都接受任意数量的列进行合并,这在这个实现中不是必需的。)

我尝试了另一种方法,过滤 c,用 NA 删除 df 的所有列,用 df2 加入并绑定未过滤的行 dfdf3.

df3 <- df %>% filter(c == "a") %>% select_if(~ !any(is.na(.))) %>%
  left_join(df2, by = c("c", "d"))
df3 <- bind_rows(df %>% filter(!c == "a"), df3) %>% arrange(c,d)
df3
#> # A tibble: 6 x 5
#>   c         d     x     y     z
#>   <chr> <dbl> <dbl> <dbl> <dbl>
#> 1 a         1     1     1     1
#> 2 a         2     2     2     2
#> 3 a         3     3     2     7
#> 4 b         1     4     4     4
#> 5 b         2     5     5     5
#> 6 b         3     6     6     6
Created on 2021-06-17 by the reprex package (v2.0.0)

您可以使用 across 并使用 .names & .keep 参数一次性改变所有列,像这样

library(dplyr, warn.conflicts = F)

df %>% left_join(df2, by = c("c", "d")) %>%
  mutate(across(ends_with('.x'), ~ coalesce(., get(gsub('.x', '.y', cur_column()))),
                .names = '{gsub(".x$", "", .col)}'), .keep = 'unused')
#> # A tibble: 6 x 5
#>   c         d     z     x     y
#>   <chr> <dbl> <dbl> <dbl> <dbl>
#> 1 a         1     1     1     1
#> 2 a         2     2     2     2
#> 3 a         3     7     3     2
#> 4 b         1     4     4     4
#> 5 b         2     5     5     5
#> 6 b         3     6     6     6

reprex package (v2.0.0)

于 2021 年 6 月 17 日创建

我们可以使用{powerjoin}

library(powerjoin)
power_left_join(df, df2, by = c("c", "d"), conflict = coalesce_xy)
#> # A tibble: 6 × 5
#>   c         d     z     x     y
#>   <chr> <dbl> <dbl> <dbl> <dbl>
#> 1 a         1     1     1     1
#> 2 a         2     2     2     2
#> 3 a         3     7     3     2
#> 4 b         1     4     4     4
#> 5 b         2     5     5     5
#> 6 b         3     6     6     6