Làm cách nào để tôi quyết định sử dụng khoảng nào trong hồi quy LOESS trong R?

Tôi đang chạy mô hình hồi quy LOESS trong R và tôi muốn so sánh kết quả đầu ra của 12 mô hình khác nhau với các cỡ mẫu khác nhau. Tôi có thể mô tả các mô hình thực tế chi tiết hơn nếu nó giúp trả lời câu hỏi.

Dưới đây là các cỡ mẫu:

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

Mô hình hồi quy LOESS là một bề mặt phù hợp, trong đó vị trí X và vị trí Y của mỗi sân bóng chày được sử dụng để dự đoán sw, xác suất vung vợt. Tuy nhiên, tôi muốn so sánh giữa tất cả 12 mô hình này, nhưng đặt cùng một khoảng (tức là span = 0,5) sẽ mang lại kết quả khác nhau vì có một loạt các cỡ mẫu như vậy.

Câu hỏi cơ bản của tôi là làm thế nào để bạn xác định khoảng của mô hình của bạn? Một nhịp cao hơn làm giảm sự phù hợp hơn, trong khi một nhịp thấp hơn nắm bắt được nhiều xu hướng hơn nhưng lại gây ra tiếng ồn thống kê nếu có quá ít dữ liệu. Tôi sử dụng nhịp cao hơn cho cỡ mẫu nhỏ hơn và nhịp thấp hơn cho cỡ mẫu lớn hơn.

Tôi nên làm gì? Quy tắc tốt khi cài đặt nhịp cho các mô hình hồi quy LOESS trong R là gì? Cảm ơn trước!

Xác thực chéo thường được sử dụng, ví dụ như k- Fold, nếu mục đích là tìm sự phù hợp với RMSEP thấp nhất. Chia dữ liệu của bạn thành các nhóm k và lần lượt bỏ từng nhóm ra, khớp với mô hình hoàng thổ bằng cách sử dụng các nhóm dữ liệu k -1 và giá trị được chọn của tham số làm mịn và sử dụng mô hình đó để dự đoán cho nhóm bên trái. Lưu trữ các giá trị dự đoán cho nhóm bên trái và sau đó lặp lại cho đến khi mỗi nhóm k bị bỏ qua một lần. Sử dụng tập hợp các giá trị dự đoán, tính toán RMSEP. Sau đó lặp lại toàn bộ điều cho từng giá trị của tham số làm mịn bạn muốn điều chỉnh lại. Chọn tham số làm mịn đó cho RMSEP thấp nhất trong CV.

Đây là, như bạn có thể thấy, khá nặng tính toán. Tôi sẽ ngạc nhiên nếu không có sự thay thế xác thực chéo (GCV) tổng quát cho CV thật mà bạn có thể sử dụng với LOESS - Hastie et al (phần 6.2) chỉ ra rằng điều này khá đơn giản để thực hiện và được đề cập trong một trong những bài tập của họ .

Tôi đề nghị bạn đọc phần 6.1.1, 6.1.2 và 6.2, cộng với các phần về chính quy hóa các spline làm mịn (vì nội dung cũng áp dụng ở đây) trong Chương 5 của Hastie et al. (2009) Các yếu tố của học thống kê: Khai thác dữ liệu, suy luận và dự đoán . Ấn bản lần 2. Mùa xuân. PDF có thể được tải xuống miễn phí.

Tôi đề nghị kiểm tra các mô hình phụ gia tổng quát (GAM, xem gói mgcv trong R). Tôi chỉ đang tìm hiểu về bản thân họ, nhưng họ dường như tự động tìm ra mức độ "ngọ nguậy" được chứng minh bằng dữ liệu. Tôi cũng thấy rằng bạn đang xử lý dữ liệu nhị thức (đình công chứ không phải đình công), do đó hãy chắc chắn phân tích dữ liệu thô (nghĩa là không tổng hợp theo tỷ lệ, sử dụng dữ liệu cao độ thô) và sử dụng gia đình = 'nhị thức' (giả sử rằng bạn sẽ sử dụng R). Nếu bạn có thông tin về những gì người ném bóng và người đánh bóng cá nhân đóng góp vào dữ liệu, bạn có thể tăng sức mạnh của mình bằng cách thực hiện mô hình hỗn hợp phụ gia tổng quát (GAMM, xem gói gamm4 trong R) và chỉ định bình và hitter là hiệu ứng ngẫu nhiên (và một lần nữa , đặt gia đình = 'nhị thức'). Cuối cùng, bạn có thể muốn cho phép tương tác giữa các hoạt động trơn tru của X & Y, nhưng tôi chưa bao giờ tự mình thử điều này vì vậy tôi không biết làm thế nào để thực hiện điều đó. Một mô hình gamm4 không có tương tác X * Y sẽ như sau:

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

Hãy nghĩ về nó, có lẽ bạn muốn để cho sự mượt mà khác nhau trong từng cấp độ của loại sân và độ thuận tay. Điều này làm cho vấn đề trở nên khó khăn hơn vì tôi chưa tìm ra cách để độ mịn thay đổi theo nhiều biến theo cách tạo ra các thử nghiệm phân tích có ý nghĩa ( xem các truy vấn của tôi vào danh sách Mô hình hỗn hợp R-SIG ). Bạn có thể thử:

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)

Nhưng điều này sẽ không đưa ra các bài kiểm tra có ý nghĩa về sự trơn tru. Để cố gắng tự giải quyết vấn đề này, tôi đã sử dụng phương pháp tái định hình bootstrap trong đó trên mỗi lần lặp, tôi có được các dự đoán mô hình cho không gian dữ liệu đầy đủ, sau đó tính toán bootstap 95% CIs cho mỗi điểm trong không gian và mọi hiệu ứng tôi quan tâm để tính toán.

Đối với hồi quy hoàng thổ, theo cách hiểu của tôi là một người không thống kê, là bạn có thể chọn khoảng của mình dựa trên diễn giải trực quan (cốt truyện với nhiều giá trị nhịp có thể chọn một mức độ làm mịn ít nhất có vẻ phù hợp) hoặc bạn có thể sử dụng xác thực chéo (CV) hoặc xác nhận chéo tổng quát (GCV). Dưới đây là mã tôi đã sử dụng cho GCV của hồi quy hoàng thổ dựa trên mã từ cuốn sách tuyệt vời của Takezawa, Giới thiệu về hồi quy không đối xứng (từ 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)
}

và với dữ liệu của tôi, tôi đã làm như sau:

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)

Xin lỗi, mã này khá cẩu thả, đây là một trong những lần đầu tiên tôi sử dụng R, nhưng nó sẽ cho bạn ý tưởng về cách thực hiện hồi quy GSV để tìm khoảng cách tốt nhất để sử dụng theo cách khách quan hơn là kiểm tra trực quan đơn giản. Trên biểu đồ trên, bạn quan tâm đến nhịp thu nhỏ hàm (thấp nhất trên "đường cong" được vẽ).

Nếu bạn chuyển sang mô hình phụ gia tổng quát, bạn có thể sử dụng gam()hàm từ gói mgcv , trong đó tác giả đảm bảo với chúng tôi :

Vì vậy, lựa chọn chính xác của k thường không quan trọng: nó nên được chọn đủ lớn để bạn chắc chắn có đủ mức độ tự do để thể hiện "sự thật" cơ bản một cách hợp lý, nhưng đủ nhỏ để duy trì hiệu quả tính toán hợp lý. Rõ ràng 'lớn' và 'nhỏ' phụ thuộc vào vấn đề cụ thể đang được giải quyết.

( kđây là mức độ của tham số tự do cho mượt mà hơn, giống như tham số độ mịn của hoàng thổ)

Bạn có thể viết vòng xác thực chéo của riêng bạn từ đầu sử dụng loess()chức năng từ statsgói.

1. Thiết lập khung dữ liệu đồ chơi.

   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. Thiết lập các biến hữu ích để xử lý vòng xác thực chéo.

   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. Chạy một forvòng lặp lồng nhau lặp đi lặp lại qua từng khả năng nhịp span.seqvà mỗi lần vào folds.

   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. Tính sai số bình phương trung bình của xác thực chéo trung bình từ mỗi 10 lần:

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

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

5. Tìm khoảng nào dẫn đến thấp nhất .$MSE$

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

6. Vẽ kết quả của bạn.

   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)

Sử dụng gói locfit. Đây là một phiên bản sửa đổi một chút của hoàng thổ nhưng cách nhanh hơn. Nó cũng có chức năng sẵn có để tính gcv http://www.statistik.lmu.de/~leiten/Lehre/M vật liệu / GLM_0708 /Tororium / locfit.pdf

Các fANCOVA gói cung cấp một cách tự động để tính toán khoảng thời gian lý tưởng sử dụng GCV hoặc 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))