替换数据框列表中数字列的NA值

Question

我有一个包含大量数据框的列表，结构如下：

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

但是两者都出现了错误，要么找不到该函数，要么给我“Selection:”并等待输入。我只是试图从select()函数的帮助页面复制。

之后，我计划这样替换NAs：

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

感谢大家！

- schroederadrian

---

下面的回答看起来不错，但是请注意，select的问题已经在这里得到解决：lorem.cols <- purrr::map(df.list, function(x) dplyr::select(x, dplyr::starts_with("lorem")) ) - markhogue

哦，这很好知道，谢谢！我只完成了那个项目的一半，很高兴知道我可以通过这种方式使用我的tidyverse函数:D - schroederadrian

Answer 1

这是一个使用 data.table 方法的示例，它依赖于 data.table 的按引用更新，在 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

- Cole

Answer 2

我们可以使用基本的R语言。通过`lapply`循环遍历`list`，使用`grep`查找与'lorem'后跟一个或多个数字相匹配的列名的索引，用0替换这些列中的NA，并使用`transform`在`list`中转换原始数据集，创建一个新列“avg”，该列获取这些“lorem”列的平均值。

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

- akrun

---

非常感谢，运行得很好！这是最佳答案，因为我不能保证我的数据框中没有其他NA。干杯，伙计！ - schroederadrian

Answer 3

另一个选择是使用rowSums，以节省将NAs转换为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]>

- chinsoon12

---

哦，那太有帮助了！每个数据框中有大约40k条观测数据，我的笔记本电脑已经运行到极限了xD 谢谢！ - schroederadrian

Answer 4

假设除以lorem开头的列外，其他列中没有缺失值，您可以执行以下操作。

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

- warnbergg

---

谢谢！我尝试了你和akrun的答案，最终选择了他的，因为我不能保证没有其他NA。但是在另一种情况下，我更喜欢你的答案，那时我没有任何NA :) - schroederadrian

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

- tmfmnk

Answer 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

- Duck