Replace sapply calls with vapply or lapply

as of 4d76f6529, there are a lot of sapply calls. We should probably convert these at some point.

The following list is generated with:

$ grep -inr sapply R

List of sapply calls

``` R/accessors.R:302: if(any(sapply(value, length) != x$loc.n.all)) stop("number of replacement alleles do not match that of the object") R/auxil.R:53: w <- sapply(w, function(cha) f1(cha,max0)) R/dapc.R:842: means <- sapply(lres, mean) R/dapc.R:849: best <- which.max(sapply(lres, mean)) R/dapc.R:850: means <- sapply(lres, mean) R/dapc.R:873: lines(n.pca, sapply(lres, mean), lwd=3, type="b") R/dapc.R:1027:## res.all <- sapply(n.pca, get.totdiscr) R/find.clust.R:181: temp[2:(length(myStat)-1)] <- sapply(1:(length(myStat)-2), R/gengraph.R:36: temp <- sapply(res, function(e) e$clust$no) R/gengraph.R:114: temp <- sapply(tempRes,function(e) e$clust$no) R/genind2genpop.R:134: } else if(is.data.frame(e) && nrow(e)==N && all(sapply(e,is.numeric)) ){ # df of numeric vectors R/glFunctions.R:15: nbVec <- sapply(x@gen, function(e) length(e$snp)) R/glFunctions.R:16: nbNa <- sapply(NA.posi(x), length) R/glFunctions.R:23: nbVec <- sapply(x@gen, function(e) length(e$snp)) R/glFunctions.R:24: nbNa <- sapply(NA.posi(x), length) R/glFunctions.R:208: nbVec <- sapply(x@gen, function(e) length(e$snp)) R/glFunctions.R:209: nbNa <- sapply(NA.posi(x), length) R/glFunctions.R:240: nbVec <- sapply(block@gen, function(e) length(e$snp)) R/glFunctions.R:241: nbNa <- sapply(NA.posi(block), length) R/glHandle.R:207: if(!all(sapply(myList, class)=="SNPbin")) stop("some objects are not SNPbin objects") R/glHandle.R:209: myList <- myList[sapply(myList,nLoc)>0] R/glHandle.R:216: if(checkPloidy && length(unique(sapply(myList, ploidy))) !=1 ) stop("objects have different ploidy levels") R/glHandle.R:245: myList <- dots[sapply(dots, inherits, "genlight")] R/glHandle.R:248: dots <- dots[!sapply(dots, inherits, "genlight")] R/glHandle.R:251: if(!all(sapply(myList, class)=="genlight")) stop("some objects are not genlight objects") R/glHandle.R:253: myList <- myList[sapply(myList,nLoc)>0 & sapply(myList,nInd)>0] R/glHandle.R:260: if(length(unique(sapply(myList, nInd))) > 1 ) stop("objects have different numbers of individuals") R/glHandle.R:310: myList <- dots[sapply(dots, inherits, "genlight")] R/glHandle.R:313: dots <- dots[!sapply(dots, inherits, "genlight")] R/glHandle.R:315: if(!all(sapply(myList, class)=="genlight")) stop("some objects are not genlight objects") R/glHandle.R:318: myList <- myList[sapply(myList,nLoc)>0 & sapply(myList,nInd)>0] R/glHandle.R:324: if(length(unique(sapply(myList, nLoc))) !=1 ) stop("objects have different numbers of SNPs") R/global_local_tests.R:40: sim <- sapply(1:nperm, function(i) calcstat( X[sample(1:n),], k ) ) R/global_local_tests.R:82: sim <- sapply(1:nperm, function(i) calcstat( X[sample(1:n),], k ) ) R/glSim.R:49: pop.freq <- as.vector(unlist(sapply(pops, function(e) sum(pop==e)))) R/gstat.randtest.R:35:## ## ## note: for, lapply and sapply are all equivalent R/gstat.randtest.R:41:## ## sim <- sapply(1:nsim, function(i) g.stats.glob(cbind(sample(pop),X))$g.stats) R/gstat.randtest.R:46:## ## sim <- sapply(1:nsim, function(i) g.stats.glob(cbind(pop,X[samp.within(sup.pop),]))$g.stats) R/gstat.randtest.R:51:## ## sim <- sapply(1:nsim, function(i) g.stats.glob(cbind(pop,X[samp.between(sub.pop),]))$g.stats) R/handling.R:475: if(!all(sapply(x,is.genind))) stop("x is does not contain only valid genind objects") R/handling.R:476: temp <- sapply(x,function(e) locNames(e)) R/handling.R:478: ## temp <- sapply(x,function(e) e$ploidy) R/handling.R:521: old.n <- sapply(x, nInd) R/haploGen.R:57: res <- sapply(1:length(snp), function(i) sample(setdiff(NUCL,snp[i]),1)) # ! sapply does not work on DNAbin vectors directly R/haploGen.R:71: res <- sapply(TRANSVSET[as.character(snp)],sample,1) R/haploGen.R:194: newDates <- sapply(1:nbDes, function(i) date.dupli(date)) # find dates for descendants R/haploGen.R:215: newDates <- sapply(1:nbDes, function(i) date.dupli(date)) # find dates for descendants R/haploPop.R:245:## toKeep <- sapply(listPop, length)>0 R/haploPop.R:318:## N <- sum(sapply(x$pop,length)) R/haploPop.R:324:## N.empty <- sum(sapply(x$pop, function(e) length(e)==0)) R/haploPop.R:356:## temp <- sapply(x,length) R/haploPop.R:362:## temp <- sapply(x,function(e) length(unique(unlist(e)))) R/haploPop.R:384:## popToKeep <- sample(which(sapply(x$pop, length) > n), n.pop, replace=FALSE) # keep n.pop large enough populations R/haploPop.R:391:## popSizes <- sapply(x$pop, length) R/haploPop.R:401:## popSizes <- sapply(x$pop, length) R/haploPop.R:483:## N <- sum(sapply(x$pop,length)) R/haploPop.R:518:## popSizes <- sapply(x$pop, length) R/haploPop.R:806:## N <- sum(sapply(list.pop$pop, length)) R/haploPop.R:824:## N <- sum(sapply(list.pop$pop, length)) R/haploPop.R:830:## res <- sapply(unlist(list.pop$pop, recursive=FALSE), function(e) sum(!e %in% root.haplo)) R/haploPop.R:848:## N <- sum(sapply(list.pop$pop, length)) R/haploPop.R:863:## res$popSize[1] <- sum(sapply(listPop, length)) R/haploPop.R:900:## toKeep <- sapply(listPop, length)>0 R/haploPop.R:912:## res$popSize[i] <- sum(sapply(listPop, length)) R/import.R:269: n.items <- sapply(allele.data, length) R/import.R:444: txt <- sapply(1:length(txt),function(i) unlist(strsplit(txt[i],"([[:space:]]+)|([[:blank:]]+)")) ) R/import.R:527: txt <- sapply(1:length(txt),function(i) unlist(strsplit(txt[i],"([[:space:]]+)|([[:blank:]]+)")) ) R/import.R:537: allNAs <- sapply(1:8, function(i) paste(rep("0",i),collapse="")) R/import.R:649: temp <- sapply(1:length(txt),function(i) strsplit(txt[i],",")) R/import.R:652: ind.names <- sapply(temp,function(e) e[1]) R/import.R:656: vec.genot <- sapply(temp,function(e) e[2]) R/import.R:894: X <- t(sapply(temp, function(i) paste(gen[i,],gen[i+1,],sep="") )) R/import.R:1149: misc.info <- sapply(misc.info, function(e) unlist(strsplit(e,"[[:space:]]+"))) R/import.R:1194: n.loc <- unique(sapply(res, nLoc)) R/import.R:1460: if(!all(sapply(res, nLoc)==n.loc)) stop(paste("some individuals do not have",n.loc,"SNPs.")) R/import.R:1575: nb.alleles <- sapply(POOL, length) R/import.R:1635: alleles(res) <- sapply(POOL[snp.posi], paste, collapse="/") R/PCtest.R:36:## sim <- sapply(1:nperm, function(i) f1(makeOnePerm(lX))) R/PCtest.R:39:## sim <- sapply(1:nperm, function(i) {cat(ifelse(i%%10==0, i, "."));return(f1(makeOnePerm(lX)))} ) R/seqTrack.R:143: res <- sapply(id, findAncestor) R/seqTrack.R:463:## temp <- sapply((1-mu)^L, function(x) x^t ) R/seqTrack.R:546:## temp <- sapply(1:(max-1), function(i) p[i]*sum(p[(i+1):max])) R/seqTrack.R:551:## temp <- sapply(idx, function(i) sum(p[i:max])) R/seqTrack.R:559:## res <- sapply(nbDays, f1, max=distribSize) R/seqTrack.R:593:## res <- sapply(1:length(days), f1) # proba for all days R/seqTrack.R:876:## newDates <- sapply(1:N, function(i) R/seqTrack.R:880:## newDates <- sapply(1:N, function(i) do.call(rDate, arg.rDate)) R/seqTrack.R:1109:## newances <- sapply(temp, f1) R/seqTrack.R:1110:## ances.support <- sapply(temp, function(e) max(e, na.rm=TRUE)/sum(e, na.rm=TRUE)) R/sequences.R:41: out <- sapply(alleles, function(e) 1*(vec==e)) R/sequences.R:51: col.names <- unlist(sapply(temp, colnames)) R/sequences.R:52: temp <- as.matrix(data.frame(temp[!sapply(temp, is.null)])) # remove NULL slots, list -> matrix R/sequences.R:99: mat <- sapply(x$seq, s2c, USE.NAMES=FALSE) R/simOutbreak.R:35:## res <- sapply(1:length(snp), function(i) sample(setdiff(NUCL,snp[i]),1)) # ! sapply does not work on DNAbin vectors directly R/simOutbreak.R:49:## res <- sapply(TRANSVSET[as.character(snp)],sample,1) R/simOutbreak.R:106:## newSeq <- t(sapply(newAnces, function(i) seq.dupli(res$dna[i,], t-res$dates[i]))) R/simOutbreak.R:120:## res$nmut <- sapply(1:res$n, function(i) dist.dna(res$dna[c(res$id[i],res$ances[i]),], model="raw"))*ncol(res$dna) R/snapclust.choose.k.R:44: genind.posi <- match("genind", sapply(call.args, class)) R/SNPbin.R:71: if(all(sapply(input$snp, class)=="raw")){ R/SNPbin.R:186: if(is.list(input$gen) && all(sapply(input$gen, class)=="SNPbin")){ R/SNPbin.R:188: if(length(unique(sapply(input$gen, nLoc)))>1) { R/SNPbin.R:224: if(is.list(input$gen) && !is.data.frame(input$gen) && all(sapply(input$gen, class) %in% c("integer","numeric"))){ R/SNPbin.R:226: lengthvec <- sapply(input$gen, length) R/SNPbin.R:522: temp <- sapply(object@gen, function(e) length(e@NA.posi)) R/SNPbin.R:674: res <- sapply(x@gen, function(e) e@ploidy) R/SNPbin.R:958: ## vecraw <- sapply(seq(1, by=8, length=nbBytes), function(i) which(apply(SNPCOMB,1, function(e) all(temp[i:(i+7)]==e))) ) # old R version R/snpposi.R:30: sim <- sapply(1:n.sim, function(e) f1(sample(1:genome.size, n.snps, replace=FALSE), stat=stat)) R/snpzip.R:132: lins <-sapply(index, function(e) seq(from=temp[e], to=orary[e])) R/snpzip.R:135: cait<-sapply(lin, function(e) ((col[lins[,e]])-1)^2) R/snpzip.R:136: FTW <-sapply(lin, function(e) sum(cait[,e])/n.rep) R/snpzip.R:229: z <- sapply(toto, function(e) xTotal[e]) R/snpzip.R:236: maximus <- as.vector(unlist(sapply(maximus, function(e) toto[e]))) R/snpzip.R:279: ASSIGN <- sapply(index, function(e) which(ASS==e)) R/snpzip.R:280: GROUP <- sapply(index, function(e) which(GRP==e)) R/snpzip.R:283: dapc.success.byGroup <- sum(sapply(index2, function(e) R/xvalDapc.R:217: lins <-sapply(index, function(e) seq(from=temp[e], to=orary[e])) R/xvalDapc.R:220: cait<-sapply(lin, function(e) ((col[lins[,e]])-1)^2) R/xvalDapc.R:221: FTW <-sapply(lin, function(e) sum(cait[,e])/n.rep) ```

thibautjombart / adegenet

Replace sapply calls with vapply or lapply #206