ทางออกหนึ่งคือการเขียนฟังก์ชั่นการกำหนดเองของคุณเองสำหรับ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ย่อมาจากการจับคู่หมายถึงการคาดการณ์ - น่าจะเป็นขั้นตอนวิธีการใส่ร้ายนิยมมากที่สุดสำหรับ imputing ตัวแปรอย่างต่อเนื่อง มันคำนวณค่าที่คาดการณ์ไว้โดยใช้แบบจำลองการถดถอยและเลือก 5 องค์ประกอบที่ใกล้เคียงที่สุดกับค่าที่คาดการณ์ (ตามระยะทางแบบยุคลิด ) องค์ประกอบที่เลือกเหล่านี้เรียกว่ากลุ่มผู้บริจาคและค่าสุดท้ายจะถูกสุ่มเลือกจากกลุ่มผู้บริจาคนี้
จากเมทริกซ์การทำนายเราพบว่าวิธีการได้รับตัวแปรที่ส่งผ่านซึ่งเป็นที่สนใจสำหรับข้อ จำกัด โปรดทราบว่าแถวนั้นเป็นตัวแปรเป้าหมายและคอลัมน์เป็นตัวทำนาย หาก x1 ไม่มี 1 ในคอลัมน์ x3 เราจะต้องเพิ่มสิ่งนี้ในเมทริกซ์:imp_base$predictorMatrix["x1","x3"] <- 1
ตอนนี้ถึงส่วนที่สนุกสร้างวิธีการใส่ความ ฉันเลือกวิธีที่ค่อนข้างหยาบที่นี่ซึ่งฉันจะทิ้งค่าทั้งหมดหากไม่ตรงตามเกณฑ์ สิ่งนี้อาจส่งผลให้เกิดการวนซ้ำเป็นเวลานานและอาจมีประสิทธิภาพมากขึ้นในการรักษา imputations ที่ถูกต้องและทำซ้ำสิ่งที่เหลืออยู่เท่านั้นซึ่งจะต้องใช้การปรับแต่งเพิ่มเติมเล็กน้อย
# 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
ตกลงนั่นทำงานได้ ฉันชอบวิธีนี้เนื่องจากคุณสามารถใช้ฟังก์ชั่นหลักและเพิ่มข้อ จำกัด ที่คุณพบว่ามีความหมาย
ปรับปรุง
เพื่อที่จะบังคับใช้ restraints ที่เข้มงวด @ t0x1n ที่กล่าวถึงในความคิดเห็นเราอาจต้องการเพิ่มความสามารถต่อไปนี้ลงในฟังก์ชัน wrapper:
- บันทึกค่าที่ถูกต้องในระหว่างลูปเพื่อให้ข้อมูลจากการรันที่สำเร็จก่อนหน้านี้บางส่วนไม่ถูกทิ้ง
- กลไกการหลบหนีเพื่อหลีกเลี่ยงการวนซ้ำไม่ จำกัด
- ขยายพูลผู้บริจาคหลังจากลองxครั้งโดยไม่พบการจับคู่ที่เหมาะสม (ส่วนใหญ่จะใช้กับ pmm)
ส่งผลให้ฟังก์ชั่น wrapper ซับซ้อนกว่าเล็กน้อย:
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 หนูวิธีการรวมถึงการกรอกข้อมูลในการสุ่มค่าบางอย่างในช่วงเริ่มต้น ส่วนโซ่ของการใส่เข้าไป จำกัด ผลกระทบจากค่าเริ่มต้นนี้ หากคุณดูที่ - ฟังก์ชั่นคุณสามารถค้นหาสิ่งนี้ก่อนที่จะเรียก imputation (the -function):data.framemicemice:::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-function รันการอิมพลีเมนต์ ค่าเริ่มต้นมาจาก1:ncol(data)แต่คุณสามารถตั้งค่าvisitSequenceให้เป็นอะไรก็ได้ที่คุณต้องการ
0 or 16 or >= 16ไป0 or >= 16ตั้งแต่มีค่า>=1616หวังว่าจะไม่เลอะความหมายของคุณ กันสำหรับ0 or 14 or >= 14