swh:1:snp:c9642977a3a6f01aa6f7c6d25a2a0b172dbcf27b
Tip revision: 8cd6867a4603458ad8381d12005311360cd15565 authored by Wayne Oldford on 08 September 2021, 18:10:02 UTC
version 1.0.4
version 1.0.4
Tip revision: 8cd6867
plot1dloon.R
## Default 1d plot functions based on loon
##' @title Rug plot in 1d using the interactive loon package
##' @family default 1d plot functions using the interactive loon package
##' @family default 1d plot functions
##' @name rug_1d_loon
##' @aliases rug_1d_loon
##' @param zargs The argument list as passed from \code{\link{zenplot}()}
##' @param ... Additional parameters passed to loon::l_plot()
##' @return A loon loon::l_plot(...)
##' @author Marius Hofert and Wayne Oldford
##' @note Just calls points_1d_loon with glyph = "osquare" to preserve linking
rug_1d_loon <- function(zargs, ...)
points_1d_loon(zargs, glyph = "square", ...)
##' @title Dot plot in 1d using the interactive loon package
##' @family default 1d plot functions using the interactive loon package
##' @family default 1d plot functions
##' @name points_1d_loon
##' @aliases points_1d_loon
##' @param zargs The argument list as passed from \code{\link{zenplot}()}
##' @param linkingGroup A string specifying the initial group of plots to be
##' linked to this plot
##' @param linkingKey List of IDs to link on
##' @param showLabels Logical determining whether axis labels are displayed
##' @param showScales Logical determining whether scales are displayed
##' @param showGuides Logical determining whether the background guidelines are
##' displayed
##' @param glyph The plot glyph
##' @param itemLabel A vector of strings to serve as the item labels
##' @param showItemLabels Logical determing whether item labels display on mouse
##' hover
##' @param parent The tk parent for this loon plot widget
##' @param ... Additional parameters passed to loon::l_plot()
##' @return A loon loon::l_plot(...)
##' @author Marius Hofert and Wayne Oldford
##' @export
points_1d_loon <- function(zargs,
linkingGroup = NULL, linkingKey = NULL,
showLabels = FALSE, showScales = FALSE,
showGuides = FALSE, glyph = "ocircle",
itemLabel = NULL, showItemLabels = TRUE,
parent = NULL, ...)
{
r <- extract_1d(zargs)
x <- as.matrix(r$x)
xlim <- r$xlim
horizontal <- r$horizontal
## Check for linkingGroup
## TODO: not sure we should do this here, or simply (as before) rely
## on linkingGroup being passed by zenplot.
## Alternatively linkingGroup could default to `none`
if (is.null(linkingGroup))
linkingGroup <- paste0("zenplot parent =", parent$ID)
## Remove NAs
ldata <- na_omit_loon(x = x, linkingKey = linkingKey, itemLabel = itemLabel)
## Main
x <- ldata$x
linkingKey <- ldata$linkingKey
itemLabel <- ldata$itemLabel
check_zargs(zargs, "ispace")
if(horizontal) {
baseplot <- loon::l_plot(x = x, y = rep(0, length(x)),
linkingGroup = linkingGroup,
linkingKey = linkingKey,
showLabels = FALSE,
showScales = showScales,
showGuides = showGuides,
glyph = glyph,
itemLabel = itemLabel,
showItemLabels = showItemLabels,
parent = parent,
...)
l_ispace_config(baseplot = baseplot,
ispace = zargs$ispace,
xlim = xlim)
} else {
baseplot <- loon::l_plot(x = rep(0, length(x)), y = x,
linkingGroup = linkingGroup,
showLabels = FALSE,
showScales = showScales,
showGuides = showGuides,
glyph = glyph,
itemLabel = itemLabel,
showItemLabels = showItemLabels,
parent = parent,
...)
l_ispace_config(baseplot = baseplot,
ispace = zargs$ispace,
ylim = xlim)
}
baseplot
}
##' @title Jittered dot plot in 1d using the interactive loon package
##' @family default 1d plot functions using the interactive loon package
##' @family default 1d plot functions
##' @name jitter_1d_loon
##' @aliases jitter_1d_loon
##' @param zargs The argument list as passed from \code{\link{zenplot}()}
##' @param linkingGroup A string specifying the initial group of plots to be
##' linked to this plot
##' @param showLabels Logical determining whether axis labels are displayed
##' @param showScales Logical determining whether scales are displayed
##' @param showGuides Logical determining whether the background guidelines
##' are displayed
##' @param glyph Glyph to be used for points, default is the open circle:
##' "ocircle"
##' @param itemLabel A vector of strings to serve as the item labels
##' @param showItemLabels Logical determing whether item labels display on mouse
##' hover
##' @param parent The tk parent for this loon plot widget
##' @param ... Additional parameters passed to loon::l_plot()
##' @return A loon loon::l_plot(...)
##' @author Marius Hofert and Wayne Oldford
##' @export
jitter_1d_loon <- function(zargs,
linkingGroup = NULL, showLabels = FALSE,
showScales = FALSE, showGuides = FALSE,
glyph = "ocircle", itemLabel = NULL,
showItemLabels = TRUE, parent = NULL, ...)
{
r <- extract_1d(zargs)
x <- as.matrix(r$x)
x <- na.omit(x)
xlim <- r$xlim
horizontal <- r$horizontal
if(is.null(itemLabel)) {
if(!is.null(rownames(x))) {
itemLabel <- rownames(x)
} else {
itemLabel <- sapply(1:length(x),
function (i) {paste0("point", i)})
}
}
if (is.null(linkingGroup))
linkingGroup <- paste0("zenplot parent =", parent$ID)
check_zargs(zargs, "ispace")
if(horizontal) {
baseplot <- loon::l_plot(x = x, y = runif(length(x)),
linkingGroup = linkingGroup,
showLabels = showLabels,
showScales = showScales,
showGuides = showGuides,
glyph = glyph,
itemLabel = itemLabel,
showItemLabels = showItemLabels,
parent = parent,
...)
l_ispace_config(baseplot = baseplot,
ispace = zargs$ispace,
xlim = xlim)
} else {
baseplot <- loon::l_plot(x = runif(length(x)), y = x,
linkingGroup = linkingGroup,
showLabels = showLabels,
showScales = showScales,
showGuides = showGuides,
glyph = glyph,
itemLabel = itemLabel,
showItemLabels = showItemLabels,
parent = parent,
...)
l_ispace_config(baseplot = baseplot,
ispace = zargs$ispace,
ylim = xlim)
}
baseplot
}
##' @title Histogram in 1d using the interactive loon package
##' @family default 1d plot functions using the interactive loon package
##' @family default 1d plot functions
##' @name hist_1d_loon
##' @aliases hist_1d_loon
##' @param zargs The argument list as passed from \code{\link{zenplot}()}
##' @param breaks Argument passed to hist() to get information on bins. Default
##' is 20 equi-width bins covering the range of x
##' @param color colour of the histogram bar interiors, unless fill is specified,
##' then this is the colour of the border
##' @param fill colour of the histogram bar interior if given
##' @param showStackedColors Logical determining whether
##' to show the individual point colours stacked in the histogram
##' @param showBinHandle Logical to show a handle to adjust bins
##' @param showLabels Logical determining whether axis labels are displayed
##' @param linkingGroup A string specifying the initial group of plots to be
##' linked to this plot
##' @param showScales Logical determining whether scales are displayed
##' @param showGuides Logical determining whether the background guidelines are
##' displayed
##' @param parent The tk parent for this loon plot widget
##' @param ... Additional parameters passed to loon::l_hist()
##' @return A loon loon::l_plot(...)
##' @author Marius Hofert and Wayne Oldford
##' @export
hist_1d_loon <- function(zargs,
breaks = NULL, color = NULL, fill = NULL,
showStackedColors = TRUE,
showBinHandle = FALSE, showLabels = FALSE,
linkingGroup = NULL, showScales = FALSE,
showGuides = FALSE, parent = NULL, ...)
{
## Extracting the information
r <- extract_1d(zargs)
x <- as.matrix(r$x)
xlim <- r$xlim
horizontal <- r$horizontal
loonInfo <- na_omit_loon(x = x)
x <- loonInfo$x
linkingKey <- loonInfo$linkingKey
if (is.null(linkingGroup))
linkingGroup <- paste0("zenplot parent =", parent$ID)
## Main
if(all(is.na(x))) {
h <- loon::l_hist(linkingGroup = linkingGroup)
} else {
if(is.null(fill)) {
if(is.null(color)) {
colorFill <- "grey"
colorOutline <- "black"
} else {
colorFill <- color
colorOutline <- "black"
}
} else {
colorFill <- fill
if(is.null(color)) colourOutline <- "black"
}
xRange <- range(x)
if(is.null(breaks))
breaks <- seq(from = xRange[1], to = xRange[2], length.out = 21)
binInfo <- hist(x, breaks = breaks, plot = FALSE)
binBoundaries <- binInfo$breaks
h <- loon::l_hist(x = x,
yshows = 'density',
origin = binBoundaries[1],
binwidth = abs(diff(binBoundaries[1:2])),
linkingGroup = linkingGroup,
linkingKey = linkingKey,
swapAxes = !horizontal,
showBinHandle = showBinHandle,
showLabels = showLabels,
showScales = showScales,
showGuides = showGuides,
showStackedColors = showStackedColors,
colorFill = colorFill,
colorOutline = colorOutline,
parent = parent,
...)
}
## Scale
check_zargs(zargs, "ispace")
l_ispace_config(baseplot = h,
ispace = zargs$ispace,
xlim = xlim)
## Return
h
}
##' @title Density plot in 1d using the interactive loon package
##' @family default 1d plot functions using the interactive loon package
##' @family default 1d plot functions
##' @name density_1d_loon
##' @aliases density_1d_loon
##' @param zargs The argument list as passed from \code{\link{zenplot}()}
##' @param density.args A list of arguments for density()
##' @param method A character specifying the type of density used
##' @param lwd Line width used only when linewidth = NULL, value of 1 used
##' otherwise.
##' @param linewidth Line width of outline for density polygons (highest
##' priority)
##' @param color Colour used to fill the density when fill is NULL and to
##' outline the density when linecolor is NULL, foreground colour used
##' otherwise.
##' @param fill Colour used to fill the density polygon
##' @param linecolor Colour used for the outline of the density
##' @param linkingGroup A string specifying the initial group of plots to be
##' linked to this plot
##' @param showLabels Logical determining whether axis labels are displayed
##' @param showScales Logical determining whether scales are displayed
##' @param showGuides Logical determining whether the background guidelines are
##' displayed
##' @param baseplot If non-null the base plot on which the plot should be
##' layered
##' @param parent The tk parent for this loon plot widget
##' @param ... Additional parameters passed to loon::l_layer()
##' @return A loon loon::l_plot(...)
##' @author Marius Hofert and Wayne Oldford
##' @export
density_1d_loon <- function(zargs,
density.args = list(), method = c("single", "double"),
lwd = NULL, linewidth = NULL, color = NULL,
fill = NULL, linecolor = NULL, linkingGroup = NULL,
showLabels = FALSE, showScales = FALSE,
showGuides = FALSE, baseplot = NULL, parent = NULL, ...)
{
## Extracting the information
r <- extract_1d(zargs)
x <- as.matrix(r$x)
x <- na_omit_loon(x)$x
xlim <- r$xlim
horizontal <- r$horizontal
if (is.null(linkingGroup))
linkingGroup <- paste0("zenplot parent =", parent$ID)
## Main
if(all(is.na(x))) {
if (is.null(baseplot)) baseplot <- loon::l_plot(linkingGroup = linkingGroup)
} else {
dens <- do.call(density, args = c(list(x), density.args))
xvals <- dens$x
keepers <- xvals >= min(x) & xvals <= max(x)
xvals <- xvals[keepers]
xrange <- range(xvals)
##xvals <- (xvals - min(xrange))/diff(xrange)
yvals <- dens$y[keepers]
method <- match.arg(method)
switch(method,
"single" = {
##yvals <- yvals/max(yvals)
x <- c(min(xvals), xvals, max(xvals))
y <- c(0, yvals, 0)
},
"double" = {
x <- rep(c(min(xvals), xvals, max(xvals)), 2)
yvals <- c(c(0, -yvals, 0), c(0, yvals, 0))
yrange <- range(yvals)
y <- yvals # (yvals - min(yrange))/diff(yrange)
},
stop("Wrong 'method'"))
## Get the base plot if not supplied
if(is.null(baseplot)) {
baseplot <- loon::l_plot(showLabels = showLabels,
showScales = showScales,
showGuides = showGuides,
linkingGroup = linkingGroup,
parent = parent)
}
## Sort out colours
if(is.null(fill)) {
if(is.null(color)) fill <- "grey50" else fill <- color
} # fill has a value, on to linecolor
if(is.null(linecolor)) {
if(is.null(color)) linecolor <- baseplot['foreground'] else linecolor <- color
} # linecolor has a value
## Sort out line widths
if(is.null(linewidth)) {
if(is.null(lwd)) {
## use linewidth
linewidth <- 1
} else { # use lwd
linewidth <- lwd
}
}
densityPoly <- loon::l_layer_polygon(baseplot,
x = x,
y = y,
color = fill,
linecolor = linecolor,
linewidth = linewidth,
...)
## loon::l_scaleto_layer(baseplot, densityPoly)
}
if (!horizontal) baseplot['swapAxes'] <- TRUE
check_zargs(zargs, "ispace")
l_ispace_config(baseplot = baseplot,
ispace = zargs$ispace,
x = x, y = y,
xlim = xlim)
baseplot
}
##' @title Boxplot in 1d using the interactive loon package
##' @family default 1d plot functions using the interactive loon package
##' @family default 1d plot functions
##' @name boxplot_1d_loon
##' @aliases boxplot_1d_loon
##' @param zargs The argument list as passed from \code{\link{zenplot}()}
##' @param color colour for boxplot
##' @param linecolor Colour used for the lines to draw the boxplot
##' @param lwd The parameter line width for whiskers and median and box
##' boundaries
##' @param range numerical value used to determine how far the plot whiskers
##' extend. If NULL, the whiskers (range) grows with sample size.
##' @param showLabels Logical determining whether axis labels are displayed
##' @param showScales Logical determining whether scales are displayed
##' @param showGuides Logical determining whether the background guidelines
##' are displayed
##' @param linkingGroup A string specifying the initial group of plots to be
##' linked to this plot
##' @param baseplot If non-null the base plot on which the plot should be layered
##' @param parent The tk parent for this loon plot widget
##' @param ... Additional parameters passed to gpar()
##' @return A loon loon::l_plot(...)
##' @author Marius Hofert and Wayne Oldford
##' @export
boxplot_1d_loon <- function(zargs,
color = NULL, linecolor = NULL, lwd = 2,
range = NULL, showLabels = FALSE, showScales = FALSE,
showGuides = FALSE, linkingGroup = NULL,
baseplot = NULL, parent, ...)
{
## Extracting the information
r <- extract_1d(zargs)
x <- as.matrix(r$x)
xlim <- r$xlim
horizontal <- r$horizontal
loonInfo <- na_omit_loon(x)
x <- loonInfo$x
linkingKey <- loonInfo$linkingKey
itemLabel <- loonInfo$itemLabel
if (is.null(linkingGroup))
linkingGroup <- paste0("zenplot parent =", parent$ID)
if(is.null(range)) { # choose 'range' depending on sample size
n <- length(x)
q25 <- qnorm(0.25)
iqr <- qnorm(0.75) - q25
range <- (q25 - qnorm(0.35/(2*n)))/iqr
}
if(is.null(color)) color <- "grey"
medianCol <- if(color == "black") "grey90" else "black"
if (is.null(linecolor)) linecolor <- color
## Summary statistics
median <- median(x, na.rm = TRUE)
Q1 <- quantile(x, 0.25, na.rm = TRUE)
Q3 <- quantile(x, 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
upper.fence <- Q3 + (range * IQR)
lower.fence <- Q1 - (range * IQR)
upper.adjacent.value <- max(x[x <= upper.fence])
lower.adjacent.value <- min(x[x >= lower.fence])
## upper.outliers <- x[x > upper.adjacent.value]
## lower.outliers <- x[x < lower.adjacent.value]
outlying <- (x < lower.adjacent.value) | (x > upper.adjacent.value)
outlierLabels <- itemLabel[outlying]
outlierLinkingKey <- linkingKey[outlying]
outliers <- x[outlying]
nOutliers <- sum(outlying)
existOutliers <- nOutliers != 0
## Get the base plot if not supplied
if(is.null(baseplot)) {
baseplot <- loon::l_plot(showLabels = showLabels,
showScales = showScales,
showGuides = showGuides,
parent = parent)
}
## Build order matters to get the layering right.
## Build the whiskers
highadjacent <- loon::l_layer_line(baseplot,
x = c(upper.adjacent.value, upper.adjacent.value),
y = c(0.25, 0.75),
label = "Upper adjacent value",
color = linecolor,
linewidth = lwd,
...)
highwhisker <- loon::l_layer_line(baseplot,
x = c(Q3,upper.adjacent.value),
y = c(0.5, 0.5),
label = "Upper whisker",
color = linecolor,
linewidth = lwd,
...)
lowadjacent <- loon::l_layer_line(baseplot,
x = c(lower.adjacent.value,lower.adjacent.value),
y = c(0.25, 0.75),
label = "Lower adjacent value",
color = linecolor,
linewidth = lwd,
...)
lowwhisker <- loon::l_layer_line(baseplot,
x = c(Q1,lower.adjacent.value),
y = c(0.5, 0.5),
label = "Lower whisker",
color = linecolor,
linewidth = lwd,
...)
## Build the box
highbox <- loon::l_layer_rectangle(baseplot,
x = c(median, Q3),
y = c(0, 1),
label = "upper half of middle 50%",
color = color,
linecolor = linecolor,
linewidth = lwd,
...)
lowbox <- loon::l_layer_rectangle(baseplot,
x = c(median, Q1),
y = c(0, 1),
label = "lower half of middle 50%",
color = color,
linecolor = linecolor,
linewidth = lwd,
...)
medianLine <- loon::l_layer_line(baseplot,
x = c(median, median),
y = c(0, 1),
label = "Median line",
color = medianCol,
linewidth = lwd,
...)
## Gather the outliers (if any)
if (existOutliers){
if (is.null(itemLabel)){
outlierIndices <- which (x %in% outliers)
if (!is.null(rownames(x))) {
outlierLabels <- rownames(x)[outlierIndices]
} else
{outlierLabels <- sapply(outlierIndices,
function(i){
paste0("point",i)
})
}
} else outlierLabels <- itemLabel
outlierpoints <- loon::l_layer_points(baseplot,
x = outliers,
y = rep(0.5, nOutliers),
label = itemLabel,
color = color,
...)
}
## Scale
check_zargs(zargs, "ispace")
l_ispace_config(baseplot = baseplot,
ispace = zargs$ispace,
xlim = xlim)
if (!horizontal) baseplot['swapAxes'] <- TRUE
## Return
baseplot
}
##' @title Arrow plot in 1d using the interactive loon package
##' @family default 1d plot functions using the interactive loon package
##' @family default 1d plot functions
##' @name arrow_1d_loon
##' @aliases arrow_1d_loon
##' @param zargs The argument list as passed from \code{\link{zenplot}()}
##' @param loc The (x,y) location of the center of the arrow
##' @param length The length of the arrow
##' @param angle The angle from the shaft to the edge of the arrow head
##' @param linkingGroup A string specifying the initial group of plots to be
##' linked to this plot
##' @param showLabels Logical determining whether axis labels are displayed
##' @param showScales Logical determining whether scales are displayed
##' @param showGuides Logical determining whether the background guidelines are
##' displayed
##' @param baseplot If non-null the base plot on which the plot should be layered
##' @param parent The tk parent for this loon plot widget
##' @param ... Additional parameters passed to loon::l_layer_line(...)
##' @return A loon loon::l_plot(...)
##' @author Marius Hofert and Wayne Oldford
##' @export
arrow_1d_loon <- function(zargs,
loc = c(0.5, 0.5), length = 0.6, angle = NULL,
linkingGroup = NULL, showLabels = FALSE,
showScales = FALSE, showGuides = FALSE,
baseplot = NULL, parent = NULL, ...)
{
check_zargs(zargs, "width1d", "width2d")
width1d <- zargs$width1d
width2d <- zargs$width2d
if(is.null(angle)) angle <- 30 * width1d/width2d
if (is.null(linkingGroup))
linkingGroup <- paste0("zenplot parent =", parent$ID)
arrow_2d_loon(zargs,
loc = loc, length = length, angle = angle,
linkingGroup = linkingGroup,
showLabels = showLabels,
showScales = showScales,
showGuides = showGuides,
baseplot = baseplot,
parent = parent,
...)
}
##' @title Rectangle plot in 1d using the interactive loon package
##' @family default 1d plot functions using the interactive loon package
##' @family default 1d plot functions
##' @name rect_1d_loon
##' @aliases rect_1d_loon
##' @param zargs The argument list as passed from \code{\link{zenplot}()}
##' @param loc.x x-location of rectangle
##' @param loc.y y-location of rectangle
##' @param color Colour of the rectangle outline
##' @param fill Colour of the rectangle interior
##' @param lwd line width for rectangle outline
##' @param linkingGroup A string specifying the initial group of plots to be
##' linked to this plot (ignored)
##' @param showLabels Logical determining whether axis labels are displayed
##' @param showScales Logical determining whether scales are displayed
##' @param showGuides Logical determining whether the background guidelines
##' are displayed
##' @param baseplot If non-NULL the base plot on which the plot should be
##' layered
##' @param parent The tk parent for this loon plot widget
##' @param ... Additional parameters passed to loon::l_layer_text(...)
##' @return A loon loon::l_plot(...)
##' @author Marius Hofert and Wayne Oldford
##' @export
rect_1d_loon <- function(zargs,
loc.x = NULL, loc.y = NULL, color = NULL,
fill = NULL, lwd = 1,
linkingGroup = NULL, showLabels = FALSE,
showScales = FALSE, showGuides = FALSE,
baseplot = NULL, parent = NULL, ...)
{
r <- extract_1d(zargs)
horizontal <- r$horizontal
xlim <- r$xlim
x <- as.matrix(r$x)
if (is.null(linkingGroup))
linkingGroup <- paste0("zenplot parent =", parent$ID)
## Get the base plot if not supplied
if(is.null(baseplot)) {
baseplot <- loon::l_plot(showLabels = showLabels,
showScales = showScales,
showGuides = showGuides,
linkingGroup = linkingGroup,
parent = parent)
}
if(is.null(color)) color <- baseplot['foreground']
if(is.null(fill)) fill <- baseplot['background']
## Get rectangle info now
label <- paste("Rectangle:", colnames(x))
if (is.null(loc.x)) loc.x <- 0:1
## if (is.null(loc.x)) loc.x <- c(baseplot['panX'] +
## (0.1) * baseplot['deltaX']/baseplot['zoomX'],
## baseplot['panX'] +
## (0.9) * (baseplot['deltaX']/baseplot['zoomX']))
## c(baseplot['panX'],
## baseplot['panX'] +
## (baseplot['deltaX']/baseplot['zoomX']))
## #0:1
if (is.null(loc.y)) loc.y <- 0:1
## if (is.null(loc.y)) loc.y <- c(baseplot['panY'] +
## (0.2) * (baseplot['deltaY']/baseplot['zoomY']),
## baseplot['panY'] +
## (0.8) * (baseplot['deltaY']/baseplot['zoomY']))
## c(baseplot['panY'],
## baseplot['panY'] +
## (baseplot['deltaY']/baseplot['zoomY']))
## #0:1
## Build the box
loon::l_layer_rectangle(baseplot,
x = loc.x,
y = loc.y,
label = label,
color = fill,
linecolor = color,
linewidth = lwd,
...)
if (!horizontal) baseplot['swapAxes'] <- TRUE
## Scale
check_zargs(zargs, "ispace")
l_ispace_config(baseplot = baseplot,
ispace = zargs$ispace,
x = loc.x, y = loc.y,
xlim = xlim)
## Return
baseplot
}
##' @title Lines plot in 1d using the interactive loon package
##' @family default 1d plot functions using the interactive loon package
##' @family default 1d plot functions
##' @name lines_1d_loon
##' @aliases lines_1d_loon
##' @param zargs The argument list as passed from \code{\link{zenplot}()}
##' @param loc.x x-coordinates of the points on the line
##' @param loc.y y-coordinates of the pointson the line
##' @param color Colour of the line
##' @param lwd line width
##' @param linkingGroup A string specifying the initial group of plots to be
##' linked to this plot (ignored)
##' @param showLabels Logical determining whether axis labels are displayed
##' @param showScales Logical determining whether scales are displayed
##' @param showGuides Logical determining whether the background guidelines are
##' displayed
##' @param baseplot If non-null the base plot on which the plot should be
##' layered
##' @param parent The tk parent for this loon plot widget
##' @param ... Additional parameters passed to loon::l_layer_text(...)
##' @return A loon loon::l_plot(...)
##' @author Marius Hofert and Wayne Oldford
##' @export
lines_1d_loon <- function(zargs,
loc.x = NULL, loc.y = NULL,
color = NULL, lwd = 1,
linkingGroup = NULL,
showLabels = FALSE, showScales = FALSE,
showGuides = FALSE, baseplot = NULL,
parent = NULL, ...)
{
r <- extract_1d(zargs)
horizontal <- r$horizontal
x <- as.matrix(r$x)
ldata <- na_omit_loon(x)
xlim <- r$xlim
x <- ldata$x
if(length(x) == 0) x <- c(0,1)
if (is.null(linkingGroup))
linkingGroup <- paste0("zenplot parent =", parent$ID)
if(is.null(loc.x)) loc.x <- range(x)
if(is.null(loc.y)) loc.y <- c(0.5, 0.5)
## Get the base plot if not supplied
if(is.null(baseplot)) {
baseplot <- loon::l_plot(showLabels = showLabels,
showScales = showScales,
showGuides = showGuides,
parent = parent)
}
if(is.null(color)) color <- baseplot['foreground']
loon::l_layer_line(widget = baseplot, x = loc.x, y = loc.y,
color = color, linewidth = lwd, ...)
if (!horizontal) baseplot['swapAxes'] <- TRUE
## Scale
check_zargs(zargs, "ispace")
l_ispace_config(baseplot = baseplot,
ispace = zargs$ispace,
x = loc.x, y = loc.y,
xlim = xlim)
## Return
baseplot
}
##' @title Label plot in 1d using the interactive loon package
##' @family default 1d plot functions using the interactive loon package
##' @family default 1d plot functions
##' @name label_1d_loon
##' @aliases label_1d_loon
##' @param zargs The argument list as passed from \code{\link{zenplot}()}
##' @param loc.x x-location of the label
##' @param loc.y y-location of the label
##' @param label The label to be used
##' @param rot The rotation of the label
##' @param size The font size
##' @param box A \code{\link{logical}} indicating whether the label is to be enclosed
##' in a box.
##' @param color Color of the label (and of box when \code{box = TRUE}).
##' @param linkingGroup A string specifying the initial group of plots to be
##' linked to this plot
##' @param showLabels Logical determining whether axis labels are displayed
##' @param showScales Logical determining whether scales are displayed
##' @param showGuides Logical determining whether the background guidelines
##' are displayed
##' @param baseplot If non-null the base plot on which the plot should be
##' layered
##' @param parent The tk parent for this loon plot widget
##' @param ... Additional parameters passed to loon::l_layer_text(...)
##' @return A loon::l_plot(...)
##' @author Marius Hofert and Wayne Oldford
##' @export
label_1d_loon <- function(zargs,
loc.x = NULL, loc.y = NULL, label = NULL,
rot = NULL, size = 8, box = FALSE, color = NULL,
linkingGroup = NULL, showLabels = FALSE,
showScales = FALSE, showGuides = FALSE,
baseplot = NULL, parent = NULL, ...)
{
r <- extract_1d(zargs)
horizontal <- r$horizontal
x <- as.matrix(r$x)
if(is.null(loc.y)) loc.y <- 0.5
if(is.null(loc.x)) {loc.x <- 0.5}
if(is.null(label)) label <- colnames(x)
if(is.null(rot)) rot <- if (horizontal) 0 else 90
if (is.null(linkingGroup))
linkingGroup <- paste0("zenplot parent =", parent$ID)
if(is.null(baseplot))
baseplot <- loon::l_plot(showLabels = showLabels,
showScales = showScales,
showGuides = showGuides,
parent = parent)
if(is.null(color)) color <- baseplot['foreground']
loon::l_layer_text(baseplot, text = label,
x = loc.x,
y = loc.y,
angle = rot,
size = size,
color = color,
...)
if (box) {
rect_1d_loon(zargs,
color = color,
baseplot = baseplot, parent = parent,
index="end", ...)
}
if (!horizontal) baseplot['swapAxes'] <- TRUE
## Scale
check_zargs(zargs, "ispace")
l_ispace_config(baseplot = baseplot,
ispace = zargs$ispace,
xlim = c(0,1), ylim = c(0,1))
## Return
baseplot
}
##' @title Layout plot in 1d using the interactive loon package
##' @param zargs The argument list as passed from \code{\link{zenplot}()}
##' @param ... Additional arguments passed to label_1d_loon()
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
layout_1d_loon <- function(zargs, ...)
label_1d_loon(zargs, box = TRUE, ...)