Small plotting change for black and white printing
[morpheus.git] / pkg / R / plot.R
1 # extractParam
2 #
3 # Extract successive values of a projection of the parameter(s)
4 #
5 # @inheritParams plotHist
6 #
7 extractParam <- function(mr, x=1, y=1)
8 {
9 # Obtain L vectors where L = number of res lists in mr
10 lapply( mr, function(mr_list) {
11 sapply(mr_list, function(m) m[x,y])
12 } )
13 }
14
15 #' plotHist
16 #'
17 #' Plot histogram
18 #'
19 #' @param mr Output of multiRun(), list of lists of functions results
20 #' @param x Row index of the element inside the aggregated parameter
21 #' @param y Column index of the element inside the aggregated parameter
22 #'
23 #' @examples
24 #' \donttest{
25 #' β <- matrix(c(1,-2,3,1),ncol=2)
26 #' mr <- multiRun(...) #see bootstrap example in ?multiRun : return lists of mu_hat
27 #' μ <- normalize(β)
28 #' for (i in 1:2)
29 #' mr[[i]] <- alignMatrices(res[[i]], ref=μ, ls_mode="exact")
30 #' plotHist(mr, 2, 1) #second row, first column}
31 #' @export
32 plotHist <- function(mr, x, y)
33 {
34 params <- extractParam(mr, x, y)
35 L = length(params)
36 # Plot histograms side by side
37 par(mfrow=c(1,L), cex.axis=1.5, cex.lab=1.5, mar=c(4.7,5,1,1))
38 for (i in 1:L)
39 hist(params[[i]], breaks=40, freq=FALSE, xlab="Parameter value", ylab="Density")
40 }
41
42 #' plotBox
43 #'
44 #' Draw boxplot
45 #'
46 #' @inheritParams plotHist
47 #'
48 #' @examples
49 #' #See example in ?plotHist
50 #' @export
51 plotBox <- function(mr, x, y)
52 {
53 params <- extractParam(mr, x, y)
54 L = length(params)
55 # Plot boxplots side by side
56 par(mfrow=c(1,L), cex.axis=1.5, cex.lab=1.5, mar=c(4.7,5,1,1))
57 for (i in 1:L)
58 boxplot(params[[i]], ylab="Parameter value")
59 }
60
61 #' plotCoefs
62 #'
63 #' Draw coefs estimations + standard deviations
64 #'
65 #' @inheritParams plotHist
66 #' @param params True value of parameters matrix
67 #'
68 #' @examples
69 #' #See example in ?plotHist
70 #' @export
71 plotCoefs <- function(mr, params)
72 {
73 nf <- length(mr)
74 L <- nrow(mr[[1]][[1]])
75 K <- ncol(mr[[1]][[1]])
76
77 params_hat <- vector("list", nf)
78 stdev <- vector("list", nf)
79 for (i in 1:nf)
80 {
81 params_hat[[i]] <- matrix(nrow=L, ncol=K)
82 stdev[[i]] <- matrix(nrow=L, ncol=K)
83 }
84 for (x in 1:L)
85 {
86 for (y in 1:K)
87 {
88 estims <- extractParam(mr, x, y)
89 for (i in 1:nf)
90 {
91 params_hat[[i]][x,y] <- mean(estims[[i]])
92 # stdev[[i]][x,y] <- sqrt( mean( (estims[[i]] - params[x,y])^2 ) )
93 # HACK remove extreme quantile in estims[[i]] before computing sd()
94 stdev[[i]][x,y] <- sd( estims[[i]] [ estims[[i]] < max(estims[[i]]) & estims[[i]] > min(estims[[i]]) ] )
95 }
96 }
97 }
98
99 par(mfrow=c(1,nf), cex.axis=1.5, cex.lab=1.5, mar=c(4.7,5,1,1))
100 params <- as.double(params)
101 o <- order(params)
102 for (i in 1:nf)
103 {
104 avg_param <- as.double(params_hat[[i]])
105 std_param <- as.double(stdev[[i]])
106 matplot(cbind(params[o],avg_param[o],avg_param[o]+std_param[o],avg_param[o]-std_param[o]),
107 col=1, lty=c(1,5,2,2), type="l", lwd=2, xlab="param", ylab="value")
108 }
109
110 #print(o) #not returning o to avoid weird Jupyter issue... (TODO:)
111 }
112
113 #' plotQn
114 #'
115 #' Draw 3D map of objective function values
116 #'
117 #' @param N Number of starting points
118 #' @param n Number of points in sample
119 #' @param p Vector of proportions
120 #' @param b Vector of biases
121 #' @param β Regression matrix (target)
122 #' @param link Link function (logit or probit)
123 #'
124 #' @export
125 plotQn <- function(N, n, p, β, b, link)
126 {
127 d <- nrow(β)
128 K <- ncol(β)
129 io <- generateSampleIO(n, p, β, b, link)
130 op <- optimParams(K, link, list(X=io$X, Y=io$Y))
131 # N random starting points gaussian (TODO: around true β?)
132 res <- matrix(nrow=d*K+1, ncol=N)
133 for (i in seq_len(N))
134 {
135 β_init <- rnorm(d*K)
136 par <- op$run( c(rep(1/K,K-1), β_init, rep(0,K)) )
137 par <- op$linArgs(par)
138 Qn <- op$f(par)
139 res[,i] = c(Qn, par[K:(K+d*K-1)])
140 }
141 res #TODO: plot this, not just return it...
142 }