Nothing
btShapes <- function(scores, vectors, fcn, row.names, pcs = 1:2, n = c(3,4), m = 3,
pc.margin=c(0,0), phy.means = NULL, centroid.size = 1, flip = rep(1,2), ...){
if(length(row.names) == 0) stop("Input parameter 'row.names' has length of 0. Length must correspond to the number of landmarks.")
# Set total number of shapes
n_shapes <- n[1]*n[2]
# Start matrix with mean PC scores for all coordinates
scores_bt <- matrix(colMeans(scores), n_shapes, ncol(vectors), byrow=TRUE)
# Set min and max for scores along PC1
pc1_range <- range(scores[, pcs[1]])
pc1_range <- c(pc1_range[1] + pc.margin[1]*diff(pc1_range), pc1_range[2] - pc.margin[1]*diff(pc1_range))
# Set min and max for scores along PC2
pc2_range <- range(scores[, pcs[2]])
pc2_range <- c(pc2_range[1] + pc.margin[2]*diff(pc2_range), pc2_range[2] - pc.margin[2]*diff(pc2_range))
# Replace mean PC1 scores with particular scores at evenly spaced points across range
scores_bt[, pcs[1]] <- rep(seq(from=pc1_range[1], to=pc1_range[2], length=n[1]), n[2])
# Replace mean PC2 scores with particular scores at evenly spaced points across range
y <- rep(NA, 0)
for(s in 0:(n[2]-1)) y <- c(y, rep((pc2_range[2] - pc2_range[1])*(s/(n[2]-1)) + pc2_range[1], n[1]))
scores_bt[, pcs[2]] <- t(y)
# Set rownames
row_names <- cbind(paste0('PC', pcs[1], '_', rep(1:n[1], n[2])), paste0('PC', pcs[2], '_', c(matrix(rep(1:n[2], n[1]), n[1], n[2], byrow=TRUE))))
rownames(scores_bt) <- paste0(row_names[, 1], '_', row_names[, 2])
if(is.null(phy.means)){
# Back-transform PC scores by multiplying by the inverse of the eigenvector matrix
lm_bt_temp <- scores_bt %*% solve(vectors)
}else{
# Create rows of 1s
one <- matrix(1, n_shapes, 1)
# Back-transform PC scores by multiplying by the inverse of the eigenvector matrix
# Need ginv (from MASS) because eigen vectors from phyl.pca is not a square matrix
# The first version of phyl.pca did return a square matrix but then it was changed
# to return a non-square matrix
lm_bt_temp <- (scores_bt %*% ginv(vectors)) + one %*% t(phy.means)
}
# Create array to hold each backtransform shape
lm_arr <- array(NA, dim=c(length(row.names), m, n_shapes), dimnames=list(row.names, NULL, rownames(scores_bt)))
# Fill shape array
for(i in 1:n_shapes){
# Get shape coordinates
xy <- matrix(lm_bt_temp[i, ], nrow=length(row.names), ncol=m, byrow=TRUE)
# Center about zero
xy <- xy - matrix(colMeans(xy), nrow(xy), ncol(xy), byrow=TRUE)
# Scale to centroid size
if(!is.null(centroid.size)) xy <- xy * (centroid.size / sqrt(sum(xy^2)))
# Center (by range) about PC score and save to array
lm_arr[, , i] <- xy
}
# Flip positions of shapes in plot by reversing scores
for(i in 1:length(pcs)) scores_bt[, pcs[i]] <- flip[i]*scores_bt[, pcs[i]]
# Plot each shape
for(i in 1:n_shapes){
# Test aspect ratio with square
seq_x <- seq(0, 1, length=10)
square <- rbind(
cbind(seq_x, rep(1,10), rep(0,10)),
cbind(rep(1,10), seq_x, rep(0,10)),
cbind(seq_x, rep(0,10), rep(0,10)),
cbind(rep(0,10), seq_x, rep(0,10))
)
#do.call(what=fcn, list(scores_bt[i, pcs], square, ...))
do.call(what=fcn, list(xy=scores_bt[i, pcs], coor=lm_arr[, , i], ...))
#break
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.