Commit | Line | Data |
---|---|---|
0ba1b11c | 1 | #' Plot |
3453829e BA |
2 | #' |
3 | #' It is a function which plots relevant parameters | |
4 | #' | |
5 | #' @param X matrix of covariates (of size n*p) | |
6 | #' @param Y matrix of responses (of size n*m) | |
7 | #' @param model the model constructed by valse procedure | |
8 | #' @param n sample size | |
1196a43d BA |
9 | #' @param comp TRUE to enable pairwise clusters comparison |
10 | #' @param k1 index of the first cluster to be compared | |
11 | #' @param k2 index of the second cluster to be compared | |
12 | #' | |
13 | #' @importFrom ggplot2 ggplot aes ggtitle geom_tile geom_line geom_point scale_fill_gradient2 geom_boxplot theme | |
14 | #' @importFrom cowplot background_grid | |
15 | #' @importFrom reshape2 melt | |
3453829e | 16 | #' |
3453829e | 17 | #' @export |
3453829e BA |
18 | plot_valse <- function(X, Y, model, n, comp = FALSE, k1 = NA, k2 = NA) |
19 | { | |
3453829e BA |
20 | K <- length(model$pi) |
21 | ## regression matrices | |
22 | gReg <- list() | |
23 | for (r in 1:K) | |
24 | { | |
25 | Melt <- melt(t((model$phi[, , r]))) | |
1196a43d | 26 | gReg[[r]] <- ggplot(data = Melt, aes(x = "Var1", y = "Var2", fill = "value")) + |
0ba1b11c | 27 | geom_tile() + scale_fill_gradient2(low = "blue", high = "red", mid = "white", |
3453829e BA |
28 | midpoint = 0, space = "Lab") + ggtitle(paste("Regression matrices in cluster", r)) |
29 | } | |
30 | print(gReg) | |
31 | ||
32 | ## Differences between two clusters | |
33 | if (comp) | |
34 | { | |
1196a43d | 35 | if (is.na(k1) || is.na(k2)) |
3453829e BA |
36 | print("k1 and k2 must be integers, representing the clusters you want to compare") |
37 | Melt <- melt(t(model$phi[, , k1] - model$phi[, , k2])) | |
1196a43d | 38 | gDiff <- ggplot(data = Melt, aes(x = "Var1", y = "Var2", fill = "value")) |
3453829e | 39 | + geom_tile() |
0ba1b11c | 40 | + scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, |
3453829e | 41 | space = "Lab") |
0ba1b11c | 42 | + ggtitle(paste("Difference between regression matrices in cluster", |
3453829e BA |
43 | k1, "and", k2)) |
44 | print(gDiff) | |
45 | } | |
46 | ||
47 | ### Covariance matrices | |
48 | matCov <- matrix(NA, nrow = dim(model$rho[, , 1])[1], ncol = K) | |
49 | for (r in 1:K) | |
50 | matCov[, r] <- diag(model$rho[, , r]) | |
51 | MeltCov <- melt(matCov) | |
1196a43d | 52 | gCov <- ggplot(data = MeltCov, aes(x = "Var1", y = "Var2", fill = "value")) + geom_tile() |
0ba1b11c | 53 | + scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, |
3453829e BA |
54 | space = "Lab") |
55 | + ggtitle("Covariance matrices") | |
56 | print(gCov) | |
57 | ||
58 | ### Proportions | |
59 | gam2 <- matrix(NA, ncol = K, nrow = n) | |
60 | for (i in 1:n) | |
61 | gam2[i, ] <- c(model$proba[i, model$affec[i]], model$affec[i]) | |
62 | ||
1196a43d | 63 | bp <- ggplot(data.frame(gam2), aes(x = "X2", y = "X1", color = "X2", group = "X2")) |
3453829e BA |
64 | + geom_boxplot() |
65 | + theme(legend.position = "none") | |
66 | + background_grid(major = "xy", minor = "none") | |
67 | print(bp) | |
68 | ||
69 | ### Mean in each cluster | |
70 | XY <- cbind(X, Y) | |
71 | XY_class <- list() | |
72 | meanPerClass <- matrix(0, ncol = K, nrow = dim(XY)[2]) | |
73 | for (r in 1:K) | |
74 | { | |
75 | XY_class[[r]] <- XY[model$affec == r, ] | |
76 | if (sum(model$affec == r) == 1) { | |
77 | meanPerClass[, r] <- XY_class[[r]] | |
78 | } else { | |
79 | meanPerClass[, r] <- apply(XY_class[[r]], 2, mean) | |
80 | } | |
81 | } | |
82 | data <- data.frame(mean = as.vector(meanPerClass), | |
83 | cluster = as.character(rep(1:K, each = dim(XY)[2])), time = rep(1:dim(XY)[2], K)) | |
1196a43d BA |
84 | g <- ggplot(data, aes(x = "time", y = "mean", group = "cluster", color = "cluster")) |
85 | print(g + geom_line(aes(linetype = "cluster", color = "cluster")) | |
86 | + geom_point(aes(color = "cluster")) + ggtitle("Mean per cluster")) | |
3453829e | 87 | } |