R: Processing data within a loop - r

Question

Below, I run a loop using the sample data provided, appending necessary items to geneexptest, and processing it further within the loop. However, in building dfs, I wish for the endpoint of each run to be data.frame(geneexptotal,...), as shown. The problem is, it seems to be stopping somehow at geneexptestapp, and outputting that instead into dfs each round. Please let me know how I might include the rest of the loop into the output.
gex <- data.frame("sample" = c("BIX","HEF","TUR","ZOP","VAG","JUF","FED","MEQ","YIF","HRB","LOP","LIX","COT","DRP","KFC","TUY","DOG","KEX","RAV","UEH"),
"TCGA-F4-6703-01" = runif(20, -1, 1),
"TCGA-DM-A28E-01" = runif(20, -1, 1),
"TCGA-AY-6197-01" = runif(20, -1, 1),
"TCGA-A6-5657-01" = runif(20, -1, 1))
colnames(gex) <- gsub("[.]", "_",colnames(gex))
listx <- c("TCGA_DM_A28E_01","TCGA_A6_5657_01")
mxy <- data.frame("TCGA-AD-6963-01" = runif(20, -1, 1),
"TCGA-AA-3663-11" = runif(20, -1, 1),
"TCGA-AD-6901-01" = runif(20, -1, 1),
"TCGA-AZ-2511-01" = runif(20, -1, 1),
"TCGA-A6-A567-01" = runif(20, -1, 1))
colnames(mxy) <- gsub("[.]", "_",colnames(mxy))
zScore <- function(x,y)((as.numeric(x) - as.numeric(rowMeans(y,na.rm=T)))/as.numeric(sd(y,na.rm=T)))
dfs <- lapply(listx, function(colName) {
do.call(rbind, lapply(seq(nrow(mxy)), function(i) {
zvalues <- zScore(gex[i,colName], mxy[i,])
geneexptest <- data.frame(gex$sample[i], zvalues, row.names = NULL, stringsAsFactors = TRUE)
geneexptest$zvalues <- as.numeric(as.character(geneexptest$zvalues))
is.na(geneexptest) <- sapply(geneexptest, is.infinite)
geneexptestapp <- na.omit(geneexptest)
geneexptestorder <- geneexptestapp[order(geneexptestapp$zvalues, decreasing = FALSE, na.last = NA), ]
geneexpa <- geneexptestorder[1:((0.05)*nrow(geneexptest)),]
geneexpz <- geneexptestorder[(nrow(geneexptestorder)-((0.05)*nrow(geneexptest))):nrow(geneexptestorder),]
geneexptotal <- rbind(geneexpa, geneexpz)
data.frame(geneexptotal$gex.sample, row.names = NULL, stringsAsFactors = TRUE)
}))
})

Answer 1

Your code, as it is, is working fine. You just have unexpected output because of some data management you're doing. I broke your code out a bit to help with readability. I made two new functions, fun1 and fun2 - fun2 is your inner function and fun1 is the outer function. fun2 takes colName as an argument to pass it along.
fun2 = function(i,colName) {
zvalues <- zScore(gex[i,colName], mxy[i,])
geneexptest <- data.frame(gex$sample[i], zvalues, row.names = NULL, stringsAsFactors = TRUE)
geneexptest$zvalues <- as.numeric(as.character(geneexptest$zvalues))
is.na(geneexptest) <- sapply(geneexptest, is.infinite)
geneexptestapp <- na.omit(geneexptest)
geneexptestorder <- geneexptestapp[order(geneexptestapp$zvalues, decreasing = FALSE, na.last = NA), ]
geneexpa <- geneexptestorder[1:((0.05)*nrow(geneexptest)),]
geneexpz <- geneexptestorder[(nrow(geneexptestorder)-((0.05)*nrow(geneexptest))):nrow(geneexptestorder),]
geneexptotal <- rbind(geneexpa, geneexpz)
data.frame(geneexptotal, row.names = NULL, stringsAsFactors = TRUE)
}
fun1 = function(colName) {
do.call(rbind, lapply(seq(nrow(mxy)), fun2, colName=colName))
}
dfs <- lapply(listx, fun1)
So, listx has two column names in it - let's start with the first one, TCGA_DM_A28E_01. So, we call fun1("TCGA_DM_A28E_01"). This is going to rbind each of 5 (nrow(mxy) = 5) iterations for fun2.
So, let's start with i=1 (we're now in fun2). You take one value from gex and one row from mxy, put them in zScore which gives a value of -0.6955057. You then make a one row data.frame and do some stuff to the zvalues column. So we have:
> geneexptest
gex.sample.i. zvalues
1 BIX -0.6955057
Do some checks and verify that nothing is infinite and remove it if it is. So now we have:
> geneexptestapp
gex.sample.i. zvalues
1 BIX -0.6955057
Now you do some ordering on a 1 row data frame. Nothing changes. This is where the problem is nrow(geneexptest) = 1 so for geneexpa you're asking for rows 1:.05 which is the same as 1 and for geneexpz you're asking for rows .95:1 which is 0.95. There are no fractional rows. This results in:
> geneexpa;geneexpz
gex.sample.i. zvalues
1 BIX -0.6955057
[1] gex.sample.i. zvalues
<0 rows> (or 0-length row.names)
which you rbind and return as a data frame. In this case, it results in a single row data frame. fun1 produces 5 of these and rbinds them together giving you a 5 row data.frame. dfs is a list of 2 of these.
Your code suggests you expect to get more than 1 row (your multiplication suggests at least 20) but there's only 1. Either the example here isn't complete or you need to rethink what's happening in fun2.
UPDATE
OK, given your updated requirements, consider this function:
getExtremeValues = function(x,p=0.05){
z = x[,2]
n = ceiling(nrow(x)*p)
r = x[order(z),1]
return(as.character(r[c(1:n,length(r):(length(r)-n+1))]))
}
You pass this function a dataframe (x), tell it which column has your zvalues (c = 2, by default) and what proportion you want from the top and bottom (p = 0.05 by default). It then returns the first column where the zvalues are in the top and bottom percent.
How to make this all work:
fun2 = function(i,colName) {
zvalues <- zScore(gex[i,colName], mxy[i,])
geneexptest <- data.frame(gex$sample[i], zvalues, row.names = NULL, stringsAsFactors = TRUE)
geneexptest$zvalues <- as.numeric(as.character(geneexptest$zvalues))
is.na(geneexptest) <- sapply(geneexptest, is.infinite)
return(na.omit(geneexptest))
}
fun1 = function(colName) {
getExtremeValues(do.call(rbind, lapply(seq(nrow(mxy)), fun2, colName=colName)))
}
dfs <- lapply(listx, fun1)
This returns:
> dfs
[[1]]
[1] "BIX" "TUY"
[[2]]
[1] "BIX" "TUR"
Given there are 20 samples, 1 is in the top 5%, 1 is in the bottom 5%, there are two column names listed in listx, so 4 samples returned.