Code
library(tidyverse)
library(magick)
library(webshot2)
library(gt)
library(here)
library(viridis)
library(hrbrthemes)
library(patchwork)
Figure 5
of the paper A Fully Instrumentalised Geolocation- And Smartphone-Based Exposure Therapy for Anxiety Disorders: SyMptOMS-ET
library(tidyverse)
library(magick)
library(webshot2)
library(gt)
library(here)
library(viridis)
library(hrbrthemes)
library(patchwork)
<- here::here("mars-data", "codes.csv")
code_file <- here::here("mars-data", "responses.csv")
data_file
<- readr::read_csv2(code_file, col_names = TRUE,
codes cols(code = col_character(),
category = col_character(),
short_name = col_character(),
long_name = col_character()))
<- read_csv2(data_file, col_names = TRUE,
mars cols(.default = col_integer(),
PART_ID = col_character()))
%>%
mars rowwise() %>%
mutate(A = mean(c(A1,A2,A3,A4,A5)),
B = mean(c(B6,B7,B8,B9)),
C = mean(c(C10,C11,C12)),
D = mean(c(D13,D14,D15,D16)),
F = mean(c(F1,F2,F3,F4,F5,F6))) -> mars
%>%
mars pivot_longer(c('A1', 'A2', 'A3', 'A4', 'A5', 'A',
'B6', 'B7', 'B8', 'B9', 'B',
'C10', 'C11', 'C12', 'C',
'D13', 'D14', 'D15', 'D16', 'D',
'E1','E2', 'E3', 'E4',
'F1','F2','F3','F4','F5','F6','F'), names_to = "code", values_to = "value") %>%
mutate(code = factor(code),
value = as.double(round(value, 2))) %>%
select(code, value) %>%
arrange(code) -> mars_long
::inner_join(mars_long, codes, by="code") %>%
dplyrmutate(type = ifelse(short_name == "Average", "mean", "item")) %>%
select(-long_name) -> mars_tidy
%>%
mars_tidy filter(category=='Engagement') %>%
group_by(code) %>%
summarise(five = list(fivenum(value))) %>%
::unnest(cols = c(five)) -> mars_fivenum_A
tidyr
%>%
mars_tidy filter(category=='Functionality') %>%
group_by(code) %>%
summarise(five = list(fivenum(value))) %>%
::unnest(cols = c(five)) -> mars_fivenum_B
tidyr
%>%
mars_tidy filter(category=='Aesthetics') %>%
group_by(code) %>%
summarise(five = list(fivenum(value))) %>%
::unnest(cols = c(five)) -> mars_fivenum_C
tidyr
%>%
mars_tidy filter(category=='Information') %>%
group_by(code) %>%
summarise(five = list(fivenum(value))) %>%
::unnest(cols = c(five)) -> mars_fivenum_D
tidyr
%>%
mars_tidy filter(category=='Subjective quality') %>%
group_by(code) %>%
summarise(five = list(fivenum(value))) %>%
::unnest(cols = c(five)) -> mars_fivenum_E
tidyr
%>%
mars_tidy filter(category=='App-specific') %>%
group_by(code) %>%
summarise(five = list(fivenum(value))) %>%
::unnest(cols = c(five)) -> mars_fivenum_F
tidyr
# table with mean and sd together
%>%
mars_tidy group_by(code) %>%
summarise(mean = round(mean(value), 2),
sd = round(sd(value),2)) -> mars_stat
<- viridis(6)
pal = pal[1]
colorA = pal[2]
colorB = pal[3]
colorC = pal[4]
colorD = pal[5]
colorE = pal[6]
colorF
= 16 #cm
plot_width = 10 #cm
plot_height = 600
plot_dpi
= 13
plot_title_size = 12 plot_subtitle_size
<- c("A1", "A2", "A3", "A4", "A5", "A")
lbl_A <- "Engagement"
cat
%>%
mars_tidy filter(category == cat) %>%
mutate(code = forcats::fct_relevel(code, lbl_A)) %>%
ggplot(aes(x=code, y=value)) +
geom_boxplot(aes(alpha=type),
width=0.5,
color=colorA,
fill=colorA) +
scale_alpha_discrete(range = c(0.2, 0.5)) +
stat_summary(fun=mean, geom="point", shape=20, size=4, color="black", alpha=1) + # display mean as black circle
geom_dotplot(binaxis = "y", stackdir = "center", fill=colorA, color=colorA, alpha=0.8, dotsize = 0.6) + # display every data point
geom_text(data = mars_fivenum_A,
aes(x = code, y = five, label = sprintf("%.2f", five)),
nudge_x = 0.45, size=3, alpha=1) +
labs(x=NULL, y=NULL, title=paste("Section A -", cat, "scores"),
subtitle="(A1) Entertainment, (A2) Interest, (A3) Customization, (A4) Interactivity, \n(A5) Target group, (A) Average Engagement score") +
ylim(3,5) +
theme_ipsum() +
theme(
legend.position = "none",
plot.title = element_text(size=plot_title_size),
plot.subtitle = element_text(size=plot_subtitle_size)) -> plotA
plotA
ggsave(file = here::here("figs", "A.svg"),
width = plot_width, height = plot_height, units="cm", dpi = plot_dpi)
<- c("B6", "B7", "B8", "B9", "B")
lbl_B <- "Functionality"
cat
%>%
mars_tidy filter(category == cat) %>%
mutate(code = forcats::fct_relevel(code, lbl_B)) %>%
ggplot(aes(x=code, y=value)) +
geom_boxplot(aes(alpha=type),
width=0.5,
color=colorB,
fill=colorB) +
scale_alpha_discrete(range = c(0.2, 0.5)) +
stat_summary(fun=mean, geom="point", shape=20, size=4, color="black", alpha=1) + # display mean as black circle
geom_dotplot(binaxis = "y", stackdir = "center", fill=colorB, color=colorB, alpha=0.8, dotsize = 0.6) + # display every data point on the boxplot
geom_text(data = mars_fivenum_B,
aes(x = code, y = five, label = sprintf("%.2f", five)),
nudge_x = 0.45, size=3) +
labs(x=NULL, y=NULL, title=paste("Section B -", cat, "scores"),
subtitle="(B6) Performance, (B7) Ease of use, (B8) Navigation, \n(B9) Gestural design, (B) Average Functionality score") +
ylim(3,5) +
theme_ipsum() +
theme(
legend.position = "none",
plot.title = element_text(size=plot_title_size),
plot.subtitle = element_text(size=plot_subtitle_size)) -> plotB
plotB
ggsave(file = here::here("figs", "B.svg"),
width = plot_width, height = plot_height, units="cm", dpi = plot_dpi)
<- c("C10", "C11", "C12", "C")
lbl_C <- "Aesthetics"
cat
%>%
mars_tidy filter(category == cat) %>%
mutate(code = forcats::fct_relevel(code, lbl_C)) %>%
ggplot(aes(x=code, y=value)) +
geom_boxplot(aes(alpha=type),
width=0.5,
color=colorC,
fill=colorC) +
scale_alpha_discrete(range = c(0.2, 0.5)) +
stat_summary(fun=mean, geom="point", shape=20, size=4, color="black", alpha=1) + # display mean as black circle
geom_dotplot(binaxis = "y", stackdir = "center", fill=colorC, color=colorC, alpha=0.8, dotsize = 0.6) + # display every data point
geom_text(data = mars_fivenum_C,
aes(x = code, y = five, label = sprintf("%.2f", five)),
nudge_x = 0.45, size=3) +
labs(x=NULL, y=NULL, title=paste("Section C -", cat, "scores"),
subtitle="(C10) Layout, (C11) Graphics, (C12) Visual appeal,\n(C) Average Aesthetics score") +
ylim(3,5) +
theme_ipsum() +
theme(
legend.position = "none",
plot.title = element_text(size=plot_title_size),
plot.subtitle = element_text(size=plot_subtitle_size)) -> plotC
plotC
ggsave(file = here::here("figs", "C.svg"),
width = plot_width, height = plot_height, units="cm", dpi = plot_dpi)
<- c("D13", "D14", "D15", "D16", "D")
lbl_D <- "Information"
cat
%>%
mars_tidy filter(category == cat) %>%
mutate(code = forcats::fct_relevel(code, lbl_D)) %>%
ggplot(aes(x=code, y=value)) +
geom_boxplot(aes(alpha=type),
width=0.5,
color=colorD,
fill=colorD) +
scale_alpha_discrete(range = c(0.2, 0.5)) +
stat_summary(fun=mean, geom="point", shape=20, size=4, color="black", alpha=1) + # display mean as black circle
geom_dotplot(binaxis = "y", stackdir = "center", fill=colorD, color=colorD, alpha=0.8, dotsize = 0.6) + # display every data point
geom_text(data = mars_fivenum_D,
aes(x = code, y = five, label = sprintf("%.2f", five)),
nudge_x = 0.45, size=3) +
labs(x=NULL, y=NULL, title=paste("Section D -", cat, "scores"),
subtitle="(D13) Quality of information, (D14) Quantity of information, (D15) Visual\ninformation, (D16) Credibility, (D) Average Information score") +
ylim(3,5) +
theme_ipsum() +
theme(
legend.position = "none",
plot.title = element_text(size=plot_title_size),
plot.subtitle = element_text(size=plot_subtitle_size)) -> plotD
plotD
ggsave(file = here::here("figs", "D.svg"),
width = plot_width, height = plot_height, units="cm", dpi = plot_dpi)
<- c("E1", "E2", "E3", "E4")
lbl_E <- "Subjective quality"
cat
%>%
mars_tidy filter(category == cat) %>%
mutate(code = forcats::fct_relevel(code, lbl_E)) %>%
ggplot(aes(x=code, y=value)) +
geom_boxplot(alpha=0.2,
width=0.5,
color=colorE,
fill=colorE) +
stat_summary(fun=mean, geom="point", shape=20, size=4, color="black", alpha=1) + # display mean as black circle
geom_dotplot(binaxis = "y", stackdir = "center", fill=colorE, color=colorE, alpha=0.8, dotsize = 0.6) + # display every data point
geom_text(data = mars_fivenum_E,
aes(x = code, y = five, label = sprintf("%.2f", five)),
nudge_x = 0.45, size=3) +
labs(x=NULL, y=NULL, title="Section E - Subjective Quality scores",
subtitle="(E1) Likelihood to recommend, (E2) Expected usage times (from patient\nperspective) in next 12 months, (E3) Will you pay (from patient perspective)\nfor its use?, (E4) Star rating") +
ylim(2,5) +
theme_ipsum() +
theme(
legend.position = "none",
plot.title = element_text(size=plot_title_size),
plot.subtitle = element_text(size=plot_subtitle_size)) -> plotE
plotE
ggsave(file = here::here("figs", "E.svg"),
width = plot_width, height = plot_height, units="cm", dpi = plot_dpi)
<- c("F1", "F2", "F3", "F4", "F5", "F6", "F")
lbl_F <- "App-specific"
cat
%>%
mars_tidy filter(category == cat) %>%
mutate(code = forcats::fct_relevel(code, lbl_F)) %>%
ggplot(aes(x=code, y=value)) +
geom_boxplot(aes(alpha=type),
width=0.5,
color=colorF,
fill=colorF) +
scale_alpha_discrete(range = c(0.2, 0.5)) +
stat_summary(fun=mean, geom="point", shape=20, size=4, color="black", alpha=1) + # display mean as black circle
geom_dotplot(binaxis = "y", stackdir = "center", fill=colorF, color=colorF, alpha=0.8, dotsize = 0.6) + # display every data point
geom_text(data = mars_fivenum_F,
aes(x = code, y = five, label = sprintf("%.2f", five)),
nudge_x = 0.45, size=3) +
labs(x=NULL, y=NULL, title=paste("Section F -", cat, "scores to perceived anxiety in places"),
subtitle="(F1) Increase awareness of the importance to increase tolerance, (F2)\nIncrease knowledge on tolerance, (F3) Change attitudes towards improving\ntolerance, (F4) Increase motivation to address tolerance, (F5) Encourage\nfurther help-seeking, (F6) Behaviour change, (F) Average App-specific score") +
ylim(3,5) +
theme_ipsum() +
theme(
legend.position = "none",
plot.title = element_text(size=plot_title_size),
plot.subtitle = element_text(size=plot_subtitle_size)) -> plotF
plotF
ggsave(file = here::here("figs", "F.svg"),
width = plot_width, height = plot_height, units="cm", dpi = plot_dpi)
<- function(x, filename) {
as_ggplot <- here::here("figs")
path_gt_table_image <- gt::gtsave(x, path = path_gt_table_image, filename = filename, expand=5)
gt_table_image
# save image in ggplot -------------------------------------------------------
<-
table_img ::image_read(here::here("figs", filename)) %>%
magick::image_ggplot(interpolate = TRUE)
magick
table_img }
<- dplyr::tibble(stat = c("mean", "sd"))
rowname = "small"
cell_size
%>%
mars_stat filter(str_starts(code, c("A"))) %>%
mutate(code = forcats::fct_relevel(code, lbl_A)) %>%
arrange(code) %>%
select(code, mean) %>%
pivot_wider(names_from = code, values_from = c("mean")) -> meanA
%>%
mars_stat filter(str_starts(code, c("A"))) %>%
mutate(code = forcats::fct_relevel(code, lbl_A)) %>%
arrange(code) %>%
select(code, sd) %>%
pivot_wider(names_from = code, values_from = c("sd")) -> sdA
bind_rows(meanA, sdA) %>%
bind_cols(rowname) %>%
gt(rowname_col = "stat") %>%
opt_table_lines("none") %>%
cols_width(
everything() ~ px(60)) %>%
cols_align(
align = "center",
columns = everything()
%>%
)
tab_options(
data_row.padding = px(1), #Reduce the height of rows
table.align = "left",
table.width = px(250)) %>%
# Apply style to all column headers
tab_style(
locations = cells_column_labels(columns = everything()),
style = list(
cell_borders(sides = "bottom", weight = px(1)), #Give a thick border below
cell_text(weight = "bold")) #Make text bold)
%>%
)
tab_style(
style = cell_text(size = cell_size),
locations = cells_body(columns = everything())
%>%
) as_ggplot(filename="tbl_A.png") -> tbl_A
%>%
mars_stat filter(str_starts(code, c("B"))) %>%
mutate(code = forcats::fct_relevel(code, lbl_B)) %>%
arrange(code) %>%
select(code, mean) %>%
pivot_wider(names_from = code, values_from = c("mean")) -> meanB
%>%
mars_stat filter(str_starts(code, c("B"))) %>%
mutate(code = forcats::fct_relevel(code, lbl_B)) %>%
arrange(code) %>%
select(code, sd) %>%
pivot_wider(names_from = code, values_from = c("sd")) -> sdB
bind_rows(meanB, sdB) %>%
bind_cols(rowname) %>%
gt(rowname_col = "stat") %>%
# gt() %>%
# cols_hide(columns = c(stat)) %>%
opt_table_lines("none") %>%
cols_width(
everything() ~ px(60)) %>%
cols_align(
align = "center",
columns = everything()
%>%
)
tab_options(
data_row.padding = px(1), #Reduce the height of rows
table.align = "left",
table.width = px(250)) %>%
# Apply style to all column headers
tab_style(
locations = cells_column_labels(columns = everything()),
style = list(
cell_borders(sides = "bottom", weight = px(1)), #Give a thick border below
cell_text(weight = "bold")) #Make text bold)
%>%
) tab_style(
style = cell_text(size = cell_size),
locations = cells_body(columns = everything())
%>%
) as_ggplot(filename="tbl_B.png") -> tbl_B
%>%
mars_stat filter(str_starts(code, c("C"))) %>%
mutate(code = forcats::fct_relevel(code, lbl_C)) %>%
arrange(code) %>%
select(code, mean) %>%
pivot_wider(names_from = code, values_from = c("mean")) -> meanC
%>%
mars_stat filter(str_starts(code, c("C"))) %>%
mutate(code = forcats::fct_relevel(code, lbl_C)) %>%
arrange(code) %>%
select(code, sd) %>%
pivot_wider(names_from = code, values_from = c("sd")) -> sdC
bind_rows(meanC, sdC) %>%
bind_cols(rowname) %>%
gt(rowname_col = "stat") %>%
opt_table_lines("none") %>%
cols_width(
everything() ~ px(60)) %>%
cols_align(
align = "center",
columns = everything()
%>%
)
tab_options(
data_row.padding = px(1), #Reduce the height of rows
table.align = "left",
table.width = px(250)) %>%
# Apply style to all column headers
tab_style(
locations = cells_column_labels(columns = everything()),
style = list(
cell_borders(sides = "bottom", weight = px(1)), #Give a thick border below
cell_text(weight = "bold")) #Make text bold)
%>%
) tab_style(
style = cell_text(size = cell_size),
locations = cells_body(columns = everything())
%>%
) as_ggplot(filename="tbl_C.png") -> tbl_C
%>%
mars_stat filter(str_starts(code, c("D"))) %>%
mutate(code = forcats::fct_relevel(code, lbl_D)) %>%
arrange(code) %>%
select(code, mean) %>%
pivot_wider(names_from = code, values_from = c("mean")) -> meanD
%>%
mars_stat filter(str_starts(code, c("D"))) %>%
mutate(code = forcats::fct_relevel(code, lbl_D)) %>%
arrange(code) %>%
select(code, sd) %>%
pivot_wider(names_from = code, values_from = c("sd")) -> sdD
bind_rows(meanD, sdD) %>%
bind_cols(rowname) %>%
gt(rowname_col = "stat") %>%
# gt() %>%
# cols_hide(columns = c(stat)) %>%
opt_table_lines("none") %>%
cols_width(
everything() ~ px(60)) %>%
cols_align(
align = "center",
columns = everything()
%>%
)
tab_options(
data_row.padding = px(1), #Reduce the height of rows
table.align = "left",
table.width = px(250)) %>%
# Apply style to all column headers
tab_style(
locations = cells_column_labels(columns = everything()),
style = list(
cell_borders(sides = "bottom", weight = px(1)), #Give a thick border below
cell_text(weight = "bold")) #Make text bold)
%>%
) tab_style(
style = cell_text(size = cell_size),
locations = cells_body(columns = everything())
%>%
) as_ggplot(filename="tbl_D.png") -> tbl_D
%>%
mars_stat filter(str_starts(code, c("E"))) %>%
mutate(code = forcats::fct_relevel(code, lbl_E)) %>%
arrange(code) %>%
select(code, mean) %>%
pivot_wider(names_from = code, values_from = c("mean")) -> meanE
%>%
mars_stat filter(str_starts(code, c("E"))) %>%
mutate(code = forcats::fct_relevel(code, lbl_E)) %>%
arrange(code) %>%
select(code, sd) %>%
pivot_wider(names_from = code, values_from = c("sd")) -> sdE
bind_rows(meanE, sdE) %>%
bind_cols(rowname) %>%
gt(rowname_col = "stat") %>%
opt_table_lines("none") %>%
cols_width(
everything() ~ px(60)) %>%
cols_align(
align = "center",
columns = everything()
%>%
)
tab_options(
data_row.padding = px(1), #Reduce the height of rows
table.align = "left",
table.width = px(250)) %>%
# Apply style to all column headers
tab_style(
locations = cells_column_labels(columns = everything()),
style = list(
cell_borders(sides = "bottom", weight = px(1)), #Give a thick border below
cell_text(weight = "bold")) #Make text bold)
%>%
) tab_style(
style = cell_text(size = cell_size),
locations = cells_body(columns = everything())
%>%
) as_ggplot(filename="tbl_E.png") -> tbl_E
%>%
mars_stat filter(str_starts(code, c("F"))) %>%
mutate(code = forcats::fct_relevel(code, lbl_F)) %>%
arrange(code) %>%
select(code, mean) %>%
pivot_wider(names_from = code, values_from = c("mean")) -> meanF
%>%
mars_stat filter(str_starts(code, c("F"))) %>%
mutate(code = forcats::fct_relevel(code, lbl_F)) %>%
arrange(code) %>%
select(code, sd) %>%
pivot_wider(names_from = code, values_from = c("sd")) -> sdF
bind_rows(meanF, sdF) %>%
bind_cols(rowname) %>%
gt(rowname_col = "stat") %>%
# gt() %>%
# cols_hide(columns = c(stat)) %>%
opt_table_lines("none") %>%
cols_width(
everything() ~ px(60)) %>%
cols_align(
align = "center",
columns = everything()
%>%
)
tab_options(
data_row.padding = px(1), #Reduce the height of rows
table.align = "left",
table.width = px(7)) %>%
# Apply style to all column headers
tab_style(
locations = cells_column_labels(columns = everything()),
style = list(
cell_borders(sides = "bottom", weight = px(1)), #Give a thick border below
cell_text(weight = "bold")) #Make text bold)
%>%
) tab_style(
style = cell_text(size = cell_size),
locations = cells_body(columns = everything())
%>%
) as_ggplot(filename="tbl_F.png") -> tbl_F
Figure 1 (Figure 5
in the paper) shows the composite of the boxplots for each MARS section along with average tables
+ plotB) / (tbl_A + tbl_B) / (plotC + plotD) / (tbl_C + tbl_D) / (plotE + plotF) / (tbl_E + tbl_F) +
(plotA plot_layout(widths = c(1,1))
ggsave(file = here::here("figs", "MARS_WDP.svg"),
width = 15, height = 20, dpi = plot_dpi)