Useful apply functions

llapply.R

pair.lapply <- function(list1, list2, fun, list3=NULL){
    results <- list()
    for (i in 1:length(list1)){
    	if (is.null(list3)){
    		results[[i]] <- do.call(fun, list(list1[[i]],list2[[i]]))
    	} else {
    		results[[i]] <- do.call(fun, list(list1[[i]][list3[[i]]],list2[[i]][list3[[i]]]))
    	}
    }
    results
}

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
}

mmapply <- function(matrix1,matrix2,fun, MARGIN=2){
	temp <- unlist(apply(matrix1, MARGIN, function(x){
		unlist(apply(matrix2, MARGIN, function(y){
			do.call(fun, list(x,y))
		}))
	}))
	temp <- matrix(temp, ncol(matrix1), ncol(matrix2), byrow=TRUE)
	if (MARGIN==2){
		colnames(temp) <- colnames(matrix2)
		rownames(temp) <- colnames(matrix1)
	} else {
		colnames(temp) <- rownames(matrix2)
		rownames(temp) <- rownames(matrix1)
	}
	temp
}