ฉันจะตัดสินใจได้อย่างไรว่าจะใช้ช่วงใดในการถดถอยแบบ LOESS ใน R

ฉันใช้โมเดลการถดถอยแบบ LOESS ใน R และฉันต้องการเปรียบเทียบผลลัพธ์ของรุ่นที่แตกต่างกัน 12 แบบด้วยขนาดตัวอย่างที่แตกต่างกัน ฉันสามารถอธิบายรายละเอียดเพิ่มเติมของโมเดลจริง ๆ ได้ถ้ามันช่วยตอบคำถามได้

นี่คือขนาดตัวอย่าง:

Fastballs vs RHH 2008-09: 2002
Fastballs vs LHH 2008-09: 2209
Fastballs vs RHH 2010: 527 
Fastballs vs LHH 2010: 449

Changeups vs RHH 2008-09: 365
Changeups vs LHH 2008-09: 824
Changeups vs RHH 2010: 201
Changeups vs LHH 2010: 330

Curveballs vs RHH 2008-09: 488
Curveballs vs LHH 2008-09: 483
Curveballs vs RHH 2010: 213
Curveballs vs LHH 2010: 162

แบบจำลองการถดถอยแบบ LOESS นั้นเหมาะสมกับพื้นผิวที่ตำแหน่ง X และตำแหน่ง Y ของแต่ละสนามเบสบอลถูกใช้ในการทำนายความน่าจะเป็นของการแกว่ง อย่างไรก็ตามฉันต้องการเปรียบเทียบระหว่างทั้ง 12 รุ่น แต่การตั้งค่าช่วงเดียวกัน (เช่นช่วง = 0.5) จะให้ผลลัพธ์ที่แตกต่างกันเนื่องจากมีขนาดตัวอย่างที่หลากหลาย

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

ฉันควรทำอย่างไร? อะไรคือกฎของหัวแม่มือที่ดีเมื่อตั้งค่าขยายสำหรับแบบจำลองการถดถอย LOESS ใน R ขอบคุณล่วงหน้า!

การตรวจสอบความถูกต้องไขว้มักใช้เช่นk -fold หากเป้าหมายคือการหาแบบที่มี RMSEP ต่ำสุด แบ่งข้อมูลของคุณออกเป็นkกลุ่มและปล่อยให้แต่ละกลุ่มออกมาพอดีกับโมเดลเหลืองโดยใช้กลุ่มข้อมูลk -1 และค่าที่เลือกของพารามิเตอร์การปรับให้เรียบและใช้แบบจำลองนั้นเพื่อทำนายกลุ่มซ้ายออก เก็บค่าที่คาดการณ์ไว้สำหรับกลุ่มที่ยังเหลืออยู่จากนั้นทำซ้ำจนกระทั่งกลุ่มkแต่ละกลุ่มถูกทิ้งไว้หนึ่งครั้ง ใช้ชุดของค่าที่คาดการณ์คำนวณ RMSEP จากนั้นทำซ้ำสิ่งทั้งหมดสำหรับแต่ละค่าของพารามิเตอร์การปรับให้เรียบที่คุณต้องการปรับ เลือกพารามิเตอร์การปรับให้เรียบที่ให้ค่า RMSEP ต่ำที่สุดภายใต้ CV

นี่คือที่คุณสามารถดูหนักคอมพิวเตอร์ค่อนข้าง ฉันจะแปลกใจถ้าไม่มีการตรวจสอบข้ามแบบทั่วไป (GCV) ทางเลือกสำหรับ CV จริงที่คุณสามารถใช้กับ LOESS - Hastie et al (ส่วนที่ 6.2) ระบุว่านี่เป็นเรื่องง่ายที่จะทำและครอบคลุมในแบบฝึกหัดของพวกเขา .

ฉันขอแนะนำให้คุณอ่านหัวข้อ 6.1.1, 6.1.2 และ 6.2 รวมถึงหัวข้อเรื่องการทำให้เส้นโค้งเรียบ (ตามที่ใช้กับเนื้อหานี้) ในบทที่ 5 ของ Hastie et al (2009) องค์ประกอบของการเรียนรู้ทางสถิติข้อมูลการทำเหมืองแร่การอนุมานและการทำนาย ฉบับที่ 2 สปริงเกอร์ สามารถดาวน์โหลด PDF ได้ฟรี

ฉันขอแนะนำให้ตรวจสอบโมเดลเสริมทั่วไป (GAM ดูแพ็คเกจ mgcv ใน R) ฉันแค่เรียนรู้เกี่ยวกับพวกเขาเอง แต่พวกเขาดูเหมือนจะรู้ได้โดยอัตโนมัติว่าข้อมูล "wiggly-ness" นั้นเป็นธรรม ฉันยังเห็นว่าคุณกำลังจัดการกับข้อมูลทวินาม (การนัดหยุดงานเทียบกับการไม่นัดหยุดงาน) ดังนั้นให้แน่ใจว่าได้วิเคราะห์ข้อมูลดิบ (เช่นไม่รวมกับสัดส่วนใช้ข้อมูลดิบแบบพิตช์พิตช์) และใช้ตระกูล = 'ทวินาม' (สมมติว่าคุณกำลังใช้ R) หากคุณมีข้อมูลเกี่ยวกับเหยือกและพิทเชอร์แต่ละตัวที่มีส่วนร่วมกับข้อมูลคุณอาจเพิ่มพลังของคุณได้โดยทำแบบผสมสารเติมแต่งทั่วไป (GAMM ดูแพ็คเกจ gamm4 ใน R) และระบุเหยือกและตีเป็นเอฟเฟกต์แบบสุ่ม (และอีกครั้ง , การตั้งค่า family = 'binomial') สุดท้าย คุณอาจต้องการอนุญาตให้มีปฏิสัมพันธ์ระหว่างความราบรื่นของ X & Y แต่ฉันไม่เคยลองด้วยตัวเองดังนั้นฉันไม่รู้จะทำยังไง รุ่น gamm4 ที่ไม่มีปฏิสัมพันธ์ X * Y จะมีลักษณะดังนี้:

fit = gamm4(
    formula = strike ~ s(X) + s(Y) + pitch_type*batter_handedness + (1|pitcher) + (1|batter)
    , data = my_data
    , family = 'binomial'
)
summary(fit$gam)

ลองคิดดูคุณอาจต้องการให้ความนุ่มนวลแตกต่างกันไปในแต่ละระดับของประเภทพิทช์และความถนัดในการปะทะ สิ่งนี้ทำให้ปัญหายากขึ้นเนื่องจากฉันยังไม่พบวิธีที่จะทำให้ความนุ่มนวลแตกต่างกันไปตามตัวแปรต่าง ๆ ในแบบที่ทำให้เกิดการทดสอบเชิงวิเคราะห์ที่มีความหมาย ( ดูแบบสอบถามของฉันไปยังรายการ R-SIG-Mixed-Models ) คุณสามารถลอง:

my_data$dummy = factor(paste(my_data$pitch_type,my_data$batter_handedness))
fit = gamm4(
    formula = strike ~ s(X,by=dummy) + s(Y,by=dummy) + pitch_type*batter_handedness + (1|pitcher) + (1|batter)
    , data = my_data
    , family = 'binomial'
)
summary(fit$gam)

แต่นี่จะไม่ให้การทดสอบที่ราบรื่นที่มีความหมาย ในการพยายามที่จะแก้ปัญหานี้ด้วยตัวเองฉันได้ใช้ bootstrap resampling อีกครั้งในแต่ละการวนซ้ำฉันได้รับการทำนายแบบจำลองสำหรับพื้นที่ข้อมูลเต็มจากนั้นคำนวณ bootstap 95% CIs สำหรับแต่ละจุดในอวกาศและผลกระทบใด ๆ

สำหรับการถดถอยแบบเหลืองความเข้าใจของฉันในฐานะที่ไม่ใช่นักสถิติคือคุณสามารถเลือกช่วงของคุณตามการตีความภาพ (พล็อตที่มีค่าช่วงจำนวนมากสามารถเลือกอันที่มีการปรับให้เรียบน้อยที่สุดที่เหมาะสม) หรือคุณสามารถใช้การตรวจสอบข้าม (CV) หรือการตรวจสอบความถูกต้องไขว้ทั่วไป (GCV) ด้านล่างเป็นรหัสที่ฉันใช้สำหรับ GCV ของการถดถอยแบบเหลืองตามรหัสจากหนังสือยอดเยี่ยมของ Takezawa, Introduction to Nonparametric Regression (จากหน้า p219)

locv1 <- function(x1, y1, nd, span, ntrial)
{
locvgcv <- function(sp, x1, y1)
{
    nd <- length(x1)

    assign("data1", data.frame(xx1 = x1, yy1 = y1))
    fit.lo <- loess(yy1 ~ xx1, data = data1, span = sp, family = "gaussian", degree = 2, surface = "direct")
    res <- residuals(fit.lo)

    dhat2 <- function(x1, sp)
    {
        nd2 <- length(x1)
        diag1 <- diag(nd2)
        dhat <- rep(0, length = nd2)

        for(jj in 1:nd2){
            y2 <- diag1[, jj]
            assign("data1", data.frame(xx1 = x1, yy1 = y2))
            fit.lo <- loess(yy1 ~ xx1, data = data1, span = sp, family = "gaussian", degree = 2, surface = "direct")
            ey <- fitted.values(fit.lo)
            dhat[jj] <- ey[jj]
            }
            return(dhat)
        }

        dhat <- dhat2(x1, sp)
        trhat <- sum(dhat)
        sse <- sum(res^2)

        cv <- sum((res/(1 - dhat))^2)/nd
        gcv <- sse/(nd * (1 - (trhat/nd))^2)

        return(gcv)
    }

    gcv <- lapply(as.list(span1), locvgcv, x1 = x1, y1 = y1)
    #cvgcv <- unlist(cvgcv)
    #cv <- cvgcv[attr(cvgcv, "names") == "cv"]
    #gcv <- cvgcv[attr(cvgcv, "names") == "gcv"]

    return(gcv)
}

และด้วยข้อมูลของฉันฉันได้ทำสิ่งต่อไปนี้:

nd <- length(Edge2$Distance)
xx <- Edge2$Distance
yy <- lcap

ntrial <- 50
span1 <- seq(from = 0.5, by = 0.01, length = ntrial)

output.lo <- locv1(xx, yy, nd, span1, ntrial)
#cv <- output.lo
gcv <- output.lo

plot(span1, gcv, type = "n", xlab = "span", ylab = "GCV")
points(span1, gcv, pch = 3)
lines(span1, gcv, lwd = 2)
gpcvmin <- seq(along = gcv)[gcv == min(gcv)]
spangcv <- span1[pgcvmin]
gcvmin <- cv[pgcvmin]
points(spangcv, gcvmin, cex = 1, pch = 15)

ขออภัยรหัสค่อนข้างเลอะเทอะนี่เป็นครั้งแรกของฉันที่ใช้ R แต่ควรให้ความคิดเกี่ยวกับวิธีทำ GSV สำหรับการถดถอยแบบสุ่มเพื่อหาช่วงที่ดีที่สุดที่จะใช้ในทางที่มีวัตถุประสงค์มากกว่าการตรวจสอบด้วยสายตาแบบง่าย ในพล็อตด้านบนคุณสนใจในการขยายที่ย่อเล็กสุดของฟังก์ชั่น

หากคุณเปลี่ยนไปใช้รูปแบบสารเติมแต่งทั่วไปคุณสามารถใช้gam()ฟังก์ชั่นจากแพคเกจmgcvซึ่งผู้เขียนมั่นใจเรา :

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

( kนี่คือองศาของพารามิเตอร์อิสระสำหรับนุ่มนวลซึ่งคล้ายกับพารามิเตอร์ความเรียบเนียน 'เหลือง')

คุณสามารถเขียนวนการตรวจสอบไขว้ของคุณเองตั้งแต่เริ่มต้นซึ่งใช้loess()ฟังก์ชันจากstatsแพ็คเกจ

1. ตั้งค่ากรอบข้อมูลของเล่น

   set.seed(4)
   x <- rnorm(n = 500)
   y <- (x)^3 + (x - 3)^2 + (x - 8) - 1 + rnorm(n = 500, sd = 0.5)
   plot(x, y)
   df <- data.frame(x, y)

2. ตั้งค่าตัวแปรที่มีประโยชน์เพื่อจัดการลูปการตรวจสอบข้าม

   span.seq <- seq(from = 0.15, to = 0.95, by = 0.05) #explores range of spans
   k <- 10 #number of folds
   set.seed(1) # replicate results
   folds <- sample(x = 1:k, size = length(x), replace = TRUE)
   cv.error.mtrx <- matrix(rep(x = NA, times = k * length(span.seq)), 
                           nrow = length(span.seq), ncol = k)

3. เรียกใช้การซ้อนกันforวงวนในช่วงแต่ละความเป็นไปได้ในแต่ละพับในspan.seqfolds

   for(i in 1:length(span.seq)) {
     for(j in 1:k) {
       loess.fit <- loess(formula = y ~ x, data = df[folds != j, ], span = span.seq[i])
       preds <- predict(object = loess.fit, newdata = df[folds == j, ])
       cv.error.mtrx[i, j] <- mean((df$y[folds == j] - preds)^2, na.rm = TRUE)
       # some predictions result in `NA` because of the `x` ranges in each fold
    }
   }

4. $$CV_{(10)} = \frac{1}{10} \sum_{i=1}^{10} MSE_i$$

   cv.errors <- rowMeans(cv.error.mtrx)

5. $MSE$

   best.span.i <- which.min(cv.errors)
   best.span.i
   span.seq[best.span.i]

6. เขียนผลลัพธ์ของคุณ

   plot(x = span.seq, y = cv.errors, type = "l", main = "CV Plot")
   points(x = span.seq, y = cv.errors, 
          pch = 20, cex = 0.75, col = "blue")
   points(x = span.seq[best.span.i], y = cv.errors[best.span.i], 
          pch = 20, cex = 1, col = "red")
   
   best.loess.fit <- loess(formula = y ~ x, data = df, 
                           span = span.seq[best.span.i])
   
   x.seq <- seq(from = min(x), to = max(x), length = 100)
   
   plot(x = df$x, y = df$y, main = "Best Span Plot")
   lines(x = x.seq, y = predict(object = best.loess.fit, 
                                newdata = data.frame(x = x.seq)), 
         col = "red", lwd = 2)

ใช้แพคเกจ locfit เป็นรุ่นเหลืองที่ได้รับการแก้ไขเล็กน้อย แต่เร็วขึ้น นอกจากนี้ยังมีฟังก์ชั่น inbuilt เพื่อคำนวณ gcv http://www.statistik.lmu.de/~leiten/Lehre/Material/GLM_0708/Tutorium/locfit.pdf

fANCOVAแพคเกจมีวิธีการคำนวณอัตโนมัติช่วงที่เหมาะใช้ GCV หรือ AIC:

FTSE.lo3 <- loess.as(Index, FTSE_close, degree = 1, criterion = c("aicc", "gcv")[2], user.span = NULL, plot = F)
FTSE.lo.predict3 <- predict(FTSE.lo3, data.frame(Index=Index))