我想找到列组中所有值的均值。给定的一组列可能包含缺少的观察结果。我想用一组列的平均值替换一组列中缺少的观察值。就我而言，每组的列数是常量years。
以下是执行此操作的代码。但是，我希望有人可能会提供更高效的代码。 lapply找到给定列组的平均值。但是，我还没有提出类似的方法来取代缺失的观察结果。谢谢你的任何建议。
以下是一个示例数据集：
my.first.year <- 1980
my.last.year <- 1982
years <- (my.last.year - my.first.year) + 1
x = read.table(text = "
city county state a80 a81 a82 b80 b81 b82
1 B AA 2 20 200 4 8 12
2 B AA 4 NA 400 5 9 NA
1 C AA 6 60 NA NA 10 14
2 C AA NA 80 800 7 11 15
", sep = "", header = TRUE, stringsAsFactors = FALSE)
(2 + 4 + 6 + 20 + 60 + 80 + 200 + 400 + 800) / 9
(4 + 5 + 7 + 8 + 9 + 10 + 11 + 12 + 14 + 15) / 10
my.means <- lapply( seq(4, ncol(x), years) , function(i) { mean(unlist(x[,i : (i+years-1) ]) , na.rm=TRUE) } )
my.means
x2 <- x
x2[,(3+years*0+1):(3+years*1)][is.na(x2[,(3+years*0+1):(3+years*1)])] = my.means[[1]]
x2[,(3+years*1+1):(3+years*2)][is.na(x2[,(3+years*1+1):(3+years*2)])] = my.means[[2]]
结果如下：
# city county state a80 a81 a82 b80 b81 b82
# 1 1 B AA 2.0000 20.0000 200.0000 4.0 8 12.0
# 2 2 B AA 4.0000 174.6667 400.0000 5.0 9 9.5
# 3 1 C AA 6.0000 60.0000 174.6667 9.5 10 14.0
# 4 2 C AA 174.6667 80.0000 800.0000 7.0 11 15.0
答案 0 :(得分：3)
一个答案，但可能不是最简单的答案，它使用plyr和reshape2个包裹：
library(reshape2)
library(plyr)
首先，将数据框从“宽”格式转换为“长格式”（每行一个观察点）并创建groups列：
mx <- melt(x, id.vars=c("city","country","state"))
mx$groups[mx$variable %in% c("a80","a81","a82")] <- 1
mx$groups[mx$variable %in% c("b80","b81","b82")] <- 2
head(mx)
您数据的第一行现在应如下所示：
city county state variable value groups
1 1 B AA a80 2 1
2 2 B AA a80 4 1
3 1 C AA a80 6 1
4 2 C AA a80 NA 1
5 1 B AA a81 20 1
6 2 B AA a81 NA 1
然后，您可以使用ddply通过以下方式替换缺失值：
mx <- ddply(mx, .(groups), function(df) {df$value[is.na(df$value)] <- mean(df$value, na.rm=TRUE); return(df)})
最后使用dcast将您的数据恢复为“长”格式：
x <- dcast(mx, city + county + state ~ variable)
x
给出了：
city county state a80 a81 a82 b80 b81 b82
1 1 B AA 2.0000 20.0000 200.0000 4.0 8 12.0
2 1 C AA 6.0000 60.0000 174.6667 9.5 10 14.0
3 2 B AA 4.0000 174.6667 400.0000 5.0 9 9.5
4 2 C AA 174.6667 80.0000 800.0000 7.0 11 15.0
答案 1 :(得分：3)
这是使用基础R中的reshape的另一种解决方案，这是一种经常被遗忘的功能，具有惊人的力量。
x2 = reshape(x, direction = 'long', varying = 4:9, sep = "")
x2[,c('a', 'b')] = apply(x2[,c('a', 'b')], 2, function(y){
y[is.na(y)] = mean(y, na.rm = T)
return(y)
})
x3 = reshape(x2, direction = 'wide', idvar = names(x2)[1:3], timevar = 'time',
sep = "")
以下是它的工作原理。首先，我们将数据重新整理为长格式，其中a和b成为列，年份变为行。其次，我们用各自的方法替换列a和b中的NA。最后，我们将数据重新整理为宽格式。 reshape是一个令人困惑的功能，但通过帮助页面上的示例，您可以加快速度。
修改
要重新排序列，您可以执行
x3[,names(x)]
要替换rownames，您可以
rownames(x3) = 1:NROW(x3)
答案 2 :(得分：2)
我使用你的代码，我添加一行na.fill（即使我不喜欢你的3列分组）。
修改
na.fill是动物园包。它非常方便，我认为它在基础包中。下次我在发布之前重新启动会话。
ll <- lapply( seq(4, ncol(x), years) ,
function(i) {
m <- mean(unlist(x[,i : (i+years-1) ]) , na.rm=TRUE)
na.fill(x[,i : (i+years-1) ],m) ## here the line I add
}
)
do.call(cbind,ll)
a80 a81 a82 b80 b81 b82
[1,] 2.0000 20.0000 200.0000 4.0 8 12.0
[2,] 4.0000 174.6667 400.0000 5.0 9 9.5
[3,] 6.0000 60.0000 174.6667 9.5 10 14.0
[4,] 174.6667 80.0000 800.0000 7.0 11 15.0
我会用这样的东西来选择列：
lapply(c('a','b'),function(i){
cols.group <- regmatches(colnames(x),
regexpr(paste(i,"[0-9]+",sep=''),colnames(x)))
m <- mean(unlist(x[,cols.group]) , na.rm=TRUE)
na.fill(x[,cols.group ],m)
})
do.call(cbind,ll)
cbind(x[,!grepl("(a|b)[0-9]+",colnames(x))],do.call(cbind,ll))
city county state a80 a81 a82 b80 b81 b82
1 1 B AA 2.0000 20.0000 200.0000 4.0 8 12.0
2 2 B AA 4.0000 174.6667 400.0000 5.0 9 9.5
3 1 C AA 6.0000 60.0000 174.6667 9.5 10 14.0
4 2 C AA 174.6667 80.0000 800.0000 7.0 11 15.0
答案 3 :(得分：2)
与长格式相比，您使数据以更宽的格式存储变得更加困难。我对此的看法是使用 reshape2 包中的melt()转换为长格式。使用您的数据
my.first.year <- 1980
my.last.year <- 1982
x <- read.table(text = "
city county state a80 a81 a82 b80 b81 b82
1 B AA 2 20 200 4 8 12
2 B AA 4 NA 400 5 9 NA
1 C AA 6 60 NA NA 10 14
2 C AA NA 80 800 7 11 15
", sep = "", header = TRUE, stringsAsFactors = FALSE)
首先我们melt() x并对variable进行一些操作以获得小组和年份
require(reshape2)
xx <- melt(x, id.vars = c("city","county","state"))
## Add year and group variables by process the `variable` column
xx <- transform(xx, year = as.numeric(sub("^[a-zA-Z]", "", variable)),
group = regmatches(variable, regexpr("^[a-zA-Z]", variable)),
stringsAsFactors = FALSE)
## format start and end years as per way stored in column names
start <- as.numeric(substring(my.first.year, first = 3))
end <- as.numeric(substring(my.last.year, first = 3))
start和end是您的开始和结束年份的格式化版本，没有世纪部分。此时xx看起来像
> head(xx)
city county state variable value year group
1 1 B AA a80 2 80 a
2 2 B AA a80 4 80 a
3 1 C AA a80 6 80 a
4 2 C AA a80 NA 80 a
5 1 B AA a81 20 81 a
6 2 B AA a81 NA 81 a
接下来，我使用一个基本的R split-apply-combine惯用语和split() xx group
xxs <- split(xx, f = xx$group)
然后lapply()可以在year：start之间或之间的end处将函数应用于子集。我计算子集值的value变量的平均值，删除NA s。我们返回平均值。
foo <- function(x, start, end) {
take <- with(x, year >= start & year <= end)
xbar <- mean(x[take, "value"], na.rm = TRUE)
xbar
}
lapply(xxs, foo, start = start, end = end)
这给出了：
> lapply(xxs, foo, start = start, end = end)
$a
[1] 174.6667
$b
[1] 9.5
对于替换NA的函数，foo()的一个小修改实现了这个：
foor <- function(x, start, end) {
take <- with(x, year >= start & year <= end)
xbar <- mean(x[take, "value"], na.rm = TRUE)
nas <- is.na(x[take, "value"]) ## which are NA?
x[take, "value"][nas] <- xbar ## replace NA with xbar
x ## return
}
要获取数据框，我将其包含在do.call()中，以便安排在rbind()的输出上调用lapply()：
xx2 <- do.call(rbind, lapply(xxs, foor, start = start, end = end))
给出：
> head(xx2)
city county state variable value year group
a.1 1 B AA a80 2.0000 80 a
a.2 2 B AA a80 4.0000 80 a
a.3 1 C AA a80 6.0000 80 a
a.4 2 C AA a80 174.6667 80 a
a.5 1 B AA a81 20.0000 81 a
a.6 2 B AA a81 174.6667 81 a
如果您需要返回原始数据格式，那么dcast()（也来自reshape2）就是您的朋友：
x2 <- dcast(xx2[, 1:5], city + county + state ~ variable)
> head(x)
city county state a80 a81 a82 b80 b81 b82
1 1 B AA 2 20 200 4 8 12
2 2 B AA 4 NA 400 5 9 NA
3 1 C AA 6 60 NA NA 10 14
4 2 C AA NA 80 800 7 11 15
> head(x2)
city county state a80 a81 a82 b80 b81 b82
1 1 B AA 2.0000 20.0000 200.0000 4.0 8 12.0
2 1 C AA 6.0000 60.0000 174.6667 9.5 10 14.0
3 2 B AA 4.0000 174.6667 400.0000 5.0 9 9.5
4 2 C AA 174.6667 80.0000 800.0000 7.0 11 15.0
答案 4 :(得分：0)
我可以给任何一个答案给出复选标记，但我更喜欢Ramnath的答案，因为它完全在基础R中，看起来非常简单。然而，当我试图使用他的答案时，我意识到我需要为众多国家中的每一个提供单独的手段。所以，我修改了他的答案如下：
my.first.year <- 1980
my.last.year <- 1982
years <- (my.last.year - my.first.year) + 1
x = read.table(text = "
city county state a80 a81 a82 b80 b81 b82
1 B AA 2 20 200 4 8 12
2 B AA 4 NA 400 5 9 NA
1 C AA 6 60 NA NA 10 14
2 C AA NA 80 800 7 11 15
1 A BB 1 2 1 2 2 2
2 A BB 2 NA 1 2 2 NA
1 B BB 1 1 NA NA 2 2
2 B BB NA 2 1 2 2 10
", sep = "", header = TRUE, stringsAsFactors = FALSE)
x
x2 = reshape(x, direction = 'long', varying = 4:9, sep = "")
x2 <- x2[order(x2$state, x2$time),]
x2[,c('a', 'b')] = apply(x2[,c('a', 'b')], 2, function(z) {
sapply(split(z, x2$state),
function(y) { y[is.na(y)] = mean(y, na.rm = T)
return(y) })
})
x2
x3 <- reshape(x2, direction = 'wide', idvar = names(x2)[1:3], timevar = 'time',
sep = "")
x3[,names(x)]
此代码似乎有效。虽然，出于某种原因，我需要x2订购state。我并不完全理解return陈述。如果我发现代码不能用于将来的数据集，我将编辑此帖子以解决问题。