\newcommand{\AIC}{\textsc{aic}}
\newcommand{\BIC}{\textsc{bic}}
\newcommand{\FPE}{\textsc{fpe}}
\newcommand{\EBIC}{\textsc{bic$_\gamma$}}
\newcommand{\BICg}{\textsc{bic}g}
\newcommand{\PRESS}{\textsc{press}}
\newcommand{\NID}{\textsc{nid}}
\newcommand{\CV}{\textsc{cv}}
\newcommand{\LOOCV}{\textsc{loocv}}
\newcommand{\GLM}{\textsc{glm}}
\newcommand{\LARS}{\textsc{lars}}
\newcommand{\LASSO}{\textsc{lasso}}
\newcommand{\QBIC}{\textsc{bic$_q$}}
\newcommand{\BICq}{\textsc{bic}q}



\documentclass[article,nojss]{jss}
\DeclareGraphicsExtensions{.pdf,.eps}
%\usepackage{Sweave}
%\usepackage{natbib}

\author{C. Xu\\University of Western Ontario \And
        A. I. McLeod\\University of Western Ontario}
\Plainauthor{C. Xu, A. I. McLeod}

\title{Performance of the BIC$_q$: Simulation Experiment }
\Plaintitle{Performance of the BICq: Simulation Experiment}

\Keywords{AIC, extended BIC}
\Plainkeywords{AIC, extended BIC}

\Abstract{
A more detailed presentation is given for the
simulation experiment reported in \citet[Table 2]{Xu2009} comparing
the performance of the \QBIC\ with the \AIC, \BIC\  and \EBIC\ 
for linear model selection.
The scripts displayed in this document may be manually extracted
using an editor from the file \code{SimExperimentBICq.Rnw} which is
located in the subdirectory \code{inst/doc}.
Alternatively if the R package \pkg{Sweave} is installed the command:
\code{R CMD Stangle SimExperimentBICq.Rnw} may be used.
}

\Address{
  A.I. McLeod\\
  University of Western Ontario\\
  E-mail: \email{aimcleod@uwo.ca}\\
  Changjiang Xu\\
  University of Western Ontario\\
  E-mail: \email{cxu49@uwo.ca}
}


\begin{document}

\SweaveOpts{engine=R,eps=FALSE}
%\VignetteIndexEntry{Performance of the BICq: Simulation Experiment}
%\VignetteDepends{leaps}
%\VignetteKeywords{extended BIC}
%\VignettePackage{bestglm}


<<preliminaries,echo=FALSE,results=hide>>=
online <- FALSE ## if set to FALSE the local copy of MSFT.rda
                ## is used instead of get.hist.quote()
options(prompt = "R> ")
@

\section[Introduction]{Introduction} 
\label{sec:intro}

The performance of the \AIC, \BIC, \EBIC\ and \QBIC\ were compared by simulation.
We used the regression, 
$y_i=\beta_1 x_{i,1} + \beta_2 x_{i,2} + \beta_3 x_{i,3} + \beta_4 x_{i,4} +\beta_5 x_{i,5} + e_i$, $i=1,\ldots,40$,
where $e_i$ are independent and identically distributed as $N(0,1)$, $x_{i,1}=1$ and $x_{i,2},\ldots,x_{i,5}$
are specified in \citet[Table 1]{Shao93}.

To compare the models we may consider the model error,
$\parallel X\beta-X({\cal S})\hat{\beta}({\cal S})\parallel^2$,
as well as counts of the number of times a correct model is chosen,
a model which underfits is chosen or a model which overfits is chosen.

For the \QBIC we consider $q=0.15,~0.25,~0.5$, and $0.75$ as well
as $q=\hat q_1\in (q_{1,k_1}, q_{2,k_1})$ and $q=\hat q_2\in (q_{1,k_2}, q_{2,k_2})$.
The interval $(q_{1,k_1}, q_{2,k_2})$ is obtained using the method given in
\citet{Xu2009} with $\alpha=0.99$.

\section[Main Simulation Function]{Main Simulation Function}
\label{sec:MainSimulationFunction}

The basic workhorse for the simulation is our function \code{BICqSimulation}
shown below.

<<Sim-BICqSimulation>>=
`BICqSimulation` <-
function(X, beta, NumSim, g=c(0.5,1),q=c(0.15,0.25,0.75)) 
{
### y=[1,X]*beta+sigma*N(0,1)
#Arguments: X - n*p design matrix for regression
#           beta - vector of p+1 coefficients (including intercept)
#           NumSim - number of simulations
#           g - adjustable parameters for EBIC
#           q - tuning parameters for BICq
#
stopifnot(ncol(X)==length(beta)-1)
n<- nrow(X)
K<- ncol(X)
b0<- beta[1]
b<- beta[-1]
s0<- (b!=0)
X1<- as.matrix(X[,b!=0]) 
b1<- b[b!=0]
y0<- b0+X1%*%b1
k0<- length(b1)
out<- 0
meMean<- 0
meSum2<- 0
for (i in 1:NumSim){
    y<- y0+rnorm(n)  
    Xy<- data.frame(X,y=y) 
#AIC
    m<- bestglm(Xy,IC="AIC")
    Subs<- m$Subsets[,-1]
    sAIC<- as.matrix(Subs[which.min(Subs[,ncol(Subs)]),][1:K])
    fit<- m$BestModel
    meAIC<- sum((y0-fit$fitted.values)^2)
    sAICst<- as.matrix(Subs[m$Bestq[1,3]+1,][1:K])
    sBICst<- as.matrix(Subs[m$Bestq[2,3]+1,][1:K])
    fit<- lm(y~., data=data.frame(X[,sAICst],y=y))
    meAICst<- sum((y0-fit$fitted.values)^2)
    fit<- lm(y~., data=data.frame(X[,sBICst],y=y))
    meBICst<- sum((y0-fit$fitted.values)^2)
#BIC
    m<- bestglm(Xy,IC="BIC")
    Subs<- m$Subsets[,-1]
    sBIC<- as.matrix(Subs[which.min(Subs[,ncol(Subs)]),][1:K])
    fit<- m$BestModel
    meBIC<- sum((y0-fit$fitted.values)^2)
#EBICs
    sBICg<- matrix(rep(NA,K*length(g)),ncol=K)
    meBICg<- rep(NA,length(g))
    for (j in 1:length(g)){
    m<- bestglm(Xy,IC="BICg",t=g[j])
    Subs<- m$Subsets[,-1]
    sBICg[j,]<- as.matrix(Subs[which.min(Subs[,ncol(Subs)]),][1:K])
    fit<- m$BestModel
    meBICg[j]<- sum((y0-fit$fitted.values)^2)
    }
#BICq's
    sBICq<- matrix(rep(NA,K*length(q)),ncol=K)
    meBICq<- rep(NA,length(q))
    for (j in 1:length(q)){
    m<- bestglm(Xy,IC="BICq",t=q[j])
    Subs<- m$Subsets[,-1]
    sBICq[j,]<- as.matrix(Subs[which.min(Subs[,ncol(Subs)]),][1:K])
    fit<- m$BestModel
    meBICq[j]<- sum((y0-fit$fitted.values)^2)
    }
#
    SS<- rbind(sAIC,sBIC,sBICg,sBICq,sAICst,sBICst)
    rownames(SS)<- c("AIC","BIC", paste("BICg(g=",g,")",sep=""), 
                paste("BICq(q=",q,")",sep=""), "BICq1","BICq2")
    meSS<- c(meAIC,meBIC,meBICg,meBICq,meAICst,meBICst) 
    Delta<- meSS-meMean
    meMean<- meMean+Delta/i
    meSum2<- meSum2+Delta*(meSS-meMean)
    SS_s0<- SS-matrix(rep(s0,nrow(SS)),nrow=nrow(SS),byrow=TRUE)
    SS_s0<- rowSums(SS_s0)
    kSS<- rowSums(SS)
    overfit <- kSS>k0
    underfit <- kSS<k0
    correct <- as.numeric(SS_s0==0)
    out <- out+cbind(overfit=(kSS>k0), underfit=(kSS<k0), correct=(SS_s0==0)) 
    }
overfit <- out[,"overfit"]/NumSim
underfit <- out[,"underfit"]/NumSim
correct <- out[,"correct"]/NumSim
cbind(overfit=overfit, underfit=underfit, correct=correct, me=meMean, se.me= sqrt(meSum2/(NumSim*(NumSim-1))))
}
@

\section[R Script for Simulations]{R Script for Simulations}
\label{sec:RScriptforSimulations}

Here we do only 10 simulations to get some timings.
It took about 4.8 seconds on our computer, so for $10^5$ simulations, it would take
about 13.3 hours or about 3.3 hours per model.

The results are in the \proglang{R} list, \code{OutTable}, and 
show for each model the model error as well
as counts for number correct, number overfit and number underfit.

<<Sim-BICq>>=
library(bestglm)
data(Shao)
NumSim <- 10^1
SEED<-123123321
X <- Shao 
#intercept is 2 for all, ie. beta[1,]
BETA <- matrix(c(c(2,0,0,4,0),c(2,0,0,4,8),c(2,9,0,4,8),c(2,9,6,4,8)), ncol=4)
Start <- proc.time()[3]
OutTable<-lapply(1:4, FUN=function(i){
            set.seed(SEED)
            BICqSimulation(X,b=BETA[,i],NumSim=NumSim)
            })
End <- proc.time()[3]
Total <- End-Start
Total
@


\section[Using Rmpi]{Using Rmpi}
\label{sec:UsingRmpi}

The main simulations were run on a Mac computer with 8 CPU's using the
package \pkg{Rmpi} \citep{HaoYu2002, HaoYu2009}.
Since $10^5$ simulations were needed, we simply divided the job
up into four parts, giving each CPU one model to simulate.
In this case, essentially all that is needed is to
replace \code{apply} by \code{mpi.apply} in the above \proglang{R} script.

Running the script below required about 3.4 hours.
Making use of the multi-core CPU by using the \pkg{Rmpi} package,
the total time to run all four models is about the same as running just
one model on a single CPU.
The results are identical to what is obtained if the \proglang{R} script
in Section \ref{sec:RScriptforSimulations} was run on a single CPU \code{NumSim}
increased to 100,000.
This was verified by running the script in Section \ref{sec:RScriptforSimulations}
overnight and setting \code{NumSim} to \code{100000}.

\subsection[R Script for Simulation Using Rmpi]{R Script for Simulation Using Rmpi}
\label{subsec:RScriptforSimulationUsing Rmpi}

\begin{Schunk}
\begin{Sinput}
library(Rmpi)
library(bestglm)
data(Shao)
NumSim <- 10^5
SEED<-123123321
X <- Shao #Note: Shao is a 40-by-4 matrix
#intercept is 2 for all, ie. beta[1,]
BETA <- matrix(c(c(2,0,0,4,0),c(2,0,0,4,8),c(2,9,0,4,8),c(2,9,6,4,8)), ncol=4)
#mpi.apply doesn't understand anonymous functions, so define:
GetTable<-function(i){
            set.seed(SEED)
            BICqSimulation(X,b=BETA[,i],NumSim=NumSim)
            }
#
Start <- proc.time()[3]
StartDate <- date()
#
mpi.spawn.Rslaves(nslaves=4)
mpi.bcast.Robj2slave(SEED)
mpi.bcast.Robj2slave(X)
mpi.bcast.Robj2slave(BETA)
mpi.bcast.Robj2slave(NumSim)
mpi.bcast.Robj2slave(BICqSimulation)
mpi.bcast.Robj2slave(GetTable)
mpi.bcast.cmd(library(bestglm))
#
#note: argument name is 'fun' not 'FUN'
OutTable<-mpi.apply(1:4, fun=GetTable)
End <- proc.time()[3]
EndDate<-date()
Total <- End-Start
#
#output results
for (i in 1:4)
    write.table(OutTable[[i]], file=paste("tb",i,".dat",sep=""))
TotalTime<-paste("started:",StartDate,"\nended:",EndDate,"\nTotal elapsed time in seconds",Total)
write(TotalTime, file="TotalTime.txt")
#
#display files at console
dir()
file.show("TotalTime.txt")
#close and quit
mpi.close.Rslaves()
mpi.quit()
\end{Sinput}
\end{Schunk}

The script saves the output results in the files \code{tb1.dat}, \code{tb2.dat}, \code{tb3.dat} and
\code{tb4.dat}.
These files may be processed afterwards to produce the tables shown below.

\vfill\eject\newpage

\section[Tables]{Tables}
\label{sec:Tables}

In the case of proportions, the maximum standard error is
when $p=0.5$ and corresponds to $(0.25 \times 10^{-5})^{-{1\over2}} \approx 0.0016$.

\SweaveOpts{echo=FALSE}

<<SimRmpi-getTable>>=
tb1<-round(read.table("tb1.dat", header=TRUE),2)
tb2<-round(read.table("tb2.dat", header=TRUE),2)
tb3<-round(read.table("tb3.dat", header=TRUE),2)
tb4<-round(read.table("tb4.dat", header=TRUE),2)
@

<<results=tex>>=
library(xtable)
tiA<-"$10^5$ Simulations with"
tiB<-"\nThe percentage of overfit, underfit and correct models as well as the model error, ME, are shown."
tiC<-"\n The maximum sd of the percentages is 0.0016. For ME the sd was about 0.01 in all cases."
xtable(tb1, caption=paste(tiA,"$\\beta=(2,0,0,4,0)$.",tiB,tiC))
@

<<results=tex>>=
xtable(tb2, caption=paste(tiA,"$\\beta=(2,0,0,4,8)$.",tiB,tiC))
@


\vfill\eject\newpage

<<results=tex>>=
xtable(tb3, caption=paste(tiA,"$\\beta=(2,9,0,4,8)$.",tiB,tiC))
@

<<results=tex>>=
xtable(tb4, caption=paste(tiA,"$\\beta=(2,9,6,4,8)$.",tiB,tiC))
@

\vfill\eject\newpage

\section[Comments on the Simulation Results]{Comments on the Simulation Results}
\label{sec:CommentsontheSimulationResults}

The results for the mean error, ME, are identical to those reported in \citet[Table 2]{Xu2009}.
It is interesting to note that in the only case where the BICq1 or BICq2 did not do better than
all the other model selection criteria was with the full model $\beta=(2,9,6,4,8)$
and in this case the difference was very small and was apparently due to a very
slight tendency to underfit.
With the other models,
it was interesting to see that most of the criteria tended to overfit the model.
Underfitting was very rare.
This agrees with asymptotic theory.
Even in the case of the AIC,  the results of \citet{Shibata1980} indicated
that asymptotically the probability of underfitting was zero.

Our simulation results are also available in the files
\code{tb1.dat}, \code{tb2.dat}, \code{tb3.dat} and \code{tb4.dat}
included with this vignette.

\bibliography{bestglm}



\end{document}


