R에서 LOESS 회귀 분석에 사용할 범위를 어떻게 결정합니까?

R에서 LOESS 회귀 모델을 실행 중이며 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 위치는 sw, 스윙 스트라이크 확률을 예측하는 데 사용됩니다. 그러나이 12 가지 모델을 모두 비교하고 싶지만 동일한 범위 (예 : span = 0.5)를 설정하면 다양한 샘플 크기가 있으므로 다른 결과를 얻을 수 있습니다.

내 기본 질문은 모델의 범위를 어떻게 결정합니까? 스팬이 높을수록 피팅이 더 매끄럽게되고, 스팬이 낮 으면 더 많은 트렌드를 캡처하지만 데이터가 너무 적 으면 통계 노이즈가 발생합니다. 더 작은 샘플 크기의 경우 더 높은 범위를 사용하고 더 큰 샘플 크기의 경우 더 낮은 범위를 사용합니다.

어떻게해야합니까? R에서 LOESS 회귀 모델의 범위를 설정할 때 가장 좋은 방법은 무엇입니까? 미리 감사드립니다!

목표가 가장 낮은 RMSEP에 맞는 것을 찾는 경우 교차 검증이 종종 사용됩니다 (예 : k -fold). 데이터를 k 그룹 으로 나누고 각 그룹을 차례로 남겨두고 k -1 데이터 그룹과 선택한 스무딩 매개 변수 값을 사용하여 황토 모델을 맞추고 해당 모델을 사용하여 왼쪽 그룹을 예측합니다. 왼쪽 그룹에 대한 예측 값을 저장 한 다음 k가 될 때까지 반복하십시오. 그룹이 한 번 빠져 나올 . 예측 값 세트를 사용하여 RMSEP를 계산하십시오. 그런 다음 튜닝하려는 스무딩 파라미터의 각 값에 대해 전체를 반복합니다. CV에서 가장 낮은 RMSEP를 제공하는 스무딩 매개 변수를 선택하십시오.

보시다시피, 이것은 상당히 계산적으로 무겁습니다. LOESS와 함께 사용할 수있는 진정한 CV에 대한 일반화 된 교차 검증 (GCV) 대안이 없다면 놀랄 것입니다-Hastie et al. .

나는 6.1.1, 6.1.2 및 6.2 절과 Hastie et al.의 5 장에서 내용이 적용되는 스무딩 스플라인의 정규화에 관한 섹션을 읽는 것이 좋습니다. (2009) 통계 학습의 요소 : 데이터 마이닝, 추론 및 예측 . 2 판. 봄 병아리. PDF는 무료로 다운로드 할 수 있습니다.

일반화 된 가산 모델을 확인하는 것이 좋습니다 (GAM, mgcv 패키지 R 참조). 나는 단지 그들 자신에 대해 배우고 있지만 데이터에 의해 얼마나 "흔들림"이 정당화되는지를 자동으로 알아내는 것 같습니다. 또한 이항 데이터를 다루는 것 (파업이 아닌 파업)을보고 있으므로 원시 데이터를 분석하고 (즉, 비율로 집계하지 않고, 피치 단위로 원시 데이터를 사용) family = '이항식'(R을 사용한다고 가정). 개별 투수와 타자가 데이터에 기여하는 것에 대한 정보가있는 경우, 일반 가산 혼합 모델 (GAMM, gamm4 패키지 R 참조)을 수행하고 투수와 타자를 임의의 효과로 지정하여 전력을 향상시킬 수 있습니다. , 설정 가족 = '이항'). 마지막으로 아마도 X & Y의 스무스 사이의 상호 작용을 허용하고 싶지만, 나는 이것을 시도하지 않았으므로 그 방법을 모릅니다. X * Y 상호 작용이없는 gamm4 모델은 다음과 같습니다.

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)

그러나 이것은 평활에 대한 의미있는 테스트를 제공하지 않습니다. 이 문제를 직접 해결하기 위해 부트 스트랩 리샘플링을 사용하여 각 반복에서 전체 데이터 공간에 대한 모델 예측을 얻은 다음 공간의 각 포인트와 계산해야 할 영향에 대한 부트 탭 95 % CI를 계산했습니다.

황토 회귀 분석의 경우 비 통계 학자로서의 이해는 시각적 해석을 기반으로 스팬을 선택할 수 있고 (스팬 값이 여러 개인 플롯은 적절하게 보이는 스무딩이 가장 적은 플롯을 선택할 수 있음) 교차 검증을 사용할 수 있다는 것입니다 (CV) 또는 일반화 된 교차 검증 (GCV). 아래는 Takezawa 의 훌륭한 저서 인 비모수 적 회귀 소개 (p219) 의 코드를 기반으로 황토 회귀의 GCV에 사용한 코드입니다 .

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를 수행하는 방법에 대한 아이디어를 제공해야합니다. 위 그림에서 함수를 최소화하는 범위에 관심이 있습니다 (플롯 된 "곡선"에서 가장 낮음).

당신이 generlized 첨가제 모델로 전환하면, 당신은 사용할 수 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.seq과 각 접기 위치를 반복 하는 중첩 루프를 실행합니다 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. $$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)

로 케이트 패키지를 사용하십시오. 황토의 약간 수정 된 버전이지만 더 빠릅니다. 또한 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))