Imputation diagnostics in MICE for factors - r

Question

I imputed my data using both the packages mice and miceRanger and I would like to compare the distributions of the imputed variables with the original data. In miceRanger this is very easy using the function plotDistributions() which displays density plots for the numeric variables and barplots for factors.
In mice, if the variables are numeric, it is easy to compare the distributions using stripplot() or bwplot(), but I cannot find a simple way to do it if the variables are factors. I wonder if I am missing something or I just have to give in and create a custom routine for that.
Does anyone have any suggestion? Thanks in advance!

Answer 1

As far as I am aware, there isn't a mice-equivalent function similar to miceRanger::plotDistributions() (which is disappointing because it's a very convenient function). However, you can use ggmice to use ggplot2 syntax on mids objects.
library(miceRanger)
library(mice)
library(ggmice)
data(nhanes)
nhanes$hyp <- factor(nhanes$hyp)
## miceRanger
imp1 <- miceRanger(data = nhanes)
plotDistributions(imp1)
## mice and ggmice
imp2 <- mice(data = nhanes)
ggmice(imp2, aes(x = hyp)) +
geom_histogram(stat = "count")

Answer 2

I adapted PlotDistributions() from miceRanger to work with mice.
Beware this function has been only tested quickly on 2 random datasets, therefore I cannot guarantee it does not contain bugs.
For more info, see here
PlotDist <- function (miceObj, vars = names(miceObj$imp), dotsize = 0.5,
...)
{
pos <- which(miceObj$nmis!=0)
vars <- vars[pos]
newClasses <- sapply(miceObj$data[pos], class)
if (vars[[1]] == "allCategorical")
vars <- names(newClasses[newClasses == "factor"])
if (vars[[1]] == "allNumeric")
vars <- names(newClasses[newClasses != "factor"])
newClasses <- newClasses[vars]
facVars <- newClasses[newClasses == "factor"]
numVars <- newClasses[newClasses != "factor"]
if (length(facVars) > 0) {
facList <- lapply(names(facVars), function(var) {
dat <- as.data.table(miceObj$imp[[var]])
dat <- melt(dat, measure.vars = names(dat))
setnames(dat, "value", var)
agg <- dat[, .(Percentage = .N/sum(miceObj$where[, var])), by = c("variable", var)]
rawAgg <- na.omit(as.data.table(mice$data),cols = var)[, .(Percentage = .N/sum(!miceObj$where[, var])), by = var]
return(ggplot() + geom_dotplot(data = agg, aes(x = !!sym(var),
y = !!sym("Percentage")),
binaxis = "y", stackdir = "center",
dotsize = dotsize, stackratio = 0.75, binwidth = 1/50) +
geom_bar(data = rawAgg, aes(x = !!sym(var), y = !!sym("Percentage")),
stat = "identity", alpha = 0.5) +
scale_x_discrete(guide = guide_axis(n.dodge = 2)))
})
}
else facList <- NULL
if (length(numVars) > 0) {
numList <- lapply(names(numVars), function(var) {
dat <- as.data.table(miceObj$imp[[var]])
dat <- melt(dat, measure.vars = names(dat))
setnames(dat, "value", var)
dens <- density(miceObj$data[, get(var)], na.rm = TRUE)
return(ggplot() + geom_density(data = dat, aes(!!sym(var), group = !!sym("variable")), bw = dens$bw) +
geom_density(data = miceObj$data[!is.na(get(var))], aes(!!sym(var)),
linewidth = 1, color = "red", bw = dens$bw) +
ylab("Density"))
})
}
else numList <- NULL
pList <- c(numList, facList)
ggarrange(plotlist = pList, ...)
}