Nothing
#' @importFrom grid makeContent
#' @export
makeContent.fittexttreepolar <- function(x) {
data <- x$data
# If ymin/ymax are not provided, generate boundary box from height. A similar
# transformation will be performed for xmin/xmax for each grob individually
# later, as it needs to be done in the context of the y position of the grob.
if (!("ymin" %in% names(data))) {
data$ymin <- data$r -
(grid::convertHeight(x$height, "npc", valueOnly = TRUE) / 2)
data$ymax <- data$r +
(grid::convertHeight(x$height, "npc", valueOnly = TRUE) / 2)
}
# Handle parameters
if (is.null(x$contrast)) x$contrast <- FALSE
if (is.null(x$outside)) x$outside <- FALSE
if (is.null(x$fullheight)) x$fullheight <- x$grow
if (x$outside) cli::cli_warn("Outside is not supported in polar coordinates")
if (x$reflow) cli::cli_warn("Reflowing is not supported in polar coordinates")
if (! is.null(x$hjust)) cli::cli_warn("hjust is not supported in polar coordinates")
if (! is.null(x$vjust)) cli::cli_warn("vjust is not supported in polar coordinates")
# Convert padding.x and padding.y to mm
padding.x <- grid::convertWidth(x$padding.x, "mm", valueOnly = TRUE)
padding.y <- grid::convertHeight(x$padding.y, "mm", valueOnly = TRUE)
# Prepare grob for each text label
grobs <- lapply(seq_len(nrow(data)), function(i) {
# Convenience
text <- data[i, ]
# Handle angled text
if (! text$angle == 0) cli::cli_warn("Angled text is not supported in polar coordinates")
# Set hjust and vjust
# A vjust of 0.2 strikes a good visual balance in the kerning of characters
# in polar coordinates
x$hjust <- 0.5
x$vjust <- 0.2
# Create starting textGrob
tg <- grid::textGrob(label = text$label, x = 0.5, y = 0.5, default.units = "mm",
hjust = x$hjust, vjust = x$vjust, rot = text$angle,
gp = grid::gpar(col = ggplot2::alpha(text$colour, text$alpha),
fontsize = text$size, fontfamily = text$family,
fontface = text$fontface,
lineheight = text$lineheight))
# Get starting textGrob dimensions
tgdim <- tgDimensions(tg, x$fullheight, text$angle)
# Convert box y coordinates to mm
ymin <- grid::convertHeight(grid::unit(text$ymin, "npc"), "mm", TRUE)
ymax <- grid::convertHeight(grid::unit(text$ymax, "npc"), "mm", TRUE)
# Get dimensions of bounding box. The y dimension will be given in mm, while
# the x dimension is given as arc length (radians). For convenience of
# comparing the textGrob to the bounding box on the x dimension, we will
# also calculate it in mm based on the text placement. If xmin/xmax are
# not provided, the boundary box will be generated from width.
ydim <- abs(ymin - ymax) - (2 * padding.y)
if (!("xmin" %in% names(data))) {
if (x$place %in% c("bottomleft", "bottom", "bottomright")) {
r <- ymin + (x$vjust * tgdim$height) + padding.y
} else if (x$place %in% c("left", "centre", "right")) {
r <- ((ymin + ymax) / 2) - ((0.5 - x$vjust) * tgdim$height)
} else if (x$place %in% c("topleft", "top", "topright")) {
r <- ymax - padding.y - ((1 - x$vjust) * tgdim$height)
}
c <- 2 * pi * r
text$xmin <- text$theta -
(((grid::convertWidth(x$width, "mm", valueOnly = TRUE) / 2) / c) * 2 * pi)
text$xmax <- text$theta +
(((grid::convertWidth(x$width, "mm", valueOnly = TRUE) / 2) / c) * 2 * pi)
}
xdim <- ifelse(
text$xmax > text$xmin,
text$xmax - text$xmin,
(text$xmax + pi + pi - text$xmin) %% (2 * pi)
)
if (x$place %in% c("bottomleft", "bottom", "bottomright")) {
r <- ymin + (x$vjust * tgdim$height) + padding.y
xdim_mm <- r * xdim
} else if (x$place %in% c("left", "centre", "right")) {
r <- ((ymin + ymax) / 2) - ((0.5 - x$vjust) * tgdim$height)
xdim_mm <- r * xdim
} else if (x$place %in% c("topleft", "top", "topright")) {
r <- ymax - padding.y - ((1 - x$vjust) * tgdim$height)
xdim_mm <- r * xdim
}
# Resize text to fit bounding box if it doesn't fit
if (
# Standard condition - is text too big for box?
(tgdim$width > xdim_mm | tgdim$height > ydim) |
# grow = TRUE condition - is text too small for box?
(x$grow & tgdim$width < xdim_mm & tgdim$height < ydim)
) {
# Get the relationships between font size and label dimensions
slopew <- tg$gp$fontsize / tgdim$width
slopeh <- tg$gp$fontsize / tgdim$height
# Calculate the target font size required to make the text fit
# height-wise
targetfsh <- ydim * slopeh
# Calculate the target font size required to make the text fit width-wise
# See https://imgur.com/a/z5TvFST for explanation of geometry
if (x$place %in% c("bottomleft", "bottom", "bottomright")) {
w <- xdim * (ymin + padding.y)
targetfsw <- w * slopew
} else if (x$place %in% c("left", "centre", "right")) {
k <- (tgdim$height * x$vjust) / tgdim$width
R <- (ymin + ymax) / 2
w <- ((xdim * R) / ((xdim * k) + 1)) - (2 * padding.x)
targetfsw <- w * slopew
} else if (x$place %in% c("topleft", "top", "topright")) {
k <- tgdim$height / tgdim$width
R <- ymax - padding.y
w <- ((xdim * R) / ((xdim * k) + 1)) - (2 * padding.x)
targetfsw <- w * slopew
}
# Set to smaller of target font sizes
tg$gp$fontsize <- ifelse(targetfsw < targetfsh, targetfsw, targetfsh)
}
# Hide if below minimum font size
if (tg$gp$fontsize < x$min.size) return()
# Update the textGrob dimensions
tgdim <- tgDimensions(tg, x$fullheight, text$angle)
# r = the radius from the centre to the text anchor (which is not the
# typographic baseline but is defined by vjust). Note that the position of
# the text anchor does not take descenders into account, so these must be
# adjusted for if fullheight is true
if (x$place %in% c("bottomleft", "bottom", "bottomright")) {
r <- ymin + padding.y + (x$vjust * tgdim$height)
} else if (x$place %in% c("left", "centre", "right")) {
r <- ((ymin + ymax) / 2) - ((0.5 - x$vjust) * tgdim$height)
} else if (x$place %in% c("topleft", "top", "topright")) {
r <- ymax - padding.y - ((1 - x$vjust) * tgdim$height)
}
if (x$fullheight) r <- r + (grid::convertHeight(tgdim$descent, "mm", TRUE) * (1 - x$vjust))
# c = the circumference of the baseline
c <- 2 * pi * r
# char_widths = widths of each character in the string
chars <- strsplit(as.character(text$label), "")[[1]]
char_widths <- (grid::calcStringMetric(chars)$width /
sum(grid::calcStringMetric(chars)$width)) * tgdim$width
# char_arcs = arcwidth of each character, in degrees
char_arcs <- 360 * char_widths / c
# padding.x.arcrad = the arcwidth of padding.x, expressed in radians, at
# the anchor radius
padding.x.arcrad <- (padding.x / c) * 2 * pi
# theta = the theta of the text anchor for the entire label in the
# coordinate system, initial calculated in radians
if (x$place %in% c("bottomleft", "left", "topleft")) {
theta <- text$xmin + (deg2rad(sum(char_arcs)) / 2) + padding.x.arcrad
} else if (x$place %in% c("bottom", "centre", "top")) {
theta <- ifelse(
text$xmax > text$xmin,
(text$xmin + text$xmax) / 2,
(text$xmin + text$xmax + pi + pi) / 2
)
} else if (x$place %in% c("bottomright", "right", "topright")) {
theta <- text$xmax - (deg2rad(sum(char_arcs)) / 2) - padding.x.arcrad
}
# check if need to flip (angle == 180)
flip <- x$flip
if (flip) {
flip <- rad2deg(theta) > 90 && rad2deg(theta) < 270
}
# If flipping, over-write necessary strings
if (flip) {
# Reverse the string
text$label <- strrev(as.character(text$label))
# re-calc string positions
chars <- strsplit(as.character(text$label), "")[[1]]
char_widths <- (grid::calcStringMetric(chars)$width /
sum(grid::calcStringMetric(chars)$width)) * tgdim$width
# char_arcs = arcwidth of each character, in degrees
char_arcs <- 360 * char_widths / c
# padding.x.arcrad = the arcwidth of padding.x, expressed in radians, at
# the anchor radius
padding.x.arcrad <- (padding.x / c) * 2 * pi
# theta = the theta of the text anchor for the entire label in the
# coordinate system, initial calculated in radians
if (x$place %in% c("bottomleft", "left", "topleft")) {
theta <- text$xmin + (deg2rad(sum(char_arcs)) / 2) + padding.x.arcrad
} else if (x$place %in% c("bottom", "centre", "top")) {
theta <- ifelse(
text$xmax > text$xmin,
(text$xmin + text$xmax) / 2,
(text$xmin + text$xmax + pi + pi) / 2
)
} else if (x$place %in% c("bottomright", "right", "topright")) {
theta <- text$xmax - (deg2rad(sum(char_arcs)) / 2) - padding.x.arcrad
}
}
# angle = ?? I can't even remember what this is supposed to do but it
# works. Converting from radians to degrees with some sort of correction?
angle <- 450 - rad2deg(theta)
# char_thetas = theta position of the anchors for each character (assuming
# hjust = 0.5 for the textGrob representing this character), in degrees
lag_vector <- function(x) c(0, x[seq_along(x) - 1])
char_thetas <- angle - lag_vector(cumsum(char_arcs)) -
(char_arcs / 2) + (sum(char_arcs) / 2)
# Generate a textGrob for each character
tgs <- lapply(seq_along(char_thetas), function(i) {
char <- chars[i]
theta <- char_thetas[i]
theta_rad <- deg2rad(theta)
x_pos <- r * cos(theta_rad)
x_pos <- 0.5 + grid::convertWidth(grid::unit(x_pos, "mm"), "npc", TRUE)
y_pos <- r * sin(theta_rad)
y_pos <- 0.5 + grid::convertHeight(grid::unit(y_pos, "mm"), "npc", TRUE)
if (flip) {
# adjust for 0.8 to take into account 0.2 vjust for nice kerning
x$vjust <- 0.8 - x$vjust
}
tg <- grid::textGrob(
label = char,
x = x_pos,
y = y_pos,
hjust = x$hjust,
vjust = x$vjust,
rot = theta - 90 + 180 * flip,
default.units = "npc",
gp = grid::gpar(
fontsize = tg$gp$fontsize,
col = ggplot2::alpha(text$colour, text$alpha),
fontfamily = text$family,
fontface = text$fontface,
lineheight = text$lineheight
)
)
return(tg)
})
# Convert to a gTree
gt <- grid::gTree(children = do.call(grid::gList, tgs))
# Return the gTree
gt
})
class(grobs) <- "gList"
grid::setChildren(x, grobs)
}
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.