Creating a matrix of vectors with apply (or other iterative function) in R -
i need run orthogonal encoding function on set of octamers (sets of 8 letters), , return them matrix of nx160 numbers (where n number of octamers on data).
the orthogonal coding functions is:
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]] (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 have asked, here example, if not part isn't working:
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 the function working on individual octamers, when try use lapply on it, result 160 numbers vector, time code altered (and meaningless).
lapply(data[1], orthocode) the result looks like:
$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 the orthocode function working. need know how take octamers dataframe, run fucntion on them , result end matrix looks one:
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 the output hase matrix of n rows, 160 columns. on data have run it, result matrix should 947x160 one.
any ideas?
we can simplify ifelse match, , drop 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 })) }
Comments
Post a Comment