# Load libraries needed.
stt1 <- Sys.time()
library(stringr)
library(readxl)
library(sf)
# Generate a Kentucky County Border Group
#
# Read the county boundary files. (Set up system directories.
# Replace with your directories to run.)
TempD<-"c:/projects/statnet/" # my private test PDF directory exist,
#don't use temp.
# get a temp directory for the output PDF files for the example.
if (!dir.exists(TempD)) {
TempD <- paste0(tempdir(),"/")
DataD <- paste0(system.file("extdata",package="micromapST"),"/")
} else {
DataD <- "c:/projects/statnet/r code/micromapST-3.0.2/inst/extdata/"
}
cat("Temporary Directory:",TempD,"\n")
# get working data directory
#cat("Working Data Directory:",DataD,"\n")
KYCoBG <- "KYCountyBG" # Border Group name
KYCoCen <- "KY_County" # shape file name(s)
KYCoShp <- st_read(DataD,KYCoCen)
st_crs(KYCoShp) <- st_crs("+proj=lonlat +datum=NAD83 +ellipse=WGS84 +no_defs")
# inspect name table
KYNTname <- paste0(DataD,"/",KYCoCen,"_NameTable.xlsx")
#cat("KYNTname:",KYNTname,"\n")
KYCoNT <- as.data.frame(read_xlsx(KYNTname))
#head(KYCoNT)
spt1 <- Sys.time()
cat("Time to get data and boundaries for Counties:",spt1-stt1,"\n")
if (FALSE) {
#
# building border group for all counties in Kentucky
#
stt2 <- Sys.time()
# Build Border Group
BuildBorderGroup(ShapeFile = KYCoShp,
ShapeLinkName = "NAME",
NameTableLink = "Name",
NameTableDir = DataD,
NameTableFile = paste0(KYCoCen,"_NameTable.xlsx"),
BorderGroupName = KYCoBG,
BorderGroupDir = TempD,
MapHdr = c("","KY Counties"),
IDHdr = c("KY Co."),
ReducePC = 0.9
)
# Setup MicromapST graphic
spt2 <- Sys.time()
cat("Time to build KY Co BG:",spt2-stt2,"\n")
stt3 <- spt2
KYCoData <- as.data.frame(read_xlsx(paste0(DataD,"/",
"KY_County_Population_1900-2020.xlsx")))
#head(KYCoData)
KY_Co_PD <- data.frame(stringsAsFactors=FALSE,
type=c("map","id","dot","dot"),
lab1=c(NA,NA,"2010 Pop","2020 Pop"),
col1=c(NA,NA,"2010","2020")
)
KYCoTitle <- c("Ez23ax-Kentucky County","Pop 2010 and 2020")
OutCoPDF <- paste0(TempD,"Ez23ax-KY Co 2010-2020 Pop.pdf")
grDevices::pdf(OutCoPDF,width=10,height=13) # on 11 x 14 paper.
micromapST(KYCoData,KY_Co_PD,sortVar=c("2020"), ascend=FALSE,
rowNames="full", rowNamesCol = c("Name"),
bordDir = TempD, bordGrp = KYCoBG,
title = KYCoTitle
)
x <- dev.off()
spt3 <- Sys.time()
cat("Time to micromapST KY Co graph:",spt3-stt3,"\n")
} # end of dontrun.
stt4 <- Sys.time()
# Aggregate Kentucky Counties into ADD areas
#
# The regions in the Kentucky County Name Table (KYCoNT) are the ADD districts
# the county was assigned to.
# The KYCoShp has the county boundaries.
#
KYCoShp$NAME <- str_to_upper(KYCoShp$NAME)
KYCoNT$NameCap <- str_to_upper(KYCoNT$Name)
aggInx <- match(KYCoShp$NAME,KYCoNT$NameCap)
#print(aggInx)
xm <- is.na(aggInx) # which polygons did not match the name table?
if (any(xm)) {
cat("ERROR: One or more polygons/counties in the shape file did not match\n",
"the entries in the KY County name table. They are:\n")
LLMiss <- KYCoNT[xm,"Name"]
print(LLMiss)
stop()
}
#
#####
# aggFUN - a function to inspect the data.frame columns and determine
# an appropriate aggregation method - copy or sum.
#
aggFUN <- function(z) { ifelse (is.character(z[1]), z[1], sum(as.numeric(z))) }
#
#####
#
aggList <- KYCoNT$regID[aggInx]
#print(aggList)
KYADDShp <- aggregate(KYCoShp, by=list(aggList), FUN = aggFUN)
names(KYADDShp)[1] <- "regID" # change first column name to "regNames"
row.names(KYADDShp) <- KYADDShp$regID
KeepAttr <- c("regID","AREA","PERIMETER","STATE","geometry")
KYADDShp <- KYADDShp[,KeepAttr]
st_geometry(KYADDShp) <- st_cast(st_geometry(KYADDShp),"MULTIPOLYGON")
#plot(st_geometry(KYADDShp))
spt4 <- Sys.time()
cat("Time to aggregate KY ADDs from Cos:",spt4-stt4,"\n")
stt5 <- spt4
# Build Border Group
BuildBorderGroup(ShapeFile = KYADDShp,
# sf structure of shapefile of combined counties into AD Districts
ShapeLinkName = "regID",
NameTableFile = "KY_ADD_NameTable.xlsx",
NameTableDir = DataD,
NameTableLink = "Index",
BorderGroupName = "KYADDBG",
BorderGroupDir = TempD,
MapHdr = c("","KY ADDs"),
IDHdr = c("KY ADDs"),
ReducePC = 0.9
)
spt5 <- Sys.time()
cat("Time to build ADD BG:",spt5-stt5,"\n")
stt6 <- spt5
# Test micromapST
KYADDData <- as.data.frame(readxl::read_xlsx(
paste0(DataD,"KY_ADD_Population-2020.xlsx")),
stringsAsFactors=FALSE)
#
KY_ADD_PD <- data.frame(stringsAsFactors=FALSE,
type=c("map","id","dot","dot"),
lab1=c(NA,NA,"Pop","Proj. Pop"),
lab2=c(NA,NA,"2020","2030"),
col1=c(NA,NA,"DecC2020","Proj2030")
)
#
KyTitle <- c("Ez23cx-KY Area Development Dist.",
"Pop 2020 and proj Pop 2023")
OutPDF2 <- paste0(TempD,"Ez23cx-KY ADD Pop.pdf")
grDevices::pdf(OutPDF2,width=10,height=7.5)
micromapST(KYADDData,KY_ADD_PD,sortVar="DecC2020",ascend=FALSE,
rowNames= "full", rowNamesCol = "ADD_Name",
bordDir = TempD,
bordGrp = "KYADDBG",
title = KyTitle
)
x <- grDevices::dev.off()
spt6 <- Sys.time()
cat("Time to do micromapST of KY ADDs:",spt6-stt6,"\n")
Run the code above in your browser using DataLab