0.0.3 (f628f345) · Commits · github_fork / LinkET

DESCRIPTION

+7 −4

Original line number	Diff line number	Diff line
		Package: linkET
		Type: Package
		Title: Everything is Linkable
		Version: 0.0.2.10
		Version: 0.0.3
		Author: Houyun Huang <houyunhuang@163.com>
		Maintainer: Houyun Huang <houyunhuang@163.com>
		Description: The 'linkET' package can be used to visualize simply and directly a
		@@ -18,6 +18,7 @@ Encoding: UTF-8
		Depends: R (>= 3.5.0)
		Imports:
		dplyr,
		geomtextpath,
		ggplot2 (>= 3.0.0),
		glue,
		igraph,
		@@ -30,6 +31,7 @@ Imports:
		stats,
		utils
		Suggests:
		testthat (>= 3.0.0),
		ade4,
		ambient,
		colorspace,
		@@ -44,3 +46,4 @@ Suggests:
		rfPermute,
		WGCNA
		RoxygenNote: 7.1.2
		Config/testthat/edition: 3

NAMESPACE

+10 −11

Original line number	Diff line number	Diff line
		@@ -8,20 +8,21 @@ S3method(as_matrix_data,corr.test)
		S3method(as_matrix_data,correlate)
		S3method(as_matrix_data,data.frame)
		S3method(as_matrix_data,default)
		S3method(as_matrix_data,grouped_correlate)
		S3method(as_matrix_data,matrix)
		S3method(as_matrix_data,rcorr)
		S3method(as_md_tbl,corr.test)
		S3method(as_md_tbl,correlate)
		S3method(as_md_tbl,data.frame)
		S3method(as_md_tbl,easycorrelation)
		S3method(as_md_tbl,grouped_correlate)
		S3method(as_md_tbl,grouped_matrix_data)
		S3method(as_md_tbl,mantel_tbl)
		S3method(as_md_tbl,matrix)
		S3method(as_md_tbl,matrix_data)
		S3method(as_md_tbl,md_tbl)
		S3method(as_md_tbl,pro_tbl)
		S3method(as_md_tbl,rcorr)
		S3method(fortify,matrix_data)
		S3method(fortify,md_tbl)
		S3method(get_order,character)
		S3method(get_order,dendrogram)
		S3method(get_order,dist)
		@@ -35,25 +36,21 @@ S3method(ggplot_add,magic_text)
		S3method(ggplot_add,secondary_axis)
		S3method(print,calc_relimp)
		S3method(print,correlate)
		S3method(print,grouped_correlate)
		S3method(print,grouped_matrix_data)
		S3method(print,matrix_data)
		S3method(print,random_forest)
		S3method(qcorrplot,cor_md_tbl)
		S3method(qcorrplot,corr.test)
		S3method(qcorrplot,correlate)
		S3method(qcorrplot,data.frame)
		S3method(qcorrplot,easycorrelation)
		S3method(qcorrplot,mantel_tbl)
		S3method(qcorrplot,default)
		S3method(qcorrplot,matrix)
		S3method(qcorrplot,pro_tbl)
		S3method(qcorrplot,rcorr)
		S3method(t,matrix_data)
		S3method(t,md_tbl)
		export("%>%")
		export("col_names<-")
		export("row_names<-")
		export(DoughnutGrob)
		export(GeomCurve2)
		export(GeomDoughnut)
		export(GeomHalfcircle)
		export(GeomMark)
		export(GeomSquare)
		export(aes)
		@@ -83,6 +80,7 @@ export(geom_couple)
		export(geom_curve2)
		export(geom_diag_label)
		export(geom_doughnut)
		export(geom_halfcircle)
		export(geom_magic_text)
		export(geom_mark)
		export(geom_node_doughnut)
		@@ -91,6 +89,7 @@ export(geom_square)
		export(get_order)
		export(grid.doughnut)
		export(hyplot)
		export(is_grouped_matrix_data)
		export(is_matrix_data)
		export(is_md_tbl)
		export(latex_richtext)
		@@ -137,7 +136,7 @@ importFrom(ggplot2,draw_key_text)
		importFrom(ggplot2,element_blank)
		importFrom(ggplot2,element_text)
		importFrom(ggplot2,expand_limits)
		importFrom(ggplot2,fortify)
		importFrom(ggplot2,facet_wrap)
		importFrom(ggplot2,geom_label)
		importFrom(ggplot2,geom_segment)
		importFrom(ggplot2,geom_text)

R/as-matrix-data.R

+43 −7

Original line number	Diff line number	Diff line
		@@ -2,6 +2,7 @@
		#' @title as_matrix_data
		#' @param x any \code{R} object.
		#' @param name variable name.
		#' @param group a character vector used to split the matrix data.
		#' @param extra_mat a list of matrix.
		#' @param ... ignore.
		#' @return a matrix_data object.
		@@ -16,14 +17,17 @@ as_matrix_data <- function(x, ...)
		#' @rdname as_matrix_data
		#' @export
		#' @method as_matrix_data matrix
		as_matrix_data.matrix <- function(x, name = NULL, ...)
		as_matrix_data.matrix <- function(x,
		name = NULL,
		group = NULL,
		...)
		{
		if (is.null(name)) {
		name <- deparse(substitute(x))
		}

		x <- rlang::set_names(list(x), name)
		matrix_data(x, ...)
		matrix_data(x, group = group, ...)
		}

		#' @param include one of "numeric" (default), "character" or "factor".
		@@ -33,6 +37,7 @@ as_matrix_data.matrix <- function(x, name = NULL, ...)
		as_matrix_data.data.frame <- function(x,
		name = NULL,
		include = "numeric",
		group = NULL,
		...)
		{
		if (is.null(name)) {
		@@ -44,13 +49,15 @@ as_matrix_data.data.frame <- function(x,
		id <- vapply(x, Fun, logical(1))

		x <- rlang::set_names(list(x[id]), name)
		matrix_data(x, ...)
		matrix_data(x, group = group, ...)
		}

		#' @rdname as_matrix_data
		#' @export
		#' @method as_matrix_data correlate
		as_matrix_data.correlate <- function(x, extra_mat = list(), ...) {
		as_matrix_data.correlate <- function(x,
		extra_mat = list(),
		...) {
		id <- vapply(x, is.null, logical(1))
		x <- x[!id]
		if(length(extra_mat) > 0) {
		@@ -59,13 +66,40 @@ as_matrix_data.correlate <- function(x, extra_mat = list(), ...) {
		}
		x <- c(x, extra_mat)
		}
		matrix_data(x, ...)
		x <- matrix_data(x, group = NULL, ...)
		class(x) <- c("cor_matrix_data", class(x))
		x
		}

		#' @rdname as_matrix_data
		#' @export
		#' @method as_matrix_data grouped_correlate
		as_matrix_data.grouped_correlate <- function(x,
		extra_mat = list(),
		...) {
		nm <- names(x)
		if (length(extra_mat) > 0) {
		if (all(names(extra_mat) %in% nm)) {
		extra_mat <- extra_mat[nm]
		} else {
		extra_mat <- rep_len(list(extra_mat), length(x))
		names(extra_mat) <- nm
		}
		}
		x <- lapply(nm, function(.nm) {
		as_matrix_data(x = x[[.nm]], extra_mat = extra_mat[[.nm]], ...)
		})
		names(x) <- nm
		class(x) <- "grouped_matrix_data"
		x
		}

		#' @rdname as_matrix_data
		#' @export
		#' @method as_matrix_data rcorr
		as_matrix_data.rcorr <- function(x, extra_mat = list(), ...) {
		as_matrix_data.rcorr <- function(x,
		extra_mat = list(),
		...) {
		x <- as_correlate(x)
		as_matrix_data(x, extra_mat = extra_mat, ...)
		}
		@@ -73,7 +107,9 @@ as_matrix_data.rcorr <- function(x, extra_mat = list(), ...) {
		#' @rdname as_matrix_data
		#' @export
		#' @method as_matrix_data corr.test
		as_matrix_data.corr.test <- function(x, extra_mat = list(), ...) {
		as_matrix_data.corr.test <- function(x,
		extra_mat = list(),
		...) {
		x <- as_correlate(x)
		as_matrix_data(x, extra_mat = extra_mat, ...)
		}

R/as-tibble.R

+121 −30

Original line number	Diff line number	Diff line
		@@ -48,24 +48,72 @@ as_md_tbl.matrix_data <- function(x, ...)
		}
		}

		#' @method as_md_tbl grouped_matrix_data
		#' @rdname as_md_tbl
		#' @export
		as_md_tbl.grouped_matrix_data <- function(x, ...)
		{
		type <- vapply(x, attr, character(1), "type")
		diag <- vapply(x, attr, logical(1), "diag")
		row_names <- unique(unlist(lapply(x, attr, "row_names")))
		col_names <- unique(unlist(lapply(x, attr, "col_names")))

		is_corr <- all(vapply(x, function(.x) "cor_matrix_data" %in% class(.x),
		logical(1)))

		if (length(unique(type)) != 1L) {
		type <- "full"
		} else {
		type <- unique(type)
		}

		if (length(unique(diag)) != 1L) {
		diag <- TRUE
		} else {
		diag <- unique(diag)
		}

		x <- lapply(names(x), function(.nm) {
		as_md_tbl(x[[.nm]], ...) %>%
		mutate(.group = .nm)
		})

		if (is_corr) {
		clss <- c("grouped_md_tbl", "cor_md_tbl", class(x[[1]]))
		} else {
		clss <- c("grouped_md_tbl", class(x[[1]]))
		}

		structure(do.call(dplyr::bind_rows, x),
		type = type,
		diag = diag,
		row_names = row_names,
		col_names = col_names,
		class = clss)
		}

		#' @method as_md_tbl pro_tbl
		#' @rdname as_md_tbl
		#' @export
		as_md_tbl.pro_tbl <- function(x, byrow = TRUE, ...) {
		class(x) <- class(x)[-1L]

		grouped <- attr(x, "grouped")
		spec <- env <- NULL
		if(isTRUE(byrow)) {
		as_md_tbl(x,
		x <- as_md_tbl(x,
		row_vars = spec,
		col_vars = env,
		is_corr = TRUE)
		} else {
		as_md_tbl(x,
		x <- as_md_tbl(x,
		row_vars = env,
		col_vars = spec,
		is_corr = TRUE)
		}
		if (isTRUE(grouped)) {
		class(x) <- c("cor_md_tbl", "grouped_md_tbl", "md_tbl", "tbl_df", "tbl", "data.frame")
		}
		x
		}

		#' @method as_md_tbl mantel_tbl
		@@ -73,19 +121,23 @@ as_md_tbl.pro_tbl <- function(x, byrow = TRUE, ...) {
		#' @export
		as_md_tbl.mantel_tbl <- function(x, byrow = TRUE, ...) {
		class(x) <- class(x)[-1L]

		grouped <- attr(x, "grouped")
		spec <- env <- NULL
		if(isTRUE(byrow)) {
		as_md_tbl(x,
		x <- as_md_tbl(x,
		row_vars = spec,
		col_vars = env,
		is_corr = TRUE)
		} else {
		as_md_tbl(x,
		x <- as_md_tbl(x,
		row_vars = env,
		col_vars = spec,
		is_corr = TRUE)
		}
		if (isTRUE(grouped)) {
		class(x) <- c("cor_md_tbl", "grouped_md_tbl", "md_tbl", "tbl_df", "tbl", "data.frame")
		}
		x
		}

		#' @method as_md_tbl easycorrelation
		@@ -95,20 +147,17 @@ as_md_tbl.easycorrelation <- function(x,
		type = "full",
		diag = TRUE,
		...) {
		if(inherits(x, "grouped_easycorrelation")) {
		stop("`grouped_easycorrelation` method of `as_md_tbl()`",
		" is not implemented yet.", call. = FALSE)
		}
		if(nrow(x) < 1) {
		stop("Empty data.", call. = FALSE)
		}

		grouped <- inherits(x, "grouped_easycorrelation")
		type <- match.arg(type, c("full", "upper", "lower"))
		is_null_data2 <- is.null(attr(x, "data2"))
		row_names <- unique(x$Parameter1)
		col_names <- unique(x$Parameter2)

		if(!isTRUE(is_null_data2)) {
		if(isFALSE(is_null_data2)) {
		if(type %in% c("upper", "lower")) {
		warning("'type = ", type, "' just support for symmetric matrices.")
		}
		@@ -118,6 +167,9 @@ as_md_tbl.easycorrelation <- function(x,
		.colnames = x$Parameter2,
		r = x$r,
		p = x$p)
		if (isTRUE(grouped)) {
		out$.group <- x$Group
		}
		} else {
		row_names <- col_names <- c(row_names, col_names[length(col_names)])
		if(type == "full") {
		@@ -125,33 +177,53 @@ as_md_tbl.easycorrelation <- function(x,
		.colnames = c(x$Parameter2, x$Parameter1),
		r = c(x$r, x$r),
		p = c(x$p, x$p))

		if (isTRUE(grouped)) {
		out$.group <- c(x$Group, x$Group)
		}
		} else if(type == "upper") {
		out <- tibble(.rownames = x$Parameter1,
		.colnames = x$Parameter2,
		r = x$r,
		p = x$p)
		if (isTRUE(grouped)) {
		out$.group <- x$Group
		}
		} else {
		out <- tibble(.rownames = x$Parameter2,
		.colnames = x$Parameter1,
		r = x$r,
		p = x$p)
		if (isTRUE(grouped)) {
		out$.group <- x$Group
		}
		}
		if(isTRUE(diag)) {
		diag_tbl <- tibble(.rownames = row_names,
		.colnames = col_names,
		r = 1,
		p = 0)
		if (isTRUE(grouped)) {
		n <- length(unique(x$Group))
		id <- rep(seq_along(row_names), each = n)
		diag_tbl <- diag_tbl[id, ]
		diag_tbl$.group <- rep(unique(x$Group), length(row_names))
		}
		out <- bind_rows(out, diag_tbl)
		}
		}

		clss <- if (isTRUE(grouped)) {
		c("cor_md_tbl", "grouped_md_tbl", "md_tbl", "tbl_df", "tbl", "data.frame")
		} else {
		c("cor_md_tbl", "md_tbl", "tbl_df", "tbl", "data.frame")
		}

		structure(.Data = out,
		row_names = row_names,
		col_names = col_names,
		type = type,
		diag = diag,
		class = c("cor_md_tbl", "md_tbl", "tbl_df", "tbl", "data.frame"))
		class = clss)
		}

		#' @method as_md_tbl correlate
		@@ -163,6 +235,15 @@ as_md_tbl.correlate <- function(x, ...) {
		x
		}

		#' @method as_md_tbl grouped_correlate
		#' @rdname as_md_tbl
		#' @export
		as_md_tbl.grouped_correlate <- function(x, ...) {
		x <- as_md_tbl(as_matrix_data(x, ...))
		class(x) <- c("cor_md_tbl", class(x))
		x
		}

		#' @method as_md_tbl rcorr
		#' @rdname as_md_tbl
		#' @export
		@@ -177,7 +258,7 @@ as_md_tbl.corr.test <- function(x, ...) {
		as_md_tbl(as_correlate(x), ...)
		}

		#' @param row_vars,col_vars variable name of row/column id.
		#' @param row_vars,col_vars,group_vars variable name of row/column/group id.
		#' @param row_names,col_names character, row/column names of matrix.
		#' @param is_corr if TRUE, the data will be regarded as the correlation
		#' coefficient.
		@@ -190,6 +271,7 @@ as_md_tbl.data.frame <- function(x,
		name = NULL,
		row_vars = NULL,
		col_vars = NULL,
		group_vars = NULL,
		row_names = NULL,
		col_names = NULL,
		is_corr = FALSE,
		@@ -198,6 +280,7 @@ as_md_tbl.data.frame <- function(x,
		...) {
		row_vars <- rlang::enquo(row_vars)
		col_vars <- rlang::enquo(col_vars)
		group_vars <- rlang::enquo(group_vars)
		if(rlang::quo_is_null(row_vars) \|\| rlang::quo_is_null(col_vars)) {
		if(isTRUE(is_corr)) {
		x <- as_md_tbl(as_correlate(x, is_corr = TRUE), ...)
		@@ -205,15 +288,25 @@ as_md_tbl.data.frame <- function(x,
		if (is.null(name)) {
		name <- deparse(substitute(x))
		}
		x <- as_md_tbl(as_matrix_data(x, name = name), ...)
		if (!rlang::quo_is_null(group_vars)) {
		group <- rlang::eval_tidy(group_vars, x)
		}
		x <- as_md_tbl(as_matrix_data(x, name = name, group = group), ...)
		}
		} else {
		row_vars <- rlang::as_name(row_vars)
		col_vars <- rlang::as_name(col_vars)
		x <- rename(x, .rownames = row_vars, .colnames = col_vars)
		if (!rlang::quo_is_null(group_vars)) {
		x <- rename(x, .group = rlang::as_name(group_vars))
		class(x) <- c("grouped_md_tbl", "md_tbl", "tbl_df", "tbl", "data.frame")
		} else {
		class(x) <- c("md_tbl", "tbl_df", "tbl", "data.frame")
		}

		if(isTRUE(is_corr)) {
		class(x) <- c("cor_md_tbl", "md_tbl", "tbl_df", "tbl", "data.frame")
		class(x) <- c("cor_md_tbl", class(x))

		r_vars <- rlang::enquo(r_vars)
		p_vars <- rlang::enquo(p_vars)
		if(!rlang::quo_is_null(r_vars)) {
		@@ -225,8 +318,6 @@ as_md_tbl.data.frame <- function(x,
		if(!"r" %in% names(x)) {
		stop("Did you forget to set the 'r_vars' param?", call. = FALSE)
		}
		} else {
		class(x) <- c("md_tbl", "tbl_df", "tbl", "data.frame")
		}

		attr(x, "row_names") <- row_names %\|\|% unique(x$.rownames)

R/cluster-and-reorder.R

+4 −0

Original line number	Diff line number	Diff line
		@@ -16,6 +16,10 @@ make_cluster <- function(md,
		row_dist = NULL,
		col_dist = NULL)
		{
		if (is_grouped_matrix_data(md)) {
		return(md)
		}

		stopifnot(is_matrix_data(md))
		cluster <- match.arg(cluster, c("all", "row", "col", "none"))
		if (cluster == "none") {

Admin message