---
title: "How to impute missing values?"
author: "Genevieve Robin, Imke Mayer, Aude Sportisse"
date: "`r format(Sys.time(), '%d %B %Y')`"
output:
  html_document:
    number_sections: yes
    toc: yes
    toc_depth: 3
    toc_float: yes 
  pdf_document:
    toc: yes
    toc_depth: '3'
linkcolor: blue
link-citations: yess
bibliography: bibliography.bib
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, cache=TRUE)
```

The problem of missing data is ubiquitous in the practice of data analysis. Main approaches for handling missing data include imputation methods. In this Notebook, we first describe the main imputation methods available on R packages on synthetic data. Then, we compare them on both synthetic data for different missing-data mechanisms and percentage of missing values. Finally, we propose a function giving the comparison of the methods in one particular setting (missing-data mechanism, percentage of missing values) for a list of (complete) real datasets. 


# Description of imputation methods on synthetic data

In this section we provide, for some of the main packages (the list is of course not thorough) to impute missing values, links to vignettes and tutorials, as well as a description of their main functionalities and reusable code. The methods we focus on are gathered in the table below.

| Package       | Data Types    | Underlying Method   | Imputation | Computational Time| Comments |
| ------------- |:--------------| ------------------- |------------|:-------------:|--------------|
| softImpute    | quantitative  |low-rank matrix completion with nuclear norm penalities | single| + |Very fast, strong theoretical guarantees, regularization parameter to tune |
| mice          | mixed         |multivariate imputation by chained equations | multiple   | -  | Very flexible to data types, no parameter to tune |
| missForest    | mixed         |random forests| single|-| Requires large sample sizes, no parameter to tune |
| missMDA       | mixed         |low-rank matrix completion with penality| single/multiple | + | Rank parameter to tune |


```{r libraries, message=FALSE, error=FALSE, warning=FALSE}
library(Amelia)
library(mice)
library(missForest)
library(missMDA)
library(MASS)
library(softImpute)
library(dplyr)
library(tidyr)
library(ggplot2)
library(devtools)
```



Let us consider a gaussian data matrix of size $n$ times $p$. 

```{r synthetic data}
#### Simulation of the data matrix ####
set.seed(123)
n <- 1000
p <- 10
mu.X <- rep(1, 10)
Sigma.X <- diag(0.5, ncol = 10, nrow = 10) + matrix(0.5, nrow = 10, ncol =
10)
X <- mvrnorm(n, mu.X, Sigma.X)
head(X)
```


We introduce some missing (here MCAR) values in the data matrix. One uses the function **produce_NA** detailed in "amputation.R" available in the related R source code of ["How to generate missing values?"](https://rmisstastic.netlify.com/workflows/). 

```{r}
source_url('https://raw.githubusercontent.com/R-miss-tastic/website/master/static/how-to/generate/amputation.R')

#### Introduction of missing values ####

XproduceNA <- produce_NA(X, mechanism = "MCAR", perc.missing = 0.3)
XNA <- as.matrix(as.data.frame(XproduceNA$data.incomp))
```


## softImpute

The [`softImpute` package](https://cran.r-project.org/web/packages/softImpute/index.html) can be used to impute quantitative data. It fits a low-rank matrix approximation to a matrix with missing values via nuclear-norm regularization. A [vignette is available online](https://web.stanford.edu/~hastie/swData/softImpute/vignette.html), as well as the original article [@hastie2015matrix].

The **softImpute** function computes, based on an incomplete dataset, a low-dimensional factorization which can be used to impute the missing values. The function is used as follows:

```{r softImpute}
# perform softImpute
sft <- softImpute(x = XNA, rank.max = 2, lambda = 0, type = c("als", "svd"))
```

The main arguments are the following (more details can be found on the help page).

* `x`: the dataset with missing values (matrix).

* `rank.max`: the restricted rank of the solution, which should not be bigger than min(dim(x))-1.

* `lambda`: the nuclear-norm regularization parameter.

* `type`: indicates the algorithm which should be used, among "svd" and "als". "svd" returns an exact solution, while "als" returns an approximate solution (in exchange for a faster computation time).

To compute the imputed dataset based on the softImpute results, one may use the following code:

```{r softImpute-impute}
# compute the factorization
X.sft <- sft$u %*% diag(sft$d) %*% t(sft$v)
# replace missing values by computed values
X.sft[which(!is.na(XNA))] <- XNA[which(!is.na(XNA))] 
```

To calibrate the parameter lambda, one may perform cross-validation, the code is given [here](https://github.com/R-miss-tastic/website/blob/master/static/how-to/impute/CrossValidation_softImpute.R). 
Then, the imputation procedure can be performed using the value of lambda computed with cross-validation (the other parameters are set to their default value):

```{r softImpute-impute-crossval, warning=FALSE}
source('https://raw.githubusercontent.com/R-miss-tastic/website/master/static/how-to/impute/CrossValidation_softImpute.R')
lambda_sft <- cv_sft(XNA)
sft <- softImpute(x = XNA, lambda = lambda_sft)
X.sft <- sft$u %*% diag(sft$d) %*% t(sft$v)
X.sft[which(!is.na(XNA))] <- XNA[which(!is.na(XNA))]
head(X.sft)
```

## mice

The [`mice` package](https://CRAN.R-project.org/package=mice) implements a multiple imputation methods for multivariate missing data. It can impute mixes of continuous, binary, unordered categorical and ordered categorical data, as well as two-level data. The original article describing the software, as well as the source package [@mice] and example code are available online [here](https://github.com/stefvanbuuren/mice).

The **mice** function computes, based on an incomplete dataset, multiple imputations by chained equations and thus returns $m$ imputed datasets. 

```{r mice, results=FALSE}
mice_mice <- mice(data = XNA, m = 5, method = "pmm") #contains m=5 completed datasets.
#mice::complete(mice_mice, 1) #get back the first completed dataset of the five available in mice_res
```

The main arguments are the following (more details can be found on the help page).

* `data`: the dataset with missing values (matrix).

* `m`: number of multiple imputations.

* `method`: the imputation method to use. 

By default, the predictive mean matching method is performed. Other imputation methods can be used, type `methods(mice)` for a list of the available imputation methods.

We aggregate the complete datasets using the mean of the imputations to get a simple imputation.

```{r mice-aggregation}
IMP <- 0
for (i in 1:5) { IMP <- IMP + mice::complete(mice_mice, i)}
X.mice  <-  IMP/5  #5 is the default number of multiple imputations
head(X.mice)
```


## missForest

The [`missForest` package](https://cran.r-project.org/web/packages/missForest/index.html) can be used to impute mixed-type data (continuous or categorical data). 

The **missForest** function imputes missing values iteratively by training random forests. A vignette is available [online](https://stat.ethz.ch/education/semesters/ss2012/ams/paper/missForest_1.2.pdf) as well as the original paper [@missforest]. 

```{r missForest, message=FALSE, results = "hide"}
forest <- missForest(xmis = XNA, maxiter = 20, ntree = 100)
```

The main arguments are the following (more details can be found on the help page).

* `xmis`: the dataset with missing values (matrix).

* `maxiter`: maximum number of iterations to be performed given the stopping criterion is not met beforehand.

* `ntree`: number of trees for each forest.


```{r missForest imputation}
X.forest<- forest$ximp
head(X.forest)
```


## missMDA

The [`missMDA` package](https://cran.r-project.org/web/packages/missMDA/index.html) serves to impute mixed-type data (continuous or categorical data). 

The **imputePCA** function imputes missing values applying principal component methods. The missing values are predicted using the iterative PCA algorithm for a predefined number of dimensions. Some information are available in the original article [@missMDA] and some videos are online [here](https://www.youtube.com/watch?v=OOM8_FH6_8o) or [here (in french)](https://www.youtube.com/watch?v=bdD9P3fGb70). 

```{r imputePCA}
pca <- imputePCA(X = XNA, ncp = 2, scale = TRUE, method = c("Regularized","EM"))
```


The main argument are the following (more details can be found on the help page).

* `X`: the dataset with missing values (matrix).

* `ncp`: number of components used to predict the missing entries.

* `scale`: if TRUE, it implies that the same weight is given for each variable.


The single imputation step requires tuning the number of dimensions used to impute the data. We use the function **estim_ncpPCA** which estimates the number of the dimensions using a cross-validation. Different cross-validation methods can be used to estimate the number of components, by default a generalized cross-validation is performed.  

```{r imputePCA with estimation ncp}
ncp.pca <- estim_ncpPCA(XNA,method.cv="gcv")$ncp
pca <- imputePCA(XNA, ncp = ncp.pca)
X.pca <- pca$comp
head(X.pca)
```


# Numerical experiments to compare the different methods

## Synthetic data

We compare the methods presented above for different percentage of missing values and for different missing-data mechanisms: 

* Missing Completely At Random (MCAR) if the probability of being missing is the same for all observations

* Missing At Random (MAR) if the probability of being missing only depends on observed values.

* Missing Not At Random (MNAR) if the unavailability of the data depends on both observed and unobserved data such as its value itself.

We compare the methods in terms of mean squared error (MSE), i.e.:
$$MSE(X^{imp}) = \frac{1}{n_{NA}}\sum_{i}\sum_{j} 1_{X^{NA}_{ij}=NA}(X^{imp}_{ij} - X_{ij})^2$$
where $n_{NA} = \sum_{i}\sum_{j} 1_{X^{NA}_{ij}=NA}$ is the number of missing entries in $X^{NA}$.

Note that in order to evaluate this error, we need to know the true values of the missing entries.
```{r mse}
MSE <- function(X, Xtrue, mask) {
  return(sqrt(sum((as.matrix(X) * mask - as.matrix(Xtrue) * mask) ^ 2) / sum(mask)))
}
```


The function **HowToImpute** compares the methods above with the naive imputation by the mean in terms of MSE on a complete dataset. More particularly, the function allows to introduce missing values on the complete dataset using different percentages of missing values and missing-data mechanisms and gives the MSE of the methods for the different missing-value settings. The final MSE for one specific missing-value setting is computed by aggregating the MSE's obtained for several simulations, where the stochasticity comes from the process of drawing several times the missing-data pattern.

The arguments are the following. 

* `X`: the complete dataset where the missing values will be introduced (matrix).

* `perc.list`: list containing the different percentage of missing values. 

* `mecha.list`: list containing the different missing-data mechanisms ("MCAR","MAR", "MNAR"). 

* `nbsim`: number of simulations performed. 

It returns a table containing the mean of the MSEs for the simulations performed. 

```{r HowToImpute, echo = FALSE}
HowToImpute <- function(X , perc.list , mecha.list , nbsim){
  
  perc_mecha.matrix <- matrix(perc.list, nrow = length(mecha.list) * length(perc.list), ncol = 2)
  perc_mecha.matrix[, 2] <- as.vector(sapply(mecha.list, rep, length(perc.list)))

  results.all <- apply(perc_mecha.matrix, 1, function(perc_mecha) { 
    
    perc <- as.numeric(perc_mecha[1])
    mecha <- perc_mecha[2]
    
    results.couple <- lapply(1:nbsim, function(iter){

      XproduceNA <- produce_NA(as.matrix(X), mechanism = mecha, perc.missing = perc)
      
      XNA <- as.matrix(as.data.frame(XproduceNA$data.incomp))
      
      ## Mean
      X.mean <- imputeMean(XNA)
      
      ## MICE
      temp <- mice(XNA, printFlag = FALSE, method = "pmm", remove.collinear = FALSE) # for the predictive mean matching method
      IMP <- 0
      for (i in 1:5) { IMP <- IMP + mice::complete(temp, i)}
      X.mice  <-  IMP/5  #5 is the default number of multiple imputations
      
      ## PCA
      ncp.pca <- estim_ncpPCA(XNA)$ncp
      pca <- imputePCA(XNA, ncp = ncp.pca)
      X.pca <- pca$comp
      
      ## SoftImpute
      lambda_sft <- cv_sft(XNA)
      sft <- softImpute(x = XNA, lambda = lambda_sft, rank.max = min(10,ncol(XNA)-1))
      X.sft <- sft$u %*% diag(sft$d) %*% t(sft$v)
      X.sft[which(!is.na(XNA))] <- XNA[which(!is.na(XNA))]
      
      ## RandomForest
      forest <- missForest(XNA, verbose = FALSE)
      X.forest<- forest$ximp
      
      
      mse <- sapply(list( X.pca, X.forest,  X.mice, X.sft,  X.mean), MSE, Xtrue = as.data.frame(X), mask = is.na(XNA))
      
      cbind.data.frame(mse)
      
    })
    
    results <- Reduce("+", results.couple) / length(results.couple)
    rownames(results) <- c("X.pca", "X.forest",  "X.mice", "X.soft", "X.mean")
    return(results)
  })

  names(results.all) <- paste0(perc_mecha.matrix[,1], " ", perc_mecha.matrix[,2])
  
  resdf <- as.data.frame(results.all)
  colnames(resdf) <- paste0(perc_mecha.matrix[,1], " ", perc_mecha.matrix[,2])
  
  return(resdf)
}

```


```{r results synthetic data, error = FALSE, warning = FALSE, message = FALSE, results = "hide"}
perc.list = c(0.1, 0.3, 0.5)
mecha.list = c("MCAR", "MAR", "MNAR")
res <- HowToImpute(X, perc.list = c(0.1, 0.3, 0.5), mecha.list = c("MCAR", "MAR", "MNAR"), nbsim = 2) 
```


```{r print results synthetic data, echo = TRUE}
res
```


```{r plot synthetic data, echo = TRUE}
plotdf <- do.call(c, res)
plotdf <- as.data.frame(plotdf)
names(plotdf) <- 'mse'
meth <- rep(c("PCA", "RandomForest",  "Mice", "SoftImpute", "Mean"), length(perc.list) * length(mecha.list))
plotdf <- cbind(plotdf, meth)
perc <- rep(rep(as.character(perc.list), each = 5),length(mecha.list))
plotdf <- cbind(plotdf, perc)
mecha <- rep(mecha.list, each = 5 * length(perc.list))
plotdf <- cbind(plotdf, mecha)
```

```{r MCAR synthetic data, error = FALSE, warning = FALSE, message = FALSE, echo = TRUE}
ggplot(plotdf[plotdf$mecha == "MCAR", ]) + geom_point(aes(x = perc, y = mse, color = meth), size = 1.8) + ylab("MSE") + xlab("Percentage of NA") + geom_path(aes(x = perc, y = mse, color = meth, group = meth)) + ggtitle("MCAR") + labs(color = "Methods")
```

```{r MAR synthetic data, error = FALSE, warning = FALSE, message = FALSE, echo = TRUE}
ggplot(plotdf[plotdf$mecha == "MAR", ]) + geom_point(aes(x= perc, y = mse, color = meth), size = 1.8) + ylab("MSE") + xlab("Percentage of NA") + geom_path(aes(x = perc, y = mse, color = meth, group = meth)) + ggtitle("MAR") + labs(color = "Methods")
```

```{r MNAR synthetic data, error = FALSE, warning = FALSE, message = FALSE, echo = TRUE}
ggplot(plotdf[plotdf$mecha == "MNAR", ])+geom_point(aes(x = perc, y = mse,color = meth), size = 1.8) + ylab("MSE") + xlab("Percentage of NA") + geom_path(aes(x = perc, y = mse, color = meth, group = meth)) + ggtitle("MNAR") + labs(color = "Methods")
```

```{r all synthetic data, message = FALSE, echo = TRUE}
ggplot(plotdf) + geom_point(aes(x = perc, y = mse, color = meth, shape = mecha), size = 1.8) + ylab("MSE") + xlab("Percentage of NA") + geom_path(aes(x = perc, y = mse, color = meth, group = meth))
```


## Real datasets

We will now compare the methods on real complete dataset taken from the UCI repository in which we will introduce missing values. In the present workflow, we propose a selection of several datasets (here, the datasets contain only quantitative variables) : 

- Wine Quality - Red (1599x11)
- Wine Quality - White (4898x11)
- Slump (103x9)
- Movement (360x90)
- Decathlon (41x10)

But you can test the methods on any complete dataset you want.


```{r}
wine_white <- read.csv("https://archive.ics.uci.edu/ml/machine-learning-databases/wine-quality/winequality-white.csv", sep = ";") 
wine_white <- wine_white[, -ncol(wine_white)]

wine_red <- read.csv("https://archive.ics.uci.edu/ml/machine-learning-databases/wine-quality/winequality-red.csv", sep = ";")
wine_red <- wine_red[, -ncol(wine_red)]

slump <-read.csv("https://archive.ics.uci.edu/ml/machine-learning-databases/concrete/slump/slump_test.data", sep = ",", header = TRUE, row.names=1)
slump <- slump[, -ncol(slump)]

movement <- read.csv("https://archive.ics.uci.edu/ml/machine-learning-databases/libras/movement_libras.data", sep = ",", header = FALSE)
movement  <- movement[, -ncol(movement)]

library(FactoMineR)
data(decathlon)
decathlon <- decathlon[, 1:10]
```

You can choose to scale data prior to running the experiments, which implies that the variable have the same weight in the analysis. Scaling data may be performed on complete datasets but is more difficult for incomplete datasets^[For MCAR values, the estimations of the standard deviation can be unbiased. However, for MNAR values, the estimators will suffer from biases.]. 

```{r scale data}
sc <- TRUE
if(sc){
  wine_white <- scale(wine_white)
  wine_red <- scale(wine_red)
  slump <- scale(slump)
  movement <- scale(movement)
  decathlon <- scale(decathlon)
}
```

We can then apply the **HowToImpute_real** function. It compares in terms of MSE several imputation methods for different complete datasets where missing values are introduced with a given percentage of missing values and a given missing-data mechanism.

The arguments are the following. 

* `datasets_list`: dictionary of complete datasets.

* `perc`: percentage of missing values.

* `mecha`: missing-data mechanism ("MCAR","MAR" or "MNAR"). 

* `nbsim`: number of simulations performed. 

* `names_dataset`: list containing the names of the datasets (for plotting results).

It returns a table containing the mean of the MSEs for the simulations performed. 

```{r HowToImpute_real, echo = FALSE}
HowToImpute_real <- function(datasets_list, perc , mecha , nbsim, names_dataset){
  plotdf_fin <- NULL
  for (dat in 1:length(datasets_list)){
      res = HowToImpute(datasets_list[[dat]],perc,mecha,nbsim)
      names(res) = names_dataset[[dat]]
      if (dat==1){
        resdf = res
      }else{
        resdf = cbind.data.frame(resdf,res)
      }
      plotdf <- do.call(c,res)
      plotdf <- as.data.frame(plotdf)
      names(plotdf) <- 'mse'
      Methods <- rep(c("PCA", "RandomForest",  "Mice", "SoftImpute",  "Mean"))
      plotdf <- cbind(plotdf, Methods)
      Datasets <- rep(names_dataset[dat],5)
      plotdf <- cbind(plotdf, Datasets)
      if (is.null(plotdf_fin)){
        plotdf_fin <- plotdf
      }else{
        plotdf_fin <- rbind(plotdf_fin,plotdf)
      }
  }
  return(list(plot=plotdf_fin,res=resdf))
}

```

```{r results real data, error = FALSE, warning = FALSE, message = FALSE, results = "hide"}
datasets_list <- list(
                  wine_white = wine_white,
                  wine_red = wine_red,
                  slump = slump,
                  movement = movement,
                  decathlon = decathlon
                 )
names_dataset <- c("winequality-white","winequality-red","slump","movement","decathlon")
perc <- 0.2
mecha <- "MCAR"
nbsim <- 2
howimp_real <-  HowToImpute_real(
                  datasets_list = list(
                    wine_white = wine_white,
                    wine_red = wine_red,
                    slump = slump,
                    movement = movement,
                    decathlon = decathlon
                  ) ,
                  perc = 0.2,
                  mech = "MCAR",
                  nbsim = 2,
                  names_dataset = c(
                    "winequality-white",
                    "winequality-red",
                    "slump",
                    "movement",
                    "decathlon"
                  )
                )
plotdf_fin <- howimp_real$plot
res <- howimp_real$res
```

```{r print results real data, echo = TRUE}
res
```

```{r plot results real data, error = FALSE, warning = FALSE, message = FALSE, echo = TRUE}
ggplot(data=plotdf_fin, aes(x =Datasets, y = mse, fill=Methods)) + geom_bar(stat="identity", position=position_dodge2(width = 1.01,preserve = "single"))
```



# Session info

```{r}
sessionInfo()
```


# References

