替换数据帧列表中编号列的NA
Posted
tags:
篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了替换数据帧列表中编号列的NA相关的知识，希望对你有一定的参考价值。
我具有以下结构的数据帧的大量列表：
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()功能的帮助页面进行复制。
我计划像这样替换NA后：
df.list <- purrr::map(df.list, function(data)
data %>% mutate(lorem.cols = replace(is.na(lorem.cols), 0))
)
谢谢大家！
答案
我们可以使用base R。用list循环遍历lapply，使用grep查找与'lorem'匹配的列名称的索引，后跟一个或多个数字，replace这些列中的NA的值为0，以及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
另一答案
使用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")))))
另一答案
[这是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
另一答案
假设除了以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)
)
另一答案
您可以尝试这样的事情：
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
另一答案
另一个选择是使用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]>
以上是关于替换数据帧列表中编号列的NA的主要内容，如果未能解决你的问题，请参考以下文章