Una soluzione è scrivere le proprie funzioni di imputazione personalizzate per il micepacchetto. Il pacchetto è preparato per questo e l'installazione è sorprendentemente indolore.
Innanzitutto impostiamo i dati come suggerito:
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))
Quindi cariciamo il micepacchetto e vediamo quali metodi sceglie per impostazione predefinita:
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
È l' pmmacronimo di matching medio predittivo , probabilmente l'algoritmo di imputazione più popolare per imputare variabili continue. Calcola il valore previsto utilizzando un modello di regressione e seleziona i 5 elementi più vicini al valore previsto (in base alla distanza euclidea ). Questi elementi scelti sono chiamati pool di donatori e il valore finale viene scelto a caso da questo pool di donatori.
Dalla matrice di previsione troviamo che i metodi ottengono le variabili passate che sono interessanti per le restrizioni. Si noti che la riga è la variabile target e la colonna i predittori. Se x1 non avesse 1 nella colonna x3, dovremmo aggiungere questo nella matrice:imp_base$predictorMatrix["x1","x3"] <- 1
Ora per la parte divertente, generando i metodi di imputazione. Ho scelto un metodo piuttosto grezzo qui in cui scarto tutti i valori se non soddisfano i criteri. Ciò può comportare un tempo di ciclo lungo e potrebbe essere potenzialmente più efficiente mantenere le imputazioni valide e ripetere solo quelle rimanenti, tuttavia richiederebbe un po 'più di modifiche.
# 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 volta che abbiamo finito di definire i metodi, cambiamo semplicemente i metodi precedenti. Se vuoi solo cambiare una singola variabile, puoi semplicemente usare, imp_base$method["x2"] <- "pmm_x2"ma per questo esempio cambieremo tutto (la denominazione non è necessaria):
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)
Ora diamo un'occhiata al terzo set di dati imputati:
> 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, questo fa il lavoro. Mi piace questa soluzione in quanto puoi sulle spalle delle funzioni principali e aggiungere solo le restrizioni che ritieni significative.
Aggiornare
Al fine di applicare le restrizioni rigorose @ t0x1n menzionate nei commenti, potremmo voler aggiungere le seguenti abilità alla funzione wrapper:
- Salvare valori validi durante i loop in modo che i dati delle precedenti esecuzioni parzialmente riuscite non vengano eliminati
- Un meccanismo di fuga per evitare cicli infiniti
- Gonfia il pool di donatori dopo aver provato x volte senza trovare una corrispondenza adatta (questo vale principalmente per pmm)
Ciò si traduce in una funzione wrapper leggermente più complicata:
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)
}
Si noti che ciò non funziona così bene, molto probabilmente a causa del fatto che il set di dati suggerito non ha i vincoli per tutti i casi senza perdere. Devo aumentare la lunghezza del loop a 400-500 prima ancora che inizi a comportarsi. Suppongo che questo non sia intenzionale, la tua imputazione dovrebbe imitare il modo in cui vengono generati i dati reali.
Ottimizzazione
L'argomento rycontiene i valori non mancanti e potremmo eventualmente accelerare il ciclo rimuovendo gli elementi che abbiamo trovato imputazioni ammissibili, ma poiché non ho familiarità con le funzioni interne, mi sono astenuto da questo.
Penso che la cosa più importante quando si hanno forti vincoli che richiedono tempo per il riempimento completo sia parallelizzare le proprie imputazioni ( vedere la mia risposta su CrossValidated ). La maggior parte ha oggi computer con 4-8 core e R ne usa solo uno per impostazione predefinita. Il tempo può essere (quasi) diviso in due raddoppiando il numero di core.
Parametri mancanti al momento dell'imputazione
Per quanto riguarda il problema della x2mancanza al momento dell'imputazione, i topi in realtà non immettono mai valori mancanti nel x- data.frame. Il metodo dei topi include l'inserimento di un valore casuale all'inizio. La parte catena dell'imputazione limita l'impatto di questo valore iniziale. Se guardi la funzione micepuoi trovarla prima della chiamata di imputazione (la funzione mice:::sampler):
...
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))
}
}
...
È data.initpossibile fornire la micefunzione e mice.imput.sample è una procedura di campionamento di base.
Sequenza di visite
Se la sequenza di visite è importante, è possibile specificare l'ordine in cui la funzione miceesegue le imputazioni. L'impostazione predefinita è 1:ncol(data)ma è possibile impostare il valore visitSequencecome desiderato.
0 or 16 or >= 16da0 or >= 16poiché>=16include il valore16. Spero che non abbia rovinato il tuo significato. Lo stesso per0 or 14 or >= 14