1

八量体のセット (8 文字のセット) に対して直交エンコード関数を実行し、nx160 の数値の行列として返す必要があります (n はデータの八量体の数です)。

直交符号化関数は次のとおりです。

  orthocode <- function(octamer){
        matcode <- c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
        octamer_char <- as.character(octamer)
        octamer_split <- strsplit(octamer_char,"")[[1]]
        for (letter in octamer_split){
           ifelse (letter == "A", (matcode = rbind(matcode,c(1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0))),
           ifelse (letter == "R", (matcode = rbind(matcode,c(0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0))),
           ifelse (letter == "N", (matcode = rbind(matcode,c(0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0))),
           ifelse (letter == "D", (matcode = rbind(matcode,c(0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0))),
           ifelse (letter == "C", (matcode = rbind(matcode,c(0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0))),
           ifelse (letter == "Q", (matcode = rbind(matcode,c(0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0))),
           ifelse (letter == "E", (matcode = rbind(matcode,c(0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0))),
           ifelse (letter == "G", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0))),
           ifelse (letter == "H", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0))),
           ifelse (letter == "I", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0))),
           ifelse (letter == "L", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0))),
           ifelse (letter == "K", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0))),
           ifelse (letter == "M", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0))),
           ifelse (letter == "F", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0))),
           ifelse (letter == "P", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0))),
           ifelse (letter == "S", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0))),
           ifelse (letter == "T", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0))),
           ifelse (letter == "W", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0))),
           ifelse (letter == "Y", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0))),
           ifelse (letter == "V", (matcode = rbind(matcode,c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1)))
           ))))))))))))))))))))
       }
       matcode <- matcode[-1,]
       matcode <- c(matcode)
       return(matcode)
    }

一部の人が尋ねたように、これが機能していない部分ではない場合でも、例を次に示します。

 orthocode("ARNDCQEG")
 [1] 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 [81] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

この関数は個々のオクタマーで動作していますが、lapply を使用しようとすると、結果は 160 個の数値ベクトルになり、今回はコードが変更されています (そして無意味です)。

lapply(data[1], orthocode)

結果は次のようになります。

$V1
[1] 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
[81] 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

オルソコード機能は実際に機能しています。私が知る必要があるのは、データフレームからオクタマーを取得し、それらに対して機能を実行する方法です。その結果、次のようなマトリックスになります。

rbind(orthocode("ARNDCQEG"),orthocode("NGJKAEPS"),orthocode("ABGSWKLA"))
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24] [,25] [,26] [,27] [,28]
[1,]    1    0    0    0    0    0    0    0    0     1     0     0     0     0     0     0     0     0     1     0     0     0     0     0     0     0     0     1
[2,]    0    0    0    0    1    0    0    0    0     0     0     0     0     0     0     0     1     0     0     0     0     0     0     0     0     0     0     0
[3,]    1    0    0    0    0    0    0    1    0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
     [,29] [,30] [,31] [,32] [,33] [,34] [,35] [,36] [,37] [,38] [,39] [,40] [,41] [,42] [,43] [,44] [,45] [,46] [,47] [,48] [,49] [,50] [,51] [,52] [,53] [,54]
[1,]     0     0     0     0     0     0     0     0     1     0     0     0     0     0     0     0     0     1     0     0     0     0     0     0     0     0
[2,]     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     1
[3,]     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
     [,55] [,56] [,57] [,58] [,59] [,60] [,61] [,62] [,63] [,64] [,65] [,66] [,67] [,68] [,69] [,70] [,71] [,72] [,73] [,74] [,75] [,76] [,77] [,78] [,79] [,80]
[1,]     1     0     0     0     0     0     0     0     0     1     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
[2,]     0     0     0     1     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
[3,]     0     0     0     0     1     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
     [,81] [,82] [,83] [,84] [,85] [,86] [,87] [,88] [,89] [,90] [,91] [,92] [,93] [,94] [,95] [,96] [,97] [,98] [,99] [,100] [,101] [,102] [,103] [,104] [,105]
[1,]     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0      0      0      0      0      0      0
[2,]     0     0     0     0     0     0     0     0     0     0     0     1     0     0     0     0     0     0     0      0      0      0      0      0      0
[3,]     0     0     0     0     0     0     1     0     0     0     0     0     0     1     0     0     0     0     0      0      0      0      0      0      0
     [,106] [,107] [,108] [,109] [,110] [,111] [,112] [,113] [,114] [,115] [,116] [,117] [,118] [,119] [,120] [,121] [,122] [,123] [,124] [,125] [,126] [,127]
[1,]      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0
[2,]      0      0      0      0      0      0      0      0      0      0      0      0      0      1      0      0      0      0      0      0      0      0
[3,]      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      1      0      0      0
     [,128] [,129] [,130] [,131] [,132] [,133] [,134] [,135] [,136] [,137] [,138] [,139] [,140] [,141] [,142] [,143] [,144] [,145] [,146] [,147] [,148] [,149]
[1,]      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0
[2,]      1      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0      0
[3,]      0      0      0      0      0      0      0      0      0      0      0      0      0      1      0      0      0      0      0      0      0      0
     [,150] [,151] [,152] [,153] [,154] [,155] [,156] [,157] [,158] [,159] [,160]
[1,]      0      0      0      0      0      0      0      0      0      0      0
[2,]      0      0      0      0      0      0      0      0      0      0      0
[3,]      0      0      0      0      0      0      0      0      0      0      0

出力は n 行 160 列の行列でなければなりません。実行する必要があるデータでは、結果のマトリックスは 947x160 になるはずです。

何か案は？

4

3 に答える 3

2

R はベクトル化されます。ケースごとに個別のコード チャンクを実行することは忘れてください。ループでオブジェクトを成長させないでください。私は単に一緒に行きます 

orthocode <- function(octamer) {

  # Predifine identity matrix
  m <- diag(20) 

  # Predefine values vector (no "J" or "B" here btw)
  rownames(m) <- c("A", "R", "N", "D", "C", "Q", "E", "G", "H", "I", "L",
                   "K", "M", "F", "P", "S", "T", "W", "Y", "V") 

  # Create a character vector for each input
  octamer_split <- strsplit(as.character(octamer), "", fixed = TRUE)

  # match values for each value
  t(sapply(octamer_split, function(x) m[match(x, rownames(m)),])) 

}

この関数は、単一の入力またはベクトルの両方に対して機能します。を使用してテストできます

orthocode(c("ARNDCQEG", "NGJKAEPS", "ABGSWKLA"))

またはあなたの場合、単に使用して

orthocode(data[, 1])

PS

あなたのベクトルにはJまたはBがないので、あなたの例ではどのように扱われるべきかわかりません。この場合、NAsを返します。

于 2016-11-05T22:06:59.560 に答える
2

で簡略化ifelseしてmatch、以下を削除できforloopます。

orthocode <- function(octamer){
  matcode <- rep(0, 20)
  octamer_char <- as.character(octamer)
  octamer_split <- strsplit(octamer_char,"")[[1]]

  t(sapply(octamer_split, function(letter){
    res <- matcode
    res[ match(letter, c("A","R","N","D","C","Q","E","G","H","I",
                         "L","K","M","F","P","S","T","W","Y","V"))] <- 1
    res
  }))
}
于 2016-11-05T21:13:00.110 に答える
2

switch他の言語に存在する CASE 構造のセマンティクスを持っています。良い例がないので軽くテストしましたが、代わりにこれを試してください:

orthocode <- function(octamer){
    matcode <- c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
    octamer_char <- as.character(octamer)
    octamer_split <- strsplit(octamer_char,"")[[1]]
    for (letter in octamer_split){ 
        val <- switch( letter,  
       "A" = c(1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
       "R" = c(0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
       "N" = c(0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
       "D" = c(0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
       "C" = c(0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
       "Q" = c(0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
       "E" = c(0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0),
       "G" = c(0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0),
       "H" = c(0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0),
       "I" = c(0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0),
       "L" = c(0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0),
       "K" = c(0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0),
       "M" = c(0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0),
       "F" = c(0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0),
       "P" = c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0),
       "S" = c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0),
       "T" = c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0),
       "W" = c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0),
       "Y" = c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0),
       "V" = c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1)
                 )
      matcode=c(matcode,val)
     }
   matcode 
}

matcode <- c(matcode)マトリックス構造を破壊するという副作用があるため、 の行を削除することに注意してください。これとともに：

dat <- list("ARNDE", "CQEGD")

私は得る：

     t( sapply(dat, orthocode) )
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16] [,17]
[1,]    0    0    0    0    0    0    0    0    0     0     0     0     0     0     0     0     0
[2,]    0    0    0    0    0    0    0    0    0     0     0     0     0     0     0     0     0
     [,18] [,19] [,20] [,21] [,22] [,23] [,24] [,25] [,26] [,27] [,28] [,29] [,30] [,31] [,32]
[1,]     0     0     0     1     0     0     0     0     0     0     0     0     0     0     0
[2,]     0     0     0     0     0     0     0     1     0     0     0     0     0     0     0
     [,33] [,34] [,35] [,36] [,37] [,38] [,39] [,40] [,41] [,42] [,43] [,44] [,45] [,46] [,47]
[1,]     0     0     0     0     0     0     0     0     0     1     0     0     0     0     0
[2,]     0     0     0     0     0     0     0     0     0     0     0     0     0     1     0
     [,48] [,49] [,50] [,51] [,52] [,53] [,54] [,55] [,56] [,57] [,58] [,59] [,60] [,61] [,62]
[1,]     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
[2,]     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
     [,63] [,64] [,65] [,66] [,67] [,68] [,69] [,70] [,71] [,72] [,73] [,74] [,75] [,76] [,77]
[1,]     1     0     0     0     0     0     0     0     0     0     0     0     0     0     0
[2,]     0     0     0     0     1     0     0     0     0     0     0     0     0     0     0
     [,78] [,79] [,80] [,81] [,82] [,83] [,84] [,85] [,86] [,87] [,88] [,89] [,90] [,91] [,92]
[1,]     0     0     0     0     0     0     1     0     0     0     0     0     0     0     0
[2,]     0     0     0     0     0     0     0     0     0     0     1     0     0     0     0
     [,93] [,94] [,95] [,96] [,97] [,98] [,99] [,100] [,101] [,102] [,103] [,104] [,105] [,106]
[1,]     0     0     0     0     0     0     0      0      0      0      0      0      0      0
[2,]     0     0     0     0     0     0     0      0      0      0      0      1      0      0
     [,107] [,108] [,109] [,110] [,111] [,112] [,113] [,114] [,115] [,116] [,117] [,118] [,119]
[1,]      1      0      0      0      0      0      0      0      0      0      0      0      0
[2,]      0      0      0      0      0      0      0      0      0      0      0      0      0
     [,120]
[1,]      0
[2,]      0

最後にこれを使用すると、結果が良くなります（ただし、あなたが反対したものではありません）：

    matcode <- matcode[-1, ,drop=FALSE]
    rownames(matcode) <- octamer_split
    return(matcode)  # here the return call is needed.
于 2016-11-05T20:50:53.630 に答える