-
Notifications
You must be signed in to change notification settings - Fork 0
/
plotFunctions.R
155 lines (122 loc) · 6.13 KB
/
plotFunctions.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
# Written by Micha? Makowski
# Plotting functions
require(ggplot2, quietly = TRUE)
require(latex2exp, quietly = TRUE)
require(tidyr, quietly = TRUE)
# Covariance matrix plot
plotCovarianceStructure <- function(covarianceMatrix)
{
colnames(covarianceMatrix) <- 1:ncol(covarianceMatrix)
rownames(covarianceMatrix) <- 1:ncol(covarianceMatrix)
df1 <- melt(covarianceMatrix)
df1$value <- as.factor(df1$value)
names(df1)[1:2] <- c("X1", "X2")
covPlot <- ggplot(df1, aes(x=X1, y=X2)) + geom_tile(aes(fill=value)) +
theme(axis.ticks = element_blank(),
axis.text.x = element_text(angle = 330, hjust = 0, vjust = 1, colour = "grey50"),
axis.text.y = element_text(colour = "grey50"),
panel.grid.major.y = element_blank(), panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(),
panel.background = element_rect(fill = "white", colour = "white"))
return(covPlot)
}
plotMatrix <- function(matrix,
title = NULL)
{
matrix <- abs(matrix)
colnames(matrix) <- 1:ncol(matrix)
rownames(matrix) <- 1:ncol(matrix)
properData <- melt(matrix)
colnames(properData) <- c("X1", "X2", "value")
matrixPlot <- ggplot(properData, aes(x=X1, y=X2))
if(length(subset(properData, isZero.default(value, neps=10))[[1]]) == 0)
{
matrixPlot <- matrixPlot +
geom_tile(data = properData, aes(fill = value))
} else
{
matrixPlot <- matrixPlot +
geom_tile(data = subset(properData, !isZero.default(value, neps=10)), aes(fill = value)) +
geom_tile(data = subset(properData, isZero.default(value, neps=10)), aes(colour = "0"),
linetype = 0, fill = "grey50", alpha = .5)
}
matrixPlot <- matrixPlot +
labs(title = title, x = TeX('$X_1$'), y = TeX('$X_2$')) +
scale_fill_gradient(name="Matrix\nentry\nabsolute value",
limits = c(.Machine$double.eps, NA)) +
scale_colour_discrete(name=NULL) +
guides(fill = guide_colorbar(order = 1, barwidth = 1, barheight = 10),
colour = guide_legend(order = 2, keywidth = 1, keyheight = 1, title.position = "bottom")) +
theme_minimal() +
theme(legend.spacing.y = unit(-0.3, "cm"))
return(matrixPlot)
}
plotFour <- function(benchResult)
{
properData <- rbind(meltingMatrix((benchResult[[1]]$matrix > 0), benchResult[[1]]$name),
meltingMatrix((benchResult[[2]]$matrix > 0), benchResult[[2]]$name),
meltingMatrix((benchResult[[3]]$matrix > 0), benchResult[[3]]$name),
meltingMatrix((benchResult[[4]]$matrix > 0), benchResult[[4]]$name))
colnames(properData) <- c("X1", "X2", colnames(properData)[3:4])
properData$value <- c("0", "1")[1+properData$value]
mainTitle <- paste0("Comparision of different precision matrix estimation methods")
out <- ggplot(properData, aes(x=X1, y=X2)) +
geom_tile(aes(fill = factor(value))) +
labs(title = mainTitle, x = TeX('$X_1$'), y = TeX('$X_2$')) +
facet_wrap(~index) +
scale_fill_manual(values = c("lightblue", "darkblue")) +
theme_minimal()
out
return(out)
}
plotDiffrence <- function(estimatedMatrix, adjacentMatrix, method = "graph", graphType = NULL, n = NULL, p = NULL, alpha = NULL)
{
properEstimated <- properAdjacent(estimatedMatrix)
properAdjacent <- properAdjacent(adjacentMatrix)
errorMatrix <- 1*(!properAdjacent & properEstimated) + # FP
2*(properAdjacent & properEstimated) + # TP
3*(properAdjacent & !properEstimated) + # FN
4*(!properAdjacent & !properEstimated) # TN
properData <- meltingMatrix(errorMatrix,
# NULL)
"Status")
colnames(properData) <- c("X1", "X2", colnames(properData)[3:4])
properData$value <- c("FP", "TP", "FN", "TN")[properData$value]
x <- as.factor(properData$value)
levels(x) <- c("FP", "TP", "FN", "TN")
mainTitle <- paste0("Difference beetwen real & estimated matrix for ", method)
subTitle <- paste0('graphType = ', graphType, ', n = ', n, ', p = ', p, ', alpha = ', alpha)
out <- ggplot(properData, aes(x=X1, y=X2)) +
geom_tile(aes(fill = factor(value))) +
# scale_fill_hue(l=50) +
# scale_fill_manual(values=c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")[c(2:5)]) +
scale_fill_brewer(palette = "Spectral") +
labs(title = mainTitle, subtitle = subTitle, fill = "Matrix\nestimator",
x = TeX('$X_1$'), y = TeX('$X_2$')) +
theme_minimal()
return(out)
}
plotTwo <- function(estimatedMatrix, adjacentMatrix, method = "graph", graphType = NULL, n = NULL, p = NULL, alpha = NULL)
{
properEstimated <- properAdjacent(estimatedMatrix)
properAdjacent <- properAdjacent(adjacentMatrix)
errorMatrix <- 1*(!properAdjacent & properEstimated) + # FP
2*(properAdjacent & properEstimated) + # TP
3*(properAdjacent & !properEstimated) + # FN
4*(!properAdjacent & !properEstimated) # TN
properData <- meltingMatrix(errorMatrix,
# NULL)
"Status")
colnames(properData) <- c("X1", "X2", colnames(properData)[3:4])
properData$value <- c("FP", "TP", "FN", "TN")[properData$value]
x <- as.factor(properData$value)
levels(x) <- c("FP", "TP", "FN", "TN")
mainTitle <- paste0("Difference beetwen real & estimated matrix for ", method)
subTitle <- paste0('graphType = ', graphType, ', n = ', n, ', p = ', p, ', alpha = ', alpha)
out <- ggplot(properData, aes(x=X1, y=X2)) +
geom_tile(aes(fill = factor(value))) +
labs(title = mainTitle, subtitle = subTitle, x = TeX('$X_1$'), y = TeX('$X_2$')) +
labs(fill = "Matrix\nestimator") +
theme_minimal()
return(out)
}