diff --git a/.Rbuildignore b/.Rbuildignore index 559cb86905..acadf4e942 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -26,3 +26,4 @@ visual_test ^\.github$ ^vignettes/profilings ^cran-comments\.md$ +^LICENSE\.md$ diff --git a/DESCRIPTION b/DESCRIPTION index 7af9aac5ab..6fb30e71f2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,6 +14,7 @@ Authors@R: c( person("Claus", "Wilke", role = "aut"), person("Kara", "Woo", role = "aut"), person("Hiroaki", "Yutani", role = "aut"), + person("Dewey", "Dunnington", role = "aut"), person("RStudio", role = c("cph")) ) Depends: @@ -23,6 +24,7 @@ Imports: grDevices, grid, gtable (>= 0.1.1), + isoband, MASS, mgcv, reshape2, @@ -30,7 +32,6 @@ Imports: scales (>= 0.5.0), stats, tibble, - viridisLite, withr (>= 2.0.0) Suggests: covr, @@ -38,7 +39,6 @@ Suggests: ggplot2movies, hexbin, Hmisc, - isoband, knitr, lattice, mapproj, diff --git a/GOVERNANCE.md b/GOVERNANCE.md index 63f89814c7..64c943d1f1 100644 --- a/GOVERNANCE.md +++ b/GOVERNANCE.md @@ -43,6 +43,7 @@ The core developers of ggplot2 are: * [Claus Wilke](https://github.com/clauswilke) * [Kara Woo](https://github.com/karawoo) * [Hiroaki Yutani](https://github.com/yutannihilation) +* [Dewey Dunnington](https://github.com/paleolimbot) All core developers are bound by the [code of conduct](CODE_OF_CONDUCT.md). diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 0000000000..28fbecabf5 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,361 @@ +### GNU GENERAL PUBLIC LICENSE + +Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +### Preamble + +The licenses for most software are designed to take away your freedom +to share and change it. By contrast, the GNU General Public License is +intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + +When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + +To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if +you distribute copies of the software, or if you modify it. + +For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + +We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + +Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, +we want its recipients to know that what they have is not the +original, so that any problems introduced by others will not reflect +on the original authors' reputations. + +Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at +all. + +The precise terms and conditions for copying, distribution and +modification follow. + +### TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + +**0.** This License applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work +based on the Program" means either the Program or any derivative work +under copyright law: that is to say, a work containing the Program or +a portion of it, either verbatim or with modifications and/or +translated into another language. (Hereinafter, translation is +included without limitation in the term "modification".) Each licensee +is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the Program +(independent of having been made by running the Program). Whether that +is true depends on what the Program does. + +**1.** You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a +fee. + +**2.** You may modify your copy or copies of the Program or any +portion of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + +**a)** You must cause the modified files to carry prominent notices +stating that you changed the files and the date of any change. + + +**b)** You must cause any work that you distribute or publish, that in +whole or in part contains or is derived from the Program or any part +thereof, to be licensed as a whole at no charge to all third parties +under the terms of this License. + + +**c)** If the modified program normally reads commands interactively +when run, you must cause it, when started running for such interactive +use in the most ordinary way, to print or display an announcement +including an appropriate copyright notice and a notice that there is +no warranty (or else, saying that you provide a warranty) and that +users may redistribute the program under these conditions, and telling +the user how to view a copy of this License. (Exception: if the +Program itself is interactive but does not normally print such an +announcement, your work based on the Program is not required to print +an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + +**3.** You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + +**a)** Accompany it with the complete corresponding machine-readable +source code, which must be distributed under the terms of Sections 1 +and 2 above on a medium customarily used for software interchange; or, + + +**b)** Accompany it with a written offer, valid for at least three +years, to give any third party, for a charge no more than your cost of +physically performing source distribution, a complete machine-readable +copy of the corresponding source code, to be distributed under the +terms of Sections 1 and 2 above on a medium customarily used for +software interchange; or, + + +**c)** Accompany it with the information you received as to the offer +to distribute corresponding source code. (This alternative is allowed +only for noncommercial distribution and only if you received the +program in object code or executable form with such an offer, in +accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + +**4.** You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt otherwise +to copy, modify, sublicense or distribute the Program is void, and +will automatically terminate your rights under this License. However, +parties who have received copies, or rights, from you under this +License will not have their licenses terminated so long as such +parties remain in full compliance. + +**5.** You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + +**6.** Each time you redistribute the Program (or any work based on +the Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + +**7.** If, as a consequence of a court judgment or allegation of +patent infringement or for any other reason (not limited to patent +issues), conditions are imposed on you (whether by court order, +agreement or otherwise) that contradict the conditions of this +License, they do not excuse you from the conditions of this License. +If you cannot distribute so as to satisfy simultaneously your +obligations under this License and any other pertinent obligations, +then as a consequence you may not distribute the Program at all. For +example, if a patent license would not permit royalty-free +redistribution of the Program by all those who receive copies directly +or indirectly through you, then the only way you could satisfy both it +and this License would be to refrain entirely from distribution of the +Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + +**8.** If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + +**9.** The Free Software Foundation may publish revised and/or new +versions of the General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Program does not specify a +version number of this License, you may choose any version ever +published by the Free Software Foundation. + +**10.** If you wish to incorporate parts of the Program into other +free programs whose distribution conditions are different, write to +the author to ask for permission. For software which is copyrighted by +the Free Software Foundation, write to the Free Software Foundation; +we sometimes make exceptions for this. Our decision will be guided by +the two goals of preserving the free status of all derivatives of our +free software and of promoting the sharing and reuse of software +generally. + +**NO WARRANTY** + +**11.** BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + +**12.** IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + +### END OF TERMS AND CONDITIONS + +### How to Apply These Terms to Your New Programs + +If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + +To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + one line to give the program's name and an idea of what it does. + Copyright (C) yyyy name of author + + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + as published by the Free Software Foundation; either version 2 + of the License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +Also add information on how to contact you by electronic and paper +mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details + type `show w'. This is free software, and you are welcome + to redistribute it under certain conditions; type `show c' + for details. + +The hypothetical commands \`show w' and \`show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than \`show w' and +\`show c'; they could even be mouse-clicks or menu items--whatever +suits your program. + +You should also get your employer (if you work as a programmer) or +your school, if any, to sign a "copyright disclaimer" for the program, +if necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright + interest in the program `Gnomovision' + (which makes passes at compilers) written + by James Hacker. + + signature of Ty Coon, 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, +you may consider it more useful to permit linking proprietary +applications with the library. If this is what you want to do, use the +[GNU Lesser General Public +License](https://www.gnu.org/licenses/lgpl.html) instead of this +License. diff --git a/NAMESPACE b/NAMESPACE index 7a90dd5f5f..af5d41396e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -45,6 +45,7 @@ S3method(fortify,tbl_df) S3method(ggplot,"function") S3method(ggplot,default) S3method(ggplot_add,"NULL") +S3method(ggplot_add,"function") S3method(ggplot_add,Coord) S3method(ggplot_add,Facet) S3method(ggplot_add,Layer) @@ -105,6 +106,7 @@ S3method(makeContent,labelgrob) S3method(makeContext,dotstackGrob) S3method(merge_element,default) S3method(merge_element,element) +S3method(merge_element,element_blank) S3method(plot,ggplot) S3method(predictdf,default) S3method(predictdf,glm) @@ -297,10 +299,12 @@ export(draw_key_timeseries) export(draw_key_vline) export(draw_key_vpath) export(dup_axis) +export(el_def) export(element_blank) export(element_grob) export(element_line) export(element_rect) +export(element_render) export(element_text) export(enexpr) export(enexprs) diff --git a/NEWS.md b/NEWS.md index 847f615320..2ad53b1a1d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,11 @@ # ggplot2 (development version) +* `scale_x_continuous()` and `scale_y_continuous()` gains an `n.breaks` argument + guiding the number of automatic generated breaks (@thomasp85, #3102) + +* `geom_sf()` now removes rows that can't be plotted due to `NA` aesthetics + (#3546, @thomasp85) + * A new scale type has been added, that allows binning of aesthetics at the scale level. It has versions for both position and non-position aesthetics and comes with two new guides (`guide_bins` and `guide_coloursteps`) (@thomasp85, #3096) @@ -14,6 +20,10 @@ * `Geom` now gains a `setup_params()` method in line with the other ggproto classes (@thomasp85, #3509) +* Themes can now modify the theme element tree, via the + `element_tree` argument. This allows extension packages to add functionality that + alters the element tree (@clauswilke, #2540). + * `element_text()` now issues a warning when vectorized arguments are provided, as in `colour = c("red", "green", "blue")`. Such use is discouraged and not officially supported (@clauswilke, #3492). @@ -82,12 +92,12 @@ * `stat_density2d()` can now take an `adjust` parameter to scale the default bandwidth. (#2860, @haleyjeppson) -* `geom_sf()` now removes rows that contain missing `shape`/`size`/`colour` (#3483, @yutannihilation) - * Fix a bug when `show.legend` is a named logical vector (#3461, @yutannihilation). * Increase the default `nbin` of `guide_colourbar()` to place the ticks more precisely (#3508, @yutannihilation). +* `geom_sf()` now applies alpha to linestring geometries (#3589, @yutannihilation). + # ggplot2 3.2.1 This is a patch release fixing a few regressions introduced in 3.2.0 as well as diff --git a/R/aes-calculated.r b/R/aes-calculated.r index 95b9390bba..918854c390 100644 --- a/R/aes-calculated.r +++ b/R/aes-calculated.r @@ -42,6 +42,8 @@ is_calculated <- function(x) { FALSE } else if (is.symbol(x)) { is_dotted_var(as.character(x)) + } else if (is_quosure(x)) { + is_calculated(quo_get_expr(x)) } else if (is.call(x)) { if (identical(x[[1]], quote(stat))) { TRUE @@ -66,6 +68,12 @@ strip_dots <- function(expr) { } else { expr } + } else if (is_quosure(expr)) { + # strip dots from quosure and reconstruct the quosure + expr <- new_quosure( + strip_dots(quo_get_expr(expr)), + quo_get_env(expr) + ) } else if (is.call(expr)) { if (identical(expr[[1]], quote(stat))) { strip_dots(expr[[2]]) diff --git a/R/bin.R b/R/bin.R index 55d898c846..cea2f1faa6 100644 --- a/R/bin.R +++ b/R/bin.R @@ -87,7 +87,11 @@ bin_breaks_width <- function(x_range, width = NULL, center = NULL, max_x <- x_range[2] + (1 - 1e-08) * width breaks <- seq(origin, max_x, width) - if (length(breaks) > 1e6) { + if (length(breaks) == 1) { + # In exceptionally rare cases, the above can fail and produce only a + # single break (see issue #3606). We fix this by adding a second break. + breaks <- c(breaks, breaks + width) + } else if (length(breaks) > 1e6) { stop("The number of histogram bins must be less than 1,000,000.\nDid you make `binwidth` too small?", call. = FALSE) } diff --git a/R/geom-dotplot.r b/R/geom-dotplot.r index 3484835ff2..0c2f371caf 100644 --- a/R/geom-dotplot.r +++ b/R/geom-dotplot.r @@ -34,7 +34,7 @@ #' @inheritParams geom_point #' @param stackdir which direction to stack the dots. "up" (default), #' "down", "center", "centerwhole" (centered, but with dots aligned) -#' @param stackratio how close to stack the dots. Default is 1, where dots just +#' @param stackratio how close to stack the dots. Default is 1, where dots #' just touch. Use smaller values for closer, overlapping dots. #' @param dotsize The diameter of the dots relative to `binwidth`, default 1. #' @param stackgroups should dots be stacked across groups? This has the effect diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 4625cdc2bd..cff9e1dbb1 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -30,8 +30,9 @@ #' h + geom_ribbon(aes(ymin=0, ymax=level)) #' h + geom_area(aes(y = level)) #' -#' # Change orientation be switching the mapping -#' h + geom_area(aes(x = level, y = year)) +#' # Orientation cannot be deduced by mapping, so must be given explicitly for +#' # flipped orientation +#' h + geom_area(aes(x = level, y = year), orientation = "y") #' #' # Add aesthetic mappings #' h + diff --git a/R/geom-sf.R b/R/geom-sf.R index cecab0b127..655a756855 100644 --- a/R/geom-sf.R +++ b/R/geom-sf.R @@ -86,28 +86,27 @@ NULL #' @usage NULL #' @format NULL GeomSf <- ggproto("GeomSf", Geom, - required_aes = "geometry", - default_aes = aes( - shape = NULL, - colour = NULL, - fill = NULL, - size = NULL, - linetype = 1, - alpha = NA, - stroke = 0.5 - ), + required_aes = "geometry", + default_aes = aes( + shape = NULL, + colour = NULL, + fill = NULL, + size = NULL, + linetype = 1, + alpha = NA, + stroke = 0.5 + ), - non_missing_aes = c("size", "shape", "colour"), - draw_panel = function(data, panel_params, coord, legend = NULL, - lineend = "butt", linejoin = "round", linemitre = 10) { + lineend = "butt", linejoin = "round", linemitre = 10, + na.rm = TRUE) { if (!inherits(coord, "CoordSf")) { stop("geom_sf() must be used with coord_sf()", call. = FALSE) } # Need to refactor this to generate one grob per geometry type coord <- coord$transform(data, panel_params) - sf_grob(coord, lineend = lineend, linejoin = linejoin, linemitre = linemitre) + sf_grob(coord, lineend = lineend, linejoin = linejoin, linemitre = linemitre, na.rm = na.rm) }, draw_key = function(data, params, size) { @@ -132,29 +131,49 @@ default_aesthetics <- function(type) { } } -sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10) { - # Need to extract geometry out of corresponding list column - geometry <- x$geometry - type <- sf_types[sf::st_geometry_type(geometry)] - is_point <- type %in% "point" - type_ind <- match(type, c("point", "line", "other")) +sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10, na.rm = TRUE) { + type <- sf_types[sf::st_geometry_type(x$geometry)] + is_point <- type == "point" + is_line <- type == "line" + is_other <- type == "other" + is_collection <- type == "collection" + type_ind <- match(type, c("point", "line", "other", "collection")) + remove <- rep_len(FALSE, nrow(x)) + remove[is_point] <- detect_missing(x, c(GeomPoint$required_aes, GeomPoint$non_missing_aes))[is_point] + remove[is_line] <- detect_missing(x, c(GeomPath$required_aes, GeomPath$non_missing_aes))[is_line] + remove[is_other] <- detect_missing(x, c(GeomPolygon$required_aes, GeomPolygon$non_missing_aes))[is_other] + if (any(remove)) { + if (!na.rm) { + warning_wrap( + "Removed ", sum(remove), " rows containing missing values (geom_sf)." + ) + } + x <- x[!remove, , drop = FALSE] + type_ind <- type_ind[!remove] + is_collection <- is_collection[!remove] + } defaults <- list( GeomPoint$default_aes, GeomLine$default_aes, modify_list(GeomPolygon$default_aes, list(fill = "grey90", colour = "grey35")) ) + defaults[[4]] <- modify_list( + defaults[[3]], + rename(GeomPoint$default_aes, c(size = "point_size", fill = "point_fill")) + ) default_names <- unique(unlist(lapply(defaults, names))) defaults <- lapply(setNames(default_names, default_names), function(n) { unlist(lapply(defaults, function(def) def[[n]] %||% NA)) }) alpha <- x$alpha %||% defaults$alpha[type_ind] col <- x$colour %||% defaults$colour[type_ind] - col[is_point] <- alpha(col[is_point], alpha[is_point]) + col[is_point | is_line] <- alpha(col[is_point | is_line], alpha[is_point | is_line]) fill <- x$fill %||% defaults$fill[type_ind] fill <- alpha(fill, alpha) size <- x$size %||% defaults$size[type_ind] + point_size <- ifelse(is_collection, x$size %||% defaults$point_size[type_ind], size) stroke <- (x$stroke %||% defaults$stroke[1]) * .stroke / 2 - fontsize <- size * .pt + stroke + fontsize <- point_size * .pt + stroke lwd <- ifelse(is_point, stroke, size * .pt) pch <- x$shape %||% defaults$shape[type_ind] lty <- x$linetype %||% defaults$linetype[type_ind] @@ -162,7 +181,7 @@ sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10) { col = col, fill = fill, fontsize = fontsize, lwd = lwd, lty = lty, lineend = lineend, linejoin = linejoin, linemitre = linemitre ) - sf::st_as_grob(geometry, pch = pch, gp = gp) + sf::st_as_grob(x$geometry, pch = pch, gp = gp) } #' @export @@ -280,7 +299,7 @@ geom_sf_text <- function(mapping = aes(), data = NULL, sf_types <- c(GEOMETRY = "other", POINT = "point", LINESTRING = "line", POLYGON = "other", MULTIPOINT = "point", MULTILINESTRING = "line", - MULTIPOLYGON = "other", GEOMETRYCOLLECTION = "other", + MULTIPOLYGON = "other", GEOMETRYCOLLECTION = "collection", CIRCULARSTRING = "line", COMPOUNDCURVE = "other", CURVEPOLYGON = "other", MULTICURVE = "other", MULTISURFACE = "other", CURVE = "other", SURFACE = "other", POLYHEDRALSURFACE = "other", TIN = "other", diff --git a/R/guide-bins.R b/R/guide-bins.R index 88a21e1c10..e6ad111ffa 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -320,10 +320,14 @@ guide_gengrob.bins <- function(guide, theme) { key_size_mat <- do.call("cbind", lapply(guide$geoms, function(g) g$data$size / 10) - )[seq_len(n_keys), , drop = FALSE] + ) + # key_size_mat can be an empty matrix (e.g. the data doesn't contain size + # column), so subset it only when it has any rows and columns. if (nrow(key_size_mat) == 0 || ncol(key_size_mat) == 0) { key_size_mat <- matrix(0, ncol = 1, nrow = n_keys) + } else { + key_size_mat <- key_size_mat[seq_len(n_keys), , drop = FALSE] } key_sizes <- apply(key_size_mat, 1, max) diff --git a/R/guide-legend.r b/R/guide-legend.r index 3558d38b1f..77ba2f67c0 100644 --- a/R/guide-legend.r +++ b/R/guide-legend.r @@ -230,7 +230,8 @@ guide_train.legend <- function(guide, scale, aesthetic = NULL) { #' @export guide_merge.legend <- function(guide, new_guide) { - guide$key <- merge(guide$key, new_guide$key, sort = FALSE) + new_guide$key$.label <- NULL + guide$key <- cbind(guide$key, new_guide$key) guide$override.aes <- c(guide$override.aes, new_guide$override.aes) if (any(duplicated(names(guide$override.aes)))) { warning("Duplicated override.aes is ignored.") diff --git a/R/guides-axis.r b/R/guides-axis.r index ef0c7b6f65..b0f9b7edbf 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -93,7 +93,7 @@ guide_train.axis <- function(guide, scale, aesthetic = NULL) { } } - guide$key <- ticks + guide$key <- ticks[is.finite(ticks[[aesthetic]]), ] } guide$name <- paste0(guide$name, "_", aesthetic) diff --git a/R/plot-construction.r b/R/plot-construction.r index 1c6b07d8ea..8796c0d6d9 100644 --- a/R/plot-construction.r +++ b/R/plot-construction.r @@ -88,7 +88,7 @@ ggplot_add <- function(object, plot, object_name) { } #' @export ggplot_add.default <- function(object, plot, object_name) { - stop("Don't know how to add ", object_name, " to a plot", call. = FALSE) + stop("Can't add `", object_name, "` to a ggplot object.", call. = FALSE) } #' @export ggplot_add.NULL <- function(object, plot, object_name) { @@ -100,6 +100,14 @@ ggplot_add.data.frame <- function(object, plot, object_name) { plot } #' @export +ggplot_add.function <- function(object, plot, object_name) { + stop( + "Can't add `", object_name, "` to a ggplot object.\n", + "Did you forget to add parentheses, as in `", + object_name, "()`?", call. = FALSE + ) +} +#' @export ggplot_add.theme <- function(object, plot, object_name) { plot$theme <- add_theme(plot$theme, object) plot diff --git a/R/scale-.r b/R/scale-.r index 76e32d006d..ed5128d9f8 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -25,6 +25,10 @@ #' each major break) #' - A numeric vector of positions #' - A function that given the limits returns a vector of minor breaks. +#' @param n.breaks An integer guiding the number of major breaks. The algorithm +#' may choose a slightly different number to ensure nice break labels. Will +#' only have an effect if `breaks = waiver()`. Use `NULL` to use the default +#' number of breaks given by the transformation. #' @param labels One of: #' - `NULL` for no labels #' - `waiver()` for the default labels computed by the @@ -78,9 +82,11 @@ #' @param super The super class to use for the constructed scale #' @keywords internal continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(), - breaks = waiver(), minor_breaks = waiver(), labels = waiver(), limits = NULL, - rescaler = rescale, oob = censor, expand = waiver(), na.value = NA_real_, - trans = "identity", guide = "legend", position = "left", super = ScaleContinuous) { + breaks = waiver(), minor_breaks = waiver(), n.breaks = NULL, + labels = waiver(), limits = NULL, rescaler = rescale, + oob = censor, expand = waiver(), na.value = NA_real_, + trans = "identity", guide = "legend", position = "left", + super = ScaleContinuous) { aesthetics <- standardise_aes_names(aesthetics) @@ -116,6 +122,7 @@ continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(), name = name, breaks = breaks, minor_breaks = minor_breaks, + n.breaks = n.breaks, labels = labels, guide = guide, @@ -444,10 +451,9 @@ Scale <- ggproto("Scale", NULL, if (is.null(self$limits)) { self$range$range } else if (is.function(self$limits)) { - # if limits is a function, it expects to work in data space - self$trans$transform(self$limits(self$trans$inverse(self$range$range))) + self$limits(self$range$range) } else { - ifelse(is.na(self$limits), self$range$range, self$limits) + self$limits } }, @@ -524,6 +530,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, rescaler = rescale, oob = censor, minor_breaks = waiver(), + n.breaks = NULL, is_discrete = function() FALSE, @@ -534,11 +541,17 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, self$range$train(x) }, + is_empty = function(self) { + has_data <- !is.null(self$range$range) + has_limits <- is.function(self$limits) || (!is.null(self$limits) && all(is.finite(self$limits))) + !has_data && !has_limits + }, + transform = function(self, x) { - new_x <- self$trans$transform(x) - axis <- if ("x" %in% self$aesthetics) "x" else "y" - check_transformation(x, new_x, self$scale_name, axis) - new_x + new_x <- self$trans$transform(x) + axis <- if ("x" %in% self$aesthetics) "x" else "y" + check_transformation(x, new_x, self$scale_name, axis) + new_x }, map = function(self, x, limits = self$get_limits()) { @@ -555,6 +568,22 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, self$rescaler(x, from = range) }, + get_limits = function(self) { + if (self$is_empty()) { + return(c(0, 1)) + } + + if (is.null(self$limits)) { + self$range$range + } else if (is.function(self$limits)) { + # if limits is a function, it expects to work in data space + self$trans$transform(self$limits(self$trans$inverse(self$range$range))) + } else { + # NA limits for a continuous scale mean replace with the min/max of data + ifelse(is.na(self$limits), self$range$range, self$limits) + } + }, + dimension = function(self, expand = expansion(0, 0), limits = self$get_limits()) { expand_limits_scale(self, expand, limits) }, @@ -578,7 +607,14 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (zero_range(as.numeric(limits))) { breaks <- limits[1] } else if (is.waive(self$breaks)) { - breaks <- self$trans$breaks(limits) + if (!is.null(self$n.breaks) && trans_support_nbreaks(self$trans)) { + breaks <- self$trans$breaks(limits, self$n.breaks) + } else { + if (!is.null(self$n.breaks)) { + warning("Ignoring n.breaks. Use a trans object that supports setting number of breaks", call. = FALSE) + } + breaks <- self$trans$breaks(limits) + } } else if (is.function(self$breaks)) { breaks <- self$breaks(limits) } else { @@ -952,7 +988,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, stop("Invalid breaks specification. Use NULL, not NA", call. = FALSE) } else if (is.waive(self$breaks)) { if (self$nice.breaks) { - if (!is.null(self$n.breaks) && "n" %in% names(formals(self$trans$breaks))) { + if (!is.null(self$n.breaks) && trans_support_nbreaks(self$trans)) { breaks <- self$trans$breaks(limits, n = self$n.breaks) } else { if (!is.null(self$n.breaks)) { @@ -989,7 +1025,15 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, self$limits <- self$trans$transform(limits) } } else if (is.function(self$breaks)) { - breaks <- self$breaks(limits, self$n_bins) + if ("n.breaks" %in% names(formals(environment(self$breaks)$f))) { + n.breaks <- self$n.breaks %||% 5 # same default as trans objects + breaks <- self$breaks(limits, n.breaks = n.breaks) + } else { + if (!is.null(self$n.breaks)) { + warning("Ignoring n.breaks. Use a breaks function that supports setting number of breaks", call. = FALSE) + } + breaks <- self$breaks(limits) + } } else { breaks <- self$breaks } @@ -1082,3 +1126,7 @@ check_transformation <- function(x, transformed, name, axis) { warning("Transformation introduced infinite values in ", type, " ", axis, "-axis", call. = FALSE) } } + +trans_support_nbreaks <- function(trans) { + "n" %in% names(formals(trans$breaks)) +} diff --git a/R/scale-continuous.r b/R/scale-continuous.r index 8f1cfb1217..174e0680e7 100644 --- a/R/scale-continuous.r +++ b/R/scale-continuous.r @@ -74,13 +74,15 @@ NULL #' #' @export scale_x_continuous <- function(name = waiver(), breaks = waiver(), - minor_breaks = waiver(), labels = waiver(), - limits = NULL, expand = waiver(), oob = censor, - na.value = NA_real_, trans = "identity", guide = waiver(), - position = "bottom", sec.axis = waiver()) { + minor_breaks = waiver(), n.breaks = NULL, + labels = waiver(), limits = NULL, + expand = waiver(), oob = censor, + na.value = NA_real_, trans = "identity", + guide = waiver(), position = "bottom", + sec.axis = waiver()) { sc <- continuous_scale( c("x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper", "x0"), - "position_c", identity, name = name, breaks = breaks, + "position_c", identity, name = name, breaks = breaks, n.breaks = n.breaks, minor_breaks = minor_breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, trans = trans, guide = guide, position = position, super = ScaleContinuousPosition @@ -93,13 +95,15 @@ scale_x_continuous <- function(name = waiver(), breaks = waiver(), #' @rdname scale_continuous #' @export scale_y_continuous <- function(name = waiver(), breaks = waiver(), - minor_breaks = waiver(), labels = waiver(), - limits = NULL, expand = waiver(), oob = censor, - na.value = NA_real_, trans = "identity", guide = waiver(), - position = "left", sec.axis = waiver()) { + minor_breaks = waiver(), n.breaks = NULL, + labels = waiver(), limits = NULL, + expand = waiver(), oob = censor, + na.value = NA_real_, trans = "identity", + guide = waiver(), position = "left", + sec.axis = waiver()) { sc <- continuous_scale( c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final", "lower", "middle", "upper", "y0"), - "position_c", identity, name = name, breaks = breaks, + "position_c", identity, name = name, breaks = breaks, n.breaks = n.breaks, minor_breaks = minor_breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, trans = trans, guide = guide, position = position, super = ScaleContinuousPosition diff --git a/R/scale-view.r b/R/scale-view.r index 2986e275cd..e7a77ff6cf 100644 --- a/R/scale-view.r +++ b/R/scale-view.r @@ -17,7 +17,6 @@ view_scale_primary <- function(scale, limits = scale$get_limits(), if(!scale$is_discrete()) { breaks <- scale$get_breaks(continuous_range) - breaks <- breaks[is.finite(breaks)] minor_breaks <- scale$get_breaks_minor(b = breaks, limits = continuous_range) } else { breaks <- scale$get_breaks(limits) diff --git a/R/scale-viridis.r b/R/scale-viridis.r index 4b4dde093a..d90ca0cce9 100644 --- a/R/scale-viridis.r +++ b/R/scale-viridis.r @@ -5,7 +5,7 @@ #' with common forms of colour blindness. See also #' . #' -#' @inheritParams viridisLite::viridis +#' @inheritParams scales::viridis_pal #' @inheritParams scales::gradient_n_pal #' @inheritParams continuous_scale #' @param ... Other arguments passed on to [discrete_scale()], diff --git a/R/theme-current.R b/R/theme-current.R index 392633fada..8cfb61f87e 100644 --- a/R/theme-current.R +++ b/R/theme-current.R @@ -104,5 +104,17 @@ theme_replace <- function(...) { # Can't use modifyList here since it works recursively and drops NULLs e1[names(e2)] <- e2 + + # Merge element trees if provided + attr(e1, "element_tree") <- defaults( + attr(e2, "element_tree", exact = TRUE), + attr(e1, "element_tree", exact = TRUE) + ) + + # comment by @clauswilke: + # `complete` and `validate` are currently ignored, + # which means they are taken from e1. Is this correct? + # I'm not sure how `%+replace%` should handle them. + e1 } diff --git a/R/theme-defaults.r b/R/theme-defaults.r index 00a92bb99e..844400bde6 100644 --- a/R/theme-defaults.r +++ b/R/theme-defaults.r @@ -111,7 +111,7 @@ theme_grey <- function(base_size = 11, base_family = "", # Throughout the theme, we use three font sizes, `base_size` (`rel(1)`) # for normal, `rel(0.8)` for small, and `rel(1.2)` for large. - theme( + t <- theme( # Elements in this first block aren't used directly, but are inherited # by others line = element_line( @@ -234,6 +234,9 @@ theme_grey <- function(base_size = 11, base_family = "", complete = TRUE ) + + # make sure all elements are set to NULL if not explicitly defined + ggplot_global$theme_all_null %+replace% t } #' @export #' @rdname ggtheme @@ -455,7 +458,7 @@ theme_void <- function(base_size = 11, base_family = "", half_line <- base_size / 2 # Only keep indispensable text: legend and plot titles - theme( + t <- theme( line = element_blank(), rect = element_blank(), text = element_text( @@ -508,6 +511,9 @@ theme_void <- function(base_size = 11, base_family = "", complete = TRUE ) + + # make sure all elements are set to NULL if not explicitly defined + ggplot_global$theme_all_null %+replace% t } @@ -518,7 +524,7 @@ theme_test <- function(base_size = 11, base_family = "", base_rect_size = base_size / 22) { half_line <- base_size / 2 - theme( + t <- theme( line = element_line( colour = "black", size = base_line_size, linetype = 1, lineend = "butt" @@ -639,4 +645,19 @@ theme_test <- function(base_size = 11, base_family = "", complete = TRUE ) + + # make sure all elements are set to NULL if not explicitly defined + ggplot_global$theme_all_null %+replace% t +} + +theme_all_null <- function() { + # set all elements in the element tree to NULL + elements <- sapply( + names(ggplot_global$element_tree), + function(x) NULL, + simplify = FALSE, USE.NAMES = TRUE + ) + + args <- c(elements, list(complete = TRUE)) + do.call(theme, args) } diff --git a/R/theme-elements.r b/R/theme-elements.r index f2916d71e8..29f8b708df 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -10,7 +10,7 @@ #' - `element_text`: text. #' #' `rel()` is used to specify sizes relative to the parent, -#' `margins()` is used to specify the margins of elements. +#' `margin()` is used to specify the margins of elements. #' #' @param fill Fill colour. #' @param colour,color Line/border colour. Color is an alias for colour. @@ -154,13 +154,22 @@ print.rel <- function(x, ...) print(noquote(paste(x, " *", sep = ""))) #' @keywords internal is.rel <- function(x) inherits(x, "rel") -# Given a theme object and element name, return a grob for the element +#' Render a specified theme element into a grob +#' +#' Given a theme object and element name, returns a grob for the element. +#' Uses [`element_grob()`] to generate the grob. +#' @param theme The theme object +#' @param element The element name given as character vector +#' @param ... Other arguments provided to [`element_grob()`] +#' @param name Character vector added to the name of the grob +#' @keywords internal +#' @export element_render <- function(theme, element, ..., name = NULL) { # Get the element from the theme, calculating inheritance el <- calc_element(element, theme) if (is.null(el)) { - message("Theme element ", element, " missing") + message("Theme element `", element, "` missing") return(zeroGrob()) } @@ -263,13 +272,51 @@ element_grob.element_line <- function(element, x = 0:1, y = 0:1, -# Define an element's class and what other elements it inherits from -# -# @param class The name of class (like "element_line", "element_text", -# or the reserved "character", which means a character vector (not -# "character" class) -# @param inherit A vector of strings, naming the elements that this -# element inherits from. +#' Define new elements for a theme's element tree +#' +#' Each theme has an element tree that defines which theme elements inherit +#' theme parameters from which other elements. The function `el_def()` can be used +#' to define new or modified elements for this tree. +#' +#' @param class The name of the element class. Examples are "element_line" or +#' "element_text" or "unit", or one of the two reserved keywords "character" or +#' "margin". The reserved keyword "character" implies a character +#' or numeric vector, not a class called "character". The keyword +#' "margin" implies a unit vector of length 4, as created by [margin()]. +#' @param inherit A vector of strings, naming the elements that this +#' element inherits from. +#' @param description An optional character vector providing a description +#' for the element. +#' @examples +#' # define a new coord that includes a panel annotation +#' coord_annotate <- function(label = "panel annotation") { +#' ggproto(NULL, CoordCartesian, +#' limits = list(x = NULL, y = NULL), +#' expand = TRUE, +#' default = FALSE, +#' clip = "on", +#' render_fg = function(panel_params, theme) { +#' element_render(theme, "panel.annotation", label = label) +#' } +#' ) +#' } +#' +#' # update the default theme by adding a new `panel.annotation` +#' # theme element +#' old <- theme_update( +#' panel.annotation = element_text(color = "blue", hjust = 0.95, vjust = 0.05), +#' element_tree = list(panel.annotation = el_def("element_text", "text")) +#' ) +#' +#' df <- data.frame(x = 1:3, y = 1:3) +#' ggplot(df, aes(x, y)) + +#' geom_point() + +#' coord_annotate("annotation in blue") +#' +#' # revert to original default theme +#' theme_set(old) +#' @keywords internal +#' @export el_def <- function(class = NULL, inherit = NULL, description = NULL) { list(class = class, inherit = inherit, description = description) } @@ -393,11 +440,12 @@ ggplot_global$element_tree <- .element_tree # # @param el an element # @param elname the name of the element -validate_element <- function(el, elname) { - eldef <- ggplot_global$element_tree[[elname]] +# @param element_tree the element tree to validate against +validate_element <- function(el, elname, element_tree) { + eldef <- element_tree[[elname]] if (is.null(eldef)) { - stop('"', elname, '" is not a valid theme element name.') + stop("Theme element `", elname, "` is not defined in the element hierarchy.", call. = FALSE) } # NULL values for elements are OK @@ -407,12 +455,12 @@ validate_element <- function(el, elname) { # Need to be a bit looser here since sometimes it's a string like "top" # but sometimes its a vector like c(0,0) if (!is.character(el) && !is.numeric(el)) - stop("Element ", elname, " must be a string or numeric vector.") + stop("Theme element `", elname, "` must be a string or numeric vector.", call. = FALSE) } else if (eldef$class == "margin") { if (!is.unit(el) && length(el) == 4) - stop("Element ", elname, " must be a unit vector of length 4.") + stop("Theme element `", elname, "` must be a unit vector of length 4.", call. = FALSE) } else if (!inherits(el, eldef$class) && !inherits(el, "element_blank")) { - stop("Element ", elname, " must be a ", eldef$class, " object.") + stop("Theme element `", elname, "` must be an `", eldef$class, "` object.", call. = FALSE) } invisible() } diff --git a/R/theme.r b/R/theme.r index f9d21f9487..0ef578b26c 100644 --- a/R/theme.r +++ b/R/theme.r @@ -9,7 +9,7 @@ #' about theme inheritance below. #' #' @section Theme inheritance: -#' Theme elements inherit properties from other theme elements heirarchically. +#' Theme elements inherit properties from other theme elements hierarchically. #' For example, `axis.title.x.bottom` inherits from `axis.title.x` which inherits #' from `axis.title`, which in turn inherits from `text`. All text elements inherit #' directly or indirectly from `text`; all lines inherit from @@ -164,6 +164,10 @@ #' `complete = TRUE` all elements will be set to inherit from blank #' elements. #' @param validate `TRUE` to run `validate_element()`, `FALSE` to bypass checks. +#' @param element_tree optional addition or modification to the element tree, +#' which specifies the inheritance relationship of the theme elements. The element +#' tree should be provided as a list of named element definitions created with +#' [`el_def()`]. See [`el_def()`] for more details. #' #' @seealso #' [+.gg()] and \code{\link{\%+replace\%}}, @@ -358,9 +362,10 @@ theme <- function(line, strip.switch.pad.wrap, ..., complete = FALSE, - validate = TRUE + validate = TRUE, + element_tree = NULL ) { - elements <- find_args(..., complete = NULL, validate = NULL) + elements <- find_args(..., complete = NULL, validate = NULL, element_tree = NULL) if (!is.null(elements$axis.ticks.margin)) { warning("`axis.ticks.margin` is deprecated. Please set `margin` property ", @@ -392,11 +397,6 @@ theme <- function(line, elements$legend.margin <- margin() } - # Check that all elements have the correct class (element_text, unit, etc) - if (validate) { - mapply(validate_element, elements, names(elements)) - } - # If complete theme set all non-blank elements to inherit from blanks if (complete) { elements <- lapply(elements, function(el) { @@ -410,21 +410,69 @@ theme <- function(line, elements, class = c("theme", "gg"), complete = complete, - validate = validate + validate = validate, + element_tree = element_tree ) } -is_theme_complete <- function(x) isTRUE(attr(x, "complete")) +# check whether theme is complete +is_theme_complete <- function(x) isTRUE(attr(x, "complete", exact = TRUE)) +# check whether theme should be validated +is_theme_validate <- function(x) { + validate <- attr(x, "validate", exact = TRUE) + if (is.null(validate)) + TRUE # we validate by default + else + isTRUE(validate) +} + +# obtain the full element tree from a theme, +# substituting the defaults if needed +complete_element_tree <- function(theme) { + element_tree <- attr(theme, "element_tree", exact = TRUE) + + # we fill in the element tree first from the current default theme, + # and then from the internal element tree if necessary + # this makes it easy for extension packages to provide modified + # default element trees + defaults( + defaults( + element_tree, + attr(theme_get(), "element_tree", exact = TRUE) + ), + ggplot_global$element_tree + ) +} # Combine plot defaults with current theme to get complete theme for a plot plot_theme <- function(x, default = theme_get()) { theme <- x$theme + + # apply theme defaults appropriately if needed if (is_theme_complete(theme)) { - theme + # for complete themes, we fill in missing elements but don't do any element merging + # can't use `defaults()` because it strips attributes + missing <- setdiff(names(default), names(theme)) + theme[missing] <- default[missing] } else { - defaults(theme, default) + # otherwise, we can just add the theme to the default theme + theme <- default + theme } + + # complete the element tree and save back to the theme + element_tree <- complete_element_tree(theme) + attr(theme, "element_tree") <- element_tree + + # Check that all elements have the correct class (element_text, unit, etc) + if (is_theme_validate(theme)) { + mapply( + validate_element, theme, names(theme), + MoreArgs = list(element_tree = element_tree) + ) + } + + theme } #' Modify properties of an element in a theme object @@ -435,8 +483,8 @@ plot_theme <- function(x, default = theme_get()) { #' informative error messages. #' @keywords internal add_theme <- function(t1, t2, t2name) { - if (!is.theme(t2)) { - stop("Don't know how to add ", t2name, " to a theme object", + if (!is.list(t2)) { # in various places in the code base, simple lists are used as themes + stop("Can't add `", t2name, "` to a theme object.", call. = FALSE) } @@ -457,6 +505,17 @@ add_theme <- function(t1, t2, t2name) { # make sure the "complete" attribute is set; this can be missing # when t1 is an empty list attr(t1, "complete") <- is_theme_complete(t1) + + # Only validate if both themes should be validated + attr(t1, "validate") <- + is_theme_validate(t1) && is_theme_validate(t2) + + # Merge element trees if provided + attr(t1, "element_tree") <- defaults( + attr(t2, "element_tree", exact = TRUE), + attr(t1, "element_tree", exact = TRUE) + ) + t1 } @@ -484,14 +543,7 @@ add_theme <- function(t1, t2, t2name) { calc_element <- function(element, theme, verbose = FALSE) { if (verbose) message(element, " --> ", appendLF = FALSE) - # if theme is not complete, merge element with theme defaults, - # otherwise take it as is. This fills in theme defaults if no - # explicit theme is set for the plot. - if (!is_theme_complete(theme)) { - el_out <- merge_element(theme[[element]], theme_get()[[element]]) - } else { - el_out <- theme[[element]] - } + el_out <- theme[[element]] # If result is element_blank, don't inherit anything from parents if (inherits(el_out, "element_blank")) { @@ -499,15 +551,23 @@ calc_element <- function(element, theme, verbose = FALSE) { return(el_out) } + # Obtain the element tree and check that the element is in it + # If not, try to retrieve the complete element tree. This is + # needed for backwards compatibility and certain unit tests. + element_tree <- attr(theme, "element_tree", exact = TRUE) + if (!element %in% names(element_tree)) { + element_tree <- complete_element_tree(theme) + } + # If the element is defined (and not just inherited), check that - # it is of the class specified in .element_tree + # it is of the class specified in element_tree if (!is.null(el_out) && - !inherits(el_out, ggplot_global$element_tree[[element]]$class)) { - stop(element, " should have class ", ggplot_global$element_tree[[element]]$class) + !inherits(el_out, element_tree[[element]]$class)) { + stop(element, " should have class ", element_tree[[element]]$class) } # Get the names of parents from the inheritance tree - pnames <- ggplot_global$element_tree[[element]]$inherit + pnames <- element_tree[[element]]$inherit # If no parents, this is a "root" node. Just return this element. if (is.null(pnames)) { diff --git a/R/utilities.r b/R/utilities.r index 42ef0f2fbe..1cb8fd144d 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -97,20 +97,13 @@ remove_missing <- function(df, na.rm = FALSE, vars = names(df), name = "", finite = FALSE) { stopifnot(is.logical(na.rm)) - vars <- intersect(vars, names(df)) - if (name != "") name <- paste(" (", name, ")", sep = "") - - if (finite) { - missing <- !cases(df[, vars, drop = FALSE], is_finite) - str <- "non-finite" - } else { - missing <- !cases(df[, vars, drop = FALSE], is_complete) - str <- "missing" - } + missing <- detect_missing(df, vars, finite) if (any(missing)) { df <- df[!missing, ] if (!na.rm) { + if (name != "") name <- paste(" (", name, ")", sep = "") + str <- if (finite) "non-finite" else "missing" warning_wrap( "Removed ", sum(missing), " rows containing ", str, " values", name, "." ) @@ -119,6 +112,10 @@ remove_missing <- function(df, na.rm = FALSE, vars = names(df), name = "", df } +detect_missing <- function(df, vars, finite = FALSE) { + vars <- intersect(vars, names(df)) + !cases(df[, vars, drop = FALSE], if (finite) is_finite else is_complete) +} # Returns a logical vector of same length as nrow(x). If all data on a row # is finite (not NA, NaN, Inf, or -Inf) return TRUE; otherwise FALSE. diff --git a/R/zzz.r b/R/zzz.r index fb8a1a4b6b..5e3d77ae5a 100644 --- a/R/zzz.r +++ b/R/zzz.r @@ -34,6 +34,7 @@ pathGrob <- NULL .zeroGrob <<- grob(cl = "zeroGrob", name = "NULL") # create default theme, store for later use, and set as current theme + ggplot_global$theme_all_null <- theme_all_null() # required by theme_grey() ggplot_global$theme_grey <- theme_grey() ggplot_global$theme_current <- ggplot_global$theme_grey diff --git a/man/continuous_scale.Rd b/man/continuous_scale.Rd index 6c5ee2a3fb..e47020117c 100644 --- a/man/continuous_scale.Rd +++ b/man/continuous_scale.Rd @@ -5,10 +5,11 @@ \title{Continuous scale constructor} \usage{ continuous_scale(aesthetics, scale_name, palette, name = waiver(), - breaks = waiver(), minor_breaks = waiver(), labels = waiver(), - limits = NULL, rescaler = rescale, oob = censor, - expand = waiver(), na.value = NA_real_, trans = "identity", - guide = "legend", position = "left", super = ScaleContinuous) + breaks = waiver(), minor_breaks = waiver(), n.breaks = NULL, + labels = waiver(), limits = NULL, rescaler = rescale, + oob = censor, expand = waiver(), na.value = NA_real_, + trans = "identity", guide = "legend", position = "left", + super = ScaleContinuous) } \arguments{ \item{aesthetics}{The names of the aesthetics that this scale works with.} @@ -44,6 +45,11 @@ each major break) \item A function that given the limits returns a vector of minor breaks. }} +\item{n.breaks}{An integer guiding the number of major breaks. The algorithm +may choose a slightly different number to ensure nice break labels. Will +only have an effect if \code{breaks = waiver()}. Use \code{NULL} to use the default +number of breaks given by the transformation.} + \item{labels}{One of: \itemize{ \item \code{NULL} for no labels diff --git a/man/el_def.Rd b/man/el_def.Rd new file mode 100644 index 0000000000..a7592f63df --- /dev/null +++ b/man/el_def.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/theme-elements.r +\name{el_def} +\alias{el_def} +\title{Define new elements for a theme's element tree} +\usage{ +el_def(class = NULL, inherit = NULL, description = NULL) +} +\arguments{ +\item{class}{The name of the element class. Examples are "element_line" or +"element_text" or "unit", or one of the two reserved keywords "character" or +"margin". The reserved keyword "character" implies a character +or numeric vector, not a class called "character". The keyword +"margin" implies a unit vector of length 4, as created by \code{\link[=margin]{margin()}}.} + +\item{inherit}{A vector of strings, naming the elements that this +element inherits from.} + +\item{description}{An optional character vector providing a description +for the element.} +} +\description{ +Each theme has an element tree that defines which theme elements inherit +theme parameters from which other elements. The function \code{el_def()} can be used +to define new or modified elements for this tree. +} +\examples{ +# define a new coord that includes a panel annotation +coord_annotate <- function(label = "panel annotation") { + ggproto(NULL, CoordCartesian, + limits = list(x = NULL, y = NULL), + expand = TRUE, + default = FALSE, + clip = "on", + render_fg = function(panel_params, theme) { + element_render(theme, "panel.annotation", label = label) + } + ) +} + +# update the default theme by adding a new `panel.annotation` +# theme element +old <- theme_update( + panel.annotation = element_text(color = "blue", hjust = 0.95, vjust = 0.05), + element_tree = list(panel.annotation = el_def("element_text", "text")) +) + +df <- data.frame(x = 1:3, y = 1:3) +ggplot(df, aes(x, y)) + + geom_point() + + coord_annotate("annotation in blue") + +# revert to original default theme +theme_set(old) +} +\keyword{internal} diff --git a/man/element.Rd b/man/element.Rd index e7be72807c..286ae88dc4 100644 --- a/man/element.Rd +++ b/man/element.Rd @@ -90,7 +90,7 @@ specify the display of how non-data components of the plot are a drawn. } \code{rel()} is used to specify sizes relative to the parent, -\code{margins()} is used to specify the margins of elements. +\code{margin()} is used to specify the margins of elements. } \examples{ plot <- ggplot(mpg, aes(displ, hwy)) + geom_point() diff --git a/man/element_render.Rd b/man/element_render.Rd new file mode 100644 index 0000000000..d9bd13ec56 --- /dev/null +++ b/man/element_render.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/theme-elements.r +\name{element_render} +\alias{element_render} +\title{Render a specified theme element into a grob} +\usage{ +element_render(theme, element, ..., name = NULL) +} +\arguments{ +\item{theme}{The theme object} + +\item{element}{The element name given as character vector} + +\item{...}{Other arguments provided to \code{\link[=element_grob]{element_grob()}}} + +\item{name}{Character vector added to the name of the grob} +} +\description{ +Given a theme object and element name, returns a grob for the element. +Uses \code{\link[=element_grob]{element_grob()}} to generate the grob. +} +\keyword{internal} diff --git a/man/geom_dotplot.Rd b/man/geom_dotplot.Rd index 31c9b50cba..107555a59e 100644 --- a/man/geom_dotplot.Rd +++ b/man/geom_dotplot.Rd @@ -57,7 +57,7 @@ aligning dot stacks across multiple groups.} \item{stackdir}{which direction to stack the dots. "up" (default), "down", "center", "centerwhole" (centered, but with dots aligned)} -\item{stackratio}{how close to stack the dots. Default is 1, where dots just +\item{stackratio}{how close to stack the dots. Default is 1, where dots just touch. Use smaller values for closer, overlapping dots.} \item{dotsize}{The diameter of the dots relative to \code{binwidth}, default 1.} diff --git a/man/geom_ribbon.Rd b/man/geom_ribbon.Rd index 06b5b619d0..db771c5387 100644 --- a/man/geom_ribbon.Rd +++ b/man/geom_ribbon.Rd @@ -114,8 +114,9 @@ h <- ggplot(huron, aes(year)) h + geom_ribbon(aes(ymin=0, ymax=level)) h + geom_area(aes(y = level)) -# Change orientation be switching the mapping -h + geom_area(aes(x = level, y = year)) +# Orientation cannot be deduced by mapping, so must be given explicitly for +# flipped orientation +h + geom_area(aes(x = level, y = year), orientation = "y") # Add aesthetic mappings h + diff --git a/man/ggplot2-package.Rd b/man/ggplot2-package.Rd index 8f94867dcc..922021f8f1 100644 --- a/man/ggplot2-package.Rd +++ b/man/ggplot2-package.Rd @@ -34,6 +34,7 @@ Authors: \item Claus Wilke \item Kara Woo \item Hiroaki Yutani + \item Dewey Dunnington } Other contributors: diff --git a/man/merge_element.Rd b/man/merge_element.Rd index 93d4dd7361..913e75ce73 100644 --- a/man/merge_element.Rd +++ b/man/merge_element.Rd @@ -3,6 +3,7 @@ \name{merge_element} \alias{merge_element} \alias{merge_element.default} +\alias{merge_element.element_blank} \alias{merge_element.element} \title{Merge a parent element into a child element} \usage{ @@ -10,6 +11,8 @@ merge_element(new, old) \method{merge_element}{default}(new, old) +\method{merge_element}{element_blank}(new, old) + \method{merge_element}{element}(new, old) } \arguments{ diff --git a/man/scale_continuous.Rd b/man/scale_continuous.Rd index c853b8c83d..97847343ab 100644 --- a/man/scale_continuous.Rd +++ b/man/scale_continuous.Rd @@ -12,16 +12,16 @@ \title{Position scales for continuous data (x & y)} \usage{ scale_x_continuous(name = waiver(), breaks = waiver(), - minor_breaks = waiver(), labels = waiver(), limits = NULL, - expand = waiver(), oob = censor, na.value = NA_real_, - trans = "identity", guide = waiver(), position = "bottom", - sec.axis = waiver()) + minor_breaks = waiver(), n.breaks = NULL, labels = waiver(), + limits = NULL, expand = waiver(), oob = censor, + na.value = NA_real_, trans = "identity", guide = waiver(), + position = "bottom", sec.axis = waiver()) scale_y_continuous(name = waiver(), breaks = waiver(), - minor_breaks = waiver(), labels = waiver(), limits = NULL, - expand = waiver(), oob = censor, na.value = NA_real_, - trans = "identity", guide = waiver(), position = "left", - sec.axis = waiver()) + minor_breaks = waiver(), n.breaks = NULL, labels = waiver(), + limits = NULL, expand = waiver(), oob = censor, + na.value = NA_real_, trans = "identity", guide = waiver(), + position = "left", sec.axis = waiver()) scale_x_log10(...) @@ -60,6 +60,11 @@ each major break) \item A function that given the limits returns a vector of minor breaks. }} +\item{n.breaks}{An integer guiding the number of major breaks. The algorithm +may choose a slightly different number to ensure nice break labels. Will +only have an effect if \code{breaks = waiver()}. Use \code{NULL} to use the default +number of breaks given by the transformation.} + \item{labels}{One of: \itemize{ \item \code{NULL} for no labels diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index d59e93fff7..78793514a7 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -71,6 +71,10 @@ each major break) \item A numeric vector of positions \item A function that given the limits returns a vector of minor breaks. }} + \item{n.breaks}{An integer guiding the number of major breaks. The algorithm +may choose a slightly different number to ensure nice break labels. Will +only have an effect if \code{breaks = waiver()}. Use \code{NULL} to use the default +number of breaks given by the transformation.} \item{labels}{One of: \itemize{ \item \code{NULL} for no labels diff --git a/man/scale_size.Rd b/man/scale_size.Rd index 31c659c4e7..21bd612dfc 100644 --- a/man/scale_size.Rd +++ b/man/scale_size.Rd @@ -86,8 +86,10 @@ transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} -\item{n.breaks}{The number of break points to create if breaks are not given -directly.} +\item{n.breaks}{An integer guiding the number of major breaks. The algorithm +may choose a slightly different number to ensure nice break labels. Will +only have an effect if \code{breaks = waiver()}. Use \code{NULL} to use the default +number of breaks given by the transformation.} \item{nice.breaks}{Logical. Should breaks be attempted placed at nice values instead of exactly evenly spaced between the limits. If \code{TRUE} (default) @@ -118,6 +120,10 @@ each major break) \item A numeric vector of positions \item A function that given the limits returns a vector of minor breaks. }} + \item{n.breaks}{An integer guiding the number of major breaks. The algorithm +may choose a slightly different number to ensure nice break labels. Will +only have an effect if \code{breaks = waiver()}. Use \code{NULL} to use the default +number of breaks given by the transformation.} \item{labels}{One of: \itemize{ \item \code{NULL} for no labels diff --git a/man/theme.Rd b/man/theme.Rd index c06deb4d74..09962d32d5 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -27,7 +27,7 @@ theme(line, rect, text, title, aspect.ratio, axis.title, axis.title.x, plot.tag, plot.tag.position, plot.margin, strip.background, strip.background.x, strip.background.y, strip.placement, strip.text, strip.text.x, strip.text.y, strip.switch.pad.grid, strip.switch.pad.wrap, - ..., complete = FALSE, validate = TRUE) + ..., complete = FALSE, validate = TRUE, element_tree = NULL) } \arguments{ \item{line}{all line elements (\code{\link[=element_line]{element_line()}})} @@ -207,6 +207,11 @@ differently when added to a ggplot object. Also, when setting elements.} \item{validate}{\code{TRUE} to run \code{validate_element()}, \code{FALSE} to bypass checks.} + +\item{element_tree}{optional addition or modification to the element tree, +which specifies the inheritance relationship of the theme elements. The element +tree should be provided as a list of named element definitions created with +\code{\link[=el_def]{el_def()}}. See \code{\link[=el_def]{el_def()}} for more details.} } \description{ Themes are a powerful way to customize the non-data components of your @@ -219,7 +224,7 @@ about theme inheritance below. } \section{Theme inheritance}{ -Theme elements inherit properties from other theme elements heirarchically. +Theme elements inherit properties from other theme elements hierarchically. For example, \code{axis.title.x.bottom} inherits from \code{axis.title.x} which inherits from \code{axis.title}, which in turn inherits from \code{text}. All text elements inherit directly or indirectly from \code{text}; all lines inherit from diff --git a/tests/testthat/test-geom-sf.R b/tests/testthat/test-geom-sf.R index 6de5f00dfb..016e69a96c 100644 --- a/tests/testthat/test-geom-sf.R +++ b/tests/testthat/test-geom-sf.R @@ -1,5 +1,58 @@ context("geom-sf") +test_that("geom_sf() removes rows containing missing aes", { + skip_if_not_installed("sf") + if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3") + + grob_xy_length <- function(x) { + g <- layer_grob(x)[[1]] + c(length(g$x), length(g$y)) + } + + pts <- sf::st_sf( + geometry = sf::st_sfc(sf::st_point(0:1), sf::st_point(1:2)), + size = c(1, NA), + shape = c("a", NA), + colour = c("red", NA) + ) + + p <- ggplot(pts) + geom_sf() + expect_warning( + expect_identical(grob_xy_length(p + aes(size = size)), c(1L, 1L)), + "Removed 1 rows containing missing values" + ) + expect_warning( + expect_identical(grob_xy_length(p + aes(shape = shape)), c(1L, 1L)), + "Removed 1 rows containing missing values" + ) + # default colour scale maps a colour even to a NA, so identity scale is needed to see if NA is removed + expect_warning( + expect_identical(grob_xy_length(p + aes(colour = colour) + scale_colour_identity()), + c(1L, 1L)), + "Removed 1 rows containing missing values" + ) +}) + +test_that("geom_sf() handles alpha properly", { + skip_if_not_installed("sf") + if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3") + + sfc <- sf::st_sfc( + sf::st_point(0:1), + sf::st_linestring(rbind(0:1, 1:2)), + sf::st_polygon(list(rbind(0:1, 1:2, 2:1, 0:1))) + ) + red <- "#FF0000FF" + p <- ggplot(sfc) + geom_sf(colour = red, fill = red, alpha = 0.5) + g <- layer_grob(p)[[1]] + + # alpha affects the colour of points and lines + expect_equal(g[[1]]$gp$col, alpha(red, 0.5)) + expect_equal(g[[2]]$gp$col, alpha(red, 0.5)) + # alpha doesn't affect the colour of polygons, but the fill + expect_equal(g[[3]]$gp$col, alpha(red, 1.0)) + expect_equal(g[[3]]$gp$fill, alpha(red, 0.5)) +}) # Visual tests ------------------------------------------------------------ @@ -64,36 +117,3 @@ test_that("geom_sf_text() and geom_sf_label() draws correctly", { ggplot() + geom_sf_label(data = nc_3857, aes(label = NAME)) ) }) - -test_that("geom_sf() removes rows containing missing aes", { - skip_if_not_installed("sf") - if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3") - - grob_xy_length <- function(x) { - g <- layer_grob(x)[[1]] - c(length(g$x), length(g$y)) - } - - pts <- sf::st_sf( - geometry = sf::st_sfc(sf::st_point(0:1), sf::st_point(1:2)), - size = c(1, NA), - shape = c("a", NA), - colour = c("red", NA) - ) - - p <- ggplot(pts) + geom_sf() - expect_warning( - expect_identical(grob_xy_length(p + aes(size = size)), c(1L, 1L)), - "Removed 1 rows containing missing values" - ) - expect_warning( - expect_identical(grob_xy_length(p + aes(shape = shape)), c(1L, 1L)), - "Removed 1 rows containing missing values" - ) - # default colour scale maps a colour even to a NA, so identity scale is needed to see if NA is removed - expect_warning( - expect_identical(grob_xy_length(p + aes(colour = colour) + scale_colour_identity()), - c(1L, 1L)), - "Removed 1 rows containing missing values" - ) -}) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 87e3898f0d..eeb1c7fe4d 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -113,6 +113,54 @@ test_that("Using non-position guides for position scales results in an informati expect_error(ggplot_gtable(built), "does not implement guide_transform()") }) +test_that("guide merging for guide_legend() works as expected", { + + merge_test_guides <- function(scale1, scale2) { + scale1$guide <- guide_legend(direction = "vertical") + scale2$guide <- guide_legend(direction = "vertical") + scales <- scales_list() + scales$add(scale1) + scales$add(scale2) + + guide_list <- guides_train(scales, theme = theme_gray(), labels = labs(), guides = guides()) + guides_merge(guide_list) + } + + different_limits <- merge_test_guides( + scale_colour_discrete(limits = c("a", "b", "c", "d")), + scale_linetype_discrete(limits = c("a", "b", "c")) + ) + expect_length(different_limits, 2) + + same_limits <- merge_test_guides( + scale_colour_discrete(limits = c("a", "b", "c")), + scale_linetype_discrete(limits = c("a", "b", "c")) + ) + expect_length(same_limits, 1) + expect_equal(same_limits[[1]]$key$.label, c("a", "b", "c")) + + same_labels_different_limits <- merge_test_guides( + scale_colour_discrete(limits = c("a", "b", "c")), + scale_linetype_discrete(limits = c("one", "two", "three"), labels = c("a", "b", "c")) + ) + expect_length(same_labels_different_limits, 1) + expect_equal(same_labels_different_limits[[1]]$key$.label, c("a", "b", "c")) + + same_labels_different_scale <- merge_test_guides( + scale_colour_continuous(limits = c(0, 4), breaks = 1:3, labels = c("a", "b", "c")), + scale_linetype_discrete(limits = c("a", "b", "c")) + ) + expect_length(same_labels_different_scale, 1) + expect_equal(same_labels_different_scale[[1]]$key$.label, c("a", "b", "c")) + + repeated_identical_labels <- merge_test_guides( + scale_colour_discrete(limits = c("one", "two", "three"), labels = c("label1", "label1", "label2")), + scale_linetype_discrete(limits = c("1", "2", "3"), labels = c("label1", "label1", "label2")) + ) + expect_length(repeated_identical_labels, 1) + expect_equal(repeated_identical_labels[[1]]$key$.label, c("label1", "label1", "label2")) +}) + # Visual tests ------------------------------------------------------------ test_that("axis guides are drawn correctly", { diff --git a/tests/testthat/test-scale-discrete.R b/tests/testthat/test-scale-discrete.R index 8f7f32a210..4e58186849 100644 --- a/tests/testthat/test-scale-discrete.R +++ b/tests/testthat/test-scale-discrete.R @@ -81,3 +81,9 @@ test_that("discrete position scales can accept functional limits", { scale$train(c("a", "b", "c")) expect_identical(scale$get_limits(), c("c", "b", "a")) }) + +test_that("discrete non-position scales can accept functional limits", { + scale <- scale_colour_discrete(limits = rev) + scale$train(c("a", "b", "c")) + expect_identical(scale$get_limits(), c("c", "b", "a")) +}) diff --git a/tests/testthat/test-scales-breaks-labels.r b/tests/testthat/test-scales-breaks-labels.r index 12bd968e7e..3c8edf800a 100644 --- a/tests/testthat/test-scales-breaks-labels.r +++ b/tests/testthat/test-scales-breaks-labels.r @@ -247,6 +247,22 @@ test_that("continuous limits accepts functions", { expect_equal(layer_scales(p)$y$get_limits(), c(range(mpg$hwy)[1] - 10, range(mpg$hwy)[2] + 100)) }) +test_that("equal length breaks and labels can be passed to ViewScales with limits", { + + test_scale <- scale_x_continuous( + breaks = c(0, 20, 40), + labels = c("0", "20", "40"), + limits = c(10, 30) + ) + + expect_identical(test_scale$get_breaks(), c(NA, 20, NA)) + expect_identical(test_scale$get_labels(), c(c("0", "20", "40"))) + + test_view_scale <- view_scale_primary(test_scale) + expect_identical(test_view_scale$get_breaks(), c(NA, 20, NA)) + expect_identical(test_scale$get_labels(), c(c("0", "20", "40"))) +}) + # Visual tests ------------------------------------------------------------ test_that("minor breaks draw correctly", { diff --git a/tests/testthat/test-scales.r b/tests/testthat/test-scales.r index 48fc74a00f..b5d53bcc28 100644 --- a/tests/testthat/test-scales.r +++ b/tests/testthat/test-scales.r @@ -294,3 +294,28 @@ test_that("multiple aesthetics can be set with one function call", { expect_equal(layer_data(p)$colour, c("cyan", "red", "green")) expect_equal(layer_data(p)$fill, c("red", "green", "blue")) }) + +test_that("limits with NA are replaced with the min/max of the data for continuous scales", { + make_scale <- function(limits = NULL, data = NULL) { + scale <- continuous_scale("aesthetic", scale_name = "test", palette = identity, limits = limits) + if (!is.null(data)) { + scale$train(data) + } + scale + } + + # emptiness + expect_true(make_scale()$is_empty()) + expect_false(make_scale(limits = c(0, 1))$is_empty()) + expect_true(make_scale(limits = c(0, NA))$is_empty()) + expect_true(make_scale(limits = c(NA, NA))$is_empty()) + expect_true(make_scale(limits = c(NA, 0))$is_empty()) + + # limits + expect_equal(make_scale(data = 1:5)$get_limits(), c(1, 5)) + expect_equal(make_scale(limits = c(1, 5))$get_limits(), c(1, 5)) + expect_equal(make_scale(limits = c(NA, NA))$get_limits(), c(0, 1)) + expect_equal(make_scale(limits = c(NA, NA), data = 1:5)$get_limits(), c(1, 5)) + expect_equal(make_scale(limits = c(1, NA), data = 1:5)$get_limits(), c(1, 5)) + expect_equal(make_scale(limits = c(NA, 5), data = 1:5)$get_limits(), c(1, 5)) +}) diff --git a/tests/testthat/test-theme.r b/tests/testthat/test-theme.r index 7d45fab7fa..ed474a4aa0 100644 --- a/tests/testthat/test-theme.r +++ b/tests/testthat/test-theme.r @@ -228,6 +228,41 @@ test_that("theme(validate=FALSE) means do not validate_element", { expect_equal(red.before$theme$animint.width, 500) }) +test_that("theme validation happens at build stage", { + # adding a non-valid theme element to a theme is no problem + expect_silent(theme_gray() + theme(text = 0)) + + # the error occurs when we try to render the plot + p <- ggplot() + theme(text = 0) + expect_error(print(p), "must be an `element_text`") + + # without validation, the error occurs when the element is accessed + p <- ggplot() + theme(text = 0, validate = FALSE) + expect_error(print(p), "text should have class element_text") +}) + +test_that("element tree can be modified", { + # we cannot add a new theme element without modifying the element tree + p <- ggplot() + theme(blablabla = element_text(colour = "red")) + expect_error(print(p), "Theme element `blablabla` is not defined in the element hierarchy") + + # things work once we add a new element to the element tree + q <- p + theme( + element_tree = list(blablabla = el_def("element_text", "text")) + ) + expect_silent(print(q)) + + # inheritance and final calculation of novel element works + final_theme <- ggplot2:::plot_theme(q, theme_gray()) + e1 <- calc_element("blablabla", final_theme) + e2 <- calc_element("text", final_theme) + expect_identical(e1$family, e2$family) + expect_identical(e1$face, e2$face) + expect_identical(e1$size, e2$size) + expect_identical(e1$lineheight, e2$lineheight) + expect_identical(e1$colour, "red") # not inherited from element_text +}) + test_that("all elements in complete themes have inherit.blank=TRUE", { inherit_blanks <- function(theme) { all(vapply(theme, function(el) { @@ -287,6 +322,44 @@ test_that("complete plot themes shouldn't inherit from default", { expect_null(ptheme$axis.text.x) }) +test_that("current theme can be updated with new elements", { + old <- theme_set(theme_grey()) + + b1 <- ggplot() + theme_grey() + b2 <- ggplot() + + # works for root element + expect_identical( + calc_element("text", plot_theme(b1)), + calc_element("text", plot_theme(b2)) + ) + + # works for derived element + expect_identical( + calc_element("axis.text.x", plot_theme(b1)), + calc_element("axis.text.x", plot_theme(b2)) + ) + + # theme calculation for nonexisting element returns NULL + expect_identical(calc_element("abcde", plot_theme(b1)), NULL) + + # element tree gets merged properly + theme_replace( + abcde = element_text(color = "blue", hjust = 0, vjust = 1), + element_tree = list(abcde = el_def("element_text", "text")), + complete = TRUE + ) + + e1 <- calc_element("abcde", plot_theme(b2)) + e2 <- calc_element("text", plot_theme(b2)) + e2$colour <- "blue" + e2$hjust <- 0 + e2$vjust <- 1 + expect_identical(e1, e2) + + theme_set(old) +}) + test_that("titleGrob() and margins() work correctly", { # ascenders and descenders g1 <- titleGrob("aaaa", 0, 0, 0.5, 0.5) # lower-case letters, no ascenders or descenders @@ -484,3 +557,38 @@ test_that("plot titles and caption can be aligned to entire plot", { expect_doppelganger("caption aligned to entire plot", plot) }) + +test_that("provided themes explicitly define all elements", { + elements <- names(ggplot_global$element_tree) + + t <- theme_all_null() + expect_true(all(names(t) %in% elements)) + expect_true(all(vapply(t, is.null, logical(1)))) + + t <- theme_grey() + expect_true(all(names(t) %in% elements)) + + t <- theme_bw() + expect_true(all(names(t) %in% elements)) + + t <- theme_linedraw() + expect_true(all(names(t) %in% elements)) + + t <- theme_light() + expect_true(all(names(t) %in% elements)) + + t <- theme_dark() + expect_true(all(names(t) %in% elements)) + + t <- theme_minimal() + expect_true(all(names(t) %in% elements)) + + t <- theme_classic() + expect_true(all(names(t) %in% elements)) + + t <- theme_void() + expect_true(all(names(t) %in% elements)) + + t <- theme_test() + expect_true(all(names(t) %in% elements)) +}) diff --git a/vignettes/ggplot2-specs.Rmd b/vignettes/ggplot2-specs.Rmd index 183ec469d6..07fee7e25f 100644 --- a/vignettes/ggplot2-specs.Rmd +++ b/vignettes/ggplot2-specs.Rmd @@ -31,7 +31,7 @@ Almost every geom has either colour, fill, or both. Colours and fills can be spe * An __NA__, for a completely transparent colour. * The [munsell](https://github.com/cwickham/munsell) package, by Charlotte - Wickham, makes it easy to specific colours using a system designed by + Wickham, makes it easy to choose specific colours using a system designed by Alfred Munsell. If you invest a little in learning the system, it provides a convenient way of specifying aesthetically pleasing colours.