7

最初の 3 つの列にマーカーdata.frameに関する情報が含まれる大きなデータがあります。残りの列は、各個人のマーカーの数値型です。各個人には 3 つの列があります。データセットは次のようになります。

                      marker alleleA alleleB   X818 X818.1 X818.2   X345 X345.1 X345.2   X346 X346.1 X346.2
1   kgp5209280_chr3_21902067       T       A 0.0000 1.0000 0.0000 1.0000 0.0000 0.0000 0.0000 1.0000 0.0000
2 chr3_21902130_21902131_A_T       A       T 0.8626 0.1356 0.0018 0.7676 0.2170 0.0154 0.8626 0.1356 0.0018
3 chr3_21902134_21902135_T_C       T       C 0.6982 0.2854 0.0164 0.5617 0.3749 0.0634 0.6982 0.2854 0.0164

つまり、各マーカー (行) について、各個人は各列に 1 つずつ、合計 3 つの値を持ちます。

元の行と同じ行をすべて持つ新しいものを作成したいのですがdata.frame、個々の列は 1 つだけです。各個人の 1 つの列で、各個人の 3 つのうち 0.8 より大きい値が必要です。0.8 より大きい値がない場合は、NA を出力します。たとえば、最初の行に指定したデータ セットでは、2 番目の値を 818 (1.0000) に、最初の値を 345 (1.0000) にするとします。2 行目では、818 (0.8626) の最初の値が必要です。345 の場合、0.8 を超える値がないため、NA を出力したいなどです。したがって、新しいデータセットは次のようになります。

                     marker alleleA alleleB   X818 X345
1   kgp5209280_chr3_21902067       T       A 1.0000    1
2 chr3_21902130_21902131_A_T       A       T 0.8626   NA

私はif/elseステートメントを使用しようとしましたif [, 4] > 0.8 then [, 4], else...が、それは私が望むものを与えてくれないようです。また、このコマンドをループする必要があるため、最初の 3 列の 1 人の個人に対してだけではありません。ただし、すべての列に対して。

どんな助けでも大歓迎です！前もって感謝します。

4

4 に答える 4

15

data.table編集：バージョン> = 1.9.0で実装された高速溶解/ dcastメソッドを使用してソリューションを更新しました。詳細については、こちらをご覧ください。

require(data.table)
require(reshape2)
dt <- as.data.table(df)

# melt data.table
dt.m <- melt(dt, id=c("marker", "alleleA", "alleleB"), 
                 variable.name="id", value.name="val")
dt.m[, id := gsub("\\.[0-9]+$", "", id)] # replace `.[0-9]` with nothing
# aggregation
dt.m <- dt.m[, list(alleleA = alleleA[1], 
         alleleB = alleleB[1], val = max(val)), 
        keyby=list(marker, id)][val <= 0.8, val := NA]
# casting back
dt.c <- dcast.data.table(dt.m, marker + alleleA + alleleB ~ id)
#                        marker alleleA alleleB X345   X346   X818
# 1: chr3_21902130_21902131_A_T       A       T   NA 0.8626 0.8626
# 2: chr3_21902134_21902135_T_C       T       C   NA     NA     NA
# 3:   kgp5209280_chr3_21902067       T       A    1 1.0000 1.0000

解決策 1:おそらく最善の方法ではありませんが、現時点で考えられるのは次のとおりです。

mm <- t(apply(df[-(1:3)], 1, function(x) tapply(x, gl(3,3), max)))
mode(mm) <- "numeric"
mm[mm < 0.8] <- NA 
# you can set the column names of mm here if necessary
out <- cbind(df[, 1:3], mm)

#                       marker alleleA alleleB      1  2      3
# 1   kgp5209280_chr3_21902067       T       A 1.0000  1 1.0000
# 2 chr3_21902130_21902131_A_T       A       T 0.8626 NA 0.8626
# 3 chr3_21902134_21902135_T_C       T       C     NA NA     NA

gl(3,3)1,1,1,2,2,2,3,3,3レベルの値を持つ因子を与える1,2,3．つまり、一度に 3 つtapplyの値を取り、それらを取得します(最初の 3 つ、次の 3 つ、最後の 3 つ)。そして、各行を 1 つずつ送信します。xmaxapply

解決策 2:またはを使用せずに、および内にあるdata.table解決策:meltcastdata.table reshapereshape2

require(data.table)
dt <- data.table(df)
# melt your data.table to long format
dt.melt <- dt[, list(id = names(.SD), val = unlist(.SD)), 
                  by=list(marker, alleleA, alleleB)]
# replace `.[0-9]` with nothing
dt.melt[, id := gsub("\\.[0-9]+$", "", id)]
# get max value grouping by marker and id
dt.melt <- dt.melt[, list(alleleA = alleleA[1], 
                      alleleB = alleleB[1], 
                      val = max(val)), 
        keyby=list(marker, id)][val <= 0.8, val := NA]
# edit mnel (use setattr(,'names') to avoid copy by `names<-` within `setNames`
dt.cast <- dt.melt[, as.list(setattr(val,'names', id)), 
                   by=list(marker, alleleA, alleleB)]

#                        marker alleleA alleleB X345   X346   X818
# 1: chr3_21902130_21902131_A_T       A       T   NA 0.8626 0.8626
# 2: chr3_21902134_21902135_T_C       T       C   NA     NA     NA
# 3:   kgp5209280_chr3_21902067       T       A    1 1.0000 1.0000
于 2013-03-19T21:31:17.443 に答える
3

I think it is better here to put your data in the long format. Here a solution based on reshape2 package , maybe similar to second @Arun solution but syntactically different 

library(reshape2)
dat.m <- melt(dat,id.vars=1:3)
dat.m$variable <- gsub('[.].*','',dat.m$variable)
dcast(dat.m,...~variable,fun.aggregate=function(x){
   res <- NA_real_
   if(length(x) > 0 && max(x)> 0.8)
      res <- max(x)
   res
})

                      marker alleleA alleleB X345   X346   X818
1 chr3_21902130_21902131_A_T       A       T   NA 0.8626 0.8626
2 chr3_21902134_21902135_T_C       T       C   NA     NA     NA
3   kgp5209280_chr3_21902067       T       A    1 1.0000 1.0000
于 2013-03-19T22:25:03.560 に答える
1

関数を使用した私のアプローチは次のとおりpmaxです。各個人に 0.8 を超える値が 2 つ以上ある場合、これにより最大値が得られることに注意してください。

df <- read.table(textConnection("                      marker alleleA alleleB   X818 X818.1 X818.2   X345 X345.1 X345.2   X346 X346.1 X346.2
1   kgp5209280_chr3_21902067       T       A 0.0000 1.0000 0.0000 1.0000 0.0000 0.0000 0.0000 1.0000 0.0000
2 chr3_21902130_21902131_A_T       A       T 0.8626 0.1356 0.0018 0.7676 0.2170 0.0154 0.8626 0.1356 0.0018
3 chr3_21902134_21902135_T_C       T       C 0.6982 0.2854 0.0164 0.5617 0.3749 0.0634 0.6982 0.2854 0.0164"), header=TRUE)

#data.table solution
library(data.table)
DT <- as.data.table(df)
DT[, M818 := ifelse(pmax(X818, X818.1, X818.2) > 0.8, pmax(X818, X818.1, X818.2), NA)]
DT[, M345 := ifelse(pmax(X345, X345.1, X345.2) > 0.8, pmax(X345, X345.1, X345.2), NA)]
DT[, M346 := ifelse(pmax(X346, X346.1, X346.2) > 0.8, pmax(X346, X346.1, X346.2), NA)]

#Base R solution
df$M818 <- ifelse(pmax(df$X818, df$X818.1, df$X818.2) > 0.8, pmax(df$X818, df$X818.1, df$X818.2), NA)
df$M345 <- ifelse(pmax(df$X345, df$X345.1, df$X345.2) > 0.8, pmax(df$X345, df$X345.1, df$X345.2), NA)
df$M346 <- ifelse(pmax(df$X346, df$X346.1, df$X346.2) > 0.8, pmax(df$X346, df$X346.1, df$X346.2), NA)

他の列を取り除きたい場合は、次のように入力します。

DT[, list(marker, alleleA, alleleB, M818, M345, M346)]
                       marker alleleA alleleB   M818 M345   M346
1:   kgp5209280_chr3_21902067       T       A 1.0000    1 1.0000
2: chr3_21902130_21902131_A_T       A       T 0.8626   NA 0.8626
3: chr3_21902134_21902135_T_C       T       C     NA   NA     NA
于 2013-03-19T21:35:01.833 に答える
0

これらは別の可能な解決策です。上記の解決策はすべて有効です。

私の解決策は、新しいライブラリを使用せずに、大文字と小文字を区別する関数を作成することです。かなり長く、コンパクトにすることもできますが、機能の仕組みを理解するために各ステップを確認すると便利です。

olddf <- data.frame(marker = c("kgp5209280_chr3_21902067",
        "chr3_21902130_21902131_A_T",
        "chr3_21902134_21902135_T_C"),
        alleleA = c("T","A","T"),
        alleleB = c("A","T","C"),
        X818 = c(0.0000,0.8626,0.6982),
        X818.1 = c(1.0000,0.1356,0.2854),
        X818.2 = c(0.0000,0.0018,0.0164),
        X345 = c(1.0000,0.7676, 0.5617),
        X345.1 = c(0.0000, 0.2170, 0.3749),
        X345.2 = c(0.0000, 0.0154, 0.0634),   
        X346 = c(0.0000, 0.8626, 0.6982),
        X346.1 = c(1.0000,0.1356, 0.2854), 
        X346.2 = c(0.0000, 0.0018, 0.0164))


mergeallele <- function(arguments,threshold = 0.8){
    n <- nrow(arguments)
    # Creation of a results object as an empty list of length NROW
    # speed for huge data.frame 
    new.lst <- vector(mode="list", n)
    for (i in 1:n){
        marker_row <- arguments[i,]
        colvalue.4 <- NaN
        if (max(marker_row[,c(4:6)]) < threshold){
            colvalue.4 <- max(marker_row[,c(4:6)])
        }

        colvalue.5 <- NaN       
        if (max(marker_row[,c(7:9)]) < threshold){
            colvalue.5 <- max(marker_row[,c(7:9)])
        }

        colvalue.6 <- NaN       
        if (max(marker_row[,c(10:12)]) < threshold){
            colvalue.6 <- max(marker_row[,c(10:12)])
        }
        new.lst[[i]]  <- data.frame(marker_row[,1],
            marker_row[,2],
            marker_row[,3],
            colvalue.4,
            colvalue.5,
            colvalue.6)     
    }   
    new.df <- as.data.frame(do.call("rbind",new.lst))
    names(new.df) <-  c(colnames(arguments)[1],
                    colnames(arguments)[2],
                    colnames(arguments)[3],
                    colnames(arguments)[4],
                    colnames(arguments)[7],
                    colnames(arguments)[10])
    return(new.df)
}


newdf <- mergeallele(olddf)

                      marker alleleA alleleB   X818   X345   X346
1   kgp5209280_chr3_21902067       T       A    NaN    NaN    NaN
2 chr3_21902130_21902131_A_T       A       T    NaN 0.7676    NaN
3 chr3_21902134_21902135_T_C       T       C 0.6982 0.5617 0.6982

約：

threshold = 0.8

しきい値 (例: 0.8) を設定して、関数内の変数を変更しないようにすることができます

new.lst <- vector(mode="list", n)

古いdata.frameの長さの空のリストを作成すると、リストの要素がループ結果で徐々に満たされます（はるかに高速です）。このブログからテスト速度を参照してください

于 2013-03-19T22:28:34.940 に答える