Effects Across Models Graph
# pch.all <- c(19, 19, 19, 19, 1, 19, 19, 19)
# pch.art <- c(19, 19, 19, 19, 1, 19, 19, 1)
# pch.hea <- c(19, 19, 19, 1, 1, 1, 19, 1)
# pch.hs <- c(19, 19, 19, 19, 19, 19, 19, 19)
# pch.pub <- c(1, 19, 19, 1, 1, 19, 19, 1)
# pch.edu <- c(19, 19, 19, 1, 19, 1, 19, 19)
# pch.oth <- c(1, 19, 19, 1, 1, 19, 19, 1)
# All Arts Health HS Public Education Misc
# Accrual 0.61*** 0.78*** 0.81*** 0.54*** 0.46*** 0.81*** 0.46***
# GovtMoneyRat 1.27*** 1.26*** 0.93*** 1.07*** 1.87*** 1.69*** 1.39***
# HHI -0.53*** -0.51 0.42 -0.63*** -0.72** -1.26*** 0.29
# UNAgrand 0.001*** 0.002** 0.002* 0.0004** 0.002*** 0.001* 0.005***
# FixedCostRat 0.25 0.24 -0.47 0.48** -0.56 1.46** -0.93*
# SurplusRat_ndrop_w892 1.90*** 2.53*** 1.41*** 1.96*** 1.62*** 1.93*** 1.75***
# EqRat_w_K 0.001*** 0.001** -0.0003 0.001*** 0.002*** 0.001 -0.001
# ProfFundFeeYes 1.06*** 1.32*** 1.09*** 0.95*** 1.36*** 1.51*** 0.57*
pch.all <- c(19,19,19,19,NA,19,19,19)
pch.art <- c(19,19,NA,19,NA,19,19,19)
pch.hea <- c(19,19,NA,19,NA,19,NA,19)
pch.hs <- c(19,19,19,19,19,19,19,19)
pch.pub <- c(19,19,19,19,NA,19,19,19)
pch.edu <- c(19,19,19,19,19,19,NA,19)
pch.oth <- c(19,19,NA,19,19,19,NA,19)
t <- readRDS( "./Data/EffectsTable.rds" )
# pch.all <- c(8,8,8,8,NA,8,8,8)
# pch.art <- c(21,21,21,21,NA,21,21,NA)
# pch.hea <- c(22,22,22,NA,NA,NA,22,NA)
# pch.hs <- c(23,23,23,23,23,23,23,23)
# pch.pub <- c(NA,24,24,NA,NA,24,24,NA)
# pch.edu <- c(25,25,25,NA,25,NA,25,25)
# pch.oth <- c(NA,20,20,NA,NA,20,20,NA)
# pch.all <- c(8,8,8,8,8,8,8,8)
# pch.art <- c(21,21,21,21,21,21,21,21)
# pch.hea <- c(22,22,22,22,22,22,22,22)
# pch.hs <- c(23,23,23,23,23,23,23,23)
# pch.pub <- c(24,24,24,24,24,24,24,24)
# pch.edu <- c(25,25,25,25,25,25,25,25)
# pch.oth <- c(20,20,20,20,20,20,20,20)
# Prof Fund
# Accrual
# Surplus
# Equity
# Fixed Cost
# UNA
# Gov Rev
# HHI
par( mar=c(5.1, 12, 4.1, 2.1) )
plot( 1, 1, type="n", xlim=c(-0.1,0.5), ylim=c(1,8),
bty="n", yaxt="n", xaxt="n",
xlab="Increase in Probability of Professionalization",
cex.lab=1.3, col.lab="gray50",
ylab="", main="Effect Size Across Subsector Models" )
abline( h=1:9, lwd=0.1, col="gray90" )
abline( v=seq(-0.1,0.7,0.1), lwd=0.1, col="gray90" )
abline( v=0, lwd=0.1 )
axis( side=1, at=seq(-0.1,0.7,0.1), labels=seq(-0.1,0.7,0.1), tick=F, padj=-1.5 )
axis( side=2, at=8:1, labels=row.names(t), tick=F, las=2, cex.axis=1 )
points( t$ALL, 8:1, col=gray(0.5,0.5), cex=2, pch=pch.all )
points( t$ARTS, 8:1, col=gray(0.5,0.5), cex=2, pch=pch.art, bg=gray(0.5,0.5) )
points( t$HEALTH, 8:1, col=gray(0.5,0.5), cex=2, pch=pch.hea, bg=gray(0.5,0.5) )
points( t$HUMAN_SERVICES, 8:1, col=gray(0.5,0.5), cex=2, pch=pch.hs, bg=gray(0.5,0.5) )
points( t$PUBLIC, 8:1, col=gray(0.5,0.5), cex=2, pch=pch.pub, bg=gray(0.5,0.5) )
points( t$EDUCATION, 8:1, col=gray(0.5,0.5), cex=2, pch=pch.edu, bg=gray(0.5,0.5) )
points( t$OTHER, 8:1, col=gray(0.5,0.5), cex=2, pch=pch.oth )
# points( 0.45, 4.5, col=gray(0.5,0.5), cex=1, pch=8 )
# points( 0.45, 4, col=gray(0.5,0.5), cex=1, pch=21, bg=gray(0.5,0.5) )
# points( 0.45, 3.5, col=gray(0.5,0.5), cex=1, pch=22, bg=gray(0.5,0.5) )
# points( 0.45, 3, col=gray(0.5,0.5), cex=1, pch=23, bg=gray(0.5,0.5) )
# points( 0.45, 2.5, col=gray(0.5,0.5), cex=1, pch=24, bg=gray(0.5,0.5) )
# points( 0.45, 2, col=gray(0.5,0.5), cex=1, pch=25, bg=gray(0.5,0.5) )
# points( 0.45, 1.5, col=gray(0.5,0.5), cex=1, pch=20 )
# text( 0.45, 4.5, "ALL", col="gray", cex=0.7, pos=4 )
# text( 0.45, 4, "ARTS", col="gray", cex=0.7, pos=4 )
# text( 0.45, 3.5, "HEALTH", col="gray", cex=0.7, pos=4 )
# text( 0.45, 3, "HUMAN SERVICES", col="gray", cex=0.7, pos=4 )
# text( 0.45, 2.5, "PUBLIC", col="gray", cex=0.7, pos=4 )
# text( 0.45, 2, "EDUCATION", col="gray", cex=0.7, pos=4 )
# text( 0.45, 1.5, "OTHER", col="gray", cex=0.7, pos=4 )
# use same symbol for all subsectors?
par( mar=c(5.1, 12, 4.1, 2.1) )
plot( 1, 1, type="n", xlim=c(-0.1,0.7), ylim=c(1,8),
bty="n", yaxt="n", xaxt="n",
xlab="Increase in Probability of Professionalization",
cex.lab=1.5, col.lab="gray50",
ylab="", main="Effect Size Across Subsector Models" )
abline( h=1:9, lwd=0.1, col="gray90" )
abline( v=seq(-0.1,0.7,0.1), lwd=0.1, col="gray90" )
abline( v=0, lwd=0.1 )
axis( side=1, at=seq(-0.1,0.7,0.1), labels=seq(-0.1,0.7,0.1), tick=F, padj=-1.5 )
axis( side=2, at=8:1, labels=row.names(t), tick=F, las=2, cex.axis=1 )
points( t$ALL, 8:1, pch=19, col="gray", cex=2 )
points( t$ARTS, 8:1, pch=19, col="gray", cex=2 )
points( t$HEALTH, 8:1, pch=19, col="gray", cex=2 )
points( t$HUMAN_SERVICES, 8:1, pch=19, col="gray", cex=2 )
points( t$PUBLIC, 8:1, pch=19, col="gray", cex=2 )
points( t$EDUCATION, 8:1, pch=19, col="gray", cex=2 )
points( t$OTHER, 8:1, pch=19, col="gray", cex=2 )
Harzard and Survival Plots
### LOAD EXAMPLE DATA
# hrc <- createBaseline( df=dat.original, mod=m.03 )
# hrt <- calc.effect( model=m.03, df=dat, variable.name="Accrual", quant=1 )
hrc <- readRDS( "./Data/BaselineVitalRates.rds" )
hrt <- readRDS( "./Data/AdjustedVitalRates.rds" )
# # > dput( hrc )
# hrc <- structure(list(age = 1:6, hazard.rate = c(0, 0.0905, 0.1112,
# 0.0905, 0.0773, 0.0735), survival.rate = c(1, 0.9095, 0.8083636,
# 0.7352066942, 0.67837521673834, 0.628514638308072)), .Names = c("age",
# "hazard.rate", "survival.rate"), row.names = c(NA, -6L), class = "data.frame")
#
# # > dput( hrt )
# hrt <- structure(list(age = 1:6, hazard.rate = c(0, 0.1549, 0.1873,
# 0.155, 0.1337, 0.1275), survival.rate = c(1, 0.8451, 0.68681277,
# 0.58035679065, 0.502763087740095, 0.438660794053233)), .Names = c("age",
# "hazard.rate", "survival.rate"), row.names = c(NA, -6L), class = "data.frame")
par( mfrow=c(1,2) )
plot( 1:6, hrc$hazard.rate, type="b", pch=19, cex=2, bty="n", ylim=c(0,0.25),
main="Hazard Rate", xlab="Nonprofit Age", ylab="Prob. of Professionalizing at Age=j" )
points( 1:6, hrt$hazard.rate, type="b", pch=18, cex=2, col="gray40" )
points( 3.5, 0.24, pch=19, cex=1.2 )
points( 3.5, 0.22, pch=18, cex=1.4, col="gray40" )
text( 3.5, 0.24, "Baseline Case", pos=4, cex=0.8 )
text( 3.5, 0.22, "Vary One IV", pos=4, col="gray40", cex=0.8 )
plot( 1:6, hrc$survival.rate, type="b", pch=19, cex=2, ylim=c(0,1.1), bty="n",
main="Survival Curve", xlab="Nonprofit Age", ylab="Prob. of Remaining Grassroots at Age=j" )
points( 1:6, hrt$survival.rate, type="b", pch=18, cex=2, col="gray40" )
points( 2, 0.35, pch=19, cex=1.4 )
points( 2, 0.10, pch=18, cex=1.6, col="gray40" )
arrows( x0=2, y0=0.15, y1=0.30, length=0.07, lwd=1.5, code=3 )
text( 2, 0.225, "Effect Size (at age=6)", pos=4, cex=0.8 )
# text( 2, 0.25, "Baseline Case", pos=4, cex=0.8 )
# text( 2, 0.15, "Vary One IV", pos=4, col="gray40", cex=0.8 )
abline( h=0.5, col="red", lty=3)
