Salah satu solusinya adalah menulis fungsi imputasi kustom Anda sendiri untuk micepaket tersebut. Paket ini disiapkan untuk ini dan pengaturannya tanpa rasa sakit.
Pertama-tama kita mengatur data seperti yang disarankan:
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))
Selanjutnya kita memuat micepaket dan melihat metode apa yang dipilih secara default:
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
The pmmsingkatan rata pencocokan prediktif - mungkin algoritma imputasi paling populer untuk imputing variabel kontinu. Ini menghitung nilai prediksi menggunakan model regresi dan memilih 5 elemen terdekat dengan nilai prediksi (dengan jarak Euclidean ). Elemen-elemen yang dipilih disebut kolam donor dan nilai akhir dipilih secara acak dari kolam donor ini.
Dari matriks prediksi kami menemukan bahwa metode mendapatkan variabel lulus yang menarik bagi pembatasan. Perhatikan bahwa baris adalah variabel target dan kolom prediktornya. Jika x1 tidak memiliki 1 di kolom x3 kita harus menambahkan ini dalam matriks:imp_base$predictorMatrix["x1","x3"] <- 1
Sekarang ke bagian yang menyenangkan, menghasilkan metode imputasi. Saya telah memilih metode yang agak kasar di sini di mana saya membuang semua nilai jika tidak memenuhi kriteria. Ini dapat mengakibatkan waktu loop yang panjang dan mungkin berpotensi lebih efisien untuk menjaga imputasi yang valid dan hanya mengulang yang tersisa, itu akan memerlukan sedikit lebih banyak penyesuaian.
# 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)
}
Setelah kita selesai mendefinisikan metode, kita dengan mudah mengubah metode sebelumnya. Jika Anda hanya ingin mengubah satu variabel maka Anda cukup menggunakan imp_base$method["x2"] <- "pmm_x2"tetapi untuk contoh ini kami akan mengubah semua (penamaan tidak perlu):
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)
Sekarang mari kita lihat dataset imputed ketiga:
> 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, itu berhasil. Saya suka solusi ini karena Anda dapat membonceng di atas fungsi utama dan hanya menambahkan batasan yang menurut Anda bermakna.
Memperbarui
Untuk menegakkan pengekangan ketat @ t0x1n yang disebutkan dalam komentar, kami mungkin ingin menambahkan kemampuan berikut ke fungsi pembungkus:
- Simpan nilai yang valid selama loop sehingga data dari yang sebelumnya, sebagian yang berhasil berjalan tidak dibuang
- Mekanisme melarikan diri untuk menghindari loop tak terbatas
- Mengembang kumpulan donor setelah mencoba x kali tanpa menemukan kecocokan yang cocok (ini terutama berlaku untuk pmm)
Ini menghasilkan fungsi pembungkus yang sedikit lebih rumit:
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)
}
Perhatikan bahwa ini tidak bekerja dengan baik, kemungkinan besar karena set data yang disarankan gagal kendala untuk semua kasus tanpa hilang. Saya perlu menambah panjang loop menjadi 400-500 bahkan sebelum mulai berlaku. Saya berasumsi bahwa ini tidak disengaja, imputasi Anda harus meniru bagaimana data aktual dihasilkan.
Optimasi
Argumen tersebut ryberisi nilai-nilai yang tidak hilang dan kami mungkin dapat mempercepat loop dengan menghapus elemen yang telah kami temukan imputasi yang memenuhi syarat, tetapi karena saya tidak terbiasa dengan fungsi-fungsi internal saya telah menahan diri dari ini.
Saya pikir hal yang paling penting ketika Anda memiliki kendala kuat yang membutuhkan waktu untuk mengisi penuh adalah untuk memparalelasikan imputasi Anda ( lihat jawaban saya di CrossValidated ). Sebagian besar memiliki komputer saat ini dengan 4-8 core dan R hanya menggunakan salah satunya secara default. Waktu dapat (hampir) diiris menjadi dua dengan menggandakan jumlah inti.
Parameter yang hilang saat imputasi
Mengenai masalah x2hilang pada saat imputasi - tikus sebenarnya tidak pernah memasukkan nilai yang hilang ke dalam x- data.frame. The tikus metode termasuk mengisi beberapa nilai acak di awal. Bagian rantai dari imputasi membatasi dampak dari nilai awal ini. Jika Anda melihat mice-fungsi Anda dapat menemukan ini sebelum panggilan imputasi ( mice:::sampler-fungsi):
...
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))
}
}
...
The data.initdapat dipasok ke micefungsi dan mice.imput.sample adalah prosedur dasar sampling.
Mengunjungi urutan
Jika urutan kunjungan penting, Anda dapat menentukan urutan di mana mice-fungsi menjalankan imputasi. Default adalah dari 1:ncol(data)tetapi Anda dapat mengatur visitSequenceuntuk menjadi apa pun yang Anda suka.
0 or 16 or >= 16untuk0 or >= 16sejak>=16meliputi nilai16. Semoga itu tidak mengacaukan arti Anda. Sama untuk0 or 14 or >= 14