R/correlation_function_utility.R

Defines functions get.gl.weights get.mb.weights sparcc.link rho.link

#--------------------------------------#
#'@export
rho.link <- function(data){

	require(propr)
	weights <- suppressMessages(propr(data)@matrix)
	colnames(weights) <- rownames(weights) <- colnames(data)

	return(weights)
}

#--------------------------------------#
#'@export
sparcc.link <- function(data){

	require(SpiecEasi)
	weights <- sparcc(data)$Cor
	colnames(weights) <- rownames(weights) <- colnames(data)

	return(weights)
}


#--------------------------------------#
#'@export
get.mb.weights <- function(res.mb){

	require(SpiecEasi)

	#CHECK ARGUMENTS
	if(class(res.mb)!="pulsar.refit") stop("class must be pulsar.refit")
	if(res.mb$est$method!="mb") stop("must be mb method")
	#END CHECK

	# get weights matrix W
	W <- as.matrix(symBeta(as.matrix(getOptBeta(res.mb)), mode='maxabs'))
	colnames(res.mb$est$data) -> colnames(W) -> rownames(W)

	return(W)
}



#--------------------------------------#
#'@export
get.gl.weights <- function(res.gl, Refit=TRUE){

	#CHECK ARGUMENTS
	if(class(res.gl)!="pulsar.refit") stop("class must be pulsar.refit")
	if(res.gl$est$method!="glasso") stop("must be gl method")
	#END CHECK

	# get weights matrix W
	W <- cov2cor(as.matrix(getOptCov(res.gl)))
	if(Refit){W <- W * as.matrix(getRefit(res.gl))}

	colnames(res.gl$est$data) -> colnames(W) -> rownames(W)

	return(W)
}
Fuschi/JAX documentation built on Dec. 17, 2021, 9:22 p.m.