# Shape drawing functions ----------
#' Add outlines/polygons to a mosaic plot
#'
#' @param df `mosaic_df`
#' @param column (`shp` by default) name or position of a
#' column in `df` to feed [polygon()].
#' @param density `numeric` (recycled) to feed [polygon()]
#' @param angle `numeric` (recycled) to feed [polygon()]
#' @param border `color` (recycled) to feed [polygon()]
#' @param col `color` (recycled) to feed [polygon()]
#' @param lty `numeric` (recycled) to feed [polygon()]
#' @param ... additional arguments to feed [polygon()]
#' @return the `mosaic_df`, invisibly
#' @export
add_polygons <-
function(df,
column="shp",
density=rep(NA, nrow(df)),
angle=45,
border=rep(par("fg"), nrow(df)),
col=rep(par("bg"), nrow(df)),
lty=rep(par("lty"), nrow(df)),
...){
n <- nrow(df)
if (!missing(density))
density <- rep_len(density, n)
if (!missing(angle))
angle <- rep_len(angle, n)
if (!missing(border))
border <- rep_len(border, n)
if (!missing(col))
col <- rep_len(col, n)
if (!missing(lty))
lty <- rep_len(lty, n)
for (i in 1:n){
getElement(df, column)[[i]] %>%
polygon(density=density[i],
angle=angle[i],
border=border[i],
col=col[i],
lty=lty[i])
}
invisible(df)
}
#' @rdname add_polygons
#' @export
add_outlines <- add_polygons
#' Add curves/lines to a mosaic plot
#'
#' @param df `mosaic_df`
#' @param column (`shp` by default) name or position of a
#' column in `df` to feed [lines()].
#' @param col `color` (recycled) to feed [lines()]
#' @param lwd `numeric` (recycled) to feed [lines()]
#' @param lty `numeric` (recycled) to feed [lines()]
#' @param ... additional arguments to feed [lines()]
#' @return the `mosaic_df`, invisibly
#' @export
add_lines <-
function(df, column="shp",
col=rep(par("fg"), nrow(df)),
lwd=rep(1, nrow(df)),
lty=rep(par("lty"), nrow(df)),
...){
n <- nrow(df)
if (!missing(col))
col <- rep_len(col, n)
if (!missing(lwd))
lwd <- rep_len(lwd, n)
if (!missing(lty))
lty <- rep_len(lty, n)
for (i in 1:n){
getElement(df, column)[[i]] %>%
lines(col=col[i],
lwd=lwd[i],
lty=lty[i])
}
invisible(df)
}
#' @rdname add_lines
#' @export
add_curves <- add_lines
#' Add text to shapes of a mosaic plot
#'
#' @param df `mosaic_df`
#' @param column (`shp` by default) name or position of a
#' column in `df` to feed [lines()].
#' If a non-character column is provided, its `names`.
#' @param col `color` (recycled) to feed [text()]
#' @param font `numeric` (recycled) to feed [text()]
#' @param cex `numeric` to feed [text()], if missing tries
#' to obtain something adequate
#' @param ... additional arguments to feed [text()]
#' @return the `mosaic_df`, invisibly
#' @export
add_text <-
function(df, column="shp",
col=rep(par("fg"), nrow(df)),
font=rep(1, nrow(df)),
cex,
...){
n <- nrow(df)
if (!missing(col))
col <- rep_len(col, n)
if (!missing(font))
font <- rep_len(font, n)
labels <- getElement(df, column)
if (!is.character(labels))
labels %<>% names
# calculate adapted cex to fill (to the most) 0.9 of a locus
if (missing(cex)){
cex <- strwidth(labels, cex=par("cex")) %>%
max %>% `/`(., 0.9) %>% `/`(par("cex"), .)
}
for (i in 1:n){
text(df$xc[i], df$yc[i],
labels[i],
col=col[i],
font=font[i],
cex=cex,
...)
}
invisible(df)
}
#' @rdname add_text
#' @export
add_labels <- add_text
#' Add headers to groups on a mosaic plot
#'
#' @param df `mosaic_df`
#' @param column (`f` by default) name or position of a column in `df` to feed [lines()].
#' If a non-character column is provided, its `names`.
#' @param cex `numeric` to feed [text()], if missing tries
#' to obtain something adequate
#' @param ... additional arguments to feed [text()]
#' @return the `mosaic_df`, invisibly
#' @export
add_headers <-
function(df, column="f",
cex,
...){
df_h <- df %>%
group_by_(column) %>%
slice(1) %>%
ungroup
labels <- as.character(getElement(df_h, column))
# calculate adapted cex to fill (to the most) 0.9 of a locus
if (missing(cex)){
cex=1
}
text(-0.25, df_h$yc, labels, cex=cex, adj=1, ...)
invisible(df)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.