R/ordirgl.m.R

In zdealveindy/ordijuice: Unconstrained ordinations of vegetation data in JUICE program

ordirgl.m <-
function (object, display = "sites", choices = 1:3, type = "p", ax.col = "red", arr.col = "yellow", text, envfit.m, ...) 
{
    if (!require(rgl)) 
        stop("Requires package 'rgl'")
    x <- scores(object, display = display, choices = choices, 
        ...)
    if (ncol(x) < 3) 
        stop("3D display needs three dimensions...")
    if (type == "p") 
        points3d(x[, 1], x[, 2], x[, 3], ...)
    else if (type == "t") {
        if (missing(text)) 
            text <- rownames(x)
        texts3d(x[, 1], x[, 2], x[, 3], text, justify = "center", 
            ...)
    }
    lines3d(range(x[, 1]), c(0, 0), c(0, 0), col = ax.col)
    lines3d(c(0, 0), range(x[, 2]), c(0, 0), col = ax.col)
    lines3d(c(0, 0), c(0, 0), range(x[, 3]), col = ax.col)
    texts3d(1.1 * max(x[, 1]), 0, 0, colnames(x)[1], col = ax.col, adj = 0.5)
    texts3d(0, 1.1 * max(x[, 2]), 0, colnames(x)[2], col = ax.col, adj = 0.5)
    texts3d(0, 0, 1.1 * max(x[, 3]), colnames(x)[3], col = ax.col, adj = 0.5)
    if (!missing(envfit.m)) {
      for (column in seq (1, dim (as.matrix(envfit.m))[2]))
      {
       object.fit <- envfit (object, envfit.m[,column, drop = F], choices = 1:4)
       bp <- scores(object.fit, dis = "bp", choices = choices)
       cn <- scores(object.fit, dis = "cn", choices = choices)
       if (!is.null(cn) && !any(is.na(cn))) {
            bp <- bp[!(rownames(bp) %in% rownames(cn)), , drop = FALSE]
            texts3d(cn[, 1], cn[, 2], cn[, 3], rownames(cn), 
                col = arr.col[column], adj = 0.5)
            points3d(cn[, 1], cn[, 2], cn[, 3], size = 5, col = arr.col[column])
        }
        if (!is.null(bp) && nrow(bp) > 0) {
            mul <- c(range(x[, 1]), range(x[, 2]), range(x[, 
                3]))/c(range(bp[, 1]), range(bp[, 2]), range(bp[, 
                3]))
            mul <- mul[is.finite(mul) & mul > 0]
            mul <- min(mul)
            bp <- bp * mul
            for (i in 1:nrow(bp)) {
                lines3d(c(0, bp[i, 1]), c(0, bp[i, 2]), c(0, 
                  bp[i, 3]), col = arr.col [column])
                texts3d(1.1 * bp[i, 1], 1.1 * bp[i, 2], 1.1 * 
                  bp[i, 3], rownames(bp)[i], col = arr.col[column], adj = 0.5)
            }
        }
      }  
    }
    invisible()
}