Απλό Μονοπαραγοντικό Μοντέλο

Αρχείο με δεδομένα φυσικής κατάστασης 100 ατόμων.

load("exercise.Rdata")
y=exercise$score
y

##   [1]  932 1488  945  765  465 1138 1625 1363  732 1188  716 1175  838  749  943
##  [16]  825  977 1444 1559  658 1384 1060  878 1492  511  566 1292  556  461 1227
##  [31]  671 1290 1584  830 1060 1364  920 1113 1481  409 1423 1206  864 1034 1301
##  [46] 1327  564 1250  468  655  885  509 1383  953  699 1301  884 1016  588  965
##  [61] 1232  510  558 1186 1198  805  958  803  547 1309  740  670  731  420  531
##  [76] 1391  949  862  574 1513  803  755  578  501 1333  729  202 1104 1344  846
##  [91]  483 1347  936  818 1016 1697 1030  996 1344  445

boxplot(y)

summary(y)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   202.0   692.0   939.5   957.4  1260.0  1697.0

sd(y)

## [1] 344.385

hist(y)

Συντελεστής διακύμανσης

cv=sd(y)/mean(y)
cv

## [1] 0.3596973

Διερεύνηση διαφοράς ως προς φύλο

ym=y[exercise$sex==1]
yf=y[exercise$sex==0]
boxplot(ym, yf)

t.test(ym,yf)

## 
##  Welch Two Sample t-test
## 
## data:  ym and yf
## t = -0.72972, df = 93.152, p-value = 0.4674
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -187.47722   86.71722
## sample estimates:
## mean of x mean of y 
##    932.24    982.62

Διερεύνηση συσχέτισης με ηλικία

rscage=cor(exercise$score, exercise$age)
rscage

## [1] -0.9345989

plot(score~age, data=exercise, cex=0.7)

Μοντέλο Παλίνδρόμησης \(Y=\beta_0 + \beta_1 X + \epsilon\), όπου \(Y\)=score, \(X\)=Ηλικία.

mod1=score~age
l1=lm(mod1, data=exercise)
l1

## 
## Call:
## lm(formula = mod1, data = exercise)
## 
## Coefficients:
## (Intercept)          age  
##     2758.22       -40.51

Αποτελέσματα μέσω lm:

names(l1)

##  [1] "coefficients"  "residuals"     "effects"       "rank"         
##  [5] "fitted.values" "assign"        "qr"            "df.residual"  
##  [9] "xlevels"       "call"          "terms"         "model"

yhat=l1$fitted.values

Γράφημα συνάρτησης Παλινδρόμησης

plot(score~age, data=exercise, cex=0.7)
points(l1$fitted.values~exercise$age, col="red", cex=0.7)
abline(l1$coefficients, col="blue")
abline(mean(exercise$score), 0)

Πίνακας Ανάλυσης Διασποράς

la1=anova(l1)

Το αποτέλεσμα της anova είναι λίστα με στοιχεία:

names(la1)

## [1] "Df"      "Sum Sq"  "Mean Sq" "F value" "Pr(>F)"

Μπορούμε να πάρουμε τα αθροίσματα τετραγώνων, τους βαθμούς ελευθερίας κλπ σε χωριστά διανύσματα:

SS=la1$`Sum Sq`
SS

## [1] 10255910  1485592

df=la1$Df
dfmod=df[1]
dfer=df[2]

Συμπερασματολογία - Στατιστική Σημαντικότητα

ls1=summary(l1)
names(ls1)

##  [1] "call"          "terms"         "residuals"     "coefficients" 
##  [5] "aliased"       "sigma"         "df"            "r.squared"    
##  [9] "adj.r.squared" "fstatistic"    "cov.unscaled"

betamatrix=ls1$coefficients
bhat=betamatrix[,1]
bstder=betamatrix[,2]

Από τα διανύσματα των συντελεστών και των τυπικών σφαλμάτων μπορούμε να δημιουργήσουμε διαστήματα εμπιστοσύνης για τα \(\hat{\beta}_0, \hat{\beta}_1\):

confintlow=bhat-qt(0.975,dfer)*bstder
confintupper=bhat+qt(0.975,dfer)*bstder
confintmatrix=cbind(confintlow, confintupper)
confintmatrix

##             confintlow confintupper
## (Intercept) 2618.67085   2897.76272
## age          -43.60353    -37.42174

Επίσης μπορούμε να δούμε τα p-values των ελέγχων \(H_0: \beta=0,\ H_1: \beta \neq 0\) για τα \(\beta_0, \beta_1\) :

pvals=betamatrix[,4]
pvals

##  (Intercept)          age 
## 1.013798e-61 8.721476e-46

Κυρίως μας ενδιαφέρει ο έλεγχος για την κλίση \(\beta_1\), για τον οποίο το p-value είναι σχεδόν μηδέν (\(\approx 10^{-45})\)), που σημαίνει ότι η συσχέτιση μεταξύ ηλικίας και σκορ είναι στατιστικά σημαντική σε οποιοδήποτε πρακατικά επίπεδο σημαντικότητας.