2020-03-30-Homework-3

Q1：找出三種職業類型的中位數

載入、瀏覽資料

library(carData)
dta <- carData::Prestige
str(dta)

## 'data.frame':    102 obs. of  6 variables:
##  $ education: num  13.1 12.3 12.8 11.4 14.6 ...
##  $ income   : int  12351 25879 9271 8865 8403 11030 8258 14163 11377 11023 ...
##  $ women    : num  11.16 4.02 15.7 9.11 11.68 ...
##  $ prestige : num  68.8 69.1 63.4 56.8 73.5 77.6 72.6 78.1 73.1 68.8 ...
##  $ census   : int  1113 1130 1171 1175 2111 2113 2133 2141 2143 2153 ...
##  $ type     : Factor w/ 3 levels "bc","prof","wc": 2 2 2 2 2 2 2 2 2 2 ...

找出中位數

aggregate(prestige ~ type, data=dta, FUN=median)

##   type prestige
## 1   bc     35.9
## 2 prof     68.4
## 3   wc     41.5

Q2：職業類型Income & Education的關係

切割出職業類型為bc的資料

dta.bc <- subset(dta, dta$type=="bc")

依照prestige的中位數分為“Low”, “High”

quantile(dta.bc$prestige, probs=seq(from=0, to=1, by=.1))

##    0%   10%   20%   30%   40%   50%   60%   70%   80%   90%  100% 
## 17.30 22.01 25.74 28.74 34.82 35.90 37.92 41.84 43.58 50.27 54.90

level.bc <- with(dta.bc, cut(prestige, ordered=T, breaks=c(0, 36, 100), labels=c("Low", "High")))

Relationship between income and education for “bc”

bc <- cbind(dta.bc, level.bc)
bc.1 <- split(bc, bc$level.bc)
lapply((bc.1), function(x) coef(lm(x$income ~ x$ education)))

## $Low
## (Intercept) x$education 
##   3399.4175     87.3788 
## 
## $High
## (Intercept) x$education 
##   1870.5507    564.2745

library(lattice)
xyplot(income ~ education, groups=level.bc, data=bc, type=c("p","g","r"), auto.key=list(columns=2))

切割出職業類型為prof的資料

dta.prof <- subset(dta, dta$type=="prof")

依照prestige的中位數分為“Low”, “High”

quantile(dta.prof$prestige, probs=seq(from=0, to=1, by=.1))

##   0%  10%  20%  30%  40%  50%  60%  70%  80%  90% 100% 
## 53.8 57.2 59.6 62.2 66.1 68.4 69.1 72.6 73.5 78.1 87.2

level.prof <- with(dta.prof, cut(prestige, ordered=T, breaks=c(0, 68, 100), labels=c("Low", "High")))

Relationship between income and education for “prof”

prof <- cbind(dta.prof, level.prof)
prof.1 <- split(prof, prof$level.prof)
lapply((prof.1), function(x) coef(lm(x$income ~ x$ education)))

## $Low
## (Intercept) x$education 
##    36.69381   607.11066 
## 
## $High
##  (Intercept)  x$education 
## 12807.634864    -1.164548

library(lattice)
xyplot(income ~ education, groups=level.prof, data=prof, type=c("p","g","r"), auto.key=list(columns=2))

切割出職業類型為wc的資料

dta.wc <- subset(dta, dta$type=="wc")

依照prestige的中位數分為“Low”, “High”

quantile(dta.wc$prestige, probs=seq(from=0, to=1, by=.1))

##    0%   10%   20%   30%   40%   50%   60%   70%   80%   90%  100% 
## 26.50 31.26 35.64 36.76 38.58 41.50 43.04 47.18 48.72 51.10 67.50

level.wc <- with(dta.wc, cut(prestige, ordered=T, breaks=c(0, 42, 100), labels=c("Low", "High")))

Relationship between income and education for “wc”

wc <- cbind(dta.wc, level.wc)
wc.1 <- split(wc, wc$level.wc)
lapply((wc.1), function(x) coef(lm(x$income ~ x$ education)))

## $Low
## (Intercept) x$education 
##   7812.3227   -299.4227 
## 
## $High
## (Intercept) x$education 
##  -3660.2745    803.7285

library(lattice)
xyplot(income ~ education, groups=level.wc, data=wc, type=c("p","g","r"), auto.key=list(columns=2))