Одне рішення - написати власні власні функції імпутації для miceпакету. Пакет для цього підготовлений, і налаштування дивно безболісне.
Спочатку ми налаштовуємо дані так, як пропонується:
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))
Далі завантажуємо miceпакунок і дивимося, які методи він обрав за замовчуванням:
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
pmmЧи означає самий корінь середнього відповідності - ймовірно, найпопулярніший алгоритм зобов'язання для поставлення безперервних змінних. Він обчислює передбачуване значення за допомогою регресійної моделі та підбирає 5 найближчих елементів до передбачуваного значення (за евклідовою відстані ). Ці обрані елементи називаються пулом донорів, а остаточне значення вибирається випадковим чином із цього пулу донорів.
З матриці прогнозування ми знаходимо, що методи отримують передані змінні, що представляють інтерес для обмежень. Зауважте, що рядок є цільовою змінною, а стовпець - провісниками. Якщо у x1 не було 1 у стовпчику x3, нам доведеться додати це в матрицю:imp_base$predictorMatrix["x1","x3"] <- 1
Тепер до цікавої частини, генеруючи методи імпутації. Тут я вибрав досить грубу методику, де я відкидаю всі значення, якщо вони не відповідають критеріям. Це може призвести до тривалого циклу, і, можливо, буде ефективніше зберегти дійсні імпутації та лише повторити решту, це зажадає трохи більше переробок.
# 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)
}
Як тільки ми закінчимо визначення методів, ми просто змінимо попередні методи. Якщо ви хочете змінити лише одну змінну, тоді ви можете просто скористатися, imp_base$method["x2"] <- "pmm_x2"але для цього прикладу ми змінимо все (іменування не потрібно):
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)
Тепер давайте подивимось на третій імпульований набір даних:
> 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
Гаразд, це робить роботу. Мені подобається це рішення, оскільки ви можете піггіфікувати поверх основних функцій і просто додавати обмеження, які вам здаються значущими.
Оновлення
Щоб застосувати жорсткі обмеження @ t0x1n, згадані в коментарях, ми можемо захотіти додати наступні здібності до функції обгортки:
- Збережіть дійсні значення під час циклів, щоб дані попередніх, частково успішних запусків не були відкинуті
- Механізм втечі, щоб уникнути нескінченних петель
- Надуйте пул донорів після спроб x разів, не знаходячи відповідного відповідника (це стосується насамперед pmm)
Це призводить до дещо складнішої функції обгортки:
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)
}
Зауважте, що це не так добре, швидше за все, через те, що запропонований набір даних не виконує обмеження для всіх випадків, не пропускаючи їх. Мені потрібно збільшити довжину петлі до 400-500, перш ніж вона навіть почне вести себе. Я припускаю, що це ненавмисно, ваша імпутація повинна імітувати, як створюються фактичні дані.
Оптимізація
Аргумент ryмістить недолічені значення, і ми могли б прискорити цикл, видаливши елементи, які ми знайшли придатні імпутації, але, оскільки я не знайомий із внутрішніми функціями, я утримався від цього.
Я вважаю, що найважливіше, якщо у вас є сильні обмеження, на які потрібен час для повного заповнення, - це паралелізувати свої імпутації ( див. Мою відповідь на CrossValidated ). Більшість сьогодні мають комп’ютери з 4-8 ядрами, а R використовує лише один із них за замовчуванням. Час можна (майже) розрізати навпіл, подвоївши кількість ядер.
Відсутні параметри при імпутації
Щодо проблеми x2відсутності під час імпутації - миші насправді ніколи не вводять пропущені значення в x- data.frame. Метод мишей включає заповнення деякого випадкового значення на початку. Ланцюгова частина імпутації обмежує вплив від цього початкового значення. Якщо ви подивитесь на функцію, miceви можете знайти це перед викликом імпутації ( 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.initможе поставлятися у miceфункцію, а вибірка mice.imput.sample - це основна процедура вибірки.
Послідовність відвідування
Якщо послідовність відвідувань важлива, ви можете вказати порядок, в якому miceфункція виконує імпутації. За замовчуванням - від, 1:ncol(data)але ви можете встановити visitSequenceбудь-що, що вам подобається.
0 or 16 or >= 16до0 or >= 16так>=16включає в себе вартість16. Сподіваюся, що це не зіпсувало ваше значення. Те саме за0 or 14 or >= 14