การตรวจสอบสมมติฐานอัตราต่อรองที่เก็บรักษาไว้ในการถดถอยโลจิสติกอันดับโดยใช้ฟังก์ชั่น polr

ฉันได้ใช้ฟังก์ชั่น 'polr' ในแพ็คเกจ MASS เพื่อเรียกใช้การถดถอยโลจิสติกอันดับสำหรับตัวแปรตอบกลับหมวดหมู่ตามลำดับที่มีตัวแปรอธิบายต่อเนื่อง 15 ตัว

ฉันได้ใช้รหัส (แสดงด้านล่าง) เพื่อตรวจสอบว่ารูปแบบของฉันเป็นไปตามอัตราต่อรองสัดส่วนสมมติฐานคำแนะนำต่อไประบุไว้ในคู่มือยูซีแอล อย่างไรก็ตามฉันกังวลเล็กน้อยเกี่ยวกับผลลัพธ์ที่บ่งบอกว่าไม่เพียง แต่มีค่าสัมประสิทธิ์ในจุดตัดต่าง ๆ ที่คล้ายกัน แต่พวกมันเหมือนกันหมด (ดูกราฟด้านล่าง)

FGV1b <- data.frame(FG1_val_cat=factor(FGV1b[,"FG1_val_cat"]), 
                    scale(FGV1[,c("X","Y","Slope","Ele","Aspect","Prox_to_for_FG", 
                          "Prox_to_for_mL", "Prox_to_nat_border", "Prox_to_village", 
                          "Prox_to_roads", "Prox_to_rivers", "Prox_to_waterFG", 
                          "Prox_to_watermL", "Prox_to_core", "Prox_to_NR", "PCA1", 
                          "PCA2", "PCA3")]))
b     <- polr(FG1_val_cat ~ X + Y + Slope + Ele + Aspect + Prox_to_for_FG + 
                            Prox_to_for_mL + Prox_to_nat_border + Prox_to_village + 
                            Prox_to_roads + Prox_to_rivers + Prox_to_waterFG + 
                            Prox_to_watermL + Prox_to_core + Prox_to_NR, 
              data=FGV1b, Hess=TRUE)

ดูข้อมูลสรุปของโมเดล:

summary(b)
(ctableb <- coef(summary(b)))
q        <- pnorm(abs(ctableb[, "t value"]), lower.tail=FALSE) * 2
(ctableb <- cbind(ctableb, "p value"=q))

และตอนนี้เราสามารถดูช่วงความมั่นใจสำหรับการประมาณพารามิเตอร์:

(cib <- confint(b)) 
confint.default(b)

แต่ผลลัพธ์เหล่านี้ยังยากต่อการตีความดังนั้นลองแปลงค่าสัมประสิทธิ์เป็นอัตราต่อรอง

exp(cbind(OR=coef(b), cib))

ตรวจสอบสมมติฐาน ดังนั้นรหัสต่อไปนี้จะประมาณค่าที่จะสร้างกราฟ ก่อนอื่นมันแสดงให้เราเห็นการแปลงโลจิตของความน่าจะเป็นที่มากกว่าหรือเท่ากับแต่ละค่าของตัวแปรเป้าหมาย

FG1_val_cat <- as.numeric(FG1_val_cat)
sf <- function(y) {
  c('VC>=1' = qlogis(mean(FG1_val_cat >= 1)),
    'VC>=2' = qlogis(mean(FG1_val_cat >= 2)),
    'VC>=3' = qlogis(mean(FG1_val_cat >= 3)),
    'VC>=4' = qlogis(mean(FG1_val_cat >= 4)),
    'VC>=5' = qlogis(mean(FG1_val_cat >= 5)),
    'VC>=6' = qlogis(mean(FG1_val_cat >= 6)),
    'VC>=7' = qlogis(mean(FG1_val_cat >= 7)),
    'VC>=8' = qlogis(mean(FG1_val_cat >= 8)))
}
(t <- with(FGV1b, summary(as.numeric(FG1_val_cat) ~ X + Y + Slope + Ele + Aspect + 
                             Prox_to_for_FG + Prox_to_for_mL + Prox_to_nat_border + 
                             Prox_to_village + Prox_to_roads + Prox_to_rivers + 
                             Prox_to_waterFG + Prox_to_watermL + Prox_to_core + 
                             Prox_to_NR, fun=sf)))

ตารางข้างต้นแสดงค่าที่คาดการณ์ (เชิงเส้น) ที่เราจะได้รับหากเราถดถอยตัวแปรตามของเราในตัวแปรตัวทำนายของเราทีละตัวโดยไม่มีข้อสันนิษฐานที่ขนานกัน ดังนั้นตอนนี้เราสามารถเรียกใช้ชุดของการถดถอยแบบไบนารีโลจิสติกที่มีจุดตัดที่แตกต่างกันในตัวแปรตามเพื่อตรวจสอบความเท่าเทียมกันของค่าสัมประสิทธิ์ข้ามจุดตัด

par(mfrow=c(1,1))
plot(t, which=1:8, pch=1:8, xlab='logit', main=' ', xlim=range(s[,7:8]))

ขอโทษที่ฉันไม่มีผู้เชี่ยวชาญด้านสถิติและบางทีฉันขาดอะไรบางอย่างที่นี่ อย่างไรก็ตามฉันได้ใช้เวลานานในการพยายามคิดออกว่ามีปัญหาในการทดสอบสมมติฐานของแบบจำลองและพยายามหาวิธีอื่น ๆ ในการใช้แบบจำลองชนิดเดียวกัน

ตัวอย่างเช่นฉันอ่านในรายการส่งเมลความช่วยเหลือมากมายที่คนอื่นใช้ฟังก์ชั่น vglm (ในแพ็คเกจ VGAM) และฟังก์ชั่น lrm (ในแพ็คเกจ rms) (ตัวอย่างดูที่นี่: สมมติฐานอัตราต่อรองแบบดั้งเดิมในการ ถดถอยโลจิสติกอันดับใน R VGAM และ rms ) ฉันพยายามเรียกใช้โมเดลเดียวกัน แต่ฉันพบกับคำเตือนและข้อผิดพลาดอย่างต่อเนื่อง

ตัวอย่างเช่นเมื่อฉันพยายามให้พอดีกับรูปแบบ vglm กับอาร์กิวเมนต์ 'parallel = FALSE' (เนื่องจากลิงก์ก่อนหน้ากล่าวถึงเป็นสิ่งสำคัญสำหรับการทดสอบสมมติฐานอัตราต่อรองสัดส่วน) ฉันพบข้อผิดพลาดต่อไปนี้:

ข้อผิดพลาดใน lm.fit (X.vlm, y = z.vlm, ... ): NA / NaN / Inf ใน 'y'
นอกจากนี้: ข้อความเตือน:
ใน Deviance.categorical.data.vgam (mu = mu, y = y, w = w, ส่วนที่เหลือ = ส่วนที่เหลือ,: ค่าติดตั้งใกล้กับ 0 หรือ 1

ฉันอยากจะถามว่ามีใครบางคนที่อาจจะเข้าใจและสามารถอธิบายให้ฉันได้ว่าทำไมกราฟที่ฉันสร้างขึ้นด้านบนดูเหมือนว่าจะเป็น หากจริง ๆ แล้วมันหมายความว่ามีบางอย่างไม่ถูกต้องคุณสามารถช่วยฉันหาวิธีทดสอบสมมติฐานอัตราต่อรองได้เมื่อใช้ฟังก์ชัน polr หรือถ้ามันเป็นไปไม่ได้ฉันก็จะพยายามใช้ฟังก์ชั่น vglm แต่ก็ต้องการความช่วยเหลือเพื่ออธิบายว่าทำไมฉันถึงได้รับข้อผิดพลาดดังกล่าวข้างต้น

หมายเหตุ: ในฐานะพื้นหลังมีดาต้าพอยน์ 1,000 จุดที่นี่ซึ่งเป็นจุดที่ตั้งทั่วทั้งพื้นที่ศึกษา ฉันต้องการตรวจสอบว่ามีความสัมพันธ์ใด ๆ ระหว่างตัวแปรการตอบสนองอย่างเด็ดขาดและตัวแปรอธิบาย 15 เหล่านี้หรือไม่ ตัวแปรอธิบายทั้งหมด 15 ตัวนั้นเป็นลักษณะเชิงพื้นที่ (เช่นระดับความสูงพิกัด xy ความใกล้เคียงกับป่าเป็นต้น) 1,000 ดาต้าพอยน์ถูกจัดสรรแบบสุ่มโดยใช้ GIS แต่ฉันใช้วิธีการสุ่มตัวอย่างแบบแบ่งชั้น ฉันแน่ใจว่าได้รับ 125 คะแนนจากการสุ่มในแต่ละหมวดหมู่ที่แตกต่างกัน 8 ระดับ ฉันหวังว่าข้อมูลนี้จะเป็นประโยชน์

ตัวแปรตามมี 8 ระดับการสั่งซื้อดังนั้นในกราฟเพื่อทดสอบสมมติฐานอัตราต่อรองที่คุณควรเห็นสัญลักษณ์ที่แตกต่างกัน 8 สำหรับตัวแปรอิสระทุก คุณเห็นเพียง 2 สัญลักษณ์สำหรับตัวแปรอิสระทุกตัวอาจเป็นเพราะคุณเลือกช่วงเวลาสั้นเกินไปสำหรับค่าของแกน x หากการคาดเดาของฉันถูกต้องคุณต้องใช้ช่วงเวลาที่กว้างขึ้นสำหรับค่าของแกน x ลองรหัสนี้:

par(mfrow=c(1,1))
plot(t, which=1:8, pch=1:8, xlab='logit', main=' ', xlim=range(s[,3:9]))

ดังนั้นฉันพบสิ่งนี้ผ่าน googling และฉันคิดว่าคำตอบอาจยังคงมีประโยชน์สำหรับเหตุผลนั้น ฉันคิดว่าความผิดพลาดมา

sf <- function(y) {
  c('VC>=1' = qlogis(mean(FG1_val_cat >= 1)),
    'VC>=2' = qlogis(mean(FG1_val_cat >= 2)),
    'VC>=3' = qlogis(mean(FG1_val_cat >= 3)),
    'VC>=4' = qlogis(mean(FG1_val_cat >= 4)),
    'VC>=5' = qlogis(mean(FG1_val_cat >= 5)),
    'VC>=6' = qlogis(mean(FG1_val_cat >= 6)),
    'VC>=7' = qlogis(mean(FG1_val_cat >= 7)),
    'VC>=8' = qlogis(mean(FG1_val_cat >= 8)))
}

ที่คุณใช้มากกว่าFG1_val_cat yใช้ตัวอย่างจากกลยุทธ์การสร้างแบบจำลองการถดถอยของ Harrell:

library(Hmisc)
getHdata(support)
support <- support[complete.cases(support[, c("sfdm2", "adlsc", "sex", "age", "meanbp")]), ]
sfdm <- as.integer (support$sfdm2 ) - 1

sf1 <- function (y) {
  c(' Y ≥ 1 ' = qlogis (mean(sfdm >= 1)), 
    ' Y ≥ 2 ' = qlogis (mean(sfdm >= 2)),
    ' Y ≥ 3 ' = qlogis (mean(sfdm >= 3))
  )
}

sf2 <- function (y) {
  c(' Y ≥ 1 ' = qlogis (mean(y >= 1)), 
    ' Y ≥ 2 ' = qlogis (mean(y >= 2)),
    ' Y ≥ 3 ' = qlogis (mean(y >= 3))
  )
}

s1 <- summary(sfdm ~ adlsc + sex + age + meanbp, fun=sf1,
              data = support)
s2 <- summary(sfdm ~ adlsc + sex + age + meanbp, fun=sf2,
              data = support)  

plot(s1, which =1:3, pch =1:3, xlab = ' logit ', main = ' ', width.factor = 1.4, cex.lab = 0.75)

plot(s2, which =1:3, pch =1:3, xlab = ' logit ', main = ' ', width.factor = 1.4, cex.lab = 0.75)

VS