Create replacement risk using ParlGov data

cogsd7.R

library(plyr)
library(zoo)

startyr <- 1992
endyr <- 2012

pg <- read.csv("http://www.parlgov.org/stable/static/data/stable-utf-8/view_cabinet.csv",as.is=T)

## Exclude GDR
pg <- pg[which(pg$country_name_short!="GDR"),]

## Include end dates of cabinets
pg$next_cabinet_id <- NA
pg$end_date <- NA
for (i in unique(pg$cabinet_id)) {
	## Get the ID of the subsequent cabinet
	## This has previous_cabinet_id equal to i
	next.cab <- unique(pg$cabinet_id[which(pg$previous_cabinet_id == i)])
	next.start <- pg$start_date[which(pg$cabinet_id == next.cab)]
	pg$next_cabinet_id[which(pg$cabinet_id == i)] <- ifelse(length(next.cab)==0,NA,next.cab)
	pg$end_date[which(pg$cabinet_id == i)] <- ifelse(length(next.start)==0,NA,next.start)
}

## Create duration
pg$durat <- as.numeric(as.Date(pg$end_date) - as.Date(pg$start_date))
## And hazard
pg$hazard <- 1 / pg$durat

## Exclude cabinets way before start year
pg <- pg[which(pg$start_date > as.Date(paste(startyr-3,"-01-01",sep=""))),]

## Create partisan centre of government
## In this case, left-right position of cabinet parties
## Weighted by seat share
pg$cog <- NA
pg <- ddply(pg,.(cabinet_id),function(df) {
	df$cog <- weighted.mean(df$left_right[which(df$cabinet_party==1)],
		df$seats[which(df$cabinet_party==1)],na.rm=T)
	df
})


## Convert COG to yearly
cogsd7 <- ddply(pg,.(country_name_short),function(df) {
	## Select only unique values
	my.subset <- unique(df[,c("cog","start_date")])
	## Create the zoo object
	zoo.obj <- zoo(x=unique(my.subset$cog),order.by=as.Date(unique(my.subset$start_date)))
	## Merge with the blank series
	zoo.blank <- as.Date(paste(startyr:endyr,"-01-01",sep=""))
	zoo.blank <- zoo(,order.by=zoo.blank)
	zoo.obj <- merge(zoo.obj,zoo.blank,all=T)
	## Aggregate, via yearmon (see https://stat.ethz.ch/pipermail/r-help/2009-March/191302.html)
	zoo.monthly <- aggregate(na.locf(zoo.obj), as.yearmon, mean)
	zoo.yr <- aggregate(na.locf(zoo.monthly),floor,mean)
	## Get the rolling seven year average
	cogsd7 <- rollapply(zoo.yr,width=7,sd,fill=NA,partial=F)
	data.frame(cogsd7=cogsd7,Date=index(cogsd7))
})

sort(by(cogsd7$cogsd7,cogsd7$country_name_short,mean,na.rm=T))

## Now do the same for hazard rate
hazard <- ddply(pg,.(country_name_short),function(df) {
	## Select only unique values
	my.subset <- unique(df[,c("hazard","start_date")])
	## Create the zoo object
	zoo.obj <- zoo(x=unique(my.subset$hazard),order.by=as.Date(unique(my.subset$start_date)))
	## Merge with the blank series
	zoo.blank <- as.Date(paste(startyr:endyr,"-01-01",sep=""))
	zoo.blank <- zoo(,order.by=zoo.blank)
	zoo.obj <- merge(zoo.obj,zoo.blank,all=T)
	## Aggregate, via yearmon (see https://stat.ethz.ch/pipermail/r-help/2009-March/191302.html)
	zoo.monthly <- aggregate(na.locf(zoo.obj), as.yearmon, mean)
	zoo.yr <- aggregate(na.locf(zoo.monthly),floor,mean)
	## Get the rolling seven year average
	data.frame(hazard=zoo.yr,Date=index(zoo.yr))
})

rr <- merge(cogsd7,hazard,all=T)

rr$rr <- rr$hazard * rr$cogsd7

by(rr$rr,rr$country_name_short,mean,na.rm=T)