Before I forget

getCorrelation.R

D <- split(as.data.frame(M), A)
correlations <- llapply(D,D,getCorrelation)


llapply <- function(list1,list2, fun){
	temp <- unlist(lapply(list1, function(x){
	unlist(lapply(list2, function(y){
	do.call(fun, list(x,y))
	}))
	}))
	temp <- matrix(temp, length(list1), length(list2), byrow=TRUE)
	#colnames(temp) <- names(list2)
	#rownames(temp) <- names(list1)
	temp
}



getCorrelation <- function(block1, block2, method="pearson"){
	p1 <- nrow(block1)
	p2 <- nrow(block2)
	p  <- min(p1,p2)
	block1 <- block1[sample(p1,p),,drop=FALSE]
	block2 <- block2[sample(p2,p),,drop=FALSE]

	col1 <- block1[,1]
	col2 <- block1[,2]
	
	pair.mapply <- function(list1, list2, fun){
		results <- list()
		for (i in 1:length(list1)){
			results[[i]] <- do.call(fun, list(list1[,i],list2[,i]))
		}
		results
	}

	unfold.blocks <- function(col1,col2){
		nn <- length(col1)
		cbind(col1[sample(nn)], col2[sample(nn)])
	}
	unfolded <- do.call(rbind, pair.mapply(block1,block2, unfold.blocks))
	cor(unfolded[,1],unfolded[,2], method=method)
}