setupCF <- function(x,xvar,yr,fd=FALSE) { # Check for each possible xvar; add appropriate newdata row # Create scenario names # Return new data and scenario names k <- length(xvar) meandata <- apply(x,2,mean) # Ensure logical consistency if (any(xvar=="cmXfisrev")) { curxrow <- (1:k)[xvar=="cmXfisrev"] cur1row <- (1:k)[xvar=="cntminexp"] cur2row <- (1:k)[xvar=="fisrevenue"] meandata[curxrow] <- meandata[cur1row]*meandata[cur2row] } if (any(xvar=="cmXgdp")) { curxrow <- (1:k)[xvar=="cmXgdp"] cur1row <- (1:k)[xvar=="cntminexp"] cur2row <- (1:k)[xvar=="gdp"] meandata[curxrow] <- meandata[cur1row]*meandata[cur2row] } if (any(xvar=="apptage")) { curxrow <- (1:k)[xvar=="apptage"] if (meandata[curxrow]>=63) { if (any(xvar=="agege63")) { currow <- (1:k)[xvar=="agege63"] meandata[currow] <- 1 } } else { if (any(xvar=="agege63")) { currow <- (1:k)[xvar=="agege63"] meandata[currow] <- 0 } } meanage <- mean(x[,curxrow]) if (any(xvar=="partyexp")) { partyexp <- mean(x[,(1:k)[xvar=="partyexp"]]) implicitPtime <- yr - (meanage*partyexp) if (any(xvar=="ccp1935")) { currow <- (1:k)[xvar=="ccp1935"] if (implicitPtime<=1935) { meandata[currow] <- 1 } else { meandata[currow] <- 0 } } if (any(xvar=="ccp1945")) { currow <- (1:k)[xvar=="ccp1945"] if (implicitPtime<=1945) { meandata[currow] <- 1 } else { meandata[currow] <- 0 } } if (any(xvar=="ccp1949")) { currow <- (1:k)[xvar=="ccp1949"] if (implicitPtime<=1949) { meandata[currow] <- 1 } else { meandata[currow] <- 0 } } } } if (any(xvar=="partyyears")) { implicitPtime <- yr - mean(x[,(1:k)[xvar=="partyyears"]]) if (any(xvar=="ccp1935")) { currow <- (1:k)[xvar=="ccp1935"] if (implicitPtime<=1935) { meandata[currow] <- 1 } else { meandata[currow] <- 0 } } if (any(xvar=="ccp1945")) { currow <- (1:k)[xvar=="ccp1945"] if (implicitPtime<=1945) { meandata[currow] <- 1 } else { meandata[currow] <- 0 } } if (any(xvar=="ccp1949")) { currow <- (1:k)[xvar=="ccp1949"] if (implicitPtime<=1949) { meandata[currow] <- 1 } else { meandata[currow] <- 0 } } } newdata <- NULL newpredata <- NULL scenarios <- NULL scenvar <- "female" if (any(xvar==scenvar)) { curxrow <- (1:k)[xvar==scenvar] newscen <- meandata newscen[curxrow] <- 1 newprescen <- meandata newprescen[curxrow] <- 0 scenname <- "Female" newdata <- rbind(newdata,newscen) newpredata <- rbind(newpredata,newprescen) scenarios <- c(scenarios,scenname) if (!fd) { newscen <- meandata newscen[curxrow] <- 0 newprescen <- meandata newprescen[curxrow] <- 1 scenname <- "Male" newdata <- rbind(newdata,newscen) newpredata <- rbind(newpredata,newprescen) scenarios <- c(scenarios,scenname) } } scenvar <- "nonhan" if (any(xvar==scenvar)) { curxrow <- (1:k)[xvar==scenvar] newscen <- meandata newscen[curxrow] <- 1 newprescen <- meandata newprescen[curxrow] <- 0 scenname <- "Minority" newdata <- rbind(newdata,newscen) newpredata <- rbind(newpredata,newprescen) scenarios <- c(scenarios,scenname) if (!fd) { newscen <- meandata newscen[curxrow] <- 0 newprescen <- meandata newprescen[curxrow] <- 1 scenname <- "Han" newdata <- rbind(newdata,newscen) newpredata <- rbind(newpredata,newprescen) scenarios <- c(scenarios,scenname) } } scenvar <- "prince" if (any(xvar==scenvar)) { curxrow <- (1:k)[xvar==scenvar] newscen <- meandata newscen[curxrow] <- 1 newprescen <- meandata newprescen[curxrow] <- 0 scenname <- "Princeling" newdata <- rbind(newdata,newscen) newpredata <- rbind(newpredata,newprescen) scenarios <- c(scenarios,scenname) if (!fd) { newscen <- meandata newscen[curxrow] <- 0 newprescen <- meandata newprescen[curxrow] <- 1 scenname <- "Non-Princeling" newdata <- rbind(newdata,newscen) newpredata <- rbind(newpredata,newprescen) scenarios <- c(scenarios,scenname) } } scenvar <- "apptage" if (any(xvar==scenvar)) { curxrow <- (1:k)[xvar==scenvar] newscen <- meandata newscen[curxrow] <- newscen[curxrow] + sd(x[,curxrow]) newprescen <- meandata scenname <- "Age +1 sd" if (any(xvar=="agege63")) { currow <- (1:k)[xvar=="agege63"] if (newscen[curxrow]>=63) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } if (newprescen[curxrow]>=63) { newprescen[currow] <- 1 } else { newprescen[currow] <- 0 } } if (any(xvar=="partyexp")) { scenage <- newscen[curxrow] preage <- newprescen[curxrow] partyexp <- newscen[(1:k)[xvar=="partyexp"]] partyexppre <- newprescen[(1:k)[xvar=="partyexp"]] implicitPtime <- yr - (scenage*partyexp) implicitprePtime <- yr - (preage*partyexppre) if (any(xvar=="ccp1935")) { currow <- (1:k)[xvar=="ccp1935"] if (implicitPtime<=1935) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } if (implicitprePtime<=1935) { newprescen[currow] <- 1 } else { newprescen[currow] <- 0 } } if (any(xvar=="ccp1945")) { currow <- (1:k)[xvar=="ccp1945"] if (implicitPtime<=1945) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } if (implicitprePtime<=1945) { newprescen[currow] <- 1 } else { newprescen[currow] <- 0 } } if (any(xvar=="ccp1949")) { currow <- (1:k)[xvar=="ccp1949"] if (implicitPtime<=1949) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } if (implicitprePtime<=1949) { newprescen[currow] <- 1 } else { newprescen[currow] <- 0 } } } newdata <- rbind(newdata,newscen) newpredata <- rbind(newpredata,newprescen) scenarios <- c(scenarios,scenname) } scenvar <- "partyexp" if (any(xvar==scenvar)) { curxrow <- (1:k)[xvar==scenvar] newscen <- meandata newscen[curxrow] <- newscen[curxrow] + sd(x[,curxrow]) newprescen <- meandata scenname <- "Party Exp +1 sd" if (any(xvar=="apptage")) { scenage <- newscen[(1:k)[xvar=="apptage"]] preage <- newprescen[(1:k)[xvar=="apptage"]] partyexp <- newscen[curxrow] partyexppre <- newprescen[curxrow] implicitPtime <- yr - (scenage*partyexp) implicitprePtime <- yr - (preage*partyexppre) if (any(xvar=="ccp1935")) { currow <- (1:k)[xvar=="ccp1935"] if (implicitPtime<=1935) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } if (implicitprePtime<=1935) { newprescen[currow] <- 1 } else { newprescen[currow] <- 0 } } if (any(xvar=="ccp1945")) { currow <- (1:k)[xvar=="ccp1945"] if (implicitPtime<=1945) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } if (implicitprePtime<=1945) { newprescen[currow] <- 1 } else { newprescen[currow] <- 0 } } if (any(xvar=="ccp1949")) { currow <- (1:k)[xvar=="ccp1949"] if (implicitPtime<=1949) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } if (implicitprePtime<=1949) { newprescen[currow] <- 1 } else { newprescen[currow] <- 0 } } } else { } newdata <- rbind(newdata,newscen) newpredata <- rbind(newpredata,newprescen) scenarios <- c(scenarios,scenname) } scenvar <- "partyyears" if (any(xvar==scenvar)) { curxrow <- (1:k)[xvar==scenvar] newscen <- meandata newscen[curxrow] <- newscen[curxrow] + sd(x[,curxrow]) newprescen <- meandata scenname <- "Party Years +1 sd" implicitPtime <- yr - newscen[curxrow] implicitprePtime <- yr - meandata[curxrow] if (any(xvar=="ccp1935")) { currow <- (1:k)[xvar=="ccp1935"] if (implicitPtime<=1935) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } if (implicitprePtime<=1935) { newprescen[currow] <- 1 } else { newprescen[currow] <- 0 } } if (any(xvar=="ccp1945")) { currow <- (1:k)[xvar=="ccp1945"] if (implicitPtime<=1945) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } if (implicitprePtime<=1945) { newprescen[currow] <- 1 } else { newprescen[currow] <- 0 } } if (any(xvar=="ccp1949")) { currow <- (1:k)[xvar=="ccp1949"] if (implicitPtime<=1949) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } if (implicitprePtime<=1949) { newprescen[currow] <- 1 } else { newprescen[currow] <- 0 } } newdata <- rbind(newdata,newscen) newpredata <- rbind(newpredata,newprescen) scenarios <- c(scenarios,scenname) } if (fd) { scenvar <- "highschool" if (any(xvar==scenvar)) { curxrow <- (1:k)[xvar==scenvar] newscen <- meandata newscen[curxrow] <- 1 if (any(xvar=="college")) { currow <- (1:k)[xvar=="college"] newscen[currow] <- 0 } if (any(xvar=="postgrad")) { currow <- (1:k)[xvar=="postgrad"] newscen[currow] <- 0 } newprescen <- meandata newprescen[curxrow] <- 0 if (any(xvar=="college")) { currow <- (1:k)[xvar=="college"] newprescen[currow] <- 0 } if (any(xvar=="postgrad")) { currow <- (1:k)[xvar=="postgrad"] newprescen[currow] <- 0 } scenname <- "High School vs =63) { if (any(xvar=="agege63")) { currow <- (1:k)[xvar=="agege63"] meandata[currow] <- 1 } } else { if (any(xvar=="agege63")) { currow <- (1:k)[xvar=="agege63"] meandata[currow] <- 0 } } meanage <- mean(x[,curxrow]) if (any(xvar=="partyexp")) { partyexp <- mean(x[,(1:k)[xvar=="partyexp"]]) implicitPtime <- yr - (meanage*partyexp) if (any(xvar=="ccp1935")) { currow <- (1:k)[xvar=="ccp1935"] if (implicitPtime<=1935) { meandata[currow] <- 1 } else { meandata[currow] <- 0 } } if (any(xvar=="ccp1945")) { currow <- (1:k)[xvar=="ccp1945"] if (implicitPtime<=1945) { meandata[currow] <- 1 } else { meandata[currow] <- 0 } } if (any(xvar=="ccp1949")) { currow <- (1:k)[xvar=="ccp1949"] if (implicitPtime<=1949) { meandata[currow] <- 1 } else { meandata[currow] <- 0 } } } } if (any(xvar=="partyyears")) { implicitPtime <- yr - mean(x[,(1:k)[xvar=="partyyears"]]) if (any(xvar=="ccp1935")) { currow <- (1:k)[xvar=="ccp1935"] if (implicitPtime<=1935) { meandata[currow] <- 1 } else { meandata[currow] <- 0 } } if (any(xvar=="ccp1945")) { currow <- (1:k)[xvar=="ccp1945"] if (implicitPtime<=1945) { meandata[currow] <- 1 } else { meandata[currow] <- 0 } } if (any(xvar=="ccp1949")) { currow <- (1:k)[xvar=="ccp1949"] if (implicitPtime<=1949) { meandata[currow] <- 1 } else { meandata[currow] <- 0 } } } newdata <- NULL minptime <- min(na.omit(ptime)) maxptime <- max(na.omit(ptime)) minage <- min(na.omit(apptage)) maxage <- max(na.omit(apptage)) hptime <- seq(minptime,maxptime) hage <- seq(minage,maxage) hptimeAll <- hageAll <- hpartyexpAll <- NULL for (i in 1:length(hptime)) { for (j in 1:length(hage)) { hptimeAll <- c(hptimeAll,hptime[i]) hageAll <- c(hageAll,hage[j]) hpartyexpAll <- c(hpartyexpAll, (yr-hptime[i])/hage[j] ) newscen <- meandata scenvar <- "apptage" if (any(xvar==scenvar)) { curxrow <- (1:k)[xvar==scenvar] newscen[curxrow] <- hage[j] } if (any(xvar=="agege63")) { currow <- (1:k)[xvar=="agege63"] if (hage[j]>=63) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } } scenvar <- "partyexp" if (any(xvar==scenvar)) { curxrow <- (1:k)[xvar==scenvar] newscen[curxrow] <- (yr-hptime[i])/hage[j] } if (any(xvar=="ccp1935")) { currow <- (1:k)[xvar=="ccp1935"] if (hptime[i]<=1935) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } } if (any(xvar=="ccp1945")) { currow <- (1:k)[xvar=="ccp1945"] if (hptime[i]<=1945) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } } if (any(xvar=="ccp1949")) { currow <- (1:k)[xvar=="ccp1949"] if (hptime[i]<=1949) { newscen[currow] <- 1 } else { newscen[currow] <- 0 } } newdata <- rbind(newdata,newscen) } } result <- list(newdata=newdata,hypptime=hptimeAll,hypage=hageAll,hyppartyexp=hpartyexpAll) result }