Nothing
#' Visualize an embedding by plotting with images
#'
#' Makes a plot of \code{n} images sampled from \code{images}, positions at coordinates given by \code{x}.
#'
#' @param x A \code{largeVis} object or [N,D] matrix of coordinates.
#' @param n The number of images to sample.
#' @param images The images. A 3-D or 4-D array.
#' @param scale Proportion to scale the images to.
#' @param ... Addiitional parameters passed to \code{plot}.
#'
#' @details The images can be passed in either as a list or a 3- or 4-dimensional array. The first dimension is \code{n}.
#'
#' If the objects in the list are \code{matrix} objects, or the array is 3-dimensional, the images will be treated as
#' greyscale. If there is an additional dimension, it must have a length of 3 and be RGB color layers.
#'
#' @references Andrej Karpapthy. \href{http://cs.stanford.edu/people/karpathy/cnnembed/}{t-SNE Visualization of CNN Codes.}
#'
#' @importFrom grDevices as.raster
#' @importFrom graphics rasterImage
#' @seealso \code{\link{ggManifoldMap}}
#' @export
#' @examples \dontrun{
#' load("mnist.Rda")
#' load("mnistcoordinates.Rda")
#'
#' flip <- function(x) apply(x,2,rev)
#' rotate <- function(x) t(flip(x))
#'
#' mnistimages <- apply(mnist$images,
#' MARGIN=1,
#' FUN = function(x) as.array(rotate(flip(x))))
#' mnistimages <- t(mnistimages)
#' dim(mnistimages) <- c(42000, 28, 28)
#'
#' manifoldMap(coords,
#' 1000,
#' scale = 0.07,
#' mnistimages)
#' }
manifoldMap <- function(x,
n = nrow(x),
images,
scale = 1,
...) { #nocov start
if (class(x) == "largeVis") x <- t(x$coords)
if (ncol(x) != 2) stop("Can only visualize in 2-D.")
N <- nrow(x)
if (class(images) == "list" &&
N != length(images))
stop("Number of images doesn't equal number of points.")
if (N != nrow(images))
stop("Number of images doesn't equal number of points.")
D <- length(dim(images)) - 1
if (! (D == 2 || D == 3)) stop("Wrong number of dimensions.")
if (D == 3 &&
(dim(images)[4] < 2 ||
dim(images)[4] > 4)) stop("Wrong number of color layers.")
selections <- sample(N, n, replace = F)
lowerscale <- min(images)
upperscale <- max(images)
graphics::plot(x * 1.1, pch = NA, type = 'n', ...)
for (i in selections) {
if (D == 2) {
image_data <- images[i, , ]
} else {
image_data <- images[i, , , ]
}
image_data <- 1 - ( (image_data - lowerscale) / upperscale)
image <- grDevices::as.raster(image_data)
offsetx <- (nrow(image) * scale) / 2
offsety <- (ncol(image) * scale) / 2
graphics::rasterImage(image,
x[i, 1] - offsetx,
x[i, 2] - offsety,
x[i, 1] + offsetx,
x[i, 2] + offsety,
interpolate = TRUE
)
}
} # nocov end
#' Visualize an embedding by ggplotting with images
#'
#' Identical to \link{manifoldMap}, but adds images to an existing \code{ggplot2} object or creates one.
#'
#' @param ggObject a \code{\link[ggplot2]{ggplot}} object. If not provided, a new \code{ggplot}
#' object with \code{\link[ggplot2]{geom_blank}} will be created.
#' @param x A \code{largeVis} object or [N,D] matrix of coordinates.
#' @param n The number of images to sample.
#' @param images The images. A 3-D or 4-D array.
#' @param scale Proportion to scale the images to.
#' @return A \code{ggplot} object.
#'
#' @details See \code{\link{manifoldMap}}. Note that this function can be considerably slower to display than \code{manifoldMap}.
#' It therefore should only be used if other features of \code{ggplot2} are required.
#'
#' If the objects in the list are \code{matrix} objects, or the array is 3-dimensional, the images will be treated as
#' greyscale. If there is an additional dimension, it must have a length of 3 and be RGB color layers.
#'
#' @importFrom grDevices as.raster
#' @importFrom graphics rasterImage
#' @importFrom ggplot2 ggplot
#' @importFrom ggplot2 geom_blank
#' @importFrom ggplot2 annotation_raster
#' @importFrom ggplot2 aes_
#' @export
ggManifoldMap <- function(ggObject = NULL,
x,
n = nrow(x),
images,
scale = 1) { #nocov start
if (class(x) == "largeVis") x <- t(x$coords)
if (ncol(x) != 2) stop("Can only visualize in 2-D.")
N <- nrow(x)
if (class(images) == "list" &&
N != length(images))
stop("Number of images doesn't equal number of points.")
if (N != nrow(images))
stop("Number of images doesn't equal number of points.")
D <- length(dim(images)) - 1
if (! (D == 2 || D == 3)) stop("Wrong number of dimensions.")
if (D == 3 &&
(dim(images)[4] < 2 ||
dim(images)[4] > 4)) stop("Wrong number of color layers.")
selections <- sample(N, n, replace = F)
lowerscale <- min(images)
upperscale <- max(images)
if (is.null(ggObject)) {
x <- data.frame(x)
colnames(x) <- c("x", "y")
ggObject = ggplot2::`%+%`(ggplot2::ggplot(x,
ggplot2::aes_(x = quote(x),
y = quote(y))),
geom_blank())
}
for (i in selections) {
if (D == 2) {
image_data <- images[i, , ]
} else {
image_data <- images[i, , , ]
}
image_data <- 1 - ( (image_data - lowerscale) / upperscale)
image <- grDevices::as.raster(image_data)
offsetx <- (nrow(image) * scale) / 2
offsety <- (ncol(image) * scale) / 2
ggObject <- ggplot2::`%+%`(ggObject, ggplot2::annotation_raster(
image,
xmin = x[i, 1] - offsetx,
ymin = x[i, 2] - offsety,
xmax = x[i, 1] + offsetx,
ymax = x[i, 2] + offsety,
interpolate = TRUE
))
}
return(ggObject)
} # nocov end
#' manifoldMapStretch
#'
#' A manifold map that fills the full extent of the plot.
#'
#' Ported from \url{http://cs.stanford.edu/people/karpathy/cnnembed/}. Each position is filled with its nearest neighbor.
#'
#' @param x A [N,D] matrix of coordinates.
#' @param f A function that, called with the index number of a row of \code{x}, returns an R object representing
#' an image. See the example.
#' @param size_x The width of the requested plot, in pixels.
#' @param size_y The height of the requested plot, in pixels.
#' @param image_size The size to plot each image; each is plotted as a square.
#' @param ... Additional parameters passed to \code{plot}.
#'
#' @note This function is experimental.
#'
#' @examples
#' \dontrun{
#' # Demonstration of f
#' load(system.file("extdata", "faces.Rda", package="largeVis"))
#'
#' imagepaths <- paste("pathtoimages",
#' faceLabels[,1], sub("png", "jpg", faceLabels[,2]), sep = "/")
#'
#' manifoldMapStretch(as.matrix(faceCoords[,1:2]),
#' f = function(x) jpeg::readJPEG(imagePaths[x]),
#' size_x = 5000, size_y = 5000, image_size = 100)
#' }
#'
#' @export
manifoldMapStretch <- function(x,
f,
size_x = 500,
size_y = 500,
image_size = 50,
...) { #nocov start
xnum <- size_x / image_size
ynum <- size_y / image_size
coordsadj <- x - c(min(x[,1]), min(x[,2]))
coordsadj <- coordsadj * c(size_x / max(coordsadj[,1]),
size_y / max(coordsadj[,2]))
graphics::plot(matrix(c(0, size_x,
size_y, 0),
ncol = 2),
pch = NA,
type = 'n', ...)
abes <- matrix(c(rep(1:xnum, ynum),
rep(1:ynum, each = xnum)),
ncol = 2)
for (i in 1:nrow(abes)) {
img_x <- abes[i, 1]
img_y <- abes[i, 2]
xf <- (img_x * image_size) - (image_size/2)
yf <- (img_y * image_size) - (image_size/2)
dd <- apply((coordsadj - c(xf, yf))^2,
MARGIN = 1,
FUN = sum)
selection <- which(dd == min(dd))
coordsadj[selection,] <- Inf
image <- f(selection)
rasterImage( image,
xleft = xf - (image_size / 2),
ybottom = yf - (image_size / 2),
xright = xf + (image_size / 2),
ytop = yf + (image_size / 2),
interpolate = TRUE
)
}
} #nocov end
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.