Downloading data from the website. The download command downloads data in the working directory.
Data are downloaded, loaded, and names of fields are read from the file:
setInternet2(TRUE) # solution for https files
download.file("https://sites.google.com/site/statsr4us/intro/software/rcmdr-1/TeachingRatings.rda", "TeachingRatings.rda")
load("TeachingRatings.rda")
setwd("C:/Users/Murtaza/Google Drive/AEBE/Data/ch.04/R_ch04")
names(TeachingRatings)
## [1] "minority" "age" "gender" "credits" "beauty"
## [6] "eval" "division" "native" "tenure" "students"
## [11] "allstudents" "prof"
Loading required packages and attaching the data set.
library(xtable)
## Warning: package 'xtable' was built under R version 3.1.3
library(psych)
## Warning: package 'psych' was built under R version 3.1.3
library(htmlTable)
## Warning: package 'htmlTable' was built under R version 3.1.3
attach(TeachingRatings)
TAble 4-18
tab <- xtable(describe(cbind(age, beauty, eval, students, allstudents),
skew=F, ranges=T))
print(tab, type="html")
vars | n | mean | sd | median | trimmed | mad | min | max | range | se | |
---|---|---|---|---|---|---|---|---|---|---|---|
age | 1 | 463.00 | 48.37 | 9.80 | 48.00 | 48.35 | 11.86 | 29.00 | 73.00 | 44.00 | 0.46 |
beauty | 2 | 463.00 | 0.00 | 0.79 | -0.07 | -0.05 | 0.87 | -1.45 | 1.97 | 3.42 | 0.04 |
eval | 3 | 463.00 | 4.00 | 0.55 | 4.00 | 4.03 | 0.59 | 2.10 | 5.00 | 2.90 | 0.03 |
students | 4 | 463.00 | 36.62 | 45.02 | 23.00 | 27.54 | 14.83 | 5.00 | 380.00 | 375.00 | 2.09 |
allstudents | 5 | 463.00 | 55.18 | 75.07 | 29.00 | 38.66 | 19.27 | 8.00 | 581.00 | 573.00 | 3.49 |
Subset data by professors
Professor specific variables:
Identifying duplicates for subsetting
profs <- subset(TeachingRatings, !duplicated(TeachingRatings$prof))
attach(profs)
Descriptive statistics
Table 4-19
tab <- xtable(describe(cbind(age, beauty), skew=F, ranges=F))
print(tab, type="html")
vars | n | mean | sd | se | |
---|---|---|---|---|---|
age | 1 | 94.00 | 47.55 | 10.26 | 1.06 |
beauty | 2 | 94.00 | 0.09 | 0.83 | 0.09 |
Evaluation Factors:
attach(TeachingRatings)
psych package
Table 4-20
tab <- xtable(describeBy(eval, gender, mat=T, skew=F, ranges=T))
print(tab, type="html")
item | group1 | vars | n | mean | sd | median | trimmed | mad | min | max | range | se | |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|
11 | 1 | male | 1.00 | 268.00 | 4.07 | 0.56 | 4.15 | 4.10 | 0.52 | 2.10 | 5.00 | 2.90 | 0.03 |
12 | 2 | female | 1.00 | 195.00 | 3.90 | 0.54 | 3.90 | 3.92 | 0.59 | 2.30 | 4.90 | 2.60 | 0.04 |
tab<-xtable(cbind("Teaching Evaluations"=tapply(eval, gender, mean)))
print(tab, type="html")
Teaching Evaluations | |
---|---|
male | 4.07 |
female | 3.90 |
Table 4-21
tab<-cbind("Teaching Evaluations"=tapply(eval, tenure, mean))
htmlTable(txtRound(tab,2),rowlabel = "Tenure status")
Tenure status | Teaching Evaluations |
---|---|
no | 4.13 |
yes | 3.96 |
tab<-xtable(cbind("Teaching Evaluations"=tapply(eval, tenure, mean)))
print(tab, type="html")
Teaching Evaluations | |
---|---|
no | 4.13 |
yes | 3.96 |
Table 4-22
tab<-cbind("Teaching Evaluation"=tapply(eval, list(tenure, gender), mean))
htmlTable(txtRound(tab,2),
cgroup = c("Gender"), n.cgroup = c(2),
rowlabel = "Tenure Status")
Gender | ||
---|---|---|
Tenure Status | male | female |
no | 4.40 | 3.86 |
yes | 3.99 | 3.92 |
Table 4-23 and 4-24
f <- function(x) c(obs=length(x), mean=mean(x), sd=sd(x))
tres<-as.matrix(aggregate(eval ~ gender+tenure, FUN=c("f")))
htmlTable(txtRound(tres,0,excl.cols = c(1,2,4,5)))
gender | tenure | eval.obs | eval.mean | eval.sd |
---|---|---|---|---|
male | no | 52 | 4.3961538 | 0.5048632 |
female | no | 50 | 3.8600000 | 0.4733726 |
male | yes | 216 | 3.9902778 | 0.5405836 |
female | yes | 145 | 3.9151724 | 0.5604228 |
colnames(tres)[3:5]<-c("n", "mean", "std. dev.")
htmlTable(txtRound(tres,0,excl.cols = c(1,2,4,5)))
gender | tenure | n | mean | std. dev. |
---|---|---|---|---|
male | no | 52 | 4.3961538 | 0.5048632 |
female | no | 50 | 3.8600000 | 0.4733726 |
male | yes | 216 | 3.9902778 | 0.5405836 |
female | yes | 145 | 3.9151724 | 0.5604228 |
Table 4-25
f <- function(x) c(obs=length(x), mean=mean(x), sd=sd(x))
tres<-as.matrix(aggregate(eval ~ gender+tenure+minority, FUN=c("f")))
colnames(tres)[4:6]<-c("n", "mean", "std. dev.")
htmlTable(txtRound(tres,0,excl.cols = c(1,2,3,5,6)))
gender | tenure | minority | n | mean | std. dev. |
---|---|---|---|---|---|
male | no | no | 42 | 4.3047619 | 0.5174762 |
female | no | no | 50 | 3.8600000 | 0.4733726 |
male | yes | no | 198 | 4.0156566 | 0.5394181 |
female | yes | no | 109 | 3.9743119 | 0.5644407 |
male | no | yes | 10 | 4.7800000 | 0.1475730 |
male | yes | yes | 18 | 3.7111111 | 0.4837220 |
female | yes | yes | 36 | 3.7361111 | 0.5150050 |
Summarising eval and beauty by gender
Table 4-26
f <- function(x) c(obs=length(x), mean=mean(x), sd=sd(x))
tres<-t(as.matrix(aggregate(cbind(eval, beauty) ~ gender, FUN=c("f"))))
rownames(tres)[2:7]<-c("n", "mean", "std. dev.", "n", "mean", "std. dev.")
htmlTable(txtRound(tres,0, excl.rows = c(3,4,6,7)),
rgroup=c("","evaluation score","beauty score"),
n.rgroup = c(1,3,3))
gender | male | female |
evaluation score | ||
n | 268 | 195 |
mean | 4.0690299 | 3.9010256 |
std. dev. | 0.5566518 | 0.5388026 |
beauty score | ||
n | 268 | 195 |
mean | -0.08448224 | 0.11610907 |
std. dev. | 0.75712993 | 0.81780964 |
tab<-xtable(cbind("Teaching Evaluation"=tapply(eval, minority, mean)))
print(tab, type="html")
Teaching Evaluation | |
---|---|
no | 4.02 |
yes | 3.89 |
tab<-xtable(cbind("Teaching Evaluation"=tapply(eval, native, mean)))
print(tab, type="html")
Teaching Evaluation | |
---|---|
yes | 4.02 |
no | 3.69 |
..
Table 4-27
myvars<- c("eval", "beauty", "age", "students", "allstudents")
x <- TeachingRatings[myvars]
tab <-xtable(cor(x), digits=3)
print(tab, type="html")
eval | beauty | age | students | allstudents | |
---|---|---|---|---|---|
eval | 1.000 | 0.189 | -0.052 | 0.035 | -0.001 |
beauty | 0.189 | 1.000 | -0.298 | 0.131 | 0.100 |
age | -0.052 | -0.298 | 1.000 | -0.030 | -0.013 |
students | 0.035 | 0.131 | -0.030 | 1.000 | 0.972 |
allstudents | -0.001 | 0.100 | -0.013 | 0.972 | 1.000 |
Generate SD Function
my.wsd<- function(w, x, wx, n) sqrt(sum(w*(x-wx)^2)/((n-1)*sum(w)/n))
Generate Percent evaluating
TeachingRatings$p.eval <- students/allstudents*100
All Results
attach(TeachingRatings)
wm.course <-weighted.mean(eval,students); wm.course
## [1] 4.02241
wsd.course<-my.wsd(students,eval, wm.course, length(eval)) ; wsd.course
## [1] 0.5249643
m.studs <- mean(allstudents); sd.studs <-sd(allstudents); m.studs
## [1] 55.17711
m.peval <-mean(p.eval); m.peval
## [1] 74.42779
tabgen<-xtabs(students~gender)/sum(students); tabgen
## gender
## male female
## 0.6406204 0.3593796
tabmin<-xtabs(students~minority)/sum(students); tabmin
## minority
## no yes
## 0.90127971 0.09872029
tabeng<-xtabs(students~native)/sum(students); tabeng
## native
## yes no
## 0.96343693 0.03656307
tabten<-xtabs(students~tenure)/sum(students); tabten
## tenure
## no yes
## 0.149024 0.850976
tabdiv<-table(division)/sum(table(division)); tabdiv
## division
## upper lower
## 0.6609071 0.3390929
tabmin<-xtabs(students~minority)/sum(students); tabmin
## minority
## no yes
## 0.90127971 0.09872029
courses <- length(eval); courses
## [1] 463
faculty <- length(unique(prof)); faculty
## [1] 94
all.res<- rbind(wm.course, wsd.course, m.studs, sd.studs, m.peval, female=tabgen[2],
minority=tabmin[2], 'native english' =tabeng[2], tenure = tabten[2],
"lower division" = tabdiv[2], courses, faculty); all.res
## female
## wm.course 4.02240962
## wsd.course 0.52496430
## m.studs 55.17710583
## sd.studs 75.07279984
## m.peval 74.42778824
## female 0.35937961
## minority 0.09872029
## native english 0.03656307
## tenure 0.85097600
## lower division 0.33909287
## courses 463.00000000
## faculty 94.00000000
colnames(all.res) <- "all courses"; all.res
## all courses
## wm.course 4.02240962
## wsd.course 0.52496430
## m.studs 55.17710583
## sd.studs 75.07279984
## m.peval 74.42778824
## female 0.35937961
## minority 0.09872029
## native english 0.03656307
## tenure 0.85097600
## lower division 0.33909287
## courses 463.00000000
## faculty 94.00000000
Subset Lower
lower <- subset(TeachingRatings, subset=division =="lower")
attach(lower)
wm.course <-weighted.mean(eval,students); wm.course
## [1] 4.060476
wsd.course<-my.wsd(students,eval, wm.course, length(eval)) ; wsd.course
## [1] 0.5634478
m.studs <- mean(allstudents); sd.studs <-sd(allstudents); m.studs
## [1] 76.50318
m.peval <-mean(p.eval); m.peval
## [1] 73.52339
tabgen<-xtabs(students~gender)/sum(students); tabgen
## gender
## male female
## 0.6995807 0.3004193
tabmin<-xtabs(students~minority)/sum(students); tabmin
## minority
## no yes
## 0.8904369 0.1095631
tabeng<-xtabs(students~native)/sum(students); tabeng
## native
## yes no
## 0.993236846 0.006763154
tabten<-xtabs(students~tenure)/sum(students); tabten
## tenure
## no yes
## 0.1719194 0.8280806
tabdiv<-table(division)/sum(table(division)); tabdiv
## division
## upper lower
## 0 1
tabmin<-xtabs(students~minority)/sum(students); tabmin
## minority
## no yes
## 0.8904369 0.1095631
courses <- length(eval); courses
## [1] 157
faculty <- length(unique(prof)); faculty
## [1] 42
lower.res<-rbind(wm.course, wsd.course, m.studs, sd.studs, m.peval, female=tabgen[2],
minority=tabmin[2], 'native english' =tabeng[2], tenure = tabten[2],
"lower division" = tabdiv[2], courses, faculty); lower.res
## female
## wm.course 4.060476e+00
## wsd.course 5.634478e-01
## m.studs 7.650318e+01
## sd.studs 1.092869e+02
## m.peval 7.352339e+01
## female 3.004193e-01
## minority 1.095631e-01
## native english 6.763154e-03
## tenure 8.280806e-01
## lower division 1.000000e+00
## courses 1.570000e+02
## faculty 4.200000e+01
colnames(lower.res) <- "lower division"; lower.res
## lower division
## wm.course 4.060476e+00
## wsd.course 5.634478e-01
## m.studs 7.650318e+01
## sd.studs 1.092869e+02
## m.peval 7.352339e+01
## female 3.004193e-01
## minority 1.095631e-01
## native english 6.763154e-03
## tenure 8.280806e-01
## lower division 1.000000e+00
## courses 1.570000e+02
## faculty 4.200000e+01
Subset Upper
upper <- subset(TeachingRatings, subset=division =="upper")
attach(upper)
wm.course <-weighted.mean(eval,students); wm.course
## [1] 3.992984
wsd.course<-my.wsd(students,eval, wm.course, length(eval)) ; wsd.course
## [1] 0.4924672
m.studs <- mean(allstudents); sd.studs <-sd(allstudents); m.studs
## [1] 44.23529
m.peval <-mean(p.eval); m.peval
## [1] 74.89181
tabgen<-xtabs(students~gender)/sum(students); tabgen
## gender
## male female
## 0.5950439 0.4049561
tabmin<-xtabs(students~minority)/sum(students); tabmin
## minority
## no yes
## 0.90966123 0.09033877
tabeng<-xtabs(students~native)/sum(students); tabeng
## native
## yes no
## 0.94040151 0.05959849
tabten<-xtabs(students~tenure)/sum(students); tabten
## tenure
## no yes
## 0.1313258 0.8686742
tabdiv<-table(division)/sum(table(division)); tabdiv
## division
## upper lower
## 1 0
tabmin<-xtabs(students~minority)/sum(students); tabmin
## minority
## no yes
## 0.90966123 0.09033877
courses <- length(eval); courses
## [1] 306
faculty <- length(unique(prof)); faculty
## [1] 79
upper.res<-rbind(wm.course, wsd.course, m.studs, sd.studs, m.peval, female=tabgen[2],
minority=tabmin[2], 'native english' =tabeng[2], tenure = tabten[2],
"lower division" = tabdiv[2], courses, faculty);upper.res
## female
## wm.course 3.99298411
## wsd.course 0.49246723
## m.studs 44.23529412
## sd.studs 45.54050832
## m.peval 74.89181028
## female 0.40495609
## minority 0.09033877
## native english 0.05959849
## tenure 0.86867419
## lower division 0.00000000
## courses 306.00000000
## faculty 79.00000000
colnames(upper.res) <- "upper division" ; upper.res
## upper division
## wm.course 3.99298411
## wsd.course 0.49246723
## m.studs 44.23529412
## sd.studs 45.54050832
## m.peval 74.89181028
## female 0.40495609
## minority 0.09033877
## native english 0.05959849
## tenure 0.86867419
## lower division 0.00000000
## courses 306.00000000
## faculty 79.00000000
Final Table
tab <-xtable(cbind(all.res, lower.res, upper.res), digits=3)
print(tab, type="html")
all courses | lower division | upper division | |
---|---|---|---|
wm.course | 4.022 | 4.060 | 3.993 |
wsd.course | 0.525 | 0.563 | 0.492 |
m.studs | 55.177 | 76.503 | 44.235 |
sd.studs | 75.073 | 109.287 | 45.541 |
m.peval | 74.428 | 73.523 | 74.892 |
female | 0.359 | 0.300 | 0.405 |
minority | 0.099 | 0.110 | 0.090 |
native english | 0.037 | 0.007 | 0.060 |
tenure | 0.851 | 0.828 | 0.869 |
lower division | 0.339 | 1.000 | 0.000 |
courses | 463.000 | 157.000 | 306.000 |
faculty | 94.000 | 42.000 | 79.000 |