Nothing
#' Visually browse through a sample rendering its landmarks and corresponding
#' surfaces.
#'
#' Browse through a sample rendering its landmarks and corresponding surfaces.
#' This is handy e.g. to check if the landmark projection using placePatch was
#' successful, and to mark specific specimen.
#'
#'
#' @param dat.array array or list containing landmark coordinates.
#' @param path optional character: path to files where surface meshes are
#' stored locally. If not specified only landmarks are displayed.
#' @param prefix prefix to attach to the filenames extracted from
#' \code{dimnames(dat.array)[[3]]} (in case of an array), or
#' \code{names(dat.array)} (in case of a list)
#' @param suffix suffix to attach to the filenames extracted from
#' \code{dimnames(dat.array)[[3]]} (in case of an array), or
#' \code{names(dat.array)} (in case of a list)
#' @param col mesh color
#' @param pt.size size of plotted points/spheres. If \code{point="s"}.
#' \code{pt.size} defines the radius of the spheres. If \code{point="p"} it
#' sets the variable \code{size} used in \code{point3d}.
#' @param alpha value between 0 and 1. Sets transparency of mesh 1=opaque 0=
#' fully transparent.
#' @param begin integer: select a specimen to start with.
#' @param render if render="w", a wireframe will be drawn, else the meshes will
#' be shaded.
#' @param point how to render landmarks. "s"=spheres, "p"=points.
#' @param add logical: add to existing rgl window.
#' @param meshlist list holding meshes in the same order as \code{dat.array} (Overrides \code{path}).
#' @param Rdata logical: if the meshes are previously stored as Rdata-files by
#' calling save(), these are simply loaded and rendered. Otherwise it is
#' assumed that the meshes are stored in standard file formats such as PLY, STL
#' or OBJ, that are then imported with the function \code{\link{file2mesh}}.
#' @param atlas provide object generated by \code{\link{createAtlas}} to
#' specify coloring of surface patches, curves and landmarks
#' @param text.lm logical: number landmarks. Only applicable when
#' \code{atlas=NULL}.
#' @return returns an invisible vector of indices of marked specimen.
#' @seealso \code{\link{placePatch}, \link{createAtlas}, \link{plotAtlas},
#' \link{file2mesh}}
#'
#' @examples
#'
#' data(nose)
#' ###create mesh for longnose
#' longnose.mesh <- tps3d(shortnose.mesh,shortnose.lm,longnose.lm,threads=1)
#' ### write meshes to disk
#' save(shortnose.mesh, file="shortnose")
#' save(longnose.mesh, file="longnose")
#'
#' ## create landmark array
#' data <- bindArr(shortnose.lm, longnose.lm, along=3)
#' dimnames(data)[[3]] <- c("shortnose", "longnose")
#' \dontrun{
#' checkLM(data, path="./",Rdata=TRUE, suffix="")
#' }
#'
#' ## now visualize by using an atlas:
#' atlas <- createAtlas(shortnose.mesh, landmarks =
#' shortnose.lm[c(1:5,20:21),],
#' patch=shortnose.lm[-c(1:5,20:21),])
#' if (interactive()){
#' checkLM(data, path="./",Rdata=TRUE, suffix="", atlas=atlas)
#' }
#' ## remove data from disk
#' unlink("shortnose")
#' unlink("longnose")
#'
#' @export
checkLM <- function(dat.array, path=NULL, prefix="", suffix=".ply", col="white", pt.size=NULL, alpha=1, begin=1, render=c("w","s"), point=c("s","p"), add=FALSE,meshlist=NULL, Rdata=FALSE, atlas=NULL, text.lm=FALSE)
{
k <- NULL
marked <- NULL
j <- 1
if (!Rdata)
load <- file2mesh
outid <- NULL
point <- point[1]
## set point/sphere sizes
radius <- pt.size
if (is.null(radius)) {
if (point == "s")
radius <- (cSize(dat.array[,,1])/sqrt(nrow(dat.array[,,1])))*(1/30)
else
radius <- 10
}
size <- radius
render <- render[1]
arr <- FALSE
point <- point[1]
if (point == "s") {
rendpoint <- spheres3d
} else if (point == "p") {
rendpoint <- points3d
} else {
stop("argument \"point\" must be \"s\" for spheres or \"p\" for points")
}
dimDat <- dim(dat.array)
if (length(dimDat) == 3) {
n <- dim(dat.array)[3]
name <- dimnames(dat.array)[[3]]
arr <- TRUE
} else if (is.list(dat.array)) {
n <- length(dat.array)
name <- names(dat.array)
} else {
stop("data must be 3-dimensional array or a list")
}
i <- begin
if (render=="w") {
back <- front <- "lines"
rend <- wire3d
} else {
back <- front <- "filled"
}
if (!add || cur3d()==0)
open3d()
if (!is.null(atlas)) {
k <- dim(atlas$landmarks)[1]
#k1 <- dim(atlas$patch)[1]
}
meshnames <- paste(path,prefix,name,suffix,sep="")
while (i <= n) {
rgl.bringtotop()
tmp.name <- meshnames[i]
if (arr)
landmarks <- dat.array[,,i]
else
landmarks <- dat.array[[i]]
if (is.null(atlas)) {
outid <- rendpoint(landmarks,radius=radius, size=size)
if (text.lm)
outid <- c(outid, text3d(landmarks, texts=paste(1:dim(landmarks)[1], sep=""), cex=1, adj=c(1,1.5)))
if (!is.null(meshlist)) {
tmpmesh <- meshlist[[i]]
} else if (!is.null(path)) {
if (!Rdata) {
tmpmesh <- file2mesh(tmp.name,readcol=TRUE)
} else {
input <- load(tmp.name)
tmp.name <- gsub(path,"",tmp.name)
tmpmesh <- get(input)
}
}
if (!is.null(meshlist) || !is.null(path)) {
outid <- c(outid,shade3d(tmpmesh,col=col,alpha=alpha,back=back,front=front))
rm(tmpmesh)
if (Rdata)
rm(list=input)
gc()
}
} else {
atlas.tmp <- atlas
atlas.tmp$mesh <- NULL
atlas.tmp$landmarks <- landmarks[1:k,]
atlas.tmp$patch <- landmarks[-c(1:k),]
if (!is.null(meshlist)) {
atlas.tmp$mesh <- meshlist[[i]]
}
if (!is.null(path) && is.null(meshlist)) {
if (!Rdata) {
atlas.tmp$mesh <- file2mesh(tmp.name)
} else {
input <- load(tmp.name)
tmp.name <- gsub(path,"",tmp.name)
atlas.tmp$mesh <- get(input)
}
}
outid <- plotAtlas(atlas.tmp, add=TRUE, alpha=alpha, pt.size=radius, render=render, point=point, meshcol=col, legend=FALSE)
}
answer <- readline(paste("viewing #",i,"(return=next | p=previous | m=mark current | s=stop viewing)\n"))
if (answer == "m") {
marked[j] <- i
j <- j+1
} else if (answer == "s") {
i <- n+1
} else if (answer == "p") {
i <- i-1
} else
i <- i+1
pop3d(id=outid)
}
invisible(marked)
}
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.