plot legend

[lizandropf]

I was trying to change symbols and colors for points and found out that the legend option of function plotTangentSpace is not working (at least on mac). Thus, I modified some parameters to include legends and modify some other plotting parameters in the function.

Are these modifications fine?

The modified version of the function can be used as usual with examples in the package (it only considers factors for groups, colors and symbols).

An easy way to change colors of points

default color parameters

plotTangentSpace(Y.gpa$coords, groups = gp)

##automatic colors using function rainbow
plotTangentSpace(Y.gpa$coords, groups = gp, col = rainbow(length(levels(gp)))[as.numeric(gp)])

user selected colors

plotTangentSpace(Y.gpa$coords, groups = gp, col = c("blue", "gray", "red", "yellow")[as.numeric(gp)])

default color with modified point symbols

plotTangentSpace(Y.gpa$coords, groups = gp, pch = c(21,22,23,24)[as.numeric(gp)])

changing points symbols

plotTangentSpace(Y.gpa$coords, groups = gp, col = c("blue", "gray", "red", "yellow")[as.numeric(gp)], pch = c(1,2,5,6)[as.numeric(gp)])

adding legend

plotTangentSpace(Y.gpa$coords, groups = gp, col = c("blue", "gray", "red", "yellow")[as.numeric(gp)], pch = c(1,2,5,6)[as.numeric(gp)], legend =TRUE)

##changing legend position
plotTangentSpace(Y.gpa$coords, groups = gp, col = c("blue", "gray", "red", "yellow")[as.numeric(gp)], pch = c(1,2,5,6)[as.numeric(gp)], legend =TRUE, leg.pos = "right")

changing legend position using selection

plotTangentSpace(Y.gpa$coords, groups = gp, col = c("blue", "gray", "red", "yellow")[as.numeric(gp)], pch = c(1,2,5,6)[as.numeric(gp)], legend =TRUE, leg.pos = locator (1))

##function with modified parameters

plotTangentSpace <- function (A, axis1 = 1, axis2 = 2, warpgrids = TRUE, mesh = NULL, label = NULL, groups = NULL, legend = FALSE, col = groups, pch = 21, leg.pos = "topright", ...) { if (length(dim(A)) != 3) { stop("Data matrix not a 3D array (see 'arrayspecs').") } if (any(is.na(A)) == T) { stop("Data matrix contains missing values. Estimate these first (see 'estimate.missing').") } dots <- list(...) retx <- dots$retx if (is.null(retx)) retx <- TRUE scale. <- dots$scale. if (is.null(scale.)) scale. <- FALSE center <- dots$center if (is.null(center)) center <- TRUE tol <- dots$tol k <- dim(A)[2] p <- dim(A)[1] n <- dim(A)[3] ref <- mshape(A) x <- two.d.array(A) if (is.null(tol)) { d <- prcomp(x)$sdev^2 cd <- cumsum(d)/sum(d) cd <- length(which(cd < 1)) if (length(cd) < length(d)) cd <- cd + 1 if (length(d) > 2) tol <- max(c(d[cd]/d[1], 0.005)) else tol <- 0 } pc.res <- prcomp(x, center = center, scale. = scale., retx = retx, tol = tol) pcdata <- pc.res$x if (warpgrids == FALSE) { if (legend == TRUE) { layout(t(matrix(c(1, 1, 2, 1, 1, 1, 1, 1, 1), 3, 3))) } plot(pcdata[, axis1], pcdata[, axis2], asp = 1, bg = "black", cex = 2, xlab = paste("PC ", axis1), ylab = paste("PC ", axis2), pch = pch, ...) if (!is.null(groups)) { points(pcdata[, axis1], pcdata[, axis2], bg = col, cex = 2, pch = pch, col = col, ...) if (legend == TRUE) { legend(x = leg.pos, legend = unique(groups), col = unique(col), pt.bg = unique(col), bty = "n", pch = unique(pch), cex = 1.5, ...) } } segments(min(pcdata[, axis1]), 0, max(pcdata[, axis1]), 0, lty = 2, lwd = 1) segments(0, min(pcdata[, axis2]), 0, max(pcdata[, axis2]), lty = 2, lwd = 1) if (length(label != 0)) { if (isTRUE(label)) { text(pcdata[, axis1], pcdata[, axis2], seq(1, n), adj = c(-0.7, -0.7)) } else { text(pcdata[, axis1], pcdata[, axis2], label, adj = c(-0.1, -0.7)) } } } shapes <- shape.names <- NULL for (i in 1:ncol(pcdata)) { pcaxis.min <- min(pcdata[, i]) pcaxis.max <- max(pcdata[, i]) pc.min <- pc.max <- rep(0, dim(pcdata)[2]) pc.min[i] <- pcaxis.min pc.max[i] <- pcaxis.max pc.min <- as.matrix(pc.min %*% (t(pc.res$rotation))) + as.vector(t(ref)) pc.max <- as.matrix(pc.max %*% (t(pc.res$rotation))) + as.vector(t(ref)) shapes <- rbind(shapes, pc.min, pc.max) shape.names <- c(shape.names, paste("PC", i, "min", sep = ""), paste("PC", i, "max", sep = "")) } shapes <- arrayspecs(shapes, p, k) shapes <- lapply(seq(dim(shapes)[3]), function(x) shapes[, , x]) names(shapes) <- shape.names if (warpgrids == TRUE) { if (k == 2) { layout(t(matrix(c(2, 1, 4, 1, 1, 1, 1, 1, 3), 3, 3))) } plot(pcdata[, axis1], pcdata[, axis2], asp = 1, bg = "black", cex = 2, xlab = paste("PC ", axis1), ylab = paste("PC ", axis2), pch = pch, ...) if (!is.null(groups)) { points(pcdata[, axis1], pcdata[, axis2], bg = col, cex = 2, pch = pch, col = col, ...) if (legend ==TRUE){ legend(x = leg.pos, legend = unique(groups), col = unique(col), pt.bg = unique(col), bty = "n", pch = unique(pch), cex = 1.5, ...) } } segments(min(pcdata[, axis1]), 0, max(pcdata[, axis1]), 0, lty = 2, lwd = 1) segments(0, min(pcdata[, axis2]), 0, max(pcdata[, axis2]), lty = 2, lwd = 1) if (length(label != 0)) { if (isTRUE(label)) { text(pcdata[, axis1], pcdata[, axis2], seq(1, n), adj = c(-0.7, -0.7)) } else { text(pcdata[, axis1], pcdata[, axis2], label, adj = c(-0.1, -0.1)) } } shape.min <- shapes[[which(names(shapes) == paste("PC", axis1, "min", sep = ""))]] shape.max <- shapes[[which(names(shapes) == paste("PC", axis1, "max", sep = ""))]] if (k == 2) { arrows(min(pcdata[, axis1]), (0.7 * max(pcdata[, axis2])), min(pcdata[, axis1]), 0, length = 0.1, lwd = 2) arrows(max(pcdata[, axis1]), (0.7 * min(pcdata[, axis2])), max(pcdata[, axis1]), 0, length = 0.1, lwd = 2) tps(ref, shape.min, 20) tps(ref, shape.max, 20) } if (k == 3) { if (is.null(mesh) == TRUE) { open3d() mfrow3d(1, 2) plot3d(shape.min, type = "s", col = "gray", main = paste("PC ", axis1, " negative"), size = 1.25, aspect = FALSE, xlab = "", ylab = "", zlab = "", box = FALSE, axes = FALSE) plot3d(shape.max, type = "s", col = "gray", main = paste("PC ", axis1, " positive"), size = 1.25, aspect = FALSE, xlab = "", ylab = "", zlab = "", box = FALSE, axes = FALSE) } if (is.null(mesh) == FALSE) { open3d() mfrow3d(1, 2) cat(paste("\nWarping mesh to negative end of axis ", axis1, "\n", sep = "")) plotRefToTarget(ref, shape.min, mesh, method = "surface") title3d(main = paste("PC ", axis1, " negative")) next3d() cat(paste("\nWarping mesh to positive end of axis ", axis1, "\n", sep = "")) plotRefToTarget(ref, shape.max, mesh, method = "surface") title3d(main = paste("PC ", axis1, " positive")) } } layout(1) } out <- list(pc.summary = summary(pc.res), pc.scores = pcdata, pc.shapes = shapes, sdev = pc.res$sdev, rotation = pc.res$rotation) class(out) = "plotTangentSpace" out }

[mlcollyer]

Thank you for your suggestions. Indeed, plotTangentSpace has limited capabilities, is a legacy function, and one we have slated for removal once we finish developing some new functions (currently on our Develop branch). The new functions will utilize S3 generic plotting capabilities, allowing for legends of any design to be added to plots. We hope to update geomorph soon, once we have had a chance to test all of the functions we are updating/adding/changing. In the interim, please feel free to modify the code, locally, if you prefer. However, we will not update this particular function, as it is not consistent with the updates we have already made on our Develop branch. You are also free to use our Develop branch (sort of a beta version), but please realize we cannot guarantee functionality for all functions. Cheers!

…

On Oct 22, 2018, at 4:15 PM, lizandropf ***@***.***> wrote: I was trying to change symbols and colors for points and found out that the legend option of function plotTangentSpace is not working (at least on mac). Thus, I modified some parameters to include legends and modify some other plotting parameters in the function. Are these modifications fine? The modified version of the function can be used as usual with examples in the package (it only considers factors for groups, colors and symbols). An easy way to change colors of points default color parameters plotTangentSpace(Y.gpa$coords, groups = gp) ##automatic colors using function rainbow plotTangentSpace(Y.gpa$coords, groups = gp, col = rainbow(length(levels(gp)))[as.numeric(gp)]) user selected colors plotTangentSpace(Y.gpa$coords, groups = gp, col = c("blue", "gray", "red", "yellow")[as.numeric(gp)]) default color with modified point symbols plotTangentSpace(Y.gpa$coords, groups = gp, pch = c(21,22,23,24)[as.numeric(gp)]) changing points symbols plotTangentSpace(Y.gpa$coords, groups = gp, col = c("blue", "gray", "red", "yellow")[as.numeric(gp)], pch = c(1,2,5,6)[as.numeric(gp)]) adding legend plotTangentSpace(Y.gpa$coords, groups = gp, col = c("blue", "gray", "red", "yellow")[as.numeric(gp)], pch = c(1,2,5,6)[as.numeric(gp)], legend =TRUE) ##changing legend position plotTangentSpace(Y.gpa$coords, groups = gp, col = c("blue", "gray", "red", "yellow")[as.numeric(gp)], pch = c(1,2,5,6)[as.numeric(gp)], legend =TRUE, leg.pos = "right") changing legend position using selection plotTangentSpace(Y.gpa$coords, groups = gp, col = c("blue", "gray", "red", "yellow")[as.numeric(gp)], pch = c(1,2,5,6)[as.numeric(gp)], legend =TRUE, leg.pos = locator (1)) ##function with modified parameters plotTangentSpace <- function (A, axis1 = 1, axis2 = 2, warpgrids = TRUE, mesh = NULL, label = NULL, groups = NULL, legend = FALSE, col = groups, pch = 21, leg.pos = "topright", ...) { if (length(dim(A)) != 3) { stop("Data matrix not a 3D array (see 'arrayspecs').") } if (any(is.na(A)) == T) { stop("Data matrix contains missing values. Estimate these first (see 'estimate.missing').") } dots <- list(...) retx <- dots$retx if (is.null(retx)) retx <- TRUE scale. <- dots$scale. if (is.null(scale.)) scale. <- FALSE center <- dots$center if (is.null(center)) center <- TRUE tol <- dots$tol k <- dim(A)[2] p <- dim(A)[1] n <- dim(A)[3] ref <- mshape(A) x <- two.d.array(A) if (is.null(tol)) { d <- prcomp(x)$sdev^2 cd <- cumsum(d)/sum(d) cd <- length(which(cd < 1)) if (length(cd) < length(d)) cd <- cd + 1 if (length(d) > 2) tol <- max(c(d[cd]/d[1], 0.005)) else tol <- 0 } pc.res <- prcomp(x, center = center, scale. = scale., retx = retx, tol = tol) pcdata <- pc.res$x if (warpgrids == FALSE) { if (legend == TRUE) { layout(t(matrix(c(1, 1, 2, 1, 1, 1, 1, 1, 1), 3, 3))) } plot(pcdata[, axis1], pcdata[, axis2], asp = 1, bg = "black", cex = 2, xlab = paste("PC ", axis1), ylab = paste("PC ", axis2), pch = pch, ...) if (!is.null(groups)) { points(pcdata[, axis1], pcdata[, axis2], bg = col, cex = 2, pch = pch, col = col, ...) if (legend == TRUE) { legend(x = leg.pos, legend = unique(groups), col = unique(col), pt.bg = unique(col), bty = "n", pch = unique(pch), cex = 1.5, ...) } } segments(min(pcdata[, axis1]), 0, max(pcdata[, axis1]), 0, lty = 2, lwd = 1) segments(0, min(pcdata[, axis2]), 0, max(pcdata[, axis2]), lty = 2, lwd = 1) if (length(label != 0)) { if (isTRUE(label)) { text(pcdata[, axis1], pcdata[, axis2], seq(1, n), adj = c(-0.7, -0.7)) } else { text(pcdata[, axis1], pcdata[, axis2], label, adj = c(-0.1, -0.7)) } } } shapes <- shape.names <- NULL for (i in 1:ncol(pcdata)) { pcaxis.min <- min(pcdata[, i]) pcaxis.max <- max(pcdata[, i]) pc.min <- pc.max <- rep(0, dim(pcdata)[2]) pc.min[i] <- pcaxis.min pc.max[i] <- pcaxis.max pc.min <- as.matrix(pc.min %*% (t(pc.res$rotation))) + as.vector(t(ref)) pc.max <- as.matrix(pc.max %*% (t(pc.res$rotation))) + as.vector(t(ref)) shapes <- rbind(shapes, pc.min, pc.max) shape.names <- c(shape.names, paste("PC", i, "min", sep = ""), paste("PC", i, "max", sep = "")) } shapes <- arrayspecs(shapes, p, k) shapes <- lapply(seq(dim(shapes)[3]), function(x) shapes[, , x]) names(shapes) <- shape.names if (warpgrids == TRUE) { if (k == 2) { layout(t(matrix(c(2, 1, 4, 1, 1, 1, 1, 1, 3), 3, 3))) } plot(pcdata[, axis1], pcdata[, axis2], asp = 1, bg = "black", cex = 2, xlab = paste("PC ", axis1), ylab = paste("PC ", axis2), pch = pch, ...) if (!is.null(groups)) { points(pcdata[, axis1], pcdata[, axis2], bg = col, cex = 2, pch = pch, col = col, ...) if (legend ==TRUE){ legend(x = leg.pos, legend = unique(groups), col = unique(col), pt.bg = unique(col), bty = "n", pch = unique(pch), cex = 1.5, ...) } } segments(min(pcdata[, axis1]), 0, max(pcdata[, axis1]), 0, lty = 2, lwd = 1) segments(0, min(pcdata[, axis2]), 0, max(pcdata[, axis2]), lty = 2, lwd = 1) if (length(label != 0)) { if (isTRUE(label)) { text(pcdata[, axis1], pcdata[, axis2], seq(1, n), adj = c(-0.7, -0.7)) } else { text(pcdata[, axis1], pcdata[, axis2], label, adj = c(-0.1, -0.1)) } } shape.min <- shapes[[which(names(shapes) == paste("PC", axis1, "min", sep = ""))]] shape.max <- shapes[[which(names(shapes) == paste("PC", axis1, "max", sep = ""))]] if (k == 2) { arrows(min(pcdata[, axis1]), (0.7 * max(pcdata[, axis2])), min(pcdata[, axis1]), 0, length = 0.1, lwd = 2) arrows(max(pcdata[, axis1]), (0.7 * min(pcdata[, axis2])), max(pcdata[, axis1]), 0, length = 0.1, lwd = 2) tps(ref, shape.min, 20) tps(ref, shape.max, 20) } if (k == 3) { if (is.null(mesh) == TRUE) { open3d() mfrow3d(1, 2) plot3d(shape.min, type = "s", col = "gray", main = paste("PC ", axis1, " negative"), size = 1.25, aspect = FALSE, xlab = "", ylab = "", zlab = "", box = FALSE, axes = FALSE) plot3d(shape.max, type = "s", col = "gray", main = paste("PC ", axis1, " positive"), size = 1.25, aspect = FALSE, xlab = "", ylab = "", zlab = "", box = FALSE, axes = FALSE) } if (is.null(mesh) == FALSE) { open3d() mfrow3d(1, 2) cat(paste("\nWarping mesh to negative end of axis ", axis1, "\n", sep = "")) plotRefToTarget(ref, shape.min, mesh, method = "surface") title3d(main = paste("PC ", axis1, " negative")) next3d() cat(paste("\nWarping mesh to positive end of axis ", axis1, "\n", sep = "")) plotRefToTarget(ref, shape.max, mesh, method = "surface") title3d(main = paste("PC ", axis1, " positive")) } } layout(1) } out <- list(pc.summary = summary(pc.res), pc.scores = pcdata, pc.shapes = shapes, sdev = pc.res$sdev, rotation = pc.res$rotation) class(out) = "plotTangentSpace" out } — You are receiving this because you are subscribed to this thread. Reply to this email directly, view it on GitHub <#21>, or mute the thread <https://github.com/notifications/unsubscribe-auth/AGjacvbiDoKMU8eeh585w9Bqaq5RqAlHks5unidPgaJpZM4X0GWV>.