-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathB.7 plot_topic_year_growth_analysis.R
116 lines (101 loc) · 3.37 KB
/
B.7 plot_topic_year_growth_analysis.R
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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
rm(list = ls())
library("stm")
library("corrr")
library("tidyverse")
library("corrr")
library("igraph")
library("ggraph")
library("reshape2")
library("ggplot2")
library("betareg")
source("functions.R")
#load and initialize data
stm_outputs <- readRDS("outputs/stmoutput_filt_50.rds")
data <- readRDS("outputs/stm_doc.rds")$data
topics <- read.csv("outputs/stmoutput_filt_50.csv")
u_year <- sort(unique(data$Year))
# parameter for estimation
nsims <- 10
uncertainty <- "Global"
# perform estimation
set.seed(1234)
reg_lm <- stm::estimateEffect(~ 1 + as.factor(Year),
stm_outputs,
metadata = data,
uncertainty = uncertainty,
nsims = nsims)
set.seed(1234)
reg_beta <- f_estimateEffect(~ 1 + as.factor(Year),
stm_outputs,
metadata = data,
uncertainty = uncertainty,
type = "betareg",
nsims = nsims)
##### Save regression results ######
save(reg_lm, reg_beta, file = "outputs/fit_B.7.rda")
####################################
rm(list = ls())
library("stm")
library("corrr")
library("tidyverse")
library("corrr")
library("igraph")
library("ggraph")
library("reshape2")
library("ggplot2")
library("betareg")
source("functions.R")
#load and initialize data
stm_outputs <- readRDS("outputs/stmoutput_filt_50.rds")
data <- readRDS("outputs/stm_doc.rds")$data
topics <- read.csv("outputs/stmoutput_filt_50.csv")
# post-process estimation
load(file = "outputs/fit_B.7.rda")
reg <- reg_lm
limit <- c(-4, 5)
reg <- reg_beta
limit <- c(-40, 50)
set.seed(1234)
reg_res2 <- summary(reg)
reg_res2 <- sapply(reg_res2$tables, FUN = function(x) x[2:nrow(x), 1] * 100)
#Remove non-valid topics
pos_rm <- which(topics$label == "Remainder 2" |
topics$label == "Remainder 1" |
topics$label == "Financial Literature Analysis" |
topics$label == "Literature Review" |
topics$label == "Statistical Modeling")
reg_res2 <- reg_res2[, -pos_rm]
topics <- topics[-pos_rm, ]
colnames(reg_res2) <- topics$label
reg_res2 <- reg_res2[, order(colMeans(reg_res2[1:29,]))]
rownames(reg_res2) <- 1993:2021
melted_cormat <- melt(reg_res2)
##### generate figure ######
limit <- c(min(melted_cormat$value), max(melted_cormat$value))
p1 <- ggplot(data = melted_cormat,
aes(x = Var1,
y = Var2,
fill = value)) +
scale_fill_gradient2(low = "red",
high = "cyan",
mid = "gray10",
midpoint = 0,
limit = limit,
space = "Lab",
name = "Coefficient") +
scale_x_continuous(breaks = seq(1992, 2021, 1)) +
geom_tile() +
xlab("Year") +
ylab("Topic") +
theme_minimal() +
theme(legend.position = "bottom",
text = element_text(size = 30),
axis.text.x = element_text(size = 26,
angle = 90,
vjust = 0.5,
hjust = 1),
axis.text.y = element_text(size = 26),
legend.key.size = unit(2, "cm"))
####### SAVE ######
ggsave("figures/fig_7_growth_topic.pdf", plot = p1, width = 20, height = 20)
###################