LSHTM_analysis/scripts/functions/lf_bp.R

197 lines
7.4 KiB
R

#############################
# Barplots: ggplot
# stats +/-
# violin +/-
# barplot +/
# beeswarm
#############################
lf_bp <- function(lf_df
, p_title = ""
, colour_categ = ""
, x_grp = "mutation_info"
, y_var = "param_value"
, facet_var = "param_type"
, n_facet_row = 1
, y_scales = "free_y"
, colour_bp_strip = "khaki2"
, dot_size = 3
, dot_transparency = 0.3
, violin_quantiles = c(0.25, 0.5, 0.75) # can be NULL
, my_ats = 22 # axis text size
, my_als = 20 # axis label size
, my_fls = 20 # facet label size
, my_pts = 22 # plot title size)
, make_boxplot = FALSE
, bp_width = c("auto", 0.5)
, add_stats = TRUE
, stat_grp_comp = c("DM", "OM")
, stat_method = "wilcox.test"
, my_paired = FALSE
, stat_label = c("p.format", "p.signif") ){
fwv = as.formula(paste0("~", facet_var))
#fwv = reformulate(facet_var)
p1 <- ggplot(lf_df, aes_string(x = x_grp, y = y_var)) +
facet_wrap( fwv
, nrow = n_facet_row
, scales = y_scales) +
geom_violin(trim = T
, scale = "width"
#, position = position_dodge(width = 0.9)
, draw_quantiles = violin_quantiles)
if (make_boxplot){
if (bp_width == "auto"){
bp_width = 0.5/length(unique(lf_df[[x_grp]]))
cat("\nAutomatically calculated boxplot width, using bp_width:\n", bp_width, "\n")
}else{
cat("\nBoxplot width value provided, using:", bp_width, "\n")
bp_width = bp_width}
p2 = p1 + geom_boxplot(fill = "white"
, outlier.colour = NA
#, position = position_dodge(width = 0.9)
, width = bp_width) +
geom_beeswarm(priority = "density"
#, shape = 21
, size = dot_size
, alpha = dot_transparency
, show.legend = FALSE
, cex = 0.8
, aes(colour = factor(eval(parse(text = colour_categ))) ))
} else {
# ggbeeswarm (better than geom_point)
p2 = p1 + geom_beeswarm(priority = "density"
#, shape = 21
, size = dot_size
, alpha = dot_transparency
, show.legend = FALSE
, cex = 0.8
, aes(colour = factor(eval(parse(text = colour_categ))) ))
}
# Add foramtting to graph
OutPlot = p2 + theme(axis.text.x = element_text(size = my_ats)
, axis.text.y = element_text(size = my_ats
, angle = 0
, hjust = 1
, vjust = 0)
, axis.title.x = element_text(size = my_ats)
, axis.title.y = element_text(size = my_ats)
, plot.title = element_text(size = my_pts
, hjust = 0.5
, colour = "black"
, face = "bold")
, strip.background = element_rect(fill = colour_bp_strip)
, strip.text.x = element_text(size = my_fls
, colour = "black")
, legend.title = element_text(color = "black"
, size = my_als)
, legend.text = element_text(size = my_ats)
, legend.direction = "vertical") +
labs(title = p_title
, x = ""
, y = "")
if (add_stats){
my_comparisonsL <- list( stat_grp_comp )
OutPlot = OutPlot + stat_compare_means(comparisons = my_comparisonsL
, method = stat_method
, paired = my_paired
, label = stat_label[2])
return(OutPlot)
}
return(OutPlot)
}
#############################
# Barplot NO stats: plotly
# violin +/-
# barplot +/
# beeswarm
# TODO: plot_ly()
#############################
lf_bp_plotly <- function(lf_df
, p_title = ""
, colour_categ = ""
, x_grp = mutation_info
, y_var = param_value
, facet_var = param_type
, n_facet_row = 1
, y_scales = "free_y"
, colour_bp_strip = "khaki2"
, dot_size = 3
, dot_transparency = 0.3
, violin_quantiles = c(0.25, 0.5, 0.75) # can be NULL
, my_ats = 20 # axis text size
, my_als = 18 # axis label size
, my_fls = 18 # facet label size
, my_pts = 22 # plot title size)
#, make_boxplot = FALSE
, bp_width = c("auto", 0.5)
#, add_stats = FALSE
#, stat_grp_comp = c("DM", "OM")
#, stat_method = "wilcox.test"
#, my_paired = FALSE
#, stat_label = c("p.format", "p.signif")
){
OutPlotly = ggplot(lf_df, aes(x = eval(parse(text = x_grp))
, y = eval(parse(text = y_var))
, label1 = x_grp
, label2 = y_var
, lable3 = colour_categ) ) +
facet_wrap(~ eval(parse(text = facet_var))
, nrow = n_facet_row
, scales = y_scales) +
geom_violin(trim = T
, scale = "width"
, draw_quantiles = violin_quantiles) +
geom_beeswarm(priority = "density"
, size = dot_size
, alpha = dot_transparency
, show.legend = FALSE
, cex = 0.8
, aes(colour = factor(eval(parse(text = colour_categ) ) ) ) ) +
theme(axis.text.x = element_text(size = my_ats)
, axis.text.y = element_text(size = my_ats
, angle = 0
, hjust = 1
, vjust = 0)
, axis.title.x = element_text(size = my_ats)
, axis.title.y = element_text(size = my_ats)
, plot.title = element_text(size = my_pts
, hjust = 0.5
, colour = "black"
, face = "bold")
, strip.background = element_rect(fill = colour_bp_strip)
, strip.text.x = element_text(size = my_fls
, colour = "black")
, legend.title = element_text(color = "black"
, size = my_als)
, legend.text = element_text(size = my_ats)
, legend.position = "none")+
labs(title = p_title
, x = ""
, y = "")
OutPlotly = ggplotly(OutPlotly
#, tooltip = c("label")
)
return(OutPlotly)
}