Một giải pháp là viết các hàm cắt cụt tùy chỉnh của riêng bạn cho micegói. Gói được chuẩn bị cho việc này và thiết lập không gây đau đớn một cách đáng ngạc nhiên.
Đầu tiên chúng tôi thiết lập dữ liệu theo đề xuất:
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))
Tiếp theo, chúng tôi tải micegói và xem nó chọn phương thức nào theo mặc định:
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à pmmviết tắt của kết hợp trung bình dự đoán - có lẽ là thuật toán cắt bỏ phổ biến nhất để đưa ra các biến liên tục. Nó tính toán giá trị dự đoán bằng mô hình hồi quy và chọn 5 phần tử gần nhất với giá trị dự đoán (theo khoảng cách Euclide ). Các yếu tố được chọn này được gọi là nhóm nhà tài trợ và giá trị cuối cùng được chọn ngẫu nhiên từ nhóm nhà tài trợ này.
Từ ma trận dự đoán, chúng tôi thấy rằng các phương thức nhận được các biến được quan tâm cho các hạn chế. Lưu ý rằng hàng là biến mục tiêu và cột dự đoán. Nếu x1 không có 1 trong cột x3, chúng ta sẽ phải thêm phần này vào ma trận:imp_base$predictorMatrix["x1","x3"] <- 1
Bây giờ đến phần thú vị, tạo ra các phương pháp cắt bỏ. Tôi đã chọn một phương pháp khá thô sơ ở đây nơi tôi loại bỏ tất cả các giá trị nếu chúng không đáp ứng các tiêu chí. Điều này có thể dẫn đến thời gian vòng lặp dài và nó có khả năng hiệu quả hơn để giữ các lần cắt bỏ hợp lệ và chỉ làm lại những cái còn lại, mặc dù vậy sẽ cần điều chỉnh nhiều hơn một chút.
# 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)
}
Khi chúng ta hoàn thành việc xác định các phương thức, chúng ta đơn giản thay đổi các phương thức trước đó. Nếu bạn chỉ muốn thay đổi một biến duy nhất thì bạn có thể chỉ cần sử dụng imp_base$method["x2"] <- "pmm_x2"nhưng với ví dụ này, chúng tôi sẽ thay đổi tất cả (việc đặt tên là không cần thiết):
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)
Bây giờ chúng ta hãy xem bộ dữ liệu được liệt kê thứ ba:
> 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, đó là công việc. Tôi thích giải pháp này vì bạn có thể cõng trên đầu các chức năng chính và chỉ cần thêm các hạn chế mà bạn thấy có ý nghĩa.
Cập nhật
Để thực thi các hạn chế nghiêm ngặt @ t0x1n được đề cập trong các nhận xét, chúng tôi có thể muốn thêm các khả năng sau vào chức năng trình bao bọc:
- Lưu các giá trị hợp lệ trong các vòng lặp để dữ liệu từ các lần chạy thành công trước đó không bị loại bỏ
- Một cơ chế thoát để tránh các vòng lặp vô hạn
- Thổi phồng nhóm nhà tài trợ sau khi thử x lần mà không tìm thấy kết quả phù hợp (điều này chủ yếu áp dụng cho pmm)
Điều này dẫn đến một chức năng bao bọc phức tạp hơn một chút:
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)
}
Lưu ý rằng điều này không thực hiện tốt điều đó, rất có thể là do tập dữ liệu được đề xuất không có các ràng buộc cho tất cả trường hợp mà không bị thiếu. Tôi cần tăng chiều dài vòng lặp lên 400-500 trước khi nó bắt đầu hoạt động. Tôi cho rằng điều này là vô ý, việc buộc tội của bạn sẽ bắt chước cách dữ liệu thực tế được tạo ra.
Tối ưu hóa
Đối số rychứa các giá trị không bị thiếu và chúng tôi có thể tăng tốc vòng lặp bằng cách loại bỏ các yếu tố mà chúng tôi đã tìm thấy các tranh chấp đủ điều kiện, nhưng vì tôi không quen với các hàm bên trong nên tôi đã kiềm chế điều này.
Tôi nghĩ rằng điều quan trọng nhất khi bạn có những ràng buộc mạnh mẽ cần có thời gian để điền đầy đủ là song song hóa các thuật ngữ của bạn ( xem câu trả lời của tôi trên CrossValidated ). Hầu hết các máy tính ngày nay có 4-8 lõi và R chỉ sử dụng một trong số chúng theo mặc định. Thời gian có thể (gần như) được cắt làm đôi bằng cách nhân đôi số lõi.
Thiếu thông số lúc cắt
Liên quan đến vấn đề x2mất tích tại thời điểm buộc tội - chuột thực sự không bao giờ đưa các giá trị bị thiếu vào x- data.frame. Các con chuột phương pháp bao gồm điền vào một số giá trị ngẫu nhiên khi khởi động. Phần chuỗi của quá trình cắt bỏ giới hạn tác động từ giá trị ban đầu này. Nếu bạn nhìn vào micechức năng, bạn có thể tìm thấy chức năng này trước cuộc gọi cắt ngang ( mice:::samplerchức năng):
...
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))
}
}
...
Có data.initthể được cung cấp cho micehàm và mouse.imput.sample là một quy trình lấy mẫu cơ bản.
Trình tự tham quan
Nếu trình tự truy cập là quan trọng, bạn có thể chỉ định thứ tự trong đó hàm-hàm micechạy các phần tử. Mặc định là từ 1:ncol(data)nhưng bạn có thể đặt thành visitSequencebất cứ điều gì bạn thích.
0 or 16 or >= 16đến0 or >= 16từ>=16bao gồm giá trị16. Hy vọng rằng đã không làm hỏng ý nghĩa của bạn lên. Tương tự cho0 or 14 or >= 14