#' Rendering a bar chart
#' @title render_bar_chart
#'
#' @import ggplot2
#' @importFrom dplyr %>%
#' @param ...
#'
#' @return
render_bar<- function(...) {
spec_list<-list(...)
#put the specification variables in a location environment
#so they can be accessed without using a list
list2env(spec_list,env=environment())
if(is.na(layout)){
layout <-"default"
}
stack_by<- if(!is.na(group)) group else NA
#TO DO: there's no good common way to pass this
proportional<-FALSE
#generate the chart
gg_chart <- if(layout == "divergent") {
#CASE 1: Divergent bar chart (waterfall)
if (is.na(stack_by)) {
#If reference_var and reference_Vector is missing,
#Assume the data frame values are already set up in the proper format (split into positive and negative values.)
if (!missing(reference_var) && !missing(reference_vector)) {
data[[y]] <- ifelse(data[[reference_var]] %in% reference_vector, -data[[y]], data[[y]])
}
data <- dplyr::arrange(data, desc(value))
ggchart <- ggplot(data, aes_string(x=x, y=y)) +
geom_bar(stat = "identity") #+
#scale_x_discrete(limits = data[[x]])
} else {
if (proportional == TRUE) {
# CASE 7: Stacked divergent proportional bar chart
if (missing(reference_vector)) {
stop("Missing required input: reference_vector. This is required when specifying a bar chart that is stacked,
divergent and proportional")
}
ggchart <- ggplot(data,
aes_string(x = x,
y = ifelse(data[[stack_by]] %in% reference_vector,
-data[[y]],
data[[y]]),
fill = stack_by)) +
geom_col(position="fill") +
coord_flip()
} else {
#CASE 2: Stacked divergent bar
if (missing(reference_vector)) {
stop("Missing required input: reference_vector. This is required when specifying a bar chart that is stacked and
divergent")
}
ggchart <- ggplot(data,
aes_string(x = x,
y = ifelse(data[[stack_by]] %in% reference_vector,
-data[[y]],
data[[y]]),
fill = stack_by)) +
geom_col() + #main different from above above case
coord_flip()
}
}
} else if (layout == "default") {
if (is.na(y) && is.na(stack_by)) {
#CASE 3: Bar Chart with y as count (geom_bar)
gg_chart <- ggplot(data, aes_string(x=x)) + geom_bar()
} else {
if (proportional | !is.na(y) & y==1) {
#CASE 6: Stacked proportional bar chart
gg_chart <- ggplot(data, aes_string(x=x, y=1, fill=stack_by)) +
geom_bar(stat="identity", position="fill") +
scale_y_continuous(labels = scales::percent_format())
} else {
if(!is.na(stack_by)) {
if (is.na(y) | y==1) {
#CASE 8: Stacked bar chart with fill as stack_by and y as count
gg_chart <- ggplot(data, aes_string(x=x)) +
geom_bar(aes_string(fill=stack_by))
} else {
#CASE 5: Stacked bar chart with fill as stack_by
gg_chart <- ggplot(data, aes_string(x=x, y=y)) +
geom_col(aes_string(fill=stack_by))
}
} else {
#CASE 4: Bar Chart (geom_col)
gg_chart <-
ggplot(data, aes_string(x = x, y = y)) +
geom_col()
}
}
}
} else {
#CASE when divergent is not TRUE or FALSE (false is default)
stop("When specifying a bar chart, layout input must be: 'default' or 'divergent'.")
}
if(!is.na(color)) {
#TODO: I added width=0.9 here because of a case with x as time, the columns overlap... and this fixes the problem.
# BUT it might be unneeded and maybe annoying in other cases so may have to change this later to a case basis
gg_chart <- gg_chart %+% geom_bar(aes_string(fill = color), width = 0.9)
if(!is.na(colour_scale)[1]) {
gg_chart <- gg_chart +
scale_fill_manual(name = color, values = colour_scale)
}
}
#getting rid of x an y labels for massive character vectors
if(!is.na(x) && class(data[,x]) %in% c("character","factor")){
if(length(unique(data[,x])) > 50){
rm_x_labels<-TRUE
}
}
if(!is.na(y) && class(data[,y]) %in% c("character","factor")){
if(length(unique(data[,y])) > 50){
rm_y_labels<-TRUE
}
}
gg_chart<-common_stats_aesethetics(gg_chart,
title=title,
flip_coord = flip_coord,
y_limits = y_limits,
x_limits=x_limits,
scale_y_cont = scale_y_cont,
rm_x_labels = rm_x_labels,
rm_y_labels = rm_y_labels,
x_labels = x_labels,
y_labels = y_labels,
shrink_plot_margin = shrink_plot_margin)
#return the faithful ggplot object
return(gg_chart)
}
#' Render a pie chart
#' @title render_pie_chart
#' @import ggplot2
#' @import dplyr
#' @param ...
#'
#' @return
render_pie <- function(...) {
spec_list<-list(...)
#put the specification variables in a location environment
#so they can be accessed without using a list
list2env(spec_list,env=environment())
data <- data %>%
dplyr::count_(x) %>%
dplyr::mutate(freq = n/sum(n))
gg_chart <- ggplot2::ggplot(data, aes_string(x=shQuote(""), y="freq", fill=x)) +
ggplot2::geom_bar(width = 1, stat = "identity") +
ggplot2::coord_polar("y", start=0)
if(!is.na(color)) {
gg_chart <- gg_chart %+% aes_string(fill = color)
}
if(!is.na(colour_scale)[1]) {
gg_chart <- gg_chart +
scale_fill_manual(name = color, values = colour_scale)
}
gg_chart<-common_stats_aesethetics(gg_chart,
title=title)
return(gg_chart)
}
#' Rendering a line chart
#' @title render_line_chart
#' @param ...
#'
#' @import ggplot2
#' @return
#'
#' @examples
render_line <- function(...) {
spec_list<-list(...)
#put the specification variables in a location environment
#so they can be accessed without using a list
list2env(spec_list,env=environment())
if(is.na(group)){
gg_chart <- ggplot(data, aes_string(x = x, y = y, group = 1)) + geom_line()
} else {
gg_chart <- ggplot(data, aes_string(x = x, y = y, group = group)) +
geom_line(aes_string(colour = group))
}
if(!is.na(color)) {
#Add colour variable
gg_chart <- gg_chart %+% aes_string(colour = color)
}
if (!is.na(colour_scale)[1]) {
#Scale colour variable
gg_chart <- gg_chart +
scale_colour_manual(name = color, values = colour_scale)
}
gg_chart<-common_stats_aesethetics(gg_chart,
title=title,
flip_coord = flip_coord,
y_limits = y_limits,
x_limits=x_limits,
shrink_plot_margin = shrink_plot_margin)
return(gg_chart)
}
render_scatter <- function(...) {
spec_list<-list(...)
#There's a bunch of stuff here that has nothing to do with a scatter plot..
#so need to take that out
#put the specification variables in a location environment
#so they can be accessed without using a list
list2env(spec_list,env= environment())
gg_chart <- ggplot(data, aes_string(x=x, y=y)) +
ggplot2::geom_point()
if(!is.na(color)) {
#Add colour variable
gg_chart <- gg_chart %+% aes_string(colour = color)
}
# if(!is.na(colour_scale)[1]) {
# #Scale colour variable
# gg_chart <- gg_chart +
# scale_colour_manual(name = color, values = colour_scale)
# }
if(class(data[,x]) %in% c("character","factor")){
if(length(unique(data[,x])) > 50){
rm_x_labels<-TRUE
}
}
result <- tryCatch({
data[,y]
}, error = function(e){return(NULL)})
if(is.null(result)){
browser()
}
if(class(data[,y]) %in% c("character","factor")){
if(length(unique(data[,y])) > 50){
rm_y_labels<-TRUE
}
}
gg_chart<-common_stats_aesethetics(gg_chart,
title=title,
flip_coord = flip_coord,
y_limits = y_limits,
x_limits=x_limits,
x_labels = x_labels,
y_labels = y_labels,
rm_x_labels = rm_x_labels,
rm_y_labels = rm_y_labels,
shrink_plot_margin = shrink_plot_margin)
#odd rest
rm_y_labels<-FALSE
rm_x_labels<-FALSE
return(gg_chart)
}
#' Render Histogram
#' @title render_histogram
#' @param ...
#'
#' @return
render_histogram<- function(...) {
spec_list<-list(...)
#put the specification variables in a location environment
#so they can be accessed without using a list
list2env(spec_list,env=environment())
gg_chart <- ggplot(data, aes_string(x=x))+
geom_histogram()
if(!is.na(color)) {
#Add colour variable
gg_chart <- gg_chart %+% aes_string(fill = color)
}
if(!is.na(colour_scale)[1]) {
#Add manual colour scale
gg_chart <- gg_chart +
scale_fill_manual(name = color, values = colour_scale)
}
#getting rid of x an y labels for massive character vectors
if(!is.na(x) && class(data[,x]) %in% c("character","factor")){
if(length(unique(data[,x])) > 50){
rm_x_labels<-TRUE
}
}
if(!is.na(y) && class(data[,y]) %in% c("character","factor")){
if(length(unique(data[,y])) > 50){
rm_y_labels<-TRUE
}
}
gg_chart<-common_stats_aesethetics(gg_chart,
title=title,
flip_coord = flip_coord,
x_limits=x_limits,
rm_x_labels= rm_x_labels,
shrink_plot_margin = shrink_plot_margin)
gg_chart
}
#' Render 1D probability density functions
#' @title render_1D_density
#' @param ...
#'
#' @return
render_1D_density <- function(...) {
spec_list<-list(...)
#put the specification variables in a location environment
#so they can be accessed without using a list
list2env(spec_list,env=environment())
gg_chart <- ggplot(data, aes_string(x)) + geom_density(kernel = "gaussian",fill="black")
gg_chart<-common_stats_aesethetics(gg_chart,
title=title,
flip_coord = flip_coord,
x_limits=x_limits,
rm_x_labels= rm_x_labels,
shrink_plot_margin = shrink_plot_margin)
if(!is.na(color)) {
#Add colour variable
gg_chart <- gg_chart %+% aes_string(fill = color)
}
if(!is.na(colour_scale)[1]) {
gg_chart <- gg_chart +
scale_fill_manual(name = color, values = colour_scale)
}
return(gg_chart)
}
#' Rendering a box chart
#'
#' @title render_boxplot
#' @param ...
#'
#' @return
render_boxplot <- function(...) {
spec_list<-list(...)
#put the specification variables in a location environment
#so they can be accessed without using a list
list2env(spec_list,env=environment())
gg_chart <- ggplot2::ggplot(data = data, aes_string(x=x,y=y)) +
geom_boxplot()
if(!is.na(color)) {
#Add colour variable
gg_chart <- gg_chart %+% aes_string(fill = color)
}
if(!is.na(colour_scale)[1]) {
gg_chart <- gg_chart +
scale_fill_manual(name = color, values = colour_scale)
# theme(legend.position = "none")
}
#getting rid of x an y labels for massive character vectors
if(!is.na(x) && class(data[,x]) %in% c("character","factor")){
if(length(unique(data[,x])) > 50){
rm_x_labels<-TRUE
}
}
if(!is.na(y) && class(data[,y]) %in% c("character","factor")){
if(length(unique(data[,y])) > 50){
rm_y_labels<-TRUE
}
}
gg_chart<-common_stats_aesethetics(gg_chart,
title=title,
flip_coord = flip_coord,
y_limits = y_limits,
x_limits=x_limits,
rm_x_labels= rm_x_labels,
rm_y_labels= rm_y_labels,
shrink_plot_margin = shrink_plot_margin)
gg_chart
}
#'Rendering a swarm plot
#'
#' @title render_swarm_plot
#' @param ...
#'
#' @return
render_swarm_plot <- function(...) {
spec_list<-list(...)
#put the specification variables in a location environment
#so they can be accessed without using a list
list2env(spec_list,env=environment())
gg_chart <- ggplot(data, aes_string(x=x,y= y)) + ggbeeswarm::geom_quasirandom()
if(!is.na(color)) {
#Add colour variable
gg_chart <- gg_chart %+% aes_string(fill = color)
}
#TODO: put this inside of if(!is.na(color)) check for all of the charts!!!
if(!is.na(colour_scale)[1]) {
gg_chart <- gg_chart +
scale_colour_manual(name = color, values = colour_scale)
# theme(legend.position = "none")
}
#getting rid of x an y labels for massive character vectors
if(!is.na(x) && class(data[,x]) %in% c("character","factor")){
if(length(unique(data[,x])) > 50){
rm_x_labels<-TRUE
}
}
if(!is.na(y) && class(data[,y]) %in% c("character","factor")){
if(length(unique(data[,y])) > 50){
rm_y_labels<-TRUE
}
}
gg_chart<-common_stats_aesethetics(gg_chart,
title=title,
flip_coord = flip_coord,
y_limits = y_limits,
x_limits=x_limits,
rm_x_labels= rm_x_labels,
rm_y_labels= rm_y_labels,
shrink_plot_margin = shrink_plot_margin)
gg_chart
}
#***************
# HELPER FUNCTION
#' Title
#'
#' @param gg_chart
#' @param title
#' @param x_limits
#' @param y_limits
#' @param flip_coord
#' @param scale_y_cont
#' @param rm_x_labels
#' @param rm_y_labels
#'
#' @return modified gg_chart
#'
#' @examples
common_stats_aesethetics<-function(gg_chart=NA,
title=NA,
x_limits=NA,
y_limits=NA,
flip_coord = FALSE,
scale_y_cont = NA,
rm_x_labels = FALSE,
rm_y_labels = FALSE,
x_labels = FALSE,
y_labels = FALSE,
x_breaks = FALSE,
y_breaks = FALSE,
shrink_plot_margin=FALSE){
if(!is.na(title)) {
gg_chart <- gg_chart + ggtitle(title)
}
if(flip_coord) {
gg_chart <- gg_chart + coord_flip()
}
if(rm_x_labels) {
gg_chart <- gg_chart +
ggplot2::theme(axis.text.x = element_blank(),
axis.ticks.x = element_blank())
}
if(rm_y_labels) {
gg_chart <- gg_chart +
ggplot2::theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank())
}
return(gg_chart)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.