हालांकि मैं पूरी तरह से निश्चित नहीं हूं कि रैखिक प्रतिगमन के साथ आपकी समस्या क्या है, मैं अभी एक लेख को समाप्त कर रहा हूं कि कैसे बंधे परिणामों का विश्लेषण किया जाए। चूंकि मैं बीटा प्रतिगमन से परिचित नहीं हूं, शायद कोई और उस विकल्प का जवाब देगा।
आपके प्रश्न से मैं समझता हूं कि आपको सीमाओं के बाहर की भविष्यवाणियां मिलती हैं। इस मामले में मैं लॉजिस्टिक क्वांटाइल रिग्रेशन के लिए जाऊंगा । मात्रात्मक प्रतिगमन नियमित रैखिक प्रतिगमन के लिए एक बहुत साफ विकल्प है। आप विभिन्न मात्राओं को देख सकते हैं और अपने डेटा की एक बेहतर तस्वीर प्राप्त कर सकते हैं जो नियमित रैखिक प्रतिगमन के साथ संभव है। वितरण 1 के संबंध में भी कोई धारणा नहीं है ।
एक परिवर्तनशील परिवर्तन अक्सर रैखिक प्रतिगमन पर मजाकिया प्रभाव पैदा कर सकता है , उदाहरण के लिए, आपके पास तार्किक परिवर्तन में एक महत्व है लेकिन यह नियमित मूल्य में अनुवाद नहीं करता है। यह क्वांटिल्स के मामले में नहीं है , ट्रांसफॉर्मेशन फ़ंक्शन की परवाह किए बिना माध्य हमेशा औसत दर्जे का होता है। यह आपको कुछ भी विकृत किए बिना आगे और पीछे बदलने की अनुमति देता है। प्रो। बोटई ने इस दृष्टिकोण को बंधे हुए परिणामों 2 , इसकी एक उत्कृष्ट विधि का सुझाव दिया यदि आप व्यक्तिगत भविष्यवाणियां करना चाहते हैं, लेकिन इसके कुछ मुद्दे हैं जब आप बीटा को देखने और उन्हें गैर-तार्किक तरीके से व्याख्या करने के लिए नहीं चाहते हैं। सूत्र सरल है:
एल ओ जीमैं टी ( वाई)) = एल ओ जी( y+ ϵm a x ( y) - वाई+ ϵ)
yε
यहाँ एक उदाहरण है जो मैंने कुछ समय पहले किया था जब मैं इसके साथ आर में प्रयोग करना चाहता था:
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()
यह निम्न डेटा बिखराव देता है, जैसा कि आप देख सकते हैं कि यह स्पष्ट रूप से बाध्य और असुविधाजनक है :
###################################
# 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)
इसका परिणाम निम्न चित्र में दिखाई देता है जहाँ महिलाएँ ऊपरी सीमा के ऊपर स्पष्ट रूप से होती हैं:
# 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)
यह निम्नलिखित प्लॉट को समान समस्याओं के साथ देता है:
# 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)
लॉजिस्टिक क्वांटाइल रिग्रेशन जिसकी एक बहुत अच्छी बाध्यता है:
यहाँ आप बीटा के साथ इस मुद्दे को देख सकते हैं कि अलग-अलग क्षेत्रों में अलग-अलग क्षेत्रों में फैशन अलग है (जैसा कि अपेक्षित है):
# 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
संदर्भ
- आर। कोएनकर और जी। बैसेट जूनियर, "रिग्रेशन क्वांटाइल्स, इकोनोमेट्रिक: इकोनोमेट्रिक सोसाइटी की पत्रिका, पीपी। 33-50, 1978।
- एम। बोटई, बी। काई, और आरई मैककेन, "लॉजिस्टिक क्वांटिल रिग्रेशन फॉर बाउंडेड आउटकम," स्टैटिस्टिक्स इन मेडिसिन, वॉल्यूम। 29, सं। 2, पीपी। 309–317, 2010।
जिज्ञासु के लिए इस कोड का उपयोग करके प्लॉट बनाए गए थे:
# 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()