Nothing
## Default 1d plot functions based on grid
## Idea: Pass through all reasonable (so doomed necessary) arguments of the grid
## function under consideration as formal arguments. Use `...' to pass
## through all graphical parameters (via gpar()).
##' @title Rug plot in 1d
##' @param x n-vector of data
##' @param width The width of the rugs as a fraction of 1
##' @param height The height of the rugs as a fraction of 1
##' @param just (x,y)-justification of the rectangles/rugs
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##' vertical
##' @param col The default color of the rectangles/rugs
##' @param default.units Default units if x, y, width or height are given
##' as numeric
##' @param name A character identifier
##' @param draw A logical indicating whether graphics output should be produced
##' @param vp The viewport
##' @param ... Additional parameters passed to gpar()
##' @return A grob (invisibly)
##' @author Marius Hofert and Wayne Oldford
##' @note The choice of width and height is to leave the rugs enough space to not
##' touch points (so to avoid points and rugs overplotting). This could also
##' be achieved by using vp1d=viewport(width=0.96, height=0.96) in zenplot()
##' but every time you adjust only one of plot1d() or plot2d(), you have to
##' adjust the viewport as well as the two plots would not match anymore at
##' the joint edges otherwise.
rug_1d_grid <- function(x, width=if(horizontal) 0.001 else 0.3,
height=if(horizontal) 0.3 else 0.001, just="centre",
col=par("fg"), horizontal=TRUE,
default.units="npc", name="rug_1d", draw=TRUE, vp=NULL, ...)
{
grid.rect(x=if(horizontal) x else 0.5, y=if(horizontal) 0.5 else x,
width=width, height=height, just=just, default.units=default.units,
name=name, gp=gpar(fill=col, col=col, ...), draw=draw, vp=vp)
}
##' @title Dot plot in 1d
##' @param x n-vector of data
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##' vertical
##' @param cex Character extension factor
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##' longer side of the plot region
##' @param plotID The plot ID as passed from zenpl
##' @param turn A turn ("l", "r", "d", "u")
##' @param pch The plotting symbol
##' @param size The size of the plotting symbol
##' @param default.units Default units if x or y are given as numeric
##' @param name A character identifier
##' @param draw A logical indicating whether graphics output should be produced
##' @param vp The viewport
##' @param ... Additional parameters passed to gpar()
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
##' @note x, horizontal, plotAsp, plotID, turn have to be passed here
##' as they are not valid graphical parameters (when passed on to '...')
points_1d_grid <- function(x, horizontal=TRUE, plotAsp=0.1,
plotID, turn, pch=21,
size=unit(0.2 * if(horizontal) plotAsp else 1, "npc"),
default.units="npc", name="points_1d", draw=TRUE, vp=NULL, ...)
{
if(horizontal) {
grid.points(x=x, y=rep(0.5, length(x)),
pch=pch, size=size, default.units=default.units,
name=name, gp=gpar(...), draw=draw, vp=vp)
} else {
grid.points(x=rep(0.5, length(x)), y=x,
pch=pch, size=size, default.units=default.units,
name=name, gp=gpar(...), draw=draw, vp=vp)
}
}
##' @title Jittered dot plot in 1d
##' @param x n-vector of data
##' @param cex Character extension factor
##' @param offset A number in [0,0.5] determining the distance between the
##' 1d and 2d plots (for creating space between the two)
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##' vertical
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##' longer side of the plot region
##' @param plotID The plot ID as passed from zenpl
##' @param turn A turn ("l", "r", "d", "u")
##' @param pch The plotting symbol
##' @param size The size of the plotting symbol
##' @param default.units Default units if x or y are given as numeric
##' @param name A character identifier
##' @param draw A logical indicating whether graphics output should be produced
##' @param vp The viewport
##' @param ... Additional parameters passed to gpar()
##' @return invisible()
##' @author Marius Hofert and Wayne Oldford
##' @note x, horizontal, plotAsp, plotID, turn have to be passed here
##' as they are not valid graphical parameters (when passed on to '...')
jitter_1d_grid <- function(x, cex=0.4, offset=0.25, horizontal=TRUE, plotAsp=0.1, plotID, turn,
pch=21, size=unit(0.2 * if(horizontal) plotAsp else 1, "npc"),
default.units="npc", name="jitter_1d", draw=TRUE, vp=NULL, ... )
{
stopifnot(0 <= offset, offset <= 0.5)
if(horizontal)
grid.points(x=x, y=offset+(1-2*offset)*runif(length(x)),
pch=pch, size=size, default.units=default.units,
name=name, gp=gpar(cex=cex, ...), draw=draw, vp=vp)
else
grid.points(x=offset+(1-2*offset)*runif(length(x)), y=x,
pch=pch, size=size, default.units=default.units,
name=name, gp=gpar(cex=cex, ...), draw=draw, vp=vp)
}
##' @title Density plot in 1d
##' @param x n-vector of data
##' @param density.args A list of arguments for density()
##' @param offset A number in [0,0.5] determining the distance between the
##' 1d and 2d plots (for creating space between the two)
##' @param method A character specifying the type of density used
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##' vertical
##' @param default.units Default units if x, y, width or height are given
##' as numeric
##' @param name A character identifier
##' @param draw A logical indicating whether graphics output should be produced
##' @param vp The viewport
##' @param ... Additional parameters passed to gpar()
##' @return A grob (invisibly)
##' @author Marius Hofert and Wayne Oldford
density_1d_grid <- function(x, density.args=list(), offset=0.25,
method=c("single", "double"), horizontal=TRUE,
default.units="npc", name="density_1d",
draw=TRUE, vp=NULL, ...)
{
stopifnot(0 <= offset, offset <= 0.5)
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)
if(horizontal) {
x <- c(min(xvals), xvals, max(xvals))
y <- c(0, yvals, 0)
} else {
x <- c(0, yvals,0)
y <- c(min(xvals), xvals, max(xvals))
}
},
"double" = {
xvals <- rep(xvals, 2)
yvals <- c(-yvals, yvals)
yrange <- range(yvals)
yvals <- (yvals - min(yrange))/diff(yrange)
if(horizontal) {
x <- xvals
y <- yvals
} else {
x <- yvals
y <- xvals
}
},
stop("Wrong 'method'"))
## Scaling to avoid overplotting of plot2d()
if(horizontal) {
min.y <- min(y)
max.y <- max(y)
y <- (1-2*offset) * (y-min.y)/(max.y-min.y) + offset # scale to [offset, 1-offset]
} else {
min.x <- min(x)
max.x <- max(x)
x <- (1-2*offset) * (x-min.x)/(max.x-min.x) + offset # scale to [offset, 1-offset]
}
grid.polygon(x=x, y=y, default.units=default.units, name=name,
gp=gpar(...), draw=draw, vp=vp)
}
##' @title Boxplot in 1d
##' @param x n-vector of data
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##' vertical
##' @param cex Character extension factor
##' @param plotAsp The fraction (in [0,1]) of the shorter side divided by the
##' longer side of the plot region
##' @param plotID The plot ID as passed from zenpl
##' @param turn A turn ("l", "r", "d", "u")
##' @param pch The plotting symbol
##' @param size The size of the plotting symbol
##' @param default.units Default units if x or y are given as numeric
##' @param col colour for boxplot
##' @param lwd The graphical parameter line width for whiskers and median
##' @param bpwidth The width of boxplot on scale of default.units
##' @param range numerical value used to determine how far the plot whiskers extend. If
##' NULL, the whiskers (range) grows with sample size.
##' @param name A character identifier
##' @param draw A logical indicating whether graphics output should be produced
##' @param vp The viewport
##' @param ... Additional parameters passed to gpar()
##' @return gTree grob containing the boxplot components as grobs
##' @author Marius Hofert and Wayne Oldford
##' @note x, horizontal, plotAsp, plotID, turn have to be passed here
##' as they are not valid graphical parameters (when passed on to '...')
boxplot_1d_grid <- function (x, horizontal=TRUE, plotAsp=0.1,
plotID, turn, pch=21,
size=unit(0.2 * if(horizontal) plotAsp else 1, "npc"),
default.units="npc",
col=NULL, lwd=2, bpwidth=0.5, range=NULL,
name="boxplot_1d", draw=TRUE, vp=NULL, ...)
{
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(col)) col <- "grey" # hcl(h=210, alpha=0.5)
medianCol <- if(col=="black") "white" else "black"
## 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]
outliers <- x[(x < lower.adjacent.value) | (x > upper.adjacent.value)]
existOutliers <- length(outliers) !=0
## Draw the boxplot
if(horizontal) {
## Build the box
highbox <- grid.rect(x=median, width=Q3-median, height=bpwidth,
default.units=default.units,
draw= FALSE, just=c("left", "center"),
gp=gpar(fill=col, col=col, ...), vp=NULL)
medianLine <- linesGrob(x=c(median, median), y=c(0.5-bpwidth/2, 0.5+bpwidth/2),
default.units=default.units, gp=gpar(fill=medianCol,
col=medianCol, lwd=lwd, ...))
lowbox <- grid.rect(x=median, width=median-Q1, height=bpwidth,
default.units=default.units, draw=FALSE, just=c("right", "center"),
gp=gpar(fill=col, col=col, ...), vp=NULL)
## Build the whiskers
highadjacent <- linesGrob(x=c(upper.adjacent.value,upper.adjacent.value),
y=c(0.5 - bpwidth/5, 0.5 + bpwidth/5),
default.units = default.units,
gp=gpar(fill=col, col=col, lwd=lwd, ...))
highwhisker <- linesGrob(x=c(Q3,upper.adjacent.value),
y=c(0.5, 0.5),
default.units = default.units,
gp=gpar(fill=col, col=col, lwd=lwd, ...))
lowadjacent <- linesGrob(x=c(lower.adjacent.value,lower.adjacent.value),
y=c(0.5 - bpwidth/5, 0.5 + bpwidth/5),
default.units = default.units,
gp=gpar(fill=col, col=col,lwd=lwd, ...))
lowwhisker <- linesGrob(x=c(Q1,lower.adjacent.value),
y=c(0.5, 0.5),
default.units = default.units,
gp=gpar(fill=col, col=col, lwd=lwd, ...))
## Gather the outliers (if any)
if (existOutliers)
outlierpoints <- grid.points(x=outliers, y=rep(0.5, length(outliers)),
pch=pch, size=size, default.units=default.units,
gp=gpar(fill=col, col=col, ...),
draw=FALSE, vp=NULL)
} else { # !horizontal
## Build the box
highbox <- grid.rect(y=median, height=Q3-median, width=bpwidth,
default.units=default.units, just=c("center", "bottom"),
gp=gpar(fill=col, col=col, ...), draw= FALSE, vp=NULL)
medianLine <- linesGrob(x=c(0.5-bpwidth/2, 0.5+bpwidth/2),
y=c(median, median), default.units=default.units,
gp=gpar(fill=medianCol, col=medianCol, lwd=lwd, ...))
lowbox <- grid.rect(y=median, height=median-Q1, width=bpwidth,
default.units=default.units, draw= FALSE,
just=c("center", "top"), gp=gpar(fill=col, col=col, ...),
vp=NULL)
## Build the whiskers
highadjacent <- linesGrob(x=c(0.5 - bpwidth/5, 0.5 + bpwidth/5),
y=c(upper.adjacent.value,upper.adjacent.value),
default.units = default.units,
gp=gpar(fill=col, col=col,lwd=lwd, ...))
highwhisker <- linesGrob(x=c(0.5, 0.5),
y=c(Q3,upper.adjacent.value),
default.units = default.units,
gp=gpar(fill=col, col=col,lwd=lwd, ...))
lowadjacent <- linesGrob(x=c(0.5 - bpwidth/5, 0.5 + bpwidth/5),
y=c(lower.adjacent.value,lower.adjacent.value),
default.units = default.units,
gp=gpar(fill=col, col=col,lwd=lwd, ...))
lowwhisker <- linesGrob(x=c(0.5, 0.5),
y=c(Q1,lower.adjacent.value),
default.units = default.units,
gp=gpar(fill=col, col=col,lwd=lwd, ...))
## Gather the outliers (if any)
if(existOutliers)
outlierpoints <- grid.points(x=rep(0.5, length(outliers)), y=outliers,
pch=pch, size=size, default.units=default.units,
gp=gpar(fill=col, col=col, ...),
draw=FALSE, vp=NULL)
}
## Put it all together
boxplotGrobs <- if(existOutliers)
list(lowadjacent, lowwhisker, lowbox, highbox,
## medianPoint, # median must come after the boxes
medianLine, highwhisker, highadjacent, outlierpoints)
else
list(lowadjacent, lowwhisker, lowbox, highbox,
## medianPoint, # median must come after the boxes
medianLine, highwhisker, highadjacent)
gt <- gTree(children=do.call(gList, boxplotGrobs), name=name, vp=vp)
if (draw) grid.draw(gt)
gt
}
##' @title Histogram in 1d
##' @param x n-vector of data
##' @param offset A number in [0,0.5] determining the distance between the
##' 1d and 2d plots (for creating space between the two)
##' @param method A character specifying the type of density used
##' @param breaks Argument passed to hist() to get information on bins. Default
##' is 20 equi-width bins covering the range of x
##' @param col 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 horizontal A logical indicating whether the 1d plot is horizontal or
##' vertical
##' @param default.units Default units if x, y, width or height are given
##' as numeric
##' @param name A character identifier
##' @param draw A logical indicating whether graphics output should be produced
##' @param vp The viewport
##' @param ... Additional parameters passed to gpar()
##' @return A grob (invisibly)
##' @author Marius Hofert and Wayne Oldford
hist_1d_grid <- function(x, offset=0.25, method=c("single", "double"),
breaks=NULL, col=NULL, fill=NULL, horizontal=TRUE,
default.units="npc", name="hist_1d",
draw=TRUE, vp=NULL, ...)
{
stopifnot(0 <= offset, offset <= 0.5)
if(is.null(fill)) {
fill <- if(is.null(col)) "grey" else "black"
if(is.null(col)) col <- "black"
} else if(is.null(col)) { col <- "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 - min(xRange))/(diff(xRange))
heights <- binInfo$counts
heights <- (1-2*offset) * heights/max(heights)
## Set values for single or double methods
method <- match.arg(method)
switch(method,
"single" = {
binLoc <- offset
just <- c("left", "bottom")
},
"double" = {
binLoc <- 0.5
just <- if(horizontal) c("left", "centre") else c("centre", "bottom")
},
stop("Wrong 'method'"))
## Build the bins
binGrobs <- lapply(1:length(heights), # bins,
function(i){
left <- binBoundaries[i]
right <- binBoundaries[i+1]
height <- heights[i]
rectGrob(x=if(horizontal) left else binLoc,
y=if(horizontal) binLoc else left,
width=if(horizontal) (right-left) else height,
height=if(horizontal) height else (right-left),
just=just, default.units=default.units,
name=paste(name, "bin",i, sep="_"),
gp=gpar(fill=fill, col=col, ...))})
gt <- gTree(children=do.call(gList, binGrobs), vp=vp)
if(draw) grid.draw(gt)
gt
}
##' @title Label plot in 1d
##' @param loc.x x-location of the label
##' @param loc.y y-location of the label
##' @param label The label to be used
##' @param x n-vector of data
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##' vertical
##' @param plotID The plot ID as passed on from zenplot()
##' @param just (x,y)-justification of the label
##' @param rot The rotation of the label
##' @param cex The font size magnification factor
##' @param check.overlap A logical indicating whether to check for and omit
##' overlapping text
##' @param default.units Default units if x or y are given as numeric
##' @param name A character identifier
##' @param draw A logical indicating whether graphics output should be produced
##' @param vp The viewport
##' @param ... Additional parameters passed to gpar()
##' @return A grob (invisibly)
##' @author Marius Hofert and Wayne Oldford
label_1d_grid <- function(loc.x=0.5, loc.y=0.5, label=NULL,
x, horizontal=TRUE, plotID,
just=c("centre", "centre"), rot=if(horizontal) 0 else 90, cex=0.4,
check.overlap=FALSE, default.units="npc", name="label_1d",
draw=TRUE, vp=NULL, ...)
{
if(is.null(label))
label <- if(is.null(colnames(x))) { # also applies to a vector (colnames == NULL)
paste0("Index ",plotID$idx)
} else {
paste0("Var ",plotID$name)
}
grid.text(label=label, x=loc.x, y=loc.y, just=just, rot=rot,
check.overlap=check.overlap, default.units=default.units,
name=name, gp=gpar(cex=cex, ...), draw=draw, vp=vp)
}
##' @title Arrow plot in 1d
##' @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 plotAsp The fraction (in [0,1]) of the shorter side divided by the
##' longer side of the plot region
##' @param turn A turn ("l", "r", "d", "u")
##' @param default.units Default units if x or y are given as numeric
##' @param name A character identifier
##' @param draw A logical indicating whether graphics output should be produced
##' @param vp The viewport
##' @param ... Additional parameters passed to gpar()
##' @return A grob (invisibly)
##' @author Marius Hofert and Wayne Oldford
arrow_1d_grid <- function(loc=c(0.5, 0.5), length=0.5, angle=plotAsp*30,
plotAsp=0.1, turn, default.units="npc", name="arrow_1d",
draw=TRUE, vp=NULL, ...)
{
arrow_2d_grid(loc=loc, length=length, angle=angle,
turn=turn, default.units=default.units, name=name,
vp=vp, draw=draw, ...)
}
##' @title Rectangle plot in 1d
##' @param loc.x x-location of rectangle
##' @param loc.y y-location of rectangle
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##' vertical
##' @param width The width of the rugs as a fraction of 1
##' @param height The height of the rugs as a fraction of 1
##' @param just (x,y)-justification of the rectangles/rugs
##' @param default.units Default units if x, y, width or height are given
##' as numeric
##' @param name A character identifier
##' @param draw A logical indicating whether graphics output should be produced
##' @param vp The viewport
##' @param ... Additional parameters passed to gpar()
##' @return A grob (invisibly)
##' @author Marius Hofert and Wayne Oldford
rect_1d_grid <- function(loc.x=0.5, loc.y=0.5, horizontal=TRUE,
width=if(horizontal) 1 else 0.4,
height=if(horizontal) 0.4 else 1,
just="centre", default.units="npc",
name="rect_1d", draw=TRUE, vp=NULL, ...)
{
grid.rect(x=loc.x, y=loc.y, width=width, height=height, just=just,
default.units=default.units, name=name,
gp=gpar(...), draw=draw, vp=vp)
}
##' @title Lines plot in 1d
##' @param loc.x x-coordinates of the points combined by lines
##' @param loc.y y-coordinates of the points combined by lines
##' @param horizontal A logical indicating whether the 1d plot is horizontal or
##' vertical
##' @param default.units Default units if x or y are given as numeric
##' @param arrow A list describing the arrow head
##' @param name A character identifier
##' @param draw A logical indicating whether graphics output should be produced
##' @param vp The viewport
##' @param ... Additional parameters passed to gpar()
##' @return A grob (invisibly)
##' @author Marius Hofert and Wayne Oldford
##' @note Note that loc.x cannot be named x.loc or x as it would then be over
##' written by the x passed via layoutpars from zenplot()
lines_1d_grid <- function(loc.x=NULL, loc.y=NULL, horizontal=TRUE,
default.units="npc", arrow=NULL,
name="lines_1d", draw=TRUE, vp=NULL, ...)
{
if(is.null(loc.x)) loc.x <- if(horizontal) c(0, 1) else c(0.5, 0.5)
if(is.null(loc.y)) loc.y <- if(horizontal) c(0.5, 0.5) else c(0, 1)
grid.lines(x=loc.x, y=loc.y, default.units=default.units, arrow=arrow, name=name,
gp=gpar(...), draw=draw, vp=vp)
}
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.