Skip to content

Commit 5a75a31

Browse files
l-acsl-acs
committed
WIP: beautify plots for publication
1 parent d42b91b commit 5a75a31

File tree

2 files changed

+165
-40
lines changed

2 files changed

+165
-40
lines changed

‎code/analysisReadAloudBeta.R‎

Lines changed: 59 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -128,6 +128,7 @@ library(htmlTable) # for descriptive table
128128
# library(colorblindr)
129129
library(MetBrewer)
130130
library(RColorBrewer)
131+
library(merDeriv)
131132

132133
# ```
133134
# Warning in install.packages :
@@ -633,11 +634,17 @@ plot_model(model11_z_scored,
633634

634635
# Jess' version
635636
plot_fig_2 <- function() {
636-
coefsmodel11z <- summary(model11_z_scored)$coef
637-
cis <- confint(model11_z_scored)
638-
b0 <- coefsmodel11z[1]
639-
b1 <- coefsmodel11z[2]
640-
se <- coefsmodel11z[4]
637+
638+
# fixme
639+
# coefsmodel11z <- summary(model11_z_scored)$coef
640+
# cis <- confint(model11_z_scored)
641+
# b0 <- coefsmodel11z[1]
642+
# b1 <- coefsmodel11z[2]
643+
# se <- coefsmodel11z[4]
644+
m2_params <- parameters::model_parameters(model11_z_scored)
645+
b0 <- m2_params$Coefficient[1]
646+
b1 <- m2_params$Coefficient[2]
647+
se <- m2_params$SE[2] # also confirm we use this
641648

642649
#bootstrap ci ribbon
643650
iterations = 1000
@@ -652,13 +659,20 @@ plot_fig_2 <- function() {
652659
a[i,3] <- lme4::fixef(mdl)[2]
653660
}
654661

662+
ll <- mean(a$beta) - (2 * sd(a$beta))
663+
ul <- mean(a$beta) + (2 * sd(a$beta))
664+
665+
print(sum(a$beta<ul & a$beta>ll))
666+
#sum(a$beta<ul & a$beta>ll) #this should be ~950 if iterations=1000
667+
668+
a <- filter(a, beta<ul & beta>ll)
655669

656670
#create df for annotation
657671
label_text <- data.frame(
658-
label = c(paste("\u03b2 = ", digit_display(b1),
659-
"\nSE = ", digit_display(se),
660-
"\nCI = [", digit_display(cis[5,1]), " - ", digit_display(cis[5,2]), "]",
661-
"\np ", tinyps(coefsmodel11z[10]), sep="")),
672+
# label = c(paste("\u03b2 = ", digit_display(b1),
673+
# "\nSE = ", digit_display(se),
674+
# "\nCI = [", digit_display(cis[5,1]), " - ", digit_display(cis[5,2]), "]",
675+
# "\np ", tinyps(coefsmodel11z[10]), sep="")),
662676
scaaredSoc_z = c(-1.1),
663677
#words_with_hes_rate_z = c(4.5)) #location for plot with all datapoints
664678
words_with_hes_rate_z = c(0.75)) #location for plot with limited y-axis
@@ -674,7 +688,8 @@ plot_fig_2 <- function() {
674688

675689
p <- p + geom_abline(intercept=b0, slope=b1, color=rwe_palette[14], linewidth=1) +
676690
guides(color=FALSE, shape=FALSE) +
677-
geom_label(data=label_text, aes(x=scaaredSoc_z, y=words_with_hes_rate_z, label=label), size=3) +
691+
# geom_label(data=label_text,
692+
# aes(x=scaaredSoc_z, y=words_with_hes_rate_z), size=3) +
678693
ylim(-0.9, 0.9) + #remove this line for plot with all datapoints
679694
theme_bw() +
680695
theme(plot.title = element_text(size=18, hjust=0.05, face='bold'),
@@ -972,20 +987,24 @@ plot_model(f_model24_z_scored,
972987
# Jess' version, wip
973988
plot_fig_3 <- function() {
974989
# determine degrees of purple needed for this variable
975-
rwe_palette_custom <- brewer.pal(4, "Purples")
976-
number_of_values <-
977-
pull(errorDat, words_with_hes_rate_z) %>%
978-
unique %>%
979-
length
980-
981-
rwe_palette_custom <- colorRampPalette(rwe_palette_custom)(number_of_values+3)
982-
rwe_palette_custom <- rwe_palette_custom[4:(number_of_values+3)]
983-
984-
coefsmodel11z <- summary(f_model24_z_scored)$coef
985-
cis <- confint(f_model24_z_scored)
986-
b0 <- coefsmodel11z[1]
987-
b1 <- coefsmodel11z[2]
988-
se <- coefsmodel11z[4]
990+
# rwe_palette_custom <- brewer.pal(4, "Purples")
991+
# number_of_values <-
992+
# pull(errorDat, scaaredSoc_z) %>% # RERUN NOW THAT I'VE FIXED THIS
993+
# unique %>%
994+
# length
995+
#
996+
# rwe_palette_custom <- colorRampPalette(rwe_palette_custom)(number_of_values+3)
997+
# rwe_palette_custom <- rwe_palette_custom[4:(number_of_values+3)]
998+
#
999+
# coefsmodel11z <- summary(f_model24_z_scored)$coef
1000+
# cis <- confint(f_model24_z_scored)
1001+
# b0 <- coefsmodel11z[1]
1002+
# b1 <- coefsmodel11z[2]
1003+
# se <- coefsmodel11z[4]
1004+
m2_params <- parameters::model_parameters(model11_z_scored)
1005+
b0 <- m2_params$Coefficient[1]
1006+
b1 <- m2_params$Coefficient[2]
1007+
se <- m2_params$SE[2] # also confirm we use this
9891008

9901009
#bootstrap ci ribbon
9911010
iterations = 1000
@@ -1000,28 +1019,37 @@ plot_fig_3 <- function() {
10001019
a[i,3] <- lme4::fixef(mdl)[2]
10011020
}
10021021

1022+
ll <- mean(a$beta) - (2 * sd(a$beta))
1023+
ul <- mean(a$beta) + (2 * sd(a$beta))
1024+
1025+
print(sum(a$beta<ul & a$beta>ll))
1026+
#sum(a$beta<ul & a$beta>ll) #this should be ~950 if iterations=1000
1027+
1028+
a <- filter(a, beta<ul & beta>ll)
10031029

10041030
#create df for annotation
10051031
label_text <- data.frame(
1006-
label = c(paste("\u03b2 = ", digit_display(b1),
1007-
"\nSE = ", digit_display(se),
1008-
"\nCI = [", digit_display(cis[5,1]), " - ", digit_display(cis[5,2]), "]",
1009-
"\np ", tinyps(coefsmodel11z[10]), sep="")),
1032+
# label = c(paste("\u03b2 = ", digit_display(b1),
1033+
# "\nSE = ", digit_display(se),
1034+
# "\nCI = [", digit_display(cis[5,1]), " - ", digit_display(cis[5,2]), "]",
1035+
# "\np ", tinyps(coefsmodel11z[10]), sep="")),
10101036
words_with_hes_rate_z = c(-1.1),
1037+
#words_with_hes_rate_z = c(4.5)) #location for plot with all datapoints
10111038
words_with_misprod_rate_z = c(0.75)) #location for plot with limited y-axis
10121039

1040+
10131041
#plot
10141042
p <- ggplot(errorDat, aes(x=words_with_hes_rate_z, y=words_with_misprod_rate_z)) +
10151043
geom_jitter(aes(color=factor(words_with_hes_rate_z)), alpha=0.5, width=0.05, show.legend=FALSE) +
1016-
scale_color_manual(values=rwe_palette_custom)
1044+
scale_color_manual(values=rwe_palette)
10171045

10181046
for(i in 1:nrow(a)){ #add bootstrapped lines to show confidence interval
10191047
p <- p + geom_abline(intercept=as.numeric(a[i,2]), slope=as.numeric(a[i,3]), color=rwe_palette_custom[3], alpha=0.1)
10201048
}
10211049

1022-
p <- p + geom_abline(intercept=b0, slope=b1, color=rwe_palette_custom[number_of_values], linewidth=1) +
1050+
p <- p + geom_abline(intercept=b0, slope=b1, color=rwe_palette[14], linewidth=1) +
10231051
guides(color=FALSE, shape=FALSE) +
1024-
geom_label(data=label_text, aes(x=words_with_hes_rate_z, y=words_with_misprod_rate_z, label=label), size=3) +
1052+
geom_label(data=label_text, aes(x=words_with_hes_rate_z, y=words_with_misprod_rate_z), size=3) +
10251053
ylim(-0.9, 0.9) + #remove this line for plot with all datapoints
10261054
theme_bw() +
10271055
theme(plot.title = element_text(size=18, hjust=0.05, face='bold'),

‎code/analysisWordLevelReadAloudBeta.R‎

Lines changed: 106 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1352,28 +1352,125 @@ interact_plot(model = wordfreq_model_with_absents_as_median_4_z_scored_logistic,
13521352
interval = TRUE,
13531353
x.label = expression(
13541354
atop("log"['10']*" word frequency",
1355-
"(lower = more rare)")),
1355+
"(z-scored; lower = more rare)")),
13561356
y.label = expression(
1357-
atop("Probability of misproduction",
1357+
atop("Probability of Misproduction",
13581358
"(word-level)")),
1359-
legend.main = "SCAARED-Social score\n(z-scored)",
1359+
legend.main = "SCAARED-Social Score\n(z-scored)",
13601360
main.title = "Item-Level Word Frequency, Social Anxiety Severity, and Item-Level Misproductions") +
13611361
theme(plot.title = element_text(hjust = 0.5))
13621362

13631363
# alt plot
1364+
# interact_plot(model = wordfreq_model_with_absents_as_median_4_z_scored_logistic,
1365+
# pred = log10frequency_with_absents_as_median_z,
1366+
# modx = scaaredSoc_z,
1367+
# interval = TRUE,
1368+
# colors = "Purples",
1369+
# x.label = expression(
1370+
# atop("log"['10']*" word frequency",
1371+
# "(z-scored; lower = more rare)")),
1372+
# y.label = expression(
1373+
# atop("Probability of Misproduction",
1374+
# "(word-level)")),
1375+
# legend.main = "SCAARED-Social Score\n(z-scored)",
1376+
# main.title = "Item-Level Word Frequency × Social Anxiety Severity × Item-Level Misproductions") +
1377+
# theme( plot.title = element_text(hjust = -0.05, size = 18),
1378+
# text = element_text(size = 16))
1379+
13641380
interact_plot(model = wordfreq_model_with_absents_as_median_4_z_scored_logistic,
13651381
pred = log10frequency_with_absents_as_median_z,
13661382
modx = scaaredSoc_z,
13671383
interval = TRUE,
1384+
colors = "Purples",
13681385
x.label = expression(
1369-
atop("log"['10']*" word frequency",
1370-
"(lower = more rare)")),
1386+
atop("Word Frequency",
1387+
"(z-scored logarithm; lower = more rare)")),
13711388
y.label = expression(
1372-
atop("Probability of misproduction",
1389+
atop("Probability of Misproduction",
13731390
"(word-level)")),
1374-
legend.main = "SCAARED-Social score\n(z-scored)",
1375-
main.title = "Item-Level Word Frequency, Social Anxiety Severity, and Item-Level Misproductions") +
1376-
theme(plot.title = element_text(hjust = -2, size = 18), text = element_text(size = 16))
1391+
legend.main = "SCAARED-Social Score\n(z-scored)",
1392+
main.title = "Item-Level Word Frequency × Social Anxiety Symptom Severity × Item-Level Misproductions") +
1393+
theme(plot.title = element_text(hjust = -0.05, size = 18),
1394+
text = element_text(size = 16),
1395+
legend.position = "inside",
1396+
legend.position.inside = c(0.792, 0.7065))
1397+
1398+
# Jess' version
1399+
plot_fig_4 <- function() { # FIXME
1400+
# determine degrees of purple needed for this variable
1401+
# rwe_palette_custom <- brewer.pal(4, "Purples")
1402+
# number_of_values <-
1403+
# pull(errorDat, log10frequency_with_absents_as_median_z) %>%
1404+
# unique %>%
1405+
# length
1406+
#
1407+
# rwe_palette_custom <- colorRampPalette(rwe_palette_custom)(number_of_values+3)
1408+
# rwe_palette_custom <- rwe_palette_custom[4:(number_of_values+3)]
1409+
#
1410+
1411+
# fixme don't use coefsmodel
1412+
1413+
# coefsmodel4z <- summary(wordfreq_model_with_absents_as_median_4_z_scored_logistic)$coef
1414+
# cis <- confint(wordfreq_model_with_absents_as_median_4_z_scored_logistic)
1415+
# b0 <- coefsmodel4z[1]
1416+
# b1 <- coefsmodel4z[2] # todo make sure we would actually want b0, and not, like, b3?
1417+
# se <- coefsmodel4z[4]
1418+
# m_params <- parameters::model_parameters(wordfreq_model_with_absents_as_median_4_z_scored_logistic, exponentiate = TRUE)
1419+
# interaction_ci_low_high <- select(m_params[4,], CI_low, CI_high)
1420+
1421+
# #bootstrap ci ribbon
1422+
# iterations = 1000
1423+
# a <- tibble(i=rep(1:iterations,))
1424+
# a <- mutate(a, intercept=NA, beta=NA)
1425+
# for(i in 1:nrow(a)){
1426+
# rows <- sample(1:nrow(errorDat), nrow(errorDat), replace=TRUE)
1427+
# df <- errorDat[rows, c('id', 'passage', 'log10frequency_with_absents_as_median_z', 'words_with_misprod_rate_z')]
1428+
# mdl <- lme4::lmer(words_with_misprod_rate_z ~ log10frequency_with_absents_as_median_z + (1|id) + (1|passage),
1429+
# data=df, REML=TRUE, control=lmerControl(optimizer="bobyqa", optCtrl=list(maxfun=2e5)))
1430+
# a[i,2] <- lme4::fixef(mdl)[1]
1431+
# a[i,3] <- lme4::fixef(mdl)[2]
1432+
# }
1433+
1434+
1435+
#create df for annotation
1436+
# label_text <- data.frame(
1437+
# label = c(paste("\u03b2 = ", digit_display(b1),
1438+
# "\nSE = ", digit_display(se),
1439+
# "\nCI = [", interaction_ci_low_high %>% map_vec(digit_display) %>% paste(collapse = ' - '), "]",
1440+
# "\np ", tinyps(coefsmodel11z[10]), sep="")),
1441+
# log10frequency_with_absents_as_median_z = c(-1.1),
1442+
# misprod_outcome = c(0.75)) #location for plot with limited y-axis
1443+
1444+
#plot
1445+
# check this.............
1446+
p <- ggplot(errorDat, aes(x=log10frequency_with_absents_as_median_z, y=misprod_outcome)) +
1447+
geom_jitter(aes(color=factor(log10frequency_with_absents_as_median_z)), alpha=0.5, width=0.05, show.legend=FALSE) +
1448+
scale_color_manual(values="Purples") #???? fixme
1449+
1450+
# for(i in 1:nrow(a)){ #add bootstrapped lines to show confidence interval
1451+
# p <- p + geom_abline(intercept=as.numeric(a[i,2]), slope=as.numeric(a[i,3]), color=rwe_palette_custom[3], alpha=0.1)
1452+
# }
1453+
1454+
p <- p + geom_abline(intercept=b0, slope=b1, color=rwe_palette_custom[number_of_values], linewidth=1) +
1455+
guides(color=FALSE, shape=FALSE) +
1456+
geom_label(data=label_text, aes(x=words_with_hes_rate_z, y=words_with_misprod_rate_z, label=label), size=3) +
1457+
ylim(-0.9, 0.9) + #remove this line for plot with all datapoints
1458+
theme_bw() +
1459+
theme(plot.title = element_text(size=18, hjust=0.05, face='bold'),
1460+
text = element_text(size=16),
1461+
panel.border = element_blank(),
1462+
panel.grid = element_line(linewidth=0.6, linetype='dashed'),
1463+
panel.grid.minor = element_blank(),
1464+
axis.line.x = element_line(linewidth=0.6, linetype='dashed', color='#bbbbbb60'),
1465+
axis.ticks.x = element_blank()) +
1466+
labs(title="Hesitation Rate × Misproduction Rate",
1467+
x="Rate of Hesitations\n(per word, z-scored)",
1468+
y="Rate of Misproductions\n(per word, z-scored)")
1469+
return(p)
1470+
}
1471+
1472+
ggsave(file.path(outpath, "fig4.jpg"), plot=plot_fig_4(), width=8, height=5, units="in")
1473+
13771474

13781475

13791476
# misprod ~ wf x SA, control for age

0 commit comments

Comments
 (0)