Xử lý hồi quy của biến phản ứng giới hạn bất thường

Tôi đang cố gắng mô hình hóa một biến trả lời bị giới hạn về mặt lý thuyết trong khoảng -225 đến +225. Biến là tổng số điểm mà các môn học đạt được khi chơi trò chơi. Mặc dù về mặt lý thuyết, các môn có thể đạt điểm +225. Mặc dù điều này là do điểm số phụ thuộc vào không chỉ các hành động của đối tượng mà cả hành động của một hành động khác mà tối đa bất kỳ ai ghi được là 125 (đây là 2 người chơi cao nhất chơi với nhau có thể ghi bàn) điều này xảy ra với tần suất rất cao. Điểm thấp nhất là +35.

Ranh giới 125 này đang gây khó khăn với hồi quy tuyến tính. Điều duy nhất tôi có thể nghĩ làm là nhân rộng lại phản hồi trong khoảng từ 0 đến 1 và sử dụng hồi quy beta. Nếu tôi làm điều này mặc dù tôi không chắc chắn tôi có thể thực sự biện minh rằng 125 là ranh giới trên cùng (hoặc 1 sau khi chuyển đổi) vì có thể đạt điểm +225. Hơn nữa, nếu tôi làm điều này thì ranh giới dưới cùng của tôi là 35?

Cảm ơn,

Jonathan

Mặc dù tôi không hoàn toàn chắc chắn về vấn đề của bạn với hồi quy tuyến tính là tôi hiện đang hoàn thành một bài viết về cách phân tích các kết quả bị ràng buộc. Vì tôi không quen với hồi quy Beta, có lẽ người khác sẽ trả lời tùy chọn đó.

Bằng câu hỏi của bạn, tôi hiểu rằng bạn có được những dự đoán bên ngoài ranh giới. Trong trường hợp này tôi sẽ đi hồi quy lượng tử logistic . Hồi quy lượng tử là một thay thế rất gọn gàng cho hồi quy tuyến tính thông thường. Bạn có thể xem xét các lượng tử khác nhau và có được bức tranh dữ liệu tốt hơn nhiều so với những gì có thể với hồi quy tuyến tính thông thường. Nó cũng không có giả định về phân phối ¹ .

Chuyển đổi một biến thường có thể gây ra các hiệu ứng buồn cười trên hồi quy tuyến tính, ví dụ, bạn có một ý nghĩa trong chuyển đổi logistic nhưng điều đó không chuyển thành giá trị thông thường. Đây không phải là trường hợp với lượng tử, trung vị luôn là trung tuyến bất kể hàm biến đổi. Điều này cho phép bạn biến đổi qua lại mà không làm biến dạng bất cứ điều gì. Giáo sư Bottai đề xuất cách tiếp cận này đối với các kết quả bị ràng buộc ² , đây là một phương pháp tuyệt vời nếu bạn muốn thực hiện các dự đoán riêng lẻ nhưng nó có một số vấn đề khi bạn không nhìn vào bản beta và diễn giải chúng theo cách không logic. Công thức rất đơn giản:

$logit(y) = log(\frac{y + \epsilon}{max(y) - y + \epsilon})$

Trong đó là điểm số của bạn và là một số nhỏ tùy ý .$y$$\epsilon$

Đây là một ví dụ mà tôi đã làm cách đây một thời gian khi tôi muốn thử nghiệm nó trong R:

library(rms)
library(lattice)
library(cairoDevice)
library(ggplot2)

# Simulate some data
set.seed(10)
intercept <- 0
beta1 <- 0.5
beta2 <- 1
n = 1000
xtest <- rnorm(n,1,1)
gender <- factor(rbinom(n, 1, .4), labels=c("Male", "Female"))
random_noise  <- runif(n, -1,1)

# Add a ceiling and a floor to simulate a bound score
fake_ceiling <- 4
fake_floor <- -1

# Simulate the predictor
linpred <- intercept + beta1*xtest^3 + beta2*(gender == "Female") + random_noise

# Remove some extremes
extreme_roof <- fake_ceiling + abs(diff(range(linpred)))/2
extreme_floor <- fake_floor - abs(diff(range(linpred)))/2
linpred[ linpred > extreme_roof|
    linpred < extreme_floor ] <- NA

#limit the interval and give a ceiling and a floor effect similar to scores
linpred[linpred > fake_ceiling] <- fake_ceiling
linpred[linpred < fake_floor] <- fake_floor

# Just to give the graphs the same look
my_ylim <- c(fake_floor - abs(fake_floor)*.25, 
             fake_ceiling + abs(fake_ceiling)*.25)
my_xlim <- c(-1.5, 3.5)

# Plot
df <- data.frame(Outcome = linpred, xtest, gender)
ggplot(df, aes(xtest, Outcome, colour = gender)) + geom_point()

Điều này mang lại sự phân tán dữ liệu sau đây, như bạn có thể thấy nó bị ràng buộc rõ ràng và bất tiện :

###################################
# Calculate & plot the true lines #
###################################
x <- seq(min(xtest), max(xtest), by=.1)
y <- beta1*x^3+intercept
y_female <- y + beta2
y[y > fake_ceiling] <- fake_ceiling
y[y < fake_floor] <- fake_floor
y_female[y_female > fake_ceiling] <- fake_ceiling
y_female[y_female < fake_floor] <- fake_floor

tr_df <- data.frame(x=x, y=y, y_female=y_female)
true_line_plot <- xyplot(y  + y_female ~ x, 
                         data=tr_df,
                         type="l", 
                         xlim=my_xlim, 
                         ylim=my_ylim, 
                         ylab="Outcome", 
                         auto.key = list(
                           text = c("Male"," Female"),
                           columns=2))

##########################
# Test regression models #
##########################

# Regular linear regression
fit_lm <- Glm(linpred~rcs(xtest, 5)+gender, x=T, y=T)
boot_fit_lm <- bootcov(fit_lm, B=500)
p <- Predict(boot_fit_lm, xtest=seq(-2.5, 3.5, by=.001), gender=c("Male", "Female"))
lm_plot <- plot(p, 
             se=T, 
             col.fill=c("#9999FF", "#BBBBFF"), 
             xlim=my_xlim, ylim=my_ylim)

Điều này dẫn đến hình ảnh sau đây, nơi con cái rõ ràng ở trên ranh giới trên:

# Quantile regression - regular
fit_rq <- Rq(formula(fit_lm), x=T, y=T)
boot_rq <- bootcov(fit_rq, B=500)
# A little disturbing warning:
# In rq.fit.br(x, y, tau = tau, ...) : Solution may be nonunique

p <- Predict(boot_rq, xtest=seq(-2.5, 3.5, by=.001), gender=c("Male", "Female"))
rq_plot <- plot(p, 
             se=T, 
             col.fill=c("#9999FF", "#BBBBFF"), 
             xlim=my_xlim, ylim=my_ylim)

Điều này đưa ra cốt truyện sau đây với các vấn đề tương tự:

# The logit transformations
logit_fn <- function(y, y_min, y_max, epsilon)
    log((y-(y_min-epsilon))/(y_max+epsilon-y))


antilogit_fn <- function(antiy, y_min, y_max, epsilon)
    (exp(antiy)*(y_max+epsilon)+y_min-epsilon)/
        (1+exp(antiy))

epsilon <- .0001
y_min <- min(linpred, na.rm=T)
y_max <- max(linpred, na.rm=T)

logit_linpred <- logit_fn(linpred, 
                            y_min=y_min,
                            y_max=y_max,
                            epsilon=epsilon)

fit_rq_logit <- update(fit_rq, logit_linpred ~ .)
boot_rq_logit <- bootcov(fit_rq_logit, B=500)

p <- Predict(boot_rq_logit, 
             xtest=seq(-2.5, 3.5, by=.001), 
             gender=c("Male", "Female"))

# Change back to org. scale
# otherwise the plot will be
# on the logit scale
transformed_p <- p
transformed_p$yhat <- antilogit_fn(p$yhat,
                                    y_min=y_min,
                                    y_max=y_max,
                                    epsilon=epsilon)
transformed_p$lower <- antilogit_fn(p$lower, 
                                     y_min=y_min,
                                     y_max=y_max,
                                     epsilon=epsilon)
transformed_p$upper <- antilogit_fn(p$upper, 
                                     y_min=y_min,
                                     y_max=y_max,
                                     epsilon=epsilon)

logit_rq_plot <- plot(transformed_p, 
             se=T, 
             col.fill=c("#9999FF", "#BBBBFF"), 
             xlim=my_xlim)

Hồi quy lượng tử logistic có dự đoán giới hạn rất hay:

Tại đây, bạn có thể thấy vấn đề với bản Beta rằng trong thời trang được truyền lại khác nhau ở các khu vực khác nhau (như mong đợi):

# Some issues trying to display the gender factor
contrast(boot_rq_logit, list(gender=levels(gender), 
                             xtest=c(-1:1)), 
         FUN=function(x)antilogit_fn(x, epsilon))

   gender xtest Contrast   S.E.       Lower      Upper       Z      Pr(>|z|)
   Male   -1    -2.5001505 0.33677523 -3.1602179 -1.84008320  -7.42 0.0000  
   Female -1    -1.3020162 0.29623080 -1.8826179 -0.72141450  -4.40 0.0000  
   Male    0    -1.3384751 0.09748767 -1.5295474 -1.14740279 -13.73 0.0000  
*  Female  0    -0.1403408 0.09887240 -0.3341271  0.05344555  -1.42 0.1558  
   Male    1    -1.3308691 0.10810012 -1.5427414 -1.11899674 -12.31 0.0000  
*  Female  1    -0.1327348 0.07605115 -0.2817923  0.01632277  -1.75 0.0809  

Redundant contrasts are denoted by *

Confidence intervals are 0.95 individual intervals

Người giới thiệu

1. R. Koenker và G. Bassett Jr, Lượng tử hồi quy, Hồi kinh tế lượng: Tạp chí của Hiệp hội Kinh tế lượng, trang 33 Hồi50, 1978.
2. M. Bottai, B. Cai, và RE McKeown, Hồi quy lượng tử logistic cho các kết quả bị ràng buộc, Thống kê trong y học, tập. 29, không 2, trang 309 Từ317, 2010.

Đối với sự tò mò, các ô được tạo bằng mã này:

# Just for making pretty graphs with the comparison plot
compareplot <- function(regr_plot, regr_title, true_plot){
  print(regr_plot, position=c(0,0.5,1,1), more=T)
  trellis.focus("toplevel")
  panel.text(0.3, .8, regr_title, cex = 1.2, font = 2)
  trellis.unfocus()
  print(true_plot, position=c(0,0,1,.5), more=F)
  trellis.focus("toplevel")
  panel.text(0.3, .65, "True line", cex = 1.2, font = 2)
  trellis.unfocus()
}

Cairo_png("Comp_plot_lm.png", width=10, height=14, pointsize=12)
compareplot(lm_plot, "Linear regression", true_line_plot)
dev.off()

Cairo_png("Comp_plot_rq.png", width=10, height=14, pointsize=12)
compareplot(rq_plot, "Quantile regression", true_line_plot)
dev.off()

Cairo_png("Comp_plot_logit_rq.png", width=10, height=14, pointsize=12)
compareplot(logit_rq_plot, "Logit - Quantile regression", true_line_plot)
dev.off()

Cairo_png("Scat. plot.png")
qplot(y=linpred, x=xtest, col=gender, ylab="Outcome")
dev.off()