pax_global_header00006660000000000000000000000064141266032660014520gustar00rootroot0000000000000052 comment=d7a8935bc8107260e217718078840a31bcfc9c98 r-cran-labdsv-2.0-1/000077500000000000000000000000001412660326600141525ustar00rootroot00000000000000r-cran-labdsv-2.0-1/DESCRIPTION000077500000000000000000000013431412660326600156640ustar00rootroot00000000000000Package: labdsv Version: 2.0-1 Title: Ordination and Multivariate Analysis for Ecology Author: David W. Roberts Maintainer: David W. Roberts Depends: R (>= 2.10), mgcv Imports: cluster, Rtsne, MASS Suggests: optpart Enhances: vegan Description: A variety of ordination and community analyses useful in analysis of data sets in community ecology. Includes many of the common ordination methods, with graphical routines to facilitate their interpretation, as well as several novel analyses. License: GPL (>= 2) URL: http://ecology.msu.montana.edu/labdsv/R Packaged: 2019-08-04 10:08:57 UTC; dvrbts NeedsCompilation: yes Repository: CRAN Date/Publication: 2019-08-04 12:00:02 UTC r-cran-labdsv-2.0-1/MD5000066400000000000000000000131011412660326600144560ustar00rootroot000000000000004631c0911e7a24b70e4e5e4608b0b7f9 *DESCRIPTION df186419b67278f5b8e6f79adfad93b4 *NAMESPACE 5ad7d7f058bcbb4d064b9df2f3d758e7 *R/abundtrans.R 5294c03579c7630a867fef9c95f71f5c *R/abuocc.R ab78659c92b7ffb2132c092b5b96b690 *R/as.dsvord.R aa3dba4b3655e73782a9fe742e02163d *R/calibrate.R 14e98f0b7dac73ac783e625b4a557b62 *R/clustify.R 2ff26533751e568cb254a158b8e03e8e *R/compspec.R 57f81c60334f5ea51ac0f9ee04e7c0cb *R/concov.R d14905cb0309bfce7b957340d48d0e87 *R/const.R fb2e6131a2c70bb35fad7450891d9c12 *R/dematrify.R 64b9a5e4431317a8786bf7f06f2ae2f6 *R/dga.R ca3d6898fbf3ae10db2bddfd267ba6c2 *R/disana.R ce1ba492d822bed4a21812c6e8d0b83e *R/drop.R 6f6621326ed6ef300a63a33647a77d64 *R/dsvdis.R a33e7b777bc1f2efb0d37b4d20547669 *R/dsvls.R b01902c71755dc440b0cf4a905eff1c3 *R/dsvord.R 9d6a49dcb22e8c2bc216b4b854a1271e *R/envrtest.R 6cb2231903a66f73600319f410882060 *R/euclidify.R e1deedd0c9747a0cb7dcd7444bc50c9f *R/factorize.R 91dc93bb249f23ba0f711c454f0f393f *R/gsr.R db74379121538a2c1436e46aeeb786e3 *R/homoteneity.R c575f55639a033230c8127a0675e9144 *R/importance.R 888887f3cb63b6db67f9653a4a6104ba *R/indval.R 68367125d7e4eb7ae7b5908d1a0aaf2e *R/isamic.R 0ea270c651d16482fde342a3763ddcf9 *R/matrify.R 7435a4f085e707a9dc5140e8d63c7ade *R/metrify.R fc91668d66f1ef312fac569d9ae834e2 *R/neighbors.R e68b8e28cefb29d40a4b0c25f04e11ae *R/nmds.R 1885f7140ba3cf4f36ab35b3ac467440 *R/ordcomm.R 45bb2c1072df8cb05cd3e15b242291c3 *R/ordcomp.R e3457b35c9e9089fca3028a1733242e3 *R/orddist.R 81364db97f952308117e75eb91d25d91 *R/ordneighbors.R 64f5a9a30261b00a35233ecf653cd8ff *R/ordpart.R 1919402f4011e098fba3e05f6c057f67 *R/ordtest.R 73500802ac384cff8be1661073524a7e *R/ordutils.R bddf758c5436fa5285ee8a9fae61e9e1 *R/pca.R b4903aef0eca6fb0d6e47735fbe23605 *R/pco.R cfd4acd3eafba22160ace0b873271b18 *R/plot.ord.R f10fff26cb90c0d1514518f57a74424a *R/predict.dsvord.R 83d6ba58cb352d8d435b06f07b687c4d *R/raretaxa.R e6672d3e5fc8c7c6f25cf15780c9c189 *R/reconcile.R 36bb7b45db14d9e0873910a2d753ea69 *R/refactor.R 7bb9018b6e29c3f2a8e146ad0751658a *R/rndcomm.R 7e2fdd6ca179d62f56c55aa9fc9416ea *R/rnddist.R 5eb1b5e4a6b2b9524276a1d77fd54c6c *R/spcdisc.R 2e1423231a65d8b44010f47a0fdbc920 *R/standi.R 1df6e5fdd7fa73b820578ea7c7ed4967 *R/stepdist.R f590b66d550f7d74c70c79695e2d2760 *R/subset_dist.R 76d4f342cc35153b5153a8b6d28c3777 *R/thull.R e1197b71e02cf2010b34c5be530c7287 *R/tsne.R aa1b214e6717c16d32140dc5f30974dc *R/vegtab.R 7bf1ca905efabdd18da90ed26a74e880 *R/zzz.R 317374d779f36ff7e2e2a8d8b9bd6887 *data/brycesite.rda 89c92cba617d6e7faf042ee5cf977604 *data/bryceveg.rda 954bff8c42e304ec2836fbbe50134c98 *inst/ChangeLog b1f28f049020b2c912e41ac53c057d14 *man/abundtrans.Rd 962b7f35f37ab33c5bab27631f616855 *man/abuocc.Rd 06887b14507ac0ac513428900449c68f *man/as.dsvord.Rd 10c80fde116ce0d4d1cb6128da428ea9 *man/brycesite.Rd d3fad0995a7d53bf6eb02a4426e75a70 *man/bryceveg.Rd 3911554437bf4983ee50d8a0113ca44f *man/calibrate.Rd 5695c8d3213539eda427615ff48bbc31 *man/compspec.Rd 0fd58067707199b2f413cc4820322360 *man/concov.Rd c7d1af6015f7e361831df9e1ea3618e9 *man/const.Rd 3aa53e79bdbe7c32a159e2d332ff0a56 *man/convex.Rd 31de942c122779246e2ab548a5fb5c8d *man/defactorize.Rd 097f79d27277ab99aff6954b29faf00e *man/dematrify.Rd abd3c0b40a6d50daa164bf2d2890dc57 *man/dga.Rd 97a47c0bfc48a96417184130ebd5d367 *man/disana.Rd 5ca874c238b6c60dfbdbe01c8fdc4cdb *man/dropplt.Rd 2dddcee08fd3d701c4160d40a737a6f1 *man/dropspc.Rd 3b87a9ac96faa1f5cea4af8d8300662a *man/dsvdis.Rd ec4de5d23b262335a313fc787c737447 *man/dsvls.Rd beec660ca8d7b0e13f657de48787c025 *man/envrtest.Rd ff3a89e66f1e60aea0c4d8d6ab63796e *man/euclidify.Rd e4803fa0f6ad1659280905cc56a4b366 *man/factorize.Rd f293dadb45ecdefbccf973b2414fb619 *man/gsr.Rd 85cc0096c9e0e1839b06fbef0a664742 *man/hellinger.Rd 461e35a49ce3e3961b096c3220e0b829 *man/homoteneity.Rd d8c8626ba13b2a965c8f2b5457ad39da *man/importance.Rd c703edde69b8b5b72d698fae1896c018 *man/indval.Rd cb086516497c5a0831b04d9b20c1f594 *man/isamic.Rd 3e38052d76e173b264286392e77282f3 *man/labdsv.internal.Rd b40caed455496f7443e0291ec2404a51 *man/matrify.Rd 8878f9709891ac0d82692b4fa11d4a4f *man/metrify.Rd 86f9e129a7459fead219e9e98d567196 *man/neighbors.Rd 4b807c0c30c8adfb6b8e7b1a890dcb07 *man/nmds.Rd 2e3a0d0f6e45b6d198676ed9cd032d74 *man/ordcomm.Rd 8a39bbd2f1fc2b4721cc73e4583baeda *man/ordcomp.Rd 86469be704a5dd3ae2a2bf99aa283922 *man/orddist.Rd b9fbf4c80bc6fb6c123e7d6e6dddf6ea *man/ordneighbors.Rd a181fc77cfc6c4a32fe1e3de07c9f472 *man/ordpart.Rd 6bc5ea49b7a242adfb026af019445694 *man/ordtest.Rd 3d884927ae96a0ab3bd074f77fb6a317 *man/pca.Rd aae52d4e9ae95990b55c90d62b3a6415 *man/pco.Rd f9d185103f38a5309ed417d3cf76e68d *man/plot.dsvord.Rd 38d641f2448c98bc62319bec0207bc06 *man/predict.Rd cb22c4bbee10e54b3907a41564721f66 *man/raretaxa.Rd dc67dc5040e9f53d2543cc4f4417b3b7 *man/reconcile.Rd 4831e42c73a670d54080331cd4bdbe14 *man/rndcomm.Rd 3a219c695e6db1348ea633d47bdbe9dd *man/rnddist.Rd d48ab7d8f8c13d3c20dacfa6b67a90a9 *man/samptot.Rd 46e87624d5cd4892d7917affcf0277e1 *man/spcdisc.Rd 4f19233057ab2de85c8b6069e0e24e1a *man/spcmax.Rd 9f3459dd0964c918f6d6363bb33731b3 *man/stepdist.Rd 681e8628ce3279194abe25da3ef44659 *man/thull.Rd 72acd9c4f3652e68375a26fbf4055b15 *man/tsne.Rd 12c08afa7323f44ff5bab7a2222a5e5b *man/vegtab.Rd 7ced6d3bda8e0928512538e66346f0bf *src/dsvdis.f90 f840bdded87f6cd7c686fbe146c7b982 *src/euclid.f90 e1de42e2fccdf8736c1bd2e50c714bf5 *src/indval.f90 d3e6cc677ffb24a496b784132fe0771b *src/ismetric.f90 ea1e982401c8208307a8d1b2dd15a354 *src/metric.f90 2da8bd5320ae7df5170cada53c73c2ee *src/orddist.f90 3ba537f58d83053ed9e2ee66824ac2cf *src/pip.f90 c878da0c9e6f4bf574431b61d3ffff84 *src/random.c 0b972c454b6b14931e8d394fa3610bc4 *src/stepdist.f90 65ca71b4a19b577e39098c23c9441874 *src/thull.f90 r-cran-labdsv-2.0-1/NAMESPACE000066400000000000000000000045301412660326600153730ustar00rootroot00000000000000# Export all names export( # data handling and generating reconcile, matrify, dematrify, rndcomm, # data editing dropplt, dropspc, factorize, defactorize, ordcomm, gsr, # transformations and standardizations abundtrans, convex, samptot, spcmax, hellinger, # disimilarity functions, dsvdis, disana, rnddist, neighbors, # dissimilarity conversion routines metrify, as.metric, is.metric, euclidify, as.euclidean, stepdist, # data viewing abuocc, vegtab, dsvls, dga, raretaxa, # ordination functions pca, pco, nmds, bestnmds, tsne, besttsne, as.dsvord, # ordination graphics functions surf, ellip, plotid, specid, hilight, chullord, thull, # ordination analysis functions density, ordcomp, orddist, ordpart, ordtest, ordneighbors, # classification utilities concov, const, homoteneity, importance, isamic, spcdisc, envrtest, # compositional specificity compspec, # indval indval ) # Import all packages listed as Imports or Depends import("mgcv") importFrom("grDevices", "chull", "rainbow") importFrom("graphics", "abline", "barplot", "contour", "identify", "image", "lines", "locator", "plot", "points", "polygon", "text", "arrows") importFrom("stats", "as.dist", "binomial", "cmdscale", "cor", "dist", "gaussian", "poisson", "prcomp", "predict", "quantile", "runif", "smooth", "AIC","var","loadings") importFrom("utils", "write.table", "tail","txtProgressBar", "setTxtProgressBar") importFrom("MASS", "isoMDS") importFrom("cluster", "ellipsoidhull") importFrom("Rtsne", "Rtsne") # Register all generic methods S3method(plot,dsvord) S3method(plot,pco) S3method(plot,nmds) S3method(chullord,dsvord) S3method(density,dsvord) S3method(hilight,dsvord) S3method(ordpart,dsvord) S3method(plotid,dsvord) S3method(points,dsvord) S3method(surf,dsvord) S3method(thull,dsvord) S3method(ellip,dsvord) S3method(predict,dsvord) S3method(calibrate,dsvord) S3method(indval,default) S3method(indval,stride) S3method(plot,compspec) S3method(plot,thull) S3method(summary,indval) S3method(summary,pca) S3method(summary,dsvord) S3method(summary,dist) S3method(summary,dsvord) S3method(summary,thull) S3method(summary,clustering) S3method(summary,compspec) S3method(varplot,pca) S3method(plot,pca) S3method(loadings,pca) S3method(print,abuocc) useDynLib(labdsv) r-cran-labdsv-2.0-1/R/000077500000000000000000000000001412660326600143535ustar00rootroot00000000000000r-cran-labdsv-2.0-1/R/abundtrans.R000077500000000000000000000014141412660326600166420ustar00rootroot00000000000000abundtrans <- function (comm,code,value) { if (!is.data.frame(comm)) { comm <- data.frame(comm) } if (length(code) != length(value)) { stop("code and value vectors must be of the same length") } if (is.numeric(code)) { code <- c(0,code) } else { code <- c('0',code) } if (is.numeric(value)) { value <- c(0,value) } else { value <- c('0',value) } newcomm <- matrix(NA,nrow=nrow(comm),ncol=ncol(comm)) for (i in 1:length(code)) newcomm[comm==code[i]] <- value[i] newcomm <- data.frame(newcomm) names(newcomm) <- names(comm) row.names(newcomm) <- row.names(comm) if (any(is.na(newcomm))) { print("WARNING, not all values specified") } return(newcomm) } r-cran-labdsv-2.0-1/R/abuocc.R000077500000000000000000000045321412660326600157410ustar00rootroot00000000000000abuocc <- function (comm, minabu = 0, panel='all') { if (!is.data.frame(comm)) comm <- data.frame(comm) spc.plt <- apply(comm > minabu, 1, sum) plt.spc <- apply(comm > minabu, 2, sum) if (minabu == 0) { mean.abu <- apply(comm, 2, sum)/plt.spc } else { mean.abu <- rep(0, ncol(comm)) for (i in 1:ncol(comm)) { mask <- comm[, i] > minabu mean.abu[i] <- sum(comm[mask, i])/max(1, plt.spc[i]) } } mean.abu[is.na(mean.abu)] <- 0 if (panel=='all' || panel==1) { plot(rev(sort(plt.spc[plt.spc > minabu])), log = "y", xlab = "Species Rank", ylab = "Number of Plots", main = "Species Occurrence") if (panel == 'all') readline("Press return for next plot ") } if (panel=='all' || panel==2) { plot(rev(sort(spc.plt)), xlab = "Plot Rank", ylab = "Number of Species", main = "Species/Plot") if (panel=='all') readline("Press return for next plot ") } if (panel=='all' || panel==3) { plot(plt.spc[mean.abu > minabu], mean.abu[mean.abu > minabu], log = "y", xlab = "Number of Plots", ylab = "Mean Abundance", main = "Abundance vs Occurrence") yorn <- readline("Do you want to identify individual species? Y/N : ") if (yorn == "Y" || yorn == "y") identify(plt.spc[mean.abu > minabu], mean.abu[mean.abu > minabu], names(comm)[mean.abu > minabu]) if (panel=='all') readline("Press return for next plot ") } if (panel=='all' || panel==4) { plot(spc.plt, apply(comm, 1, sum), xlab = "Number of Species/Plot", ylab = "Total Abundance") yorn <- readline("Do you want to identify individual plots? Y/N : ") if (yorn == "Y" || yorn == "y") identify(spc.plt, apply(comm, 1, sum), labels = row.names(comm)) } out <- list(spc.plt = spc.plt, plt.spc = plt.spc, mean = mean.abu) attr(out,'call') <- match.call() attr(out,'comm') <- deparse(substitute(comm)) attr(out,'timestamp') <- date() attr(out,'class') <- 'abuocc' invisible(out) } print.abuocc <- function(x,...) { cat("\nSpecies Richness\n\n") print(x$spc.plt) cat("\nSpecies Statistics\n\n") tmp <- data.frame(x$plt.spc,x$mean) names(tmp) <- c("Occurrences","Mean Abundance") print(tmp) } r-cran-labdsv-2.0-1/R/as.dsvord.R000066400000000000000000000062171412660326600164070ustar00rootroot00000000000000as.dsvord <- function(obj) { # ltm2dsv <- function (ltm) # { # require('reo') # out <- list() # out$points <- scores(ltm) # out$type <- 'LTM' # class(out) <- c('dsvord','ltm') # out # } lvs2dsv <- function (lvs,alpha=0.5) { testcov <- lvs$lv.median %*% t(lvs$lv.coefs.median[, 2:(lvs$num.lv + 1)]) do.svd <- svd(testcov, lvs$num.lv, lvs$num.lv) choose.lvs <- scale(do.svd$u * matrix(do.svd$d[1:lvs$num.lv]^alpha, nrow = lvs$n, ncol = lvs$num.lv, byrow = TRUE), center = TRUE, scale = FALSE) out <- list() out$points <- choose.lvs out$type <- 'LVS' class(out) <- c('dsvord','lvs') out } tsne2dsv <- function(tsne) { out <- list() out$points <- tsne$Y out$type <- 't-SNE' out$perplexity <- tsne$perplexity out$theta <- tsne$theta out$eta <- tsne$eta out$KLdiv <- tail(tsne$itercosts,1) class(out) <- c('dsvord','tsne') attr(out,'call') <- attr(tsne,'call') out } meta2dsv <- function(obj) { out <- list() out$points <- obj$points out$type <- 'NMDS' class(out) <- c('dsvord','metamds') out } ordip2dsv <- function(obj) { out <- list() out$points <- obj$sites if (!is.null(obj$species)) out$species <- obj$species tmp <- dimnames(obj$sites)[[2]][1] out$type <- substring(tmp,1,nchar(tmp)-1) out$stress <- obj$stress * 100 class(out) <- c('dsvord','ordip') } dsv2dsv <- function(obj) { out <- list() out$points <- obj$points out$type <- class(obj) if (inherits(obj,'nmds')) out$stress <- obj$stress if (inherits(obj,'pco')) out$GOF <- obj$GOF class(out) <- c('dsvord',class(obj)) out } pca2dsv <- function(obj) { out <- list() out$scores <- obj$scores out$points <- obj$scores out$loadings <- obj$loadings out$sdev <- obj$sdev out$totdev <- obj$totdev class(out) <- c("dsvord","pca") out$type <- 'PCA' out } mfso2dsv <- function(obj) { out<- list() out$points <- obj$mu out$type='MFSO' class(out) <- c('dsvord') out } if (inherits(obj,c('nmds','pco'))) { out <- dsv2dsv(obj) } else if (inherits(obj,'ltm.ecol')) { # out <- ltm2dsv(obj) stop('ltm is not currently supported, send me an email') } else if (inherits(obj,'boral')) { out <- lvs2dsv(obj) } else if (inherits(obj,'metaMDS')) { out <- meta2dsv(obj) } else if ('perplexity' %in% names(obj)) { out <- tsne2dsv(obj) } else if (inherits(obj,'ordiplot')) { out <- ordip2dsv(obj) } else if (inherits(obj,'pca')) { out<- pca2dsv(obj) } else if (inherits(obj,'mfso')) { out <- mfso2dsv(obj) } else { stop("object class not recognized") } attr(out,'call') <- match.call() attr(out,'timestamp') <- date() out } r-cran-labdsv-2.0-1/R/calibrate.R000066400000000000000000000052521412660326600164300ustar00rootroot00000000000000calibrate.dsvord <- function(dsvord,site,dims=1:ncol(dsvord$points), family='gaussian',gamma=1,keep.models=FALSE) { if (!inherits(dsvord,'dsvord')) stop("The first argument must be an object of class 'dsvord'") if (nrow(site) != nrow(dsvord$points)) stop("The arguments are incompatible") if (length(family) == 1) family <- rep(family,ncol(site)) if (length(gamma) == 1) gamma <- rep(gamma,ncol(site)) getdev <- function(object) { a <- object$deviance b <- object$null.deviance out <- 1 - (a/b) out } r.sq <- function(object) { w <- as.numeric(object$prior.weights) mean.y <- sum(w * object$y)/sum(w) w <- sqrt(w) residual.df <- length(object$y) - sum(object$edf) nobs <- nrow(object$model) r.sq <- 1 - var(w * (as.numeric(object$y) - object$fitted.values)) * (nobs - 1)/(var(w * (as.numeric(object$y) - mean.y)) * residual.df) r.sq } points <- dsvord$points[,dims] numdim <- ncol(points) if (numdim > 3) { cat("\n truncating to 3D\n") points <- points[,1:3] } check <- sapply(site,class)=="numeric" if (sum(check) > 0) { cat("\n omitting factors\n") site <- site[,check] } size <- ncol(site) res <- list() if (interactive()) pb <- txtProgressBar(min=0, max=ncol(site), style=3) if (numdim == 2) { for (i in 1:size) { res[[i]] <- try(gam(site[,i] ~ s(points[,1],points[,2]), family=family[i],gamma=gamma[i])) if (inherits(res[[i]],'try-error')) res[[i]] <- gam(site[,i] ~ s(points[,1]) + s(points[,2]), family=family[i],gamma=gamma[i]) if (interactive()) setTxtProgressBar(pb,i) } } else if (numdim == 3) { for (i in 1:size) { res[[i]] <- try(gam(site[,i] ~ s(points[,1],points[,2],points[,3]), family=family[i],gamma=gamma[i])) if (inherits(res[[i]],'try-error')) res[[i]]<- gam(site[,i] ~ s(points[,1]) + s(points[,2])+ s(points[,3]),family=family[i],gamma=gamma[i]) if (interactive()) setTxtProgressBar(pb,i) } } if (interactive()) close(pb) fitted <- sapply(res,predict,type='response') dimnames(fitted) <- list(row.names(site),names(site)) aic <- sapply(res,AIC) dev <-sapply(res,getdev) adj.rsq <- sapply(res,r.sq) out <- list(fitted=fitted,aic=aic,dev.expl=dev,adj.rsq=adj.rsq) if (keep.models) { out$models <- res names(out$models) <- names(site) } out } r-cran-labdsv-2.0-1/R/clustify.R000066400000000000000000000017401412660326600163420ustar00rootroot00000000000000clustify <- function (clustering) { if (inherits(clustering, c("partana", "partition", "clustering"))) { clustering <- factor(clustering$clustering) } else if (is.character(clustering)) { clustering <- factor(clustering) } else if (is.numeric(clustering)) { clustering <- factor(clustering) } else if (is.logical(clustering)) { clustering <- factor(clustering) } else if (!is.factor(clustering)) stop("Cannot understand passed clustering") clustering } summary.clustering <- function(object,...) { if (!inherits(object,'clustering')) stop("You must pass an object of class 'clustering'") cat(paste('Number of clusters = ',length(table(object$clustering)),'\n')) print(table(object$clustering)) cat(paste('\ncall = ',deparse(attr(object,'call')),'\n')) cat(paste('created = ',attr(object,'timestamp'),'\n')) } print.clustering <- function(x,...) { print(x$clustering) } r-cran-labdsv-2.0-1/R/compspec.R000066400000000000000000000133361412660326600163150ustar00rootroot00000000000000compspec <- function (comm, dis, numitr = 100, drop=FALSE, progress=FALSE) { compspec.core <- function(comm,dis,maxocc,numitr) { numspc <- ncol(comm) numocc <- apply(comm>0,2,sum) tmp <- 1 - as.matrix(dis) compval <- rep(0,numspc) for (i in 1:numspc) { mask <- comm[, i] > 0 if (sum(mask) > 1) { x <- as.matrix(tmp[mask, mask]) compval[i] <- mean(x[row(x) > col(x)]) } else { compval[i] <- 0 } } q99 <- rep(0,maxocc) q95 <- rep(0,maxocc) q05 <- rep(0,maxocc) q01 <- rep(0,maxocc) pvals <- rep(1,numspc) sim <- 1-dis for (i in 2:maxocc) { tmp <- rep(0,numitr-1) pairs <- (i^2-i)/2 for (j in 1:(numitr-1)) { tmp[j] <- mean(sample(sim,pairs,replace=FALSE)) } q01[i] <- quantile(tmp,0.01) q05[i] <- quantile(tmp,0.05) q95[i] <- quantile(tmp,0.95) q99[i] <- quantile(tmp,0.99) for (j in seq(1:numspc)[numocc==i]) { pvals[j] <- (sum(tmp>compval[j])+1)/(numitr) } } x <- list(compval=compval, numocc=numocc, pvals=pvals, quantiles=data.frame(q01,q05,q95,q99),mean=1-mean(dis)) attr(x,'call') <- match.call() return(x) } if (!inherits(dis,"dist")) stop("Must pass a dist object") if (max(dis) > 1) stop("compspec is only defined for dissimilarities, not distances") if (!is.data.frame(comm)) comm <- data.frame(comm) maxocc <- max(apply(comm>0,2,sum)) if (drop) { mean <- 0 res <- list() compval <- rep(0,ncol(comm)) numocc <- rep(0,ncol(comm)) pval <- rep(1,ncol(comm)) quantiles <- matrix(0,nrow=max(apply(comm>0,2,sum)),ncol=4) res$spc <- list() for (i in 1:ncol(comm)) { if (progress) cat(paste(i,'/',ncol(comm),'\n')) tmp.dis <- dsvdis(comm[,-i],attr(dis,'method')) res$spc[[names(comm)[i]]] <- compspec.core(comm,tmp.dis,maxocc,numitr=numitr) quantiles <- quantiles + res$spc[[i]]$quantiles mean <- mean + res$spc[[i]]$mean } quantiles <- quantiles / ncol(comm) mean <- mean / ncol(comm) for (i in 1:length(res$spc)) { compval[i] <- res$spc[[i]]$compval[i] numocc[i] <- res$spc[[i]]$numocc[i] pval[i] <- res$spc[[i]]$pval[i] } res$compval <- compval res$numocc <- numocc res$pvals <- pval res$quantiles <- quantiles res$mean <- mean } else { res <- compspec.core(comm=comm,dis=dis, maxocc=maxocc,numitr=numitr) } out <- list() out$vals <- data.frame(res$compval,res$numocc,res$pvals) row.names(out$vals) <- names(comm) names(out$vals) <- c('compval','numocc','pval') out$quantiles <- res$quantiles out$mean <- res$mean if (drop) out$spc <- res$spc class(out) <- 'compspec' attr(out,'call') <- match.call() attr(out,'timestamp') <- date() out } plot.compspec <- function (x, spc=NULL, pch=1, type='p', col = 1, ...) { if (!inherits(x,"compspec")) stop("only defined for objects of class compspec") if (is.null(spc)) { maxval <- max(x$vals$numocc) plot(x$vals$numocc[x$vals$numocc > 1], x$vals$compval[x$vals$numocc > 1], col = col, log = "x", xlim = c(2, maxval), pch=pch, type=type, xlab = "Number of Occurrences", ylab = "Similarity", ...) abline(x$mean, 0, col = 2) lines(2:maxval, smooth(x$quantiles$q01[2:maxval], endrule = "copy"), col = 2) lines(2:maxval, smooth(x$quantiles$q05[2:maxval], endrule = "copy"), col = 2) lines(2:maxval, smooth(x$quantiles$q95[2:maxval], endrule = "copy"), col = 2) lines(2:maxval, smooth(x$quantiles$q99[2:maxval], endrule = "copy"), col = 2) yorn <- readline("Do you want to identify species [Y or N] : ") if (yorn == "Y" || yorn == "y") { identify(x$vals$numocc, x$vals$compval, row.names(x$vals)) } } else { maxval <- max(x$spc[[spc]]$numocc) plot(x$spc[[spc]]$numocc[x$spc[[spc]]$numocc>1], x$spc[[spc]]$compval[x$spc[[spc]]$numocc>1], log = "x", xlim = c(2, maxval), xlab = "Number of Occurrences", ylab = "Similarity", ...) abline(x$spc[[spc]]$mean, 0, col = 2) lines(2:maxval, smooth(x$spc[[spc]]$quantiles$q01[2:maxval], endrule = "copy"), col = 2) lines(2:maxval, smooth(x$spc[[spc]]$quantiles$q05[2:maxval], endrule = "copy"), col = 2) lines(2:maxval, smooth(x$spc[[spc]]$quantiles$q95[2:maxval], endrule = "copy"), col = 2) lines(2:maxval, smooth(x$spc[[spc]]$quantiles$q99[2:maxval], endrule = "copy"), col = 2) yorn <- readline("Do you want to identify species [Y or N] : ") print(yorn) if (yorn == "Y" || yorn == "y") { identify(x$spc[[spc]]$numocc, x$spc[[spc]]$compval, names(x$spc[[spc]]$numocc)) } } out <- data.frame(numocc=x$vals$numocc,compval=x$vals$compval) invisible(out) } summary.compspec <- function (object,pval=0.05,...) { if (!inherits(object,'compspec')) stop("You must pass an object of class 'compspec'") cat(paste('call = ',deparse(attr(object,'call')),'\n')) cat(paste('created = ',attr(object,'timestamp'),'\n')) tot <- nrow(object$vals) sigs <- sum(object$vals$pval<=pval) cat(paste('number of significant species = ',sigs,'/',tot,'\n')) } r-cran-labdsv-2.0-1/R/concov.R000066400000000000000000000065661412660326600160020ustar00rootroot00000000000000concov <- function (comm, clustering, digits = 1, width = 5, typical = TRUE, thresh = 10) { if (missing(clustering)) { const <- apply(comm > 0, 2, sum)/nrow(comm) keep <- const >= thresh/100 impt <- apply(comm, 2, sum)/nrow(comm) a <- formatC(as.numeric(const) * 100, width = 2, format = "d") b <- formatC(as.numeric(impt), width = width, digits = digits, format = "f") tmp <- NULL tmp <- cbind(tmp, paste(a, "(", b, ")", sep = "")) tmp <- tmp[keep] tmp <- data.frame(tmp) row.names(tmp) <- names(comm)[keep] attr(tmp, "call") <- match.call() attr(tmp, "comm") <- deparse(substitute(comm)) attr(tmp, "timestamp") <- date() return(tmp) } else if (is.logical(clustering)) { comm <- comm[clustering, ] comm <- comm[, apply(comm > 0, 2, sum) > 0] x <- apply(comm > 0, 2, sum) y <- apply(comm, 2, sum)/x x <- x/nrow(comm) keep <- apply(as.matrix(x), 1, max) >= thresh/100 a <- formatC(as.numeric(x) * 100, width = 2, format = "d") b <- formatC(as.numeric(y), width = width, digits = digits, format = "f") tmp <- NULL tmp <- cbind(tmp, paste(a, "(", b, ")", sep = "")) tmp <- tmp[keep] tmp <- data.frame(tmp) row.names(tmp) <- names(comm)[keep] names(tmp) <- deparse(substitute(clustering)) attr(tmp, "call") <- match.call() attr(tmp, "comm") <- deparse(substitute(comm)) attr(tmp, "clustering") <- clustering attr(tmp, "timestamp") <- date() return(tmp) } clustering <- clustify(clustering) if (length(table(clustering))==1) { const <- apply(comm > 0, 2, sum)/nrow(comm) keep <- const >= thresh/100 impt <- apply(comm, 2, sum)/nrow(comm) a <- formatC(as.numeric(const) * 100, width = 2, format = "d") b <- formatC(as.numeric(impt), width = width, digits = digits, format = "f") tmp <- NULL tmp <- cbind(tmp, paste(a, "(", b, ")", sep = "")) tmp <- tmp[keep] tmp <- data.frame(tmp) row.names(tmp) <- names(comm)[keep] names(tmp) <- deparse(substitute(clustering)) attr(tmp, "call") <- match.call() attr(tmp, "comm") <- deparse(substitute(comm)) attr(tmp, "clustering") <- clustering attr(tmp, "timestamp") <- date() return(tmp) } else { levels <- levels(clustering) clustering <- as.integer(clustering) x <- const(comm, clustering) y <- importance(comm, clustering, typical = typical, dots = FALSE) tmp <- NULL keep <- apply(as.matrix(x), 1, max) >= thresh/100 for (i in 1:length(table(clustering))) { a <- formatC(as.numeric(x[, i]) * 100, width = 2, format = "d") b <- formatC(as.numeric(y[, i]), width = width, digits = digits, format = "f") tmp <- cbind(tmp, paste(a, "(", b, ")", sep = "")) } tmp <- tmp[keep, ] tmp <- data.frame(tmp) row.names(tmp) <- names(comm)[keep] names(tmp) <- levels attr(tmp, "call") <- match.call() attr(tmp, "comm") <- deparse(substitute(comm)) attr(tmp, "clustering") <- clustering attr(tmp, "timestamp") <- date() return(tmp) } tmp } r-cran-labdsv-2.0-1/R/const.R000066400000000000000000000060701412660326600156270ustar00rootroot00000000000000const <- function (comm, clustering, minval = 0, show = minval, digits = 2, sort = FALSE, spcord = NULL) { if (missing(clustering)) { const <- apply(comm > 0, 2, sum)/nrow(comm) const <- const[const >= minval] const <- data.frame(const) names(const) <- deparse(substitute(comm)) return(round(const,digits)) } else if (is.logical(clustering)) { comm <- comm[clustering,] const <- apply(comm > 0, 2, sum)/nrow(comm) const <- const[const >= minval] const <- data.frame(const) names(const) <- deparse(substitute(clustering)) return(round(const,digits)) } clustering <- clustify(clustering) if (length(table(clustering)) == 1) { const <- apply(comm > 0, 2, sum)/nrow(comm) const <- const[const >= minval] const <- data.frame(const) return(round(const,digits)) } else { res <- matrix(0, nrow = ncol(comm), ncol = length(levels(clustering))) x <- apply(comm, 2, function(x) { tapply(x > 0, clustering, sum) }) y <- as.numeric(table(clustering)) res <- x/y keep <- as.logical(apply(res, 2, max) >= minval) res <- res[, keep] tmp <- as.data.frame(t(res)) row.names(tmp) <- names(comm)[keep] if (!is.null(spcord)) { tmp <- tmp[rev(order(spcord[keep])), ] } tmp <- format(round(tmp, digits = digits)) tmp[tmp < show] <- substring(" . ", 1, digits + 2) names(tmp) <- attr(clustering, "levels") attr(tmp, "call") <- match.call() attr(tmp, "timestamp") <- date() if (sort) { print(tmp) repeat { plots <- readline(" enter the species: ") if (plots == "") { break } else { pnt <- readline(" in front of : ") } for (i in (strsplit(plots, ",")[[1]])) { ord <- 1:nrow(tmp) x <- match(i, row.names(tmp)) if (!is.na(x)) { z <- ord[x] ord <- ord[-x] y <- match(pnt, row.names(tmp)) if (!is.na(y)) { if (y > 1) { first <- ord[1:(y - 1)] last <- ord[y:length(ord)] ord <- c(first, z, last) } else { last <- ord[y:length(ord)] ord <- c(z, last) } tmp <- tmp[ord, ] print(tmp) } else { print(paste("species", pnt, "does not exist")) } } else { print(paste("species", i, "does not exist")) } } } return(tmp) } } return(tmp) } r-cran-labdsv-2.0-1/R/dematrify.R000066400000000000000000000012331412660326600164610ustar00rootroot00000000000000dematrify <- function (comm, filename, sep = ",", thresh = 0) { tmp <- which(comm > thresh, arr.ind = TRUE) samples <- row.names(tmp) species <- names(comm)[tmp[, 2]] abund <- comm[tmp] ord <- order(tmp[, 1], tmp[, 2]) result <- data.frame(samples[ord], species[ord], abund[ord]) names(result) <- c("sample", "species", "abundance") attr(result,'call') <- match.call() attr(result,'comm') <- deparse(substitute(comm)) attr(result,'thresh') <- thresh if (missing(filename)) { return(result) } else { write.table(file = filename, result, sep = sep, quote = FALSE, row.names = FALSE) } } r-cran-labdsv-2.0-1/R/dga.R000077500000000000000000000035561412660326600152450ustar00rootroot00000000000000dga <- function(z,x,y,step=50,pres="+",abs="-",labcex=1, xlab=deparse(substitute(x)),ylab=deparse(substitute(y)),pch=1,title="",...) { xstep <- seq(min(x),max(x),(max(x)-min(x))/step) ystep <- seq(min(y),max(y),(max(y)-min(y))/step) grid<-expand.grid(x=xstep,y=ystep) if (any(is.na(x))) { cat("Omitting plots with missing values \n") y <- y[!is.na(x)] z <- z[!is.na(x)] x <- x[!is.na(x)] } if (any(is.na(y))) { cat("Omitting plots with missing values \n") x <- y[!is.na(y)] z <- z[!is.na(y)] y <- x[!is.na(y)] } if (any(is.na(z))) { cat("Omitting plots with missing values \n") x <- y[!is.na(z)] y <- z[!is.na(z)] x <- x[!is.na(z)] } if (is.logical(z)) { cat(paste(" \n z = ",deparse(substitute(z)), " \n x = ",deparse(substitute(x)), " \n y = ",deparse(substitute(y)),"\n")) tmp.gam <- gam(z ~ s(x) + s(y),family=binomial) gam.pred <- matrix(predict.gam(tmp.gam,grid,type="response"),nrow=step+1) contour(xstep,ystep,gam.pred,levels=seq(0.2,0.8,0.2),labcex=labcex, xlab=xlab,ylab=ylab,main=title) points(x[z],y[z],pch=pres) points(x[!z],y[!z],pch=abs) attr(tmp.gam,'call') <- match.call() invisible(tmp.gam) } else { tmp.gam <- gam(z ~ s(x) + s(y),family=nb) gam.pred <- matrix(predict.gam(tmp.gam,grid,type="response"),nrow=step+1) contour(xstep,ystep,gam.pred,labcex=1, xlab=xlab,ylab=ylab,main=title) quant <- quantile(z) points(x[z<=quant[2]],y[z<=quant[2]],cex=0.5,pch=pch) points(x[z>quant[2]&z<=quant[4]], y[z>quant[2]&z<=quant[4]],pch=pch) points(x[z>quant[4]],y[z>quant[4]],cex=1.5,pch=pch) attr(tmp.gam,'call') <- match.call() invisible(tmp.gam) } } r-cran-labdsv-2.0-1/R/disana.R000077500000000000000000000026421412660326600157440ustar00rootroot00000000000000disana <- function (x,panel='all') { if (inherits(x,"dist")) { y <- as.matrix(x) triang <- x } else { y <- as.matrix(x) triang <- y[row(y) > col(y)] } is.na(diag(y)) <- TRUE tmin <- apply(y, 1, function(z) { min(z, na.rm = TRUE) }) tavg <- apply(y, 1, function(z) { mean(z, na.rm = TRUE) }) tmax <- apply(y, 1, function(z) { max(z, na.rm = TRUE) }) plots <- NULL if (panel=='all' || panel==1) { plot(sort(triang), xlab = "Sorted Value", ylab = "Dissimilarity") if (panel=='all') readline("Press return for next page....") } if (panel=='all' || panel==2) { plot(sort(tmin), ylim = c(0, max(tmax)), xlab = "Sorted Plot", ylab = "Dissimilarity") points(sort(tavg), col = 2) points(sort(tmax), col = 3) if (panel=='all') readline("Press return for next page....") } if (panel=='all' || panel==3) { plot(tmin, tavg, xlab = "Minimum Dissimilarity", ylab = "Average Dissimilarity") lines(c(0.5, 0.5), c(min(tavg), max(tavg)), col = 2) yorn <- readline("Do you want to identify individual plots [Y or N] : ") if (yorn == "Y" || yorn == "y") plots <- identify(tmin, tavg, attr(x, "Labels")) } res <- list(min = tmin, mean = tavg, max = tmax, plots = plots) attr(res,'call') <- match.call() invisible(res) } r-cran-labdsv-2.0-1/R/drop.R000066400000000000000000000014501412660326600154420ustar00rootroot00000000000000dropplt <- function (comm,site,which=NULL) { if (!identical(row.names(comm),row.names(site))) stop('data frames do not match') orig_comm <- deparse(substitute(comm)) orig_site <- deparse(substitute(site)) if (is.null(which)) { keep <- apply(site,1,function(x){!any(is.na(x))}) } else { keep <- 1:nrow(comm) keep <- keep[-which] } comm <- comm[keep,] site <- site[keep,] res <- list(comm=comm,site=site) attr(res,'call') <- match.call() attr(res,'orig_comm') <- orig_comm attr(res,'orig_site') <- orig_site res } dropspc <- function (comm,minocc=0,minabu=0) { comm <- comm[,apply(comm>minabu,2,sum)>minocc] attr(comm,'call') <- match.call() attr(comm,'minocc') <- minocc attr(comm,'minabu') <- minabu comm } r-cran-labdsv-2.0-1/R/dsvdis.R000077500000000000000000000032511412660326600157760ustar00rootroot00000000000000dsvdis <- function(x, index, weight = rep(1,ncol(x)), step = 0., diag=FALSE, upper=FALSE) { choices <- c("steinhaus", "sorensen", "ochiai", "ruzicka", "bray/curtis", "roberts", "chisq", "hellinger") i <- pmatch(index, choices) if(is.na(i)) stop(paste(index, "is not a valid index:", paste(choices, collapse = ", "))) if (!is.loaded("dsvdis")) { dyn.load("labdsv") } commname <- deparse(substitute(x)) x <- as.matrix(x) y <- matrix(0,nrow=nrow(x),ncol=nrow(x)) rowsum <- rep(0,nrow(x)) colsum <- rep(0,ncol(x)) dis <- .Fortran("dsvdis", as.double(x), as.double(weight), as.integer(nrow(x)), as.integer(ncol(x)), as.integer(i), out = as.double(y), as.double(step), as.double(rowsum), as.double(colsum), PACKAGE='labdsv') tmp <- matrix(dis$out, nrow = nrow(x)) tmp2 <- as.dist(tmp) class(tmp2) <- 'dist' attr(tmp2, "Labels") <- dimnames(x)[[1]] attr(tmp2, "Diag") <- diag attr(tmp2, "Upper") <- upper attr(tmp2, "method") <- choices[i] attr(tmp2, "call") <- match.call() attr(tmp2, "comm") <- commname attr(tmp2, "Size") <- nrow(x) return(tmp2) } summary.dist <- function (object,...) { if (!inherits(object,'dist')) stop("You must pass an object of class 'dist'") if (!is.null(attr(object, "call"))) { str <- c(attr(object, "call")) cat(paste("call = ", str, "\n")) } cat(paste("size = ", attr(object, "Size"), "\n")) if (!is.null(attr(object, "method"))) cat(paste("method = ", attr(object, "method"), "\n")) } r-cran-labdsv-2.0-1/R/dsvls.R000066400000000000000000000073251412660326600156400ustar00rootroot00000000000000dsvls <- function (frame=NULL,opt='full') { if (is.null(frame)) frame<- ls(parent.frame()) df <- NULL dis <- NULL ord <- NULL clust <- NULL stride <- NULL ordip <- NULL for (i in frame) { tmp <- eval(parse(text=i)) if (inherits(tmp,'data.frame')) df <- c(df,i) else if (inherits(tmp,'dist')) dis <- c(dis,i) else if (inherits(tmp,'dsvord')) ord <- c(ord,i) else if (inherits(tmp,c('clustering','partition','optpart','hclust'))) clust <- c(clust,i) else if (inherits(tmp,'stride')) stride <- c(stride,i) else if (inherits(tmp,'ordiplot')) ordip <- c(ordip,i) } if (opt == 'brief') { cat('data.frames\n') for (i in df) cat(paste(' ',i,'\n')) cat('distance/dissimilarity matrices\n') for (i in dis) cat(paste(' ',i,'\n')) cat('ordinations\n') for (i in ord) cat(paste(' ',i,'\n')) cat('classifications\n') for (i in clust) cat(paste(' ',i,'\n')) cat('strides\n') for (i in stride) cat(paste(' ',i,'\n')) cat('vegan ordiplots\n') for (i in ordip) cat(paste(' ',i,'\n')) } else { if (length(df) > 0) { cat('data.frames\n') for (i in df) { cat(paste(' ',i,'\n')) tmp <- eval(parse(text=i)) cat(paste(' nrow = ',nrow(tmp)),'\n') cat(paste(' ncol = ',ncol(tmp)),'\n') } } if (length(dis) > 0) { cat('distance/dissimilarity matrices\n') for (i in dis) { cat(paste(' ',i,'\n')) tmp <- eval(parse(text=i)) if (!is.null(attr(tmp,'call'))) { str <- c(attr(tmp,'call')) cat(paste(' call = ',str,'\n')) } cat(paste(' size = ',attr(tmp,'Size'),'\n')) if (!is.null(attr(tmp,'method'))) cat(paste(' method = ',attr(tmp,'method'),'\n')) } } if (length(ord) > 0) { cat('ordinations\n') for (i in ord) { cat(paste(' ',i,'\n')) tmp <- eval(parse(text=i)) cat(paste(' type = ',tmp$type,'\n')) cat(paste(' dim = ',ncol(tmp$points)),'\n') } } if (length(ordip) > 0) { cat('vegan ordiplot\n') for (i in ordip) { cat(paste(' ',i,'\n')) tmp <- eval(parse(text=i)) cat(paste(' dim = ',ncol(tmp$sites),'\n')) } } if (length(clust) > 0) { cat('classifications\n') for (i in clust) { tmp <- eval(parse(text=i)) cat(paste(' ',i,'\n')) if (inherits(tmp,'hclust')) { cat(paste(' dis = ',tmp$dist.method,'\n')) cat(paste(' method = ',tmp$method,'\n')) } else if (inherits(tmp,'partana')) { cat(paste(' dis = ',attr(tmp,'call')[[3]],'\n')) cat(paste(' numclu = ',attr(tmp,'call')[[2]],'\n')) cat(paste(' numitr = ',tmp$numitr,'\n')) cat(paste(' ratio = ',round(tmp$ratio[tmp$numitr],2),'\n')) } else if (inherits(tmp,'partition')) { cat(paste(' dis = ',tmp$call[[2]],'\n')) cat(paste(' method = ',attr(tmp,'class')[[1]],'\n')) cat(paste(' numclu = ',tmp$call[[3]],'\n')) } } } } } r-cran-labdsv-2.0-1/R/dsvord.R000066400000000000000000000202101412660326600157720ustar00rootroot00000000000000plot.dsvord <- function(x, ax = 1, ay = 2, col = 1, title = "", pch = 1, ...) { if (!inherits(x,'dsvord')) stop ("You must provide an object of class dsvord") xlab <- paste(x$type,ax) ylab <- paste(x$type,ay) plot(x$points[, ax], x$points[, ay], asp = 1, col = col, xlab = xlab, ylab = ylab, pch = pch, main = title, ...) invisible() } points.dsvord <- function(x, which, ax = 1, ay = 2, col = 2, pch = 1, cex=1, breaks=FALSE, ...) { if (!inherits(x,'dsvord')) stop("You must supply an object of class 'dsvord'") xp <- x$points[which, ax] yp <- x$points[which, ay] if (is.logical(which)) { points(xp, yp, col = col, pch = pch, cex = cex, ...) } else if (is.numeric(which)) { if (breaks) { mask <- !is.na(which) cex <- (which-min(which[mask])) / (max(which[mask])-min(which[mask])) * 5 } else { cex <- 1 } points(xp, yp, col = col, pch = pch, cex = cex, ...) } } hilight.dsvord <- function (ord, overlay, ax=1, ay=2, title="", cols=c(2,3,4,5,6,7), glyph=c(1,3,5), ...) { if (!inherits(ord,'dsvord')) stop("You must pass an object of class 'dsvord'") overlay <- as.integer(clustify(overlay)) plot(ord,ax=ax,ay=ay,type='n',...) title(title) layer <- 0 pass <- 1 for (i in 1:max(overlay,na.rm=TRUE)) { layer <- layer + 1 if (layer > length(cols)) { layer <- 1 pass <- pass + 1 } col <- cols[layer] pch <- glyph[pass] points(ord, overlay == i, ax, ay, col = col, pch = pch) } } plotid.dsvord <- function(ord, ids=seq(1:nrow(ord$points)), ax = 1, ay = 2, col = 1, ...) { if (!inherits(ord,'dsvord')) stop("You must supply an object of class 'dsvord'") identify(ord$points[, ax],ord$points[, ay],ids,col=col) } surf.dsvord <- function(ord, var, ax=1, ay=2, thinplate=TRUE, col=2, labcex = 0.8, family=gaussian, gamma=1.0, grid=50, ...) { if (!inherits(ord,'dsvord')) stop("You must supply an object of class 'dsvord'") if (missing(var)) { stop("You must specify a variable to surface") } x <- ord$points[,ax] y <- ord$points[,ay] if (any(is.na(var))) { cat("Omitting plots with missing values \n") x <- x[!is.na(var)] y <- y[!is.na(var)] var <- var[!is.na(var)] } if (is.logical(var)) { tvar <- as.numeric(var) if (thinplate) tmp <- gam(tvar~s(x,y),family=binomial,gamma=gamma) else tmp <- gam(tvar~s(x)+s(y),family=binomial, gamma=gamma) } else { if (thinplate) tmp <- gam(var~s(x,y),family=family, gamma=gamma) else tmp <- gam(var~s(x)+s(y),family=family,gamma=gamma) } new.x <- seq(min(x),max(x),len=grid) new.y <- seq(min(y),max(y),len=grid) xy.hull <- chull(x,y) xy.hull <- c(xy.hull,xy.hull[1]) new.xy <- expand.grid(x=new.x,y=new.y) inside <- as.logical(pip(new.xy$x,new.xy$y,x[xy.hull],y[xy.hull])) fit <- predict(tmp, type="response", newdata=as.data.frame(new.xy)) fit[!inside] <- NA contour(x=new.x,y=new.y,z=matrix(fit,nrow=grid), add=TRUE,col=col) print(tmp) d2 <- (tmp$null.deviance-tmp$deviance)/tmp$null.deviance cat(paste("D^2 = ",formatC(d2,width=4),"\n")) invisible(tmp) } chullord.dsvord <- function (ord, overlay, ax = 1, ay = 2, cols=c(2,3,4,5,6,7), ltys=c(1,2,3), ...) { if (!inherits(ord,'dsvord')) stop("You must pass an object of class 'dsvord'") overlay <- as.integer(clustify(overlay)) pass <- 1 layer <- 0 lty <- ltys[pass] for (i in 1:max(overlay,na.rm=TRUE)) { x <- ord$points[,ax][overlay==i & !is.na(overlay)] y <- ord$points[,ay][overlay==i & !is.na(overlay)] pts <- chull(x,y) layer <- layer + 1 if (layer > length(cols)) { layer <- 1 pass <- min(pass + 1,length(ltys)) } col <- cols[layer] lty = ltys[pass] polygon(x[pts],y[pts],col=col,density=0,lty=lty,...) } } ellip.dsvord <- function (ord, overlay, ax = 1, ay = 2, cols = c(2, 3, 4, 5, 6, 7), ltys = c(1, 2, 3), ...) { if (!inherits(ord,'dsvord')) stop("You must pass an object of class 'dsvord'") overlay <- as.integer(clustify(overlay)) pass <- 1 layer <- 0 lty <- ltys[pass] for (i in 1:max(overlay, na.rm = TRUE)) { x <- ord$points[, ax][overlay == i & !is.na(overlay)] y <- ord$points[, ay][overlay == i & !is.na(overlay)] pts <- chull(x, y) layer <- layer + 1 if (layer > length(cols)) { layer <- 1 pass <- min(pass + 1, length(ltys)) } col <- cols[layer] lty <- ltys[pass] x <- as.matrix(cbind(x[pts], y[pts])) elp <- ellipsoidhull(x,...) lines(predict(elp),col=col,...) } } density.dsvord <- function (ord, overlay, ax = 1, ay = 2, cols = c(2, 3, 4, 5, 6, 7), ltys = c(1, 2, 3), numitr, ...) { if (!inherits(ord,'dsvord')) stop("You must pass an object of class 'dsvord'") overlay <- as.integer(clustify(overlay)) densi <- function(xpts,ypts,overlay) { x <- xpts[overlay==1 & !is.na(overlay)] y <- ypts[overlay==1 & !is.na(overlay)] pts <- chull(x,y) a <- c(x,x[1]) b <- c(y,y[1]) inside <- pip(xpts,ypts,a,b) test <- pmax(inside,overlay==1) out <- sum(overlay)/sum(test) return(out) } out <- list() for (i in 1:max(overlay, na.rm = TRUE)) { obs <- densi(ord$points[, ax],ord$points[, ay], overlay==i) pval <- 0 for (j in 1:(numitr-1)) { rnd <- sample(1:length(overlay),sum(overlay==i),replace=FALSE) rndvec <- rep(0,length(overlay)) rndvec[rnd] <- 1 tmp <- densi(ord$points[, ax],ord$points[, ay], rndvec) if (tmp >= obs) pval <- pval + 1 } pval <- (pval+1)/numitr print(paste('d = ',obs,'p = ',pval)) } } gamord.dsvord <- function (ord,var,partial=NULL,family='gaussian',thinplate=TRUE) { ord <- ord$points if (any(is.na(var))) { cat("Omitting plots with missing values \n") ord <- ord[!is.na(var),] var <- var[!is.na(var)] } size <- ncol(ord) if (thinplate) { if (!is.null(partial)) indep <- 's(partial) + s(' else indep <- 's(' for (i in 1:(size-1)) { indep <- paste(indep,'ord[,',i,'],',sep='') } indep <- paste(indep,'ord[,',size,'])',sep='') print(paste('gam(var~',indep,',family=family)')) } else { if (!is.null(partial)) indep <- 's(partial) + ' else indep <- '' for (i in 1:(size-1)) { indep <- paste(indep,'s(ord[,',i,'])+',sep='') } indep <- paste(indep,'s(ord[,',size,'])',sep='') print(paste('gam(var~',indep,',family=family)')) } res <- eval(parse(text=paste('gam(var~',indep,',family=family)'))) res } summary.dsvord <- function(object, ...) { if (!inherits(object,'dsvord')) stop("You must pass an argument of type 'dsvord'") cat(paste('type = ',object$type,'\n')) cat(paste('dimensions = ',ncol(object$points),'\n')) if (inherits(object,'nmds')) cat(paste('stress = ',object$stress,'\n')) if (inherits(object,'pco')) cat(paste('GOF = ',object$GOF,'\n')) if (inherits(object,'tsne')) { cat(paste('perplexity = ',object$perplexity,'\n')) cat(paste('theta = ',object$theta,'\n')) cat(paste('eta = ',object$eta,'\n')) cat(paste('KL-Div = ',object$KLdiv,'\n')) } cat(paste('call = ',deparse(attr(object,'call')),'\n')) cat(paste('created = ',attr(object,'timestamp'),'\n')) } print.dsvord <- function(x,numpts=50,...) { cat(paste('type = ',x$type,'\n')) cat(paste('dimensions = ',ncol(x$points),'\n')) cat(paste("\nCall ",c(attr(x,'call')),"\n")) if (nrow(x$points) <= numpts) { cat("\nPoints\n") print(x$points) } } r-cran-labdsv-2.0-1/R/envrtest.R000077500000000000000000000020661412660326600163570ustar00rootroot00000000000000envrtest <- function (set,env,numitr=1000,minval=0, replace=FALSE, plotit=TRUE, main=paste(deparse(substitute(set)),' on ', deparse(substitute(env)))) { prob <- 0 if (!is.logical(set)) { mask <- (set > minval) } else { mask <- set } omin <- min(env[mask]) omax <- max(env[mask]) odiff <- omax - omin sdiff <- rep(0,numitr-1) for (i in 1:numitr-1) { tmp <- sample(1:length(env),sum(mask),replace=replace) nullmin <- min(env[tmp]) nullmax <- max(env[tmp]) null <- nullmax - nullmin if (null <= odiff) prob <- prob + 1 sdiff[i] <- null } prob <- min(1,(prob+1)/numitr) if (plotit) { plot(sort(sdiff),ylim=c(min(odiff,sdiff),max(sdiff)), ylab="Within-Set Difference", main=main) abline(odiff,0,col=2) text(0,max(sdiff),paste("p = ",format(prob,digits=3)),adj=0) } out <- list() out$diff <- odiff out$prob <- prob attr(out,'call') <- match.call() invisible(out) } r-cran-labdsv-2.0-1/R/euclidify.R000077500000000000000000000012421412660326600164550ustar00rootroot00000000000000euclidify <- function (dis,upper=FALSE,diag=FALSE) { if (!inherits(dis,'dist')) stop('The first argument must be an object of class dist') tmp <- .Fortran("euclid",dis=as.matrix(dis),as.integer(attr(dis,"Size")), PACKAGE='labdsv') tmp2 <- as.dist(tmp$dis) attr(tmp2, "Labels") <- dimnames(dis)[[1]] attr(tmp2, "Diag") <- diag attr(tmp2, "Upper") <- upper attr(tmp2, "method") <- paste("euclidify", attr(dis, "method")) attr(tmp2, "call") <- match.call() attr(tmp2, "timestamp") <- date() tmp2 } as.euclidean <- function(dis,upper=FALSE,diag=FALSE) { return(euclidify(dis,upper=upper,diag=diag)) } r-cran-labdsv-2.0-1/R/factorize.R000066400000000000000000000004141412660326600164630ustar00rootroot00000000000000factorize <- function (df) { for (i in 1:ncol(df)) { if (is.character(df[,i])) df[,i] <- factor(df[,i]) } df } defactorize <- function(df) { for (i in 1:ncol(df)) { if (is.factor(df[,i])) df[,i] <- as.character(df[,i]) } df } r-cran-labdsv-2.0-1/R/gsr.R000066400000000000000000000007201412660326600152700ustar00rootroot00000000000000gsr <- function (field,old,new) { if (length(old) != length(new)) stop("replacement vectors must be teh same length") newfield <- as.character(field) if (length(old)==1) { newfield[newfield==old] <- new } else { for (i in 1:length(old)) newfield[newfield==old[i]] <- new[i] } if (is.factor(field)) newfield <- factor(newfield) if (is.numeric(field)) newfield <- as.numeric(newfield) return(newfield) } r-cran-labdsv-2.0-1/R/homoteneity.R000066400000000000000000000011241412660326600170400ustar00rootroot00000000000000homoteneity <- function (comm,clustering) { clustering <- clustify(clustering) levels <- levels(clustering) clustering <- as.integer(clustering) numtyp <- length(table(clustering)) homo <- rep(NA,numtyp) S <- mean(apply(comm>0,1,sum)) const <- const(comm,clustering) for (i in 1:numtyp) { tmp <- as.numeric(rev(sort(const[,i]))) homo[i] <- mean(tmp[1:S]) } out <- data.frame(as.character(1:numtyp),homo) names(out) <- c('cluster','homoteneity') attr(out,'call') <- match.call() attr(out,'orig_clustering') <- levels out } r-cran-labdsv-2.0-1/R/importance.R000066400000000000000000000064371412660326600166510ustar00rootroot00000000000000importance <- function (comm, clustering, minval = 0, digits = 2, show = minval, sort = FALSE, typical = TRUE, spcord, dots = TRUE) { if (missing(clustering)) { impt <- apply(comm, 2, sum)/nrow(comm) impt <- impt[impt >= minval] impt <- data.frame(impt) names(impt) <- deparse(substitute(comm)) return(round(impt,digits)) } else if (is.logical(clustering)) { comm <- comm[clustering,] impt <- apply(comm, 2, sum)/nrow(comm) impt <- impt[impt >= minval] impt <- data.frame(impt) names(impt) <- deparse(substitute(clustering)) return(round(impt,digits)) } clustering <- clustify(clustering) if (length(table(clustering)) == 1) { impt <- apply(comm, 2, sum)/nrow(comm) impt <- impt[impt >= minval] impt <- data.frame(impt) return(round(impt,digits)) } else { res <- matrix(0, nrow = ncol(comm), ncol = length(levels(clustering))) x <- apply(comm, 2, function(x) { tapply(x, clustering, sum) }) if (typical) { y <- apply(comm, 2, function(x) { tapply(x > 0, clustering, sum) }) } else { y <- apply(comm, 2, function(x) { tapply(x >= 0, clustering, sum) }) } y[x == 0] <- 1 res <- x/y keep <- as.logical(apply(res, 2, max) >= minval) res <- res[, keep] tmp <- as.data.frame(t(res)) row.names(tmp) <- names(comm)[keep] if (!missing(spcord)) { tmp <- tmp[rev(order(spcord[keep])), ] } if (dots) { tmpx <- format(round(tmp, digits = digits)) tmpx[tmp < show] <- substring(" . ", 1, nchar(tmpx[1, 1])) print(tmpx) } if (sort) { cat("\nConstancy Table\n\n") print(tmp) repeat { plots <- readline(" enter the species: ") if (plots == "") { break } else { pnt <- readline(" in front of : ") } for (i in (strsplit(plots, ",")[[1]])) { ord <- 1:nrow(tmp) x <- match(i, row.names(tmp)) if (!is.na(x)) { ord <- ord[-x] y <- match(pnt, row.names(tmp[ord, ])) if (!is.na(y)) { if (y == 1) { ord <- c(x, ord) } else { first <- ord[1:(y - 1)] last <- ord[y:length(ord)] ord <- c(first, x, last) } tmp <- tmp[ord, ] print(tmp) } else { print(paste("species", pnt, "does not exist")) } } else { print(paste("species", i, "does not exist")) } } } attr(tmp, "call") <- match.call() attr(tmp, "comm") <- deparse(substitute(comm)) return(tmp) } } } r-cran-labdsv-2.0-1/R/indval.R000077500000000000000000000127371412660326600157700ustar00rootroot00000000000000indval <- function(x, ...) { UseMethod("indval") } indval.default <- function(x,clustering,numitr=1000, ...) { if (!is.data.frame(x)) x <- data.frame(x) clustering <- clustify(clustering) levels <- levels(clustering) clustering <- as.integer(clustering) if (any(apply(x>0,2,sum)==0)) stop('All species must occur in at least one plot') numplt <- nrow(x) numspc <- ncol(x) numcls <- as.integer(length(table(clustering))) maxcls <- rep(0,numspc) relfrq <- matrix(0,nrow=numspc,ncol=numcls) relabu <- matrix(0,nrow=numspc,ncol=numcls) indval <- matrix(0,nrow=numspc,ncol=numcls) indcls <- rep(0,numspc) pval <- rep(0,numspc) tmpfrq <- rep(0.0,numcls) tmpabu <- rep(0.0,numcls) pclass <- rep(0,numplt) tclass <- rep(0,numplt) errcod <- 0 tmp <- .Fortran("duleg", as.double(as.matrix(x)), as.integer(numplt), as.integer(numspc), as.integer(factor(clustering)), as.integer(table(clustering)), as.integer(numcls), as.integer(numitr), relfrq = relfrq, relabu = relabu, indval = indval, pval = pval, indcls = indcls, maxcls = as.integer(maxcls), as.double(tmpfrq), as.double(tmpabu), as.integer(pclass), as.integer(tclass), errcod = as.integer(errcod), PACKAGE='labdsv') out <- list(relfrq=data.frame(tmp$relfrq),relabu=data.frame(tmp$relabu), indval=data.frame(tmp$indval),maxcls=tmp$maxcls,indcls=tmp$indcls, pval=tmp$pval,error=tmp$errcod) row.names(out$relfrq) <- names(x) row.names(out$relabu) <- names(x) row.names(out$indval) <- names(x) names(out$maxcls) <- names(x) names(out$indcls) <- names(x) names(out$pval) <- names(x) names(out$relfrq) <- levels names(out$relabu) <- levels names(out$indval) <- levels class(out) <- 'indval' if (out$error == 1) cat('WARNING: one or more sample units not assigned to any cluster\n') out } indval.stride <- function(x,comm,numitr=1,...) { res <- rep(NA,ncol(x$clustering)) for (i in 1:ncol(x$clustering)) { res[i] <- mean(indval(comm,x$clustering[,i],numitr=numitr)$indcls) } clusters <- x$seq indval <- res out <- data.frame(clusters,indval) out } summary.indval <- function (object, p = 0.05, type='short', digits=2, show=p, sort=FALSE, too.many = 100, ...) { if (object$error == 1) cat('WARNING: one or more species not assigned to any cluster\n') if (type == 'short') { tmp <- data.frame(object$maxcls[object$pval <= p], round(object$indcls[object$pval <= p], 4), object$pval[object$pval <= p]) names(tmp) <- c("cluster", "indicator_value", "probability") if (nrow(tmp) <= too.many) print(tmp[order(tmp$cluster, -tmp$indicator_value), ]) cat(paste("\nSum of probabilities = ", sum(object$pval), "\n")) cat(paste("\nSum of Indicator Values = ", round(sum(object$indcls),digits=2), "\n")) cat(paste("\nSum of Significant Indicator Values = ", round(sum(tmp$indicator_value),digits=2), "\n")) cat(paste("\nNumber of Significant Indicators = ", nrow(tmp),"\n")) cat(paste("\nSignificant Indicator Distribution\n")) print(table(tmp$cluster)) } else { tmp <- format(round(object$indval,digits=digits)) keep <- apply(object$indval,1,function(x){max(x)>show}) tmp <- tmp[keep,] tmp[tmp < show] <- substring(" . ",1,nchar(tmp[1,1])) print(tmp) } if (sort) { repeat { plots <- readline(' enter the plots : ') if (plots == "") { break } else { pnt <- readline(' in front of : ') } for (i in strsplit(plots,",")[[1]]){ ord <- 1:nrow(tmp) x <- match(i,row.names(tmp)) print(paste(i,x)) if (!is.na(x)) { ord <- ord[-x] y <- match(pnt,row.names(tmp[ord,])) print(y) if (!is.na(y)) { if (y==1) { ord <- c(x,ord) } else { first <- ord[1:(y-1)] last <- ord[y:length(ord)] ord <- c(first,x,last) } tmp <- tmp[ord,] print(tmp) } else { print(paste('species',pnt,'does not exist')) } } else { print(paste('species',i,'does not exist')) } } } invisible(tmp) } } plot.indval <- function (indval,title='',pch=1,legend=TRUE) { plot(indval$indcls,indval$pval,col=indval$maxcls+1,log='y', pch=pch,xlab='Indicator Value',ylab='Probability') lines(c(0,1),c(0.05,0.05),col=2,lty=2) lines(c(0,1),c(0.01,0.01),col=2,lty=2) clusts <- 1:max(indval$maxcls) if (legend) legend(0.9,0.9,as.character(clusts), col=clusts+1,pch=pch) test <- readline("Do you want to identify any species [Y or N] : ") if (test == 'Y' || test == 'y') { spcs <- identify(indval$indcls,indval$pval,names(indval$indcls)) return(spcs) } } r-cran-labdsv-2.0-1/R/isamic.R000077500000000000000000000003571412660326600157530ustar00rootroot00000000000000isamic <- function (comm,clustering,sort=FALSE) { tmp <- const(comm,clustering) result <- apply(tmp,1,function(x) {2*sum(abs(as.numeric(x)-0.5))/ncol(tmp)}) if (sort) result <- rev(sort(result)) result } r-cran-labdsv-2.0-1/R/matrify.R000066400000000000000000000010411412660326600161450ustar00rootroot00000000000000matrify <- function(data) { if (ncol(data) != 3) stop('data frame must have three column format') plt <- data[,1] spc <- data[,2] abu <- data[,3] plt.codes <- levels(factor(plt)) spc.codes <- levels(factor(spc)) comm <- matrix(0,nrow=length(plt.codes),ncol=length(spc.codes)) row <- match(plt,plt.codes) col <- match(spc,spc.codes) for (i in 1:length(abu)) { comm[row[i],col[i]] <- abu[i] } comm <- data.frame(comm) names(comm) <- spc.codes row.names(comm) <- plt.codes comm } r-cran-labdsv-2.0-1/R/metrify.R000077500000000000000000000025671412660326600161720ustar00rootroot00000000000000metrify <- function (dis,upper=FALSE,diag=FALSE) { if (!inherits(dis,'dist')) stop('The first argument must be an object of class dist') tmp <- .Fortran("metric",dis=as.matrix(dis),as.integer(attr(dis,"Size")), PACKAGE='labdsv') tmp2 <- as.dist(tmp$dis) attr(tmp2, "Labels") <- dimnames(dis)[[1]] attr(tmp2, "Diag") <- diag attr(tmp2, "Upper") <- upper attr(tmp2, "method") <- paste("metrify", attr(dis, "method")) attr(tmp2, "call") <- match.call() tmp2 } as.metric <- function (dis,upper=FALSE,diag=FALSE) { if (!inherits(dis,'dist')) stop('The first argument must be an object of class dist') tmp <- .Fortran("metric",dis=as.matrix(dis),as.integer(attr(dis,"Size")), PACKAGE='labdsv') tmp2 <- as.dist(tmp$dis) attr(tmp2, "Labels") <- dimnames(dis)[[1]] attr(tmp2, "Diag") <- diag attr(tmp2, "Upper") <- upper attr(tmp2, "method") <- paste("metrify", attr(dis, "method")) attr(tmp2, "call") <- match.call() tmp2 } is.metric <- function (dis) { if (!inherits(dis,'dist')) stop('The first argument must be an object of class dist') flag <- 0 tmp <- .Fortran("ismetric",dis=as.matrix(dis),as.integer(attr(dis,"Size")), flag=as.integer(flag),PACKAGE='labdsv') if (tmp$flag==0) ans <- TRUE else ans <- FALSE ans } r-cran-labdsv-2.0-1/R/neighbors.R000066400000000000000000000010261412660326600164550ustar00rootroot00000000000000neighbors <- function (dis,numnbr=1) { mat <- as.matrix(dis) diag(mat) <- 999 out <- matrix(NA,nrow=nrow(mat),ncol=numnbr) for (i in 1:nrow(mat)) { tmp <- rank(mat[i,]) nbrs <- which(tmp <= numnbr) if (length(nbrs) == 0) nbrs <- which(mat[i,] == min(mat[i,]))[1:numnbr] nbrs <- nbrs[order(mat[i,nbrs])] out[i,] <- nbrs[1:numnbr] } out <- data.frame(out) row.names(out) <- attr(dis,'Labels') names(out) <- as.character(1:numnbr) out } r-cran-labdsv-2.0-1/R/nmds.R000077500000000000000000000030601412660326600154410ustar00rootroot00000000000000nmds <- function(dis,k=2,y=cmdscale(d=dis,k=k),maxit=50,trace=FALSE) { if (!inherits(dis,'dist')) stop("You must pass a dist() obhject as the first argument") if (!is.numeric(k)) stop("The second argument must be an integer") out <- isoMDS(dis,y=y,k=k,maxit=maxit,trace=trace) class(out) <- c("dsvord","nmds") attr(out,'call') <- match.call() attr(out,'timestamp') <- date() out$type <- "NMDS" return(out) } bestnmds <- function (dis,k=2,itr=20,maxit=100,trace=FALSE) { if (!inherits(dis,'dist')) stop("You must pass a dist() object as the first argument") if (!is.numeric(k)) stop("The second argument must be an integer") if (!is.numeric(itr)) stop("The third argument must be an integer") if (interactive()) pb <- txtProgressBar(min=0, max=itr, style=3) strss <- rep(0,itr) out <- nmds(dis,k=k,maxit=maxit,trace=trace) strss[1] <- out$stress minstr <- out$stress best <- 1 for (i in 2:itr) { tmp <- nmds(dis,k=k,y=matrix(runif(k*attr(dis,'Size')),ncol=k), maxit=maxit,trace=trace) strss[i] <- tmp$stress if (tmp$stress < minstr) { minstr <- tmp$stress best <- i out <- tmp } if (interactive()) setTxtProgressBar(pb,i) } if (interactive()) close(pb) print(strss) cat(paste("\nbest result =", best)) cat(paste("\nwith stress =",format(out$stress,4),"\n")) class(out) <- c("dsvord","nmds") attr(out,'call') <- match.call() attr(out,'timestamp') <- date() out$type = "NMDS" out } r-cran-labdsv-2.0-1/R/ordcomm.R000066400000000000000000000050331412660326600161370ustar00rootroot00000000000000ordcomm <- function (comm,site) { print(comm) repeat { plots <- readline(' enter the plots : ') if (plots == "") { break } else { pnt <- as.numeric(readline(' in front of : ')) } for (i in strsplit(plots,",")[[1]]){ ord <- 1:nrow(comm) x <- match(i,row.names(comm)) if (!is.na(x)) { ord <- ord[-x] y <- match(pnt,row.names(comm[ord,])) if (!is.na(y)) { if (y==1) { ord <- c(x,ord) } else { first <- ord[1:(y-1)] last <- ord[y:length(ord)] ord <- c(first,x,last) } comm <- comm[ord,] site <- site[ord,] print(comm) } else { print(paste('plot',pnt,'does not exist')) } } else { print(paste('plot',i,'does not exist')) } } repeat { species <- readline(' enter the species : ') if (species == "") { break } else { pnt <- readline(' in front of : ') } for (i in strsplit(species,",")[[1]]){ ord <- 1:ncol(comm) x <- match(i,names(comm)) if (!is.na(x)) { ord <- ord[-x] y <- match(pnt,names(comm[,ord])) if (!is.na(y)) { if (y==1) { ord <- c(x,ord) } else { first <- ord[1:(y-1)] last <- ord[y:length(ord)] print(first) print(last) ord <- c(first,x,last) } comm <- comm[,ord] print(comm) } else { print(paste('species',pnt,'does not exist')) } } else { print(paste('species',i,'does not exist')) } } } } out <- list(comm=comm,site=site) invisible(out) } r-cran-labdsv-2.0-1/R/ordcomp.R000077500000000000000000000011471412660326600161470ustar00rootroot00000000000000ordcomp <- function(x,dis,dim,xlab="Computed Distance",ylab="Ordination Distance",title="",pch=1) { if (inherits(x,"dsvord")) { z <- x$points } else if (inherits(x,"ordiplot")) { z <- x$sites } else { z <- x } y <- as.dist(dis) if (missing(dim)) dim <- ncol(z) if (ncol(z) > dim) cat(paste("Only comparing first",dim,"dimensions\n")) if (length(y) > 5000 & missing(pch)) pch <- "." a <- dist(z[,1:dim]) plot(y,a,xlab=xlab,ylab=ylab,main=title,pch=pch) text(min(y),max(a),paste("r = ",format(cor(y,a),digits=3)),pos=4) invisible(cor(y,a)) } r-cran-labdsv-2.0-1/R/orddist.R000077500000000000000000000005141412660326600161510ustar00rootroot00000000000000orddist <- function (x, dim) { z <- x$points if (missing(dim)) dim <- ncol(z) if (dim != ncol(z)) cat(paste("Only comparing first",dim,"dimensions\n")) if (dim > ncol(z)) { dim <- ncol(z) cat(paste("The ordination is only",dim,"dimensionsal.")) } tmp <- dist(z[, 1:dim]) tmp } r-cran-labdsv-2.0-1/R/ordneighbors.R000066400000000000000000000023341412660326600171650ustar00rootroot00000000000000ordneighbors <- function (ord,dis,numnbr=1,ax=1,ay=2,digits=5,length=0.1) { if (!inherits(ord,'dsvord')) stop("The first argument must be an object of class 'dsvord'") mat <- as.matrix(dis) diag(mat) <- 999 sum <- 0 neighbors <- 0 x <- ord$points[,ax] y <- ord$points[,ay] for (i in 1:nrow(mat)) { tmp <- rank(mat[i,]) nbrs <- which(tmp <= numnbr) if (length(nbrs) == 0) nbrs <- which(mat[i,] == min(mat[i,])) for (j in nbrs) { arrows(x[i],y[i],x[j],y[j], length=length,col=2) sum <- sum + sqrt((x[i]-x[j])^2 + (y[i]-y[j])^2) neighbors <- neighbors + 1 } } meannbr <- sum/neighbors meandis <- mean(dist(ord$points)) cat(paste("Mean distance to neighbor = ", round(meannbr,digits),"\n")) cat(paste("Mean matrix distance = ", round(meandis,digits),"\n")) cat(paste("Ratio = ", round(meannbr/meandis,digits),"\n")) out <- list(meaninbrdist=round(meannbr,digits), meanmatdist=round(meandis,digits), ratio=as.numeric(round(meannbr/meandis,digits))) invisible(out) } r-cran-labdsv-2.0-1/R/ordpart.R000077500000000000000000000020741412660326600161570ustar00rootroot00000000000000ordpart <- function(ord, ax = 1, ay = 2) { UseMethod("ordpart") } ordpart.dsvord <- function(ord,ax=1,ay=2) { set <- 0 clust <- rep(0,nrow(ord$points)) while (1) { set <- set + 1 tmp <- locator(type='l',col=set+1) if (length(tmp$x) > 0) { x <- c(tmp$x,tmp$x[1]) y <- c(tmp$y,tmp$y[1]) lines(x,y,col=set+1) tmp <- pip(ord$points[,ax],ord$points[,ay],x,y) points(ord,as.logical(tmp),ax,ay,col=set+1) clust <- pmax(clust,tmp*set) } else { break } } out <- list() out$clustering <- clust class(out) <- 'clustering' attr(out,'call') <- match.call() attr(out,'timestamp') <- date() return(out) } pip <- function (x,y,polyx,polyy) { z <- rep(0,length(x)) res <- .Fortran("pip", as.double(x), as.double(y), as.integer(z), as.double(polyx), as.double(polyy), as.integer(length(x)), as.integer(length(polyx)), PACKAGE='labdsv') return(res[[3]]) } r-cran-labdsv-2.0-1/R/ordtest.R000077500000000000000000000015721412660326600161720ustar00rootroot00000000000000ordtest <- function (ord,var,dim=1:ncol(ord$points),index='euclidean',nitr=1000) { if (!inherits(ord, c('dsvord'))) stop('ordtest is only defined for objkect of class dsvord') points <- ord$points tdist <- 0 observed <- 0 reps <- rep(0,nitr-1) variable <- deparse(substitute(var)) var <- factor(var) for (i in levels(var)) { mask <- var == i tdist <- tdist + sum(dist(points[mask,dim],index)) } observed <- tdist for (i in 1:(nitr-1)) { tdist <- 0 var <- sample(var,length(var),replace=FALSE) for (j in levels(var)) { mask <- var == j tdist <- tdist + sum(dist(points[mask,dim],index)) } reps[i] <- tdist } pval <- (sum(reps<=observed)+1)/nitr print(paste(variable,'<',pval)) out <- list(obs=observed,p=pval,reps=reps) invisible(out) } r-cran-labdsv-2.0-1/R/ordutils.R000077500000000000000000000013621412660326600163500ustar00rootroot00000000000000surf <- function(ord,...) { UseMethod("surf") } plotid <- function(ord,...) { UseMethod("plotid") } specid <- function(ord,...) { UseMethod("specid") } hilight <- function(ord, ...) { UseMethod("hilight") } chullord <- function(ord, ...) { UseMethod("chullord") } thull <- function(ord, ...) { UseMethod("thull") } density <- function(ord, ...) { UseMethod("density") } ellip <- function(ord, ...) { UseMethod("ellip") } rgl <- function(ord, ...) { UseMethod("rgl") } loadings <- function(pca, ...) { UseMethod("loadings") } varplot <- function(pca, ...) { UseMethod("varplot") } scores <- function(pca, ...) { UseMethod("scores") } calibrate <- function(dsvord, ...) { UseMethod("calibrate") } r-cran-labdsv-2.0-1/R/pca.R000077500000000000000000000033071412660326600152470ustar00rootroot00000000000000pca <- function(mat, cor=FALSE, dim=min(nrow(mat),ncol(mat))) { tmp <- prcomp(mat, retx=TRUE, center=TRUE, scale=cor) out <- list() out$scores <- tmp$x[,1:dim] out$points <- tmp$x[,1:dim] out$loadings <- tmp$rotation[,1:dim] out$sdev <- tmp$sdev[1:dim] out$totdev <- sum(tmp$sdev^2) class(out) <- c("dsvord","pca") out$type <- 'PCA' return(out) } summary.pca <- function(object, dim=length(object$sdev), ...) { vars <- object$sdev^2 vars <- vars/object$totdev cat("Importance of components:\n") print(rbind("Standard deviation" = object$sdev[1:dim], "Proportion of Variance" = vars[1:dim], "Cumulative Proportion" = cumsum(vars[1:dim]))) } scores.pca <- function (x,labels=NULL,dim=length(x$sdev)) { if (dim>length(x$sdev)) { cat("Only",length(x$sdev)," axes available\n") dim <- length(x$sdev) } if (!is.null(labels)) { cbind(labels,x$scores[,1:dim]) } else { x$scores[,1:dim] } } loadings.pca <- function (x, dim=length(x$sdev), digits=3, cutoff=0.1) { if (dim>ncol(x$loadings)) { cat("Only",ncol(x$loadings),"axes available\n") dim <- ncol(x$loadings) } cat("\nLoadings:\n") cx <- format(round(x$loadings[,1:dim], digits = digits)) cx[abs(x$loadings[,1:dim]) < cutoff] <- substring(" ",1, nchar(cx[1, 1])) print(cx, quote = FALSE) invisible() } loadings.default <- function(x, ...) { stats::loadings(x, ...) } varplot.pca <- function(x,dim=length(x$sdev)) { var <- x$sdev^2 barplot(var[1:dim],ylab="Variance") readline("Hit Return to Continue\n") barplot(cumsum(var/x$totdev)[1:dim],ylab="Cumulative Variance") } r-cran-labdsv-2.0-1/R/pco.R000077500000000000000000000002151412660326600152600ustar00rootroot00000000000000pco <- function(dis, k=2) { tmp <-cmdscale(dis,k=k,eig=TRUE) class(tmp) <- c("dsvord","pco") tmp$type <- "PCO" return(tmp) } r-cran-labdsv-2.0-1/R/plot.ord.R000066400000000000000000000007501412660326600162410ustar00rootroot00000000000000plot.pco <- function(x, ...) { plot(as.dsvord(x,...)) cat("\nlabdsv 1.X ordinations are deprecated") cat("\nUse 'x <- dsvord(x)' to update them\n\n") } plot.pca <- function(x, ...) { plot(as.dsvord(x,...)) cat("\nlabdsv 1.X ordinations are deprecated") cat("\nUse 'x <- dsvord(x)' to update them\n\n") } plot.nmds <- function(x, ...) { plot(as.dsvord(x,...)) cat("\nlabdsv 1.X ordinations are deprecated") cat("\nUse 'x <- dsvord(x)' to update them\n\n") } r-cran-labdsv-2.0-1/R/predict.dsvord.R000066400000000000000000000052351412660326600174350ustar00rootroot00000000000000predict.dsvord <- function(object,comm,minocc=5,dims=1:ncol(object$points), family='nb',gamma=1,keep.models=FALSE,...) { if (!inherits(object,'dsvord')) stop("The first argument must be an object of class 'dsvord'") if (nrow(comm) != nrow(object$points)) stop("The arguments are incompatible") getdev <- function(object) { a <- object$deviance b <- object$null.deviance out <- 1 - (a/b) out } r.sq <- function (object) { w <- as.numeric(object$prior.weights) mean.y <- sum(w * object$y)/sum(w) w <- sqrt(w) residual.df <- length(object$y) - sum(object$edf) nobs <- nrow(object$model) r.sq <- 1 - var(w * (as.numeric(object$y) - object$fitted.values)) * (nobs - 1)/(var(w * (as.numeric(object$y) - mean.y)) * residual.df) r.sq } points <- object$points[,dims] numdim <- ncol(points) if (numdim > 3) { cat("\n truncating to 3D\n") points <- points[,1:3] } check <- apply(comm>0,2,sum)>=minocc if (sum(check) < ncol(comm)) { rare <- ncol(comm)-sum(check) cat(paste("\n deleting",rare,"rare species\n")) comm <- comm[,check] } size <- ncol(comm) if (size == 0) stop("No species left, reduce minocc") res <- list() if (interactive()) pb <- txtProgressBar(min=0, max=ncol(comm), style=3) if (numdim == 2) { for (i in 1:size) { res[[i]] <- try(gam(comm[,i] ~ s(points[,1],points[,2]), family=family,gamma=gamma)) if (inherits(res[[i]],'try-error')) res[[i]] <- gam(comm[,i] ~ s(points[,1]) + s(points[,2]), family=family,gamma=gamma) if (interactive()) setTxtProgressBar(pb,i) } } else if (numdim == 3) { for (i in 1:size) { res[[i]] <- try(gam(comm[,i] ~ s(points[,1],points[,2],points[,3]), family=family,gamma=gamma)) if (inherits(res[[i]],'try-error')) res[[i]]<- gam(comm[,i] ~ s(points[,1]) + s(points[,2])+ s(points[,3]),family=family,gamma=gamma) if (interactive()) setTxtProgressBar(pb,i) } } if (interactive()) close(pb) aic <- sapply(res,AIC) dev <- sapply(res,getdev) adj.rsq <- sapply(res,r.sq) fitted <- sapply(res,predict,type='response') dimnames(fitted) <- list(row.names(comm),names(comm)) out <- list(fitted=fitted,aic=aic,dev.expl=dev,adj.rsq=adj.rsq) if (keep.models) { out$models <- res dimnames(out$models) <- names(comm) } out } r-cran-labdsv-2.0-1/R/raretaxa.R000066400000000000000000000021621412660326600163060ustar00rootroot00000000000000raretaxa <- function (comm,min=1,log=FALSE,type='b',panel='all') { rare <- apply(comm>0,2,sum) <= min occ <- apply(comm[,rare]>0,1,sum) abu <- apply(comm[,rare],2,sum)/apply(comm[,rare]>0,2,sum) tot <- apply(comm[,rare],1,sum) if (panel == 'all' || panel == 1) { if (log) { plot(rev(sort(occ[occ>0])),log='y',type=type, xlab='Plot',ylab='Rare Species/Plot') } else { plot(rev(sort(occ[occ>0])),type=type, xlab='Plot',ylab='Rare Species/Plot') } if (panel == 'all') readline('Hit return') } if (panel == 'all' || panel == 2) { if (log) { plot(rev(sort(abu)),type=type,log='y',xlab='Species',ylab='Mean Abundance') } else { plot(rev(sort(abu)),type=type,xlab='Species',ylab='Mean Abundance') } if (panel == 'all') readline('Hit return') } if (panel == 'all' || panel == 3) { plot(rev(sort(tot[tot>0])),type=type,log='y',xlab='Plot',ylab='Total Abundance') } out=list(rare=rare,occurence=occ,abundance=abu,total=tot) invisible(out) } r-cran-labdsv-2.0-1/R/reconcile.R000066400000000000000000000034071412660326600164450ustar00rootroot00000000000000reconcile <- function (comm, site, exlist = 10) { if (identical(row.names(comm), row.names(site))) { cat("You're good to go\n") } else { orig_comm <- deparse(substitute(comm)) orig_site <- deparse(substitute(site)) extracomm <- nrow(comm) - sum(row.names(comm) %in% row.names(site)) if (extracomm > 0) { cat(paste("You have", extracomm, "plots in comm not in site\n")) if (extracomm <= exlist) print(row.names(comm)[!row.names(comm) %in% row.names(site)]) cat("I'll delete the extra plots in comm in the output\n") } extrasite <- nrow(site) - sum(row.names(site) %in% row.names(comm)) if (extrasite > 0) { cat(paste("You have", extrasite, "plots in site not in comm\n")) if (extrasite <= exlist) print(row.names(site)[!row.names(site) %in% row.names(comm)]) cat("I'll delete the extra plots in site in the output\n") } if (!extracomm && !extrasite) { cat("Your data.frames have the same sample units but are sorted differently\n") cat("I'll fix that\n") } if (!extracomm || !extrasite) { cat("Your edited data.frames now have the same sample units but are sorted differently\n") cat("I'll fix that\n") } comm <- comm[order(row.names(comm)), ] site <- site[order(row.names(site)), ] comm <- comm[row.names(comm) %in% row.names(site), ] site <- site[row.names(site) %in% row.names(comm), ] out <- list(comm = comm, site = site) attr(out, "call") <- match.call() attr(out, "orig_comm") <- orig_comm attr(out, "orig_site") <- orig_site invisible(out) } } r-cran-labdsv-2.0-1/R/refactor.R000066400000000000000000000002011412660326600162740ustar00rootroot00000000000000refactor <- function (df) { for (i in 1:ncol(df)) { if (is.factor(df[,i])) df[,i] <- factor(df[,i]) } df } r-cran-labdsv-2.0-1/R/rndcomm.R000077500000000000000000000006251412660326600161430ustar00rootroot00000000000000rndcomm <- function(comm,replace=FALSE,species=FALSE,plots=FALSE) { if (species) { out <- apply(comm,2,sample,replace=replace) } if (plots) { out <- apply(comm,1,sample,replace=replace) } if (!species & !plots) { tmp <- as.vector(as.matrix(comm)) out <- as.data.frame(matrix(sample(tmp,replace=replace),ncol=ncol(comm))) } as.data.frame(out) } r-cran-labdsv-2.0-1/R/rnddist.R000077500000000000000000000012671412660326600161560ustar00rootroot00000000000000rnddist <- function (size, method='metric', sat = 1.0, upper=FALSE, diag=FALSE) { tmp <- matrix(runif(size^2),ncol=size) x <- as.dist(tmp) if (method == 'metric') { y <- metrify(x, upper=upper, diag=diag) attr(y, "method") <- "metric random" } else if (method == 'euclidean') { y <- euclidify(x, upper=upper, diag=diag) attr(y,"method") <- 'euclidean random' } else { stop("you must specify 'metric' or 'euclidean' as the method") } y <- y/max(y) if (sat != 1.0) { y <- y / sat y[y>1.0] <- 1.0 } attr(y, "call") <- match.call() attr(y, "Diag") <- diag attr(y, "Upper") <- upper y } r-cran-labdsv-2.0-1/R/spcdisc.R000077500000000000000000000004571412660326600161370ustar00rootroot00000000000000spcdisc <- function(x,sort=FALSE) { shannon <- function(y) { y <- as.numeric(y) frac <- y/sum(y) comp <- sum((-1 * frac * log(frac))[frac>0]) comp <- 1 - (comp/log(length(y))) comp } tmp <- apply(x,1,shannon) if (sort) tmp <- tmp[rev(order(tmp))] tmp } r-cran-labdsv-2.0-1/R/standi.R000066400000000000000000000006561412660326600157670ustar00rootroot00000000000000samptot <- function(comm) { x <- apply(comm,1,sum) comm <- sweep(comm,1,x,'/') comm } spcmax <- function(comm) { x <- apply(comm,2,max) comm <- sweep(comm,2,x,'/') comm } hellinger <- function(comm) { x <- apply(comm,1,sum) comm <- sqrt(sweep(comm,1,x,'/')) comm } convex <- function(n,b=2,stand=FALSE) { res <- b^(n-1) - b^seq(n-1,0) if (stand) res <- res/res[n] res } r-cran-labdsv-2.0-1/R/stepdist.R000066400000000000000000000010021412660326600163260ustar00rootroot00000000000000stepdist <- function (dis,alpha) { labels<- attr(dis,'Labels') dis <- as.matrix(dis) dis[dis >= alpha] <- 9999.9 n <- nrow(dis) out <- .Fortran('stepdist', as.double(dis), as.integer(n), PACKAGE='labdsv') out <- as.dist(matrix(out[[1]],nrow=n)) attr(out,'timestamp') <- date() attr(out,'call') <- match.call() attr(out,'Labels') <- labels if (max(out) == 9999.9) print('Space is disjunct') invisible(out) } r-cran-labdsv-2.0-1/R/subset_dist.R000066400000000000000000000002671412660326600170330ustar00rootroot00000000000000subset.dist <- function (dist,subset) { if (!inherits(dist,'dist')) stop('You must pass an object of class dist') dist <- as.dist(as.matrix(dist)[subset,subset]) dist } r-cran-labdsv-2.0-1/R/thull.R000077500000000000000000000072561412660326600156430ustar00rootroot00000000000000thull.dsvord <- function (ord,var,grain,ax=1,ay=2,col=2, grid=51,nlevels=5, levels=NULL,lty=1,numitr=100,...) { if (!inherits(ord,"dsvord")) { stop("You must supply an object of class dsvord") } if(missing(var)) { stop("You must specify a variable to surface") } if (is.null(var)) { stop("No such variable") } x <- ord$points[,ax] y <- ord$points[,ay] if (any(is.na(var))) { cat("Omitting plots with missing values \n") x <- x[!is.na(var)] y <- y[!is.na(var)] var <- var[!is.na(var)] } new.x <- seq(min(x),max(x),len=grid) new.y <- seq(min(y),max(y),len=grid) hull <- matrix(0,nrow=grid,ncol=grid) res <- .Fortran('thull', hull=as.double(hull), as.double(new.x), as.double(new.y), as.integer(grid), as.double(x), as.double(y), as.double(var), as.integer(length(x)), as.double(grain), PACKAGE='labdsv') if (is.null(levels)) { vals <- levels(factor(var)) levels <- as.numeric(vals)[-1] } contour(x=new.x,y=new.y,z=matrix(res$hull,nrow=grid), add=TRUE,col=col,nlevels=nlevels,levels=levels,lty=lty) final <- matrix(res$hull,nrow=grid) out <- list(thull=final,x=new.x,y=new.y,ax=x,ay=y,vals=var, xlab=paste(ord$type,ax),ylab=paste(ord$type,ay), main=deparse(substitute(var))) if (numitr > 0) { obssum <- sum(final) rndsum <- rep(NA,numitr-1) for (i in 1:(numitr-1)) { res <- .Fortran('thull', hull=as.double(hull), as.double(new.x), as.double(new.y), as.integer(grid), as.double(x), as.double(y), as.double(sample(var,replace=FALSE)), as.integer(length(x)), as.double(grain), PACKAGE='labdsv') rndsum[i] <- sum(res$hull) } cat(paste('\nvolume = ',format(obssum,digits=5),'\nmean = ', format(mean(rndsum),digit=5), '\nfraction = ',format(obssum/mean(rndsum),digits=5))) cat(paste('\np <= ',(sum(rndsum<=obssum)+1)/numitr),'\n') out$obs <- obssum out$reps <- rndsum } class(out) <- 'thull' attr(out,'call') <- match.call() attr(out,'timestamp') <- date() invisible(out) } plot.thull <- function (x,col=rainbow(20),levels=NULL,cont=TRUE, xlab=x$xlab,ylab=x$ylab,main=x$main,...) { if (!inherits(x,'thull')) stop("You must pass an argument of type 'thull'") if (is.null(levels)) { vals <- levels(factor(x$vals)) levels <- as.numeric(vals)[-1] } image(x$x,x$y,x$thull,col=col,asp=1,xlab=xlab,ylab=ylab,main=main) if (cont) contour(x$x,x$y,x$thull,levels=levels,nlevels=length(levels),add=TRUE) } summary.thull <- function(object,...) { if (!inherits(object,'thull')) stop("You must pass an object of class 'thull'") cat(paste('\nvolume = ',format(object$obs,digits=5),'\nmean = ', format(mean(object$reps),digit=5), '\nfraction = ',format(object$obs/mean(object$reps),digits=5))) cat(paste('\np <= ',format( (sum(object$reps<=object$obs)+1)/length(object$reps+1) ,digits=2),'\n')) cat(paste('\ncall = ',deparse(attr(object,'call')),'\n')) cat(paste('created = ',attr(object,'timestamp'),'\n')) } r-cran-labdsv-2.0-1/R/tsne.R000066400000000000000000000034721412660326600154550ustar00rootroot00000000000000tsne <- function (dis, k = 2, perplexity = 30, theta = 0.0, eta = 200) { if (!inherits(dis,'dist')) stop("You must pass an object of class 'dist' as the first argument") tmp <- Rtsne(dis, dims= k, perplexity = perplexity, theta = theta, eta = eta, is_distance = TRUE) out=list(points=tmp$Y,type='t-SNE',perplexity=tmp$perplexity,theta=theta, eta=eta,KLdiv=tail(tmp$itercosts,1)) class(out) <- c('dsvord','tsne') attr(out,'call') <- match.call() attr(out,'timestamp') <- date() out } besttsne <- function (dis, k = 2, itr = 100, perplexity = 30, theta = 0.0, eta = 200) { if (!inherits(dis,'dist')) stop("You must pass an object of class 'dist' as the first argument") if (interactive()) pb <- txtProgressBar(min=0, max=itr, style=3) kldiv <- rep(0, itr) res <- Rtsne(dis, dims = k, perplexity = perplexity, theta = theta, eta = eta, is_distance = TRUE) kldiv[1] <- tail(res$itercosts, 1) minkld <- kldiv[1] best <- 1 for (i in 2:itr) { tmp <- Rtsne(dis, dims = k, perplexity = perplexity, theta = theta, eta = eta, is_distance = TRUE) kldiv[i] <- tail(tmp$itercosts, 1) if (kldiv[i] < minkld) { minkld <- kldiv[i] best <- i res <- tmp } if (interactive()) setTxtProgressBar(pb,i) } if (interactive()) close(pb) print(kldiv) cat(paste("\nbest result =", best)) cat(paste("\nwith KL-div =",format(kldiv[best],4),"\n")) out <- list(points=res$Y,type='t-SNE') class(out) <- c('dsvord','tsne') attr(out,'perplexity') <- res$perplexity attr(out,'theta') <- res$theta attr(out,'eta') <- res$eta attr(out,'KL-div') <- kldiv[best] attr(out,'call') <- match.call() attr(out,'timestamp') <- date() out } r-cran-labdsv-2.0-1/R/vegtab.R000077500000000000000000000020341412660326600157500ustar00rootroot00000000000000vegtab <- function(comm,set,minval=1,pltord,spcord,pltlbl,trans=FALSE) { if (missing(set)) { set <- seq(1:nrow(comm)) } else { set <- seq(1:nrow(comm))[set] set <- set[!is.na(set)] } tmp <- comm[set,] spcidx <- apply(tmp>0,2,sum) tmp <- tmp[,spcidx >= minval] if (missing(pltord)) { pltord <- seq(1:nrow(tmp)) } else { pltord <- pltord[set] } if (missing(spcord)) { x <- apply(tmp > 0, 2, sum) y <- apply(tmp, 2, sum) spcord <- -1 * (x + y/max(y)) #spcord <- -apply(tmp > 0, 2, sum) } else { spcord <- spcord[spcidx >= minval] } if (!missing(pltlbl)) { if (is.numeric(pltlbl)) { tmp <- cbind(pltlbl[set],tmp) dimnames(tmp)[[2]][1] <- deparse(substitute(pltlbl)) spcord <- c(min(spcord)-1,spcord) } else { dimnames(tmp)[[1]] <- pltlbl } } tmp <- tmp[order(pltord),order(spcord)] if (trans==TRUE) { tmp <- t(tmp) } tmp } r-cran-labdsv-2.0-1/R/zzz.R000066400000000000000000000002631412660326600153340ustar00rootroot00000000000000.onAttach <- function(lib, pkg) { packageStartupMessage("This is labdsv 2.0-1\nconvert existing ordinations with as.dsvord()", appendLF = TRUE) } r-cran-labdsv-2.0-1/data/000077500000000000000000000000001412660326600150635ustar00rootroot00000000000000r-cran-labdsv-2.0-1/data/brycesite.rda000066400000000000000000000076131412660326600175530ustar00rootroot00000000000000‹š xUÅÇç¾—„¥Š¨`K±~Òº”û²ŸvHm•ÖE-i $!,‘„$@eDTAÙ"KEE­  Ö WDE\PDk„"PÀ­ÿ¹çÌãžËÅ|ßÏYÏ™ÿœ™{Þ»Oºý¹G´yæJ© ;! £šÂ• š¡lÖ§ê–âÒêþ5¥J…ÏDÇ)àT0_©µ×‚nà:p=¸üt=À Üz‚€BÐ ôE (%k¬í Ê@?Ð A9¸   U Ô€!`(þ nÃÁ0Œ£Á­`  ÆÛÀx0Ô‚:0Ü&;Àdp'¸ Ü ¦€©`˜î3ÀLp/¸Ì³Á0Ìõà~`â·,‹@X KÀJ° <ž«Áðx<þ žÏçÁ àE°¼^¯€WÁkàu°¼Öƒ7Á[àm°¼6‚wÁ{à}ðØ>Íàc°|>ÿŸF°|¶/À—à+°ì_ƒ`Ø ¾{À^ð_°| öƒà ø8ƒ#à;ðýÑ{¨`§ Caõ#ÀZ ztŒúÓT:§¡Ÿ ûV‡Ø±pN-@ h ð@8æIøŽðü\„úaª+ì[!~N+”™g…líúÎo@"©=¬©‘|:ç’±1ë;g°ìß9“ç"æjiR8gu„×EÜÕ{w¨îé5cˆ»“Ä~·ðž0¦–ð‡u´¾Ñ¢ç|òíù ü‰÷¼Ÿ÷šÌ>›€fÌÙÜבbbÖñöy€÷`bü%Çç«RÏ¿±Ë¡óñú[±MûÁ˜êxT“ñ©7r¤šÃëï¥Òé€:žOUÀ6ð¼æÛ¬µÍ1±÷úv'›Ï°ÏYIcžÎŸØW÷?×b7‡í#¬ëÞ_ïÿMžoÚ‹)®^ßTÞ³™íÇÔÎ//f[8Nù.ôãñïÏìý2°ÆK£ùBö=ŽcWÀqý‰ïÝÖˆ<©.æ¹Ï§s=ÇÈœW!µUª{ûîÏq[ÃqYÎûØÂã“y/gòØ^ŽÁ…<¯„1kÌ×fú›Õ×:Vî~ñ՟r{»WtÓ”ø‹Íû¤rÑ¦æ— Ž•ÖïWŽãò­†7vÑ劉izOóKÌLÝ0¼##ô}½?ý*÷omô tã,ó7[Á~ízÖ?ëÑ;3¼?[ÆôÙyÛ¹¬·ûäõÖÑ:ÇÌ·ëlb=Ÿ³k·ÇX]¾â˜8YvÏìú& Æö¿’÷mÛ›½e.‰ÅÃêµëX?¶´çô•1ý{8ÞÁ}¿Ì:y¾^Ãqµq·ñ^Ëû\ï¹ù]l}«÷Iއ=W;?¦‹ý=fV¹vW윿æýÙóµúìøºÀúïRàcúv°?×M¬+x­;ný'ý±yïö6;?«Ïê²úm¿=×À=³~cû¶óž {ÞÁó´z¬ÿúÀ½±þli㼟6ö¹³ñ²úíø6nÛ~;Ïö[}V·ÕiýØøZ{«ÇŽÛs´vÖ½6^Ásäï)öóØ|6‡ŽCpÌ9Éù'šgç:ch‹ñüüÜz¡€x¾~‰–ŸgüZ‚v'XÓQÇî!ž]¼9q±ûü…ó7v¢þŸû5çàâçÛ‡x‘N*/ZZn¾Ñµô,©7¡¤´´’ëMªû•—W &—U[»˜·¾EÅ5x÷õ¾ßzŸûùÉ}kž»üäUûׯ_ÿf~òJOJ~òãWSùìí&oä'¿øŠÉkùÉ/”Sÿsiþ¾.T~{>ùÙýŽWFÎ*ðæG’—yö‘VÃ=»HøRj7îÙEZô¡²édd­·o0µ8‹ü>@íƒÝiüó¾Ôÿeõõ•;>¡ñ¿åñ»¨|LåŠö´nÅ?r'í#2m1íJ9O›EíÚTN }GF*Ò±ó—t"•R9:Ÿæ÷<í7ãGêoµ˜t=Dv/Ôþõõ´ÞMd×'ƒÊ’Tþ‰ìoº€ü]µŽæ_“@e×'¨¿ ÊÂ>TöVT–ð¹–ѽˆ”ÝOíú¸œAå<º‘y­©=ó,²ŸÙÖŸÙÓ”·î5ÿm²qyâV7žÆ‡eÒü¡©=äµË8>e¼Ÿc¹¬ û3šÒø©…´~??aº‘ð½4¿ÙCÔnÙ†Ú§}OvÉÉä§MWêO@ög “ÏiëyÞX*[Ósi‘KóO_HþUõ'†¨ÿ¼i\.$?™óÈ~ÆPêŸü>ÍŸtì'­â{DÏWdúašß·‚Ï÷Qêp/õM%»;ø^.¤²×!Z¯hÙðó;0DýåýÈ®ÿjî÷ò—н‡w@¦L_ªÔÙ•à=Îu¾M¥wÈéX'­3Àw¦ôI(?£z îsJo*ÍëWZ?¶yö}Éîì.÷"}û¿ü§ßC¾ÏÎäõpGR 'ºÒ>@‰÷ß´‘„ñ‘Ž;’Þš¯dFïóÔŸ†wëTܺö§ Ä»têż|w€¾¹xÕE‡ªb>¶3ãiö Ý6”ðݱiwˆK¬Ý®ž|f”]¬zÛ•³_øìð¨Rm‹6xçm¡zÛ)`?æu"Ú~ÆýĶm!‘Ú‘iE¤¼%Dk§¤¸§loq߇‹Ô-^;–´×÷úúñ>žºœðÆý>–SRp)ØkÊDŽÓŠ‘W†öäÅ õöãi~ûJ¹wcû=È<7sÁýà.Íï˘iÊû}Na ÕîåÒÌ›ÎýKyîÆø\Ì,c¿¶nÖšÉ6³À"îŸÏó–r9‹ý<ÀzøÖ°:—p¹€í̳}cÓ|v³y|ëoðíkžOã\î3cµ¾½Le?óxÎ’ãìqû¶>â±Ð7g.·òØ}<æŸÓÀ¾í ¾µûÆüØ=ûðé°uëciŸñÚ‹¸œæóeb0ƒ}ؽ,â¸/õù·¶õìî¡þã¥ÿ:Dé.Ó•¾¼Ò—ÕƒÅhãåëªMJ_ªô-èûçn¥os•W ô­ß*=}£¯QzÄï1§#æÔ(=ä_Jýd+=æ{ôï#0»aXghŠÒ5UJ÷ë¤t_Ø”žŠò9Œ•Ãö/(‡aÍJÖ*]?37(}Ï$P¨ôàþà)¥+3•..UzüWŽDù¶Ò›)=`¢Ò TzѰþÛ*]п ñ]~5xQ離|e Ð}  ã¨c|Iwð<8„¾ 9ôŒEëO€¶ s@°MéZø¯…ž:h¨ÛŠ:âQ ›‰W`ü¥ÇïB?|×bÚPÿh¢ô¨s±·Jß=Fé)Ð>ûž…3™û2ñœ}3.B?Æj€/pbrÎhj1l°Þ¨Þ¸I¸/8¯Ñˆõ¨×p/~½à{7¿Ó‡SOôµýuûnØ‚ïk‰<'Áç'!à3Ñç7Ñ7Çÿþ—g­p_ုà˜ß¿¿/§ ÔƒþC¶õ™X?8?QImAí?×ï‰ÿ:˜ÏÞ èI ØÇû äDïðöžøãê™Õ蟬Åvæµ:d~³oéõñ›tŸŠššŠ›íÿîÆûw¯êòŠÊRÛqsÿÑ‘XÕ¿¤Ì6š©äAÏyØ:ûš{ ‚! r2?ñüR’oüWý4â#¸Î‰H< ìãiÓ¿~˜ý%¨_Ÿ“Ñb¯ÿ¯‰ÕÉà÷}<ÇÛà üŠÇ ‰oj¨Oq¬f UÆúªb}5±>|Ìÿ‚[û2Ü̧BN/˜è’”L¾ödƒÉ(!à'!à'è»-Û*_dþ¾`2wÔ±O¦õÑ>°v¼©p`ã%@ÿÉE½ý´QòCÉ”­âØ›±&³&ŒM’ö);-ÎÚvÌ ”~ýþ„jýïƒ$8–èóüÀ÷#¸?NvNSŸ­µwXË9¾ºÝÃñkΘv>ù‘¿©*º¹Ôþ¦zŠMæ•å5Å%6¹' TUT­pQuì(jý””VÖô³¿å–U×Äêå¥vRRYUÅQ?‰ƒ*ªb&áÊŠjk1xÈÑ9'úLi^RTStQß*ì øoµª*†]äßÙ|ûËrŸâA•½z¹²•Í ÙÌ”Í,ÙÌ–ÍÙÌ•Í<Ñt;ɦTåJU®TåJU®TåJU®TåJU®T•ª¢RUTªŠJUQ©**UE¥ª¨T•ª¢RU†T•!UeHURU†T•!UeHURU†T•!UeJU™RU¦T•)UeJU™RU¦T•)UeJU™RU–T•%UeIUYRU–T•%UeIUYRU–T•%UeKUÙRU¶T•-UeKUÙRU¶T•-UeKUÙRUŽT•#UåHU9RUŽT•#UåHU9RUŽT•#UåJU¹RU®T•+UåJU¹RU®T•+UåJU¹RUžT•'UåIUyRUžT•'UåIUyRUžT•'T¹:ɦ+›QÙÌÍLÙÌ’ÍlÙÌ‘Í\Ù”ªdnwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenwenw‘ÛùßšþxéšH/r-cran-labdsv-2.0-1/data/bryceveg.rda000066400000000000000000000117131412660326600173640ustar00rootroot00000000000000‹í[rãÆ†9ãI"»Ê©©Š×á2tדñäÉo.ˆ‚HÚ$Á€¤¦´”äɯ^Jv¡%`®`<"ЧÉVßnàÿªÆíCôåèþÑ7@ÿúçOçßüôÍd2y?ùêÝûÉû¯êÿýð¾þϻɇÉ×uxv_>Oó§|6™|õÚþ½þ÷÷úßoÄ/4:ªç9–ëaÑAþ:ÉlSø|RîwÓz,НšŸêqY92\×GÛr}ûc›¿¯zÀ+êàÕ£iç Ó§í”Ë,ýŽþ~ù¦g’üáw\xÆù§šßõO×ø-ËÿÒdM9|>¼_/œÍûËŸ7wþüy•ûñíxG÷ùÿùÌ¿óùñ¤\¾[t=E×áp^"øûq ¹^ÿÀ°ðýüdl¯ãb<·OÒCxvÚ–éf* Ç6¾ãÌ‚háÇ-Gã>ÞËéã|Èǃ:”9Œ£•ã¿xtÆC¹Ð½a#‹Ž… E嘆Â|*ÉqÃ|›ß+M8¿”ýá╯˜_*ðK†ê¸BtÒ âݯW;•ùÁÅÓ-C¼ô­+WnòqE×ýôO3”ùAYÿªoDýRQ^õv:×~t^”Ÿ/^÷³ÓñS?n¸:ƒ¨Ý§Žó·Þ·*I'+WÕ?±ô÷:˜ÿ…)Gû͹ßUÓÉæ)EûôeùGtЀïó›ôµÞ:´ë¢:À@Û¾V ¾¼_üòÅpõ¬¯ÇÕüŒí¾ÓÐCg~W†¿óÇùße¡ è–Ãwyøûs”N_@º‰þ`DTo¢Fy¡¢¡-)‚·ép½:hô„€n=D½Ñ£ºÿÐAz&Ý>ÚŸSÒ ~è }ÕÛXÚ PCu]ª‰_)¦s*ûÉǯNÿn öQ¤œ-Ý×\¶Eû§°Fè ÀŠô5ŒX7¡ƒ"·¨¦“å§š^íñVõv>®öšæs”_¥ÏÕq¬nù}­7©ÖgÛúûÆqè`D„ò¼UÖI<:hÚ7ƒ:@ÏÄú\`?Œ*äýb6¾î“é8Vµ˜Î[ö…ÈŸ”;®üžµ$”•{È7ü~ÿåôqÕùY¾Qú®q5?xô8ºë><)—ÏÁ}:B ƒŒœÔ6ý« ¿ôbY€œê`çë„PÞ'1Ýß!ú½ïz«»ÍÓï¨-zßëh+ ùò‡ºø.,í÷è‚Áãlß^õ%L'4ͯÅ«¸|ÎNÚ\9"ŽâWÔúÅåoJs^ñŒ›½èàˆŸ+ Ú¥ôèÛñ±éû ²umÝrÑAWýb×óLªóZ¦ù©¾×#óGµ\_×Ù÷¾š®@ûìÛ÷ƒTÛSÀ ?@ä˜îSt_æO@ ˆèþä@Œ¾Ÿ³}—ßX/@×ë²t®ö)£ìšî7v]Ž,]W퀑3JÀ„ÐöQg@Á¡¶ÓPýÑ`$`žEt`Åô2 ìê:‡òÞÄØP½¸^ÀQè Cdhë&¾Ow:pBDºÇãõ;¬®÷ᙾéª\ßé#®GNûùƒÞ@€žðý$Óç°«þCD@#"Âú:Àô{X¾ˆ°žö¢ƒ®¯“«ûÝ×÷ñ½==p]€c”þ~±í<œïyCÝ|m¿³j«[®ß£÷õ9þ÷¾è»|0x:í¢>$êùAèê¸àÿþ&ŽˆZÁ¸q5®7ýÞ¼«ùÝr|Ï+õýݹ€‚Áà»Ý©ê“oÎQÒAÛõÝt¦t½NìjCæG×íÀv_›èx,ëâ]ûã»@G¥õ]~Wí$´ø¾ ÍS†r]ã{ZßùtÆÅ z\õ£cé¯ç@PDw=Dt€žÐ]§¥“ågº>c‹¯çíû'ÒCà°Gƒè€o E'†r¡bºßS5_…~aPßY@}ôúƒ'DÜñú=jY¼¾÷«Ê~—åc»¿ÜtžÜÖÓã±ì‹nÑõG žµg`FÔ:hÚ¯tÕoõµÏ@u?D_¸ºÞ¶ýê¾èjÜ£zÝBßçÒ²zå{dh×B?@£'êq1@Œê¸Ðv0ôy ƒÀ9®êígÐŒèúCÁà𥿺ûtm]€3¢ÐAWýyÝò\¿—[}îj ¯ñ›/lÇ…ºû\Ç·M§ŠëûåñþG¡ƒø ]½@ÝýޮְïÆ;ÐÁˆè{|h:þïz?ðØ å:úž·r˜ÑAÝ÷JMç}ÏØ>‡eù«þn:ÿe:?Jý½‚þ ptN Ýu‘ Ìðý^]ì žQp=ÀÀœñóòO4íŸË~7:C9ÀŸxíB/ðæz±ë÷“ºÖEÛ~mWïS„–_(÷É4š1?ˆú=L°OØ`ZtßCœ¢ƒœú :BIMëcWû¨}ÓõûLϱN±}>û.œÆt¾gD×?ˆ¿_ê<™n9®çSEÇC©ŸºïÛª×7Vb›¿v…«~™ïq±éûaÊí£òS¾,?ÕrtÑÕ…¡õ]Ý'W¸ng¡èI(ãWùÛÆÃü ñŠ®ŠMÿ€ŒÐütKí è ŠˆÞ?UýŽšët¾æÁGøüFD(õÓÕ:¹,ŸPΗGuÝÌ×¾1ÕrtËE=ŒÇ¡ƒÀšÐÛ ¾@uy×·$êç±ï÷ºC}Ît½V7½³qKe–¸!Ôúï¨uÐ7¡ÔƒPüÐÅ›>¦ ÓyÓùjÓyoY¾²üÆëûNûƒ]¿çcê‡ïñ´m:Û÷€b}nÙ^ Õ÷€]­+›Ww˜âkœâû>Ʋ/\õ¾ùÚwÕ÷ùÌàÝç`h„ƒâkÝÕþ|  tOô5Þe~>" ƒtD„ú0¼¬‡’OWø^'e=Xwþ_×ï¾Ï õLôAôôõÞ8 ÐA`í~FÓþ# àz…ö=ì*]Wù™Òõ¾G:"  FLߎÏ:pBDºÇÞêû¶ßc‘å§_9¬ Óiú%ò/ ƒ 7ºj/¡æ?¶u!Wû¦tu[a^:€"¡èUßå£ïšê®é÷4tß[WÝÇ¡ú>§îùêæ«ûq€ûEQm=€þ Š˜Îã·x¸®A~‡5t†~~]ëþé¾÷‡Ú®wŒåýF ÿÑ£ÇtŸŸé¼‡í|KèÄâ'à u0ÂûèAê PèA蘀ÖI•ˆ}œ®tÐ#ª'×ïSÐ3ÐAоÁQ=‡)®tÊtœ> „Ð3ºïQ¹.§¯|Âëß'±½^ªóPªéC!T¿)Ntí1ƒÑ€ç5ƒ#¶ýyà ¡|oÆô»T²ßù㪶êï®æ Mß3ýîë»[¦ïÓÛ¦ù#‹'Jëûÿ¾Þ3v]Lë‹ïyù®î¾³Æ€®ž«¦7Õ#Õreù΂ѽÐA¸Þÿ5Ôv:Âý¹  ƒ@è'×IxLç§]ÏË‹ò•ç ×ûÃùßuÏÃv}ÂUþ¢ø]§@ô8®×qBY·wȨuów€ÉÈu„ ž7ý2¢ëƒEÖŽSÅx¾éz^Û÷>çÇÍÐA"º¿9JëÅ0\>¼¯ÿónòaòuþe­òmý?ë¿¿þø×_öëb»;XuŒý.k¬rºÉÚcånW.kWN³õÁºÏËÇ2?XÓ<[eek•Ëü±VE“n:/ò c­³=cm˜\æåÓb{°ò}¹lK¯ÏaZ¬Ö&›®ž›t›rÿ´h­}ɜÿ÷ù,kÒ•ó=s¬\Ü×®6V±ýTk›­¦Es¶Ûyž•3Æ*‹æšmŸWE{]êë¹b®î.+ï둹ºånóæÛâ©)a¾XþÒÞ‡únÞ·1-òõ¢¹ž«ýœ©=µUŸýÁ*ÊçùóбVí±Í|¹iÏaSdl})²Ç|ÍXëü‰±˜tÛÅnþÜœÑv·`r©­e¾c¬Í¢½òÓùª½JÙ¬˜-ÛZ°ÎWûöØzWWµWëì‹õ}Òýì\Ó’²2›KÆÚ´g‘•ù#kÕõ d¬å¾Íe»«o7cMç Öj¯vmÍ÷+Æú5g­òkµmµ¶vmÌúÖn³&æ4[®÷»ÖÚÖÍœ±– F)²‡¢Õ†E¹Î›ZX߆M[cêæð+“®Ìë¶„ò™9£é󪄃õo·EÓ®Êl»oZg>3ÚP·¹¬½ƒŸ[`ÛÊj+o5³¶IÌ ‰¹i¯gm•Ù”±ØÒËÅ~ÕZû sokkÙžCm•Eó±Ìžòæ>ÌòuöøØZ¬b×Ó’f‹%s•æY-ßóüá¡lîCÝà²iÆXm=¯-&ÏE]wgÍ}_” ¦†,j/³Æëe¾Ùì×­µeîß2ßçí}X.f›VûêÊÂÜ÷ÚZæŸZk·XO‹isËbÇ<ó–û ›Ë~³mŸË磄µµÝ4¾Ô×aÖz¶*–̳«–°û6]mM³œµ 6&S_jk™5ZTlØs/Êâ±ÕïMþÀÔÁÚÚ.Z}#å}¶ öØ2_0s%jÍ\¶µ`3®›`«‹¬2|¶ZÏj‹¹J›]ÎhÖæ¹džÆõaqß>G§ËO­öló5s¶›ù´hî_-YŒºnëÇ\ÎX%s=·Ÿò2kJ¯Ÿ·EÛvsV÷wŧU›ç®NÕ¶¿§ºµO›:ÿT7÷UÎw®¦Ël{è\~üæ!Ûeß×­ð(ú×eñé{¶?öÛë¿ÝO×›ŸN¨yNÍ j^RóŠš×Ô¼¡æ-5ü@MêUB½J¨W õ*¡^%Ô«„z•P¯êÕ9õêœzuN½:§^S¯Î©WçÔ«sêÕ9õêœzuA½º ^]P¯.¨WÔ« êÕõê‚zuA½º ^]R¯.©W—Ô«KêÕ%õê’zuI½º¤^]R¯.©WWÔ«+êÕõêŠzuE½º¢^]Q¯®¨WWÔ«+êÕ5õêšzuM½º¦^]S¯®©W×Ô«kêÕ5õêšzuC½º¡^ÝP¯n¨W7Ô«êÕ õê†zuC½º¡^ÝR¯n©W·Ô«[êÕ-õê–zuK½º¥^ÝR¯n©WwÔ«;êÕõêŽzuG½º£^ÝQ¯î¨WwÔ«;âUòÃÔL¨yNÍ j^RóŠš×Ô¼¡æ-5©WTÛªí Õö„j{Bµ=¡ÚžPmO¨¶'TÛªí Õö„j{Bµ=¡ÚžPmO¨¶'TÛªí Õö„j{Bµ=¡ÚžPmO¨¶'TÛªí Õö„j{Bµ=¡ÚžPmO¨¶'TÛªí Õö„j{Bµ=¡ÚžPmO¨¶'TÛªí Õö„j{Bµ=¡ÚžPmO¨¶'TÛªíI­í“ÉŸÿý?åÂÚ`r-cran-labdsv-2.0-1/inst/000077500000000000000000000000001412660326600151275ustar00rootroot00000000000000r-cran-labdsv-2.0-1/inst/ChangeLog000066400000000000000000000426201412660326600167050ustar00rootroot00000000000000labdsv_2.0-1 This is a fairly significant redesign of labdsv focused primarily on the ordination routines. This version creates a new ordination class "dsvord" that incorporates all the existing ordinations and makes importing ordinations from other packages simpler. The plot(), points(), surf(), plotid(), hilight(), chullord(), ellip(), rgl() and thull() functions have all been re-written to accommodate the new dsvord class. The result is much simpler, but should be backward compatible with all existing scripts that use labdsv. Many ordination results from other packages can be converted to labdsv through the as.dsvord function. labdsv now incorporates the t-Distributed Stochastic Neighbor Embedding routine from Rtsne as an ordination. New functions were introduced to facilitate modeling species and environmental variables as a function of ordinations: see predict and calibrate respectively. The bestnmds and besttsne functions now include a single iteration from a PCO initial condition as part of the requested random starts. Several new functions were introduced to make it easier to edit data.frames in the workspace. See factorize, defactorize, and gsr. In addition, new community standardizations were developed, comprising samptot (for standardize by sample total), spcmax (to standardize by species maximum) and hellinger (to perform the hellinger standardization). A couple of changes were made to make labdsv more R-like in syntax. metrify can now be invoked as as.metric, euclidify can now be invoked as as.euclidean. (I know that verbs are now the rage, but I added the conversions anyway, and the old verbs still work.) Changes were made to function concov() to make it work better when passed a single cluster. At least for the time being rgl is back in labdsv. labdsv_1.8-0 Due to the ever increasing hassle of building rgl I deleted all references to rgl from labdsv, and following vegan, ported those functions to another package, labdsv3d. labdsv_1.7-0 Quite a few changes were made to labdsv to (1) make it work better with tools like knitr or Sweave, and (2) to improve and standardize the way functions work with factors or classification vectors. With respect to knitr and Sweave, all functions which produce multiple panels of plots with "hit return" prompts have been modified to allow you to specify a single panel if desired by passing an argument called 'panel' which can be an integer or the word 'all'. With respect to clustering, , a new function called "clustify" was written to manage the wide variety of forms clustering information can take. All inputs are converted to a factor, and then managed within the calling functions as necessary. as.numeric(clustify('input')) guarantees consecutive integers beginning at one, and allows levels('input') to correctly label columns or list objects with the original IDs. Changes made in 1.6-1 to prevent passing unacceptable cluster IDs (e.g. 0) broke the ability of some functions to use factors as cluster IDs. The changes in 1.7-0 fix that. Finally, now that Google and Hadley Wickham have both said that 'else' does not need to start on line by itself, all instances of if () { } else { } have been changed to if () { } else { } I know it breaks the rules, but I agree with Hadley it's more readable and the interpreter seems to handle it just fine. labdsv_1.6-1 added a routine to function indval() to check the taxa matrix for species which never occur [apply(x>0,2,sum) = 0] for some species. indval() aborts with an error message in such cases. I also added a routine to the FORTRAN code to trap array out-of-bounds conditions caused by species not assigned to any cluster for any reason. indval() gives such species a probability of 1.0 and prints a warning message from indval() or summary.indval(). labdsv_1.6-0 adding a routine to check cluster memberships in all functions that accept cluster membership vectors as input. Such vectors are now forced to consecutive integers (preserving the order) if they are not already in that form. labdsv 1.5-0 labdsv was updated in several areas, with the largest change being the transition to a NAMESPACE format as mandated by R 2.14. Specific changes are: 1) function const() was modernized to replace truncation code with formatting code. More importantly, const() was modified to return the result with a return() statement, rather than a print() statement to make it embeddable in the new concov() function (see just below). 2) a new function called concov() was added to combine the two functions const() and importance() in a single output, commonly called a "constancy/coverage table" by ecologists. 3) a new function called homoteneity() was added to facilitate diversity analysis. homoteneity() is defined as the mean constancy of the S most constant species, expressed as a fraction, where S is the mean species richness of a type. This value represents the constancy of the average species in a community type; higher values for homoteneity indicate greater uniformity in species composition among plots. This function was adapted from the Virginia heritage program at http://www.dcr.virginia.gov/natural_heritage/ncstatistics.shtml. 4) function importance() was modified to replace truncation code with formatting code. More importantly, importance was modified to allow calculating "typical" importance, as opposed to "mean" importance where typical importance is the sum of the abundance of a species divided by the number of plots in which it occurs, whereas mean importance is the sum of the abundance of a species divided by the number of plots in the type. Typical importance is the default. 5) function plot.pca() was updated to use more conventional R graphing code. function surf.pca() had a typo fixed that produced a bug when surfing non-thinplate spline surfs for binary variables. 6) a new function called reconcile() was added to help manage the taxa and site environment data.frames. Specifically, reconcile() returns as a list the rows common to both the the taxa and site data.frames, and drops plots which only occur in one or the other. 7) function rgl.pco() was added to produce rgl three-dimensional graphics of PCO ordination. rgl.nmds always worked on PCOs, but the naming convention made it appear to be specific to NMDS. Since rgl is not a S-3 generic function, it was necessary to have two separately named functions to do the job. labdsv 1.4-1 labdsv was modified in several subtle ways to better accommodate package optpart, e.g. function indval was made generic to handle 'strides' from, package optpart. The hilight.nmds and hilight.pco functions were modified slightly to overcome problems with ghosting. labdsv 1.3-3 1) I added two new plotting routines for plotting NMDS ordinations: thull and rgl.nmds. thull stands for "tensioned hull" and fits a minimum volume surface to a plot to contain a specific identified element. The rgl.nmds function uses the fabulous rgl library to plot a 3-D version of an NMDS. 2) Since no one (as far as I know) uses labdsv in S-Plus, I simplified the plotting routines just using "asp = 1" where necessary. 3) In response to a problem noted by Miquel de Caceres, I modified an element of code in indval.f to eliminate a >= comparison. In some cases, because the test compared a 64-bit real to an 80-bit register value the test would fail even when the values were known to be the same. The problem only occurred on rare occasions where cluster sizes were equal and species were rare of singletons. It's possible that alternative compiler optimizations would have solved the problem, but I do not know how to write R make files for multiple systems that would solve the problem. In essence, the code was changed from if (x >= y) then to if (x - y > -0.0001) then to enforce a conservative test. I would be happy to replace that with better code if anyone has suggestions. labdsv 1.3-2 1) I fixed a bug (typo) in surf.nmds() that affected thinplate splines of logical variables. 2) Changed a parameter in the smooth function of the plot.indspc() function as well as changing the axis labels. 3) I renamed the duleg function to "indval." It now returns objects of class "indval." 4) I added a new function called ordtaxa which allows interactive re-ordering of rows and columns in the taxon dataframe, re-ordering the rows in the site dataframe to maintain the correspondence. 5) Similar to ordtaxa, I added an argument to summary.indval, const, and importance to allow interactive re-ordering the rows in the summary tables. 6) I added simple functions dropspc and dropplt to simplify maintaining the taxon and site dataframes. dropspc eliminates species (columns) in the taxon data.frame where the number of occurrences is less then a threshold. dropplt removes plots (rows) in both the taxon dataframe and the site dataframe where plots have missing values for any site variable. labdsv 1.3-1 This is a bug fix for 1.3-0. dsvdis.R was missing a cast of the taxon data.frame to "as.double" and would fail on taxon matrices that are strictly integers. Taxon matrices with real numbers worked. labdsv 1.3-0 A number of small changes, and a couple of larger ones were made in the revision to 1.3-0. 1) A bug was fixed in the duleg FORTRAN code that compared a four-byte floating point number to an eight-byte number. This bug would only appear in relatively few cases, and affected the calculated probability of some observations, not the indicator value itself. I also improved the permutation code used in the probability estimates. 2) Subsequent to the discovery of duleg bug, all remaining four-byte floating points (FORTRAN REAL) were converted to eight-byte floating point (FORTRAN DOUBLE PRECISION) to achieve better correspondence with R and avoid problems. It does increase the storage requirement of some programs, but this seems to rarely be a problem on modern computers. 3) I discovered that I was using specialized FORTRAN code in several places where the base package "dist()" function would work. I replaced all of those instances. This resulted in dropping function "vardist," and modifying internal function "orddist." 4) I modified function "ordcomp," changing the default dimensionality to full dimensionality, rather than n=2. It is still possible to specify any desired dimensionality through the "dim=" argument; I only changed the default. 5) While updating function "ordcomp" I realized that it would be just as easy to have function "ordcomp" avoid the call to internal function "orddist" and do the calculations directly. Consequently, function "orddist" is now a stand-alone function useful for calculating the pair-wise distances in an ordination for any purpose. Function "orddist" returns an object of class "dist." 6) I changed the surface fitting routine in all versions of the "surf" functions (for pca, pco, and nmds) to use the "predict.gam" function of package "mgcv" in place of the function "interp" from package "akima." This resulted in smoother, better fit surfaces, and allowed me to no longer require package "akima" to load labdsv. This change was suggested and first implemented by Jari Oksanen for function "ordisurf" in package "vegan." Again, following the lead of vegan, I made the default surface fitter a thin plate spline, rather then additive independent smooth splines. The original behavior is still available by specifying thinplate=FALSE. Finally, I added a gamma argument to the surf function to allow users to control the smoothness of the surface by passing gamma tot he underlying gam function. 7) In response to a problem identified by P. Legendre, I inserted checks to see that "taxa" is converted to a dataframe, rather than a matrix, wherever necessary. 8) I added two new routines to simplify working with large sparse data sets: "matrify" and "dematrify". "matrify" takes data in three column database format (sample_id, taxon, abundance) and converts it into an expanded sparse matrix data.frame. This routine allows users to store their data in a compacted, three column form for exchange with other programs. "dematrify" takes a data.frame of taxa abundance in sparse matrix form and writes it out three column database format (sample_id, taxon, abundance). 9) I added a new routine to nmds() and pco() called "density" which calculates the fraction of plots within a convex hull that belong to the same type as the type that defines the convex hull. 10) Once again, I had to re-organize the web server that supports labdsv and other activities. The general site for all material is http://ecology.msu.montana.edu/labdsv/ The material specifically relevant to this package is at http://ecology.msu.montana.edu/labdsv/R/labdsv labdsv 1.2-2 fixed a bug in jsurf.nmds where the ordination was not called correctly deleted extraneous files in the man directory (don't know why they were there in the first place) moved confus to package optpart labdsv 1.2-1 function tabdev.R was deleted to temporarily solve inscrutable problems with Windows server. tabdev.R worked under linux and Windows XP, so there may be no need to update on your system. In addition, the URL in the description file was updated to point to the current location of the lab manual for LabDSV. labdsv 1.2-0 A couple of general changes were made to many functions. 1) in several functions the dataframe "veg" was changed to "taxa" to better represent the full range of community ecology the code is suitable for 2) in functions that used classified types or community types the vector specifying that was changed from "class" to "clustering" to avoid conflict with a reserved word, and to integrate better with code from package "cluster". 3) the package was checked and built on both linux and Windows to help ensure better utility on windows In addition, a number of small changes were made to several functions, listed below: abuocc.R changed veg to taxa in function and documentation confus.R added a correction for plotting factors correctly example changed to "\dontrun" because it requires library tree const.R changed veg to taxa in function and documentation changed class to clustering in function and documentation changed class test to inheritance generally improved documentation dga.R added an invisible return improved the example in the documentation disana.R eliminated null class test eliminated FORTRAN call by using apply with na.rm corrected point labels to "attr(x,'Labels')" dissim.R removed function dissim dsvdis.R changed an attribute label from "index" to "method" to match dist() changed the test of step from > to >= so that step=1.0 works duarm.R changed veg to taxa in function and documentation changed class to clustering simplified the presentation of results duleg.R changed veg to taxa in function and documentation changed class to clustering enforced better casting of variable types in FORTRAN call added numitr to FORTRAN call and return improved the labeling of row and column names in output fixed possible bugs from uninitiated values in FORTRAN code envrtest.R added an argument to function call to control plotting improved the default title on the plot euclidify.R cast the input object to class "dist" improved the information in the attributes of the output object hilight.R converted hilight to a generic function and wrote separate methods for PCA. PCO, and NMDS importance.R changed veg to taxa changed class to clustering changed class test to inheritance metrify.R cast the input object as class "dist" changed the output attribute from "index" to "method" to match dist() nmds.R deleted test for null class changed the name of the overlayed object in the points.nmds function from "overlay" to "which" added "cex=0.8" as the default to function surf.nmds and jsurf.nmds corrected logical values from "T" to "TRUE" improved the bestnmds function improved the hilight function by adding better control of colors and glyphs added a convex hull function called chullord.nmds() npmmds.R dropped function npmmds() ordcomp.R deleted the test of NULL class and the option to submit a matrix instead of a "dist" object added an invisible return orddist.R cast the input object to double in FORTRAN call ordpart.R added default axes to the plot, and renamed axes to ax and ay cast the values to double in FORTRAN call significantly improved the documentation ordtest.R added an inheritance test for object of class "pco", "nmds" and "metaMDS" ordutils.R added hilight() and chullord() as generic functions pca.R added an explicit "cex = 1" as the default in points.pca() corrected logicals from "T" to "TRUE" corrected the scaling on variance accounted for in varplot() added a jsurf.pca() function to jitter coordinates if necessary added hilight.pca() as a method added chullord.pca() as a method improved the documentation pco.R eliminated NULL class test corrected logical "T" to "TRUE" added hilight.pco() as a method added chullord.pco() as a method refine.R dropped function refine() rndveg.R renamed rndveg() to rndtaxa() changed veg to taxa in function simenv.R dropped function simenv(), replaced by envrtest() spcdisc.R corrected logical "F" to "FALSE" tabdev.R changed veg to taxa cast most variables as double in FORTRAN call vardist.R cast arguments as double in FORTRAN call vegtab.R changed veg to taxa vegtrans.R eliminated FORTRAN call by conversion of algorithm to pure R eliminated function stdveg() to standardize by plot or species max zzz.R no longer require stats (now included in base) r-cran-labdsv-2.0-1/man/000077500000000000000000000000001412660326600147255ustar00rootroot00000000000000r-cran-labdsv-2.0-1/man/abundtrans.Rd000066400000000000000000000024741412660326600173640ustar00rootroot00000000000000\name{abundtrans} \alias{abundtrans} \title{Species Abundance Data Transformation} \description{Transforms species abundances according to an arbitrary specified vector} \usage{ abundtrans(comm,code,value) } \arguments{ \item{comm}{the original community data.frame} \item{code}{a vector containing the set of values appearing in the original data.frame} \item{value}{a vector containing the set of respective values to substitute} } \details{Performs a respective substitution to transform specific values in an initial data.frame to other specified values.} \value{a data.frame of transformed abundance data} \references{\url{http://ecology.msu.montana.edu/labdsv/R/labs/lab1/lab1.html}} \note{Vegetation data are often collected in arbitrary abundance schemes (e.g. Braun-Blanquet, Domin, etc.) which have no direct algebraic transformation (e.g. log). This function transforms coded abundances to arbitrary importance values as specified.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[vegan]{decostand}}, \code{\link[vegan]{wisconsin}}} \examples{ data(bryceveg) old <- c(0.2,0.5,1.0,2.0,3.0,4.0,5.0,6.0) new <- c(0.2,0.5,3.0,15.0,37.5,62.5,85.0,97.5) midpoint <- abundtrans(bryceveg,old,new) } \keyword{arith} r-cran-labdsv-2.0-1/man/abuocc.Rd000066400000000000000000000045731412660326600164610ustar00rootroot00000000000000\name{abuocc} \alias{abuocc} \title{Abundance/Occurrence Graphical Analysis} \description{Calculates and plots summary statistics about species occurrences in a data frame} \usage{abuocc(comm,minabu=0,panel='all')} \arguments{ \item{comm}{a community data.frame with samples as rows and species as columns} \item{minabu}{a minimum abundance threshold species must exceed to be included in the calculations (default=0)} \item{panel}{controls which of four graphs is drawn, and can be 'all' or integers 1-4} } \details{This functions calculates and plots four data summaries about the occurrence of species: Plots: 1) the number of samples each species occurs in on a log scale, sorted from maximum to minimum 2) the number of species in each sample plot (species richness) from highest to lowest 3) the mean abundance of non-zero values (on a log scale) as a function of the number of plots a species occurs in 4) the total abundance/sample as a function of the plot-level species richness The third plot allows you to identify individual species with the mouse; the fourth plot allows you to identify individual sample units with the mouse. } \value{Returns an (invisible) list composed of: \item{spc.plt}{number of species/sample} \item{plt.spc}{number of samples each species occurs in} \item{mean}{mean abundance of each species when present (excluding values smaller than minabu)} } \references{ \url{http://ecology.msu.montana.edu/labdsv/R/labs/lab1/lab1.html} } \note{It's common in niche theory analyses to calculate the rank abundances of taxa in a sample. This function is similar, but works on multiple samples simultaneously. The spc.plt vector in the returned list can be used anywhere species richness is desired. The plt.spc vector in the returned list can be used to mask out rare species in calculations of sample similarity using \code{\link[labdsv]{dsvdis}} among other purposes.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[vegan]{fisherfit}}, \code{\link[vegan]{prestonfit}}, \code{\link[vegan]{radfit}}} \examples{ data(bryceveg) # produces a data.frame called bryceveg abuocc(bryceveg) } \keyword{multivariate} r-cran-labdsv-2.0-1/man/as.dsvord.Rd000077500000000000000000000031741412660326600171270ustar00rootroot00000000000000\name{as.dsvord} \alias{as.dsvord} \title{Convert existing and external ordinations to dsv format} \description{ This function updates ordinations from previous versions of labdsv and converts ordinations of class \sQuote{boral} from package boral, list output objects from package Rtsne, class \sQuote{metaMDS} objects from package vegan, or class \sQuote{ordiplot} objects from package vegan into objects of class \sQuote{dsvord} for plotting and comparison. } \usage{as.dsvord(obj) } \arguments{ \item{obj}{an object of class nmds, pco, pca, boral, metaMDS, or ordiplot or an output list object from Rtsne} } \details{as.dsvord calls internal format-specific conversion functions to produce an object of class \sQuote{dsvord} from the given input. } \value{an object of class \sQuote{dsvord}, i.e. a list with items \sQuote{points} and \sQuote{type} (optionally more), and attributes \sQuote{call} and \sQuote{timestamp} and \sQuote{class}. } \references{\url{http://ecology.msu.montana.edu/labdsv/R/}} \note{LabDSV recently converted all ordination objects to a single class with an ancillary \sQuote{type} specification to differentiate ordination types.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ \dontrun{data(bryceveg) dis.bc <- dsvdis(bryceveg,'bray') library(vegan) demo.metaMDS <- metaMDS(bryceveg) metamds.dsv <- as.dsvord(demo.metaMDS) demo.ordi <- plot(demo.metaMDS) ordip.dsv <- as.dsvord(demo.ordi) library(boral) demo.boral <- boral(bryceveg,row.eff='random') boral.dsv <- as.dsvord(demo.boral) } } \keyword{multivariate} r-cran-labdsv-2.0-1/man/brycesite.Rd000066400000000000000000000015721412660326600172120ustar00rootroot00000000000000\name{brycesite} \docType{data} \alias{brycesite} \title{Site Data for Bryce Canyon National Park} \description{Environmental variables recorded at or calculated for each of 160 sample plots in Bryce Canyon National Park, Utah, U.S.A.} \usage{data(brycesite)} \format{a data.frame with sample units as rows and site variables as columns. Variables are: \describe{ \item{plotcode}{= original plot codes} \item{annrad}{= annual direct solar radiation in Langleys} \item{asp}{= slope aspect in degrees} \item{av}{= aspect value = (1+cosd(asp-30))/2} \item{depth}{= soil depth = "deep" or "shallow"} \item{east}{= UTM easting in meters} \item{elev}{= elevation in feet} \item{grorad}{= growing season radiation in Langleys} \item{north}{= UTM northing in meters} \item{pos}{= topographic position} \item{quad}{= USGS 7.5 minute quad sheet} \item{slope}{= percent slope} } } \keyword{datasets} r-cran-labdsv-2.0-1/man/bryceveg.Rd000066400000000000000000000012221412660326600170170ustar00rootroot00000000000000\name{bryceveg} \docType{data} \alias{bryceveg} \title{Bryce Canyon Vegetation Data} \description{Estimates of cover class for all non-tree vascular plant species in 160 375\eqn{m^2} circular sample plots. Species codes are first three letters of genus + first three letters of specific epithet.} \usage{data(bryceveg)} \format{a data.frame of 160 sample units (rows) and 169 species (columns). Cover is estimated in codes as follows: \describe{ \item{0.2}{present in the stand but not the plot} \item{0.5}{0-1\%} \item{1.0}{1-5\%} \item{2.0}{5-25\%} \item{3.0}{25-50\%} \item{4.0}{50-75\%} \item{5.0}{75-95\%} \item{6.0}{95-100\%} } } \keyword{datasets} r-cran-labdsv-2.0-1/man/calibrate.Rd000066400000000000000000000040361412660326600171450ustar00rootroot00000000000000\name{calibrate} \alias{calibrate} \alias{calibrate.dsvord} \title{Calculate fitted environmental attributes in an ordination} \description{Fits a Generalized Additive Model (GAM) for each environmental variable in a data.frame against an ordination.} \usage{ \method{calibrate}{dsvord}(dsvord,site,dims=1:ncol(dsvord$points), family='gaussian',gamma=1,keep.models=FALSE) } \arguments{ \item{dsvord}{an ordination object of class dsvord} \item{site}{a matrix or data.frame with sample units as rows and environmental variables as columns} \item{dims}{the specific dimensions of the ordination to consider} \item{family}{the error distribution specifier for the GAM function} \item{gamma}{the gamma parameter to control fitting GAM models} \item{keep.models}{a switch to control saving the individual GAM models} } \details{The calibrate function sequentially and independently fits a GAM model for each environmental variable as a function of ordination coordinates, using the family and gamma specifiers supplied in the function call, or their defaults. The model fits two or three dimensional models; if the length of dims is greater than three the dimensions are truncated to the first three chosen.} \value{A list object with vector elements aic, dev.expl, adj.rsq, and fitted value matrix. Optionally, if keep.models is TRUE, a list with all of the GAM models fitted. List element aic gives the model AICs for each variable, dev.expl gives the deviance explained, adj.rsq gives the adjusted r-Squared, and fitted gives the expected value of each variable in each sample unit.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\link[labdsv]{predict} for the complementary function that fits GAM models for species} \examples{ data(bryceveg) dis.man <- dist(bryceveg,method="manhattan") demo.nmds <- nmds(dis.man,k=4) \dontrun{res <- calibrate(demo.nmds,brycesite[,c(2,4,7,12)],minocc=10)} } \keyword{multivariate} r-cran-labdsv-2.0-1/man/compspec.Rd000066400000000000000000000052271412660326600170330ustar00rootroot00000000000000\name{compspec} \alias{compspec} \alias{indspc} \alias{plot.compspec} \title{Compositional Specificity Analysis} \description{ Calculates the mean similarity of all plots in which each species occurs } \usage{compspec(comm, dis, numitr=100, drop=FALSE, progress=FALSE) \method{plot}{compspec}(x,spc=NULL,pch=1,type='p',col=1,\dots) } \arguments{ \item{comm}{a data frame of community samples, samples as rows, species as columns} \item{dis}{an object of class \sQuote{dist} from \code{dist}, \code{\link[labdsv]{dsvdis}} or \code{\link[vegan]{vegdist}}} \item{numitr}{the number of iterations to use to establish the quantiles of the distribution} \item{drop}{a switch to determine whether to drop species out when calculating their compspec value} \item{progress}{a switch to control printing out a progress bar} \item{x}{an object of class compspec} \item{spc}{an integer code to specify exactly which species drop-out to plot} \item{pch}{which glyph to plot for species} \item{type}{which type of plot} \item{col}{an integer or integer vector) to color the points} \item{\dots}{additional arguments to the plot function} } \value{a list with several data.frames: \sQuote{vals} with species name, mean similarity, number of occurrences, and probability of observing as high a mean similarity as observed, and \sQuote{quantiles} with the distribution of the quantiles of mean similarity for given numbers of occurrences. If drop=TRUE, results specific to dropping out each species in turn are added to the list by species name.} \note{ One measure of the habitat specificity of a species is the degree to which a species only occurs in communities that are similar to each other. This function calculates the mean similarity of all samples in which each species occurs, and compares that value to the distribution of mean similarities for randomly generated sets of the same size. The mean similarity of species which only occur once is set to 0, rather than NA. If drop=TRUE each species is deleted in turn and a new dissimilarity matrix minus that species is calculated for the analysis. This eliminates the bias that part of the similarity of communities being analyzed is due to the known joint occurrence of the species being analyzed. } \references{\url{http://ecology.msu.montana.edu/labdsv/R}} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{ \code{indval},\code{isamic} } \examples{ data(bryceveg) # returns a vegetation data.frame dis.bc <- dsvdis(bryceveg,'bray/curtis') # returns a Bray/Curtis dissimilarity matrix compspec(bryceveg,dis.bc) } \keyword{multivariate} r-cran-labdsv-2.0-1/man/concov.Rd000066400000000000000000000036751412660326600165160ustar00rootroot00000000000000\name{concov} \alias{concov} \title{Constancy-Coverage Table for Ecological Community Data} \description{Produces a table of combined species constancy and importance} \usage{concov(comm,clustering,digits=1,width=5,typical=TRUE,thresh=10)} \arguments{ \item{comm}{a community data.frame, samples as rows and species as columns} \item{clustering}{(1) an object of class \sQuote{clustering}, class \sQuote{partana}, or class \sQuote{partition}, (2) a vector of integer cluster memberships, (3) a factor vector, or (4) a character vector} \item{digits}{the number of digits for the importance value of species} \item{width}{controls the formatting of columns} \item{typical}{an argument passed to \code{\link[labdsv]{importance}} to control how mean abundance is calculated} \item{thresh}{a threshold parameter to control the suppression of small details in the output. Species must have >= thresh constancy in at least one type to appear in the output table} } \details{concov calls \code{\link[labdsv]{const}} and \code{\link[labdsv]{importance}} and then combines the output in a single table.} \value{a data.frame with factors (combined constancy and coverage) as columns} \references{\url{http://ecology.msu.montana.edu/labdsv/R/labs/lab3/lab3.html}} \note{Constancy-coverage tables are an informative and concise representation of species in classified types. The output format [constancy(mean cover)] follows the convention of the US Forest Service vegetation classifications.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[labdsv]{const}}, \code{\link[labdsv]{importance}}} \examples{ data(bryceveg) # returns a vegetation data.frame data(brycesite) # returns a site data.frame \dontrun{concov(bryceveg,brycesite$quad) # calculates the constancy # and coverage by USGS quad} } \keyword{multivariate} r-cran-labdsv-2.0-1/man/const.Rd000066400000000000000000000056501412660326600163500ustar00rootroot00000000000000\name{const} \alias{const} \title{Constancy Table} \description{For a classified set of vegetation samples, lists for each species the fraction of samples in each class the species occurs in.} \usage{const(comm, clustering, minval = 0, show = minval, digits = 2, sort = FALSE, spcord = NULL)} \arguments{ \item{comm}{a data.frame of species abundances with samples as rows and species as columns} \item{clustering}{(1) an object of class \sQuote{clustering}, class \sQuote{partana}, or class \sQuote{partition}, (2) a vector of numeric cluster memberships, (3) a factor vector, or (4) a character vector.} \item{minval}{the minimum constancy a species must have in at least one class to be included in the output} \item{show}{the minimum constancy a species must have to show a printed value} \item{digits}{the number of digits to report in the table} \item{sort}{a switch to control interactive re-ordering of the output table} \item{spcord}{a vector of integers to specify the order in which species should be listed in the table} } \details{Produces a table with species as rows, and species constancy in clusters as columns. The \sQuote{clustering} vector represents a classification of the samples that the table summarizes. It may result from a cluster analysis, partitioning an ordination, subjective partitioning of a vegetation table, or other source. The \sQuote{minval} argument is used to emphasize the dominant species and suppress the rare species. Vegetation tables are often very sparse, and this argument simplifies making them more compact. The \sQuote{digits} argument limits the reported precision of the calculations. Generally, relatively low precision is adequate and perhaps more realistic. The \sQuote{spcord} argument specifies the order species are listed in a table. You can use the reverse of the number of occurrences to get dominant species at the top to rarer at the bottom, use fidelity values for the ordered clusters, or possibly the order of species centroids in an ordination. } \value{a data.frame with species as rows, classes as columns, with fraction of occurrence of species in classes.} \references{\url{http://ecology.msu.montana.edu/labdsv/R/labs/lab3/lab3.html}} \note{Constancy tables are often used in vegetation classification to calculate or present characteristic species for specific classes or types. \sQuote{const} may be combined with \sQuote{importance} and \sQuote{vegtab} to achieve a vegetation table-oriented analysis.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{ \code{\link[labdsv]{importance}}, \code{\link[labdsv]{vegtab}}, \code{\link[vegan]{vegemite}} } \examples{ data(bryceveg) # returns a data.frame called bryceveg data(brycesite) class <- cut(brycesite$elev,10,labels=FALSE) const(bryceveg,class,minval=0.25) } \keyword{multivariate} r-cran-labdsv-2.0-1/man/convex.Rd000066400000000000000000000015501412660326600165170ustar00rootroot00000000000000\name{convex} \alias{convex} \title{Convex Data Transformation} \description{Calculates a convex data transformation for a given number of desired classes.} \usage{convex(n,b=2,stand=FALSE)} \arguments{ \item{n}{the desired number of values} \item{b}{the base of the exponential function} \item{stand}{a switch to control standardizing values to a maximum of 1.0} } \details{Calculates a series of values where the difference between adjacent values is 1/b the previous difference. With the default b=2 you get an octave scale.} \value{a vector of numeric values} \references{\url{http://ecology.msu.montana.edu/labdsv/R}} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{spcmax, samptot, abundtrans, hellinger } \examples{ convex(5,2) } \keyword{standardization} r-cran-labdsv-2.0-1/man/defactorize.Rd000066400000000000000000000023011412660326600175070ustar00rootroot00000000000000\name{defactorize} \alias{defactorize} \title{Change Factors in Data.frames to Character Vectors} \description{Looks at each column in a data.frame, and converts factors to character vectors.} \usage{ defactorize(df) } \arguments{ \item{df}{a data.frame} } \details{The function simply scans each column in a data.frame looking for factor columns. For each factor column it calls the \sQuote{as.character()} function to convert the column to a character vector.} \value{Returns a data.frame where every factor column has been converted to a character vector.} \note{This function simplifies editing data.frames by allowing users to edit character columns (which have no levels constraints) and then converting the results to factors for modeling. It is often used in a cycle of defactorize(df) edit the columns as necessary to correct errors or simplify factorize(df) } \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\link[labdsv]{factorize}} \examples{ data(brycesite) brycesite <- defactorize(brycesite) brycesite$quad[brycesite$quad=='bp'] <- 'BP' brycesite <- factorize(brycesite) } \keyword{manip} r-cran-labdsv-2.0-1/man/dematrify.Rd000066400000000000000000000027551412660326600172110ustar00rootroot00000000000000\name{dematrify} \alias{dematrify} \title{Create Three Column Database Form Data Frame from Sparse Data Frames} \description{Takes a sparse matrix data frame (typical of ecological abundance data) and converts it into three column database format.} \usage{dematrify(comm, filename, sep = ",", thresh = 0)} \arguments{ \item{comm}{a sparse data.frame or matrix, with samples as rows and comm as columns} \item{filename}{the name of the filename to produce} \item{sep}{the separator to use in separating columns} \item{thresh}{the minimum abundance to be included in the output} } \details{The routine is pure R code to convert data from sparse matrix form to three column database form for export or reduced storage} \value{a data.frame with the first column the sample ID, the second column the taxon ID, and the third column the abundance. } \note{Typically, large ecological data sets are characterized by sparse matrices of taxon abundance in samples with many zeros in the matrix. Because these datasets may be many columns wide, they are difficult to work with in text editors or spreadsheets, and require excessive amount of space for storage. The reduced three column form is suitable for input to databases, and more easily edited.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[labdsv]{matrify}}} \examples{ library(labdsv) data(bryceveg) x <- dematrify(bryceveg) } \keyword{IO} r-cran-labdsv-2.0-1/man/dga.Rd000066400000000000000000000041711412660326600157520ustar00rootroot00000000000000\name{dga} \alias{dga} \title{Direct Gradient Analysis} \description{Direct gradient analysis is a graphical representation of the abundance distribution of (typically) species along opposing environmental gradients } \usage{dga(z,x,y,step=50,pres="+",abs="-",labcex=1, xlab = deparse(substitute(x)), ylab = deparse(substitute(y)), pch = 1, title = "", \dots) } \arguments{ \item{z}{the variable (typically a species abundance) to be plotted} \item{x}{the variable to use as the x axis} \item{y}{the variable to use as the y axis} \item{step}{controls the grid density fed to the GAM surface fitter} \item{pres}{the symbol to print when a species is present (presence/absence mode)} \item{abs}{the symbol to print when a species is absent (presence/absence mode)} \item{labcex}{the character size for contour labels} \item{xlab}{the x axis legend} \item{ylab}{the y axis legend} \item{pch}{the symbol to print in continuous abundance plots} \item{title}{the title to print} \item{\dots}{miscellaneous arguments to pass to par} } \details{ \sQuote{dga} interpolates a grid of x,y values from the supplied data and fits a GAM (from \code{\link[mgcv]{mgcv}}) of the z variable to the grid. For presence/absence data (enterd as a logical) it employs a binomial family, for species abundances a negative binomial is employed. The GAM surface is then represented by a contour map and abundance symbols as described above.} \value{a graph of the distribution of the z variable on a grid of x and y is displayed on the current active device.} \note{ Direct gradient analysis was promoted by Robert Whittaker and followers as a preferred method of vegetation analysis. } \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[mgcv]{gam}}} \examples{ data(bryceveg) # returns a data.frame called bryceveg x <- c(0.2,0.5,1.0,2.0,3.0,4.0,5.0,6.0) y <- c(0.2,0.5,3.0,15.0,37.5,62.5,85.0,97.5) cover <- abundtrans(bryceveg,x,y) data(brycesite) dga(round(cover$arcpat),brycesite$elev,brycesite$av) } \keyword{multivariate} r-cran-labdsv-2.0-1/man/disana.Rd000066400000000000000000000041401412660326600164520ustar00rootroot00000000000000\name{disana} \alias{disana} \title{Dissimilarity Analysis} \description{Dissimilarity analysis is a graphical analysis of the distribution of values in a dissimilarity matrix} \usage{disana(x, panel='all') } \arguments{ \item{x}{an object of class \sQuote{dist} such as returned by \code{\link{dist}}, \code{\link[labdsv]{dsvdis}}. or \code{\link[vegan]{vegdist}}} \item{panel}{a switch to specify which panel of graphics should be displayed. Can be either an integer from 1 to 3, or the word \sQuote{all}.} } \details{Calculates three vectors: the minimum, mean, and maximum dissimilarity for each sample in a dissimilarity matrix. By default it produces three plots: the sorted dissimilarity values, the sorted min, mean, and maximum dissimilarity for each sample, and the mean dissimilarity versus the minimum dissimilarity for each sample. Optionally, you can identify sample plots in the last panel with the mouse. } \value{Plots three graphs to the current graphical device, and returns an (invisible) list with four components: \item{min}{the minimum dissimilarity of each sample to all others} \item{mean}{the mean dissimilarity of each sample to all others} \item{max}{the maximum dissimilarity of each sample to all others} \item{plots}{a vector of samples identified in the last panel} } \references{\url{http://ecology.msu.montana.edu/labdsv/R/labs/lab8/lab8.html}} \note{Dissimilarity matrices are often large, and difficult to visualize directly. \sQuote{disana} is designed to highlight aspects of interest in these large matrices. If the first panel shows a long limb of constant maximum value, you should consider recalculating the dissimilarity with a step-across adjustment. The third panel is useful for identifying outliers, which are plots more than 0.5 dissimilar to their nearest neighbor.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) # returns a data.frame called veg dis.bc <- dsvdis(bryceveg,'bray/curtis') disana(dis.bc) } \keyword{multivariate} r-cran-labdsv-2.0-1/man/dropplt.Rd000066400000000000000000000035261412660326600167060ustar00rootroot00000000000000\name{dropplt} \alias{dropplt} \title{Dropping Plots with Missing Values From Taxon and Site Data Frames} \description{Looks for plots which have missing values in site or environment data, and deletes those plots from both the community and site data frames.} \usage{dropplt(comm,site,which=NULL) } \arguments{ \item{comm}{a community data frame with samples as rows and species as columns} \item{site}{a site or environment data frame with samples as rows and variables as columns} \item{which}{a switch to specify specific plots to drop from both data.frames} } \details{First looks to see that the row names of the community data frame and the site or environment data frame are identical. If not, it prints an error message and exits. If which is NULL, it then looks at the site or environment data frame for plots or samples that have missing values, and deletes those plots from both the community and site data frames. Alternatively, if which is a numeric scalar or vector it deletes the specified plots from both the community and site data.frames.} \value{produces a list with two components: \item{site}{the new site data frame} } \note{This is a VERY heavy-handed approach to managing missing values. Most R routines (including most of the labdsv package functions) have ways of handling missing values that are fairly graceful. This function simply maintains the correspondence between the community and site data frames while eliminating ALL missing values, and all plots that have missing values.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) # returns a data frame called bryceveg data(brycesite) # returns a data frame called brycesite demo <- dropplt(bryceveg,brycesite) newcomm <- demo$comm newsite <- demo$site } \keyword{manip} r-cran-labdsv-2.0-1/man/dropspc.Rd000066400000000000000000000027241412660326600166730ustar00rootroot00000000000000\name{dropspc} \alias{dropspc} \title{Dropping Species with Few Occurrences} \description{Eliminates species from the community data frame that occur fewer than or equal to a threshold number of occurrences.} \usage{dropspc(comm,minocc=0,minabu=0) } \arguments{ \item{comm}{a community data frame} \item{minocc}{the threshold number of occurrences to be dropped} \item{minabu}{the threshold minimum abundance to be dropped} } \details{The function is useful for eliminating species (columns) from community data frames which never occur, which often happens if you eliminate plots, and those plots are the only ones that contain that species. In addition, many species are rare in data frames, and some algorithms (especially dissimilarity functions and table sorting routines) benefit from smaller, simpler data frames. } \value{Produces a new community data frame} \note{This is a heavy-handed approach to managing rare species in data.frames. It is often possible to write a mask (logical vector) that suppresses the influence of rare species and keeps the original data.frame intact, but this function simplifies data management for some purposes.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) # returns a data frame called bryceveg newveg <- dropspc(bryceveg,5) # deletes species which # occur 5 or fewer times } \keyword{manip} r-cran-labdsv-2.0-1/man/dsvdis.Rd000066400000000000000000000102221412660326600165050ustar00rootroot00000000000000\name{dsvdis} \alias{dsvdis} \title{Dissimilarity Indices and Distance Measures} \description{This function provides a set of alternative dissimilarity indices and distance metrics for classification and ordination, including weighting by species (columns) and shortest-path adjustment for dissimilarity indices.} \usage{dsvdis(x,index,weight=rep(1,ncol(x)),step=0.0, diag=FALSE, upper=FALSE)} \arguments{ \item{x}{a matrix of observations, samples as rows and variables as columns} \item{index}{a specific dissimilarity or distance index (see details below)} \item{weight}{a vector of weights for species (columns)} \item{step}{a threshold dissimilarity to initiate shortest-path adjustment (0.0 is a flag for no adjustment)} \item{diag}{a switch to control returning the diagonal (default=FALSE)} \item{upper}{a switch to control returning the upper (TRUE) or lower (FALSE) triangle} } \details{ The function calculates dissimilarity or distance between rows of a matrix of observations according to a specific index. Three indices convert the data to presence/absence automatically. In contingency table notation, they are: \tabular{ll}{ steinhaus \tab \eqn{1 - a / (a + b + c)} \cr sorensen \tab \eqn{1 - 2a / (2a + b +c)} \cr ochiai \tab \eqn{1 - a / \sqrt{(a+b) * (a+c)}} \cr } Others are quantitative. For variable i in samples x and y: \tabular{ll}{ ruzicka \tab \eqn{1 - \sum min(x_i,y_i) / \sum max(x_i,y_i)} \cr bray/curtis \tab \eqn{1 - \sum[2 * min(x_i,y_i)] / \sum x_i + y_i} \cr roberts \tab \eqn{1 - [(x_i+y_i) * min(x_i,y_i) / max(x_i,y_i)] / (x_i + y_i)} \cr chisq \tab \eqn{(exp - obs) / \sqrt{exp}} \cr } The weight argument allows the assignment of weights to individual species in the calculation of plot-to-plot similarity. The weights can be assigned by life-form, indicator value, or for other investigator specific reasons. For the presence/absence indices the weights should be integers; for the quantitative indices the weights should be in the interval [0,1]. The default (rep(1,ncol(x)) is to set all species = 1. The threshold dissimilarity \sQuote{step} sets all values greater than or equal to "step" to 9999.9 and then solves for the shortest path distance connecting plots to other non-9999.9 values in the matrix. Step = 0.0 (the default) is a flag for "no shortest-path correction". } \value{Returns an object of class "dist", equivalent to that from \code{dist}.} \note{Ecologists have spent a great deal of time and effort examining the properties of different dissimilarity indices and distances for ecological data. Many of these indices should have more general application however. Dissimilarity indices are bounded [0,1], so that samples with no attributes in common cannot be more dissimilar than 1.0, regardless of their separation along hypothetical or real gradients. The shortest-path adjustment provides a partial solution. Pairs of samples more dissimilar than a specified threshold are set to 9999.9, and the algorithm solves for their actual dissimilarity from the transitive closure of the triangle inequality. Essentially, the dissimilarity is replaced by the shortest connected path between points less than the threshold apart. In this way it is possible to obtain dissimilarities much greater than 1.0. The chi-square distance is not usually employed directly in cluster analysis or ordination, but is provided so that you can calculate correspondence analysis as a principal coordinates analysis (using \code{cmdscale}) from a simple distance matrix.} \author{David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \references{\url{http://ecology.msu.montana.edu/labdsv/R/labs/lab8/lab8.html}} \seealso{\code{dist}, \code{\link[vegan]{vegdist}}} \examples{ data(bryceveg) # returns a data.frame called "bryceveg" dis.ochiai <- dsvdis(bryceveg,index="ochiai") dis.bc <- dsvdis(bryceveg,index="bray/curtis") } \keyword{multivariate} r-cran-labdsv-2.0-1/man/dsvls.Rd000066400000000000000000000021071412660326600163470ustar00rootroot00000000000000\name{dsvls} \alias{dsvls} \title{LabDSV Object ls() Command} \usage{ dsvls(frame=NULL,opt='full') } \arguments{ \item{frame}{an environment; if null substitutes parent.frame()} \item{opt}{a switch for \sQuote{full} or \sQuote{brief} output} } \description{ The function searches through all the objects in the specified environment, and determines which ones have specific meaning in LabDSV. It then produces an output of a summary of every known LabDSV object sorted by type.} \value{Prints output to the console} \references{ \url{http://ecology.msu.montana.edu/labdsv/R} } \note{It's common that after a while the number of objects in your workspace can get large, and even with disciplined naming of objects the list can get overwhelming. dsvls() attempts to organize and report on the objects LabDSV understands.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) dis.bc <- dsvdis(bryceveg,'bray') nmds.bc <- nmds(dis.bc,2) dsvls() } \keyword{utilities} r-cran-labdsv-2.0-1/man/envrtest.Rd000066400000000000000000000042041412660326600170660ustar00rootroot00000000000000\name{envrtest} \alias{envrtest} \title{Environmental Distribution Test} \description{Calculates whether the value of a specified environmental variable has an improbable distribution with respect to a specified vector} \usage{envrtest(set,env,numitr=1000,minval=0,replace=FALSE, plotit = TRUE, main = paste(deparse(substitute(set)), " on ", deparse(substitute(env)))) } \arguments{ \item{set}{a vector of logical or quantitative values} \item{env}{the quantitative variable whose distribution is to be tested} \item{numitr}{the number of randomizations to iterate to calculate probabilities} \item{minval}{the threshold to use to partition the data into a logical if set is quantitative} \item{replace}{whether to permute (replace=FALSE) or bootstrap (replace=TRUE) the values in the permutation test} \item{plotit}{logical; plot results if TRUE} \item{main}{title for plot if plotted} } \details{Calculates the maximum within-set difference in the values of vector \sQuote{env}, and the distribution of the permuted random within-set differences. It then plots the observed difference as a red line, and the sorted permuted differences as a black line and prints the probability of getting such a limited distribution. The probability is calculated by permuting numitr-1 times, counting the number of times the permuted maximum difference is as small or smaller than observed (n), and calculating (n+1)/numitr. To get three-digit probabilities, set numitr=1000 (the default) } \value{Produces a plot on the current graphics device, and an invisible list with the components observed within-set difference and the p-value. } \note{The plot is based on the concept of constraint, or limiting value, and checks to see whether the distribution of a particular variable within a cluster is constrained in an improbable way.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) # returns a vegetation data.frame data(brycesite) # returns and environmental data.frame envrtest(bryceveg$berrep>0,brycesite$elev) } \keyword{cluster} r-cran-labdsv-2.0-1/man/euclidify.Rd000066400000000000000000000037111412660326600171730ustar00rootroot00000000000000\name{euclidify} \alias{euclidify} \alias{as.euclidean} \title{Nearest Euclidean Space Representation of a Dissimilarity Object} \description{Calculates the nearest Euclidean space representation of a dissimilarity object by iterating the transitive closure of the triangle inequality} \usage{ euclidify(dis,upper=FALSE,diag=FALSE) as.euclidean(dis,upper=FALSE,diag=FALSE) } \arguments{ \item{dis}{a distance or dissimilarity object returned from \code{\link{dist}}, \code{\link[vegan]{vegdist}}, or \code{\link[labdsv]{dsvdis}}} \item{upper}{a logical switch to control whether to return the lower triangle (upper=FALSE) or upper triangle (upper=TRUE) of the distance matrix} \item{diag}{a logical switch to control whether to return the diagonal of the distance matrix} } \details{Implements a constrained iteration of the transitive closure of Pythagoras' theorem, such that the squared distance between any two objects is less than or equal to the sum of the squared distances from the two objects to all possible third objects. } \value{An object of class \sQuote{dist}} \note{Many multivariate statistical methods are designed for euclidean spaces, and yet the direct calculation of euclidean distance is often inappropriate due to problems with joint absences. euclidify takes any dissimilarity matrix and converts it to the closest euclidean representation, generally to avoid negative eigenvalues in an eigenanalysis of the matrix.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[labdsv]{metrify}} } \examples{ data(bryceveg) # returns a vegetation data.frame dis.bc <- dsvdis(bryceveg,'bray/curtis') # calculate a Bray/Curtis # dissimilarity matrix dis.euc <- euclidify(dis.bc) # calculate the nearest euclidean # representation \dontrun{plot(dis.bc,dis.euc)} } \keyword{multivariate} r-cran-labdsv-2.0-1/man/factorize.Rd000066400000000000000000000022711412660326600172040ustar00rootroot00000000000000\name{factorize} \alias{factorize} \title{Change Character Vectors in Data.frames to Factors} \description{Looks at each column in a data.frame, and converts character vector columns to factors.} \usage{ factorize(df) } \arguments{ \item{df}{a data.frame} } \details{The function simply scans each column in a data.frame looking for character vector columns. For each character column it calls the \sQuote{factor()} function to convert the column to a factor.} \value{Returns a data.frame where every character column has been converted to a factor} \note{This function simplifies editing data.frames by allowing users to edit character columns (which have no levels constraints) and then converting the results to factors for modeling. It is often used in a cycle of defactorize(df) edit the columns as necessary to correct errors or simplify factorize(df) } \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\link[labdsv]{defactorize}} \examples{ data(brycesite) brycesite <- defactorize(brycesite) brycesite$quad[brycesite$quad=='bp'] <- 'BP' brycesite <- factorize(brycesite) } \keyword{manip} r-cran-labdsv-2.0-1/man/gsr.Rd000066400000000000000000000022711412660326600160110ustar00rootroot00000000000000\name{gsr} \alias{gsr} \title{Global Search and Replace for Data.frames} \description{Performs in-place editing of data.frames that have factor columns while correcting for the change to levels.} \usage{ gsr(field,old,new) } \arguments{ \item{field}{a vector or specific column in a data.frame} \item{old}{a character vector of values to search for} \item{new}{a character vector of values to replace the respective items in old} } \details{The function temporarily converts a vector or vector column in a data.frame to a character vector, and then loops through the \sQuote{old} vector looking for values to replace with the respective value in the \sQuote{new} vector. The column is then converted back to a factor.} \value{a factor vector} \note{The function is designed to make simple editing changes to data.frames or factor vectors, resetting the levels appropriately.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(brycesite) brycesite$quad <- gsr(brycesite$quad, old=c('bp','bc','pc','rp','tc','tr'), new=c('BP','BC','PC','RP','TC','TR')) } \keyword{manip} r-cran-labdsv-2.0-1/man/hellinger.Rd000066400000000000000000000016631412660326600171730ustar00rootroot00000000000000\name{hellinger} \alias{hellinger} \title{Hellinger Data Transformation} \description{Performs the Hellinger data transformation (square root of sample total standardized data). } \usage{hellinger(comm) } \arguments{ \item{comm}{a community data.frame (samples as rows, species as columns)} } \details{Calculates a sample total standardization (all values in a row are divided by the row sum), and then takes the square root of the values. } \value{A community data.frame } \references{\url{http://ecology.msu.montana.edu/labdsv/R}} \note{Hellinger standardization is a convex standardization that simultaneously helps minimize effects of vastly different sample total abundances.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{spcmax, samptot, abundtrans } \examples{ data(bryceveg) hellveg <- hellinger(bryceveg) } \keyword{standardization} r-cran-labdsv-2.0-1/man/homoteneity.Rd000066400000000000000000000024241412660326600175620ustar00rootroot00000000000000\name{homoteneity} \alias{homoteneity} \title{Homoteneity Analysis of Classified Ecological Communities} \description{Homoteneity is defined as \sQuote{the mean constancy of the S most constant species, expressed as a fraction, where S is the mean species richness of a type.} } \usage{homoteneity(comm,clustering) } \arguments{ \item{comm}{a data.frame of species abundances with samples as rows and species as columns} \item{clustering}{a vector of (integer) class memberships, or an object of class \sQuote{clustering}, class \sQuote{partana}, or class \code{\link[cluster]{partition}}} } \value{A data.frame of homoteneity values } \note{This function was adapted from the Virginia Heritage Program at http://www.dcr.virginia.gov/natural_heritage/ncstatistics.shtml} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[labdsv]{const}}, \code{\link[labdsv]{concov}} } \examples{ data(bryceveg) # returns a data.frame of species in sample plots data(brycesite) # returns a data.frame of site variables homoteneity(bryceveg,brycesite$quad) # analysis of species constancy # by USGS quad location } \keyword{multivariate} r-cran-labdsv-2.0-1/man/importance.Rd000066400000000000000000000044151412660326600173610ustar00rootroot00000000000000\name{importance} \alias{importance} \alias{importance.default} \title{Importance Table} \description{For a classified set of vegetation samples, a importance table lists for each species the average or typical abundance of each species in each class. } \usage{importance(comm,clustering,minval=0,digits=2,show=minval, sort=FALSE,typical=TRUE,spcord,dots=TRUE) } \arguments{ \item{comm}{a data.frame of species abundances with samples as rows and species as columns} \item{clustering}{a vector of (integer) class memberships, or an object of class \sQuote{clustering}, class \sQuote{partana}, of class \code{\link[cluster]{partition}}} \item{minval}{the minimum importance a species must have in at least one class to be included in the output} \item{digits}{the number of digits to report in the table} \item{show}{the minimum value a species must have to print a value} \item{sort}{a switch to control interactive re-ordering} \item{typical}{a switch to control how mean abundance is calculated. Typical=TRUE divides the sum of species abundance by the number of plots in which it occurs; typical=FALSE divides by the number of plots in the type} \item{spcord}{a vector of integers to specify the order in which species should be listed in the table} \item{dots}{a switch to control substituting dots for small values} } \value{a data.frame with species as rows, classes as columns, with average abundance of species in classes.} \references{\url{http://ecology.msu.montana.edu/labdsv/R/labs/lab3/lab3.html}} \note{Importance tables are often used in vegetation classification to calculate or present characteristic species for specific classes or types. Importance may be combined with \code{\link[labdsv]{const}}, \code{\link[labdsv]{concov}} and \code{\link[labdsv]{vegtab}} to achieve a vegetation table-oriented analysis.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[labdsv]{const}}, \code{\link[labdsv]{vegtab}}, \code{\link[labdsv]{concov}} } \examples{ data(bryceveg) # returns a data.frame called bryceveg data(brycesite) class <- cut(brycesite$elev,10,labels=FALSE) importance(bryceveg,class,minval=0.25) } \keyword{multivariate} r-cran-labdsv-2.0-1/man/indval.Rd000066400000000000000000000113041412660326600164700ustar00rootroot00000000000000\name{indval} \alias{indval} \alias{duleg} \alias{indval.default} \alias{indval.stride} \alias{summary.indval} \title{Dufrene-Legendre Indicator Species Analysis} \description{Calculates the indicator value (fidelity and relative abundance) of species in clusters or types.} \usage{ indval(x, \dots) \method{indval}{default}(x,clustering,numitr=1000,\dots) \method{indval}{stride}(x,comm,numitr=1,\dots) \method{summary}{indval}(object, p=0.05, type='short', digits=2, show=p, sort=FALSE, too.many=100, \dots) } \arguments{ \item{x}{a matrix or data.frame of samples with species as columns and samples as rows, or an object of class \sQuote{stride} from function \code{\link[optpart]{stride}}} \item{clustering}{a vector of numeric cluster memberships for samples, or a classification object returned from \code{\link[cluster]{pam}}, or \code{\link[optpart]{optpart}}, \code{\link[optpart]{slice}}, or \code{\link[optpart]{archi}}} \item{numitr}{the number of randomizations to iterate to calculate probabilities} \item{comm}{a data.frame with samples as rows and species as columns} \item{object}{an object of class \sQuote{indval}} \item{p}{the maximum probability for a species to be listed in the summary} \item{type}{a switch to choose between \sQuote{short} and \sQuote{long} style summary} \item{digits}{the number of significant digits to show} \item{show}{the threshold to show values as opposed to a dot column place-holder} \item{sort}{a switch to control user-managed interactive table sorting} \item{too.many}{a threshold reduce the listing for large data sets} \item{\dots}{additional arguments to the summary or generic function} } \details{Calculates the indicator value \sQuote{d} of species as the product of the relative frequency and relative average abundance in clusters. Specifically, where:\cr \eqn{p_{ij}}{p_(ij)} = presence/absence (1/0) of species \eqn{i} in sample \eqn{j}; \cr \eqn{x_{ij}}{x_(ij)} = abundance of species \eqn{i} in sample \eqn{j}; \cr \eqn{n_c} = number of samples in cluster \eqn{c};\cr for cluster \eqn{c \in K}; \cr \deqn{f_{ic} = {\sum_{j \in c} p_{ij} \over n_c}} \deqn{a_{ic} = {\sum_{j \in c} x_{ij} / n_c \over \sum_{k=1}^K (\sum_{j \in k} x_{ij} / n_k)}} \deqn{d_{ic} = f_{ic} \times a_{ic}} Calculated on a \sQuote{stride} the function calculates the indicator values of species for each of the separate partitions in the stride. } \value{ The default function returns a list of class \sQuote{indval} with components: \item{relfrq}{relative frequency of species in classes} \item{relabu}{relative abundance of species in classes} \item{indval}{the indicator value for each species} \item{maxcls}{the class each species has maximum indicator value for} \item{indcls}{the indicator value for each species to its maximum class} \item{pval}{the probability of obtaining as high an indicator values as observed over the specified iterations} The stride-based function returns a data.frame with the number of clusters in the first column and the mean indicator value in the second. The \sQuote{summary} function has two options. In \sQuote{short} mode it presents a table of indicator species whose probability is less then \sQuote{p}, giving their indicator value and the identity of the cluster they indicate, along with the sum of probabilities for the entire data set. In \sQuote{long} mode, the indicator value of each species in each class is shown, with values less than \sQuote{show} replaced by a place-holder dot to emphasize larger values. If \sQuote{sort==TRUE}, a prompt is given to re-order the rows of the matrix interactively. } \note{Indicator value analysis was proposed by Dufrene and Legendre (1997) as a possible stopping rule for clustering, but has been used by ecologists for a variety of analyses. Dufrene and Legendre's nomenclature in the paper is somewhat ambiguous, but the equations above are taken from the worked example in the paper, not the equations on page 350 which appear to be in error. Dufrene and Legendre, however, multiply \eqn{d} by 100; this function does not.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \references{Dufrene, M. and Legendre, P. 1997. Species assemblages and indicator species: the need for a flexible asymmetrical approach. Ecol. Monogr. 67(3):345-366.} \seealso{\code{\link[labdsv]{isamic}}} \examples{ data(bryceveg) # returns a vegetation data.frame data(brycesite) clust <- cut(brycesite$elev,5,labels=FALSE) summary(indval(bryceveg,clust)) } \keyword{cluster} r-cran-labdsv-2.0-1/man/isamic.Rd000066400000000000000000000027641412660326600164720ustar00rootroot00000000000000\name{isamic} \alias{isamic} \alias{duarm} \title{Indicator Species Analysis Minimizing Intermediate Occurrences} \description{Calculates the degree to which species are either always present or always absent within clusters or types.} \usage{isamic(comm,clustering,sort=FALSE)} \arguments{ \item{comm}{a matrix or data.frame of samples, species as columns, samples as rows} \item{clustering}{a vector of numeric cluster memberships for samples, or a classification object returned from \code{\link[cluster]{pam}}, \code{\link[optpart]{partana}}, or \code{\link[optpart]{slice}}} \item{sort}{if TRUE, return in order of highest value to lowest rather than input order} } \details{Calculates the constancy (fractional occurrence of each species in every type), and then calculates twice the the sum of the absolute values of the constancy - 0.5, normalized to the number of clusters (columns).} \value{A data.frame of species indicator values} \references{ Aho, K., D.W. Roberts, and T.W. Weaver. 2008. Using geometric and non-geometric internal evaluators to compare eight vegetation classification methods. J. Veg. Sci. 19(4):549-562.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[labdsv]{indval}}} \examples{ data(bryceveg) data(brycesite) clust <- cut(brycesite$elev,5,labels=FALSE) isamic(bryceveg,clust) } \keyword{cluster} r-cran-labdsv-2.0-1/man/labdsv.internal.Rd000066400000000000000000000004621412660326600203040ustar00rootroot00000000000000\name{labdsv.internal} \alias{plotid} \alias{specid} \alias{surf} \alias{hilight} \alias{chullord} \alias{shannon} \alias{pip} \alias{density} \title{LabDSV Internal Functions} \description{These functions establish several generic functions, and are not intended to be called directly} \keyword{internal} r-cran-labdsv-2.0-1/man/matrify.Rd000066400000000000000000000027421412660326600166740ustar00rootroot00000000000000\name{matrify} \alias{matrify} \title{Create Taxon Data.frames From Three Column Database Form} \description{Takes a data.frame in three column form (sample.id, taxon, abundance) and converts it into full matrix form, and then exports it as a data.frame with the appropriate row.names and column names.} \usage{matrify(data)} \arguments{ \item{data}{a data.frame or matrix in three column format (or database format), where the first column is the sample ID, the second column is the taxon ID, and the third sample is the abundance of that taxon in that sample.} } \details{The routine is pure R code to convert data from database form to the sparse matrix form required by multivariate analyses in packages \sQuote{labdsv} and \sQuote{vegan}, as well as \code{dist} and other routines. } \value{A data.frame with samples as rows, taxa as columns, and abundance values for taxa in samples. } \note{Typically, the source of the data will be an ASCII file or a dBase database or a CSV file from an Excel file in three column format. That file can be read into a data.frame with \code{read.table} or \code{read.csv} and then that data.frame can be matrified by this function.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[labdsv]{dematrify}}} \examples{ x <- cbind(c('a','a','b','b','b','c','c'), c('x','y','x','z','w','y','z'), c(1,2,1,3,2,2,1)) matrify(x) } \keyword{IO} r-cran-labdsv-2.0-1/man/metrify.Rd000066400000000000000000000036451412660326600167030ustar00rootroot00000000000000\name{metrify} \alias{metrify} \alias{as.metric} \alias{is.metric} \title{Nearest Metric Space Representation of a Dissimilarity Object} \description{Calculates the nearest metric space representation of a dissimilarity object by iterating the transitive closure of the triangle inequality rule} \usage{ metrify(dis,upper=FALSE,diag=FALSE) as.metric(dis,upper=FALSE,diag=FALSE) is.metric(dis) } \arguments{ \item{dis}{a distance or dissimilarity object returned from \code{\link{dist}}, \code{\link[vegan]{vegdist}}, or \code{\link[labdsv]{dsvdis}}} \item{upper}{a logical switch to control whether to return the lower triangle (upper=FALSE) or upper triangle (upper=TRUE) of the distance matrix} \item{diag}{a logical switch to control whether to return the diagonal of the distance matrix} } \details{Implements a constrained iteration of the transitive closure of the triangle inequality, such that the distance between any two objects is less than or equal to the sum of the distances from the two objects to a third. } \value{For metrify and as.metric, an object of class \sQuote{dist}. For is.metric returns TRUE or FALSE.} \note{Many multivariate statistical methods are designed for metric spaces, and yet the direct calculation of distance is often inappropriate due to problems with joint absences. metrify takes any dissimilarity matrix and converts it to the closest metric space representation, generally to avoid negative eigenvalues in an eigenanalysis of the matrix.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[labdsv]{euclidify}}} \examples{ data(bryceveg) # returns a vegetation data.frame dis.bc <- dsvdis(bryceveg,'bray/curtis') # calculate a Bray/Curtis # dissimilarity matrix dis.met <- metrify(dis.bc) # calculate the nearest euclidean # representation } \keyword{multivariate} r-cran-labdsv-2.0-1/man/neighbors.Rd000066400000000000000000000017701412660326600172010ustar00rootroot00000000000000\name{neighbors} \alias{neighbors} \title{Neighbors} \description{Calculates the nearest neighbors in a distance/dissimilarity matrix} \usage{neighbors(dis,numnbr) } \arguments{ \item{dis}{an object of class \sQuote{dist} such as returned by \code{\link{dist}}, \code{\link[vegan]{vegdist}} or \code{\link[labdsv]{dsvdis}}} \item{numnbr}{the number (order) of neighbors to return} } \details{For each sample unit in a dissimilarity matrix finds the \sQuote{numnbr} nearest neighbors and returns them in order. } \value{Returns a data.frame with sample units as rows and neighbors as columns, listed in order of proximity to the sample unit. } \references{\url{http://ecology.msu.montana.edu/labdsv/R/labs/lab8/lab8.html}} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) # returns a data.frame called veg dis.bc <- dsvdis(bryceveg,'bray/curtis') neighbors(dis.bc,5) } \keyword{multivariate} r-cran-labdsv-2.0-1/man/nmds.Rd000066400000000000000000000073341412660326600161640ustar00rootroot00000000000000\name{nmds} \alias{nmds} \alias{bestnmds} \title{Nonmetric Multidimensional Scaling} \description{This function is simply a wrapper for the isoMDS function in the MASS package by Venables and Ripley. The purpose is to convert the output to class \sQuote{dsvord} to simplify plotting and additional graphical analysis as well as to provide a summary method.} \usage{ nmds(dis,k=2,y=cmdscale(d=dis,k=k),maxit=50,trace=FALSE) bestnmds(dis,k=2,itr=20,maxit=100,trace=FALSE) } \arguments{ \item{dis}{a dist object returned from \code{dist} or a full symmetric dissimilarity or distance matrix} \item{k}{the desired number of dimensions for the result} \item{y}{a matrix of initial locations (objects as rows, coordinates as columns, as many columns as specified by k). If none is supplied, \code{cmdscale} is used to generate them} \item{maxit}{the maximum number of iterations in the isoMDS routine} \item{trace}{a switch to control printing intermediate results} \item{itr}{number of random starts to find best result} } \details{The nmds function simply calls the \code{isoMDS} function of the MASS library, but converts the result from a list to an object of class \sQuote{dsvord}. The only purpose for the function is to allow \sQuote{plot}, \sQuote{identify}, \sQuote{surf}, and other additional methods to be defined for the class, to simplify the analysis of the result. The \sQuote{bestnmds} function runs one run from a PCO solution and \sQuote{itr-1} number of random initial locations and returns the best result of the set.} \value{An object of class \sQuote{dsvord}, with components: \item{points}{the coordinates of samples along axes} \item{stress}{the "goodness-of-fit" computed as stress in percent} \item{type}{\sQuote{NMDS}} } \references{ Kruskal, J.B. (1964) Multidimensional scaling by optimizing goodness of fit to nonmetric hypothesis. Psychometrics 29:1-27. Kruskal, J.B. (1964) Nonmetric multidimensional scaling: a numerical method. Psychometrics 29:115-129. T.F. Cox and M.A.A. Cox. (1994) \emph{Multidimensional Scaling.} Chapman and Hall. \url{http://ecology.msu.montana.edu/labdsv/R/labs/lab9/lab9.html} } \note{nmds is included as part of the LabDSV package to provide a consistent interface and utility for vegetation ordination methods. Other analyses included with the same interface at present include principal components analysis (pca), principal coordinates analysis (pco), and t-distributed neighborhood embedding (t-SNE).} \author{ Venables and Ripley for the original isoMDS function included in the MASS package. David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{ \code{isoMDS} for the original function \code{\link[labdsv]{plot.dsvord}} for the \sQuote{plot} method, the \sQuote{plotid} method to identify points with a mouse, the \sQuote{points} method to identify points meeting a logical condition, the \sQuote{hilight} method to color-code points according to a factor, the \sQuote{chullord} method to add convex hulls for a factor, or the the \sQuote{surf} method to add surface contours for continuous variables. \code{\link[vegan]{initMDS}} for an alternative way to automate random starts \code{\link[vegan]{postMDS}} for a post-solution rescaling \code{\link[vegan]{metaMDS}} for a full treatment of variations } \examples{ data(bryceveg) data(brycesite) dis.man <- dist(bryceveg,method="manhattan") demo.nmds <- nmds(dis.man,k=4) plot(demo.nmds) points(demo.nmds,brycesite$elev>8000) plotid(demo.nmds,ids=row.names(brycesite)) } \keyword{multivariate} r-cran-labdsv-2.0-1/man/ordcomm.Rd000066400000000000000000000032071412660326600166560ustar00rootroot00000000000000\name{ordcomm} \alias{ordcomm} \title{Re-Order the Rows and Columns of a Taxon Data Frame} \description{Allows analysts to interactively re-order a community data frame to achieve a \sQuote{structured} table following phytosociological principles.} \usage{ordcomm(comm,site) } \arguments{ \item{comm}{a community data frame} \item{site}{a site or environment data frame} } \details{Prints a copy of the community data frame, and then prompts for plots to move in front of another plot. It then prompts for species to move in front of a specified species. Multiple plots or species can be moved in a single move, with plot or species IDs separated by commas with no blanks. The program cycles between prompting for plots to move, and then species to move, until both prompts are responded to with blank lines. } \value{produces a list with two components: \item{comm}{the new community data frame} \item{site}{the new site data frame} } \note{This is a a fairly simple means to sort a table. For large tables, it is often possible (and preferable) to sort the tables with ordination coordinates or other indices, but this function allows analysts to order the table arbitrarily into any form.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{ \code{summary.indval},\code{const},\code{importance} } \examples{ \dontrun{data(bryceveg)} # returns a data frame called bryceveg \dontrun{data(brycesite)} # returns a data frame called brycesite \dontrun{demo <- ordcomm(bryceveg,brycesite)} \dontrun{newveg <- demo$taxon} \dontrun{newsite <- demo$site} } \keyword{data} r-cran-labdsv-2.0-1/man/ordcomp.Rd000066400000000000000000000035051412660326600166620ustar00rootroot00000000000000\name{ordcomp} \alias{ordcomp} \title{Ordination to Dissimilarity Comparison} \description{ Plots the distribution of pair-wise distances of all points in an ordination over the distances in the dissimilarity or distance matrix the ordination was calculated from. Prints the correlation between the two on the graph. } \usage{ordcomp(x,dis,dim,xlab="Computed Distance", ylab="Ordination Distance",title="",pch=1) } \arguments{ \item{x}{an ordination object of class \sQuote{dsvord} from \code{\link[labdsv]{pca}}, \code{\link[labdsv]{pco}}, \code{\link[labdsv]{nmds}}, \code{\link[fso]{fso}} or \cr \code{\link[vegan]{ordiplot}}} \item{dis}{an object of class \code{\link{dist}}} \item{dim}{the number of dimensions in the ordination to use (default=all)} \item{xlab}{the X axis label for the graph} \item{ylab}{the Y axis label for the graph} \item{title}{a title for the plot} \item{pch}{the symbol to plot} } \value{A plot is created on the current graphics device. Returns the (invisible) correlation. } \note{Ordinations are low dimensional representations of multidimensional spaces. This function attempts to portray how well the low dimensional solution approximates the full dimensional space.} \references{\url{http://ecology.msu.montana.edu/labdsv/R/labs/lab9/lab9.html}} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) # produces a vegetation data.frame dis.bc <- dsvdis(bryceveg,'bray/curtis') # creates a Bray/Curtis # dissimilarity matrix pco.bc <- pco(dis.bc,2) # produces a two-dimensional Principal # Coordinates Ordination object ordcomp(pco.bc,dis.bc) } \keyword{multivariate} \keyword{hplot} r-cran-labdsv-2.0-1/man/orddist.Rd000066400000000000000000000027031412660326600166660ustar00rootroot00000000000000\name{orddist} \alias{orddist} \title{Ordination Point Pair-Wise Distance Calculation} \description{ Calculates the pair-wise distances of all points in an ordination. The function is simply a wrapper for the \sQuote{dist} function, but simplifies managing ordinations that store their coordinates under different names, as well as managing the desired dimensionality of the calculations.} \usage{orddist(x,dim)} \arguments{ \item{x}{an ordination object of class \sQuote{dsvord} from \code{\link[labdsv]{pca}}, \code{\link[labdsv]{pco}}, \code{\link[labdsv]{nmds}}, \code{\link[fso]{fso}}} \item{dim}{the desired dimensionality to be included in the calculations (must be <= number of dimensions of the ordinations)} } \value{An object of class \sQuote{dist} is produced } \note{Ordinations are low dimensional representations of multidimensional spaces. This function produces data on the low-dimensional distances for other analyses.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) # produces a vegetation data.frame dis.bc <- dsvdis(bryceveg,'bray/curtis') # creates a Bray/Curtis #dissimilarity matrix pco.bc <- pco(dis.bc,2) # produces a two-dimensional Principal # Coordinates Ordination object orddist(pco.bc,dim=2) } \keyword{multivariate} \keyword{hplot} r-cran-labdsv-2.0-1/man/ordneighbors.Rd000066400000000000000000000036641412660326600177120ustar00rootroot00000000000000\name{ordneighbors} \alias{ordneighbors} \title{Nearest Neighbors Plotted in Ordination Space} \description{ For each sample unit in an ordination, for each of n nearest neighbors, draws an arrow from the sample unit to its n neighbors. } \usage{ordneighbors(ord,dis,numnbr=1,ax=1,ay=2,digits=5,length=0.1) } \arguments{ \item{ord}{an ordination object of class \sQuote{dsvord} from \code{\link[labdsv]{pca}}, \code{\link[labdsv]{pco}}, \code{\link[labdsv]{nmds}}, \code{\link[fso]{fso}}} \item{dis}{an object of class \code{\link{dist}}} \item{numnbr}{the number (order) of nearest neighbors to plot} \item{ax}{the dimension t plot on the X axis} \item{ay}{the dimension to plot on the y axis} \item{digits}{the number of digits to report} \item{length}{the length of the arrowhead} } \value{Additional information is plotted on an existing ordination and summary information is printed. Returns an (invisible) list of summary values. } \note{Ordinations are low dimensional representations of multidimensional spaces. This function attempts to portray how well the low dimensional solution approximates the neighborhood relations of the full dimensional space. If numnbr = 1 and there are ties the function plots arrows for all tied values. If n > 1 the function draws arrows for all values with rank <= n. } \references{\url{http://ecology.msu.montana.edu/labdsv/R/labs/lab9/lab9.html}} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) # produces a vegetation data.frame dis.bc <- dsvdis(bryceveg,'bray/curtis') # creates a Bray/Curtis # dissimilarity matrix pco.bc <- pco(dis.bc,2) # produces a two-dimensional Principal # Coordinates Ordination object plot(pco.bc) ordneighbors(pco.bc,dis.bc) } \keyword{multivariate} \keyword{hplot} r-cran-labdsv-2.0-1/man/ordpart.Rd000066400000000000000000000033571412660326600166770ustar00rootroot00000000000000\name{ordpart} \alias{ordpart} \alias{ordpart.pca} \alias{ordpart.pco} \alias{ordpart.nmds} \alias{ordpart.dsvord} \title{Ordination Partitioning} \description{This function allows users to partition or classify the points in an ordination by identifying clusters of points with a mouse} \usage{ordpart(ord, ax = 1, ay = 2) } \arguments{ \item{ord}{an ordination of class \sQuote{dsvord} produced by nmds, pco, pca or other labdsv ordination functions} \item{ax}{the first axis number in the ordination plot} \item{ay}{the second axis number in the ordination plot} } \details{ Given a plot of an ordination, you assign plots to clusters by drawing a polygon with the first mouse button to include all points in a given cluster. To end that cluster, click the right mouse button to close the polygon. Plots included in that cluster will be color-coded to indicate membership. Start the next cluster by drawing another polygon. To end, click the right mouse button again after closing the last polygon. Plots within more than one polygon are assigned membership in the last polygon which includes them; plots which are not within any polygon are assigned membership in cluster zero. } \value{A integer vector of cluster membership values } \note{Although the routine could easily be adapted for any scatter plot, it is currently only designed for objects of class \sQuote{dsvord}.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) data(brycesite) dis.bc <- dsvdis(bryceveg,'bray/curtis') nmds.1 <- nmds(dis.bc,5) plot(nmds.1) \dontrun{clustering <- ordpart(nmds.1)} } \keyword{hplot} \keyword{aplot} \keyword{iplot} \keyword{cluster} r-cran-labdsv-2.0-1/man/ordtest.Rd000066400000000000000000000032101412660326600166740ustar00rootroot00000000000000\name{ordtest} \alias{ordtest} \title{Ordination Distribution Test} \description{Testing the distribution of points in an ordination} \usage{ ordtest(ord, var, dim=1:ncol(ord$points), index = 'euclidean', nitr = 1000) } \arguments{ \item{ord}{an object of class \sQuote{dsvord}} \item{var}{a logical or factor vector used to organize the calculation of within-set distances} \item{dim}{the number of dimensions to use in the calculation} \item{index}{the distance metric for the calculation of within-set distances. Currently only euclidean is accepted} \item{nitr}{the number of iterations to perform to establish p-values} } \details{ Calculates the sum of within-set pair-wise distances and compares to \sQuote{nitr} permutations of the same distribution to calculate the probability of observing clusters as tight as observed or tighter. The p-value is calculated by running nitr-1 permutations and counting the number of cases where the sum of pair-wise distances is as small as smaller than observed. That count is increased by one and divided by nitr to estimate p. } \value{ Produces a list with components: \item{obs}{the observed sum of within-set distances} \item{p}{the probability of obtaining a value that small} \item{reps}{the sum of within-set pairwise distances for all permutations} } \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[vegan]{anosim}}} \examples{ data(bryceveg) data(brycesite) dis.bc <- dsvdis(bryceveg,'bray/curtis') pco.bc <- pco(dis.bc) plot(pco.bc) demo <- ordtest(pco.bc,brycesite$quad) demo$p } \keyword{multivariate} r-cran-labdsv-2.0-1/man/pca.Rd000066400000000000000000000054061412660326600157640ustar00rootroot00000000000000\name{pca} \alias{pca} \alias{loadings.pca} \alias{summary.pca} \alias{scores.pca} \alias{varplot.pca} \title{Principal Components Analysis} \description{Principal components analysis is a eigenanalysis of a correlation or covariance matrix used to project a high-dimensional system to fewer dimensions. } \usage{ pca(mat, cor = FALSE, dim = min(nrow(mat),ncol(mat))) \method{summary}{pca}(object, dim = length(object$sdev), \dots) \method{scores}{pca}(x, labels = NULL, dim = length(x$sdev)) \method{loadings}{pca}(x, dim = length(x$sdev), digits = 3, cutoff = 0.1) varplot.pca(x, dim=length(x$sdev)) } \arguments{ \item{mat}{a matrix or data.frame of interest, samples as rows, attributes as columns} \item{cor}{logical: whether to use a correlation matrix (if TRUE), or covariance matrix (if FALSE)} \item{dim}{the number of dimensions to return} \item{object}{an object of class \sQuote{pca}} \item{x}{an object of class \sQuote{dsvord} and type='pca'} \item{labels}{an (optional) vector of labels to identify points} \item{digits}{number of digits to report} \item{cutoff}{threshold to suppress printing small values} \item{\dots}{arguments to pass to function summary} } \details{PCA is a common multivariate technique. The version here is simply a wrapper for the \code{prcomp} function to make its use and plotting consistent with the other LabDSV functions. } \value{an object of class "pca", a list with components: \item{scores}{a matrix of the coordinates of the samples in the reduced space} \item{loadings}{a matrix of the contributions of the variables to the axes of the reduced space.} \item{sdev}{a vector of standard deviations for each dimension} } \references{\url{http://ecology.msu.montana.edu/labdsv/R/labs/lab7/lab7.html}} \note{The current version of pca is based on the \code{prcomp} function, as opposed to the \code{princomp} function. Nonetheless, it maintains the more conventional labels "scores" and "loadings", rather than x and rotation. prcomp is based on a singular value decomposition algorithm, as has worked better in my experience. In the rare cases where it fails, you may want to try \code{princomp}. } \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{ \code{princomp}, \code{prcomp}, \code{\link[labdsv]{pco}}, \code{\link[labdsv]{nmds}}, \code{\link[fso]{fso}}, \code{\link[vegan]{cca}} } \examples{ data(bryceveg) # returns a vegetation data.frame data(brycesite) x <- pca(bryceveg,dim=10) # returns the first 10 eigenvectors # and loadings plot(x) surf(x,brycesite$elev) points(x,brycesite$depth=='deep') } \keyword{multivariate} r-cran-labdsv-2.0-1/man/pco.Rd000066400000000000000000000032011412660326600157710ustar00rootroot00000000000000\name{pco} \alias{pco} \title{Principal Coordinates Analysis} \description{Principal coordinates analysis is an eigenanalysis of distance or metric dissimilarity matrices. } \usage{pco(dis, k=2) } \arguments{ \item{dis}{the distance or dissimilarity matrix object of class "dist" returned from \code{dist}, \code{\link[vegan]{vegdist}}, or \code{\link[labdsv]{dsvdis}}} \item{k}{the number of dimensions to return} } \details{pco is simply a wrapper for the \code{cmdscale} function of Venebles and Ripley to make plotting of the function similar to other LabDSV functions } \value{An object of class \sQuote{pco} with components: \item{points}{the coordinates of samples on eigenvectors} } \references{Gower, J.C. (1966) Some distance properties of latent root and vector methods used in multivariate analysis. Biometrika 53:325-328. \url{http://ecology.msu.montana.edu/labdsv/R/labs/lab8/lab8.html}} \note{Principal Coordinates Analysis was pioneered by Gower (1966) as an alternative to PCA better suited to ecological datasets.} \author{ of the \sQuote{cmdscale} function: Venebles and Ripley of the wrapper function David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{cmdscale}, \code{\link[labdsv]{pca}}, \code{\link[labdsv]{nmds}}, \code{\link[vegan]{cca}} } \examples{ data(bryceveg) # returns a vegetation data.frame dis.bc <- dsvdis(bryceveg,'bray/curtis') # returns an object of class dist' veg.pco <- pco(dis.bc,k=4) # returns first 4 dimensions plot(veg.pco) } \keyword{multivariate} r-cran-labdsv-2.0-1/man/plot.dsvord.Rd000066400000000000000000000161471412660326600175030ustar00rootroot00000000000000\name{plot.dsvord} \alias{plot.dsvord} \alias{points.dsvord} \alias{plotid.dsvord} \alias{hilight.dsvord} \alias{chullord.dsvord} \alias{ellip.dsvord} \alias{surf.dsvord} \alias{density.dsvord} \alias{thull.dsvord} \alias{ellip} \title{Plotting Routines For LabDSV Ordinations} \description{A set of routines for plotting, highlighting points, or adding fitted surfaces to ordinations.} \usage{ \method{plot}{dsvord}(x, ax = 1, ay = 2, col = 1, title = "", pch = 1, \dots) \method{points}{dsvord}(x, which, ax = 1, ay = 2, col = 2, pch = 1, cex = 1, breaks=FALSE, \dots) \method{plotid}{dsvord}(ord, ids = seq(1:nrow(ord$points)), ax = 1, ay = 2, col = 1, \dots) \method{hilight}{dsvord}(ord, overlay, ax = 1, ay = 2, title="", cols=c(2,3,4,5,6,7), glyph=c(1,3,5), \dots) \method{chullord}{dsvord}(ord, overlay, ax = 1, ay = 2, cols=c(2,3,4,5,6,7), ltys = c(1,2,3), \dots) \method{ellip}{dsvord}(ord, overlay, ax = 1, ay = 2, cols=c(2,3,4,5,6,7), ltys = c(1,2,3), \dots) \method{surf}{dsvord}(ord, var, ax = 1, ay = 2, thinplate = TRUE, col = 2, labcex = 0.8, family = gaussian, gamma=1, grid=50, \dots) \method{thull}{dsvord}(ord,var,grain,ax=1,ay=2,col=2,grid=51,nlevels=5, levels=NULL,lty=1, numitr=100,\dots) \method{density}{dsvord}(ord, overlay, ax = 1, ay = 2, cols = c(2, 3, 4, 5, 6, 7), ltys = c(1, 2, 3), numitr, \dots) } \arguments{ \item{x}{an object of class \sQuote{dsvord}} \item{ax}{the dimension to use for the X axis} \item{ay}{the dimension to use for the Y axis} \item{title}{a title for the plot} \item{which}{a logical variable to specify points to be highlighted} \item{breaks}{a logical switch to control using variable glyph sizes in \sQuote{points}} \item{ord}{an object of class \sQuote{dsvord}} \item{overlay}{a factor or integer vector to hilight or distinguish} \item{cols}{the sequence of color indices to be used} \item{glyph}{the sequence of glyphs (pch) to be used} \item{ltys}{the sequence of line types to be used} \item{var}{a variable to be surfaced or tension hulled} \item{thinplate}{a logical variable to control the fitting routine: thinplate=TRUE (the default) fits a thinplate spline, thinplate=FALSE fits independent smooth splines. If you have too few data points you may have to specify thinplate=FALSE} \item{family}{controls the link function passed to \sQuote{gam}: one of \sQuote{gaussian}, \sQuote{binomial}, \sQuote{poisson} or \sQuote{nb}} \item{gamma}{controls the smoothness of the fit from \code{\link[mgcv]{gam}}} \item{grid}{the number of X and Y values to use in establishing a grid for use in surf} \item{grain}{the size of cell to use in calculating the tensioned hull} \item{nlevels}{the number of contours to draw in representing the tensioned hull} \item{lty}{the line type to use in drawing tensioned hull contours} \item{ids}{identifier labels for samples. Defaults to 1:n} \item{col}{color index for points or contours} \item{labcex}{size of contour interval labels} \item{pch}{plot character: glyph to plot} \item{cex}{character expansion factor: size of plotted characters} \item{numitr}{the number of iterations to use in estimating the probability of the observed density} \item{levels}{specific levels for contours in thull} \item{\dots}{arguments to pass to the plot function} } \details{ Function \sQuote{plot} produces a scatter plot of sample scores for the specified axes, erasing or over-plotting on the current graphic device. Axes dimensions are controlled to produce a graph with the correct aspect ratio. Functions \sQuote{points}, \sQuote{plotid}, and \sQuote{surf} add detail to an existing plot. The axes specified must match the underlying plot exactly. Function \sQuote{plotid} identifies and labels samples (optionally with values from a third vector) in the ordination, and requires interaction with the mouse: left button identifies, right button exits. Function \sQuote{points} is passed a logical vector to identify a set of samples by color of glyph. It can be used to identify a single set meeting almost any criterion that can be stated as a logical expression. Function \sQuote{hilight} is passed a factor vector or integer vector, and identifies factor values by color and glyph. Function \sQuote{chullord} is passed a factor vector or integer vector, and plots a convex hull around all points in each factor class. By specifying values for arguments \sQuote{cols} and \sQuote{ltys} it is possible to control the sequence of colors and linetypes of the convex hulls. Function \sQuote{ellip} is passed a factor vector or integer vector, and plots minimal volume ellipses containingg all points within a class. By specifying values for arguments \sQuote{cols} and \sQuote{ltys} it is possible to control the sequence of colors and linetypes of the ellipses. Function \sQuote{density} calculates the fraction of points within the convex hull that belong to the specified type. Function \sQuote{surf} calculates and plots fitted surfaces for logical or quantitative variables. The function employs the \code{\link[mgcv]{gam}} function to fit a variable to the ordination coordinates, and to predict the values at all grid points. The grid is established with the \sQuote{expand.grid} function, and the grid is then specified in a call to \sQuote{predict.gam}. The predicted values are trimmed to the the convex hull of the data, and the contours are fit by \sQuote{contour}. The default link function for fitting the GAMs is \sQuote{gaussian}, suitable for unbounded continuous variables. For logical variables you should specify \sQuote{family = binomial} to get a logistic GAM, and for integer counts you should specify \sQuote{family = poisson} to get a Poisson GAM or \sQuote{family='nb'} to get a negative binomial fit. Function \sQuote{thull} calculates a tensioned hull for a specific variable on the ordination. A tensioned hull is a minimum volume container. The grain size must be specified as a fraction of the units of the NMDS, with larger values generating smoother representations, and smaller numbers a more resolved container. \sQuote{thull} returns an invisible object of class \sQuote{thull} which has an associated plot function. Plotting the thull object produces a colored surface representation of the thull with optional contour lines. } \value{Function \sQuote{plotid} returns a vector of row numbers of identified plots} \note{ The contouring routine using \code{\link[mgcv]{predict.gam}} follows \code{\link[vegan]{ordisurf}} as suggested by Jari Oksanen. } \references{\url{http://ecology.msu.montana.edu/labdsv/R/labs/lab9/lab9.html}} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) data(brycesite) dis.bc <- dsvdis(bryceveg,'bray/curtis') nmds.1 <- nmds(dis.bc,5) plot(nmds.1) points(nmds.1,brycesite$elev>8000) surf(nmds.1,brycesite$elev) \dontrun{plotid(nmds.1,ids=row.names(bryceveg))} } \keyword{hplot} \keyword{aplot} \keyword{iplot} r-cran-labdsv-2.0-1/man/predict.Rd000066400000000000000000000043711412660326600166530ustar00rootroot00000000000000\name{predict} \alias{predict} \alias{predict.dsvord} \title{Predict species abundances in an ordination} \description{This function fits a Generalized Additive Model (GAM) for each species in a data.frame against an ordination.} \usage{ \method{predict}{dsvord}(object,comm,minocc=5,dims=1:ncol(object$points), family='nb',gamma=1,keep.models=FALSE,\dots) } \arguments{ \item{object}{an object of class dsvord} \item{comm}{a community matrix or data.frame with samples as rows and species as columns} \item{minocc}{the minimum number of occurrences to model a species} \item{dims}{which specific dimensions to include} \item{family}{the error distribution specifier for the GAM function; can be 'nb' for negative binomial, 'poisson' for the Poisson distribution, or 'binomial' for presence/absence data} \item{gamma}{the gamma parameter to control fitting GAM models} \item{keep.models}{a switch to control saving the individual GAM models} \item{\dots}{ancillary arguments to function predict} } \details{The predict function sequentially and independently fits a GAM model of each species distribution as a function of ordination coordinates, using the family and gamma specifiers supplied in the function call, or their defaults. The function fits two or three dimensional models; if the length of dims is greater than three the dimensions are truncated to the first three chosen.} \value{A list object with vector elements aic, dev.expl, adj.rsq, and matrix fitted. Optionally, if keep.models is TRUE, a list with all of the GAM models fitted. list element aic gives the model AICs for each species, dev.expl gives the deviance explained, adj.rsq gives the adjusted r-Squared, and fitted gives the expected abundance of each species in each sample unit.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\link[labdsv]{calibrate} for the complementary function that fits GAM models for environment variables} \examples{ data(bryceveg) dis.man <- dist(bryceveg,method="manhattan") demo.nmds <- nmds(dis.man,k=4) \dontrun{res <- predict(demo.nmds,bryceveg,minocc=10)} } \keyword{multivariate} r-cran-labdsv-2.0-1/man/raretaxa.Rd000066400000000000000000000023041412660326600170220ustar00rootroot00000000000000\name{raretaxa} \alias{raretaxa} \title{Identify Rare Taxa in a Data Set} \description{Identifies the distribution of rare taxa in a community data.frame, using a specified rareness threshold.} \usage{ raretaxa(comm,min=1,log=FALSE,type='b', panel='all') } \arguments{ \item{comm}{a community data.frame with samples as rows and species as columns} \item{min}{the minimum number of occurrences for a species to be considered rare} \item{log}{controls whether or not the Y axis on some graphs should be log scaled} \item{type}{the plot type. \sQuote{b} = both points and lines} \item{panel}{a switch to control which graphic is displayed. Can be either an integer from 1 to 3 or the word \sQuote{all}. } } \details{Rare species are an issue in ecological data sets. This function produces three graphs identifying (1) the distribution of rare species/plot, (2) the mean abundance (when present) of rare species, and (3) the total abundance or rare species/plot. } \value{Produces only graphs and returns no output} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) raretaxa(bryceveg,min=3,log=TRUE) } \keyword{hplot} r-cran-labdsv-2.0-1/man/reconcile.Rd000066400000000000000000000040141412660326600171560ustar00rootroot00000000000000\name{reconcile} \alias{reconcile} \title{Reconcile Community and Site Data.Frames} \description{reconcile takes two data frames (comm and site) and sorts both into the same order, and then deletes any rows unique to either of the two data.frames, achieving perfect correspondence of the two. } \usage{reconcile(comm,site,exlist)} \arguments{ \item{comm}{a community abundance data.frame with samples as rows and species as columns} \item{site}{a data.frame of site or environmental variables with samples as rows and variables as columns} \item{exlist}{a switch to control listing specific plots vs simply the number of plots} } \details{reconcile sorts each data.frame alphabetically by row.name, and then compares the list of row.names to identify sample plots common to both data.frames. Sample plots which occur in only one of the data.frames are deleted. } \value{A list object with two elements: comm and site, which are the sorted and reconciled data.frames. } \note{Package labdsv (and many other packages in ecological data analysis) require two data.frames to structure the data. One contains the abundance of species within samples with samples as rows and species as columns. This data.frame I refer to as the sQuote{comm} data.frame. The other data.frame contains all the environmental or site data collected at the same samples. This data.frame I refer to as the \sQuote{site} data.frame. Due to independent subsampling, sorting or editing of the data (often outside of R) the two data.frames often lose the necessary requirement of the identical number of rows, with the rows in exactly the same order. The reconcile() function is a simple remedy to correct this situation while maintaining the maximum amount of data.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) # returns a data.frame of taxon abundance data(brycesite) # returns a data.frame of site variables test <- reconcile(bryceveg,brycesite) } \keyword{manip} r-cran-labdsv-2.0-1/man/rndcomm.Rd000066400000000000000000000036031412660326600166550ustar00rootroot00000000000000\name{rndcomm} \alias{rndcomm} \title{Randomize a Community Data.Frame} \description{Permutes a vegetation (or other) data.frame to establish a basis for null model tests in vegetation ecology. } \usage{rndcomm(comm,replace=FALSE,species=FALSE,plots=FALSE)} \arguments{ \item{comm}{the vegetation (or other taxon) data.frame, samples as rows, species as columns} \item{replace}{a switch for permuting (if FALSE) or boostrapping (if TRUE)} \item{species}{a switch to control randomizing by species (if TRUE), maintaining species occurrence distributions} \item{plots}{a switch to control randomizing by samples (if TRUE), maintaining plot-level species richness} } \details{Permutes or bootstraps a vegetation data frame for input to \code{\link{dist}}, \code{\link[vegan]{vegdist}}, \code{\link[labdsv]{dsvdis}}, or other routines. Can randomize by columns (species=TRUE), samples (plots=TRUE), or fully (neither species nor plots = TRUE). } \value{a data.frame with samples as rows and species as columns of the same dimensions as entered.} \note{Randomizing vegetation often leads to unrealistic data distributions, but this function attempts to preserve either species occurrence distributions or plot-level species richness. It is probably worth examining the output of this function with \code{\link[labdsv]{abuocc}} to see its characteristics before engaging in extensive analysis.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) # returns a vegetation data.frame called bryceveg test <- rndcomm(bryceveg,species=TRUE) # preserves species abundance # distribution test2 <- rndcomm(bryceveg,plots=TRUE) # preserves plot-level # species richness} \keyword{datagen} r-cran-labdsv-2.0-1/man/rnddist.Rd000066400000000000000000000024411412660326600166640ustar00rootroot00000000000000\name{rnddist} \alias{rnddist} \title{Random Distance} \usage{rnddist(size, method='metric', sat = 1.0, upper=FALSE, diag=FALSE)} \description{Calculates a random distance matrix for use in null model analysis.} \arguments{ \item{size}{the number of items to calculate the distances for} \item{method}{the desired properties of the matrix. Must be either \sQuote{metric} or \sQuote{euclidean}} \item{sat}{a saturation coefficient to set an upper limit less than 1.0 that truncates maximum values to simulate a dissimilarity rather than a distance} \item{upper}{logical: whether to print the upper triangle (default=FALSE)} \item{diag}{logical: whether to print the diagonal (default=FALSE)} } \value{A dissimilarity object of class \sQuote{dist}} \details{Generates a matrix of \eqn{size^2} uniform random numbers and passes the matrix to \code{\link[labdsv]{metrify}} or \code{\link[labdsv]{euclidify}} to ensure the metric or euclidean properties of the distances. Values are normalized to a maximum of 1.0. } \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[labdsv]{metrify}}, \code{\link[labdsv]{euclidify}}} \examples{ x <- rnddist(100) pco.x <- pco(x) plot(pco.x) } \keyword{datagen} r-cran-labdsv-2.0-1/man/samptot.Rd000066400000000000000000000015071412660326600167060ustar00rootroot00000000000000\name{samptot} \alias{samptot} \title{Sample total standardization} \description{Standardizes a community data set to a sample total standardization.} \usage{samptot(comm) } \arguments{ \item{comm}{a community matrix (samples as rows, species as columns)} } \details{This function simply calculates row sums for the community matrix and then divides all values in that row by the appropriate sum so that all samples total to 1.0. } \value{A data frame of sample total standardized community data. } \references{\url{http://ecology.msu.montana.edu/labdsv/R}} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{ spcmax, abundtrans } \examples{ data(bryceveg) stveg <- samptot(bryceveg) apply(stveg,1,sum) } \keyword{standardization} r-cran-labdsv-2.0-1/man/spcdisc.Rd000066400000000000000000000016441412660326600166510ustar00rootroot00000000000000\name{spcdisc} \alias{spcdisc} \title{Species Discrimination Analysis} \description{ Calculates the degree to which species are restricted to certain classes of classified vegetation} \usage{spcdisc(x,sort=FALSE)} \arguments{ \item{x}{a classified vegetation table returned by \sQuote{const}, or \sQuote{importance}} \item{sort}{return in sorted order if TRUE} } \details{Calculates a Shannon-Weiner information statistic on the relative abundance of species within classes. } \value{ A vector of discrimination values. } \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[labdsv]{const}}, \code{\link[labdsv]{importance}}, \code{\link[labdsv]{indval}}, \code{\link[labdsv]{isamic}} } \examples{ data(bryceveg) data(brycesite) test <- const(bryceveg,brycesite$quad) spcdisc(test) } \keyword{multivariate} r-cran-labdsv-2.0-1/man/spcmax.Rd000066400000000000000000000016631412660326600165150ustar00rootroot00000000000000\name{spcmax} \alias{spcmax} \title{Species Maximum Standardization} \description{Standardizes a community data.frame by dividing the abundance of each species by the maximum value obtained for that species.} \usage{spcmax(comm) } \arguments{ \item{comm}{community data.frame (samples as rows, species as columns)} } \details{This is a simple standardization to make each species abundance scaled from 0 to 1, essentially relativizing abundance by species and making each species equal in the calculation of distance or dissimilarity or other analyses. } \value{A data.frame of standardized community data. } \references{\url{http://ecology.msu.montana.edu/labdsv/R}} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{samptot, abundtrans, hellinger } \examples{ data(bryceveg) smveg <- spcmax(bryceveg) apply(smveg,2,max) } \keyword{standardization} r-cran-labdsv-2.0-1/man/stepdist.Rd000066400000000000000000000021371412660326600170560ustar00rootroot00000000000000\name{stepdist} \alias{stepdist} \title{Step-Across Distance} \description{Solves for the shortest-path step-across distance for a given distance matrix} \usage{ stepdist(dis,alpha) } \arguments{ \item{dis}{a distance or dissimilarity object of class \sQuote{dist}} \item{alpha}{a threshold distance to establish the step-across} } \details{The function takes the dist object and converts all values >= alpha to 9999.9 and then solves for new distances by calculating the transitive closure of the triangle inequality.} \value{an object of class \sQuote{dist}} \note{The \sQuote{dsvdis} function includes a step-across function in the initial calculation of a distance or dissimilarity matrix. This function simply allows the conversion to take place at a later time, or on distance metrics that \sQuote{dsvdis} doesn't support.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) dis.bc <- dsvdis(bryceveg,'bray') dis.bcx <- stepdist(dis.bc,1.00) disana(dis.bcx) } \keyword{multivariate} r-cran-labdsv-2.0-1/man/thull.Rd000066400000000000000000000040471412660326600163510ustar00rootroot00000000000000\name{plot.thull} \alias{plot.thull} \alias{thull} \title{Plotting a Tensioned Hull} \description{A tensioned hull is a minimum volume container for specified elements of an ordination. A \sQuote{thull} object is returned as an invisible object by plotting a thull of an NMDS or PCO (or MFSO). Subsequently plotting the returned thull results in an \sQuote{image} of the representation. } \usage{ \method{plot}{thull}(x,col=rainbow(20),levels=NULL,cont=TRUE, xlab=x$xlab,ylab=x$ylab,main=x$main,\dots) } \arguments{ \item{x}{an object of class \sQuote{thull} from function \link[labdsv]{thull}} \item{col}{the color to use plotting the contours} \item{levels}{the specific levels desired for the contours} \item{cont}{a logical variable to control plotting contours on the image representation of the tensioned hull} \item{xlab}{the X axis label} \item{ylab}{the Y axis label} \item{main}{the main title} \item{\dots}{other graphics parameters} } \details{Tensioned hull analysis fits a minimum volume envelope to specific points in an ordination. A tensioned hull object is returned from function \code{\link[labdsv]{thull}} of a ordination of class \sQuote{dsvord}. This function plots the resulting tensioned hull as an image, with optional overlays of contours. } \value{ Produces a plot on the current graphic device. } \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \examples{ data(bryceveg) # returns a data.frame called bryceveg dis.bc <- dsvdis(bryceveg,'bray') # calculates a Bray-Curtis # dissimilarity matrix nmds.bc <- nmds(dis.bc) # calculates an NMDS ordination plot(nmds.bc) # plots the ordination on the current device demo.thull <- thull(nmds.bc,bryceveg$arcpat,0.25) # calculates # the tensioned hull representing the # distributtion of a species plot(demo.thull) # portrays the image version of the tensioned hull } \keyword{aplot} r-cran-labdsv-2.0-1/man/tsne.Rd000066400000000000000000000102571412660326600161720ustar00rootroot00000000000000\name{tsne} \alias{tsne} \alias{besttsne} \title{t-Distributed Stochastic Neighbor Embedding} \description{This function is a wrapper for the Rtsne function in the Rtsne package by Krijthe and van der Maaten. The purpose is to convert the output to class \sQuote{dsvord} to simplify plotting and additional graphical analysis as well as to provide a summary method.} \usage{ tsne(dis,k=2,perplexity=30,theta= 0.0,eta=200) besttsne(dis,k=2,itr=100,perplexity=30,theta=0.0,eta = 200) } \arguments{ \item{dis}{a dist object returned from \code{dist} or a full symmetric dissimilarity or distance matrix} \item{k}{the desired number of dimensions for the result} \item{perplexity}{neighborhood size parameter (should be less than (size(dis)-1) /3} \item{theta}{Speed/accuracy trade-off; set to 0.0 for exact TSNE, (0,0,0.5] for increasing speeed (default: 0.0)} \item{eta}{Learning rate} \item{itr}{number of random starts to find best result} } \details{The tsne function simply calls the \code{Rtsne} function of the Rtsne package with a specified distance/dissimilarity matrix rather than the community matrix. By convention, t-SNE employs a PCA on the input data matrix, and calculates distances among the first 50 eigenvectors of the PCA. Rtsne, however, allows the submission of a pre-calculated distance/dissimilarity matrix in place of the PCA. Given the long history of research into the use of PCA in ecological community analysis, tsne allows the simple use of any of a vast number of distance/dissimilarity matrices known to work better with ecological data. In addition, the tsne function converts the output to an object of class \sQuote{dsvord} to simplify plotting and analyses using the many functions defined for objects of class \sQuote{dsvord}. (see \code{\link[labdsv]{plot.dsvord}} for more details.) The \sQuote{besttsne} function runs one run from a PCO solution as the initial configuration and \sQuote{itr-1} number of random initial locations and returns the best result of the set.} \value{an object of class \sQuote{dsvord}, with components: \item{points}{the coordinates of samples along axes} \item{type}{\sQuote{t-SNE}} } \references{ van der Maaten, L. 2014. Accelerating t-SNE using Tree-Based Algorithms. Journal of Machine Learning Research, 15, p.3221-3245. van der Maaten, L.J.P. & Hinton, G.E., 2008. Visualizing High-Dimensional Data Using t-SNE. Journal of Machine Learning Research, 9, pp.2579-2605. Krijthe, J,H, 2015. Rtsne: T-Distributed Stochastic Neighbor Embedding using a Barnes-Hut Implementation, URL: https://github.com/jkrijthe/Rtsne \url{http://ecology.msu.montana.edu/labdsv/R} } \note{tsne is included as part of the LabDSV package to provide a consistent interface and utility for ecological community ordination methods. Other analyses included with the same interface at present include nonmetric multidimensional scaling (NMDS), principal components analysis (pca), and principal coordinates analysis (pco).} \author{ Jesse H. Krijthe for the original Rtsne R code, adapted from C++ code from Laurens van der Maaten. David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} for the adaptation to the LabDSV protocol. } \seealso{ \code{\link[Rtsne]{Rtsne}} for the original function \code{\link[labdsv]{plot.dsvord}} for the \sQuote{plot} method, the \sQuote{plotid} method to identify points with a mouse, the \sQuote{points} method to identify points meeting a logical condition, the \sQuote{hilight} method to color-code points according to a factor, the \sQuote{chullord} method to add convex hulls for a factor, or the the \sQuote{surf} method to add surface contours for continuous variables. } \examples{ data(bryceveg) data(brycesite) dis.man <- dist(bryceveg,method="manhattan") demo.tsne <- tsne(dis.man,k=2) plot(demo.tsne) points(demo.tsne,brycesite$elev>8000) plotid(demo.tsne,ids=row.names(brycesite)) } \keyword{multivariate} r-cran-labdsv-2.0-1/man/vegtab.Rd000066400000000000000000000035221412660326600164660ustar00rootroot00000000000000\name{vegtab} \alias{vegtab} \title{Vegetation Table} \description{Produces an ordered table of abundance of species in samples, sub-sampled by (an optional) classification of the samples } \usage{vegtab(comm,set,minval=1,pltord,spcord,pltlbl,trans=FALSE)} \arguments{ \item{comm}{a vegetation (or other taxon) data.frame } \item{set}{a logical variable specifying which samples to include} \item{minval}{a minimum abundance threshold to include in the table} \item{pltord}{a numeric vector specifying the order of rows in the output} \item{spcord}{a numeric vector specifying the order of columns in the output} \item{pltlbl}{a vector specifying an alternative row label (must be unique!)} \item{trans}{a logical variable to control transposing the table} } \details{Subsets a vegetation data.frame according to specified plots or minimum species abundances, optionally ordering in arbitrary order. } \value{a data.frame with specified rows, columns, and row.names} \references{\url{http://ecology.msu.montana.edu/labdsv/R/labs/lab3/lab3.html}} \note{Vegetation tables are a common tool in vegetation analysis. In recent years analysis has tended to become more quantitative, and less oriented to sorted tables, but even still presenting the results from these analyses often involves a sorted vegetation table.} \author{ David W. Roberts \email{droberts@montana.edu} \url{http://ecology.msu.montana.edu/droberts/droberts.html} } \seealso{\code{\link[vegan]{vegemite}}} \examples{ data(bryceveg) # returns a vegetation data frame called bryceveg data(brycesite) # returns an environmental data frame called # brycesite vegtab(bryceveg,minval=10,pltord=brycesite$elev) # produces a sorted table for species whose abundance sums # to 10, with rows in order of elevation. } \keyword{multivariate} r-cran-labdsv-2.0-1/src/000077500000000000000000000000001412660326600147415ustar00rootroot00000000000000r-cran-labdsv-2.0-1/src/dsvdis.f90000077500000000000000000000226761412660326600165750ustar00rootroot00000000000000 subroutine dsvdis(mat,weight,nrow,ncol,index,dis, & stepx,rowsum,colsum) !* passed double precision mat(nrow,ncol) double precision weight(ncol) integer nrow,ncol integer index double precision dis(nrow,nrow) double precision stepx double precision rowsum(nrow) double precision colsum(ncol) if (index .eq. 1) then call jaccrd(mat,weight,nrow,ncol,dis) else if (index .eq. 2) then call sorens(mat,weight,nrow,ncol,dis) else if (index .eq. 3) then call ochiai(mat,weight,nrow,ncol,dis) else if (index .eq. 4) then call ruziki(mat,weight,nrow,ncol,dis) else if (index .eq. 5) then call stemot(mat,weight,nrow,ncol,dis) else if (index .eq. 6) then call robrts(mat,weight,nrow,ncol,dis) else if (index .eq. 7) then call chisq(mat,weight,nrow,ncol,dis,rowsum,colsum) else if (index .eq. 8) then call hellin(mat,weight,nrow,ncol,dis,rowsum) endif if (stepx .gt. 0.0) then do i=1,nrow-1 do j=i+1,nrow if (dis(i,j) .ge. stepx) then dis(i,j) = 9999.9 dis(j,i) = 9999.9 endif end do end do do i=1,nrow flag = 0 do j=1,nrow do k=1,nrow do l=1,nrow if (i .eq. j .or. l .eq. k) cycle if (dis(j,k) - (dis(j,l)+dis(k,l)) .gt. 0.001) then dis(j,k) = dis(j,l)+dis(k,l) dis(k,j) = dis(j,l)+dis(k,l) flag = 1 endif end do end do end do if (flag .eq. 0) return end do endif end !* dsvdis ************ subroutine jaccrd ******************* subroutine jaccrd(mat,weight,nrow,ncol,dis) !* passed double precision mat(nrow,ncol) double precision weight(ncol) integer nrow,ncol double precision dis(nrow,nrow) !* local integer a,b do i=1,nrow-1 dis(i,i) = 0.0 do j=i+1,nrow a = 0 b = 0 do k=1,ncol if (mat(i,k) .gt. 0 .and. mat(j,k) .gt. 0) then a = a + weight(k) b = b + weight(k) else if (mat(i,k) .gt. 0 .or. mat(j,k) .gt. 0) then b = b + weight(k) endif end do if (a .eq. 0 .or. b .eq. 0) then dis(i,j) = 1.0 dis(j,i) = 1.0 else dis(i,j) = 1.0 - a/float(b) dis(j,i) = dis(i,j) endif end do end do dis(nrow,nrow) = 0.0 return end !* dsvdis ************ subroutine sorens ******************* subroutine sorens(mat,weight,nrow,ncol,dis) !* passed double precision mat(nrow,ncol) double precision weight(ncol) integer nrow,ncol double precision dis(nrow,nrow) !* local integer a,b do i=1,nrow-1 dis(i,i) = 0.0 do j=i+1,nrow a = 0 b = 0 do k=1,ncol if (mat(i,k) .gt. 0 .and. mat(j,k) .gt. 0) then a = a + 2 * weight(k) b = b + 2 * weight(k) else if (mat(i,k) .gt. 0 .or. mat(j,k) .gt. 0) then b = b + weight(k) endif end do if (a .eq. 0 .or. b .eq. 0) then dis(i,j) = 1.0 dis(j,i) = 1.0 else dis(i,j) = 1.0 - float(a)/float(b) dis(j,i) = dis(i,j) endif end do end do dis(nrow,nrow) = 0.0 return end !* dsvdis ************ subroutine ochiai ******************* subroutine ochiai(mat,weight,nrow,ncol,dis) !* passed double precision mat(nrow,ncol) double precision weight(ncol) integer nrow,ncol double precision dis(nrow,nrow) !* local integer a,b,c double precision temp do i=1,nrow-1 dis(i,i) = 0.0 do j=i+1,nrow a = 0 b = 0 c = 0 do k=1,ncol if (mat(i,k) .gt. 0 .and. mat(j,k) .gt. 0) then a = a + weight(k) else if (mat(i,k) .gt. 0 .and. mat(j,k) .eq. 0) then b = b + weight(k) else if (mat(i,k) .eq. 0 .and. mat(j,k) .gt. 0) then c = c + weight(k) endif end do temp = (a+b) * (a+c) if (temp .eq. 0) then dis(i,j) = 0.0 dis(j,i) = 0.0 else dis(i,j) = 1.0 - a / sqrt(temp) dis(j,i) = dis(i,j) endif end do end do dis(nrow,nrow) = 0.0 return end !* dsvdis ************ subroutine ruziki ******************* subroutine ruziki(mat,weight,nrow,ncol,dis) !* passed double precision mat(nrow,ncol) double precision weight(ncol) integer nrow,ncol double precision dis(nrow,nrow) !* local double precision numer,denom do i=1,nrow-1 dis(i,i) = 0.0 do j=i+1,nrow numer = 0.0 denom = 0.0 do k=1,ncol numer = numer + min(mat(i,k),mat(j,k)) * weight(k) denom = denom + max(mat(i,k),mat(j,k)) * weight(k) end do if (denom .eq. 0) then dis(i,j) = 0.0 dis(j,i) = 0.0 else dis(i,j) = 1.0 - numer / denom dis(j,i) = dis(i,j) endif end do end do dis(nrow,nrow) = 0.0 return end !* dsvdis ************ subroutine stemot ******************* subroutine stemot(mat,weight,nrow,ncol,dis) !* passed double precision mat(nrow,ncol) double precision weight(ncol) integer nrow,ncol double precision dis(nrow,nrow) !* local double precision numer,denom do i=1,nrow-1 dis(i,i) = 0.0 do j=i+1,nrow numer = 0.0 denom = 0.0 do k=1,ncol numer = numer + 2 * min(mat(i,k),mat(j,k)) * weight(k) denom = denom + weight(k) * (mat(i,k) + mat(j,k)) end do if (denom .eq. 0) then dis(i,j) = 0.0 dis(j,i) = 0.0 else dis(i,j) = 1.0 - numer / denom dis(j,i) = dis(i,j) endif end do end do dis(nrow,nrow) = 0.0 return end !* dsvdis ************ subroutine robrts******************* subroutine robrts(mat,weight,nrow,ncol,dis) !* passed double precision mat(nrow,ncol) double precision weight(ncol) integer nrow,ncol double precision dis(nrow,nrow) !* local double precision numer,denom do i=1,nrow-1 dis(i,i) = 0.0 do j=i+1,nrow numer = 0.0 denom = 0.0 do k=1,ncol if (mat(i,k) .eq. 0 .and. mat(j,k) .eq. 0) cycle numer = numer + (mat(i,k)+mat(j,k)) * weight(k) * & (min(mat(i,k),mat(j,k))/max(mat(i,k),mat(j,k))) denom = denom + weight(k) * (mat(i,k) + mat(j,k)) end do if (denom .eq. 0) then dis(i,j) = 0.0 dis(j,i) = 0.0 else dis(i,j) = 1.0 - numer / denom dis(j,i) = dis(i,j) endif end do end do dis(nrow,nrow) = 0.0 return end !* dsvdis ***************** subroutine chisq *************** subroutine chisq(mat,weight,nrow,ncol,dis,rowsum,colsum) !* passed double precision mat(nrow,ncol) double precision weight(ncol) integer nrow,ncol double precision dis(nrow,nrow) double precision rowsum(nrow) double precision colsum(ncol) !* local double precision totsum double precision temp do i=1,ncol colsum(i) = 0.0 end do do i=1,nrow rowsum(i) = 0.0 end do totsum = 0.0 do i=1,nrow do j=1,ncol rowsum(i) = rowsum(i) + mat(i,j) colsum(j) = colsum(j) + mat(i,j) totsum = totsum + mat(i,j) end do end do do i=1,nrow dis(i,i) = 0.0 do j=i+1,nrow dis(i,j) = 0.0 temp = 0.0 do k=1,ncol temp = temp + (1.0/colsum(k)) * weight(k) * & (mat(i,k)/rowsum(i) - mat(j,k)/rowsum(j))**2 end do dis(i,j) = sqrt(totsum) * sqrt(temp) dis(j,i) = dis(i,j) end do end do return end !* dsvdis ******************* subroutine hellin ********************** subroutine hellin(mat,weight,nrow,ncol,dis,rowsum) !* passed double precision mat(nrow,ncol) double precision weight(ncol) integer nrow,ncol double precision dis(nrow,nrow) double precision rowsum(nrow) !* local double precision totsum double precision temp do i=1,nrow rowsum(i) = 0.0 do j=1,ncol rowsum(i) = rowsum(i) + mat(i,j) end do end do do i=1,nrow do j=1,ncol mat(i,j) = sqrt(mat(i,j) /rowsum(i)) end do end do do i=1,nrow dis(i,i) = 0.0 do j=i+1,nrow dis(i,j) = 0.0 do k=1,ncol dis(i,j) = dis(i,j) + (mat(i,k) -mat(j,k))**2 end do dis(i,j) = sqrt(dis(i,j)) end do end do return end r-cran-labdsv-2.0-1/src/euclid.f90000077500000000000000000000012761412660326600165370ustar00rootroot00000000000000 subroutine euclid(dis,nrow) double precision dis(nrow,nrow) integer nrow integer flag do i=1,nrow flag = 0 do j=1,nrow do k=1,nrow do l=1,nrow if (j .eq. k .or. j .eq. l .or. k .eq. l) cycle if (dis(j,k)**2 - (dis(j,l)**2 + dis(k,l)**2) & .gt. 0.00001) then dis(j,k) = sqrt(dis(j,l)**2 + dis(k,l)**2) dis(k,j) = dis(j,k) flag = 1 endif end do end do end do if (flag .eq. 0) then return endif end do return end r-cran-labdsv-2.0-1/src/indval.f90000077500000000000000000000077121412660326600165500ustar00rootroot00000000000000 subroutine duleg(veg,numplt,numspc,class,clstab, & numcls,numitr,relfrq,relabu,indval,pval, & indcls,maxcls,tmpfrq,tmpabu,pclass,tclass,errcod) !* passed in double precision veg(numplt,numspc) integer numplt integer numspc integer class(numplt) integer clstab(numcls) integer numcls integer numitr !* passed back double precision relfrq(numspc,numcls) double precision relabu(numspc,numcls) double precision indval(numspc,numcls) double precision pval(numspc) double precision indcls(numspc) integer maxcls(numspc) integer errcod !* relfrq, relabu, and indval all initialized to zero by R !* scratch double precision tmpfrq(numcls) double precision tmpabu(numcls) integer pclass(numplt) integer tclass(numplt) !* local double precision tmpind double precision maxval double precision tmpcls double precision totveg double precision sumrab double precision tmpsum !*********************************** one ********************************* errcod = 0 do i=1,numspc totveg = 0 do j=1,numplt if (veg(j,i) .gt. 0) then totveg = totveg + veg(j,i) relabu(i,class(j)) = relabu(i,class(j)) + veg(j,i) relfrq(i,class(j)) = relfrq(i,class(j)) + 1 endif end do sumrab = 0.0 do j=1,numcls relabu(i,j) = relabu(i,j) / clstab(j) sumrab = sumrab + relabu(i,j) relfrq(i,j) = relfrq(i,j) / clstab(j) end do maxcls(i) = 0 maxval = 0 do j=1,numcls relabu(i,j) = relabu(i,j) / sumrab indval(i,j) = relabu(i,j) * relfrq(i,j) if (indval(i,j) .gt. maxval) then maxcls(i) = j maxval = indval(i,j) endif end do indcls(i) = maxval if (maxcls(i) .lt. 1 .or. maxcls(i) .gt. numcls) errcod = 1 end do !*********************************** two ************************************ do i=1,numspc if (maxcls(i) .lt. 1 .or. maxcls(i) .gt. numcls) then pval(i) = 0 cycle end if do j=1,numitr-1 tmpcls = 0 tmpind = 0 totveg = 0 maxval = 0 call permute(class,pclass,numplt,tclass) do k=1,numcls tmpfrq(k) = 0 tmpabu(k) = 0 end do do k=1,numplt if (veg(k,i) .gt. 0) then totveg = totveg + veg(k,i) tmpabu(pclass(k)) = tmpabu(pclass(k)) + veg(k,i) tmpfrq(pclass(k)) = tmpfrq(pclass(k)) + 1 endif end do tmpsum = 0.0 do k=1,numcls tmpabu(k) = tmpabu(k) / clstab(k) tmpsum = tmpsum + tmpabu(k) tmpfrq(k) = tmpfrq(k) / clstab(k) end do do k=1,numcls tmpabu(k) = tmpabu(k) / tmpsum tmpind = tmpabu(k) * tmpfrq(k) if (tmpind .gt. maxval) then maxval = tmpind endif end do if (maxval - indval(i,maxcls(i)) .gt. -0.0001) then pval(i) = pval(i) + 1 endif end do pval(i) = (pval(i)+1) / numitr end do return end !************************************************************ subroutine permute(class,pclass,numplt,tclass) integer class(numplt) integer pclass(numplt) integer numplt double precision unifrnd !* local integer tclass(numplt) integer pool call rndstart() pool = numplt do i=1,numplt tclass(i) = class(i) end do do i=1,numplt index = unifrnd()*pool+1 pclass(i) = tclass(index) tclass(index) = tclass(pool) pool = pool - 1 end do call rndend() return end r-cran-labdsv-2.0-1/src/ismetric.f90000066400000000000000000000011321412660326600170750ustar00rootroot00000000000000 subroutine ismetric(dis,nrow,flag) double precision dis(nrow,nrow) integer nrow integer flag flag = 0 do i=1,nrow do j=1,nrow do k=1,nrow do l=1,nrow if (j .eq. k .or. j .eq. l .or. k .eq. l) cycle if (dis(j,k) - (dis(j,l) + dis(k,l)) & .gt. 0.00001) then flag = 1 endif end do end do end do if (flag .eq. 1) then return endif end do return end r-cran-labdsv-2.0-1/src/metric.f90000077500000000000000000000012031412660326600165430ustar00rootroot00000000000000 subroutine metric(dis,nrow) double precision dis(nrow,nrow) integer nrow integer flag do i=1,nrow flag = 0 do j=1,nrow do k=1,nrow do l=1,nrow if (j .eq. k .or. j .eq. l .or. k .eq. l) cycle if (dis(j,k) - (dis(j,l) + dis(k,l)) .gt. 0.00001) then dis(j,k) = (dis(j,l) + dis(k,l)) dis(k,j) = dis(j,k) flag = 1 endif end do end do end do if (flag .eq. 0) then return endif end do return end r-cran-labdsv-2.0-1/src/orddist.f90000077500000000000000000000010111412660326600167250ustar00rootroot00000000000000 subroutine orddist(ord,nrow,ncol,ndim,size,dist) !* passed double precision ord(nrow,ncol) integer nrow,ncol,ndim,size double precision dist(size) !* local integer index double precision sum index = 0 do i=1,nrow-1 do j=i+1,nrow sum = 0.0 do k=1,ndim sum = sum + (ord(i,k)-ord(j,k))**2 end do index = index + 1 dist(index) = sqrt(sum) end do end do return end r-cran-labdsv-2.0-1/src/pip.f90000077500000000000000000000023011412660326600160500ustar00rootroot00000000000000 subroutine pip(x,y,z,polyx,polyy,lenvec,lenpol) !* passed double precision x(lenvec) double precision y(lenvec) double precision polyx(lenpol) double precision polyy(lenpol) integer z(lenvec) integer lenvec integer lenpol !* local double precision expect double precision xdiff,ydiff double precision pxmin,pxmax integer count do i=1,lenvec count = 0 do j=1,lenpol-1 if (polyy(j) .gt. y(i) .and. polyy(j+1) .lt. y(i) .or. & polyy(j) .lt. y(i) .and. polyy(j+1) .gt. y(i)) then pxmin = min(polyx(j),polyx(j+1)) pxmax = max(polyx(j),polyx(j+1)) if (pxmin .gt. x(i)) then count = count + 1 else if (pxmax .gt. x(i)) then xdiff = polyx(j+1) - polyx(j) ydiff = polyy(j+1) - polyy(j) r = (y(i) - polyy(j)) / ydiff expect = polyx(j) + r * xdiff if (x(i) .le. expect) then count = count + 1 endif endif endif end do z(i) = mod(count,2) end do return end r-cran-labdsv-2.0-1/src/random.c000066400000000000000000000002541412660326600163660ustar00rootroot00000000000000#include #include void F77_SUB(rndstart)(void){GetRNGstate();} void F77_SUB(rndend)(void){PutRNGstate();} double F77_SUB(unifrnd)(void){return runif(0,1);} r-cran-labdsv-2.0-1/src/stepdist.f90000066400000000000000000000011301412660326600171130ustar00rootroot00000000000000 subroutine stepdist(dis,nrow) double precision dis(nrow,nrow) integer nrow integer flag do i=1,nrow flag = 0 do j=1,nrow do k=1,nrow do l=1,nrow if (i .eq. j .or. l .eq. k) cycle if (dis(j,k) - (dis(j,l)+dis(k,l)) .gt. 0.0001) then dis(j,k) = dis(j,l)+dis(k,l) dis(k,j) = dis(j,l)+dis(k,l) flag = 1 endif end do end do end do if (flag .eq. 0) return end do return end r-cran-labdsv-2.0-1/src/thull.f90000066400000000000000000000020111412660326600164030ustar00rootroot00000000000000 subroutine thull(hull,gridx,gridy,grdcll,x,y,z,points,grain) integer grdcll integer points double precision hull(grdcll,grdcll) double precision gridx(grdcll) double precision gridy(grdcll) double precision x(points) double precision y(points) double precision z(points) double precision grain !* local double precision step double precision brkpt double precision tmp double precision dist step = grain/2 brkpt = grain/4 do i=1,grdcll do j=1,grdcll hull(i,j) = 0.0 do k=1,points dist = sqrt((gridx(i)-x(k))**2 + (gridy(j)-y(k))**2) if (dist .lt. brkpt) then tmp = 1 - 2 * (dist/step)**2 else if (dist .lt. step) then tmp = 2 * ((step-dist)/step)**2 else tmp = 0 endif hull(i,j) = max(hull(i,j),tmp*z(k)) end do end do end do return end