Created
November 4, 2013 18:33
-
-
Save chrishanretty/7307151 to your computer and use it in GitHub Desktop.
R/Sweave code for a talk on the termination of Irish government agencies
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| \documentclass[14pt]{beamer} | |
| \usetheme{default} | |
| \usefonttheme{professionalfonts} | |
| \usepackage[lm-default]{fontspec} % remove font-spec if maths are required | |
| \setmainfont[Mapping=tex-text]{Fontin Regular} | |
| \setsansfont[Mapping=tex-text]{Museo Sans 300} % Beamer uses sans-serif by default | |
| \setbeamersize{text margin left=.5cm} | |
| \setbeamersize{text margin right=.5cm} | |
| \setbeamertemplate{headline}[authortitle]{}% | |
| \setbeamertemplate{navigation symbols}{} %gets rid of navigation symbols | |
| \setbeamertemplate{footline}[page number]{} %gets rid of bottom navigation bars | |
| \usepackage[noae]{Sweave} | |
| \usepackage{soul} | |
| \usepackage{natbib} | |
| \usepackage{dcolumn} | |
| \usepackage{booktabs} | |
| \setbeamertemplate{theorems}[numbered] | |
| \newtheorem{hyp}{Hypothesis} | |
| \setbeamertemplate{itemize items}[circle] | |
| \setbeamercolor{titlelike}{fg=black} | |
| \setbeamercolor{item}{fg=black} | |
| \setbeamerfont{title}{size=\Huge} | |
| %% All following colours are colorbrewer colours | |
| \definecolor{color0}{RGB}{228,26,28} | |
| \definecolor{color1}{RGB}{55,126,184} | |
| \definecolor{color2}{RGB}{77,175,74} | |
| \definecolor{color3}{RGB}{152,78,163} | |
| \definecolor{color4}{RGB}{255,127,0} | |
| \definecolor{color5}{RGB}{247,129,191} | |
| \definecolor{color6}{RGB}{0,0,0} | |
| \definecolor{color7}{RGB}{255,255,51} | |
| \makeatletter | |
| \def\sectioncolor{color0}% color to be applied to section headers | |
| \AtBeginSection[] | |
| { | |
| % Each \section redefines \sectioncolor and applies the shading with this color | |
| % add as many colors as you need | |
| \renewcommand\sectioncolor{% | |
| \ifcase\value{section} color0\or color1\or color2\or color3\or color4\or color5\else color6\fi} | |
| { | |
| \setbeamercolor{background canvas}{bg=\sectioncolor,fg=\sectioncolor} | |
| \begin{frame}[c] | |
| \frametitle{~} | |
| {\color{white}\fontspec{Museo Slab}\large{\#{}\thesection{}:}\\ \Huge{\insertsection}} | |
| \end{frame} | |
| } | |
| } | |
| \setbeamertemplate{frametitle}{ | |
| \vspace{1cm} | |
| \begin{centering} | |
| {\Large \textbf{\textmd{\insertframetitle}}} | |
| \par | |
| \end{centering} | |
| } | |
| \renewcommand{\baselinestretch}{.9} | |
| \usepackage[english]{babel} | |
| \title{\fontspec{Museo Slab}A dual process theory of agency termination} | |
| \author{Chris Hanretty} | |
| \institute{University of East Anglia} | |
| \date{\today} | |
| \date{7th November 2013} | |
| \begin{document} | |
| <<loadlibs,echo=FALSE,results=hide>>= | |
| library(plyr) | |
| library(survival) | |
| library(zoo) | |
| library(ggplot2) | |
| library(stargazer) | |
| library(reshape) | |
| @ | |
| <<loaddata,echo=FALSE,results=hide>>= | |
| ### Also available at https://drive.google.com/file/d/0B1LkeTCb2GrxSGcwaFNvamtZaWc/edit?usp=sharing | |
| dat <- read.csv("../view_quarterly.csv",header=T) | |
| ### Remove one from density | |
| dat$density.cofog <- dat$density.cofog - 1 | |
| @ | |
| \frame{\titlepage} | |
| \frame{ | |
| \frametitle{Reasons to care about termination} | |
| \small | |
| \begin{center} | |
| \begin{tabular}{p{5cm}p{5cm}} \toprule | |
| \multicolumn{1}{c}{\textbf{Me}} & \multicolumn{1}{c}{\textbf{You}} \\ \midrule | |
| \alert<2>{Concern over independence} \citep{hanretty2012measuring,hanretty2012shall} & \alert<4>{Interest in power} \\ | |
| \alert<3>{Previous paper on termination in UK} \citep{greasley2012culling} & \alert<5>{Government effectiveness} \\ | |
| & \alert<6>{Credibility issues} \\ \bottomrule | |
| \end{tabular} | |
| \end{center} | |
| } | |
| \frame{ | |
| \includegraphics[width=\textwidth]{andreas} % see also Greg Barker | |
| } | |
| \frame{\tableofcontents} | |
| \section{Existing work} | |
| \frame{ | |
| \frametitle{The American literature} | |
| \begin{itemize}[<alert@+>] | |
| \item \citet{kaufman1976government}: are agencies immortal? | |
| \item Challenged by \citet{peters1988death} and \citet{lewis2002politics} | |
| \item Aim: statistical testing of hypothesis concerning survival of federal agencies | |
| \item Features: | |
| \begin{itemize} | |
| \item Rock-solid operationalization | |
| \item Technically sophisticated analysis (esp. \citet{carpenter2004political}) | |
| \item Decreasing marginal returns? (cf. \citet{berry2010after}) | |
| \end{itemize} | |
| \end{itemize} | |
| } | |
| \frame{ | |
| \frametitle{The European literature} | |
| \begin{itemize}[<alert@+>] | |
| \item \citet{hood1981axeman}, ``Axeman spare that quango!'' | |
| \item Norwegian, Irish and Flemish State Administration Databases | |
| \item Aim: careful description of organisational transformation | |
| \item Features: | |
| \begin{itemize} | |
| \item Occasional periodicisation rather than hypothesis testing | |
| \item Conceptual finesse (23 organisational events!) | |
| \end{itemize} | |
| \end{itemize} | |
| } | |
| \frame{ | |
| \frametitle{Shoes that haven't dropped} | |
| \begin{itemize}[<alert@+>] | |
| \item Work on international organisations \citep{shanks1996inertia} | |
| \item Work on non-European, non-US cases \citep{park2013causes} | |
| \item Organizational ecology \citep{peters1991applying} | |
| \end{itemize} | |
| } | |
| \section{The two processes} | |
| \frame<1>[label=twoprocesses]{ | |
| \frametitle{The two processes} | |
| \begin{center} | |
| \footnotesize | |
| \begin{tabular}{p{.48\textwidth}p{.48\textwidth}} \toprule | |
| \textbf{Process 1} & \textbf{Process 2} \\ \midrule | |
| \alert<2>{The agent is a representative politician amongst others similarly situated} & \alert<2>{The agent is a politician with special responsibility for groups of bodies} \\ | |
| \alert<3>{Agents maximise net benefit} & \alert<3>{Agents minimize costs myopically} \\ | |
| \alert<4>{Agents evaluate agencies considered individually}&\alert<4>{Agents evaluate agencies considered as an ensemble} \\ | |
| \alert<5>{Political differences are dispositive and positively signed}&\alert<5>{Political agreement is facultative and positively signed} \\ | |
| \alert<6>{The outcome is termination with or without replacement} & \alert<6>{The outcome is merging or absorption} \\ \bottomrule | |
| \end{tabular} | |
| \end{center} | |
| } | |
| \againframe<2>{twoprocesses} | |
| \frame{ | |
| \frametitle{Agents} | |
| \small | |
| \begin{quote} | |
| \textbf{[Process 1]} We model the choice of a representative politician as to when, if at all, to terminate an agency she has created. Our model describes the optimal choice patterns of an uncertain politician (or coalition of politicians) \citep{carpenter2004political} | |
| \end{quote} | |
| \begin{quote} | |
| \textbf{[Process 2]} party constellations in government are not being fully or clearly reflected in organizational change in the Norwegian state administration. This may be due to the importance of top civil servants and sector-specific ministries in the formulation and implementation of administrative reforms in recent decades \citep{rolland2012foundings} | |
| \end{quote} | |
| } | |
| \againframe<3>{twoprocesses} | |
| \frame{ | |
| \frametitle{Benefits \& Costs} | |
| \begin{quote} | |
| \textbf{[Process 1]} [S]hort term costs are attached to agency termination\ldots{} There can also be longer-term costs associated with efficiency losses depending upon new administrative arrangements'' \citep{carpenter2004political} | |
| \end{quote} | |
| \begin{quote} | |
| \textbf{[Process 2]} In most reconfigurations\ldots{} little time was left for the essential but longer-term issues\ldots{} [like] human resources, operations and finance \citep{white2010making} | |
| \end{quote} | |
| } | |
| \againframe<4>{twoprocesses} | |
| \frame{ | |
| \frametitle{Individuals versus ensembles} | |
| \begin{quote} | |
| \textbf{[Process 1]} ``One alternative explanation is that agencies are terminated as part of larger policy changes...'' \citep{carpenter2004political} but this is minimized as something to be controlled for | |
| \end{quote} | |
| \begin{quote} | |
| \textbf{[Process 2]} ``We will reduce the number and cost of quangos'' (Coalition Agreement, p. 16) | |
| \end{quote} | |
| } | |
| \againframe<5>{twoprocesses} | |
| \frame{ | |
| \frametitle{Politics} | |
| \begin{quote} | |
| Decisions on program curtailments should be especially amenable to rigorous, methodologically sound evaluations\ldots{} Yet these criteria are largely ignored in favor of political and ideological dictates \citep{deleon1983policy} | |
| \end{quote} | |
| \begin{itemize} | |
| \item Agencies established by left-wing coalitions face right-wing incumbents (an unfriendly majority) | |
| \end{itemize} | |
| } | |
| \againframe<6>{twoprocesses} | |
| \frame{ | |
| \frametitle{Outcomes} | |
| Compare to the program evaluation framework above with \ldots{} | |
| \begin{quote} | |
| ``Existing departments and boards were combined on an essentially ad-hoc basis, showing little creative concept of the role of the civil service in a newly independent small state'' \citep[105]{lee1989ireland} | |
| \end{quote} | |
| } | |
| \againframe<7>{twoprocesses} | |
| \section{Hypotheses} | |
| \frame{ | |
| \frametitle{The proper explanandum} | |
| \begin{table} | |
| % | |
| \begin{tabular}{p{4cm}p{4cm}} \toprule | |
| ISAD event & Recode \\ \midrule | |
| Replacement by new organization & Pure termination \\ | |
| Death & Pure termination \\ | |
| Absorption & Reshaping \\ | |
| Merger & Reshaping \\ \bottomrule | |
| \end{tabular} | |
| \end{table} | |
| } | |
| \frame{ | |
| \frametitle{Ordering the hypotheses} | |
| \begin{itemize}[<alert@+>] | |
| \item Hypotheses come in three groups: | |
| \begin{enumerate} | |
| \item Political | |
| \item Design | |
| \item Environmental | |
| \end{enumerate} | |
| \item Meta-hypothesis: pure termination responsive to political, design factors\ldots{} | |
| \item termination-through-reshaping responsive to design, environment factors | |
| \end{itemize} | |
| } | |
| \frame{ | |
| \frametitle{Political} | |
| \begin{tabular}{lcc} \toprule | |
| Variable & \multicolumn{1}{p{3cm}}{Effect, pure termination} & \multicolumn{1}{p{3cm}}{Effect, termination-through-reshaping} \\ \midrule | |
| Unfriendly govt. & \alert<2>{$\uparrow$} & \alert<6>{$\downarrow$} \\ | |
| Minority govt. & \alert<3>{$\downarrow$} & \textasciitilde \\ | |
| Election year & \alert<4>{$\uparrow$} &\textasciitilde \\ | |
| Fine Gael & \alert<5>{$\uparrow$} & \alert<7>{$\downarrow$} \\ \bottomrule | |
| \end{tabular} | |
| } | |
| \frame{ | |
| \frametitle{Design} | |
| \begin{tabular}{lcc} \toprule | |
| Variable & \multicolumn{1}{p{3cm}}{Effect, pure termination} & \multicolumn{1}{p{3cm}}{Effect, termination-through-reshaping} \\ \midrule | |
| Regulatory func. & \alert<2>{$\downarrow$} & \textasciitilde \\ | |
| Statutory est. & \alert<3>{$\downarrow$} & \alert<5>{$\downarrow$} \\ | |
| Company v. NDB & \alert<4>{$\downarrow$} & \textasciitilde \\ | |
| Exec agency v. NDB & \alert<4>{$\downarrow$} & \textasciitilde \\ | |
| \end{tabular} | |
| } | |
| \frame{ | |
| \frametitle{Environment} | |
| \begin{tabular}{lcc} \toprule | |
| Variable & \multicolumn{1}{p{3cm}}{Effect, pure termination} & \multicolumn{1}{p{3cm}}{Effect, termination-through-reshaping} \\ \midrule | |
| Govt. debt. & \alert<2>{$\downarrow$} & \alert<3>{$\uparrow$} \\ | |
| Agency density & \textasciitilde & \alert<4>{$\uparrow$} \\ | |
| \end{tabular} | |
| } | |
| \section{Testing the hypotheses} | |
| \frame{ | |
| \frametitle{What do we need?} | |
| \begin{itemize}[<alert@+>] | |
| \item A model for duration data | |
| \item A model with few assumptions (i.e., a non-parametric model) | |
| \item A model which permits time-varying covariates | |
| \item A model which allows competing risks (pure termination; reshaping) | |
| \item Two (independent) Cox proportional hazards models | |
| \end{itemize} | |
| } | |
| \frame{ | |
| \frametitle{What do we need? (2)} | |
| A data source: the Irish State Administration Database \citep{isad2013} \\ | |
| \vskip 2em | |
| Why Ireland? | |
| \begin{itemize}[<alert@+>] | |
| \item Pragmatic reason: data availability! | |
| \item Scope conditions satisfied | |
| \item Entire state history from 1922 onwards | |
| \end{itemize} | |
| } | |
| \frame{ | |
| \frametitle{Terminations} | |
| \begin{itemize} | |
| \item In total, \Sexpr{length(unique(dat$unit))} unique bodies | |
| \item These bodies experience \Sexpr{sum(dat$termination.ending) + sum(dat$termination.reshuffle)} terminal events | |
| \item Of which: | |
| \begin{itemize} | |
| \item \Sexpr{sum(dat$termination.ending)} pure termination events | |
| \item \Sexpr{sum(dat$termination.reshuffle)} events involving reshaping | |
| \end{itemize} | |
| \item Vanishingly rare as a proportion of agency-quarters ($\frac{\Sexpr{sum(dat$termination.ending) + sum(dat$termination.reshuffle)}}{\Sexpr{nrow(dat)}} = \Sexpr{round((sum(dat$termination.ending) + sum(dat$termination.reshuffle)) / nrow(dat),2)}$). | |
| \end{itemize} | |
| } | |
| \frame{ | |
| \frametitle{} | |
| \begin{figure} | |
| \caption{Terminations over time} | |
| \label{fig:termbyyear} | |
| \setkeys{Gin}{width=\textwidth} | |
| <<termsbyyear,echo=FALSE,fig=T,width=7,height=4>>= | |
| term.tab <- aggregate(dat[,c("termination.ending","termination.reshuffle")],list(Year=dat$Year),sum) | |
| term.tab$FiveYears <- floor(term.tab$Year/5) * 5 | |
| term.tab$FiveYears <- paste(term.tab$FiveYears, "-",term.tab$FiveYears+4) | |
| term.tab <- aggregate(term.tab[,c("termination.ending","termination.reshuffle")], | |
| list(Period=term.tab$FiveYears), | |
| sum) | |
| term.mat <- as.matrix(term.tab[,c("termination.ending","termination.reshuffle")]) | |
| rownames(term.mat) <- NULL | |
| colnames(term.mat) <- c("Termination","Reshaping") | |
| par(mar=c(5.5,3,1,5),xpd=TRUE) | |
| bp <- barplot(t(term.mat), | |
| #legend = colnames(term.mat), | |
| names.arg = NULL, | |
| col = c('black','gray'), | |
| beside = TRUE, | |
| ylim = c(0,max(term.mat)+5), | |
| axes = F) | |
| axis(1,las=2, | |
| at = colMeans(bp), labels = term.tab$Period, | |
| cex.axis = .6) | |
| axis(2,las=2, | |
| cex.axis = .6) | |
| legend(max(bp),y=34, | |
| colnames(term.mat), | |
| fill = c('black','gray'), | |
| col = c('black','gray'), | |
| bty = "n", | |
| cex = .9) | |
| @ | |
| \end{figure} | |
| } | |
| \frame{ | |
| \begin{figure} | |
| \caption{Kaplan-Meier plots} | |
| <<kmplot,fig=TRUE,width=7,height=5,echo=FALSE,results=hide>>= | |
| km.exciting <- survfit(Surv(start.qtr2,I(start.qtr2 + .25),termination,type="counting") ~ 1, data=dat) | |
| km.ending <- survfit(Surv(start.qtr2,I(start.qtr2 + .25),termination.ending,type="counting") ~ 1, data=dat) | |
| km.reshape <- survfit(Surv(start.qtr2,I(start.qtr2 + .25),termination.reshuffle,type="counting") ~ 1, data=dat) | |
| ### Create a data frame for ggplot | |
| plot.df <- data.frame(time = c(km.exciting$time,km.ending$time,km.reshape$time), | |
| surv = c(km.exciting$surv,km.ending$surv,km.reshape$surv), | |
| lower = c(km.exciting$lower,km.ending$lower,km.reshape$lower), | |
| upper = c(km.exciting$upper,km.ending$upper,km.reshape$upper), | |
| group = rep(c("All","Pure termination","Reshape"),each= length(km.exciting$time))) | |
| p1 <- ggplot(plot.df,aes(x=time,y=surv,ymax= upper,ymin=lower,fill=group)) + | |
| geom_smooth(stat="identity") + | |
| theme_bw() + | |
| scale_y_continuous("Survival probability") + | |
| scale_x_continuous("Time (years)") + | |
| scale_fill_discrete("Terminal event") + | |
| opts(legend.position="bottom") | |
| print(p1) | |
| @ | |
| \end{figure} | |
| Median survival time is \Sexpr{km.exciting$time[which.min(abs(km.exciting$surv - .5))]} years v 12 years in the USA \citep{carpenter2004political}. | |
| } | |
| \frame{ | |
| <<summarypoliticalvars,echo=FALSE,results=tex>>= | |
| tmp <- dat[,c("delta.party","current.minority","elec.year","current.ff")] | |
| names(tmp) <- c("Unfriendly govt","Minority govt","Election year","Fine Gael") | |
| stargazer(tmp,title="Summary stats, political variables", | |
| font.size = "small") | |
| @ | |
| \textbf{Note: } an unfriendly government is a government which includes Fianna F\'{a}il, for Cumann na nGaedheal/Fine Gael established bodies, or Cumann na nGaedheal/Fine Gael, for Fianna F\'{a}il established bodies. \\ | |
| \textbf{Sources: } \citet{isad2013}; \citet{doring2012parlgov} with additions. | |
| } | |
| \frame{ | |
| <<summarydesignvars,echo=FALSE,results=tex>>= | |
| tmp <- dat[,c("unit","Statutory","Function.2","LegalForm2")] | |
| tmp$Regulatory <- tmp$Function.2 == "Regulatory (over public and private sectors)" | |
| tmp$Function.2 <- NULL | |
| tmp$Company <- tmp$LegalForm2 == "Company" | |
| tmp$`Executive Agency` <- tmp$LegalForm2 == "Executive Agency (without independent legal personality)" | |
| tmp$LegalForm2 <- NULL | |
| tmp <- aggregate(tmp[,2:ncol(tmp)],list(Unit=tmp[,1]),mean) | |
| stargazer(tmp,title="Summary stats, design variables",font.size = "small") | |
| @ | |
| \textbf{Sources: } \citet{isad2013} | |
| } | |
| \frame{ | |
| <<summaryenvironmentvars,echo=FALSE,results=tex>>= | |
| tmp <- dat[,c("GovtDebt","density.cofog")] | |
| tmp$densitysq <- tmp$density.cofog^2 | |
| names(tmp) <- c("Govt debt","Density","Density squared") | |
| stargazer(tmp,title="Summary stats, environmental variables", | |
| font.size = "small") | |
| @ | |
| \textbf{Notes: } The value of `density' for any given body in any given quarter is the number of bodies also working in that COFOG sector in that quarter. \\ | |
| \textbf{Sources: } \citet{isad2013}; \citet{reinhart2009time} as updated | |
| } | |
| \section{Results} | |
| %% pandoc talk.mkdn --slide-level 2 -t beamer -o markdown-output.tex | |
| %% \input{markdown-output.tex} | |
| <<models,echo=FALSE,results=hide>>= | |
| reg.df <- dat | |
| reg.df$Regulatory <- as.numeric(dat$Function.2 == "Regulatory (over public and private sectors)") | |
| reg.df$Company <- as.numeric(dat$LegalForm2 == "Company") | |
| reg.df$`Executive Agency` <- as.numeric(dat$LegalForm2 == "Executive Agency (without independent legal personality)") | |
| reg.df$`Unfriendly govt` <- as.numeric(reg.df$delta.party) | |
| reg.df$`Minority govt` <- reg.df$current.minority | |
| reg.df$`Election year` <- as.numeric(reg.df$elec.year) | |
| reg.df$`Fine Gael` <- as.numeric(reg.df$current.ff == "Fine Gael") | |
| reg.df$`Govt debt` <- as.vector(scale(reg.df$GovtDebt)) | |
| reg.df$`Agency density` <- as.vector(scale(log1p(reg.df$density.cofogfunction))) | |
| reg.df$`Pure termination` <- reg.df$start.qtr2 | |
| reg.df$Reshape <- reg.df$start.qtr2 | |
| reg.df$`Govt debt`[is.na(reg.df$`Govt debt`)] <- mean(reg.df$`Govt debt`,na.rm=T) | |
| coxmod.full.simple <- coxph(Surv(start.qtr2,I(start.qtr2 + .25),termination,type="counting") ~ | |
| COFOG.2 + | |
| `Unfriendly govt` + `Minority govt` + `Election year` + `Fine Gael` + # political | |
| `Regulatory` + `Statutory` + `Company` + `Executive Agency` + # design | |
| `Govt debt` + `Agency density` + # + # environmentI(`Agency density`^2) | |
| I(as.numeric(elec.year)):log1p(start.qtr2) + | |
| cluster(cabinet_id), | |
| data = reg.df) | |
| coxmod.ending.simple <- update(coxmod.full.simple, | |
| Surv(`Pure termination`,I(start.qtr2+ .25),termination.ending,type="counting") ~ .) | |
| coxmod.reshuffle.simple <- update(coxmod.full.simple, | |
| Surv(Reshape,I(start.qtr2+ .25),termination.reshuffle,type="counting") ~ .) | |
| customcoef.names <- names(coxmod.ending.simple$coef)[grep("COFOG",names(coxmod.ending.simple$coef),invert=T)] | |
| customcoef.names[length(customcoef.names)] <- "Election year $\\times$ age" | |
| customcis <- list(as.matrix(exp(confint(coxmod.ending.simple))), | |
| as.matrix(exp(confint(coxmod.reshuffle.simple)))) | |
| stout <- stargazer(coxmod.ending.simple,coxmod.reshuffle.simple, | |
| label ="coxph", | |
| title = "Cox PH regression models", | |
| model.numbers=FALSE, | |
| omit = "COFOG.2", | |
| covariate.labels = customcoef.names, | |
| ci = TRUE, | |
| ci.custom = customcis, | |
| coef = list(exp(coxmod.ending.simple$coef),exp(coxmod.reshuffle.simple$coef)), | |
| p = list(summary(coxmod.ending.simple)$coefficients[,6], | |
| summary(coxmod.reshuffle.simple)$coefficients[,6]), | |
| p.auto = FALSE, | |
| omit.stat = c("all"), | |
| font.size="tiny", | |
| align = TRUE, | |
| no.space = TRUE, | |
| single.row = FALSE) | |
| if (1==1) { | |
| library(coxme) | |
| coxmod.full <- coxme(Surv(start.qtr2,I(start.qtr2 + .25),termination,type="counting") ~ | |
| `Unfriendly govt` + `Minority govt` + `Election year` + `Fine Gael` + # political | |
| `Regulatory` + `Statutory` + `Company` + `Executive Agency` + # design | |
| `Govt debt` + `Agency density` + # + # environmentI(`Agency density`^2) | |
| I(as.numeric(elec.year)):log1p(start.qtr2) + (1|COFOG.2), | |
| data = reg.df) | |
| coxmod.ending <- coxme(Surv(`Pure termination`,I(start.qtr2+ .25),termination.ending,type="counting") ~ | |
| `Unfriendly govt` + `Minority govt` + `Election year` + `Fine Gael` + # political | |
| `Regulatory` + `Statutory` + `Company` + `Executive Agency` + # design | |
| `Govt debt` + `Agency density` + # + # environmentI(`Agency density`^2) | |
| I(as.numeric(elec.year)):log1p(start.qtr2) + (1|COFOG.2), | |
| data = reg.df) | |
| coxmod.reshuffle <- coxme(Surv(Reshape,I(start.qtr2+ .25),termination.reshuffle,type="counting") ~ | |
| `Unfriendly govt` + `Minority govt` + `Election year` + `Fine Gael` + # political | |
| `Regulatory` + `Statutory` + `Company` + `Executive Agency` + # design | |
| `Govt debt` + `Agency density` + # + # environmentI(`Agency density`^2) | |
| I(as.numeric(elec.year)):log1p(start.qtr2) + (1|COFOG.2), | |
| data = reg.df) | |
| customcoef.names <- names(coxmod.ending$coef)[grep("COFOG",names(coxmod.ending$coef),invert=T)] | |
| customcoef.names[length(customcoef.names)] <- "Election year $\\times$ age" | |
| customcis <- list(as.matrix(exp(confint(coxmod.ending))), | |
| as.matrix(exp(confint(coxmod.reshuffle)))) | |
| custompvals <- list() | |
| beta <- coxmod.ending$coef | |
| se <- sqrt(diag(coxmod.ending$var[9:19,9:19])) | |
| custompvals[[1]] <- 1 - pchisq((beta/se)^2, 1) | |
| beta <- coxmod.reshuffle$coef | |
| se <- sqrt(diag(coxmod.reshuffle$var[9:19,9:19])) | |
| custompvals[[2]] <- 1 - pchisq((beta/se)^2, 1) | |
| stout <- stargazer(coxmod.ending.simple,coxmod.reshuffle.simple, | |
| label ="coxph", | |
| title = "Cox PH regression models", | |
| model.numbers=FALSE, | |
| omit = "COFOG.2", | |
| covariate.labels = customcoef.names, | |
| ci = TRUE, | |
| ci.custom = customcis, | |
| coef = list(exp(coxmod.ending$coef),exp(coxmod.reshuffle$coef)), | |
| p = custompvals, | |
| p.auto = FALSE, | |
| omit.stat = c("all"), | |
| font.size="tiny", | |
| align = TRUE, | |
| no.space = TRUE, | |
| single.row = FALSE) | |
| } | |
| @ | |
| \frame{ | |
| \frametitle{Preparatory notes} | |
| \begin{itemize} | |
| \item You'll be seeing hazard ratios, not coefficients | |
| \item You'll not see COFOG fixed effects | |
| \item All of the coefficients are standardized | |
| \item There's an atheoretical interaction term | |
| \end{itemize} | |
| } | |
| \frame{ | |
| <<stargazerbit,echo=FALSE,results=tex>>= | |
| cat(stout,sep="\n") | |
| @ | |
| \framezoom<1><2>[border](2.45cm,0.5cm)(7cm,1cm) | |
| \framezoom<1><3>[border](2.45cm,4cm)(7cm,2cm) | |
| \framezoom<1><4>[border](2.45cm,5.85cm)(7cm,2cm) | |
| } | |
| <<preds,echo=FALSE,results=hide>>= | |
| stime <- seq(min(reg.df$start.qtr2),max(reg.df$start.qtr2),length.out=100) | |
| newdata <- data.frame(start.qtr2 = c(stime,stime), | |
| COFOG.2 = 'General Public Services', | |
| `Election year` = rep(c(0,1),each=100), | |
| `elec.year` = rep(c(0,1),each=100), | |
| `Unfriendly govt` = mean(reg.df$`Unfriendly govt`), | |
| `Minority govt` = mean(reg.df$`Minority govt`), | |
| `Fine Gael` = mean(reg.df$`Fine Gael`), | |
| `Regulatory` = mean(reg.df$`Regulatory`), | |
| `Statutory` = mean(reg.df$`Statutory`), | |
| `Company` = mean(reg.df$`Company`), | |
| `Executive Agency` = mean(reg.df$`Executive Agency`), | |
| `Govt debt` = mean(reg.df$`Govt debt`,na.rm=T), | |
| `Agency density` = mean(reg.df$`Agency density`), | |
| check.names=FALSE) | |
| newdata$interaction<- log1p(newdata$start.qtr2) * I(as.numeric(newdata$elec.year)) | |
| names(newdata)[ncol(newdata)] <- "I(as.numeric(elec.year)):log1p(start.qtr2)" | |
| myfes <- fixef(coxmod.ending) | |
| names(myfes) <- gsub("`","",names(myfes)) | |
| matchpos <- charmatch(names(newdata),names(myfes)) | |
| preds <- exp(as.matrix(newdata[!is.na(matchpos)]) %*% matrix(na.omit(myfes[matchpos]))) | |
| #preds <- predict(coxmod.ending.simple, | |
| # newdata=newdata, | |
| # type="risk") | |
| #summary(preds) | |
| #preds <- predict(coxmod.ending.predict,# | |
| # newdata=newdata, | |
| # type="risk") | |
| #summary(preds) | |
| @ | |
| \frame{ | |
| \begin{figure} | |
| \caption{Risk from election year} | |
| <<elecplot,echo=FALSE,fig=TRUE,width=7,height=5>>= | |
| plot(stime,preds[101:200]/preds[1:100],lty=1, | |
| ylim=c(0.25,2.5),type="l", | |
| xlab = "Agency age", | |
| ylab = "Hazard ratio") | |
| abline(a=1,lty=2,b=0) | |
| text(60,1.12,"Non-election year") | |
| text(15,2,"Election year") | |
| @ | |
| \end{figure} | |
| } | |
| \frame<1>[label=implications]{ | |
| \frametitle{Observable implications} | |
| \begin{enumerate}[<alert@+>] | |
| \item Lesser relevance of function in Process 2 | |
| \item Different shapes of baseline hazard | |
| \item Language of overall reductions | |
| \end{enumerate} | |
| } | |
| \frame{ | |
| \frametitle{Random effects} | |
| <<ranefplot,echo=FALSE,fig=TRUE,width=7,height=5>>= | |
| fixef.df <- data.frame(variable = names(ranef(coxmod.ending)[[1]]), | |
| value = c(as.vector(unlist(ranef(coxmod.ending))),as.vector(unlist(ranef(coxmod.reshuffle)))), | |
| condition = rep(c("Pure","Reshape"),each=8)) | |
| ggplot(fixef.df,aes(y=value,x=condition,group=variable)) + geom_line() + | |
| geom_text(data=subset(fixef.df,condition=="Pure"), | |
| aes(y=value,x=condition,group=variable,label=variable),size=4,hjust=1) + | |
| scale_x_discrete("Outcome") + | |
| scale_y_continuous("Value") + | |
| theme_bw() | |
| @ | |
| } | |
| \againframe<2>{implications} | |
| \frame{ | |
| \frametitle{} | |
| \begin{figure} | |
| \caption{Baseline hazard curves} | |
| \label{fig:basehaz} | |
| <<survcurve,echo=FALSE,results=hide,eval=TRUE,fig=TRUE,width=7,height=4>>= | |
| ### Get the shape of the survival functions | |
| #pdf(file="survival_rates.pdf") | |
| #par(mfrow=c(2,1)) | |
| #plot(sf1 <- survfit(coxmod.ending.simple)) | |
| #plot(sf2 <- survfit(coxmod.reshuffle.simple)) | |
| #dev.off() | |
| ### Get the shape of the cumulative hazard | |
| H1 <- -log(sf1$surv) | |
| H2 <- -log(sf2$surv) | |
| ### Smooth | |
| t1 <- sf1$time | |
| t2 <- sf2$time | |
| loe1 <- loess(H1~t1,span=.8) | |
| loe2 <- loess(H2~t2,span=.8) | |
| tt1 <- seq(min(t1),max(t1),length=200) | |
| tt2 <- seq(min(t2),max(t2),length=200) | |
| out1 <- predict(loe1, data.frame(t1=tt1)) | |
| out2 <- predict(loe2, data.frame(t2=tt2)) | |
| par(mfrow=c(2,1),mar=c(2,1,2,1)) | |
| plot( diff(out1) ~ tt1[-1], type='l', | |
| ylab = expression(lambda[0]), | |
| xlab = 'Time (years)', | |
| main="Pure Termination") | |
| plot( diff(out2) ~ tt2[-1], type='l', | |
| ylab = expression(lambda[0]), | |
| xlab = 'Time (years)', | |
| main="Reshaping/Termination") | |
| @ | |
| \end{figure} | |
| } | |
| \againframe<3>{implications} | |
| \frame{ | |
| \frametitle{Language} | |
| \begin{itemize} | |
| \item Two large cost-reduction exercises: | |
| \begin{itemize} | |
| \item \emph{An Bord Snip} [The Snip Board], 1987 | |
| \item \emph{An Bord Snip Nua} [The New Snip Board], 2009 | |
| \end{itemize} | |
| \item The language of An Bord Snip Nua is very much one of cutting overall counts | |
| \end{itemize} | |
| } | |
| \frame{ | |
| \frametitle{Language (2)} | |
| \scriptsize | |
| \begin{quote} | |
| Delivering a public service numbers policy\ldots{} \\ | |
| The Group recommends that a uniform Public Service Numbers Policy should now be put in place and | |
| implemented centrally by the Department of Finance. Such a policy should provide for the capping | |
| and progressive lowering of numbers in particular Ministerial Vote Groups / sectoral areas, with | |
| demanding targets for annual reductions and effective staff redeployment mechanisms to minimise | |
| public service impacts. Crucially, staff reductions will need to be matched with re-design and | |
| streamlining of organisations, and this will require a proactive approach by public service | |
| managers. (Report of the Special Group on Public Service Numbers and Expenditure Programmes, p. 21) | |
| \end{quote} | |
| } | |
| \section{Conclusions} | |
| \frame{ | |
| \frametitle{Recap} | |
| \begin{itemize} | |
| \item Two processes drive agency termination | |
| \item one corresponds to a rational cost-benefit calculation of each agency | |
| \item one corresponds to a myopic attempt at cost reduction considering groups of agencies | |
| \item political and design considerations are important in the former\ldots{} | |
| \item environmental considerations are paramount in the latter | |
| \end{itemize} | |
| } | |
| \frame{ | |
| \frametitle{Improvements} | |
| \begin{itemize} | |
| \item Do the CMP->MRG cross-walk \citep{bertelli2013policy} | |
| \item Consider a mixture model? \citep{imai2012statistical} | |
| \end{itemize} | |
| } | |
| \frame{ | |
| \begin{center} | |
| {\Huge Thank you.} | |
| \vskip 5em | |
| Code available at \url{github.com} | |
| \end{center} | |
| } | |
| \frame[allowframebreaks]{ | |
| \frametitle{References} | |
| {\tiny | |
| \frametitle{Bibliography} | |
| \bibliographystyle{apalike} | |
| \bibliography{presentation} | |
| } | |
| } | |
| \frame{ | |
| \frametitle{Cox proportional hazards test} | |
| <<zph,echo=FALSE,results=hide,fig=T,width=7,height=5>>= | |
| ph.ending <- cox.zph(coxmod.ending.simple, transform="km", global=TRUE) | |
| ph.reshuffle <- cox.zph(coxmod.reshuffle.simple, transform="km", global=TRUE) | |
| zph.df <- data.frame(variable = names(ph.ending[[1]][,3]), | |
| `Pure termination` = ph.ending[[1]][,3], | |
| `Reshaping` = ph.reshuffle[[1]][,3], | |
| check.names = FALSE) | |
| zph.df <- subset(zph.df,variable!="GLOBAL") | |
| zph.df <- melt(zph.df) | |
| names(zph.df) <- c("variable","Model","value") | |
| zph.plot <- ggplot(zph.df,aes(x=variable,y=value,group=Model,color=Model)) + geom_point() + | |
| geom_hline(yintercept=0.05,color='grey') + | |
| scale_y_log10("p-value") + | |
| coord_flip() + | |
| theme_bw() + | |
| opts(legend.position="bottom") | |
| print(zph.plot) | |
| @ | |
| } | |
| \frame{ | |
| \begin{table} | |
| \caption{Fit statistics} | |
| \begin{tabular}{lcc} \toprule | |
| Model & $R^2$ & Concordance \\ \midrule | |
| Full-model & \Sexpr{round(summary(coxmod.full.simple)$rsq[1],3)}; max. \Sexpr{round(summary(coxmod.full.simple)$rsq[2],2)} & \Sexpr{round(summary(coxmod.full.simple)$concordance[1],2)}\\ | |
| Pure termination & \Sexpr{round(summary(coxmod.ending.simple)$rsq[1],3)}; max. \Sexpr{round(summary(coxmod.ending.simple)$rsq[2],2)} & \Sexpr{round(summary(coxmod.ending.simple)$concordance[1],2)}\\ | |
| Reshaping & \Sexpr{round(summary(coxmod.reshuffle.simple)$rsq[1],3)}; max. \Sexpr{round(summary(coxmod.reshuffle.simple)$rsq[2],2)} & \Sexpr{round(summary(coxmod.reshuffle.simple)$concordance[1],2)}\\ \bottomrule | |
| \end{tabular} | |
| \end{table} | |
| \textbf{Note: } fit statistics refer to model with fixed COFOG effects... | |
| } | |
| \end{document} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment