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

1 つの答えですが、plyrパッケージreshape2を使用する最も単純なものではない可能性があります。

library(reshape2)
library(plyr)

まず、データ フレームを「ワイド」形式から「ロング」形式 (1 行に 1 つの観測値) に変換し、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

ベース 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のNA をbそれぞれの平均値に置き換えます。最後に、データを再形成してワイド フォーマットに戻します。reshapeは紛らわしい機能ですが、ヘルプ ページの例を参照すると、すぐに理解できます。

編集

列を並べ替えるには、次のことができます

x3[,names(x)]

行名を置き換えるには、次のことができます

rownames(x3) = 1:NROW(x3)
于 2013-01-25T15:36:38.657 に答える
2

私はあなたのコードを使用し、1行追加します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))

startend世紀の部分のない開始年と終了年の書式設定されたバージョンです。この時点で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 分割-適用-結合イディオムの 1 つを使用しますsplit() xx。group

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

次に、 :内または : の間にあることが示されている年に対してlapply()サブセット化する関数を適用できます。sを削除して、サブセット値の変数の平均を計算します。平均を返します。yearstartendvalueNA

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

sを置き換える関数に関しては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
于 2013-01-25T11:06:53.820 に答える
0

どの回答にもチェックマークを付けることができましたが、完全にベース R にあり、非常に単純に見えるため、Ramnath の回答を好みます。しかし、彼の答えを使おうとすると、多数の状態ごとに個別の手段が必要であることに気付きました。だから、私は彼の答えを次のように修正しました：

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 に答える