Nothing
R/ggThemeAssist.R
In ggThemeAssist: Add-in to Customize 'ggplot2' Themes
Defines functions
ggThemeAssist
ggThemeAssistGadget
ggThemeAssistAddin
Documented in
ggThemeAssist
ggThemeAssistGadget
#' ggThemeAssist
#'
#' \code{ggThemeAssist} is a RStudio-Addin that delivers a graphical interface for editing ggplot2 theme elements.
#'
#' @details To run the addin, either highlight a ggplot2-object in your current script and select \code{ggThemeAssist} from the Addins-menu within RStudio, or run \code{ggThemeAssistGadget(plot)} with a ggplot2 object as the parameter. After editing themes and terminating the addin, a character string containing the desired changes is inserted in your current script.
#' @param plot A ggplot2 plot object to manipulate its theme.
#' @examples
#' \dontrun{
#' # example for ggThemeAssist command line usage.
#' library(ggplot2)
#' gg <- ggplot(mtcars, aes(x = hp, y = mpg, colour = as.factor(cyl))) + geom_point()
#' ggThemeAssistGadget(gg)
#' }
#' @return \code{ggThemeAssist} returns a character vector.
#' @import miniUI
#' @import shiny
#' @import ggplot2
#' @import formatR
#' @import rstudioapi
#' @importFrom grDevices col2rgb
#' @name ggThemeAssist
NULL
ggThemeAssist <- function(text){
SubtitlesSupport <- any(names(formals(ggtitle)) == 'subtitle')
if (grepl('^\\s*[[:alpha:]]+[[:alnum:]\\.]*\\s*$', paste0(text, collapse = ''))) {
text <- gsub('\\s+', '', text)
if (any(ls(envir = .GlobalEnv) == text)) {
gg_original <- get(text, envir = .GlobalEnv)
allowOneline <- TRUE
} else {
stop(paste0('I\'m sorry, I couldn\'t find object', text, '.'))
}
} else {
gg_original <- try(eval(parse(text = text)), silent = TRUE)
allowOneline <- FALSE
if(class(gg_original)[1] == 'try-error') {
stop(paste0('I\'m sorry, I was unable to parse the string you gave to me.\n', gg_original))
}
}
if (!is.ggplot(gg_original)) {
stop('No ggplot2 object has been selected. Fool someone else!')
}
# add rgb colours to the available colours
colours.available <- c(colours.available, getRGBHexColours(gg_original))
default <- updateDefaults(gg_original, default, linetypes = linetypes)
ui <- miniPage(
tags$script(jscodeWidth),
tags$script(jscodeHeight),
tags$style(type = "text/css", ".selectize-dropdown{ width: 200px !important; }"),
gadgetTitleBar("ggplot Theme Assistant"),
miniTabstripPanel(selected = 'Panel & Background',
miniTabPanel("Settings", icon = icon('sliders'),
plotOutput("ThePlot5", width = '100%', height = '45%'),
miniContentPanel(scrollable = TRUE,
fillRow(height = heading.height, width = '100%',
headingOutput('Plot dimensions')
),
fillRow(height = line.height, width = '100%',
numericInput('plot.width', label = 'Width', min = 0, max = 10, step = 1, value = 10),
numericInput('plot.height', label = 'Height', min = 0, max = 10, step = 1, value = 5)
),
fillRow(height = heading.height, width = '100%',
headingOutput("General options")),
fillRow(height = heading.height, width = '100%',
tags$div(
title = 'If enabled, formatR will be used. Set options(ggThemeAssist.formatR = FALSE) to disable it permanently.',
checkboxInput('formatR', 'Use FormatR', value = getOption("ggThemeAssist.formatR", default = TRUE))
),
if (allowOneline) {
tags$div(
title = 'If multiline support is enabled, a theme function is returned for each element. To set this option permanently set options(ggThemeAssist.multiline = TRUE).',
checkboxInput('multiline', 'Multiline results', value = getOption("ggThemeAssist.multiline", default = FALSE))
)
}
)
)
),
miniTabPanel("Panel & Background", icon = icon('sliders'),
plotOutput("ThePlot2", width = '100%', height = '45%'),
miniContentPanel(scrollable = TRUE,
fillRow(height = heading.height, width = '100%',
headingOutput('Plot Background'),
headingOutput('Panel Background'),
headingOutput('Grid Major'),
headingOutput('Grid Minor')
),
fillRow(height = line.height, width = '100%',
selectizeInput('plot.background.fill', label = 'Fill', choices = NULL, width = input.width),
selectizeInput('panel.background.fill', label = 'Fill', choices = NULL, width = input.width),
"",
""
),
fillRow(height = line.height, width = '100%',
selectInput('plot.background.linetype', label = 'Type', choices = linetypes, selected = default$plot.background$linetype, width = input.width),
selectInput('panel.background.linetype', label = 'Type', choices = linetypes, selected = default$panel.background$linetype, width = input.width),
selectInput('panel.grid.major.type', label = 'Type', choices = linetypes, selected = default$panel.grid.major$linetype, width = input.width),
selectInput('panel.grid.minor.type', label = 'Type', choices = linetypes, selected = default$panel.grid.minor$linetype, width = input.width)
),
fillRow(height = line.height, width = '100%',
numericInput('plot.background.size', label = 'Size', step = 0.1, value = default$plot.background$size, width = input.width),
numericInput('panel.background.size', label = 'Size', step = 0.1, value = default$panel.background$size, width = input.width),
numericInput('panel.grid.major.size', label = 'Size', step = 0.1, value = default$panel.grid.major$size, min = 0, width = input.width),
numericInput('panel.grid.minor.size', label = 'Size', step = 0.1, value = default$panel.grid.minor$size, min = 0, width = input.width)
),
fillRow(height = line.height, width = '100%',
selectizeInput('plot.background.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('panel.background.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('panel.grid.major.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('panel.grid.minor.colour', label = 'Colour', choices = NULL, width = input.width)
)
)
),
miniTabPanel("Axis", icon = icon('sliders'),
plotOutput("ThePlot", width = '100%', height = '45%'),
miniContentPanel(scrollable = TRUE,
fillRow(height = heading.height, width = '100%',
headingOutput('Axis text'),
headingOutput('Axis text.x'),
headingOutput('Axis text.y'),
headingOutput('Axis line'),
headingOutput('Axis ticks')
),
fillRow(height = line.height, width = '100%',
selectInput('axis.text.family', label = 'Family', choices = text.families, selected = default$axis.text$family, width = input.width),
selectInput('axis.text.x.family', label = 'Family', choices = c('None' = 'NULL', text.families), selected = NULL, width = input.width),
selectInput('axis.text.y.family', label = 'Family', choices = c('None' = 'NULL', text.families), selected = NULL, width = input.width),
selectInput('axis.line.type', label = 'Type', choices = linetypes, selected = default$axis.line$linetype, width = input.width),
selectInput('axis.ticks.type', label = 'Type', choices = linetypes, selected = default$axis.ticks$linetype, width = input.width)
),
fillRow(height = line.height, width = '100%',
selectInput('axis.text.face', label = 'Face', choices = text.faces, width = input.width, selected = default$axis.text$face),
selectInput('axis.text.x.face', label = 'Face', choices = c('None' = 'NULL', text.faces), width = input.width, selected = NULL),
selectInput('axis.text.y.face', label = 'Face', choices = c('None' = 'NULL', text.faces), width = input.width, selected = NULL),
numericInput('axis.line.size', label = 'Size', step = 0.1, value = default$axis.line$size, min = 0,width = input.width),
numericInput('axis.ticks.size', label = 'Size', step = 0.1, value = default$axis.ticks$size, min = 0,width = input.width)
),
fillRow(height = line.height, width = '100%',
numericInput('axis.text.size', label = 'Size', min = 1, max = 30, value = default$axis.text$size, step = 1, width = input.width),
numericInput('axis.text.x.size', label = 'Size', min = 1, max = 30, value = NULL, step = 1, width = input.width),
numericInput('axis.text.y.size', label = 'Size', min = 1, max = 30, value = NULL, step = 1, width = input.width),
selectizeInput('axis.line.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('axis.ticks.colour', label = 'Colour', choices = NULL, width = input.width)
),
fillRow(height = line.height, width = '100%',
selectizeInput('axis.text.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('axis.text.x.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('axis.text.y.colour', label = 'Colour', choices = NULL, width = input.width),
"",
""
),
fillRow(height = line.height, width = '100%',
numericInput('axis.text.hjust', 'Hjust', value = default$axis.text$hjust, step = 0.25, width = input.width),
numericInput('axis.text.hjust.x', 'Hjust', value = NULL, step = 0.25, width = input.width),
numericInput('axis.text.hjust.y', 'Hjust', value = NULL, step = 0.25, width = input.width),
"",
""
),
fillRow(height = line.height, width = '100%',
numericInput('axis.text.vjust', 'Vjust', value = default$axis.text$vjust, step = 0.25, width = input.width),
numericInput('axis.text.x.vjust', 'Vjust', value = NULL, step = 0.25, width = input.width),
numericInput('axis.text.y.vjust', 'Vjust', value = NULL, step = 0.25, width = input.width),
"",
""
),
fillRow(height = line.height, width = '100%',
numericInput('axis.text.angle', label = 'Angle', min = -180, max = 180, value = default$axis.text$angle, step = 5, width = input.width),
numericInput('axis.text.x.angle', label = 'Angle', min = -180, max = 180, value = NULL, step = 5, width = input.width),
numericInput('axis.text.y.angle', label = 'Angle', min = -180, max = 180, value = NULL, step = 5, width = input.width),
"",
""
)
)),
miniTabPanel("Title and label", icon = icon('sliders'),
plotOutput("ThePlot4", width = '100%', height = '45%'),
miniContentPanel(scrollable = TRUE,
fillRow(height = heading.height, width = '100%',
headingOutput('Labels'),
headingOutput('Plot Title'),
headingOutput('Axis Labels')
),
fillRow(height = line.height, width = '100%',
textInput('plot.title', label = 'Title', value = preserveNewlines(gg_original$labels$title), width = input.width),
selectInput('plot.title.family', label = 'Family', choices = text.families, selected = default$plot.title$family, width = input.width),
selectInput('axis.title.family', label = 'Family', choices = text.families, selected = default$axis.title$family, width = input.width)
),
fillRow(height = line.height, width = '100%',
textInput('axis.title.x', label = 'x-Axis label', value = preserveNewlines(gg_original$labels$x), width = input.width),
selectInput('plot.title.face', label = 'Face', choices = text.faces, width = input.width, selected = default$plot.title$face),
selectInput('axis.title.face', label = 'Face', choices = text.faces, width = input.width, selected = default$axis.title$face)
),
fillRow(height = line.height, width = '100%',
textInput('axis.title.y', label = 'y-Axis label', value = preserveNewlines(gg_original$labels$y), width = input.width),
numericInput('plot.title.size', label = 'Size', min = 1, max = 30, value = default$plot.title$size, step = 1, width = input.width),
numericInput('axis.title.size', label = 'Size', min = 1, max = 30, value = default$axis.title$size, step = 1, width = input.width)
),
fillRow(height = line.height, width = '100%',
textInput('legend.colour.title', label = 'Colour', value = preserveNewlines(gg_original$labels$colour), width = input.width),
selectizeInput('plot.title.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('axis.title.colour', label = 'Colour', choices = NULL, width = input.width)
),
fillRow(height = line.height, width = '100%',
textInput('legend.fill.title', label = 'Fill label', value = preserveNewlines(gg_original$labels$fill), width = input.width),
numericInput('plot.title.hjust', 'Hjust', value = default$plot.title$hjust, step = 0.25, width = input.width),
numericInput('axis.title.hjust', 'Hjust', value = default$axis.title$hjust, step = 0.25, width = input.width)
),
fillRow(height = line.height, width = '100%',
textInput('legend.size.title', label = 'Size label', value = preserveNewlines(gg_original$labels$size), width = input.width),
numericInput('plot.title.vjust', 'Vjust', value = default$plot.title$vjust, step = 0.25, width = input.width),
numericInput('axis.title.vjust', 'Vjust', value = default$axis.title$vjust, step = 0.25, width = input.width)
),
fillRow(height = line.height, width = '100%',
textInput('legend.alpha.title', label = 'Alpha label', value = preserveNewlines(gg_original$labels$alpha), width = input.width),
numericInput('plot.title.angle', label = 'Angle', min = -180, max = 180, value = default$plot.title$angle, step = 5, width = input.width),
numericInput('axis.title.angle', label = 'Angle', min = -180, max = 180, value = default$axis.title$angle, step = 5, width = input.width)
),
fillRow(height = line.height, width = '33%',
textInput('legend.linetype.title', label = 'Linetype label', value = preserveNewlines(gg_original$labels$linetype), width = input.width)
),
fillRow(height = line.height, width = '33%',
textInput('legend.shape.title', label = 'Shape label', value = preserveNewlines(gg_original$labels$shape), width = input.width)
)
)
),
miniTabPanel("Legend", icon = icon('sliders'),
plotOutput("ThePlot3", width = '100%', height = '45%', click = 'legend.click'),
miniContentPanel(scrollable = TRUE,
fillRow(height = heading.height, width = '100%',
headingOutput('Legend position'),
headingOutput('Legend Title'),
headingOutput('Legend Text'),
headingOutput("Legend Background"),
headingOutput("Legend Keys")
),
fillRow(height = line.height, width = '100%',
selectInput('legend.position', label = 'Position', choices = legend.positions, selected = default$legend.position, width = input.width),
selectInput('legend.title.family', label = 'Family', choices = text.families, selected = default$legend.title$family, width = input.width),
selectInput('legend.text.family', label = 'Family', choices = text.families, selected = default$legend.text$family, width = input.width),
selectizeInput('legend.background.fill', label = 'Fill', choices = NULL, width = input.width),
selectizeInput('legend.key.fill', label = 'Fill', choices = NULL, width = input.width)
),
fillRow(height = line.height, width = '100%',
selectInput('legend.direction', label = 'Direction', choices = legend.directions, selected = default$legend.direction, width = input.width),
selectInput('legend.title.face', label = 'Face', choices = text.faces, selected = default$legend.title$face, width = input.width),
selectInput('legend.text.face', label = 'Face', choices = text.faces, selected = default$legend.text$face, width = input.width),
selectInput('legend.background.linetype', label = 'Type', choices = linetypes, selected = default$legend.background$linetype, width = input.width),
selectInput('legend.key.linetype', label = 'Type', choices = linetypes, selected = default$legend.key$linetype, width = input.width)
),
fillRow(height = line.height, width = '100%',
conditionalPanel(
condition = "input['legend.position'] == 'XY'",
numericInput('legend.position.x', label = 'X Coord', min = 0, max = 1, value = default$legend.position.x, step = 0.01, width = input.width)
),
numericInput('legend.title.size', label = 'Size', min = 1, max = 30, value = default$legend.title$size, step = 1, width = input.width),
numericInput('legend.text.size', label = 'Size', min = 1, max = 30, value = default$legend.text$size, step = 1, width = input.width),
numericInput('legend.background.size', label = 'Size', step = 0.1, value = default$legend.background$size, width = input.width),
numericInput('legend.key.size', label = 'Size', step = 0.1, value = default$legend.key$size, width = input.width)
),
fillRow(height = line.height, width = '100%',
conditionalPanel(
condition = "input['legend.position'] == 'XY'",
numericInput('legend.position.y', label = 'Y Coord', min = 0, max = 1, value = default$legend.position.y, step = 0.01, width = input.width)
),
selectizeInput('legend.title.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('legend.text.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('legend.background.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('legend.key.colour', label = 'Colour', choices = NULL, width = input.width)
)
)
),
if (SubtitlesSupport) {
miniTabPanel("Subtitle and Caption", icon = icon('sliders'),
plotOutput("ThePlot6", width = '100%', height = '45%'),
miniContentPanel(scrollable = TRUE,
fillRow(width = '100%', height = heading.height,
headingOutput('Subtitle')
),
fillRow(width = '100%', height = line.height,
tags$div(style="display:table; width:100%; margin:auto",
tags$textarea(id="plot.subtitle.text", label="Subtitle",
rows=3, cols=80, gg_original$labels$subtitle,
style="width:inherit; font-size:9pt; padding:5px"
)
)
),
fillRow(width = '100%', height = line.height,
selectInput('plot.subtitle.family', label = 'Family', choices = text.families, selected = default$plot.subtitle$family, width = input.width2),
selectInput('plot.subtitle.face', label = 'Face', choices = text.faces, width = input.width2, selected = default$plot.subtitle$face),
numericInput('plot.subtitle.size', label = 'Size', min = 1, max = 30, value = default$plot.subtitle$size, step = 1, width = input.width2),
selectizeInput('plot.subtitle.colour', label = 'Colour', choices = colours.available, selected = default$plot.subtitle$colour, width = input.width2, options = list(create = TRUE)),
numericInput('plot.subtitle.hjust', 'Hjust', value = default$plot.subtitle$hjust, step = 0.25, width = input.width2)
),
fillRow(width = '100%', height = heading.height,
headingOutput('Caption')
),
fillRow(width = '100%', height = line.height,
tags$div(style="display:table; width:100%; margin:auto",
tags$textarea(id="plot.caption.text", label="Subtitle",
rows=3, cols=80, gg_original$labels$caption,
style="width:inherit; font-size:9pt; padding:5px"
)
)
),
fillRow(width = '100%', height = line.height,
selectInput('plot.caption.family', label = 'Family', choices = text.families, selected = default$plot.caption$family, width = input.width2),
selectInput('plot.caption.face', label = 'Face', choices = text.faces, width = input.width2, selected = default$plot.caption$face),
numericInput('plot.caption.size', label = 'Size', min = 1, max = 30, value = default$plot.caption$size, step = 1, width = input.width2),
selectizeInput('plot.caption.colour', label = 'Colour', choices = colours.available, selected = default$plot.caption$colour, width = input.width2, options = list(create = TRUE)),
numericInput('plot.caption.hjust', 'Hjust', value = default$plot.caption$hjust, step = 0.25, width = input.width2)
)
)
)
}
))
server <- function(input, output, session) {
colour.choices <- colours2RGB(colours.available)
updateSelectizeInput(session = session, inputId = 'plot.background.fill', choices = colour.choices, selected = NA2text(default$plot.background$fill), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'panel.background.fill', choices = colour.choices, selected = NA2text(default$panel.background$fill), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'plot.background.colour', choices = colour.choices, selected = NA2text(default$plot.background$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'panel.background.colour', choices = colour.choices, selected = NA2text(default$panel.background$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'panel.grid.major.colour', choices = colour.choices, selected = NA2text(default$panel.grid.major$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'panel.grid.minor.colour', choices = colour.choices, selected = NA2text(default$panel.grid.minor$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'axis.line.colour', choices = colour.choices, selected = NA2text(default$axis.line$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'axis.ticks.colour', choices = colour.choices, selected = NA2text(default$axis.ticks$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'axis.text.colour', choices = colour.choices, selected = NA2text(default$axis.text$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'axis.text.x.colour', choices = colours2RGB(colours.available, Inherit = TRUE), selected = 'NULL', server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'axis.text.y.colour', choices = colours2RGB(colours.available, Inherit = TRUE), selected = 'NULL', server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'plot.title.colour', choices = colour.choices, selected = NA2text(default$plot.title$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'axis.title.colour', choices = colour.choices, selected = NA2text(default$axis.title$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.background.fill', choices = colour.choices, selected = NA2text(default$legend.background$fill), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.key.fill', choices = colour.choices, selected = NA2text(default$legend.key$fill), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.title.colour', choices = colour.choices, selected = NA2text(default$legend.title$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.text.colour', choices = colour.choices, selected = NA2text(default$legend.text$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.background.colour', choices = colour.choices, selected = NA2text(default$legend.background$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.key.colour', choices = colour.choices, selected = NA2text(default$legend.key$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'panel.background.fill', choices = colour.choices, selected = NA2text(default$panel.background$fill), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.key.colour', choices = colour.choices, selected = NA2text(default$legend.key$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
if (SubtitlesSupport) {
updateSelectizeInput(session = session, inputId = 'plot.subtitle.colour', choices = colour.choices, selected = NA2text(default$plot.subtitle$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'plot.caption.colour', choices = colour.choices, selected = NA2text(default$plot.caption$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
}
gg_reactive <- reactive({
validate(
need(is.validColour(input$plot.background.fill), ''),
need(is.validColour(input$panel.background.fill), ''),
need(is.validColour(input$plot.background.colour), ''),
need(is.validColour(input$panel.background.colour), ''),
need(is.validColour(input$panel.grid.major.colour), ''),
need(is.validColour(input$panel.grid.minor.colour), ''),
need(is.validColour(input$axis.line.colour), ''),
need(is.validColour(input$axis.ticks.colour), ''),
need(is.validColour(input$axis.text.colour), ''),
need(is.validColour(input$axis.text.x.colour), ''),
need(is.validColour(input$axis.text.y.colour), ''),
need(is.validColour(input$plot.title.colour), ''),
need(is.validColour(input$axis.title.colour), ''),
need(is.validColour(input$legend.background.fill), ''),
need(is.validColour(input$legend.key.fill), ''),
need(is.validColour(input$legend.title.colour), ''),
need(is.validColour(input$legend.text.colour), ''),
need(is.validColour(input$legend.background.colour), ''),
need(is.validColour(input$legend.key.colour), '')
)
if (SubtitlesSupport) {
validate(
need(is.validColour(input$plot.subtitle.colour), ''),
need(is.validColour(input$plot.caption.colour), '')
)
}
gg <- gg_original +
labs(
title = checkInputText(input$plot.title),
x = checkInputText(input$axis.title.x),
y = checkInputText(input$axis.title.y),
fill = checkInputText(input$legend.fill.title),
linetype = checkInputText(input$legend.linetype.title),
alpha = checkInputText(input$legend.alpha.title),
size = checkInputText(input$legend.size.title),
shape = checkInputText(input$legend.shape.title),
colour = checkInputText(input$legend.colour.title)
) +
theme(
axis.text = element_text(
size = input$axis.text.size,
colour = input$axis.text.colour,
face = input$axis.text.face,
family = input$axis.text.family,
angle = input$axis.text.angle,
hjust = input$axis.text.hjust,
vjust = input$axis.text.vjust,
lineheight = input$axis.text.lineheight),
axis.text.x = element_text(
size = setNull(input$axis.text.x.size),
colour = setNull(input$axis.text.x.colour),
family = setNull(input$axis.text.x.family),
angle = setNull(input$axis.text.x.angle),
hjust = setNull(input$axis.text.x.hjust),
vjust = setNull(input$axis.text.x.vjust)
),
axis.text.y = element_text(
size = setNull(input$axis.text.y.size),
colour = setNull(input$axis.text.y.colour),
family = setNull(input$axis.text.y.family),
angle = setNull(input$axis.text.y.angle),
hjust = setNull(input$axis.text.y.hjust),
vjust = setNull(input$axis.text.y.vjust)
),
axis.line = element_line(
linetype = input$axis.line.type,
colour = input$axis.line.colour,
size = input$axis.line.size),
axis.ticks = element_line(
linetype = input$axis.ticks.type,
colour = input$axis.ticks.colour,
size = input$axis.ticks.size),
axis.title = element_text(
size = input$axis.title.size,
colour = input$axis.title.colour,
face = input$axis.title.face,
family = input$axis.title.family,
angle = input$axis.title.angle,
hjust = input$axis.title.hjust,
vjust = input$axis.title.vjust,
lineheight = input$axis.title.lineheight),
plot.title = element_text(
size = input$plot.title.size,
colour = input$plot.title.colour,
face = input$plot.title.face,
family = input$plot.title.family,
angle = input$plot.title.angle,
hjust = input$plot.title.hjust,
vjust = input$plot.title.vjust,
lineheight = input$plot.title.lineheight),
plot.background = element_rect(
fill = input$plot.background.fill,
colour = input$plot.background.colour,
size = input$plot.background.size,
linetype = input$plot.background.linetype
),
panel.background = element_rect(
fill = input$panel.background.fill,
colour = input$panel.background.colour,
size = input$panel.background.size,
linetype = input$panel.background.linetype
),
panel.grid.major = element_line(
linetype = input$panel.grid.major.type,
colour = input$panel.grid.major.colour,
size = input$panel.grid.major.size),
panel.grid.minor = element_line(
linetype = input$panel.grid.minor.type,
colour = input$panel.grid.minor.colour,
size = input$panel.grid.minor.size),
legend.text = element_text(
size = input$legend.text.size,
face = input$legend.text.face,
colour = input$legend.text.colour,
family = input$legend.text.family
),
legend.title = element_text(
size = input$legend.title.size,
face = input$legend.title.face,
colour = input$legend.title.colour,
family = input$legend.title.family
),
legend.background = element_rect(
fill = input$legend.background.fill,
colour = input$legend.background.colour,
size = input$legend.background.size,
linetype = input$legend.background.linetype
),
legend.key = element_rect(
fill = input$legend.key.fill,
colour = input$legend.key.colour,
size = input$legend.key.size,
linetype = input$legend.key.linetype
),
legend.position = (if (input$legend.position == 'XY') {
c(input$legend.position.x, input$legend.position.y)
} else {
input$legend.position
}),
legend.direction = input$legend.direction
)
if (SubtitlesSupport) {
gg <- gg + labs(
subtitle = if (input$plot.subtitle.text == '') {NULL} else {input$plot.subtitle.text},
caption = if (input$plot.caption.text == '') {NULL} else {input$plot.caption.text}
) +
theme(
plot.subtitle = element_text(
size = input$plot.subtitle.size,
colour = input$plot.subtitle.colour,
face = input$plot.subtitle.face,
family = input$plot.subtitle.family,
#angle = input$plot.subtitle.angle,
hjust = input$plot.subtitle.hjust,
#vjust = input$plot.subtitle.vjust,
lineheight = input$plot.subtitle.lineheight),
plot.caption = element_text(
size = input$plot.caption.size,
colour = input$plot.caption.colour,
face = input$plot.caption.face,
family = input$plot.caption.family,
#angle = input$plot.caption.angle,
hjust = input$plot.caption.hjust,
#vjust = input$plot.caption.vjust,
lineheight = input$plot.caption.lineheight)
)
}
return(gg)
})
observeEvent(input$legend.click, {
x.click <- input$legend.click$x / (input$legend.click$domain$right - input$legend.click$domain$left)
y.click <- input$legend.click$y / (input$legend.click$domain$top - input$legend.click$domain$bottom)
if (hasLegend(gg_original)) {
updateSelectInput(session, 'legend.position', selected = 'XY')
updateSelectInput(session, 'legend.position.x', selected = round(x.click, 4))
updateSelectInput(session, 'legend.position.y', selected = round(y.click, 4))
}
})
ThePlot <- renderPlot(width = function() {
validate(
need(is.numeric(input$plot.width), ''),
need(is.numeric(input$plot.height), ''),
need(!is.null(input$ViewerWidth), ''),
need(is.validColour(input$legend.key.colour), '')
)
min(input$plot.width / input$plot.height * input$ViewerWidth * 45 / 100,
input$ViewerWidth
)
},
{
gg_reactive()
})
output$ThePlot <- ThePlot
output$ThePlot2 <- ThePlot
output$ThePlot3 <- ThePlot
output$ThePlot4 <- ThePlot
output$ThePlot5 <- ThePlot
output$ThePlot6 <- ThePlot
observeEvent(input$done, {
themeResult <- sapply(AvailableElements, compileResults, new = gg_reactive(), original = gg_original, std = default, USE.NAMES = FALSE)
themeResult <- themeResult[!is.na(themeResult)]
labelResult <- construcThemeString('labs', original = gg_original, new = gg_reactive(), std = default, category = 'labels')
if((!is.null(themeResult) & length(themeResult) > 0) | !is.null(labelResult)) {
if (!is.null(input$multiline)) {
if (input$multiline) {
oneline <- FALSE
} else {
oneline <- TRUE
}
} else {
oneline <- TRUE
}
result <- formatResult(text = text, themestring = themeResult, labelstring = labelResult, oneline = oneline, formatR = input$formatR)
rstudioapi::insertText(result)
}
invisible(stopApp())
})
observeEvent(input$cancel, {
invisible(stopApp())
})
}
viewer <- dialogViewer(dialogName = 'ggThemeAssist', width = 990, height = 900)
runGadget(ui, server, stopOnCancel = FALSE, viewer = viewer)
}
#' @export
#' @rdname ggThemeAssist
ggThemeAssistGadget <- function(plot) {
if (missing(plot)) {
stop('You must provide a ggplot2 plot object.', call. = FALSE)
}
plot <- deparse(substitute(plot))
if (grepl('^\\s*[[:alpha:]]+[[:alnum:]\\.]*\\s*$', paste0(plot, collapse = ''))) {
ggThemeAssist(plot)
} else {
stop('You must provide a ggplot2 plot object.', call. = FALSE)
}
}
ggThemeAssistAddin <- function() {
# Get the document context.
context <- rstudioapi::getActiveDocumentContext()
# Set the default data to use based on the selection.
text <- context$selection[[1]]$text
if (nchar(text) == 0) {
stop('Please highlight a ggplot2 plot before selecting this addin.')
}
ggThemeAssist(text)
}
Try the ggThemeAssist package in your browser
Any scripts or data that you put into this service are public.
ggThemeAssist documentation built on May 2, 2019, 9:39 a.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 ggThemeAssist ggThemeAssistGadget ggThemeAssistAddin
Documented in ggThemeAssist ggThemeAssistGadget
#' ggThemeAssist
#'
#' \code{ggThemeAssist} is a RStudio-Addin that delivers a graphical interface for editing ggplot2 theme elements.
#'
#' @details To run the addin, either highlight a ggplot2-object in your current script and select \code{ggThemeAssist} from the Addins-menu within RStudio, or run \code{ggThemeAssistGadget(plot)} with a ggplot2 object as the parameter. After editing themes and terminating the addin, a character string containing the desired changes is inserted in your current script.
#' @param plot A ggplot2 plot object to manipulate its theme.
#' @examples
#' \dontrun{
#' # example for ggThemeAssist command line usage.
#' library(ggplot2)
#' gg <- ggplot(mtcars, aes(x = hp, y = mpg, colour = as.factor(cyl))) + geom_point()
#' ggThemeAssistGadget(gg)
#' }
#' @return \code{ggThemeAssist} returns a character vector.
#' @import miniUI
#' @import shiny
#' @import ggplot2
#' @import formatR
#' @import rstudioapi
#' @importFrom grDevices col2rgb
#' @name ggThemeAssist
NULL
ggThemeAssist <- function(text){
SubtitlesSupport <- any(names(formals(ggtitle)) == 'subtitle')
if (grepl('^\\s*[[:alpha:]]+[[:alnum:]\\.]*\\s*$', paste0(text, collapse = ''))) {
text <- gsub('\\s+', '', text)
if (any(ls(envir = .GlobalEnv) == text)) {
gg_original <- get(text, envir = .GlobalEnv)
allowOneline <- TRUE
} else {
stop(paste0('I\'m sorry, I couldn\'t find object', text, '.'))
}
} else {
gg_original <- try(eval(parse(text = text)), silent = TRUE)
allowOneline <- FALSE
if(class(gg_original)[1] == 'try-error') {
stop(paste0('I\'m sorry, I was unable to parse the string you gave to me.\n', gg_original))
}
}
if (!is.ggplot(gg_original)) {
stop('No ggplot2 object has been selected. Fool someone else!')
}
# add rgb colours to the available colours
colours.available <- c(colours.available, getRGBHexColours(gg_original))
default <- updateDefaults(gg_original, default, linetypes = linetypes)
ui <- miniPage(
tags$script(jscodeWidth),
tags$script(jscodeHeight),
tags$style(type = "text/css", ".selectize-dropdown{ width: 200px !important; }"),
gadgetTitleBar("ggplot Theme Assistant"),
miniTabstripPanel(selected = 'Panel & Background',
miniTabPanel("Settings", icon = icon('sliders'),
plotOutput("ThePlot5", width = '100%', height = '45%'),
miniContentPanel(scrollable = TRUE,
fillRow(height = heading.height, width = '100%',
headingOutput('Plot dimensions')
),
fillRow(height = line.height, width = '100%',
numericInput('plot.width', label = 'Width', min = 0, max = 10, step = 1, value = 10),
numericInput('plot.height', label = 'Height', min = 0, max = 10, step = 1, value = 5)
),
fillRow(height = heading.height, width = '100%',
headingOutput("General options")),
fillRow(height = heading.height, width = '100%',
tags$div(
title = 'If enabled, formatR will be used. Set options(ggThemeAssist.formatR = FALSE) to disable it permanently.',
checkboxInput('formatR', 'Use FormatR', value = getOption("ggThemeAssist.formatR", default = TRUE))
),
if (allowOneline) {
tags$div(
title = 'If multiline support is enabled, a theme function is returned for each element. To set this option permanently set options(ggThemeAssist.multiline = TRUE).',
checkboxInput('multiline', 'Multiline results', value = getOption("ggThemeAssist.multiline", default = FALSE))
)
}
)
)
),
miniTabPanel("Panel & Background", icon = icon('sliders'),
plotOutput("ThePlot2", width = '100%', height = '45%'),
miniContentPanel(scrollable = TRUE,
fillRow(height = heading.height, width = '100%',
headingOutput('Plot Background'),
headingOutput('Panel Background'),
headingOutput('Grid Major'),
headingOutput('Grid Minor')
),
fillRow(height = line.height, width = '100%',
selectizeInput('plot.background.fill', label = 'Fill', choices = NULL, width = input.width),
selectizeInput('panel.background.fill', label = 'Fill', choices = NULL, width = input.width),
"",
""
),
fillRow(height = line.height, width = '100%',
selectInput('plot.background.linetype', label = 'Type', choices = linetypes, selected = default$plot.background$linetype, width = input.width),
selectInput('panel.background.linetype', label = 'Type', choices = linetypes, selected = default$panel.background$linetype, width = input.width),
selectInput('panel.grid.major.type', label = 'Type', choices = linetypes, selected = default$panel.grid.major$linetype, width = input.width),
selectInput('panel.grid.minor.type', label = 'Type', choices = linetypes, selected = default$panel.grid.minor$linetype, width = input.width)
),
fillRow(height = line.height, width = '100%',
numericInput('plot.background.size', label = 'Size', step = 0.1, value = default$plot.background$size, width = input.width),
numericInput('panel.background.size', label = 'Size', step = 0.1, value = default$panel.background$size, width = input.width),
numericInput('panel.grid.major.size', label = 'Size', step = 0.1, value = default$panel.grid.major$size, min = 0, width = input.width),
numericInput('panel.grid.minor.size', label = 'Size', step = 0.1, value = default$panel.grid.minor$size, min = 0, width = input.width)
),
fillRow(height = line.height, width = '100%',
selectizeInput('plot.background.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('panel.background.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('panel.grid.major.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('panel.grid.minor.colour', label = 'Colour', choices = NULL, width = input.width)
)
)
),
miniTabPanel("Axis", icon = icon('sliders'),
plotOutput("ThePlot", width = '100%', height = '45%'),
miniContentPanel(scrollable = TRUE,
fillRow(height = heading.height, width = '100%',
headingOutput('Axis text'),
headingOutput('Axis text.x'),
headingOutput('Axis text.y'),
headingOutput('Axis line'),
headingOutput('Axis ticks')
),
fillRow(height = line.height, width = '100%',
selectInput('axis.text.family', label = 'Family', choices = text.families, selected = default$axis.text$family, width = input.width),
selectInput('axis.text.x.family', label = 'Family', choices = c('None' = 'NULL', text.families), selected = NULL, width = input.width),
selectInput('axis.text.y.family', label = 'Family', choices = c('None' = 'NULL', text.families), selected = NULL, width = input.width),
selectInput('axis.line.type', label = 'Type', choices = linetypes, selected = default$axis.line$linetype, width = input.width),
selectInput('axis.ticks.type', label = 'Type', choices = linetypes, selected = default$axis.ticks$linetype, width = input.width)
),
fillRow(height = line.height, width = '100%',
selectInput('axis.text.face', label = 'Face', choices = text.faces, width = input.width, selected = default$axis.text$face),
selectInput('axis.text.x.face', label = 'Face', choices = c('None' = 'NULL', text.faces), width = input.width, selected = NULL),
selectInput('axis.text.y.face', label = 'Face', choices = c('None' = 'NULL', text.faces), width = input.width, selected = NULL),
numericInput('axis.line.size', label = 'Size', step = 0.1, value = default$axis.line$size, min = 0,width = input.width),
numericInput('axis.ticks.size', label = 'Size', step = 0.1, value = default$axis.ticks$size, min = 0,width = input.width)
),
fillRow(height = line.height, width = '100%',
numericInput('axis.text.size', label = 'Size', min = 1, max = 30, value = default$axis.text$size, step = 1, width = input.width),
numericInput('axis.text.x.size', label = 'Size', min = 1, max = 30, value = NULL, step = 1, width = input.width),
numericInput('axis.text.y.size', label = 'Size', min = 1, max = 30, value = NULL, step = 1, width = input.width),
selectizeInput('axis.line.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('axis.ticks.colour', label = 'Colour', choices = NULL, width = input.width)
),
fillRow(height = line.height, width = '100%',
selectizeInput('axis.text.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('axis.text.x.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('axis.text.y.colour', label = 'Colour', choices = NULL, width = input.width),
"",
""
),
fillRow(height = line.height, width = '100%',
numericInput('axis.text.hjust', 'Hjust', value = default$axis.text$hjust, step = 0.25, width = input.width),
numericInput('axis.text.hjust.x', 'Hjust', value = NULL, step = 0.25, width = input.width),
numericInput('axis.text.hjust.y', 'Hjust', value = NULL, step = 0.25, width = input.width),
"",
""
),
fillRow(height = line.height, width = '100%',
numericInput('axis.text.vjust', 'Vjust', value = default$axis.text$vjust, step = 0.25, width = input.width),
numericInput('axis.text.x.vjust', 'Vjust', value = NULL, step = 0.25, width = input.width),
numericInput('axis.text.y.vjust', 'Vjust', value = NULL, step = 0.25, width = input.width),
"",
""
),
fillRow(height = line.height, width = '100%',
numericInput('axis.text.angle', label = 'Angle', min = -180, max = 180, value = default$axis.text$angle, step = 5, width = input.width),
numericInput('axis.text.x.angle', label = 'Angle', min = -180, max = 180, value = NULL, step = 5, width = input.width),
numericInput('axis.text.y.angle', label = 'Angle', min = -180, max = 180, value = NULL, step = 5, width = input.width),
"",
""
)
)),
miniTabPanel("Title and label", icon = icon('sliders'),
plotOutput("ThePlot4", width = '100%', height = '45%'),
miniContentPanel(scrollable = TRUE,
fillRow(height = heading.height, width = '100%',
headingOutput('Labels'),
headingOutput('Plot Title'),
headingOutput('Axis Labels')
),
fillRow(height = line.height, width = '100%',
textInput('plot.title', label = 'Title', value = preserveNewlines(gg_original$labels$title), width = input.width),
selectInput('plot.title.family', label = 'Family', choices = text.families, selected = default$plot.title$family, width = input.width),
selectInput('axis.title.family', label = 'Family', choices = text.families, selected = default$axis.title$family, width = input.width)
),
fillRow(height = line.height, width = '100%',
textInput('axis.title.x', label = 'x-Axis label', value = preserveNewlines(gg_original$labels$x), width = input.width),
selectInput('plot.title.face', label = 'Face', choices = text.faces, width = input.width, selected = default$plot.title$face),
selectInput('axis.title.face', label = 'Face', choices = text.faces, width = input.width, selected = default$axis.title$face)
),
fillRow(height = line.height, width = '100%',
textInput('axis.title.y', label = 'y-Axis label', value = preserveNewlines(gg_original$labels$y), width = input.width),
numericInput('plot.title.size', label = 'Size', min = 1, max = 30, value = default$plot.title$size, step = 1, width = input.width),
numericInput('axis.title.size', label = 'Size', min = 1, max = 30, value = default$axis.title$size, step = 1, width = input.width)
),
fillRow(height = line.height, width = '100%',
textInput('legend.colour.title', label = 'Colour', value = preserveNewlines(gg_original$labels$colour), width = input.width),
selectizeInput('plot.title.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('axis.title.colour', label = 'Colour', choices = NULL, width = input.width)
),
fillRow(height = line.height, width = '100%',
textInput('legend.fill.title', label = 'Fill label', value = preserveNewlines(gg_original$labels$fill), width = input.width),
numericInput('plot.title.hjust', 'Hjust', value = default$plot.title$hjust, step = 0.25, width = input.width),
numericInput('axis.title.hjust', 'Hjust', value = default$axis.title$hjust, step = 0.25, width = input.width)
),
fillRow(height = line.height, width = '100%',
textInput('legend.size.title', label = 'Size label', value = preserveNewlines(gg_original$labels$size), width = input.width),
numericInput('plot.title.vjust', 'Vjust', value = default$plot.title$vjust, step = 0.25, width = input.width),
numericInput('axis.title.vjust', 'Vjust', value = default$axis.title$vjust, step = 0.25, width = input.width)
),
fillRow(height = line.height, width = '100%',
textInput('legend.alpha.title', label = 'Alpha label', value = preserveNewlines(gg_original$labels$alpha), width = input.width),
numericInput('plot.title.angle', label = 'Angle', min = -180, max = 180, value = default$plot.title$angle, step = 5, width = input.width),
numericInput('axis.title.angle', label = 'Angle', min = -180, max = 180, value = default$axis.title$angle, step = 5, width = input.width)
),
fillRow(height = line.height, width = '33%',
textInput('legend.linetype.title', label = 'Linetype label', value = preserveNewlines(gg_original$labels$linetype), width = input.width)
),
fillRow(height = line.height, width = '33%',
textInput('legend.shape.title', label = 'Shape label', value = preserveNewlines(gg_original$labels$shape), width = input.width)
)
)
),
miniTabPanel("Legend", icon = icon('sliders'),
plotOutput("ThePlot3", width = '100%', height = '45%', click = 'legend.click'),
miniContentPanel(scrollable = TRUE,
fillRow(height = heading.height, width = '100%',
headingOutput('Legend position'),
headingOutput('Legend Title'),
headingOutput('Legend Text'),
headingOutput("Legend Background"),
headingOutput("Legend Keys")
),
fillRow(height = line.height, width = '100%',
selectInput('legend.position', label = 'Position', choices = legend.positions, selected = default$legend.position, width = input.width),
selectInput('legend.title.family', label = 'Family', choices = text.families, selected = default$legend.title$family, width = input.width),
selectInput('legend.text.family', label = 'Family', choices = text.families, selected = default$legend.text$family, width = input.width),
selectizeInput('legend.background.fill', label = 'Fill', choices = NULL, width = input.width),
selectizeInput('legend.key.fill', label = 'Fill', choices = NULL, width = input.width)
),
fillRow(height = line.height, width = '100%',
selectInput('legend.direction', label = 'Direction', choices = legend.directions, selected = default$legend.direction, width = input.width),
selectInput('legend.title.face', label = 'Face', choices = text.faces, selected = default$legend.title$face, width = input.width),
selectInput('legend.text.face', label = 'Face', choices = text.faces, selected = default$legend.text$face, width = input.width),
selectInput('legend.background.linetype', label = 'Type', choices = linetypes, selected = default$legend.background$linetype, width = input.width),
selectInput('legend.key.linetype', label = 'Type', choices = linetypes, selected = default$legend.key$linetype, width = input.width)
),
fillRow(height = line.height, width = '100%',
conditionalPanel(
condition = "input['legend.position'] == 'XY'",
numericInput('legend.position.x', label = 'X Coord', min = 0, max = 1, value = default$legend.position.x, step = 0.01, width = input.width)
),
numericInput('legend.title.size', label = 'Size', min = 1, max = 30, value = default$legend.title$size, step = 1, width = input.width),
numericInput('legend.text.size', label = 'Size', min = 1, max = 30, value = default$legend.text$size, step = 1, width = input.width),
numericInput('legend.background.size', label = 'Size', step = 0.1, value = default$legend.background$size, width = input.width),
numericInput('legend.key.size', label = 'Size', step = 0.1, value = default$legend.key$size, width = input.width)
),
fillRow(height = line.height, width = '100%',
conditionalPanel(
condition = "input['legend.position'] == 'XY'",
numericInput('legend.position.y', label = 'Y Coord', min = 0, max = 1, value = default$legend.position.y, step = 0.01, width = input.width)
),
selectizeInput('legend.title.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('legend.text.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('legend.background.colour', label = 'Colour', choices = NULL, width = input.width),
selectizeInput('legend.key.colour', label = 'Colour', choices = NULL, width = input.width)
)
)
),
if (SubtitlesSupport) {
miniTabPanel("Subtitle and Caption", icon = icon('sliders'),
plotOutput("ThePlot6", width = '100%', height = '45%'),
miniContentPanel(scrollable = TRUE,
fillRow(width = '100%', height = heading.height,
headingOutput('Subtitle')
),
fillRow(width = '100%', height = line.height,
tags$div(style="display:table; width:100%; margin:auto",
tags$textarea(id="plot.subtitle.text", label="Subtitle",
rows=3, cols=80, gg_original$labels$subtitle,
style="width:inherit; font-size:9pt; padding:5px"
)
)
),
fillRow(width = '100%', height = line.height,
selectInput('plot.subtitle.family', label = 'Family', choices = text.families, selected = default$plot.subtitle$family, width = input.width2),
selectInput('plot.subtitle.face', label = 'Face', choices = text.faces, width = input.width2, selected = default$plot.subtitle$face),
numericInput('plot.subtitle.size', label = 'Size', min = 1, max = 30, value = default$plot.subtitle$size, step = 1, width = input.width2),
selectizeInput('plot.subtitle.colour', label = 'Colour', choices = colours.available, selected = default$plot.subtitle$colour, width = input.width2, options = list(create = TRUE)),
numericInput('plot.subtitle.hjust', 'Hjust', value = default$plot.subtitle$hjust, step = 0.25, width = input.width2)
),
fillRow(width = '100%', height = heading.height,
headingOutput('Caption')
),
fillRow(width = '100%', height = line.height,
tags$div(style="display:table; width:100%; margin:auto",
tags$textarea(id="plot.caption.text", label="Subtitle",
rows=3, cols=80, gg_original$labels$caption,
style="width:inherit; font-size:9pt; padding:5px"
)
)
),
fillRow(width = '100%', height = line.height,
selectInput('plot.caption.family', label = 'Family', choices = text.families, selected = default$plot.caption$family, width = input.width2),
selectInput('plot.caption.face', label = 'Face', choices = text.faces, width = input.width2, selected = default$plot.caption$face),
numericInput('plot.caption.size', label = 'Size', min = 1, max = 30, value = default$plot.caption$size, step = 1, width = input.width2),
selectizeInput('plot.caption.colour', label = 'Colour', choices = colours.available, selected = default$plot.caption$colour, width = input.width2, options = list(create = TRUE)),
numericInput('plot.caption.hjust', 'Hjust', value = default$plot.caption$hjust, step = 0.25, width = input.width2)
)
)
)
}
))
server <- function(input, output, session) {
colour.choices <- colours2RGB(colours.available)
updateSelectizeInput(session = session, inputId = 'plot.background.fill', choices = colour.choices, selected = NA2text(default$plot.background$fill), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'panel.background.fill', choices = colour.choices, selected = NA2text(default$panel.background$fill), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'plot.background.colour', choices = colour.choices, selected = NA2text(default$plot.background$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'panel.background.colour', choices = colour.choices, selected = NA2text(default$panel.background$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'panel.grid.major.colour', choices = colour.choices, selected = NA2text(default$panel.grid.major$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'panel.grid.minor.colour', choices = colour.choices, selected = NA2text(default$panel.grid.minor$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'axis.line.colour', choices = colour.choices, selected = NA2text(default$axis.line$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'axis.ticks.colour', choices = colour.choices, selected = NA2text(default$axis.ticks$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'axis.text.colour', choices = colour.choices, selected = NA2text(default$axis.text$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'axis.text.x.colour', choices = colours2RGB(colours.available, Inherit = TRUE), selected = 'NULL', server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'axis.text.y.colour', choices = colours2RGB(colours.available, Inherit = TRUE), selected = 'NULL', server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'plot.title.colour', choices = colour.choices, selected = NA2text(default$plot.title$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'axis.title.colour', choices = colour.choices, selected = NA2text(default$axis.title$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.background.fill', choices = colour.choices, selected = NA2text(default$legend.background$fill), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.key.fill', choices = colour.choices, selected = NA2text(default$legend.key$fill), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.title.colour', choices = colour.choices, selected = NA2text(default$legend.title$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.text.colour', choices = colour.choices, selected = NA2text(default$legend.text$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.background.colour', choices = colour.choices, selected = NA2text(default$legend.background$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.key.colour', choices = colour.choices, selected = NA2text(default$legend.key$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'panel.background.fill', choices = colour.choices, selected = NA2text(default$panel.background$fill), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'legend.key.colour', choices = colour.choices, selected = NA2text(default$legend.key$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
if (SubtitlesSupport) {
updateSelectizeInput(session = session, inputId = 'plot.subtitle.colour', choices = colour.choices, selected = NA2text(default$plot.subtitle$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
updateSelectizeInput(session = session, inputId = 'plot.caption.colour', choices = colour.choices, selected = NA2text(default$plot.caption$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector))
}
gg_reactive <- reactive({
validate(
need(is.validColour(input$plot.background.fill), ''),
need(is.validColour(input$panel.background.fill), ''),
need(is.validColour(input$plot.background.colour), ''),
need(is.validColour(input$panel.background.colour), ''),
need(is.validColour(input$panel.grid.major.colour), ''),
need(is.validColour(input$panel.grid.minor.colour), ''),
need(is.validColour(input$axis.line.colour), ''),
need(is.validColour(input$axis.ticks.colour), ''),
need(is.validColour(input$axis.text.colour), ''),
need(is.validColour(input$axis.text.x.colour), ''),
need(is.validColour(input$axis.text.y.colour), ''),
need(is.validColour(input$plot.title.colour), ''),
need(is.validColour(input$axis.title.colour), ''),
need(is.validColour(input$legend.background.fill), ''),
need(is.validColour(input$legend.key.fill), ''),
need(is.validColour(input$legend.title.colour), ''),
need(is.validColour(input$legend.text.colour), ''),
need(is.validColour(input$legend.background.colour), ''),
need(is.validColour(input$legend.key.colour), '')
)
if (SubtitlesSupport) {
validate(
need(is.validColour(input$plot.subtitle.colour), ''),
need(is.validColour(input$plot.caption.colour), '')
)
}
gg <- gg_original +
labs(
title = checkInputText(input$plot.title),
x = checkInputText(input$axis.title.x),
y = checkInputText(input$axis.title.y),
fill = checkInputText(input$legend.fill.title),
linetype = checkInputText(input$legend.linetype.title),
alpha = checkInputText(input$legend.alpha.title),
size = checkInputText(input$legend.size.title),
shape = checkInputText(input$legend.shape.title),
colour = checkInputText(input$legend.colour.title)
) +
theme(
axis.text = element_text(
size = input$axis.text.size,
colour = input$axis.text.colour,
face = input$axis.text.face,
family = input$axis.text.family,
angle = input$axis.text.angle,
hjust = input$axis.text.hjust,
vjust = input$axis.text.vjust,
lineheight = input$axis.text.lineheight),
axis.text.x = element_text(
size = setNull(input$axis.text.x.size),
colour = setNull(input$axis.text.x.colour),
family = setNull(input$axis.text.x.family),
angle = setNull(input$axis.text.x.angle),
hjust = setNull(input$axis.text.x.hjust),
vjust = setNull(input$axis.text.x.vjust)
),
axis.text.y = element_text(
size = setNull(input$axis.text.y.size),
colour = setNull(input$axis.text.y.colour),
family = setNull(input$axis.text.y.family),
angle = setNull(input$axis.text.y.angle),
hjust = setNull(input$axis.text.y.hjust),
vjust = setNull(input$axis.text.y.vjust)
),
axis.line = element_line(
linetype = input$axis.line.type,
colour = input$axis.line.colour,
size = input$axis.line.size),
axis.ticks = element_line(
linetype = input$axis.ticks.type,
colour = input$axis.ticks.colour,
size = input$axis.ticks.size),
axis.title = element_text(
size = input$axis.title.size,
colour = input$axis.title.colour,
face = input$axis.title.face,
family = input$axis.title.family,
angle = input$axis.title.angle,
hjust = input$axis.title.hjust,
vjust = input$axis.title.vjust,
lineheight = input$axis.title.lineheight),
plot.title = element_text(
size = input$plot.title.size,
colour = input$plot.title.colour,
face = input$plot.title.face,
family = input$plot.title.family,
angle = input$plot.title.angle,
hjust = input$plot.title.hjust,
vjust = input$plot.title.vjust,
lineheight = input$plot.title.lineheight),
plot.background = element_rect(
fill = input$plot.background.fill,
colour = input$plot.background.colour,
size = input$plot.background.size,
linetype = input$plot.background.linetype
),
panel.background = element_rect(
fill = input$panel.background.fill,
colour = input$panel.background.colour,
size = input$panel.background.size,
linetype = input$panel.background.linetype
),
panel.grid.major = element_line(
linetype = input$panel.grid.major.type,
colour = input$panel.grid.major.colour,
size = input$panel.grid.major.size),
panel.grid.minor = element_line(
linetype = input$panel.grid.minor.type,
colour = input$panel.grid.minor.colour,
size = input$panel.grid.minor.size),
legend.text = element_text(
size = input$legend.text.size,
face = input$legend.text.face,
colour = input$legend.text.colour,
family = input$legend.text.family
),
legend.title = element_text(
size = input$legend.title.size,
face = input$legend.title.face,
colour = input$legend.title.colour,
family = input$legend.title.family
),
legend.background = element_rect(
fill = input$legend.background.fill,
colour = input$legend.background.colour,
size = input$legend.background.size,
linetype = input$legend.background.linetype
),
legend.key = element_rect(
fill = input$legend.key.fill,
colour = input$legend.key.colour,
size = input$legend.key.size,
linetype = input$legend.key.linetype
),
legend.position = (if (input$legend.position == 'XY') {
c(input$legend.position.x, input$legend.position.y)
} else {
input$legend.position
}),
legend.direction = input$legend.direction
)
if (SubtitlesSupport) {
gg <- gg + labs(
subtitle = if (input$plot.subtitle.text == '') {NULL} else {input$plot.subtitle.text},
caption = if (input$plot.caption.text == '') {NULL} else {input$plot.caption.text}
) +
theme(
plot.subtitle = element_text(
size = input$plot.subtitle.size,
colour = input$plot.subtitle.colour,
face = input$plot.subtitle.face,
family = input$plot.subtitle.family,
#angle = input$plot.subtitle.angle,
hjust = input$plot.subtitle.hjust,
#vjust = input$plot.subtitle.vjust,
lineheight = input$plot.subtitle.lineheight),
plot.caption = element_text(
size = input$plot.caption.size,
colour = input$plot.caption.colour,
face = input$plot.caption.face,
family = input$plot.caption.family,
#angle = input$plot.caption.angle,
hjust = input$plot.caption.hjust,
#vjust = input$plot.caption.vjust,
lineheight = input$plot.caption.lineheight)
)
}
return(gg)
})
observeEvent(input$legend.click, {
x.click <- input$legend.click$x / (input$legend.click$domain$right - input$legend.click$domain$left)
y.click <- input$legend.click$y / (input$legend.click$domain$top - input$legend.click$domain$bottom)
if (hasLegend(gg_original)) {
updateSelectInput(session, 'legend.position', selected = 'XY')
updateSelectInput(session, 'legend.position.x', selected = round(x.click, 4))
updateSelectInput(session, 'legend.position.y', selected = round(y.click, 4))
}
})
ThePlot <- renderPlot(width = function() {
validate(
need(is.numeric(input$plot.width), ''),
need(is.numeric(input$plot.height), ''),
need(!is.null(input$ViewerWidth), ''),
need(is.validColour(input$legend.key.colour), '')
)
min(input$plot.width / input$plot.height * input$ViewerWidth * 45 / 100,
input$ViewerWidth
)
},
{
gg_reactive()
})
output$ThePlot <- ThePlot
output$ThePlot2 <- ThePlot
output$ThePlot3 <- ThePlot
output$ThePlot4 <- ThePlot
output$ThePlot5 <- ThePlot
output$ThePlot6 <- ThePlot
observeEvent(input$done, {
themeResult <- sapply(AvailableElements, compileResults, new = gg_reactive(), original = gg_original, std = default, USE.NAMES = FALSE)
themeResult <- themeResult[!is.na(themeResult)]
labelResult <- construcThemeString('labs', original = gg_original, new = gg_reactive(), std = default, category = 'labels')
if((!is.null(themeResult) & length(themeResult) > 0) | !is.null(labelResult)) {
if (!is.null(input$multiline)) {
if (input$multiline) {
oneline <- FALSE
} else {
oneline <- TRUE
}
} else {
oneline <- TRUE
}
result <- formatResult(text = text, themestring = themeResult, labelstring = labelResult, oneline = oneline, formatR = input$formatR)
rstudioapi::insertText(result)
}
invisible(stopApp())
})
observeEvent(input$cancel, {
invisible(stopApp())
})
}
viewer <- dialogViewer(dialogName = 'ggThemeAssist', width = 990, height = 900)
runGadget(ui, server, stopOnCancel = FALSE, viewer = viewer)
}
#' @export
#' @rdname ggThemeAssist
ggThemeAssistGadget <- function(plot) {
if (missing(plot)) {
stop('You must provide a ggplot2 plot object.', call. = FALSE)
}
plot <- deparse(substitute(plot))
if (grepl('^\\s*[[:alpha:]]+[[:alnum:]\\.]*\\s*$', paste0(plot, collapse = ''))) {
ggThemeAssist(plot)
} else {
stop('You must provide a ggplot2 plot object.', call. = FALSE)
}
}
ggThemeAssistAddin <- function() {
# Get the document context.
context <- rstudioapi::getActiveDocumentContext()
# Set the default data to use based on the selection.
text <- context$selection[[1]]$text
if (nchar(text) == 0) {
stop('Please highlight a ggplot2 plot before selecting this addin.')
}
ggThemeAssist(text)
}
Try the ggThemeAssist package in your browser
Any scripts or data that you put into this service are public.
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.