Una solución es escribir sus propias funciones de imputación personalizadas para el micepaquete. El paquete está preparado para esto y la configuración sorprendentemente sin dolor.
Primero configuramos los datos como se sugiere:
dat=data.frame(x1=c(21, 50, 31, 15, 36, 82, 14, 14, 19, 18, 16, 36, 583, NA,NA,NA, 50, 52, 26, 24),
x2=c(0, NA, 18,0, 19, 0, NA, 0, 0, 0, 0, 0, 0,NA,NA, NA, 22, NA, 0, 0),
x3=c(0, 0, 0, 0, 0, 54, 0 ,0, 0, 0, 0, 0, 0, NA, NA, NA, NA, 0, 0, 0))
A continuación, cargamos el micepaquete y vemos qué métodos elige de forma predeterminada:
library(mice)
# Do a non-imputation
imp_base <- mice(dat, m=0, maxit = 0)
# Find the methods that mice chooses
imp_base$method
# Returns: "pmm" "pmm" "pmm"
# Look at the imputation matrix
imp_base$predictorMatrix
# Returns:
# x1 x2 x3
#x1 0 1 1
#x2 1 0 1
#x3 1 1 0
El pmmrepresenta predictivo coincidencia media - probablemente el algoritmo de imputación más populares para imputar las variables continuas. Calcula el valor predicho utilizando un modelo de regresión y selecciona los 5 elementos más cercanos al valor predicho (por distancia euclidiana ). Estos elementos elegidos se denominan grupo de donantes y el valor final se elige al azar de este grupo de donantes.
De la matriz de predicción encontramos que los métodos obtienen las variables que son interesantes para las restricciones. Tenga en cuenta que la fila es la variable objetivo y la columna los predictores. Si x1 no tuviera 1 en la columna x3, tendríamos que agregar esto en la matriz:imp_base$predictorMatrix["x1","x3"] <- 1
Ahora a la parte divertida, generando los métodos de imputación. Elegí un método bastante crudo aquí donde descarto todos los valores si no cumplen con los criterios. Esto puede resultar en un tiempo de bucle prolongado y puede ser potencialmente más eficiente mantener las imputaciones válidas y solo rehacer las restantes, aunque requeriría un poco más de ajustes.
# Generate our custom methods
mice.impute.pmm_x1 <-
function (y, ry, x, donors = 5, type = 1, ridge = 1e-05, version = "",
...)
{
max_sum <- sum(max(x[,"x2"], na.rm=TRUE),
max(x[,"x3"], na.rm=TRUE))
repeat{
vals <- mice.impute.pmm(y, ry, x, donors = 5, type = 1, ridge = 1e-05,
version = "", ...)
if (all(vals < max_sum)){
break
}
}
return(vals)
}
mice.impute.pmm_x2 <-
function (y, ry, x, donors = 5, type = 1, ridge = 1e-05, version = "",
...)
{
repeat{
vals <- mice.impute.pmm(y, ry, x, donors = 5, type = 1, ridge = 1e-05,
version = "", ...)
if (all(vals == 0 | vals >= 14)){
break
}
}
return(vals)
}
mice.impute.pmm_x3 <-
function (y, ry, x, donors = 5, type = 1, ridge = 1e-05, version = "",
...)
{
repeat{
vals <- mice.impute.pmm(y, ry, x, donors = 5, type = 1, ridge = 1e-05,
version = "", ...)
if (all(vals == 0 | vals >= 16)){
break
}
}
return(vals)
}
Una vez que hayamos terminado de definir los métodos, simplemente cambiaremos los métodos anteriores. Si solo desea cambiar una sola variable, simplemente puede usarla, imp_base$method["x2"] <- "pmm_x2"pero para este ejemplo cambiaremos todas (la nomenclatura no es necesaria):
imp_base$method <- c(x1 = "pmm_x1", x2 = "pmm_x2", x3 = "pmm_x3")
# The predictor matrix is not really necessary for this example
# but I use it just to illustrate in case you would like to
# modify it
imp_ds <-
mice(dat,
method = imp_base$method,
predictorMatrix = imp_base$predictorMatrix)
Ahora echemos un vistazo al tercer conjunto de datos imputado:
> complete(imp_ds, action = 3)
x1 x2 x3
1 21 0 0
2 50 19 0
3 31 18 0
4 15 0 0
5 36 19 0
6 82 0 54
7 14 0 0
8 14 0 0
9 19 0 0
10 18 0 0
11 16 0 0
12 36 0 0
13 583 0 0
14 50 22 0
15 52 19 0
16 14 0 0
17 50 22 0
18 52 0 0
19 26 0 0
20 24 0 0
Ok, eso hace el trabajo. Me gusta esta solución, ya que puedes aprovechar las funciones principales y solo agregar las restricciones que consideres significativas.
Actualizar
Para hacer cumplir las rigurosas restricciones @ t0x1n mencionadas en los comentarios, es posible que deseemos agregar las siguientes habilidades a la función de envoltura:
- Guarde valores válidos durante los bucles para que no se descarten los datos de ejecuciones parcialmente exitosas anteriores
- Un mecanismo de escape para evitar bucles infinitos.
- Infle el grupo de donantes después de intentar x veces sin encontrar una coincidencia adecuada (esto se aplica principalmente a pmm)
Esto da como resultado una función de envoltura ligeramente más complicada:
mice.impute.pmm_x1_adv <- function (y, ry,
x, donors = 5,
type = 1, ridge = 1e-05,
version = "", ...) {
# The mice:::remove.lindep may remove the parts required for
# the test - in those cases we should escape the test
if (!all(c("x2", "x3") %in% colnames(x))){
warning("Could not enforce pmm_x1 due to missing column(s):",
c("x2", "x3")[!c("x2", "x3") %in% colnames(x)])
return(mice.impute.pmm(y, ry, x, donors = 5, type = 1, ridge = 1e-05,
version = "", ...))
}
# Select those missing
max_vals <- rowSums(x[!ry, c("x2", "x3")])
# We will keep saving the valid values in the valid_vals
valid_vals <- rep(NA, length.out = sum(!ry))
# We need a counter in order to avoid an eternal loop
# and for inflating the donor pool if no match is found
cntr <- 0
repeat{
# We should be prepared to increase the donor pool, otherwise
# the criteria may become imposs
donor_inflation <- floor(cntr/10)
vals <- mice.impute.pmm(y, ry, x,
donors = min(5 + donor_inflation, sum(ry)),
type = 1, ridge = 1e-05,
version = "", ...)
# Our criteria check
correct <- vals < max_vals
if (all(!is.na(valid_vals) |
correct)){
valid_vals[correct] <-
vals[correct]
break
}else if (any(is.na(valid_vals) &
correct)){
# Save the new valid values
valid_vals[correct] <-
vals[correct]
}
# An emergency exit to avoid endless loop
cntr <- cntr + 1
if (cntr > 200){
warning("Could not completely enforce constraints for ",
sum(is.na(valid_vals)),
" out of ",
length(valid_vals),
" missing elements")
if (all(is.na(valid_vals))){
valid_vals <- vals
}else{
valid_vals[is.na(valid_vals)] <-
vals[is.na(valid_vals)]
}
break
}
}
return(valid_vals)
}
Tenga en cuenta que esto no funciona tan bien, probablemente debido a que el conjunto de datos sugerido falla sin restricciones en todos los casos. Necesito aumentar la longitud del bucle a 400-500 incluso antes de que comience a comportarse. Supongo que esto no es intencional, su imputación debe imitar cómo se generan los datos reales.
Mejoramiento
El argumento rycontiene los valores que no faltan y posiblemente podríamos acelerar el ciclo eliminando los elementos que hemos encontrado imputaciones elegibles, pero como no estoy familiarizado con las funciones internas, me he abstenido de esto.
Creo que lo más importante cuando tienes fuertes restricciones que tardan en completarse es paralelizar tus imputaciones ( consulta mi respuesta en CrossValidated ). La mayoría tiene hoy computadoras con 4-8 núcleos y R solo usa una de ellas de manera predeterminada. El tiempo puede dividirse (casi) por la mitad duplicando el número de núcleos.
Faltan parámetros en la imputación
Con respecto al problema de x2faltar en el momento de la imputación, los ratones nunca introducen valores perdidos en el x- data.frame. El método de los ratones incluye completar algún valor aleatorio al inicio. La parte de la cadena de la imputación limita el impacto de este valor inicial. Si observa la micefunción, puede encontrarla antes de la llamada de imputación (la mice:::samplerfunción):
...
if (method[j] != "") {
for (i in 1:m) {
if (nmis[j] < nrow(data)) {
if (is.null(data.init)) {
imp[[j]][, i] <- mice.impute.sample(y,
ry, ...)
}
else {
imp[[j]][, i] <- data.init[!ry, j]
}
}
else imp[[j]][, i] <- rnorm(nrow(data))
}
}
...
El data.initpuede suministrarse a la micefunción y mouse.imput.sample es un procedimiento de muestreo básico.
Secuencia de visita
Si la secuencia de visitas es importante, puede especificar el orden en que la función mice-funciona las imputaciones. El valor predeterminado es from 1:ncol(data)pero puedes configurarlo visitSequencepara que sea lo que quieras.
0 or 16 or >= 16a0 or >= 16ya que>=16incluye el valor16. Espero que no haya estropeado tu significado. Lo mismo para0 or 14 or >= 14