Alışılmadık derecede sınırlı tepki değişkeninin gerilemesi ile başa çıkmak

Teorik olarak -225 ile +225 arasında sınırlı bir yanıt değişkeni modellemeye çalışıyorum. Değişken, deneklerin oyun oynarken aldığı toplam puandır. Teorik olarak konuların +225 puan alması mümkündür. Buna rağmen, puan sadece deneklerin hareketlerine değil, aynı zamanda en fazla puan alan en fazla 125'in olduğu başka bir eylemin eylemlerine de bağlıydı (bu, birbirini oynayan en yüksek 2 oyuncunun her ikisini de skorlayabilir), bu çok yüksek bir frekansla oldu. En düşük puan +35'tir.

125'in bu sınırı doğrusal bir gerilemeyle ilgili zorluklara neden olmaktadır. Yapmayı düşünebildiğim tek şey yanıtı 0 ile 1 arasında yeniden ölçeklendirmek ve beta regresyonu kullanmak. Eğer bunu yaparsam, +225 puan almak mümkün olduğundan 125'in en üst sınır (veya dönüşümden sonra 1) olduğunu söyleyebilirim. Üstelik bunu yapsaydım alt sınırım ne olurdu, 35?

Teşekkürler,

Jonathan

Doğrusal regresyon ile ilgili probleminizin ne olduğundan tam olarak emin olmasam da, şu anda sınırlı sonuçların nasıl analiz edileceği hakkında bir makale bitiriyorum. Beta regresyonuna aşina olmadığımdan belki başka biri bu seçeneği cevaplayacaktır.

Sorunuzla sınırların dışında tahminler aldığınızı anlıyorum. Bu durumda lojistik kantil regresyona giderdim . Kuantil regresyon, düzenli lineer regresyona çok temiz bir alternatiftir. Farklı niceliklere bakabilir ve verilerinizin düzenli doğrusal regresyon ile mümkün olandan çok daha iyi bir resmini elde edebilirsiniz. Ayrıca dağıtım ^{1 ile} ilgili herhangi bir varsayımı yoktur .

Bir değişkenin dönüşümü genellikle doğrusal regresyon üzerinde komik etkilere neden olabilir , örneğin lojistik dönüşümde bir öneme sahip olursunuz, ancak bu normal değere dönüşmez. Bu durum böyle değil quantiles ile ortanca bağımsız olarak her zaman dönüşüm fonksiyonunun medyan olduğunu. Bu, hiçbir şeyi bozmadan ileri geri dönüşüm yapmanızı sağlar. Bottai, sınırlı sonuçlar ² için bu yaklaşımı önerdi , bireysel tahminler yapmak istiyorsanız mükemmel bir yöntemdir, ancak betalara bakmak ve lojistik olmayan bir şekilde yorumlamak istemediğinizde bazı sorunları vardır. Formül basit:

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

Burada puanınız ve rastgele küçük bir sayıdır.$y$$\epsilon$

İşte R ile denemek istediğimde bir süre önce yaptığım bir örnek:

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()

Bu, açıkça bağlı ve rahatsız edici olduğunu görebileceğiniz gibi, aşağıdaki veri dağılımını verir :

###################################
# 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)

Bu, kadınların açıkça üst sınırın üzerinde olduğu aşağıdaki resim ile sonuçlanmaktadır:

# 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)

Bu, benzer sorunlara sahip aşağıdaki grafiği verir:

# 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)

Çok güzel sınırlı bir tahmini olan lojistik kantil regresyon:

Burada, Beta'nın yeniden dönüştürülmüş bir şekilde farklı bölgelerde (beklendiği gibi) farklı olduğu sorununu görebilirsiniz:

# 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

Referanslar

1. R. Koenker ve G. Bassett Jr, “Regresyon miktarları” Econometrica: Ekonometrik Derneği dergisi, s.33–50, 1978.
2. M. Bottai, B. Cai ve RE McKeown, “Sınırlı sonuçlar için lojistik kantil regresyon,” Tıpta İstatistikler, cilt. 29, hayır. 2, sayfa 309-317, 2010.

Meraklı olanlar için bu kod kullanılarak grafikler oluşturuldu:

# 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()