X-Git-Url: https://git.auder.net/?p=valse.git;a=blobdiff_plain;f=pkg%2FR%2Fplot_valse.R;h=0ef5f7256a6e7f7a3158274389593e1d3b67e0f3;hp=0963946ea1152b5f1ca0c309f03811e347594440;hb=6af1d4897dbab92a7be05068e0e15823378965d9;hpb=fb6e49cb85308c3f99cc98fe955aa7c36839c819 diff --git a/pkg/R/plot_valse.R b/pkg/R/plot_valse.R index 0963946..0ef5f72 100644 --- a/pkg/R/plot_valse.R +++ b/pkg/R/plot_valse.R @@ -1,78 +1,66 @@ +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(model,n, comp = FALSE, k1 = NA, k2 = NA){ - require("gridExtra") - require("ggplot2") - require("reshape2") - require("cowplot") - - K = length(model$pi) +#' @export +plot_valse <- function(X, Y, model, comp = FALSE, k1 = NA, k2 = NA) +{ + 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)) + gReg <- list() + 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)){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",k1, "and", k2)) + if (comp) { + if (is.na(k1) || is.na(k2)) + print("k1 and k2 must be integers, representing the clusters you want to compare") + 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) - } - + ### Covariance matrices - 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") - print(gCov ) - + matCov <- matrix(NA, nrow = dim(model$rho[, , 1])[1], ncol = K) + for (r in 1:K) + matCov[, r] <- diag(model$rho[, , r]) + 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) - 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") + 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 <- 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')) - -} \ No newline at end of file +}