R/plot.R

In irenecrsn/ggmexp: Utilities for Experiments in Gaussian Graphical Models

#' Plot the results of a Gaussian graphical model experiment
#' 
#' @name plot-experiment-results
#' 
#' @rdname plot_ggm
#'
#' @param p Vector of dimensions that have been tested.
#' @param d Vector of densities that have been tested.
#' @param r Number of replications for the experiment.
#' @param N Vector of number of samples obtained in each atomic experiment.
#' @param map Function that will map the values obtained from each atomic
#' experiment for each sample.
#' @param reduce Function that will reduce the previously mapped results from
#' each sample, yielding a single value for each atomic experiment.
#' @param show_sd Whether to show the standard deviation for `map` function.
#' @param ename Name of the atomic experiment that has been executed, for 
#' [plot_experiment()], or vector of atomic experiments to compare in the case 
#' of [plot_comparison()]
#' @param plot_title Optional title for the plot.
#' @param plot_ylab Optional text for the Y values.
#' @param ... Additional arguments for `map`.
#' 
#' @details Function [plot_experiment()] plots the results from a previously executed
#' experiment related to a Gaussian graphical model. It expects the results
#' stored in the same format as [excute()] stores them.
#'
#' @return The generated plot.
#' @export
plot_experiment <- function(p, d, r, N, map = function(x) {
	return(x)
}, reduce, show_sd = FALSE, ename, 
plot_title = "", plot_ylab = "", ...) {
	data <- matrix(
		nrow = length(p), ncol = length(d),
		dimnames = list(p = p, d = d)
	)
	data_sd <- matrix(
		nrow = length(p), ncol = length(d),
		dimnames = list(p = p, d = d)
	)
	
	
	for (i in 1:length(p)) {
		exp_res <- array(dim = c(p[i], p[i], N[i] * r))
		for (j in 1:length(d)) {
			for (rep in 1:r) {
				exp_res[, , ((rep - 1) * N[i] + 1):(rep * N[i])] <-
					readRDS(file = paste0(ename, "_r", rep, "/", p[i], "_", d[j], ".rds"))
			}
			mapd_mat <- apply(X = exp_res, MARGIN = 3, FUN = map, ...)
			data[i, j] <- reduce(mapd_mat)
			data_sd[i, j] <- stats::sd(mapd_mat)
		}
	}
	
	wd <- getwd()
	dir.create(paste0(wd, "/plot_", r), showWarnings = FALSE)
	
	palette <- grDevices::colorRampPalette(colors = c("black", "red"))
	colors <- palette(length(d))
	
	df <- data %>% as.tbl_cube(met_name = "data") %>% as_tibble()
	df$d <- as.factor(df$d)
	df_sd <- data_sd %>% as.tbl_cube(met_name = "data_sd") %>% as_tibble()
	df$data_sd <- df_sd$data_sd
	
	pl <- ggplot(df, aes(x = p, y = data, group = d, color = d)) +
		geom_line() +
		geom_point() +
		theme(text = element_text(size = 20), legend.position = "bottom") +
		scale_color_manual(values = colors) +
		xlab("Number of nodes") + 
		ylab(plot_ylab) +
		ggtitle(plot_title)
	
	if (show_sd == TRUE) {
		pl <- pl +
			geom_ribbon(aes(ymin = data - data_sd, ymax = data + data_sd, fill = ename),
									alpha = .3) +
			scale_fill_manual(labels = ename, values = colors)  
	}
	
	return(pl)
}

#' Plot a comparison of the results of different Gaussian graphical model 
#' experiments
#' 
#' @rdname plot_ggm
#' 
#' @details Function [plot_comparison()] is similar to [plot_experiment()], but instead of 
#' focusing on all the results of a single experiment, it compares the results
#' over several experiments in a fixed scenario. Therefore, either `p` or `d` 
#' must be a scalar, and the `X` axis in the generated plot will range over the 
#' values of the one that is a vector.
#'
#' @export
plot_comparison <- function(p, d, r, N, map = function(x) {
	return(x)
},
reduce, ename, show_sd = FALSE, plot_title = "", plot_ylab = "", ...) {
	data <- matrix(
		nrow = length(p), ncol = length(ename),
		dimnames = list(p = p, ename = ename)
	)
	data_sd <- matrix(
		nrow = length(p), ncol = length(ename),
		dimnames = list(p = p, ename = ename)
	)
	
	for (i in 1:length(p)) {
		sample <- array(dim = c(p[i], p[i], N[i] * r))
		for (m in ename) {
			for (k in 1:r) {
				sample[, , ((k - 1) * N[i] + 1):(k * N[i])] <-
					readRDS(file = paste0(m, "_r", k, "/", p[i], "_", d, ".rds"))
			}
			mapd_mat <- apply(sample, MARGIN = 3, map, ...)
			data[i, m] <- reduce(mapd_mat)
			data_sd[i, m] <- stats::sd(mapd_mat)
		}
	}
	
	df <- data %>% as.tbl_cube(met_name = "data") %>% as_tibble()
	df$ename <- as.factor(df$ename)
	df_sd <- data_sd %>% as.tbl_cube(met_name = "data_sd") %>% as_tibble()
	df$data_sd <- df_sd$data_sd
	
	palette <- grDevices::colorRampPalette(colors = c("green4", "blue"))
	colors <- palette(length(ename))
	
	pl <- ggplot(df, aes(x = p, y = data, group = ename)) +
		geom_line(aes(color = ename)) +
		geom_point(aes(color = ename)) +
		scale_color_manual(labels = ename, values = colors) +
		theme(text = element_text(size = 20), legend.position = "bottom") +
		xlab("Number of nodes") +
		ylab(plot_ylab) +
		ggtitle(plot_title)
	
	if (show_sd == TRUE) {
		pl <- pl +
			geom_ribbon(aes(ymin = data - data_sd, ymax = data + data_sd, fill = ename),
									alpha = .3) +
			scale_fill_manual(labels = ename, values = colors)
	}
	
	
	return(pl)
}