adegenet
adegenet copied to clipboard
Published
20 hours ago •
thibautjombart
thibautjombart
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([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)
Note: there are 79 lines that are uncommented for this:
$ grep -inr sapply R | grep -Ev '[0-9]:[ ]*[#]' | wc
79 528 6593