X-Git-Url: https://git.auder.net/?p=valse.git;a=blobdiff_plain;f=pkg%2FR%2Fplot_valse.R;h=0ef5f7256a6e7f7a3158274389593e1d3b67e0f3;hp=ec2302d6ccf47f7ed95ec4cc42b3f9be6295e8ef;hb=6af1d4897dbab92a7be05068e0e15823378965d9;hpb=228ee602a972fcac6177db0d539bf9d0c5fa477f diff --git a/pkg/R/plot_valse.R b/pkg/R/plot_valse.R index ec2302d..0ef5f72 100644 --- a/pkg/R/plot_valse.R +++ b/pkg/R/plot_valse.R @@ -1,47 +1,45 @@ -#' Plot +utils::globalVariables(c("Var1","Var2","X1","X2","value")) #, package="valse") + +#' Plot #' -#' It is a function which plots relevant parameters +#' A function which plots relevant parameters. #' #' @param X matrix of covariates (of size n*p) #' @param Y matrix of responses (of size n*m) #' @param model the model constructed by valse procedure -#' @param n sample size -#' @return several plots +#' @param comp TRUE to enable pairwise clusters comparison +#' @param k1 index of the first cluster to be compared +#' @param k2 index of the second cluster to be compared #' -#' @examples TODO +#' @importFrom ggplot2 ggplot aes ggtitle geom_tile geom_line scale_fill_gradient2 geom_boxplot theme +#' @importFrom cowplot background_grid +#' @importFrom reshape2 melt #' -#' @export +#' @return No return value (only plotting). #' -plot_valse <- function(X, Y, model, n, comp = FALSE, k1 = NA, k2 = NA) +#' @export +plot_valse <- function(X, Y, model, comp = FALSE, k1 = NA, k2 = NA) { - require("gridExtra") - require("ggplot2") - require("reshape2") - require("cowplot") - + n <- nrow(X) K <- length(model$pi) ## regression matrices gReg <- list() - for (r in 1:K) - { - Melt <- melt(t((model$phi[, , r]))) - gReg[[r]] <- ggplot(data = Melt, aes(x = Var1, y = Var2, fill = value)) + - geom_tile() + scale_fill_gradient2(low = "blue", high = "red", mid = "white", - midpoint = 0, space = "Lab") + ggtitle(paste("Regression matrices in cluster", r)) + for (r in 1:K) { + Melt <- reshape2::melt(t((model$phi[, , r]))) + gReg[[r]] <- ggplot2::ggplot(data = Melt, ggplot2::aes(x = Var1, y = Var2, fill = value)) + + ggplot2::geom_tile() + ggplot2::scale_fill_gradient2(low = "blue", high = "red", mid = "white", + midpoint = 0, space = "Lab") + ggplot2::ggtitle(paste("Regression matrices in cluster", r)) } print(gReg) ## Differences between two clusters - if (comp) - { - if (is.na(k1) || is.na(k)) + if (comp) { + if (is.na(k1) || is.na(k2)) print("k1 and k2 must be integers, representing the clusters you want to compare") - Melt <- melt(t(model$phi[, , k1] - model$phi[, , k2])) - gDiff <- ggplot(data = Melt, aes(x = Var1, y = Var2, fill = value)) - + geom_tile() - + scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, - space = "Lab") - + ggtitle(paste("Difference between regression matrices in cluster", + Melt <- reshape2::melt(t(model$phi[, , k1] - model$phi[, , k2])) + gDiff <- ggplot2::ggplot(data = Melt, ggplot2::aes(x = Var1, y = Var2, fill = value)) + + ggplot2::geom_tile() + ggplot2::scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, + space = "Lab") + ggplot2::ggtitle(paste("Difference between regression matrices in cluster", k1, "and", k2)) print(gDiff) } @@ -50,40 +48,19 @@ plot_valse <- function(X, Y, model, n, comp = FALSE, k1 = NA, k2 = NA) matCov <- matrix(NA, nrow = dim(model$rho[, , 1])[1], ncol = K) for (r in 1:K) matCov[, r] <- diag(model$rho[, , r]) - MeltCov <- melt(matCov) - gCov <- ggplot(data = MeltCov, aes(x = Var1, y = Var2, fill = value)) + geom_tile() - + scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, - space = "Lab") - + ggtitle("Covariance matrices") + MeltCov <- reshape2::melt(matCov) + gCov <- ggplot2::ggplot(data = MeltCov, ggplot2::aes(x = Var1, y = Var2, fill = value)) + ggplot2::geom_tile() + + ggplot2::scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, + space = "Lab") + ggplot2::ggtitle("Covariance matrices (diag., one row per cluster)") print(gCov) ### Proportions - gam2 <- matrix(NA, ncol = K, nrow = n) + gam2 <- matrix(NA, ncol = 2, nrow = n) for (i in 1:n) gam2[i, ] <- c(model$proba[i, model$affec[i]], model$affec[i]) - bp <- ggplot(data.frame(gam2), aes(x = X2, y = X1, color = X2, group = X2)) - + geom_boxplot() - + theme(legend.position = "none") - + background_grid(major = "xy", minor = "none") + bp <- ggplot2::ggplot(data.frame(gam2), ggplot2::aes(x = X2, y = X1, color = X2, group = X2)) + ggplot2::geom_boxplot() + + ggplot2::theme(legend.position = "none") + cowplot::background_grid(major = "xy", minor = "none") + + ggplot2::ggtitle("Assignment boxplot per cluster") print(bp) - - ### Mean in each cluster - XY <- cbind(X, Y) - XY_class <- list() - meanPerClass <- matrix(0, ncol = K, nrow = dim(XY)[2]) - for (r in 1:K) - { - XY_class[[r]] <- XY[model$affec == r, ] - if (sum(model$affec == r) == 1) { - meanPerClass[, r] <- XY_class[[r]] - } else { - meanPerClass[, r] <- apply(XY_class[[r]], 2, mean) - } - } - data <- data.frame(mean = as.vector(meanPerClass), - cluster = as.character(rep(1:K, each = dim(XY)[2])), time = rep(1:dim(XY)[2], K)) - g <- ggplot(data, aes(x = time, y = mean, group = cluster, color = cluster)) - print(g + geom_line(aes(linetype = cluster, color = cluster)) - + geom_point(aes(color = cluster)) + ggtitle("Mean per cluster")) }