Replication code for "Public trust in the Supreme Court of the United Kingdom"

uksc_support.R

## ----Setup, include=FALSE, results="hide", warning=FALSE-----------------
## This chunk is for setting nice options for the output. Notice how
## we create both png and pdf files by default, so that we can easily process
## to both HTML and LaTeX/PDF files later.
opts_chunk$set(fig.path='figures/paper-', cache.path='cache/report-', dev=c("png","pdf"), fig.width=14, fig.height=7, fig.show='hold', fig.lp="fig:", cache=FALSE, par=TRUE, echo=FALSE, results="hide", message=FALSE, warning=FALSE, dpi=300)
knit_hooks$set(par=function(before, options, envir){
if (before && options$fig.show!='none') par(mar=c(4,4,.1,.1),cex.lab=.95,cex.axis=.9,mgp=c(2,.7,0),tcl=-.3)
}, crop=hook_pdfcrop) 


## ----loadlibs, include = FALSE, echo = FALSE, results = "hide", warning = FALSE, message = FALSE----
library(MASS)
library(foreign)
library(arm)
library(ltm)
library(mi)
library(stargazer)
library(car)


## ----loaddata, echo = FALSE, results = "hide", warning = FALSE, message = FALSE----
data.locn <- "../dec12spb.dta"
if(!file.exists(data.locn)) {
	bes.url <- "http://www.bes2009-10.org/cms-data/dec12spb.dta"
	download.file(bes.url,destfile = data.locn)
}
dat <- read.dta(data.locn)


## ----recodes, echo = FALSE, results = "hide", warning = FALSE, message = FALSE----
dat$trustUKSC <- as.numeric(gsub("\\D","",dat$q1107))

dat$familiarUKSC <- factor(dat$q1102,
	levels = c("have never heard of this court",
		"not very familiar",
		"somewhat familiar",
		"very familiar"),
	ordered = FALSE)
dat$familiarUKSC <- relevel(dat$familiarUKSC, "not very familiar")

### Should the court be 'supreme'
likerts <- c("strongly agree","agree","neither agree nor disagree",
		"disagree","strongly disagree")

dat$supremacyUKSC <- factor(dat$q1106,
	levels = rev(likerts),
	ordered = TRUE)

### Court abolition?
dat$abolishUKSC <- factor(dat$q1104,
	levels = likerts,
	ordered = TRUE)

low.knowledge.cor <- cor(sapply(dat[!is.element(dat$familiarUKSC,c("very familiar")),c("trustUKSC","supremacyUKSC","abolishUKSC")],as.numeric),
	method = "spearman",
	use= "pairwise")

high.knowledge.cor <- cor(sapply(dat[dat$familiarUKSC %in% c("very familiar"),c("trustUKSC","supremacyUKSC","abolishUKSC")],as.numeric),
	method = "spearman",
	use= "pairwise")

tmp <- dat[,c("trustUKSC","supremacyUKSC","abolishUKSC")]
tmp <- tmp[complete.cases(tmp),]
my.cronbach <- cronbach.alpha(tmp)
rm(tmp)

### generalized trust: simple average of q246 and q247 (trust parties, trust politicians
### These must be converted
dat$q246 <- as.numeric(gsub("\\D","",dat$q246))
dat$q247 <- as.numeric(gsub("\\D","",dat$q247))

dat$generalizedTrust <- rowMeans(dat[,c("q246","q247")],na.rm = TRUE)

### Interpersonal trust
dat$interpersonalTrust <- as.numeric(gsub("\\D","",dat$q37))

### left-right position
lr.qns <- c("q1080","q1081","q1082","q1083")
for (q in lr.qns) {
	dat[,q] <- factor(dat[,q],
		levels = likerts,
		ordered = TRUE)
}
grm.mod <- grm(dat[,lr.qns],
	IRT.param = TRUE)
grm.scores <- factor.scores(grm.mod, resp.patterns = dat[,lr.qns])
dat$leftRight <- grm.scores$score.dat$z1
dat$leftRight.raw <- rowMeans(sapply(dat[,lr.qns],as.numeric),na.rm = TRUE)
the.cor <- cor(dat$leftRight,dat$leftRight.raw,use="pairwise")
if (sign(the.cor) < 0) {
	dat$leftRight <- dat$leftRight * -1
}

dat$q32 <- car:::recode(dat$q32, "'british national party (bnp)'='other party'")
dat$partyID <- factor(dat$q32,
	levels = c("conservative",
		"labour",
		"liberal democrat",
		"plaid cymru",
		"scottish nationalist",
		"green",
		"united kingdom independence party (ukip)",
		"other party",
		"No party"),
	ordered = FALSE)
dat$partyID[is.na(dat$partyID)] <- "No party"
dat$partyID <- relevel(dat$partyID, "No party")

### Controls
dat$region <- factor(as.character(dat$q1))
dat$country <- car:::recode(dat$q1, "'scotland'='Scotland';'wales'='Wales';else='England'")
dat$country <- factor(dat$country)
dat$country <- relevel(dat$country, "England")

dat$q112 <- car:::recode(dat$q112,"c('14 or under','15')='Before 16'")
dat$Education <- factor(as.character(dat$q112))
dat$Education <- relevel(dat$Education,"16")



## ----histtrust, fig = TRUE, fig.cap = "Trust in the UKSC"----------------
## Not quite sure why this was getting eaten in the knitting
pdf(file="figures/paper-histtrust.pdf", width = 7, height = 4)
hist(dat$trustUKSC,
	xlab = "Trust in UKSC (0-10 scale)",
	ylab = "Number of respondents",
	col = "black",
	main = "",
	cex = 1.5,
	border = "white")
dev.off()


## ----familiaritycounts, echo = FALSE, results = "hide", message = FALSE, warning = FALSE, eval = TRUE----
noknowledge <- (is.na(dat$familiarUKSC)|(dat$familiarUKSC=="have never heard of this court"))
hastrust <- !is.na(dat$trustUKSC)
trustwoknowledge <- length(which(noknowledge & hastrust))


## ----mi, echo = FALSE, results = "hide", message = FALSE, warning = FALSE, eval = TRUE, cache = TRUE----
my.vars <- c("trustUKSC","supremacyUKSC","abolishUKSC",
	"generalizedTrust","interpersonalTrust",
	"leftRight","leftRight.raw","familiarUKSC","partyID",
	"country","Education")

dat.bak <- dat
dat <- dat[,my.vars]

inf <- mi.info(dat)
inf <- update(inf, "type", list("trustUKSC" = "ordered-categorical",
	"familiarUKSC" = "unordered-categorical"))

set.seed(1982)
IMP <- mi(dat, info=inf,n.imp = 5)


## ----bivariateplots, echo = FALSE, fig = TRUE, fig.cap = "Bivariate scatterplots", dpi = 300, echo = FALSE, eval = FALSE----
## cor1 <- cor(dat$generalizedTrust, dat$trustUKSC,
## 	method = "spearman",
## 	use = "pairwise")
## cor2 <- cor(dat$interpersonalTrust, dat$trustUKSC,
## 	method = "spearman",
## 	use = "pairwise")
## cor1 <- round(cor1,2)
## cor2 <- round(cor2,2)
## main1 <- paste0("Spearman's ",expression(r),"=",cor1)
## main2 <- paste0("Spearman's ",expression(r),"=",cor2)
## 
## par(mfrow = c(1,2))
## plot(jitter(dat$generalizedTrust), jitter(dat$trustUKSC),
## 	pch = 19,
## 	col = "#99999999",
## 	xlab = "Trust in institutions",
## 	ylab = "Trust in UKSC",
## 	main = main1)
## plot(jitter(dat$interpersonalTrust), jitter(dat$trustUKSC),
## 	pch = 19,
## 	col = "#99999999",
## 	xlab = "Trust in other persons",
## 	ylab = "Trust in UKSC",
## 	main = main2)


## ----modelling, echo = FALSE, results = "hide", message = FALSE, warning = FALSE, eval = TRUE----
basic.formula <- formula(trustUKSC ~ generalizedTrust + interpersonalTrust + 
	familiarUKSC + Education + 
	partyID + leftRight.raw + I(leftRight.raw^2) + 
	country)

milmmod <- lm.mi(basic.formula, 	IMP)

milmmod2 <- lm.mi(update(basic.formula,.~.-I(leftRight.raw^2)), 	IMP)

mipolrmod <- polr.mi(update(basic.formula, factor(trustUKSC)~.),	IMP)

mipolrmod.abolish <- polr.mi(update(basic.formula, factor(abolishUKSC)~.),	IMP)
mipolrmod.supremacy <- polr.mi(update(basic.formula, factor(supremacyUKSC)~.),	IMP)


## ----modelout, echo = FALSE, results = 'asis', message = FALSE, warning = FALSE, eval = TRUE----
### 
lmmod <- lm(basic.formula, 
	data = mi.data.frame(IMP, m = 1))
polrmod <- polr(update(basic.formula, factor(trustUKSC)~.), 
	data = mi.data.frame(IMP, m = 1))

pretty.covars <- c("Institutional trust","Interpersonal trust",
		"Have never heard of UKSC","Somewhat familiar with UKSC","Very familiar with UKSC",
		"Left education at 17/18","Left education at 19/20",
		"Left education 21 or over","Left school before 16",
		"Party ID: Conservative","Party ID: Labour","Party ID: Liberal Democrat",
		"Party ID: Plaid Cymru","Party ID: SNP","Party ID: Green","Party ID: UKIP",
		"Party ID: Other party",
		"Left-right position","Left-right position squared",
		"Scottish respondent","Welsh respondent")

stargazer(polrmod, lmmod,
	covariate.labels = pretty.covars,
	#covariate.labels = car:::recode(names(coef(mipolrmod))[1:21],coef.recode.list),
	single.row = FALSE,
	no.space = TRUE,
	intercept.top = FALSE, intercept.bottom = TRUE,
	coef = list(coef(mipolrmod),coef(milmmod)),
	se = list(se.coef(mipolrmod),se.coef(milmmod)),
	star.cutoffs = c(0.05,0.01,0.001),
	font.size = "scriptsize",
	dep.var.labels = c("Trust in UKSC","Trust in UKSC"),
	header = FALSE)