2016-11-05 40 views
1

Мне нужно запустить функцию ортогонального кодирования по набору октамеров (наборов из 8 букв) и вернуть их в виде матрицы из чисел nx160 (где n - количество октамеров по данным).Создание матрицы векторов с применением (или другой итеративной функции) в R

ортогональной функции кодирования:

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) 
    } 

AS некоторые спрашивали, вот пример, даже если это не та часть, которая не работает:

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 

Функция работая над отдельными октамерами, но когда я пытаюсь использовать на нем латентность, результатом является всего лишь вектор с 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 

Функция orthocode на самом деле работает. Что мне нужно знать, как я беру октамеры из в dataframe, запустите fucntion на них, в результате чего в конечном итоге с матрицей, которая выглядит как этот:

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 

Выход Hase быть матрицей из n строк, 160 столбцов. По данным, которые я должен запустить, матрица результатов должна быть равна 947x160.

Любые идеи?

+0

'ifelse' - это не дизайн для выполнения кода, а выбор из элементов в векторах на основе логического входного вектора. В этом случае довольно неэффективным подходом было бы преобразование 'ifelse' в' if (test) {code1} else {rest_of_code} '. Более эффективные методы, несомненно, возможны, но вы не представили полный пример, а не полный пример. –

+0

Можете ли вы добавить желаемый результат для нескольких тестовых строк? –

+0

Мы не знаем, что у вас есть в 'data [1]' и что должно быть для него результатом. Просто показать пример для 'orthocode (« ARNDCQEG »)' не полезно. Было бы полезно, если бы вы могли отображать первые 2-3 значения в 'data [1]', и они должны обрабатываться –

ответ

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 
    })) 
} 
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. 
+0

Я не думаю, что' switch' + растущие объекты в цикле являются хорошая практика для чего-то, что очень легко можно было бы векторизовать –

+0

Спасибо за совет о 'switch', теперь он выглядит лучше. «matcode <- c (matcode) был там специально, так как он является одним из реквизитов. Матрица результатов должна быть 160xn, а 160 - матрицей каждого октамера, преобразованного в вектор. Проблема заключается не в функции, а в том, что я не знаю, как создать матрицу с отдельными результатами. – Hjorvik

+0

Если вы хотите получить матрицу (со значениями в столбцах), просто используйте 'sapply' и транспонируйте, если вам нужны строки. Это считается хорошим манером для поддержки полезных ответов. –

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]) 

P.S.

У вас нет J или B в вашем векторе, поэтому не уверен, как это должно быть принято для вашего примера. В этом случае он возвращает NA s