new geom to draw richtext label (3d1fa679) · Commits · github_fork / LinkET

NAMESPACE

+2 −0

Original line number	Diff line number	Diff line
		@@ -31,6 +31,7 @@ S3method(ggplot_add,doughnut)
		S3method(ggplot_add,geom_couple)
		S3method(ggplot_add,geom_diag_label)
		S3method(ggplot_add,geom_panel_grid)
		S3method(ggplot_add,magic_text)
		S3method(ggplot_add,secondary_axis)
		S3method(print,calc_relimp)
		S3method(print,correlate)
		@@ -81,6 +82,7 @@ export(geom_couple)
		export(geom_curve2)
		export(geom_diag_label)
		export(geom_doughnut)
		export(geom_magic_text)
		export(geom_mark)
		export(geom_node_doughnut)
		export(geom_panel_grid)

R/geom-magic-text.R

0 → 100644

+156 −0

Original line number	Diff line number	Diff line
		#' @title Magic Method to Draw labels
		#' @description a wrapper function of \code{ggtext::geom_richtext}, but can
		#' formatted labels by \code{LaTeX} style.
		#' @param mapping set of aesthetic mappings created by \code{aes()} or \code{aes_()}.
		#' @param data the data to be displayed in this layer.
		#' @param stat the statistical transformation to use on the data for this layer,
		#' as a string.
		#' @param position position adjustment, either as a string, or the result of a
		#' call to a position adjustment function.
		#' @param parse logical. IF TRUE (default), the labels will be parsed into richtext.
		#' @param sup one-length character, indicates that characters after this is superscript.
		#' @param sub one-length character, indicates that characters after this is subscript.
		#' @param br string, separator of lines.
		#' @param ... others passing to \code{ggtext::geom_richtext()}.
		#' @return a gg layer object.
		#' @rdname geom_magic_text
		#' @author Hou Yun
		#' @export
		geom_magic_text <- function(mapping = NULL,
		data = NULL,
		stat = "identity",
		position = "identity",
		parse = TRUE,
		sup = "^",
		sub = "_",
		br = "\n",
		...) {
		if(!suppressMessages(requireNamespace("ggtext"))) {
		stop("ggtext package has not been installed", call. = FALSE)
		}
		structure(list(mapping = mapping,
		data = data,
		stat = stat,
		position = position,
		parse = parse,
		sup = sup,
		sub = sub,
		br = br,
		...), class = "magic_text")
		}

		#' @importFrom ggplot2 ggplot_add
		#' @export
		ggplot_add.magic_text <- function(object, plot, object_name) {
		inherit.aes <- object$inherit.aes %\|\|% TRUE
		if(isTRUE(inherit.aes)) {
		object$mapping <- aes_modify(plot$mapping, object$mapping)
		}

		label <- aes_vars(object$mapping, "label")
		if(is.null(label) && is.null(object$label)) {
		stop("geom_magic_text requires the label aesthetics.", call. = FALSE)
		}

		if(isTRUE(parse)) {
		if(!is.null(object$label)) {
		object$label <- latex_richtext(object$label,
		sup = object$sup,
		sub = object$sub,
		br = object$br)
		} else {
		object$data[[label]] <- latex_richtext(object$data[[label]],
		sup = object$sup,
		sub = object$sub,
		br = object$br)
		}
		}

		object <- object[setdiff(names(object), c("sub", "sup", "br", "parse"))]
		if(is.null(object$fill %\|\|% object$mapping$fill)) {
		object$fill <- NA
		}
		if(is.null(object$label.colour %\|\|% object$mapping$label.colour)) {
		object$label.colour <- NA
		}
		geom_richtext <- get_function("ggtext", "geom_richtext")
		object <- do.call(geom_richtext, object)
		ggplot_add(object, plot, object_name)
		}

		#' @noRd
		latex_richtext <- function(x,
		sup = "^",
		sub = "_",
		br = "\n") {
		if(!is.character(x)) {
		x <- as.character(x)
		}

		x <- sub(br, "<br>", x, fixed = "TRUE")
		x <- vapply(x, function(.x) {
		if(is.na(.x)) {
		return(.x)
		}

		ll <- unlist(strsplit(.x, ""))

		any_tex <- any(c(sup, sub) %in% ll)
		if(!any_tex) {
		return(.x)
		}

		if(sum(ll == "{") != sum(ll == "}")) {
		stop("Invalid latex mode character.", call. = FALSE)
		}

		n <- length(ll)
		sub_id <- which(ll == sub)
		sub_id <- sub_id[sub_id < n]
		sup_id <- which(ll == sup)
		sup_id <- sup_id[sup_id < n]

		if(length(sub_id) > 0) {
		purrr::walk(sub_id, function(.id) {
		if(ll[.id + 1] == "{") {
		eid <- end_bracket(.id + 1, ll)
		ll[.id] <<- "<sub>"
		ll[.id + 1] <<- ""
		ll[eid] <<- "</sub>"
		} else {
		ll[.id] <<- "<sub>"
		ll[.id + 1] <<- paste0(ll[.id + 1], "</sub>")
		}
		})
		}

		if(length(sup_id) > 0) {
		purrr::walk(sup_id, function(.id) {
		if(ll[.id + 1] == "{") {
		eid <- end_bracket(.id + 1, ll)
		ll[.id] <<- "<sup>"
		ll[.id + 1] <<- ""
		ll[eid] <<- "</sup>"
		} else {
		ll[.id] <<- "<sup>"
		ll[.id + 1] <<- paste0(ll[.id + 1], "</sup>")
		}
		})
		}

		paste0(ll, collapse = "")
		}, character(1), USE.NAMES = FALSE)
		x
		}

		#' @noRd
		end_bracket <- function(id, ll) {
		out <- integer(length(ll))
		out[ll == "{"] <- -1L
		out[ll == "}"] <- 1L
		s <- which(cumsum(out) == 0L)
		s[s > id][1L]
		}

man/geom_magic_text.Rd

0 → 100644

+49 −0

Original line number	Diff line number	Diff line
		% Generated by roxygen2: do not edit by hand
		% Please edit documentation in R/geom-magic-text.R
		\name{geom_magic_text}
		\alias{geom_magic_text}
		\title{Magic Method to Draw labels}
		\usage{
		geom_magic_text(
		mapping = NULL,
		data = NULL,
		stat = "identity",
		position = "identity",
		parse = TRUE,
		sup = "^",
		sub = "_",
		br = "\\n",
		...
		)
		}
		\arguments{
		\item{mapping}{set of aesthetic mappings created by \code{aes()} or \code{aes_()}.}

		\item{data}{the data to be displayed in this layer.}

		\item{stat}{the statistical transformation to use on the data for this layer,
		as a string.}

		\item{position}{position adjustment, either as a string, or the result of a
		call to a position adjustment function.}

		\item{parse}{logical. IF TRUE (default), the labels will be parsed into richtext.}

		\item{sup}{one-length character, indicates that characters after this is superscript.}

		\item{sub}{one-length character, indicates that characters after this is subscript.}

		\item{br}{string, separator of lines.}

		\item{...}{others passing to \code{ggtext::geom_richtext()}.}
		}
		\value{
		a gg layer object.
		}
		\description{
		a wrapper function of \code{ggtext::geom_richtext}, but can
		formatted labels by \code{LaTeX} style.
		}
		\author{
		Hou Yun
		}

Admin message