การประมาณจุดพักในตัวแบบเชิงเส้นแท่ง / เศษชิ้นส่วนที่มีเอฟเฟกต์แบบสุ่มใน R [รวมรหัสและเอาท์พุท]

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

ฉันได้รวมตัวอย่างของเล่นด้านล่างที่เหมาะกับไม้ฮอกกี้ / การถดถอยแบบแท่งหักด้วยความแปรปรวนแบบสุ่มและความแปรปรวนแบบสุ่มตัดแกน y สำหรับจุดพักที่ 4 ฉันต้องการประเมินจุดพักแทนการระบุ มันอาจเป็นผลแบบสุ่ม (ดีกว่า) หรือผลคงที่

library(lme4)
str(sleepstudy)

#Basis functions
bp = 4
b1 <- function(x, bp) ifelse(x < bp, bp - x, 0)
b2 <- function(x, bp) ifelse(x < bp, 0, x - bp)

#Mixed effects model with break point = 4
(mod <- lmer(Reaction ~ b1(Days, bp) + b2(Days, bp) + (b1(Days, bp) + b2(Days, bp) | Subject), data = sleepstudy))

#Plot with break point = 4
xyplot(
        Reaction ~ Days | Subject, sleepstudy, aspect = "xy",
        layout = c(6,3), type = c("g", "p", "r"),
        xlab = "Days of sleep deprivation",
        ylab = "Average reaction time (ms)",
        panel = function(x,y) {
        panel.points(x,y)
        panel.lmline(x,y)
        pred <- predict(lm(y ~ b1(x, bp) + b2(x, bp)), newdata = data.frame(x = 0:9))
            panel.lines(0:9, pred, lwd=1, lty=2, col="red")
        }
    )

เอาท์พุท:

Linear mixed model fit by REML 
Formula: Reaction ~ b1(Days, bp) + b2(Days, bp) + (b1(Days, bp) + b2(Days, bp) | Subject) 
   Data: sleepstudy 
  AIC  BIC logLik deviance REMLdev
 1751 1783 -865.6     1744    1731
Random effects:
 Groups   Name         Variance Std.Dev. Corr          
 Subject  (Intercept)  1709.489 41.3460                
          b1(Days, bp)   90.238  9.4994  -0.797        
          b2(Days, bp)   59.348  7.7038   0.118 -0.008 
 Residual               563.030 23.7283                
Number of obs: 180, groups: Subject, 18

Fixed effects:
             Estimate Std. Error t value
(Intercept)   289.725     10.350  27.994
b1(Days, bp)   -8.781      2.721  -3.227
b2(Days, bp)   11.710      2.184   5.362

Correlation of Fixed Effects:
            (Intr) b1(D,b
b1(Days,bp) -0.761       
b2(Days,bp) -0.054  0.181

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

library(lme4)
str(sleepstudy)

#Basis functions
bp = 4
b1 <- function(x, bp) ifelse(x < bp, bp - x, 0)
b2 <- function(x, bp) ifelse(x < bp, 0, x - bp)

#Wrapper for Mixed effects model with variable break point
foo <- function(bp)
{
  mod <- lmer(Reaction ~ b1(Days, bp) + b2(Days, bp) + (b1(Days, bp) + b2(Days, bp) | Subject), data = sleepstudy)
  deviance(mod)
}

search.range <- c(min(sleepstudy$Days)+0.5,max(sleepstudy$Days)-0.5)
foo.opt <- optimize(foo, interval = search.range)
bp <- foo.opt$minimum
bp
[1] 6.071932
mod <- lmer(Reaction ~ b1(Days, bp) + b2(Days, bp) + (b1(Days, bp) + b2(Days, bp) | Subject), data = sleepstudy)

ที่จะได้รับความเชื่อมั่นสำหรับเบรกพอยต์, คุณสามารถใช้ความน่าจะเป็นรายละเอียด เพิ่มเช่นqchisq(0.95,1)ไปที่ส่วนเบี่ยงเบนต่ำสุด (สำหรับช่วงความมั่นใจ 95%) จากนั้นค้นหาคะแนนที่foo(x)เท่ากับค่าที่คำนวณได้:

foo.root <- function(bp, tgt)
{
  foo(bp) - tgt
}
tgt <- foo.opt$objective + qchisq(0.95,1)
lb95 <- uniroot(foo.root, lower=search.range[1], upper=bp, tgt=tgt)
ub95 <- uniroot(foo.root, lower=bp, upper=search.range[2], tgt=tgt)
lb95$root
[1] 5.754051
ub95$root
[1] 6.923529

ค่อนข้างไม่สมมาตร แต่ไม่แม่นยำสำหรับปัญหาของเล่นนี้ อีกทางเลือกหนึ่งคือ bootstrap ขั้นตอนการประเมินหากคุณมีข้อมูลเพียงพอที่จะทำให้ bootstrap เชื่อถือได้

วิธีแก้ปัญหาที่เสนอโดย jbowman นั้นดีมากเพียงแค่เพิ่มข้อสังเกตเชิงทฤษฎีบางประการ:

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

• ภายในโมเดลที่ไม่ได้มาตรฐานนี้ซึ่งมีการประเมินเบรกพอยต์ค่าเบี่ยงเบนมักจะไม่ได้มีการแจกแจงมาตรฐาน มักจะใช้วิธีการที่ซับซ้อนกว่านี้ ดูการอ้างอิงถึง Hansen (2000) ด้านล่าง

• bootstrap นั้นไม่สอดคล้องกันเสมอไปในเรื่องนี้ดูที่ Yu (ใกล้ถึง) ด้านล่าง

• ในที่สุดมันยังไม่ชัดเจนสำหรับฉันว่าทำไมคุณจึงแปลงข้อมูลโดยการจัดศูนย์กลางรอบวันใหม่ (เช่น bp - x แทนที่จะเป็นแค่ x) ฉันเห็นสองประเด็น:

  1. ด้วยขั้นตอนนี้คุณสร้างวันเทียมเช่น 6.1 วัน 4.1 ฯลฯ ฉันไม่แน่ใจว่าจะตีความผลลัพธ์ของ 6.07 ได้อย่างไรเนื่องจากคุณสังเกตเห็นค่าสำหรับวันที่ 6 และวันที่ 7 เท่านั้น (ในรูปแบบเบรกพอยต์มาตรฐานค่าใด ๆ ของขีด จำกัด ระหว่าง 6 และ 7 ควรให้โคฟ / deviance เดียวกัน)
  2. b1 และ b2 มีความหมายตรงกันข้ามเนื่องจาก b1 วันจะลดลงในขณะที่เพิ่มขึ้นสำหรับ b2? ดังนั้นการทดสอบแบบไม่เป็นทางการของจุดพักคือ b1! = - b2

การอ้างอิงมาตรฐานสำหรับสิ่งนี้คือ:

• OLS มาตรฐาน: Hansen (2000) การแยกตัวอย่างและการประมาณค่าเกณฑ์ Econometrica, Vol. 68, ลำดับที่ 3 (พฤษภาคม, 2000), หน้า 575-603
• แบบจำลองที่แปลกใหม่มากขึ้น: การทดสอบ Lee, Seo, Shin (2011) สำหรับผลกระทบขีด จำกัด ในแบบจำลองการถดถอย, วารสารสมาคมสถิติอเมริกัน (ทฤษฎีและวิธีการ) (2011), 106, 220-231
• Ping Yu (ที่กำลังจะมีขึ้น) The Bootstrap in Threshold Regression "ทฤษฎีเศรษฐมิติ

รหัส:

# Using grid search over existing values:
search.grid <- sort(unique(subset(sleepstudy, Days > search.range[1] &
Days<search.range[2], "Days", drop=TRUE)))

res <- unlist(lapply(as.list(search.grid), foo))

plot(search.grid, res, type="l")
bp_grid <- search.grid[which.min(res)]

คุณสามารถลองแบบจำลองMARS อย่างไรก็ตามฉันไม่แน่ใจว่าจะระบุเอฟเฟ็กต์แบบสุ่มได้อย่างไร earth(Reaction~Days+Subject, sleepstudy)

นี่คือกระดาษที่นำเสนอเอฟเฟ็กต์แบบผสม MARS ดังที่ @lockedoff พูดถึงฉันไม่เห็นการใช้งานที่เหมือนกันในแพ็คเกจใด ๆ