Gestire la regressione di una variabile di risposta insolitamente limitata

Sto tentando di modellare una variabile di risposta che è teoricamente limitata tra -225 e +225. La variabile è il punteggio totale ottenuto dai soggetti durante una partita. Sebbene teoricamente sia possibile per i soggetti segnare +225. Ciononostante, poiché il punteggio dipendeva non solo dalle azioni dei soggetti, ma anche dalle azioni di un'altra azione, il massimo che chiunque avesse segnato era 125 (questo è il numero massimo di 2 giocatori che si giocano a vicenda possono segnare entrambi), questo è accaduto con una frequenza molto alta. Il punteggio più basso è stato +35.

Questo limite di 125 sta causando difficoltà con una regressione lineare. L'unica cosa che posso pensare di fare è ridimensionare la risposta tra 0 e 1 e utilizzare una regressione beta. Se lo faccio anche se non sono sicuro di poter veramente giustificare dicendo che 125 è il limite superiore (o 1 dopo la trasformazione) poiché è possibile segnare +225. Inoltre, se lo facessi, quale sarebbe il mio limite inferiore, 35?

Grazie,

Jonathan

Anche se non sono del tutto sicuro di quale sia il tuo problema con la regressione lineare, sto finendo adesso un articolo su come analizzare i risultati limitati. Dal momento che non ho familiarità con la regressione Beta, forse qualcun altro risponderà a questa opzione.

Dalla tua domanda capisco che ottieni previsioni al di fuori dei confini. In questo caso sceglierei la regressione logistica quantile . La regressione quantile è un'alternativa molto accurata alla regressione lineare regolare. Puoi guardare diversi quantili e ottenere un'immagine molto migliore dei tuoi dati rispetto a quanto è possibile con una regressione lineare regolare. Non ha inoltre ipotesi sulla distribuzione ¹ .

La trasformazione di una variabile può spesso causare effetti divertenti sulla regressione lineare, ad esempio si ha un significato nella trasformazione logistica ma ciò non si traduce nel valore normale. Questo non è il caso dei quantili, la mediana è sempre la mediana indipendentemente dalla funzione di trasformazione. Ciò consente di trasformarsi avanti e indietro senza distorcere nulla. Il prof. Bottai ha suggerito questo approccio ai risultati limitati ² , è un metodo eccellente se si desidera fare previsioni individuali, ma presenta alcuni problemi quando non si desidera esaminare le beta e interpretarle in modo non logistico. La formula è semplice:

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

Dove è il tuo punteggio e è un numero piccolo arbitrario .$y$$\epsilon$

Ecco un esempio che ho fatto qualche tempo fa quando volevo sperimentarlo in 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()

Ciò fornisce la seguente diffusione dei dati, come puoi vedere è chiaramente limitata e scomoda :

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

Ciò si traduce nella seguente immagine in cui le femmine sono chiaramente al di sopra del limite superiore:

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

Questo dà la seguente trama con problemi simili:

# 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 regressione quantistica logistica che ha una previsione limitata molto bella:

Qui puoi vedere il problema con la Beta che nella maniera ritrasmessa differisce in diverse regioni (come previsto):

# 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

Riferimenti

1. R. Koenker e G. Bassett Jr, "Regressione quantiles", Econometrica: rivista dell'Econometric Society, pagg. 33-50, 1978.
2. M. Bottai, B. Cai e RE McKeown, "regressione quantistica logistica per risultati limitati", Statistics in Medicine, vol. 29, n. 2, pagg. 309–317, 2010.

Per i curiosi i grafici sono stati creati usando questo codice:

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