PageRenderTime 7ms CodeModel.GetById 1ms app.highlight 4ms RepoModel.GetById 1ms app.codeStats 0ms

/working/auteur/R/intercalate.samples.R

http://github.com/eastman/auteur
R | 38 lines | 32 code | 4 blank | 2 comment | 9 complexity | d0cee096712e7fa4c0b38ecaf76b48c0 MD5 | raw file
 1#general utility for combining supplied list of dataframes into a single 'intercalated' sample. E.g., list(as.data.frame(c(AAA)),as.data.frame(c(BBB))) becomes data.frame(c(ABABAB))
 2#author: JM EASTMAN 2010
 3
 4intercalate.samples <-
 5function(list.obj) {
 6	if(length(list.obj)<2) warning("Nothing to be done... too few objects in list.")
 7	vv=sapply(list.obj, is.vector)
 8	if(all(vv)) list.obj=lapply(list.obj, function(x) {y=data.frame(x); names(y)=NULL; return(y)})
 9	orig.names=names(list.obj[[1]])
10	n=length(list.obj)
11	R=sapply(list.obj, nrow)
12	if(length(unique(R))!=1) {
13		minR=nrow(list.obj[[which(R==min(R))]])
14		list.obj=lapply(list.obj, function(x) {y=as.data.frame(x[1:minR,]); names(y)=orig.names; return(y)})
15		warning("Objects pruned to the length of the smallest.")
16	}
17	C=sapply(list.obj, ncol)
18	if(length(unique(C))!=1) stop("Cannot process objects; column lengths do not match.")
19	c=unique(C)
20	if(c>1) {
21		M=lapply(1:length(list.obj), function(x) mm=match(names(list.obj[[x]]), orig.names))
22		for(mm in 2:length(list.obj)) {
23			list.obj[[mm]]=list.obj[[mm]][,M[[mm]]]
24		}
25	}
26	r=nrow(list.obj[[1]])
27	indices=lapply(1:n, function(x) seq(x, r*n, by=n))
28	
29	out.array=array(dim=c(r*n, c))
30	for(nn in 1:n){
31		out.array[indices[[nn]],]=as.matrix(list.obj[[nn]])
32	}
33	
34	out.array=data.frame(out.array)
35	if(!is.null(orig.names)) names(out.array)=orig.names else names(out.array)=paste("X",1:ncol(out.array),sep="")
36	return(out.array)
37}
38