3

我想找到列组中所有值的均值。给定的一组列可能包含缺失的观察值。我想用该组列的平均值替换一组列中缺失的观察值。在我的情况下，每组的列数是一个常数，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
4

5 回答 5

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
于 2013-01-25T10:13:51.520 回答
3

这是使用reshapebase R 的另一种解决方案，这是一个经常被遗忘的功能，具有惊人的功能。

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成为列，年份成为行。其次，我们用它们各自的方式替换列中的 NA a。b最后，我们将数据重新整形为宽格式。reshape是一个令人困惑的功能，但通过帮助页面上的示例可以让您快速上手。

编辑

要重新排序列，您可以执行

x3[,names(x)]

要替换行名，您可以执行

rownames(x3) = 1:NROW(x3)
于 2013-01-25T15:36:38.657 回答
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
于 2013-01-25T10:36:50.240 回答
2

与长格式相比，以宽格式存储数据会使您自己的事情变得更加困难。melt()我对此的看法是使用reshape2包转换为长格式。使用您的数据

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() xx通过group

xxs <- split(xx, f = xx$group)

然后lapply()可以将函数应用于子集 byyear表示位于start:之间或之间的年份end。我计算value子集值的变量的平均值，删除NAs。我们返回平均值。

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

至于替换NAs 的函数，只需对 s 稍作修改即可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
于 2013-01-25T11:06:53.820 回答
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说法。如果我发现代码不适用于未来的数据集，我将编辑这篇文章来解决这个问题。

于 2013-01-26T09:59:40.403 回答