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列的平均值。 / p>

问题是这些是原始数据中的重叠面板，因此任何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))
  )

谢谢大家！

Answer 1

假设除以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)
})

Answer 2

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

Answer 3

我们可以使用base R。用list遍历lapply，使用grep查找与“ lorem”匹配的列名的索引，后跟一个或多个数字，replace {{1 }}中的那些列为0，并NA中的原始数据集transform通过获取这些“ lorem”列中的list来创建新列“ avg”

mean

Answer 4

这是一种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

Answer 5

另一种选择是使用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]>

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

替换数据帧列表中编号列的NA

6 个答案: