# Things that need to be done just once
if (FALSE) {
# We need the dev version of ggrepel
devtools::install_github("slowkow/ggrepel")
# Install Lato font on machine, then import it into extrafont library
extrafont::font_import(pattern = "Lato")
}
library(tidyverse)
extrafont::loadfonts(device = "win", quiet = TRUE)
# My plotting theme
theme_teej <- function(base_size = 11, base_family = "Lato Medium",
base_line_size = base_size / 22,
base_rect_size = base_size / 22) {
half_line <- base_size / 2
start <- theme_grey(
base_size = base_size,
base_family = base_family,
base_line_size = base_line_size,
base_rect_size = base_rect_size
)
start %+replace%
theme(
axis.title = element_text(hjust = 1),
strip.text = element_text(
hjust = 0,
family = "Lato Medium",
size = rel(1),
margin = margin(
t = 0.80 * half_line,
r = 0.25 * half_line,
b = 0.80 * half_line,
l = 0.25 * half_line)
),
strip.background = element_rect(fill = NA, colour = NA)
)
}
# # code I used to compute intervals
# posterior <- data_posterior %>%
# group_by(group, parameter) %>%
# tidybayes::median_qih(.width = c(0, .5, .8, .95))
# created with datapasta::tribble_paste()
posterior <- tibble::tribble(
~group, ~parameter, ~value, ~.lower, ~.upper, ~.width, ~.point, ~.interval,
"NSMI", "mid", 40.1512906665361, 40.1512906665361, 40.1512906665361, 0, "median", "qi",
"NSMI", "phi", 38.1339458186469, 38.1339458186469, 38.1339458186469, 0, "median", "qi",
"NSMI", "prop", 0.862307327544911, 0.862307327544911, 0.862307327544911, 0, "median", "qi",
"NSMI", "slope", 0.0211848195996685, 0.0211848195996685, 0.0211848195996685, 0, "median", "qi",
"SMIMLCI", "mid", 50.0313657660507, 50.0313657660507, 50.0313657660507, 0, "median", "qi",
"SMIMLCI", "phi", 18.1460194734679, 18.1460194734679, 18.1460194734679, 0, "median", "qi",
"SMIMLCI", "prop", 0.600764180915117, 0.600764180915117, 0.600764180915117, 0, "median", "qi",
"SMIMLCI", "slope", 0.00550809947821239, 0.00550809947821239, 0.00550809947821239, 0, "median", "qi",
"SMIMLCT", "mid", 53.8505226177306, 53.8505226177306, 53.8505226177306, 0, "median", "qi",
"SMIMLCT", "phi", 27.9466215408407, 27.9466215408407, 27.9466215408407, 0, "median", "qi",
"SMIMLCT", "prop", 0.768006391325915, 0.768006391325915, 0.768006391325915, 0, "median", "qi",
"SMIMLCT", "slope", 0.0157599852671279, 0.0157599852671279, 0.0157599852671279, 0, "median", "qi",
"NSMI", "mid", 40.1512906665361, 38.6626678980382, 41.6633643635245, 0.5, "median", "qi",
"NSMI", "phi", 38.1339458186469, 35.0419249880578, 41.3272609475226, 0.5, "median", "qi",
"NSMI", "prop", 0.862307327544911, 0.838443006415332, 0.882626910532456, 0.5, "median", "qi",
"NSMI", "slope", 0.0211848195996685, 0.0196282759454783, 0.0228212429800172, 0.5, "median", "qi",
"SMIMLCI", "mid", 50.0313657660507, 44.342745599758, 55.989090875593, 0.5, "median", "qi",
"SMIMLCI", "phi", 18.1460194734679, 15.8992814866775, 20.5630293175756, 0.5, "median", "qi",
"SMIMLCI", "prop", 0.600764180915117, 0.529105503139899, 0.669300399142929, 0.5, "median", "qi",
"SMIMLCI", "slope", 0.00550809947821239, 0.00430313892377911, 0.00703196566056379, 0.5, "median", "qi",
"SMIMLCT", "mid", 53.8505226177306, 52.3417842389953, 55.4110869956611, 0.5, "median", "qi",
"SMIMLCT", "phi", 27.9466215408407, 25.9557115046007, 30.0220251218974, 0.5, "median", "qi",
"SMIMLCT", "prop", 0.768006391325915, 0.730126148857925, 0.805146261216979, 0.5, "median", "qi",
"SMIMLCT", "slope", 0.0157599852671279, 0.0146202354368508, 0.0169273307672776, 0.5, "median", "qi",
"NSMI", "mid", 40.1512906665361, 37.3851582023825, 43.0361881660536, 0.8, "median", "qi",
"NSMI", "phi", 38.1339458186469, 32.5321324091804, 44.2677499291782, 0.8, "median", "qi",
"NSMI", "prop", 0.862307327544911, 0.815115314617659, 0.898665975103861, 0.8, "median", "qi",
"NSMI", "slope", 0.0211848195996685, 0.0182932249237414, 0.0243686527289431, 0.8, "median", "qi",
"SMIMLCI", "mid", 50.0313657660507, 39.377920266859, 61.5002037382172, 0.8, "median", "qi",
"SMIMLCI", "phi", 18.1460194734679, 14.1820580577392, 23.0164123722118, 0.8, "median", "qi",
"SMIMLCI", "prop", 0.600764180915117, 0.467297001732489, 0.731748657810347, 0.8, "median", "qi",
"SMIMLCI", "slope", 0.00550809947821239, 0.00342224629075752, 0.00903699245637957, 0.8, "median", "qi",
"SMIMLCT", "mid", 53.8505226177306, 51.003116242772, 56.7894090662208, 0.8, "median", "qi",
"SMIMLCT", "phi", 27.9466215408407, 24.1972835569052, 32.091587213647, 0.8, "median", "qi",
"SMIMLCT", "prop", 0.768006391325915, 0.693411903548042, 0.835532145209722, 0.8, "median", "qi",
"SMIMLCT", "slope", 0.0157599852671279, 0.0136126794560865, 0.0180185700498226, 0.8, "median", "qi",
"NSMI", "mid", 40.1512906665361, 35.932984887005, 44.6165891658308, 0.95, "median", "qi",
"NSMI", "phi", 38.1339458186469, 29.9576183860332, 47.7213561836896, 0.95, "median", "qi",
"NSMI", "prop", 0.862307327544911, 0.785699090622336, 0.913810132395412, 0.95, "median", "qi",
"NSMI", "slope", 0.0211848195996685, 0.0167567302206072, 0.0262668363239787, 0.95, "median", "qi",
"SMIMLCI", "mid", 50.0313657660507, 33.4603680810194, 68.2234488658527, 0.95, "median", "qi",
"SMIMLCI", "phi", 18.1460194734679, 12.3383091136992, 26.2253243087712, 0.95, "median", "qi",
"SMIMLCI", "prop", 0.600764180915117, 0.400838498312218, 0.78846296635821, 0.95, "median", "qi",
"SMIMLCI", "slope", 0.00550809947821239, 0.0025260454854747, 0.0123261226261669, 0.95, "median", "qi",
"SMIMLCT", "mid", 53.8505226177306, 49.5325645753245, 58.5949914876063, 0.95, "median", "qi",
"SMIMLCT", "phi", 27.9466215408407, 22.5124805034684, 34.3787008065597, 0.95, "median", "qi",
"SMIMLCT", "prop", 0.768006391325915, 0.647276291648422, 0.866722063519153, 0.95, "median", "qi",
"SMIMLCT", "slope", 0.0157599852671279, 0.012414067853522, 0.0193024700700164, 0.95, "median", "qi"
)
# Labeling!
fct_set_slpg_srcld3 <- function(xs) {
levels <- c("NSMI", "SMIMLCT", "SMIMLCI")
labels <- c(
"No dysarthria",
"Dysarthria\nwith typical\ncomprehension",
"Dysarthria\nwith impaired\ncomprehension"
)
# reversing here so it runs down the y-axis
forcats::fct_rev(factor(xs, levels, labels))
}
fct_set_parameter <- function(xs) {
levels <- c("mid", "prop", "slope", "phi")
labels <- c(
"Age of steepest growth (months)",
"Asymptote (max) intelligibility",
"Steepest growth rate (% per month)",
"Precision parameter"
)
factor(xs, levels, labels)
}
fct_set_width <- function(xs) {
levels <- c(.95, .8, .5, 0)
labels <- c("95%", "80%", "50%", "median")
factor(xs, levels, labels)
}
posterior <- posterior %>%
mutate(
group = fct_set_slpg_srcld3(group),
parameter = fct_set_parameter(parameter)
)
colors <- c(rev(colorspace::sequential_hcl(3, palette = "Peach")), "black")
note_size <- 3.5
ggplot(posterior) +
aes(x = value, y = group) +
# draw the bands
tidybayes::geom_intervalh(
aes(color = fct_set_width(.width)),
data = . %>% filter(.width != 0)
) +
# draw the median
geom_point(
aes(x = value, color = fct_set_width(.width)),
data = . %>% filter(.width == 0)
) +
ggrepel::geom_text_repel(
data = tibble(
value = 40,
parameter = fct_set_parameter("mid"),
group = fct_set_slpg_srcld3("NSMI")
),
label = "about a year earlier than CP peers",
hjust = 0,
nudge_x = 4,
nudge_y = .35,
segment.curvature = +1e-20,
family = "Lato Medium",
size = note_size,
point.padding = .5
) +
ggrepel::geom_text_repel(
data = tibble(
value = 53,
parameter = fct_set_parameter("mid"),
group = fct_set_slpg_srcld3("SMIMLCT")
),
label = "intervene during age 4\nto accelerate growth?",
hjust = 0,
nudge_x = 3,
nudge_y = -.35,
segment.curvature = -1e-20,
family = "Lato Medium",
size = note_size,
point.padding = .5
) +
ggrepel::geom_text_repel(
data = tibble(
value = .41,
parameter = fct_set_parameter("prop"),
group = fct_set_slpg_srcld3("SMIMLCI")
),
label = "average growth features for group were very uncertain",
hjust = 0,
nudge_x = .04,
nudge_y = .35,
segment.curvature = +1e-20,
family = "Lato Medium",
size = note_size,
point.padding = .5
) +
ggrepel::geom_text_repel(
data = tibble(
value = .01575,
parameter = fct_set_parameter("slope"),
group = fct_set_slpg_srcld3("SMIMLCT")
),
label = "intelligibility increased by \n1.5 percentage-points per month",
hjust = 0,
nudge_x = .001,
nudge_y = -.45,
segment.curvature = +1e-20,
family = "Lato Medium",
size = note_size,
point.padding = .5
) +
ggrepel::geom_text_repel(
data = tibble(
value = 30,
parameter = fct_set_parameter("phi"),
group = fct_set_slpg_srcld3("SMIMLCI")
),
label = "intelligibility scores were noisier with dysarthria",
hjust = .5,
nudge_y = .5,
# suppress the line from being drawn
min.segment.length = 100,
family = "Lato Medium",
size = note_size
) +
facet_wrap("parameter", scales = "free_x") +
scale_color_manual(
breaks = c("95%", "80%", "50%", "median"),
values = colors
) +
# Some trickery to manually label the percentages because we know
# they are really small values
scale_x_continuous(
NULL,
labels = function(xs) {
if (max(xs, na.rm = TRUE) < .05) {
scales::percent(xs, accuracy = .1)
} else if (max(xs, na.rm = TRUE) < 1) {
scales::percent(xs, accuracy = 1)
} else {
xs
}
}
) +
labs(y = NULL) +
guides(
color = guide_legend(
title = "Posterior intervals",
# Customize appearance of four boxes in legend
override.aes = list(
# Draw lines in first three, no line in last.
linetype = c(rep(1, 3), 0),
# Draw the point in last one.
shape = c(rep(NA, 3), 16)
)
)
) +
theme_teej(base_size = 16) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
legend.justification = "right",
legend.title = element_text(size = rel(.8)),
legend.text = element_text(size = rel(.8)),
legend.key = element_rect(fill = NA),
legend.box.spacing = unit(0, "pt"),
legend.background = element_rect(fill = NA)
)
Created on 2019-06-06 by the reprex package (v0.3.0)