├── .gitignore ├── examples ├── result.PNG ├── script.gif └── ggThemeAssist2.gif ├── inst └── rstudio │ └── addins.dcf ├── .Rbuildignore ├── .travis.yml ├── R ├── ggThemeAssist-package.R ├── jsHelpers.R ├── formatResult.R ├── constructThemeString.R ├── updateDefaults.R ├── helpers.R ├── constants.R └── ggThemeAssist.R ├── NAMESPACE ├── cran-comments.md ├── ggthemeassist.Rproj ├── DESCRIPTION ├── man └── ggThemeAssist.Rd ├── NEWS.md └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | 6 | -------------------------------------------------------------------------------- /examples/result.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/calligross/ggthemeassist/HEAD/examples/result.PNG -------------------------------------------------------------------------------- /examples/script.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/calligross/ggthemeassist/HEAD/examples/script.gif -------------------------------------------------------------------------------- /examples/ggThemeAssist2.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/calligross/ggthemeassist/HEAD/examples/ggThemeAssist2.gif -------------------------------------------------------------------------------- /inst/rstudio/addins.dcf: -------------------------------------------------------------------------------- 1 | Name: ggplot Theme Assistant 2 | Description: Customize your ggplot theme 3 | Binding: ggThemeAssistAddin 4 | Interactive: true 5 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^examples 4 | ^README.md 5 | ^.Rhistory 6 | ^.RData 7 | ^NEWS\.md$ 8 | ^cran-comments\.md$ 9 | ^\.travis\.yml$ 10 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: r 4 | r: 5 | - oldrel 6 | - release 7 | - devel 8 | sudo: false 9 | cache: packages 10 | -------------------------------------------------------------------------------- /R/ggThemeAssist-package.R: -------------------------------------------------------------------------------- 1 | #' RStudio Addins 2 | #' 3 | #' Addin to help style your ggplot2 themes 4 | #' 5 | #' @name ggThemeAssist 6 | #' @docType package 7 | #' @import shiny miniUI rstudioapi formatR ggplot2 8 | NULL 9 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(ggThemeAssistGadget) 4 | import(formatR) 5 | import(ggplot2) 6 | import(miniUI) 7 | import(rstudioapi) 8 | import(shiny) 9 | importFrom(grDevices,col2rgb) 10 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Test environments 2 | * local OS X install, R 3.3.1 3 | * win-builder (devel and release) 4 | * ubuntu 12.04 (on travis-ci) 5 | 6 | ## R CMD check results 7 | 8 | 0 errors | 0 warnings | 1 notes 9 | 10 | \* checking CRAN incoming feasibility ... NOTE 11 | Maintainer: 'Calli Gross ' 12 | 13 | ## Downstream dependencies 14 | There are no downstream dependencies. 15 | -------------------------------------------------------------------------------- /ggthemeassist.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageCheckArgs: --as-cran 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ggThemeAssist 2 | Type: Package 3 | Title: Add-in to Customize 'ggplot2' Themes 4 | Version: 0.1.5.9001 5 | Author: Calli Gross [aut, cre], 6 | Philipp Ottolinger [aut, ctb] 7 | Maintainer: Calli Gross 8 | Description: Rstudio add-in that delivers a graphical interface for editing 'ggplot2' theme elements. 9 | License: GPL-3 10 | URL: https://github.com/calligross/ggthemeassist 11 | LazyData: TRUE 12 | Imports: 13 | shiny (>= 0.13), 14 | miniUI (>= 0.1.1), 15 | rstudioapi (>= 0.5), 16 | ggplot2, 17 | formatR 18 | Suggests: extrafont 19 | RoxygenNote: 6.0.1 20 | Depends: 21 | R (>= 3.0.0) 22 | -------------------------------------------------------------------------------- /R/jsHelpers.R: -------------------------------------------------------------------------------- 1 | jscodeHeight <- 2 | '$(document).on("shiny:connected", function(e) { 3 | var jsHeight = document.documentElement.clientHeight; 4 | Shiny.onInputChange("ViewerHeight",jsHeight); 5 | });' 6 | 7 | jscodeWidth <- 8 | '$(document).on("shiny:connected", function(e) { 9 | var jsWidth = document.documentElement.clientWidth; 10 | Shiny.onInputChange("ViewerWidth",jsWidth); 11 | });' 12 | 13 | jsColourSelector <- I( 14 | '{ 15 | option: function(item, escape) { 16 | return "
 " + escape(item.name) + "
"; 17 | } 18 | }') 19 | -------------------------------------------------------------------------------- /R/formatResult.R: -------------------------------------------------------------------------------- 1 | formatResult <- function(text, themestring, labelstring, oneline, formatR = TRUE) { 2 | result <- NULL 3 | 4 | if (!is.null(themestring) && length(themestring) > 0) { 5 | if (oneline) { 6 | result <- paste0(' + theme(', paste(themestring, collapse = ', '),')') 7 | } else { 8 | result <- paste0(paste(text, ' <- ', text, ' + theme(', themestring, ')', sep = ''), collapse = '\n') 9 | } 10 | } 11 | 12 | if (!is.null(labelstring)) { 13 | if (oneline) { 14 | result <- c(result, ' + ', labelstring) 15 | } else { 16 | labelstring <- paste0(text, ' <- ', text, ' + ', labelstring) 17 | result <- paste(c(result, labelstring), collapse = '\n') 18 | } 19 | } 20 | 21 | if (oneline) { 22 | if (formatR) { 23 | result <- formatR::tidy_source(text = result, output = FALSE, width.cutoff = 40)$text.tidy 24 | result <- gsub('^\\+theme', ' + theme', result) 25 | } 26 | result <- paste0(text, paste(result, collapse = ' ')) 27 | 28 | } 29 | 30 | result <- paste(result, collapse = "\n") 31 | return(result) 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/ggThemeAssist.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggThemeAssist-package.R, R/ggThemeAssist.R 3 | \docType{package} 4 | \name{ggThemeAssist} 5 | \alias{ggThemeAssist} 6 | \alias{ggThemeAssist-package} 7 | \alias{ggThemeAssist} 8 | \alias{ggThemeAssistGadget} 9 | \title{RStudio Addins} 10 | \usage{ 11 | ggThemeAssistGadget(plot) 12 | } 13 | \arguments{ 14 | \item{plot}{A ggplot2 plot object to manipulate its theme.} 15 | } 16 | \value{ 17 | \code{ggThemeAssist} returns a character vector. 18 | } 19 | \description{ 20 | Addin to help style your ggplot2 themes 21 | 22 | \code{ggThemeAssist} is a RStudio-Addin that delivers a graphical interface for editing ggplot2 theme elements. 23 | } 24 | \details{ 25 | 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. 26 | } 27 | \examples{ 28 | \dontrun{ 29 | # example for ggThemeAssist command line usage. 30 | library(ggplot2) 31 | gg <- ggplot(mtcars, aes(x = hp, y = mpg, colour = as.factor(cyl))) + geom_point() 32 | ggThemeAssistGadget(gg) 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # ggThemeAssist 2 | 3 | # ggThemeAssist 0.1.5.9000 4 | 5 | * Added support for strip.background and strip.text 6 | * Escape single quoted strings (#69) 7 | 8 | # ggThemeAssist 0.1.5 9 | 10 | This is a bug fix release. When theme$text$size was NULL, ggThemeAssist crashed at start. (#65) 11 | 12 | # ggThemeAssist 0.1.4 13 | 14 | Second CRAN release after 0.1.0 15 | 16 | * Removed invalidateLater() due to rendering problems with facetted plots. 17 | 18 | # ggThemeAssist 0.1.3 19 | 20 | ## New features 21 | 22 | * Enable/disable formatR 23 | * Multiline results 24 | 25 | Multiline results look like: 26 | 27 | ```r 28 | gg <- gg + theme(panel.grid.major = element_line(size = 0.6)) 29 | gg <- gg + theme(panel.grid.minor = element_line(size = 0.6)) 30 | gg <- gg + theme(panel.background = element_rect(size = 0.6)) 31 | ``` 32 | Multiline results are only available, if an ggplot2 object has been highlighted. 33 | 34 | ## Bugfixes 35 | 36 | * Handling of empty theme strings. Closes #55 37 | 38 | 39 | # ggThemeAssist 0.1.2 40 | 41 | ## New features 42 | * subtitle* 43 | * caption* 44 | * Set legend position by click 45 | * Set the plot dimensions 46 | * Run ggThemeAssist from the console, e.g.: ggThemeAssistGadget(gg) 47 | * Legend labels now support size, shape, alpha and linetype 48 | * Previews for colour selection 49 | 50 | *) Please consider that subtitle and captions require the [latest version of `ggplot2` from GitHub](https://github.com/hadley/ggplot2#installation). 51 | 52 | 53 | ## Bugfixes 54 | * Plot height is now a relative value to improve visibility in combinations with lower screen resolutions. Closes #32. 55 | * Apply preset themes correctly to input widgets. Closes #36 56 | * Added validate checks for colours. Closes #41 57 | * Reduce the given fonts if extrafont package is installed. Closes #35 58 | * Handle newlines correctly. Closes #44 59 | 60 | 61 | 62 | # ggThemeAssist 0.1.0 63 | 64 | **ggThemeAssist** is now available on CRAN (v0.1.0). 65 | 66 | Full list of supported themes: 67 | 68 | * axis.title.x 69 | * axis.title.y 70 | * axis.text 71 | * axis.ticks 72 | * axis.line 73 | * legend.background 74 | * legend.key 75 | * legend.text 76 | * legend.title 77 | * legend.position 78 | * legend.direction 79 | * panel.background 80 | * panel.grid.major 81 | * panel.grid.minor 82 | * plot.background 83 | * plot.title 84 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ggThemeAssist 2 | ============== 3 | [![Build Status](https://travis-ci.org/calligross/ggthemeassist.svg?branch=master)](https://travis-ci.org/calligross/ggthemeassist) 4 | [![CRAN](http://www.r-pkg.org/badges/version/ggThemeAssist)](http://cran.rstudio.com/package=ggThemeAssist) [![Downloads](http://cranlogs.r-pkg.org/badges/ggThemeAssist?color=brightgreen)](http://www.r-pkg.org/pkg/ggThemeAssist) 5 | [![saythanks](https://img.shields.io/badge/say-thanks-ff69b4.svg)](https://saythanks.io/to/calligross) 6 | 7 | 8 | **ggThemeAssist** is a RStudio-Addin that uses the [`rstudioapi`](https://github.com/rstudio/rstudioapi) package and provides a GUI for editing [`ggplot2`](https://github.com/hadley/ggplot2) themes. 9 | 10 | For a full list of features see [`NEWS`](./NEWS.md). 11 | 12 | 13 | Installation 14 | ------------ 15 | 16 | Please be aware that you need the **most recent (stable) release of RStudio** (v0.99.878 or later). Additionally, **ggThemeAssist** depends on [`shiny`](https://github.com/rstudio/shiny) and [`miniUI`](https://github.com/rstudio/miniUI). 17 | 18 | #### Install from Github 19 | You can install the latest version of **ggThemeAssist** from Github using the [`devtools`](https://github.com/hadley/devtools) package: 20 | ```r 21 | if (!requireNamespace("devtools", quietly = TRUE)) 22 | install.packages("devtools") 23 | 24 | devtools::install_github("calligross/ggthemeassist") 25 | ``` 26 | 27 | #### Install from CRAN 28 | 29 | The stable version of **ggThemeAssist**, v0.1.4, is available on CRAN: 30 | ```r 31 | install.packages("ggThemeAssist") 32 | ``` 33 | 37 | 38 | Usage 39 | ------------ 40 | After installing, **ggThemeAssist** is available in the Addins menu within RStudio. 41 | 42 | To edit `ggplot2` themes, just highlight a `ggplot2` object in your current script and run the Addin from the Addins menu. **ggplot2** will analyze your current plot, update its defaults to your current specification and give you a preview. Use the input widgets to get your ideas into shape. After terminating **ggThemeAssist** a character string containing your desired changes in standard `ggplot2` notation is inserted in your script. Re-running your script now produces the plot you just configured using **ggThemeAssist**. 43 | 44 | [Click to enlarge](https://raw.githubusercontent.com/calligross/ggthemeassist/master/examples/ggThemeAssist2.gif) 45 | 46 | ![Screenshot](examples/ggThemeAssist2.gif) 47 | 48 | -------------------------------------------------------------------------------- /R/constructThemeString.R: -------------------------------------------------------------------------------- 1 | construcThemeString <- function(theme, original, new, std = default, element = NULL, category = 'theme') { 2 | result <- NULL 3 | std <- unlist(std[[theme]]) 4 | std[is.na(std)] <- 'NA' 5 | 6 | if (category == 'theme') { 7 | # if you value good style of coding, don't read the next few lines, it's an ugly workaround for legend.position 8 | if (theme == 'legend.position' && length(new[[category]][[theme]]) > 1) { 9 | legend_position <- new[[category]][[theme]] 10 | legend_position <- paste0('c(',paste(legend_position, collapse = ', '), ')') 11 | new[[category]][[theme]] <- legend_position 12 | } 13 | 14 | new <- unlist(new[[category]][[theme]]) 15 | 16 | if (theme == 'legend.position' && length(original[[category]][[theme]]) > 1) { 17 | legend_position <- original[[category]][[theme]] 18 | legend_position <- paste0('c(',paste(legend_position, collapse = ', '), ')') 19 | original[[category]][[theme]] <- legend_position 20 | } 21 | 22 | original <- unlist(original[[category]][[theme]]) 23 | 24 | } else if (category == 'labels') { 25 | new <- unlist(new[[category]]) 26 | original <- unlist(original[[category]]) 27 | 28 | new_names <- names(new) 29 | original_names <- names(original) 30 | 31 | lost_names <- original_names[!original_names %in% new_names] 32 | 33 | if(length(lost_names) > 0) { 34 | new[lost_names] <- 'NULL' 35 | } 36 | 37 | } 38 | 39 | if (is.list(std) || length(std) > 1){ 40 | DifferentToStandard <- names(std)[!new[names(std)] == std[names(std)]] 41 | DifferentToStandard <- DifferentToStandard[!is.na(DifferentToStandard)] 42 | DifferentToStandard <- new[DifferentToStandard] 43 | 44 | if (!is.null(original)) { 45 | DifferentToOriginal <- (!new[names(new)] == original[names(new)]) 46 | DifferentToOriginal[is.na(DifferentToOriginal)] <- TRUE 47 | DifferentToOriginal <- names(DifferentToOriginal)[DifferentToOriginal] 48 | 49 | Different <- ((names(DifferentToStandard) %in% DifferentToOriginal)) 50 | result <- DifferentToStandard[Different] 51 | } else { 52 | result <- DifferentToStandard 53 | } 54 | 55 | if (!is.null(result) && length(result) > 0) { 56 | result <- addQuotes(result) 57 | if (category == 'labels') { 58 | result <- paste0(theme, '(', element, '', paste(names(result), ' = ', result, collapse = ', '),')') 59 | } else { 60 | result <- paste0(theme, ' = ', element, '(', paste(names(result), ' = ', result, collapse = ', '),')') 61 | } 62 | return(result) 63 | } else { 64 | NULL 65 | } 66 | } else if (length(std) == 1 && class(std) == 'character' && !is.null(new)) { 67 | if (is.null(original)) { 68 | original <- '' 69 | } 70 | if (new != std && new != original) { 71 | result <- paste0(theme, ' = ', addQuotes(new)) 72 | return(result) 73 | } 74 | } 75 | } 76 | -------------------------------------------------------------------------------- /R/updateDefaults.R: -------------------------------------------------------------------------------- 1 | updateDefaults <- function(gg, defaults, linetypes = linetypes) { 2 | 3 | # Set default values for all elements 4 | for (i in c('rect', 'line', 'text')) { 5 | #substitute numeric linetypes to named, otherwise input widgets can't handle them 6 | if (i %in% c('rect', 'line') && !is.null(gg$theme[[i]]['linetype']) && is.numeric(gg$theme[[i]][['linetype']])) { 7 | gg$theme[[i]]['linetype'] <- linetypes[(gg$theme[[i]][['linetype']] + 1)] 8 | } 9 | 10 | # find elements in defaults with the class of i 11 | ThemeClass <- class(gg$theme[[i]])[1] 12 | DefaultClasses <- sapply(defaults, class) 13 | DefaultClasses <- DefaultClasses[DefaultClasses == ThemeClass] 14 | DefaultClasses <- names(DefaultClasses) 15 | if (length(DefaultClasses) > 0) { 16 | for (j in DefaultClasses) { 17 | gg$theme[[i]][which(gg$theme[[i]][names(default[[j]])] == '')] <- NULL 18 | default[[j]][names(gg$theme[[i]])] <- lapply(gg$theme[[i]][names(gg$theme[[i]])], unname) 19 | } 20 | } 21 | } 22 | 23 | 24 | LegendPosition <- NULL 25 | if (length(gg$theme$legend.position) > 1) { 26 | LegendPosition <- gg$theme$legend.position 27 | gg$theme$legend.position <- 'XY' 28 | gg$theme$legend.position.x <- LegendPosition[1] 29 | gg$theme$legend.position.y <- LegendPosition[2] 30 | } 31 | 32 | ThemeOptions <- unlist(gg$theme) 33 | 34 | # get common names 35 | NamesThemes <- names(ThemeOptions) 36 | NamesDefaults <- names(unlist(defaults)) 37 | CommonNames <- NamesThemes[NamesThemes %in% NamesDefaults] 38 | 39 | CommonNames <- CommonNames[!CommonNames %in% c('legend.position.x', 'legend.position.y')] 40 | 41 | # have to get rid of the for loop later 42 | 43 | for (i in CommonNames) { 44 | anchor <- gsub(pattern = '\\.[a-z]*$', '', i) 45 | element <- gsub(pattern = '^.*\\.', '', i) 46 | if (i == 'legend.position' || i == 'legend.direction') { 47 | if (!is.null(LegendPosition) && i == 'legend.position') { 48 | defaults['legend.position'] <- 'XY' 49 | defaults['legend.position.x'] <- LegendPosition[1] 50 | defaults['legend.position.y'] <- LegendPosition[2] 51 | } else { 52 | defaults[i] <- gg$theme[i] 53 | } 54 | } 55 | else { 56 | # Relative size needs to be converted to absolute sizes 57 | if (class(gg[['theme']][[anchor]][[element]]) == 'rel') { 58 | 59 | if (!is.null(gg$theme$text$size)) { 60 | text_size <- gg$theme$text$size 61 | } else { 62 | text_size <- 10 63 | } 64 | 65 | defaults[[anchor]][[element]] <- as.numeric(gg[['theme']][[anchor]][[element]]) * text_size 66 | 67 | } else { 68 | if (element == 'linetype' && is.numeric(gg[['theme']][[anchor]][[element]])) { 69 | defaults[[anchor]][[element]] <- linetypes[gg[['theme']][[anchor]][[element]] + 1] 70 | } else { 71 | defaults[[anchor]][[element]] <- gg[['theme']][[anchor]][[element]] 72 | } 73 | } 74 | } 75 | } 76 | 77 | # substitute grey with gray 78 | defaults <- rapply(defaults, function(x) { gsub('grey', 'gray', x) }, how = 'list') 79 | return(defaults) 80 | } 81 | -------------------------------------------------------------------------------- /R/helpers.R: -------------------------------------------------------------------------------- 1 | headingOutput <- function(heading, height = '20px', css = 'color: #ad1d28; text-decoration: underline;') { 2 | 3 | fillCol(tags$div(style = css, strong(heading)), height = height) 4 | 5 | } 6 | 7 | addQuotes <- function(x){ 8 | chars <- grepl(pattern = '[a-zA-Z#]', x) 9 | x <- gsub("'", "\\\\'", x) 10 | chars[grep('^(c\\(.*|NA|NULL)*$', x)] <- FALSE 11 | x[chars] <- paste("'", x[chars], "'", sep = '') 12 | x 13 | } 14 | 15 | setNull <- function(x) { 16 | if(is.null(x)) { 17 | return(NULL) 18 | } else if (is.na(x)) { 19 | x <- NULL 20 | } else if (x == 'NULL') { 21 | x <- NULL 22 | } else if (x == 'NA') { 23 | x <- NULL 24 | } 25 | return(x) 26 | } 27 | 28 | compileResults <- function(element, original, new, std = default) { 29 | if (element$enabled == TRUE) { 30 | result <- construcThemeString(element$name, original = original, new = new, std = std, element = element$type) 31 | if (is.null(result)) 32 | result <- NA 33 | return(result) 34 | } else { 35 | return(NA) 36 | } 37 | } 38 | 39 | is.validColour <- function(x) { 40 | if (is.null(x)) { 41 | return(TRUE) 42 | } else if (x %in% c(colours.available, 'NA', 'NULL')) { 43 | return(TRUE) 44 | } else if (grepl('#[0-9a-fA-F]{6}$', x)) { 45 | return(TRUE) 46 | } 47 | else { 48 | return(FALSE) 49 | } 50 | } 51 | 52 | is.valid <- function(x) { 53 | if (!is.null(x) && !is.na(x)) { 54 | return(TRUE) 55 | } else { 56 | return(FALSE) 57 | } 58 | } 59 | 60 | checkInputText <- function(x) { 61 | if (x == '') { 62 | return(NULL) 63 | } else { 64 | x <- gsub('\\\\n', '\\\n', x) 65 | x <- gsub("'", "\\'", x) 66 | return(x) 67 | } 68 | } 69 | 70 | preserveNewlines <- function(x) { 71 | if (is.null(x)) { 72 | return('') 73 | } else { 74 | x <- gsub('\\\n', '\\\\n', x) 75 | return(x) 76 | } 77 | } 78 | 79 | getRGBHexColours <- function(gg) { 80 | theme <- unlist(gg$theme) 81 | colours <- theme[grep('#[0-9a-fA-F]{6}', theme)] 82 | colours <- unname(colours) 83 | colours <- unique(colours) 84 | return(colours) 85 | } 86 | 87 | colours2RGB <- function(colours, Inherit = FALSE) { 88 | #return a df of rgb colours 89 | colours[is.na(colours)] <- 'NA' 90 | rgbcolours <- matrix(as.character(as.character.hexmode(col2rgb(colours), width = 2)), nrow = 3) 91 | rgbcolours <- apply(rgbcolours, 2, paste, collapse = '') 92 | rgbcolours <- paste('#', rgbcolours, sep = '') 93 | rgbcolours <- data.frame(name = colours, colour = colours, rgb = rgbcolours, stringsAsFactors = FALSE) 94 | rgbcolours[1, 1] <- 'None' 95 | if (Inherit) { 96 | rgbcolours <- rbind(data.frame(name = 'Inherit', colour = 'NULL', rgb = '#ffffff'), rgbcolours) 97 | } 98 | rgbcolours <- rbind(data.frame(name = 'None', colour = NA, rgb = '#ffffff'), rgbcolours) 99 | #rgbcolours <- rgbcolours[orderRGB(rgbcolours$rgb), ] 100 | return(rgbcolours) 101 | } 102 | 103 | orderRGB <- function(colours) { 104 | # simple method, not very accurate 105 | colours <- gsub('#', '', colours) 106 | colours <- strsplit(tolower(colours), "") 107 | rgb <- sapply(colours, function(x) sum((match(x, c(0L:9L, letters[1L:6L])) - 1L) * 16 ^ (rev(seq_along(x) - 1)))) 108 | rgb <- order(rgb) 109 | return(rgb) 110 | } 111 | 112 | NA2text <- function(x) { 113 | if (is.na(x)) { 114 | return('NA') 115 | } else { 116 | return(x) 117 | } 118 | } 119 | 120 | hasLegend <- function(gg) { 121 | mappings <- names(gg$mapping) 122 | mappings <- mappings[!mappings %in% c('x', 'y')] 123 | length(mappings) > 0 124 | } 125 | 126 | -------------------------------------------------------------------------------- /R/constants.R: -------------------------------------------------------------------------------- 1 | # Choices to pick from 2 | colours.available <- c('None' = NA, colors()[!grepl('grey', colors())]) # We don't want redundant grays 3 | text.faces <- c('plain', 'italic', 'bold', 'bold.italic') 4 | 5 | text.families <- if (is.element('extrafont', installed.packages()[, 1])) { 6 | c(c('sans', 'serif', 'mono'), extrafont::fonttable()$FamilyName) 7 | } else { 8 | names(pdfFonts()) 9 | } 10 | 11 | legend.positions <- c('none', 'left', 'right', 'top', 'bottom', 'XY') 12 | legend.directions <- c('horizontal', 'vertical') 13 | linetypes <- c('blank', 'solid', 'dashed', 'dotted', 'dotdash', 'longdash', 'twodash') 14 | 15 | # Configurations 16 | input.width <- '50%' 17 | input.width2 <- '90%' 18 | line.height <- '70px' 19 | heading.height <- '30px' 20 | 21 | 22 | # default values 23 | default <- list( 24 | plot.subtitle = structure(list( 25 | family = 'sans', 26 | size = 9, 27 | face = 'plain', 28 | colour = 'gray30', 29 | hjust = 0, 30 | vjust = 1, 31 | angle = 0, 32 | lineheight = 1.1 33 | ), class = 'element_text'), 34 | plot.caption = structure(list( 35 | family = 'sans', 36 | size = 9, 37 | face = 'plain', 38 | colour = 'gray30', 39 | hjust = 1, 40 | vjust = 1, 41 | angle = 0, 42 | lineheight = 1.1 43 | ), class = 'element_text'), 44 | axis.text = structure(list( 45 | family = 'sans', 46 | size = 10, 47 | face = 'plain', 48 | colour = 'gray30', 49 | hjust = 0.5, 50 | vjust = 0.5, 51 | angle = 0, 52 | lineheight = 1.1 53 | ), class = 'element_text'), 54 | axis.text.x = structure(list( 55 | family = 'sans', 56 | size = 10, 57 | face = 'plain', 58 | colour = 'gray30', 59 | hjust = 0.5, 60 | vjust = 1, 61 | angle = 0, 62 | lineheight = 1.1 63 | ), class = 'element_text'), 64 | axis.text.y = structure(list( 65 | family = 'sans', 66 | size = 10, 67 | face = 'plain', 68 | colour = 'gray30', 69 | hjust = 1, 70 | vjust = 0.5, 71 | angle = 0, 72 | lineheight = 1.1 73 | ), class = 'element_text'), 74 | axis.line = structure(list( 75 | colour = 'black', 76 | size = 1, 77 | linetype = 'blank' 78 | ), class = 'element_line'), 79 | axis.ticks = structure(list( 80 | colour = 'gray20', 81 | size = 0.5, 82 | linetype = 'solid' 83 | ), class = 'element_line'), 84 | axis.title = structure(list( 85 | family = 'sans', 86 | size = 11, 87 | face = 'plain', 88 | colour = 'black', 89 | hjust = 0.5, 90 | vjust = 0.5, 91 | angle = 0, 92 | lineheight = 1.1 93 | ), class = 'element_text'), 94 | plot.title = structure(list( 95 | family = 'sans', 96 | size = 13, 97 | face = 'plain', 98 | colour = 'black', 99 | hjust = if (any(names(formals(ggtitle)) == 'subtitle')) {0} else {0.5}, 100 | vjust = 0.5, 101 | angle = 0, 102 | lineheight = 1.1 103 | ), class = 'element_text'), 104 | panel.background = structure(list( 105 | fill = 'gray92', 106 | colour = 'NA', 107 | size = 0.5, 108 | linetype = 'blank' 109 | ), class = 'element_rect'), 110 | plot.background = structure(list( 111 | fill = 'NA', 112 | colour = 'white', 113 | size = 0.5, 114 | linetype = 'blank' 115 | ), class = 'element_rect'), 116 | strip.background = structure(list( 117 | fill = 'NA', 118 | colour = 'white', 119 | size = 0.5, 120 | linetype = 'blank' 121 | ), class = 'element_rect'), 122 | strip.text = structure(list( 123 | family = 'sans', 124 | size = 10, 125 | face = 'plain', 126 | colour = 'gray30', 127 | hjust = 0.5, 128 | vjust = 1, 129 | angle = 0, 130 | lineheight = 1.1 131 | ), class = 'element_text'), 132 | panel.grid.major = structure(list( 133 | colour = 'gray100', 134 | size = 0.5, 135 | linetype = 'solid' 136 | ), class = 'element_line'), 137 | panel.grid.minor = structure(list( 138 | colour = 'gray100', 139 | size = 0.5, 140 | linetype = 'solid' 141 | ), class = 'element_line'), 142 | legend.text = structure(list( 143 | size = 10, 144 | face = 'plain', 145 | family = 'sans', 146 | colour = 'black' 147 | ), class = 'element_text'), 148 | legend.title = structure(list( 149 | size = 10, 150 | face = 'plain', 151 | family = 'sans', 152 | colour = 'black' 153 | ), class = 'element_text'), 154 | legend.background = structure(list( 155 | fill = 'gray100', 156 | colour = 'NA', 157 | size = 0.5, 158 | linetype = 'blank' 159 | ), class = 'element_rect'), 160 | legend.key = structure(list( 161 | fill = 'gray95', 162 | colour = 'NA', 163 | size = 0.5, 164 | linetype = 'blank' 165 | ), class = 'element_rect'), 166 | legend.position = 'right', 167 | legend.position.x = 0.5, 168 | legend.position.y = 0.5, 169 | legend.direction = 'vertical', 170 | labs = list( 171 | title = '', 172 | x = '', 173 | y = '', 174 | colour = '', 175 | fill = '', 176 | size = '', 177 | linetype = '', 178 | shape = '', 179 | alpha = '', 180 | subtitle = '', 181 | caption = '' 182 | ) 183 | ) 184 | 185 | AvailableElements <- list( 186 | plot.subtitle = list( 187 | name = 'plot.subtitle', 188 | type = 'element_text', 189 | enabled = TRUE 190 | ), 191 | plot.caption = list( 192 | name = 'plot.caption', 193 | type = 'element_text', 194 | enabled = TRUE 195 | ), 196 | axis.line = list( 197 | name = 'axis.line', 198 | type = 'element_line', 199 | enabled = TRUE 200 | ), 201 | axis.ticks = list( 202 | name = 'axis.ticks', 203 | type = 'element_line', 204 | enabled = TRUE 205 | ), 206 | panel.grid.major = list( 207 | name = 'panel.grid.major', 208 | type = 'element_line', 209 | enabled = TRUE 210 | ), 211 | panel.grid.minor = list( 212 | name = 'panel.grid.minor', 213 | type = 'element_line', 214 | enabled = TRUE 215 | ), 216 | axis.title = list( 217 | name = 'axis.title', 218 | type = 'element_text', 219 | enabled = TRUE 220 | ), 221 | axis.text = list( 222 | name = 'axis.text', 223 | type = 'element_text', 224 | enabled = TRUE 225 | ), 226 | axis.text.x = list( 227 | name = 'axis.text.x', 228 | type = 'element_text', 229 | enabled = TRUE 230 | ), 231 | axis.text.y = list( 232 | name = 'axis.text.y', 233 | type = 'element_text', 234 | enabled = TRUE 235 | ), 236 | plot.title = list( 237 | name = 'plot.title', 238 | type = 'element_text', 239 | enabled = TRUE 240 | ), 241 | legend.text = list( 242 | name = 'legend.text', 243 | type = 'element_text', 244 | enabled = TRUE 245 | ), 246 | legend.title = list( 247 | name = 'legend.title', 248 | type = 'element_text', 249 | enabled = TRUE 250 | ), 251 | panel.background = list( 252 | name = 'panel.background', 253 | type = 'element_rect', 254 | enabled = TRUE 255 | ), 256 | plot.background = list( 257 | name = 'plot.background', 258 | type = 'element_rect', 259 | enabled = TRUE 260 | ), 261 | strip.background = list( 262 | name = 'strip.background', 263 | type = 'element_rect', 264 | enabled = TRUE 265 | ), 266 | strip.text = list( 267 | name = 'strip.text', 268 | type = 'element_text', 269 | enabled = TRUE 270 | ), 271 | legend.key = list( 272 | name = 'legend.key', 273 | type = 'element_rect', 274 | enabled = TRUE 275 | ), 276 | legend.background = list( 277 | name = 'legend.background', 278 | type = 'element_rect', 279 | enabled = TRUE 280 | ), 281 | legend.position = list( 282 | name = 'legend.position', 283 | type = '', 284 | enabled = TRUE 285 | ), 286 | legend.direction = list( 287 | name = 'legend.direction', 288 | type = '', 289 | enabled = TRUE 290 | ) 291 | ) 292 | -------------------------------------------------------------------------------- /R/ggThemeAssist.R: -------------------------------------------------------------------------------- 1 | #' ggThemeAssist 2 | #' 3 | #' \code{ggThemeAssist} is a RStudio-Addin that delivers a graphical interface for editing ggplot2 theme elements. 4 | #' 5 | #' @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. 6 | #' @param plot A ggplot2 plot object to manipulate its theme. 7 | #' @examples 8 | #' \dontrun{ 9 | #' # example for ggThemeAssist command line usage. 10 | #' library(ggplot2) 11 | #' gg <- ggplot(mtcars, aes(x = hp, y = mpg, colour = as.factor(cyl))) + geom_point() 12 | #' ggThemeAssistGadget(gg) 13 | #' } 14 | #' @return \code{ggThemeAssist} returns a character vector. 15 | #' @import miniUI 16 | #' @import shiny 17 | #' @import ggplot2 18 | #' @import formatR 19 | #' @import rstudioapi 20 | #' @importFrom grDevices col2rgb 21 | #' @name ggThemeAssist 22 | NULL 23 | 24 | ggThemeAssist <- function(text){ 25 | 26 | SubtitlesSupport <- any(names(formals(ggtitle)) == 'subtitle') 27 | 28 | if (grepl('^\\s*[[:alpha:]]+[[:alnum:]\\.]*\\s*$', paste0(text, collapse = ''))) { 29 | text <- gsub('\\s+', '', text) 30 | if (any(ls(envir = .GlobalEnv) == text)) { 31 | gg_original <- get(text, envir = .GlobalEnv) 32 | allowOneline <- TRUE 33 | } else { 34 | stop(paste0('I\'m sorry, I couldn\'t find object', text, '.')) 35 | } 36 | } else { 37 | gg_original <- try(eval(parse(text = text)), silent = TRUE) 38 | allowOneline <- FALSE 39 | if(class(gg_original)[1] == 'try-error') { 40 | stop(paste0('I\'m sorry, I was unable to parse the string you gave to me.\n', gg_original)) 41 | } 42 | } 43 | 44 | if (!is.ggplot(gg_original)) { 45 | stop('No ggplot2 object has been selected. Fool someone else!') 46 | } 47 | 48 | # add rgb colours to the available colours 49 | colours.available <- c(colours.available, getRGBHexColours(gg_original)) 50 | default <- updateDefaults(gg_original, default, linetypes = linetypes) 51 | 52 | ui <- miniPage( 53 | tags$script(jscodeWidth), 54 | tags$script(jscodeHeight), 55 | tags$style(type = "text/css", ".selectize-dropdown{ width: 200px !important; }"), 56 | 57 | gadgetTitleBar("ggplot Theme Assistant"), 58 | miniTabstripPanel(selected = 'Panel & Background', 59 | miniTabPanel("Settings", icon = icon('sliders'), 60 | plotOutput("ThePlot5", width = '100%', height = '45%'), 61 | miniContentPanel(scrollable = TRUE, 62 | fillRow(height = heading.height, width = '100%', 63 | headingOutput('Plot dimensions') 64 | ), 65 | fillRow(height = line.height, width = '100%', 66 | numericInput('plot.width', label = 'Width', min = 0, max = 10, step = 1, value = 10), 67 | numericInput('plot.height', label = 'Height', min = 0, max = 10, step = 1, value = 5) 68 | ), 69 | fillRow(height = heading.height, width = '100%', 70 | headingOutput("General options")), 71 | fillRow(height = heading.height, width = '100%', 72 | tags$div( 73 | title = 'If enabled, formatR will be used. Set options(ggThemeAssist.formatR = FALSE) to disable it permanently.', 74 | checkboxInput('formatR', 'Use FormatR', value = getOption("ggThemeAssist.formatR", default = TRUE)) 75 | ), 76 | if (allowOneline) { 77 | tags$div( 78 | title = 'If multiline support is enabled, a theme function is returned for each element. To set this option permanently set options(ggThemeAssist.multiline = TRUE).', 79 | checkboxInput('multiline', 'Multiline results', value = getOption("ggThemeAssist.multiline", default = FALSE)) 80 | ) 81 | } 82 | ) 83 | ) 84 | ), 85 | miniTabPanel("Panel & Background", icon = icon('sliders'), 86 | plotOutput("ThePlot2", width = '100%', height = '45%'), 87 | miniContentPanel(scrollable = TRUE, 88 | fillRow(height = heading.height, width = '100%', 89 | headingOutput('Plot Background'), 90 | headingOutput('Panel Background'), 91 | headingOutput('Grid Major'), 92 | headingOutput('Grid Minor') 93 | ), 94 | fillRow(height = line.height, width = '100%', 95 | selectizeInput('plot.background.fill', label = 'Fill', choices = NULL, width = input.width), 96 | selectizeInput('panel.background.fill', label = 'Fill', choices = NULL, width = input.width), 97 | "", 98 | "" 99 | ), 100 | fillRow(height = line.height, width = '100%', 101 | selectInput('plot.background.linetype', label = 'Type', choices = linetypes, selected = default$plot.background$linetype, width = input.width), 102 | selectInput('panel.background.linetype', label = 'Type', choices = linetypes, selected = default$panel.background$linetype, width = input.width), 103 | selectInput('panel.grid.major.type', label = 'Type', choices = linetypes, selected = default$panel.grid.major$linetype, width = input.width), 104 | selectInput('panel.grid.minor.type', label = 'Type', choices = linetypes, selected = default$panel.grid.minor$linetype, width = input.width) 105 | ), 106 | fillRow(height = line.height, width = '100%', 107 | numericInput('plot.background.size', label = 'Size', step = 0.1, value = default$plot.background$size, width = input.width), 108 | numericInput('panel.background.size', label = 'Size', step = 0.1, value = default$panel.background$size, width = input.width), 109 | numericInput('panel.grid.major.size', label = 'Size', step = 0.1, value = default$panel.grid.major$size, min = 0, width = input.width), 110 | numericInput('panel.grid.minor.size', label = 'Size', step = 0.1, value = default$panel.grid.minor$size, min = 0, width = input.width) 111 | ), 112 | fillRow(height = line.height, width = '100%', 113 | selectizeInput('plot.background.colour', label = 'Colour', choices = NULL, width = input.width), 114 | selectizeInput('panel.background.colour', label = 'Colour', choices = NULL, width = input.width), 115 | selectizeInput('panel.grid.major.colour', label = 'Colour', choices = NULL, width = input.width), 116 | selectizeInput('panel.grid.minor.colour', label = 'Colour', choices = NULL, width = input.width) 117 | ) 118 | ) 119 | ), 120 | miniTabPanel("Axis", icon = icon('sliders'), 121 | plotOutput("ThePlot", width = '100%', height = '45%'), 122 | miniContentPanel(scrollable = TRUE, 123 | fillRow(height = heading.height, width = '100%', 124 | headingOutput('Axis text'), 125 | headingOutput('Axis text.x'), 126 | headingOutput('Axis text.y'), 127 | headingOutput('Axis line'), 128 | headingOutput('Axis ticks') 129 | ), 130 | fillRow(height = line.height, width = '100%', 131 | selectInput('axis.text.family', label = 'Family', choices = text.families, selected = default$axis.text$family, width = input.width), 132 | selectInput('axis.text.x.family', label = 'Family', choices = c('None' = 'NULL', text.families), selected = NULL, width = input.width), 133 | selectInput('axis.text.y.family', label = 'Family', choices = c('None' = 'NULL', text.families), selected = NULL, width = input.width), 134 | selectInput('axis.line.type', label = 'Type', choices = linetypes, selected = default$axis.line$linetype, width = input.width), 135 | selectInput('axis.ticks.type', label = 'Type', choices = linetypes, selected = default$axis.ticks$linetype, width = input.width) 136 | ), 137 | fillRow(height = line.height, width = '100%', 138 | selectInput('axis.text.face', label = 'Face', choices = text.faces, width = input.width, selected = default$axis.text$face), 139 | selectInput('axis.text.x.face', label = 'Face', choices = c('None' = 'NULL', text.faces), width = input.width, selected = NULL), 140 | selectInput('axis.text.y.face', label = 'Face', choices = c('None' = 'NULL', text.faces), width = input.width, selected = NULL), 141 | numericInput('axis.line.size', label = 'Size', step = 0.1, value = default$axis.line$size, min = 0,width = input.width), 142 | numericInput('axis.ticks.size', label = 'Size', step = 0.1, value = default$axis.ticks$size, min = 0,width = input.width) 143 | ), 144 | fillRow(height = line.height, width = '100%', 145 | numericInput('axis.text.size', label = 'Size', min = 1, max = 30, value = default$axis.text$size, step = 1, width = input.width), 146 | numericInput('axis.text.x.size', label = 'Size', min = 1, max = 30, value = NULL, step = 1, width = input.width), 147 | numericInput('axis.text.y.size', label = 'Size', min = 1, max = 30, value = NULL, step = 1, width = input.width), 148 | selectizeInput('axis.line.colour', label = 'Colour', choices = NULL, width = input.width), 149 | selectizeInput('axis.ticks.colour', label = 'Colour', choices = NULL, width = input.width) 150 | ), 151 | fillRow(height = line.height, width = '100%', 152 | selectizeInput('axis.text.colour', label = 'Colour', choices = NULL, width = input.width), 153 | selectizeInput('axis.text.x.colour', label = 'Colour', choices = NULL, width = input.width), 154 | selectizeInput('axis.text.y.colour', label = 'Colour', choices = NULL, width = input.width), 155 | "", 156 | "" 157 | ), 158 | fillRow(height = line.height, width = '100%', 159 | numericInput('axis.text.hjust', 'Hjust', value = default$axis.text$hjust, step = 0.25, width = input.width), 160 | numericInput('axis.text.hjust.x', 'Hjust', value = NULL, step = 0.25, width = input.width), 161 | numericInput('axis.text.hjust.y', 'Hjust', value = NULL, step = 0.25, width = input.width), 162 | "", 163 | "" 164 | ), 165 | fillRow(height = line.height, width = '100%', 166 | numericInput('axis.text.vjust', 'Vjust', value = default$axis.text$vjust, step = 0.25, width = input.width), 167 | numericInput('axis.text.x.vjust', 'Vjust', value = NULL, step = 0.25, width = input.width), 168 | numericInput('axis.text.y.vjust', 'Vjust', value = NULL, step = 0.25, width = input.width), 169 | "", 170 | "" 171 | ), 172 | fillRow(height = line.height, width = '100%', 173 | numericInput('axis.text.angle', label = 'Angle', min = -180, max = 180, value = default$axis.text$angle, step = 5, width = input.width), 174 | numericInput('axis.text.x.angle', label = 'Angle', min = -180, max = 180, value = NULL, step = 5, width = input.width), 175 | numericInput('axis.text.y.angle', label = 'Angle', min = -180, max = 180, value = NULL, step = 5, width = input.width), 176 | "", 177 | "" 178 | ) 179 | )), 180 | miniTabPanel("Title, Label & Facet", icon = icon('sliders'), 181 | plotOutput("ThePlot4", width = '100%', height = '45%'), 182 | miniContentPanel(scrollable = TRUE, 183 | fillRow(height = heading.height, width = '100%', 184 | headingOutput('Labels'), 185 | headingOutput('Plot Title'), 186 | headingOutput('Axis Labels'), 187 | headingOutput('Facets Background'), 188 | headingOutput('Facets Text') 189 | ), 190 | fillRow(height = line.height, width = '100%', 191 | textInput('plot.title', label = 'Title', value = preserveNewlines(gg_original$labels$title), width = input.width), 192 | selectInput('plot.title.family', label = 'Family', choices = text.families, selected = default$plot.title$family, width = input.width), 193 | selectInput('axis.title.family', label = 'Family', choices = text.families, selected = default$axis.title$family, width = input.width), 194 | selectizeInput('strip.background.fill', label = 'Fill', choices = NULL, width = input.width), 195 | selectInput('strip.text.family', label = 'Family', choices = text.families, selected = default$strip.text$family, width = input.width) 196 | ), 197 | fillRow(height = line.height, width = '100%', 198 | textInput('axis.title.x', label = 'x-Axis label', value = preserveNewlines(gg_original$labels$x), width = input.width), 199 | selectInput('plot.title.face', label = 'Face', choices = text.faces, width = input.width, selected = default$plot.title$face), 200 | selectInput('axis.title.face', label = 'Face', choices = text.faces, width = input.width, selected = default$axis.title$face), 201 | selectInput('strip.background.linetype', label = 'Type', choices = linetypes, selected = default$strip.background$linetype, width = input.width), 202 | selectInput('strip.text.face', label = 'Face', choices = text.faces, width = input.width, selected = default$strip.text$face) 203 | ), 204 | fillRow(height = line.height, width = '100%', 205 | textInput('axis.title.y', label = 'y-Axis label', value = preserveNewlines(gg_original$labels$y), width = input.width), 206 | numericInput('plot.title.size', label = 'Size', min = 1, max = 30, value = default$plot.title$size, step = 1, width = input.width), 207 | numericInput('axis.title.size', label = 'Size', min = 1, max = 30, value = default$axis.title$size, step = 1, width = input.width), 208 | numericInput('strip.background.size', label = 'Size', step = 0.1, value = default$strip.background$size, width = input.width), 209 | numericInput('strip.text.size', label = 'Size', min = 1, max = 30, value = default$strip.text$size, step = 1, width = input.width) 210 | ), 211 | fillRow(height = line.height, width = '100%', 212 | textInput('legend.colour.title', label = 'Colour', value = preserveNewlines(gg_original$labels$colour), width = input.width), 213 | selectizeInput('plot.title.colour', label = 'Colour', choices = NULL, width = input.width), 214 | selectizeInput('axis.title.colour', label = 'Colour', choices = NULL, width = input.width), 215 | selectizeInput('strip.background.colour', label = 'Colour', choices = NULL, width = input.width), 216 | selectizeInput('strip.text.colour', label = 'Colour', choices = NULL, width = input.width) 217 | ), 218 | fillRow(height = line.height, width = '100%', 219 | textInput('legend.fill.title', label = 'Fill label', value = preserveNewlines(gg_original$labels$fill), width = input.width), 220 | numericInput('plot.title.hjust', 'Hjust', value = default$plot.title$hjust, step = 0.25, width = input.width), 221 | numericInput('axis.title.hjust', 'Hjust', value = default$axis.title$hjust, step = 0.25, width = input.width), 222 | '', 223 | numericInput('strip.text.hjust', 'Hjust', value = default$strip.text$hjust, step = 0.25, width = input.width) 224 | 225 | ), 226 | fillRow(height = line.height, width = '100%', 227 | textInput('legend.size.title', label = 'Size label', value = preserveNewlines(gg_original$labels$size), width = input.width), 228 | numericInput('plot.title.vjust', 'Vjust', value = default$plot.title$vjust, step = 0.25, width = input.width), 229 | numericInput('axis.title.vjust', 'Vjust', value = default$axis.title$vjust, step = 0.25, width = input.width), 230 | '', 231 | numericInput('strip.text.vjust', 'Vjust', value = default$strip.text$vjust, step = 0.25, width = input.width) 232 | 233 | ), 234 | fillRow(height = line.height, width = '100%', 235 | textInput('legend.alpha.title', label = 'Alpha label', value = preserveNewlines(gg_original$labels$alpha), width = input.width), 236 | numericInput('plot.title.angle', label = 'Angle', min = -180, max = 180, value = default$plot.title$angle, step = 5, width = input.width), 237 | numericInput('axis.title.angle', label = 'Angle', min = -180, max = 180, value = default$axis.title$angle, step = 5, width = input.width), 238 | '', 239 | numericInput('strip.text.angle', label = 'Angle', min = -180, max = 180, value = default$strip.text$angle, step = 5, width = input.width) 240 | ), 241 | fillRow(height = line.height, width = '33%', 242 | textInput('legend.linetype.title', label = 'Linetype label', value = preserveNewlines(gg_original$labels$linetype), width = input.width) 243 | ), 244 | fillRow(height = line.height, width = '33%', 245 | textInput('legend.shape.title', label = 'Shape label', value = preserveNewlines(gg_original$labels$shape), width = input.width) 246 | ) 247 | 248 | 249 | ) 250 | ), 251 | miniTabPanel("Legend", icon = icon('sliders'), 252 | plotOutput("ThePlot3", width = '100%', height = '45%', click = 'legend.click'), 253 | miniContentPanel(scrollable = TRUE, 254 | fillRow(height = heading.height, width = '100%', 255 | headingOutput('Legend position'), 256 | headingOutput('Legend Title'), 257 | headingOutput('Legend Text'), 258 | headingOutput("Legend Background"), 259 | headingOutput("Legend Keys") 260 | ), 261 | fillRow(height = line.height, width = '100%', 262 | selectInput('legend.position', label = 'Position', choices = legend.positions, selected = default$legend.position, width = input.width), 263 | selectInput('legend.title.family', label = 'Family', choices = text.families, selected = default$legend.title$family, width = input.width), 264 | selectInput('legend.text.family', label = 'Family', choices = text.families, selected = default$legend.text$family, width = input.width), 265 | selectizeInput('legend.background.fill', label = 'Fill', choices = NULL, width = input.width), 266 | selectizeInput('legend.key.fill', label = 'Fill', choices = NULL, width = input.width) 267 | ), 268 | fillRow(height = line.height, width = '100%', 269 | selectInput('legend.direction', label = 'Direction', choices = legend.directions, selected = default$legend.direction, width = input.width), 270 | selectInput('legend.title.face', label = 'Face', choices = text.faces, selected = default$legend.title$face, width = input.width), 271 | selectInput('legend.text.face', label = 'Face', choices = text.faces, selected = default$legend.text$face, width = input.width), 272 | selectInput('legend.background.linetype', label = 'Type', choices = linetypes, selected = default$legend.background$linetype, width = input.width), 273 | selectInput('legend.key.linetype', label = 'Type', choices = linetypes, selected = default$legend.key$linetype, width = input.width) 274 | ), 275 | fillRow(height = line.height, width = '100%', 276 | conditionalPanel( 277 | condition = "input['legend.position'] == 'XY'", 278 | numericInput('legend.position.x', label = 'X Coord', min = 0, max = 1, value = default$legend.position.x, step = 0.01, width = input.width) 279 | ), 280 | numericInput('legend.title.size', label = 'Size', min = 1, max = 30, value = default$legend.title$size, step = 1, width = input.width), 281 | numericInput('legend.text.size', label = 'Size', min = 1, max = 30, value = default$legend.text$size, step = 1, width = input.width), 282 | numericInput('legend.background.size', label = 'Size', step = 0.1, value = default$legend.background$size, width = input.width), 283 | numericInput('legend.key.size', label = 'Size', step = 0.1, value = default$legend.key$size, width = input.width) 284 | ), 285 | fillRow(height = line.height, width = '100%', 286 | conditionalPanel( 287 | condition = "input['legend.position'] == 'XY'", 288 | numericInput('legend.position.y', label = 'Y Coord', min = 0, max = 1, value = default$legend.position.y, step = 0.01, width = input.width) 289 | ), 290 | selectizeInput('legend.title.colour', label = 'Colour', choices = NULL, width = input.width), 291 | selectizeInput('legend.text.colour', label = 'Colour', choices = NULL, width = input.width), 292 | selectizeInput('legend.background.colour', label = 'Colour', choices = NULL, width = input.width), 293 | selectizeInput('legend.key.colour', label = 'Colour', choices = NULL, width = input.width) 294 | ) 295 | ) 296 | ), 297 | if (SubtitlesSupport) { 298 | miniTabPanel("Subtitle and Caption", icon = icon('sliders'), 299 | plotOutput("ThePlot6", width = '100%', height = '45%'), 300 | miniContentPanel(scrollable = TRUE, 301 | fillRow(width = '100%', height = heading.height, 302 | headingOutput('Subtitle') 303 | ), 304 | fillRow(width = '100%', height = line.height, 305 | tags$div(style="display:table; width:100%; margin:auto", 306 | tags$textarea(id="plot.subtitle.text", label="Subtitle", 307 | rows=3, cols=80, gg_original$labels$subtitle, 308 | style="width:inherit; font-size:9pt; padding:5px" 309 | ) 310 | ) 311 | ), 312 | fillRow(width = '100%', height = line.height, 313 | selectInput('plot.subtitle.family', label = 'Family', choices = text.families, selected = default$plot.subtitle$family, width = input.width2), 314 | selectInput('plot.subtitle.face', label = 'Face', choices = text.faces, width = input.width2, selected = default$plot.subtitle$face), 315 | numericInput('plot.subtitle.size', label = 'Size', min = 1, max = 30, value = default$plot.subtitle$size, step = 1, width = input.width2), 316 | selectizeInput('plot.subtitle.colour', label = 'Colour', choices = colours.available, selected = default$plot.subtitle$colour, width = input.width2, options = list(create = TRUE)), 317 | numericInput('plot.subtitle.hjust', 'Hjust', value = default$plot.subtitle$hjust, step = 0.25, width = input.width2) 318 | ), 319 | fillRow(width = '100%', height = heading.height, 320 | headingOutput('Caption') 321 | ), 322 | fillRow(width = '100%', height = line.height, 323 | tags$div(style="display:table; width:100%; margin:auto", 324 | tags$textarea(id="plot.caption.text", label="Subtitle", 325 | rows=3, cols=80, gg_original$labels$caption, 326 | style="width:inherit; font-size:9pt; padding:5px" 327 | ) 328 | ) 329 | ), 330 | fillRow(width = '100%', height = line.height, 331 | selectInput('plot.caption.family', label = 'Family', choices = text.families, selected = default$plot.caption$family, width = input.width2), 332 | selectInput('plot.caption.face', label = 'Face', choices = text.faces, width = input.width2, selected = default$plot.caption$face), 333 | numericInput('plot.caption.size', label = 'Size', min = 1, max = 30, value = default$plot.caption$size, step = 1, width = input.width2), 334 | selectizeInput('plot.caption.colour', label = 'Colour', choices = colours.available, selected = default$plot.caption$colour, width = input.width2, options = list(create = TRUE)), 335 | numericInput('plot.caption.hjust', 'Hjust', value = default$plot.caption$hjust, step = 0.25, width = input.width2) 336 | ) 337 | 338 | 339 | ) 340 | ) 341 | } 342 | )) 343 | 344 | 345 | 346 | server <- function(input, output, session) { 347 | 348 | colour.choices <- colours2RGB(colours.available) 349 | 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)) 350 | 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)) 351 | 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)) 352 | 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)) 353 | 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)) 354 | 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)) 355 | 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)) 356 | 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)) 357 | 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)) 358 | 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)) 359 | 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)) 360 | 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)) 361 | 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)) 362 | 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)) 363 | 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)) 364 | 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)) 365 | 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)) 366 | 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)) 367 | 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)) 368 | 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)) 369 | 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)) 370 | updateSelectizeInput(session = session, inputId = 'strip.background.fill', choices = colour.choices, selected = NA2text(default$strip.background$fill), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector)) 371 | updateSelectizeInput(session = session, inputId = 'strip.background.colour', choices = colour.choices, selected = NA2text(default$strip.background$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector)) 372 | updateSelectizeInput(session = session, inputId = 'strip.text.colour', choices = colour.choices, selected = NA2text(default$strip.text$colour), server = TRUE, options = list(create = TRUE, labelField = 'name', searchField = 'colour', valueField = 'colour', render = jsColourSelector)) 373 | if (SubtitlesSupport) { 374 | 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)) 375 | 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)) 376 | } 377 | 378 | gg_reactive <- reactive({ 379 | validate( 380 | need(is.validColour(input$plot.background.fill), ''), 381 | need(is.validColour(input$panel.background.fill), ''), 382 | need(is.validColour(input$plot.background.colour), ''), 383 | need(is.validColour(input$panel.background.colour), ''), 384 | need(is.validColour(input$panel.grid.major.colour), ''), 385 | need(is.validColour(input$panel.grid.minor.colour), ''), 386 | need(is.validColour(input$axis.line.colour), ''), 387 | need(is.validColour(input$axis.ticks.colour), ''), 388 | need(is.validColour(input$axis.text.colour), ''), 389 | need(is.validColour(input$axis.text.x.colour), ''), 390 | need(is.validColour(input$axis.text.y.colour), ''), 391 | need(is.validColour(input$plot.title.colour), ''), 392 | need(is.validColour(input$axis.title.colour), ''), 393 | need(is.validColour(input$legend.background.fill), ''), 394 | need(is.validColour(input$legend.key.fill), ''), 395 | need(is.validColour(input$legend.title.colour), ''), 396 | need(is.validColour(input$legend.text.colour), ''), 397 | need(is.validColour(input$legend.background.colour), ''), 398 | need(is.validColour(input$legend.key.colour), ''), 399 | need(is.validColour(input$strip.background.fill), ''), 400 | need(is.validColour(input$strip.background.colour), ''), 401 | need(is.validColour(input$strip.text.colour), '') 402 | ) 403 | if (SubtitlesSupport) { 404 | validate( 405 | need(is.validColour(input$plot.subtitle.colour), ''), 406 | need(is.validColour(input$plot.caption.colour), '') 407 | ) 408 | } 409 | 410 | gg <- gg_original + 411 | labs( 412 | title = checkInputText(input$plot.title), 413 | x = checkInputText(input$axis.title.x), 414 | y = checkInputText(input$axis.title.y), 415 | fill = checkInputText(input$legend.fill.title), 416 | linetype = checkInputText(input$legend.linetype.title), 417 | alpha = checkInputText(input$legend.alpha.title), 418 | size = checkInputText(input$legend.size.title), 419 | shape = checkInputText(input$legend.shape.title), 420 | colour = checkInputText(input$legend.colour.title) 421 | ) + 422 | theme( 423 | axis.text = element_text( 424 | size = input$axis.text.size, 425 | colour = input$axis.text.colour, 426 | face = input$axis.text.face, 427 | family = input$axis.text.family, 428 | angle = input$axis.text.angle, 429 | hjust = input$axis.text.hjust, 430 | vjust = input$axis.text.vjust, 431 | lineheight = input$axis.text.lineheight), 432 | axis.text.x = element_text( 433 | size = setNull(input$axis.text.x.size), 434 | colour = setNull(input$axis.text.x.colour), 435 | family = setNull(input$axis.text.x.family), 436 | angle = setNull(input$axis.text.x.angle), 437 | hjust = setNull(input$axis.text.x.hjust), 438 | vjust = setNull(input$axis.text.x.vjust) 439 | ), 440 | axis.text.y = element_text( 441 | size = setNull(input$axis.text.y.size), 442 | colour = setNull(input$axis.text.y.colour), 443 | family = setNull(input$axis.text.y.family), 444 | angle = setNull(input$axis.text.y.angle), 445 | hjust = setNull(input$axis.text.y.hjust), 446 | vjust = setNull(input$axis.text.y.vjust) 447 | ), 448 | axis.line = element_line( 449 | linetype = input$axis.line.type, 450 | colour = input$axis.line.colour, 451 | size = input$axis.line.size), 452 | axis.ticks = element_line( 453 | linetype = input$axis.ticks.type, 454 | colour = input$axis.ticks.colour, 455 | size = input$axis.ticks.size), 456 | axis.title = element_text( 457 | size = input$axis.title.size, 458 | colour = input$axis.title.colour, 459 | face = input$axis.title.face, 460 | family = input$axis.title.family, 461 | angle = input$axis.title.angle, 462 | hjust = input$axis.title.hjust, 463 | vjust = input$axis.title.vjust, 464 | lineheight = input$axis.title.lineheight), 465 | plot.title = element_text( 466 | size = input$plot.title.size, 467 | colour = input$plot.title.colour, 468 | face = input$plot.title.face, 469 | family = input$plot.title.family, 470 | angle = input$plot.title.angle, 471 | hjust = input$plot.title.hjust, 472 | vjust = input$plot.title.vjust, 473 | lineheight = input$plot.title.lineheight), 474 | plot.background = element_rect( 475 | fill = input$plot.background.fill, 476 | colour = input$plot.background.colour, 477 | size = input$plot.background.size, 478 | linetype = input$plot.background.linetype 479 | ), 480 | panel.background = element_rect( 481 | fill = input$panel.background.fill, 482 | colour = input$panel.background.colour, 483 | size = input$panel.background.size, 484 | linetype = input$panel.background.linetype 485 | ), 486 | strip.background = element_rect( 487 | fill = input$strip.background.fill, 488 | colour = input$strip.background.colour, 489 | size = input$strip.background.size, 490 | linetype = input$strip.background.linetype 491 | ), 492 | strip.text = element_text( 493 | size = input$strip.text.size, 494 | colour = input$strip.text.colour, 495 | face = input$strip.text.face, 496 | family = input$strip.text.family, 497 | angle = input$strip.text.angle, 498 | hjust = input$strip.text.hjust, 499 | vjust = input$strip.text.vjust), 500 | panel.grid.major = element_line( 501 | linetype = input$panel.grid.major.type, 502 | colour = input$panel.grid.major.colour, 503 | size = input$panel.grid.major.size), 504 | panel.grid.minor = element_line( 505 | linetype = input$panel.grid.minor.type, 506 | colour = input$panel.grid.minor.colour, 507 | size = input$panel.grid.minor.size), 508 | legend.text = element_text( 509 | size = input$legend.text.size, 510 | face = input$legend.text.face, 511 | colour = input$legend.text.colour, 512 | family = input$legend.text.family 513 | ), 514 | legend.title = element_text( 515 | size = input$legend.title.size, 516 | face = input$legend.title.face, 517 | colour = input$legend.title.colour, 518 | family = input$legend.title.family 519 | ), 520 | legend.background = element_rect( 521 | fill = input$legend.background.fill, 522 | colour = input$legend.background.colour, 523 | size = input$legend.background.size, 524 | linetype = input$legend.background.linetype 525 | ), 526 | legend.key = element_rect( 527 | fill = input$legend.key.fill, 528 | colour = input$legend.key.colour, 529 | size = input$legend.key.size, 530 | linetype = input$legend.key.linetype 531 | ), 532 | legend.position = (if (input$legend.position == 'XY') { 533 | c(input$legend.position.x, input$legend.position.y) 534 | } else { 535 | input$legend.position 536 | }), 537 | legend.direction = input$legend.direction 538 | ) 539 | if (SubtitlesSupport) { 540 | gg <- gg + labs( 541 | subtitle = if (input$plot.subtitle.text == '') {NULL} else {input$plot.subtitle.text}, 542 | caption = if (input$plot.caption.text == '') {NULL} else {input$plot.caption.text} 543 | ) + 544 | theme( 545 | plot.subtitle = element_text( 546 | size = input$plot.subtitle.size, 547 | colour = input$plot.subtitle.colour, 548 | face = input$plot.subtitle.face, 549 | family = input$plot.subtitle.family, 550 | #angle = input$plot.subtitle.angle, 551 | hjust = input$plot.subtitle.hjust, 552 | #vjust = input$plot.subtitle.vjust, 553 | lineheight = input$plot.subtitle.lineheight), 554 | plot.caption = element_text( 555 | size = input$plot.caption.size, 556 | colour = input$plot.caption.colour, 557 | face = input$plot.caption.face, 558 | family = input$plot.caption.family, 559 | #angle = input$plot.caption.angle, 560 | hjust = input$plot.caption.hjust, 561 | #vjust = input$plot.caption.vjust, 562 | lineheight = input$plot.caption.lineheight) 563 | ) 564 | } 565 | 566 | return(gg) 567 | 568 | }) 569 | 570 | observeEvent(input$legend.click, { 571 | x.click <- input$legend.click$x / (input$legend.click$domain$right - input$legend.click$domain$left) 572 | y.click <- input$legend.click$y / (input$legend.click$domain$top - input$legend.click$domain$bottom) 573 | if (hasLegend(gg_original)) { 574 | updateSelectInput(session, 'legend.position', selected = 'XY') 575 | updateSelectInput(session, 'legend.position.x', selected = round(x.click, 4)) 576 | updateSelectInput(session, 'legend.position.y', selected = round(y.click, 4)) 577 | } 578 | }) 579 | 580 | ThePlot <- renderPlot(width = function() { 581 | validate( 582 | need(is.numeric(input$plot.width), ''), 583 | need(is.numeric(input$plot.height), ''), 584 | need(!is.null(input$ViewerWidth), ''), 585 | need(is.validColour(input$legend.key.colour), '') 586 | ) 587 | min(input$plot.width / input$plot.height * input$ViewerWidth * 45 / 100, 588 | input$ViewerWidth 589 | ) 590 | }, 591 | { 592 | gg_reactive() 593 | 594 | }) 595 | output$ThePlot <- ThePlot 596 | output$ThePlot2 <- ThePlot 597 | output$ThePlot3 <- ThePlot 598 | output$ThePlot4 <- ThePlot 599 | output$ThePlot5 <- ThePlot 600 | output$ThePlot6 <- ThePlot 601 | 602 | observeEvent(input$done, { 603 | themeResult <- sapply(AvailableElements, compileResults, new = gg_reactive(), original = gg_original, std = default, USE.NAMES = FALSE) 604 | themeResult <- themeResult[!is.na(themeResult)] 605 | 606 | labelResult <- construcThemeString('labs', original = gg_original, new = gg_reactive(), std = default, category = 'labels') 607 | 608 | if((!is.null(themeResult) & length(themeResult) > 0) | !is.null(labelResult)) { 609 | if (!is.null(input$multiline)) { 610 | if (input$multiline) { 611 | oneline <- FALSE 612 | } else { 613 | oneline <- TRUE 614 | } 615 | } else { 616 | oneline <- TRUE 617 | } 618 | 619 | result <- formatResult(text = text, themestring = themeResult, labelstring = labelResult, oneline = oneline, formatR = input$formatR) 620 | rstudioapi::insertText(result) 621 | } 622 | invisible(stopApp()) 623 | }) 624 | 625 | observeEvent(input$cancel, { 626 | invisible(stopApp()) 627 | }) 628 | 629 | } 630 | 631 | viewer <- dialogViewer(dialogName = 'ggThemeAssist', width = 990, height = 900) 632 | runGadget(ui, server, stopOnCancel = FALSE, viewer = viewer) 633 | } 634 | 635 | #' @export 636 | #' @rdname ggThemeAssist 637 | ggThemeAssistGadget <- function(plot) { 638 | if (missing(plot)) { 639 | stop('You must provide a ggplot2 plot object.', call. = FALSE) 640 | } 641 | plot <- deparse(substitute(plot)) 642 | if (grepl('^\\s*[[:alpha:]]+[[:alnum:]\\.]*\\s*$', paste0(plot, collapse = ''))) { 643 | ggThemeAssist(plot) 644 | } else { 645 | stop('You must provide a ggplot2 plot object.', call. = FALSE) 646 | } 647 | 648 | } 649 | 650 | ggThemeAssistAddin <- function() { 651 | # Get the document context. 652 | context <- rstudioapi::getActiveDocumentContext() 653 | 654 | # Set the default data to use based on the selection. 655 | text <- context$selection[[1]]$text 656 | 657 | if (nchar(text) == 0) { 658 | stop('Please highlight a ggplot2 plot before selecting this addin.') 659 | } 660 | 661 | ggThemeAssist(text) 662 | } 663 | --------------------------------------------------------------------------------