<p><div><div><div><div data-width="100" data-show-faces="false" data-send="true" data-layout="button_count" data-height="21" data-href="https://www.r-bloggers.com/bagging-the-perfect-solution-for-model-instability/"></div></div><div></div></div><div></div></div>
<div>
(This article was first published on <strong><a href="https://insightr.wordpress.com/2017/05/22/bagging-the-perfect-solution-for-model-instability/"> R – insightR</a></strong>, and kindly contributed to <a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers)</a> </div>
<div><strong>By Gabriel Vasconcelos</strong></div>
<h2>Motivation</h2>
<p>The name bagging comes from boostrap aggregating. It is a machine learning technique proposed by Breiman (1996) to increase stability in potentially unstable estimators. For example, suppose you want to run a regression with a few variables in two steps. First, you run the regression with all the variables in your data and select the significant ones. Second, you run a new regression using only the selected variables and compute the predictions.</p>
<p><span></span></p>
<p>This procedure is not wrong if your problem is forecasting. However, this two step estimation may result in highly unstable models. If many variables are important but individually their importance is small, you will probably leave some of them out, and small perturbations on the data may drastically change the results.</p>
<h2>Bagging</h2>
<p>The Bagging solves instability problem by giving each variable several chances to be in the model. The same procedure described in the previous section is repeated in many bootstrap samples and the final forecast will be the average forecast across all these samples.</p>
<p>In this post I will show an example of Bagging with regression in the selection context described above. But you should keep in mind that this technique can be used for any unstable model. The most successful case is to use Bagging on regression trees, resulting in the famous random forest. The Bagging is also very robust to over fitting and produces forecasts with less variance.</p>
<h2>Application</h2>
<p>I am going to show an application of Bagging from the scratch using the <code>boot</code> package for the bootstrap replications. We start by generating some data with the following dgp:</p>
<p><img title="y_i = sum_{j=1}^K beta_j x_{i,j} + varepsilon_i,~~~~~~i=1,dots,N; ~j=1,dots,K " alt="y_i = sum_{j=1}^K beta_j x_{i,j} + varepsilon_i,~~~~~~i=1,dots,N; ~j=1,dots,K " class="latex" src="https://s0.wp.com/latex.php?latex=y_i+%3D+%5Csum_%7Bj%3D1%7D%5EK+%5Cbeta_j+x_%7Bi%2Cj%7D+%2B+%5Cvarepsilon_i%2C~~~~~~i%3D1%2C%5Cdots%2CN%3B+~j%3D1%2C%5Cdots%2CK+&bg=ffffff&%23038;fg=333333&%23038;s=0"><br>
<img title="x_{i,j} = A_j f_i+epsilon_{i,j}~~~~~~i=1,dots,N; ~j=1,dots,K " alt="x_{i,j} = A_j f_i+epsilon_{i,j}~~~~~~i=1,dots,N; ~j=1,dots,K " class="latex" src="https://s0.wp.com/latex.php?latex=x_%7Bi%2Cj%7D+%3D+A_j+f_i%2B%5Cepsilon_%7Bi%2Cj%7D~~~~~~i%3D1%2C%5Cdots%2CN%3B+~j%3D1%2C%5Cdots%2CK+&bg=ffffff&%23038;fg=333333&%23038;s=0"></p>
<p>The first equation shows how the variable we want to predict, <img title="y_i" alt="y_i" class="latex" src="https://s0.wp.com/latex.php?latex=y_i&bg=ffffff&%23038;fg=333333&%23038;s=0">, is generated. The second equation shows that the independent variables are generated by a common factor, which will induce a correlation structure. Since we need instability, the data will be generated to have an <img title="R^2" alt="R^2" class="latex" src="https://s0.wp.com/latex.php?latex=R%5E2&bg=ffffff&%23038;fg=333333&%23038;s=0"> around <img title="0.33" alt="0.33" class="latex" src="https://s0.wp.com/latex.php?latex=0.33&bg=ffffff&%23038;fg=333333&%23038;s=0"> and <img title="K=40" alt="K=40" class="latex" src="https://s0.wp.com/latex.php?latex=K%3D40&bg=ffffff&%23038;fg=333333&%23038;s=0"> in order to have many variables with small individual importance.</p>
<pre>N = 300 # = Number of obs. = #
K = 40 # = Number of Variables = #
set.seed(123) # = Seed for replication = #
f = rnorm(N) # = Common factor = #
A = runif(K,-1,1) # = Coefficients from the second equation = #
X = t(A%*%t(f)) + matrix(rnorm(N*K), N, K) # = Generate xij = #
beta = c((-1)^(1:(K-10)) ,rep(0, 10)) # = Coefficients from the first equation, the first 30 are equal 1 or -1 and the last 10 are 0 = #

# = R2 setup = #
aux = var(X%*%beta)
erro = rnorm(N, 0, sqrt(2*aux)) # = The variance of the error will be twice the variance of X%*%beta = #

y = X %*% beta+erro # = Generate y = #
1-var(erro)/var(y) # = R2 = #
</pre>
<pre>##           [,1]
## [1,] 0.2925866
</pre>
<pre># = Break data into in-sample and out-of-sample = #
y.in = y[1:(N-100)]
X.in = X[1:(N-100),]
y.out = y[-c(1:(N-100))]
X.out = X[-c(1:(N-100)),]
</pre>
<p>Now we must define a function to be called by the boostrap. This function must receive the data and an argument for indexes that will tell <code>R</code> where the sampling must be made. This function will run a linear regression with all variables, select those with t-statistics bigger than <img title="1.96" alt="1.96" class="latex" src="https://s0.wp.com/latex.php?latex=1.96&bg=ffffff&%23038;fg=333333&%23038;s=0">, run a new regression with the selected variables and store the coefficients.</p>
<pre>bagg = function(data,ind){
  sample = data[ind,]
  y = sample[, 1]
  X = sample[, 2:ncol(data)]
  model1 = lm(y ~ X)
  t.stat = summary(model1)$coefficients[-1, 3]
  selected = which(abs(t.stat)>=1.96)
  model2 = lm(y ~ X[, selected])
  coefficients = coef(model2)
  cons = coefficients[1]
  betas = coefficients[-1]
  aux = rep(0, ncol(X))
  aux[selected] = betas
  res = c(cons, aux)
  return(res)
}
</pre>
<p>Now we are ready to use the <code>boot</code> function to run the Bagging. The code below does precisely that with <img title="500" alt="500" class="latex" src="https://s0.wp.com/latex.php?latex=500&bg=ffffff&%23038;fg=333333&%23038;s=0"> boostrap replications. It also runs the simple OLS procedure for us to compare. If you type <code>selected</code> after running this code you will see that many variables were left out and some variables with <img title="beta=0" alt="beta=0" class="latex" src="https://s0.wp.com/latex.php?latex=%5Cbeta%3D0&bg=ffffff&%23038;fg=333333&%23038;s=0"> were selected.</p>
<pre>library(boot)
# = Bagging = #
bagging = boot(data = cbind(y.in, X.in), statistic=bagg, R=500)
bagg.coef = bagging$t
y.pred.bagg = rowMeans(cbind(1, X.out)%*%t(bagg.coef))

# = OLS = #
ols0 = lm(y.in ~ X.in)
selected = which(abs(summary(ols0)$coefficients[-1, 3])>=1.96)
ols1 = lm(y.in ~ X.in[, selected])
y.pred = cbind(1, X.out[, selected])%*%coef(ols1)

# = Forecasting RMSE = #
sqrt(mean((y.pred-y.out)^2)) # = OLS = #
</pre>
<pre>## [1] 10.43338
</pre>
<pre>sqrt(mean((y.pred.bagg-y.out)^2)) # = Bagging = #
</pre>
<pre>## [1] 9.725554
</pre>
<p>The results showed that the Bagging has a RMSE <img title="7%" alt="7%" class="latex" src="https://s0.wp.com/latex.php?latex=7%5C%25&bg=ffffff&%23038;fg=333333&%23038;s=0"> smaller than the OLS. It is also interesting to see what happens to the coefficients. The plot below shows that the bagging performs some shrinkage on the coefficients towards zero.</p>
<pre>barplot(coef(ols0)[-1])
barplot(colMeans(bagg.coef)[-1], add=TRUE, col=&quot;red&quot;)
</pre>
<p><img alt="plot of chunk unnamed-chunk-12" src="https://i0.wp.com/i.imgur.com/5M0HvSw.png"></p>
<p>Finally, what would happen if we had no instability? If you run the same code again changing the <img title="R^2" alt="R^2" class="latex" src="https://s0.wp.com/latex.php?latex=R%5E2&bg=ffffff&%23038;fg=333333&%23038;s=0"> to around <img title="99%" alt="99%" class="latex" src="https://s0.wp.com/latex.php?latex=99%5C%25&bg=ffffff&%23038;fg=333333&%23038;s=0"> you will find the plot below. To change the <img title="R^2" alt="R^2" class="latex" src="https://s0.wp.com/latex.php?latex=R%5E2&bg=ffffff&%23038;fg=333333&%23038;s=0"> to <img title="99%" alt="99%" class="latex" src="https://s0.wp.com/latex.php?latex=99%5C%25&bg=ffffff&%23038;fg=333333&%23038;s=0"> just replace <img title="2" alt="2" class="latex" src="https://s0.wp.com/latex.php?latex=2&bg=ffffff&%23038;fg=333333&%23038;s=0"> by <img title="0.01" alt="0.01" class="latex" src="https://s0.wp.com/latex.php?latex=0.01&bg=ffffff&%23038;fg=333333&%23038;s=0"> in the code <code>erro = rnorm(N, 0, sqrt(2*aux))</code> in the dgp. As you can see, the bagging and the simple procedure are the same in the absence of instability.</p>
<p><img alt="plot of chunk unnamed-chunk-13" src="https://i0.wp.com/i.imgur.com/WDQyY08.png"></p>
<h2>References</h2>
<p>Breiman, Leo (1996). “Bagging predictors”. Machine Learning. 24 (2): 123–140</p>
<p> <a target="_blank" rel="nofollow" href="http://feeds.wordpress.com/1.0/gocomments/insightr.wordpress.com/213/"><img alt="" src="http://feeds.wordpress.com/1.0/comments/insightr.wordpress.com/213/" border="0"></a> <img alt="" src="https://i1.wp.com/pixel.wp.com/b.gif?resize=1%2C1&ssl=1" border="0" data-recalc-dims="1"></p>
<p>
<div>
<div>To <strong>leave a comment</strong> for the author, please follow the link and comment on their blog: <strong><a href="https://insightr.wordpress.com/2017/05/22/bagging-the-perfect-solution-for-model-instability/"> R – insightR</a></strong>.</div>
<hr>
<a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers.com</a> offers <strong><a rel="nofollow" href="https://feedburner.google.com/fb/a/mailverify?uri=RBloggers">daily e-mail updates</a></strong> about <a title="The R Project for Statistical Computing" rel="nofollow" href="https://www.r-project.org/">R</a> news and <a title="R tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/tutorial">tutorials</a> on topics such as: <a title="Data science" rel="nofollow" href="https://www.r-bloggers.com/search/data%20science">Data science</a>, <a title="Big Data" rel="nofollow" href="https://www.r-bloggers.com/search/Big%20Data">Big Data, <a title="R jobs" rel="nofollow" href="https://www.r-users.com/">R jobs</a>, visualization (<a title="ggplot and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/ggplot2">ggplot2</a>, <a title="Boxplots using lattice and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/boxplot">Boxplots</a>, <a title="Maps and gis" rel="nofollow" href="https://www.r-bloggers.com/search/map">maps</a>, <a title="Animation in R" rel="nofollow" href="https://www.r-bloggers.com/search/animation">animation</a>), programming (<a title="RStudio IDE for R" rel="nofollow" href="https://www.r-bloggers.com/search/RStudio">RStudio</a>, <a title="Sweave and literate programming" rel="nofollow" href="https://www.r-bloggers.com/search/sweave">Sweave</a>, <a title="LaTeX in R" rel="nofollow" href="https://www.r-bloggers.com/search/LaTeX">LaTeX</a>, <a title="SQL and databases" rel="nofollow" href="https://www.r-bloggers.com/search/SQL">SQL</a>, <a title="Eclipse IDE for R" rel="nofollow" href="https://www.r-bloggers.com/search/eclipse">Eclipse</a>, <a title="git and github, Version Control System" rel="nofollow" href="https://www.r-bloggers.com/search/git">git</a>, <a title="Large data in R using Hadoop" rel="nofollow" href="https://www.r-bloggers.com/search/hadoop">hadoop</a>, <a title="Web Scraping of google, facebook, yahoo, twitter and more using R" rel="nofollow" href="https://www.r-bloggers.com/search/Web+Scraping">Web Scraping</a>) statistics (<a title="Regressions and ANOVA analysis tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/regression">regression</a>, <a title="principal component analysis tutorial" rel="nofollow" href="https://www.r-bloggers.com/search/PCA">PCA</a>, <a title="Time series" rel="nofollow" href="https://www.r-bloggers.com/search/time+series">time series</a>, <a title="finance trading" rel="nofollow" href="https://www.r-bloggers.com/search/trading">trading</a>) and more...
<img height="1" alt="" width="1" src="http://feeds.feedburner.com/~r/RBloggers/~4/SmSn8UWuksk"></a></div>