R/ggThemeViewer.R
In M3IT/ggThemeViewer: What the Package Does (One Line, Title Case)
Defines functions
ggThemeViewer
# ------------------------------------------------------
#
# To Do next steps
#
# Read https://cran.r-project.org/web/packages/ggthemes/ggthemes.pdf
# Compare with \\M3-XPS-15\RMIT\Dev_V2\R\Shiny\ggThemeViewer\Themes.xlsx which I've started updating
#
# Confirm all options here are covered: https://yutannihilation.github.io/allYourFigureAreBelongToUs/ggthemes/
#
# Decide ho to handle the options with many combinations/palettes e.g Canva
#
# Canva resources:
# https://www.canva.com/colors/color-palettes/page/1/
# https://www.canva.com/colors/color-wheel/
#
# Work out how to export the code needed to add the theme/palette etc to the ggplot passed
# Also return a ggplot object with the changes applied.
#
# Caution with making changes after the p1 (plot render) as it stops the plot rendering.
#
# look for other options and decide which are practical to implement (eg. xkcd seems problematic.)
#----------------------------------------------------------
#' An addin to let you see how good your ggplot can look
#'
#' This function allows you to pass a ggplot and then see how that plot will look with many
#' different themes and colour schemes
#' @param ggp Your ggplot. If none passed, there are samples included.
#' @param scale_type The colour scale your plot uses (scale_) colour, fill, continuous. Will attempt to guess if none passed.
#' @param palette_size How many colours are in your plot (default = 10)
#' @keywords ggplot, theme, colour, color
#' @import shiny, miniUI, rstudioapi, ggplot2, ggthemes, scales, ggsci, jcolors, RColorBrewer, wesanderson
#' @examples
#' p <- ggplot(mtcars) + geom_bar(aes(factor(hp), fill=factor(hp)))
#' ggThemeViewer(p)
#' @name ggThemeViewer
#'
#'
ggThemeViewer <- function(ggp = NULL, scale_type = c('colour', 'fill', 'continuous'), palette_size = NULL) {
library(shiny)
library(miniUI)
library(ggplot2)
library(ggthemes)
library(scales)
library(ggsci)
library(jcolors)
library(RColorBrewer)
library(wesanderson)
# devtools::use_package("wesanderson")
#devtools::document()
#context <- rstudioapi::getActiveDocumentContext()
#text <- context$selection[[1]]$text
ggtv_out <- '!'
test_fn <- function(ss) {
ggtv_out <<- paste0(ggtv_out, ss)
}
plot_info <- function(ggplot) {
ret = list()
bp <- ggplot2::ggplot_build(ggplot)
ret$x_scale <- class(bp$layout$get_scales(1)$x)[2]
ret$y_scale <- class(bp$layout$get_scales(1)$y)[2]
# Swap if axes are flipped (so only x axis needs to be checked)
if (ret$x_scale == 'ScaleContinuous' & ret$y_scale != 'ScaleContinuous') {
ret$x_scale <- ret$y_scale
ret$y_scale <- 'ScaleContinuous'
}
clr_max <- 0
for (i in 1:length(bp$data)) {clr_max <- max(clr_max, length(unique(as.data.frame(bp$data[i])$colour)))}
ret$colours <- clr_max
fll_max <- 0
for (i in 1:length(bp$data)) {fll_max <- max(fll_max, length(unique(as.data.frame(bp$data[i])$fill)))}
ret$fills <- fll_max
grp_max <- 0
grps <- c()
for (i in 1:length(bp$data)) {
grp_max <- max(grp_max, length(unique(as.data.frame(bp$data[i])$group)))
grps <- c(grps, unique(as.data.frame(bp$data[i])$group))
}
ret$group_count <- grp_max
ret$groups <- unique(grps)
if (ret$x_scale == 'ScaleDiscrete') {
if (ret$fills > 1) {
ret$scale_type <- 'fill'
ret$pal_size <- ret$fills
}
else {
ret$scale_type <- 'colour'
ret$pal_size <- ret$colours
}
}
else {
if (ret$group_count > 1) {
ret$scale_type <- 'colour'
ret$pal_size <- ret$colours
}
else {
ret$scale_type <- 'continuous'
ret$pal_size <- -1
}
}
return (ret)
}
palette_fill_na <- function(palt, n) {
ret <- palt
if (length(palt) < n) {
for (i in (length(palt) + 1):n) {
ret <- c(ret, NA)
}
}
return (ret)
}
# options(error = NULL)
# To do - tidy this up
passed.valid <- FALSE
if (is.null(ggp)) {
passed.valid = FALSE
} else if (class(ggp)[1] == 'gg') {
# if (class(ggp)[2] == 'ggplot') {
# passed.valid = TRUE
# } else {
# passed.valid = FALSE
# }
passed.valid = (class(ggp)[2] == 'ggplot')
} else {
passed.valid = FALSE
}
# A better option may be this code, from Dean Attali's plotHelper
# If it's a ggplot2 plot, we need to explicitly print it to see if there
# are errors
# if (ggplot2::is.ggplot(p)) {
# print(p)
# } else {
# p
# }
#data(tvcars)
#devtools::use_data(tvcars)
# ggtv_out = paste0('Nothing', passed.valid, Sys.time())
if (passed.valid) {
plt.info <- plot_info(ggp)
scale.type <- ifelse(missing(scale_type), plt.info$scale_type, scale_type)
palette.size <- ifelse(is.null(palette_size), plt.info$pal_size, palette_size)
# ggtv_out <- deparse(substitute(ggp))
}
Themes <- new.env()
Themes[['grey']]$src <- 'ggplot'; Themes[['grey']]$nm <- 'theme_grey()'; Themes[['grey']]$th <- theme_grey()
Themes[['bw']]$src <- 'ggplot'; Themes[['grey']]$nm <- 'theme_grey()'; Themes[['bw']]$th <- theme_bw()
Themes[['classic']]$src <- 'ggplot'; Themes[['classic']]$th <- theme_classic()
Themes[['dark']]$src <- 'ggplot'; Themes[['dark']]$th <- theme_dark()
Themes[['light']]$src <- 'ggplot'; Themes[['light']]$th <- theme_light()
Themes[['linedraw']]$src <- 'ggplot'; Themes[['linedraw']]$th <- theme_linedraw()
Themes[['minimal']]$src <- 'ggplot'; Themes[['minimal']]$th <- theme_minimal()
Themes[['void']]$src <- 'ggplot'; Themes[['void']]$th <- theme_void()
Themes[['base']]$src <- 'ggthemes'; Themes[['base']]$th <- theme_base()
Themes[['calc']]$src <- 'ggthemes'; Themes[['calc']]$th <- theme_calc()
Themes[['economist']]$src <- 'ggthemes'; Themes[['economist']]$th <- theme_economist()
Themes[['excel']]$src <- 'ggthemes'; Themes[['excel']]$th <- theme_excel()
Themes[['few']]$src <- 'ggthemes'; Themes[['few']]$th <- theme_few()
Themes[['fivethirtyeight']]$src <- 'ggthemes'; Themes[['fivethirtyeight']]$th <- theme_fivethirtyeight()
Themes[['gdocs']]$src <- 'ggthemes'; Themes[['gdocs']]$th <- theme_gdocs()
Themes[['hc']]$src <- 'ggthemes'; Themes[['hc']]$th <- theme_hc()
Themes[['par']]$src <- 'ggthemes'; Themes[['par']]$th <- theme_par()
Themes[['pander']]$src <- 'ggthemes'; Themes[['pander']]$th <- theme_pander()
Themes[['solarized']]$src <- 'ggthemes'; Themes[['solarized']]$th <- theme_solarized()
Themes[['stata']]$src <- 'ggthemes'; Themes[['stata']]$th <- theme_stata()
Themes[['tufte']]$src <- 'ggthemes'; Themes[['tufte']]$th <- theme_tufte()
Themes[['wsj']]$src <- 'ggthemes'; Themes[['wsj']]$th <- theme_wsj()
Themes[['dark_bg']]$src <- 'jcolors'; Themes[['dark_bg']]$th <- theme_dark_bg()
Themes[['light_bg']]$src <- 'jcolors'; Themes[['light_bg']]$th <- theme_light_bg()
tn <- c() # Names
td <- c() # Sources & names
ord <- c('ggplot', 'ggthemes', 'jcolors') # Set display order
# Order by source, then theme name alphabetically (otherwise just sorted by alpha)
for (i in 1:length(ord)) {
for (each in ls(Themes)) {
m = match(Themes[[each]]$src, ord)
if (m == i) {
tn <- append(tn, each)
td <- append(td, paste0(Themes[[each]]$src, ' - ', each))
}
}
}
names(tn) <- td
Scales <- new.env()
Scales[['default']]$src <- 'ggplot'; Scales[['default']]$sc <- scale_colour_hue(); Scales[['default']]$sf <- scale_fill_hue(); Scales[['default']]$pal <- hue_pal()(12)
Scales[['calc']]$src <- 'ggthemes'; Scales[['calc']]$sc <- scale_colour_calc(); Scales[['calc']]$sf <- scale_fill_calc(); Scales[['calc']]$pal <- calc_pal()(12)
Scales[['colorblind']]$src <- 'ggthemes';Scales[['colorblind']]$sc <- scale_colour_colorblind(); Scales[['colorblind']]$sf <- scale_fill_colorblind(); Scales[['colorblind']]$pal <- colorblind_pal()(8)
Scales[['economist']]$src <- 'ggthemes'; Scales[['economist']]$sc <- scale_colour_economist(); Scales[['economist']]$sf <- scale_fill_economist(); Scales[['economist']]$pal <- economist_pal()(6)
Scales[['excel']]$src <- 'ggthemes'; Scales[['excel']]$sc <- scale_colour_excel(); Scales[['excel']]$sf <- scale_fill_excel(); Scales[['excel']]$pal <- excel_pal()(7)
Scales[['few']]$src <- 'ggthemes'; Scales[['few']]$sc <- scale_colour_few(); Scales[['few']]$sf <- scale_fill_few(); Scales[['few']]$pal <- few_pal()(7)
Scales[['gdocs']]$src <- 'ggthemes'; Scales[['gdocs']]$sc <- scale_colour_gdocs(); Scales[['gdocs']]$sf <- scale_fill_gdocs(); Scales[['gdocs']]$pal <- gdocs_pal()(10)
Scales[['hc']]$src <- 'ggthemes'; Scales[['hc']]$sc <- scale_colour_hc(); Scales[['hc']]$sf <- scale_fill_hc(); Scales[['hc']]$pal <- hc_pal(palette = 'default')(10)
Scales[['pander']]$src <- 'ggthemes'; Scales[['pander']]$sc <- scale_colour_pander(); Scales[['pander']]$sf <- scale_fill_pander(); Scales[['pander']]$pal <- palette_pander(8)
Scales[['ptol']]$src <- 'ggthemes'; Scales[['ptol']]$sc <- scale_colour_ptol(); Scales[['ptol']]$sf <- scale_fill_ptol(); Scales[['ptol']]$pal <- ptol_pal()(10)
Scales[['solarized']]$src <- 'ggthemes'; Scales[['solarized']]$sc <- scale_colour_solarized(); Scales[['solarized']]$sf <- scale_fill_solarized(); Scales[['solarized']]$pal <- solarized_pal()(8)
Scales[['stata']]$src <- 'ggthemes'; Scales[['stata']]$sc <- scale_colour_stata(); Scales[['stata']]$sf <- scale_fill_stata(); Scales[['stata']]$pal <- stata_pal()(15)
Scales[['tableau']]$src <- 'ggthemes'; Scales[['tableau']]$sc <- scale_colour_tableau(); Scales[['tableau']]$sf <- scale_fill_tableau(); Scales[['tableau']]$pal <- tableau_color_pal('Tableau 10')(10); Scales[['tableau']]$cont <- scale_color_continuous_tableau()
Scales[['tableau2']]$src <- 'ggthemes'; Scales[['tableau2']]$sc <- scale_colour_tableau(); Scales[['tableau2']]$sf <- scale_fill_tableau(); Scales[['tableau2']]$pal <- tableau_color_pal('Tableau 20')(20); Scales[['tableau2']]$cont <- scale_color_continuous_tableau()
Scales[['tableau Color Blind']]$src <- 'ggthemes'; Scales[['tableau Color Blind']]$sc <- scale_colour_tableau(); Scales[['tableau Color Blind']]$sf <- scale_fill_tableau(); Scales[['tableau Color Blind']]$pal <- tableau_color_pal('Color Blind')(10); Scales[['tableau Color Blind']]$cont <- scale_color_continuous_tableau()
Scales[['tableau4']]$src <- 'ggthemes'; Scales[['tableau4']]$sc <- scale_colour_tableau(); Scales[['tableau4']]$sf <- scale_fill_tableau(); Scales[['tableau4']]$pal <- tableau_color_pal('Seattle Grays')(5); Scales[['tableau4']]$cont <- scale_color_continuous_tableau()
# Scales[['tableau']]$src <- 'ggthemes'; Scales[['tableau5']]$sc <- scale_colour_tableau(); Scales[['tableau']]$sf <- scale_fill_tableau(); Scales[['tableau']]$pal <- tableau_color_pal('Traffic')(9); Scales[['tableau']]$cont <- scale_color_continuous_tableau()
# Scales[['tableau']]$src <- 'ggthemes'; Scales[['tableau6']]$sc <- scale_colour_tableau(); Scales[['tableau']]$sf <- scale_fill_tableau(); Scales[['tableau']]$pal <- tableau_color_pal('Miller Stone')(11); Scales[['tableau']]$cont <- scale_color_continuous_tableau()
# Suggestion from Yong Kai (Email 5 Nov 2017)
# library(RColorBrewer)
# df <- RColorBrewer::brewer.pal.info
# Scales <- new.env()
#
# for(i in 1:nrow(df)){
# Scales[[ rownames(df)[i] ]]$scr <- paste('brewer', df[i, 2] )
# }
Scales[['Blues']]$src <- 'brewer seq'; Scales[['Blues']]$pal <- brewer.pal(9, 'Blues')
Scales[['BuGn']]$src <- 'brewer seq'; Scales[['BuGn']]$pal <- brewer.pal(9, 'BuGn')
Scales[['BuPu']]$src <- 'brewer seq'; Scales[['BuPu']]$pal <- brewer.pal(9, 'BuPu')
Scales[['GnBu']]$src <- 'brewer seq'; Scales[['GnBu']]$pal <- brewer.pal(9, 'GnBu')
Scales[['Greens']]$src <- 'brewer seq'; Scales[['Greens']]$pal <- brewer.pal(9, 'Greens')
Scales[['Greys']]$src <- 'brewer seq'; Scales[['Greys']]$pal <- brewer.pal(9, 'Greys')
Scales[['Oranges']]$src <- 'brewer seq'; Scales[['Oranges']]$pal <- brewer.pal(9, 'Oranges')
Scales[['OrRd']]$src <- 'brewer seq'; Scales[['OrRd']]$pal <- brewer.pal(9, 'OrRd')
Scales[['PuBu']]$src <- 'brewer seq'; Scales[['PuBu']]$pal <- brewer.pal(9, 'PuBu')
Scales[['PuBuGn']]$src <- 'brewer seq'; Scales[['PuBuGn']]$pal <- brewer.pal(9, 'PuBuGn')
Scales[['PuRd']]$src <- 'brewer seq'; Scales[['PuRd']]$pal <- brewer.pal(9, 'PuRd')
Scales[['Purples']]$src <- 'brewer seq'; Scales[['Purples']]$pal <- brewer.pal(9, 'Purples')
Scales[['RdPu']]$src <- 'brewer seq'; Scales[['RdPu']]$pal <- brewer.pal(9, 'RdPu')
Scales[['Reds']]$src <- 'brewer seq'; Scales[['Reds']]$pal <- brewer.pal(9, 'Reds')
Scales[['YlGn']]$src <- 'brewer seq'; Scales[['YlGn']]$pal <- brewer.pal(9, 'YlGn')
Scales[['YlGnBu']]$src <- 'brewer seq'; Scales[['YlGnBu']]$pal <- brewer.pal(9, 'YlGnBu')
Scales[['YlOrBr']]$src <- 'brewer seq'; Scales[['YlOrBr']]$pal <- brewer.pal(9, 'YlOrBr')
Scales[['YlOrRd']]$src <- 'brewer seq'; Scales[['YlOrRd']]$pal <- brewer.pal(9, 'YlOrRd')
Scales[['Accent']]$src <- 'brewer qual'; Scales[['Accent']]$pal <- brewer.pal(8, 'Accent')
Scales[['Dark2']]$src <- 'brewer qual'; Scales[['Dark2']]$pal <- brewer.pal(8, 'Dark2')
Scales[['Paired']]$src <- 'brewer qual'; Scales[['Paired']]$pal <- brewer.pal(12, 'Paired')
Scales[['Pastel1']]$src <- 'brewer qual';Scales[['Pastel1']]$pal <- brewer.pal(9, 'Pastel1')
Scales[['Pastel2']]$src <- 'brewer qual';Scales[['Pastel2']]$pal <- brewer.pal(8, 'Pastel2')
Scales[['Set1']]$src <- 'brewer qual'; Scales[['Set1']]$pal <- brewer.pal(9, 'Set1')
Scales[['Set2']]$src <- 'brewer qual'; Scales[['Set2']]$pal <- brewer.pal(8, 'Set2')
Scales[['Set3']]$src <- 'brewer qual'; Scales[['Set3']]$pal <- brewer.pal(12, 'Set3')
Scales[['BrBG']]$src <- 'brewer div'; Scales[['BrBG']]$pal <- brewer.pal(11, 'BrBG')
Scales[['PiYG']]$src <- 'brewer div'; Scales[['PiYG']]$pal <- brewer.pal(11, 'PiYG')
Scales[['PRGn']]$src <- 'brewer div'; Scales[['PRGn']]$pal <- brewer.pal(11, 'PRGn')
Scales[['PuOr']]$src <- 'brewer div'; Scales[['PuOr']]$pal <- brewer.pal(11, 'PuOr')
Scales[['RdBu']]$src <- 'brewer div'; Scales[['RdBu']]$pal <- brewer.pal(11, 'RdBu')
Scales[['RdGy']]$src <- 'brewer div'; Scales[['RdGy']]$pal <- brewer.pal(11, 'RdGy')
Scales[['RdYlBu']]$src <- 'brewer div'; Scales[['RdYlBu']]$pal <- brewer.pal(11, 'RdYlBu')
Scales[['RdYlGn']]$src <- 'brewer div'; Scales[['RdYlGn']]$pal <- brewer.pal(11, 'RdYlGn')
Scales[['Spectral']]$src <- 'brewer div';Scales[['Spectral']]$pal <- brewer.pal(11, 'Spectral')
Scales[['BottleRocket1']]$src <- 'wesanderson'; Scales[['BottleRocket1']]$pal <- wes_palette("BottleRocket1");
Scales[['BottleRocket2']]$src <- 'wesanderson'; Scales[['BottleRocket2']]$pal <- wes_palette("BottleRocket2");
Scales[['Rushmore1']]$src <- 'wesanderson'; Scales[['Rushmore1']]$pal <- wes_palette("Rushmore")
Scales[['Royal1']]$src <- 'wesanderson'; Scales[['Royal1']]$pal <- wes_palette("Royal1")
Scales[['Royal2']]$src <- 'wesanderson'; Scales[['Royal2']]$pal <- wes_palette("Royal2")
Scales[['Zissou1']]$src <- 'wesanderson'; Scales[['Zissou1']]$pal <- wes_palette("Zissou1")
Scales[['Darjeeling1']]$src <- 'wesanderson'; Scales[['Darjeeling1']]$pal <- wes_palette("Darjeeling1")
Scales[['Darjeeling2']]$src <- 'wesanderson'; Scales[['Darjeeling2']]$pal <- wes_palette("Darjeeling2")
Scales[['Chevalier1']]$src <- 'wesanderson'; Scales[['Chevalier1']]$pal <- wes_palette("Chevalier1")
Scales[['FantasticFox1']]$src <- 'wesanderson'; Scales[['FantasticFox1']]$pal <- wes_palette("FantasticFox1")
Scales[['Moonrise1']]$src <- 'wesanderson'; Scales[['Moonrise1']]$pal <- wes_palette("Moonrise1")
Scales[['Moonrise2']]$src <- 'wesanderson'; Scales[['Moonrise2']]$pal <- wes_palette("Moonrise2")
Scales[['Moonrise3']]$src <- 'wesanderson'; Scales[['Moonrise3']]$pal <- wes_palette("Moonrise3")
Scales[['Cavalcanti1']]$src <- 'wesanderson'; Scales[['Cavalcanti1']]$pal <- wes_palette("Cavalcanti1")
Scales[['GrandBudapest1']]$src <- 'wesanderson'; Scales[['GrandBudapest1']]$pal <- wes_palette("GrandBudapest1")
Scales[['GrandBudapest2']]$src <- 'wesanderson'; Scales[['GrandBudapest2']]$pal <- wes_palette("GrandBudapest2")
Scales[['IsleofDogs1']]$src <- 'wesanderson'; Scales[['IsleofDogs1']]$pal <- wes_palette("IsleofDogs1")
Scales[['IsleofDogs2']]$src <- 'wesanderson'; Scales[['IsleofDogs2']]$pal <- wes_palette("IsleofDogs2")
# https://cran.r-project.org/web/packages/ggsci/ggsci.pdf
Scales[['aaas']]$src <- 'ggsci'; Scales[['aaas']]$sc <- scale_colour_aaas(); Scales[['aaas']]$sf <- scale_fill_aaas(); Scales[['aaas']]$pal <- pal_aaas()(10);
Scales[['d3']]$src <- 'ggsci'; Scales[['d3']]$sc <- scale_colour_d3(); Scales[['d3']]$sf <- scale_fill_d3(); Scales[['d3']]$pal <- pal_d3()(10);
Scales[['futurama']]$src <- 'ggsci'; Scales[['futurama']]$sc <- scale_colour_futurama(); Scales[['futurama']]$sf <- scale_fill_futurama(); Scales[['futurama']]$pal <- pal_futurama()(11);
Scales[['igv']]$src <- 'ggsci'; Scales[['igv']]$sc <- scale_colour_igv(); Scales[['igv']]$sf <- scale_fill_igv(); Scales[['igv']]$pal <- pal_igv()(20);
Scales[['jama']]$src <- 'ggsci'; Scales[['jama']]$sc <- scale_colour_jama(); Scales[['jama']]$sf <- scale_fill_jama(); Scales[['jama']]$pal <- pal_jama()(7);
Scales[['jco']]$src <- 'ggsci'; Scales[['jco']]$sc <- scale_colour_jco(); Scales[['jco']]$sf <- scale_fill_jco(); Scales[['jco']]$pal <- pal_jco()(5);
Scales[['lancet']]$src <- 'ggsci'; Scales[['lancet']]$sc <- scale_colour_lancet(); Scales[['lancet']]$sf <- scale_fill_lancet(); Scales[['lancet']]$pal <- pal_lancet()(9);
Scales[['locuszoom']]$src <- 'ggsci'; Scales[['locuszoom']]$sc <- scale_colour_locuszoom(); Scales[['locuszoom']]$sf <- scale_fill_locuszoom(); Scales[['locuszoom']]$pal <- pal_locuszoom()(7);
# Scales[['material']]$src <- 'ggsci'; Scales[['material']]$sc <- scale_colour_material(); Scales[['material']]$sf <- scale_fill_material(); Scales[['material']]$pal <- pal_material()(4);
Scales[['nejm']]$src <- 'ggsci'; Scales[['nejm']]$sc <- scale_colour_nejm(); Scales[['nejm']]$sf <- scale_fill_nejm(); Scales[['nejm']]$pal <- pal_nejm()(8);
Scales[['npg']]$src <- 'ggsci'; Scales[['npg']]$sc <- scale_colour_npg(); Scales[['npg']]$sf <- scale_fill_npg(); Scales[['npg']]$pal <- pal_npg()(10);
Scales[['rickandmorty']]$src <- 'ggsci'; Scales[['rickandmorty']]$sc <- scale_colour_rickandmorty(); Scales[['rickandmorty']]$sf <- scale_fill_rickandmorty();Scales[['rickandmorty']]$pal <- pal_rickandmorty()(12);
Scales[['simpsons']]$src <- 'ggsci'; Scales[['simpsons']]$sc <- scale_colour_simpsons(); Scales[['simpsons']]$sf <- scale_fill_simpsons(); Scales[['simpsons']]$pal <- pal_simpsons()(16);
Scales[['startrek']]$src <- 'ggsci'; Scales[['startrek']]$sc <- scale_colour_startrek(); Scales[['startrek']]$sf <- scale_fill_startrek(); Scales[['startrek']]$pal <- pal_startrek()(7);
Scales[['tron']]$src <- 'ggsci'; Scales[['tron']]$sc <- scale_colour_tron(); Scales[['tron']]$sf <- scale_fill_tron(); Scales[['tron']]$pal <- pal_tron()(7);
Scales[['uchicago']]$src <- 'ggsci'; Scales[['uchicago']]$sc <- scale_colour_uchicago(); Scales[['uchicago']]$sf <- scale_fill_uchicago(); Scales[['uchicago']]$pal <- pal_uchicago()(9);
# Scales[['gsea']]$src <- 'ggsci'; Scales[['gsea']]$cont <- scale_colour_gsea(); Scales[['gsea']]$sf <- scale_fill_gsea()
sn <- c() # Names
sd <- c() # Sources & names (for display)
# Set display order
ord <- c('ggplot', 'ggthemes', 'brewer seq', 'brewer qual', 'brewer div', 'wesanderson', 'ggsci')
# Order by source, then theme name alphabetically (otherwise just sorted by alpha)
for (i in 1:length(ord)) {
for (each in ls(Scales)) {
m = match(Scales[[each]]$src, ord)
if (m == i) {
sn <- append(sn, each)
sd <- append(sd, paste0(Scales[[each]]$src, ' - ', each))
}
}
}
names(sn) <- sd
t <- c('Point', 'Box', 'Bar', 'Contin.')
ui <- miniPage(
gadgetTitleBar("ggPlot Theme Viewer", right = miniTitleBarButton("done", "Done", primary = TRUE)),
tags$style(type='text/css',
'.shiny-output-error { visibility: hidden; }',
'.shiny-output-error:before { visibility: hidden; }'),
fillRow(flex = c(1, 3),
miniContentPanel(
#fillCol(flex = c(3, 3, 1, 1, 1), # Not working
uiOutput("theme"),
uiOutput("scale"),
uiOutput("interpolate"),
uiOutput("show_palette"),
uiOutput("demo"),
conditionalPanel(
condition = "input.demo == true",
uiOutput("plot_type"),
uiOutput("alpha")
)
#)
, padding = 15, scrollable = FALSE),
miniContentPanel(
textOutput("txtOut"),
plotOutput("plot", height = "95%")
, padding = 15)
)
)
server <- function(input, output, session) {
output$theme <- renderUI({
selectInput("theme", "Select background theme:",
choices = tn,
selected = 'grey',
selectize = FALSE,
size = 4
)
})
output$scale <- renderUI({
selectInput("scale", "Select foreground theme:",
choices = sn,
selected = 'default',
selectize = FALSE,
#size = 20
size = 20 + ifelse(input$demo, 0, 8)
)
})
output$interpolate <- renderUI({
checkboxInput("interpolate", "Match colour count to plot", value = TRUE)
})
output$show_palette <- renderUI({
checkboxInput("show_palette", "Show Palette (instead of plot)", value = FALSE)
})
output$demo <- renderUI({
checkboxInput("demo", "Demo chart", value = !passed.valid)
})
output$plot_type <- renderUI({
radioButtons("plot_type", "Select plot type:",
choices = t,
selected = 'Point',
inline = TRUE
)
})
output$alpha <- renderUI({
sliderInput("alpha", "Alpha:", min = 0.05, max = 1, value = 1, step = 0.05)
})
# tvcars is a dataset designed for the demo chart. ToDo: Work out how to include in package.
# Render the plot
output$plot <- renderPlot({
# ggtv_out <- paste0(ggtv_out, ':')
p1 <- ggplot(mtcars) + geom_bar(aes(factor(hp), fill=factor(hp)), alpha = input$alpha)
if (!is.null(input$theme)) {
if (input$demo == TRUE | !passed.valid) {
ttl <- ifelse(!passed.valid, 'Object passed is not a ggplot, using demo chart', 'Demo chart')
pal_size <- 5
if (input$plot_type == 'Bar') {
p1 <- ggplot(mtcars) + geom_bar(aes(factor(hp), fill=factor(hp)), alpha = input$alpha)
pal_size <- 22
# p1 <- ggplot(tvcars, aes(x = Drive_Wheels, y = Kilowatts, fill = Cylinders )) +
# geom_bar(stat="identity", position = "dodge", alpha = input$alpha) +
# scale_x_discrete(name = "Drive Wheels")
scl_type <- 'fill'
}
else if (input$plot_type == 'Box') {
# p1 <- ggplot(tvcars, aes(x = Cylinders, y = Kilowatts, colour = Cylinders)) +
# geom_boxplot(alpha = input$alpha) +
# facet_grid(. ~ paste0(Drive_Wheels, ' wheel drive'))
p1 <- ggplot(mtcars, aes(x = as.factor(cyl), y = hp, colour = as.factor(cyl))) +
geom_boxplot(alpha = input$alpha) +
facet_grid(. ~ paste0(vs, ' vs'))
scl_type <- 'colour'
}
else if (input$plot_type == 'Contin.') {
# p1 <- ggplot(tvcars, aes(x = Weight, y = Economy_city, colour = Kilowatts)) +
# geom_point(size = 5) + scale_y_continuous(limits = c(15, 60))
p1 <- ggplot(mtcars, aes(x = wt, y = mpg, colour = hp)) +
geom_point(size = 5, alpha = input$alpha)
scl_type <- 'continuous'
}
else {
# p1 <- ggplot(tvcars, aes(x = Engine_size, y = Kilowatts, colour = Cylinders)) +
# geom_point(position = "jitter", alpha = input$alpha) +
# geom_smooth(aes(colour = Cylinders), method = lm, se = FALSE) +
# scale_x_continuous(name = "Engine Size (litre)")
p1 <- ggplot(mtcars, aes(x = disp, y = hp, colour = as.factor(cyl))) +
geom_point(position = "jitter", alpha = input$alpha) +
geom_smooth(aes(colour = as.factor(cyl)), method = lm, se = FALSE) +
scale_x_continuous(name = "Displacement")
scl_type <- 'colour'
}
p1 <- p1 + ggtitle(ttl)
}
else {
p1 <- ggp
pal_size <- palette.size
scl_type <- scale.type
}
p1 <- p1 + Themes[[input$theme]]$th +
theme(plot.title = element_text(size = 14, face = "bold"), legend.key.size = unit(1.3, "cm"))
# ggtv_out <- paste0(ggtv_out, " + ", Themes[[input$theme]]$th)
if (pal_size <= length(Scales[[input$scale]]$pal)) {
palette_use <- Scales[[input$scale]]$pal
}
else {
if (input$interpolate) {palette_use <- colorRampPalette(Scales[[input$scale]]$pal)(pal_size)}
else {palette_use <- palette_fill_na(Scales[[input$scale]]$pal, pal_size)}
}
if (length(input$scale) > 0) {
if (scl_type == 'fill') {
p1 <- p1 + scale_fill_manual(values = palette_use)
test_fn('sfm')
}
else if (scl_type == 'colour') {
if (!is.null(Scales[[input$scale]]$pal) && is.null(Scales[[input$scale]]$sc)) {
p1 <- p1 + scale_color_manual(values = palette_use)
test_fn('scm')
}
else {
p1 <- p1 + Scales[[input$scale]]$sc
}
}
else if (scl_type == 'continuous') {
if (!is.null(Scales[[input$scale]]$cont)) {
p1 <- p1 + Scales[[input$scale]]$cont
}
else {
p1 <- p1 + scale_colour_gradientn(colours = Scales[[input$scale]]$pal[1:5])
}
}
}
if (!input$show_palette) {
# ggtv_out <- paste0(ggtv_out, " + ")
test_fn('P')
p1 # Must be the last thing done (rendered). Anything after will stop plot rendering
}
else {
test_fn('a')
if (!input$interpolate) {
show_col(colorRampPalette(Scales[[input$scale]]$pal)(length(Scales[[input$scale]]$pal)))
}
else {
show_col(colorRampPalette(Scales[[input$scale]]$pal)(pal_size))
}
}
}
})
output$txtOut <- renderText({
paste(paste0(Themes[[input$theme]]$src, '.', input$theme),
paste0(Scales[[input$scale]]$src, '.', input$scale),
input$alpha, ggtv_out, sep = ' | ')
})
# textOutput("txtOut"),
# Handle the Done button being pressed.
observeEvent(input$done, {
returnValue <- paste0(ggtv_out, ': ', Themes[[input$theme]]$src, '.', input$theme, '/', Scales[[input$scale]]$src, '.', input$scale, '\n')
rstudioapi::insertText(returnValue)
stopApp(returnValue)
})
observeEvent(input$cancel, {
stopApp()
})
}
viewer <- dialogViewer("Theme Viewer (v0.9.0)", width = 1200, height = 1000)
runGadget(ui, server, viewer = viewer)
}
M3IT/ggThemeViewer documentation built on Feb. 11, 2020, 4:16 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions ggThemeViewer
# ------------------------------------------------------
#
# To Do next steps
#
# Read https://cran.r-project.org/web/packages/ggthemes/ggthemes.pdf
# Compare with \\M3-XPS-15\RMIT\Dev_V2\R\Shiny\ggThemeViewer\Themes.xlsx which I've started updating
#
# Confirm all options here are covered: https://yutannihilation.github.io/allYourFigureAreBelongToUs/ggthemes/
#
# Decide ho to handle the options with many combinations/palettes e.g Canva
#
# Canva resources:
# https://www.canva.com/colors/color-palettes/page/1/
# https://www.canva.com/colors/color-wheel/
#
# Work out how to export the code needed to add the theme/palette etc to the ggplot passed
# Also return a ggplot object with the changes applied.
#
# Caution with making changes after the p1 (plot render) as it stops the plot rendering.
#
# look for other options and decide which are practical to implement (eg. xkcd seems problematic.)
#----------------------------------------------------------
#' An addin to let you see how good your ggplot can look
#'
#' This function allows you to pass a ggplot and then see how that plot will look with many
#' different themes and colour schemes
#' @param ggp Your ggplot. If none passed, there are samples included.
#' @param scale_type The colour scale your plot uses (scale_) colour, fill, continuous. Will attempt to guess if none passed.
#' @param palette_size How many colours are in your plot (default = 10)
#' @keywords ggplot, theme, colour, color
#' @import shiny, miniUI, rstudioapi, ggplot2, ggthemes, scales, ggsci, jcolors, RColorBrewer, wesanderson
#' @examples
#' p <- ggplot(mtcars) + geom_bar(aes(factor(hp), fill=factor(hp)))
#' ggThemeViewer(p)
#' @name ggThemeViewer
#'
#'
ggThemeViewer <- function(ggp = NULL, scale_type = c('colour', 'fill', 'continuous'), palette_size = NULL) {
library(shiny)
library(miniUI)
library(ggplot2)
library(ggthemes)
library(scales)
library(ggsci)
library(jcolors)
library(RColorBrewer)
library(wesanderson)
# devtools::use_package("wesanderson")
#devtools::document()
#context <- rstudioapi::getActiveDocumentContext()
#text <- context$selection[[1]]$text
ggtv_out <- '!'
test_fn <- function(ss) {
ggtv_out <<- paste0(ggtv_out, ss)
}
plot_info <- function(ggplot) {
ret = list()
bp <- ggplot2::ggplot_build(ggplot)
ret$x_scale <- class(bp$layout$get_scales(1)$x)[2]
ret$y_scale <- class(bp$layout$get_scales(1)$y)[2]
# Swap if axes are flipped (so only x axis needs to be checked)
if (ret$x_scale == 'ScaleContinuous' & ret$y_scale != 'ScaleContinuous') {
ret$x_scale <- ret$y_scale
ret$y_scale <- 'ScaleContinuous'
}
clr_max <- 0
for (i in 1:length(bp$data)) {clr_max <- max(clr_max, length(unique(as.data.frame(bp$data[i])$colour)))}
ret$colours <- clr_max
fll_max <- 0
for (i in 1:length(bp$data)) {fll_max <- max(fll_max, length(unique(as.data.frame(bp$data[i])$fill)))}
ret$fills <- fll_max
grp_max <- 0
grps <- c()
for (i in 1:length(bp$data)) {
grp_max <- max(grp_max, length(unique(as.data.frame(bp$data[i])$group)))
grps <- c(grps, unique(as.data.frame(bp$data[i])$group))
}
ret$group_count <- grp_max
ret$groups <- unique(grps)
if (ret$x_scale == 'ScaleDiscrete') {
if (ret$fills > 1) {
ret$scale_type <- 'fill'
ret$pal_size <- ret$fills
}
else {
ret$scale_type <- 'colour'
ret$pal_size <- ret$colours
}
}
else {
if (ret$group_count > 1) {
ret$scale_type <- 'colour'
ret$pal_size <- ret$colours
}
else {
ret$scale_type <- 'continuous'
ret$pal_size <- -1
}
}
return (ret)
}
palette_fill_na <- function(palt, n) {
ret <- palt
if (length(palt) < n) {
for (i in (length(palt) + 1):n) {
ret <- c(ret, NA)
}
}
return (ret)
}
# options(error = NULL)
# To do - tidy this up
passed.valid <- FALSE
if (is.null(ggp)) {
passed.valid = FALSE
} else if (class(ggp)[1] == 'gg') {
# if (class(ggp)[2] == 'ggplot') {
# passed.valid = TRUE
# } else {
# passed.valid = FALSE
# }
passed.valid = (class(ggp)[2] == 'ggplot')
} else {
passed.valid = FALSE
}
# A better option may be this code, from Dean Attali's plotHelper
# If it's a ggplot2 plot, we need to explicitly print it to see if there
# are errors
# if (ggplot2::is.ggplot(p)) {
# print(p)
# } else {
# p
# }
#data(tvcars)
#devtools::use_data(tvcars)
# ggtv_out = paste0('Nothing', passed.valid, Sys.time())
if (passed.valid) {
plt.info <- plot_info(ggp)
scale.type <- ifelse(missing(scale_type), plt.info$scale_type, scale_type)
palette.size <- ifelse(is.null(palette_size), plt.info$pal_size, palette_size)
# ggtv_out <- deparse(substitute(ggp))
}
Themes <- new.env()
Themes[['grey']]$src <- 'ggplot'; Themes[['grey']]$nm <- 'theme_grey()'; Themes[['grey']]$th <- theme_grey()
Themes[['bw']]$src <- 'ggplot'; Themes[['grey']]$nm <- 'theme_grey()'; Themes[['bw']]$th <- theme_bw()
Themes[['classic']]$src <- 'ggplot'; Themes[['classic']]$th <- theme_classic()
Themes[['dark']]$src <- 'ggplot'; Themes[['dark']]$th <- theme_dark()
Themes[['light']]$src <- 'ggplot'; Themes[['light']]$th <- theme_light()
Themes[['linedraw']]$src <- 'ggplot'; Themes[['linedraw']]$th <- theme_linedraw()
Themes[['minimal']]$src <- 'ggplot'; Themes[['minimal']]$th <- theme_minimal()
Themes[['void']]$src <- 'ggplot'; Themes[['void']]$th <- theme_void()
Themes[['base']]$src <- 'ggthemes'; Themes[['base']]$th <- theme_base()
Themes[['calc']]$src <- 'ggthemes'; Themes[['calc']]$th <- theme_calc()
Themes[['economist']]$src <- 'ggthemes'; Themes[['economist']]$th <- theme_economist()
Themes[['excel']]$src <- 'ggthemes'; Themes[['excel']]$th <- theme_excel()
Themes[['few']]$src <- 'ggthemes'; Themes[['few']]$th <- theme_few()
Themes[['fivethirtyeight']]$src <- 'ggthemes'; Themes[['fivethirtyeight']]$th <- theme_fivethirtyeight()
Themes[['gdocs']]$src <- 'ggthemes'; Themes[['gdocs']]$th <- theme_gdocs()
Themes[['hc']]$src <- 'ggthemes'; Themes[['hc']]$th <- theme_hc()
Themes[['par']]$src <- 'ggthemes'; Themes[['par']]$th <- theme_par()
Themes[['pander']]$src <- 'ggthemes'; Themes[['pander']]$th <- theme_pander()
Themes[['solarized']]$src <- 'ggthemes'; Themes[['solarized']]$th <- theme_solarized()
Themes[['stata']]$src <- 'ggthemes'; Themes[['stata']]$th <- theme_stata()
Themes[['tufte']]$src <- 'ggthemes'; Themes[['tufte']]$th <- theme_tufte()
Themes[['wsj']]$src <- 'ggthemes'; Themes[['wsj']]$th <- theme_wsj()
Themes[['dark_bg']]$src <- 'jcolors'; Themes[['dark_bg']]$th <- theme_dark_bg()
Themes[['light_bg']]$src <- 'jcolors'; Themes[['light_bg']]$th <- theme_light_bg()
tn <- c() # Names
td <- c() # Sources & names
ord <- c('ggplot', 'ggthemes', 'jcolors') # Set display order
# Order by source, then theme name alphabetically (otherwise just sorted by alpha)
for (i in 1:length(ord)) {
for (each in ls(Themes)) {
m = match(Themes[[each]]$src, ord)
if (m == i) {
tn <- append(tn, each)
td <- append(td, paste0(Themes[[each]]$src, ' - ', each))
}
}
}
names(tn) <- td
Scales <- new.env()
Scales[['default']]$src <- 'ggplot'; Scales[['default']]$sc <- scale_colour_hue(); Scales[['default']]$sf <- scale_fill_hue(); Scales[['default']]$pal <- hue_pal()(12)
Scales[['calc']]$src <- 'ggthemes'; Scales[['calc']]$sc <- scale_colour_calc(); Scales[['calc']]$sf <- scale_fill_calc(); Scales[['calc']]$pal <- calc_pal()(12)
Scales[['colorblind']]$src <- 'ggthemes';Scales[['colorblind']]$sc <- scale_colour_colorblind(); Scales[['colorblind']]$sf <- scale_fill_colorblind(); Scales[['colorblind']]$pal <- colorblind_pal()(8)
Scales[['economist']]$src <- 'ggthemes'; Scales[['economist']]$sc <- scale_colour_economist(); Scales[['economist']]$sf <- scale_fill_economist(); Scales[['economist']]$pal <- economist_pal()(6)
Scales[['excel']]$src <- 'ggthemes'; Scales[['excel']]$sc <- scale_colour_excel(); Scales[['excel']]$sf <- scale_fill_excel(); Scales[['excel']]$pal <- excel_pal()(7)
Scales[['few']]$src <- 'ggthemes'; Scales[['few']]$sc <- scale_colour_few(); Scales[['few']]$sf <- scale_fill_few(); Scales[['few']]$pal <- few_pal()(7)
Scales[['gdocs']]$src <- 'ggthemes'; Scales[['gdocs']]$sc <- scale_colour_gdocs(); Scales[['gdocs']]$sf <- scale_fill_gdocs(); Scales[['gdocs']]$pal <- gdocs_pal()(10)
Scales[['hc']]$src <- 'ggthemes'; Scales[['hc']]$sc <- scale_colour_hc(); Scales[['hc']]$sf <- scale_fill_hc(); Scales[['hc']]$pal <- hc_pal(palette = 'default')(10)
Scales[['pander']]$src <- 'ggthemes'; Scales[['pander']]$sc <- scale_colour_pander(); Scales[['pander']]$sf <- scale_fill_pander(); Scales[['pander']]$pal <- palette_pander(8)
Scales[['ptol']]$src <- 'ggthemes'; Scales[['ptol']]$sc <- scale_colour_ptol(); Scales[['ptol']]$sf <- scale_fill_ptol(); Scales[['ptol']]$pal <- ptol_pal()(10)
Scales[['solarized']]$src <- 'ggthemes'; Scales[['solarized']]$sc <- scale_colour_solarized(); Scales[['solarized']]$sf <- scale_fill_solarized(); Scales[['solarized']]$pal <- solarized_pal()(8)
Scales[['stata']]$src <- 'ggthemes'; Scales[['stata']]$sc <- scale_colour_stata(); Scales[['stata']]$sf <- scale_fill_stata(); Scales[['stata']]$pal <- stata_pal()(15)
Scales[['tableau']]$src <- 'ggthemes'; Scales[['tableau']]$sc <- scale_colour_tableau(); Scales[['tableau']]$sf <- scale_fill_tableau(); Scales[['tableau']]$pal <- tableau_color_pal('Tableau 10')(10); Scales[['tableau']]$cont <- scale_color_continuous_tableau()
Scales[['tableau2']]$src <- 'ggthemes'; Scales[['tableau2']]$sc <- scale_colour_tableau(); Scales[['tableau2']]$sf <- scale_fill_tableau(); Scales[['tableau2']]$pal <- tableau_color_pal('Tableau 20')(20); Scales[['tableau2']]$cont <- scale_color_continuous_tableau()
Scales[['tableau Color Blind']]$src <- 'ggthemes'; Scales[['tableau Color Blind']]$sc <- scale_colour_tableau(); Scales[['tableau Color Blind']]$sf <- scale_fill_tableau(); Scales[['tableau Color Blind']]$pal <- tableau_color_pal('Color Blind')(10); Scales[['tableau Color Blind']]$cont <- scale_color_continuous_tableau()
Scales[['tableau4']]$src <- 'ggthemes'; Scales[['tableau4']]$sc <- scale_colour_tableau(); Scales[['tableau4']]$sf <- scale_fill_tableau(); Scales[['tableau4']]$pal <- tableau_color_pal('Seattle Grays')(5); Scales[['tableau4']]$cont <- scale_color_continuous_tableau()
# Scales[['tableau']]$src <- 'ggthemes'; Scales[['tableau5']]$sc <- scale_colour_tableau(); Scales[['tableau']]$sf <- scale_fill_tableau(); Scales[['tableau']]$pal <- tableau_color_pal('Traffic')(9); Scales[['tableau']]$cont <- scale_color_continuous_tableau()
# Scales[['tableau']]$src <- 'ggthemes'; Scales[['tableau6']]$sc <- scale_colour_tableau(); Scales[['tableau']]$sf <- scale_fill_tableau(); Scales[['tableau']]$pal <- tableau_color_pal('Miller Stone')(11); Scales[['tableau']]$cont <- scale_color_continuous_tableau()
# Suggestion from Yong Kai (Email 5 Nov 2017)
# library(RColorBrewer)
# df <- RColorBrewer::brewer.pal.info
# Scales <- new.env()
#
# for(i in 1:nrow(df)){
# Scales[[ rownames(df)[i] ]]$scr <- paste('brewer', df[i, 2] )
# }
Scales[['Blues']]$src <- 'brewer seq'; Scales[['Blues']]$pal <- brewer.pal(9, 'Blues')
Scales[['BuGn']]$src <- 'brewer seq'; Scales[['BuGn']]$pal <- brewer.pal(9, 'BuGn')
Scales[['BuPu']]$src <- 'brewer seq'; Scales[['BuPu']]$pal <- brewer.pal(9, 'BuPu')
Scales[['GnBu']]$src <- 'brewer seq'; Scales[['GnBu']]$pal <- brewer.pal(9, 'GnBu')
Scales[['Greens']]$src <- 'brewer seq'; Scales[['Greens']]$pal <- brewer.pal(9, 'Greens')
Scales[['Greys']]$src <- 'brewer seq'; Scales[['Greys']]$pal <- brewer.pal(9, 'Greys')
Scales[['Oranges']]$src <- 'brewer seq'; Scales[['Oranges']]$pal <- brewer.pal(9, 'Oranges')
Scales[['OrRd']]$src <- 'brewer seq'; Scales[['OrRd']]$pal <- brewer.pal(9, 'OrRd')
Scales[['PuBu']]$src <- 'brewer seq'; Scales[['PuBu']]$pal <- brewer.pal(9, 'PuBu')
Scales[['PuBuGn']]$src <- 'brewer seq'; Scales[['PuBuGn']]$pal <- brewer.pal(9, 'PuBuGn')
Scales[['PuRd']]$src <- 'brewer seq'; Scales[['PuRd']]$pal <- brewer.pal(9, 'PuRd')
Scales[['Purples']]$src <- 'brewer seq'; Scales[['Purples']]$pal <- brewer.pal(9, 'Purples')
Scales[['RdPu']]$src <- 'brewer seq'; Scales[['RdPu']]$pal <- brewer.pal(9, 'RdPu')
Scales[['Reds']]$src <- 'brewer seq'; Scales[['Reds']]$pal <- brewer.pal(9, 'Reds')
Scales[['YlGn']]$src <- 'brewer seq'; Scales[['YlGn']]$pal <- brewer.pal(9, 'YlGn')
Scales[['YlGnBu']]$src <- 'brewer seq'; Scales[['YlGnBu']]$pal <- brewer.pal(9, 'YlGnBu')
Scales[['YlOrBr']]$src <- 'brewer seq'; Scales[['YlOrBr']]$pal <- brewer.pal(9, 'YlOrBr')
Scales[['YlOrRd']]$src <- 'brewer seq'; Scales[['YlOrRd']]$pal <- brewer.pal(9, 'YlOrRd')
Scales[['Accent']]$src <- 'brewer qual'; Scales[['Accent']]$pal <- brewer.pal(8, 'Accent')
Scales[['Dark2']]$src <- 'brewer qual'; Scales[['Dark2']]$pal <- brewer.pal(8, 'Dark2')
Scales[['Paired']]$src <- 'brewer qual'; Scales[['Paired']]$pal <- brewer.pal(12, 'Paired')
Scales[['Pastel1']]$src <- 'brewer qual';Scales[['Pastel1']]$pal <- brewer.pal(9, 'Pastel1')
Scales[['Pastel2']]$src <- 'brewer qual';Scales[['Pastel2']]$pal <- brewer.pal(8, 'Pastel2')
Scales[['Set1']]$src <- 'brewer qual'; Scales[['Set1']]$pal <- brewer.pal(9, 'Set1')
Scales[['Set2']]$src <- 'brewer qual'; Scales[['Set2']]$pal <- brewer.pal(8, 'Set2')
Scales[['Set3']]$src <- 'brewer qual'; Scales[['Set3']]$pal <- brewer.pal(12, 'Set3')
Scales[['BrBG']]$src <- 'brewer div'; Scales[['BrBG']]$pal <- brewer.pal(11, 'BrBG')
Scales[['PiYG']]$src <- 'brewer div'; Scales[['PiYG']]$pal <- brewer.pal(11, 'PiYG')
Scales[['PRGn']]$src <- 'brewer div'; Scales[['PRGn']]$pal <- brewer.pal(11, 'PRGn')
Scales[['PuOr']]$src <- 'brewer div'; Scales[['PuOr']]$pal <- brewer.pal(11, 'PuOr')
Scales[['RdBu']]$src <- 'brewer div'; Scales[['RdBu']]$pal <- brewer.pal(11, 'RdBu')
Scales[['RdGy']]$src <- 'brewer div'; Scales[['RdGy']]$pal <- brewer.pal(11, 'RdGy')
Scales[['RdYlBu']]$src <- 'brewer div'; Scales[['RdYlBu']]$pal <- brewer.pal(11, 'RdYlBu')
Scales[['RdYlGn']]$src <- 'brewer div'; Scales[['RdYlGn']]$pal <- brewer.pal(11, 'RdYlGn')
Scales[['Spectral']]$src <- 'brewer div';Scales[['Spectral']]$pal <- brewer.pal(11, 'Spectral')
Scales[['BottleRocket1']]$src <- 'wesanderson'; Scales[['BottleRocket1']]$pal <- wes_palette("BottleRocket1");
Scales[['BottleRocket2']]$src <- 'wesanderson'; Scales[['BottleRocket2']]$pal <- wes_palette("BottleRocket2");
Scales[['Rushmore1']]$src <- 'wesanderson'; Scales[['Rushmore1']]$pal <- wes_palette("Rushmore")
Scales[['Royal1']]$src <- 'wesanderson'; Scales[['Royal1']]$pal <- wes_palette("Royal1")
Scales[['Royal2']]$src <- 'wesanderson'; Scales[['Royal2']]$pal <- wes_palette("Royal2")
Scales[['Zissou1']]$src <- 'wesanderson'; Scales[['Zissou1']]$pal <- wes_palette("Zissou1")
Scales[['Darjeeling1']]$src <- 'wesanderson'; Scales[['Darjeeling1']]$pal <- wes_palette("Darjeeling1")
Scales[['Darjeeling2']]$src <- 'wesanderson'; Scales[['Darjeeling2']]$pal <- wes_palette("Darjeeling2")
Scales[['Chevalier1']]$src <- 'wesanderson'; Scales[['Chevalier1']]$pal <- wes_palette("Chevalier1")
Scales[['FantasticFox1']]$src <- 'wesanderson'; Scales[['FantasticFox1']]$pal <- wes_palette("FantasticFox1")
Scales[['Moonrise1']]$src <- 'wesanderson'; Scales[['Moonrise1']]$pal <- wes_palette("Moonrise1")
Scales[['Moonrise2']]$src <- 'wesanderson'; Scales[['Moonrise2']]$pal <- wes_palette("Moonrise2")
Scales[['Moonrise3']]$src <- 'wesanderson'; Scales[['Moonrise3']]$pal <- wes_palette("Moonrise3")
Scales[['Cavalcanti1']]$src <- 'wesanderson'; Scales[['Cavalcanti1']]$pal <- wes_palette("Cavalcanti1")
Scales[['GrandBudapest1']]$src <- 'wesanderson'; Scales[['GrandBudapest1']]$pal <- wes_palette("GrandBudapest1")
Scales[['GrandBudapest2']]$src <- 'wesanderson'; Scales[['GrandBudapest2']]$pal <- wes_palette("GrandBudapest2")
Scales[['IsleofDogs1']]$src <- 'wesanderson'; Scales[['IsleofDogs1']]$pal <- wes_palette("IsleofDogs1")
Scales[['IsleofDogs2']]$src <- 'wesanderson'; Scales[['IsleofDogs2']]$pal <- wes_palette("IsleofDogs2")
# https://cran.r-project.org/web/packages/ggsci/ggsci.pdf
Scales[['aaas']]$src <- 'ggsci'; Scales[['aaas']]$sc <- scale_colour_aaas(); Scales[['aaas']]$sf <- scale_fill_aaas(); Scales[['aaas']]$pal <- pal_aaas()(10);
Scales[['d3']]$src <- 'ggsci'; Scales[['d3']]$sc <- scale_colour_d3(); Scales[['d3']]$sf <- scale_fill_d3(); Scales[['d3']]$pal <- pal_d3()(10);
Scales[['futurama']]$src <- 'ggsci'; Scales[['futurama']]$sc <- scale_colour_futurama(); Scales[['futurama']]$sf <- scale_fill_futurama(); Scales[['futurama']]$pal <- pal_futurama()(11);
Scales[['igv']]$src <- 'ggsci'; Scales[['igv']]$sc <- scale_colour_igv(); Scales[['igv']]$sf <- scale_fill_igv(); Scales[['igv']]$pal <- pal_igv()(20);
Scales[['jama']]$src <- 'ggsci'; Scales[['jama']]$sc <- scale_colour_jama(); Scales[['jama']]$sf <- scale_fill_jama(); Scales[['jama']]$pal <- pal_jama()(7);
Scales[['jco']]$src <- 'ggsci'; Scales[['jco']]$sc <- scale_colour_jco(); Scales[['jco']]$sf <- scale_fill_jco(); Scales[['jco']]$pal <- pal_jco()(5);
Scales[['lancet']]$src <- 'ggsci'; Scales[['lancet']]$sc <- scale_colour_lancet(); Scales[['lancet']]$sf <- scale_fill_lancet(); Scales[['lancet']]$pal <- pal_lancet()(9);
Scales[['locuszoom']]$src <- 'ggsci'; Scales[['locuszoom']]$sc <- scale_colour_locuszoom(); Scales[['locuszoom']]$sf <- scale_fill_locuszoom(); Scales[['locuszoom']]$pal <- pal_locuszoom()(7);
# Scales[['material']]$src <- 'ggsci'; Scales[['material']]$sc <- scale_colour_material(); Scales[['material']]$sf <- scale_fill_material(); Scales[['material']]$pal <- pal_material()(4);
Scales[['nejm']]$src <- 'ggsci'; Scales[['nejm']]$sc <- scale_colour_nejm(); Scales[['nejm']]$sf <- scale_fill_nejm(); Scales[['nejm']]$pal <- pal_nejm()(8);
Scales[['npg']]$src <- 'ggsci'; Scales[['npg']]$sc <- scale_colour_npg(); Scales[['npg']]$sf <- scale_fill_npg(); Scales[['npg']]$pal <- pal_npg()(10);
Scales[['rickandmorty']]$src <- 'ggsci'; Scales[['rickandmorty']]$sc <- scale_colour_rickandmorty(); Scales[['rickandmorty']]$sf <- scale_fill_rickandmorty();Scales[['rickandmorty']]$pal <- pal_rickandmorty()(12);
Scales[['simpsons']]$src <- 'ggsci'; Scales[['simpsons']]$sc <- scale_colour_simpsons(); Scales[['simpsons']]$sf <- scale_fill_simpsons(); Scales[['simpsons']]$pal <- pal_simpsons()(16);
Scales[['startrek']]$src <- 'ggsci'; Scales[['startrek']]$sc <- scale_colour_startrek(); Scales[['startrek']]$sf <- scale_fill_startrek(); Scales[['startrek']]$pal <- pal_startrek()(7);
Scales[['tron']]$src <- 'ggsci'; Scales[['tron']]$sc <- scale_colour_tron(); Scales[['tron']]$sf <- scale_fill_tron(); Scales[['tron']]$pal <- pal_tron()(7);
Scales[['uchicago']]$src <- 'ggsci'; Scales[['uchicago']]$sc <- scale_colour_uchicago(); Scales[['uchicago']]$sf <- scale_fill_uchicago(); Scales[['uchicago']]$pal <- pal_uchicago()(9);
# Scales[['gsea']]$src <- 'ggsci'; Scales[['gsea']]$cont <- scale_colour_gsea(); Scales[['gsea']]$sf <- scale_fill_gsea()
sn <- c() # Names
sd <- c() # Sources & names (for display)
# Set display order
ord <- c('ggplot', 'ggthemes', 'brewer seq', 'brewer qual', 'brewer div', 'wesanderson', 'ggsci')
# Order by source, then theme name alphabetically (otherwise just sorted by alpha)
for (i in 1:length(ord)) {
for (each in ls(Scales)) {
m = match(Scales[[each]]$src, ord)
if (m == i) {
sn <- append(sn, each)
sd <- append(sd, paste0(Scales[[each]]$src, ' - ', each))
}
}
}
names(sn) <- sd
t <- c('Point', 'Box', 'Bar', 'Contin.')
ui <- miniPage(
gadgetTitleBar("ggPlot Theme Viewer", right = miniTitleBarButton("done", "Done", primary = TRUE)),
tags$style(type='text/css',
'.shiny-output-error { visibility: hidden; }',
'.shiny-output-error:before { visibility: hidden; }'),
fillRow(flex = c(1, 3),
miniContentPanel(
#fillCol(flex = c(3, 3, 1, 1, 1), # Not working
uiOutput("theme"),
uiOutput("scale"),
uiOutput("interpolate"),
uiOutput("show_palette"),
uiOutput("demo"),
conditionalPanel(
condition = "input.demo == true",
uiOutput("plot_type"),
uiOutput("alpha")
)
#)
, padding = 15, scrollable = FALSE),
miniContentPanel(
textOutput("txtOut"),
plotOutput("plot", height = "95%")
, padding = 15)
)
)
server <- function(input, output, session) {
output$theme <- renderUI({
selectInput("theme", "Select background theme:",
choices = tn,
selected = 'grey',
selectize = FALSE,
size = 4
)
})
output$scale <- renderUI({
selectInput("scale", "Select foreground theme:",
choices = sn,
selected = 'default',
selectize = FALSE,
#size = 20
size = 20 + ifelse(input$demo, 0, 8)
)
})
output$interpolate <- renderUI({
checkboxInput("interpolate", "Match colour count to plot", value = TRUE)
})
output$show_palette <- renderUI({
checkboxInput("show_palette", "Show Palette (instead of plot)", value = FALSE)
})
output$demo <- renderUI({
checkboxInput("demo", "Demo chart", value = !passed.valid)
})
output$plot_type <- renderUI({
radioButtons("plot_type", "Select plot type:",
choices = t,
selected = 'Point',
inline = TRUE
)
})
output$alpha <- renderUI({
sliderInput("alpha", "Alpha:", min = 0.05, max = 1, value = 1, step = 0.05)
})
# tvcars is a dataset designed for the demo chart. ToDo: Work out how to include in package.
# Render the plot
output$plot <- renderPlot({
# ggtv_out <- paste0(ggtv_out, ':')
p1 <- ggplot(mtcars) + geom_bar(aes(factor(hp), fill=factor(hp)), alpha = input$alpha)
if (!is.null(input$theme)) {
if (input$demo == TRUE | !passed.valid) {
ttl <- ifelse(!passed.valid, 'Object passed is not a ggplot, using demo chart', 'Demo chart')
pal_size <- 5
if (input$plot_type == 'Bar') {
p1 <- ggplot(mtcars) + geom_bar(aes(factor(hp), fill=factor(hp)), alpha = input$alpha)
pal_size <- 22
# p1 <- ggplot(tvcars, aes(x = Drive_Wheels, y = Kilowatts, fill = Cylinders )) +
# geom_bar(stat="identity", position = "dodge", alpha = input$alpha) +
# scale_x_discrete(name = "Drive Wheels")
scl_type <- 'fill'
}
else if (input$plot_type == 'Box') {
# p1 <- ggplot(tvcars, aes(x = Cylinders, y = Kilowatts, colour = Cylinders)) +
# geom_boxplot(alpha = input$alpha) +
# facet_grid(. ~ paste0(Drive_Wheels, ' wheel drive'))
p1 <- ggplot(mtcars, aes(x = as.factor(cyl), y = hp, colour = as.factor(cyl))) +
geom_boxplot(alpha = input$alpha) +
facet_grid(. ~ paste0(vs, ' vs'))
scl_type <- 'colour'
}
else if (input$plot_type == 'Contin.') {
# p1 <- ggplot(tvcars, aes(x = Weight, y = Economy_city, colour = Kilowatts)) +
# geom_point(size = 5) + scale_y_continuous(limits = c(15, 60))
p1 <- ggplot(mtcars, aes(x = wt, y = mpg, colour = hp)) +
geom_point(size = 5, alpha = input$alpha)
scl_type <- 'continuous'
}
else {
# p1 <- ggplot(tvcars, aes(x = Engine_size, y = Kilowatts, colour = Cylinders)) +
# geom_point(position = "jitter", alpha = input$alpha) +
# geom_smooth(aes(colour = Cylinders), method = lm, se = FALSE) +
# scale_x_continuous(name = "Engine Size (litre)")
p1 <- ggplot(mtcars, aes(x = disp, y = hp, colour = as.factor(cyl))) +
geom_point(position = "jitter", alpha = input$alpha) +
geom_smooth(aes(colour = as.factor(cyl)), method = lm, se = FALSE) +
scale_x_continuous(name = "Displacement")
scl_type <- 'colour'
}
p1 <- p1 + ggtitle(ttl)
}
else {
p1 <- ggp
pal_size <- palette.size
scl_type <- scale.type
}
p1 <- p1 + Themes[[input$theme]]$th +
theme(plot.title = element_text(size = 14, face = "bold"), legend.key.size = unit(1.3, "cm"))
# ggtv_out <- paste0(ggtv_out, " + ", Themes[[input$theme]]$th)
if (pal_size <= length(Scales[[input$scale]]$pal)) {
palette_use <- Scales[[input$scale]]$pal
}
else {
if (input$interpolate) {palette_use <- colorRampPalette(Scales[[input$scale]]$pal)(pal_size)}
else {palette_use <- palette_fill_na(Scales[[input$scale]]$pal, pal_size)}
}
if (length(input$scale) > 0) {
if (scl_type == 'fill') {
p1 <- p1 + scale_fill_manual(values = palette_use)
test_fn('sfm')
}
else if (scl_type == 'colour') {
if (!is.null(Scales[[input$scale]]$pal) && is.null(Scales[[input$scale]]$sc)) {
p1 <- p1 + scale_color_manual(values = palette_use)
test_fn('scm')
}
else {
p1 <- p1 + Scales[[input$scale]]$sc
}
}
else if (scl_type == 'continuous') {
if (!is.null(Scales[[input$scale]]$cont)) {
p1 <- p1 + Scales[[input$scale]]$cont
}
else {
p1 <- p1 + scale_colour_gradientn(colours = Scales[[input$scale]]$pal[1:5])
}
}
}
if (!input$show_palette) {
# ggtv_out <- paste0(ggtv_out, " + ")
test_fn('P')
p1 # Must be the last thing done (rendered). Anything after will stop plot rendering
}
else {
test_fn('a')
if (!input$interpolate) {
show_col(colorRampPalette(Scales[[input$scale]]$pal)(length(Scales[[input$scale]]$pal)))
}
else {
show_col(colorRampPalette(Scales[[input$scale]]$pal)(pal_size))
}
}
}
})
output$txtOut <- renderText({
paste(paste0(Themes[[input$theme]]$src, '.', input$theme),
paste0(Scales[[input$scale]]$src, '.', input$scale),
input$alpha, ggtv_out, sep = ' | ')
})
# textOutput("txtOut"),
# Handle the Done button being pressed.
observeEvent(input$done, {
returnValue <- paste0(ggtv_out, ': ', Themes[[input$theme]]$src, '.', input$theme, '/', Scales[[input$scale]]$src, '.', input$scale, '\n')
rstudioapi::insertText(returnValue)
stopApp(returnValue)
})
observeEvent(input$cancel, {
stopApp()
})
}
viewer <- dialogViewer("Theme Viewer (v0.9.0)", width = 1200, height = 1000)
runGadget(ui, server, viewer = viewer)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.