Gérer la régression d'une variable de réponse inhabituellement limitée

J'essaie de modéliser une variable de réponse théoriquement limitée entre -225 et +225. La variable est le score total obtenu par les sujets en jouant à un jeu. Bien que théoriquement, il est possible pour les sujets d'obtenir un score de +225. Malgré cela, car le score dépend non seulement des actions des sujets, mais aussi des actions d'une autre action.Le maximum que n'importe qui a marqué était de 125 (c'est le plus haut score que les 2 joueurs peuvent jouer), cela s'est produit avec une fréquence très élevée. Le score le plus bas était de +35.

Cette limite de 125 cause des difficultés avec une régression linéaire. La seule chose à laquelle je peux penser est de redimensionner la réponse entre 0 et 1 et d'utiliser une régression bêta. Si je fais cela, je ne suis pas sûr de pouvoir vraiment justifier que 125 est la limite supérieure (ou 1 après transformation) car il est possible de marquer +225. De plus, si je faisais cela, quelle serait ma limite inférieure, 35?

Merci,

Jonathan

Bien que je ne sois pas entièrement certain de votre problème de régression linéaire, je suis en train de terminer un article sur la façon d'analyser les résultats bornés. Comme je ne connais pas la régression bêta, peut-être que quelqu'un d'autre répondra à cette option.

Par votre question, je comprends que vous obtenez des prédictions en dehors des limites. Dans ce cas, je choisirais la régression logistique quantile . La régression quantile est une alternative très intéressante à la régression linéaire régulière. Vous pouvez regarder différents quantiles et obtenir une bien meilleure image de vos données que ce qui est possible avec une régression linéaire régulière. Il n'a également aucune hypothèse concernant la distribution ¹ .

La transformation d'une variable peut souvent provoquer des effets amusants sur la régression linéaire, par exemple vous avez une signification dans la transformation logistique mais cela ne se traduit pas en valeur régulière. Ce n'est pas le cas avec les quantiles, la médiane est toujours la médiane quelle que soit la fonction de transformation. Cela vous permet de vous transformer d'avant en arrière sans déformer quoi que ce soit. Le professeur Bottai a suggéré cette approche des résultats bornés ² , c'est une excellente méthode si vous voulez faire des prédictions individuelles, mais il y a des problèmes lorsque vous ne voulez pas regarder les bêta et les interpréter de manière non logistique. La formule est simple:

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

Où est votre score et est un petit nombre arbitraire .$y$$\epsilon$

Voici un exemple que j'ai fait il y a quelque temps lorsque je voulais l'expérimenter dans 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()

Cela donne la dispersion de données suivante, comme vous pouvez le voir, elle est clairement limitée et incommode :

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

Cela donne l'image suivante où les femelles sont clairement au-dessus de la limite supérieure:

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

Cela donne le tracé suivant avec des problèmes similaires:

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

La régression quantile logistique qui a une très belle prédiction bornée:

Ici, vous pouvez voir le problème avec les bêta qui, à la manière de la retransformation, diffère selon les régions (comme prévu):

# 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

Références

1. R. Koenker et G. Bassett Jr, «Regression quantiles», Econometrica: journal de l'Econometric Society, pp. 33–50, 1978.
2. M. Bottai, B. Cai et RE McKeown, «Régression logistique quantile pour les résultats bornés», Statistics in Medicine, vol. 29, non. 2, p. 309–317, 2010.

Pour les curieux les parcelles ont été créées à l'aide de ce code:

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