2016-05-07 13 views
4

これは昨日登場した質問を再現するためのものです。質問。 2つのデータセットdf1とより小さいdf2には、同じ列名が提供され、date列が一致する行でNA値のみを置き換える要求がありました。私はマージがそれを行っている可能性があり、十分に負担の少ないだったかもしれないが、私はmatch() -ingとインデックスの戦略を模索していたし、最終的に1を発見したとしますR:最初のdfrmの複数の列のNA値を、日付を一致させた行の後に2番目のdfrmの値に置き換えます。

df1 <- structure(list(date = c(20040101L, 20040115L, 20040131L, 20040205L, 
20040228L, 20040301L, 20040315L, 20040331L), X11A = c(100L, 200L, 
NA, NA, NA, 150L, NA, NA), X11A.1 = c(150L, NA, 165L, NA, NA, 
155L, NA, NA), X21B = c(NA, 200L, 180L, NA, NA, 170L, 180L, NA 
), X3CC = c(NA, NA, 190L, NA, NA, 150L, 190L, 175L), X3CC.1 = c(140L, 
NA, 190L, NA, NA, 160L, 200L, 180L)), .Names = c("date", "X11A", 
"X11A.1", "X21B", "X3CC", "X3CC.1"), class = "data.frame", row.names = c(NA, 
-8L)) 

df2 <- structure(list(date = c(20040228L, 20040131L, 20040331L), X11A = c(140L, 
170L, NA), X11A.1 = c(145L, NA, 145L), X21B = c(165L, NA, 160L 
), X3CC = c(150L, NA, NA), X3CC.1 = c(155L, NA, NA)), .Names = c("date", 
"X11A", "X11A.1", "X21B", "X3CC", "X3CC.1"), class = "data.frame", row.names = c(NA, 
-3L)) 

実際に提供されたもの:

DF1を:

date  11A 11A 21B 3CC 3CC 
20040101 100 150  NA  NA 140 
20040115 200  NA 200  NA  NA 
20040131  NA 165 180 190 190 
20040205  NA  NA  NA  NA  NA 
20040228  NA  NA  NA  NA  NA 
20040301 150 155 170 150 160 
20040315  NA  NA 180 190 200 
20040331  NA  NA  NA 175 180 

DF2:

date  11A 11A 21B 3CC 3CC 
20040228 140 145 165 150 155 
20040131 170  NA  NA  NA  NA 
20040331  NA 145 160  NA  NA 

答えて

4

is.na関数は、dataframe引数から論理の「テンプレート」を作成できます。私の目標は、そのようなテンプレートを作成し、2つのdate列の間に結果がmatchの行だけを選択することでした。 arr.indとwhichを使用して= TRUEは[<-又は[いずれか1つの引数として使用することができる2つの列の行列を与える:

valpos <- which(is.na(df1)[match(df2$date, df1$date), ], arr.ind=TRUE) 

次のタスクは非常に(「行」と名付けられた)最初の列を変換することです正しい行は、「ターゲット」データフレームのために置換されていること:

targpos <- cbind(match(df2$date, df1$date)[ valpos[,'row'] ] , 
        valpos[,'col']) 

は、次にそれだけだ:

> df1[targpos] <- df2[valpos] 
> df1 
     date X11A X11A.1 X21B X3CC X3CC.1 
1 20040101 100 150 NA NA 140 
2 20040115 200  NA 200 NA  NA 
3 20040131 170 165 180 190 190 
4 20040205 NA  NA NA NA  NA 
5 20040228 140 145 165 150 155 
6 20040301 150 155 170 150 160 
7 20040315 NA  NA 180 190 200 
8 20040331 NA 145 160 175 180 

私は問題aを作りました私は日付に注文をシャッフルしたときに少し難しくなった。私はこの論理がそれを難し​​く解決すると思う。

0

dateの列に従ってdf2からdf1までの行マッピングと、(2)2つのdata.framesの間の共通データ列名を事前計算します。その後、共通の列を繰り返し処理し、df1列内のどのセルがどちらもdf2にマップされ、値がNAであるかどうかをテストし、df2で使用可能な値からそれらのセルを割り当てます。

利点:

  • 完全に対応する列のセットを必要としません。列名でそれらを一致させます。
  • 共通の列を反復するだけで、df2にマップされたセルをdf1にマッピングし、NAセルを割り当てないで、最小限の量のデータを処理します。
  • 入力列のデータ型を保護します。 IOWでは、df1に異種の列型があった場合、これらの型はこの操作で破損することはありません。

rms <- match(df2$date,df1$date); 
cms <- intersect(names(df1)[-1L],names(df2)[-1L]); 
for (cm in cms) { n <- is.na(df1[[cm]][rms]); df1[[cm]][rms][n] <- df2[[cm]][n]; }; 
df1; 
##  date X11A X11A.1 X21B X3CC X3CC.1 
## 1 20040101 100 150 NA NA 140 
## 2 20040115 200  NA 200 NA  NA 
## 3 20040131 170 165 180 190 190 
## 4 20040205 NA  NA NA NA  NA 
## 5 20040228 140 145 165 150 155 
## 6 20040301 150 155 170 150 160 
## 7 20040315 NA  NA 180 190 200 
## 8 20040331 NA 145 160 175 180 

ベンチマーク

library(microbenchmark); 

`42` <- function(df1,df2) { valpos <- which(is.na(df1)[match(df2$date,df1$date),],arr.ind=TRUE); targpos <- cbind(match(df2$date,df1$date)[valpos[,'row']],valpos[,'col']); df1[targpos] <- df2[valpos]; df1; }; 
bgoldst <- function(df1,df2) { rms <- match(df2$date,df1$date); cms <- intersect(names(df1)[-1L],names(df2)[-1L]); for (cm in cms) { n <- is.na(df1[[cm]][rms]); df1[[cm]][rms][n] <- df2[[cm]][n]; }; df1; }; 

identical(`42`(df1,df2),bgoldst(df1,df2)); 
## [1] TRUE 
microbenchmark(`42`(df1,df2),bgoldst(df1,df2)); 
## Unit: microseconds 
##    expr  min  lq  mean median  uq  max neval 
##  `42`(df1, df2) 297.219 309.1935 340.1425 319.0295 333.9975 1236.771 100 
## bgoldst(df1, df2) 175.766 181.7530 192.9317 188.1670 198.2180 316.463 100 

set.seed(1L); 
NR1 <- 10000L; NC1 <- 300L; NR2 <- 1000L; NC2 <- 300L; probNA1 <- 0.5; probNA2 <- 0.1; 
df1 <- data.frame(date=as.integer(format(sort(sample(seq(as.Date('2004-01-01'),by=1L,len=NR1*5L),NR1)),'%Y%m%d'))); 
df1[paste0('X',seq_len(NC1))] <- matrix(sample(c(NA,100:200),NR1*NC1,T,c(probNA1,rep((1-probNA1)/101,101L))),NR1); 
df2 <- data.frame(date=sample(df1$date,NR2)); 
df2[paste0('X',seq_len(NC2))] <- matrix(sample(c(NA,100:200),NR2*NC2,T,c(probNA2,rep((1-probNA2)/101,101L))),NR2); 

identical(`42`(df1,df2),bgoldst(df1,df2)); 
## [1] TRUE 
microbenchmark(`42`(df1,df2),bgoldst(df1,df2)); 
## Unit: milliseconds 
##    expr  min  lq  mean median  uq  max neval 
##  `42`(df1, df2) 149.61503 194.66606 216.16916 231.25129 233.68079 277.24701 100 
## bgoldst(df1, df2) 29.17145 31.32318 37.85904 32.15154 33.24013 75.47765 100 
関連する問題