Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
f808e5d
commit 0b2b2fc
Showing
24 changed files
with
858 additions
and
203 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,15 +1,23 @@ | ||
| 9d367256f8b7dc48cdfd12c8de0d6b35 *DESCRIPTION | ||
| 120e2ae84515c93fa9776b0cd1ea3cbc *NAMESPACE | ||
| 7b6992413e1b02be9f5dcbf212f5d29a *R/ordiplot3d.R | ||
| 9a5b2d59884e71926bf7af1503f5ab5f *R/ordirgl.R | ||
| c53e9402a842833d80a8df39c0adee6f *R/orglpoints.R | ||
| 56c4036863990ae0ec88a8d459540fd0 *R/orglsegments.R | ||
| 7ea9d2eb332869c020abe77e3ac6e416 *R/orglspider.R | ||
| 647cd6f0ffa48070eeaa095bb9057884 *R/orgltext.R | ||
| bdbed35a667499b2fbf49dff06c2dcfe *R/rgl.isomap.R | ||
| 8707a6885617ed42d0bbbe88cd5ddadd *R/rgl.renyiaccum.R | ||
| 4c6f76131670c92476cbc687e6b5c667 *README.md | ||
| 92f81687d7b3a939d4f40e2c10839ca7 *man/ordiplot3d.Rd | ||
| fdfc154857ab2871a72b941d6425295d *man/ordirgl.Rd | ||
| dde3bfef80a701f75593776d40d628cd *man/rgl.isomap.Rd | ||
| 49bd4c6b69e2542550ca4f8d3169f1c5 *man/rgl.renyiaccum.Rd | ||
| 315a86825274b86aba1660588cef1445 *DESCRIPTION | ||
| 79e886de38281600db0303a26fef8686 *NAMESPACE | ||
| 8eced0a7249ee650146c4f3f023d06bb *R/ordiplot3d.R | ||
| 595ac079e5e426eb25243e5aa19396c0 *R/ordirgl.R | ||
| 721ee6ae0171b0303d6861630c0eb47c *R/orditree3d.R | ||
| a4f19142d98a24a90cd5b983ffdbb5de *R/orglellipse.R | ||
| b3102bd4f6cbe0fac76a0912deb1f921 *R/orglpoints.R | ||
| d3a55195c5a8cbadc1e810a7d65e0236 *R/orglsegments.R | ||
| 5e44553fb76724c312a5cfb7de003173 *R/orglspantree.R | ||
| 81c883d382cd2a2c83c2576942dc45ef *R/orglspider.R | ||
| 1935297d832809c62f49867ce7790df1 *R/orgltext.R | ||
| e5e09128689042f0e9678fc8857cff4c *R/rgl.isomap.R | ||
| 2b5fcb826c1cfa6f02aa2dfb21fc95ce *R/rgl.renyiaccum.R | ||
| 459f34914f0416645498dc434a961e94 *R/scores.ordiplot3d.R | ||
| a1d18f38384f36f91d69897baee4f480 *build/partial.rdb | ||
| 5da018579119cd430246077cfa339e50 *inst/NEWS.md | ||
| f395748ce7a81a29e7b9488a537fcaf8 *inst/README.md | ||
| 4ca9d525d6e0b33d04e86d9f0055d5af *man/ordiplot3d.Rd | ||
| 1d5d762c959a9033b5b929f4baef9beb *man/ordirgl.Rd | ||
| 85a6a7daa672199f8cb3734a49d97ab4 *man/orditree3d.Rd | ||
| 2f969c52a2d612d2b6b91b01b053d946 *man/rgl.isomap.Rd | ||
| 4f0e7d9bb2c76809aca4fd4da03f0bbb *man/rgl.renyiaccum.Rd | ||
| ff9de292e39ca70793f602654582cc37 *man/vegan3d-package.Rd |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,111 @@ | ||
| `orditree3d` <- | ||
| function(ord, cluster, prune = 0, display = "sites", choices = c(1,2), | ||
| col = "blue", text, type = "p", ...) | ||
| { | ||
| ## ordination scores in 2d: leaves | ||
| ord <- scores(ord, choices = choices, display = display, ...) | ||
| ## pad z-axis to zeros | ||
| if (ncol(ord) != 2) | ||
| stop(gettextf("needs plane in 2d, got %d", ncol(ord))) | ||
| ord <- cbind(ord, 0) | ||
| if (!inherits(cluster, "hclust")) # works only with hclust | ||
| cluster <- as.hclust(cluster) # or object that can be converted | ||
| ## get coordinates of internal nodes with vegan:::reorder.hclust | ||
| x <- reorder(cluster, ord[,1], agglo.FUN = "mean")$value | ||
| y <- reorder(cluster, ord[,2], agglo.FUN = "mean")$value | ||
| xyz <- cbind(x, y, "height" = cluster$height) | ||
| ## make line colour the mean of point colours | ||
| if (is.factor(col)) | ||
| col <- as.numeric(col) | ||
| col <- rep(col, length = nrow(ord)) | ||
| lcol <- col2rgb(col)/255 | ||
| r <- reorder(cluster, lcol[1,], agglo.FUN = "mean")$value | ||
| g <- reorder(cluster, lcol[2,], agglo.FUN = "mean")$value | ||
| b <- reorder(cluster, lcol[3,], agglo.FUN = "mean")$value | ||
| lcol <- rgb(r, g, b) | ||
| ## set up frame | ||
| pl <- scatterplot3d(rbind(ord, xyz), type = "n") | ||
| if (type == "p") | ||
| pl$points3d(ord, col = col, ...) | ||
| else if (type == "t") { | ||
| if (missing(text)) | ||
| text <- rownames(ord) | ||
| text(pl$xyz.convert(ord), labels = text, col = col, ...) | ||
| } | ||
| ## project leaves and nodes to 2d | ||
| leaf <- pl$xyz.convert(ord) | ||
| node <- pl$xyz.convert(xyz) | ||
| ## two lines from each node down, either to a leaf or to an | ||
| ## internal node | ||
| merge <- cluster$merge | ||
| for (i in seq_len(nrow(merge) - prune)) | ||
| for (j in 1:2) | ||
| if (merge[i,j] < 0) | ||
| segments(node$x[i], node$y[i], | ||
| leaf$x[-merge[i,j]], leaf$y[-merge[i,j]], | ||
| col = col[-merge[i,j]], ...) | ||
| else | ||
| segments(node$x[i], node$y[i], | ||
| node$x[merge[i,j]], node$y[merge[i,j]], | ||
| col = lcol[merge[i,j]], ...) | ||
|
|
||
| pl$internal <- do.call(cbind, node) | ||
| pl$points <- do.call(cbind, leaf) | ||
| pl$col.internal <- as.matrix(lcol) | ||
| pl$col.points <- as.matrix(col) | ||
| class(pl) <- c("orditree3d", "ordiplot3d") | ||
| invisible(pl) | ||
| } | ||
|
|
||
| `ordirgltree` <- | ||
| function(ord, cluster, prune = 0, display = "sites", choices = c(1, 2), | ||
| col = "blue", text, type = "p", ...) | ||
| { | ||
| p <- cbind(scores(ord, choices = choices, display = display, ...), 0) | ||
| if (ncol(p) != 3) | ||
| stop(gettextf("needs 2D ordination plane, but got %d", ncol(p)-1)) | ||
| if (!inherits(cluster, "hclust")) | ||
| cluster <- as.hclust(cluster) | ||
| x <- reorder(cluster, p[,1], agglo.FUN = "mean")$value | ||
| y <- reorder(cluster, p[,2], agglo.FUN = "mean")$value | ||
| z <- cluster$height | ||
| merge <- cluster$merge | ||
| ## adjust height | ||
| z <- mean(c(diff(range(x)), diff(range(y))))/diff(range(z)) * z | ||
| ## make line colour the mean of point colours | ||
| if (is.factor(col)) | ||
| col <- as.numeric(col) | ||
| col <- rep(col, length = nrow(p)) | ||
| lcol <- col2rgb(col)/255 | ||
| r <- reorder(cluster, lcol[1,], agglo.FUN = "mean")$value | ||
| g <- reorder(cluster, lcol[2,], agglo.FUN = "mean")$value | ||
| b <- reorder(cluster, lcol[3,], agglo.FUN = "mean")$value | ||
| lcol <- rgb(r, g, b) | ||
| ## plot | ||
| rgl.clear() | ||
| if (type == "p") | ||
| rgl.points(p, col = col, ...) | ||
| else if (type == "t") { | ||
| if (missing(text)) | ||
| text <- rownames(p) | ||
| rgl.texts(p, text = text, col = col, ...) | ||
| } | ||
| for (i in seq_len(nrow(merge) - prune)) | ||
| for(j in 1:2) | ||
| if (merge[i,j] < 0) | ||
| rgl.lines(c(x[i], p[-merge[i,j],1]), | ||
| c(y[i], p[-merge[i,j],2]), | ||
| c(z[i], 0), | ||
| col = col[-merge[i,j]], ...) | ||
| else | ||
| rgl.lines(c(x[i], x[merge[i,j]]), | ||
| c(y[i], y[merge[i,j]]), | ||
| c(z[i], z[merge[i,j]]), | ||
| col = lcol[merge[i,j]], ...) | ||
| ## add a short nipple so that you see the root (if you draw the root) | ||
| if (prune <= 0) { | ||
| n <- nrow(merge) | ||
| rgl.lines(c(x[n],x[n]), c(y[n],y[n]), c(z[n],1.05*z[n]), | ||
| col = lcol[n], ...) | ||
| } | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,38 @@ | ||
| `orglellipse` <- | ||
| function(object, groups, display = "sites", w = weights(object, display), | ||
| kind = c("sd", "se"), conf, choices = 1:3, alpha = 0.3, | ||
| col = "red", ...) | ||
| { | ||
| weights.default <- function(object, ...) NULL | ||
| kind <- match.arg(kind) | ||
| x <- scores(object, display = display, choices = choices, ...) | ||
| groups <- as.factor(groups) | ||
| ## evaluate weights | ||
| w <- eval(w) | ||
| if (is.null(w) || length(w) == 1) | ||
| w <- rep(1, nrow(x)) | ||
| ## covariance and centres as lists | ||
| Cov <- list() | ||
| for (g in levels(groups)) | ||
| Cov[[g]] <- cov.wt(x[groups == g,, drop = FALSE], | ||
| wt = w[groups == g]) | ||
| if (kind == "se") | ||
| for(i in seq_len(length(Cov))) | ||
| Cov[[i]]$cov <- Cov[[i]]$cov * sum(Cov[[i]]$wt^2) | ||
| ## recycle colours | ||
| if (is.factor(col)) | ||
| col <- as.numeric(col) | ||
| col <- rep(col, length = length(Cov)) | ||
| ## rgl::ellipse3d defaults to confidence envelopes, but we want to | ||
| ## default to sd/se and only use confidence ellipses if conf is | ||
| ## given | ||
| if (missing(conf)) | ||
| t <- 1 | ||
| else | ||
| t <- sqrt(qchisq(conf, 3)) | ||
| ## graph | ||
| for(i in seq_len(length(Cov))) | ||
| if (Cov[[i]]$n.obs > 3) | ||
| plot3d(ellipse3d(Cov[[i]]$cov, centre = Cov[[i]]$center, t = t), | ||
| add = TRUE, alpha = alpha, col = col[i], ...) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,8 +1,20 @@ | ||
| "orglpoints" <- | ||
| function (object, display = "sites", choices = 1:3, ...) | ||
| `orglpoints` <- | ||
| function (object, display = "sites", choices = 1:3, radius, col = "black", | ||
| ...) | ||
| { | ||
| x <- scores(object, display = display, choices = choices, ...) | ||
| rgl.points(x[,1], x[,2], x[,3], ...) | ||
| ## default radius | ||
| if (missing(radius)) | ||
| radius <- max(apply(x, 2, function(z) diff(range(z))))/100 | ||
| ## honor cex | ||
| cex <- match.call(expand.dots = FALSE)$...$cex | ||
| if (!is.null(cex)) | ||
| radius <- cex * radius | ||
| ## make a color vector, handle factors | ||
| if (is.factor(col)) | ||
| col <- as.numeric(col) | ||
| col <- rep(col, length = nrow(x)) | ||
| rgl.spheres(x, radius = radius, col = col, ...) | ||
| invisible() | ||
| } | ||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.