├── .gitignore ├── .Rbuildignore ├── R ├── plotflow-package.R ├── mergePDF.R ├── theme_map.R ├── cushion.R ├── help.R ├── label_rename_margin.R ├── qcolors.R ├── label_breaks.R ├── ggalign.R ├── qsymbol.R ├── ggcolors.R ├── fill_by_column.R ├── ggplot_global_set_color.R ├── axis0.R ├── plot2drop.R ├── theme_basic.R ├── qgrid.R ├── theme_apa.R ├── merge_pdf.R ├── utils.R ├── unbalanced_facet_axis.R ├── yes_no_bar.R ├── splot.R ├── theme_black.R ├── ggdual_axis.R ├── reorder_by.R └── ggfaxt.R ├── .travis.yml ├── man ├── print.ggalign.Rd ├── plotflow.Rd ├── plot.ggdual_axis.Rd ├── qcolor.Rd ├── print.ggdual_axis.Rd ├── print.unbalanced_facet_axis.Rd ├── qsymbol.Rd ├── theme_map.Rd ├── ggalign.Rd ├── help.Rd ├── plot.unbalanced_facet_axis.Rd ├── cushion.Rd ├── ggplot_global_set_color.Rd ├── label_rename_margin.Rd ├── theme_basic.Rd ├── plot2drop.Rd ├── theme_apa.Rd ├── ggdual_axis.Rd ├── label_breaks.Rd ├── ggcolors.Rd ├── unbalanced_facet_axis.Rd ├── theme_black.Rd ├── merge_pdf.Rd ├── fill_by_column.Rd ├── axis0.Rd ├── qgrid.Rd ├── yes_no_bar.Rd ├── reorder_by.Rd └── ggfaxt.Rd ├── NEWS.md ├── DESCRIPTION ├── inst ├── CITATION ├── build.R └── maintenance.R ├── README.md ├── NAMESPACE └── .Rprofile /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | plotflow.Rproj 5 | ^\.Rprofile 6 | inst/build.R 7 | inst/maintenance.R 8 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.travis\.yml$ 4 | ^\.gitignore 5 | ^\.Rprofile 6 | inst/build.R 7 | inst/maintenance.R 8 | 9 | -------------------------------------------------------------------------------- /R/plotflow-package.R: -------------------------------------------------------------------------------- 1 | #' plotflow: Tools to speed up workflow associated with plotting 2 | #' 3 | #' Plotting functions designed to increase efficiency around plotting. 4 | #' 5 | #' @docType package 6 | #' @name plotflow 7 | #' @aliases plotflow package-plotflow 8 | NULL 9 | 10 | 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: r 2 | sudo: false 3 | cache: packages 4 | pandoc: false 5 | 6 | r: 7 | - 3.1 8 | - oldrel 9 | - release 10 | - devel 11 | 12 | addons: 13 | apt: 14 | packages: 15 | - ghostscript 16 | 17 | notifications: 18 | email: 19 | on_success: change 20 | on_failure: change 21 | -------------------------------------------------------------------------------- /man/print.ggalign.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggalign.R 3 | \name{print.ggalign} 4 | \alias{print.ggalign} 5 | \title{Prints a ggalign Object} 6 | \usage{ 7 | \method{print}{ggalign}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{The ggalign object.} 11 | 12 | \item{\ldots}{ignored.} 13 | } 14 | \description{ 15 | Prints a ggalign object. 16 | } 17 | -------------------------------------------------------------------------------- /man/plotflow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotflow-package.R 3 | \docType{package} 4 | \name{plotflow} 5 | \alias{plotflow} 6 | \alias{package-plotflow} 7 | \alias{plotflow-package} 8 | \title{plotflow: Tools to speed up workflow associated with plotting} 9 | \description{ 10 | Plotting functions designed to increase efficiency around plotting. 11 | } 12 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # plotflow 0.2.1 2 | 3 | * Fixed a bug introduced in 0.2.0 where the package only worked on Windows 4 | 5 | # plotflow 0.2.0 6 | 7 | * Package was updated for compatibility with ggplot2 >= 2.2.0 (now required). 8 | 9 | * Ghostscript path is detected with `tools::find_gs_cms()` (R >= 3.1.0 now required). 10 | 11 | * New function `x0()` was added to complement `y0()`. 12 | 13 | * All imported functions are now declared. 14 | 15 | * Some examples were tweaked. 16 | -------------------------------------------------------------------------------- /man/plot.ggdual_axis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggdual_axis.R 3 | \name{plot.ggdual_axis} 4 | \alias{plot.ggdual_axis} 5 | \title{Plots a ggdual_axis Object} 6 | \usage{ 7 | \method{plot}{ggdual_axis}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{The \code{ggdual_axis} object.} 11 | 12 | \item{\ldots}{Other arguments passed to \code{\link[gridExtra]{grid.arrange}}.} 13 | } 14 | \description{ 15 | Plots a ggdual_axis object. 16 | } 17 | -------------------------------------------------------------------------------- /man/qcolor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/qcolors.R 3 | \name{qcolor} 4 | \alias{qcolor} 5 | \title{Plot Base R colors()} 6 | \usage{ 7 | qcolor() 8 | } 9 | \description{ 10 | Makes a plot of base R colors from \code{\link[grDevices]{colors}}. 11 | } 12 | \examples{ 13 | qcolor() 14 | } 15 | \references{ 16 | \url{http://research.stowers-institute.org/efg/R/Color/Chart/ColorChart.R} 17 | } 18 | \author{ 19 | Earl F. Glynn 20 | } 21 | -------------------------------------------------------------------------------- /man/print.ggdual_axis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggdual_axis.R 3 | \name{print.ggdual_axis} 4 | \alias{print.ggdual_axis} 5 | \title{Prints a ggdual_axis Object} 6 | \usage{ 7 | \method{print}{ggdual_axis}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{The \code{ggdual_axis} object.} 11 | 12 | \item{\ldots}{Other arguments passed to \code{\link[gridExtra]{grid.arrange}}.} 13 | } 14 | \description{ 15 | Prints a ggdual_axis object. 16 | } 17 | -------------------------------------------------------------------------------- /man/print.unbalanced_facet_axis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/unbalanced_facet_axis.R 3 | \name{print.unbalanced_facet_axis} 4 | \alias{print.unbalanced_facet_axis} 5 | \title{Prints an unbalanced_facet_axis object.} 6 | \usage{ 7 | \method{print}{unbalanced_facet_axis}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{The unbalanced_facet_axis object} 11 | 12 | \item{\ldots}{arguments passed to the plot method} 13 | } 14 | \description{ 15 | Calls \code{\link{plot}} with the same arguments. 16 | } 17 | -------------------------------------------------------------------------------- /man/qsymbol.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/qsymbol.R 3 | \name{qsymbol} 4 | \alias{qsymbol} 5 | \title{Plot ggplot2/base R Symbols} 6 | \usage{ 7 | qsymbol(ggplot2 = TRUE) 8 | } 9 | \arguments{ 10 | \item{ggplot2}{logical. If \code{TRUE} 11 | \href{http://docs.ggplot2.org/current/}{ggplot2} symbols will be plotted. If 12 | \code{FALSE} base graphics symbols will be plotted.} 13 | } 14 | \description{ 15 | Makes a plot of ggplot2/base R symbols. 16 | } 17 | \examples{ 18 | qsymbol() 19 | } 20 | -------------------------------------------------------------------------------- /man/theme_map.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme_map.R 3 | \name{theme_map} 4 | \alias{theme_map} 5 | \title{ggplot2 Theme for Mapping.} 6 | \usage{ 7 | theme_map() 8 | } 9 | \description{ 10 | A ggplot2 theme with no background, gridlines, border, labels, or ticks. 11 | } 12 | \examples{ 13 | \dontrun{ 14 | require("maps") 15 | states <- data.frame(map("state", plot=FALSE)[c("x","y")]) 16 | (usamap <- qplot(x, y, data=states, geom="path")) 17 | usamap + theme_map() 18 | } 19 | } 20 | \seealso{ 21 | \code{\link[ggplot2]{theme}} 22 | } 23 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: plotflow 2 | Type: Package 3 | Title: Tools to Speed Up Workflow Associated with Plotting 4 | Version: 0.2.1 5 | Date: 2017-12-05 6 | Author: Tyler Rinker, Ananda Mahto, Mikko Korpela 7 | Maintainer: Tyler Rinker 8 | Description: Plotting functions not found in other plotting packages. 9 | Depends: R (>= 3.1.0), ggplot2 (>= 2.2.0) 10 | Imports: dplyr, grid, graphics, grDevices, gtable, gridExtra, tools, 11 | utils 12 | Suggests: GGally, ggdendro, ggthemes, ggmap, gplots, plotrix, reshape2, 13 | scales 14 | License: GPL-2 15 | RoxygenNote: 6.0.1 16 | -------------------------------------------------------------------------------- /R/mergePDF.R: -------------------------------------------------------------------------------- 1 | #helper function 2 | #' @importFrom tools find_gs_cmd 3 | mergePDF <- 4 | function(..., file, gsversion = NULL, in.file = NULL) { 5 | if (is.null(in.file)) { 6 | in.file <- substitute(...()) 7 | } 8 | infiles <- unlist(lapply(in.file, function(y) as.character(y))) 9 | if (is.null(gsversion)) { 10 | gsversion <- find_gs_cmd() 11 | if (!nzchar(gsversion)) 12 | stop("Please install Ghostscript and see ?tools::find_gs_cmd") 13 | } 14 | pre <- c("-dBATCH", "-dNOPAUSE", "-q", "-sDEVICE=pdfwrite") 15 | out <- paste0("-sOutputFile=", shQuote(file)) 16 | system2(gsversion, c(pre, out, shQuote(infiles))) 17 | } 18 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite plotflow in publications, please use:") 2 | 3 | 4 | citEntry(entry = "manual", 5 | title = "{plotflow}: Tools to speed up workflow associated with plotting", 6 | author = "Tyler W. Rinker", 7 | organization = "University at Buffalo/SUNY", 8 | address = "Buffalo, New York", 9 | note = "version 0.2.1", 10 | year = "2017", 11 | url = "http://github.com/trinker/plotflow", 12 | textVersion = paste("Rinker, T. W. (2017).", 13 | "plotflow: Tools to speed up workflow associated with plotting", 14 | "version 0.2.1. University at Buffalo. Buffalo, New York.", 15 | "http://github.com/trinker/plotflow") 16 | ) 17 | -------------------------------------------------------------------------------- /R/theme_map.R: -------------------------------------------------------------------------------- 1 | #' ggplot2 Theme for Mapping. 2 | #' 3 | #' A ggplot2 theme with no background, gridlines, border, labels, or ticks. 4 | #' 5 | #' @export 6 | #' @seealso \code{\link[ggplot2]{theme}} 7 | #' @importFrom ggplot2 theme_bw theme element_blank 8 | #' @examples 9 | #' \dontrun{ 10 | #' require("maps") 11 | #' states <- data.frame(map("state", plot=FALSE)[c("x","y")]) 12 | #' (usamap <- qplot(x, y, data=states, geom="path")) 13 | #' usamap + theme_map() 14 | #' } 15 | theme_map <- function() { 16 | theme_bw() + 17 | theme(axis.title=element_blank(), 18 | axis.text = element_blank(), 19 | axis.ticks = element_blank(), 20 | panel.grid = element_blank(), 21 | panel.border = element_blank() 22 | ) 23 | } 24 | 25 | -------------------------------------------------------------------------------- /man/ggalign.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggalign.R 3 | \name{ggalign} 4 | \alias{ggalign} 5 | \title{Align ggplot2 Graph Edges} 6 | \usage{ 7 | ggalign(plot1, plot2) 8 | } 9 | \arguments{ 10 | \item{plot1}{A ggplot2 plot.} 11 | 12 | \item{plot2}{A ggplot2 plot.} 13 | } 14 | \value{ 15 | Returns a stacked grid object with left/right edges aligned. 16 | } 17 | \description{ 18 | Align ggplot2 graph edges. 19 | } 20 | \examples{ 21 | require(ggplot2) 22 | A <- ggplot(CO2, aes(x=Plant)) + geom_bar() + coord_flip() 23 | B <- ggplot(CO2, aes(x=Type)) + geom_bar() + coord_flip() 24 | ggalign(A, B) 25 | } 26 | \references{ 27 | \url{http://stackoverflow.com/a/13295880/1000343} 28 | } 29 | \author{ 30 | Baptiste Auguie 31 | } 32 | \keyword{align} 33 | -------------------------------------------------------------------------------- /man/help.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/help.R 3 | \name{gghelp} 4 | \alias{gghelp} 5 | \alias{ggcook} 6 | \title{Open Help Pages for ggplot2} 7 | \usage{ 8 | gghelp(FUN) 9 | 10 | ggcook() 11 | } 12 | \arguments{ 13 | \item{FUN}{A particular ggplot function to reference. Default is the index 14 | page.} 15 | } 16 | \value{ 17 | Opens a help web page. 18 | } 19 | \description{ 20 | \code{gghelp} - Open Hadley Wickham's ggplot2 21 | \href{http://docs.ggplot2.org/current/}{web page}. 22 | 23 | \code{ggcook} - Open Winston Chang's ggplot2 24 | \href{http://www.cookbook-r.com/Graphs/}{Cookbook for R page}. 25 | } 26 | \examples{ 27 | \dontrun{ 28 | gghelp() 29 | gghelp("theme") 30 | ggcook() 31 | } 32 | } 33 | \seealso{ 34 | \code{\link[utils]{browseURL}} 35 | } 36 | -------------------------------------------------------------------------------- /man/plot.unbalanced_facet_axis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/unbalanced_facet_axis.R 3 | \name{plot.unbalanced_facet_axis} 4 | \alias{plot.unbalanced_facet_axis} 5 | \title{Plots an unbalanced_facet_axis object.} 6 | \usage{ 7 | \method{plot}{unbalanced_facet_axis}(x, newpage = is.null(viewport), 8 | viewport = NULL, ...) 9 | } 10 | \arguments{ 11 | \item{x}{The unbalanced_facet_axis object} 12 | 13 | \item{newpage}{logical. If \code{TRUE} \code{\link[grid]{grid.newpage}} is called.} 14 | 15 | \item{viewport}{logical. If character \code{\link[grid]{seekViewport}} is 16 | used. If an object \code{\link[grid]{pushViewport}} is used. If \code{NULL} 17 | neither viewport is used.} 18 | 19 | \item{\ldots}{ignored} 20 | } 21 | \description{ 22 | Plots an unbalanced_facet_axis object. 23 | } 24 | -------------------------------------------------------------------------------- /inst/build.R: -------------------------------------------------------------------------------- 1 | root <- Sys.getenv("USERPROFILE") 2 | repo <- pack <- basename(getwd()) 3 | 4 | curd <- getwd() 5 | loc <- file.path(root, "Desktop") 6 | setwd(loc) 7 | 8 | base.git <- dirname(curd) 9 | 10 | qman <- function(x = repo, db = file.path(root, "/Dropbox/Public"), dir=loc) { 11 | path <- file.path(dir, paste0(x, ".pdf")) 12 | if (!file.exists(path)) stop(paste(x, "does not exist...")) 13 | opath <- file.path(db, paste0(x, ".pdf")) 14 | file.copy(path, opath, overwrite = TRUE) 15 | message("manual copied!\n") 16 | } 17 | 18 | 19 | quick <- TRUE 20 | library(devtools) 21 | 22 | unlink(paste0(pack, ".pdf"), recursive = TRUE, force = TRUE) 23 | x <- file.path(base.git, pack) 24 | document(x) 25 | install(x, quick = quick, build_vignettes = FALSE, dependencies = TRUE) 26 | 27 | path <- find.package(pack) 28 | system(paste(shQuote(file.path(R.home("bin"), "R")), 29 | "CMD", "Rd2pdf", shQuote(path))) 30 | 31 | qman(repo, dir=loc) 32 | setwd(curd) 33 | message("Done!") -------------------------------------------------------------------------------- /man/cushion.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cushion.R 3 | \name{cushion} 4 | \alias{cushion} 5 | \title{Determine Max Value + n Extra} 6 | \usage{ 7 | cushion(x, pad = 0.05) 8 | } 9 | \arguments{ 10 | \item{x}{A vector.} 11 | 12 | \item{pad}{A proportion extra to add.} 13 | } 14 | \value{ 15 | Returns the max value of a vector + n extra. 16 | } 17 | \description{ 18 | Determine max value of a vector plus an additional proportion. 19 | } 20 | \note{ 21 | If x is a factor or character vector counts for each category are used 22 | as \code{max(n)}. 23 | } 24 | \examples{ 25 | cushion(as.factor(mtcars$cyl)) 26 | cushion(mtcars$cyl) 27 | cushion(mtcars$cyl, .5) 28 | 29 | \dontrun{ 30 | ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 31 | geom_bar() + 32 | theme_apa() + 33 | y0(cushion(as.factor(mtcars$cyl))) + 34 | xlab("Cylinders") + 35 | ylab("Total") 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /R/cushion.R: -------------------------------------------------------------------------------- 1 | #' Determine Max Value + n Extra 2 | #' 3 | #' Determine max value of a vector plus an additional proportion. 4 | #' 5 | #' @param x A vector. 6 | #' @param pad A proportion extra to add. 7 | #' @return Returns the max value of a vector + n extra. 8 | #' @note If x is a factor or character vector counts for each category are used 9 | #' as \code{max(n)}. 10 | #' @export 11 | #' @examples 12 | #' cushion(as.factor(mtcars$cyl)) 13 | #' cushion(mtcars$cyl) 14 | #' cushion(mtcars$cyl, .5) 15 | #' 16 | #' \dontrun{ 17 | #' ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 18 | #' geom_bar() + 19 | #' theme_apa() + 20 | #' y0(cushion(as.factor(mtcars$cyl))) + 21 | #' xlab("Cylinders") + 22 | #' ylab("Total") 23 | #' } 24 | cushion <- function(x, pad = .05) { 25 | 26 | if(is.factor(x) | is.character(x)) { 27 | out <- max(tapply(x, x, length)) 28 | } else { 29 | out <- max(x) 30 | } 31 | 32 | out + out*pad 33 | } 34 | 35 | 36 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | plotflow 2 | ======== 3 | 4 | [![Build Status](https://travis-ci.org/trinker/plotflow.png?branch=master)](https://travis-ci.org/trinker/plotflow) 5 | [![Follow](https://img.shields.io/twitter/follow/tylerrinker.svg?style=social)](https://twitter.com/intent/follow?screen_name=tylerrinker) 6 | 7 | A group of tools to speed up work flow associated with plotting tasks. 8 | 9 | ## Installation 10 | 11 | Currently there isn't a release on [CRAN](http://cran.r-project.org/). 12 | 13 | 14 | You can, however, download the [zip ball](https://github.com/trinker/plotflow/zipball/master) or [tar ball](https://github.com/trinker/plotflow/tarball/master), decompress and run `R CMD INSTALL` on it, or use the **devtools** package to install the development version: 15 | 16 | ```r 17 | # install.packages("devtools") 18 | 19 | library(devtools) 20 | install_github("trinker/plotflow") 21 | ``` 22 | 23 | ## Installing Ghostscript 24 | [ghostscript](http://www.ghostscript.com/) must be installed when using `merge_pdf`. 25 | 26 | ## Help 27 | [Help Manual](https://dl.dropbox.com/u/61803503/plotflow.pdf) 28 | 29 | -------------------------------------------------------------------------------- /R/help.R: -------------------------------------------------------------------------------- 1 | #' Open Help Pages for ggplot2 2 | #' 3 | #' \code{gghelp} - Open Hadley Wickham's ggplot2 4 | #' \href{http://docs.ggplot2.org/current/}{web page}. 5 | #' 6 | #' @param FUN A particular ggplot function to reference. Default is the index 7 | #' page. 8 | #' @return Opens a help web page. 9 | #' @rdname help 10 | #' @importFrom utils browseURL 11 | #' @export 12 | #' @seealso \code{\link[utils]{browseURL}} 13 | #' @examples 14 | #' \dontrun{ 15 | #' gghelp() 16 | #' gghelp("theme") 17 | #' ggcook() 18 | #' } 19 | gghelp <- function(FUN) { 20 | if(missing(FUN)) FUN <- "" else FUN <- paste0(FUN, ".html") 21 | browseURL(sprintf("http://docs.ggplot2.org/current/%s", FUN)) 22 | } 23 | 24 | #' Open Help Pages for ggplot2 25 | #' 26 | #' \code{ggcook} - Open Winston Chang's ggplot2 27 | #' \href{http://www.cookbook-r.com/Graphs/}{Cookbook for R page}. 28 | #' 29 | #' @rdname help 30 | #' @importFrom utils browseURL 31 | #' @export 32 | ggcook <- function() { 33 | ## browseURL("http://www.cookbook-r.com/Graphs/#graphs-with-ggplot2") 34 | browseURL("http://www.cookbook-r.com/Graphs/") 35 | } 36 | -------------------------------------------------------------------------------- /R/label_rename_margin.R: -------------------------------------------------------------------------------- 1 | #' Rename the Margins of ggplot2 facet_grid 2 | #' 3 | #' Convert the default (all) when setting ggplot2's 4 | #' \code{\link[ggplot2]{facet_grid}} to \code{margins = TRUE}. 5 | #' 6 | #' @param newname The new strip.text name to overwrite (all). 7 | #' @keywords margin 8 | #' @importFrom ggplot2 as_labeller 9 | #' @export 10 | #' @examples 11 | #' mtcars2 <- mtcars 12 | #' mtcars2$gear <- factor(mtcars2$gear) 13 | #' ggplot(mtcars2, aes(cyl)) + 14 | #' geom_point(stat="bin", size = 2, binwidth = 2, 15 | #' aes(shape = gear), position = "stack") + 16 | #' facet_grid(carb ~ gear, margins = TRUE, 17 | #' labeller=label_rename_margin("Total")) 18 | #' 19 | #' ggplot(mtcars2, aes(cyl)) + 20 | #' geom_point(stat="bin", size = 2, binwidth = 2, 21 | #' aes(shape = gear), position = "stack") + 22 | #' facet_grid(carb ~ gear, margins = "gear", 23 | #' labeller=label_rename_margin("Total")) 24 | label_rename_margin <- function(newname = "Total") { 25 | as_labeller(function(x) { 26 | x[x == "(all)"] <- newname 27 | x 28 | }) 29 | } 30 | -------------------------------------------------------------------------------- /man/ggplot_global_set_color.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggplot_global_set_color.R 3 | \name{ggplot_global_set_color} 4 | \alias{ggplot_global_set_color} 5 | \title{Globally Set ggplot2 Colors/Fills} 6 | \usage{ 7 | ggplot_global_set_color(color = "black", alter.fill = TRUE, 8 | alter.color = TRUE, reset = TRUE) 9 | } 10 | \arguments{ 11 | \item{color}{A single color character string.} 12 | 13 | \item{alter.fill}{logical. If \code{TRUE} fill is globally altered.} 14 | 15 | \item{alter.color}{logical. If \code{TRUE} colour is globally altered.} 16 | 17 | \item{reset}{logical. If colour and fill are reset to black before applying 18 | new color.} 19 | } 20 | \description{ 21 | Globally set the color and fill of ggplot2. 22 | } 23 | \examples{ 24 | ggplot_global_set_color("purple") 25 | 26 | ggplot(mtcars, aes(factor(cyl))) + geom_bar() 27 | ggplot(mtcars, aes(hp, mpg, group = factor(cyl))) + geom_point() 28 | } 29 | \references{ 30 | \url{http://stackoverflow.com/a/21175042/1000343} 31 | } 32 | \seealso{ 33 | \code{\link[ggplot2]{update_geom_defaults}} 34 | } 35 | -------------------------------------------------------------------------------- /man/label_rename_margin.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/label_rename_margin.R 3 | \name{label_rename_margin} 4 | \alias{label_rename_margin} 5 | \title{Rename the Margins of ggplot2 facet_grid} 6 | \usage{ 7 | label_rename_margin(newname = "Total") 8 | } 9 | \arguments{ 10 | \item{newname}{The new strip.text name to overwrite (all).} 11 | } 12 | \description{ 13 | Convert the default (all) when setting ggplot2's 14 | \code{\link[ggplot2]{facet_grid}} to \code{margins = TRUE}. 15 | } 16 | \examples{ 17 | mtcars2 <- mtcars 18 | mtcars2$gear <- factor(mtcars2$gear) 19 | ggplot(mtcars2, aes(cyl)) + 20 | geom_point(stat="bin", size = 2, binwidth = 2, 21 | aes(shape = gear), position = "stack") + 22 | facet_grid(carb ~ gear, margins = TRUE, 23 | labeller=label_rename_margin("Total")) 24 | 25 | ggplot(mtcars2, aes(cyl)) + 26 | geom_point(stat="bin", size = 2, binwidth = 2, 27 | aes(shape = gear), position = "stack") + 28 | facet_grid(carb ~ gear, margins = "gear", 29 | labeller=label_rename_margin("Total")) 30 | } 31 | \keyword{margin} 32 | -------------------------------------------------------------------------------- /man/theme_basic.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme_basic.R 3 | \name{theme_basic} 4 | \alias{theme_basic} 5 | \title{ggplot2 Theme with No Background or Gridlines.} 6 | \usage{ 7 | theme_basic(x = FALSE, y = FALSE, plot.box = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{logical. If \code{TRUE} vertical gridlines are added.} 11 | 12 | \item{y}{logical. If \code{TRUE} horizontal gridlines are added.} 13 | 14 | \item{plot.box}{logical. If \code{TRUE} a full box surrounds the plot area. If \code{FALSE} only the x and y axis are shown.} 15 | } 16 | \description{ 17 | A ggplot2 theme with no background and no gridlines. 18 | } 19 | \note{ 20 | Both x and y can not be \code{TRUE}. Use 21 | \code{\link[ggplot2]{theme_bw}} instead. 22 | } 23 | \examples{ 24 | ggplot(mtcars, aes(factor(cyl))) + geom_bar() + theme_basic() 25 | ggplot(mtcars, aes(factor(cyl))) + geom_bar() + theme_basic(x = TRUE) 26 | ggplot(mtcars, aes(factor(cyl))) + geom_bar() + theme_basic(y = TRUE) 27 | ggplot(mtcars, aes(factor(cyl))) + geom_bar() + theme_basic(x = TRUE, y = TRUE) 28 | } 29 | \seealso{ 30 | \code{\link[ggplot2]{theme}} 31 | } 32 | -------------------------------------------------------------------------------- /man/plot2drop.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot2drop.R 3 | \name{plot2drop} 4 | \alias{plot2drop} 5 | \title{Plot to Drop Box} 6 | \usage{ 7 | plot2drop(name, type = "png", width = 400, height = 400, open = TRUE, 8 | loc = getOption("dropbox_path"), key = getOption("dropbox_key"), ...) 9 | } 10 | \arguments{ 11 | \item{name}{The name of the plot (no file extension needed).} 12 | 13 | \item{type}{The type of plotting device (png, pdf, etc).} 14 | 15 | \item{width}{Width of plot.} 16 | 17 | \item{height}{Height of plot.} 18 | 19 | \item{open}{logical. If \code{TRUE} provides the code to open the plot in 20 | default browser.} 21 | 22 | \item{loc}{The path to the location of the dropbox public folder.} 23 | 24 | \item{key}{The dropbox key.} 25 | 26 | \item{\ldots}{Other arguments passed to the plotting device in type.} 27 | } 28 | \description{ 29 | A wrapper to plotting device for easy plotting to Drop Box. 30 | } 31 | \details{ 32 | Plots to Drop Box and returns the URL to the plot (and optionally 33 | opens the plot). Code attemoted to be copied to the clipboard. 34 | } 35 | \examples{ 36 | \dontrun{ 37 | plot2drop("dfg") 38 | plot(1:10) 39 | dev.off() 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /R/qcolors.R: -------------------------------------------------------------------------------- 1 | #' Plot Base R colors() 2 | #' 3 | #' Makes a plot of base R colors from \code{\link[grDevices]{colors}}. 4 | #' 5 | #' @importFrom grDevices col2rgb colors 6 | #' @importFrom graphics plot rect text title 7 | #' @export 8 | #' @author Earl F. Glynn 9 | #' @references \url{http://research.stowers-institute.org/efg/R/Color/Chart/ColorChart.R} 10 | #' @examples 11 | #' qcolor() 12 | qcolor <- function() { 13 | SetTextContrastColor <- function(color){ 14 | ifelse(mean(col2rgb(color)) > 127, "black", "white") 15 | } 16 | 17 | TextContrastColor <- unlist( lapply(colors(), SetTextContrastColor) ) 18 | 19 | colCount <- 25 20 | rowCount <- 27 21 | plot( c(1,colCount), c(0,rowCount), type="n", ylab="", xlab="", 22 | axes=FALSE, ylim=c(rowCount,0)) 23 | title("R colors") 24 | 25 | for (j in 0:(rowCount-1)) { 26 | base <- j*colCount 27 | remaining <- length(colors()) - base 28 | RowSize <- ifelse(remaining < colCount, remaining, colCount) 29 | rect((1:RowSize)-0.5,j-0.5, (1:RowSize)+0.5,j+0.5, 30 | border="black", 31 | col=colors()[base + (1:RowSize)]) 32 | text((1:RowSize), j, paste(base + (1:RowSize)), cex=0.7, 33 | col=TextContrastColor[base + (1:RowSize)]) 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /R/label_breaks.R: -------------------------------------------------------------------------------- 1 | #' Break Axis Labels 2 | #' 3 | #' Break factor level labels onto new lines within plots. 4 | #' 5 | #' @param dataframe A dataframe object. 6 | #' @param split.col The column to break its labels onto separate lines. 7 | #' @return Returns a data.frame with the factor element spaces replaces with \code{\\n}. 8 | #' @author Mollie Taylor and Tyler Rinker 9 | #' @references \url{http://www.mollietaylor.com/2013/10/line-breaks-between-words-in-axis.html} 10 | #' @export 11 | #' @examples 12 | #' set.seed(1000) 13 | #' dat <- data.frame(Location = rnorm(1:1000, mean = 200, sd = 75), 14 | #' Type = sample(c("Big Red Monster", "Little Green Alien", 15 | #' "One-Eyed, One-Horned Flying Purple People Eater"), 1000, TRUE)) 16 | #' 17 | #' ggplot(dat, aes(x = Type, y = Location)) + 18 | #' geom_boxplot() 19 | #' 20 | #' ggplot(label_breaks(dat, 2), aes(x = Type, y = Location)) + 21 | #' geom_boxplot() 22 | #' 23 | #' 24 | #' ggplot(label_breaks(dat, "Type"), aes(x = Type, y = Location)) + 25 | #' geom_boxplot() + 26 | #' coord_flip() 27 | label_breaks <- function(dataframe, split.col) { 28 | 29 | levels(dataframe[, split.col]) <- gsub(" ", "\n", 30 | levels(dataframe[, split.col])) 31 | dataframe 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/theme_apa.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme_apa.R 3 | \name{theme_apa} 4 | \alias{theme_apa} 5 | \title{ggplot2 Theme for APA Publications} 6 | \usage{ 7 | theme_apa(plot.box = FALSE) 8 | } 9 | \arguments{ 10 | \item{plot.box}{logical. If \code{TRUE} a full box surrounds the plot area. If \code{FALSE} only the x and y axis are shown.} 11 | } 12 | \description{ 13 | A ggplot2 theme with no background and Times New Roman font. 14 | } 15 | \examples{ 16 | \dontrun{ 17 | ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 18 | geom_bar() + 19 | theme_apa() + 20 | y0(cushion(as.factor(mtcars$cyl))) + 21 | xlab("Cylinders") + 22 | ylab("Total") 23 | 24 | ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 25 | geom_bar() + 26 | theme_apa(plot.box=T) + 27 | y0(cushion(as.factor(mtcars$cyl))) + 28 | xlab("Cylinders") + 29 | ylab("Total") 30 | 31 | ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 32 | geom_bar() + 33 | theme_basic() + 34 | theme_apa() + 35 | y0(cushion(as.factor(mtcars$cyl))) + 36 | xlab("Cylinders") + 37 | ylab("Total") 38 | } 39 | } 40 | \seealso{ 41 | \code{\link[ggplot2]{theme}} 42 | } 43 | -------------------------------------------------------------------------------- /man/ggdual_axis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggdual_axis.R 3 | \name{ggdual_axis} 4 | \alias{ggdual_axis} 5 | \title{Dual Y-axis for ggplot2} 6 | \usage{ 7 | ggdual_axis(lhs, rhs, angle = 270) 8 | } 9 | \arguments{ 10 | \item{lhs}{A plot whose y axis shall be on the left hand side.} 11 | 12 | \item{rhs}{A plot whose y axis shall be on the right hand side.} 13 | 14 | \item{angle}{Angle to rotate y-axis on right hand side.} 15 | } 16 | \value{ 17 | Returns an \code{\link[gridExtra]{arrangeGrob}} with extra class 18 | \code{ggdual_axis} that plots by default. This allows it to be further 19 | combined with other grobs via \code{\link[gridExtra]{grid.arrange}}. 20 | } 21 | \description{ 22 | lot dual y-axis for ggplot2 objects. 23 | } 24 | \examples{ 25 | p1 <- ggplot(mtcars, aes(mpg, disp)) + 26 | geom_line(colour = "blue") + 27 | theme_bw() + 28 | theme(plot.margin = grid::unit(c(.5, 1, .5, 0), "cm")) 29 | 30 | p2 <- ggplot(mtcars, aes(mpg, drat)) + 31 | geom_line(colour = "red") + 32 | theme_bw() + 33 | theme(plot.margin = grid::unit(c(.5, 1, .5, 0), "cm")) 34 | 35 | ggdual_axis(lhs = p1, rhs = p2) 36 | } 37 | \references{ 38 | \url{http://stackoverflow.com/a/27608585/1000343} 39 | \url{http://stackoverflow.com/a/25699817/1000343} 40 | } 41 | -------------------------------------------------------------------------------- /man/label_breaks.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/label_breaks.R 3 | \name{label_breaks} 4 | \alias{label_breaks} 5 | \title{Break Axis Labels} 6 | \usage{ 7 | label_breaks(dataframe, split.col) 8 | } 9 | \arguments{ 10 | \item{dataframe}{A dataframe object.} 11 | 12 | \item{split.col}{The column to break its labels onto separate lines.} 13 | } 14 | \value{ 15 | Returns a data.frame with the factor element spaces replaces with \code{\\n}. 16 | } 17 | \description{ 18 | Break factor level labels onto new lines within plots. 19 | } 20 | \examples{ 21 | set.seed(1000) 22 | dat <- data.frame(Location = rnorm(1:1000, mean = 200, sd = 75), 23 | Type = sample(c("Big Red Monster", "Little Green Alien", 24 | "One-Eyed, One-Horned Flying Purple People Eater"), 1000, TRUE)) 25 | 26 | ggplot(dat, aes(x = Type, y = Location)) + 27 | geom_boxplot() 28 | 29 | ggplot(label_breaks(dat, 2), aes(x = Type, y = Location)) + 30 | geom_boxplot() 31 | 32 | 33 | ggplot(label_breaks(dat, "Type"), aes(x = Type, y = Location)) + 34 | geom_boxplot() + 35 | coord_flip() 36 | } 37 | \references{ 38 | \url{http://www.mollietaylor.com/2013/10/line-breaks-between-words-in-axis.html} 39 | } 40 | \author{ 41 | Mollie Taylor and Tyler Rinker 42 | } 43 | -------------------------------------------------------------------------------- /R/ggalign.R: -------------------------------------------------------------------------------- 1 | #' Align ggplot2 Graph Edges 2 | #' 3 | #' Align ggplot2 graph edges. 4 | #' 5 | #' @param plot1 A ggplot2 plot. 6 | #' @param plot2 A ggplot2 plot. 7 | #' @return Returns a stacked grid object with left/right edges aligned. 8 | #' @references \url{http://stackoverflow.com/a/13295880/1000343} 9 | #' @keywords align 10 | #' @export 11 | #' @author Baptiste Auguie 12 | #' @examples 13 | #' require(ggplot2) 14 | #' A <- ggplot(CO2, aes(x=Plant)) + geom_bar() + coord_flip() 15 | #' B <- ggplot(CO2, aes(x=Type)) + geom_bar() + coord_flip() 16 | #' ggalign(A, B) 17 | ggalign <- function(plot1, plot2) { 18 | 19 | gA <- ggplot2::ggplotGrob(plot1) 20 | gB <- ggplot2::ggplotGrob(plot2) 21 | maxWidth <- grid::unit.pmax(gA$widths[2:5], gB$widths[2:5]) 22 | gA$widths[2:5] <- as.list(maxWidth) 23 | gB$widths[2:5] <- as.list(maxWidth) 24 | out <- gridExtra::arrangeGrob(gA, gB, ncol=1) 25 | # if (plot) print(out) 26 | # return(invisible(out)) 27 | class(out) <- c("ggalign", class(out)) 28 | out 29 | } 30 | 31 | #' Prints a ggalign Object 32 | #' 33 | #' Prints a ggalign object. 34 | #' 35 | #' @param x The ggalign object. 36 | #' @param \ldots ignored. 37 | #' @method print ggalign 38 | #' @export 39 | print.ggalign <- function(x, ...){ 40 | gridExtra::grid.arrange(x) 41 | } 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | -------------------------------------------------------------------------------- /R/qsymbol.R: -------------------------------------------------------------------------------- 1 | #' Plot ggplot2/base R Symbols 2 | #' 3 | #' Makes a plot of ggplot2/base R symbols. 4 | #' 5 | #' @param ggplot2 logical. If \code{TRUE} 6 | #' \href{http://docs.ggplot2.org/current/}{ggplot2} symbols will be plotted. If 7 | #' \code{FALSE} base graphics symbols will be plotted. 8 | #' @importFrom graphics box plot text 9 | #' @export 10 | #' @examples 11 | #' qsymbol() 12 | qsymbol <- function(ggplot2 = TRUE){ 13 | 14 | x <- y <- symb <- NULL 15 | 16 | if (!ggplot2) { 17 | plot(x=rep(5:1, 5), y=rep(1:5, each=5), pch=25:1, 18 | ylim=c(1, 5.25), xlab="", ylab="", 19 | main="Base Symbols (pch)", axes=FALSE) 20 | text(25:1, x=rep(5:1, 5), y=rep(1:5, each=5)+.2, cex=.8) 21 | box() 22 | } else { 23 | dat <- data.frame(y = rep(5:1, , each = 5), x = rep(1:5, 5), symb=1:25) 24 | 25 | ggplot2::ggplot(dat, ggplot2::aes(x=x, y=y)) + 26 | ggplot2::geom_text(ggplot2::aes(label=symb), size=3.25, vjust=2.25) + 27 | ggplot2::geom_point(ggplot2::aes(shape = symb), size = 5, 28 | colour = "red", fill = "black") + 29 | ggplot2::scale_shape_identity() + 30 | ggplot2::ylab("") + ggplot2::xlab("") + 31 | ggplot2::theme(axis.text=ggplot2::element_blank(), 32 | axis.ticks=ggplot2::element_blank()) + 33 | ggplot2::ggtitle("ggplot2 Symbols (shape)") 34 | } 35 | 36 | } 37 | -------------------------------------------------------------------------------- /man/ggcolors.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggcolors.R 3 | \name{ggcolors} 4 | \alias{ggcolors} 5 | \alias{random_ggcolors} 6 | \title{ggplot2's Default Color Scheme} 7 | \usage{ 8 | ggcolors(n) 9 | 10 | random_ggcolors(n) 11 | } 12 | \arguments{ 13 | \item{n}{An integer specifying the number of colors.} 14 | } 15 | \value{ 16 | Returns a vector of \code{n} hex colors. 17 | } 18 | \description{ 19 | \code{ggcolors} - Make a palette with \pkg{ggplot2}'s default color scheme. 20 | 21 | \code{random_ggcolors} - Make a random n length palette with \pkg{ggplot2}'s 22 | default color scheme. 23 | } 24 | \examples{ 25 | scales:::show_col(ggcolors(n=9)) 26 | 27 | n <- 10 28 | ggcolors(n) 29 | 30 | plot( 31 | 1:n, 32 | pch=16, 33 | cex=2, 34 | col= ggcolors(n) 35 | ) 36 | 37 | barplot( 38 | stats::setNames(5:14, LETTERS[5:14]), 39 | col = ggcolors(n), 40 | border = ggcolors(n) 41 | ) 42 | 43 | boxplot( 44 | x ~ y, 45 | data = data.frame(x = rnorm(1000), 46 | y = sample(LETTERS[5:14], 1000, TRUE)), 47 | border = ggcolors(n), 48 | lwd=2 49 | ) 50 | 51 | pie( 52 | stats::setNames(5:14, LETTERS[5:14]), 53 | col = ggcolors(n), 54 | border = ggcolors(n) 55 | ) 56 | } 57 | \references{ 58 | \url{http://stackoverflow.com/a/8197703/1000343} 59 | } 60 | \author{ 61 | John Colby 62 | } 63 | -------------------------------------------------------------------------------- /man/unbalanced_facet_axis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/unbalanced_facet_axis.R 3 | \name{unbalanced_facet_axis} 4 | \alias{unbalanced_facet_axis} 5 | \title{Add Tick Marks to an Unbalanced facet_wrap} 6 | \usage{ 7 | unbalanced_facet_axis(ggplot_obj, position = c("up", "down")) 8 | } 9 | \arguments{ 10 | \item{ggplot_obj}{An unbalanced ggplot2 \code{\link[ggplot2]{facet_wrap}} 11 | object.} 12 | 13 | \item{position}{Either \code{"up"} (match unbalanced facet's position, 14 | as is the default of ggplot2) or \code{"down"} (along bottom most axis).} 15 | } 16 | \description{ 17 | Adds the tick marks to an unbalanced grouping of 18 | \code{\link[ggplot2]{facet_wrap}} plots. 19 | } 20 | \examples{ 21 | set.seed(2) 22 | mtcars2 <- mtcars 23 | mtcars2[["new"]] <- sample(LETTERS[1:7], nrow(mtcars), TRUE) 24 | 25 | library(ggplot2) 26 | 27 | unbalanced_facet_axis(ggplot(mtcars2, aes(x=mpg, y=hp)) + 28 | geom_line() + 29 | facet_wrap(~new, ncol=2)) 30 | 31 | unbalanced_facet_axis(ggplot(mtcars2, aes(x=mpg, y=hp)) + 32 | geom_line() + 33 | facet_wrap(~new, ncol=3), "down") 34 | } 35 | \references{ 36 | \url{http://stackoverflow.com/a/13316126/1000343} 37 | } 38 | \author{ 39 | Original by \href{http://stackoverflow.com/users/1320535/julius}{Julius} 40 | (stackoverflow.com). Updated by Mikko Korpela for ggplot2 >= 2.2.0. 41 | } 42 | \keyword{axis} 43 | \keyword{facet_wrap} 44 | -------------------------------------------------------------------------------- /man/theme_black.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme_black.R 3 | \name{theme_black} 4 | \alias{theme_black} 5 | \title{ggplot2 Theme with No Background or Gridlines.} 6 | \usage{ 7 | theme_black(base_size = 12, base_family = "") 8 | } 9 | \arguments{ 10 | \item{base_size}{The size to use for text. Various textual components are 11 | scaled off of this value.} 12 | 13 | \item{base_family}{The base font family.} 14 | } 15 | \description{ 16 | A ggplot2 theme with no background and no gridlines. 17 | } 18 | \examples{ 19 | ggplot(mtcars, aes(factor(cyl))) + geom_bar(fill="white") + theme_black() 20 | dat <- data.frame(y = c(austres), time = time(austres)) 21 | ggplot(dat, aes(time, y)) + scale_x_continuous() + 22 | geom_line(color="lightblue", size=1) + theme_black() 23 | 24 | \dontrun{ 25 | library(maps) 26 | crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests) 27 | states_map <-map_data("state") 28 | 29 | ggplot(crimes, aes(map_id = state)) + 30 | geom_map(aes(fill = Murder), map = states_map) + 31 | expand_limits(x = states_map$long, y = states_map$lat) + 32 | theme_black() + 33 | scale_fill_gradient(low="grey10", high="white") 34 | } 35 | } 36 | \references{ 37 | \url{http://jonlefcheck.net/2013/03/11/black-theme-for-ggplot2-2} 38 | } 39 | \seealso{ 40 | \code{\link[ggplot2]{theme}} 41 | } 42 | \author{ 43 | Jon Lefcheck (\url{http://jonlefcheck.net}) 44 | } 45 | -------------------------------------------------------------------------------- /R/ggcolors.R: -------------------------------------------------------------------------------- 1 | #' ggplot2's Default Color Scheme 2 | #' 3 | #' \code{ggcolors} - Make a palette with \pkg{ggplot2}'s default color scheme. 4 | #' 5 | #' @param n An integer specifying the number of colors. 6 | #' @return Returns a vector of \code{n} hex colors. 7 | #' @references \url{http://stackoverflow.com/a/8197703/1000343} 8 | #' @export 9 | #' @rdname ggcolors 10 | #' @author John Colby 11 | #' @examples 12 | #' scales:::show_col(ggcolors(n=9)) 13 | #' 14 | #' n <- 10 15 | #' ggcolors(n) 16 | #' 17 | #' plot( 18 | #' 1:n, 19 | #' pch=16, 20 | #' cex=2, 21 | #' col= ggcolors(n) 22 | #' ) 23 | #' 24 | #' barplot( 25 | #' stats::setNames(5:14, LETTERS[5:14]), 26 | #' col = ggcolors(n), 27 | #' border = ggcolors(n) 28 | #' ) 29 | #' 30 | #' boxplot( 31 | #' x ~ y, 32 | #' data = data.frame(x = rnorm(1000), 33 | #' y = sample(LETTERS[5:14], 1000, TRUE)), 34 | #' border = ggcolors(n), 35 | #' lwd=2 36 | #' ) 37 | #' 38 | #' pie( 39 | #' stats::setNames(5:14, LETTERS[5:14]), 40 | #' col = ggcolors(n), 41 | #' border = ggcolors(n) 42 | #' ) 43 | ggcolors <- function(n) { 44 | hues = seq(15, 375, length=n+1) 45 | grDevices::hcl(h=hues, l=65, c=100)[1:n] 46 | } 47 | 48 | 49 | 50 | #' ggplot2's Default Color Scheme 51 | #' 52 | #' \code{random_ggcolors} - Make a random n length palette with \pkg{ggplot2}'s 53 | #' default color scheme. 54 | #' @export 55 | #' @rdname ggcolors 56 | random_ggcolors <- function(n) { 57 | sample(ggcolors(n)) 58 | } 59 | 60 | 61 | 62 | -------------------------------------------------------------------------------- /man/merge_pdf.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/merge_pdf.R 3 | \name{merge_pdf} 4 | \alias{merge_pdf} 5 | \title{Merge Different Sized Plots} 6 | \usage{ 7 | merge_pdf(n.plots, file, widths = 8, heights = 8, n.lines = 1) 8 | } 9 | \arguments{ 10 | \item{n.plots}{The number of plots to be combined.} 11 | 12 | \item{file}{A connection, or a character string naming the file to print to.} 13 | 14 | \item{widths}{A vector of widths equal to \code{n.plots} or a single value 15 | that will be used for all plot widths.} 16 | 17 | \item{heights}{A vector of heights equal to \code{n.plots} or a single value 18 | that will be used for all plot widths.} 19 | 20 | \item{n.lines}{A vector of integer values indicating the number of lines each 21 | plotting sequence will take. Default is 1 line each.} 22 | } 23 | \value{ 24 | Returns a single combined plot of various sizes. 25 | } 26 | \description{ 27 | Allows for merging of different sized R plots. 28 | } 29 | \note{ 30 | To use with ggplot the plotting sequence must be wrapped with 31 | \code{plot()}. 32 | } 33 | \examples{ 34 | \dontrun{ 35 | merge_pdf(3, file = "foo.pdf", widths = c(7, 7, 10), heights = c(6, 10, 7)) 36 | plot(1:10) 37 | plot(1:10, pch=19) 38 | plot(1:10, col="red", pch=19) 39 | 40 | library(ggplot2) 41 | p <- ggplot(mtcars, aes(factor(cyl), mpg)) + geom_boxplot() 42 | merge_pdf(2, file = "bar.pdf", widths = c(7, 10), heights = c(6, 10)) 43 | plot(1:10) 44 | print(p) 45 | } 46 | } 47 | \keyword{plot} 48 | -------------------------------------------------------------------------------- /man/fill_by_column.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fill_by_column.R 3 | \name{fill_by_column} 4 | \alias{fill_by_column} 5 | \title{Fill facet_wrap By Column} 6 | \usage{ 7 | fill_by_column(dataframe, fact, ncol = 2) 8 | } 9 | \arguments{ 10 | \item{dataframe}{A data.frame object.} 11 | 12 | \item{fact}{The factor to be reordered (re-leveled) to fill by column.} 13 | 14 | \item{ncol}{Number of columns to make the plot} 15 | } 16 | \description{ 17 | Alter the data set to fill ggplot2's \code{\link[ggplot2]{facet_wrap}} by 18 | column rather than row. 19 | } 20 | \examples{ 21 | library(ggplot2); library(reshape2) 22 | dat <- aggregate(cbind(vs, am, gear, cyl) ~ carb, mtcars, sum) 23 | dat$carb <- factor(dat$carb, rev(dat$carb[order(rowSums(dat[, -1]))])) 24 | mdat <- melt(dat) 25 | 26 | ggplot(mdat, aes(x = variable)) + 27 | geom_bar(stat="count", aes(fill=variable, weight = value)) + 28 | facet_wrap(~carb, ncol = 2) + coord_flip() 29 | 30 | ggplot(fill_by_column(mdat, "carb"), aes(x = variable)) + 31 | geom_bar(stat="count", aes(fill=variable, weight = value)) + 32 | facet_wrap(~carb, ncol = 2) + coord_flip() 33 | 34 | ggplot(fill_by_column(mdat, "carb", 3), aes(x = variable)) + 35 | geom_bar(stat="count", aes(fill=variable, weight = value)) + 36 | facet_wrap(~carb, ncol = 3) + coord_flip() 37 | } 38 | \references{ 39 | \url{http://stackoverflow.com/a/12893273/1000343} 40 | } 41 | \author{ 42 | jem77bfp (stackoverflow.com) and Tyler Rinker 43 | } 44 | -------------------------------------------------------------------------------- /R/fill_by_column.R: -------------------------------------------------------------------------------- 1 | #' Fill facet_wrap By Column 2 | #' 3 | #' Alter the data set to fill ggplot2's \code{\link[ggplot2]{facet_wrap}} by 4 | #' column rather than row. 5 | #' 6 | #' @param dataframe A data.frame object. 7 | #' @param fact The factor to be reordered (re-leveled) to fill by column. 8 | #' @param ncol Number of columns to make the plot 9 | #' @references \url{http://stackoverflow.com/a/12893273/1000343} 10 | #' @author jem77bfp (stackoverflow.com) and Tyler Rinker 11 | #' @export 12 | #' @examples 13 | #' library(ggplot2); library(reshape2) 14 | #' dat <- aggregate(cbind(vs, am, gear, cyl) ~ carb, mtcars, sum) 15 | #' dat$carb <- factor(dat$carb, rev(dat$carb[order(rowSums(dat[, -1]))])) 16 | #' mdat <- melt(dat) 17 | #' 18 | #' ggplot(mdat, aes(x = variable)) + 19 | #' geom_bar(stat="count", aes(fill=variable, weight = value)) + 20 | #' facet_wrap(~carb, ncol = 2) + coord_flip() 21 | #' 22 | #' ggplot(fill_by_column(mdat, "carb"), aes(x = variable)) + 23 | #' geom_bar(stat="count", aes(fill=variable, weight = value)) + 24 | #' facet_wrap(~carb, ncol = 2) + coord_flip() 25 | #' 26 | #' ggplot(fill_by_column(mdat, "carb", 3), aes(x = variable)) + 27 | #' geom_bar(stat="count", aes(fill=variable, weight = value)) + 28 | #' facet_wrap(~carb, ncol = 3) + coord_flip() 29 | fill_by_column <- function(dataframe, fact, ncol = 2) { 30 | var2 <- dataframe[, fact] 31 | dat <- matrix(levels(var2), ncol = ncol) 32 | dataframe[, fact] <- factor(dataframe[, fact], 33 | levels = unlist(lapply(1:nrow(dat), function(i) dat[i, ]))) 34 | dataframe 35 | } 36 | -------------------------------------------------------------------------------- /man/axis0.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/axis0.R 3 | \name{axis0} 4 | \alias{axis0} 5 | \alias{x0} 6 | \alias{y0} 7 | \title{Adjust Space Between Axis in ggplot2} 8 | \usage{ 9 | axis0(max, scale = "continuous", axis = "y") 10 | 11 | x0(max, scale = "continuous") 12 | 13 | y0(max, scale = "continuous") 14 | } 15 | \arguments{ 16 | \item{max}{The upper/right-most edge (upper ylim/xlim numeric value).} 17 | 18 | \item{scale}{A ggplot scale type (e.g. "continuous", "discrete", etc.)} 19 | 20 | \item{axis}{The axis to operate on ("x" or "y").} 21 | } 22 | \description{ 23 | \code{axis0} - Adjust Space Between x/y Axis in ggplot2. 24 | 25 | \code{x0} - Adjust Space Between x Axis in ggplot2. 26 | 27 | \code{y0} - Adjust Space Between y Axis in ggplot2. 28 | } 29 | \examples{ 30 | \dontrun{ 31 | ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 32 | geom_bar() + 33 | theme_apa() + 34 | y0(cushion(as.factor(mtcars$cyl))) + 35 | xlab("Cylinders") + 36 | ylab("Total") 37 | 38 | library(dplyr) 39 | mtcars2 <- mtcars \%>\% group_by(cyl) \%>\% summarise(n=length(cyl)) 40 | ggplot(mtcars2, aes(y=as.factor(cyl), x=n)) + 41 | geom_point() + 42 | theme_apa() + 43 | x0(16) 44 | 45 | ggplot(mtcars, aes(x=hp, y=mpg)) + 46 | geom_point() + 47 | theme_apa() + 48 | x0(max(mtcars$hp) + 10) + 49 | y0(max(mtcars$mpg) + 5) 50 | } 51 | } 52 | \references{ 53 | \url{http://stackoverflow.com/a/20220737/1000343}. 54 | } 55 | \seealso{ 56 | \code{\link[ggplot2]{scale_y_continuous}} 57 | } 58 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(plot,ggdual_axis) 4 | S3method(plot,unbalanced_facet_axis) 5 | S3method(print,ggalign) 6 | S3method(print,ggdual_axis) 7 | S3method(print,unbalanced_facet_axis) 8 | export(axis0) 9 | export(cushion) 10 | export(fill_by_column) 11 | export(ggalign) 12 | export(ggcolors) 13 | export(ggcook) 14 | export(ggdual_axis) 15 | export(ggfaxt) 16 | export(gghelp) 17 | export(ggplot_global_set_color) 18 | export(label_breaks) 19 | export(label_rename_margin) 20 | export(merge_pdf) 21 | export(plot2drop) 22 | export(qcolor) 23 | export(qgrid) 24 | export(qsymbol) 25 | export(random_ggcolors) 26 | export(reorder_by) 27 | export(theme_apa) 28 | export(theme_basic) 29 | export(theme_black) 30 | export(theme_map) 31 | export(unbalanced_facet_axis) 32 | export(x0) 33 | export(y0) 34 | export(yes_no_bar) 35 | importFrom(ggplot2,"%+replace%") 36 | importFrom(ggplot2,as_labeller) 37 | importFrom(ggplot2,element_blank) 38 | importFrom(ggplot2,element_line) 39 | importFrom(ggplot2,element_rect) 40 | importFrom(ggplot2,element_text) 41 | importFrom(ggplot2,ggplot_build) 42 | importFrom(ggplot2,ggplot_gtable) 43 | importFrom(ggplot2,theme) 44 | importFrom(ggplot2,theme_bw) 45 | importFrom(ggplot2,theme_grey) 46 | importFrom(grDevices,col2rgb) 47 | importFrom(grDevices,colors) 48 | importFrom(grDevices,dev.off) 49 | importFrom(grDevices,dev.print) 50 | importFrom(grDevices,pdf) 51 | importFrom(graphics,box) 52 | importFrom(graphics,par) 53 | importFrom(graphics,plot) 54 | importFrom(graphics,rect) 55 | importFrom(graphics,text) 56 | importFrom(graphics,title) 57 | importFrom(tools,find_gs_cmd) 58 | importFrom(utils,browseURL) 59 | importFrom(utils,head) 60 | importFrom(utils,tail) 61 | -------------------------------------------------------------------------------- /R/ggplot_global_set_color.R: -------------------------------------------------------------------------------- 1 | #' Globally Set ggplot2 Colors/Fills 2 | #' 3 | #' Globally set the color and fill of ggplot2. 4 | #' 5 | #' @param color A single color character string. 6 | #' @param alter.fill logical. If \code{TRUE} fill is globally altered. 7 | #' @param alter.color logical. If \code{TRUE} colour is globally altered. 8 | #' @param reset logical. If colour and fill are reset to black before applying 9 | #' new color. 10 | #' @references \url{http://stackoverflow.com/a/21175042/1000343} 11 | #' @export 12 | #' @seealso \code{\link[ggplot2]{update_geom_defaults}} 13 | #' @examples 14 | #' ggplot_global_set_color("purple") 15 | #' 16 | #' ggplot(mtcars, aes(factor(cyl))) + geom_bar() 17 | #' ggplot(mtcars, aes(hp, mpg, group = factor(cyl))) + geom_point() 18 | ggplot_global_set_color <- function(color = "black", alter.fill = TRUE, alter.color = TRUE, reset = TRUE) { 19 | 20 | params <- ls(pattern = 'Geom[A-Z]', envir = as.environment('package:ggplot2')) 21 | geoms <- gsub("Geom", "", params) 22 | # 23 | # geoms 24 | 25 | if (reset) { 26 | invisible(lapply(geoms, ggplot2::update_geom_defaults, list(fill = "black", 27 | colour = "black"))) 28 | } 29 | if (alter.color && !alter.fill) { 30 | invisible(lapply(geoms, ggplot2::update_geom_defaults, list(colour = color))) 31 | } else { 32 | if (alter.color && alter.fill) { 33 | invisible(lapply(geoms, ggplot2::update_geom_defaults, list(fill = color, 34 | colour = color))) 35 | } else { 36 | if (!alter.color && alter.fill) { 37 | invisible(lapply(geoms, ggplot2::update_geom_defaults, list(fill = color))) 38 | } else { 39 | stop("better rethink why you're using this function") 40 | } 41 | } 42 | } 43 | } 44 | -------------------------------------------------------------------------------- /R/axis0.R: -------------------------------------------------------------------------------- 1 | #' Adjust Space Between Axis in ggplot2 2 | #' 3 | #' \code{axis0} - Adjust Space Between x/y Axis in ggplot2. 4 | #' 5 | #' @param max The upper/right-most edge (upper ylim/xlim numeric value). 6 | #' @param scale A ggplot scale type (e.g. "continuous", "discrete", etc.) 7 | #' @param axis The axis to operate on ("x" or "y"). 8 | #' @references \url{http://stackoverflow.com/a/20220737/1000343}. 9 | #' @seealso \code{\link[ggplot2]{scale_y_continuous}} 10 | #' @export 11 | #' @rdname axis0 12 | #' @examples 13 | #' \dontrun{ 14 | #' ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 15 | #' geom_bar() + 16 | #' theme_apa() + 17 | #' y0(cushion(as.factor(mtcars$cyl))) + 18 | #' xlab("Cylinders") + 19 | #' ylab("Total") 20 | #' 21 | #' library(dplyr) 22 | #' mtcars2 <- mtcars %>% group_by(cyl) %>% summarise(n=length(cyl)) 23 | #' ggplot(mtcars2, aes(y=as.factor(cyl), x=n)) + 24 | #' geom_point() + 25 | #' theme_apa() + 26 | #' x0(16) 27 | #' 28 | #' ggplot(mtcars, aes(x=hp, y=mpg)) + 29 | #' geom_point() + 30 | #' theme_apa() + 31 | #' x0(max(mtcars$hp) + 10) + 32 | #' y0(max(mtcars$mpg) + 5) 33 | #' } 34 | axis0 <- function(max, scale = "continuous", axis = "y") { 35 | 36 | fun <- match.fun(sprintf("scale_%s_%s", axis, scale)) 37 | fun(expand = c(0,0), limits = c(0, max)) 38 | 39 | } 40 | 41 | #' Adjust Space Between Axis in ggplot2 42 | #' 43 | #' \code{x0} - Adjust Space Between x Axis in ggplot2. 44 | #' 45 | #' @export 46 | #' @rdname axis0 47 | x0 <- function(max, scale = "continuous") { 48 | 49 | axis0(max, scale = scale, axis = "x") 50 | 51 | } 52 | 53 | #' Adjust Space Between Axis in ggplot2 54 | #' 55 | #' \code{y0} - Adjust Space Between y Axis in ggplot2. 56 | #' 57 | #' @export 58 | #' @rdname axis0 59 | y0 <- function(max, scale = "continuous") { 60 | 61 | axis0(max, scale = scale, axis = "y") 62 | 63 | } 64 | -------------------------------------------------------------------------------- /man/qgrid.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/qgrid.R 3 | \name{qgrid} 4 | \alias{qgrid} 5 | \title{Quickly Set ggplot2 panel.grid} 6 | \usage{ 7 | qgrid(xmaj = "grey94", xmin = "grey94", ymaj = "grey94", 8 | ymin = "grey94", x, y) 9 | } 10 | \arguments{ 11 | \item{xmaj}{A colour choice for panel.grid.major.x. Use \code{NULL} to 12 | remove.} 13 | 14 | \item{xmin}{A colour choice for panel.minor.x. Use \code{NULL} to remove.} 15 | 16 | \item{ymaj}{A colour choice for panel.grid.major.y. Use \code{NULL} to 17 | remove.} 18 | 19 | \item{ymin}{A colour choice for panel.minor.y. Use \code{NULL} to remove.} 20 | 21 | \item{x}{A colour choice. Sets both panel.grid.major.x and panel.minor.x. 22 | Overrides \code{xmin} and \code{xmax}. Use \code{NULL} to remove.} 23 | 24 | \item{y}{A colour choice. Sets both panel.grid.major.y and panel.minor.y. 25 | Overrides \code{ymin} and \code{ymax}. Use \code{NULL} to remove.} 26 | } 27 | \description{ 28 | Set ggplot2's panel.grid quickly. 29 | } 30 | \examples{ 31 | \dontrun{ 32 | ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 33 | geom_bar() + 34 | theme_apa() + 35 | y0(cushion(as.factor(mtcars$cyl))) + 36 | xlab("Cylinders") + 37 | ylab("Total") + qgrid() 38 | 39 | ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 40 | geom_bar() + 41 | theme_apa() + 42 | y0(cushion(as.factor(mtcars$cyl))) + 43 | xlab("Cylinders") + 44 | ylab("Total") + qgrid(x=NULL) 45 | 46 | ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 47 | geom_bar() + 48 | theme_apa() + 49 | y0(cushion(as.factor(mtcars$cyl))) + 50 | xlab("Cylinders") + 51 | ylab("Total") + qgrid(x=NULL, y="red") 52 | } 53 | } 54 | \seealso{ 55 | \code{\link[ggplot2]{theme}} 56 | } 57 | \keyword{gridelines} 58 | -------------------------------------------------------------------------------- /R/plot2drop.R: -------------------------------------------------------------------------------- 1 | #' Plot to Drop Box 2 | #' 3 | #' A wrapper to plotting device for easy plotting to Drop Box. 4 | #' 5 | #' @param name The name of the plot (no file extension needed). 6 | #' @param type The type of plotting device (png, pdf, etc). 7 | #' @param width Width of plot. 8 | #' @param height Height of plot. 9 | #' @param open logical. If \code{TRUE} provides the code to open the plot in 10 | #' default browser. 11 | #' @param loc The path to the location of the dropbox public folder. 12 | #' @param key The dropbox key. 13 | #' @param \ldots Other arguments passed to the plotting device in type. 14 | #' @details Plots to Drop Box and returns the URL to the plot (and optionally 15 | #' opens the plot). Code attemoted to be copied to the clipboard. 16 | #' @export 17 | #' @examples 18 | #' \dontrun{ 19 | #' plot2drop("dfg") 20 | #' plot(1:10) 21 | #' dev.off() 22 | #' } 23 | plot2drop <- 24 | function(name, type = "png", width = 400, height = 400, open = TRUE, 25 | loc = getOption("dropbox_path"), key = getOption("dropbox_key"), ...){ 26 | name <- as.character(substitute(name)) 27 | if (missing(name)) { 28 | stop("must specify a name") 29 | } 30 | if (is.null(getOption("dropbox_path"))) { 31 | stop("must specify a loc (Dropbox Location)") 32 | } 33 | if (is.null(getOption("dropbox_key"))) { 34 | stop("must specify a key (Dropbox Key)") 35 | } 36 | what <- paste0(name, ".", type) 37 | loc <- file.path(loc, what) 38 | dev <- match.fun(type) 39 | dev(loc, width, height, ...) 40 | w <- "dev.off()" 41 | x <- paste0("plotflow:::write_clip(\"https://dl.dropboxusercontent.com/u/", key, 42 | "/", what, "\")") 43 | y <- NULL 44 | if (open) { 45 | y <- paste0("browseURL(\"https://dl.dropboxusercontent.com/u/", key, 46 | "/", what, "\")\n") 47 | } 48 | z <- paste(w, x, y, sep="\n") 49 | write_clip(z) 50 | message(z) 51 | } 52 | -------------------------------------------------------------------------------- /man/yes_no_bar.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/yes_no_bar.R 3 | \name{yes_no_bar} 4 | \alias{yes_no_bar} 5 | \title{Two Choice Horizontal Stacked Bar} 6 | \usage{ 7 | yes_no_bar(n.yes, n.no = NULL, n = NULL, labs = c("Yes", "No"), 8 | digits = 1, fill = c("#51A651", "white"), color = "#CAE4CA", 9 | border = "grey70", size = 10, include.percent = c(TRUE, FALSE)) 10 | } 11 | \arguments{ 12 | \item{n.yes}{Number yes (integer). User must supply 2 of the first three 13 | parameters (\code{n.yes}, \code{n.no}, or \code{n}).} 14 | 15 | \item{n.no}{Number no (integer).} 16 | 17 | \item{n}{Total number (integer).} 18 | 19 | \item{labs}{The labels to use for the two choices that correspond to 20 | \code{n.yes} and \code{n.no}.} 21 | 22 | \item{digits}{Digits to use in the percents.} 23 | 24 | \item{fill}{The bar fill colors} 25 | 26 | \item{color}{The text color.} 27 | 28 | \item{border}{The border color.} 29 | 30 | \item{size}{The text size.} 31 | 32 | \item{include.percent}{A logical vector of 1-2 (if 1 the second will be 33 | \code{FALSE}) stating if percents should be included. The length of 2 34 | corresponds to the 2 choices; \code{n.yes} and \code{n.no}. If a single value 35 | is given it is recycled.} 36 | } 37 | \value{ 38 | Returns a \code{ggplot} object. 39 | } 40 | \description{ 41 | Create a two choice horizontal stacked bar chart in the style of base graphics. 42 | Default color scheme makes it easy to throw into slides and posters as an 43 | infographic style plot. 44 | } 45 | \examples{ 46 | yes_no_bar(111, 66) 47 | yes_no_bar(111, 66, fill=c("pink", "ivory"), color="purple") 48 | yes_no_bar(55, n = 166, labs = c("True", "False")) 49 | yes_no_bar(2345, 3456, labs = c("Boy", "Girl"), fill=c("lightblue", "pink"), 50 | color="grey50", include.percent = TRUE) 51 | yes_no_bar(2345, 3456, labs = c("Boy", "Girl"), fill=c("lightblue", "pink"), 52 | color="grey50", include.percent = FALSE) 53 | yes_no_bar(9999, n = 22166, fill=c("green", "pink"), 54 | labs = c("Go:", "Stop"), color = "grey30", digits=0) 55 | } 56 | \keyword{bar} 57 | \keyword{infographic} 58 | -------------------------------------------------------------------------------- /R/theme_basic.R: -------------------------------------------------------------------------------- 1 | #' ggplot2 Theme with No Background or Gridlines. 2 | #' 3 | #' A ggplot2 theme with no background and no gridlines. 4 | #' 5 | #' @param x logical. If \code{TRUE} vertical gridlines are added. 6 | #' @param y logical. If \code{TRUE} horizontal gridlines are added. 7 | #' @param plot.box logical. If \code{TRUE} a full box surrounds the plot area. If \code{FALSE} only the x and y axis are shown. 8 | #' @note Both x and y can not be \code{TRUE}. Use 9 | #' \code{\link[ggplot2]{theme_bw}} instead. 10 | #' @export 11 | #' @seealso \code{\link[ggplot2]{theme}} 12 | #' @importFrom ggplot2 theme_bw theme element_blank element_line element_rect 13 | #' @examples 14 | #' ggplot(mtcars, aes(factor(cyl))) + geom_bar() + theme_basic() 15 | #' ggplot(mtcars, aes(factor(cyl))) + geom_bar() + theme_basic(x = TRUE) 16 | #' ggplot(mtcars, aes(factor(cyl))) + geom_bar() + theme_basic(y = TRUE) 17 | #' ggplot(mtcars, aes(factor(cyl))) + geom_bar() + theme_basic(x = TRUE, y = TRUE) 18 | theme_basic <- function(x = FALSE, y = FALSE, plot.box = FALSE) { 19 | a <- theme_bw() 20 | if (!x && !y) { 21 | b <- a + theme(panel.grid.major = element_blank(), 22 | panel.grid.minor = element_blank()) 23 | } else { 24 | if (!x && y) { 25 | b <- a + theme(panel.grid.major.x = element_blank(), 26 | panel.grid.minor.x = element_blank()) 27 | } else { 28 | if (x && !y) { 29 | b <- a + theme(panel.grid.major.y = element_blank(), 30 | panel.grid.minor.y = element_blank()) 31 | } else { 32 | return(message("`x` and `y` set to TRUE; use `theme_bw()` instead")) 33 | } 34 | } 35 | } 36 | if (!plot.box) { 37 | b <- b + theme(panel.background = element_rect(fill = "white", 38 | colour = "black"), panel.border = element_rect(fill = NA, 39 | colour = "white"), axis.line = element_line()) 40 | } else { 41 | b <- b + theme(panel.background = element_rect(fill = "white", 42 | colour = "white"), panel.border = element_rect(fill = NA, 43 | colour = "grey50")) 44 | } 45 | b 46 | } 47 | -------------------------------------------------------------------------------- /R/qgrid.R: -------------------------------------------------------------------------------- 1 | #' Quickly Set ggplot2 panel.grid 2 | #' 3 | #' Set ggplot2's panel.grid quickly. 4 | #' 5 | #' @param xmaj A colour choice for panel.grid.major.x. Use \code{NULL} to 6 | #' remove. 7 | #' @param xmin A colour choice for panel.minor.x. Use \code{NULL} to remove. 8 | #' @param ymaj A colour choice for panel.grid.major.y. Use \code{NULL} to 9 | #' remove. 10 | #' @param ymin A colour choice for panel.minor.y. Use \code{NULL} to remove. 11 | #' @param x A colour choice. Sets both panel.grid.major.x and panel.minor.x. 12 | #' Overrides \code{xmin} and \code{xmax}. Use \code{NULL} to remove. 13 | #' @param y A colour choice. Sets both panel.grid.major.y and panel.minor.y. 14 | #' Overrides \code{ymin} and \code{ymax}. Use \code{NULL} to remove. 15 | #' @importFrom ggplot2 theme element_blank element_line 16 | #' @keywords gridelines 17 | #' @export 18 | #' @seealso \code{\link[ggplot2]{theme}} 19 | #' @examples 20 | #' \dontrun{ 21 | #' ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 22 | #' geom_bar() + 23 | #' theme_apa() + 24 | #' y0(cushion(as.factor(mtcars$cyl))) + 25 | #' xlab("Cylinders") + 26 | #' ylab("Total") + qgrid() 27 | #' 28 | #' ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 29 | #' geom_bar() + 30 | #' theme_apa() + 31 | #' y0(cushion(as.factor(mtcars$cyl))) + 32 | #' xlab("Cylinders") + 33 | #' ylab("Total") + qgrid(x=NULL) 34 | #' 35 | #' ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 36 | #' geom_bar() + 37 | #' theme_apa() + 38 | #' y0(cushion(as.factor(mtcars$cyl))) + 39 | #' xlab("Cylinders") + 40 | #' ylab("Total") + qgrid(x=NULL, y="red") 41 | #' } 42 | qgrid <- function(xmaj="grey94", xmin="grey94", ymaj="grey94", ymin="grey94", x, y) { 43 | 44 | if (!missing(x)) { 45 | xmaj <- xmin <- x 46 | } 47 | 48 | if (!missing(y)) { 49 | ymaj <- ymin <- y 50 | } 51 | 52 | funs <- lapply(list(xmaj, xmin, ymaj, ymin), function(x) { 53 | if (is.null(x)) { 54 | element_blank() 55 | } else { 56 | element_line(colour = x) 57 | } 58 | }) 59 | 60 | theme( 61 | panel.grid.major.x = funs[[1]], 62 | panel.grid.minor.x = funs[[2]], 63 | panel.grid.major.y = funs[[3]], 64 | panel.grid.minor.y = funs[[4]] 65 | ) 66 | 67 | } 68 | -------------------------------------------------------------------------------- /man/reorder_by.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reorder_by.R 3 | \name{reorder_by} 4 | \alias{reorder_by} 5 | \title{Order a Factor by Numeric Variable(s)} 6 | \usage{ 7 | reorder_by(fact, by, data, FUN = NULL, df = TRUE) 8 | } 9 | \arguments{ 10 | \item{fact}{The factor to be reordered (re-leveled).} 11 | 12 | \item{by}{A formula to order the factor by.} 13 | 14 | \item{data}{A \code{data.frame} object.} 15 | 16 | \item{FUN}{A function to compute the summary statistics which can be applied 17 | to all data subsets.} 18 | 19 | \item{df}{logical. If \code{TRUE} a dataframe is returned. If \code{FALSE} 20 | a factor vector is returned.} 21 | } 22 | \value{ 23 | Returns a re-ordered (re-leveled) dataframe, factor vector, or levels. 24 | } 25 | \description{ 26 | Create a new dataframe with a factor reordered (re-leveled) by numeric 27 | variable(s). 28 | } 29 | \examples{ 30 | \dontrun{ 31 | ## EXAMPLE 1 - no aggregation ## 32 | 33 | ## Make a fake data set 34 | dat <- aggregate(cbind(mpg, hp, disp)~carb, mtcars, mean) 35 | dat$carb <- factor(dat$carb) 36 | 37 | ## compare levels (data set looks the same though) 38 | dat$carb 39 | reorder_by(carb, ~-hp + -mpg, data = dat)$carb 40 | 41 | library(ggplot2) 42 | ## Unordered bars 43 | ggplot(dat, aes(x=carb, y=mpg)) + 44 | geom_bar(stat="identity") + 45 | coord_flip() 46 | 47 | ## Ordered bars 48 | ggplot(reorder_by(carb, ~mpg, dat), aes(x=carb, y=mpg)) + 49 | geom_bar(stat="identity") + 50 | coord_flip() 51 | 52 | ## Return just the vector with new levels 53 | reorder_by(carb, ~-hp + -mpg, dat, df=FALSE) 54 | 55 | ## EXAMPLE 2 - with aggregation ## 56 | 57 | mtcars2 <- reorder_by(gear, ~hp + -carb, mtcars, mean) 58 | 59 | ## Without re-leveling gear 60 | ggplot(mtcars, aes(mpg, hp)) + 61 | geom_point(aes(color=factor(cyl))) + 62 | facet_grid(gear~.) 63 | 64 | ## After re-leveling gear 65 | ggplot(mtcars2, aes(mpg, hp)) + 66 | geom_point(aes(color=factor(cyl))) + 67 | facet_grid(gear~.) 68 | } 69 | } 70 | \references{ 71 | The majority of this code is taken directly from Thomas Wutzler's 72 | blog post that has since been removed/redirected. 73 | } 74 | \author{ 75 | Thomas Wutzler and Tyler Rinker . 76 | } 77 | \keyword{factor} 78 | \keyword{order} 79 | \keyword{plot} 80 | \keyword{sort} 81 | -------------------------------------------------------------------------------- /R/theme_apa.R: -------------------------------------------------------------------------------- 1 | #' ggplot2 Theme for APA Publications 2 | #' 3 | #' A ggplot2 theme with no background and Times New Roman font. 4 | #' 5 | #' @param plot.box logical. If \code{TRUE} a full box surrounds the plot area. If \code{FALSE} only the x and y axis are shown. 6 | #' @export 7 | #' @seealso \code{\link[ggplot2]{theme}} 8 | #' @importFrom ggplot2 theme_bw theme element_blank element_text element_line element_rect 9 | #' @examples 10 | #' \dontrun{ 11 | #' ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 12 | #' geom_bar() + 13 | #' theme_apa() + 14 | #' y0(cushion(as.factor(mtcars$cyl))) + 15 | #' xlab("Cylinders") + 16 | #' ylab("Total") 17 | #' 18 | #' ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 19 | #' geom_bar() + 20 | #' theme_apa(plot.box=T) + 21 | #' y0(cushion(as.factor(mtcars$cyl))) + 22 | #' xlab("Cylinders") + 23 | #' ylab("Total") 24 | #' 25 | #' ggplot(reorder_by(cyl, ~-cyl , mtcars, length), aes(x=as.factor(cyl))) + 26 | #' geom_bar() + 27 | #' theme_basic() + 28 | #' theme_apa() + 29 | #' y0(cushion(as.factor(mtcars$cyl))) + 30 | #' xlab("Cylinders") + 31 | #' ylab("Total") 32 | #' } 33 | theme_apa <- function(plot.box = FALSE){ 34 | 35 | if (Sys.info()["sysname"] != "Windows") { 36 | windowsFonts <- NULL 37 | } 38 | 39 | if (Sys.info()["sysname"] == "Windows") { 40 | grDevices::windowsFonts(RMN=grDevices::windowsFont("Times New Roman")) 41 | RMN <- "RMN" 42 | } else { 43 | RMN <- "Times New Roman" 44 | } 45 | 46 | out <- theme( 47 | plot.title=element_text(family=RMN, size=14, face="bold", colour="black"), 48 | axis.title.x=element_text(family=RMN, size=14, colour="black"), 49 | axis.title.y=element_text(family=RMN, size=14, angle=90, colour="black"), 50 | axis.text.x=element_text(family=RMN, size=11, colour="black"), 51 | axis.text.y=element_text(family=RMN, size=11, colour="black"), 52 | axis.ticks=element_line(colour="black")) 53 | 54 | if (!plot.box) { 55 | out <- out + theme(panel.background = element_rect(fill = "white", 56 | colour = "black"), panel.border = element_rect(fill = NA, 57 | colour = "white"), axis.line = element_line()) 58 | } else { 59 | out <- out + theme(panel.background = element_rect(fill = "white", 60 | colour = "white"), panel.border = element_rect(fill = NA, 61 | colour = "grey50")) 62 | } 63 | out 64 | 65 | } 66 | -------------------------------------------------------------------------------- /R/merge_pdf.R: -------------------------------------------------------------------------------- 1 | #' Merge Different Sized Plots 2 | #' 3 | #' Allows for merging of different sized R plots. 4 | #' 5 | #' @param n.plots The number of plots to be combined. 6 | #' @param file A connection, or a character string naming the file to print to. 7 | #' @param widths A vector of widths equal to \code{n.plots} or a single value 8 | #' that will be used for all plot widths. 9 | #' @param heights A vector of heights equal to \code{n.plots} or a single value 10 | #' that will be used for all plot widths. 11 | #' @param n.lines A vector of integer values indicating the number of lines each 12 | #' plotting sequence will take. Default is 1 line each. 13 | #' @return Returns a single combined plot of various sizes. 14 | #' @note To use with ggplot the plotting sequence must be wrapped with 15 | #' \code{plot()}. 16 | #' @keywords plot 17 | #' @importFrom grDevices dev.off pdf 18 | #' @export 19 | #' @examples 20 | #' \dontrun{ 21 | #' merge_pdf(3, file = "foo.pdf", widths = c(7, 7, 10), heights = c(6, 10, 7)) 22 | #' plot(1:10) 23 | #' plot(1:10, pch=19) 24 | #' plot(1:10, col="red", pch=19) 25 | #' 26 | #' library(ggplot2) 27 | #' p <- ggplot(mtcars, aes(factor(cyl), mpg)) + geom_boxplot() 28 | #' merge_pdf(2, file = "bar.pdf", widths = c(7, 10), heights = c(6, 10)) 29 | #' plot(1:10) 30 | #' print(p) 31 | #' } 32 | merge_pdf <- 33 | function(n.plots, file, widths = 8, heights = 8, n.lines = 1) { 34 | xs <- c(n.plots, 1) 35 | if ((!length(widths) %in% xs) || (!length(heights) %in% xs) || (!length(n.lines) %in% xs)) { 36 | stop("widths and heights must be length 1 or equal to n.plots") 37 | } 38 | if (length(widths) == 1) { 39 | widths <- rep(widths, n.plots) 40 | } 41 | if (length(heights) == 1) { 42 | heights <- rep(heights, n.plots) 43 | } 44 | if (length(n.lines) == 1) { 45 | n.lines <- rep(n.lines, n.plots) 46 | } 47 | if (n.plots < 2) stop("Must have > 2 plots") 48 | files <- tempfile(fileext = rep.int(".pdf", n.plots)) 49 | invisible(lapply(1:n.plots, function(i) { 50 | pdf(file=files[i], width = widths[i], height = heights[i]) 51 | # Reads string interactively 52 | cat(paste("Enter plot ", i, ":\n", sep="")) 53 | input <- readLines(n=n.lines[i]) 54 | # Executes `input` as a command (possibly, needs extra check) 55 | eval(parse(text=input)) 56 | dev.off() 57 | })) 58 | mergePDF(in.file = files, file = file) 59 | unlink(files, recursive = TRUE, force = FALSE) 60 | cat("\n") 61 | cat(paste(file, "written to:", paste0(getwd(), "/", file, "\n"))) 62 | } 63 | -------------------------------------------------------------------------------- /inst/maintenance.R: -------------------------------------------------------------------------------- 1 | #======== 2 | # BUILD 3 | #======== 4 | source("inst/build.R") 5 | 6 | #========================== 7 | # Run unit tests 8 | #========================== 9 | devtools::test() 10 | 11 | #========================== 12 | # knit README.md 13 | #========================== 14 | rmarkdown::render("README.Rmd", "all"); md_toc() 15 | 16 | #========================== 17 | # Make vignette 18 | #========================== 19 | source("inst/vign_stuff/vign_build.R") 20 | 21 | #========================== 22 | # UPDATE NEWS 23 | #========================== 24 | update_news() 25 | 26 | #========================== 27 | # UPDATE VERSION 28 | #========================== 29 | update_version() 30 | 31 | #======================== 32 | #staticdocs dev version 33 | #======================== 34 | 35 | if (!require("pacman")) install.packages("pacman") 36 | pacman::p_load_gh("hadley/staticdocs", "trinker/acc.roxygen2") 37 | p_load(rstudioapi, qdap) 38 | 39 | R_USER <- switch(Sys.info()[["user"]], 40 | Tyler = "C:/Users/Tyler", 41 | trinker = "C:/Users/trinker", 42 | message("Computer name not found") 43 | ) 44 | build_site(pkg=file.path(R_USER, "GitHub", basename(getwd())), launch = FALSE) 45 | 46 | #STEP 2: reshape index 47 | path <- "inst/web" 48 | path2 <- file.path(path, "/index.html") 49 | rdme <- file.path(R_USER, "GitHub", basename(getwd()), "inst/extra_statdoc/readme.R") 50 | 51 | extras <- qcv("") 52 | ## drops <- qcv() 53 | expand_statdoc(path2, to.icon = extras, readme = rdme) 54 | 55 | x <- readLines(path2) 56 | x[grepl("

Authors

", x)] <- paste( 57 | c("

Author

" 58 | #rep("

Contributor

", 1) 59 | ), 60 | c("Tyler W. Rinker") 61 | ) 62 | 63 | cat(paste(x, collapse="\n"), file=path2) 64 | 65 | #STEP 3: move to trinker.guthub 66 | library(reports) 67 | file <- file.path(R_USER, "/GitHub/trinker.github.com") 68 | # incoming <- file.path(file, basename(getwd())) 69 | delete(incoming) 70 | file.copy(path, file, TRUE, TRUE) 71 | file.rename(file.path(file, "web"), incoming) 72 | ## delete(path) 73 | 74 | #========================== 75 | #staticdocs current version 76 | #========================== 77 | 78 | #STEP 3: move to trinker.guthub 79 | library(reports) 80 | file <- file.path(R_USER, "/GitHub/trinker.github.com") 81 | incoming <- file.path(file, "discon") 82 | ## delete(incoming); file.copy(path, file, TRUE, TRUE); file.rename(file.path(file, "web"), incoming) 83 | 84 | #========================== 85 | # NEWS new version 86 | #========================== 87 | x <- c("BUG FIXES", "NEW FEATURES", "MINOR FEATURES", "IMPROVEMENTS", "CHANGES") 88 | cat(paste(x, collapse = "\n\n"), file="clipboard") 89 | 90 | 91 | 92 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | write_clip <- function(x) { 2 | ## The code for this helper function comes from the oveRflow package. 3 | ## # https://raw.github.com/sebastian-c/oveRflow/master/R/writeClip.R 4 | ## This is code I submitted but was modified by the package maintainers. 5 | ## The idea to keep this function as a modular unit makes sense and was 6 | ## subsequently applied to the reports package 7 | 8 | OS <- Sys.info()["sysname"] 9 | 10 | if(!(OS %in% c("Darwin", "Windows", "Linux"))) { 11 | stop("Copying to clipboard not supported on your OS") 12 | } 13 | 14 | if (OS != "Windows") { 15 | writeClipboard <- NULL 16 | } 17 | 18 | switch(OS, 19 | "Darwin"={j <- pipe("pbcopy", "w") 20 | writeLines(x, con = j) 21 | close(j) 22 | }, 23 | "Windows"=writeClipboard(x, format = 1), 24 | "Linux"={ 25 | if(Sys.which("xclip") == "") { 26 | stop("Clipboard on Linux requires 'xclip'. Try using:\nsudo apt-get install xclip") 27 | } 28 | con <- pipe("xclip -i", "w") 29 | writeLines(x, con=con) 30 | close(con) 31 | } 32 | ) 33 | } 34 | 35 | read_clip <- function() { 36 | ## The code for this helper function comes from the oveRflow package. 37 | ## # https://raw.github.com/sebastian-c/oveRflow/master/R/writeClip.R 38 | ## This is code I submitted but was modified by the package maintainers. 39 | ## The idea to keep this function as a modular unit makes sense and was 40 | ## subsequently applied to the reports package 41 | 42 | OS <- Sys.info()["sysname"] 43 | 44 | if (OS != "Windows") { 45 | readClipboard <- NULL 46 | } 47 | 48 | 49 | switch(OS, 50 | "Darwin" = {j <- pipe("pbcopy", "w") 51 | pcon <- pipe("pbpaste") 52 | out <- scan(pcon, what="character", quiet=TRUE) 53 | close(pcon) 54 | }, 55 | "Windows" = {out <- readClipboard()}, 56 | out <- readLines("clipboard") 57 | ) 58 | out 59 | } 60 | 61 | pp <- function(x, digits = getOption("digit_digits")) { 62 | 63 | f(x, digits = digits, e="%") 64 | } 65 | 66 | pc <- function(x, big.mark = ",", ...) { 67 | 68 | prettyNum(x, big.mark, ...) 69 | } 70 | 71 | 72 | f <- function(x, digits = getOption("digit_digits"), s, e) { 73 | 74 | if (is.null(digits)) digits <- 3 75 | 76 | if(length(digits) > 1) { 77 | digits <- digits[1] 78 | warning("Using only digits[1]") 79 | } 80 | 81 | x <- round(as.numeric(x), digits) 82 | 83 | if (digits > 0) x <- sprintf(paste0("%.", digits, "f"), x) 84 | out <- gsub("^0(?=\\.)|(?<=-)0", "", x, perl=TRUE) 85 | out[out == "NA"] <- NA 86 | if (!missing(s)) out <- paste0(s, out) 87 | if (!missing(e)) out <- paste0(out, e) 88 | out 89 | } 90 | -------------------------------------------------------------------------------- /man/ggfaxt.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggfaxt.R 3 | \name{ggfaxt} 4 | \alias{ggfaxt} 5 | \title{Add Text to a Faceted ggplot2 Plot} 6 | \usage{ 7 | ggfaxt(ggplot2.object, x.coord = NULL, y.coord = NULL, labels = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{ggplot2.object}{a faceted ggplot2 object or an object returned from 11 | qfacet_text} 12 | 13 | \item{x.coord}{a single x coordinate to be repeated or a vector of x 14 | coordinates equal to the number of facets} 15 | 16 | \item{y.coord}{a single y coordinate to be repeated or a vector of y 17 | coordinates equal to the number of facets} 18 | 19 | \item{labels}{a vector of labels to place on each facet} 20 | 21 | \item{\ldots}{additional arguments accepted by geom_text} 22 | } 23 | \value{ 24 | Returns a plot of class "gg" "ggplot" with annotations. Also 25 | invisibly returns a list object of the class qfacet with the following items: 26 | \itemize{ 27 | \item{original} {the Original ggplot2 object} 28 | \item{new} {the new ggplot object} 29 | \item{dat} {the mini data frame created for the text} 30 | } 31 | } 32 | \description{ 33 | A ggplot2 wrapper for adding text to facets. 34 | } 35 | \examples{ 36 | #alter mtcars to make some variables factors 37 | mtcars2 <- mtcars 38 | mtcars2[, c("cyl", "am", "gear")] <- lapply(mtcars[, 39 | c("cyl", "am", "gear")], as.factor) 40 | 41 | p <- ggplot(mtcars2, aes(mpg, wt, group = cyl)) + 42 | geom_line(aes(color=cyl)) + 43 | geom_point(aes(shape=cyl)) + 44 | facet_grid(gear ~ am) + 45 | theme_bw() 46 | 47 | z <- ggfaxt(ggplot2.object = p, x.coor = 33, y.coor = 2.2, 48 | labels = 1:6, color="red") 49 | #approach 1 (alter the text data frame and pass the qfacet object) 50 | z$dat[5, 1:2] <- c(15, 5) 51 | ggfaxt(z, color="red") 52 | 53 | #approach 2 (alter the original ggplot object) 54 | ggfaxt(p, x = c(33, 33, 33, 33, 15, 33), 55 | y = c(2.2, 2.2, 2.2, 2.2, 5, 2.2), 1:6, color="red") 56 | 57 | #use "" to not add a label to a facet 58 | ggfaxt(ggplot2.object = p, x.coor = 33, y.coor = 2.2, 59 | labels = c("", letters[1:4], ""), color="red") 60 | 61 | #all the same things you can pass to geom_text qfacet_text takes 62 | ggfaxt(z, labels = paste("beta ==", 1:6), 63 | size = 3, color = "grey50", parse = TRUE) 64 | 65 | #two labels: same plot 66 | p <- ggplot(CO2, aes(conc, uptake, group = Plant)) + 67 | geom_line(aes(color=Plant)) + 68 | facet_grid(Type ~ Treatment) + 69 | theme_bw() 70 | 71 | #plot first text layer 72 | z <- ggfaxt(ggplot2.object = p, x.coor = 250, y.coor = 10, 73 | labels = 1:4, color="red") 74 | 75 | #plot second text layer 76 | ggfaxt(ggplot2.object = z$new, x.coor = 900, y.coor = 10, 77 | labels = paste("beta ==", 11:14), color="blue", parse = TRUE) 78 | } 79 | \seealso{ 80 | \code{\link[ggplot2]{geom_text}} 81 | } 82 | \keyword{facet} 83 | \keyword{ggplot2} 84 | \keyword{text} 85 | -------------------------------------------------------------------------------- /R/unbalanced_facet_axis.R: -------------------------------------------------------------------------------- 1 | #' Add Tick Marks to an Unbalanced facet_wrap 2 | #' 3 | #' Adds the tick marks to an unbalanced grouping of 4 | #' \code{\link[ggplot2]{facet_wrap}} plots. 5 | #' 6 | #' @param ggplot_obj An unbalanced ggplot2 \code{\link[ggplot2]{facet_wrap}} 7 | #' object. 8 | #' @param position Either \code{"up"} (match unbalanced facet's position, 9 | #' as is the default of ggplot2) or \code{"down"} (along bottom most axis). 10 | #' @author Original by \href{http://stackoverflow.com/users/1320535/julius}{Julius} 11 | #' (stackoverflow.com). Updated by Mikko Korpela for ggplot2 >= 2.2.0. 12 | #' @references \url{http://stackoverflow.com/a/13316126/1000343} 13 | #' @keywords facet_wrap axis 14 | #' @importFrom ggplot2 ggplot_build ggplot_gtable 15 | #' @export 16 | #' @examples 17 | #' set.seed(2) 18 | #' mtcars2 <- mtcars 19 | #' mtcars2[["new"]] <- sample(LETTERS[1:7], nrow(mtcars), TRUE) 20 | #' 21 | #' library(ggplot2) 22 | #' 23 | #' unbalanced_facet_axis(ggplot(mtcars2, aes(x=mpg, y=hp)) + 24 | #' geom_line() + 25 | #' facet_wrap(~new, ncol=2)) 26 | #' 27 | #' unbalanced_facet_axis(ggplot(mtcars2, aes(x=mpg, y=hp)) + 28 | #' geom_line() + 29 | #' facet_wrap(~new, ncol=3), "down") 30 | unbalanced_facet_axis <- function(ggplot_obj, position = c("up", "down")) { 31 | pos <- match.arg(position) 32 | gb <- ggplot_build(ggplot_obj) 33 | gt <- ggplot_gtable(gb) 34 | ## Nothing done for position == "up" (nowadays default in ggplot2) 35 | if (pos == "down") { 36 | layout <- gt$layout 37 | layout_names <- layout$name 38 | grob_names <- vapply(gt$grobs, `[[`, "", "name") 39 | idx_axb <- which(grepl("^axis-b", layout_names) & grob_names != "NULL") 40 | t_axb <- layout$t[idx_axb] 41 | b_axb <- layout$b[idx_axb] 42 | max_t <- max(t_axb) 43 | max_b <- max(b_axb) 44 | layout$t[idx_axb] <- max_t 45 | layout$b[idx_axb] <- max_b 46 | gt$layout <- layout 47 | } 48 | class(gt) <- c("unbalanced_facet_axis", class(gt)) 49 | gt 50 | } 51 | 52 | #' Plots an unbalanced_facet_axis object. 53 | #' 54 | #' Plots an unbalanced_facet_axis object. 55 | #' 56 | #' @param x The unbalanced_facet_axis object 57 | #' @param newpage logical. If \code{TRUE} \code{\link[grid]{grid.newpage}} is called. 58 | #' @param viewport logical. If character \code{\link[grid]{seekViewport}} is 59 | #' used. If an object \code{\link[grid]{pushViewport}} is used. If \code{NULL} 60 | #' neither viewport is used. 61 | #' @param \ldots ignored 62 | #' @export 63 | #' @method plot unbalanced_facet_axis 64 | plot.unbalanced_facet_axis <- function(x, newpage = is.null(viewport), viewport = NULL, ...) { 65 | NextMethod("plot", NULL, newpage = newpage, vp = viewport, ...) 66 | } 67 | 68 | #' Prints an unbalanced_facet_axis object. 69 | #' 70 | #' Calls \code{\link{plot}} with the same arguments. 71 | #' 72 | #' @param x The unbalanced_facet_axis object 73 | #' @param \ldots arguments passed to the plot method 74 | #' @export 75 | #' @method print unbalanced_facet_axis 76 | print.unbalanced_facet_axis <- function(x, ...) { 77 | plot(x, ...) 78 | } 79 | -------------------------------------------------------------------------------- /R/yes_no_bar.R: -------------------------------------------------------------------------------- 1 | #' Two Choice Horizontal Stacked Bar 2 | #' 3 | #' Create a two choice horizontal stacked bar chart in the style of base graphics. 4 | #' Default color scheme makes it easy to throw into slides and posters as an 5 | #' infographic style plot. 6 | #' 7 | #' @param n.yes Number yes (integer). User must supply 2 of the first three 8 | #' parameters (\code{n.yes}, \code{n.no}, or \code{n}). 9 | #' @param n.no Number no (integer). 10 | #' @param n Total number (integer). 11 | #' @param labs The labels to use for the two choices that correspond to 12 | #' \code{n.yes} and \code{n.no}. 13 | #' @param digits Digits to use in the percents. 14 | #' @param fill The bar fill colors 15 | #' @param color The text color. 16 | #' @param border The border color. 17 | #' @param size The text size. 18 | #' @param include.percent A logical vector of 1-2 (if 1 the second will be 19 | #' \code{FALSE}) stating if percents should be included. The length of 2 20 | #' corresponds to the 2 choices; \code{n.yes} and \code{n.no}. If a single value 21 | #' is given it is recycled. 22 | #' @return Returns a \code{ggplot} object. 23 | #' @keywords bar infographic 24 | #' @importFrom utils head 25 | #' @export 26 | #' @examples 27 | #' yes_no_bar(111, 66) 28 | #' yes_no_bar(111, 66, fill=c("pink", "ivory"), color="purple") 29 | #' yes_no_bar(55, n = 166, labs = c("True", "False")) 30 | #' yes_no_bar(2345, 3456, labs = c("Boy", "Girl"), fill=c("lightblue", "pink"), 31 | #' color="grey50", include.percent = TRUE) 32 | #' yes_no_bar(2345, 3456, labs = c("Boy", "Girl"), fill=c("lightblue", "pink"), 33 | #' color="grey50", include.percent = FALSE) 34 | #' yes_no_bar(9999, n = 22166, fill=c("green", "pink"), 35 | #' labs = c("Go:", "Stop"), color = "grey30", digits=0) 36 | yes_no_bar <- function(n.yes, n.no = NULL, n = NULL, labs = c("Yes", "No"), 37 | digits = 1, fill = c("#51A651", "white"), color = "#CAE4CA", 38 | border = "grey70", size = 10, include.percent = c(TRUE, FALSE)){ 39 | 40 | prop <- diffs <- aes <- pos <- percent <- NULL 41 | 42 | stopifnot(sum(c(!is.null(n.yes), !is.null(n), !is.null(n.no))) > 1) 43 | 44 | if (!is.null(n)) { 45 | if (!is.null(n.yes)) { 46 | n.no <- n - n.yes 47 | } else { 48 | n.yes <- n - n.no 49 | } 50 | } 51 | 52 | if (length(include.percent) == 1) include.percent[2] <- include.percent[1] 53 | 54 | bar <- dplyr::data_frame( 55 | tagged = factor(labs, levels = labs[2:1]), 56 | n = c(n.yes, n.no), 57 | prop = n/sum(c(n.yes, n.no)), 58 | diffs = diff(c(0, cumsum(prop))), 59 | pos = head(c(0, cumsum(prop)), -1) + (0.5 * diffs), 60 | percent = ifelse(include.percent, paste0(" ", pp(prop*100, digits)), "") 61 | ) 62 | 63 | ggplot2::ggplot(bar, ggplot2::aes_string(1, fill ='tagged', y = 'prop')) + 64 | ggplot2::geom_bar(stat='identity', color=border, size=2) + 65 | ggplot2::coord_flip() + 66 | ggplot2::scale_y_continuous(label=scales::percent) + 67 | ggplot2::scale_fill_manual(values=fill[2:1]) + 68 | ggplot2::geom_text(ggplot2::aes(y =pos, label=ifelse(c(TRUE, FALSE), 69 | paste0(sprintf("%s", bar[[1]][1]), percent, "\n", pc(n)), 70 | paste0(sprintf("%s", bar[[1]][2]), percent, "\n", pc(n)) 71 | )), size=size, color=color) + 72 | ggplot2::theme_minimal() + 73 | ggplot2::theme( 74 | axis.text = ggplot2::element_blank(), 75 | axis.ticks = ggplot2::element_blank(), 76 | panel.grid = ggplot2::element_blank() 77 | ) + 78 | ggplot2::guides(fill=FALSE) + 79 | ggplot2::labs(x=NULL, y=NULL) 80 | } 81 | -------------------------------------------------------------------------------- /R/splot.R: -------------------------------------------------------------------------------- 1 | ## Generic Graphics Device 2 | ## 3 | ## \code{splot} - Save plot (splot) to graphics device based on file extension 4 | ## with sensible defaults. 5 | ## 6 | ## @param file The name of the output file. 7 | ## @param width The width in inches. 8 | ## @param height The height in inches. 9 | ## @param cairo logical. If \code{TRUE} \pkg{cairoDevice} package is used for 10 | ## supported file types. See \code{\link[cairoDevice]{Cairo}} for more details. 11 | ## @param reduce.margins logical. If \code{TRUE} margins will be reduced. 12 | ## @param bg The background color. 13 | ## @param \ldots Arguments passed to graphics devices. 14 | ## @return Sets up a graphics device using default parameters. 15 | ## @keywords plot 16 | ## @rdname splot 17 | #' @importFrom graphics par 18 | #' @importFrom grDevices dev.print 19 | ## @export 20 | ## @examples 21 | ## \dontrun{ 22 | ## plot(1:10, 1:10) 23 | ## splot() 24 | ## 25 | ## ggplot(mtcars, aes(mpg, hp)) + geom_point() 26 | ## splot() 27 | ## 28 | ## ggplot(mtcars, aes(mpg, hp)) + geom_point() 29 | ## splot("out.pdf") 30 | ## } 31 | splot <- function(file = "myPlot.png", width = 6.93, height = 6.93, 32 | cairo = FALSE, reduce.margins = TRUE, bg = "white", ...){ 33 | 34 | req <- NULL 35 | 36 | if (reduce.margins) { 37 | opar <- par()[["mar"]] 38 | par(mar=c(5,3,2,2)+0.1) 39 | } 40 | 41 | ext <- tools::file_ext(file) 42 | size <- sprintf("Image size: width %s inches x height %s inches", 43 | width, height) 44 | 45 | gd <- switch(ext, 46 | svg = list(con = 1, name = "svg"), 47 | pdf = list(con = 1, name = "pdf"), 48 | png = list(con = 72, name = "png"), 49 | tif = list(con = 72, name = "tiff"), 50 | jpg = list(con = 72, name = "jpeg"), 51 | bmp = list(con = 72, name = "bmp"), 52 | ps = list(con = 1, name = "postscript"), 53 | stop(sprintf("%s not a supported graphics device", ext)) 54 | ) 55 | if(cairo && ext == "png") gd[["con"]] <- 1 56 | if (cairo && ext %in% c("pdf", "ps", "svg", "png")) { 57 | # req <- require(cairoDevice) 58 | if (!req) { 59 | warning("carioDevice package not installed, `cario` ignored") 60 | } else { 61 | gd[["name"]] <- paste0("Cairo_", gd[["name"]]) 62 | } 63 | } 64 | if(cairo && !ext %in% c("pdf", "ps", "svg", "png")) { 65 | message(sprintf("%s not supported by cairoDevice package", 66 | gd[["name"]])) 67 | } 68 | 69 | width <- width * gd[["con"]] 70 | height <- height * gd[["con"]] 71 | 72 | graphics_dev <- match.fun(gd[["name"]]) 73 | 74 | if (ext %in% c("svg", "png", "jpg", "bmp", "tiff")){ 75 | dev.print(device=graphics_dev, filename=file, 76 | width=width, height=height, bg = bg, ...) 77 | } else { 78 | dev.print(device=graphics_dev, file=file, 79 | width=width, height=height, bg = bg, ...) 80 | } 81 | 82 | message(file, " ready to plot on ", gd[["name"]], "\n", size) 83 | } 84 | 85 | 86 | 87 | ## Generic Graphics Device 88 | ## 89 | ## \code{lsplot} - A wrapper for \code{splot} that saves the last plot to 90 | ## a graphics device. 91 | ## 92 | ## @note \code{lsplot} only works under 2 conditions (1) the last plotting 93 | ## function has the word "plot" in the function name; (2) no other functions 94 | ## were called after the plot. 95 | ## @rdname splot 96 | #' @importFrom grDevices dev.off 97 | #' @importFrom utils head tail 98 | ## @export 99 | lsplot <- function(...) { 100 | 101 | suppressMessages(splot(...) ) 102 | x <- head(ggplot2::last_plot(), -1) 103 | x <- x[tail(grep("plot", x), 1):length(x)] 104 | eval(parse(text=paste(x, collapse=" ")), envir=.GlobalEnv) 105 | dev.off() 106 | 107 | } 108 | 109 | 110 | -------------------------------------------------------------------------------- /R/theme_black.R: -------------------------------------------------------------------------------- 1 | #' ggplot2 Theme with No Background or Gridlines. 2 | #' 3 | #' A ggplot2 theme with no background and no gridlines. 4 | #' 5 | #' @param base_size The size to use for text. Various textual components are 6 | #' scaled off of this value. 7 | #' @param base_family The base font family. 8 | #' @author Jon Lefcheck (\url{http://jonlefcheck.net}) 9 | #' @references \url{http://jonlefcheck.net/2013/03/11/black-theme-for-ggplot2-2} 10 | #' @export 11 | #' @seealso \code{\link[ggplot2]{theme}} 12 | #' @importFrom ggplot2 theme_grey theme element_blank element_text element_line element_rect %+replace% 13 | #' @examples 14 | #' ggplot(mtcars, aes(factor(cyl))) + geom_bar(fill="white") + theme_black() 15 | #' dat <- data.frame(y = c(austres), time = time(austres)) 16 | #' ggplot(dat, aes(time, y)) + scale_x_continuous() + 17 | #' geom_line(color="lightblue", size=1) + theme_black() 18 | #' 19 | #' \dontrun{ 20 | #' library(maps) 21 | #' crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests) 22 | #' states_map <-map_data("state") 23 | #' 24 | #' ggplot(crimes, aes(map_id = state)) + 25 | #' geom_map(aes(fill = Murder), map = states_map) + 26 | #' expand_limits(x = states_map$long, y = states_map$lat) + 27 | #' theme_black() + 28 | #' scale_fill_gradient(low="grey10", high="white") 29 | #' } 30 | theme_black <- function(base_size=12, base_family="") { 31 | theme_grey(base_size=base_size, base_family=base_family) %+replace% 32 | theme( 33 | # Specify axis options 34 | axis.line=element_blank(), 35 | axis.text.x=element_text(size=base_size*0.8, color="grey55", 36 | lineheight=0.9, vjust=1), 37 | axis.text.y=element_text(size=base_size*0.8, color="grey55", 38 | lineheight=0.9,hjust=1), 39 | axis.ticks=element_line(color="grey55", size = 0.2), 40 | axis.title.x=element_text(size=base_size, color="grey55", vjust=1, 41 | margin=ggplot2::margin(.5, 0, 0, 0, "lines")), 42 | axis.title.y=element_text(size=base_size, color="grey55", angle=90, 43 | margin=ggplot2::margin(.5, 0, 0, 0, "lines"), vjust=0.5), 44 | axis.ticks.length=grid::unit(0.3, "lines"), 45 | 46 | # Specify legend options 47 | legend.background=element_rect(color=NA, fill="black"), 48 | legend.key=element_rect(color="grey55", fill="black"), 49 | legend.key.size=grid::unit(1.2, "lines"), 50 | legend.key.height=NULL, 51 | legend.key.width=NULL, 52 | legend.text=element_text(size=base_size*0.8, color="grey55"), 53 | legend.title=element_text(size=base_size*0.8, face="bold",hjust=0, 54 | color="grey55"), 55 | legend.position="right", 56 | legend.text.align=NULL, 57 | legend.title.align=NULL, 58 | legend.direction="vertical", 59 | legend.box=NULL, 60 | # Specify panel options 61 | panel.background=element_rect(fill="black", color = NA), 62 | panel.border=element_rect(fill=NA, color="grey55"), 63 | panel.grid.major=element_blank(), 64 | panel.grid.minor=element_blank(), 65 | panel.spacing=grid::unit(0.25,"lines"), 66 | # Specify facetting options 67 | strip.background=element_rect(fill="grey30", color="grey10"), 68 | strip.text.x=element_text(size=base_size*0.8, color="grey55"), 69 | strip.text.y=element_text(size=base_size*0.8, color="grey55", 70 | angle=-90), 71 | # Specify plot options 72 | plot.background=element_rect(color="black", fill="black"), 73 | plot.title=element_text(size=base_size*1.2, color="grey55"), 74 | plot.margin=grid::unit(c(1, 1, 0.5, 0.5), "lines") 75 | ) 76 | } 77 | -------------------------------------------------------------------------------- /R/ggdual_axis.R: -------------------------------------------------------------------------------- 1 | #' Dual Y-axis for ggplot2 2 | #' 3 | #' lot dual y-axis for ggplot2 objects. 4 | #' 5 | #' @param lhs A plot whose y axis shall be on the left hand side. 6 | #' @param rhs A plot whose y axis shall be on the right hand side. 7 | #' @param angle Angle to rotate y-axis on right hand side. 8 | #' @return Returns an \code{\link[gridExtra]{arrangeGrob}} with extra class 9 | #' \code{ggdual_axis} that plots by default. This allows it to be further 10 | #' combined with other grobs via \code{\link[gridExtra]{grid.arrange}}. 11 | #' @references \url{http://stackoverflow.com/a/27608585/1000343} 12 | #' \url{http://stackoverflow.com/a/25699817/1000343} 13 | #' @export 14 | #' @examples 15 | #' p1 <- ggplot(mtcars, aes(mpg, disp)) + 16 | #' geom_line(colour = "blue") + 17 | #' theme_bw() + 18 | #' theme(plot.margin = grid::unit(c(.5, 1, .5, 0), "cm")) 19 | #' 20 | #' p2 <- ggplot(mtcars, aes(mpg, drat)) + 21 | #' geom_line(colour = "red") + 22 | #' theme_bw() + 23 | #' theme(plot.margin = grid::unit(c(.5, 1, .5, 0), "cm")) 24 | #' 25 | #' ggdual_axis(lhs = p1, rhs = p2) 26 | ggdual_axis <- function(lhs, rhs, angle = 270) { 27 | # 1. Fix the right y-axis label justification 28 | 29 | r <- name <- NULL 30 | rhs <- rhs + ggplot2::theme(axis.text.y = ggplot2::element_text(hjust = 0)) 31 | # 2. Rotate the right y-axis label by 270 degrees by default 32 | rhs <- rhs + ggplot2::theme(axis.title.y = ggplot2::element_text(angle = angle)) 33 | 34 | # 3a. Use only major grid lines for the left axis 35 | lhs <- lhs + ggplot2::theme(panel.grid.minor = ggplot2::element_blank()) 36 | # 3b. Use only major grid lines for the right axis 37 | # force transparency of the backgrounds to allow grid lines to show 38 | rhs <- rhs + ggplot2::theme(panel.grid.minor = ggplot2::element_blank(), 39 | panel.background = ggplot2::element_rect(fill = "transparent", colour = NA), 40 | plot.background = ggplot2::element_rect(fill = "transparent", colour = NA)) 41 | # Process gtable objects 42 | # 4. Extract gtable 43 | 44 | g1 <- ggplot2::ggplot_gtable(ggplot2::ggplot_build(lhs)) 45 | g2 <- ggplot2::ggplot_gtable(ggplot2::ggplot_build(rhs)) 46 | # 5. Overlap the panel of the rhs plot on that of the lhs plot 47 | pp <- c(subset(g1$layout, name == "panel", se = t:r)) 48 | g <- gtable::gtable_add_grob(g1, 49 | g2$grobs[[which(g2$layout$name == "panel")]], pp$t, pp$l, pp$b, pp$l) 50 | # Tweak axis position and labels 51 | ia <- which(g2$layout$name == "axis-l") 52 | ga <- g2$grobs[[ia]] 53 | ax <- ga$children[["axis"]] # ga$children[[2]] 54 | ax$widths <- rev(ax$widths) 55 | ax$grobs <- rev(ax$grobs) 56 | ax$grobs[[1]]$x <- ax$grobs[[1]]$x - grid::unit(1, "npc") + grid::unit(0.15, "cm") 57 | g <- gtable::gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1) 58 | g <- gtable::gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b) 59 | g <- gtable::gtable_add_grob(g, g2$grobs[[7]], pp$t, length(g$widths), pp$b) 60 | # Display plot with arrangeGrob wrapper arrangeGrob(g) 61 | 62 | out <- gridExtra::arrangeGrob(g) 63 | class(out) <- c("ggdual_axis", class(out)) 64 | out 65 | } 66 | 67 | #' Plots a ggdual_axis Object 68 | #' 69 | #' Plots a ggdual_axis object. 70 | #' 71 | #' @param x The \code{ggdual_axis} object. 72 | #' @param \ldots Other arguments passed to \code{\link[gridExtra]{grid.arrange}}. 73 | #' @method plot ggdual_axis 74 | #' @export 75 | plot.ggdual_axis <- function(x, ...){ 76 | gridExtra::grid.arrange(x, ...) 77 | } 78 | 79 | #' Prints a ggdual_axis Object 80 | #' 81 | #' Prints a ggdual_axis object. 82 | #' 83 | #' @param x The \code{ggdual_axis} object. 84 | #' @param \ldots Other arguments passed to \code{\link[gridExtra]{grid.arrange}}. 85 | #' @method print ggdual_axis 86 | #' @export 87 | print.ggdual_axis <- function(x, ...){ 88 | graphics::plot(x, ...) 89 | } 90 | 91 | -------------------------------------------------------------------------------- /R/reorder_by.R: -------------------------------------------------------------------------------- 1 | #' Order a Factor by Numeric Variable(s) 2 | #' 3 | #' Create a new dataframe with a factor reordered (re-leveled) by numeric 4 | #' variable(s). 5 | #' 6 | #' @param fact The factor to be reordered (re-leveled). 7 | #' @param by A formula to order the factor by. 8 | #' @param data A \code{data.frame} object. 9 | #' @param FUN A function to compute the summary statistics which can be applied 10 | #' to all data subsets. 11 | #' @param df logical. If \code{TRUE} a dataframe is returned. If \code{FALSE} 12 | #' a factor vector is returned. 13 | #' @return Returns a re-ordered (re-leveled) dataframe, factor vector, or levels. 14 | #' @references The majority of this code is taken directly from Thomas Wutzler's 15 | #' blog post that has since been removed/redirected. 16 | #' @author Thomas Wutzler and Tyler Rinker . 17 | #' @keywords factor order sort plot 18 | #' @export 19 | #' @examples 20 | #' \dontrun{ 21 | #' ## EXAMPLE 1 - no aggregation ## 22 | #' 23 | #' ## Make a fake data set 24 | #' dat <- aggregate(cbind(mpg, hp, disp)~carb, mtcars, mean) 25 | #' dat$carb <- factor(dat$carb) 26 | #' 27 | #' ## compare levels (data set looks the same though) 28 | #' dat$carb 29 | #' reorder_by(carb, ~-hp + -mpg, data = dat)$carb 30 | #' 31 | #' library(ggplot2) 32 | #' ## Unordered bars 33 | #' ggplot(dat, aes(x=carb, y=mpg)) + 34 | #' geom_bar(stat="identity") + 35 | #' coord_flip() 36 | #' 37 | #' ## Ordered bars 38 | #' ggplot(reorder_by(carb, ~mpg, dat), aes(x=carb, y=mpg)) + 39 | #' geom_bar(stat="identity") + 40 | #' coord_flip() 41 | #' 42 | #' ## Return just the vector with new levels 43 | #' reorder_by(carb, ~-hp + -mpg, dat, df=FALSE) 44 | #' 45 | #' ## EXAMPLE 2 - with aggregation ## 46 | #' 47 | #' mtcars2 <- reorder_by(gear, ~hp + -carb, mtcars, mean) 48 | #' 49 | #' ## Without re-leveling gear 50 | #' ggplot(mtcars, aes(mpg, hp)) + 51 | #' geom_point(aes(color=factor(cyl))) + 52 | #' facet_grid(gear~.) 53 | #' 54 | #' ## After re-leveling gear 55 | #' ggplot(mtcars2, aes(mpg, hp)) + 56 | #' geom_point(aes(color=factor(cyl))) + 57 | #' facet_grid(gear~.) 58 | #' } 59 | reorder_by <- function(fact, by, data, FUN = NULL, df = TRUE){ 60 | 61 | if(by[[1]] != "~") { 62 | stop("Argument 'by' must be a one-sided formula.") 63 | } 64 | 65 | x <- data 66 | 67 | form1 <- as.character(substitute(fact)) 68 | form2 <- as.character(by[[2]]) 69 | check1 <- c(length(form2) == 1 && form1 == form2) 70 | check2 <- c(length(form2) == 2 && form1 == form2[2] && form2[1] == "-") 71 | 72 | if(check1 | check2) { 73 | if (is.null(FUN)) { 74 | warning("FUN not provided: `length` assumed") 75 | FUN <- length 76 | } 77 | ord <- match.fun(ifelse(check2, "rev", "c")) 78 | lvls <- ord(sort(tapply(data[, form1], data[, form1], FUN = FUN))) 79 | data[, form1] <- factor(data[, form1], levels = names(lvls)) 80 | return(data) 81 | } 82 | 83 | 84 | fact <- as.character(substitute(fact)) 85 | # Make the formula into character and remove spaces 86 | formc <- as.character(by[2]) 87 | formc <- gsub(" ", "", formc) 88 | # If the first character is not + or -, add + 89 | if(!is.element(substring(formc, 1, 1), c("+", "-"))) 90 | formc <- paste("+", formc, sep = "") 91 | 92 | # Extract the variables from the formula 93 | vars <- unlist(strsplit(formc, "[\\+\\-]")) 94 | vars <- vars[vars != ""] # Remove any extra "" terms 95 | 96 | ## use for aggregating 97 | if (!is.null(FUN)) { 98 | x <- eval(parse(text=paste0("aggregate(cbind(", paste(vars, collapse = ", "), ") ~", 99 | fact, ", data = data, FUN = \"", substitute(FUN), "\")"))) 100 | } 101 | 102 | # Build a list of arguments to pass to "order" function 103 | calllist <- list() 104 | pos <- 1 # Position of + or - 105 | for(i in 1:length(vars)){ 106 | varsign <- substring(formc, pos, pos) 107 | pos <- pos + 1 + nchar(vars[i]) 108 | if(is.factor(x[, vars[i]])){ 109 | if(varsign == "-") { 110 | calllist[[i]] <- -rank(x[, vars[i]]) 111 | } else { 112 | calllist[[i]] <- rank(x[, vars[i]]) 113 | } 114 | } else { 115 | if(varsign == "-") { 116 | calllist[[i]] <- -x[, vars[i]] 117 | } else { 118 | calllist[[i]] <- x[,vars[i]] 119 | } 120 | } 121 | } 122 | data[, fact] <- factor(data[, fact], levels = x[do.call("order", calllist), fact]) 123 | if (df) { 124 | data 125 | } else { 126 | data[, fact] 127 | } 128 | } 129 | 130 | 131 | 132 | by_self <- function(x, rev = FALSE) { 133 | y <- names(sort(table(x))) 134 | if (rev) { 135 | y <- rev(y) 136 | } 137 | factor(x, levels=y) 138 | } 139 | 140 | 141 | -------------------------------------------------------------------------------- /.Rprofile: -------------------------------------------------------------------------------- 1 | if (file.exists("~/.Rprofile")) source("~/.Rprofile") 2 | 3 | if (interactive()) { 4 | 5 | if (!require("pacman")) utils::install.packages("pacman") 6 | pacman::p_load(qdap, reports) 7 | 8 | update_version <- function(ver = NULL){ 9 | 10 | desc <- suppressWarnings(readLines("DESCRIPTION")) 11 | regex <- "(^Version:\\s+\\d+\\.\\d+\\.)(\\d+)" 12 | loc <- grep(regex, desc) 13 | ver <- ifelse(is.null(ver), as.numeric(gsub(regex, "\\2", desc[loc])) + 1, ver) 14 | desc[loc] <- sprintf(gsub(regex, "\\1%s", desc[loc]), ver) 15 | cat(paste0(paste(desc, collapse="\n"), "\n"), file="DESCRIPTION") 16 | 17 | cit <- suppressWarnings(readLines("inst/CITATION")) 18 | regex2 <- '(version\\s+\\d+\\.\\d+\\.)(\\d+)([."])' 19 | cit <- paste(cit, collapse="\n") 20 | cat(paste0(gsub(regex2, paste0("\\1", ver, "\\3"), cit), "\n"), 21 | file = "inst/CITATION") 22 | message(sprintf("Updated to version: %s", ver)) 23 | } 24 | 25 | update_news <- function(repo = basename(getwd())) { 26 | 27 | News <- readLines("NEWS") 28 | 29 | News <- mgsub( 30 | c("<", ">", "<major>.<minor>.<patch>", "BUG FIXES", 31 | "NEW FEATURES", "MINOR FEATURES", "CHANGES", "IMPROVEMENTS", " TRUE ", " FALSE ", 32 | " NULL ", "TRUE.", "FALSE.", "NULL.", ":m:"), 33 | c("<", ">", "**<major>.<minor>.<patch>**", 34 | "**BUG FIXES**", "**NEW FEATURES**", "**MINOR FEATURES**", 35 | "**CHANGES**", "**IMPROVEMENTS**", " `TRUE` ", "`FALSE`.", "`NULL`.", "`TRUE`.", 36 | " `FALSE` ", " `NULL` ", " : m : "), 37 | News, trim = FALSE, fixed=TRUE) 38 | 39 | News <- sub(pattern="issue *# *([0-9]+)", 40 | replacement=sprintf("issue #\\1", 41 | repo), 42 | x=News) 43 | 44 | News <- sub(pattern="pull request *# *([0-9]+)", 45 | replacement=sprintf("pull request #\\1", 46 | repo), 47 | x=News) 48 | 49 | News <- gsub(sprintf(" %s", repo), 50 | sprintf(" %s", 51 | repo, repo), News) 52 | 53 | cat(paste(News, collapse = "\n"), file = "NEWS.md") 54 | message("news.md updated") 55 | } 56 | 57 | update_date <- function(){ 58 | desc <- read.dcf("DESCRIPTION") 59 | if (Sys.Date() > desc[,"Date"]) { 60 | desc[,"Date"] <- as.character(Sys.Date()) 61 | write.dcf(desc, "DESCRIPTION") 62 | message("Date updated") 63 | } else { 64 | message("Date is current") 65 | } 66 | } 67 | 68 | update_date() 69 | 70 | twitter <- "[![Follow](https://img.shields.io/twitter/follow/tylerrinker.svg?style=social)](https://twitter.com/intent/follow?screen_name=tylerrinker)" 71 | 72 | 73 | md_toc <- function(path = "README.md", repo = basename(getwd()), 74 | insert.loc = "Functions"){ 75 | 76 | x <- suppressWarnings(readLines(path)) 77 | 78 | 79 | 80 | inds <- 1:(which(!grepl("(^\\s*-)|(\\]\\(#)", x))[1] - 1) 81 | 82 | temp <- gsub("(^[ -]+)(.+)", "\\1", x[inds]) 83 | content <- gsub("^[ -]+", "", x[inds]) 84 | bkna <- grepl("^[^[]", content) 85 | 86 | if (sum(bkna) > 0){ 87 | bkn <- which(bkna) 88 | for (i in bkn){ 89 | content[i - 1] <- paste(content[i - 1], content[i]) 90 | } 91 | content <- content[!bkna] 92 | temp <- temp[!bkna] 93 | } 94 | 95 | toc <- paste(c("\nTable of Contents\n============\n", 96 | sprintf("%s[%s](%s)", temp, c(qdapRegex::ex_square(content)), gsub("[;/?:@&=+$,.]", "", 97 | gsub("\\s", "-", c(tolower(qdapRegex::ex_round(content)))))), 98 | sprintf("\n%s\n============\n", insert.loc)), 99 | collapse = "\n" 100 | ) 101 | 102 | x <- x[(max(inds) + 1):length(x)] 103 | 104 | inst_loc <- which(grepl(sprintf("^%s$", insert.loc), x))[1] 105 | x[inst_loc] <- toc 106 | x <- x[-c(1 + inst_loc)] 107 | 108 | beg <- grep("^You are welcome", x) 109 | end <- grep("compose a friendly", x) 110 | 111 | x[beg] <- sprintf(contact, repo, repo) 112 | 113 | x <- x[!seq_along(x) %in% (1+beg:end)] 114 | 115 | a <- grep("", x) 116 | if (!identical(integer(0), a)){ 117 | b <- grep("
", x) 118 | inds <- unlist(mapply(function(a, b){ a:b}, a, b)) 119 | x[inds] <- gsub("\\\\_", "_", x[inds]) 120 | } 121 | 122 | x <- gsub("", "", x, fixed=TRUE) 123 | cat(paste(c(sprintf("%s %s\n============\n", repo, twitter), x), collapse = "\n"), file = path) 124 | message("README.md updated") 125 | } 126 | 127 | contact <- paste(c( 128 | "You are welcome to: ", 129 | "- submit suggestions and bug-reports at: ", 130 | "- send a pull request on: ", 131 | "- compose a friendly e-mail to: " 132 | ), collapse="\n") 133 | 134 | 135 | }# end if (interactive()) 136 | -------------------------------------------------------------------------------- /R/ggfaxt.R: -------------------------------------------------------------------------------- 1 | #' Add Text to a Faceted ggplot2 Plot 2 | #' 3 | #' A ggplot2 wrapper for adding text to facets. 4 | #' 5 | #' @param ggplot2.object a faceted ggplot2 object or an object returned from 6 | #' qfacet_text 7 | #' @param x.coord a single x coordinate to be repeated or a vector of x 8 | #' coordinates equal to the number of facets 9 | #' @param y.coord a single y coordinate to be repeated or a vector of y 10 | #' coordinates equal to the number of facets 11 | #' @param labels a vector of labels to place on each facet 12 | #' @param \ldots additional arguments accepted by geom_text 13 | #' @return Returns a plot of class "gg" "ggplot" with annotations. Also 14 | #' invisibly returns a list object of the class qfacet with the following items: 15 | #' \itemize{ 16 | #' \item{original} {the Original ggplot2 object} 17 | #' \item{new} {the new ggplot object} 18 | #' \item{dat} {the mini data frame created for the text} 19 | #' } 20 | #' @seealso \code{\link[ggplot2]{geom_text}} 21 | #' @keywords ggplot2 facet text 22 | #' @export 23 | #' @examples 24 | #' #alter mtcars to make some variables factors 25 | #' mtcars2 <- mtcars 26 | #' mtcars2[, c("cyl", "am", "gear")] <- lapply(mtcars[, 27 | #' c("cyl", "am", "gear")], as.factor) 28 | #' 29 | #' p <- ggplot(mtcars2, aes(mpg, wt, group = cyl)) + 30 | #' geom_line(aes(color=cyl)) + 31 | #' geom_point(aes(shape=cyl)) + 32 | #' facet_grid(gear ~ am) + 33 | #' theme_bw() 34 | #' 35 | #' z <- ggfaxt(ggplot2.object = p, x.coor = 33, y.coor = 2.2, 36 | #' labels = 1:6, color="red") 37 | # 38 | #' #approach 1 (alter the text data frame and pass the qfacet object) 39 | #' z$dat[5, 1:2] <- c(15, 5) 40 | #' ggfaxt(z, color="red") 41 | #' 42 | #' #approach 2 (alter the original ggplot object) 43 | #' ggfaxt(p, x = c(33, 33, 33, 33, 15, 33), 44 | #' y = c(2.2, 2.2, 2.2, 2.2, 5, 2.2), 1:6, color="red") 45 | #' 46 | #' #use "" to not add a label to a facet 47 | #' ggfaxt(ggplot2.object = p, x.coor = 33, y.coor = 2.2, 48 | #' labels = c("", letters[1:4], ""), color="red") 49 | #' 50 | #' #all the same things you can pass to geom_text qfacet_text takes 51 | #' ggfaxt(z, labels = paste("beta ==", 1:6), 52 | #' size = 3, color = "grey50", parse = TRUE) 53 | #' 54 | #' #two labels: same plot 55 | #' p <- ggplot(CO2, aes(conc, uptake, group = Plant)) + 56 | #' geom_line(aes(color=Plant)) + 57 | #' facet_grid(Type ~ Treatment) + 58 | #' theme_bw() 59 | #' 60 | #' #plot first text layer 61 | #' z <- ggfaxt(ggplot2.object = p, x.coor = 250, y.coor = 10, 62 | #' labels = 1:4, color="red") 63 | #' 64 | #' #plot second text layer 65 | #' ggfaxt(ggplot2.object = z$new, x.coor = 900, y.coor = 10, 66 | #' labels = paste("beta ==", 11:14), color="blue", parse = TRUE) 67 | ggfaxt <- 68 | function(ggplot2.object, x.coord = NULL, y.coord = NULL, 69 | labels = NULL, ...) { 70 | 71 | x <- y <- NULL 72 | 73 | dat <- ggplot2.object$data 74 | params <- ggplot2.object$facet$params 75 | rows <- params$rows 76 | cols <- params$cols 77 | who <- c(length(rows) > 0, length(cols) > 0) 78 | if (all(who)) { 79 | rows <- as.character(rows[[1]]) 80 | cols <- as.character(cols[[1]]) 81 | frow <- dat[, rows] 82 | fcol <- dat[, cols] 83 | len <- length(levels(factor(fcol))) * length(levels(factor(frow))) 84 | vars <- data.frame(expand.grid(levels(factor(frow)), levels(factor(fcol)))) 85 | colnames(vars) <- c(rows, cols) 86 | } else { 87 | if (who[1]) { 88 | rows <- as.character(rows[[1]]) 89 | frow <- dat[, rows] 90 | len <- length(levels(factor(frow))) 91 | vars <- data.frame(levels(factor(frow)), stringsAsFactors = FALSE) 92 | colnames(vars) <- rows 93 | } else { 94 | cols <- as.character(cols[[1]]) 95 | fcol <- dat[, cols] 96 | len <- length(levels(factor(fcol))) 97 | vars <- data.frame(levels(factor(fcol)), stringsAsFactors = FALSE) 98 | colnames(vars) <- cols 99 | } 100 | } 101 | if (any(class(ggplot2.object) %in% c("ggplot", "gg"))) { 102 | if (is.null(labels)) { 103 | labels <- LETTERS[1:len] 104 | } 105 | if (!length(labels) %in% c(1, len)) { 106 | stop("labels must be of length 1 or equal to number of facets") 107 | } 108 | if (length(x.coord) == 1) { 109 | x.coord <- rep(x.coord, len) 110 | } 111 | if (length(y.coord) == 1) { 112 | y.coord <- rep(y.coord, len) 113 | } 114 | text.df <- data.frame(x = x.coord, y = y.coord, vars, labs=labels) 115 | } else { 116 | if (class(ggplot2.object) == "qfacet") { 117 | text.df <- ggplot2.object$dat 118 | if (!is.null(x.coord)) { 119 | text.df$x.coord <- x.coord 120 | } 121 | if (!is.null(y.coord)) { 122 | text.df$y.coord <- y.coord 123 | } 124 | if (!is.null(labels)) { 125 | text.df$labs <- labels 126 | } 127 | ggplot2.object <- ggplot2.object$original 128 | } 129 | } 130 | p <- ggplot2.object + ggplot2::geom_text(ggplot2::aes_string('x', 'y', 131 | label='labs', group=NULL), data=text.df, ...) 132 | print(p) 133 | v <- list(original = ggplot2.object, new = p, dat = text.df) 134 | class(v) <- "qfacet" 135 | invisible(v) 136 | } 137 | --------------------------------------------------------------------------------