export annotateGrob and fixed a few bugs (1be8c443) · Commits · github_fork / LinkET

NAMESPACE

+10 −0

Original line number	Original line	Diff line number	Diff line
	# Generated by roxygen2: do not edit by hand		# Generated by roxygen2: do not edit by hand

	S3method("[",marker)		S3method("[",marker)
			S3method(annotateGrob,"NULL")
			S3method(annotateGrob,"magick-image")
			S3method(annotateGrob,character)
			S3method(annotateGrob,ggplot)
			S3method(annotateGrob,grob)
			S3method(annotateGrob,numeric)
			S3method(annotateGrob,raster)
	S3method(as_md_tbl,corr.test)		S3method(as_md_tbl,corr.test)
	S3method(c,marker)		S3method(c,marker)
	S3method(get_order,character)		S3method(get_order,character)
	@@ -22,6 +29,7 @@ S3method(guide_gengrob,guide_child)
	S3method(guide_train,guide_child)		S3method(guide_train,guide_child)
	S3method(guide_transform,guide_child)		S3method(guide_transform,guide_child)
	S3method(length,marker)		S3method(length,marker)
			S3method(makeContent,annotateGrob)
	S3method(makeContent,markerGrob)		S3method(makeContent,markerGrob)
	S3method(plot,gggplot)		S3method(plot,gggplot)
	S3method(print,calc_relimp)		S3method(print,calc_relimp)
	@@ -44,6 +52,7 @@ export("%>%")
	export("col_names<-")		export("col_names<-")
	export("row_names<-")		export("row_names<-")
	export(DoughnutGrob)		export(DoughnutGrob)
			export(GeomAnnotate)
	export(GeomCorr)		export(GeomCorr)
	export(GeomDoughnut)		export(GeomDoughnut)
	export(GeomMark)		export(GeomMark)
	@@ -52,6 +61,7 @@ export(Geomshaping)
	export(adjacency_matrix)		export(adjacency_matrix)
	export(aes)		export(aes)
	export(anno_link)		export(anno_link)
			export(annotateGrob)
	export(as.igraph)		export(as.igraph)
	export(as_correlate)		export(as_correlate)
	export(as_matrix_data)		export(as_matrix_data)

R/geom-annotate.R

+124 −64

Original line number	Original line	Diff line number	Diff line
	@@ -18,59 +18,37 @@
	#' @param width,height width/height of annotate.		#' @param width,height width/height of annotate.
	#' @param nudge_x,nudge_y a minor shift of position, should be a grid::unit object.		#' @param nudge_x,nudge_y a minor shift of position, should be a grid::unit object.
	#' @return a layer object.		#' @return a layer object.
			#' @param na.rm not used.
			#' @param digits integer indicating the number of decimal places (round)
			#' to be used, the default value is 2.
			#' @param nsmall the minimum number of digits to the right of the decimal point,
			#' the default value is 2.
	#' @rdname geom_annotate		#' @rdname geom_annotate
	#' @export		#' @export
	geom_annotate <- function(annotate = NULL,		geom_annotate <- function(mapping = NULL,
	...,
	mapping = NULL,
	data = NULL,		data = NULL,
	stat = "identity",		stat = "identity",
	position = "rt",		position = "rt",
	inherit.aes = TRUE,		inherit.aes = TRUE,
	show.legend = FALSE,		show.legend = FALSE,
			...,
			annotate = NULL,
	width = NULL,		width = NULL,
	height = NULL,		height = NULL,
	nudge_x = NULL,
	nudge_y = NULL,
	na.rm = FALSE)		na.rm = FALSE)
	{		{
	if (is.null(mapping)) {		params <- list(...)
	required_aes <- NULL		others <- params[setdiff(names(params), c("v", "h", "nudge_x", "nudge_y"))]
			params <- params[intersect(names(params), c("v", "h", "nudge_x", "nudge_y"))]
			if (inherits(annotate, "ggplot") \|\| inherits(annotate, "grob") \|\|
			inherits(annotate, "raster") \|\| inherits(annotate, "magick-image")) {
			annotate <- list(annotate)
			width <- width %\|\|% 0.5
			height <- height %\|\|% 0.5
	} else {		} else {
	required_aes <- names(mapping)		annotate <- as.list(annotate)
	}
	if (packageVersion("ggplot2") <= "3.3.5") {
	default_aes = aes(xmin = -Inf, xmax = -Inf)
	} else {
	default_aes = aes()
	}		}

	GeomAnnotate <- ggproto(
	"GeomAnnotate", Geom,
	required_aes = required_aes,
	default_aes = default_aes,
	draw_panel = function(data,
	panel_params,
	coord,
	annotate = NULL,
	position = "rt",
	width = NULL,
	height = NULL,
	nudge_x = NULL,
	nudge_y = NULL,
	params = list(),
	na.rm = FALSE) {
	params <- c(list(annotate = annotate,
	position = position,
	width = width,
	height = height,
	nudge_x = nudge_x,
	nudge_y = nudge_y), params)
	do.call(annotateGrob, params)
	},
	draw_key = ggplot2::draw_key_blank
	)

	layer(		layer(
	data = data,		data = data,
	mapping = mapping,		mapping = mapping,
	@@ -79,25 +57,83 @@ geom_annotate <- function(annotate = NULL,
	position = "identity",		position = "identity",
	show.legend = show.legend,		show.legend = show.legend,
	inherit.aes = inherit.aes,		inherit.aes = inherit.aes,
	params = list(		params = c(
			list(
	annotate = annotate,		annotate = annotate,
	position = position,		position = position,
	width = width,		width = width,
	height = height,		height = height,
	nudge_x = nudge_x,		params = others,
	nudge_y = nudge_y,
	params = list(...),
	na.rm = na.rm		na.rm = na.rm
			),
			params
	)		)
	)		)
	}		}

	#' @noRd		#' @rdname linkET-extensions
			#' @format NULL
			#' @usage NULL
			#' @export
			GeomAnnotate <- ggproto(
			"GeomAnnotate", Geom,
			required_aes = NULL,
			default_aes = aes(ids = NULL, h = "r", v = "t", nudge_x = 0, nudge_y = 0),
			draw_panel = function(data,
			panel_params,
			coord,
			annotate = list(),
			position = NULL,
			width = NULL,
			height = NULL,
			params = list(),
			na.rm = FALSE) {
			if (empty(annotate) \|\| empty(data)) {
			return(grid::nullGrob())
			}

			if (!is.null(data$ids)) {
			if (is.null(names(annotate))) {
			stop("annotate should be a named list.", call. = FALSE)
			}
			annotate <- annotate[intersect(names(annotate),
			unique(as.character(data$ids), TRUE))]
			if (is_nested_annotate_list(annotate)) {
			annotate <- Reduce("c", annotate)
			}
			}
			if (empty(annotate)) {
			return(grid::nullGrob())
			}

			data <- data[seq_len(length(annotate)), , drop = FALSE]
			n <- nrow(data)

			grobs <- lapply(seq_len(n), function(id) {
			rows <- data[id, , drop = FALSE]
			pp <- c(list(annotate = annotate[[id]],
			position = position %\|\|% paste0(rows$h, rows$v),
			width = width,
			height = height,
			nudge_x = rows$nudge_x,
			nudge_y = rows$nudge_y), params)
			do.call(annotateGrob, pp)
			})
			ggname("geom_annotate", do.call("grobTree", grobs))
			},
			draw_key = ggplot2::draw_key_blank
			)

			#' @rdname geom_annotate
			#' @param default.units A string indicating the default units to use.
			#' @export
	annotateGrob <- function(annotate, ...) {		annotateGrob <- function(annotate, ...) {
	UseMethod("annotateGrob")		UseMethod("annotateGrob")
	}		}

	#' @noRd		#' @rdname geom_annotate
			#' @method annotateGrob grob
			#' @export
	annotateGrob.grob <- function(annotate,		annotateGrob.grob <- function(annotate,
	position = "rt",		position = "rt",
	width = NULL,		width = NULL,
	@@ -150,7 +186,9 @@ annotateGrob.grob <- function(annotate,
	cl = "annotateGrob")		cl = "annotateGrob")
	}		}

	#' @noRd		#' @rdname geom_annotate
			#' @method annotateGrob character
			#' @export
	annotateGrob.character <- function(annotate,		annotateGrob.character <- function(annotate,
	position = "rt",		position = "rt",
	width = NULL,		width = NULL,
	@@ -174,7 +212,9 @@ annotateGrob.character <- function(annotate,
	default.units = default.units)		default.units = default.units)
	}		}

	#' @noRd		#' @rdname geom_annotate
			#' @method annotateGrob raster
			#' @export
	annotateGrob.raster <- function(annotate,		annotateGrob.raster <- function(annotate,
	position = "rt",		position = "rt",
	width = 0.5,		width = 0.5,
	@@ -197,7 +237,9 @@ annotateGrob.raster <- function(annotate,
	default.units = default.units)		default.units = default.units)
	}		}

	#' @noRd		#' @rdname geom_annotate
			#' @method annotateGrob magick-image
			#' @export
	`annotateGrob.magick-image` <- function(annotate,		`annotateGrob.magick-image` <- function(annotate,
	position = "rt",		position = "rt",
	width = 0.5,		width = 0.5,
	@@ -217,7 +259,9 @@ annotateGrob.raster <- function(annotate,
	...)		...)
	}		}

	#' @noRd		#' @rdname geom_annotate
			#' @method annotateGrob ggplot
			#' @export
	annotateGrob.ggplot <- function(annotate,		annotateGrob.ggplot <- function(annotate,
	position = "rt",		position = "rt",
	width = 0.5,		width = 0.5,
	@@ -237,20 +281,26 @@ annotateGrob.ggplot <- function(annotate,
	...)		...)
	}		}

	#' @noRd		#' @rdname geom_annotate
			#' @method annotateGrob NULL
			#' @export
	annotateGrob.NULL <- function(annotate, ...) {		annotateGrob.NULL <- function(annotate, ...) {
	annotate <- grid::nullGrob()		annotate <- grid::nullGrob()
	annotateGrob(annotate = annotate,		annotateGrob(annotate = annotate, ...)
	position = position,
	width = width,
	height = height,
	nudge_x = nudge_x,
	nudge_y = nudge_y,
	default.units = default.units,
	...)
	}		}

	#' @noRd		#' @rdname geom_annotate
			#' @method annotateGrob numeric
			#' @export
			annotateGrob.numeric <- function(annotate,
			digits = 2,
			nsmall = 2,
			...) {
			annotate <- format(annotate, digits = digits, nsmall = nsmall)
			annotateGrob(annotate = annotate, ...)
			}

			#' @export
	makeContent.annotateGrob <- function(x) {		makeContent.annotateGrob <- function(x) {
	annotate <- x$annotate		annotate <- x$annotate
	xx <- x$x		xx <- x$x
	@@ -300,3 +350,13 @@ makeContent.annotateGrob <- function(x) {

	grid::setChildren(x, do.call(grid::gList, list(annotate)))		grid::setChildren(x, do.call(grid::gList, list(annotate)))
	}		}

			#' @noRd
			is_nested_annotate_list <- function(annotate) {
			id <- vapply(annotate, function(x) {
			is.list(x) && !inherits(x, "ggplot") && !inherits(x, "grob") &&
			!inherits(x, "raster") && !inherits(x, "magick-image") &&
			!inherits(x, "NULL")
			}, logical(1))
			if (any(id)) TRUE else FALSE
			}

man/geom_annotate.Rd

+85 −8

Original line number	Original line	Diff line number	Diff line
	@@ -2,29 +2,92 @@
	% Please edit documentation in R/geom-annotate.R		% Please edit documentation in R/geom-annotate.R
	\name{geom_annotate}		\name{geom_annotate}
	\alias{geom_annotate}		\alias{geom_annotate}
			\alias{annotateGrob}
			\alias{annotateGrob.grob}
			\alias{annotateGrob.character}
			\alias{annotateGrob.raster}
			\alias{annotateGrob.magick-image}
			\alias{annotateGrob.ggplot}
			\alias{annotateGrob.NULL}
			\alias{annotateGrob.numeric}
	\title{Annotate Layer}		\title{Annotate Layer}
	\usage{		\usage{
	geom_annotate(		geom_annotate(
	annotate = NULL,
	...,
	mapping = NULL,		mapping = NULL,
	data = NULL,		data = NULL,
	stat = "identity",		stat = "identity",
	position = "rt",		position = "rt",
	inherit.aes = TRUE,		inherit.aes = TRUE,
	show.legend = FALSE,		show.legend = FALSE,
			...,
			annotate = NULL,
	width = NULL,		width = NULL,
	height = NULL,		height = NULL,
	nudge_x = NULL,
	nudge_y = NULL,
	na.rm = FALSE		na.rm = FALSE
	)		)
	}
	\arguments{
	\item{annotate}{a grob object, or other object can be converted to a grob.}

	\item{...}{other parameters passing to convert-function.}		annotateGrob(annotate, ...)

			\method{annotateGrob}{grob}(
			annotate,
			position = "rt",
			width = NULL,
			height = NULL,
			nudge_x = 0,
			nudge_y = 0,
			default.units = "npc",
			...
			)

			\method{annotateGrob}{character}(
			annotate,
			position = "rt",
			width = NULL,
			height = NULL,
			nudge_x = 0,
			nudge_y = 0,
			default.units = "npc",
			...
			)

			\method{annotateGrob}{raster}(
			annotate,
			position = "rt",
			width = 0.5,
			height = 0.5,
			nudge_x = 0,
			nudge_y = 0,
			default.units = "npc",
			...
			)

			\method{annotateGrob}{`magick-image`}(
			annotate,
			position = "rt",
			width = 0.5,
			height = 0.5,
			nudge_x = 0,
			nudge_y = 0,
			default.units = "npc",
			...
			)

			\method{annotateGrob}{ggplot}(
			annotate,
			position = "rt",
			width = 0.5,
			height = 0.5,
			nudge_x = 0,
			nudge_y = 0,
			default.units = "npc",
			...
			)

			\method{annotateGrob}{`NULL`}(annotate, ...)

			\method{annotateGrob}{numeric}(annotate, digits = 2, nsmall = 2, ...)
			}
			\arguments{
	\item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or		\item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or
	\code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the		\code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the
	default), it is combined with the default mapping at the top level of the		default), it is combined with the default mapping at the top level of the
	@@ -72,9 +135,23 @@ the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.}
	It can also be a named logical vector to finely select the aesthetics to		It can also be a named logical vector to finely select the aesthetics to
	display.}		display.}

			\item{...}{other parameters passing to convert-function.}

			\item{annotate}{a grob object, or other object can be converted to a grob.}

	\item{width, height}{width/height of annotate.}		\item{width, height}{width/height of annotate.}

			\item{na.rm}{not used.}

	\item{nudge_x, nudge_y}{a minor shift of position, should be a grid::unit object.}		\item{nudge_x, nudge_y}{a minor shift of position, should be a grid::unit object.}

			\item{default.units}{A string indicating the default units to use.}

			\item{digits}{integer indicating the number of decimal places (round)
			to be used, the default value is 2.}

			\item{nsmall}{the minimum number of digits to the right of the decimal point,
			the default value is 2.}
	}		}
	\value{		\value{
	a layer object.		a layer object.

man/linkET-extensions.Rd

+5 −3

Original line number	Original line	Diff line number	Diff line
	% Generated by roxygen2: do not edit by hand		% Generated by roxygen2: do not edit by hand
	% Please edit documentation in R/geom-curve2.R, R/geom-doughnut.R,		% Please edit documentation in R/geom-annotate.R, R/geom-curve2.R,
	% R/geom-mark.R, R/geom-shaping.R, R/geom-square.R, R/ggproto.R		% R/geom-doughnut.R, R/geom-mark.R, R/geom-shaping.R, R/geom-square.R,
			% R/ggproto.R
	\docType{data}		\docType{data}
	\name{GeomCurve2}		\name{GeomAnnotate}
			\alias{GeomAnnotate}
	\alias{GeomCurve2}		\alias{GeomCurve2}
	\alias{GeomDoughnut}		\alias{GeomDoughnut}
	\alias{GeomMark}		\alias{GeomMark}

Admin message