6

次のような 5845*1095 (行*列) のデータ フレームがあります。

 9  286593   C     C/C     C/A     A/A
 9  334337   A     A/A     G/A     A/A
 9  390512   C     C/C     C/C     C/C

c <-  c("9", "286593", "C", "C/C", "C/A", "A/A") 
d <-  c("9", "334337", "A", "A/A", "G/A", "A/A")
e <-   c("9", "390512", "C", "C/C", "C/C", "C/C")
dat <- data.frame(rbind(c,d,e))

3列目の値を使用して列を右に変更したいので、(行1ごとに)列3が「C」の場合、列4は「C/C」から「0」に変わります。同じ手紙。1 文字一致は "1" (1 文字目または 2 文字目) で、文字一致なしは "2" です。

9 286593  C  0  1  2
9 334337  A  0  1  0
9 390512  C  0  0  0 

c <-  c("9", "286593", "C", "0", "1", "2") 
d <-  c("9", "334337", "A", "0", " 1", "0")
e <-   c("9", "390512", "C", "0", "0", "0")
dat <- data.frame(rbind(c,d,e))

Rでネストされた For ループを使用する習慣から抜け出したいので、これを行う最善の方法を知りたいと思っています。

4

6 に答える 6

5

最初にあなたのデータ：

c <-  c("9", "286593", "C", "C/C", "C/A", "A/A")
# Note: In your original data, you had a space in "G/A", which I did remove. 
# If this was no mistake, we would also have to deal with the space.
d <-  c("9", "334337", "A", "A/A", "G/A", "A/A")
e <-   c("9", "390512", "C", "C/C", "C/C", "C/C")
dat <- data.frame(rbind(c,d,e))

ここで、使用可能なすべての文字を含むベクトルを生成します。

values <- c("A", "C", "G", "T")
dat$X3 <- factor(dat$X3, levels=values) # This way we just ensure that it will later on be possible to compare the reference values to our generated data. 

# Generate all possible combinations of two letters
combinations <- expand.grid(f=values, s=values)
combinations <- cbind(combinations, v=with(combinations, paste(f, s, sep='/')))

メイン関数は、各列の各組み合わせの正しい列を見つけ、これを参照列 3 と比較します。 

compare <- function(col, val) {
    m <- match(col, combinations$v)
    2 - (combinations$f[m] == val) - (combinations$s[m] == val)
}

最後に、apply を使用して、変更が必要なすべての列に対して関数を実行します。6 を実際の列数に変更することをお勧めします。 

dat[,4:6] <- apply(dat[,4:6], 2, compare, val=dat[,3])

これまでの他のソリューションと比較して、このソリューションは文字列比較を使用せず、純粋に因子レベルに基づくアプローチであることに注意してください。どちらがより優れたパフォーマンスを発揮するかを見るのは興味深いでしょう。

編集

私はいくつかのベンチマークを行いました：

    test replications elapsed relative user.self sys.self user.child sys.child
1   arun      1000000   2.881    1.116     2.864    0.024          0         0
2  fabio      1000000   2.593    1.005     2.558    0.030          0         0
3 roland      1000000   2.727    1.057     2.687    0.048          0         0
5  thilo      1000000   2.581    1.000     2.540    0.036          0         0
4  tyler      1000000   2.663    1.032     2.626    0.042          0         0

これにより、私のバージョンはわずかに速くなります。ただし、違いはほとんどないため、おそらくすべてのアプローチで問題ありません。公平を期すために、因子レベルを追加する部分のベンチマークは行いませんでした。これも同様に行うと、おそらく私のバージョンが除外されます。

于 2013-06-24T15:24:24.670 に答える
4

ここに1つのアプローチがあります：

FUN <- function(x) {
    a <- strsplit(as.character(unlist(x[-1])), "/")
    b <- sapply(a, function(y) sum(y %in% as.character(unlist(x[1]))))
    2 - b
}

dat[4:6] <-  t(apply(dat[, 3:6], 1, FUN))

## > dat
##   X1     X2 X3 X4 X5 X6
## c  9 286593  C  0  1  2
## d  9 334337  A  0  1  0
## e  9 390512  C  0  0  0
于 2013-06-24T15:25:32.387 に答える
4

を使用する 1 つの方法を次に示しapplyます。

out <- apply(dat[, -(1:2)], 1, function(x) 
        2 - grepl(x[1], x[-1]) -  
        x[-1] %in% paste(x[1], x[1], sep="/"))
cbind(dat[, (1:3)], t(out))
于 2013-06-24T15:31:21.370 に答える
3

このソリューションはあまり効率的ではありません。

dat <-  cbind(dat[,-(4:6)],
              t(sapply(seq_len(nrow(dat)),function(i){
                res <- dat[i,]
                res[,4:6] <- lapply(res[,4:6],function(x) 2-sum(gregexpr(res[,3],x)[[1]]>0))
              })))

#  X1     X2 X3 X4 X5 X6
#c  9 286593  C  0  1  2
#d  9 334337  A  0  1  0
#e  9 390512  C  0  0  0
于 2013-06-24T15:26:48.847 に答える
2

醜いですが、うまくいきます！

fff<-apply(dat[,4:ncol(dat)],2,substr,1,1)!=dat[,3]
ggg<-apply(dat[,4:ncol(dat)],2,substr,3,3)!=dat[,3]
final<-fff+ggg
cbind(dat,final)
X1     X2 X3  X4  X5  X6 X4 X5 X6
c  9 286593  C C/C C/A A/A  0  1  2
d  9 334337  A A/A G/A A/A  0  1  0
e  9 390512  C C/C C/C C/C  0  0  0
于 2013-06-24T15:28:18.663 に答える