R/modifyGraphs.R

In gMCPLite: Lightweight Graph Based Multiple Comparison Procedures

#    Copyright (c) 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved.
#
#    This file is part of the gMCPLite program.
#
#    gMCPLite is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
#' Joins two graphMCP objects
#'
#' Creates a new graphMCP object by joining two given graphMCP objects.
#'
#' If \code{graph1} and \code{graph2} have duplicates in the node names, the
#' nodes of the second graph will be renamed.
#'
#' If and only if the sum of the weights of graph1 and graph2 exceeds 1, the
#' weights are scaled so that the sum equals 1.
#'
#' A description attribute of either graph will be discarded.
#'
#' @param graph1 A graph of class \code{graphMCP}.
#' @param graph2 A graph of class \code{graphMCP}.
#' @param xOffset A numeric specifying an offset (on the x-axis) for placing
#' the nodes and edge labels of the second graph.
#' @param yOffset A numeric specifying an offset (on the y-axis) for placing
#' the nodes and edge labels of the second graph.
#' @return A graphMCP object that represents a graph that consists of the two
#' given graphs.
#' @author Kornelius Rohmeyer \email{rohmeyer@@small-projects.de}
#' @seealso \code{graphMCP}
#' @keywords graphs
#' @examples
#'
#'
#' g1 <- BonferroniHolm(2)
#' g2 <- BonferroniHolm(3)
#'
#' suppressWarnings(joinGraphs(g1, g2))
#'
#'
#' @export joinGraphs
#'
joinGraphs <- function(graph1, graph2, xOffset=0, yOffset=200) {
	m1 <- graph2matrix(graph1)
	m2 <- graph2matrix(graph2)
	m <- bdiagNA(m1,m2)
	m[is.na(m)] <- 0
	nNames <- c(getNodes(graph1), getNodes(graph2))
	d <- duplicated(nNames)
	if(any(d)) {
		warning(paste(c("The two graphs have the following identical nodes: ", paste(nNames[d], collapse=", "), ". The nodes of the second graph will be renamed."), sep=""))
		nodes2 <- getNodes(graph2)
		i <- 1
		for (x in nNames[d]) {
			while (any(nNames==paste("H",i, sep=""))) {
				i <- i + 1
			}
			nodes2[nodes2==x] <- paste("H",i, sep="")
			i <- i + 1
		}
		nNames <- c(getNodes(graph1), nodes2)
	}
	rownames(m) <- nNames
	colnames(m) <- nNames
	graph <- matrix2graph(m)
	weights <- c(getWeights(graph1), getWeights(graph2))
	if (sum(weights)>1) {
		weights <- weights / sum(weights)
	}
	graph <- setWeights(graph, weights=weights)
	if (is.null(getXCoordinates(graph1)) || is.null(getXCoordinates(graph2))) {
	  nodeX <- NULL
	} else {
	  nodeX <- c(getXCoordinates(graph1), getXCoordinates(graph2) + xOffset)
	  names(nodeX) <- nNames
	}
	if (is.null(getYCoordinates(graph1)) || is.null(getYCoordinates(graph2))) {
	  nodeY <- NULL
	} else {
	  nodeY <- c(getYCoordinates(graph1), getYCoordinates(graph2) + yOffset)
	  names(nodeY) <- nNames
	}
	graph@nodeAttr$X <- nodeX
	graph@nodeAttr$Y <- nodeY
	return(graph)
}

#' Get a subgraph
#'
#' Given a set of nodes and a graph this function creates the subgraph
#' containing only the specified nodes.
#'
#'
#' @param graph A graph of class \code{graphMCP}.
#' @param subset A logical or character vector specifying the nodes in the
#' subgraph.
#' @return A subgraph containing only the specified nodes.
#' @author Kornelius Rohmeyer \email{rohmeyer@@small-projects.de}
#' @seealso \code{graphMCP}
#' @keywords print graphs
#' @examples
#'
#'
#' graph <- improvedParallelGatekeeping()
#' subgraph(graph, c(TRUE, FALSE, TRUE, FALSE))
#' subgraph(graph, c("H1", "H3"))
#'
#'
#' @export subgraph
#'
subgraph <- function(graph, subset) {
	if (is.logical(subset)) {
		subset <- getNodes(graph)[subset]
	}
	m <- graph@m
	w <- getWeights(graph)
	rejected <- getRejected(graph)
	if (is.character(subset)) {
		subGraph <- matrix2graph(m[subset,subset], w[subset])
		setRejected(subGraph, getNodes(subGraph)) <- rejected[subset]
		return(subGraph)
	} else {
		stop("The parameter subset must be either a logical or character vector.")
	}
}