Skip to content

Instantly share code, notes, and snippets.

@Nicktz

Nicktz/psec_theme.R

Last active September 10, 2020 10:45
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Nicktz/7ba35bceb6eadfdc6a79c43475593dbb to your computer and use it in GitHub Desktop.
Save Nicktz/7ba35bceb6eadfdc6a79c43475593dbb to your computer and use it in GitHub Desktop.
Download ZIP
psec_theme.R
Raw
psec_theme.R
#' @title theme_psec1
#' @description Plotting theme for ggplot: with boundary
#' @param FontType Check available fonts using: windowsFonts()
#' @return plot theme
#' @examples
#' g + theme_psec1(title.size = ggpts(35), axis.size.title = ggpts(35), grid_Col = "#FFFFFF") # Remove grids
#' g + theme_psec1(title.size = ggpts(35), axis.size.title = ggpts(35))
#'
#' # Custom Caption used as:
#' # labs(caption= "First~line \n italic('and a second,')~bold('fancy one') \n 'also,'~integral(f(x)*dx, a, b)~'for good measure'")
#' # Bold and italics work from second line...
#' @export
#'
theme_psec1 <- function(base.size = 15,
title.size = 14,
subtitle.size = 12,
caption.size = 9,
legend.size = 10,
axis.size.title = 10,
axis.size = 10,
strip.size = 10,
legend.pos = "bottom",
grid_Col = "#F0EFEF",
Strip_Col = "#DDE1EE",
CustomCaption = FALSE,
CaptionColor = "grey50",
FontType = "sans") {
safefontload <- purrr::safely(extrafont::loadfonts)
x <- safefontload(device = "win", quiet = T)
extrafont::loadfonts(device = "pdf", quiet = T)
extrafont::loadfonts(device = "postscript", quiet = T)
if(CustomCaption){
library(grid)
element_custom <- function() {
structure(list(), class = c("element_custom", "element_text"))
}
element_grob.element_custom <- function(element, label="", ...) {
disect <- strsplit(label, "\\n")[[1]]
labels <- lapply(disect, function(x) tryCatch(parse(text=x),
error = function(e) x))
hl <- unit(rep(1, length(labels)), 'strheight', data=labels) + unit(0.1,"line")
yl <- c(list(unit(0,"line")),
lapply(seq_along(labels[-length(labels)]), function(ii) sum(hl[1:ii])))
cl <- do.call(gList, Map(function(label, ii)
textGrob(label, y = unit(1,"npc")-yl[[ii]], hjust=0, x=0, vjust=1),
label = labels, ii = seq_along(labels)))
gTree(children = cl, cl="sl", heights = hl, gp=gpar(col=CaptionColor,fontsize=caption.size))
}
heightDetails.sl <- function(x) sum(x$heights)
.GlobalEnv$element_custom <- element_custom
.GlobalEnv$element_grob.element_custom <- element_grob.element_custom
.GlobalEnv$heightDetails.sl <- heightDetails.sl
theme_grey() %+replace%
ggplot2::theme(rect = element_rect(fill = "transparent",
colour = NA, color = NA, size = 0, linetype = 0),
text = element_text(family = FontType, face = "plain",
colour = "black", size = base.size, lineheight = 0.9,
hjust = 0.5, vjust = 0.5, angle = 0, margin = margin(),
debug = FALSE),
plot.title = ggplot2::element_text(size = title.size, face = "bold", color = "#222222",
# Left align
hjust = 0),
plot.subtitle = ggplot2::element_text(size = subtitle.size, margin = ggplot2::margin(9, 0, 9, 0),
# Left align
hjust = 0),
# plot.caption = ggplot2::element_text(size = caption.size),
#Legend
legend.position = legend.pos, legend.text.align = 0,
legend.background = ggplot2::element_blank(),
legend.title = ggplot2::element_blank(),
legend.key = ggplot2::element_blank(),
legend.text = ggplot2::element_text(size = legend.size,
color = "#222222"),
# Axes
# axis.title.x = ggplot2::element_blank(),
axis.text = ggplot2::element_text(size = axis.size,
color = "#222222"),
axis.text.x = ggplot2::element_text(margin = ggplot2::margin(5, b = 10)),
axis.ticks = ggplot2::element_blank(),
axis.title = ggplot2::element_text(size = axis.size.title),
# Plot Border
# panel.border = element_blank(),
axis.line = element_line(colour = "black",
size = rel(1)),
# Gridlines
panel.grid.major.y = ggplot2::element_line(color = grid_Col),
panel.grid.major.x = ggplot2::element_line(color = grid_Col),
# panel.grid.major.x = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
# panel.grid.minor = element_line(size = rel(0.5)),
# Panels:
panel.background = ggplot2::element_blank(),
strip.background = element_rect(fill = Strip_Col),
strip.text = element_text(face = "bold", colour = "black", size = strip.size),
plot.caption = element_custom())
} else {
theme_grey() %+replace%
ggplot2::theme(rect = element_rect(fill = "transparent",
colour = NA, color = NA, size = 0, linetype = 0),
text = element_text(family = FontType, face = "plain",
colour = "black", size = base.size, lineheight = 0.9,
hjust = 0.5, vjust = 0.5, angle = 0, margin = margin(),
debug = FALSE),
plot.title = ggplot2::element_text(size = title.size, face = "bold", color = "#222222",
# Left align
hjust = 0),
plot.subtitle = ggplot2::element_text(size = subtitle.size, margin = ggplot2::margin(9, 0, 9, 0),
# Left align
hjust = 0),
plot.caption = ggplot2::element_text(size = caption.size),
#Legend
legend.position = legend.pos, legend.text.align = 0,
legend.background = ggplot2::element_blank(),
legend.title = ggplot2::element_blank(),
legend.key = ggplot2::element_blank(),
legend.text = ggplot2::element_text(size = legend.size,
color = "#222222"),
# Axes
# axis.title.x = ggplot2::element_blank(),
axis.text = ggplot2::element_text(size = axis.size,
color = "#222222"),
axis.text.x = ggplot2::element_text(margin = ggplot2::margin(5, b = 10)),
axis.ticks = ggplot2::element_blank(),
axis.title = ggplot2::element_text(size = axis.size.title),
# Plot Border
# panel.border = element_blank(),
axis.line = element_line(colour = "black",
size = rel(1)),
# Gridlines
panel.grid.major.y = ggplot2::element_line(color = grid_Col),
panel.grid.major.x = ggplot2::element_line(color = grid_Col),
# panel.grid.major.x = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
# panel.grid.minor = element_line(size = rel(0.5)),
# Panels:
panel.background = ggplot2::element_blank(),
strip.background = element_rect(fill = Strip_Col),
strip.text = element_text(face = "bold", colour = "black", size = strip.size))
}
}
#' @title theme_psec2
#' @description Plotting theme for ggplot: with boundary
#' @param FontType Check available fonts using: windowsFonts() - use $ title in list given.
#' @return plot theme
#' @examples
#' g + theme_psec2(title.size = ggpts(35), axis.size.title = ggpts(35), grid_Col = "#FFFFFF") # rm grid lines..
#' g + theme_psec2(title.size = ggpts(35), axis.size.title = ggpts(35))
#' @export
#'
#'
theme_psec2 <- function(base.size = 15,
title.size = 14,
subtitle.size = 12,
caption.size = 9,
legend.size = 10,
axis.size.title = 10,
axis.size = 10,
strip.size = 10,
legend.pos = "bottom",
grid_Col = "#F0EFEF",
Strip_Col = "#DDE1EE",
CustomCaption = FALSE,
CaptionColor = "grey50",
FontType = "sans") {
safefontload <- purrr::safely(extrafont::loadfonts)
x <- safefontload(device = "win", quiet = T)
extrafont::loadfonts(device = "pdf", quiet = T)
extrafont::loadfonts(device = "postscript", quiet = T)
if(CustomCaption){
library(grid)
element_custom <- function() {
structure(list(), class = c("element_custom", "element_text"))
}
element_grob.element_custom <- function(element, label="", ...) {
disect <- strsplit(label, "\\n")[[1]]
labels <- lapply(disect, function(x) tryCatch(parse(text=x),
error = function(e) x))
hl <- unit(rep(1, length(labels)), 'strheight', data=labels) + unit(0.1,"line")
yl <- c(list(unit(0,"line")),
lapply(seq_along(labels[-length(labels)]), function(ii) sum(hl[1:ii])))
cl <- do.call(gList, Map(function(label, ii)
textGrob(label, y = unit(1,"npc")-yl[[ii]], hjust=0, x=0, vjust=1),
label = labels, ii = seq_along(labels)))
gTree(children = cl, cl="sl", heights = hl, gp=gpar(col=CaptionColor,fontsize=caption.size))
}
heightDetails.sl <- function(x) sum(x$heights)
.GlobalEnv$element_custom <- element_custom
.GlobalEnv$element_grob.element_custom <- element_grob.element_custom
.GlobalEnv$heightDetails.sl <- heightDetails.sl
theme_grey() %+replace%
ggplot2::theme(rect = element_rect(fill = "transparent",
colour = NA, color = NA, size = 0, linetype = 0),
text = element_text(family = FontType, face = "plain",
colour = "black", size = base.size, lineheight = 0.9,
hjust = 0.5, vjust = 0.5, angle = 0, margin = margin(),
debug = FALSE),
plot.title = ggplot2::element_text(size = title.size, face = "bold", color = "#222222",
# Left align
hjust = 0),
plot.subtitle = ggplot2::element_text(size = subtitle.size, margin = ggplot2::margin(9, 0, 9, 0),
# Left align
hjust = 0),
# plot.caption = ggplot2::element_text(size = caption.size),
plot.caption = element_custom(),
#Legend
legend.position = legend.pos, legend.text.align = 0,
legend.background = ggplot2::element_blank(),
legend.title = ggplot2::element_blank(),
legend.key = ggplot2::element_blank(),
legend.text = ggplot2::element_text( size = legend.size,
color = "#222222"),
# Axes
# axis.title.x = ggplot2::element_blank(),
axis.text = ggplot2::element_text( size = axis.size,
color = "#222222"),
axis.text.x = ggplot2::element_text(margin = ggplot2::margin(5, b = 10)),
axis.ticks = ggplot2::element_blank(),
axis.line = ggplot2::element_blank(),
axis.title = ggplot2::element_text(size = axis.size.title),
# Plot Border
panel.border = element_rect(fill = NA, color = "black"),
# Gridlines
panel.grid.major.y = ggplot2::element_line(color = grid_Col),
# panel.grid.major.x = ggplot2::element_line(color = "#cbcbcb"),
panel.grid.major.x = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
# panel.grid.minor = element_line(size = rel(0.5)),
# Panels:
panel.background = ggplot2::element_blank(),
strip.background = element_rect(fill = Strip_Col),
strip.text = element_text(colour = "black", size = strip.size))
} else {
theme_grey() %+replace%
ggplot2::theme(rect = element_rect(fill = "transparent",
colour = NA, color = NA, size = 0, linetype = 0),
text = element_text(family = FontType, face = "plain",
colour = "black", size = base.size, lineheight = 0.9,
hjust = 0.5, vjust = 0.5, angle = 0, margin = margin(),
debug = FALSE),
plot.title = ggplot2::element_text(size = title.size, face = "bold", color = "#222222",
# Left align
hjust = 0),
plot.subtitle = ggplot2::element_text(size = subtitle.size, margin = ggplot2::margin(9, 0, 9, 0),
# Left align
hjust = 0),
plot.caption = ggplot2::element_text(size = caption.size),
#Legend
legend.position = legend.pos, legend.text.align = 0,
legend.background = ggplot2::element_blank(),
legend.title = ggplot2::element_blank(),
legend.key = ggplot2::element_blank(),
legend.text = ggplot2::element_text( size = legend.size,
color = "#222222"),
# Axes
# axis.title.x = ggplot2::element_blank(),
axis.text = ggplot2::element_text( size = axis.size,
color = "#222222"),
axis.text.x = ggplot2::element_text(margin = ggplot2::margin(5, b = 10)),
axis.ticks = ggplot2::element_blank(),
axis.line = ggplot2::element_blank(),
axis.title = ggplot2::element_text(size = axis.size.title),
# Plot Border
panel.border = element_rect(fill = NA, color = "black"),
# Gridlines
panel.grid.major.y = ggplot2::element_line(color = grid_Col),
# panel.grid.major.x = ggplot2::element_line(color = "#cbcbcb"),
panel.grid.major.x = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
# panel.grid.minor = element_line(size = rel(0.5)),
# Panels:
panel.background = ggplot2::element_blank(),
strip.background = element_rect(fill = Strip_Col),
strip.text = element_text(colour = "black", size = strip.size))
}
}
#' @title finplot
#' @description Plotting aide for Psec plotting functionalities.
#' @return ggplot object
#' @param x.comma.sep Make x axis not show scientific values (e.g. shows 25,000,000 as opposed to 2.5e+6)
#' @param y.comma.sep Make y axis not show scientific values (e.g. shows 25,000,000 as opposed to 2.5e+6)
#' @param x.pct Make x axis percentages
#' @param x.pct_acc Rounding of pct value.
#' @param y.pct Make y axis percentages
#' @param y.pct_acc Rounding of pct value.
#' @param x.vert flip x axis
#' @param y.vert flip y axis
#' @param x.ticks.rm Remove x ticks altogether
#' @param y.ticks.rm Remove x ticks altogether
#' @param legend_pos where to position legend. Defaults to bottom.
#' @param col.hue set color hues. E.g., set hue = 40 to see what happens
#' @param fill.hue set fill hues. E.g., set hue = 40 to see what happens
#' @param title.center Put title in center of figure. Used with grids or facet wraps e.g.
#' @param darkcol Use dark colors
#' @param x.date.type Of e.g. form '\%Y', '\%y_\%b'
#' @param x.date.dist Space between date points on x axis. E.g., "2 years", "10 week"
#' @param x.date.vector.sel Provide a vector of possible dates - this way weekends and holidays are e.g. removed... use bdscale here. E.g. use: x.date.vector.sel = unique(df$date)
#' @param legend.line.size Make legend lines larger
#' @param legend.line.alpha Make legend lines lighter
#' @param legend.text.size Adj legend text
#' @param log.y Apply a log transformation on the y-axis. This is a log base 10 transformation
#' @examples
#' g <- ggplot() + geom_line(aes(date, returns, color = Funds)) + theme_psec1
#' finplot(g, x.pct = TRUE)
#' @export
#'
finplot <- function(g,
x.comma.sep = FALSE,
y.comma.sep = FALSE,
x.pct = FALSE,
x.pct_acc = 0.1,
y.pct = FALSE,
y.pct_acc = 0.1,
zero.anchor = FALSE,
x.vert = FALSE,
y.vert = FALSE,
x.ticks.rm = FALSE,
y.ticks.rm = FALSE,
legend_pos = "bottom",
col.hue = NULL,
fill.hue = NULL,
title.centre = FALSE,
darkcol = FALSE,
x.date.type = NULL,
x.date.dist = NULL,
x.date.vector.sel = NULL,
legend.line.size = NULL,
legend.text.size = NULL,
legend.line.alpha = NULL,
legend.title = NULL,
log.y = FALSE){
if( x.comma.sep ) {
g <-
g + scale_x_continuous(labels = scales::comma)
}
if( y.comma.sep ) {
g <-
g + scale_y_continuous(labels = scales::comma)
}
if( x.pct ) {
g <-
g + scale_x_continuous(labels = scales::percent_format(accuracy = x.pct_acc))
}
if( y.pct ) {
g <-
g + scale_y_continuous(labels = scales::percent_format(accuracy = y.pct_acc))
}
if( zero.anchor ) {
g <-
g + expand_limits(x = 0, y = 0)
}
if(is.null(x.date.type) & !is.null(x.date.vector.sel) ) {
g <-
g +
bdscale::scale_x_bd(business.dates = x.date.vector.sel)
}
if(!is.null(x.date.type) & !is.null(x.date.vector.sel) ) {
g <-
g +
bdscale::scale_x_bd(business.dates = x.date.vector.sel, labels=scales::date_format(x.date.type))
}
if(is.null(x.date.vector.sel) & is.null(x.date.type) & !is.null(x.date.dist) ) {
g <-
g +
scale_x_date(date_breaks = x.date.dist)
}
if(!is.null(x.date.type) & is.null(x.date.vector.sel) & !is.null(x.date.dist) ) {
g <-
g +
scale_x_date(labels=scales::date_format(x.date.type), date_breaks = x.date.dist)
}
if( !is.null(col.hue)){
g <-
g + scale_color_hue(l = col.hue)
}
if( !is.null(fill.hue)){
g <-
g + scale_fill_hue(l = fill.hue)
}
if( x.vert & x.ticks.rm ) stop("Cannot have x.vert and x.ticks.rm... please choose")
if( y.vert & y.ticks.rm ) stop("Cannot have x.vert and x.ticks.rm... please choose")
if(x.vert) {
g <-
g + theme(axis.text.x=element_text(angle = 90, hjust = 1))
}
if(x.ticks.rm) {
g <-
g + theme(axis.text.x=element_blank())
}
if(y.vert) {
g <-
g + theme(axis.text.y=element_text(angle = 90, hjust = 1))
}
if(y.ticks.rm) {
g <-
g + theme(axis.text.y=element_blank())
}
if ( darkcol ) {
g <-
g +
scale_color_brewer(palette="Dark2")
}
g <-
g + theme(legend.position = legend_pos)
if(title.centre){
g <- g +
ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5),
plot.subtitle = ggplot2::element_text(hjust = 0.5) )
}
if( !is.null( legend.line.size )) {
g <-
g + guides(colour = guide_legend(override.aes = list(size = legend.line.size)))
}
if( !is.null( legend.text.size )) {
g <-
g +
ggplot2::theme(legend.text = ggplot2::element_text(size = legend.text.size) )
}
if( !is.null( legend.line.alpha )) {
g <-
g + guides(colour = guide_legend(override.aes = list(alpha=legend.line.alpha)))
}
if( !is.null( legend.title )) {
g <-
g + ggplot2::theme(legend.title = ggplot2::element_text(size = legend.title) )
} else {
g <-
g + ggplot2::theme(legend.title = ggplot2::element_blank() )
}
if( log.y ) {
g <-
g +
coord_trans(y = 'log10') +
# annotation_logticks(scaled=FALSE) +
scale_y_continuous(breaks = scales::trans_breaks("log10", function(x) 10^x),
labels = scales::trans_format("log10", scales::math_format(10^.x)))
}
g
}
#' @title psec_cols1
#' @description Plotting colors
#' @return manual color theme
#' @examples
#' g + psec_cols1() + ...
#' @export
#'
psec_cols1 <- function() {
PastelCols <- c("dodgerblue4", "chocolate3", "springgreen3", "#AD3636", "cornflowerblue", "darkslategray",
"darkorange", "darkorchid4", "darkgoldenrod4", "gray45", "darkolivegreen", "gray3", "yellow2")
scale_color_manual(values = PastelCols)
}
#' @title psec_fills1
#' @description Plotting colors
#' @return manual color theme
#' @examples
#' g + psec_fills1() + ...
#' @export
#'
psec_fills1 <- function() {
Pastelfills <- c("#AD3636", "chocolate3", "mediumseagreen", "dodgerblue4", "cornflowerblue", "darkslategray",
"darkolivegreen2", "darkorchid4", "darkgoldenrod4", "gray45", "darkolivegreen", "gray3", "yellow2")
scale_fill_manual(values = Pastelfills)
}
#' @title ggpts
#' @description Makes text size changes much easier in ggplot
#' @return changes text size in plot
#' @param x size
#' @examples
#' g <- ggplot(mtcars, aes(x=wt, y=mpg)) + geom_point() +
#' annotate(geom="label", x = 3.5, y = 22.5, label = "Some Text", size = ggpts(12))
#' @export
#'
ggpts <- function(x) {
as.numeric(grid::convertX(grid::unit(x, "points"), "mm"))
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment