fixed geom_couple bugs when facet (c80c64e9) · Commits · github_fork / LinkET

R/geom-couple.R

+119 −98

Original line number	Diff line number	Diff line
		@@ -75,8 +75,14 @@ ggplot_add.geom_couple <- function(object, plot, object_name) {
		}
		}

		facets <- get_facet_vars(plot)
		if (length(facets) > 1L) {
		stop("Multi facets has not been implemented.", call. = FALSE)
		}
		if (!is.null(facets) && !facets %in% names(object$data)) {
		stop("Not contain facets vars in data of geom_couple().", call. = FALSE)
		}
		link_data <- link_tbl(data = object$data,
		md = md,
		row_names = rev(row_names(md)),
		col_names = col_names(md),
		type = type,
		@@ -85,7 +91,8 @@ ggplot_add.geom_couple <- function(object, plot, object_name) {
		to = to,
		drop = object$drop,
		offset_x = object$offset_x,
		offset_y = object$offset_y)
		offset_y = object$offset_y,
		facets = facets)

		.isEdge <- NULL
		edge <- dplyr::filter(link_data, .isEdge)
		@@ -178,7 +185,6 @@ nice_curvature <- function(curvature, by = "to") {

		#' @noRd
		link_tbl <- function(data,
		md,
		row_names,
		col_names,
		type,
		@@ -187,13 +193,10 @@ link_tbl <- function(data,
		to = NULL,
		drop = TRUE,
		offset_x = NULL,
		offset_y = NULL)
		offset_y = NULL,
		facets = NULL)
		{
		if(!is_md_tbl(md)) {
		stop("Need a md_tbl.", call. = FALSE)
		}


		if (is.null(facets)) {
		from <- if(is.null(from)) {
		data[[1]]
		} else {
		@@ -292,8 +295,25 @@ link_tbl <- function(data,
		.y = y[unique_from],
		.label = unique_from,
		.isEdge = FALSE)

		dplyr::bind_rows(dplyr::bind_cols(edge, data), node)
		} else {
		data <- split(data, data[[facets]])
		purrr::map2_dfr(data, names(data), function(.data, .name) {
		df <- link_tbl(data = .data,
		row_names = row_names,
		col_names = col_names,
		type = type,
		diag = diag,
		from = from,
		to = to,
		drop = drop,
		offset_x = offset_x,
		offset_y = offset_y,
		facets = NULL)
		df[[facets]][!df$.isEdge] <- .name
		df
		})
		}
		}

		offset <- function(..x.., ...) {
		@@ -321,3 +341,4 @@ offset <- function(..x.., ...) {
		}
		..x..
		}

R/hyplot.R

+12 −2

Original line number	Diff line number	Diff line
		@@ -6,6 +6,7 @@
		#' @param use_md logical. if TRUE, will use \code{ggtext::element_markdown()} to
		#' draw the axis labels.
		#' @param facets a parameters list of \code{facet_wrap}.
		#' @param facets_order character vector to set the order of facet panels.
		#' @param ... passing to \code{\link{as_matrix_data}}.
		#' @return a ggplot object.
		#' @importFrom ggplot2 ggplot
		@@ -26,6 +27,7 @@ hyplot <- function(md,
		drop = TRUE,
		use_md = NULL,
		facets = list(),
		facets_order = NULL,
		...) {
		if (!is_matrix_data(md) && !is_grouped_matrix_data(md) && !is_md_tbl(md)) {
		if (!"name" %in% names(list(...))) {
		@@ -79,6 +81,14 @@ hyplot <- function(md,
		mapping <- modifyList(base_mapping, mapping)
		}

		if (isTRUE(grouped)) {
		.group <- NULL
		if (!is.null(facets_order)) {
		md$.group <- factor(md$.group, levels = facets_order)
		}
		facets$facets <- facets$facets %\|\|% ~ .group
		}

		p <- ggplot(data = md,
		mapping = mapping)
		p <- p + scale_x_discrete(limits = col_names,
		@@ -96,11 +106,11 @@ hyplot <- function(md,
		# adjust the default theme
		p <- p + theme_hy(legend.position = guide_pos, use_md = use_md)

		# auto facets
		if (isTRUE(grouped)) {
		.group <- NULL
		facets$facets <- facets$facets %\|\|% ~ .group
		p <- p + do.call(facet_wrap, facets)
		}

		class(p) <- c("hyplot", class(p))
		p
		}

R/qcorrplot.R

+7 −2

Original line number	Diff line number	Diff line
		@@ -9,6 +9,7 @@
		#' @param use_md logical. if TRUE, will use \code{ggtext::element_markdown()} to
		#' draw the axis labels.
		#' @param facets NULL or a parameters list of \code{facet_wrap}.
		#' @param facets_order character vector to set the order of facet panels.
		#' @param ... other parameters.
		#' @return a gg object.
		#' @rdname qcorrplot
		@@ -38,6 +39,7 @@ qcorrplot.cor_md_tbl <- function(data,
		fixed = TRUE,
		use_md = NULL,
		facets = list(),
		facets_order = NULL,
		...) {
		if("p" %in% names(data)) {
		base_mapping <- aes_(fill = ~r, r = ~r, r0 = ~r, pvalue = ~p)
		@@ -49,7 +51,8 @@ qcorrplot.cor_md_tbl <- function(data,
		mapping = aes_modify(base_mapping, mapping),
		drop = drop,
		use_md = use_md,
		facets = facets)
		facets = facets,
		facets_order = facets_order)

		## add panel grid
		p <- p + geom_panel_grid(colour = grid_col, size = grid_size)
		@@ -123,6 +126,7 @@ qcorrplot.default <- function(data,
		fixed = TRUE,
		use_md = NULL,
		facets = list(),
		facets_order = NULL,
		...) {
		data <- as_md_tbl(data, ...)
		qcorrplot(data = data,
		@@ -132,5 +136,6 @@ qcorrplot.default <- function(data,
		grid_size = grid_size,
		fixed = fixed,
		use_md = use_md,
		facets = facets)
		facets = facets,
		facets_order = facets_order)
		}

R/utils.R

+9 −0

Original line number	Diff line number	Diff line
		@@ -153,3 +153,12 @@ df_to_matrix <- function(x,
		matrix(vv, nrow = length(rnm), ncol = length(cnm),
		dimnames = list(rnm, cnm))
		}

		#' @noRd
		get_facet_vars <- function(plot) {
		if (inherits(plot$facet, "FacetNull")) {
		return(NULL)
		}
		facet <- plot$facet$params$facets
		names(facet)
		}

man/hyplot.Rd

+11 −1

Original line number	Diff line number	Diff line
		@@ -4,7 +4,15 @@
		\alias{hyplot}
		\title{Initialize hyplot}
		\usage{
		hyplot(md, mapping = NULL, drop = TRUE, use_md = NULL, facets = list(), ...)
		hyplot(
		md,
		mapping = NULL,
		drop = TRUE,
		use_md = NULL,
		facets = list(),
		facets_order = NULL,
		...
		)
		}
		\arguments{
		\item{md}{a matrix_data or md_tbl object or any can be converted to matrix_data.}
		@@ -18,6 +26,8 @@ draw the axis labels.}

		\item{facets}{a parameters list of \code{facet_wrap}.}

		\item{facets_order}{character vector to set the order of facet panels.}

		\item{...}{passing to \code{\link{as_matrix_data}}.}
		}
		\value{

Admin message