北宋、明清进士空间分析

1
2
3
4

library(readr)
nsong.js <- read_csv("下载/CBDB_exams_NSong_WGS84_kto.csv")
ming.js <- read_csv("下载/CBDB_exams_Ming_WGS84_MbJ.csv")
qing.js <- read_csv("下载/CBDB_exams_Qing_WGS84_GWU.csv")

1

sort(table(nsong.js$AddrChn), decreasing=TRUE)

1

sort(table(ming.js$AddrChn), decreasing=TRUE)

1

sort(table(qing.js$AddrChn), decreasing=TRUE)

1
2
3
4
5
6
7
8
9

library(dplyr)
library(ggplot2)
library(ggthemes)
jinshi <- do.call("bind_rows", list(nsong.js, ming.js, qing.js))
jinshi.putian <- jinshi[jinshi$AddrChn=='莆田',]
jinshi.putian <- dcast(jinshi.putian, EntryYear~., length)
jinshi.putian$EntryYear <- as.integer(jinshi.putian$EntryYear)
ggplot() + geom_bar(aes(EntryYear, .), stat='identity', data=jinshi.putian) +
    theme_hc() + ggtitle("莆田进士数变迁") + xlab("年份") + ylab("人数")

1

sort(table(jinshi$AddrChn), decreasing=TRUE)

1
2
3
4
5
6
7
8
9

cn.mapdata <- readOGR("下载/Regime_Bou/CHN_adm1.shp")
tw.mapdata <- readOGR("下载/Regime_Bou/TWN_adm0.shp")
p.chn <- ggplot() + geom_polygon(
    aes(long, lat, group=group), data=cn.mapdata,
    fill='gray97', color='gray', linetype=2, size=0.2) +
    geom_polygon(
        aes(long, lat, group=group), data=tw.mapdata,
        fill='gray97', color='gray', linetype=2, size=0.2) +
    theme_minimal() + coord_map()

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12

get_xml_list <- function(xml){
    library(XML)
    xmlToList(xmlParse(xml))
}
get_coord_df <- function(lst, split="[ ,]", id=1){
    staging <- strsplit(lst, split)
    out <- data.frame(matrix(
        as.numeric(unlist(staging)), byrow=TRUE, ncol=2))
    names(out) <- c("long", "lat")
    out$id <- id
    return(out)
}

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

# 北宋
nsong.xml <- get_xml_list("~/下载/northSong.kml")
nsong.bou <- c(
    nsong.xml[[1]][[3]][[3]]$Polygon$outerBoundaryIs$LinearRing$coordinates,
    nsong.xml[[1]][[3]][[4]]$Polygon$outerBoundaryIs$LinearRing$coordinates)
nsong.bou <- mapply(get_coord_df, nsong.bou, id=1:2, SIMPLIFY=FALSE)
names(nsong.bou) <- 1:2
nsong.bou <- do.call('rbind', nsong.bou)
# 明朝
ming.xml <- get_xml_list("~/下载/ming.kml")
ming.bou <- c(
    ming.xml[[1]][[3]][[3]]$outerBoundaryIs$LinearRing$coordinates,
    ming.xml[[1]][[4]][[3]]$outerBoundaryIs$LinearRing$coordinates,
    ming.xml[[1]][[5]][[3]]$outerBoundaryIs$LinearRing$coordinates)
ming.bou <- mapply(get_coord_df, ming.bou, id=1:3, SIMPLIFY=FALSE)
names(ming.bou) <- 1:3
ming.bou <- do.call('rbind', ming.bou)
# 清朝
qing.xml <- get_xml_list("~/下载/qing.kml")
qing.bou <- c(
    qing.xml[[1]][[3]][[3]]$outerBoundaryIs$LinearRing$coordinates,
    qing.xml[[1]][[4]][[3]]$outerBoundaryIs$LinearRing$coordinates,
    qing.xml[[1]][[5]][[3]]$outerBoundaryIs$LinearRing$coordinates,
    qing.xml[[1]][[6]][[3]]$outerBoundaryIs$LinearRing$coordinates)
qing.bou <- mapply(get_coord_df, qing.bou, id=1:4, SIMPLIFY=FALSE)
names(qing.bou) <- 1:4
qing.bou <- do.call('rbind', qing.bou)

1
2
3
4
5
6
7
8
9

p.song <- p.chn + geom_polygon(aes(long, lat, group=id),
	data=nsong.bou, fill="red", alpha=0.1) +
    ggtitle("北宋疆域")
p.ming <- p.chn + geom_polygon(aes(long, lat, group=id),
	data=ming.bou, fill="red", alpha=0.1) +
    ggtitle("明朝疆域")
p.qing <- p.chn + geom_polygon(aes(long, lat, group=id),
	data=qing.bou, fill="black", alpha=0.1)+
    ggtitle("清朝疆域")

1
2
3
4
5
6
7

p.song + geom_point(aes(x_coord, y_coord), data=nsong.js,
	color="blue", alpha=0.2, size=0.5) +
    ggtitle("北宋进士来源地")
p.song + stat_density_2d(aes(x_coord, y_coord, fill=..level..),
    data=nsong.js, geom="polygon", alpha=0.5) +
    scale_fill_gradient(low="cyan", high="darkblue")+
    ggtitle("北宋进士来源地")

1
2
3
4
5
6
7

p.ming + geom_point(aes(x_coord, y_coord), data=ming.js,
	color="blue", alpha=0.2, size=0.5)+
    ggtitle("明朝进士来源地")
p.ming + stat_density_2d(aes(x_coord, y_coord, fill=..level..),
	data=ming.js, geom="polygon", alpha=0.5) +
    scale_fill_gradient(low="cyan", high="darkblue")+
    ggtitle("明朝进士来源地")

1
2
3
4
5
6
7

p.qing + geom_point(aes(x_coord, y_coord), data=qing.js,
	color="blue", alpha=0.2, size=0.5)+
    ggtitle("清朝进士来源地")
p.qing + stat_density_2d(aes(x_coord, y_coord, fill=..level..),
	data=qing.js, geom="polygon", alpha=0.5) +
    scale_fill_gradient(low="cyan", high="darkblue")+
    ggtitle("清朝进士来源地")

1
2
3
4
5
6
7

p.chn + geom_point(aes(x_coord, y_coord), data=jinshi,
	color="blue", alpha=0.2, size=0.5)+
    ggtitle("北宋、明、清进士来源地")
p.chn + stat_density_2d(aes(x_coord, y_coord, fill=..level..),
	data=jinshi, geom="polygon", alpha=0.5) +
    scale_fill_gradient(low="cyan", high="darkblue")+
    ggtitle("北宋、明、清进士来源地")

1
2
3
4

library(RSQLite)
con <- dbConnect(SQLite(), "下载/cbdb_sqlite.db")
addr <- dbReadTable(con, "ADDRESSES")
dbDisconnect(con)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

get_stat <- function(addr, jsdt, dyn.name, yr.begin, yr.end){
	addr.dyn <- addr[addr$belongs3_Name == dyn.name |
					  addr$belongs4_Name == dyn.name |
                      addr$belongs5_Name == dyn.name,]
	addr.dyn <-addr.dyn[!is.na(addr.dyn$c_name_chn),]
	addr.dyn$Prov <- addr.dyn$belongs2_Name
	i <- which(addr.dyn$belongs4_Name == dyn.name)
	addr.dyn$Prov[i] <- addr.dyn$belongs3_Name[i]
	i <- which(addr.dyn$belongs5_Name == dyn.name)
	addr.dyn$Prov[i] <- addr.dyn$belongs4_Name[i]
	addr.dyn <- addr.dyn[!duplicated(addr.dyn$c_name_chn),]
	js <- merge(jsdt, addr.dyn[,c("c_name_chn", "Prov")],
                by.x="AddrChn", by.y="c_name_chn", all.x=TRUE)
	js$Decade <- cut(as.numeric(js$EntryYear), seq(yr.begin, yr.end, 10))
	js$Decade <- factor(js$Decade,
		labels=seq(yr.begin, yr.end, 10)[1:nlevels(nsong.js$Decade)])

	stat1 <- dcast(js, Prov~., length)
	stat1 <- stat1[order(stat1$., decreasing=TRUE),]

	stat <- dcast(js, Decade~Prov, length)
	stat <- melt(stat, id="Decade", stringsAsFactors=FALSE)
	stat$Decade <- as.integer(as.character(stat$Decade))
	stat$variable <- factor(stat$variable, levels=stat1$Prov)
	stat <- stat[!is.na(stat$variable) & stat$variable != 'NA',]
	return(stat)
}

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11

palcols <- c(hc_pal()(10), tableau_color_pal()(10), wsj_pal()(6),
		  canva_pal()(4), economist_pal()(10))
nsong.stat <- get_stat(addr, nsong.js, "宋朝", 960, 1130)
cols <- palcols[(1:nlevels(nsong.stat$variable))]
names(cols) <- levels(nsong.stat$variable)
ggplot(nsong.stat, aes(Decade, value, fill=variable))+
    geom_area(stat="identity", position="fill", alpha=0.75) +
    scale_fill_manual(values=cols) + theme_minimal() +
    scale_y_continuous(labels=scales::percent)+
    xlab("年份") + ylab("比重") + ggtitle("北宋进士来源地比重变迁")+
    theme(legend.position="bottom")

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13

ming.stat <- get_stat(addr, ming.js, "明朝", 1360, 1650)
ming.stat$variable <- gsub("(^.+)(布政司|巡撫|總督|留守司)$", "\\1",
							ming.stat$variable)
ming.stat <- dcast(ming.stat, Decade ~ variable, sum)
ming.stat$Decade <- as.integer(ming.stat$Decade)
cols <- palcols[(1:nlevels(ming.stat$variable))]
names(cols) <- levels(ming.stat$variable)
ggplot(ming.stat, aes(Decade, value, fill=variable))+
    geom_area(stat="identity", position="fill", alpha=0.75) +
    scale_fill_manual(values=cols) + theme_minimal() +
    scale_y_continuous(labels=scales::percent)+
    xlab("年份") + ylab("比重") + ggtitle("明朝进士来源地比重变迁")+
    theme(legend.position="bottom")

1
2
3
4
5
6
7
8
9

qing.stat <- get_stat(addr, qing.js, "清朝", 1640, 1910)
cols <- palcols[(1:nlevels(qing.stat$variable))]
names(cols) <- levels(qing.stat$variable)
ggplot(qing.stat, aes(Decade, value, fill=variable))+
    geom_area(stat="identity", position="fill", alpha=0.75) +
    scale_fill_manual(values=cols) + theme_minimal() +
    scale_y_continuous(labels=scales::percent)+
    xlab("年份") + ylab("比重") + ggtitle("清朝进士来源地比重变迁")+
    theme(legend.position="bottom")

1
2
3

library(stringr)
fam.name <- str_sub(jinshi$NameChn, 1,1)
sort(table(fam.name), decreasing=TRUE)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13

jinshi$FamilyName <- fam.name
for (famName in c(
    "王", "李", "瀳", "隇", "劉", "吳", "楊", "黃", "林", "周")){
    pp <- p.chn + geom_point(aes(x_coord, y_coord),
        data=jinshi[jinshi$FamilyName==famName,],
            color="blue", alpha=0.2, size=0.5)+
        stat_density_2d(aes(x_coord, y_coord, fill=..level..),
                        data=jinshi[jinshi$FamilyName==famName,],
                        geom="polygon", alpha=0.5) +
        scale_fill_gradient(low="cyan", high="darkblue")+
        ggtitle(paste0("北宋、明、清", fam.name, "姓进士来源地"))
    print(pp)
}