correlation engine for correlate (bc19fc9c) · Commits · github_fork / LinkET

R/as-correlate.R

+54 −0

Original line number	Diff line number	Diff line
		@@ -55,6 +55,60 @@ as_correlate.data.frame <- function(x, ...) {
		as_correlate(as.matrix(x), ...)
		}

		#' @method as_correlate easycorrelation
		#' @rdname as_correlate
		as_correlate.easycorrelation <- function(x, ...) {
		if(nrow(x) < 1) {
		stop("Empty data.", call. = FALSE)
		}

		grouped <- inherits(x, "grouped_easycorrelation")
		is_null_data2 <- is.null(attr(x, "data2"))
		row_names <- unique(x$Parameter1)
		col_names <- unique(x$Parameter2)

		if(isFALSE(is_null_data2)) {
		corr <- tibble(.rownames = x$Parameter1,
		.colnames = x$Parameter2,
		r = x$r,
		p = x$p)
		if (isTRUE(grouped)) {
		corr$.group <- x$Group
		}
		} else {
		corr <- tibble(.rownames = c(x$Parameter1, x$Parameter2),
		.colnames = c(x$Parameter2, x$Parameter1),
		r = c(x$r, x$r),
		p = c(x$p, x$p))
		if (isTRUE(grouped)) {
		corr$.group <- c(x$Group, x$Group)
		}
		}
		mat <- matrix(nrow = length(row_names),
		ncol = length(col_names),
		dimnames = list(row_names, col_names))
		corr$.rownames <- as.integer(factor(corr$.rownames, levels = row_names))
		corr$.colnames <- as.integer(factor(corr$.colnames, levels = col_names))

		if (isTRUE(grouped)) {
		out <- lapply(split(corr, corr$.group), function(.corr) {
		r <- mat
		p <- mat
		r[.corr$.rownames, .corr$.colnames] <- .corr$r
		p[.corr$.rownames, .corr$.colnames] <- .corr$p
		as_correlate(x = r, p = p, is_corr = TRUE)
		})
		class(out) <- "grouped_correlate"
		} else {
		r <- mat
		p <- mat
		r[corr$.rownames, corr$.colnames] <- corr$r
		p[corr$.rownames, corr$.colnames] <- corr$p
		out <- as_correlate(x = r, p = p, is_corr = TRUE)
		}
		out
		}


		#' @noRd
		check_corr <- function(x) {

R/correlate.R

+15 −5

Original line number	Diff line number	Diff line
		@@ -57,14 +57,13 @@ correlate <- function(x,
		adjust_method = "holm",
		engine = "default",
		...) {
		engine <- match.arg(engine, c("default", "WGCNA", "picante", "Hmisc", "psych"))
		engine <- match.arg(engine, c("default", "WGCNA", "picante", "Hmisc", "psych",
		"correlation"))
		if (engine == "picante" && !is.null(y)) {
		warning("`y` will be abandoned when 'engine = picante'.", call. = FALSE)
		y <- NULL
		}



		if (is.null(group)) {
		if (engine == "default") {
		out <- .correlate(x = x,
		@@ -106,7 +105,7 @@ correlate <- function(x,
		adjust_method <- match.arg(adjust_method, p.adjust.methods)
		out$p <- p.adjust(out$p, adjust_method)
		}
		} else {
		} else if (engine == "psych") {
		corr.test <- get_function("psych", "corr.test")
		x <- as.data.frame(x)
		y <- if (is.null(y)) y else as.data.frame(y)
		@@ -114,7 +113,18 @@ correlate <- function(x,
		y = y,
		use = if (use == "everything") "complete" else "pairwise",
		method = method,
		adjust = if (isTRUE(adjust)) adjust_method else "none"))
		adjust = if (isTRUE(adjust)) adjust_method else "none",
		...))
		} else {
		correlation <- get_function("correlation", "correlation")
		x <- as.data.frame(x)
		y <- if (is.null(y)) y else as.data.frame(y)
		p_adjust <- if (isTRUE(adjust)) adjust_method else "none"
		out <- as_correlate(correlation(data = x,
		data2 = y,
		method = method,
		p_adjust = p_adjust,
		...))
		}
		} else {
		if (length(group) != nrow(x)) {

man/as_correlate.Rd

+3 −0

Original line number	Diff line number	Diff line
		@@ -6,6 +6,7 @@
		\alias{as_correlate.corr.test}
		\alias{as_correlate.matrix}
		\alias{as_correlate.data.frame}
		\alias{as_correlate.easycorrelation}
		\title{Coerce a object to correlate}
		\usage{
		as_correlate(x, ...)
		@@ -17,6 +18,8 @@ as_correlate(x, ...)
		\method{as_correlate}{matrix}(x, is_corr = NULL, p = NULL, ...)

		\method{as_correlate}{data.frame}(x, ...)

		\method{as_correlate}{easycorrelation}(x, ...)
		}
		\arguments{
		\item{x}{any \code{R} object can convert to correlate.}

Admin message