Replace sapply calls with vapply or lapply

[zkamvar]

as of 4d76f65, 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([email protected]))
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)

[zkamvar]

Note: there are 79 lines that are uncommented for this:

$ grep -inr sapply R | grep -Ev '[0-9]:[ ]*[#]' | wc
      79     528    6593