Nothing
#' @title Layer Contour Lines
#'
#' @description This function is a wrapper around
#' \code{\link[grDevices]{contourLines}} that adds the countourlines to a loon
#' plot which is based on the cartesian coordinate system.
#'
#' @param x,y As described in \code{grDevices::contourLines}:
#' locations of grid lines at which the values in z are measured.
#' These must be in ascending order.
#' By default, equally spaced values from 0 to 1 are used.
#' If \code{x} is a list, its components \code{x$x} and \code{x$y} are
#' used for \code{x} and \code{y}, respectively.
#' If the list has component \code{z} this is used for \code{z}.
#' @param z As described in \code{grDevices::contourLines}: a matrix
#' containing the values to be plotted (\code{NA}s are allowed).
#' Note that \code{x} can be used instead of \code{z} for convenience.
#' @param levels As described in \code{grDevices::contourLines}: numeric vector
#' of levels at which to draw contour lines.
#' @param nlevels As described in \code{grDevices::contourLines}: number of
#' contour levels desired iff \code{levels} is not supplied.
#' @template param_widget
#' @param asSingleLayer if \code{TRUE} a lines layer is used for the line,
#' otherwise if \code{FALSE} a group with nested line layers for each line is
#' created
#' @template param_parent
#' @template param_index
#' @param ... arguments forwarded to \code{\link{l_layer_line}}
#'
#' @templateVar page learn_R_layer
#' @templateVar section countourlines-heatimage-rasterimage
#' @template see_l_help
#'
#' @return layer id of group or lines layer
#'
#' @export
#'
#' @examples
#' if(interactive()){
#'
#' p <- l_plot()
#' x <- 10*1:nrow(volcano)
#' y <- 10*1:ncol(volcano)
#' lcl <- l_layer_contourLines(p, x, y, volcano)
#' l_scaleto_world(p)
#'
#' if (requireNamespace("MASS", quietly = TRUE)) {
#'
#' p1 <- with(iris, l_plot(Sepal.Length~Sepal.Width, color=Species))
#' lcl <- with(iris, l_layer_contourLines(p1, MASS::kde2d(Sepal.Width,Sepal.Length)))
#'
#' p2 <- with(iris, l_plot(Sepal.Length~Sepal.Width, color=Species))
#' layers <- sapply(split(cbind(iris, color=p2['color']), iris$Species), function(dat) {
#' kest <- with(dat, MASS::kde2d(Sepal.Width,Sepal.Length))
#' l_layer_contourLines(p2, kest, color=as.character(dat$color[1]), linewidth=2,
#' label=paste0(as.character(dat$Species[1]), " contours"))
#' })
#' }
#'
#' }
l_layer_contourLines <- function (widget, x = seq(0, 1, length.out = nrow(z)),
y = seq(0, 1, length.out = ncol(z)),
z,
nlevels = 10, levels = pretty(range(z,na.rm = TRUE), nlevels),
asSingleLayer=TRUE, parent="root", index="end", ...) {
l_throwErrorIfNotLoonWidget(widget)
if (missing(z)) {
if (!missing(x)) {
if (is.list(x)) {
z <- x$z
y <- x$y
x <- x$x
} else {
z <- x
x <- seq.int(0, 1, length.out = nrow(z))
}
} else stop("no 'z' matrix specified")
} else if (is.list(x)) {
y <- x$y
x <- x$x
}
if (any(diff(x) <= 0) || any(diff(y) <= 0))
stop("increasing 'x' and 'y' values expected")
if (!is.matrix(z) || nrow(z) <= 1 || ncol(z) <= 1)
stop("no proper 'z' matrix specified")
if (1 * length(x) * length(y) != length(z))
stop("dimensions of 'x', 'y' and 'z' do not match")
lines <- grDevices::contourLines(x=x,y=y,z=z,nlevels=nlevels, levels=levels)
levels <- vapply(lines, function(x)x$level, numeric(1))
xcoords <- sapply(lines, FUN=function(x)x$x)
ycoords <- sapply(lines, FUN=function(x)x$y)
if(length(levels) != length(xcoords) && length(levels) != length(ycoords))
stop("cannot parse output of contourLines correct.")
if(asSingleLayer) {
id <- l_layer_lines(widget, x=xcoords, y=ycoords, parent=parent, index=index, tag=levels, ...)
} else {
id <- l_layer_group(widget, label="contour lines", parent=parent, index=index)
ids <- Map(function(l, x, y) {
l_layer_line(widget, x=x, y=y, label=l, parent=id, ...)
}, levels, xcoords, ycoords)
attr(id, "ids") <- ids
}
attr(id, "levels") <- levels
return(id)
}
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.