Add title arg to plotCoefs
[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 #' @param idx List index to process in mr
68 #'
69 #' @examples
70 #' #See example in ?plotHist
71 #' @export
72 plotCoefs <- function(mr, params, idx, xtitle="Parameter")
73 {
74 L <- nrow(mr[[1]][[1]])
75 K <- ncol(mr[[1]][[1]])
76
77 params_hat <- matrix(nrow=L, ncol=K)
78 stdev <- matrix(nrow=L, ncol=K)
79 for (x in 1:L)
80 {
81 for (y in 1:K)
82 {
83 estims <- extractParam(mr, x, y)
84 params_hat[x,y] <- mean(estims[[idx]])
85 # stdev[x,y] <- sqrt( mean( (estims[[idx]] - params[x,y])^2 ) )
86 # HACK remove extreme quantile in estims[[i]] before computing sd()
87 stdev[x,y] <- sd( estims[[idx]] ) #[ estims[[idx]] < max(estims[[idx]]) & estims[[idx]] > min(estims[[idx]]) ] )
88 }
89 }
90
91 par(cex.axis=1.5, cex.lab=1.5, mar=c(4.7,5,1,1))
92 params <- as.double(params)
93 o <- order(params)
94 avg_param <- as.double(params_hat)
95 std_param <- as.double(stdev)
96 matplot(cbind(params[o],avg_param[o],avg_param[o]+std_param[o],avg_param[o]-std_param[o]),
97 col=1, lty=c(1,5,3,3), type="l", lwd=2, xlab=xtitle, ylab="")
98
99 #print(o) #not returning o to avoid weird Jupyter issue... (TODO:)
100 }
101
102 #' plotQn
103 #'
104 #' Draw 3D map of objective function values
105 #'
106 #' @param N Number of starting points
107 #' @param n Number of points in sample
108 #' @param p Vector of proportions
109 #' @param b Vector of biases
110 #' @param β Regression matrix (target)
111 #' @param link Link function (logit or probit)
112 #'
113 #' @export
114 plotQn <- function(N, n, p, β, b, link)
115 {
116 d <- nrow(β)
117 K <- ncol(β)
118 io <- generateSampleIO(n, p, β, b, link)
119 op <- optimParams(K, link, list(X=io$X, Y=io$Y))
120 # N random starting points gaussian (TODO: around true β?)
121 res <- matrix(nrow=d*K+1, ncol=N)
122 for (i in seq_len(N))
123 {
124 β_init <- rnorm(d*K)
125 par <- op$run( c(rep(1/K,K-1), β_init, rep(0,K)) )
126 par <- op$linArgs(par)
127 Qn <- op$f(par)
128 res[,i] = c(Qn, par[K:(K+d*K-1)])
129 }
130 res #TODO: plot this, not just return it...
131 }