替换数据框列表中编号列的 NA答案

【问题标题】：Replacing NA of numbered column in list of data frames替换数据框列表中编号列的 NA
【发布时间】：2020-03-06 01:24:26
【问题描述】：

我有大量具有以下结构的数据框：

foo <- 1:5
lorem1968 <- c(6, NA, NA, 8, NA)
lorem1969 <- c(NA, 17, NA, 19, 20)
df1 <- data.frame(foo, lorem1968, lorem1969)

ipsum <- 11:15
lorem1970 <- c(22, NA, 24, NA, NA)
df2 <- data.frame(ipsum, lorem1969, lorem1970)

df.list <- list(df1, df2)

[[1]]
  foo lorem1968 lorem1969
1   1         6        NA
2   2        NA        17
3   3        NA        NA
4   4         8        19
5   5        NA        20

[[2]]
  ipsum lorem1969 lorem1970
1    11        NA        22
2    12        17        NA
3    13        NA        24
4    14        19        NA
5    15        20        NA

我现在想遍历所有名为 loremxxxx 的列，并将那里的所有 NA 替换为 0。然后，我想在每个 df 中创建一个新列，其中包含该特定 df 中包含的所有 loremxxxx 列的平均值。

问题在于这些是原始数据中的重叠面板，因此任何 df1 都包含 lorem1968、lorem1969、lorem1970。 df2 包含 lorem1969, 1970, 1971. 等等。

我尝试选择这样的列：

lorem.cols <- purrr::map(panels.list, function(x)
  select(x, starts_with("lorem"))
  )

还有：

lorem.cols <- purrr::map(df.list, function(data)
  data %>% select(data, starts_with("lorem"))
)

但两者都抛出了一个错误，要么找不到函数，要么给我“选择：”并等待输入。刚刚尝试从select()函数的帮助页面复制。

在我计划像这样更换 NA 之后：

df.list <- purrr::map(df.list, function(data)
  data %>% mutate(lorem.cols = replace(is.na(lorem.cols), 0))
  )

谢谢各位！

【问题讨论】：

在下面看起来是个不错的答案，但仅供参考，选择问题已在此处修复：lorem.cols <- purrr::map(df.list, function(x) dplyr::select(x, dplyr::starts_with("lorem")) )
哦，很高兴知道谢谢！该项目只完成了一半，很高兴知道我可以通过这种方式获得我的 tidyverse 功能：D

标签： r list replace na purrr

【解决方案1】：

另一种选择是使用rowSums 来节省一些将 NA 转换为 0 的时间：

lapply(df.list, function(x) {
    i1 <- grep("^lorem\\d+$", names(x))
    transform(x, avg = rowSums(x[i1], na.rm=TRUE) / ncol(x[i1]))
})

计时码：

set.seed(0L)
ndf <- 1e4
nr <- 1e4
nc <- 2
df.list <- replicate(ndf,
    data.frame(id=1:nr, matrix(sample(c(1, NA_real_), nr*nc, TRUE), ncol=nc)),
    simplify=FALSE)

mtd0 <- function() {
    lapply(df.list, function(x) {
        i1 <- grep("^X\\d+$", names(x))
        x[i1] <- replace(x[i1], is.na(x[i1]), 0)
        transform(x, avg = rowMeans(x[i1], na.rm = TRUE))
    })
}

mtd2 <- function() {
    lapply(df.list, function(x) {
        i1 <- grep("^X\\d+$", names(x))
        transform(x, avg = rowSums(x[i1], na.rm=TRUE) / ncol(x[i1]))
    })
}

bench::mark(mtd0(), mtd2(), check=FALSE)

时间安排：

# A tibble: 2 x 13
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result          memory                 time     gc              
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list>          <list>                 <list>   <list>          
1 mtd0()       35.51s   35.51s    0.0282    7.83GB    0.422     1    15     35.51s <list [10,000]> <df[,3] [151,107 x 3]> <bch:tm> <tibble [1 x 3]>
2 mtd2()        8.91s    8.91s    0.112     2.98GB    1.12      1    10      8.91s <list [10,000]> <df[,3] [30,314 x 3]>  <bch:tm> <tibble [1 x 3]>

【讨论】：

哦，那会很有帮助的！每个 df 有大约 40k 的观察结果，所以我的笔记本电脑无论如何都在容量上运行 xD 谢谢！

【解决方案2】：

假设除以 lorem 开头的列之外的任何其他列中没有 NA，您可以执行以下操作

lapply(df.list, function(df) {
    df[is.na(df)] <- 0
    df$mean <- apply(df[, grep("lorem", names(df))], 1, mean)
    return (df)
})

# [[1]]
#   foo lorem1968 lorem1969 mean
# 1   1         6         0  3.0
# 2   2         0        17  8.5
# 3   3         0         0  0.0
# 4   4         8        19 13.5
# 5   5         0        20 10.0
# 
# [[2]]
#   ipsum lorem1969 lorem1970 mean
# 1    11         0        22 11.0
# 2    12        17         0  8.5
# 3    13         0        24 12.0
# 4    14        19         0  9.5
# 5    15        20         0 10.0

在@akrun 回答之后，您可以使用rowMeans 而不是apply(df[, grep("lorem", names(df))], 1, mean)，即

lapply(df.list, function(df) {
    df[is.na(df)] <- 0
    df$mean <- rowMeans(df[, grep("lorem", names(df))])
    return (df)
})

【讨论】：

谢谢！我尝试了你和 akruns 的答案，最后解决了他的问题，因为我不能总是保证我没有其他 NA。但是在我没有任何 NA 的情况下更喜欢你的 :)

【解决方案3】：

我们可以使用base R。循环使用list 和lapply，使用grep 查找与'lorem' 后跟一位或多位数字匹配的列名的索引，replace 和那些带有0 的列中的NAs，以及transform list 中的原始数据集通过获取那些“lorem”列的mean 来创建一个新列“avg”

lapply(df.list, function(x) {
         i1 <- grep("^lorem\\d+$", names(x))
         x[i1] <- replace(x[i1], is.na(x[i1]), 0)
    transform(x, avg = rowMeans(x[i1], na.rm = TRUE))
   })
#[[1]]
#  foo lorem1968 lorem1969  avg
#1   1         6         0  3.0
#2   2         0        17  8.5
#3   3         0         0  0.0
#4   4         8        19 13.5
#5   5         0        20 10.0

#[[2]]
#  ipsum lorem1969 lorem1970  avg
#1    11         0        22 11.0
#2    12        17         0  8.5
#3    13         0        24 12.0
#4    14        19         0  9.5
#5    15        20         0 10.0

【讨论】：

非常感谢，工作就像一个魅力！最佳答案，因为我不能总是保证我的数据框中没有其他 NA。干杯伙伴！

【解决方案4】：

这是一个 data.table 方法，它依赖于 data.table update-by-reference，在 lapply() 调用中也适用。

library(data.table)
lapply(df.list, setDT)

lapply(df.list,
       function(dt) {
         cols <- grep('^lorem', names(dt))
         setnafill(dt, fill = 0L, cols = cols)
         dt[, mean_lorem := rowMeans(.SD), .SDcols = cols]
         })
#> [[1]]
#>    foo lorem1968 lorem1969 mean_lorem
#> 1:   1         6         0        3.0
#> 2:   2         0        17        8.5
#> 3:   3         0         0        0.0
#> 4:   4         8        19       13.5
#> 5:   5         0        20       10.0
#> 
#> [[2]]
#>    ipsum lorem1969 lorem1970 mean_lorem
#> 1:    11         0        22       11.0
#> 2:    12        17         0        8.5
#> 3:    13         0        24       12.0
#> 4:    14        19         0        9.5
#> 5:    15        20         0       10.0

【讨论】：

【解决方案5】：

使用dplyr、tidyr 和purrr，您可以：

map(df.list, ~ select_at(.x, vars(contains("lorem"))) %>%
     mutate_all(~ replace_na(., 0)) %>%
     mutate(avg = rowMeans(.)))

[[1]]
  lorem1968 lorem1969  avg
1         6         0  3.0
2         0        17  8.5
3         0         0  0.0
4         8        19 13.5
5         0        20 10.0

[[2]]
  lorem1969 lorem1970  avg
1         0        22 11.0
2        17         0  8.5
3         0        24 12.0
4        19         0  9.5
5        20         0 10.0

如果你真的想保留其他列：

map(df.list, ~ mutate_at(.x, vars(contains("lorem")), ~ replace_na(., 0)) %>%
     mutate(avg = rowMeans(select(., starts_with("lorem")))))

【讨论】：

【解决方案6】：

你可以试试这样的：

foo <- 1:5
lorem1968 <- c(6, NA, NA, 8, NA)
lorem1969 <- c(NA, 17, NA, 19, 20)
df1 <- data.frame(foo, lorem1968, lorem1969)

ipsum <- 11:15
lorem1970 <- c(22, NA, 24, NA, NA)
df2 <- data.frame(ipsum, lorem1969, lorem1970)

df.list <- list(df1, df2)
#Create function
replace_f <- function(x)
{
  #Replace NA by 0
  x[is.na(x)] <- 0
  #Compute mean
  #Variable selection
  index <- which(grepl("lorem",names(x)))
  x$Avg <- apply(x[,index],1,mean)
  return(x)
}
df.list2 <- lapply(df.list,replace_f)

df.list2

[[1]]
  foo lorem1968 lorem1969  Avg
1   1         6         0  3.0
2   2         0        17  8.5
3   3         0         0  0.0
4   4         8        19 13.5
5   5         0        20 10.0

[[2]]
  ipsum lorem1969 lorem1970  Avg
1    11         0        22 11.0
2    12        17         0  8.5
3    13         0        24 12.0
4    14        19         0  9.5
5    15        20         0 10.0

【讨论】：