Korelasi antara estimator OLS untuk intersep dan kemiringan


25

Dalam model regresi sederhana,

y=β0+β1x+ε,

estimator OLS dan berkorelasi.ββ^0OLSβ^1OLS

Rumus untuk korelasi antara kedua penaksir adalah (jika saya mendapatkannya dengan benar):

Corr(β^0OLS,β^1OLS)=i=1nxini=1nxi2.

Pertanyaan:

  1. Apa penjelasan intuitif untuk keberadaan korelasi?
  2. Apakah kehadiran korelasi memiliki implikasi penting?

Pos diedit dan pernyataan bahwa korelasi menghilang dengan ukuran sampel telah dihapus. (Terima kasih kepada @whuber dan @ChristophHanck.)


7
Rumusnya benar, tetapi bisakah Anda menjelaskan asimptotik apa yang Anda gunakan? Lagi pula, dalam banyak kasus, korelasinya tidak hilang - stabil. Pertimbangkan, misalnya , percobaan di mana xi adalah biner dan anggaplah data dikumpulkan dengan mengganti xi antara 1 dan 0 . Kemudian xi=xi2n/2 dan korelasinya akan selalu dekat dengan 2/20 , tidak peduli seberapa besar n menjadi.
whuber

1
Saya akan mengatakan itu hanya hilang jika E(X)=0 : tulis
Corr(β^0OLS,β^1OLS)=1Ni=1NxiNi=1Nxi2N2=1Ni=1Nxii=1Nxi2N,
yang dimaksudkan untuk E(X)/E(X2) .
Christoph Hanck

Memang, saya kehilangan satu ketika saya menurunkan perilaku korelasi ketika meningkat. Jadi whuber dan ChristophHanck benar. Saya masih tertarik pada penjelasan intuitif mengapa korelasi itu bukan nol di tempat pertama, dan implikasi yang berguna . (Saya tidak mengatakan korelasi seharusnya nol, saya tidak punya intuisi di sini.)nnn
Richard Hardy

3
Rumus Anda dengan rapi menunjukkan misalnya bahwa untuk regressor berpusat-rata-rata , korelasi dengan intersep menghilang. x
Michael M

Jawaban:


16

Biarkan saya mencobanya sebagai berikut (benar-benar tidak yakin apakah itu intuisi yang berguna):

Berdasarkan komentar saya di atas, korelasinya kira-kira akan menjadi Jadi, jika bukannya , sebagian besar data akan dikelompokkan di sebelah kanan nol. Jadi, jika koefisien kemiringan semakin besar, rumus korelasi menegaskan bahwa intersep perlu menjadi lebih kecil - yang masuk akal. E(X)>0E(X)=0

E(X)E(X2)
E(X)>0E(X)=0

Saya sedang memikirkan sesuatu seperti ini:

Pada sampel biru, estimasi kemiringan lebih rata, yang berarti estimasi intersepsi dapat lebih besar. Kemiringan untuk sampel emas agak lebih besar, sehingga intersep dapat sedikit lebih kecil untuk mengimbangi ini.

masukkan deskripsi gambar di sini

Di sisi lain, jika , kita dapat memiliki kemiringan tanpa kendala pada intersep.E(X)=0

Penyebut rumus juga dapat ditafsirkan sepanjang garis-garis ini: jika, untuk rata-rata yang diberikan, variabilitas yang diukur dengan meningkat, data akan dioleskan di atas sumbu, sehingga secara efektif "terlihat". "Lebih berarti-nol lagi, melonggarkan kendala pada intersep untuk rata-rata diberikan .x XE(X2)xX

Inilah kodenya, yang saya harap jelaskan gambarnya:

n <- 30
x_1 <- sort(runif(n,2,3))
beta <- 2
y_1 <- x_1*beta + rnorm(n) # the golden sample

x_2 <- sort(runif(n,2,3)) 
beta <- 2
y_2 <- x_2*beta + rnorm(n) # the blue sample

xax <- seq(-1,3,by=.001)
plot(x_1,y_1,xlim=c(-1,3),ylim=c(-4,7),pch=19,col="gold",ylab="y",xlab="x")
abline(lm(y_1~x_1),col="gold",lwd=2)
abline(v=0,lty=2)
lines(xax,beta*xax) # the "true" regression line
abline(lm(y_2~x_2),col="lightblue",lwd=2)
points(x_2,y_2,pch=19,col="lightblue")

1
Untuk implikasi praktis, pertimbangkan pengembangan dan penggunaan kurva kalibrasi untuk instrumen laboratorium. Untuk mengembangkan kalibrasi, nilai yang diketahui diuji dengan instrumen dan nilai output instrumen diukur, diikuti dengan regresi linier. Kemudian sampel yang tidak diketahui diterapkan pada instrumen, dan nilai baru digunakan untuk memprediksi tidak diketahui berdasarkan kalibrasi linier-regresi. Analisis kesalahan estimasi tidak diketahui akan melibatkan korelasi antara estimasi kemiringan regresi dan intersep. y y x xxyyxx
EdM

17

Anda mungkin ingin mengikuti Dougherty's Introduction to Econometrics , mungkin mempertimbangkan untuk sekarang bahwa adalah variabel non-stokastik, dan mendefinisikan deviasi kuadrat rata-rata menjadi . Perhatikan bahwa MSD diukur dalam kuadrat unit (mis. Jika ada di maka MSD di ), sedangkan root mean square deviation, berada pada skala asli. Ini menghasilkanx MSD ( x ) = 1xxxxcmcm2rmsd(x)=MSD(x)=1ni=1n(xix¯)2xxcmcm2RMSD(x)=MSD(x)

Corr(β^0OLS,β^1OLS)=x¯MSD(x)+x¯2

Ini akan membantu Anda melihat bagaimana korelasi dipengaruhi oleh kedua rata-rata dari (khususnya, korelasi antara kemiringan dan mencegat Anda estimator dihapus jika variabel berpusat) dan juga dengan yang spread . (Penguraian ini mungkin juga membuat asimptotik lebih jelas!)xxx

Saya akan mengulangi pentingnya hasil ini: jika tidak memiliki rata-rata nol, kita dapat mengubahnya dengan mengurangi sehingga sekarang terpusat. Jika kita cocok dengan garis regresi pada perkiraan kemiringan dan intersepsi tidak berkorelasi - yang kurang atau terlalu tinggi dalam satu cenderung tidak menghasilkan kurang atau terlalu tinggi di yang lain. Tetapi garis regresi ini hanyalah terjemahan dari pada garis regresi ! Kesalahan standar dari intersep garis pada hanyalah ukuran ketidakpastian ketika variabel yang Anda terjemahkanˉ x y x - ˉ x y x y x - ˉ x y x - ˉ x = 0 y x = ˉ x y x y x y x = 0xx¯yxx¯yxyxx¯y^xx¯=0; ketika baris itu diterjemahkan kembali ke posisi semula, ini kembali menjadi kesalahan standar at . Lebih umum, kesalahan standar dari pada setiap nilai hanyalah kesalahan standar dari intersepsi regresi pada diterjemahkan dengan tepat ; kesalahan standar pada tentu saja adalah kesalahan standar dari intersep dalam regresi asli yang tidak diterjemahkan.y^x=x¯y^xyxy^x=0

Karena kita dapat menerjemahkan , dalam arti tertentu tidak ada yang istimewa tentang dan oleh karena itu tidak ada yang istimewa tentang . Dengan sedikit pemikiran, apa yang akan saya katakan bekerja untuk pada setiap nilai , yang berguna jika Anda sedang mencari wawasan interval kepercayaan misalnya untuk tanggapan berarti dari garis regresi Anda. Namun, kita telah melihat bahwa ada adalah sesuatu yang khusus tentang di , untuk itu adalah di sini bahwa kesalahan dalam perkiraan ketinggian garis regresi - yang tentu saja diperkirakanx = 0 β 0 y x y x = ˉ x ˉ y β 0 = ˉ y - β 1 ˉ x ˉ y β 1 x ˉ x < 0 y = ˉ y x = ˉ xxx=0β^0y^xy^x=x¯y¯- dan kesalahan estimasi kemiringan garis regresi tidak ada hubungannya dengan satu sama lain. Taksiran intersepsi Anda adalah dan kesalahan dalam estimasi harus berasal dari estimasi atau estimasi (karena kami menganggap bukan -stochastic); sekarang kita tahu kedua sumber kesalahan ini tidak berkorelasi jelas secara aljabar mengapa harus ada korelasi negatif antara perkiraan kemiringan dan intersep (kemiringan yang berlebihan akan cenderung meremehkan intersep, selama ) tetapi korelasi positif antara estimasi mencegat dan memperkirakan respons rata-rata diβ^0=y¯β^1x¯y¯β^1xx¯<0y^=y¯x=x¯. Tapi bisa melihat hubungan seperti itu tanpa aljabar juga.

Bayangkan garis regresi yang diperkirakan sebagai penggaris. Penguasa itu harus melewati . Kita baru saja melihat bahwa ada dua ketidakpastian yang pada dasarnya tidak berhubungan di lokasi baris ini, yang saya visualisasikan secara kinestetik sebagai ketidakpastian "dentingan" dan ketidakpastian "geser paralel". Sebelum Anda mengaitkan penggaris, pegang penggaris di sebagai poros, lalu berikan dentingan yang kuat terkait dengan ketidakpastian Anda di lereng. Penguasa akan memiliki goyangan yang baik, lebih keras sehingga jika Anda sangat tidak yakin tentang kemiringan (memang, kemiringan yang sebelumnya positif sangat mungkin akan diberikan negatif jika ketidakpastian Anda besar) tetapi perhatikan bahwa ketinggian garis regresi pada( ˉ x , ˉ y ) x = ˉ x(x¯,y¯)(x¯,y¯)x=x¯tidak berubah oleh ketidakpastian semacam ini, dan efek dentingan lebih terlihat semakin jauh dari rata-rata yang Anda lihat.

Untuk "menggeser" penggaris, pegang dengan kuat dan geser ke atas dan ke bawah, berhati-hatilah agar tetap sejajar dengan posisi aslinya - jangan mengubah lereng! Seberapa kuat untuk menggesernya ke atas dan ke bawah tergantung pada seberapa tidak pasti Anda tentang ketinggian garis regresi saat melewati titik rata-rata; pikirkan tentang apa kesalahan standar dari intersep jika telah diterjemahkan sehingga sumbu melewati titik rerata. Atau, karena estimasi tinggi garis regresi di sini adalah , itu juga merupakan kesalahan standar dari . Perhatikan bahwa ketidakpastian "geser" ini memengaruhi semua titik pada garis regresi dengan cara yang sama, tidak seperti "dentingan".y ˉ y ˉ yxyy¯y¯

Kedua ketidakpastian berlaku secara independen (baik, uncorrelatedly, tetapi jika kita menganggap hal kesalahan terdistribusi secara normal maka mereka harus secara teknis independen) sehingga ketinggian dari semua titik pada garis regresi Anda dipengaruhi oleh "twanging" ketidakpastian yang nol pada artinya dan semakin buruk darinya, dan ketidakpastian "meluncur" yang sama di mana-mana. (Dapatkah Anda melihat hubungan dengan interval kepercayaan regresi yang saya janjikan sebelumnya, terutama bagaimana lebar mereka paling sempit di ?) ˉ xy^x¯

Ini termasuk ketidakpastian dalam pada , yang pada dasarnya adalah apa yang kami maksud dengan kesalahan standar di . Sekarang anggap di sebelah kanan ; kemudian memutar-mutar grafik ke perkiraan kemiringan yang lebih tinggi cenderung mengurangi perkiraan intersep kami karena sketsa cepat akan terbuka. Ini adalah korelasi negatif yang diprediksi oleh ketika positif. Sebaliknya, jika adalah kiri Anda akan melihat bahwa perkiraan kemiringan yang lebih tinggi cenderung meningkatkan perkiraan intersep kami, konsisten dengan yang positif x=0 β 0 ˉ x x=0- ˉ xy^x=0β^0x¯x=0 ˉxˉxx=0ˉxˉxy-β1ˉxˉyβ0β1ˉx±suβ0β11x¯MSD(x)+x¯2x¯x¯x=0korelasi yang diprediksi persamaan Anda saat negatif. Perhatikan bahwa jika jauh dari nol, ekstrapolasi dari garis regresi dari gradien tidak pasti menuju sumbu menjadi semakin genting (amplitudo "dentingan" semakin buruk dari rata-rata). Kesalahan "dentingan" dalam istilah akan secara masif melebihi kesalahan "geser" dalam istilah , jadi kesalahan dalam hampir seluruhnya ditentukan oleh kesalahan apa pun dalam . Karena Anda dapat dengan mudah memverifikasi secara aljabar, jika kami mengambil tanpa mengubah MSD atau standar deviasi kesalahanx¯x¯yβ^1x¯y¯β^0β^1x¯±su , korelasi antara dan cenderung .β^0β^11

Simulasi lereng dan penyadapan

Untuk mengilustrasikan ini (Anda mungkin ingin mengklik kanan pada gambar dan menyimpannya, atau melihatnya ukuran penuh di tab baru jika opsi itu tersedia untuk Anda) Saya telah memilih untuk mempertimbangkan pengambilan sampel berulang , di mana iid, di atas set nilai tetap dengan , jadi . Dalam pengaturan ini, ada korelasi negatif yang cukup kuat antara perkiraan kemiringan dan intersep, dan korelasi positif yang lebih lemah antara , estimasi respons rata-rata padau iN ( 0 , 10 2 ) x ˉ x = 10 E ( ˉ y ) = 25 ˉ y x = ˉ x ˉ y ˉ y ˉ y ˉ y ˉ y ˉ yyi=5+2xi+uiuiN(0,102)xx¯=10E(y¯)=25y¯x=x¯, dan estimasi intersep. Animasi ini menunjukkan beberapa sampel yang disimulasikan, dengan garis regresi sampel (emas) ditarik di atas garis regresi (hitam) yang sebenarnya. Baris kedua menunjukkan seperti apa kumpulan garis regresi yang diperkirakan jika ada kesalahan hanya dalam estimasi dan lereng cocok dengan kemiringan sebenarnya (kesalahan "geser"); kemudian, jika ada kesalahan hanya di lereng dan cocok dengan nilai populasinya (kesalahan "dentingan"); dan akhirnya, seperti apa sebenarnya kumpulan garis yang diperkirakan, ketika kedua sumber kesalahan digabungkan. Ini telah diberi kode warna oleh ukuran intersep yang sebenarnya diperkirakany¯y¯(bukan penyadapan yang ditunjukkan pada dua grafik pertama di mana salah satu sumber kesalahan telah dihilangkan) dari biru untuk penyadapan rendah menjadi merah untuk penyadapan tinggi. Perhatikan bahwa dari warna saja kita dapat melihat bahwa sampel dengan rendah cenderung menghasilkan intersep estimasi yang lebih rendah, seperti halnya sampel dengan estimasi lereng yang tinggi . Baris berikutnya menunjukkan distribusi sampling yang disimulasikan (histogram) dan teoretis (kurva normal) dari estimasi, dan baris terakhir menunjukkan plot pencar di antaranya. Amati bagaimana tidak ada korelasi antara dan estimasi kemiringan, korelasi negatif antara perkiraan intersep dan kemiringan, dan korelasi positif antara intersep dan .y¯y¯y¯

Apa yang dilakukan MSD dalam penyebut ? Menyebarkan rentang nilai Anda ukur terkenal untuk memungkinkan Anda memperkirakan kemiringan lebih akurat, dan intuisi jelas dari sketsa, tetapi itu tidak membuat Anda memperkirakan lebih baik. Saya sarankan Anda memvisualisasikan mengambil MSD mendekati nol (yaitu titik pengambilan sampel hanya sangat dekat dengan rata-rata ), sehingga ketidakpastian di lereng menjadi masif: pikirkan dentingan besar, tetapi tanpa perubahan pada ketidakpastian geser Anda. Jika sumbu Anda jauh dari (dengan kata lain, jika xˉyxyˉxˉx0xMSD(x)±ˉx0±1ˉxMSD(x)0x¯MSD(x)+x¯2xy¯xyx¯x¯0) Anda akan menemukan bahwa ketidakpastian dalam intersep Anda menjadi sangat didominasi oleh kesalahan dentingan terkait kemiringan. Sebaliknya, jika Anda meningkatkan penyebaran pengukuran Anda , tanpa mengubah rata-rata, Anda akan secara besar-besaran meningkatkan ketepatan estimasi kemiringan Anda dan hanya perlu membawa dentingan lembut ke garis Anda. Ketinggian intersep Anda sekarang didominasi oleh ketidakpastian geser Anda, yang tidak ada hubungannya dengan perkiraan kemiringan Anda. Ini sesuai dengan fakta aljabar bahwa korelasi antara perkiraan kemiringan dan intersep cenderung nol sebagai dan, ketika , menuju (tandanya adalah kebalikan dari tanda ) sebagaixMSD(x)±x¯0±1x¯MSD(x)0.

Korelasi penaksir kemiringan dan intersepsi adalah fungsi dari kedua dan MSD (atau RMSD) dari , jadi bagaimana kontribusi relatifnya membebani? Sebenarnya, yang penting adalah rasio dengan RMSD dari . Intuisi geometris adalah bahwa RMSD memberi kita semacam "unit alami" untuk ; Jika kita menskala ulang menggunakan maka ini adalah peregangan horizontal yang membuat perkiraan intersep dan tidak berubah, memberi kita , dan mengalikan estimasi kemiringan oleh RMSD x ˉ x xxxwi=xi/rmsd(x) ˉ y rmsd(w)=1xrmsd(w) ˉ w ˉ xx¯xx¯xxxwi=xi/RMSD(x)y¯RMSD(w)=1x. Rumus untuk korelasi antara kemiringan baru dan penaksir intersepsi hanya dalam istilah , yang merupakan satu, dan , yang merupakan rasio . Karena estimasi intersep tidak berubah, dan estimasi slope hanya dikalikan dengan konstanta positif, maka korelasi di antara mereka tidak berubah: maka korelasi antara slope asli dan intersep juga harus hanya bergantung pada . Secara aljabar kita dapat melihat ini dengan membagi atas dan bawah oleh untuk mendapatkanRMSD(w)w¯ˉ xx¯RMSD(x) - ˉ xx¯RMSD(x) rmsd(x)Corr( β 0, β 1)=-( ˉ x /rmsd(x))x¯MSD(x)+x¯2RMSD(x)Corr(β^0,β^1)=(x¯/RMSD(x))1+(x¯/RMSD(x))2 .

Untuk menemukan korelasi antara dan , pertimbangkan . Dengan bilinearitas dari ini adalah . Istilah pertama adalah sedangkan istilah kedua yang kita tentukan sebelumnya adalah nol. Dari sini kita simpulkan ˉ y Cov( β 0, ˉ y )=Cov( ˉ y - β 1 ˉ x , ˉ y )CovCov( ˉ y , ˉ y )- ˉ x Cov( β 1, ˉ y )Var( ˉ y )=σ 2 uβ^0y¯Cov(β^0,y¯)=Cov(y¯β^1x¯,y¯)CovCov(y¯,y¯)x¯Cov(β^1,y¯)Var(y¯)=σu2n

Corr(β^0,y¯)=11+(x¯/RMSD(x))2

Jadi korelasi ini juga hanya bergantung pada rasio . Perhatikan bahwa kuadrat dari dan berjumlah satu: kami mengharapkan ini karena semua variasi sampel (untuk tetap ) dalam disebabkan oleh variasi dalam atau variasi dalam , dan sumber-sumber variasi ini tidak berkorelasi satu sama lain. Berikut adalah plot korelasi terhadap rasio . Corr( β 0, ß 1)Corr( β 0, ˉ y )x β 0 β 1 ˉ y ˉ xx¯RMSD(x)Corr(β^0,β^1)Corr(β^0,y¯)xβ^0β^1y¯x¯RMSD(x)

Korelasi intersep dan kemiringan, dan intersep dan rata-rata y, terhadap rasio rata-rata x terhadap RMSD

Plotnya dengan jelas menunjukkan bagaimana ketika relatif tinggi terhadap RMSD , kesalahan dalam estimasi intersepsi sebagian besar disebabkan oleh kesalahan dalam estimasi kemiringan dan keduanya berkorelasi erat, sedangkan ketika relatif rendah terhadap RMSD , maka ada kesalahan dalam estimasi yang mendominasi, dan hubungan antara intersep dan slope lebih lemah. Perhatikan bahwa korelasi intersep dengan kemiringan adalah fungsi aneh dari rasio , jadi tandanya tergantung pada tanda dan nol jika , sedangkan korelasi intersep denganˉ x ˉ y ˉ xx¯x¯y¯ˉ x ˉ x =0 ˉ y y ˉ x ˉ x yCorr( β 0, ˉ y )=1x¯RMSD(x)x¯x¯=0y¯selalu positif dan merupakan fungsi genap dari rasio, yaitu tidak masalah apa sisi sumbu yang merupakan . Korelasi sama besarnya jika berjarak satu RMSD dari sumbu, ketika dan mana tandanya berlawanan dengan . Pada contoh dalam simulasi di atas, dan sehingga rerata sekitar RMSD dariyx¯x¯yCorr(β0,β1)=±1Corr(β^0,y¯)=120.707ˉxˉx=10RMSD(x)5,161,93yˉyCorr(β^0,β^1)=±12±0.707x¯x¯=10RMSD(x)5.161.93y-sumbu; pada rasio ini, korelasi antara intersepsi dan kemiringan lebih kuat, tetapi korelasi antara intersep dan masih tidak dapat diabaikan.y¯

Selain itu, saya suka memikirkan rumus untuk kesalahan standar intersep,

s.e.(β^0OLS)=su2(1n+x¯2nMSD(x))

sebagai , dan juga untuk rumus untuk kesalahan standar di (digunakan untuk interval kepercayaan untuk respons rata-rata, dan yang mana intersep hanyalah kasus khusus seperti yang saya jelaskan sebelumnya melalui argumen terjemahan),y x=x0sliding error+twanging errory^x=x0

s.e.(y^)=su2(1n+(x0x¯)2nMSD(x))

Kode R untuk plot

require(graphics)
require(grDevices)
require(animation

#This saves a GIF so you may want to change your working directory
#setwd("~/YOURDIRECTORY")
#animation package requires ImageMagick or GraphicsMagick on computer
#See: http://www.inside-r.org/packages/cran/animation/docs/im.convert
#You might only want to run up to the "STATIC PLOTS" section
#The static plot does not save a file, so need to change directory.

#Change as desired
simulations <- 100 #how many samples to draw and regress on
xvalues <- c(2,4,6,8,10,12,14,16,18) #used in all regressions
su <- 10 #standard deviation of error term
beta0 <- 5 #true intercept
beta1 <- 2 #true slope
plotAlpha <- 1/5 #transparency setting for charts
interceptPalette <- colorRampPalette(c(rgb(0,0,1,plotAlpha),
            rgb(1,0,0,plotAlpha)), alpha = TRUE)(100) #intercept color range
animationFrames <- 20 #how many samples to include in animation

#Consequences of previous choices
n <- length(xvalues) #sample size
meanX <- mean(xvalues) #same for all regressions
msdX <- sum((xvalues - meanX)^2)/n #Mean Square Deviation
minX <- min(xvalues)
maxX <- max(xvalues)
animationFrames <- min(simulations, animationFrames)

#Theoretical properties of estimators
expectedMeanY <- beta0 + beta1 * meanX
sdMeanY <- su / sqrt(n) #standard deviation of mean of Y (i.e. Y hat at mean x)
sdSlope <- sqrt(su^2 / (n * msdX))
sdIntercept <- sqrt(su^2 * (1/n + meanX^2 / (n * msdX)))


data.df <- data.frame(regression = rep(1:simulations, each=n),
                      x = rep(xvalues, times = simulations))

data.df$y <- beta0 + beta1*data.df$x + rnorm(n*simulations, mean = 0, sd = su) 

regressionOutput <- function(i){ #i is the index of the regression simulation
  i.df <- data.df[data.df$regression == i,]
  i.lm <- lm(y ~ x, i.df)
  return(c(i, mean(i.df$y), coef(summary(i.lm))["x", "Estimate"],
          coef(summary(i.lm))["(Intercept)", "Estimate"]))
}

estimates.df <- as.data.frame(t(sapply(1:simulations, regressionOutput)))
colnames(estimates.df) <- c("Regression", "MeanY", "Slope", "Intercept")

perc.rank <- function(x) ceiling(100*rank(x)/length(x))
rank.text <- function(x) ifelse(x < 50, paste("bottom", paste0(x, "%")), 
                                paste("top", paste0(101 - x, "%")))
estimates.df$percMeanY <- perc.rank(estimates.df$MeanY)
estimates.df$percSlope <- perc.rank(estimates.df$Slope)
estimates.df$percIntercept <- perc.rank(estimates.df$Intercept)
estimates.df$percTextMeanY <- paste("Mean Y", 
                                    rank.text(estimates.df$percMeanY))
estimates.df$percTextSlope <- paste("Slope",
                                    rank.text(estimates.df$percSlope))
estimates.df$percTextIntercept <- paste("Intercept",
                                    rank.text(estimates.df$percIntercept))

#data frame of extreme points to size plot axes correctly
extremes.df <- data.frame(x = c(min(minX,0), max(maxX,0)),
              y = c(min(beta0, min(data.df$y)), max(beta0, max(data.df$y))))

#STATIC PLOTS ONLY

par(mfrow=c(3,3))

#first draw empty plot to reasonable plot size
with(extremes.df, plot(x,y, type="n", main = "Estimated Mean Y"))
invisible(mapply(function(a,b,c) { abline(a, b, col=c) }, 
                 estimates.df$Intercept, beta1, 
                 interceptPalette[estimates.df$percIntercept]))

with(extremes.df, plot(x,y, type="n", main = "Estimated Slope"))
invisible(mapply(function(a,b,c) { abline(a, b, col=c) }, 
                 expectedMeanY - estimates.df$Slope * meanX, estimates.df$Slope, 
                 interceptPalette[estimates.df$percIntercept]))

with(extremes.df, plot(x,y, type="n", main = "Estimated Intercept"))
invisible(mapply(function(a,b,c) { abline(a, b, col=c) }, 
                 estimates.df$Intercept, estimates.df$Slope, 
                 interceptPalette[estimates.df$percIntercept]))

with(estimates.df, hist(MeanY, freq=FALSE, main = "Histogram of Mean Y",
                        ylim=c(0, 1.3*dnorm(0, mean=0, sd=sdMeanY))))
curve(dnorm(x, mean=expectedMeanY, sd=sdMeanY), lwd=2, add=TRUE)

with(estimates.df, hist(Slope, freq=FALSE, 
                        ylim=c(0, 1.3*dnorm(0, mean=0, sd=sdSlope))))
curve(dnorm(x, mean=beta1, sd=sdSlope), lwd=2, add=TRUE)

with(estimates.df, hist(Intercept, freq=FALSE, 
                        ylim=c(0, 1.3*dnorm(0, mean=0, sd=sdIntercept))))
curve(dnorm(x, mean=beta0, sd=sdIntercept), lwd=2, add=TRUE)

with(estimates.df, plot(MeanY, Slope, pch = 16,  col = rgb(0,0,0,plotAlpha), 
                        main = "Scatter of Slope vs Mean Y"))

with(estimates.df, plot(Slope, Intercept, pch = 16, col = rgb(0,0,0,plotAlpha),
                        main = "Scatter of Intercept vs Slope"))

with(estimates.df, plot(Intercept, MeanY, pch = 16, col = rgb(0,0,0,plotAlpha),
                        main = "Scatter of Mean Y vs Intercept"))


#ANIMATED PLOTS

makeplot <- function(){for (i in 1:animationFrames) {

  par(mfrow=c(4,3))

  iMeanY <- estimates.df$MeanY[i]
  iSlope <- estimates.df$Slope[i]
  iIntercept <- estimates.df$Intercept[i]

  with(extremes.df, plot(x,y, type="n", main = paste("Simulated dataset", i)))
  with(data.df[data.df$regression==i,], points(x,y))
  abline(beta0, beta1, lwd = 2)
  abline(iIntercept, iSlope, lwd = 2, col="gold")

  plot.new()
  title(main = "Parameter Estimates")
  text(x=0.5, y=c(0.9, 0.5, 0.1), labels = c(
    paste("Mean Y =", round(iMeanY, digits = 2), "True =", expectedMeanY),
    paste("Slope =", round(iSlope, digits = 2), "True =", beta1),
    paste("Intercept =", round(iIntercept, digits = 2), "True =", beta0)))

  plot.new()
  title(main = "Percentile Ranks")
  with(estimates.df, text(x=0.5, y=c(0.9, 0.5, 0.1),
                          labels = c(percTextMeanY[i], percTextSlope[i],
                                     percTextIntercept[i])))


  #first draw empty plot to reasonable plot size
  with(extremes.df, plot(x,y, type="n", main = "Estimated Mean Y"))
  invisible(mapply(function(a,b,c) { abline(a, b, col=c) }, 
                   estimates.df$Intercept, beta1, 
                   interceptPalette[estimates.df$percIntercept]))
  abline(iIntercept, beta1, lwd = 2, col="gold")

  with(extremes.df, plot(x,y, type="n", main = "Estimated Slope"))
  invisible(mapply(function(a,b,c) { abline(a, b, col=c) }, 
                expectedMeanY - estimates.df$Slope * meanX, estimates.df$Slope, 
                interceptPalette[estimates.df$percIntercept]))
  abline(expectedMeanY - iSlope * meanX, iSlope,
         lwd = 2, col="gold")

  with(extremes.df, plot(x,y, type="n", main = "Estimated Intercept"))
  invisible(mapply(function(a,b,c) { abline(a, b, col=c) }, 
                   estimates.df$Intercept, estimates.df$Slope, 
                   interceptPalette[estimates.df$percIntercept]))
  abline(iIntercept, iSlope, lwd = 2, col="gold")

  with(estimates.df, hist(MeanY, freq=FALSE, main = "Histogram of Mean Y",
                          ylim=c(0, 1.3*dnorm(0, mean=0, sd=sdMeanY))))
  curve(dnorm(x, mean=expectedMeanY, sd=sdMeanY), lwd=2, add=TRUE)
  lines(x=c(iMeanY, iMeanY),
        y=c(0, dnorm(iMeanY, mean=expectedMeanY, sd=sdMeanY)),
        lwd = 2, col = "gold")

  with(estimates.df, hist(Slope, freq=FALSE, 
                          ylim=c(0, 1.3*dnorm(0, mean=0, sd=sdSlope))))
  curve(dnorm(x, mean=beta1, sd=sdSlope), lwd=2, add=TRUE)
  lines(x=c(iSlope, iSlope), y=c(0, dnorm(iSlope, mean=beta1, sd=sdSlope)),
        lwd = 2, col = "gold")

  with(estimates.df, hist(Intercept, freq=FALSE, 
                          ylim=c(0, 1.3*dnorm(0, mean=0, sd=sdIntercept))))
  curve(dnorm(x, mean=beta0, sd=sdIntercept), lwd=2, add=TRUE)
  lines(x=c(iIntercept, iIntercept),
        y=c(0, dnorm(iIntercept, mean=beta0, sd=sdIntercept)),
        lwd = 2, col = "gold")

  with(estimates.df, plot(MeanY, Slope, pch = 16,  col = rgb(0,0,0,plotAlpha), 
                          main = "Scatter of Slope vs Mean Y"))
  points(x = iMeanY, y = iSlope, pch = 16, col = "gold")

  with(estimates.df, plot(Slope, Intercept, pch = 16, col = rgb(0,0,0,plotAlpha),
                          main = "Scatter of Intercept vs Slope"))
  points(x = iSlope, y = iIntercept, pch = 16, col = "gold")

  with(estimates.df, plot(Intercept, MeanY, pch = 16, col = rgb(0,0,0,plotAlpha),
                          main = "Scatter of Mean Y vs Intercept"))
  points(x = iIntercept, y = iMeanY, pch = 16, col = "gold")

}}

saveGIF(makeplot(), interval = 4, ani.width = 500, ani.height = 600)

Untuk plot korelasi versus rasio terhadap RMSD:x¯

require(ggplot2)

numberOfPoints <- 200
data.df  <- data.frame(
  ratio = rep(seq(from=-10, to=10, length=numberOfPoints), times=2),
  between = rep(c("Slope", "MeanY"), each=numberOfPoints))
data.df$correlation <- with(data.df, ifelse(between=="Slope",
  -ratio/sqrt(1+ratio^2),
  1/sqrt(1+ratio^2)))

ggplot(data.df, aes(x=ratio, y=correlation, group=factor(between),
                    colour=factor(between))) +
  theme_bw() + 
  geom_line(size=1.5) +
  scale_colour_brewer(name="Correlation between", palette="Set1",
                      labels=list(expression(hat(beta[0])*" and "*bar(y)),
                              expression(hat(beta[0])*" and "*hat(beta[1])))) +
  theme(legend.key = element_blank()) +
  ggtitle(expression("Correlation of intercept estimates with slope and "*bar(y))) +
  xlab(expression("Ratio of "*bar(X)/"RMSD(X)")) +
  ylab(expression(paste("Correlation")))

1
"Dentingan" dan "slide" adalah istilah saya. Ini adalah intuisi visual saya sendiri, dan tidak ada yang pernah saya lihat di buku teks manapun, meskipun ide-ide dasar di sini semua bahan standar. Ya Tuhan tahu jika ada nama yang lebih teknis dari "dentingan" dan "slide"! Saya mendasarkan jawaban ini, dari ingatan, pada jawaban atas pertanyaan terkait yang tidak pernah saya selesaikan sampai selesai dan diposkan. Itu memiliki lebih banyak grafik instruktif, yang (jika saya dapat melacak kode R di komputer lama saya, atau menemukan waktu untuk mereproduksi) saya akan menambahkan.
Silverfish

1
Pekerjaan apa! Terima kasih banyak! Sekarang pemahaman saya harus jauh lebih baik.
Richard Hardy

@ RichardHardy Saya telah memasukkan animasi simulasi, yang seharusnya membuat semuanya lebih jelas.
Silverfish
Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.