diff --git a/.travis.yml b/.travis.yml index 0e4597a797..1a72522ff9 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,34 +1,8 @@ -language: R -cache: packages +language: r sudo: false +cache: packages -r_github_packages: - - hadley/staticdocs - -after_success: - - Rscript -e 'covr::codecov()' - -before_deploy: - - R -e "install.packages('roxygen2', repos = 'http://cran.rstudio.com')" - - R -e "staticdocs::build_site(examples = TRUE)" - -deploy: - - provider: s3 - access_key_id: AKIAJDM6KGIZ6LSGAK4Q - secret_access_key: - secure: "r3vSpvVNcpvIcjWFyk+GhYG55iuhfmy3mwuQHQS2EqjT3Skd3mOojnZuRIqy60XXElK5/nfa3qt7KH0GCSd4Is28cqPwh+1PtQ0ZVXfeKefAk2whTPDI4P+rgOA+srUxZraLALap9QGmvlzJyXbqBCRdDmXUjtXKi2ONE9PrUk4=" - bucket: docs.ggplot2.org - skip_cleanup: true - local-dir: inst/web - upload-dir: dev - - - provider: s3 - access_key_id: AKIAJDM6KGIZ6LSGAK4Q - secret_access_key: - secure: "r3vSpvVNcpvIcjWFyk+GhYG55iuhfmy3mwuQHQS2EqjT3Skd3mOojnZuRIqy60XXElK5/nfa3qt7KH0GCSd4Is28cqPwh+1PtQ0ZVXfeKefAk2whTPDI4P+rgOA+srUxZraLALap9QGmvlzJyXbqBCRdDmXUjtXKi2ONE9PrUk4=" - bucket: docs.ggplot2.org - skip_cleanup: true - local-dir: inst/web - upload-dir: current - on: - tags: true +branches: + only: + - cran + - validate-params diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index e7c58ab380..6fa7a82a2b 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -5,6 +5,57 @@ The goal of this guide is to help you get up and contributing to ggplot2 as quic 1. Filing a bug report or feature request in an issue. 1. Suggesting a change via a pull request. +## Development Moode: ggplot2Animint + +@vivekktiwari [For Future References] + +Date: 30-06-2018 + +ggproto --> a_ggproto +9along with its all S3 methods) + +Date: 23-06-2018 + +train_layout --> a_train_layout +NOTE: this a_train_layout is different from the function defined in Animint2 + +build_strip --> a_build_strip + +------------------------------- +draw_key_funcname --> a_draw_key_* +(all its functions) + +facet_funcname --> a_facet_* + +facet -- > a_facet + +ggplot --> a_plot +(along with its S3 methods) + +ggplot_gtable --> a_plot_gtable + +ggplot_build --> a_plot_build + +scales_list --> a_scales_list + + +Previous Changes: + +Following function/object have been made internal functions: + + + +export(annotate) +export(annotation_custom) +export(annotation_logticks) +export(annotation_map) +export(annotation_raster) +export(benchplot) +export(borders) +export(label_wrap_gen) +export(labs) + + ## Issues When filing an issue, the most important thing is to include a minimal reproducible example so that we can quickly verify the problem, and then figure out how to fix it. There are three things you need to include to make your example reproducible: required packages, data, code. diff --git a/DESCRIPTION b/DESCRIPTION index 27c50cb525..1d368403c0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,9 +1,10 @@ -Package: ggplot2 -Version: 2.1.0 +Package: ggplot2Animint +Version: 2.1.0.99 Authors@R: c( - person("Hadley", "Wickham", , "hadley@rstudio.com", c("aut", "cre")), + person("Hadley", "Wickham", , "hadley@rstudio.com", c("aut")), person("Winston", "Chang", , "winston@rstudio.com", "aut"), - person("RStudio", role = "cph") + person("RStudio", role = "cph"), + person("Faizan", "Khan", , "faizan.khan.iitbhu@gmail.com", c("cre")) ) Title: An Implementation of the Grammar of Graphics Description: An implementation of the grammar of graphics in R. It combines the @@ -217,4 +218,4 @@ Collate: 'zxx.r' 'zzz.r' VignetteBuilder: knitr -RoxygenNote: 5.0.1 +RoxygenNote: 6.0.1 diff --git a/NAMESPACE b/NAMESPACE index 5297ffbdc9..1aa9650b32 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,78 +1,87 @@ # Generated by roxygen2: do not edit by hand -S3method("$",ggproto) -S3method("$",ggproto_parent) -S3method("+",gg) +S3method("$",a_ggproto) +S3method("$",a_ggproto_parent) +S3method("+",aaa) S3method("[",uneval) -S3method("[[",ggproto) +S3method("[[",a_ggproto) +S3method(a_element_grob,a_element_blank) +S3method(a_element_grob,a_element_line) +S3method(a_element_grob,a_element_rect) +S3method(a_element_grob,a_element_text) +S3method(a_facet_axes,grid) +S3method(a_facet_axes,wrap) +S3method(a_facet_map_layout,grid) +S3method(a_facet_map_layout,null) +S3method(a_facet_map_layout,wrap) +S3method(a_facet_panels,grid) +S3method(a_facet_panels,wrap) +S3method(a_facet_render,grid) +S3method(a_facet_render,null) +S3method(a_facet_render,wrap) +S3method(a_facet_strips,grid) +S3method(a_facet_strips,wrap) +S3method(a_facet_train_layout,grid) +S3method(a_facet_train_layout,null) +S3method(a_facet_train_layout,wrap) +S3method(a_facet_vars,grid) +S3method(a_facet_vars,null) +S3method(a_facet_vars,wrap) +S3method(a_fortify,"NULL") +S3method(a_fortify,"function") +S3method(a_fortify,Line) +S3method(a_fortify,Lines) +S3method(a_fortify,Polygon) +S3method(a_fortify,Polygons) +S3method(a_fortify,SpatialLinesDataFrame) +S3method(a_fortify,SpatialPolygons) +S3method(a_fortify,SpatialPolygonsDataFrame) +S3method(a_fortify,cld) +S3method(a_fortify,confint.glht) +S3method(a_fortify,data.frame) +S3method(a_fortify,default) +S3method(a_fortify,glht) +S3method(a_fortify,lm) +S3method(a_fortify,map) +S3method(a_fortify,summary.glht) +S3method(a_guide_gengrob,colorbar) +S3method(a_guide_gengrob,legend) +S3method(a_guide_geom,colorbar) +S3method(a_guide_geom,legend) +S3method(a_guide_merge,colorbar) +S3method(a_guide_merge,legend) +S3method(a_guide_train,colorbar) +S3method(a_guide_train,legend) +S3method(a_plot,data.frame) +S3method(a_plot,default) +S3method(a_scale_type,AsIs) +S3method(a_scale_type,Date) +S3method(a_scale_type,POSIXt) +S3method(a_scale_type,character) +S3method(a_scale_type,default) +S3method(a_scale_type,factor) +S3method(a_scale_type,logical) +S3method(a_scale_type,numeric) +S3method(a_scale_type,ordered) S3method(as.character,uneval) -S3method(as.list,ggproto) +S3method(as.list,a_ggproto) S3method(autoplot,default) -S3method(drawDetails,zeroGrob) -S3method(element_grob,element_blank) -S3method(element_grob,element_line) -S3method(element_grob,element_rect) -S3method(element_grob,element_text) -S3method(facet_axes,grid) -S3method(facet_axes,wrap) -S3method(facet_map_layout,grid) -S3method(facet_map_layout,null) -S3method(facet_map_layout,wrap) -S3method(facet_panels,grid) -S3method(facet_panels,wrap) -S3method(facet_render,grid) -S3method(facet_render,null) -S3method(facet_render,wrap) -S3method(facet_strips,grid) -S3method(facet_strips,wrap) -S3method(facet_train_layout,grid) -S3method(facet_train_layout,null) -S3method(facet_train_layout,wrap) -S3method(facet_vars,grid) -S3method(facet_vars,null) -S3method(facet_vars,wrap) +S3method(drawDetails,a_zeroGrob) S3method(finite.cases,data.frame) -S3method(format,facet) -S3method(format,ggproto) -S3method(format,ggproto_method) -S3method(fortify,"NULL") -S3method(fortify,"function") -S3method(fortify,Line) -S3method(fortify,Lines) -S3method(fortify,Polygon) -S3method(fortify,Polygons) -S3method(fortify,SpatialLinesDataFrame) -S3method(fortify,SpatialPolygons) -S3method(fortify,SpatialPolygonsDataFrame) -S3method(fortify,cld) -S3method(fortify,confint.glht) -S3method(fortify,data.frame) -S3method(fortify,default) -S3method(fortify,glht) -S3method(fortify,lm) -S3method(fortify,map) -S3method(fortify,summary.glht) -S3method(ggplot,data.frame) -S3method(ggplot,default) +S3method(format,a_facet) +S3method(format,a_ggproto) +S3method(format,a_ggproto_method) +S3method(grid.draw,a_plot) S3method(grid.draw,absoluteGrob) -S3method(grid.draw,ggplot) +S3method(grobHeight,a_zeroGrob) S3method(grobHeight,absoluteGrob) -S3method(grobHeight,zeroGrob) +S3method(grobWidth,a_zeroGrob) S3method(grobWidth,absoluteGrob) -S3method(grobWidth,zeroGrob) S3method(grobX,absoluteGrob) S3method(grobY,absoluteGrob) -S3method(guide_gengrob,colorbar) -S3method(guide_gengrob,legend) -S3method(guide_geom,colorbar) -S3method(guide_geom,legend) -S3method(guide_merge,colorbar) -S3method(guide_merge,legend) -S3method(guide_train,colorbar) -S3method(guide_train,legend) +S3method(heightDetails,a_zeroGrob) S3method(heightDetails,stripGrob) S3method(heightDetails,titleGrob) -S3method(heightDetails,zeroGrob) S3method(interleave,default) S3method(interleave,unit) S3method(limits,Date) @@ -81,410 +90,407 @@ S3method(limits,POSIXlt) S3method(limits,character) S3method(limits,factor) S3method(limits,numeric) -S3method(makeContent,labelgrob) +S3method(makeContent,a_labelgrob) S3method(makeContext,dotstackGrob) -S3method(plot,ggplot) +S3method(plot,a_plot) S3method(predictdf,default) S3method(predictdf,glm) S3method(predictdf,locfit) S3method(predictdf,loess) -S3method(print,element) -S3method(print,facet) -S3method(print,ggplot) +S3method(print,a_element) +S3method(print,a_facet) +S3method(print,a_ggproto) +S3method(print,a_ggproto_method) +S3method(print,a_plot) +S3method(print,a_theme) S3method(print,ggplot2_bins) -S3method(print,ggproto) -S3method(print,ggproto_method) S3method(print,rel) -S3method(print,theme) S3method(print,uneval) -S3method(scale_type,AsIs) -S3method(scale_type,Date) -S3method(scale_type,POSIXt) -S3method(scale_type,character) -S3method(scale_type,default) -S3method(scale_type,factor) -S3method(scale_type,logical) -S3method(scale_type,numeric) -S3method(scale_type,ordered) S3method(str,uneval) -S3method(summary,ggplot) +S3method(summary,a_plot) +S3method(widthDetails,a_zeroGrob) S3method(widthDetails,stripGrob) S3method(widthDetails,titleGrob) -S3method(widthDetails,zeroGrob) export("%+%") export("%+replace%") export(.pt) export(.stroke) -export(Coord) -export(CoordCartesian) -export(CoordFixed) -export(CoordFlip) -export(CoordMap) -export(CoordPolar) -export(CoordQuickmap) -export(CoordTrans) -export(Geom) -export(GeomAbline) -export(GeomAnnotationMap) -export(GeomArea) -export(GeomBar) -export(GeomBlank) -export(GeomBoxplot) -export(GeomContour) -export(GeomCrossbar) -export(GeomCurve) -export(GeomCustomAnn) -export(GeomDensity) -export(GeomDensity2d) -export(GeomDotplot) -export(GeomErrorbar) -export(GeomErrorbarh) -export(GeomHex) -export(GeomHline) -export(GeomLabel) -export(GeomLine) -export(GeomLinerange) -export(GeomLogticks) -export(GeomMap) -export(GeomPath) -export(GeomPoint) -export(GeomPointrange) -export(GeomPolygon) -export(GeomQuantile) -export(GeomRaster) -export(GeomRasterAnn) -export(GeomRect) -export(GeomRibbon) -export(GeomRug) -export(GeomSegment) -export(GeomSmooth) -export(GeomSpoke) -export(GeomStep) -export(GeomText) -export(GeomTile) -export(GeomViolin) -export(GeomVline) -export(Position) -export(PositionDodge) -export(PositionFill) -export(PositionIdentity) -export(PositionJitter) -export(PositionJitterdodge) -export(PositionNudge) -export(PositionStack) -export(Scale) -export(ScaleContinuous) -export(ScaleContinuousDate) -export(ScaleContinuousDatetime) -export(ScaleContinuousIdentity) -export(ScaleContinuousPosition) -export(ScaleDiscrete) -export(ScaleDiscreteIdentity) -export(ScaleDiscretePosition) -export(Stat) -export(StatBin) -export(StatBin2d) -export(StatBindot) -export(StatBinhex) -export(StatBoxplot) -export(StatContour) -export(StatCount) -export(StatDensity) -export(StatDensity2d) -export(StatEcdf) -export(StatEllipse) -export(StatFunction) -export(StatIdentity) -export(StatQq) -export(StatQuantile) -export(StatSmooth) -export(StatSum) -export(StatSummary) -export(StatSummary2d) -export(StatSummaryBin) -export(StatSummaryHex) -export(StatUnique) -export(StatYdensity) -export(aes) -export(aes_) -export(aes_all) -export(aes_auto) -export(aes_q) -export(aes_string) +export(a_Coord) +export(a_CoordCartesian) +export(a_CoordFixed) +export(a_CoordFlip) +export(a_CoordMap) +export(a_CoordPolar) +export(a_CoordQuickmap) +export(a_CoordTrans) +export(a_Geom) +export(a_GeomAbline) +export(a_GeomAnnotationMap) +export(a_GeomArea) +export(a_GeomBar) +export(a_GeomBlank) +export(a_GeomBoxplot) +export(a_GeomContour) +export(a_GeomCrossbar) +export(a_GeomCurve) +export(a_GeomCustomAnn) +export(a_GeomDensity) +export(a_GeomDensity2d) +export(a_GeomDotplot) +export(a_GeomErrorbar) +export(a_GeomErrorbarh) +export(a_GeomHex) +export(a_GeomHline) +export(a_GeomLabel) +export(a_GeomLine) +export(a_GeomLinerange) +export(a_GeomLogticks) +export(a_GeomMap) +export(a_GeomPath) +export(a_GeomPoint) +export(a_GeomPointrange) +export(a_GeomPolygon) +export(a_GeomQuantile) +export(a_GeomRaster) +export(a_GeomRasterAnn) +export(a_GeomRect) +export(a_GeomRibbon) +export(a_GeomRug) +export(a_GeomSegment) +export(a_GeomSmooth) +export(a_GeomSpoke) +export(a_GeomStep) +export(a_GeomText) +export(a_GeomTile) +export(a_GeomViolin) +export(a_GeomVline) +export(a_Position) +export(a_PositionDodge) +export(a_PositionFill) +export(a_PositionIdentity) +export(a_PositionJitter) +export(a_PositionJitterdodge) +export(a_PositionNudge) +export(a_PositionStack) +export(a_Scale) +export(a_ScaleContinuous) +export(a_ScaleContinuousDate) +export(a_ScaleContinuousDatetime) +export(a_ScaleContinuousIdentity) +export(a_ScaleContinuousPosition) +export(a_ScaleDiscrete) +export(a_ScaleDiscreteIdentity) +export(a_ScaleDiscretePosition) +export(a_ScalesList) +export(a_Stat) +export(a_StatBin) +export(a_StatBin2d) +export(a_StatBindot) +export(a_StatBinhex) +export(a_StatBoxplot) +export(a_StatContour) +export(a_StatCount) +export(a_StatDensity) +export(a_StatDensity2d) +export(a_StatEcdf) +export(a_StatEllipse) +export(a_StatFunction) +export(a_StatIdentity) +export(a_StatQq) +export(a_StatQuantile) +export(a_StatSmooth) +export(a_StatSum) +export(a_StatSummary) +export(a_StatSummary2d) +export(a_StatSummaryBin) +export(a_StatSummaryHex) +export(a_StatUnique) +export(a_StatYdensity) +export(a_aes) +export(a_aes_) +export(a_aes_all) +export(a_aes_auto) +export(a_aes_q) +export(a_aes_string) +export(a_benchplot) +export(a_build_strip) +export(a_calc_element) +export(a_coord_cartesian) +export(a_coord_equal) +export(a_coord_fixed) +export(a_coord_flip) +export(a_coord_map) +export(a_coord_munch) +export(a_coord_polar) +export(a_coord_quickmap) +export(a_coord_trans) +export(a_draw_key_abline) +export(a_draw_key_blank) +export(a_draw_key_boxplot) +export(a_draw_key_crossbar) +export(a_draw_key_dotplot) +export(a_draw_key_label) +export(a_draw_key_path) +export(a_draw_key_point) +export(a_draw_key_pointrange) +export(a_draw_key_polygon) +export(a_draw_key_rect) +export(a_draw_key_smooth) +export(a_draw_key_text) +export(a_draw_key_vline) +export(a_draw_key_vpath) +export(a_element_blank) +export(a_element_grob) +export(a_element_line) +export(a_element_rect) +export(a_element_text) +export(a_facet) +export(a_facet_grid) +export(a_facet_null) +export(a_facet_wrap) +export(a_fortify) +export(a_geom_abline) +export(a_geom_area) +export(a_geom_bar) +export(a_geom_bin2d) +export(a_geom_blank) +export(a_geom_boxplot) +export(a_geom_contour) +export(a_geom_count) +export(a_geom_crossbar) +export(a_geom_curve) +export(a_geom_density) +export(a_geom_density2d) +export(a_geom_density_2d) +export(a_geom_dotplot) +export(a_geom_errorbar) +export(a_geom_errorbarh) +export(a_geom_freqpoly) +export(a_geom_hex) +export(a_geom_histogram) +export(a_geom_hline) +export(a_geom_jitter) +export(a_geom_label) +export(a_geom_line) +export(a_geom_linerange) +export(a_geom_map) +export(a_geom_path) +export(a_geom_point) +export(a_geom_pointrange) +export(a_geom_polygon) +export(a_geom_qq) +export(a_geom_quantile) +export(a_geom_raster) +export(a_geom_rect) +export(a_geom_ribbon) +export(a_geom_rug) +export(a_geom_segment) +export(a_geom_smooth) +export(a_geom_spoke) +export(a_geom_step) +export(a_geom_text) +export(a_geom_tile) +export(a_geom_violin) +export(a_geom_vline) +export(a_ggproto) +export(a_ggproto_parent) +export(a_guide_colorbar) +export(a_guide_colourbar) +export(a_guide_legend) +export(a_guides) +export(a_guides_build) +export(a_guides_geom) +export(a_guides_merge) +export(a_guides_train) +export(a_label_both) +export(a_label_bquote) +export(a_label_context) +export(a_label_parsed) +export(a_label_value) +export(a_layer) +export(a_layer_data) +export(a_layer_grob) +export(a_layer_scales) +export(a_mean_cl_boot) +export(a_mean_cl_normal) +export(a_mean_sdl) +export(a_mean_se) +export(a_median_hilow) +export(a_plot) +export(a_plot_build) +export(a_plot_gtable) +export(a_position_dodge) +export(a_position_fill) +export(a_position_identity) +export(a_position_jitter) +export(a_position_jitterdodge) +export(a_position_nudge) +export(a_position_stack) +export(a_resolution) +export(a_scale_alpha) +export(a_scale_alpha_continuous) +export(a_scale_alpha_discrete) +export(a_scale_alpha_identity) +export(a_scale_alpha_manual) +export(a_scale_color_brewer) +export(a_scale_color_continuous) +export(a_scale_color_discrete) +export(a_scale_color_distiller) +export(a_scale_color_gradient) +export(a_scale_color_gradient2) +export(a_scale_color_gradientn) +export(a_scale_color_grey) +export(a_scale_color_hue) +export(a_scale_color_identity) +export(a_scale_color_manual) +export(a_scale_colour_brewer) +export(a_scale_colour_continuous) +export(a_scale_colour_date) +export(a_scale_colour_datetime) +export(a_scale_colour_discrete) +export(a_scale_colour_distiller) +export(a_scale_colour_gradient) +export(a_scale_colour_gradient2) +export(a_scale_colour_gradientn) +export(a_scale_colour_grey) +export(a_scale_colour_hue) +export(a_scale_colour_identity) +export(a_scale_colour_manual) +export(a_scale_fill_brewer) +export(a_scale_fill_continuous) +export(a_scale_fill_date) +export(a_scale_fill_datetime) +export(a_scale_fill_discrete) +export(a_scale_fill_distiller) +export(a_scale_fill_gradient) +export(a_scale_fill_gradient2) +export(a_scale_fill_gradientn) +export(a_scale_fill_grey) +export(a_scale_fill_hue) +export(a_scale_fill_identity) +export(a_scale_fill_manual) +export(a_scale_linetype) +export(a_scale_linetype_continuous) +export(a_scale_linetype_discrete) +export(a_scale_linetype_identity) +export(a_scale_linetype_manual) +export(a_scale_radius) +export(a_scale_shape) +export(a_scale_shape_continuous) +export(a_scale_shape_discrete) +export(a_scale_shape_identity) +export(a_scale_shape_manual) +export(a_scale_size) +export(a_scale_size_area) +export(a_scale_size_continuous) +export(a_scale_size_date) +export(a_scale_size_datetime) +export(a_scale_size_discrete) +export(a_scale_size_identity) +export(a_scale_size_manual) +export(a_scale_x_continuous) +export(a_scale_x_date) +export(a_scale_x_datetime) +export(a_scale_x_discrete) +export(a_scale_x_log10) +export(a_scale_x_reverse) +export(a_scale_x_sqrt) +export(a_scale_y_continuous) +export(a_scale_y_date) +export(a_scale_y_datetime) +export(a_scale_y_discrete) +export(a_scale_y_log10) +export(a_scale_y_reverse) +export(a_scale_y_sqrt) +export(a_scales_list) +export(a_stairstep) +export(a_stat_bin) +export(a_stat_bin2d) +export(a_stat_bin_2d) +export(a_stat_bin_hex) +export(a_stat_binhex) +export(a_stat_boxplot) +export(a_stat_contour) +export(a_stat_count) +export(a_stat_density) +export(a_stat_density2d) +export(a_stat_density_2d) +export(a_stat_ecdf) +export(a_stat_ellipse) +export(a_stat_function) +export(a_stat_identity) +export(a_stat_qq) +export(a_stat_quantile) +export(a_stat_smooth) +export(a_stat_spoke) +export(a_stat_sum) +export(a_stat_summary) +export(a_stat_summary2d) +export(a_stat_summary_2d) +export(a_stat_summary_bin) +export(a_stat_summary_hex) +export(a_stat_unique) +export(a_stat_ydensity) +export(a_theme) +export(a_theme_bw) +export(a_theme_classic) +export(a_theme_dark) +export(a_theme_get) +export(a_theme_gray) +export(a_theme_grey) +export(a_theme_light) +export(a_theme_linedraw) +export(a_theme_minimal) +export(a_theme_replace) +export(a_theme_set) +export(a_theme_update) +export(a_theme_void) +export(a_zeroGrob) +export(absoluteGrob) export(alpha) -export(annotate) -export(annotation_custom) -export(annotation_logticks) -export(annotation_map) -export(annotation_raster) export(arrow) export(as_labeller) -export(autoplot) -export(benchplot) -export(borders) -export(calc_element) -export(continuous_scale) -export(coord_cartesian) -export(coord_equal) -export(coord_fixed) -export(coord_flip) -export(coord_map) -export(coord_munch) -export(coord_polar) -export(coord_quickmap) -export(coord_trans) +export(continuous_a_scale) export(cut_interval) export(cut_number) export(cut_width) -export(discrete_scale) -export(draw_key_abline) -export(draw_key_blank) -export(draw_key_boxplot) -export(draw_key_crossbar) -export(draw_key_dotplot) -export(draw_key_label) -export(draw_key_path) -export(draw_key_point) -export(draw_key_pointrange) -export(draw_key_polygon) -export(draw_key_rect) -export(draw_key_smooth) -export(draw_key_text) -export(draw_key_vline) -export(draw_key_vpath) -export(element_blank) -export(element_grob) -export(element_line) -export(element_rect) -export(element_text) +export(discrete_a_scale) export(expand_limits) -export(facet) -export(facet_grid) -export(facet_null) -export(facet_wrap) -export(fortify) -export(geom_abline) -export(geom_area) -export(geom_bar) -export(geom_bin2d) -export(geom_blank) -export(geom_boxplot) -export(geom_contour) -export(geom_count) -export(geom_crossbar) -export(geom_curve) -export(geom_density) -export(geom_density2d) -export(geom_density_2d) -export(geom_dotplot) -export(geom_errorbar) -export(geom_errorbarh) -export(geom_freqpoly) -export(geom_hex) -export(geom_histogram) -export(geom_hline) -export(geom_jitter) -export(geom_label) -export(geom_line) -export(geom_linerange) -export(geom_map) -export(geom_path) -export(geom_point) -export(geom_pointrange) -export(geom_polygon) -export(geom_qq) -export(geom_quantile) -export(geom_raster) -export(geom_rect) -export(geom_ribbon) -export(geom_rug) -export(geom_segment) -export(geom_smooth) -export(geom_spoke) -export(geom_step) -export(geom_text) -export(geom_tile) -export(geom_violin) -export(geom_vline) +export(find_line_formula) export(gg_dep) -export(ggplot) export(ggplotGrob) -export(ggplot_build) -export(ggplot_gtable) -export(ggproto) -export(ggproto_parent) export(ggsave) export(ggtitle) -export(guide_colorbar) -export(guide_colourbar) -export(guide_legend) -export(guides) -export(is.Coord) -export(is.facet) -export(is.ggplot) -export(is.ggproto) -export(is.theme) -export(label_both) -export(label_bquote) -export(label_context) -export(label_parsed) -export(label_value) -export(label_wrap_gen) +export(is.a_Coord) +export(is.a_facet) +export(is.a_ggproto) +export(is.a_plot) +export(is.a_theme) export(labeller) -export(labs) export(last_plot) -export(layer) -export(layer_data) -export(layer_grob) -export(layer_scales) +export(layout_grid) +export(limits) export(lims) export(map_data) export(margin) -export(mean_cl_boot) -export(mean_cl_normal) -export(mean_sdl) -export(mean_se) -export(median_hilow) -export(position_dodge) -export(position_fill) -export(position_identity) -export(position_jitter) -export(position_jitterdodge) -export(position_nudge) -export(position_stack) +export(plot_a_theme) export(qplot) export(quickplot) export(rel) export(remove_missing) -export(resolution) -export(scale_alpha) -export(scale_alpha_continuous) -export(scale_alpha_discrete) -export(scale_alpha_identity) -export(scale_alpha_manual) -export(scale_color_brewer) -export(scale_color_continuous) -export(scale_color_discrete) -export(scale_color_distiller) -export(scale_color_gradient) -export(scale_color_gradient2) -export(scale_color_gradientn) -export(scale_color_grey) -export(scale_color_hue) -export(scale_color_identity) -export(scale_color_manual) -export(scale_colour_brewer) -export(scale_colour_continuous) -export(scale_colour_date) -export(scale_colour_datetime) -export(scale_colour_discrete) -export(scale_colour_distiller) -export(scale_colour_gradient) -export(scale_colour_gradient2) -export(scale_colour_gradientn) -export(scale_colour_grey) -export(scale_colour_hue) -export(scale_colour_identity) -export(scale_colour_manual) -export(scale_fill_brewer) -export(scale_fill_continuous) -export(scale_fill_date) -export(scale_fill_datetime) -export(scale_fill_discrete) -export(scale_fill_distiller) -export(scale_fill_gradient) -export(scale_fill_gradient2) -export(scale_fill_gradientn) -export(scale_fill_grey) -export(scale_fill_hue) -export(scale_fill_identity) -export(scale_fill_manual) -export(scale_linetype) -export(scale_linetype_continuous) -export(scale_linetype_discrete) -export(scale_linetype_identity) -export(scale_linetype_manual) -export(scale_radius) -export(scale_shape) -export(scale_shape_continuous) -export(scale_shape_discrete) -export(scale_shape_identity) -export(scale_shape_manual) -export(scale_size) -export(scale_size_area) -export(scale_size_continuous) -export(scale_size_date) -export(scale_size_datetime) -export(scale_size_discrete) -export(scale_size_identity) -export(scale_size_manual) -export(scale_x_continuous) -export(scale_x_date) -export(scale_x_datetime) -export(scale_x_discrete) -export(scale_x_log10) -export(scale_x_reverse) -export(scale_x_sqrt) -export(scale_y_continuous) -export(scale_y_date) -export(scale_y_datetime) -export(scale_y_discrete) -export(scale_y_log10) -export(scale_y_reverse) -export(scale_y_sqrt) export(should_stop) -export(stat_bin) -export(stat_bin2d) -export(stat_bin_2d) -export(stat_bin_hex) -export(stat_binhex) -export(stat_boxplot) -export(stat_contour) -export(stat_count) -export(stat_density) -export(stat_density2d) -export(stat_density_2d) -export(stat_ecdf) -export(stat_ellipse) -export(stat_function) -export(stat_identity) -export(stat_qq) -export(stat_quantile) -export(stat_smooth) -export(stat_spoke) -export(stat_sum) -export(stat_summary) -export(stat_summary2d) -export(stat_summary_2d) -export(stat_summary_bin) -export(stat_summary_hex) -export(stat_unique) -export(stat_ydensity) -export(theme) -export(theme_bw) -export(theme_classic) -export(theme_dark) -export(theme_get) -export(theme_gray) -export(theme_grey) -export(theme_light) -export(theme_linedraw) -export(theme_minimal) -export(theme_replace) -export(theme_set) -export(theme_update) -export(theme_void) export(transform_position) export(unit) -export(update_geom_defaults) -export(update_labels) -export(update_stat_defaults) +export(update_a_geom_defaults) +export(update_a_labels) +export(update_a_stat_defaults) +export(update_a_theme) +export(validate_guide) export(waiver) export(xlab) export(xlim) export(ylab) export(ylim) -export(zeroGrob) import(grid) import(gtable) import(scales) diff --git a/R/aaa-.r b/R/aaa-.r index c40a3a2d85..b2941a1797 100644 --- a/R/aaa-.r +++ b/R/aaa-.r @@ -1,13 +1,13 @@ #' @include ggproto.r NULL -#' Base ggproto classes for ggplot2 +#' Base ggproto classes for ggplot2Animint #' #' If you are creating a new geom, stat, position, or scale in another package, -#' you'll need to extend from \code{ggplot2::Geom}, \code{ggplot2::Stat}, -#' \code{ggplot2::Position}, or \code{ggplot2::Scale}. +#' you'll need to extend from \code{ggplot2Animint::a_Geom}, \code{ggplot2Animint::a_Stat}, +#' \code{ggplot2Animint::a_Position}, or \code{ggplot2Animint::a_Scale}. #' -#' @seealso ggproto +#' @seealso a_ggproto #' @keywords internal -#' @name ggplot2-ggproto +#' @name ggplot2Animint-ggproto NULL diff --git a/R/aes-calculated.r b/R/aes-calculated.r index d8a14b62b3..87b365b5bb 100644 --- a/R/aes-calculated.r +++ b/R/aes-calculated.r @@ -2,8 +2,8 @@ match_calculated_aes <- "^\\.\\.([a-zA-Z._]+)\\.\\.$" # Determine if aesthetic is calculated -is_calculated_aes <- function(aesthetics) { - vars <- lapply(aesthetics, find_vars) +is_calculated_aes <- function(a_aesthetics) { + vars <- lapply(a_aesthetics, find_vars) vapply(vars, function(x) any(grepl(match_calculated_aes, x)), logical(1)) } diff --git a/R/aes-colour-fill-alpha.r b/R/aes-colour-fill-alpha.r index 3b24a305ce..6ae449d1b9 100644 --- a/R/aes-colour-fill-alpha.r +++ b/R/aes-colour-fill-alpha.r @@ -3,54 +3,54 @@ #' This page demonstrates the usage of a sub-group #' of aesthetics; colour, fill and alpha. #' -#' @name aes_colour_fill_alpha +#' @name a_aes_colour_fill_alpha #' @aliases colour color fill #' @examples #' \donttest{ #' #' # Bar chart example -#' c <- ggplot(mtcars, aes(factor(cyl))) +#' c <- a_plot(mtcars, a_aes(factor(cyl))) #' # Default plotting -#' c + geom_bar() +#' c + a_geom_bar() #' # To change the interior colouring use fill aesthetic -#' c + geom_bar(fill = "red") +#' c + a_geom_bar(fill = "red") #' # Compare with the colour aesthetic which changes just the bar outline -#' c + geom_bar(colour = "red") +#' c + a_geom_bar(colour = "red") #' # Combining both, you can see the changes more clearly -#' c + geom_bar(fill = "white", colour = "red") +#' c + a_geom_bar(fill = "white", colour = "red") #' #' # The aesthetic fill also takes different colouring scales #' # setting fill equal to a factor variable uses a discrete colour scale -#' k <- ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) -#' k + geom_bar() +#' k <- a_plot(mtcars, a_aes(factor(cyl), fill = factor(vs))) +#' k + a_geom_bar() #' #' # Fill aesthetic can also be used with a continuous variable -#' m <- ggplot(faithfuld, aes(waiting, eruptions)) -#' m + geom_raster() -#' m + geom_raster(aes(fill = density)) +#' m <- a_plot(faithfuld, a_aes(waiting, eruptions)) +#' m + a_geom_raster() +#' m + a_geom_raster(a_aes(fill = density)) #' -#' # Some geoms don't use both aesthetics (i.e. geom_point or geom_line) -#' b <- ggplot(economics, aes(x = date, y = unemploy)) -#' b + geom_line() -#' b + geom_line(colour = "green") -#' b + geom_point() -#' b + geom_point(colour = "red") +#' # Some geoms don't use both a_aesthetics (i.e. geom_point or geom_line) +#' b <- a_plot(economics, a_aes(x = date, y = unemploy)) +#' b + a_geom_line() +#' b + a_geom_line(colour = "green") +#' b + a_geom_point() +#' b + a_geom_point(colour = "red") #' #' # For large datasets with overplotting the alpha -#' # aesthetic will make the points more transparent +#' # a_aesthetic will make the points more transparent #' df <- data.frame(x = rnorm(5000), y = rnorm(5000)) -#' h <- ggplot(df, aes(x,y)) -#' h + geom_point() -#' h + geom_point(alpha = 0.5) -#' h + geom_point(alpha = 1/10) +#' h <- a_plot(df, a_aes(x,y)) +#' h + a_geom_point() +#' h + a_geom_point(alpha = 0.5) +#' h + a_geom_point(alpha = 1/10) #' #' # Alpha can also be used to add shading -#' j <- b + geom_line() +#' j <- b + a_geom_line() #' j #' yrng <- range(economics$unemploy) -#' j <- j + geom_rect(aes(NULL, NULL, xmin = start, xmax = end, fill = party), +#' j <- j + a_geom_rect(a_aes(NULL, NULL, xmin = start, xmax = end, fill = party), #' ymin = yrng[1], ymax = yrng[2], data = presidential) #' j -#' j + scale_fill_manual(values = alpha(c("blue", "red"), .3)) +#' j + a_scale_fill_manual(values = alpha(c("blue", "red"), .3)) #' } NULL diff --git a/R/aes-group-order.r b/R/aes-group-order.r index a97956a1c6..63b3017db3 100644 --- a/R/aes-group-order.r +++ b/R/aes-group-order.r @@ -1,6 +1,6 @@ #' Aesthetics: group #' -#' @name aes_group_order +#' @name a_aes_group_order #' @aliases group #' #' @examples @@ -15,19 +15,19 @@ #' # For most applications you can simply specify the grouping with #' # various aesthetics (colour, shape, fill, linetype) or with facets. #' -#' p <- ggplot(mtcars, aes(wt, mpg)) +#' p <- a_plot(mtcars, a_aes(wt, mpg)) #' # A basic scatter plot -#' p + geom_point(size = 4) -#' # The colour aesthetic -#' p + geom_point(aes(colour = factor(cyl)), size = 4) +#' p + a_geom_point(size = 4) +#' # The colour a_aesthetic +#' p + a_geom_point(a_aes(colour = factor(cyl)), size = 4) #' # Or you can use shape to distinguish the data -#' p + geom_point(aes(shape = factor(cyl)), size = 4) +#' p + a_geom_point(a_aes(shape = factor(cyl)), size = 4) #' #' # Using fill -#' a <- ggplot(mtcars, aes(factor(cyl))) -#' a + geom_bar() -#' a + geom_bar(aes(fill = factor(cyl))) -#' a + geom_bar(aes(fill = factor(vs))) +#' a <- a_plot(mtcars, a_aes(factor(cyl))) +#' a + a_geom_bar() +#' a + a_geom_bar(a_aes(fill = factor(cyl))) +#' a + a_geom_bar(a_aes(fill = factor(vs))) #' #' # Using linetypes #' rescale01 <- function(x) (x - min(x)) / diff(range(x)) @@ -35,11 +35,11 @@ #' date = economics$date, #' plyr::colwise(rescale01)(economics[, -(1:2)])) #' ecm <- reshape2::melt(ec_scaled, id.vars = "date") -#' f <- ggplot(ecm, aes(date, value)) -#' f + geom_line(aes(linetype = variable)) +#' f <- a_plot(ecm, a_aes(date, value)) +#' f + a_geom_line(a_aes(linetype = variable)) #' #' # Using facets -#' k <- ggplot(diamonds, aes(carat, ..density..)) + geom_histogram(binwidth = 0.2) +#' k <- a_plot(diamonds, a_aes(carat, ..density..)) + a_geom_histogram(binwidth = 0.2) #' k + facet_grid(. ~ cut) #' #' # There are three common cases where the default is not enough, and we @@ -48,33 +48,33 @@ #' # (height) and centered ages (age) of 26 boys (Subject), measured on nine #' # occasions (Occasion). #' -#' # Multiple groups with one aesthetic -#' h <- ggplot(nlme::Oxboys, aes(age, height)) +#' # Multiple groups with one a_aesthetic +#' h <- a_plot(nlme::Oxboys, a_aes(age, height)) #' # A single line tries to connect all the observations -#' h + geom_line() -#' # The group aesthetic maps a different line for each subject -#' h + geom_line(aes(group = Subject)) +#' h + a_geom_line() +#' # The group a_aesthetic maps a different line for each subject +#' h + a_geom_line(a_aes(group = Subject)) #' #' # Different groups on different layers -#' h <- h + geom_line(aes(group = Subject)) -#' # Using the group aesthetic with both geom_line() and geom_smooth() +#' h <- h + a_geom_line(a_aes(group = Subject)) +#' # Using the group a_aesthetic with both a_geom_line() and a_geom_smooth() #' # groups the data the same way for both layers -#' h + geom_smooth(aes(group = Subject), method = "lm", se = FALSE) +#' h + a_geom_smooth(a_aes(group = Subject), method = "lm", se = FALSE) #' # Changing the group aesthetic for the smoother layer #' # fits a single line of best fit across all boys -#' h + geom_smooth(aes(group = 1), size = 2, method = "lm", se = FALSE) +#' h + a_geom_smooth(a_aes(group = 1), size = 2, method = "lm", se = FALSE) #' #' # Overriding the default grouping #' # The plot has a discrete scale but you want to draw lines that connect across #' # groups. This is the strategy used in interaction plots, profile plots, and parallel #' # coordinate plots, among others. For example, we draw boxplots of height at #' # each measurement occasion -#' boysbox <- ggplot(nlme::Oxboys, aes(Occasion, height)) -#' boysbox + geom_boxplot() +#' boysbox <- a_plot(nlme::Oxboys, a_aes(Occasion, height)) +#' boysbox + a_geom_boxplot() #' # There is no need to specify the group aesthetic here; the default grouping #' # works because occasion is a discrete variable. To overlay individual trajectories -#' # we again need to override the default grouping for that layer with aes(group = Subject) -#' boysbox <- boysbox + geom_boxplot() -#' boysbox + geom_line(aes(group = Subject), colour = "blue") +#' # we again need to override the default grouping for that layer with a_aes(group = Subject) +#' boysbox <- boysbox + a_geom_boxplot() +#' boysbox + a_geom_line(a_aes(group = Subject), colour = "blue") #' } NULL diff --git a/R/aes-linetype-size-shape.r b/R/aes-linetype-size-shape.r index 41ea07848a..a995e89c11 100644 --- a/R/aes-linetype-size-shape.r +++ b/R/aes-linetype-size-shape.r @@ -1,9 +1,9 @@ -#' Differentiation related aesthetics: linetype, size, shape +#' Differentiation related a_aesthetics: linetype, size, shape #' #' This page demonstrates the usage of a sub-group -#' of aesthetics; linetype, size and shape. +#' of a_aesthetics; linetype, size and shape. #' -#' @name aes_linetype_size_shape +#' @name a_aes_linetype_size_shape #' @aliases linetype size shape #' @examples #' @@ -14,51 +14,51 @@ #' #' # Data #' df <- data.frame(x = 1:10 , y = 1:10) -#' f <- ggplot(df, aes(x, y)) -#' f + geom_line(linetype = 2) -#' f + geom_line(linetype = "dotdash") +#' f <- a_plot(df, a_aes(x, y)) +#' f + a_geom_line(linetype = 2) +#' f + a_geom_line(linetype = "dotdash") #' #' # An example with hex strings, the string "33" specifies three units on followed #' # by three off and "3313" specifies three units on followed by three off followed #' # by one on and finally three off. -#' f + geom_line(linetype = "3313") +#' f + a_geom_line(linetype = "3313") #' #' # Mapping line type from a variable -#' ggplot(economics_long, aes(date, value01)) + -#' geom_line(aes(linetype = variable)) +#' a_plot(economics_long, a_aes(date, value01)) + +#' a_geom_line(a_aes(linetype = variable)) #' #' # Size examples #' # Should be specified with a numerical value (in millimetres), #' # or from a variable source -#' p <- ggplot(mtcars, aes(wt, mpg)) -#' p + geom_point(size = 4) -#' p + geom_point(aes(size = qsec)) -#' p + geom_point(size = 2.5) + -#' geom_hline(yintercept = 25, size = 3.5) +#' p <- a_plot(mtcars, a_aes(wt, mpg)) +#' p + a_geom_point(size = 4) +#' p + a_geom_point(a_aes(size = qsec)) +#' p + a_geom_point(size = 2.5) + +#' a_geom_hline(yintercept = 25, size = 3.5) #' #' # Shape examples #' # Shape takes four types of values: an integer in [0, 25], #' # a single character-- which uses that character as the plotting symbol, #' # a . to draw the smallest rectangle that is visible (i.e., about one pixel) #' # an NA to draw nothing -#' p + geom_point() -#' p + geom_point(shape = 5) -#' p + geom_point(shape = "k", size = 3) -#' p + geom_point(shape = ".") -#' p + geom_point(shape = NA) +#' p + a_geom_point() +#' p + a_geom_point(shape = 5) +#' p + a_geom_point(shape = "k", size = 3) +#' p + a_geom_point(shape = ".") +#' p + a_geom_point(shape = NA) #' #' # Shape can also be mapped from a variable -#' p + geom_point(aes(shape = factor(cyl))) +#' p + a_geom_point(a_aes(shape = factor(cyl))) #' #' # A look at all 25 symbols #' df2 <- data.frame(x = 1:5 , y = 1:25, z = 1:25) -#' s <- ggplot(df2, aes(x, y)) -#' s + geom_point(aes(shape = z), size = 4) + -#' scale_shape_identity() +#' s <- a_plot(df2, a_aes(x, y)) +#' s + a_geom_point(a_aes(shape = z), size = 4) + +#' a_scale_shape_identity() #' # While all symbols have a foreground colour, symbols 19-25 also take a #' # background colour (fill) -#' s + geom_point(aes(shape = z), size = 4, colour = "Red") + -#' scale_shape_identity() -#' s + geom_point(aes(shape = z), size = 4, colour = "Red", fill = "Black") + -#' scale_shape_identity() +#' s + a_geom_point(a_aes(shape = z), size = 4, colour = "Red") + +#' a_scale_shape_identity() +#' s + a_geom_point(a_aes(shape = z), size = 4, colour = "Red", fill = "Black") + +#' a_scale_shape_identity() NULL diff --git a/R/aes-position.r b/R/aes-position.r index 2feeb3aeaa..a1d5be5023 100644 --- a/R/aes-position.r +++ b/R/aes-position.r @@ -1,9 +1,9 @@ #' Position related aesthetics: x, y, xmin, xmax, ymin, ymax, xend, yend #' #' This page demonstrates the usage of a sub-group -#' of aesthetics; x, y, xmin, xmax, ymin, ymax, xend, and yend. +#' of a_aesthetics; x, y, xmin, xmax, ymin, ymax, xend, and yend. #' -#' @name aes_position +#' @name a_aes_position #' @aliases x y xmin xmax ymin ymax xend yend #' @examples #' @@ -12,28 +12,28 @@ #' dmod <- lm(price ~ cut, data = diamonds) #' cuts <- data.frame(cut = unique(diamonds$cut), predict(dmod, data.frame(cut = #' unique(diamonds$cut)), se = TRUE)[c("fit", "se.fit")]) -#' se <- ggplot(cuts, aes(x = cut, y = fit, ymin = fit - se.fit, +#' se <- a_plot(cuts, a_aes(x = cut, y = fit, ymin = fit - se.fit, #' ymax = fit + se.fit, colour = cut)) -#' se + geom_pointrange() +#' se + a_geom_pointrange() #' -#' # Using annotate -#' p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() -#' p + annotate("rect", xmin = 2, xmax = 3.5, ymin = 2, ymax = 25, +#' # Using a_annotate +#' p <- a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point() +#' p + ggplot2Animint:::a_annotate("rect", xmin = 2, xmax = 3.5, ymin = 2, ymax = 25, #' fill = "dark grey", alpha = .5) #' #' # Geom_segment examples -#' p + geom_segment(aes(x = 2, y = 15, xend = 2, yend = 25), +#' p + a_geom_segment(a_aes(x = 2, y = 15, xend = 2, yend = 25), #' arrow = arrow(length = unit(0.5, "cm"))) -#' p + geom_segment(aes(x = 2, y = 15, xend = 3, yend = 15), +#' p + a_geom_segment(a_aes(x = 2, y = 15, xend = 3, yend = 15), #' arrow = arrow(length = unit(0.5, "cm"))) -#' p + geom_segment(aes(x = 5, y = 30, xend = 3.5, yend = 25), +#' p + a_geom_segment(a_aes(x = 5, y = 30, xend = 3.5, yend = 25), #' arrow = arrow(length = unit(0.5, "cm"))) #' -#' # You can also use geom_segment to recreate plot(type = "h") : +#' # You can also use a_geom_segment to recreate plot(type = "h") : #' counts <- as.data.frame(table(x = rpois(100, 5))) #' counts$x <- as.numeric(as.character(counts$x)) #' with(counts, plot(x, Freq, type = "h", lwd = 10)) #' -#' ggplot(counts, aes(x, Freq)) + -#' geom_segment(aes(yend = 0, xend = x), size = 10) +#' a_plot(counts, a_aes(x, Freq)) + +#' a_geom_segment(a_aes(yend = 0, xend = x), size = 10) NULL diff --git a/R/aes.r b/R/aes.r index 410317c00b..5964ac444c 100644 --- a/R/aes.r +++ b/R/aes.r @@ -2,12 +2,12 @@ NULL .all_aesthetics <- c("adj", "alpha", "angle", "bg", "cex", "col", "color", - "colour", "fg", "fill", "group", "hjust", "label", "linetype", "lower", + "colour", "fg", "fill", "group", "hjust", "a_label", "linetype", "lower", "lty", "lwd", "max", "middle", "min", "pch", "radius", "sample", "shape", "size", "srt", "upper", "vjust", "weight", "width", "x", "xend", "xmax", "xmin", "xintercept", "y", "yend", "ymax", "ymin", "yintercept", "z") -.base_to_ggplot <- c( +.base_to_a_plot <- c( "col" = "colour", "color" = "colour", "pch" = "shape", @@ -33,35 +33,35 @@ NULL #' @param x,y,... List of name value pairs giving aesthetics to map to #' variables. The names for x and y aesthetics can be omitted (because #' they are so common); all other aesthetics must be named. -#' @seealso See \code{\link{aes_q}}/\code{\link{aes_string}} for standard -#' evaluation versions of \code{aes}. +#' @seealso See \code{\link{a_aes_q}}/\code{\link{a_aes_string}} for standard +#' evaluation versions of \code{a_aes}. #' @seealso See -#' \code{\link{aes_colour_fill_alpha}}, \code{\link{aes_group_order}}, -#' \code{\link{aes_linetype_size_shape}} and \code{\link{aes_position}} +#' \code{\link{a_aes_colour_fill_alpha}}, \code{\link{a_aes_group_order}}, +#' \code{\link{a_aes_linetype_size_shape}} and \code{\link{a_aes_position}} #' for more specific examples with different aesthetics. #' @export #' @examples -#' aes(x = mpg, y = wt) -#' aes(mpg, wt) +#' a_aes(x = mpg, y = wt) +#' a_aes(mpg, wt) #' -#' # You can also map aesthetics to functions of variables -#' aes(x = mpg ^ 2, y = wt / cyl) +#' # You can also map a_aesthetics to functions of variables +#' a_aes(x = mpg ^ 2, y = wt / cyl) #' #' # Aesthetic names are automatically standardised -#' aes(col = x) -#' aes(fg = x) -#' aes(color = x) -#' aes(colour = x) +#' a_aes(col = x) +#' a_aes(fg = x) +#' a_aes(color = x) +#' a_aes(colour = x) #' -#' # aes is almost always used with ggplot() or a layer -#' ggplot(mpg, aes(displ, hwy)) + geom_point() -#' ggplot(mpg) + geom_point(aes(displ, hwy)) +#' # a_aes is almost always used with a_plot() or a layer +#' a_plot(mpg, a_aes(displ, hwy)) + a_geom_point() +#' a_plot(mpg) + a_geom_point(a_aes(displ, hwy)) #' -#' # Aesthetics supplied to ggplot() are used as defaults for every layer +#' # Aesthetics supplied to a_plot() are used as defaults for every layer #' # you can override them, or supply different aesthetics for each layer -aes <- function(x, y, ...) { - aes <- structure(as.list(match.call()[-1]), class = "uneval") - rename_aes(aes) +a_aes <- function(x, y, ...) { + a_aes <- structure(as.list(match.call()[-1]), class = "uneval") + rename_aes(a_aes) } #' @export print.uneval <- function(x, ...) { @@ -89,11 +89,11 @@ rename_aes <- function(x) { full <- match(names(x), .all_aesthetics) names(x)[!is.na(full)] <- .all_aesthetics[full[!is.na(full)]] - plyr::rename(x, .base_to_ggplot, warn_missing = FALSE) + plyr::rename(x, .base_to_a_plot, warn_missing = FALSE) } # Look up the scale that should be used for a given aesthetic -aes_to_scale <- function(var) { +a_aes_to_scale <- function(var) { var[var %in% c("x", "xmin", "xmax", "xend", "xintercept")] <- "x" var[var %in% c("y", "ymin", "ymax", "yend", "yintercept")] <- "y" @@ -102,49 +102,49 @@ aes_to_scale <- function(var) { # Figure out if an aesthetic is a position aesthetic or not is_position_aes <- function(vars) { - aes_to_scale(vars) %in% c("x", "y") + a_aes_to_scale(vars) %in% c("x", "y") } #' Define aesthetic mappings from strings, or quoted calls and formulas. #' #' Aesthetic mappings describe how variables in the data are mapped to visual -#' properties (aesthetics) of geoms. \code{\link{aes}} uses non-standard -#' evaluation to capture the variable names. \code{aes_} and \code{aes_string} +#' properties (aesthetics) of geoms. \code{\link{a_aes}} uses non-standard +#' evaluation to capture the variable names. \code{a_aes_} and \code{a_aes_string} #' require you to explicitly quote the inputs either with \code{""} for -#' \code{aes_string()}, or with \code{quote} or \code{~} for \code{aes_()}. -#' (\code{aes_q} is an alias to \code{aes_}) +#' \code{a_aes_string()}, or with \code{quote} or \code{~} for \code{a_aes_()}. +#' (\code{a_aes_q} is an alias to \code{a_aes_}) #' -#' It's better to use \code{aes_q()}, because there's no easy way to create the -#' equivalent to \code{aes(colour = "my colour")} or \code{aes{x = `X$1`}} -#' with \code{aes_string()}. +#' It's better to use \code{a_aes_q()}, because there's no easy way to create the +#' equivalent to \code{a_aes(colour = "my colour")} or \code{a_aes{x = `X$1`}} +#' with \code{a_aes_string()}. #' -#' \code{aes_string} and \code{aes_} are particularly useful when writing +#' \code{a_aes_string} and \code{a_aes_} are particularly useful when writing #' functions that create plots because you can use strings or quoted #' names/calls to define the aesthetic mappings, rather than having to use -#' \code{\link{substitute}} to generate a call to \code{aes()}. +#' \code{\link{substitute}} to generate a call to \code{a_aes()}. #' #' @param x,y,... List of name value pairs. Elements must be either #' quoted calls, strings, one-sided formulas or constants. -#' @seealso \code{\link{aes}} +#' @seealso \code{\link{a_aes}} #' @export #' @examples #' # Three ways of generating the same aesthetics -#' aes(mpg, wt, col = cyl) -#' aes_(quote(mpg), quote(wt), col = quote(cyl)) -#' aes_(~mpg, ~wt, col = ~cyl) -#' aes_string("mpg", "wt", col = "cyl") +#' a_aes(mpg, wt, col = cyl) +#' a_aes_(quote(mpg), quote(wt), col = quote(cyl)) +#' a_aes_(~mpg, ~wt, col = ~cyl) +#' a_aes_string("mpg", "wt", col = "cyl") #' -#' # You can't easily mimic these calls with aes_string -#' aes(`$100`, colour = "smooth") -#' aes_(~ `$100`, colour = "smooth") +#' # You can't easily mimic these calls with a_aes_string +#' a_aes(`$100`, colour = "smooth") +#' a_aes_(~ `$100`, colour = "smooth") #' # Ok, you can, but it requires a _lot_ of quotes -#' aes_string("`$100`", colour = '"smooth"') +#' a_aes_string("`$100`", colour = '"smooth"') #' #' # Convert strings to names with as.name #' var <- "cyl" -#' aes(col = x) -#' aes_(col = as.name(var)) -aes_ <- function(x, y, ...) { +#' a_aes(col = x) +#' a_aes_(col = as.name(var)) +a_aes_ <- function(x, y, ...) { mapping <- list(...) if (!missing(x)) mapping["x"] <- list(x) if (!missing(y)) mapping["y"] <- list(y) @@ -163,9 +163,9 @@ aes_ <- function(x, y, ...) { structure(rename_aes(mapping), class = "uneval") } -#' @rdname aes_ +#' @rdname a_aes_ #' @export -aes_string <- function(x, y, ...) { +a_aes_string <- function(x, y, ...) { mapping <- list(...) if (!missing(x)) mapping["x"] <- list(x) if (!missing(y)) mapping["y"] <- list(y) @@ -181,8 +181,8 @@ aes_string <- function(x, y, ...) { } #' @export -#' @rdname aes_ -aes_q <- aes_ +#' @rdname a_aes_ +a_aes_q <- a_aes_ #' Given a character vector, create a set of identity mappings #' @@ -190,9 +190,9 @@ aes_q <- aes_ #' @keywords internal #' @export #' @examples -#' aes_all(names(mtcars)) -#' aes_all(c("x", "y", "col", "pch")) -aes_all <- function(vars) { +#' a_aes_all(names(mtcars)) +#' a_aes_all(c("x", "y", "col", "pch")) +a_aes_all <- function(vars) { names(vars) <- vars vars <- rename_aes(vars) @@ -208,12 +208,12 @@ aes_all <- function(vars) { #' @param ... aesthetics that need to be explicitly mapped. #' @keywords internal #' @export -aes_auto <- function(data = NULL, ...) { - warning("aes_auto() is deprecated", call. = FALSE) +a_aes_auto <- function(data = NULL, ...) { + warning("a_aes_auto() is deprecated", call. = FALSE) # detect names of data if (is.null(data)) { - stop("aes_auto requires data.frame or names of data.frame.") + stop("a_aes_auto requires data.frame or names of data.frame.") } else if (is.data.frame(data)) { vars <- names(data) } else { @@ -223,13 +223,13 @@ aes_auto <- function(data = NULL, ...) { # automatically detected aes vars <- intersect(.all_aesthetics, vars) names(vars) <- vars - aes <- lapply(vars, function(x) parse(text = x)[[1]]) + a_aes <- lapply(vars, function(x) parse(text = x)[[1]]) - # explicitly defined aes + # explicitly defined a_aes if (length(match.call()) > 2) { args <- as.list(match.call()[-1]) - aes <- c(aes, args[names(args) != "data"]) + a_aes <- c(a_aes, args[names(args) != "data"]) } - structure(rename_aes(aes), class = "uneval") + structure(rename_aes(a_aes), class = "uneval") } diff --git a/R/annotation-custom.r b/R/annotation-custom.r index 77404b5b5b..b0ffbc03f0 100644 --- a/R/annotation-custom.r +++ b/R/annotation-custom.r @@ -15,39 +15,39 @@ NULL #' location of raster #' @param ymin,ymax y location (in data coordinates) giving vertical #' location of raster -#' @export -#' @note \code{annotation_custom} expects the grob to fill the entire viewport +#' @keywords internal +#' @note \code{a_annotation_custom} expects the grob to fill the entire viewport #' defined by xmin, xmax, ymin, ymax. Grobs with a different (absolute) size #' will be center-justified in that region. #' Inf values can be used to fill the full plot panel (see examples). #' @examples #' # Dummy plot #' df <- data.frame(x = 1:10, y = 1:10) -#' base <- ggplot(df, aes(x, y)) + -#' geom_blank() + -#' theme_bw() +#' base <- a_plot(df, a_aes(x, y)) + +#' a_geom_blank() + +#' a_theme_bw() #' -#' # Full panel annotation -#' base + annotation_custom( +#' # Full panel a_annotation +#' base + ggplot2Animint:::a_annotation_custom( #' grob = grid::roundrectGrob(), #' xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf #' ) #' #' # Inset plot #' df2 <- data.frame(x = 1 , y = 1) -#' g <- ggplotGrob(ggplot(df2, aes(x, y)) + -#' geom_point() + -#' theme(plot.background = element_rect(colour = "black"))) -#' base + -#' annotation_custom(grob = g, xmin = 1, xmax = 10, ymin = 8, ymax = 10) -annotation_custom <- function(grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) { - layer( +#' g <- ggplotGrob(a_plot(df2, a_aes(x, y)) + +#' a_geom_point() + +#' a_theme(plot.background = a_element_rect(colour = "black"))) +#' base + ggplot2Animint:::a_annotation_custom(grob = g, xmin = 1, xmax = 10, ymin = 8, ymax = 10) +a_annotation_custom <- function(grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) { + a_layer( data = NULL, - stat = StatIdentity, - position = PositionIdentity, - geom = GeomCustomAnn, - inherit.aes = TRUE, + a_stat = a_StatIdentity, + a_position = a_PositionIdentity, + a_geom = a_GeomCustomAnn, + inherit.a_aes = TRUE, params = list( + grob = grob, xmin = xmin, xmax = xmax, @@ -57,24 +57,24 @@ annotation_custom <- function(grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomCustomAnn <- ggproto("GeomCustomAnn", Geom, +a_GeomCustomAnn <- a_ggproto("a_GeomCustomAnn", a_Geom, extra_params = "", handle_na = function(data, params) { data }, - draw_panel = function(data, panel_scales, coord, grob, xmin, xmax, + draw_panel = function(data, panel_scales, a_coord, grob, xmin, xmax, ymin, ymax) { - if (!inherits(coord, "CoordCartesian")) { - stop("annotation_custom only works with Cartesian coordinates", + if (!inherits(a_coord, "a_CoordCartesian")) { + stop("a_annotation_custom only works with Cartesian coordinates", call. = FALSE) } corners <- data.frame(x = c(xmin, xmax), y = c(ymin, ymax)) - data <- coord$transform(corners, panel_scales) + data <- a_coord$transform(corners, panel_scales) x_rng <- range(data$x, na.rm = TRUE) y_rng <- range(data$y, na.rm = TRUE) @@ -82,13 +82,13 @@ GeomCustomAnn <- ggproto("GeomCustomAnn", Geom, vp <- viewport(x = mean(x_rng), y = mean(y_rng), width = diff(x_rng), height = diff(y_rng), just = c("center","center")) - editGrob(grob, vp = vp, name = paste(grob$name, annotation_id())) + editGrob(grob, vp = vp, name = paste(grob$name, a_annotation_id())) }, - default_aes = aes_(xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) + default_aes = a_aes_(xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) ) -annotation_id <- local({ +a_annotation_id <- local({ i <- 1 function() { i <<- i + 1 diff --git a/R/annotation-logticks.r b/R/annotation-logticks.r index 56d909a931..4533e266a4 100644 --- a/R/annotation-logticks.r +++ b/R/annotation-logticks.r @@ -15,8 +15,8 @@ #' long tick marks. In base 10, these are the "1" (or "10") ticks. #' @param scaled is the data already log-scaled? This should be \code{TRUE} #' (default) when the data is already transformed with \code{log10()} or when -#' using \code{scale_y_log10}. It should be \code{FALSE} when using -#' \code{coord_trans(y = "log10")}. +#' using \code{a_scale_y_log10}. It should be \code{FALSE} when using +#' \code{a_coord_trans(y = "log10")}. #' @param colour Colour of the tick marks. #' @param size Thickness of tick marks, in mm. #' @param linetype Linetype of tick marks (\code{solid}, \code{dashed}, etc.) @@ -24,70 +24,71 @@ #' @param color An alias for \code{colour}. #' @param ... Other parameters passed on to the layer #' -#' @export -#' @seealso \code{\link{scale_y_continuous}}, \code{\link{scale_y_log10}} for log scale +#' @keywords internal +#' @seealso \code{\link{a_scale_y_continuous}}, \code{\link{a_scale_y_log10}} for log scale #' transformations. -#' @seealso \code{\link{coord_trans}} for log coordinate transformations. +#' @seealso \code{\link{a_coord_trans}} for log coordinate transformations. #' #' @examples #' # Make a log-log plot (without log ticks) -#' a <- ggplot(msleep, aes(bodywt, brainwt)) + -#' geom_point(na.rm = TRUE) + -#' scale_x_log10( +#' a <- a_plot(msleep, a_aes(bodywt, brainwt)) + +#' a_geom_point(na.rm = TRUE) + +#' a_scale_x_log10( #' breaks = scales::trans_breaks("log10", function(x) 10^x), -#' labels = scales::trans_format("log10", scales::math_format(10^.x)) +#' a_labels = scales::trans_format("log10", scales::math_format(10^.x)) #' ) + -#' scale_y_log10( +#' a_scale_y_log10( #' breaks = scales::trans_breaks("log10", function(x) 10^x), -#' labels = scales::trans_format("log10", scales::math_format(10^.x)) +#' a_labels = scales::trans_format("log10", scales::math_format(10^.x)) #' ) + -#' theme_bw() +#' a_theme_bw() #' -#' a + annotation_logticks() # Default: log ticks on bottom and left -#' a + annotation_logticks(sides = "lr") # Log ticks for y, on left and right -#' a + annotation_logticks(sides = "trbl") # All four sides +#' a + ggplot2Animint:::a_annotation_logticks() # Default: log ticks on bottom and left +#' a + ggplot2Animint:::a_annotation_logticks(sides = "lr") # Log ticks for y, on left and right +#' a + ggplot2Animint:::a_annotation_logticks(sides = "trbl") # All four sides #' #' # Hide the minor grid lines because they don't align with the ticks -#' a + annotation_logticks(sides = "trbl") + theme(panel.grid.minor = element_blank()) +#' a + ggplot2Animint:::a_annotation_logticks(sides = "trbl") + +#' a_theme(panel.grid.minor = a_element_blank()) #' #' # Another way to get the same results as 'a' above: log-transform the data before #' # plotting it. Also hide the minor grid lines. -#' b <- ggplot(msleep, aes(log10(bodywt), log10(brainwt))) + -#' geom_point(na.rm = TRUE) + -#' scale_x_continuous(name = "body", labels = scales::math_format(10^.x)) + -#' scale_y_continuous(name = "brain", labels = scales::math_format(10^.x)) + -#' theme_bw() + theme(panel.grid.minor = element_blank()) +#' b <- a_plot(msleep, a_aes(log10(bodywt), log10(brainwt))) + +#' a_geom_point(na.rm = TRUE) + +#' a_scale_x_continuous(name = "body", a_labels = scales::math_format(10^.x)) + +#' a_scale_y_continuous(name = "brain", a_labels = scales::math_format(10^.x)) + +#' a_theme_bw() + a_theme(panel.grid.minor = a_element_blank()) #' -#' b + annotation_logticks() +#' b + ggplot2Animint:::a_annotation_logticks() #' #' # Using a coordinate transform requires scaled = FALSE -#' t <- ggplot(msleep, aes(bodywt, brainwt)) + -#' geom_point() + -#' coord_trans(x = "log10", y = "log10") + -#' theme_bw() -#' t + annotation_logticks(scaled = FALSE) +#' t <- a_plot(msleep, a_aes(bodywt, brainwt)) + +#' a_geom_point() + +#' ggplot2Animint:::a_coord_trans(x = "log10", y = "log10") + +#' a_theme_bw() +#' t + ggplot2Animint:::a_annotation_logticks(scaled = FALSE) #' #' # Change the length of the ticks -#' a + annotation_logticks( +#' a + ggplot2Animint:::a_annotation_logticks( #' short = unit(.5,"mm"), #' mid = unit(3,"mm"), #' long = unit(4,"mm") #' ) -annotation_logticks <- function(base = 10, sides = "bl", scaled = TRUE, +a_annotation_logticks <- function(base = 10, sides = "bl", scaled = TRUE, short = unit(0.1, "cm"), mid = unit(0.2, "cm"), long = unit(0.3, "cm"), colour = "black", size = 0.5, linetype = 1, alpha = 1, color = NULL, ...) { if (!is.null(color)) colour <- color - layer( + a_layer( data = data.frame(x = NA), mapping = NULL, - stat = StatIdentity, - geom = GeomLogticks, - position = PositionIdentity, + a_stat = a_StatIdentity, + a_geom = a_GeomLogticks, + a_position = a_PositionIdentity, show.legend = FALSE, - inherit.aes = FALSE, + inherit.a_aes = FALSE, params = list( base = base, sides = sides, @@ -104,17 +105,17 @@ annotation_logticks <- function(base = 10, sides = "bl", scaled = TRUE, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomLogticks <- ggproto("GeomLogticks", Geom, +a_GeomLogticks <- a_ggproto("a_GeomLogticks", a_Geom, extra_params = "", handle_na = function(data, params) { data }, - draw_panel = function(data, panel_scales, coord, base = 10, sides = "bl", + draw_panel = function(data, panel_scales, a_coord, base = 10, sides = "bl", scaled = TRUE, short = unit(0.1, "cm"), mid = unit(0.2, "cm"), long = unit(0.3, "cm")) { @@ -129,7 +130,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, if (grepl("[b|t]", sides)) { # Get positions of x tick marks - xticks <- calc_logticks( + xticks <- a_calc_logticks( base = base, minpow = floor(panel_scales$x.range[1]), maxpow = ceiling(panel_scales$x.range[2]), @@ -143,7 +144,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, xticks$value <- log(xticks$value, base) names(xticks)[names(xticks) == "value"] <- "x" # Rename to 'x' for coordinates$transform - xticks <- coord$transform(xticks, panel_scales) + xticks <- a_coord$transform(xticks, panel_scales) # Make the grobs if (grepl("b", sides)) { @@ -164,7 +165,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, if (grepl("[l|r]", sides)) { - yticks <- calc_logticks( + yticks <- a_calc_logticks( base = base, minpow = floor(panel_scales$y.range[1]), maxpow = ceiling(panel_scales$y.range[2]), @@ -178,7 +179,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, yticks$value <- log(yticks$value, base) names(yticks)[names(yticks) == "value"] <- "y" # Rename to 'y' for coordinates$transform - yticks <- coord$transform(yticks, panel_scales) + yticks <- a_coord$transform(yticks, panel_scales) # Make the grobs if (grepl("l", sides)) { @@ -200,7 +201,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, gTree(children = do.call("gList", ticks)) }, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = 1) + default_aes = a_aes(colour = "black", size = 0.5, linetype = 1, alpha = 1) ) @@ -209,7 +210,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, # - value: the position of the log tick on the data axis, for example 1, 2, ..., 9, 10, 20, ... # - start: on the other axis, start position of the line (usually 0) # - end: on the other axis, end position of the line (for example, .1, .2, or .3) -calc_logticks <- function(base = 10, ticks_per_base = base - 1, +a_calc_logticks <- function(base = 10, ticks_per_base = base - 1, minpow = 0, maxpow = minpow + 1, start = 0, shortend = .1, midend = .2, longend = .3) { # Number of blocks of tick marks diff --git a/R/annotation-map.r b/R/annotation-map.r index c7476a0d5e..e0c70b614d 100644 --- a/R/annotation-map.r +++ b/R/annotation-map.r @@ -4,28 +4,28 @@ NULL #' Annotation: maps. #' #' @param map data frame representing a map. Most map objects can be -#' converted into the right format by using \code{\link{fortify}} +#' converted into the right format by using \code{\link{a_fortify}} #' @param ... other arguments used to modify aesthetics -#' @export +#' @keywords internal #' @examples #' if (require("maps")) { #' usamap <- map_data("state") #' #' seal.sub <- subset(seals, long > -130 & lat < 45 & lat > 40) -#' ggplot(seal.sub, aes(x = long, y = lat)) + -#' annotation_map(usamap, fill = "NA", colour = "grey50") + -#' geom_segment(aes(xend = long + delta_long, yend = lat + delta_lat)) +#' a_plot(seal.sub, a_aes(x = long, y = lat)) + +#' ggplot2Animint:::a_annotation_map(usamap, fill = "NA", colour = "grey50") + +#' a_geom_segment(a_aes(xend = long + delta_long, yend = lat + delta_lat)) #' #' seal2 <- transform(seal.sub, #' latr = cut(lat, 2), #' longr = cut(long, 2)) #' -#' ggplot(seal2, aes(x = long, y = lat)) + -#' annotation_map(usamap, fill = "NA", colour = "grey50") + -#' geom_segment(aes(xend = long + delta_long, yend = lat + delta_lat)) + -#' facet_grid(latr ~ longr, scales = "free", space = "free") +#' a_plot(seal2, a_aes(x = long, y = lat)) + +#' ggplot2Animint:::a_annotation_map(usamap, fill = "NA", colour = "grey50") + +#' a_geom_segment(a_aes(xend = long + delta_long, yend = lat + delta_lat)) + +#' ggplot2Animint:::a_facet_grid(latr ~ longr, scales = "free", space = "free") #' } -annotation_map <- function(map, ...) { +a_annotation_map <- function(map, ...) { # Get map input into correct form stopifnot(is.data.frame(map)) if (!is.null(map$lat)) map$y <- map$lat @@ -33,30 +33,30 @@ annotation_map <- function(map, ...) { if (!is.null(map$region)) map$id <- map$region stopifnot(all(c("x", "y", "id") %in% names(map))) - layer( + a_layer( data = NULL, - stat = StatIdentity, - geom = GeomAnnotationMap, - position = PositionIdentity, - inherit.aes = FALSE, + a_stat = a_StatIdentity, + a_geom = a_GeomAnnotationMap, + a_position = a_PositionIdentity, + inherit.a_aes = FALSE, params = list(map = map, ...) ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomAnnotationMap <- ggproto("GeomAnnotationMap", GeomMap, +a_GeomAnnotationMap <- a_ggproto("a_GeomAnnotationMap", a_GeomMap, extra_params = "", handle_na = function(data, params) { data }, - draw_panel = function(data, panel_scales, coord, map) { + draw_panel = function(data, panel_scales, a_coord, map) { # Munch, then set up id variable for polygonGrob - # must be sequential integers - coords <- coord_munch(coord, map, panel_scales) + coords <- a_coord_munch(a_coord, map, panel_scales) coords$group <- coords$group %||% coords$id grob_id <- match(coords$group, unique(coords$group)) diff --git a/R/annotation-raster.r b/R/annotation-raster.r index 45b49cb408..542ec40c78 100644 --- a/R/annotation-raster.r +++ b/R/annotation-raster.r @@ -4,7 +4,7 @@ NULL #' Annotation: High-performance rectangular tiling. #' -#' This is a special version of \code{\link{geom_raster}} optimised for static +#' This is a special version of \code{\link{a_geom_raster}} optimised for static #' annotations that are the same in every panel. These annotations will not #' affect scales (i.e. the x and y axes will not grow to cover the range #' of the raster, and the raster must already have its own colours). @@ -18,37 +18,37 @@ NULL #' location of raster #' @param interpolate If \code{TRUE} interpolate linearly, if \code{FALSE} #' (the default) don't interpolate. -#' @export +#' @keywords internal #' @examples #' # Generate data #' rainbow <- matrix(hcl(seq(0, 360, length.out = 50 * 50), 80, 70), nrow = 50) -#' ggplot(mtcars, aes(mpg, wt)) + -#' geom_point() + -#' annotation_raster(rainbow, 15, 20, 3, 4) +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point() + +#' ggplot2Animint:::a_annotation_raster(rainbow, 15, 20, 3, 4) #' # To fill up whole plot -#' ggplot(mtcars, aes(mpg, wt)) + -#' annotation_raster(rainbow, -Inf, Inf, -Inf, Inf) + -#' geom_point() +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' ggplot2Animint:::a_annotation_raster(rainbow, -Inf, Inf, -Inf, Inf) + +#' a_geom_point() #' #' rainbow2 <- matrix(hcl(seq(0, 360, length.out = 10), 80, 70), nrow = 1) -#' ggplot(mtcars, aes(mpg, wt)) + -#' annotation_raster(rainbow2, -Inf, Inf, -Inf, Inf) + -#' geom_point() +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' ggplot2Animint:::a_annotation_raster(rainbow2, -Inf, Inf, -Inf, Inf) + +#' a_geom_point() #' rainbow2 <- matrix(hcl(seq(0, 360, length.out = 10), 80, 70), nrow = 1) -#' ggplot(mtcars, aes(mpg, wt)) + -#' annotation_raster(rainbow2, -Inf, Inf, -Inf, Inf, interpolate = TRUE) + -#' geom_point() -annotation_raster <- function(raster, xmin, xmax, ymin, ymax, +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' ggplot2Animint:::a_annotation_raster(rainbow2, -Inf, Inf, -Inf, Inf, interpolate = TRUE) + +#' a_geom_point() +a_annotation_raster <- function(raster, xmin, xmax, ymin, ymax, interpolate = FALSE) { raster <- grDevices::as.raster(raster) - layer( + a_layer( data = NULL, mapping = NULL, - stat = StatIdentity, - position = PositionIdentity, - geom = GeomRasterAnn, - inherit.aes = TRUE, + a_stat = a_StatIdentity, + a_position = a_PositionIdentity, + a_geom = a_GeomRasterAnn, + inherit.a_aes = TRUE, params = list( raster = raster, xmin = xmin, @@ -61,24 +61,24 @@ annotation_raster <- function(raster, xmin, xmax, ymin, ymax, } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomRasterAnn <- ggproto("GeomRasterAnn", Geom, +a_GeomRasterAnn <- a_ggproto("a_GeomRasterAnn", a_Geom, extra_params = "", handle_na = function(data, params) { data }, - draw_panel = function(data, panel_scales, coord, raster, xmin, xmax, + draw_panel = function(data, panel_scales, a_coord, raster, xmin, xmax, ymin, ymax, interpolate = FALSE) { - if (!inherits(coord, "CoordCartesian")) { - stop("annotation_raster only works with Cartesian coordinates", + if (!inherits(a_coord, "a_CoordCartesian")) { + stop("a_annotation_raster only works with Cartesian coordinates", call. = FALSE) } corners <- data.frame(x = c(xmin, xmax), y = c(ymin, ymax)) - data <- coord$transform(corners, panel_scales) + data <- a_coord$transform(corners, panel_scales) x_rng <- range(data$x, na.rm = TRUE) y_rng <- range(data$y, na.rm = TRUE) diff --git a/R/annotation.r b/R/annotation.r index d810024d4f..5df76eb7a4 100644 --- a/R/annotation.r +++ b/R/annotation.r @@ -11,56 +11,56 @@ #' set. This means that layers created with this function will never #' affect the legend. #' -#' @param geom name of geom to use for annotation +#' @param a_geom name of geom to use for annotation #' @param x,y,xmin,ymin,xmax,ymax,xend,yend positioning aesthetics - #' you must specify at least one of these. -#' @inheritParams layer -#' @inheritParams geom_point -#' @export +#' @inheritParams a_layer +#' @inheritParams a_geom_point +#' @keywords internal #' @examples -#' p <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_point() -#' p + annotate("text", x = 4, y = 25, label = "Some text") -#' p + annotate("text", x = 2:5, y = 25, label = "Some text") -#' p + annotate("rect", xmin = 3, xmax = 4.2, ymin = 12, ymax = 21, +#' p <- a_plot(mtcars, a_aes(x = wt, y = mpg)) + a_geom_point() +#' p + ggplot2Animint:::a_annotate("text", x = 4, y = 25, a_label = "Some text") +#' p + ggplot2Animint:::a_annotate("text", x = 2:5, y = 25, a_label = "Some text") +#' p + ggplot2Animint:::a_annotate("rect", xmin = 3, xmax = 4.2, ymin = 12, ymax = 21, #' alpha = .2) -#' p + annotate("segment", x = 2.5, xend = 4, y = 15, yend = 25, +#' p + ggplot2Animint:::a_annotate("segment", x = 2.5, xend = 4, y = 15, yend = 25, #' colour = "blue") -#' p + annotate("pointrange", x = 3.5, y = 20, ymin = 12, ymax = 28, +#' p + ggplot2Animint:::a_annotate("pointrange", x = 3.5, y = 20, ymin = 12, ymax = 28, #' colour = "red", size = 1.5) #' -#' p + annotate("text", x = 2:3, y = 20:21, label = c("my label", "label 2")) -annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL, +#' p + ggplot2Animint:::a_annotate("text", x = 2:3, y = 20:21, a_label = c("my label", "label 2")) +a_annotate <- function(a_geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL, ymin = NULL, ymax = NULL, xend = NULL, yend = NULL, ..., na.rm = FALSE) { - position <- compact(list( + a_position <- compact(list( x = x, xmin = xmin, xmax = xmax, xend = xend, y = y, ymin = ymin, ymax = ymax, yend = yend )) - aesthetics <- c(position, list(...)) + a_aesthetics <- c(a_position, list(...)) - # Check that all aesthetic have compatible lengths - lengths <- vapply(aesthetics, length, integer(1)) + # Check that all a_aesthetic have compatible lengths + lengths <- vapply(a_aesthetics, length, integer(1)) unequal <- length(unique(setdiff(lengths, 1L))) > 1L if (unequal) { bad <- lengths != 1L - details <- paste(names(aesthetics)[bad], " (", lengths[bad], ")", + details <- paste(names(a_aesthetics)[bad], " (", lengths[bad], ")", sep = "", collapse = ", ") stop("Unequal parameter lengths: ", details, call. = FALSE) } - data <- data.frame(position) - layer( - geom = geom, + data <- data.frame(a_position) + a_layer( + a_geom = a_geom, params = list( na.rm = na.rm, ... ), - stat = StatIdentity, - position = PositionIdentity, + a_stat = a_StatIdentity, + a_position = a_PositionIdentity, data = data, - mapping = aes_all(names(data)), - inherit.aes = FALSE, + mapping = a_aes_all(names(data)), + inherit.a_aes = FALSE, show.legend = FALSE ) } diff --git a/R/autoplot.r b/R/autoplot.r index 0796d4d4f5..8c498b21e0 100644 --- a/R/autoplot.r +++ b/R/autoplot.r @@ -7,8 +7,8 @@ #' @param object an object, whose class will determine the behaviour of autoplot #' @param ... other arguments passed to specific methods #' @return a ggplot object -#' @export -#' @seealso \code{\link{ggplot}} and \code{\link{fortify}} +#' @keywords internal +#' @seealso \code{\link{a_plot}} and \code{\link{a_fortify}} autoplot <- function(object, ...) { UseMethod("autoplot") } diff --git a/R/bench.r b/R/bench.r index 575d08f5a0..7bc4ed5f65 100644 --- a/R/bench.r +++ b/R/bench.r @@ -3,17 +3,17 @@ #' #' @param x code to create ggplot2 plot #' @export -#' @keywords internal #' @examples -#' benchplot(ggplot(mtcars, aes(mpg, wt)) + geom_point()) -#' benchplot(ggplot(mtcars, aes(mpg, wt)) + geom_point() + facet_grid(. ~ cyl)) -benchplot <- function(x) { +#' a_benchplot(a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point()) +#' a_benchplot(a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() + +#' a_facet_grid(. ~ cyl)) +a_benchplot <- function(x) { construct <- system.time(force(x)) - stopifnot(inherits(x, "ggplot")) + stopifnot(inherits(x, "a_plot")) - build <- system.time(data <- ggplot_build(x)) - render <- system.time(grob <- ggplot_gtable(data)) + build <- system.time(data <- a_plot_build(x)) + render <- system.time(grob <- a_plot_gtable(data)) draw <- system.time(grid.draw(grob)) times <- rbind(construct, build, render, draw)[, 1:3] diff --git a/R/coord-.r b/R/coord-.r index ce3ae43fc5..c8609b63ab 100644 --- a/R/coord-.r +++ b/R/coord-.r @@ -1,21 +1,21 @@ -#' @section Coordinate systems: +#' @section a_Coordinate systems: #' -#' All \code{coord_*} functions (like \code{coord_trans}) return a \code{Coord*} -#' object (like \code{CoordTrans}). The \code{Coord*} object is responsible for +#' All \code{a_coord_*} functions (like \code{a_coord_trans}) return a \code{a_Coord*} +#' object (like \code{a_CoordTrans}). The \code{a_Coord*} object is responsible for #' adjusting the position of overlapping geoms. #' -#' The way that the \code{coord_*} functions work is slightly different from the -#' \code{geom_*} and \code{stat_*} functions, because a \code{coord_*} function -#' actually "instantiates" the \code{Coord*} object by creating a descendant, +#' The way that the \code{a_coord_*} functions work is slightly different from the +#' \code{a_geom_*} and \code{a_stat_*} functions, because a \code{a_coord_*} function +#' actually "instantiates" the \code{a_Coord*} object by creating a descendant, #' and returns that. #' -#' Each of the \code{Coord*} objects is a \code{\link{ggproto}} object, -#' descended from the top-level \code{Coord}. To create a new type of Coord +#' Each of the \code{a_Coord*} objects is a \code{\link{a_ggproto}} object, +#' descended from the top-level \code{a_Coord}. To create a new type of Coord #' object, you typically will want to implement one or more of the following: #' #' \itemize{ #' \item \code{aspect}: Returns the desired aspect ratio for the plot. -#' \item \code{labels}: Returns a list containing labels for x and y. +#' \item \code{a_labels}: Returns a list containing labels for x and y. #' \item \code{render_fg}: Renders foreground elements. #' \item \code{render_bg}: Renders background elements. #' \item \code{render_axis_h}: Renders the horizontal axis. @@ -28,33 +28,33 @@ #' linear; \code{FALSE} otherwise. #' } #' -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -Coord <- ggproto("Coord", +a_Coord <- a_ggproto("a_Coord", aspect = function(ranges) NULL, - labels = function(scale_details) scale_details, + a_labels = function(scale_details) scale_details, - render_fg = function(scale_details, theme) element_render(theme, "panel.border"), + render_fg = function(scale_details, a_theme) a_element_render(a_theme, "panel.border"), - render_bg = function(scale_details, theme) { + render_bg = function(scale_details, a_theme) { x.major <- if (length(scale_details$x.major) > 0) unit(scale_details$x.major, "native") x.minor <- if (length(scale_details$x.minor) > 0) unit(scale_details$x.minor, "native") y.major <- if (length(scale_details$y.major) > 0) unit(scale_details$y.major, "native") y.minor <- if (length(scale_details$y.minor) > 0) unit(scale_details$y.minor, "native") - guide_grid(theme, x.minor, x.major, y.minor, y.major) + a_guide_grid(a_theme, x.minor, x.major, y.minor, y.major) }, - render_axis_h = function(scale_details, theme) { - guide_axis(scale_details$x.major, scale_details$x.labels, "bottom", theme) + render_axis_h = function(scale_details, a_theme) { + a_guide_axis(scale_details$x.major, scale_details$x.a_labels, "bottom", a_theme) }, - render_axis_v = function(scale_details, theme) { - guide_axis(scale_details$y.major, scale_details$y.labels, "left", theme) + render_axis_v = function(scale_details, a_theme) { + a_guide_axis(scale_details$y.major, scale_details$y.a_labels, "left", a_theme) }, range = function(scale_details) { @@ -72,10 +72,10 @@ Coord <- ggproto("Coord", #' Is this object a coordinate system? #' -#' @export is.Coord +#' @export is.a_Coord #' @keywords internal -is.Coord <- function(x) inherits(x, "Coord") +is.a_Coord <- function(x) inherits(x, "a_Coord") -expand_default <- function(scale, discrete = c(0, 0.6), continuous = c(0.05, 0)) { - scale$expand %|W|% if (scale$is_discrete()) discrete else continuous +expand_default <- function(a_scale, discrete = c(0, 0.6), continuous = c(0.05, 0)) { + a_scale$expand %|W|% if (a_scale$is_discrete()) discrete else continuous } diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index 5ae6e498a0..dedd13dac1 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -14,51 +14,51 @@ #' # There are two ways of zooming the plot display: with scales or #' # with coordinate systems. They work in two rather different ways. #' -#' p <- ggplot(mtcars, aes(disp, wt)) + -#' geom_point() + -#' geom_smooth() +#' p <- a_plot(mtcars, a_aes(disp, wt)) + +#' a_geom_point() + +#' a_geom_smooth() #' p #' #' # Setting the limits on a scale converts all values outside the range to NA. -#' p + scale_x_continuous(limits = c(325, 500)) +#' p + a_scale_x_continuous(limits = c(325, 500)) #' #' # Setting the limits on the coordinate system performs a visual zoom. #' # The data is unchanged, and we just view a small portion of the original #' # plot. Note how smooth continues past the points visible on this plot. -#' p + coord_cartesian(xlim = c(325, 500)) +#' p + a_coord_cartesian(xlim = c(325, 500)) #' #' # By default, the same expansion factor is applied as when setting scale #' # limits. You can set the limits precisely by setting expand = FALSE -#' p + coord_cartesian(xlim = c(325, 500), expand = FALSE) +#' p + a_coord_cartesian(xlim = c(325, 500), expand = FALSE) #' #' # Simiarly, we can use expand = FALSE to turn off expansion with the #' # default limits -#' p + coord_cartesian(expand = FALSE) +#' p + a_coord_cartesian(expand = FALSE) #' #' # You can see the same thing with this 2d histogram -#' d <- ggplot(diamonds, aes(carat, price)) + -#' stat_bin2d(bins = 25, colour = "white") +#' d <- a_plot(diamonds, a_aes(carat, price)) + +#' a_stat_bin2d(bins = 25, colour = "white") #' d #' #' # When zooming the scale, the we get 25 new bins that are the same #' # size on the plot, but represent smaller regions of the data space -#' d + scale_x_continuous(limits = c(0, 1)) +#' d + a_scale_x_continuous(limits = c(0, 1)) #' #' # When zooming the coordinate system, we see a subset of original 50 bins, #' # displayed bigger -#' d + coord_cartesian(xlim = c(0, 1)) -coord_cartesian <- function(xlim = NULL, ylim = NULL, expand = TRUE) { - ggproto(NULL, CoordCartesian, +#' d + a_coord_cartesian(xlim = c(0, 1)) +a_coord_cartesian <- function(xlim = NULL, ylim = NULL, expand = TRUE) { + a_ggproto(NULL, a_CoordCartesian, limits = list(x = xlim, y = ylim), expand = expand ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -CoordCartesian <- ggproto("CoordCartesian", Coord, +a_CoordCartesian <- a_ggproto("a_CoordCartesian", a_Coord, is_linear = function() TRUE, diff --git a/R/coord-fixed.r b/R/coord-fixed.r index 98eb933ce8..d6154630d6 100644 --- a/R/coord-fixed.r +++ b/R/coord-fixed.r @@ -9,20 +9,20 @@ #' \code{\link[MASS]{eqscplot}}, but it works for all types of graphics. #' #' @export -#' @inheritParams coord_cartesian +#' @inheritParams a_coord_cartesian #' @param ratio aspect ratio, expressed as \code{y / x} #' @examples #' # ensures that the ranges of axes are equal to the specified ratio by #' # adjusting the plot aspect ratio #' -#' p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() -#' p + coord_fixed(ratio = 1) -#' p + coord_fixed(ratio = 5) -#' p + coord_fixed(ratio = 1/5) +#' p <- a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() +#' p + a_coord_fixed(ratio = 1) +#' p + a_coord_fixed(ratio = 5) +#' p + a_coord_fixed(ratio = 1/5) #' #' # Resize the plot to see that the specified aspect ratio is maintained -coord_fixed <- function(ratio = 1, xlim = NULL, ylim = NULL, expand = TRUE) { - ggproto(NULL, CoordFixed, +a_coord_fixed <- function(ratio = 1, xlim = NULL, ylim = NULL, expand = TRUE) { + a_ggproto(NULL, a_CoordFixed, limits = list(x = xlim, y = ylim), ratio = ratio, expand = expand @@ -30,16 +30,16 @@ coord_fixed <- function(ratio = 1, xlim = NULL, ylim = NULL, expand = TRUE) { } #' @export -#' @rdname coord_fixed +#' @rdname a_coord_fixed #' @usage NULL -coord_equal <- coord_fixed +a_coord_equal <- a_coord_fixed -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -CoordFixed <- ggproto("CoordFixed", CoordCartesian, +a_CoordFixed <- a_ggproto("a_CoordFixed", a_CoordCartesian, aspect = function(self, ranges) { diff(ranges$y.range) / diff(ranges$x.range) * self$ratio diff --git a/R/coord-flip.r b/R/coord-flip.r index b42d64ead6..9a094a8f47 100644 --- a/R/coord-flip.r +++ b/R/coord-flip.r @@ -5,42 +5,42 @@ #' statistics which display y conditional on x, to x conditional on y. #' #' @export -#' @inheritParams coord_cartesian +#' @inheritParams a_coord_cartesian #' @examples #' # Very useful for creating boxplots, and other interval #' # geoms in the horizontal instead of vertical position. #' -#' ggplot(diamonds, aes(cut, price)) + -#' geom_boxplot() + -#' coord_flip() +#' a_plot(diamonds, a_aes(cut, price)) + +#' a_geom_boxplot() + +#' a_coord_flip() #' -#' h <- ggplot(diamonds, aes(carat)) + -#' geom_histogram() +#' h <- a_plot(diamonds, a_aes(carat)) + +#' a_geom_histogram() #' h -#' h + coord_flip() -#' h + coord_flip() + scale_x_reverse() +#' h + a_coord_flip() +#' h + a_coord_flip() + a_scale_x_reverse() #' #' # You can also use it to flip line and area plots: #' df <- data.frame(x = 1:5, y = (1:5) ^ 2) -#' ggplot(df, aes(x, y)) + -#' geom_area() -#' last_plot() + coord_flip() -coord_flip <- function(xlim = NULL, ylim = NULL, expand = TRUE) { - ggproto(NULL, CoordFlip, +#' a_plot(df, a_aes(x, y)) + +#' a_geom_area() +#' last_plot() + a_coord_flip() +a_coord_flip <- function(xlim = NULL, ylim = NULL, expand = TRUE) { + a_ggproto(NULL, a_CoordFlip, limits = list(x = xlim, y = ylim), expand = expand ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -CoordFlip <- ggproto("CoordFlip", CoordCartesian, +a_CoordFlip <- a_ggproto("a_CoordFlip", a_CoordCartesian, transform = function(data, scale_details) { data <- flip_labels(data) - CoordCartesian$transform(data, scale_details) + a_CoordCartesian$transform(data, scale_details) }, range = function(scale_details) { @@ -48,12 +48,12 @@ CoordFlip <- ggproto("CoordFlip", CoordCartesian, }, train = function(self, scale_details) { - trained <- ggproto_parent(CoordCartesian, self)$train(scale_details) + trained <- a_ggproto_parent(a_CoordCartesian, self)$train(scale_details) flip_labels(trained) }, - labels = function(scale_details) { - flip_labels(CoordCartesian$labels(scale_details)) + a_labels = function(scale_details) { + flip_labels(a_CoordCartesian$a_labels(scale_details)) } ) diff --git a/R/coord-map.r b/R/coord-map.r index 63e09fb1f9..e63ac5a6d9 100644 --- a/R/coord-map.r +++ b/R/coord-map.r @@ -2,7 +2,7 @@ #' #' The representation of a portion of the earth, which is approximately spherical, #' onto a flat 2D plane requires a projection. This is what -#' \code{\link{coord_map}} does. These projections account for the fact that the +#' \code{\link{a_coord_map}} does. These projections account for the fact that the #' actual length (in km) of one degree of longitude varies between the equator #' and the pole. Near the equator, the ratio between the lengths of one degree #' of latitude and one degree of longitude is approximately 1. Near the pole, it @@ -10,11 +10,11 @@ #' towards 0. For regions that span only a few degrees and are not too close to #' the poles, setting the aspect ratio of the plot to the appropriate lat/lon #' ratio approximates the usual mercator projection. This is what -#' \code{coord_quickmap} does. With \code{\link{coord_map}} all elements of the +#' \code{a_coord_quickmap} does. With \code{\link{a_coord_map}} all elements of the #' graphic have to be projected which is not the case here. So -#' \code{\link{coord_quickmap}} has the advantage of being much faster, in +#' \code{\link{a_coord_quickmap}} has the advantage of being much faster, in #' particular for complex plots such as those using with -#' \code{\link{geom_tile}}, at the expense of correctness in the projection. +#' \code{\link{a_geom_tile}}, at the expense of correctness in the projection. #' This coordinate system provides the full range of map projections available #' in the mapproj package. #' @@ -34,57 +34,57 @@ #' if (require("maps")) { #' nz <- map_data("nz") #' # Prepare a map of NZ -#' nzmap <- ggplot(nz, aes(x = long, y = lat, group = group)) + -#' geom_polygon(fill = "white", colour = "black") +#' nzmap <- a_plot(nz, a_aes(x = long, y = lat, group = group)) + +#' a_geom_polygon(fill = "white", colour = "black") #' #' # Plot it in cartesian coordinates #' nzmap #' # With correct mercator projection -#' nzmap + coord_map() +#' nzmap + a_coord_map() #' # With the aspect ratio approximation -#' nzmap + coord_quickmap() +#' nzmap + a_coord_quickmap() #' #' # Other projections -#' nzmap + coord_map("cylindrical") -#' nzmap + coord_map("azequalarea", orientation = c(-36.92,174.6,0)) +#' nzmap + a_coord_map("cylindrical") +#' nzmap + a_coord_map("azequalarea", orientation = c(-36.92,174.6,0)) #' #' states <- map_data("state") -#' usamap <- ggplot(states, aes(long, lat, group = group)) + -#' geom_polygon(fill = "white", colour = "black") +#' usamap <- a_plot(states, a_aes(long, lat, group = group)) + +#' a_geom_polygon(fill = "white", colour = "black") #' #' # Use cartesian coordinates #' usamap #' # With mercator projection -#' usamap + coord_map() -#' usamap + coord_quickmap() +#' usamap + a_coord_map() +#' usamap + a_coord_quickmap() #' # See ?mapproject for coordinate systems and their parameters -#' usamap + coord_map("gilbert") -#' usamap + coord_map("lagrange") +#' usamap + a_coord_map("gilbert") +#' usamap + a_coord_map("lagrange") #' #' # For most projections, you'll need to set the orientation yourself #' # as the automatic selection done by mapproject is not available to #' # ggplot -#' usamap + coord_map("orthographic") -#' usamap + coord_map("stereographic") -#' usamap + coord_map("conic", lat0 = 30) -#' usamap + coord_map("bonne", lat0 = 50) +#' usamap + a_coord_map("orthographic") +#' usamap + a_coord_map("stereographic") +#' usamap + a_coord_map("conic", lat0 = 30) +#' usamap + a_coord_map("bonne", lat0 = 50) #' -#' # World map, using geom_path instead of geom_polygon +#' # World map, using a_geom_path instead of a_geom_polygon #' world <- map_data("world") -#' worldmap <- ggplot(world, aes(x = long, y = lat, group = group)) + -#' geom_path() + -#' scale_y_continuous(breaks = (-2:2) * 30) + -#' scale_x_continuous(breaks = (-4:4) * 45) +#' worldmap <- a_plot(world, a_aes(x = long, y = lat, group = group)) + +#' a_geom_path() + +#' a_scale_y_continuous(breaks = (-2:2) * 30) + +#' a_scale_x_continuous(breaks = (-4:4) * 45) #' #' # Orthographic projection with default orientation (looking down at North pole) -#' worldmap + coord_map("ortho") +#' worldmap + a_coord_map("ortho") #' # Looking up up at South Pole -#' worldmap + coord_map("ortho", orientation = c(-90, 0, 0)) +#' worldmap + a_coord_map("ortho", orientation = c(-90, 0, 0)) #' # Centered on New York (currently has issues with closing polygons) -#' worldmap + coord_map("ortho", orientation = c(41, -74, 0)) +#' worldmap + a_coord_map("ortho", orientation = c(41, -74, 0)) #' } -coord_map <- function(projection="mercator", ..., orientation = NULL, xlim = NULL, ylim = NULL) { - ggproto(NULL, CoordMap, +a_coord_map <- function(projection="mercator", ..., orientation = NULL, xlim = NULL, ylim = NULL) { + a_ggproto(NULL, a_CoordMap, projection = projection, orientation = orientation, limits = list(x = xlim, y = ylim), @@ -92,11 +92,11 @@ coord_map <- function(projection="mercator", ..., orientation = NULL, xlim = NUL ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -CoordMap <- ggproto("CoordMap", Coord, +a_CoordMap <- a_ggproto("a_CoordMap", a_Coord, transform = function(self, data, scale_details) { trans <- mproject(self, data$x, data$y, scale_details$orientation) @@ -122,13 +122,13 @@ CoordMap <- ggproto("CoordMap", Coord, ranges <- list() for (n in c("x", "y")) { - scale <- scale_details[[n]] + a_scale <- scale_details[[n]] limits <- self$limits[[n]] if (is.null(limits)) { - range <- scale$dimension(expand_default(scale)) + range <- a_scale$dimension(expand_default(a_scale)) } else { - range <- range(scale$transform(limits)) + range <- range(a_scale$transform(limits)) } ranges[[n]] <- range } @@ -153,20 +153,20 @@ CoordMap <- ggproto("CoordMap", Coord, ret[[n]]$range <- out$range ret[[n]]$major <- out$major_source ret[[n]]$minor <- out$minor_source - ret[[n]]$labels <- out$labels + ret[[n]]$a_labels <- out$a_labels } details <- list( orientation = orientation, x.range = ret$x$range, y.range = ret$y$range, x.proj = ret$x$proj, y.proj = ret$y$proj, - x.major = ret$x$major, x.minor = ret$x$minor, x.labels = ret$x$labels, - y.major = ret$y$major, y.minor = ret$y$minor, y.labels = ret$y$labels + x.major = ret$x$major, x.minor = ret$x$minor, x.a_labels = ret$x$a_labels, + y.major = ret$y$major, y.minor = ret$y$minor, y.a_labels = ret$y$a_labels ) details }, - render_bg = function(self, scale_details, theme) { + render_bg = function(self, scale_details, a_theme) { xrange <- expand_range(scale_details$x.range, 0.2) yrange <- expand_range(scale_details$y.range, 0.2) @@ -191,31 +191,31 @@ CoordMap <- ggproto("CoordMap", Coord, ylines <- self$transform(ygrid, scale_details) if (nrow(xlines) > 0) { - grob.xlines <- element_render( - theme, "panel.grid.major.x", + grob.xlines <- a_element_render( + a_theme, "panel.grid.major.x", xlines$x, xlines$y, default.units = "native" ) } else { - grob.xlines <- zeroGrob() + grob.xlines <- a_zeroGrob() } if (nrow(ylines) > 0) { - grob.ylines <- element_render( - theme, "panel.grid.major.y", + grob.ylines <- a_element_render( + a_theme, "panel.grid.major.y", ylines$x, ylines$y, default.units = "native" ) } else { - grob.ylines <- zeroGrob() + grob.ylines <- a_zeroGrob() } ggname("grill", grobTree( - element_render(theme, "panel.background"), + a_element_render(a_theme, "panel.background"), grob.xlines, grob.ylines )) }, - render_axis_h = function(self, scale_details, theme) { - if (is.null(scale_details$x.major)) return(zeroGrob()) + render_axis_h = function(self, scale_details, a_theme) { + if (is.null(scale_details$x.major)) return(a_zeroGrob()) x_intercept <- with(scale_details, data.frame( x = x.major, @@ -223,11 +223,11 @@ CoordMap <- ggproto("CoordMap", Coord, )) pos <- self$transform(x_intercept, scale_details) - guide_axis(pos$x, scale_details$x.labels, "bottom", theme) + a_guide_axis(pos$x, scale_details$x.a_labels, "bottom", a_theme) }, - render_axis_v = function(self, scale_details, theme) { - if (is.null(scale_details$y.major)) return(zeroGrob()) + render_axis_v = function(self, scale_details, a_theme) { + if (is.null(scale_details$y.major)) return(a_zeroGrob()) x_intercept <- with(scale_details, data.frame( x = x.range[1], @@ -235,15 +235,15 @@ CoordMap <- ggproto("CoordMap", Coord, )) pos <- self$transform(x_intercept, scale_details) - guide_axis(pos$y, scale_details$y.labels, "left", theme) + a_guide_axis(pos$y, scale_details$y.a_labels, "left", a_theme) } ) -mproject <- function(coord, x, y, orientation) { +mproject <- function(a_coord, x, y, orientation) { suppressWarnings(mapproj::mapproject(x, y, - projection = coord$projection, - parameters = coord$params, + projection = a_coord$projection, + parameters = a_coord$params, orientation = orientation )) } diff --git a/R/coord-munch.r b/R/coord-munch.r index e2b56ba3c7..e9bc6c2187 100644 --- a/R/coord-munch.r +++ b/R/coord-munch.r @@ -3,19 +3,18 @@ #' This function "munches" lines, dividing each line into many small pieces #' so they can be transformed independently. Used inside geom functions. #' -#' @param coord Coordinate system definition. +#' @param a_coord Coordinate system definition. #' @param data Data set to transform - should have variables \code{x} and #' \code{y} are chopped up into small pieces (as defined by \code{group}). #' All other variables are duplicated as needed. #' @param range Panel range specification. #' @param segment_length Target segment length -#' @keywords internal #' @export -coord_munch <- function(coord, data, range, segment_length = 0.01) { - if (coord$is_linear()) return(coord$transform(data, range)) +a_coord_munch <- function(a_coord, data, range, segment_length = 0.01) { + if (a_coord$is_linear()) return(a_coord$transform(data, range)) # range has theta and r values; get corresponding x and y values - ranges <- coord$range(range) + ranges <- a_coord$range(range) # Convert any infinite locations into max/min # Only need to work with x and y because for munching, those are the @@ -25,20 +24,20 @@ coord_munch <- function(coord, data, range, segment_length = 0.01) { data$y[data$y == -Inf] <- ranges$y[1] data$y[data$y == Inf] <- ranges$y[2] - # Calculate distances using coord distance metric - dist <- coord$distance(data$x, data$y, range) + # Calculate distances using a_coord distance metric + dist <- a_coord$distance(data$x, data$y, range) dist[data$group[-1] != data$group[-nrow(data)]] <- NA # Munch and then transform result munched <- munch_data(data, dist, segment_length) - coord$transform(munched, range) + a_coord$transform(munched, range) } -# For munching, only grobs are lines and polygons: everything else is -# transformed into those special cases by the geom. -# -# @param dist distance, scaled from 0 to 1 (maximum distance on plot) -# @keyword internal +#' For munching, only grobs are lines and polygons: everything else is +#' transformed into those special cases by the geom. +#' +#' @param dist distance, scaled from 0 to 1 (maximum distance on plot) +#' @keywords internal munch_data <- function(data, dist = NULL, segment_length = 0.01) { n <- nrow(data) @@ -58,9 +57,9 @@ munch_data <- function(data, dist = NULL, segment_length = 0.01) { # Replicate other aesthetics: defined by start point but also # must include final point id <- c(rep(seq_len(nrow(data) - 1), extra), nrow(data)) - aes_df <- data[id, setdiff(names(data), c("x", "y")), drop = FALSE] + a_aes_df <- data[id, setdiff(names(data), c("x", "y")), drop = FALSE] - plyr::unrowname(data.frame(x = x, y = y, aes_df)) + plyr::unrowname(data.frame(x = x, y = y, a_aes_df)) } # Interpolate. @@ -79,10 +78,10 @@ dist_euclidean <- function(x, y) { sqrt((x[-n] - x[-1]) ^ 2 + (y[-n] - y[-1]) ^ 2) } -# Compute central angle between two points. -# Multiple by radius of sphere to get great circle distance -# @arguments longitude -# @arguments latitude +#' Compute central angle between two points. +#' Multiple by radius of sphere to get great circle distance +#' @param lon longitude +#' @param lat latitude dist_central_angle <- function(lon, lat) { # Convert to radians lat <- lat * pi / 180 @@ -157,16 +156,17 @@ dist_polar <- function(r, theta) { abs(lf$dist / max_dist) } -# Given n points, find the slope, xintercept, and yintercept of -# the lines connecting them. -# -# This returns a data frame with length(x)-1 rows -# -# @param x A vector of x values -# @param y A vector of y values -# @examples -# find_line_formula(c(4, 7), c(1, 5)) -# find_line_formula(c(4, 7, 9), c(1, 5, 3)) +#' Given n points, find the slope, xintercept, and yintercept of +#' the lines connecting them. +#' +#' This returns a data frame with length(x)-1 rows +#' +#' @param x A vector of x values +#' @param y A vector of y values +#' @examples +#' find_line_formula(c(4, 7), c(1, 5)) +#' find_line_formula(c(4, 7, 9), c(1, 5, 3)) +#' @export find_line_formula <- function(x, y) { slope <- diff(y) / diff(x) yintercept <- y[-1] - (slope * x[-1]) @@ -176,18 +176,19 @@ find_line_formula <- function(x, y) { slope = slope, yintercept = yintercept, xintercept = xintercept) } -# Spiral arc length -# -# Each segment consists of a spiral line of slope 'a' between angles -# 'theta1' and 'theta2'. Because each segment has its own _normalized_ -# slope, the ending theta2 value may not be the same as the starting -# theta1 value of the next point. -# -# @param a A vector of spiral "slopes". Each spiral is defined as r = a * theta. -# @param theta1 A vector of starting theta values. -# @param theta2 A vector of ending theta values. -# @examples -# spiral_arc_length(a = c(0.2, 0.5), c(0.5 * pi, pi), c(pi, 1.25 * pi)) +#' Spiral arc length +#' +#' Each segment consists of a spiral line of slope 'a' between angles +#' 'theta1' and 'theta2'. Because each segment has its own _normalized_ +#' slope, the ending theta2 value may not be the same as the starting +#' theta1 value of the next point. +#' +#' @param a A vector of spiral "slopes". Each spiral is defined as r = a * theta. +#' @param theta1 A vector of starting theta values. +#' @param theta2 A vector of ending theta values. +#' @examples +#' ggplot2Animint:::spiral_arc_length(a = c(0.2, 0.5), c(0.5 * pi, pi), c(pi, 1.25 * pi)) +#' @keywords internal spiral_arc_length <- function(a, theta1, theta2) { # Archimedes' spiral arc length formula from # http://mathworld.wolfram.com/ArchimedesSpiral.html diff --git a/R/coord-polar.r b/R/coord-polar.r index aa6211123d..3626523453 100644 --- a/R/coord-polar.r +++ b/R/coord-polar.r @@ -14,31 +14,31 @@ #' # grammar. Use with EXTREME caution. #' #' #' # A pie chart = stacked bar chart + polar coordinates -#' pie <- ggplot(mtcars, aes(x = factor(1), fill = factor(cyl))) + -#' geom_bar(width = 1) -#' pie + coord_polar(theta = "y") +#' pie <- a_plot(mtcars, a_aes(x = factor(1), fill = factor(cyl))) + +#' a_geom_bar(width = 1) +#' pie + a_coord_polar(theta = "y") #' #' \donttest{ #' #' # A coxcomb plot = bar chart + polar coordinates -#' cxc <- ggplot(mtcars, aes(x = factor(cyl))) + -#' geom_bar(width = 1, colour = "black") -#' cxc + coord_polar() +#' cxc <- a_plot(mtcars, a_aes(x = factor(cyl))) + +#' a_geom_bar(width = 1, colour = "black") +#' cxc + a_coord_polar() #' # A new type of plot? -#' cxc + coord_polar(theta = "y") +#' cxc + a_coord_polar(theta = "y") #' #' # The bullseye chart -#' pie + coord_polar() +#' pie + a_coord_polar() #' #' # Hadley's favourite pie chart #' df <- data.frame( #' variable = c("does not resemble", "resembles"), #' value = c(20, 80) #' ) -#' ggplot(df, aes(x = "", y = value, fill = variable)) + -#' geom_bar(width = 1, stat = "identity") + -#' scale_fill_manual(values = c("red", "yellow")) + -#' coord_polar("y", start = pi / 3) + +#' a_plot(df, a_aes(x = "", y = value, fill = variable)) + +#' a_geom_bar(width = 1, a_stat = "identity") + +#' a_scale_fill_manual(values = c("red", "yellow")) + +#' a_coord_polar("y", start = pi / 3) + #' labs(title = "Pac man") #' #' # Windrose + doughnut plot @@ -46,19 +46,19 @@ #' movies$rrating <- cut_interval(movies$rating, length = 1) #' movies$budgetq <- cut_number(movies$budget, 4) #' -#' doh <- ggplot(movies, aes(x = rrating, fill = budgetq)) +#' doh <- a_plot(movies, a_aes(x = rrating, fill = budgetq)) #' #' # Wind rose -#' doh + geom_bar(width = 1) + coord_polar() +#' doh + a_geom_bar(width = 1) + a_coord_polar() #' # Race track plot -#' doh + geom_bar(width = 0.9, position = "fill") + coord_polar(theta = "y") +#' doh + a_geom_bar(width = 0.9, position = "fill") + a_coord_polar(theta = "y") #' } #' } -coord_polar <- function(theta = "x", start = 0, direction = 1) { +a_coord_polar <- function(theta = "x", start = 0, direction = 1) { theta <- match.arg(theta, c("x", "y")) r <- if (theta == "x") "y" else "x" - ggproto(NULL, CoordPolar, + a_ggproto(NULL, a_CoordPolar, theta = theta, r = r, start = start, @@ -66,11 +66,11 @@ coord_polar <- function(theta = "x", start = 0, direction = 1) { ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -CoordPolar <- ggproto("CoordPolar", Coord, +a_CoordPolar <- a_ggproto("a_CoordPolar", a_Coord, aspect = function(details) 1, @@ -98,31 +98,31 @@ CoordPolar <- ggproto("CoordPolar", Coord, ret <- list(x = list(), y = list()) for (n in c("x", "y")) { - scale <- scale_details[[n]] + a_scale <- scale_details[[n]] limits <- self$limits[[n]] if (is.null(limits)) { if (self$theta == n) { - expand <- expand_default(scale, c(0, 0.5), c(0, 0)) + expand <- expand_default(a_scale, c(0, 0.5), c(0, 0)) } else { - expand <- expand_default(scale, c(0, 0), c(0, 0)) + expand <- expand_default(a_scale, c(0, 0), c(0, 0)) } - range <- scale$dimension(expand) + range <- a_scale$dimension(expand) } else { - range <- range(scale_transform(scale, limits)) + range <- range(a_scale_transform(a_scale, limits)) } - out <- scale$break_info(range) + out <- a_scale$break_info(range) ret[[n]]$range <- out$range ret[[n]]$major <- out$major_source ret[[n]]$minor <- out$minor_source - ret[[n]]$labels <- out$labels + ret[[n]]$a_labels <- out$a_labels } details = list( x.range = ret$x$range, y.range = ret$y$range, - x.major = ret$x$major, x.minor = ret$x$minor, x.labels = ret$x$labels, - y.major = ret$y$major, y.minor = ret$y$minor, y.labels = ret$y$labels + x.major = ret$x$major, x.minor = ret$x$minor, x.a_labels = ret$x$a_labels, + y.major = ret$y$major, y.minor = ret$y$minor, y.a_labels = ret$y$a_labels ) if (self$theta == "y") { @@ -147,16 +147,16 @@ CoordPolar <- ggproto("CoordPolar", Coord, data }, - render_axis_v = function(self, scale_details, theme) { + render_axis_v = function(self, scale_details, a_theme) { x <- r_rescale(self, scale_details$r.major, scale_details) + 0.5 - guide_axis(x, scale_details$r.labels, "left", theme) + a_guide_axis(x, scale_details$r.a_labels, "left", a_theme) }, - render_axis_h = function(scale_details, theme) { - guide_axis(NA, "", "bottom", theme) + render_axis_h = function(scale_details, a_theme) { + a_guide_axis(NA, "", "bottom", a_theme) }, - render_bg = function(self, scale_details, theme) { + render_bg = function(self, scale_details, a_theme) { scale_details <- rename_data(self, scale_details) theta <- if (length(scale_details$theta.major) > 0) @@ -167,31 +167,31 @@ CoordPolar <- ggproto("CoordPolar", Coord, rfine <- c(r_rescale(self, scale_details$r.major, scale_details), 0.45) - # This gets the proper theme element for theta and r grid lines: + # This gets the proper a_theme element for theta and r grid lines: # panel.grid.major.x or .y majortheta <- paste("panel.grid.major.", self$theta, sep = "") minortheta <- paste("panel.grid.minor.", self$theta, sep = "") majorr <- paste("panel.grid.major.", self$r, sep = "") ggname("grill", grobTree( - element_render(theme, "panel.background"), - if (length(theta) > 0) element_render( - theme, majortheta, name = "angle", + a_element_render(a_theme, "panel.background"), + if (length(theta) > 0) a_element_render( + a_theme, majortheta, name = "angle", x = c(rbind(0, 0.45 * sin(theta))) + 0.5, y = c(rbind(0, 0.45 * cos(theta))) + 0.5, id.lengths = rep(2, length(theta)), default.units = "native" ), - if (length(thetamin) > 0) element_render( - theme, minortheta, name = "angle", + if (length(thetamin) > 0) a_element_render( + a_theme, minortheta, name = "angle", x = c(rbind(0, 0.45 * sin(thetamin))) + 0.5, y = c(rbind(0, 0.45 * cos(thetamin))) + 0.5, id.lengths = rep(2, length(thetamin)), default.units = "native" ), - element_render( - theme, majorr, name = "radius", + a_element_render( + a_theme, majorr, name = "radius", x = rep(rfine, each = length(thetafine)) * sin(thetafine) + 0.5, y = rep(rfine, each = length(thetafine)) * cos(thetafine) + 0.5, id.lengths = rep(length(thetafine), length(rfine)), @@ -200,78 +200,78 @@ CoordPolar <- ggproto("CoordPolar", Coord, )) }, - render_fg = function(self, scale_details, theme) { + render_fg = function(self, scale_details, a_theme) { if (is.null(scale_details$theta.major)) { - return(element_render(theme, "panel.border")) + return(a_element_render(a_theme, "panel.border")) } theta <- theta_rescale(self, scale_details$theta.major, scale_details) - labels <- scale_details$theta.labels + a_labels <- scale_details$theta.a_labels # Combine the two ends of the scale if they are close theta <- theta[!is.na(theta)] ends_apart <- (theta[length(theta)] - theta[1]) %% (2 * pi) if (length(theta) > 0 && ends_apart < 0.05) { - n <- length(labels) - if (is.expression(labels)) { + n <- length(a_labels) + if (is.expression(a_labels)) { combined <- substitute(paste(a, "/", b), - list(a = labels[[1]], b = labels[[n]])) + list(a = a_labels[[1]], b = a_labels[[n]])) } else { - combined <- paste(labels[1], labels[n], sep = "/") + combined <- paste(a_labels[1], a_labels[n], sep = "/") } - labels[[n]] <- combined - labels <- labels[-1] + a_labels[[n]] <- combined + a_labels <- a_labels[-1] theta <- theta[-1] } grobTree( - if (length(labels) > 0) element_render( - theme, "axis.text.x", - labels, 0.45 * sin(theta) + 0.5, 0.45 * cos(theta) + 0.5, + if (length(a_labels) > 0) a_element_render( + a_theme, "axis.text.x", + a_labels, 0.45 * sin(theta) + 0.5, 0.45 * cos(theta) + 0.5, hjust = 0.5, vjust = 0.5, default.units = "native" ), - element_render(theme, "panel.border") + a_element_render(a_theme, "panel.border") ) }, - render_fg = function(self, scale_details, theme) { + render_fg = function(self, scale_details, a_theme) { if (is.null(scale_details$theta.major)) { - return(element_render(theme, "panel.border")) + return(a_element_render(a_theme, "panel.border")) } theta <- theta_rescale(self, scale_details$theta.major, scale_details) - labels <- scale_details$theta.labels + a_labels <- scale_details$theta.a_labels # Combine the two ends of the scale if they are close theta <- theta[!is.na(theta)] ends_apart <- (theta[length(theta)] - theta[1]) %% (2*pi) if (length(theta) > 0 && ends_apart < 0.05) { - n <- length(labels) - if (is.expression(labels)) { + n <- length(a_labels) + if (is.expression(a_labels)) { combined <- substitute(paste(a, "/", b), - list(a = labels[[1]], b = labels[[n]])) + list(a = a_labels[[1]], b = a_labels[[n]])) } else { - combined <- paste(labels[1], labels[n], sep = "/") + combined <- paste(a_labels[1], a_labels[n], sep = "/") } - labels[[n]] <- combined - labels <- labels[-1] + a_labels[[n]] <- combined + a_labels <- a_labels[-1] theta <- theta[-1] } grobTree( - if (length(labels) > 0) element_render( - theme, "axis.text.x", - labels, + if (length(a_labels) > 0) a_element_render( + a_theme, "axis.text.x", + a_labels, unit(0.45 * sin(theta) + 0.5, "native"), unit(0.45 * cos(theta) + 0.5, "native"), hjust = 0.5, vjust = 0.5 ), - element_render(theme, "panel.border") + a_element_render(a_theme, "panel.border") ) }, - labels = function(self, scale_details) { + a_labels = function(self, scale_details) { if (self$theta == "y") { list(x = scale_details$y, y = scale_details$x) } else { @@ -281,24 +281,24 @@ CoordPolar <- ggproto("CoordPolar", Coord, ) -rename_data <- function(coord, data) { - if (coord$theta == "y") { +rename_data <- function(a_coord, data) { + if (a_coord$theta == "y") { plyr::rename(data, c("y" = "theta", "x" = "r"), warn_missing = FALSE) } else { plyr::rename(data, c("y" = "r", "x" = "theta"), warn_missing = FALSE) } } -theta_rescale_no_clip <- function(coord, x, scale_details) { - rotate <- function(x) (x + coord$start) * coord$direction +theta_rescale_no_clip <- function(a_coord, x, scale_details) { + rotate <- function(x) (x + a_coord$start) * a_coord$direction rotate(rescale(x, c(0, 2 * pi), scale_details$theta.range)) } -theta_rescale <- function(coord, x, scale_details) { - rotate <- function(x) (x + coord$start) %% (2 * pi) * coord$direction +theta_rescale <- function(a_coord, x, scale_details) { + rotate <- function(x) (x + a_coord$start) %% (2 * pi) * a_coord$direction rotate(rescale(x, c(0, 2 * pi), scale_details$theta.range)) } -r_rescale <- function(coord, x, scale_details) { +r_rescale <- function(a_coord, x, scale_details) { rescale(x, c(0, 0.4), scale_details$r.range) } diff --git a/R/coord-quickmap.R b/R/coord-quickmap.R index a16ff71bba..f0e843c79a 100644 --- a/R/coord-quickmap.R +++ b/R/coord-quickmap.R @@ -1,18 +1,18 @@ -#' @inheritParams coord_cartesian +#' @inheritParams a_coord_cartesian #' @export -#' @rdname coord_map -coord_quickmap <- function(xlim = NULL, ylim = NULL, expand = TRUE) { - ggproto(NULL, CoordQuickmap, +#' @rdname a_coord_map +a_coord_quickmap <- function(xlim = NULL, ylim = NULL, expand = TRUE) { + a_ggproto(NULL, a_CoordQuickmap, limits = list(x = xlim, y = ylim), expand = expand ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -CoordQuickmap <- ggproto("CoordQuickmap", CoordCartesian, +a_CoordQuickmap <- a_ggproto("a_CoordQuickmap", a_CoordCartesian, aspect = function(ranges) { # compute coordinates of center point of map diff --git a/R/coord-transform.r b/R/coord-transform.r index cc506b1f28..37295784f8 100644 --- a/R/coord-transform.r +++ b/R/coord-transform.r @@ -1,6 +1,6 @@ #' Transformed cartesian coordinate system. #' -#' \code{coord_trans} is different to scale transformations in that it occurs after +#' \code{a_coord_trans} is different to scale transformations in that it occurs after #' statistical transformation and will affect the visual appearance of geoms - there is #' no guarantee that straight lines will continue to be straight. #' @@ -15,21 +15,21 @@ #' @export #' @examples #' \donttest{ -#' # See ?geom_boxplot for other examples +#' # See ?a_geom_boxplot for other examples #' #' # Three ways of doing transformation in ggplot: #' # * by transforming the data -#' ggplot(diamonds, aes(log10(carat), log10(price))) + -#' geom_point() +#' a_plot(diamonds, a_aes(log10(carat), log10(price))) + +#' a_geom_point() #' # * by transforming the scales -#' ggplot(diamonds, aes(carat, price)) + -#' geom_point() + -#' scale_x_log10() + -#' scale_y_log10() +#' a_plot(diamonds, a_aes(carat, price)) + +#' a_geom_point() + +#' a_scale_x_log10() + +#' a_scale_y_log10() #' # * by transforming the coordinate system: -#' ggplot(diamonds, aes(carat, price)) + -#' geom_point() + -#' coord_trans(x = "log10", y = "log10") +#' a_plot(diamonds, a_aes(carat, price)) + +#' a_geom_point() + +#' a_coord_trans(x = "log10", y = "log10") #' #' # The difference between transforming the scales and #' # transforming the coordinate system is that scale @@ -39,16 +39,16 @@ #' #' d <- subset(diamonds, carat > 0.5) #' -#' ggplot(d, aes(carat, price)) + -#' geom_point() + -#' geom_smooth(method = "lm") + -#' scale_x_log10() + -#' scale_y_log10() +#' a_plot(d, a_aes(carat, price)) + +#' a_geom_point() + +#' a_geom_smooth(method = "lm") + +#' a_scale_x_log10() + +#' a_scale_y_log10() #' -#' ggplot(d, aes(carat, price)) + -#' geom_point() + -#' geom_smooth(method = "lm") + -#' coord_trans(x = "log10", y = "log10") +#' a_plot(d, a_aes(carat, price)) + +#' a_geom_point() + +#' a_geom_smooth(method = "lm") + +#' a_coord_trans(x = "log10", y = "log10") #' #' # Here I used a subset of diamonds so that the smoothed line didn't #' # drop below zero, which obviously causes problems on the log-transformed @@ -56,26 +56,26 @@ #' #' # With a combination of scale and coordinate transformation, it's #' # possible to do back-transformations: -#' ggplot(diamonds, aes(carat, price)) + -#' geom_point() + -#' geom_smooth(method = "lm") + -#' scale_x_log10() + -#' scale_y_log10() + -#' coord_trans(x = scales::exp_trans(10), y = scales::exp_trans(10)) +#' a_plot(diamonds, a_aes(carat, price)) + +#' a_geom_point() + +#' a_geom_smooth(method = "lm") + +#' a_scale_x_log10() + +#' a_scale_y_log10() + +#' a_coord_trans(x = scales::exp_trans(10), y = scales::exp_trans(10)) #' #' # cf. -#' ggplot(diamonds, aes(carat, price)) + -#' geom_point() + -#' geom_smooth(method = "lm") +#' a_plot(diamonds, a_aes(carat, price)) + +#' a_geom_point() + +#' a_geom_smooth(method = "lm") #' #' # Also works with discrete scales #' df <- data.frame(a = abs(rnorm(26)),letters) -#' plot <- ggplot(df,aes(a,letters)) + geom_point() +#' plot <- a_plot(df,a_aes(a,letters)) + a_geom_point() #' -#' plot + coord_trans(x = "log10") -#' plot + coord_trans(x = "sqrt") +#' plot + a_coord_trans(x = "log10") +#' plot + a_coord_trans(x = "sqrt") #' } -coord_trans <- function(x = "identity", y = "identity", limx = NULL, limy = NULL, +a_coord_trans <- function(x = "identity", y = "identity", limx = NULL, limy = NULL, xtrans, ytrans) { if (!missing(xtrans)) { @@ -91,24 +91,24 @@ coord_trans <- function(x = "identity", y = "identity", limx = NULL, limy = NULL # Now limits are implemented. # But for backward compatibility, xlim -> limx, ylim -> ylim # Because there are many examples such as - # > coord_trans(x = "log10", y = "log10") + # > a_coord_trans(x = "log10", y = "log10") # Maybe this is changed. if (is.character(x)) x <- as.trans(x) if (is.character(y)) y <- as.trans(y) - ggproto(NULL, CoordTrans, + a_ggproto(NULL, a_CoordTrans, trans = list(x = x, y = y), limits = list(x = limx, y = limy) ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -CoordTrans <- ggproto("CoordTrans", Coord, +a_CoordTrans <- a_ggproto("a_CoordTrans", a_Coord, distance = function(self, x, y, scale_details) { max_dist <- dist_euclidean(scale_details$x.range, scale_details$y.range) @@ -166,7 +166,7 @@ train_trans <- function(scale_details, limits, trans, name) { out$minor_source <- transform_value(trans, out$minor_source, out$range) out <- list( - range = out$range, labels = out$labels, + range = out$range, a_labels = out$a_labels, major = out$major_source, minor = out$minor_source ) names(out) <- paste(name, names(out), sep = ".") diff --git a/R/facet-.r b/R/facet-.r index 029ec067ed..54a3dad4e2 100644 --- a/R/facet-.r +++ b/R/facet-.r @@ -1,4 +1,4 @@ -#' Facet specification. +#' a_facet specification. #' #' Create new facetting specification. For internal use only. #' @@ -6,8 +6,8 @@ #' @param shrink shrink scales to fit output of statistics, not raw data #' @keywords internal #' @export -facet <- function(..., shrink = TRUE, subclass = c()) { - structure(list(..., shrink = shrink), class = c(subclass, "facet")) +a_facet <- function(..., shrink = TRUE, subclass = c()) { + structure(list(..., shrink = shrink), class = c(subclass, "a_facet")) } #' Is this object a facetting specification? @@ -15,7 +15,7 @@ facet <- function(..., shrink = TRUE, subclass = c()) { #' @param x object to test #' @keywords internal #' @export -is.facet <- function(x) inherits(x, "facet") +is.a_facet <- function(x) inherits(x, "a_facet") # Figure out layout from data from plot and all layers. @@ -26,37 +26,37 @@ is.facet <- function(x) inherits(x, "facet") # # @param data a list of data frames (one for the plot and one for each # layer) -facet_train_layout <- function(facet, data) - UseMethod("facet_train_layout") +a_facet_train_layout <- function(a_facet, data) + UseMethod("a_facet_train_layout") -facet_map_layout <- function(facet, data, layout) - UseMethod("facet_map_layout") +a_facet_map_layout <- function(a_facet, data, layout) + UseMethod("a_facet_map_layout") -facet_render <- function(facet, panels_grob, coord, theme, geom_grobs) - UseMethod("facet_render") +a_facet_render <- function(a_facet, panels_grob, a_coord, a_theme, a_geom_grobs) + UseMethod("a_facet_render") -facet_strips <- function(facet, panel, theme) - UseMethod("facet_strips") +a_facet_strips <- function(a_facet, panel, a_theme) + UseMethod("a_facet_strips") -facet_panels <- function(facet, panel, coord, theme, geom_grobs) - UseMethod("facet_panels") +a_facet_panels <- function(a_facet, panel, a_coord, a_theme, a_geom_grobs) + UseMethod("a_facet_panels") -facet_axes <- function(facet, panel, coord, theme) - UseMethod("facet_axes") +a_facet_axes <- function(a_facet, panel, a_coord, a_theme) + UseMethod("a_facet_axes") -# Text description of facetting variables -facet_vars <- function(facet) - UseMethod("facet_vars") +# Text description of a_facetting variables +a_facet_vars <- function(a_facet) + UseMethod("a_facet_vars") #' @export -format.facet <- function(x, ...) { +format.a_facet <- function(x, ...) { name <- paste(rev(class(x)), collapse = "_") - paste(name, "(", facet_vars(x), ")", sep = "") + paste(name, "(", a_facet_vars(x), ")", sep = "") } #' @export -print.facet <- function(x, ...) { +print.a_facet <- function(x, ...) { cat(format(x, ...), "\n") } diff --git a/R/facet-grid-.r b/R/facet-grid-.r index 4d8f94108e..ad9f99fa57 100644 --- a/R/facet-grid-.r +++ b/R/facet-grid-.r @@ -27,7 +27,7 @@ #' column gets displayed as one separate line in the strip #' label. This function should inherit from the "labeller" S3 class #' for compatibility with \code{\link{labeller}()}. See -#' \code{\link{label_value}} for more details and pointers to other +#' \code{\link{a_label_value}} for more details and pointers to other #' options. #' @param as.table If \code{TRUE}, the default, the facets are laid out like #' a table with highest values at the bottom-right. If \code{FALSE}, the @@ -45,11 +45,11 @@ #' will be shown, regardless of whether or not they appear in the data. #' @export #' @examples -#' p <- ggplot(mpg, aes(displ, cty)) + geom_point() +#' p <- a_plot(mpg, a_aes(displ, cty)) + a_geom_point() #' -#' p + facet_grid(. ~ cyl) -#' p + facet_grid(drv ~ .) -#' p + facet_grid(drv ~ cyl) +#' p + a_facet_grid(. ~ cyl) +#' p + a_facet_grid(drv ~ .) +#' p + a_facet_grid(drv ~ cyl) #' #' # To change plot order of facet grid, #' # change the order of variable levels with factor() @@ -59,70 +59,70 @@ #' # combinations: #' df <- data.frame(displ = mean(mpg$displ), cty = mean(mpg$cty)) #' p + -#' facet_grid(. ~ cyl) + -#' geom_point(data = df, colour = "red", size = 2) +#' a_facet_grid(. ~ cyl) + +#' a_geom_point(data = df, colour = "red", size = 2) #' #' # Free scales ------------------------------------------------------- #' # You can also choose whether the scales should be constant #' # across all panels (the default), or whether they should be allowed #' # to vary -#' mt <- ggplot(mtcars, aes(mpg, wt, colour = factor(cyl))) + -#' geom_point() +#' mt <- a_plot(mtcars, a_aes(mpg, wt, colour = factor(cyl))) + +#' a_geom_point() #' -#' mt + facet_grid(. ~ cyl, scales = "free") +#' mt + a_facet_grid(. ~ cyl, scales = "free") #' #' # If scales and space are free, then the mapping between position #' # and values in the data will be the same across all panels. This #' # is particularly useful for categorical axes -#' ggplot(mpg, aes(drv, model)) + -#' geom_point() + -#' facet_grid(manufacturer ~ ., scales = "free", space = "free") + -#' theme(strip.text.y = element_text(angle = 0)) +#' a_plot(mpg, a_aes(drv, model)) + +#' a_geom_point() + +#' a_facet_grid(manufacturer ~ ., scales = "free", space = "free") + +#' a_theme(strip.text.y = a_element_text(angle = 0)) #' #' # Facet labels ------------------------------------------------------ -#' p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() +#' p <- a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point() #' p #' -#' # label_both() displays both variable name and value -#' p + facet_grid(vs ~ cyl, labeller = label_both) +#' # a_label_both() displays both variable name and value +#' p + a_facet_grid(vs ~ cyl, labeller = a_label_both) #' -#' # label_parsed() parses text into mathematical expressions, see ?plotmath +#' # a_label_parsed() parses text into mathematical expressions, see ?plotmath #' mtcars$cyl2 <- factor(mtcars$cyl, labels = c("alpha", "beta", "sqrt(x, y)")) -#' ggplot(mtcars, aes(wt, mpg)) + -#' geom_point() + -#' facet_grid(. ~ cyl2, labeller = label_parsed) +#' a_plot(mtcars, a_aes(wt, mpg)) + +#' a_geom_point() + +#' a_facet_grid(. ~ cyl2, labeller = a_label_parsed) #' -#' # label_bquote() makes it easy to construct math expressions -#' p + facet_grid(. ~ vs, labeller = label_bquote(cols = alpha ^ .(vs))) +#' # a_label_bquote() makes it easy to construct math expressions +#' p + a_facet_grid(. ~ vs, labeller = a_label_bquote(cols = alpha ^ .(vs))) #' #' # The facet strips can be displayed near the axes with switch #' data <- transform(mtcars, #' am = factor(am, levels = 0:1, c("Automatic", "Manual")), #' gear = factor(gear, levels = 3:5, labels = c("Three", "Four", "Five")) #' ) -#' p <- ggplot(data, aes(mpg, disp)) + geom_point() -#' p + facet_grid(am ~ gear, switch = "both") +#' p <- a_plot(data, a_aes(mpg, disp)) + a_geom_point() +#' p + a_facet_grid(am ~ gear, switch = "both") #' # It looks better without boxes around the strips -#' p + facet_grid(am ~ gear, switch = "both") + -#' theme(strip.background = element_blank()) +#' p + a_facet_grid(am ~ gear, switch = "both") + +#' a_theme(strip.background = a_element_blank()) #' #' # Margins ---------------------------------------------------------- #' \donttest{ #' # Margins can be specified by logically (all yes or all no) or by specific #' # variables as (character) variable names -#' mg <- ggplot(mtcars, aes(x = mpg, y = wt)) + geom_point() -#' mg + facet_grid(vs + am ~ gear) -#' mg + facet_grid(vs + am ~ gear, margins = TRUE) -#' mg + facet_grid(vs + am ~ gear, margins = "am") +#' mg <- a_plot(mtcars, a_aes(x = mpg, y = wt)) + a_geom_point() +#' mg + a_facet_grid(vs + am ~ gear) +#' mg + a_facet_grid(vs + am ~ gear, margins = TRUE) +#' mg + a_facet_grid(vs + am ~ gear, margins = "am") #' # when margins are made over "vs", since the facets for "am" vary #' # within the values of "vs", the marginal facet for "vs" is also #' # a margin over "am". -#' mg + facet_grid(vs + am ~ gear, margins = "vs") -#' mg + facet_grid(vs + am ~ gear, margins = "gear") -#' mg + facet_grid(vs + am ~ gear, margins = c("gear", "am")) +#' mg + a_facet_grid(vs + am ~ gear, margins = "vs") +#' mg + a_facet_grid(vs + am ~ gear, margins = "gear") +#' mg + a_facet_grid(vs + am ~ gear, margins = c("gear", "am")) #' } #' @importFrom plyr as.quoted -facet_grid <- function(facets, margins = FALSE, scales = "fixed", space = "fixed", shrink = TRUE, labeller = "label_value", as.table = TRUE, switch = NULL, drop = TRUE) { +a_facet_grid <- function(facets, margins = FALSE, scales = "fixed", space = "fixed", shrink = TRUE, labeller = "a_label_value", as.table = TRUE, switch = NULL, drop = TRUE) { scales <- match.arg(scales, c("fixed", "free_x", "free_y", "free")) free <- list( x = any(scales %in% c("free_x", "free")), @@ -131,8 +131,8 @@ facet_grid <- function(facets, margins = FALSE, scales = "fixed", space = "fixed space <- match.arg(space, c("fixed", "free_x", "free_y", "free")) space_free <- list( - x = any(space %in% c("free_x", "free")), - y = any(space %in% c("free_y", "free")) + x = any(space %in% c("free_x", "free")), + y = any(space %in% c("free_y", "free")) ) # Facets can either be a formula, a string, or a list of things to be @@ -160,7 +160,7 @@ facet_grid <- function(facets, margins = FALSE, scales = "fixed", space = "fixed # Check for deprecated labellers labeller <- check_labeller(labeller) - facet( + a_facet( rows = rows, cols = cols, margins = margins, shrink = shrink, free = free, space_free = space_free, labeller = labeller, as.table = as.table, switch = switch, drop = drop, @@ -170,28 +170,28 @@ facet_grid <- function(facets, margins = FALSE, scales = "fixed", space = "fixed #' @export -facet_train_layout.grid <- function(facet, data) { - layout <- layout_grid(data, facet$rows, facet$cols, facet$margins, - drop = facet$drop, as.table = facet$as.table) +a_facet_train_layout.grid <- function(a_facet, data) { + layout <- layout_grid(data, a_facet$rows, a_facet$cols, a_facet$margins, + drop = a_facet$drop, as.table = a_facet$as.table) # Relax constraints, if necessary - layout$SCALE_X <- if (facet$free$x) layout$COL else 1L - layout$SCALE_Y <- if (facet$free$y) layout$ROW else 1L + layout$SCALE_X <- if (a_facet$free$x) layout$COL else 1L + layout$SCALE_Y <- if (a_facet$free$y) layout$ROW else 1L layout } #' @export -facet_map_layout.grid <- function(facet, data, layout) { - locate_grid(data, layout, facet$rows, facet$cols, facet$margins) +a_facet_map_layout.grid <- function(a_facet, data, layout) { + locate_grid(data, layout, a_facet$rows, a_facet$cols, a_facet$margins) } #' @export -facet_render.grid <- function(facet, panel, coord, theme, geom_grobs) { - axes <- facet_axes(facet, panel, coord, theme) - strips <- facet_strips(facet, panel, theme) - panels <- facet_panels(facet, panel, coord, theme, geom_grobs) +a_facet_render.grid <- function(a_facet, panel, a_coord, a_theme, a_geom_grobs) { + axes <- a_facet_axes(a_facet, panel, a_coord, a_theme) + strips <- a_facet_strips(a_facet, panel, a_theme) + panels <- a_facet_panels(a_facet, panel, a_coord, a_theme, a_geom_grobs) # adjust the size of axes to the size of panel axes$l$heights <- panels$heights @@ -202,22 +202,22 @@ facet_render.grid <- function(facet, panel, coord, theme, geom_grobs) { strips$t$widths <- panels$widths # Check if switch is consistent with grid layout - switch_x <- !is.null(facet$switch) && facet$switch %in% c("both", "x") - switch_y <- !is.null(facet$switch) && facet$switch %in% c("both", "y") + switch_x <- !is.null(a_facet$switch) && a_facet$switch %in% c("both", "x") + switch_y <- !is.null(a_facet$switch) && a_facet$switch %in% c("both", "y") if (switch_x && length(strips$t) == 0) { - facet$switch <- if (facet$switch == "both") "y" else NULL + a_facet$switch <- if (a_facet$switch == "both") "y" else NULL switch_x <- FALSE warning("Cannot switch x axis strips as they do not exist", call. = FALSE) } if (switch_y && length(strips$r) == 0) { - facet$switch <- if (facet$switch == "both") "x" else NULL + a_facet$switch <- if (a_facet$switch == "both") "x" else NULL switch_y <- FALSE warning("Cannot switch y axis strips as they do not exist", call. = FALSE) } # Combine components into complete plot - if (is.null(facet$switch)) { + if (is.null(a_facet$switch)) { top <- strips$t top <- gtable_add_cols(top, strips$r$widths) top <- gtable_add_cols(top, axes$l$widths, pos = 0) @@ -231,19 +231,19 @@ facet_render.grid <- function(facet, panel, coord, theme, geom_grobs) { } else { # Add padding between the switched strips and the axes - padding <- convertUnit(theme$strip.switch.pad.grid, "cm") + padding <- convertUnit(a_theme$strip.switch.pad.grid, "cm") if (switch_x) { t_heights <- c(padding, strips$t$heights) gt_t <- gtable(widths = strips$t$widths, heights = unit(t_heights, "cm")) gt_t <- gtable_add_grob(gt_t, strips$t, name = strips$t$name, clip = "off", - t = 1, l = 1, b = -1, r = -1) + t = 1, l = 1, b = -1, r = -1) } if (switch_y) { r_widths <- c(strips$r$widths, padding) gt_r <- gtable(widths = unit(r_widths, "cm"), heights = strips$r$heights) gt_r <- gtable_add_grob(gt_r, strips$r, name = strips$r$name, clip = "off", - t = 1, l = 1, b = -1, r = -1) + t = 1, l = 1, b = -1, r = -1) } # Combine plot elements according to strip positions @@ -276,7 +276,7 @@ facet_render.grid <- function(facet, panel, coord, theme, geom_grobs) { complete <- rbind(top, center, bottom, z = c(1, 2, 3)) } else { stop("`switch` must be either NULL, 'both', 'x', or 'y'", - call. = FALSE) + call. = FALSE) } } @@ -288,67 +288,67 @@ facet_render.grid <- function(facet, panel, coord, theme, geom_grobs) { } #' @export -facet_strips.grid <- function(facet, panel, theme) { - col_vars <- unique(panel$layout[names(facet$cols)]) - row_vars <- unique(panel$layout[names(facet$rows)]) +a_facet_strips.grid <- function(a_facet, panel, a_theme) { + col_vars <- unique(panel$layout[names(a_facet$cols)]) + row_vars <- unique(panel$layout[names(a_facet$rows)]) # Adding labels metadata, useful for labellers attr(col_vars, "type") <- "cols" - attr(col_vars, "facet") <- "grid" + attr(col_vars, "a_facet") <- "grid" attr(row_vars, "type") <- "rows" - attr(row_vars, "facet") <- "grid" + attr(row_vars, "a_facet") <- "grid" dir <- list(r = "r", t = "t") - if (!is.null(facet$switch) && facet$switch %in% c("both", "x")) { + if (!is.null(a_facet$switch) && a_facet$switch %in% c("both", "x")) { dir$t <- "b" } - if (!is.null(facet$switch) && facet$switch %in% c("both", "y")) { + if (!is.null(a_facet$switch) && a_facet$switch %in% c("both", "y")) { dir$r <- "l" } strips <- list( - r = build_strip(panel, row_vars, facet$labeller, - theme, dir$r, switch = facet$switch), - t = build_strip(panel, col_vars, facet$labeller, - theme, dir$t, switch = facet$switch) + r = a_build_strip(panel, row_vars, a_facet$labeller, + a_theme, dir$r, switch = a_facet$switch), + t = a_build_strip(panel, col_vars, a_facet$labeller, + a_theme, dir$t, switch = a_facet$switch) ) Map(function(strip, side) { if (side %in% c("t", "b")) { - gtable_add_col_space(strip, theme$panel.margin.x %||% theme$panel.margin) + gtable_add_col_space(strip, a_theme$panel.margin.x %||% a_theme$panel.margin) } else { - gtable_add_row_space(strip, theme$panel.margin.y %||% theme$panel.margin) + gtable_add_row_space(strip, a_theme$panel.margin.y %||% a_theme$panel.margin) } }, strips, dir) } #' @export -facet_axes.grid <- function(facet, panel, coord, theme) { +a_facet_axes.grid <- function(a_facet, panel, a_coord, a_theme) { axes <- list() # Horizontal axes cols <- which(panel$layout$ROW == 1) - grobs <- lapply(panel$ranges[cols], coord$render_axis_h, theme = theme) + grobs <- lapply(panel$ranges[cols], a_coord$render_axis_h, a_theme = a_theme) axes$b <- gtable_add_col_space(gtable_row("axis-b", grobs), - theme$panel.margin.x %||% theme$panel.margin) + a_theme$panel.margin.x %||% a_theme$panel.margin) # Vertical axes rows <- which(panel$layout$COL == 1) - grobs <- lapply(panel$ranges[rows], coord$render_axis_v, theme = theme) + grobs <- lapply(panel$ranges[rows], a_coord$render_axis_v, a_theme = a_theme) axes$l <- gtable_add_row_space(gtable_col("axis-l", grobs), - theme$panel.margin.y %||% theme$panel.margin) + a_theme$panel.margin.y %||% a_theme$panel.margin) axes } #' @export -facet_panels.grid <- function(facet, panel, coord, theme, geom_grobs) { +a_facet_panels.grid <- function(a_facet, panel, a_coord, a_theme, a_geom_grobs) { # If user hasn't set aspect ratio, and we have fixed scales, then # ask the coordinate system if it wants to specify one - aspect_ratio <- theme$aspect.ratio - if (is.null(aspect_ratio) && !facet$free$x && !facet$free$y) { - aspect_ratio <- coord$aspect(panel$ranges[[1]]) + aspect_ratio <- a_theme$aspect.ratio + if (is.null(aspect_ratio) && !a_facet$free$x && !a_facet$free$y) { + aspect_ratio <- a_coord$aspect(panel$ranges[[1]]) } if (is.null(aspect_ratio)) { aspect_ratio <- 1 @@ -363,15 +363,15 @@ facet_panels.grid <- function(facet, panel, coord, theme, geom_grobs) { nrow <- max(panel$layout$ROW) panel_grobs <- lapply(panels, function(i) { - fg <- coord$render_fg(panel$ranges[[i]], theme) - bg <- coord$render_bg(panel$ranges[[i]], theme) + fg <- a_coord$render_fg(panel$ranges[[i]], a_theme) + bg <- a_coord$render_bg(panel$ranges[[i]], a_theme) - geom_grobs <- lapply(geom_grobs, `[[`, i) + a_geom_grobs <- lapply(a_geom_grobs, `[[`, i) - if (theme$panel.ontop) { - panel_grobs <- c(geom_grobs, list(bg), list(fg)) + if (a_theme$panel.ontop) { + panel_grobs <- c(a_geom_grobs, list(bg), list(fg)) } else { - panel_grobs <- c(list(bg), geom_grobs, list(fg)) + panel_grobs <- c(list(bg), a_geom_grobs, list(fg)) } gTree(children = do.call("gList", panel_grobs)) @@ -381,18 +381,18 @@ facet_panels.grid <- function(facet, panel, coord, theme, geom_grobs) { # @kohske # Now size of each panel is calculated using PANEL$ranges, which is given by - # coord_train called by train_range. + # a_coord_train called by train_range. # So here, "scale" need not to be referred. # - # In general, panel has all information for building facet. - if (facet$space_free$x) { + # In general, panel has all information for building a_facet. + if (a_facet$space_free$x) { ps <- panel$layout$PANEL[panel$layout$ROW == 1] widths <- vapply(ps, function(i) diff(panel$ranges[[i]]$x.range), numeric(1)) panel_widths <- unit(widths, "null") } else { panel_widths <- rep(unit(1, "null"), ncol) } - if (facet$space_free$y) { + if (a_facet$space_free$y) { ps <- panel$layout$PANEL[panel$layout$COL == 1] heights <- vapply(ps, function(i) diff(panel$ranges[[i]]$y.range), numeric(1)) panel_heights <- unit(heights, "null") @@ -401,15 +401,15 @@ facet_panels.grid <- function(facet, panel, coord, theme, geom_grobs) { } panels <- gtable_matrix("panel", panel_matrix, - panel_widths, panel_heights, respect = respect) - panels <- gtable_add_col_space(panels, theme$panel.margin.x %||% theme$panel.margin) - panels <- gtable_add_row_space(panels, theme$panel.margin.y %||% theme$panel.margin) + panel_widths, panel_heights, respect = respect) + panels <- gtable_add_col_space(panels, a_theme$panel.margin.x %||% a_theme$panel.margin) + panels <- gtable_add_row_space(panels, a_theme$panel.margin.y %||% a_theme$panel.margin) panels } #' @export -facet_vars.grid <- function(facet) { - paste(lapply(list(facet$rows, facet$cols), paste, collapse = ", "), - collapse = " ~ ") +a_facet_vars.grid <- function(a_facet) { + paste(lapply(list(a_facet$rows, a_facet$cols), paste, collapse = ", "), + collapse = " ~ ") } diff --git a/R/facet-labels.r b/R/facet-labels.r index b75e812a46..092571ca68 100644 --- a/R/facet-labels.r +++ b/R/facet-labels.r @@ -6,16 +6,16 @@ #' such as \code{~first + second}) should be displayed on a single #' line separated with commas, or each on their own line. #' -#' \code{label_value()} only displays the value of a factor while -#' \code{label_both()} displays both the variable name and the factor -#' value. \code{label_context()} is context-dependent and uses -#' \code{label_value()} for single factor facetting and -#' \code{label_both()} when multiple factors are -#' involved. \code{label_wrap_gen()} uses \code{\link[base]{strwrap}()} +#' \code{a_label_value()} only displays the value of a factor while +#' \code{a_label_both()} displays both the variable name and the factor +#' value. \code{a_label_context()} is context-dependent and uses +#' \code{a_label_value()} for single factor facetting and +#' \code{a_label_both()} when multiple factors are +#' involved. \code{a_label_wrap_gen()} uses \code{\link[base]{strwrap}()} #' for line wrapping. #' -#' \code{label_parsed()} interprets the labels as plotmath -#' expressions. \code{\link{label_bquote}()} offers a more flexible +#' \code{a_label_parsed()} interprets the labels as plotmath +#' expressions. \code{\link{a_label_bquote}()} offers a more flexible #' way of constructing plotmath expressions. See examples and #' \code{\link{bquote}()} for details on the syntax of the #' argument. @@ -47,82 +47,82 @@ #' attribute of the incoming data frame of labels. The value of this #' attribute reflects the kind of strips your labeller is dealing #' with: \code{"cols"} for columns and \code{"rows"} for rows. Note -#' that \code{\link{facet_wrap}()} has columns by default and rows +#' that \code{\link{a_facet_wrap}()} has columns by default and rows #' when the strips are switched with the \code{switch} option. The -#' \code{facet} attribute also provides metadata on the labels. It +#' \code{a_facet} attribute also provides metadata on the labels. It #' takes the values \code{"grid"} or \code{"wrap"}. #' #' For compatibility with \code{\link{labeller}()}, each labeller #' function must have the \code{labeller} S3 class. #' -#' @param labels Data frame of labels. Usually contains only one +#' @param a_labels Data frame of labels. Usually contains only one #' element, but facetting over multiple factors entails multiple #' label variables. #' @param multi_line Whether to display the labels of multiple factors #' on separate lines. #' @param sep String separating variables and values. #' @param width Maximum number of characters before wrapping the strip. -#' @family facet +#' @family a_facet #' @seealso \code{\link{labeller}()}, \code{\link{as_labeller}()}, -#' \code{\link{label_bquote}()} +#' \code{\link{a_label_bquote}()} #' @name labellers #' @examples #' mtcars$cyl2 <- factor(mtcars$cyl, labels = c("alpha", "beta", "gamma")) -#' p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() +#' p <- a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point() #' #' # Displaying only the values -#' p + facet_grid(. ~ cyl) -#' p + facet_grid(. ~ cyl, labeller = label_value) +#' p + ggplot2Animint:::a_facet_grid(. ~ cyl) +#' p + ggplot2Animint:::a_facet_grid(. ~ cyl, labeller = a_label_value) #' #' \donttest{ #' # Displaying both the values and the variables -#' p + facet_grid(. ~ cyl, labeller = label_both) +#' p + facet_grid(. ~ cyl, labeller = a_label_both) #' #' # Displaying only the values or both the values and variables #' # depending on whether multiple factors are facetted over -#' p + facet_grid(am ~ vs+cyl, labeller = label_context) +#' p + facet_grid(am ~ vs+cyl, labeller = a_label_context) #' #' # Interpreting the labels as plotmath expressions #' p + facet_grid(. ~ cyl2) -#' p + facet_grid(. ~ cyl2, labeller = label_parsed) -#' p + facet_wrap(~vs + cyl2, labeller = label_parsed) +#' p + facet_grid(. ~ cyl2, labeller = a_label_parsed) +#' p + facet_wrap(~vs + cyl2, labeller = a_label_parsed) #' } NULL -collapse_labels_lines <- function(labels) { - out <- do.call("Map", c(list(paste, sep = ", "), labels)) +collapse_labels_lines <- function(a_labels) { + out <- do.call("Map", c(list(paste, sep = ", "), a_labels)) list(unname(unlist(out))) } #' @rdname labellers #' @export -label_value <- function(labels, multi_line = TRUE) { - labels <- lapply(labels, as.character) +a_label_value <- function(a_labels, multi_line = TRUE) { + a_labels <- lapply(a_labels, as.character) if (multi_line) { - labels + a_labels } else { - collapse_labels_lines(labels) + collapse_labels_lines(a_labels) } } # Should ideally not have the 'function' class here, but this is # currently needed for Roxygen -class(label_value) <- c("function", "labeller") +class(a_label_value) <- c("function", "labeller") -# Helper for label_both -label_variable <- function(labels, multi_line = TRUE) { +# Helper for a_label_both +a_label_variable <- function(a_labels, multi_line = TRUE) { if (multi_line) { - row <- as.list(names(labels)) + row <- as.list(names(a_labels)) } else { - row <- list(paste(names(labels), collapse = ", ")) + row <- list(paste(names(a_labels), collapse = ", ")) } - lapply(row, rep, nrow(labels) %||% length(labels[[1]])) + lapply(row, rep, nrow(a_labels) %||% length(a_labels[[1]])) } #' @rdname labellers #' @export -label_both <- function(labels, multi_line = TRUE, sep = ": ") { - value <- label_value(labels, multi_line = multi_line) - variable <- label_variable(labels, multi_line = multi_line) +a_label_both <- function(a_labels, multi_line = TRUE, sep = ": ") { + value <- a_label_value(a_labels, multi_line = multi_line) + variable <- a_label_variable(a_labels, multi_line = multi_line) if (multi_line) { out <- vector("list", length(value)) @@ -138,37 +138,37 @@ label_both <- function(labels, multi_line = TRUE, sep = ": ") { out } -class(label_both) <- c("function", "labeller") +class(a_label_both) <- c("function", "labeller") #' @rdname labellers #' @export -label_context <- function(labels, multi_line = TRUE, sep = ": ") { - if (length(labels) == 1) { - label_value(labels, multi_line) +a_label_context <- function(a_labels, multi_line = TRUE, sep = ": ") { + if (length(a_labels) == 1) { + a_label_value(a_labels, multi_line) } else { - label_both(labels, multi_line) + a_label_both(a_labels, multi_line) } } -class(label_context) <- c("function", "labeller") +class(a_label_context) <- c("function", "labeller") #' @rdname labellers #' @export -label_parsed <- function(labels, multi_line = TRUE) { - labels <- label_value(labels, multi_line = multi_line) +a_label_parsed <- function(a_labels, multi_line = TRUE) { + a_labels <- a_label_value(a_labels, multi_line = multi_line) if (multi_line) { # Using unname() and c() to return a cleaner and easily testable # object structure - lapply(unname(labels), lapply, function(values) { + lapply(unname(a_labels), lapply, function(values) { c(parse(text = as.character(values))) }) } else { - lapply(labels, function(values) { + lapply(a_labels, function(values) { values <- paste0("list(", values, ")") lapply(values, function(expr) c(parse(text = expr))) }) } } -class(label_parsed) <- c("function", "labeller") +class(a_label_parsed) <- c("function", "labeller") find_names <- function(expr) { if (is.call(expr)) { @@ -180,7 +180,7 @@ find_names <- function(expr) { #' Backquoted labeller #' -#' \code{\link{label_bquote}()} offers a flexible way of labelling +#' \code{\link{a_label_bquote}()} offers a flexible way of labelling #' facet rows or columns with plotmath expressions. Backquoted #' variables will be replaced with their value in the facet. #' @param rows Backquoted labelling expression for rows. @@ -192,20 +192,20 @@ find_names <- function(expr) { #' @examples #' # The variables mentioned in the plotmath expression must be #' # backquoted and referred to by their names. -#' p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() -#' p + facet_grid(vs ~ ., labeller = label_bquote(alpha ^ .(vs))) -#' p + facet_grid(. ~ vs, labeller = label_bquote(cols = .(vs) ^ .(vs))) -#' p + facet_grid(. ~ vs + am, labeller = label_bquote(cols = .(am) ^ .(vs))) -label_bquote <- function(rows = NULL, cols = NULL, - default = label_value) { +#' p <- a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point() +#' p + ggplot2Animint:::a_facet_grid(vs ~ ., labeller = a_label_bquote(alpha ^ .(vs))) +#' p + ggplot2Animint:::a_facet_grid(. ~ vs, labeller = a_label_bquote(cols = .(vs) ^ .(vs))) +#' p + ggplot2Animint:::a_facet_grid(. ~ vs + am, labeller = a_label_bquote(cols = .(am) ^ .(vs))) +a_label_bquote <- function(rows = NULL, cols = NULL, + default = a_label_value) { cols_quoted <- substitute(cols) rows_quoted <- substitute(rows) has_warned <- FALSE - fun <- function(labels) { - quoted <- resolve_labeller(rows_quoted, cols_quoted, labels) + fun <- function(a_labels) { + quoted <- resolve_labeller(rows_quoted, cols_quoted, a_labels) if (is.null(quoted)) { - return(label_value(labels)) + return(a_label_value(a_labels)) } evaluate <- function(...) { @@ -226,7 +226,7 @@ label_bquote <- function(rows = NULL, cols = NULL, eval(substitute(bquote(expr, params), list(expr = quoted))) } - list(do.call("Map", c(list(f = evaluate), labels))) + list(do.call("Map", c(list(f = evaluate), a_labels))) } structure(fun, class = "labeller") @@ -234,11 +234,11 @@ label_bquote <- function(rows = NULL, cols = NULL, globalVariables(c("x", ".")) #' @rdname labellers -#' @export -label_wrap_gen <- function(width = 25, multi_line = TRUE) { - fun <- function(labels) { - labels <- label_value(labels, multi_line = multi_line) - lapply(labels, function(x) { +#' @keywords internal +a_label_wrap_gen <- function(width = 25, multi_line = TRUE) { + fun <- function(a_labels) { + a_labels <- a_label_value(a_labels, multi_line = multi_line) + lapply(a_labels, function(x) { x <- strwrap(x, width = width, simplify = FALSE) vapply(x, paste, character(1), collapse = "\n") }) @@ -248,18 +248,18 @@ label_wrap_gen <- function(width = 25, multi_line = TRUE) { is_labeller <- function(x) inherits(x, "labeller") -resolve_labeller <- function(rows, cols, labels) { +resolve_labeller <- function(rows, cols, a_labels) { if (is.null(cols) && is.null(rows)) { stop("Supply one of rows or cols", call. = FALSE) } - if (attr(labels, "facet") == "wrap") { + if (attr(a_labels, "a_facet") == "wrap") { # Return either rows or cols for facet_wrap() if (!is.null(cols) && !is.null(rows)) { - stop("Cannot supply both rows and cols to facet_wrap()", call. = FALSE) + stop("Cannot supply both rows and cols to a_facet_wrap()", call. = FALSE) } cols %||% rows } else { - if (attr(labels, "type") == "rows") { + if (attr(a_labels, "type") == "rows") { rows } else { cols @@ -283,25 +283,25 @@ resolve_labeller <- function(rows, cols, labels) { #' @seealso \code{\link{labeller}()}, \link{labellers} #' @export #' @examples -#' p <- ggplot(mtcars, aes(disp, drat)) + geom_point() -#' p + facet_wrap(~am) +#' p <- a_plot(mtcars, a_aes(disp, drat)) + a_geom_point() +#' p + ggplot2Animint:::a_facet_wrap(~am) #' #' # Rename labels on the fly with a lookup character vector #' to_string <- as_labeller(c(`0` = "Zero", `1` = "One")) -#' p + facet_wrap(~am, labeller = to_string) +#' p + ggplot2Animint:::a_facet_wrap(~am, labeller = to_string) #' #' # Quickly transform a function operating on character vectors to a #' # labeller function: #' appender <- function(string, suffix = "-foo") paste0(string, suffix) -#' p + facet_wrap(~am, labeller = as_labeller(appender)) +#' p + ggplot2Animint:::a_facet_wrap(~am, labeller = as_labeller(appender)) #' #' # If you have more than one facetting variable, be sure to dispatch #' # your labeller to the right variable with labeller() -#' p + facet_grid(cyl ~ am, labeller = labeller(am = to_string)) -as_labeller <- function(x, default = label_value, multi_line = TRUE) { +#' p + ggplot2Animint:::a_facet_grid(cyl ~ am, labeller = labeller(am = to_string)) +as_labeller <- function(x, default = a_label_value, multi_line = TRUE) { force(x) - fun <- function(labels) { - labels <- lapply(labels, as.character) + fun <- function(a_labels) { + a_labels <- lapply(a_labels, as.character) # Dispatch multi_line argument to the labeller function instead of # supplying it to the labeller call because some labellers do not @@ -310,13 +310,13 @@ as_labeller <- function(x, default = label_value, multi_line = TRUE) { if (is_labeller(x)) { x <- dispatch_args(x, multi_line = multi_line) - x(labels) + x(a_labels) } else if (is.function(x)) { - default(lapply(labels, x)) + default(lapply(a_labels, x)) } else if (is.character(x)) { - default(lapply(labels, function(label) x[label])) + default(lapply(a_labels, function(a_label) x[a_label])) } else { - default(labels) + default(a_labels) } } structure(fun, class = "labeller") @@ -352,29 +352,29 @@ as_labeller <- function(x, default = label_value, multi_line = TRUE) { #' function. #' @param .default Default labeller for variables not specified. Also #' used with lookup tables or non-labeller functions. -#' @family facet labeller +#' @family a_facet labeller #' @seealso \code{\link{as_labeller}()}, \link{labellers} -#' @return A labeller function to supply to \code{\link{facet_grid}} +#' @return A labeller function to supply to \code{\link{a_facet_grid}} #' for the argument \code{labeller}. #' @export #' @examples #' \donttest{ -#' p1 <- ggplot(mtcars, aes(x = mpg, y = wt)) + geom_point() +#' p1 <- a_plot(mtcars, a_aes(x = mpg, y = wt)) + a_geom_point() #' #' # You can assign different labellers to variables: #' p1 + facet_grid(vs + am ~ gear, -#' labeller = labeller(vs = label_both, am = label_value)) +#' labeller = labeller(vs = a_label_both, am = a_label_value)) #' #' # Or whole margins: #' p1 + facet_grid(vs + am ~ gear, -#' labeller = labeller(.rows = label_both, .cols = label_value)) +#' labeller = labeller(.rows = a_label_both, .cols = a_label_value)) #' #' # You can supply functions operating on strings: #' capitalize <- function(string) { #' substr(string, 1, 1) <- toupper(substr(string, 1, 1)) #' string #' } -#' p2 <- ggplot(msleep, aes(x = sleep_total, y = awake)) + geom_point() +#' p2 <- a_plot(msleep, a_aes(x = sleep_total, y = awake)) + a_geom_point() #' p2 + facet_grid(vore ~ conservation, labeller = labeller(vore = capitalize)) #' #' # Or use character vectors as lookup tables: @@ -401,7 +401,7 @@ as_labeller <- function(x, default = label_value, multi_line = TRUE) { #' p2 %+% msleep + facet_grid(vore ~ conservation2) #' p2 %+% msleep + #' facet_grid(vore ~ conservation2, -#' labeller = labeller(conservation2 = label_wrap_gen(10)) +#' labeller = labeller(conservation2 = a_label_wrap_gen(10)) #' ) #' #' # labeller() is especially useful to act as a global labeller. You @@ -411,8 +411,8 @@ as_labeller <- function(x, default = label_value, multi_line = TRUE) { #' global_labeller <- labeller( #' vore = capitalize, #' conservation = conservation_status, -#' conservation2 = label_wrap_gen(10), -#' .default = label_both +#' conservation2 = a_label_wrap_gen(10), +#' .default = a_label_both #' ) #' #' p2 + facet_grid(vore ~ conservation, labeller = global_labeller) @@ -421,16 +421,16 @@ as_labeller <- function(x, default = label_value, multi_line = TRUE) { #' } labeller <- function(..., .rows = NULL, .cols = NULL, keep.as.numeric = NULL, .multi_line = TRUE, - .default = label_value) { + .default = a_label_value) { if (!is.null(keep.as.numeric)) { .Deprecated(old = "keep.as.numeric") } dots <- list(...) .default <- as_labeller(.default) - function(labels) { + function(a_labels) { if (!is.null(.rows) || !is.null(.cols)) { - margin_labeller <- resolve_labeller(.rows, .cols, labels) + margin_labeller <- resolve_labeller(.rows, .cols, a_labels) } else { margin_labeller <- NULL } @@ -443,8 +443,8 @@ labeller <- function(..., .rows = NULL, .cols = NULL, # Check that variable-specific labellers do not overlap with # margin-wide labeller - if (any(names(dots) %in% names(labels))) { - stop("Conflict between .", attr(labels, "type"), " and ", + if (any(names(dots) %in% names(a_labels))) { + stop("Conflict between .", attr(a_labels, "type"), " and ", paste(names(dots), collapse = ", "), call. = FALSE) } } @@ -452,33 +452,41 @@ labeller <- function(..., .rows = NULL, .cols = NULL, # Apply relevant labeller if (is.null(margin_labeller)) { # Apply named labeller one by one - out <- lapply(names(labels), function(label) { - if (label %in% names(labellers)) { - labellers[[label]](labels[label])[[1]] + out <- lapply(names(a_labels), function(a_label) { + if (a_label %in% names(labellers)) { + labellers[[a_label]](a_labels[a_label])[[1]] } else { - .default(labels[label])[[1]] + .default(a_labels[a_label])[[1]] } }) - names(out) <- names(labels) + names(out) <- names(a_labels) if (.multi_line) { out } else { collapse_labels_lines(out) } } else { - margin_labeller(labels) + margin_labeller(a_labels) } } } - -build_strip <- function(panel, label_df, labeller, theme, side = "right", switch = NULL) { +#' a_build strip function +#' @param panel .... +#' @param a_label_df .... +#' @param labeller .... +#' @param a_theme ..... +#' @param side ..... +#' @param switch .... +#' @export +## TODO: define params in detail +a_build_strip <- function(panel, a_label_df, labeller, a_theme, side = "right", switch = NULL) { side <- match.arg(side, c("top", "left", "bottom", "right")) horizontal <- side %in% c("top", "bottom") labeller <- match.fun(labeller) # No labelling data, so return empty row/col - if (empty(label_df)) { + if (empty(a_label_df)) { if (horizontal) { widths <- unit(rep(0, max(panel$layout$COL)), "null") return(gtable_row_spacer(widths)) @@ -489,16 +497,16 @@ build_strip <- function(panel, label_df, labeller, theme, side = "right", switch } # Create matrix of labels - labels <- lapply(labeller(label_df), cbind) - labels <- do.call("cbind", labels) + a_labels <- lapply(labeller(a_label_df), cbind) + a_labels <- do.call("cbind", a_labels) - # Display the mirror of the y strip labels if switched + # Display the mirror of the y strip a_labels if switched if (!is.null(switch) && switch %in% c("both", "y")) { - theme$strip.text.y$angle <- adjust_angle(theme$strip.text.y$angle) + a_theme$strip.text.y$angle <- adjust_angle(a_theme$strip.text.y$angle) } # Render as grobs - grobs <- apply(labels, c(1, 2), ggstrip, theme = theme, + grobs <- apply(a_labels, c(1, 2), ggstrip, a_theme = a_theme, horizontal = horizontal) # Create layout @@ -519,28 +527,28 @@ build_strip <- function(panel, label_df, labeller, theme, side = "right", switch } # Grob for strip labels -ggstrip <- function(text, horizontal = TRUE, theme) { - text_theme <- if (horizontal) "strip.text.x" else "strip.text.y" +ggstrip <- function(text, horizontal = TRUE, a_theme) { + text_a_theme <- if (horizontal) "strip.text.x" else "strip.text.y" if (is.list(text)) text <- text[[1]] - element <- calc_element(text_theme, theme) - if (inherits(element, "element_blank")) - return(zeroGrob()) + a_element <- a_calc_element(text_a_theme, a_theme) + if (inherits(a_element, "a_element_blank")) + return(a_zeroGrob()) - gp <- gpar(fontsize = element$size, col = element$colour, - fontfamily = element$family, fontface = element$face, - lineheight = element$lineheight) + gp <- gpar(fontsize = a_element$size, col = a_element$colour, + fontfamily = a_element$family, fontface = a_element$face, + lineheight = a_element$lineheight) - label <- stripGrob(text, element$hjust, element$vjust, element$angle, - margin = element$margin, gp = gp, debug = element$debug) + a_label <- stripGrob(text, a_element$hjust, a_element$vjust, a_element$angle, + margin = a_element$margin, gp = gp, debug = a_element$debug) ggname("strip", absoluteGrob( gList( - element_render(theme, "strip.background"), - label + a_element_render(a_theme, "strip.background"), + a_label ), - width = grobWidth(label), - height = grobHeight(label) + width = grobWidth(a_label), + height = grobHeight(a_label) )) } @@ -563,8 +571,8 @@ check_labeller <- function(labeller) { if (is_deprecated) { old_labeller <- labeller - labeller <- function(labels) { - Map(old_labeller, names(labels), labels) + labeller <- function(a_labels) { + Map(old_labeller, names(a_labels), a_labels) } warning("The labeller API has been updated. Labellers taking `variable`", "and `value` arguments are now deprecated. See labellers documentation.", diff --git a/R/facet-layout.r b/R/facet-layout.r index ef312b4a14..692f06ddcd 100644 --- a/R/facet-layout.r +++ b/R/facet-layout.r @@ -1,11 +1,15 @@ -# Layout panels in a 2d grid. -# -# @params data list of data frames, one for each layer -# @params rows variables that form the rows -# @params cols variables that form the columns -# @return a data frame with columns \code{PANEL}, \code{ROW} and \code{COL}, -# that match the facetting variable values up with their position in the -# grid +#' Layout panels in a 2d grid. +#' +#' @param data list of data frames, one for each layer +#' @param rows variables that form the rows +#' @param cols variables that form the columns +#' @param margins ...... +#' @param drop .... +#' @param as.table .... +#' @return a data frame with columns \code{PANEL}, \code{ROW} and \code{COL}, +#' that match the facetting variable values up with their position in the +#' grid +#' @export layout_grid <- function(data, rows = NULL, cols = NULL, margins = NULL, drop = TRUE, as.table = TRUE) { if (length(rows) == 0 && length(cols) == 0) return(layout_null()) @@ -39,10 +43,10 @@ layout_grid <- function(data, rows = NULL, cols = NULL, margins = NULL, panels } -# Layout out panels in a 1d ribbon. -# -# @params drop should missing combinations be excluded from the plot? -# @keywords internal +#' Layout out panels in a 1d ribbon. +#' +#' @param drop should missing combinations be excluded from the plot? +#' @keywords internal layout_wrap <- function(data, vars = NULL, nrow = NULL, ncol = NULL, as.table = TRUE, drop = TRUE, dir = "h") { vars <- as.quoted(vars) @@ -78,13 +82,13 @@ layout_null <- function() { data.frame(PANEL = 1, ROW = 1, COL = 1) } -# Base layout function that generates all combinations of data needed for -# facetting -# The first data frame in the list should be the default data for the plot. -# Other data frames in the list are ones that are added to layers. -# -# @params data list of data frames (one for each layer) -# @keywords internal +#' Base layout function that generates all combinations of data needed for +#' facetting +#' The first data frame in the list should be the default data for the plot. +#' Other data frames in the list are ones that are added to layers. +#' +#' @param data list of data frames (one for each layer) +#' @keywords internal layout_base <- function(data, vars = NULL, drop = TRUE) { if (length(vars) == 0) return(data.frame()) diff --git a/R/facet-locate.r b/R/facet-locate.r index 57483e41f1..a1ba9663a7 100644 --- a/R/facet-locate.r +++ b/R/facet-locate.r @@ -21,32 +21,32 @@ locate_grid <- function(data, panels, rows = NULL, cols = NULL, margins = FALSE) intersect(names(cols), names(data))) data <- reshape2::add_margins(data, margin_vars, margins) - facet_vals <- quoted_df(data, c(rows, cols)) + a_facet_vals <- quoted_df(data, c(rows, cols)) # If any facetting variables are missing, add them in by # duplicating the data - missing_facets <- setdiff(vars, names(facet_vals)) + missing_facets <- setdiff(vars, names(a_facet_vals)) if (length(missing_facets) > 0) { to_add <- unique(panels[missing_facets]) data_rep <- rep.int(1:nrow(data), nrow(to_add)) - facet_rep <- rep(1:nrow(to_add), each = nrow(data)) + a_facet_rep <- rep(1:nrow(to_add), each = nrow(data)) data <- plyr::unrowname(data[data_rep, , drop = FALSE]) - facet_vals <- plyr::unrowname(cbind( - facet_vals[data_rep, , drop = FALSE], - to_add[facet_rep, , drop = FALSE])) + a_facet_vals <- plyr::unrowname(cbind( + a_facet_vals[data_rep, , drop = FALSE], + to_add[a_facet_rep, , drop = FALSE])) } # Add PANEL variable - if (nrow(facet_vals) == 0) { + if (nrow(a_facet_vals) == 0) { # Special case of no facetting data$PANEL <- NO_PANEL } else { - facet_vals[] <- lapply(facet_vals[], as.factor) - facet_vals[] <- lapply(facet_vals[], addNA, ifany = TRUE) + a_facet_vals[] <- lapply(a_facet_vals[], as.factor) + a_facet_vals[] <- lapply(a_facet_vals[], addNA, ifany = TRUE) - keys <- plyr::join.keys(facet_vals, panels, by = vars) + keys <- plyr::join.keys(a_facet_vals, panels, by = vars) data$PANEL <- panels$PANEL[match(keys$x, keys$y)] } @@ -60,24 +60,24 @@ locate_wrap <- function(data, panels, vars) { } vars <- as.quoted(vars) - facet_vals <- quoted_df(data, vars) - facet_vals[] <- lapply(facet_vals[], as.factor) + a_facet_vals <- quoted_df(data, vars) + a_facet_vals[] <- lapply(a_facet_vals[], as.factor) - missing_facets <- setdiff(names(vars), names(facet_vals)) + missing_facets <- setdiff(names(vars), names(a_facet_vals)) if (length(missing_facets) > 0) { to_add <- unique(panels[missing_facets]) data_rep <- rep.int(1:nrow(data), nrow(to_add)) - facet_rep <- rep(1:nrow(to_add), each = nrow(data)) + a_facet_rep <- rep(1:nrow(to_add), each = nrow(data)) data <- plyr::unrowname(data[data_rep, , drop = FALSE]) - facet_vals <- plyr::unrowname(cbind( - facet_vals[data_rep, , drop = FALSE], - to_add[facet_rep, , drop = FALSE])) + a_facet_vals <- plyr::unrowname(cbind( + a_facet_vals[data_rep, , drop = FALSE], + to_add[a_facet_rep, , drop = FALSE])) } - keys <- plyr::join.keys(facet_vals, panels, by = names(vars)) + keys <- plyr::join.keys(a_facet_vals, panels, by = names(vars)) data$PANEL <- panels$PANEL[match(keys$x, keys$y)] data[order(data$PANEL), ] diff --git a/R/facet-null.r b/R/facet-null.r index a3205379ac..e0579c3dc1 100644 --- a/R/facet-null.r +++ b/R/facet-null.r @@ -1,24 +1,24 @@ #' Facet specification: a single panel. #' -#' @inheritParams facet_grid +#' @inheritParams a_facet_grid #' @export #' @examples #' # facet_null is the default facetting specification if you #' # don't override it with facet_grid or facet_wrap -#' ggplot(mtcars, aes(mpg, wt)) + geom_point() -facet_null <- function(shrink = TRUE) { - facet(shrink = shrink, subclass = "null") +#' a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() +a_facet_null <- function(shrink = TRUE) { + a_facet(shrink = shrink, subclass = "null") } #' @export -facet_train_layout.null <- function(facet, data) { +a_facet_train_layout.null <- function(a_facet, data) { data.frame( PANEL = 1L, ROW = 1L, COL = 1L, SCALE_X = 1L, SCALE_Y = 1L) } #' @export -facet_map_layout.null <- function(facet, data, layout) { +a_facet_map_layout.null <- function(a_facet, data, layout) { # Need the is.waive check for special case where no data, but aesthetics # are mapped to vectors if (is.waive(data) || empty(data)) @@ -28,11 +28,11 @@ facet_map_layout.null <- function(facet, data, layout) { } #' @export -facet_render.null <- function(facet, panel, coord, theme, geom_grobs) { +a_facet_render.null <- function(a_facet, panel, a_coord, a_theme, a_geom_grobs) { range <- panel$ranges[[1]] # Figure out aspect ratio - aspect_ratio <- theme$aspect.ratio %||% coord$aspect(range) + aspect_ratio <- a_theme$aspect.ratio %||% a_coord$aspect(range) if (is.null(aspect_ratio)) { aspect_ratio <- 1 respect <- FALSE @@ -40,25 +40,25 @@ facet_render.null <- function(facet, panel, coord, theme, geom_grobs) { respect <- TRUE } - fg <- coord$render_fg(range, theme) - bg <- coord$render_bg(range, theme) + fg <- a_coord$render_fg(range, a_theme) + bg <- a_coord$render_bg(range, a_theme) # Flatten layers - we know there's only one panel - geom_grobs <- lapply(geom_grobs, "[[", 1) + a_geom_grobs <- lapply(a_geom_grobs, "[[", 1) - if (theme$panel.ontop) { - panel_grobs <- c(geom_grobs, list(bg), list(fg)) + if (a_theme$panel.ontop) { + panel_grobs <- c(a_geom_grobs, list(bg), list(fg)) } else { - panel_grobs <- c(list(bg), geom_grobs, list(fg)) + panel_grobs <- c(list(bg), a_geom_grobs, list(fg)) } panel_grob <- gTree(children = do.call("gList", panel_grobs)) - axis_h <- coord$render_axis_h(range, theme) - axis_v <- coord$render_axis_v(range, theme) + axis_h <- a_coord$render_axis_h(range, a_theme) + axis_v <- a_coord$render_axis_v(range, a_theme) all <- matrix(list( axis_v, panel_grob, - zeroGrob(), axis_h + a_zeroGrob(), axis_h ), ncol = 2, byrow = TRUE) layout <- gtable_matrix("layout", all, @@ -73,4 +73,4 @@ facet_render.null <- function(facet, panel, coord, theme, geom_grobs) { } #' @export -facet_vars.null <- function(facet) "" +a_facet_vars.null <- function(a_facet) "" diff --git a/R/facet-wrap.r b/R/facet-wrap.r index 66004b1bee..29925ec867 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -2,7 +2,7 @@ #' #' Most displays are roughly rectangular, so if you have a categorical #' variable with many levels, it doesn't make sense to try and display them -#' all in one row (or one column). To solve this dilemma, \code{facet_wrap} +#' all in one row (or one column). To solve this dilemma, \code{a_facet_wrap} #' wraps a 1d sequence of panels into 2d, making best use of screen real estate. #' #' @param facets Either a formula or character vector. Use either a @@ -17,65 +17,65 @@ #' left, near the y axis. #' @param dir Direction: either "h" for horizontal, the default, or "v", for #' vertical. -#' @inheritParams facet_grid +#' @inheritParams a_facet_grid #' @export #' @examples -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + -#' facet_wrap(~class) +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point() + +#' a_facet_wrap(~class) #' #' # Control the number of rows and columns with nrow and ncol -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + -#' facet_wrap(~class, nrow = 4) +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point() + +#' a_facet_wrap(~class, nrow = 4) #' #' \donttest{ #' # You can facet by multiple variables -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + -#' facet_wrap(~ cyl + drv) +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point() + +#' a_facet_wrap(~ cyl + drv) #' # Or use a character vector: -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point() + #' facet_wrap(c("cyl", "drv")) #' #' # Use the `labeller` option to control how labels are printed: -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + -#' facet_wrap(c("cyl", "drv"), labeller = "label_both") +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point() + +#' facet_wrap(c("cyl", "drv"), labeller = "a_label_both") #' #' # To change the order in which the panels appear, change the levels #' # of the underlying factor. #' mpg$class2 <- reorder(mpg$class, mpg$displ) -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point() + #' facet_wrap(~class2) #' #' # By default, the same scales are used for all panels. You can allow #' # scales to vary across the panels with the `scales` argument. #' # Free scales make it easier to see patterns within each panel, but #' # harder to compare across panels. -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point() + #' facet_wrap(~class, scales = "free") #' #' # To repeat the same data in every panel, simply construct a data frame #' # that does not contain the facetting variable. -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point(data = transform(mpg, class = NULL), colour = "grey85") + -#' geom_point() + +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point(data = transform(mpg, class = NULL), colour = "grey85") + +#' a_geom_point() + #' facet_wrap(~class) #' #' # Use `switch` to display the facet labels near an axis, acting as #' # a subtitle for this axis. This is typically used with free scales -#' # and a theme without boxes around strip labels. -#' ggplot(economics_long, aes(date, value)) + -#' geom_line() + +#' # and a a_theme without boxes around strip labels. +#' a_plot(economics_long, a_aes(date, value)) + +#' a_geom_line() + #' facet_wrap(~variable, scales = "free_y", nrow = 2, switch = "x") + -#' theme(strip.background = element_blank()) +#' a_theme(strip.background = a_element_blank()) #' } -facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed", - shrink = TRUE, labeller = "label_value", as.table = TRUE, +a_facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed", + shrink = TRUE, labeller = "a_label_value", as.table = TRUE, switch = NULL, drop = TRUE, dir = "h") { scales <- match.arg(scales, c("fixed", "free_x", "free_y", "free")) dir <- match.arg(dir, c("h", "v")) @@ -98,7 +98,7 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed", # Check for deprecated labellers labeller <- check_labeller(labeller) - facet( + a_facet( facets = as.quoted(facets), free = free, shrink = shrink, as.table = as.table, switch = switch, drop = drop, ncol = ncol, nrow = nrow, @@ -109,51 +109,49 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed", } #' @export -facet_train_layout.wrap <- function(facet, data) { - panels <- layout_wrap(data, facet$facets, facet$nrow, facet$ncol, - facet$as.table, facet$drop, facet$dir) +a_facet_train_layout.wrap <- function(a_facet, data) { + panels <- layout_wrap(data, a_facet$facets, a_facet$nrow, a_facet$ncol, + a_facet$as.table, a_facet$drop, a_facet$dir) n <- nrow(panels) nrow <- max(panels$ROW) # Add scale identification - panels$SCALE_X <- if (facet$free$x) seq_len(n) else 1L - panels$SCALE_Y <- if (facet$free$y) seq_len(n) else 1L + panels$SCALE_X <- if (a_facet$free$x) seq_len(n) else 1L + panels$SCALE_Y <- if (a_facet$free$y) seq_len(n) else 1L # Figure out where axes should go - panels$AXIS_X <- if (facet$free$x) TRUE else panels$ROW == nrow - panels$AXIS_Y <- if (facet$free$y) TRUE else panels$COL == 1 + panels$AXIS_X <- if (a_facet$free$x) TRUE else panels$ROW == nrow + panels$AXIS_Y <- if (a_facet$free$y) TRUE else panels$COL == 1 panels } #' @export -facet_map_layout.wrap <- function(facet, data, layout) { - locate_wrap(data, layout, facet$facets) +a_facet_map_layout.wrap <- function(a_facet, data, layout) { + locate_wrap(data, layout, a_facet$facets) } # How to think about facet wrap: -# * vector of panels # * every panel has strips (strip_pos) and axes (axis_pos) # * if scales fixed, most axes empty # * combine panels, strips and axes, then wrap into 2d # * finally: add title, labels and legend -# #' @export -facet_render.wrap <- function(facet, panel, coord, theme, geom_grobs) { +a_facet_render.wrap <- function(a_facet, panel, a_coord, a_theme, a_geom_grobs) { - # If coord is (non-cartesian or flip) and (x is free or y is free) + # If a_coord is (non-cartesian or flip) and (x is free or y is free) # then print a warning - if ((!inherits(coord, "CoordCartesian") || inherits(coord, "CoordFlip")) && - (facet$free$x || facet$free$y)) { - stop("ggplot2 does not currently support free scales with a non-cartesian coord or coord_flip.\n") + if ((!inherits(a_coord, "a_CoordCartesian") || inherits(a_coord, "a_CoordFlip")) && + (a_facet$free$x || a_facet$free$y)) { + stop("ggplot2 does not currently support free scales with a non-cartesian coord or a_coord_flip.\n") } # If user hasn't set aspect ratio, and we have fixed scales, then # ask the coordinate system if it wants to specify one - aspect_ratio <- theme$aspect.ratio - if (is.null(aspect_ratio) && !facet$free$x && !facet$free$y) { - aspect_ratio <- coord$aspect(panel$ranges[[1]]) + aspect_ratio <- a_theme$aspect.ratio + if (is.null(aspect_ratio) && !a_facet$free$x && !a_facet$free$y) { + aspect_ratio <- a_coord$aspect(panel$ranges[[1]]) } if (is.null(aspect_ratio)) { @@ -171,18 +169,18 @@ facet_render.wrap <- function(facet, panel, coord, theme, geom_grobs) { # Set switch to default value when misspecified switch_to_x <- FALSE switch_to_y <- FALSE - if (!is.null(facet$switch) && facet$switch == "x") { + if (!is.null(a_facet$switch) && a_facet$switch == "x") { switch_to_x <- TRUE - } else if (!is.null(facet$switch) && facet$switch == "y") { + } else if (!is.null(a_facet$switch) && a_facet$switch == "y") { switch_to_y <- TRUE - } else if (!is.null(facet$switch)) { + } else if (!is.null(a_facet$switch)) { message("`switch` must be set to 'x', 'y' or NULL") - facet$switch <- NULL + a_facet$switch <- NULL } - panels <- facet_panels(facet, panel, coord, theme, geom_grobs) - axes <- facet_axes(facet, panel, coord, theme) - strips <- facet_strips(facet, panel, theme) + panels <- a_facet_panels(a_facet, panel, a_coord, a_theme, a_geom_grobs) + axes <- a_facet_axes(a_facet, panel, a_coord, a_theme) + strips <- a_facet_strips(a_facet, panel, a_theme) # Should become facet_arrange_grobs @@ -234,7 +232,7 @@ facet_render.wrap <- function(facet, panel, coord, theme, geom_grobs) { # If strips are switched, add padding if (switch_to_x) { - padding <- convertUnit(theme$strip.switch.pad.wrap, "cm") + padding <- convertUnit(a_theme$strip.switch.pad.wrap, "cm") add_padding <- function(strip) { gt_t <- gtable_row("strip_t", list(strip), @@ -255,7 +253,7 @@ facet_render.wrap <- function(facet, panel, coord, theme, geom_grobs) { size <- c(3, 4) } else if (switch_to_y) { - padding <- convertUnit(theme$strip.switch.pad.wrap, "cm") + padding <- convertUnit(a_theme$strip.switch.pad.wrap, "cm") add_padding <- function(strip) { gt_t <- gtable_col("strip_t", list(strip), @@ -289,13 +287,13 @@ facet_render.wrap <- function(facet, panel, coord, theme, geom_grobs) { widths <- list( axis_l = width_cm(grobs$axis_l), strip_t = strip_width, - vspace = ifelse(layout$COL == ncol, 0, width_cm(theme$panel.margin.x %||% theme$panel.margin)) + vspace = ifelse(layout$COL == ncol, 0, width_cm(a_theme$panel.margin.x %||% a_theme$panel.margin)) ) heights <- list( panel = unit(aspect_ratio, "null"), strip_t = strip_height, axis_b = height_cm(grobs$axis_b), - hspace = ifelse(layout$ROW == nrow, 0, height_cm(theme$panel.margin.y %||% theme$panel.margin)) + hspace = ifelse(layout$ROW == nrow, 0, height_cm(a_theme$panel.margin.y %||% a_theme$panel.margin)) ) # Remove strip_t according to which strips are switched @@ -320,18 +318,18 @@ facet_render.wrap <- function(facet, panel, coord, theme, geom_grobs) { } #' @export -facet_panels.wrap <- function(facet, panel, coord, theme, geom_grobs) { +a_facet_panels.wrap <- function(a_facet, panel, a_coord, a_theme, a_geom_grobs) { panels <- panel$layout$PANEL lapply(panels, function(i) { - fg <- coord$render_fg(panel$ranges[[i]], theme) - bg <- coord$render_bg(panel$ranges[[i]], theme) + fg <- a_coord$render_fg(panel$ranges[[i]], a_theme) + bg <- a_coord$render_bg(panel$ranges[[i]], a_theme) - geom_grobs <- lapply(geom_grobs, "[[", i) + a_geom_grobs <- lapply(a_geom_grobs, "[[", i) - if (theme$panel.ontop) { - panel_grobs <- c(geom_grobs, list(bg), list(fg)) + if (a_theme$panel.ontop) { + panel_grobs <- c(a_geom_grobs, list(bg), list(fg)) } else { - panel_grobs <- c(list(bg), geom_grobs, list(fg)) + panel_grobs <- c(list(bg), a_geom_grobs, list(fg)) } ggname(paste("panel", i, sep = "-"), @@ -340,23 +338,23 @@ facet_panels.wrap <- function(facet, panel, coord, theme, geom_grobs) { } #' @export -facet_strips.wrap <- function(facet, panel, theme) { - labels_df <- panel$layout[names(facet$facets)] +a_facet_strips.wrap <- function(a_facet, panel, a_theme) { + a_labels_df <- panel$layout[names(a_facet$facets)] # Adding labels metadata, useful for labellers - attr(labels_df, "facet") <- "wrap" - if (is.null(facet$switch) || facet$switch == "x") { + attr(a_labels_df, "a_facet") <- "wrap" + if (is.null(a_facet$switch) || a_facet$switch == "x") { dir <- "b" - attr(labels_df, "type") <- "rows" + attr(a_labels_df, "type") <- "rows" } else { dir <- "l" - attr(labels_df, "type") <- "cols" + attr(a_labels_df, "type") <- "cols" } - strips_table <- build_strip(panel, labels_df, facet$labeller, - theme, dir, switch = facet$switch) + strips_table <- a_build_strip(panel, a_labels_df, a_facet$labeller, + a_theme, dir, switch = a_facet$switch) - # While grid facetting works with a whole gtable, wrap processes the + # While grid a_facetting works with a whole gtable, wrap processes the # strips separately. So we turn the gtable into a list if (dir == "b") { n_strips <- ncol(strips_table) @@ -377,24 +375,24 @@ facet_strips.wrap <- function(facet, panel, theme) { #' @export -facet_axes.wrap <- function(facet, panel, coord, theme) { +a_facet_axes.wrap <- function(a_facet, panel, a_coord, a_theme) { panels <- panel$layout$PANEL axes <- list() axes$b <- lapply(panels, function(i) { if (panel$layout$AXIS_X[i]) { - grob <- coord$render_axis_h(panel$ranges[[i]], theme) + grob <- a_coord$render_axis_h(panel$ranges[[i]], a_theme) } else { - grob <- zeroGrob() + grob <- a_zeroGrob() } ggname(paste("axis-b-", i, sep = ""), grob) }) axes$l <- lapply(panels, function(i) { if (panel$layout$AXIS_Y[i]) { - grob <- coord$render_axis_v(panel$ranges[[i]], theme) + grob <- a_coord$render_axis_v(panel$ranges[[i]], a_theme) } else { - grob <- zeroGrob() + grob <- a_zeroGrob() } ggname(paste("axis-l-", i, sep = ""), grob) }) @@ -403,15 +401,15 @@ facet_axes.wrap <- function(facet, panel, coord, theme) { } #' @export -facet_vars.wrap <- function(facet) { - paste(lapply(facet$facets, paste, collapse = ", "), collapse = " ~ ") +a_facet_vars.wrap <- function(a_facet) { + paste(lapply(a_facet$facets, paste, collapse = ", "), collapse = " ~ ") } #' Sanitise the number of rows or columns #' #' Cleans up the input to be an integer greater than or equal to one, or #' \code{NULL}. Intended to be used on the \code{nrow} and \code{ncol} -#' arguments of \code{facet_wrap}. +#' arguments of \code{a_facet_wrap}. #' @param n Hopefully an integer greater than or equal to one, or \code{NULL}, #' though other inputs are handled. #' @return An integer greater than or equal to one, or \code{NULL}. diff --git a/R/fortify-lm.r b/R/fortify-lm.r index 574a834b38..1b19b8e999 100644 --- a/R/fortify-lm.r +++ b/R/fortify-lm.r @@ -17,62 +17,62 @@ #' @export #' @examples #' mod <- lm(mpg ~ wt, data = mtcars) -#' head(fortify(mod)) -#' head(fortify(mod, mtcars)) +#' head(a_fortify(mod)) +#' head(a_fortify(mod, mtcars)) #' #' plot(mod, which = 1) #' -#' ggplot(mod, aes(.fitted, .resid)) + -#' geom_point() + -#' geom_hline(yintercept = 0) + -#' geom_smooth(se = FALSE) +#' a_plot(mod, a_aes(.fitted, .resid)) + +#' a_geom_point() + +#' a_geom_hline(yintercept = 0) + +#' a_geom_smooth(se = FALSE) #' -#' ggplot(mod, aes(.fitted, .stdresid)) + -#' geom_point() + -#' geom_hline(yintercept = 0) + -#' geom_smooth(se = FALSE) +#' a_plot(mod, a_aes(.fitted, .stdresid)) + +#' a_geom_point() + +#' a_geom_hline(yintercept = 0) + +#' a_geom_smooth(se = FALSE) #' -#' ggplot(fortify(mod, mtcars), aes(.fitted, .stdresid)) + -#' geom_point(aes(colour = factor(cyl))) +#' a_plot(a_fortify(mod, mtcars), a_aes(.fitted, .stdresid)) + +#' a_geom_point(a_aes(colour = factor(cyl))) #' -#' ggplot(fortify(mod, mtcars), aes(mpg, .stdresid)) + -#' geom_point(aes(colour = factor(cyl))) +#' a_plot(a_fortify(mod, mtcars), a_aes(mpg, .stdresid)) + +#' a_geom_point(a_aes(colour = factor(cyl))) #' #' plot(mod, which = 2) -#' ggplot(mod) + -#' stat_qq(aes(sample = .stdresid)) + -#' geom_abline() +#' a_plot(mod) + +#' a_stat_qq(a_aes(sample = .stdresid)) + +#' a_geom_abline() #' #' plot(mod, which = 3) -#' ggplot(mod, aes(.fitted, sqrt(abs(.stdresid)))) + -#' geom_point() + -#' geom_smooth(se = FALSE) +#' a_plot(mod, a_aes(.fitted, sqrt(abs(.stdresid)))) + +#' a_geom_point() + +#' a_geom_smooth(se = FALSE) #' #' plot(mod, which = 4) -#' ggplot(mod, aes(seq_along(.cooksd), .cooksd)) + -#' geom_bar(stat = "identity") +#' a_plot(mod, a_aes(seq_along(.cooksd), .cooksd)) + +#' a_geom_bar(a_stat = "identity") #' #' plot(mod, which = 5) -#' ggplot(mod, aes(.hat, .stdresid)) + -#' geom_vline(size = 2, colour = "white", xintercept = 0) + -#' geom_hline(size = 2, colour = "white", yintercept = 0) + -#' geom_point() + geom_smooth(se = FALSE) +#' a_plot(mod, a_aes(.hat, .stdresid)) + +#' a_geom_vline(size = 2, colour = "white", xintercept = 0) + +#' a_geom_hline(size = 2, colour = "white", yintercept = 0) + +#' a_geom_point() + a_geom_smooth(se = FALSE) #' -#' ggplot(mod, aes(.hat, .stdresid)) + -#' geom_point(aes(size = .cooksd)) + -#' geom_smooth(se = FALSE, size = 0.5) +#' a_plot(mod, a_aes(.hat, .stdresid)) + +#' a_geom_point(a_aes(size = .cooksd)) + +#' a_geom_smooth(se = FALSE, size = 0.5) #' #' plot(mod, which = 6) -#' ggplot(mod, aes(.hat, .cooksd)) + -#' geom_vline(xintercept = 0, colour = NA) + -#' geom_abline(slope = seq(0, 3, by = 0.5), colour = "white") + -#' geom_smooth(se = FALSE) + -#' geom_point() +#' a_plot(mod, a_aes(.hat, .cooksd)) + +#' a_geom_vline(xintercept = 0, colour = NA) + +#' a_geom_abline(slope = seq(0, 3, by = 0.5), colour = "white") + +#' a_geom_smooth(se = FALSE) + +#' a_geom_point() #' -#' ggplot(mod, aes(.hat, .cooksd)) + -#' geom_point(aes(size = .cooksd / .hat)) + -#' scale_size_area() -fortify.lm <- function(model, data = model$model, ...) { +#' a_plot(mod, a_aes(.hat, .cooksd)) + +#' a_geom_point(a_aes(size = .cooksd / .hat)) + +#' a_scale_size_area() +a_fortify.lm <- function(model, data = model$model, ...) { infl <- stats::influence(model, do.coef = FALSE) data$.hat <- infl$hat data$.sigma <- infl$sigma diff --git a/R/fortify-map.r b/R/fortify-map.r index 858bedd19e..5f2d99b381 100644 --- a/R/fortify-map.r +++ b/R/fortify-map.r @@ -11,16 +11,16 @@ #' @examples #' if (require("maps")) { #' ca <- map("county", "ca", plot = FALSE, fill = TRUE) -#' head(fortify(ca)) -#' ggplot(ca, aes(long, lat)) + -#' geom_polygon(aes(group = group)) +#' head(a_fortify(ca)) +#' a_plot(ca, a_aes(long, lat)) + +#' a_geom_polygon(a_aes(group = group)) #' #' tx <- map("county", "texas", plot = FALSE, fill = TRUE) -#' head(fortify(tx)) -#' ggplot(tx, aes(long, lat)) + -#' geom_polygon(aes(group = group), colour = "white") +#' head(a_fortify(tx)) +#' a_plot(tx, a_aes(long, lat)) + +#' a_geom_polygon(a_aes(group = group), colour = "white") #' } -fortify.map <- function(model, data, ...) { +a_fortify.map <- function(model, data, ...) { df <- as.data.frame(model[c("x", "y")]) names(df) <- c("long", "lat") df$group <- cumsum(is.na(df$long) & is.na(df$lat)) + 1 @@ -55,17 +55,17 @@ fortify.map <- function(model, data, ...) { #' #' choro <- merge(states, arrests, sort = FALSE, by = "region") #' choro <- choro[order(choro$order), ] -#' ggplot(choro, aes(long, lat)) + -#' geom_polygon(aes(group = group, fill = assault)) + -#' coord_map("albers", at0 = 45.5, lat1 = 29.5) +#' a_plot(choro, a_aes(long, lat)) + +#' a_geom_polygon(a_aes(group = group, fill = assault)) + +#' ggplot2Animint:::a_coord_map("albers", at0 = 45.5, lat1 = 29.5) #' -#' ggplot(choro, aes(long, lat)) + -#' geom_polygon(aes(group = group, fill = assault / murder)) + -#' coord_map("albers", at0 = 45.5, lat1 = 29.5) +#' a_plot(choro, a_aes(long, lat)) + +#' a_geom_polygon(a_aes(group = group, fill = assault / murder)) + +#' ggplot2Animint:::a_coord_map("albers", at0 = 45.5, lat1 = 29.5) #' } map_data <- function(map, region = ".", exact = FALSE, ...) { try_require("maps", "map_data") - fortify(map(map, region, exact = exact, plot = FALSE, fill = TRUE, ...)) + a_fortify(map(map, region, exact = exact, plot = FALSE, fill = TRUE, ...)) } #' Create a layer of map borders. @@ -76,36 +76,36 @@ map_data <- function(map, region = ".", exact = FALSE, ...) { #' @param colour border colour #' @param xlim,ylim latitudinal and logitudinal range for extracting map #' polygons, see \code{\link[maps]{map}} for details. -#' @param ... other arguments passed onto \code{\link{geom_polygon}} -#' @export +#' @param ... other arguments passed onto \code{\link{a_geom_polygon}} +#' @keywords internal #' @examples #' if (require("maps")) { #' #' ia <- map_data("county", "iowa") #' mid_range <- function(x) mean(range(x)) #' seats <- plyr::ddply(ia, "subregion", plyr::colwise(mid_range, c("lat", "long"))) -#' ggplot(ia, aes(long, lat)) + -#' geom_polygon(aes(group = group), fill = NA, colour = "grey60") + -#' geom_text(aes(label = subregion), data = seats, size = 2, angle = 45) +#' a_plot(ia, a_aes(long, lat)) + +#' a_geom_polygon(a_aes(group = group), fill = NA, colour = "grey60") + +#' a_geom_text(a_aes(label = subregion), data = seats, size = 2, angle = 45) #' #' data(us.cities) #' capitals <- subset(us.cities, capital == 2) -#' ggplot(capitals, aes(long, lat)) + -#' borders("state") + -#' geom_point(aes(size = pop)) + -#' scale_size_area() + -#' coord_quickmap() +#' a_plot(capitals, a_aes(long, lat)) + +#' ggplot2Animint:::borders("state") + +#' a_geom_point(a_aes(size = pop)) + +#' a_scale_size_area() + +#' ggplot2Animint:::a_coord_quickmap() #' #' # Same map, with some world context -#' ggplot(capitals, aes(long, lat)) + -#' borders("world", xlim = c(-130, -60), ylim = c(20, 50)) + -#' geom_point(aes(size = pop)) + -#' scale_size_area() + -#' coord_quickmap() +#' a_plot(capitals, a_aes(long, lat)) + +#' ggplot2Animint:::borders("world", xlim = c(-130, -60), ylim = c(20, 50)) + +#' a_geom_point(a_aes(size = pop)) + +#' a_scale_size_area() + +#' ggplot2Animint:::a_coord_quickmap() #' } borders <- function(database = "world", regions = ".", fill = NA, colour = "grey50", xlim = NULL, ylim = NULL, ...) { df <- map_data(database, regions, xlim = xlim, ylim = ylim) - geom_polygon(aes_(~long, ~lat, group = ~group), data = df, - fill = fill, colour = colour, ..., inherit.aes = FALSE) + a_geom_polygon(a_aes_(~long, ~lat, group = ~group), data = df, + fill = fill, colour = colour, ..., inherit.a_aes = FALSE) } diff --git a/R/fortify-multcomp.r b/R/fortify-multcomp.r index b1c19b5c11..350fc7a7f4 100644 --- a/R/fortify-multcomp.r +++ b/R/fortify-multcomp.r @@ -3,35 +3,35 @@ #' @param model an object of class \code{glht}, \code{confint.glht}, #' \code{summary.glht} or \code{\link[multcomp]{cld}} #' @param data,... other arguments to the generic ignored in this method. -#' @name fortify-multcomp +#' @name a_fortify-multcomp #' @examples #' if (require("multcomp")) { #' amod <- aov(breaks ~ wool + tension, data = warpbreaks) #' wht <- glht(amod, linfct = mcp(tension = "Tukey")) #' -#' fortify(wht) -#' ggplot(wht, aes(lhs, estimate)) + geom_point() +#' a_fortify(wht) +#' a_plot(wht, a_aes(lhs, estimate)) + a_geom_point() #' #' CI <- confint(wht) -#' fortify(CI) -#' ggplot(CI, aes(lhs, estimate, ymin = lwr, ymax = upr)) + -#' geom_pointrange() +#' a_fortify(CI) +#' a_plot(CI, a_aes(lhs, estimate, ymin = lwr, ymax = upr)) + +#' a_geom_pointrange() #' -#' fortify(summary(wht)) -#' ggplot(mapping = aes(lhs, estimate)) + -#' geom_linerange(aes(ymin = lwr, ymax = upr), data = CI) + -#' geom_point(aes(size = p), data = summary(wht)) + -#' scale_size(trans = "reverse") +#' a_fortify(summary(wht)) +#' a_plot(mapping = a_aes(lhs, estimate)) + +#' a_geom_linerange(a_aes(ymin = lwr, ymax = upr), data = CI) + +#' a_geom_point(a_aes(size = p), data = summary(wht)) + +#' a_scale_size(trans = "reverse") #' #' cld <- cld(wht) -#' fortify(cld) +#' a_fortify(cld) #' } NULL -#' @method fortify glht -#' @rdname fortify-multcomp +#' @method a_fortify glht +#' @rdname a_fortify-multcomp #' @export -fortify.glht <- function(model, data, ...) { +a_fortify.glht <- function(model, data, ...) { plyr::unrowname(data.frame( lhs = rownames(model$linfct), rhs = model$rhs, @@ -40,10 +40,10 @@ fortify.glht <- function(model, data, ...) { stringsAsFactors = FALSE)) } -#' @rdname fortify-multcomp -#' @method fortify confint.glht +#' @rdname a_fortify-multcomp +#' @method a_fortify confint.glht #' @export -fortify.confint.glht <- function(model, data, ...) { +a_fortify.confint.glht <- function(model, data, ...) { coef <- model$confint colnames(coef) <- tolower(colnames(coef)) @@ -55,10 +55,10 @@ fortify.confint.glht <- function(model, data, ...) { stringsAsFactors = FALSE)) } -#' @method fortify summary.glht -#' @rdname fortify-multcomp +#' @method a_fortify summary.glht +#' @rdname a_fortify-multcomp #' @export -fortify.summary.glht <- function(model, data, ...) { +a_fortify.summary.glht <- function(model, data, ...) { coef <- as.data.frame( model$test[c("coefficients", "sigma", "tstat", "pvalues")]) names(coef) <- c("estimate", "se", "t", "p") @@ -72,10 +72,10 @@ fortify.summary.glht <- function(model, data, ...) { } -#' @method fortify cld -#' @rdname fortify-multcomp +#' @method a_fortify cld +#' @rdname a_fortify-multcomp #' @export -fortify.cld <- function(model, data, ...) { +a_fortify.cld <- function(model, data, ...) { plyr::unrowname(data.frame( lhs = names(model$mcletters$Letters), letters = model$mcletters$Letters, diff --git a/R/fortify-spatial.r b/R/fortify-spatial.r index 3b63966689..806a6f256d 100644 --- a/R/fortify-spatial.r +++ b/R/fortify-spatial.r @@ -7,50 +7,50 @@ #' @param data not used by this method #' @param region name of variable used to split up regions #' @param ... not used by this method -#' @name fortify.sp +#' @name a_fortify.sp #' @examples #' if (require("maptools")) { #' sids <- system.file("shapes/sids.shp", package="maptools") #' nc1 <- readShapePoly(sids, #' proj4string = CRS("+proj=longlat +datum=NAD27")) -#' nc1_df <- fortify(nc1) +#' nc1_df <- a_fortify(nc1) #' } NULL -#' @rdname fortify.sp +#' @rdname a_fortify.sp #' @export -#' @method fortify SpatialPolygonsDataFrame -fortify.SpatialPolygonsDataFrame <- function(model, data, region = NULL, ...) { +#' @method a_fortify SpatialPolygonsDataFrame +a_fortify.SpatialPolygonsDataFrame <- function(model, data, region = NULL, ...) { attr <- as.data.frame(model) # If not specified, split into regions based on polygons if (is.null(region)) { - coords <- plyr::ldply(model@polygons,fortify) + coords <- plyr::ldply(model@polygons,a_fortify) message("Regions defined for each Polygons") } else { cp <- sp::polygons(model) # Union together all polygons that make up a region unioned <- maptools::unionSpatialPolygons(cp, attr[, region]) - coords <- fortify(unioned) + coords <- a_fortify(unioned) coords$order <- 1:nrow(coords) } coords } -#' @rdname fortify.sp +#' @rdname a_fortify.sp #' @export -#' @method fortify SpatialPolygons -fortify.SpatialPolygons <- function(model, data, ...) { - plyr::ldply(model@polygons, fortify) +#' @method a_fortify SpatialPolygons +a_fortify.SpatialPolygons <- function(model, data, ...) { + plyr::ldply(model@polygons, a_fortify) } -#' @rdname fortify.sp +#' @rdname a_fortify.sp #' @export -#' @method fortify Polygons -fortify.Polygons <- function(model, data, ...) { +#' @method a_fortify Polygons +a_fortify.Polygons <- function(model, data, ...) { subpolys <- model@Polygons pieces <- plyr::ldply(seq_along(subpolys), function(i) { - df <- fortify(subpolys[[model@plotOrder[i]]]) + df <- a_fortify(subpolys[[model@plotOrder[i]]]) df$piece <- i df }) @@ -62,10 +62,10 @@ fortify.Polygons <- function(model, data, ...) { pieces } -#' @rdname fortify.sp +#' @rdname a_fortify.sp #' @export -#' @method fortify Polygon -fortify.Polygon <- function(model, data, ...) { +#' @method a_fortify Polygon +a_fortify.Polygon <- function(model, data, ...) { df <- as.data.frame(model@coords) names(df) <- c("long", "lat") df$order <- 1:nrow(df) @@ -73,20 +73,20 @@ fortify.Polygon <- function(model, data, ...) { df } -#' @rdname fortify.sp +#' @rdname a_fortify.sp #' @export -#' @method fortify SpatialLinesDataFrame -fortify.SpatialLinesDataFrame <- function(model, data, ...) { - plyr::ldply(model@lines, fortify) +#' @method a_fortify SpatialLinesDataFrame +a_fortify.SpatialLinesDataFrame <- function(model, data, ...) { + plyr::ldply(model@lines, a_fortify) } -#' @rdname fortify.sp +#' @rdname a_fortify.sp #' @export -#' @method fortify Lines -fortify.Lines <- function(model, data, ...) { +#' @method a_fortify Lines +a_fortify.Lines <- function(model, data, ...) { lines <- model@Lines pieces <- plyr::ldply(seq_along(lines), function(i) { - df <- fortify(lines[[i]]) + df <- a_fortify(lines[[i]]) df$piece <- i df }) @@ -98,10 +98,10 @@ fortify.Lines <- function(model, data, ...) { pieces } -#' @rdname fortify.sp +#' @rdname a_fortify.sp #' @export -#' @method fortify Line -fortify.Line <- function(model, data, ...) { +#' @method a_fortify Line +a_fortify.Line <- function(model, data, ...) { df <- as.data.frame(model@coords) names(df) <- c("long", "lat") df$order <- 1:nrow(df) diff --git a/R/fortify.r b/R/fortify.r index a35be2a3d9..16f9bcf063 100644 --- a/R/fortify.r +++ b/R/fortify.r @@ -1,24 +1,24 @@ #' Fortify a model with data. #' #' Rather than using this function, I now recomend using the \pkg{broom} -#' package, which implements a much wider range of methods. \code{fortify} +#' package, which implements a much wider range of methods. \code{a_fortify} #' may be deprecated in the future. #' -#' @seealso \code{\link{fortify.lm}} +#' @seealso \code{\link{a_fortify.lm}} #' @param model model or other R object to convert to data frame #' @param data original dataset, if needed #' @param ... other arguments passed to methods #' @export -fortify <- function(model, data, ...) UseMethod("fortify") +a_fortify <- function(model, data, ...) UseMethod("a_fortify") #' @export -fortify.data.frame <- function(model, data, ...) model +a_fortify.data.frame <- function(model, data, ...) model #' @export -fortify.NULL <- function(model, data, ...) waiver() +a_fortify.NULL <- function(model, data, ...) waiver() #' @export -fortify.function <- function(model, data, ...) model +a_fortify.function <- function(model, data, ...) model #' @export -fortify.default <- function(model, data, ...) { +a_fortify.default <- function(model, data, ...) { stop( "ggplot2 doesn't know how to deal with data of class ", paste(class(model), collapse = "/"), diff --git a/R/geom-.r b/R/geom-.r index 610824eab3..3a5c885ce8 100644 --- a/R/geom-.r +++ b/R/geom-.r @@ -1,18 +1,18 @@ #' @include legend-draw.r NULL -#' @section Geoms: +#' @section a_Geoms: #' -#' All \code{geom_*} functions (like \code{geom_point}) return a layer that -#' contains a \code{Geom*} object (like \code{GeomPoint}). The \code{Geom*} +#' All \code{a_geom_*} functions (like \code{a_geom_point}) return a layer that +#' contains a \code{a_Geom*} object (like \code{a_GeomPoint}). The \code{a_Geom*} #' object is responsible for rendering the data in the plot. #' -#' Each of the \code{Geom*} objects is a \code{\link{ggproto}} object, descended -#' from the top-level \code{Geom}, and each implements various methods and +#' Each of the \code{a_Geom*} objects is a \code{\link{a_ggproto}} object, descended +#' from the top-level \code{a_Geom}, and each implements various methods and #' fields. To create a new type of Geom object, you typically will want to #' implement one or more of the following: #' -#' Compared to \code{Stat} and \code{Position}, \code{Geom} is a little +#' Compared to \code{a_Stat} and \code{a_Position}, \code{a_Geom} is a little #' different because the execution of the setup and compute functions is #' split up. \code{setup_data} runs before position adjustments, and #' \code{draw_layer} is not run until render time, much later. This @@ -20,8 +20,8 @@ NULL #' the changes. #' #' \itemize{ -#' \item Override either \code{draw_panel(self, data, panel_scales, coord)} or -#' \code{draw_group(self, data, panel_scales, coord)}. \code{draw_panel} is +#' \item Override either \code{draw_panel(self, data, panel_scales, a_coord)} or +#' \code{draw_group(self, data, panel_scales, a_coord)}. \code{draw_panel} is #' called once per panel, \code{draw_group} is called once per group. #' #' Use \code{draw_panel} if each row in the data represents a @@ -30,34 +30,34 @@ NULL #' #' \code{data} is a data frame of scaled aesthetics. \code{panel_scales} #' is a list containing information about the scales in the current -#' panel. \code{coord} is a coordinate specification. You'll -#' need to call \code{coord$transform(data, panel_scales)} to work +#' panel. \code{a_coord} is a coordinate specification. You'll +#' need to call \code{a_coord$transform(data, panel_scales)} to work #' with non-Cartesian coords. To work with non-linear coordinate systems, #' you typically need to convert into a primitive geom (e.g. point, path #' or polygon), and then pass on to the corresponding draw method #' for munching. #' -#' Must return a grob. Use \code{\link{zeroGrob}} if there's nothing to +#' Must return a grob. Use \code{\link{a_zeroGrob}} if there's nothing to #' draw. #' \item \code{draw_key}: Renders a single legend key. #' \item \code{required_aes}: A character vector of aesthetics needed to #' render the geom. -#' \item \code{default_aes}: A list (generated by \code{\link{aes}()} of +#' \item \code{default_aes}: A list (generated by \code{\link{a_aes}()} of #' default values for aesthetics. #' \item \code{reparameterise}: Converts width and height to xmin and xmax, #' and ymin and ymax values. It can potentially set other values as well. #' } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -Geom <- ggproto("Geom", +a_Geom <- a_ggproto("a_Geom", required_aes = character(), non_missing_aes = character(), - default_aes = aes(), + default_aes = a_aes(), - draw_key = draw_key_point, + draw_key = a_draw_key_point, handle_na = function(self, data, params) { remove_missing(data, params$na.rm, @@ -66,28 +66,28 @@ Geom <- ggproto("Geom", ) }, - draw_layer = function(self, data, params, panel, coord) { + draw_layer = function(self, data, params, panel, a_coord) { if (empty(data)) { n <- if (is.factor(data$PANEL)) nlevels(data$PANEL) else 1L - return(rep(list(zeroGrob()), n)) + return(rep(list(a_zeroGrob()), n)) } # Trim off extra parameters params <- params[intersect(names(params), self$parameters())] - args <- c(list(quote(data), quote(panel_scales), quote(coord)), params) + args <- c(list(quote(data), quote(panel_scales), quote(a_coord)), params) plyr::dlply(data, "PANEL", function(data) { - if (empty(data)) return(zeroGrob()) + if (empty(data)) return(a_zeroGrob()) panel_scales <- panel$ranges[[data$PANEL[1]]] do.call(self$draw_panel, args) }, .drop = FALSE) }, - draw_panel = function(self, data, panel_scales, coord, ...) { + draw_panel = function(self, data, panel_scales, a_coord, ...) { groups <- split(data, factor(data$group)) grobs <- lapply(groups, function(group) { - self$draw_group(group, panel_scales, coord, ...) + self$draw_group(group, panel_scales, a_coord, ...) }) ggname(snake_class(self), gTree( @@ -95,7 +95,7 @@ Geom <- ggproto("Geom", )) }, - draw_group = function(self, data, panel_scales, coord) { + draw_group = function(self, data, panel_scales, a_coord) { stop("Not implemented") }, @@ -112,9 +112,9 @@ Geom <- ggproto("Geom", } # Override mappings with params - aes_params <- intersect(self$aesthetics(), names(params)) - check_aesthetics(params[aes_params], nrow(data)) - data[aes_params] <- params[aes_params] + a_aes_params <- intersect(self$a_aesthetics(), names(params)) + check_aesthetics(params[a_aes_params], nrow(data)) + data[a_aes_params] <- params[a_aes_params] data }, @@ -127,12 +127,12 @@ Geom <- ggproto("Geom", parameters = function(self, extra = FALSE) { # Look first in draw_panel. If it contains ... then look in draw groups - panel_args <- names(ggproto_formals(self$draw_panel)) - group_args <- names(ggproto_formals(self$draw_group)) + panel_args <- names(a_ggproto_formals(self$draw_panel)) + group_args <- names(a_ggproto_formals(self$draw_group)) args <- if ("..." %in% panel_args) group_args else panel_args # Remove arguments of defaults - args <- setdiff(args, names(ggproto_formals(Geom$draw_group))) + args <- setdiff(args, names(a_ggproto_formals(a_Geom$draw_group))) if (extra) { args <- union(args, self$extra_params) @@ -140,7 +140,7 @@ Geom <- ggproto("Geom", args }, - aesthetics = function(self) { + a_aesthetics = function(self) { c(union(self$required_aes, names(self$default_aes)), "group") } diff --git a/R/geom-abline.r b/R/geom-abline.r index 518c64885b..d59b7e2d11 100644 --- a/R/geom-abline.r +++ b/R/geom-abline.r @@ -10,7 +10,7 @@ NULL #' These geoms act slightly different to other geoms. You can supply the #' parameters in two ways: either as arguments to the layer function, #' or via aesthetics. If you use arguments, e.g. -#' \code{geom_abline(intercept = 0, slope = 1)}, then behind the scenes +#' \code{a_geom_abline(intercept = 0, slope = 1)}, then behind the scenes #' the geom makes a new data frame containing just the data you've supplied. #' That means that the lines will be the same in all facets; if you want them #' to vary across facets, construct the data frame yourself and use aesthetics. @@ -20,55 +20,55 @@ NULL #' commonly set in the plot. They also do not affect the x and y scales. #' #' @section Aesthetics: -#' These geoms are drawn using with \code{\link{geom_line}} so support the +#' These geoms are drawn using with \code{\link{a_geom_line}} so support the #' same aesthetics: alpha, colour, linetype and size. They also each have #' aesthetics that control the position of the line: #' #' \itemize{ -#' \item \code{geom_vline}: \code{xintercept} -#' \item \code{geom_hline}: \code{yintercept} -#' \item \code{geom_abline}: \code{slope} and \code{intercept} +#' \item \code{a_geom_vline}: \code{xintercept} +#' \item \code{a_geom_hline}: \code{yintercept} +#' \item \code{a_geom_abline}: \code{slope} and \code{intercept} #' } #' -#' @seealso See \code{\link{geom_segment}} for a more general approach to +#' @seealso See \code{\link{a_geom_segment}} for a more general approach to #' adding straight line segments to a plot. -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @param xintercept,yintercept,slope,intercept Parameters that control the #' position of the line. If these are set, \code{data}, \code{mapping} and #' \code{show.legend} are overridden #' @export #' @examples -#' p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() +#' p <- a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point() #' #' # Fixed values -#' p + geom_vline(xintercept = 5) -#' p + geom_vline(xintercept = 1:5) -#' p + geom_hline(yintercept = 20) +#' p + a_geom_vline(xintercept = 5) +#' p + a_geom_vline(xintercept = 1:5) +#' p + a_geom_hline(yintercept = 20) #' -#' p + geom_abline() # Can't see it - outside the range of the data -#' p + geom_abline(intercept = 20) +#' p + a_geom_abline() # Can't see it - outside the range of the data +#' p + a_geom_abline(intercept = 20) #' #' # Calculate slope and intercept of line of best fit #' coef(lm(mpg ~ wt, data = mtcars)) -#' p + geom_abline(intercept = 37, slope = -5) -#' # But this is easier to do with geom_smooth: -#' p + geom_smooth(method = "lm", se = FALSE) +#' p + a_geom_abline(intercept = 37, slope = -5) +#' # But this is easier to do with a_geom_smooth: +#' p + a_geom_smooth(method = "lm", se = FALSE) #' #' # To show different lines in different facets, use aesthetics -#' p <- ggplot(mtcars, aes(mpg, wt)) + -#' geom_point() + -#' facet_wrap(~ cyl) +#' p <- a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point() + +#' a_facet_wrap(~ cyl) #' #' mean_wt <- data.frame(cyl = c(4, 6, 8), wt = c(2.28, 3.11, 4.00)) -#' p + geom_hline(aes(yintercept = wt), mean_wt) +#' p + a_geom_hline(a_aes(yintercept = wt), mean_wt) #' #' # You can also control other aesthetics -#' ggplot(mtcars, aes(mpg, wt, colour = wt)) + -#' geom_point() + -#' geom_hline(aes(yintercept = wt, colour = wt), mean_wt) + -#' facet_wrap(~ cyl) -geom_abline <- function(mapping = NULL, data = NULL, +#' a_plot(mtcars, a_aes(mpg, wt, colourffa = wt)) + +#' a_geom_point() + +#' a_geom_hline(a_aes(yintercept = wt, colour = wt), mean_wt) + +#' a_facet_wrap(~ cyl) +a_geom_abline <- function(mapping = NULL, data = NULL, ..., slope, intercept, @@ -87,18 +87,18 @@ geom_abline <- function(mapping = NULL, data = NULL, if (missing(intercept)) intercept <- 0 data <- data.frame(intercept = intercept, slope = slope) - mapping <- aes(intercept = intercept, slope = slope) + mapping <- a_aes(intercept = intercept, slope = slope) show.legend <- FALSE } - layer( + a_layer( data = data, mapping = mapping, - stat = StatIdentity, - geom = GeomAbline, - position = PositionIdentity, + a_stat = a_StatIdentity, + a_geom = a_GeomAbline, + a_position = a_PositionIdentity, show.legend = show.legend, - inherit.aes = FALSE, + inherit.a_aes = FALSE, params = list( na.rm = na.rm, ... @@ -106,24 +106,24 @@ geom_abline <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomAbline <- ggproto("GeomAbline", Geom, - draw_panel = function(data, panel_scales, coord) { - ranges <- coord$range(panel_scales) +a_GeomAbline <- a_ggproto("a_GeomAbline", a_Geom, + draw_panel = function(data, panel_scales, a_coord) { + ranges <- a_coord$range(panel_scales) data$x <- ranges$x[1] data$xend <- ranges$x[2] data$y <- ranges$x[1] * data$slope + data$intercept data$yend <- ranges$x[2] * data$slope + data$intercept - GeomSegment$draw_panel(unique(data), panel_scales, coord) + a_GeomSegment$draw_panel(unique(data), panel_scales, a_coord) }, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), + default_aes = a_aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), required_aes = c("slope", "intercept"), - draw_key = draw_key_abline + draw_key = a_draw_key_abline ) diff --git a/R/geom-bar.r b/R/geom-bar.r index ca264d4a70..895dbfec9c 100644 --- a/R/geom-bar.r +++ b/R/geom-bar.r @@ -1,11 +1,11 @@ #' Bars, rectangles with bases on x-axis #' #' There are two types of bar charts, determined by what is mapped to bar -#' height. By default, \code{geom_bar} uses \code{stat="count"} which makes the +#' height. By default, \code{a_geom_bar} uses \code{a_stat="count"} which makes the #' height of the bar proportion to the number of cases in each group (or if the #' \code{weight} aethetic is supplied, the sum of the weights). If you want the #' heights of the bars to represent values in the data, use -#' \code{stat="identity"} and map a variable to the \code{y} aesthetic. +#' \code{a_stat="identity"} and map a variable to the \code{y} aesthetic. #' #' A bar chart maps the height of the bar to a variable, and so the base of the #' bar must always be shown to produce a valid visual comparison. Naomi Robbins @@ -15,90 +15,90 @@ #' bar chart. #' #' By default, multiple x's occurring in the same place will be stacked atop one -#' another by \code{\link{position_stack}}. If you want them to be dodged -#' side-to-side, see \code{\link{position_dodge}}. Finally, -#' \code{\link{position_fill}} shows relative proportions at each x by stacking +#' another by \code{\link{a_position_stack}}. If you want them to be dodged +#' side-to-side, see \code{\link{a_position_dodge}}. Finally, +#' \code{\link{a_position_fill}} shows relative proportions at each x by stacking #' the bars and then stretching or squashing to the same height. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "bar")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "bar")} #' -#' @seealso \code{\link{geom_histogram}} for continuous data, -#' \code{\link{position_dodge}} for creating side-by-side barcharts. +#' @seealso \code{\link{a_geom_histogram}} for continuous data, +#' \code{\link{a_position_dodge}} for creating side-by-side barcharts. #' @export -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @param width Bar width. By default, set to 90\% of the resolution of the data. -#' @param binwidth \code{geom_bar} no longer has a binwidth argument - if +#' @param binwidth \code{a_geom_bar} no longer has a binwidth argument - if #' you use it you'll get an warning telling to you use -#' \code{\link{geom_histogram}} instead. -#' @param geom,stat Override the default connection between \code{geom_bar} and -#' \code{stat_count}. +#' \code{\link{a_geom_histogram}} instead. +#' @param a_geom,a_stat Override the default connection between \code{a_geom_bar} and +#' \code{a_stat_count}. #' @examples -#' # geom_bar is designed to make it easy to create bar charts that show +#' # a_geom_bar is designed to make it easy to create bar charts that show #' # counts (or sums of weights) -#' g <- ggplot(mpg, aes(class)) +#' g <- a_plot(mpg, a_aes(class)) #' # Number of cars in each class: -#' g + geom_bar() +#' g + a_geom_bar() #' # Total engine displacement of each class -#' g + geom_bar(aes(weight = displ)) +#' g + a_geom_bar(a_aes(weight = displ)) #' -#' # To show (e.g.) means, you need stat = "identity" +#' # To show (e.g.) means, you need a_stat = "identity" #' df <- data.frame(trt = c("a", "b", "c"), outcome = c(2.3, 1.9, 3.2)) -#' ggplot(df, aes(trt, outcome)) + -#' geom_bar(stat = "identity") -#' # But geom_point() display exactly the same information and doesn't +#' a_plot(df, a_aes(trt, outcome)) + +#' a_geom_bar(a_stat = "identity") +#' # But a_geom_point() display exactly the same information and doesn't #' # require the y-axis to touch zero. -#' ggplot(df, aes(trt, outcome)) + -#' geom_point() +#' a_plot(df, a_aes(trt, outcome)) + +#' a_geom_point() #' -#' # You can also use geom_bar() with continuous data, in which case +#' # You can also use a_geom_bar() with continuous data, in which case #' # it will show counts at unique locations #' df <- data.frame(x = rep(c(2.9, 3.1, 4.5), c(5, 10, 4))) -#' ggplot(df, aes(x)) + geom_bar() +#' a_plot(df, a_aes(x)) + a_geom_bar() #' # cf. a histogram of the same data -#' ggplot(df, aes(x)) + geom_histogram(binwidth = 0.5) +#' a_plot(df, a_aes(x)) + a_geom_histogram(binwidth = 0.5) #' #' \donttest{ #' # Bar charts are automatically stacked when multiple bars are placed #' # at the same location -#' g + geom_bar(aes(fill = drv)) +#' g + a_geom_bar(a_aes(fill = drv)) #' #' # You can instead dodge, or fill them -#' g + geom_bar(aes(fill = drv), position = "dodge") -#' g + geom_bar(aes(fill = drv), position = "fill") +#' g + a_geom_bar(a_aes(fill = drv), a_position = "dodge") +#' g + a_geom_bar(a_aes(fill = drv), a_position = "fill") #' #' # To change plot order of bars, change levels in underlying factor #' reorder_size <- function(x) { #' factor(x, levels = names(sort(table(x)))) #' } -#' ggplot(mpg, aes(reorder_size(class))) + geom_bar() +#' a_plot(mpg, a_aes(reorder_size(class))) + a_geom_bar() #' } -geom_bar <- function(mapping = NULL, data = NULL, - stat = "count", position = "stack", +a_geom_bar <- function(mapping = NULL, data = NULL, + a_stat = "count", a_position = "stack", ..., width = NULL, binwidth = NULL, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.a_aes = TRUE) { if (!is.null(binwidth)) { - warning("`geom_bar()` no longer has a `binwidth` parameter. ", - "Please use `geom_histogram()` instead.", call. = "FALSE") - return(geom_histogram(mapping = mapping, data = data, - position = position, width = width, binwidth = binwidth, ..., - na.rm = na.rm, show.legend = show.legend, inherit.aes = inherit.aes)) + warning("`a_geom_bar()` no longer has a `binwidth` parameter. ", + "Please use `a_geom_histogram()` instead.", call. = "FALSE") + return(a_geom_histogram(mapping = mapping, data = data, + a_position = a_position, width = width, binwidth = binwidth, ..., + na.rm = na.rm, show.legend = show.legend, inherit.a_aes = inherit.a_aes)) } - layer( + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomBar, - position = position, + a_stat = a_stat, + a_geom = a_GeomBar, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( width = width, na.rm = na.rm, @@ -107,25 +107,25 @@ geom_bar <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export #' @include geom-rect.r -GeomBar <- ggproto("GeomBar", GeomRect, +a_GeomBar <- a_ggproto("a_GeomBar", a_GeomRect, required_aes = "x", setup_data = function(data, params) { data$width <- data$width %||% - params$width %||% (resolution(data$x, FALSE) * 0.9) + params$width %||% (a_resolution(data$x, FALSE) * 0.9) transform(data, ymin = pmin(y, 0), ymax = pmax(y, 0), xmin = x - width / 2, xmax = x + width / 2, width = NULL ) }, - draw_panel = function(self, data, panel_scales, coord, width = NULL) { + draw_panel = function(self, data, panel_scales, a_coord, width = NULL) { # Hack to ensure that width is detected as a parameter - ggproto_parent(GeomRect, self)$draw_panel(data, panel_scales, coord) + a_ggproto_parent(a_GeomRect, self)$draw_panel(data, panel_scales, a_coord) } ) diff --git a/R/geom-bin2d.r b/R/geom-bin2d.r index c372eed077..d72e8223fb 100644 --- a/R/geom-bin2d.r +++ b/R/geom-bin2d.r @@ -1,40 +1,40 @@ #' Add heatmap of 2d bin counts. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("stat", "bin2d")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_stat", "bin2d")} #' #' @export -#' @inheritParams layer -#' @inheritParams geom_point -#' @param geom,stat Use to override the default connection between -#' \code{geom_bin2d} and \code{stat_bin2d}. -#' @seealso \code{\link{stat_binhex}} for hexagonal binning +#' @inheritParams a_layer +#' @inheritParams a_geom_point +#' @param a_geom,a_stat Use to override the default connection between +#' \code{a_geom_bin2d} and \code{a_stat_bin2d}. +#' @seealso \code{\link{a_stat_binhex}} for hexagonal binning #' @examples -#' d <- ggplot(diamonds, aes(x, y)) + xlim(4, 10) + ylim(4, 10) -#' d + geom_bin2d() +#' d <- a_plot(diamonds, a_aes(x, y)) + xlim(4, 10) + ylim(4, 10) +#' d + a_geom_bin2d() #' #' # You can control the size of the bins by specifying the number of #' # bins in each direction: -#' d + geom_bin2d(bins = 10) -#' d + geom_bin2d(bins = 30) +#' d + a_geom_bin2d(bins = 10) +#' d + a_geom_bin2d(bins = 30) #' #' # Or by specifying the width of the bins -#' d + geom_bin2d(binwidth = c(0.1, 0.1)) -geom_bin2d <- function(mapping = NULL, data = NULL, - stat = "bin2d", position = "identity", +#' d + a_geom_bin2d(binwidth = c(0.1, 0.1)) +a_geom_bin2d <- function(mapping = NULL, data = NULL, + a_stat = "bin2d", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.a_aes = TRUE) { - layer( + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomTile, - position = position, + a_stat = a_stat, + a_geom = a_GeomTile, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... diff --git a/R/geom-blank.r b/R/geom-blank.r index 133a2fa4d1..98ffb53786 100644 --- a/R/geom-blank.r +++ b/R/geom-blank.r @@ -4,35 +4,35 @@ #' scales between different plots. #' #' @export -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @examples -#' ggplot(mtcars, aes(wt, mpg)) +#' a_plot(mtcars, a_aes(wt, mpg)) #' # Nothing to see here! -geom_blank <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +a_geom_blank <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomBlank, - position = position, + a_stat = a_stat, + a_geom = a_GeomBlank, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list(...) ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomBlank <- ggproto("GeomBlank", Geom, - default_aes = aes(), +a_GeomBlank <- a_ggproto("a_GeomBlank", a_Geom, + default_aes = a_aes(), handle_na = function(data, params) data, draw_panel = function(...) nullGrob() ) diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 8623b3b4e7..c32f8e9bcd 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -17,15 +17,15 @@ #' See McGill et al. (1978) for more details. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "boxplot")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "boxplot")} #' -#' @seealso \code{\link{stat_quantile}} to view quantiles conditioned on a -#' continuous variable, \code{\link{geom_jitter}} for another way to look +#' @seealso \code{\link{a_stat_quantile}} to view quantiles conditioned on a +#' continuous variable, \code{\link{a_geom_jitter}} for another way to look #' at conditional distributions. -#' @inheritParams layer -#' @inheritParams geom_point -#' @param geom,stat Use to override the default connection between -#' \code{geom_boxplot} and \code{stat_boxplot}. +#' @inheritParams a_layer +#' @inheritParams a_geom_point +#' @param a_geom,a_stat Use to override the default connection between +#' \code{a_geom_boxplot} and \code{a_stat_boxplot}. #' @param outlier.colour,outlier.color,outlier.shape,outlier.size,outlier.stroke #' Default aesthetics for outliers. Set to \code{NULL} to inherit from the #' aesthetics used for the box. @@ -46,31 +46,31 @@ #' @references McGill, R., Tukey, J. W. and Larsen, W. A. (1978) Variations of #' box plots. The American Statistician 32, 12-16. #' @examples -#' p <- ggplot(mpg, aes(class, hwy)) -#' p + geom_boxplot() -#' p + geom_boxplot() + geom_jitter(width = 0.2) -#' p + geom_boxplot() + coord_flip() +#' p <- a_plot(mpg, a_aes(class, hwy)) +#' p + a_geom_boxplot() +#' p + a_geom_boxplot() + a_geom_jitter(width = 0.2) +#' p + a_geom_boxplot() + ggplot2Animint:::a_coord_flip() #' -#' p + geom_boxplot(notch = TRUE) -#' p + geom_boxplot(varwidth = TRUE) -#' p + geom_boxplot(fill = "white", colour = "#3366FF") +#' p + a_geom_boxplot(notch = TRUE) +#' p + a_geom_boxplot(varwidth = TRUE) +#' p + a_geom_boxplot(fill = "white", colour = "#3366FF") #' # By default, outlier points match the colour of the box. Use #' # outlier.colour to override -#' p + geom_boxplot(outlier.colour = "red", outlier.shape = 1) +#' p + a_geom_boxplot(outlier.colour = "red", outlier.shape = 1) #' #' # Boxplots are automatically dodged when any aesthetic is a factor -#' p + geom_boxplot(aes(colour = drv)) +#' p + a_geom_boxplot(a_aes(colour = drv)) #' #' # You can also use boxplots with continuous x, as long as you supply #' # a grouping variable. cut_width is particularly useful -#' ggplot(diamonds, aes(carat, price)) + -#' geom_boxplot() -#' ggplot(diamonds, aes(carat, price)) + -#' geom_boxplot(aes(group = cut_width(carat, 0.25))) +#' a_plot(diamonds, a_aes(carat, price)) + +#' a_geom_boxplot() +#' a_plot(diamonds, a_aes(carat, price)) + +#' a_geom_boxplot(a_aes(group = cut_width(carat, 0.25))) #' #' \donttest{ #' # It's possible to draw a boxplot with your own computations if you -#' # use stat = "identity": +#' # use a_stat = "identity": #' y <- rnorm(100) #' df <- data.frame( #' x = 1, @@ -80,14 +80,14 @@ #' y75 = quantile(y, 0.75), #' y100 = max(y) #' ) -#' ggplot(df, aes(x)) + -#' geom_boxplot( -#' aes(ymin = y0, lower = y25, middle = y50, upper = y75, ymax = y100), -#' stat = "identity" +#' a_plot(df, a_aes(x)) + +#' a_geom_boxplot( +#' a_aes(ymin = y0, lower = y25, middle = y50, upper = y75, ymax = y100), +#' a_stat = "identity" #' ) #' } -geom_boxplot <- function(mapping = NULL, data = NULL, - stat = "boxplot", position = "dodge", +a_geom_boxplot <- function(mapping = NULL, data = NULL, + a_stat = "boxplot", a_position = "dodge", ..., outlier.colour = NULL, outlier.color = NULL, @@ -99,15 +99,15 @@ geom_boxplot <- function(mapping = NULL, data = NULL, varwidth = FALSE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomBoxplot, - position = position, + a_stat = a_stat, + a_geom = a_GeomBoxplot, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( outlier.colour = outlier.color %||% outlier.colour, outlier.shape = outlier.shape, @@ -122,14 +122,14 @@ geom_boxplot <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomBoxplot <- ggproto("GeomBoxplot", Geom, +a_GeomBoxplot <- a_ggproto("a_GeomBoxplot", a_Geom, setup_data = function(data, params) { data$width <- data$width %||% - params$width %||% (resolution(data$x, FALSE) * 0.9) + params$width %||% (a_resolution(data$x, FALSE) * 0.9) if (!is.null(data$outliers)) { suppressWarnings({ @@ -157,7 +157,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, data }, - draw_group = function(data, panel_scales, coord, fatten = 2, + draw_group = function(data, panel_scales, a_coord, fatten = 2, outlier.colour = NULL, outlier.shape = 19, outlier.size = 1.5, outlier.stroke = 0.5, notch = FALSE, notchwidth = 0.5, varwidth = FALSE) { @@ -207,21 +207,21 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, alpha = NA, stringsAsFactors = FALSE ) - outliers_grob <- GeomPoint$draw_panel(outliers, panel_scales, coord) + outliers_grob <- a_GeomPoint$draw_panel(outliers, panel_scales, a_coord) } else { outliers_grob <- NULL } ggname("geom_boxplot", grobTree( outliers_grob, - GeomSegment$draw_panel(whiskers, panel_scales, coord), - GeomCrossbar$draw_panel(box, fatten = fatten, panel_scales, coord) + a_GeomSegment$draw_panel(whiskers, panel_scales, a_coord), + a_GeomCrossbar$draw_panel(box, fatten = fatten, panel_scales, a_coord) )) }, - draw_key = draw_key_boxplot, + draw_key = a_draw_key_boxplot, - default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5, + default_aes = a_aes(weight = 1, colour = "grey20", fill = "white", size = 0.5, alpha = NA, shape = 19, linetype = "solid"), required_aes = c("x", "lower", "upper", "middle", "ymin", "ymax") diff --git a/R/geom-contour.r b/R/geom-contour.r index 31c1c07a07..20b74a32c9 100644 --- a/R/geom-contour.r +++ b/R/geom-contour.r @@ -1,56 +1,56 @@ #' Display contours of a 3d surface in 2d. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "contour")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "contour")} #' -#' @inheritParams layer -#' @inheritParams geom_point -#' @inheritParams geom_path -#' @seealso \code{\link{geom_density_2d}}: 2d density contours +#' @inheritParams a_layer +#' @inheritParams a_geom_point +#' @inheritParams a_geom_path +#' @seealso \code{\link{a_geom_density_2d}}: 2d density contours #' @export #' @export #' @examples #' #' # Basic plot -#' v <- ggplot(faithfuld, aes(waiting, eruptions, z = density)) -#' v + geom_contour() +#' v <- a_plot(faithfuld, a_aes(waiting, eruptions, z = density)) +#' v + a_geom_contour() #' #' # Or compute from raw data -#' ggplot(faithful, aes(waiting, eruptions)) + -#' geom_density_2d() +#' a_plot(faithful, a_aes(waiting, eruptions)) + +#' a_geom_density_2d() #' #' \donttest{ #' # Setting bins creates evenly spaced contours in the range of the data -#' v + geom_contour(bins = 2) -#' v + geom_contour(bins = 10) +#' v + a_geom_contour(bins = 2) +#' v + a_geom_contour(bins = 10) #' #' # Setting binwidth does the same thing, parameterised by the distance #' # between contours -#' v + geom_contour(binwidth = 0.01) -#' v + geom_contour(binwidth = 0.001) +#' v + a_geom_contour(binwidth = 0.01) +#' v + a_geom_contour(binwidth = 0.001) #' #' # Other parameters -#' v + geom_contour(aes(colour = ..level..)) -#' v + geom_contour(colour = "red") -#' v + geom_raster(aes(fill = density)) + -#' geom_contour(colour = "white") +#' v + a_geom_contour(a_aes(colour = ..level..)) +#' v + a_geom_contour(colour = "red") +#' v + a_geom_raster(a_aes(fill = density)) + +#' a_geom_contour(colour = "white") #' } -geom_contour <- function(mapping = NULL, data = NULL, - stat = "contour", position = "identity", +a_geom_contour <- function(mapping = NULL, data = NULL, + a_stat = "contour", a_position = "identity", ..., lineend = "butt", linejoin = "round", linemitre = 1, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomContour, - position = position, + a_stat = a_stat, + a_geom = a_GeomContour, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( lineend = lineend, linejoin = linejoin, @@ -61,12 +61,12 @@ geom_contour <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export #' @include geom-path.r -GeomContour <- ggproto("GeomContour", GeomPath, - default_aes = aes(weight = 1, colour = "#3366FF", size = 0.5, linetype = 1, +a_GeomContour <- a_ggproto("a_GeomContour", a_GeomPath, + default_aes = a_aes(weight = 1, colour = "#3366FF", size = 0.5, linetype = 1, alpha = NA) ) diff --git a/R/geom-count.r b/R/geom-count.r index a04a6f0662..7566545d7c 100644 --- a/R/geom-count.r +++ b/R/geom-count.r @@ -1,60 +1,60 @@ #' Count the number of observations at each location. #' -#' This is a variant \code{\link{geom_point}} that counts the number of +#' This is a variant \code{\link{a_geom_point}} that counts the number of #' observations at each location, then maps the count to point size. It #' useful when you have discrete data. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "point")} -#' @param geom,stat Use to override the default connection between -#' \code{geom_count} and \code{stat_sum}. -#' @inheritParams layer -#' @inheritParams geom_point +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "point")} +#' @param a_geom,a_stat Use to override the default connection between +#' \code{a_geom_count} and \code{a_stat_sum}. +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @export #' @examples -#' ggplot(mpg, aes(cty, hwy)) + -#' geom_point() +#' a_plot(mpg, a_aes(cty, hwy)) + +#' a_geom_point() #' -#' ggplot(mpg, aes(cty, hwy)) + -#' geom_count() +#' a_plot(mpg, a_aes(cty, hwy)) + +#' a_geom_count() #' -#' # Best used in conjunction with scale_size_area which ensures that +#' # Best used in conjunction with a_scale_size_area which ensures that #' # counts of zero would be given size 0. Doesn't make much different #' # here because the smallest count is already close to 0. -#' ggplot(mpg, aes(cty, hwy)) + -#' geom_count() -#' scale_size_area() +#' a_plot(mpg, a_aes(cty, hwy)) + +#' a_geom_count() +#' a_scale_size_area() #' #' # Display proportions instead of counts ------------------------------------- #' # By default, all categorical variables in the plot form the groups. -#' # Specifying geom_count without a group identifier leads to a plot which is +#' # Specifying a_geom_count without a group identifier leads to a plot which is #' # not useful: -#' d <- ggplot(diamonds, aes(x = cut, y = clarity)) -#' d + geom_count(aes(size = ..prop..)) +#' d <- a_plot(diamonds, a_aes(x = cut, y = clarity)) +#' d + a_geom_count(a_aes(size = ..prop..)) #' # To correct this problem and achieve a more desirable plot, we need #' # to specify which group the proportion is to be calculated over. -#' d + geom_count(aes(size = ..prop.., group = 1)) + -#' scale_size_area(max_size = 10) +#' d + a_geom_count(a_aes(size = ..prop.., group = 1)) + +#' a_scale_size_area(max_size = 10) #' #' # Or group by x/y variables to have rows/columns sum to 1. -#' d + geom_count(aes(size = ..prop.., group = cut)) + -#' scale_size_area(max_size = 10) -#' d + geom_count(aes(size = ..prop.., group = clarity)) + -#' scale_size_area(max_size = 10) -geom_count <- function(mapping = NULL, data = NULL, - stat = "sum", position = "identity", +#' d + a_geom_count(a_aes(size = ..prop.., group = cut)) + +#' a_scale_size_area(max_size = 10) +#' d + a_geom_count(a_aes(size = ..prop.., group = clarity)) + +#' a_scale_size_area(max_size = 10) +a_geom_count <- function(mapping = NULL, data = NULL, + a_stat = "sum", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomPoint, - position = position, + a_stat = a_stat, + a_geom = a_GeomPoint, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... diff --git a/R/geom-crossbar.r b/R/geom-crossbar.r index ba71d6b949..7ca583323d 100644 --- a/R/geom-crossbar.r +++ b/R/geom-crossbar.r @@ -1,20 +1,20 @@ #' @export -#' @rdname geom_linerange -geom_crossbar <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' @rdname a_geom_linerange +a_geom_crossbar <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., fatten = 2.5, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomCrossbar, - position = position, + a_stat = a_stat, + a_geom = a_GeomCrossbar, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( fatten = fatten, na.rm = na.rm, @@ -23,23 +23,23 @@ geom_crossbar <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomCrossbar <- ggproto("GeomCrossbar", Geom, +a_GeomCrossbar <- a_ggproto("a_GeomCrossbar", a_Geom, setup_data = function(data, params) { - GeomErrorbar$setup_data(data, params) + a_GeomErrorbar$setup_data(data, params) }, - default_aes = aes(colour = "black", fill = NA, size = 0.5, linetype = 1, + default_aes = a_aes(colour = "black", fill = NA, size = 0.5, linetype = 1, alpha = NA), required_aes = c("x", "y", "ymin", "ymax"), - draw_key = draw_key_crossbar, + draw_key = a_draw_key_crossbar, - draw_panel = function(data, panel_scales, coord, fatten = 2.5, width = NULL) { + draw_panel = function(data, panel_scales, a_coord, fatten = 2.5, width = NULL) { middle <- transform(data, x = xmin, xend = xmax, yend = y, size = size * fatten, alpha = NA) has_notch <- !is.null(data$ynotchlower) && !is.null(data$ynotchupper) && @@ -88,8 +88,8 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, } ggname("geom_crossbar", gTree(children = gList( - GeomPolygon$draw_panel(box, panel_scales, coord), - GeomSegment$draw_panel(middle, panel_scales, coord) + a_GeomPolygon$draw_panel(box, panel_scales, a_coord), + a_GeomSegment$draw_panel(middle, panel_scales, a_coord) ))) } ) diff --git a/R/geom-curve.r b/R/geom-curve.r index 20124d52ae..7eee159552 100644 --- a/R/geom-curve.r +++ b/R/geom-curve.r @@ -1,8 +1,8 @@ #' @inheritParams grid::curveGrob #' @export -#' @rdname geom_segment -geom_curve <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' @rdname a_geom_segment +a_geom_curve <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., curvature = 0.5, angle = 90, @@ -11,15 +11,15 @@ geom_curve <- function(mapping = NULL, data = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomCurve, - position = position, + a_stat = a_stat, + a_geom = a_GeomCurve, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( arrow = arrow, curvature = curvature, @@ -32,19 +32,19 @@ geom_curve <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @include geom-segment.r #' @format NULL #' @usage NULL #' @export -GeomCurve <- ggproto("GeomCurve", GeomSegment, - draw_panel = function(data, panel_scales, coord, curvature = 0.5, angle = 90, +a_GeomCurve <- a_ggproto("a_GeomCurve", a_GeomSegment, + draw_panel = function(data, panel_scales, a_coord, curvature = 0.5, angle = 90, ncp = 5, arrow = NULL, lineend = "butt", na.rm = FALSE) { - if (!coord$is_linear()) { - warning("geom_curve is not implemented for non-linear coordinates", + if (!a_coord$is_linear()) { + warning("a_geom_curve is not implemented for non-linear coordinates", call. = FALSE) } - trans <- coord$transform(data, panel_scales) + trans <- a_coord$transform(data, panel_scales) curveGrob( trans$x, trans$y, trans$xend, trans$yend, default.units = "native", diff --git a/R/geom-defaults.r b/R/geom-defaults.r index 44b11a374c..68b3b59723 100644 --- a/R/geom-defaults.r +++ b/R/geom-defaults.r @@ -1,22 +1,22 @@ #' Modify geom/stat aesthetic defaults for future plots #' -#' @param stat,geom Name of geom/stat to modify (like \code{"point"} or -#' \code{"bin"}), or a Geom/Stat object (like \code{GeomPoint} or -#' \code{StatBin}). +#' @param a_stat,a_geom Name of a_geom/a_stat to modify (like \code{"point"} or +#' \code{"bin"}), or a a_Geom/a_Stat object (like \code{a_GeomPoint} or +#' \code{a_StatBin}). #' @param new Named list of aesthetics. #' @export #' @examples -#' update_geom_defaults("point", list(colour = "darkblue")) -#' ggplot(mtcars, aes(mpg, wt)) + geom_point() -#' update_geom_defaults("point", list(colour = "black")) +#' update_a_geom_defaults("point", list(colour = "darkblue")) +#' a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() +#' update_a_geom_defaults("point", list(colour = "black")) #' @rdname update_defaults -update_geom_defaults <- function(geom, new) { - if (is.character(geom)) { - g <- find_subclass("Geom", geom) - } else if (inherits(geom, "Geom")) { - g <- geom +update_a_geom_defaults <- function(a_geom, new) { + if (is.character(a_geom)) { + g <- find_subclass("a_Geom", a_geom) + } else if (inherits(a_geom, "a_Geom")) { + g <- a_geom } else { - stop('`geom` must be a string (like "point") or a Geom object (like GeomPoint).', + stop('`a_geom` must be a string (like "point") or a a_Geom object (like a_GeomPoint).', call. = FALSE) } @@ -26,13 +26,13 @@ update_geom_defaults <- function(geom, new) { #' @rdname update_defaults #' @export -update_stat_defaults <- function(stat, new) { - if (is.character(stat)) { - g <- find_subclass("Stat", stat) - } else if (inherits(stat, "Stat")) { - g <- stat +update_a_stat_defaults <- function(a_stat, new) { + if (is.character(a_stat)) { + g <- find_subclass("a_Stat", a_stat) + } else if (inherits(a_stat, "a_Stat")) { + g <- a_stat } else { - stop('`stat` must be a string (like "point") or a Stat object (like StatBin).', + stop('`stat` must be a string (like "point") or a Stat object (like a_StatBin).', call. = FALSE) } diff --git a/R/geom-density.r b/R/geom-density.r index 101dce60af..23175c4af1 100644 --- a/R/geom-density.r +++ b/R/geom-density.r @@ -4,30 +4,30 @@ #' with underlying smoothness. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "density")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "density")} #' -#' @seealso See \code{\link{geom_histogram}}, \code{\link{geom_freqpoly}} for +#' @seealso See \code{\link{a_geom_histogram}}, \code{\link{a_geom_freqpoly}} for #' other methods of displaying continuous distribution. -#' See \code{\link{geom_violin}} for a compact density display. -#' @inheritParams layer -#' @inheritParams geom_point -#' @param geom,stat Use to override the default connection between -#' \code{geom_density} and \code{stat_density}. +#' See \code{\link{a_geom_violin}} for a compact density display. +#' @inheritParams a_layer +#' @inheritParams a_geom_point +#' @param a_geom,a_stat Use to override the default connection between +#' \code{a_geom_density} and \code{a_stat_density}. #' @export #' @examples -#' ggplot(diamonds, aes(carat)) + -#' geom_density() +#' a_plot(diamonds, a_aes(carat)) + +#' a_geom_density() #' -#' ggplot(diamonds, aes(carat)) + -#' geom_density(adjust = 1/5) -#' ggplot(diamonds, aes(carat)) + -#' geom_density(adjust = 5) +#' a_plot(diamonds, a_aes(carat)) + +#' a_geom_density(adjust = 1/5) +#' a_plot(diamonds, a_aes(carat)) + +#' a_geom_density(adjust = 5) #' -#' ggplot(diamonds, aes(depth, colour = cut)) + -#' geom_density() + +#' a_plot(diamonds, a_aes(depth, colour = cut)) + +#' a_geom_density() + #' xlim(55, 70) -#' ggplot(diamonds, aes(depth, fill = cut, colour = cut)) + -#' geom_density(alpha = 0.1) + +#' a_plot(diamonds, a_aes(depth, fill = cut, colour = cut)) + +#' a_geom_density(alpha = 0.1) + #' xlim(55, 70) #' #' \donttest{ @@ -36,31 +36,31 @@ #' # density #' #' # Loses marginal densities -#' ggplot(diamonds, aes(carat, fill = cut)) + -#' geom_density(position = "stack") +#' a_plot(diamonds, a_aes(carat, fill = cut)) + +#' a_geom_density(a_position = "stack") #' # Preserves marginal densities -#' ggplot(diamonds, aes(carat, ..count.., fill = cut)) + -#' geom_density(position = "stack") +#' a_plot(diamonds, a_aes(carat, ..count.., fill = cut)) + +#' a_geom_density(a_position = "stack") #' -#' # You can use position="fill" to produce a conditional density estimate -#' ggplot(diamonds, aes(carat, ..count.., fill = cut)) + -#' geom_density(position = "fill") +#' # You can use a_position="fill" to produce a conditional density estimate +#' a_plot(diamonds, a_aes(carat, ..count.., fill = cut)) + +#' a_geom_density(a_position = "fill") #' } -geom_density <- function(mapping = NULL, data = NULL, - stat = "density", position = "identity", +a_geom_density <- function(mapping = NULL, data = NULL, + a_stat = "density", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.a_aes = TRUE) { - layer( + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomDensity, - position = position, + a_stat = a_stat, + a_geom = a_GeomDensity, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -68,14 +68,14 @@ geom_density <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export #' @include geom-ribbon.r -GeomDensity <- ggproto("GeomDensity", GeomArea, +a_GeomDensity <- a_ggproto("a_GeomDensity", a_GeomArea, default_aes = defaults( - aes(fill = NA, weight = 1, colour = "black", alpha = NA), - GeomArea$default_aes + a_aes(fill = NA, weight = 1, colour = "black", alpha = NA), + a_GeomArea$default_aes ) ) diff --git a/R/geom-density2d.r b/R/geom-density2d.r index 66418dd023..b53487c6db 100644 --- a/R/geom-density2d.r +++ b/R/geom-density2d.r @@ -4,54 +4,54 @@ #' results with contours. This can be useful for dealing with overplotting. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "density_2d")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "density_2d")} #' -#' @seealso \code{\link{geom_contour}} for contour drawing geom, -#' \code{\link{stat_sum}} for another way of dealing with overplotting -#' @param geom,stat Use to override the default connection between -#' \code{geom_density_2d} and \code{stat_density_2d}. -#' @inheritParams layer -#' @inheritParams geom_point -#' @inheritParams geom_path +#' @seealso \code{\link{a_geom_contour}} for contour drawing geom, +#' \code{\link{a_stat_sum}} for another way of dealing with overplotting +#' @param a_geom,a_stat Use to override the default connection between +#' \code{a_geom_density_2d} and \code{a_stat_density_2d}. +#' @inheritParams a_layer +#' @inheritParams a_geom_point +#' @inheritParams a_geom_path #' @export #' @examples -#' m <- ggplot(faithful, aes(x = eruptions, y = waiting)) + -#' geom_point() + +#' m <- a_plot(faithful, a_aes(x = eruptions, y = waiting)) + +#' a_geom_point() + #' xlim(0.5, 6) + #' ylim(40, 110) -#' m + geom_density_2d() +#' m + a_geom_density_2d() #' \donttest{ -#' m + stat_density_2d(aes(fill = ..level..), geom = "polygon") +#' m + a_stat_density_2d(a_aes(fill = ..level..), a_geom = "polygon") #' #' set.seed(4393) #' dsmall <- diamonds[sample(nrow(diamonds), 1000), ] -#' d <- ggplot(dsmall, aes(x, y)) -#' # If you map an aesthetic to a categorical variable, you will get a +#' d <- a_plot(dsmall, a_aes(x, y)) +#' # If you map an a_aesthetic to a categorical variable, you will get a #' # set of contours for each value of that variable -#' d + geom_density_2d(aes(colour = cut)) +#' d + a_geom_density_2d(a_aes(colour = cut)) #' #' # If we turn contouring off, we can use use geoms like tiles: -#' d + stat_density_2d(geom = "raster", aes(fill = ..density..), contour = FALSE) +#' d + a_stat_density_2d(a_geom = "raster", a_aes(fill = ..density..), contour = FALSE) #' # Or points: -#' d + stat_density_2d(geom = "point", aes(size = ..density..), n = 20, contour = FALSE) +#' d + a_stat_density_2d(a_geom = "point", a_aes(size = ..density..), n = 20, contour = FALSE) #' } -geom_density_2d <- function(mapping = NULL, data = NULL, - stat = "density2d", position = "identity", +a_geom_density_2d <- function(mapping = NULL, data = NULL, + a_stat = "density2d", a_position = "identity", ..., lineend = "butt", linejoin = "round", linemitre = 1, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomDensity2d, - position = position, + a_stat = a_stat, + a_geom = a_GeomDensity2d, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( lineend = lineend, linejoin = linejoin, @@ -63,15 +63,15 @@ geom_density_2d <- function(mapping = NULL, data = NULL, } #' @export -#' @rdname geom_density_2d +#' @rdname a_geom_density_2d #' @usage NULL -geom_density2d <- geom_density_2d +a_geom_density2d <- a_geom_density_2d -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomDensity2d <- ggproto("GeomDensity2d", GeomPath, - default_aes = aes(colour = "#3366FF", size = 0.5, linetype = 1, alpha = NA) +a_GeomDensity2d <- a_ggproto("a_GeomDensity2d", a_GeomPath, + default_aes = a_aes(colour = "#3366FF", size = 0.5, linetype = 1, alpha = NA) ) diff --git a/R/geom-dotplot.r b/R/geom-dotplot.r index 9cb0c1ceb7..894d3d6958 100644 --- a/R/geom-dotplot.r +++ b/R/geom-dotplot.r @@ -17,21 +17,21 @@ #' to match the number of dots. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "dotplot")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "dotplot")} #' -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_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 #' just touch. Use smaller values for closer, overlapping dots. #' @param dotsize The diameter of the dots relative to \code{binwidth}, default 1. #' @param stackgroups should dots be stacked across groups? This has the effect -#' that \code{position = "stack"} should have, but can't (because this geom has +#' that \code{a_position = "stack"} should have, but can't (because this geom has #' some odd properties). #' @param binaxis The axis to bin along, "x" (default) or "y" #' @param method "dotdensity" (default) for dot-density binning, or -#' "histodot" for fixed bin widths (like stat_bin) +#' "histodot" for fixed bin widths (like a_stat_bin) #' @param binwidth When \code{method} is "dotdensity", this specifies maximum bin #' width. When \code{method} is "histodot", this specifies bin width. #' Defaults to 1/30 of the range of the data @@ -61,59 +61,59 @@ #' @references Wilkinson, L. (1999) Dot plots. The American Statistician, #' 53(3), 276-281. #' @examples -#' ggplot(mtcars, aes(x = mpg)) + geom_dotplot() -#' ggplot(mtcars, aes(x = mpg)) + geom_dotplot(binwidth = 1.5) +#' a_plot(mtcars, a_aes(x = mpg)) + a_geom_dotplot() +#' a_plot(mtcars, a_aes(x = mpg)) + a_geom_dotplot(binwidth = 1.5) #' #' # Use fixed-width bins -#' ggplot(mtcars, aes(x = mpg)) + -#' geom_dotplot(method="histodot", binwidth = 1.5) +#' a_plot(mtcars, a_aes(x = mpg)) + +#' a_geom_dotplot(method="histodot", binwidth = 1.5) #' #' # Some other stacking methods -#' ggplot(mtcars, aes(x = mpg)) + -#' geom_dotplot(binwidth = 1.5, stackdir = "center") -#' ggplot(mtcars, aes(x = mpg)) + -#' geom_dotplot(binwidth = 1.5, stackdir = "centerwhole") +#' a_plot(mtcars, a_aes(x = mpg)) + +#' a_geom_dotplot(binwidth = 1.5, stackdir = "center") +#' a_plot(mtcars, a_aes(x = mpg)) + +#' a_geom_dotplot(binwidth = 1.5, stackdir = "centerwhole") #' #' # y axis isn't really meaningful, so hide it -#' ggplot(mtcars, aes(x = mpg)) + geom_dotplot(binwidth = 1.5) + -#' scale_y_continuous(NULL, breaks = NULL) +#' a_plot(mtcars, a_aes(x = mpg)) + a_geom_dotplot(binwidth = 1.5) + +#' a_scale_y_continuous(NULL, breaks = NULL) #' #' # Overlap dots vertically -#' ggplot(mtcars, aes(x = mpg)) + geom_dotplot(binwidth = 1.5, stackratio = .7) +#' a_plot(mtcars, a_aes(x = mpg)) + a_geom_dotplot(binwidth = 1.5, stackratio = .7) #' #' # Expand dot diameter -#' ggplot(mtcars, aes(x = mpg)) + geom_dotplot(binwidth = 1.5, dotsize = 1.25) +#' a_plot(mtcars, a_aes(x = mpg)) + a_geom_dotplot(binwidth = 1.5, dotsize = 1.25) #' #' \donttest{ #' # Examples with stacking along y axis instead of x -#' ggplot(mtcars, aes(x = 1, y = mpg)) + -#' geom_dotplot(binaxis = "y", stackdir = "center") +#' a_plot(mtcars, a_aes(x = 1, y = mpg)) + +#' a_geom_dotplot(binaxis = "y", stackdir = "center") #' -#' ggplot(mtcars, aes(x = factor(cyl), y = mpg)) + -#' geom_dotplot(binaxis = "y", stackdir = "center") +#' a_plot(mtcars, a_aes(x = factor(cyl), y = mpg)) + +#' a_geom_dotplot(binaxis = "y", stackdir = "center") #' -#' ggplot(mtcars, aes(x = factor(cyl), y = mpg)) + -#' geom_dotplot(binaxis = "y", stackdir = "centerwhole") +#' a_plot(mtcars, a_aes(x = factor(cyl), y = mpg)) + +#' a_geom_dotplot(binaxis = "y", stackdir = "centerwhole") #' -#' ggplot(mtcars, aes(x = factor(vs), fill = factor(cyl), y = mpg)) + -#' geom_dotplot(binaxis = "y", stackdir = "center", position = "dodge") +#' a_plot(mtcars, a_aes(x = factor(vs), fill = factor(cyl), y = mpg)) + +#' a_geom_dotplot(binaxis = "y", stackdir = "center", a_position = "dodge") #' #' # binpositions="all" ensures that the bins are aligned between groups -#' ggplot(mtcars, aes(x = factor(am), y = mpg)) + -#' geom_dotplot(binaxis = "y", stackdir = "center", binpositions="all") +#' a_plot(mtcars, a_aes(x = factor(am), y = mpg)) + +#' a_geom_dotplot(binaxis = "y", stackdir = "center", binpositions="all") #' #' # Stacking multiple groups, with different fill -#' ggplot(mtcars, aes(x = mpg, fill = factor(cyl))) + -#' geom_dotplot(stackgroups = TRUE, binwidth = 1, binpositions = "all") +#' a_plot(mtcars, a_aes(x = mpg, fill = factor(cyl))) + +#' a_geom_dotplot(stackgroups = TRUE, binwidth = 1, binpositions = "all") #' -#' ggplot(mtcars, aes(x = mpg, fill = factor(cyl))) + -#' geom_dotplot(stackgroups = TRUE, binwidth = 1, method = "histodot") +#' a_plot(mtcars, a_aes(x = mpg, fill = factor(cyl))) + +#' a_geom_dotplot(stackgroups = TRUE, binwidth = 1, method = "histodot") #' -#' ggplot(mtcars, aes(x = 1, y = mpg, fill = factor(cyl))) + -#' geom_dotplot(binaxis = "y", stackgroups = TRUE, binwidth = 1, method = "histodot") +#' a_plot(mtcars, a_aes(x = 1, y = mpg, fill = factor(cyl))) + +#' a_geom_dotplot(binaxis = "y", stackgroups = TRUE, binwidth = 1, method = "histodot") #' } -geom_dotplot <- function(mapping = NULL, data = NULL, - position = "identity", +a_geom_dotplot <- function(mapping = NULL, data = NULL, + a_position = "identity", ..., binwidth = NULL, binaxis = "x", @@ -129,25 +129,25 @@ geom_dotplot <- function(mapping = NULL, data = NULL, drop = FALSE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - # If identical(position, "stack") or position is position_stack(), tell them + inherit.a_aes = TRUE) { + # If identical(a_position, "stack") or a_position is a_position_stack(), tell them # to use stackgroups=TRUE instead. Need to use identical() instead of ==, - # because == will fail if object is position_stack() or position_dodge() - if (!is.null(position) && - (identical(position, "stack") || (inherits(position, "PositionStack")))) - message("position=\"stack\" doesn't work properly with geom_dotplot. Use stackgroups=TRUE instead.") + # because == will fail if object is a_position_stack() or a_position_dodge() + if (!is.null(a_position) && + (identical(a_position, "stack") || (inherits(a_position, "a_PositionStack")))) + message("a_position=\"stack\" doesn't work properly with a_geom_dotplot. Use stackgroups=TRUE instead.") if (stackgroups && method == "dotdensity" && binpositions == "bygroup") - message('geom_dotplot called with stackgroups=TRUE and method="dotdensity". You probably want to set binpositions="all"') + message('a_geom_dotplot called with stackgroups=TRUE and method="dotdensity". You probably want to set binpositions="all"') - layer( + a_layer( data = data, mapping = mapping, - stat = StatBindot, - geom = GeomDotplot, - position = position, + a_stat = a_StatBindot, + a_geom = a_GeomDotplot, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, # Need to make sure that the binaxis goes to both the stat and the geom params = list( binaxis = binaxis, @@ -168,19 +168,19 @@ geom_dotplot <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomDotplot <- ggproto("GeomDotplot", Geom, +a_GeomDotplot <- a_ggproto("a_GeomDotplot", a_Geom, required_aes = c("x", "y"), non_missing_aes = c("size", "shape"), - default_aes = aes(colour = "black", fill = "black", alpha = NA), + default_aes = a_aes(colour = "black", fill = "black", alpha = NA), setup_data = function(data, params) { data$width <- data$width %||% - params$width %||% (resolution(data$x, FALSE) * 0.9) + params$width %||% (a_resolution(data$x, FALSE) * 0.9) # Set up the stacking function and range if (is.null(params$stackdir) || params$stackdir == "up") { @@ -250,17 +250,17 @@ GeomDotplot <- ggproto("GeomDotplot", Geom, }, - draw_group = function(data, panel_scales, coord, na.rm = FALSE, + draw_group = function(data, panel_scales, a_coord, na.rm = FALSE, binaxis = "x", stackdir = "up", stackratio = 1, dotsize = 1, stackgroups = FALSE) { - if (!coord$is_linear()) { - warning("geom_dotplot does not work properly with non-linear coordinates.") + if (!a_coord$is_linear()) { + warning("a_geom_dotplot does not work properly with non-linear coordinates.") } - tdata <- coord$transform(data, panel_scales) + tdata <- a_coord$transform(data, panel_scales) - # Swap axes if using coord_flip - if (inherits(coord, "CoordFlip")) + # Swap axes if using a_coord_flip + if (inherits(a_coord, "a_CoordFlip")) binaxis <- ifelse(binaxis == "x", "y", "x") if (binaxis == "x") { @@ -281,5 +281,5 @@ GeomDotplot <- ggproto("GeomDotplot", Geom, ) }, - draw_key = draw_key_dotplot + draw_key = a_draw_key_dotplot ) diff --git a/R/geom-errorbar.r b/R/geom-errorbar.r index 0df3ad5fe4..df0f43a1c8 100644 --- a/R/geom-errorbar.r +++ b/R/geom-errorbar.r @@ -1,19 +1,19 @@ #' @export -#' @rdname geom_linerange -geom_errorbar <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' @rdname a_geom_linerange +a_geom_errorbar <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomErrorbar, - position = position, + a_stat = a_stat, + a_geom = a_GeomErrorbar, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -21,29 +21,29 @@ geom_errorbar <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomErrorbar <- ggproto("GeomErrorbar", Geom, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, width = 0.5, +a_GeomErrorbar <- a_ggproto("a_GeomErrorbar", a_Geom, + default_aes = a_aes(colour = "black", size = 0.5, linetype = 1, width = 0.5, alpha = NA), - draw_key = draw_key_path, + draw_key = a_draw_key_path, required_aes = c("x", "ymin", "ymax"), setup_data = function(data, params) { data$width <- data$width %||% - params$width %||% (resolution(data$x, FALSE) * 0.9) + params$width %||% (a_resolution(data$x, FALSE) * 0.9) transform(data, xmin = x - width / 2, xmax = x + width / 2, width = NULL ) }, - draw_panel = function(data, panel_scales, coord, width = NULL) { - GeomPath$draw_panel(data.frame( + draw_panel = function(data, panel_scales, a_coord, width = NULL) { + a_GeomPath$draw_panel(data.frame( x = as.vector(rbind(data$xmin, data$xmax, NA, data$x, data$x, NA, data$xmin, data$xmax)), y = as.vector(rbind(data$ymax, data$ymax, NA, data$ymax, data$ymin, NA, data$ymin, data$ymin)), colour = rep(data$colour, each = 8), @@ -53,6 +53,6 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom, group = rep(1:(nrow(data)), each = 8), stringsAsFactors = FALSE, row.names = 1:(nrow(data) * 8) - ), panel_scales, coord) + ), panel_scales, a_coord) } ) diff --git a/R/geom-errorbarh.r b/R/geom-errorbarh.r index 06d84eb225..4cd4af67ac 100644 --- a/R/geom-errorbarh.r +++ b/R/geom-errorbarh.r @@ -1,11 +1,11 @@ #' Horizontal error bars #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "errorbarh")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "errorbarh")} #' -#' @seealso \code{\link{geom_errorbar}}: vertical error bars -#' @inheritParams layer -#' @inheritParams geom_point +#' @seealso \code{\link{a_geom_errorbar}}: vertical error bars +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @export #' @examples #' df <- data.frame( @@ -17,25 +17,25 @@ #' #' # Define the top and bottom of the errorbars #' -#' p <- ggplot(df, aes(resp, trt, colour = group)) -#' p + geom_point() + -#' geom_errorbarh(aes(xmax = resp + se, xmin = resp - se)) -#' p + geom_point() + -#' geom_errorbarh(aes(xmax = resp + se, xmin = resp - se, height = .2)) -geom_errorbarh <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' p <- a_plot(df, a_aes(resp, trt, colour = group)) +#' p + a_geom_point() + +#' a_geom_errorbarh(a_aes(xmax = resp + se, xmin = resp - se)) +#' p + a_geom_point() + +#' a_geom_errorbarh(a_aes(xmax = resp + se, xmin = resp - se, height = .2)) +a_geom_errorbarh <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomErrorbarh, - position = position, + a_stat = a_stat, + a_geom = a_GeomErrorbarh, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -44,21 +44,21 @@ geom_errorbarh <- function(mapping = NULL, data = NULL, } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomErrorbarh <- ggproto("GeomErrorbarh", Geom, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, height = 0.5, +a_GeomErrorbarh <- a_ggproto("a_GeomErrorbarh", a_Geom, + default_aes = a_aes(colour = "black", size = 0.5, linetype = 1, height = 0.5, alpha = NA), - draw_key = draw_key_path, + draw_key = a_draw_key_path, required_aes = c("x", "xmin", "xmax", "y"), setup_data = function(data, params) { data$height <- data$height %||% - params$height %||% (resolution(data$y, FALSE) * 0.9) + params$height %||% (a_resolution(data$y, FALSE) * 0.9) transform(data, ymin = y - height / 2, ymax = y + height / 2, height = NULL @@ -66,7 +66,7 @@ GeomErrorbarh <- ggproto("GeomErrorbarh", Geom, }, draw_panel = function(data, panel_scales, coord, height = NULL) { - GeomPath$draw_panel(data.frame( + a_GeomPath$draw_panel(data.frame( x = as.vector(rbind(data$xmax, data$xmax, NA, data$xmax, data$xmin, NA, data$xmin, data$xmin)), y = as.vector(rbind(data$ymin, data$ymax, NA, data$y, data$y, NA, data$ymin, data$ymax)), colour = rep(data$colour, each = 8), diff --git a/R/geom-freqpoly.r b/R/geom-freqpoly.r index bf6f9f39ef..d9164a51ee 100644 --- a/R/geom-freqpoly.r +++ b/R/geom-freqpoly.r @@ -1,25 +1,25 @@ #' @export -#' @rdname geom_histogram -geom_freqpoly <- function(mapping = NULL, data = NULL, - stat = "bin", position = "identity", +#' @rdname a_geom_histogram +a_geom_freqpoly <- function(mapping = NULL, data = NULL, + a_stat = "bin", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.a_aes = TRUE) { params <- list(na.rm = na.rm, ...) - if (identical(stat, "bin")) { + if (identical(a_stat, "bin")) { params$pad <- TRUE } - layer( + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomPath, - position = position, + a_stat = a_stat, + a_geom = a_GeomPath, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = params ) } diff --git a/R/geom-hex.r b/R/geom-hex.r index e8c904f709..d6224081bc 100644 --- a/R/geom-hex.r +++ b/R/geom-hex.r @@ -1,43 +1,43 @@ #' Hexagon binning. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "hex")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "hex")} #' -#' @seealso \code{\link{stat_bin2d}} for rectangular binning -#' @param geom,stat Override the default connection between \code{geom_hex} and -#' \code{stat_binhex.} +#' @seealso \code{\link{a_stat_bin2d}} for rectangular binning +#' @param a_geom,a_stat Override the default connection between \code{a_geom_hex} and +#' \code{a_stat_binhex.} #' @export -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @export #' @examples -#' d <- ggplot(diamonds, aes(carat, price)) -#' d + geom_hex() +#' d <- a_plot(diamonds, a_aes(carat, price)) +#' d + a_geom_hex() #' #' \donttest{ #' # You can control the size of the bins by specifying the number of #' # bins in each direction: -#' d + geom_hex(bins = 10) -#' d + geom_hex(bins = 30) +#' d + a_geom_hex(bins = 10) +#' d + a_geom_hex(bins = 30) #' #' # Or by specifying the width of the bins -#' d + geom_hex(binwidth = c(1, 1000)) -#' d + geom_hex(binwidth = c(.1, 500)) +#' d + a_geom_hex(binwidth = c(1, 1000)) +#' d + a_geom_hex(binwidth = c(.1, 500)) #' } -geom_hex <- function(mapping = NULL, data = NULL, - stat = "binhex", position = "identity", +a_geom_hex <- function(mapping = NULL, data = NULL, + a_stat = "binhex", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomHex, - position = position, + a_stat = a_stat, + a_geom = a_GeomHex, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -46,28 +46,28 @@ geom_hex <- function(mapping = NULL, data = NULL, } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomHex <- ggproto("GeomHex", Geom, - draw_group = function(data, panel_scales, coord) { - if (!inherits(coord, "CoordCartesian")) { - stop("geom_hex() only works with Cartesian coordinates", call. = FALSE) +a_GeomHex <- a_ggproto("a_GeomHex", a_Geom, + draw_group = function(data, panel_scales, a_coord) { + if (!inherits(a_coord, "a_CoordCartesian")) { + stop("a_geom_hex() only works with Cartesian coordinates", call. = FALSE) } - coord <- coord$transform(data, panel_scales) + a_coord <- a_coord$transform(data, panel_scales) ggname("geom_hex", hexGrob( - coord$x, coord$y, colour = coord$colour, - fill = alpha(coord$fill, coord$alpha) + a_coord$x, a_coord$y, colour = a_coord$colour, + fill = alpha(a_coord$fill, a_coord$alpha) )) }, required_aes = c("x", "y"), - default_aes = aes(colour = NA, fill = "grey50", size = 0.5, alpha = NA), + default_aes = a_aes(colour = NA, fill = "grey50", size = 0.5, alpha = NA), - draw_key = draw_key_polygon + draw_key = a_draw_key_polygon ) @@ -83,8 +83,8 @@ GeomHex <- ggproto("GeomHex", Geom, hexGrob <- function(x, y, size = rep(1, length(x)), colour = "grey50", fill = "grey90") { stopifnot(length(y) == length(x)) - dx <- resolution(x, FALSE) - dy <- resolution(y, FALSE) / sqrt(3) / 2 * 1.15 + dx <- a_resolution(x, FALSE) + dy <- a_resolution(y, FALSE) / sqrt(3) / 2 * 1.15 hexC <- hexbin::hexcoords(dx, dy, n = 1) diff --git a/R/geom-histogram.r b/R/geom-histogram.r index a6eeaf2061..7f3da5de3b 100644 --- a/R/geom-histogram.r +++ b/R/geom-histogram.r @@ -4,90 +4,90 @@ #' of observations in each bin. Histograms use bars; frequency polygons use #' lines. #' -#' By default, \code{stat_bin} uses 30 bins - this is not a good default, +#' By default, \code{a_stat_bin} uses 30 bins - this is not a good default, #' but the idea is to get you experimenting with different binwidths. You #' may need to look at a few to uncover the full story behind your data. #' #' @section Aesthetics: -#' \code{geom_histogram} uses the same aesthetics as \code{geom_bar}; -#' \code{geom_freqpoly} uses the same aesthetics as \code{geom_line}. +#' \code{a_geom_histogram} uses the same aesthetics as \code{a_geom_bar}; +#' \code{a_geom_freqpoly} uses the same aesthetics as \code{a_geom_line}. #' #' @export -#' @inheritParams layer -#' @inheritParams geom_point -#' @param geom,stat Use to override the default connection between -#' \code{geom_histogram}/\code{geom_freqpoly} and \code{stat_bin}. +#' @inheritParams a_layer +#' @inheritParams a_geom_point +#' @param a_geom,a_stat Use to override the default connection between +#' \code{a_geom_histogram}/\code{a_geom_freqpoly} and \code{a_stat_bin}. #' @examples -#' ggplot(diamonds, aes(carat)) + -#' geom_histogram() -#' ggplot(diamonds, aes(carat)) + -#' geom_histogram(binwidth = 0.01) -#' ggplot(diamonds, aes(carat)) + -#' geom_histogram(bins = 200) +#' a_plot(diamonds, a_aes(carat)) + +#' a_geom_histogram() +#' a_plot(diamonds, a_aes(carat)) + +#' a_geom_histogram(binwidth = 0.01) +#' a_plot(diamonds, a_aes(carat)) + +#' a_geom_histogram(bins = 200) #' #' # Rather than stacking histograms, it's easier to compare frequency #' # polygons -#' ggplot(diamonds, aes(price, fill = cut)) + -#' geom_histogram(binwidth = 500) -#' ggplot(diamonds, aes(price, colour = cut)) + -#' geom_freqpoly(binwidth = 500) +#' a_plot(diamonds, a_aes(price, fill = cut)) + +#' a_geom_histogram(binwidth = 500) +#' a_plot(diamonds, a_aes(price, colour = cut)) + +#' a_geom_freqpoly(binwidth = 500) #' #' # To make it easier to compare distributions with very different counts, #' # put density on the y axis instead of the default count -#' ggplot(diamonds, aes(price, ..density.., colour = cut)) + -#' geom_freqpoly(binwidth = 500) +#' a_plot(diamonds, a_aes(price, ..density.., colour = cut)) + +#' a_geom_freqpoly(binwidth = 500) #' #' if (require("ggplot2movies")) { #' # Often we don't want the height of the bar to represent the #' # count of observations, but the sum of some other variable. #' # For example, the following plot shows the number of movies #' # in each rating. -#' m <- ggplot(movies, aes(rating)) -#' m + geom_histogram(binwidth = 0.1) +#' m <- a_plot(movies, a_aes(rating)) +#' m + a_geom_histogram(binwidth = 0.1) #' #' # If, however, we want to see the number of votes cast in each #' # category, we need to weight by the votes variable -#' m + geom_histogram(aes(weight = votes), binwidth = 0.1) + ylab("votes") +#' m + a_geom_histogram(a_aes(weight = votes), binwidth = 0.1) + ylab("votes") #' #' # For transformed scales, binwidth applies to the transformed data. #' # The bins have constant width on the transformed scale. -#' m + geom_histogram() + scale_x_log10() -#' m + geom_histogram(binwidth = 0.05) + scale_x_log10() +#' m + a_geom_histogram() + a_scale_x_log10() +#' m + a_geom_histogram(binwidth = 0.05) + a_scale_x_log10() #' #' # For transformed coordinate systems, the binwidth applies to the -#' # raw data. The bins have constant width on the original scale. +#' # raw data. The bins have constant width on the original a_scale. #' #' # Using log scales does not work here, because the first -#' # bar is anchored at zero, and so when transformed becomes negative +#' # bar is anchored at zero, and so whens transformed becomes negative #' # infinity. This is not a problem when transforming the scales, because #' # no observations have 0 ratings. -#' m + geom_histogram(origin = 0) + coord_trans(x = "log10") +#' m + a_geom_histogram(origin = 0) + ggplot2Animint:::a_coord_trans(x = "log10") #' # Use origin = 0, to make sure we don't take sqrt of negative values -#' m + geom_histogram(origin = 0) + coord_trans(x = "sqrt") +#' m + a_geom_histogram(origin = 0) + ggplot2Animint:::a_coord_trans(x = "sqrt") #' #' # You can also transform the y axis. Remember that the base of the bars #' # has value 0, so log transformations are not appropriate -#' m <- ggplot(movies, aes(x = rating)) -#' m + geom_histogram(binwidth = 0.5) + scale_y_sqrt() +#' m <- a_plot(movies, a_aes(x = rating)) +#' m + a_geom_histogram(binwidth = 0.5) + a_scale_y_sqrt() #' } #' rm(movies) -geom_histogram <- function(mapping = NULL, data = NULL, - stat = "bin", position = "stack", +a_geom_histogram <- function(mapping = NULL, data = NULL, + a_stat = "bin", a_position = "stack", ..., binwidth = NULL, bins = NULL, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.a_aes = TRUE) { - layer( + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomBar, - position = position, + a_stat = a_stat, + a_geom = a_GeomBar, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( binwidth = binwidth, bins = bins, diff --git a/R/geom-hline.r b/R/geom-hline.r index 2dc749619a..ff46a82d87 100644 --- a/R/geom-hline.r +++ b/R/geom-hline.r @@ -2,8 +2,8 @@ NULL #' @export -#' @rdname geom_abline -geom_hline <- function(mapping = NULL, data = NULL, +#' @rdname a_geom_abline +a_geom_hline <- function(mapping = NULL, data = NULL, ..., yintercept, na.rm = FALSE, @@ -12,18 +12,18 @@ geom_hline <- function(mapping = NULL, data = NULL, # Act like an annotation if (!missing(yintercept)) { data <- data.frame(yintercept = yintercept) - mapping <- aes(yintercept = yintercept) + mapping <- a_aes(yintercept = yintercept) show.legend <- FALSE } - layer( + a_layer( data = data, mapping = mapping, - stat = StatIdentity, - geom = GeomHline, - position = PositionIdentity, + a_stat = a_StatIdentity, + a_geom = a_GeomHline, + a_position = a_PositionIdentity, show.legend = show.legend, - inherit.aes = FALSE, + inherit.a_aes = FALSE, params = list( na.rm = na.rm, ... @@ -31,24 +31,24 @@ geom_hline <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomHline <- ggproto("GeomHline", Geom, - draw_panel = function(data, panel_scales, coord) { - ranges <- coord$range(panel_scales) +a_GeomHline <- a_ggproto("a_GeomHline", a_Geom, + draw_panel = function(data, panel_scales, a_coord) { + ranges <- a_coord$range(panel_scales) data$x <- ranges$x[1] data$xend <- ranges$x[2] data$y <- data$yintercept data$yend <- data$yintercept - GeomSegment$draw_panel(unique(data), panel_scales, coord) + a_GeomSegment$draw_panel(unique(data), panel_scales, a_coord) }, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), + default_aes = a_aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), required_aes = "yintercept", - draw_key = draw_key_path + draw_key = a_draw_key_path ) diff --git a/R/geom-jitter.r b/R/geom-jitter.r index 6254b402e7..0579c324a1 100644 --- a/R/geom-jitter.r +++ b/R/geom-jitter.r @@ -1,59 +1,59 @@ #' Points, jittered to reduce overplotting. #' -#' The jitter geom is a convenient default for geom_point with position = +#' The jitter geom is a convenient default for a_geom_point with a_position = #' 'jitter'. It's a useful way of handling overplotting caused by discreteness #' in smaller datasets. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "point")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "point")} #' -#' @inheritParams layer -#' @inheritParams geom_point -#' @inheritParams position_jitter +#' @inheritParams a_layer +#' @inheritParams a_geom_point +#' @inheritParams a_position_jitter #' @seealso -#' \code{\link{geom_point}} for regular, unjittered points, -#' \code{\link{geom_boxplot}} for another way of looking at the conditional +#' \code{\link{a_geom_point}} for regular, unjittered points, +#' \code{\link{a_geom_boxplot}} for another way of looking at the conditional #' distribution of a variable #' @export #' @examples -#' p <- ggplot(mpg, aes(cyl, hwy)) -#' p + geom_point() -#' p + geom_jitter() +#' p <- a_plot(mpg, a_aes(cyl, hwy)) +#' p + a_geom_point() +#' p + a_geom_jitter() #' -#' # Add aesthetic mappings -#' p + geom_jitter(aes(colour = class)) +#' # Add a_aesthetic mappings +#' p + a_geom_jitter(a_aes(colour = class)) #' #' # Use smaller width/height to emphasise categories -#' ggplot(mpg, aes(cyl, hwy)) + geom_jitter() -#' ggplot(mpg, aes(cyl, hwy)) + geom_jitter(width = 0.25) +#' a_plot(mpg, a_aes(cyl, hwy)) + a_geom_jitter() +#' a_plot(mpg, a_aes(cyl, hwy)) + a_geom_jitter(width = 0.25) #' #' # Use larger width/height to completely smooth away discreteness -#' ggplot(mpg, aes(cty, hwy)) + geom_jitter() -#' ggplot(mpg, aes(cty, hwy)) + geom_jitter(width = 0.5, height = 0.5) -geom_jitter <- function(mapping = NULL, data = NULL, - stat = "identity", position = "jitter", +#' a_plot(mpg, a_aes(cty, hwy)) + a_geom_jitter() +#' a_plot(mpg, a_aes(cty, hwy)) + a_geom_jitter(width = 0.5, height = 0.5) +a_geom_jitter <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "jitter", ..., width = NULL, height = NULL, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.a_aes = TRUE) { if (!missing(width) || !missing(height)) { - if (!missing(position)) { - stop("Specify either `position` or `width`/`height`", call. = FALSE) + if (!missing(a_position)) { + stop("Specify either `a_position` or `width`/`height`", call. = FALSE) } - position <- position_jitter(width = width, height = height) + a_position <- a_position_jitter(width = width, height = height) } - layer( + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomPoint, - position = position, + a_stat = a_stat, + a_geom = a_GeomPoint, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... diff --git a/R/geom-label.R b/R/geom-label.R index 285c827631..4539506da7 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -1,41 +1,41 @@ #' @export -#' @rdname geom_text -#' @param label.padding Amount of padding around label. Defaults to 0.25 lines. -#' @param label.r Radius of rounded corners. Defaults to 0.15 lines. -#' @param label.size Size of label border, in mm. -geom_label <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' @rdname a_geom_text +#' @param a_label.padding Amount of padding around a_label. Defaults to 0.25 lines. +#' @param a_label.r Radius of rounded corners. Defaults to 0.15 lines. +#' @param a_label.size Size of label border, in mm. +a_geom_label <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., parse = FALSE, nudge_x = 0, nudge_y = 0, - label.padding = unit(0.25, "lines"), - label.r = unit(0.15, "lines"), - label.size = 0.25, + a_label.padding = unit(0.25, "lines"), + a_label.r = unit(0.15, "lines"), + a_label.size = 0.25, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.a_aes = TRUE) { if (!missing(nudge_x) || !missing(nudge_y)) { - if (!missing(position)) { - stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE) + if (!missing(a_position)) { + stop("Specify either `a_position` or `nudge_x`/`nudge_y`", call. = FALSE) } - position <- position_nudge(nudge_x, nudge_y) + a_position <- a_position_nudge(nudge_x, nudge_y) } - layer( + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomLabel, - position = position, + a_stat = a_stat, + a_geom = a_GeomLabel, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( parse = parse, - label.padding = label.padding, - label.r = label.r, - label.size = label.size, + a_label.padding = a_label.padding, + a_label.r = a_label.r, + a_label.size = a_label.size, na.rm = na.rm, ... ) @@ -43,30 +43,30 @@ geom_label <- function(mapping = NULL, data = NULL, } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomLabel <- ggproto("GeomLabel", Geom, - required_aes = c("x", "y", "label"), +a_GeomLabel <- a_ggproto("a_GeomLabel", a_Geom, + required_aes = c("x", "y", "a_label"), - default_aes = aes( + default_aes = a_aes( colour = "black", fill = "white", size = 3.88, angle = 0, hjust = 0.5, vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2 ), - draw_panel = function(self, data, panel_scales, coord, parse = FALSE, + draw_panel = function(self, data, panel_scales, a_coord, parse = FALSE, na.rm = FALSE, - label.padding = unit(0.25, "lines"), - label.r = unit(0.15, "lines"), - label.size = 0.25) { - lab <- data$label + a_label.padding = unit(0.25, "lines"), + a_label.r = unit(0.15, "lines"), + a_label.size = 0.25) { + lab <- data$a_label if (parse) { lab <- parse(text = as.character(lab)) } - data <- coord$transform(data, panel_scales) + data <- a_coord$transform(data, panel_scales) if (is.character(data$vjust)) { data$vjust <- compute_just(data$vjust, data$y) } @@ -76,12 +76,12 @@ GeomLabel <- ggproto("GeomLabel", Geom, grobs <- lapply(1:nrow(data), function(i) { row <- data[i, , drop = FALSE] - labelGrob(lab[i], + a_labelGrob(lab[i], x = unit(row$x, "native"), y = unit(row$y, "native"), just = c(row$hjust, row$vjust), - padding = label.padding, - r = label.r, + padding = a_label.padding, + r = a_label.r, text.gp = gpar( col = row$colour, fontsize = row$size * .pt, @@ -92,7 +92,7 @@ GeomLabel <- ggproto("GeomLabel", Geom, rect.gp = gpar( col = row$colour, fill = alpha(row$fill, row$alpha), - lwd = label.size * .pt + lwd = a_label.size * .pt ) ) }) @@ -101,32 +101,32 @@ GeomLabel <- ggproto("GeomLabel", Geom, ggname("geom_label", grobTree(children = grobs)) }, - draw_key = draw_key_label + draw_key = a_draw_key_label ) -labelGrob <- function(label, x = unit(0.5, "npc"), y = unit(0.5, "npc"), +a_labelGrob <- function(a_label, x = unit(0.5, "npc"), y = unit(0.5, "npc"), just = "center", padding = unit(0.25, "lines"), r = unit(0.1, "snpc"), default.units = "npc", name = NULL, text.gp = gpar(), rect.gp = gpar(fill = "white"), vp = NULL) { - stopifnot(length(label) == 1) + stopifnot(length(a_label) == 1) if (!is.unit(x)) x <- unit(x, default.units) if (!is.unit(y)) y <- unit(y, default.units) - gTree(label = label, x = x, y = y, just = just, padding = padding, r = r, - name = name, text.gp = text.gp, rect.gp = rect.gp, vp = vp, cl = "labelgrob") + gTree(a_label = a_label, x = x, y = y, just = just, padding = padding, r = r, + name = name, text.gp = text.gp, rect.gp = rect.gp, vp = vp, cl = "a_labelgrob") } #' @export -makeContent.labelgrob <- function(x) { +makeContent.a_labelgrob <- function(x) { hj <- resolveHJust(x$just, NULL) vj <- resolveVJust(x$just, NULL) t <- textGrob( - x$label, + x$a_label, x$x + 2 * (0.5 - hj) * x$padding, x$y + 2 * (0.5 - vj) * x$padding, just = c(hj, vj), diff --git a/R/geom-linerange.r b/R/geom-linerange.r index c1a96cf208..ac6121afd5 100644 --- a/R/geom-linerange.r +++ b/R/geom-linerange.r @@ -4,17 +4,17 @@ #' \code{ymin} and \code{ymax}. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "linerange")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "linerange")} #' #' @param fatten A multiplicative factor used to increase the size of the -#' middle bar in \code{geom_crossbar()} and the middle point in -#' \code{geom_pointrange()}. +#' middle bar in \code{a_geom_crossbar()} and the middle point in +#' \code{a_geom_pointrange()}. #' @seealso -#' \code{\link{stat_summary}} for examples of these guys in use, -#' \code{\link{geom_smooth}} for continuous analog +#' \code{\link{a_stat_summary}} for examples of these guys in use, +#' \code{\link{a_geom_smooth}} for continuous analog #' @export -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @examples #' #' # Create a simple example dataset #' df <- data.frame( @@ -25,44 +25,44 @@ #' lower = c(0.8, 4.6, 2.4, 3.6) #' ) #' -#' p <- ggplot(df, aes(trt, resp, colour = group)) -#' p + geom_linerange(aes(ymin = lower, ymax = upper)) -#' p + geom_pointrange(aes(ymin = lower, ymax = upper)) -#' p + geom_crossbar(aes(ymin = lower, ymax = upper), width = 0.2) -#' p + geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2) +#' p <- a_plot(df, a_aes(trt, resp, colour = group)) +#' p + a_geom_linerange(a_aes(ymin = lower, ymax = upper)) +#' p + a_geom_pointrange(a_aes(ymin = lower, ymax = upper)) +#' p + a_geom_crossbar(a_aes(ymin = lower, ymax = upper), width = 0.2) +#' p + a_geom_errorbar(a_aes(ymin = lower, ymax = upper), width = 0.2) #' #' # Draw lines connecting group means #' p + -#' geom_line(aes(group = group)) + -#' geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2) +#' a_geom_line(a_aes(group = group)) + +#' a_geom_errorbar(a_aes(ymin = lower, ymax = upper), width = 0.2) #' #' # If you want to dodge bars and errorbars, you need to manually #' # specify the dodge width -#' p <- ggplot(df, aes(trt, resp, fill = group)) +#' p <- a_plot(df, a_aes(trt, resp, fill = group)) #' p + -#' geom_bar(position = "dodge", stat = "identity") + -#' geom_errorbar(aes(ymin = lower, ymax = upper), position = "dodge", width = 0.25) +#' a_geom_bar(a_position = "dodge", a_stat = "identity") + +#' a_geom_errorbar(a_aes(ymin = lower, ymax = upper), a_position = "dodge", width = 0.25) #' #' # Because the bars and errorbars have different widths #' # we need to specify how wide the objects we are dodging are -#' dodge <- position_dodge(width=0.9) +#' dodge <- a_position_dodge(width=0.9) #' p + -#' geom_bar(position = dodge, stat = "identity") + -#' geom_errorbar(aes(ymin = lower, ymax = upper), position = dodge, width = 0.25) -geom_linerange <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' a_geom_bar(a_position = dodge, a_stat = "identity") + +#' a_geom_errorbar(a_aes(ymin = lower, ymax = upper), a_position = dodge, width = 0.25) +a_geom_linerange <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomLinerange, - position = position, + a_stat = a_stat, + a_geom = a_GeomLinerange, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -70,19 +70,19 @@ geom_linerange <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomLinerange <- ggproto("GeomLinerange", Geom, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), +a_GeomLinerange <- a_ggproto("a_GeomLinerange", a_Geom, + default_aes = a_aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), - draw_key = draw_key_vpath, + draw_key = a_draw_key_vpath, required_aes = c("x", "ymin", "ymax"), - draw_panel = function(data, panel_scales, coord) { + draw_panel = function(data, panel_scales, a_coord) { data <- transform(data, xend = x, y = ymin, yend = ymax) - ggname("geom_linerange", GeomSegment$draw_panel(data, panel_scales, coord)) + ggname("geom_linerange", a_GeomSegment$draw_panel(data, panel_scales, a_coord)) } ) diff --git a/R/geom-map.r b/R/geom-map.r index 5256e64259..913d5444d0 100644 --- a/R/geom-map.r +++ b/R/geom-map.r @@ -6,17 +6,17 @@ NULL #' Does not affect position scales. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "map")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "map")} #' #' @export #' @param map Data frame that contains the map coordinates. This will -#' typically be created using \code{\link{fortify}} on a spatial object. +#' typically be created using \code{\link{a_fortify}} on a spatial object. #' It must contain columns \code{x} or \code{long}, \code{y} or #' \code{lat}, and \code{region} or \code{id}. -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @examples -#' # When using geom_polygon, you will typically need two data frames: +#' # When using a_geom_polygon, you will typically need two data frames: #' # one contains the coordinates of each polygon (positions), and the #' # other the values associated with each polygon (values). An id #' # variable links the two together @@ -36,37 +36,37 @@ NULL #' 2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2) #' ) #' -#' ggplot(values) + geom_map(aes(map_id = id), map = positions) + -#' expand_limits(positions) -#' ggplot(values, aes(fill = value)) + -#' geom_map(aes(map_id = id), map = positions) + -#' expand_limits(positions) -#' ggplot(values, aes(fill = value)) + -#' geom_map(aes(map_id = id), map = positions) + -#' expand_limits(positions) + ylim(0, 3) +#' a_plot(values) + a_geom_map(a_aes(map_id = id), map = positions) + +#' ggplot2Animint:::expand_limits(positions) +#' a_plot(values, a_aes(fill = value)) + +#' a_geom_map(a_aes(map_id = id), map = positions) + +#' ggplot2Animint:::expand_limits(positions) +#' a_plot(values, a_aes(fill = value)) + +#' a_geom_map(a_aes(map_id = id), map = positions) + +#' ggplot2Animint:::expand_limits(positions) + ylim(0, 3) #' #' # Better example #' crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests) #' crimesm <- reshape2::melt(crimes, id = 1) #' if (require(maps)) { #' states_map <- map_data("state") -#' ggplot(crimes, aes(map_id = state)) + -#' geom_map(aes(fill = Murder), map = states_map) + -#' expand_limits(x = states_map$long, y = states_map$lat) +#' a_plot(crimes, a_aes(map_id = state)) + +#' a_geom_map(a_aes(fill = Murder), map = states_map) + +#' ggplot2Animint:::expand_limits(x = states_map$long, y = states_map$lat) #' -#' last_plot() + coord_map() -#' ggplot(crimesm, aes(map_id = state)) + -#' geom_map(aes(fill = value), map = states_map) + -#' expand_limits(x = states_map$long, y = states_map$lat) + -#' facet_wrap( ~ variable) +#' last_plot() + ggplot2Animint:::a_coord_map() +#' a_plot(crimesm, a_aes(map_id = state)) + +#' a_geom_map(a_aes(fill = value), map = states_map) + +#' ggplot2Animint:::expand_limits(x = states_map$long, y = states_map$lat) + +#' ggplot2Animint:::a_facet_wrap( ~ variable) #' } -geom_map <- function(mapping = NULL, data = NULL, - stat = "identity", +a_geom_map <- function(mapping = NULL, data = NULL, + a_stat = "identity", ..., map, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.a_aes = TRUE) { # Get map input into correct form stopifnot(is.data.frame(map)) if (!is.null(map$lat)) map$y <- map$lat @@ -74,14 +74,14 @@ geom_map <- function(mapping = NULL, data = NULL, if (!is.null(map$region)) map$id <- map$region stopifnot(all(c("x", "y", "id") %in% names(map))) - layer( + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomMap, - position = PositionIdentity, + a_stat = a_stat, + a_geom = a_GeomMap, + a_position = a_PositionIdentity, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( map = map, na.rm = na.rm, @@ -90,12 +90,12 @@ geom_map <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomMap <- ggproto("GeomMap", GeomPolygon, - draw_panel = function(data, panel_scales, coord, map) { +a_GeomMap <- a_ggproto("a_GeomMap", a_GeomPolygon, + draw_panel = function(data, panel_scales, a_coord, map) { # Only use matching data and map ids common <- intersect(data$map_id, map$id) data <- data[data$map_id %in% common, , drop = FALSE] @@ -103,7 +103,7 @@ GeomMap <- ggproto("GeomMap", GeomPolygon, # Munch, then set up id variable for polygonGrob - # must be sequential integers - coords <- coord_munch(coord, map, panel_scales) + coords <- a_coord_munch(a_coord, map, panel_scales) coords$group <- coords$group %||% coords$id grob_id <- match(coords$group, unique(coords$group)) diff --git a/R/geom-path.r b/R/geom-path.r index 79b4282d9e..e39322d02b 100644 --- a/R/geom-path.r +++ b/R/geom-path.r @@ -1,59 +1,59 @@ #' Connect observations. #' -#' \code{geom_path()} connects the observations in the order in which they appear -#' in the data. \code{geom_line()} connects them in order of the variable on the -#' x axis. \code{geom_step()} creates a stairstep plot, highlighting exactly +#' \code{a_geom_path()} connects the observations in the order in which they appear +#' in the data. \code{a_geom_line()} connects them in order of the variable on the +#' x axis. \code{a_geom_step()} creates a a_stairstep plot, highlighting exactly #' when changes occur. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "path")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "path")} #' -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @param lineend Line end style (round, butt, square) #' @param linejoin Line join style (round, mitre, bevel) #' @param linemitre Line mitre limit (number greater than 1) #' @param arrow Arrow specification, as created by \code{\link[grid]{arrow}} #' @seealso -#' \code{\link{geom_polygon}}: Filled paths (polygons); -#' \code{\link{geom_segment}}: Line segments +#' \code{\link{a_geom_polygon}}: Filled paths (polygons); +#' \code{\link{a_geom_segment}}: Line segments #' @export #' @examples -#' # geom_line() is suitable for time series -#' ggplot(economics, aes(date, unemploy)) + geom_line() -#' ggplot(economics_long, aes(date, value01, colour = variable)) + -#' geom_line() +#' # a_geom_line() is suitable for time series +#' a_plot(economics, a_aes(date, unemploy)) + a_geom_line() +#' a_plot(economics_long, a_aes(date, value01, colour = variable)) + +#' a_geom_line() #' -#' # geom_step() is useful when you want to highlight exactly when +#' # a_geom_step() is useful when you want to highlight exactly when #' # the y value chanes #' recent <- economics[economics$date > as.Date("2013-01-01"), ] -#' ggplot(recent, aes(date, unemploy)) + geom_line() -#' ggplot(recent, aes(date, unemploy)) + geom_step() +#' a_plot(recent, a_aes(date, unemploy)) + a_geom_line() +#' a_plot(recent, a_aes(date, unemploy)) + a_geom_step() #' -#' # geom_path lets you explore how two variables are related over time, +#' # a_geom_path lets you explore how two variables are related over time, #' # e.g. unemployment and personal savings rate -#' m <- ggplot(economics, aes(unemploy/pop, psavert)) -#' m + geom_path() -#' m + geom_path(aes(colour = as.numeric(date))) +#' m <- a_plot(economics, a_aes(unemploy/pop, psavert)) +#' m + a_geom_path() +#' m + a_geom_path(a_aes(colour = as.numeric(date))) #' #' # Changing parameters ---------------------------------------------- -#' ggplot(economics, aes(date, unemploy)) + -#' geom_line(colour = "red") +#' a_plot(economics, a_aes(date, unemploy)) + +#' a_geom_line(colour = "red") #' #' # Use the arrow parameter to add an arrow to the line #' # See ?arrow for more details -#' c <- ggplot(economics, aes(x = date, y = pop)) -#' c + geom_line(arrow = arrow()) -#' c + geom_line( +#' c <- a_plot(economics, a_aes(x = date, y = pop)) +#' c + a_geom_line(arrow = arrow()) +#' c + a_geom_line( #' arrow = arrow(angle = 15, ends = "both", type = "closed") #' ) #' #' # Control line join parameters #' df <- data.frame(x = 1:3, y = c(4, 1, 9)) -#' base <- ggplot(df, aes(x, y)) -#' base + geom_path(size = 10) -#' base + geom_path(size = 10, lineend = "round") -#' base + geom_path(size = 10, linejoin = "mitre", lineend = "butt") +#' base <- a_plot(df, a_aes(x, y)) +#' base + a_geom_path(size = 10) +#' base + a_geom_path(size = 10, lineend = "round") +#' base + a_geom_path(size = 10, linejoin = "mitre", lineend = "butt") #' #' # NAs break the line. Use na.rm = T to suppress the warning message #' df <- data.frame( @@ -62,9 +62,9 @@ #' y2 = c(NA, 2, 3, 4, 5), #' y3 = c(1, 2, NA, 4, 5) #' ) -#' ggplot(df, aes(x, y1)) + geom_point() + geom_line() -#' ggplot(df, aes(x, y2)) + geom_point() + geom_line() -#' ggplot(df, aes(x, y3)) + geom_point() + geom_line() +#' a_plot(df, a_aes(x, y1)) + a_geom_point() + a_geom_line() +#' a_plot(df, a_aes(x, y2)) + a_geom_point() + a_geom_line() +#' a_plot(df, a_aes(x, y3)) + a_geom_point() + a_geom_line() #' #' \donttest{ #' # Setting line type vs colour/size @@ -77,16 +77,16 @@ #' group = rep(c("a","b"), #' each = 100) #' ) -#' p <- ggplot(df, aes(x=x, y=y, group=group)) +#' p <- a_plot(df, a_aes(x=x, y=y, group=group)) #' # These work -#' p + geom_line(linetype = 2) -#' p + geom_line(aes(colour = group), linetype = 2) -#' p + geom_line(aes(colour = x)) +#' p + a_geom_line(linetype = 2) +#' p + a_geom_line(a_aes(colour = group), linetype = 2) +#' p + a_geom_line(a_aes(colour = x)) #' # But this doesn't -#' should_stop(p + geom_line(aes(colour = x), linetype=2)) +#' should_stop(p + a_geom_line(a_aes(colour = x), linetype=2)) #' } -geom_path <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +a_geom_path <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., lineend = "butt", linejoin = "round", @@ -94,15 +94,15 @@ geom_path <- function(mapping = NULL, data = NULL, arrow = NULL, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomPath, - position = position, + a_stat = a_stat, + a_geom = a_GeomPath, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( lineend = lineend, linejoin = linejoin, @@ -114,14 +114,14 @@ geom_path <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomPath <- ggproto("GeomPath", Geom, +a_GeomPath <- a_ggproto("a_GeomPath", a_Geom, required_aes = c("x", "y"), - default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), + default_aes = a_aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), handle_na = function(data, params) { keep <- function(x) { @@ -143,28 +143,28 @@ GeomPath <- ggproto("GeomPath", Geom, if (!all(kept) && !params$na.rm) { warning("Removed ", sum(!kept), " rows containing missing values", - " (geom_path).", call. = FALSE) + " (a_geom_path).", call. = FALSE) } data }, - draw_panel = function(data, panel_scales, coord, arrow = NULL, + draw_panel = function(data, panel_scales, a_coord, arrow = NULL, lineend = "butt", linejoin = "round", linemitre = 1, na.rm = FALSE) { if (!anyDuplicated(data$group)) { - message_wrap("geom_path: Each group consists of only one observation. ", + message_wrap("a_geom_path: Each group consists of only one observation. ", "Do you need to adjust the group aesthetic?") } # must be sorted on group data <- data[order(data$group), , drop = FALSE] - munched <- coord_munch(coord, data, panel_scales) + munched <- a_coord_munch(a_coord, data, panel_scales) # Silently drop lines with less than two points, preserving order rows <- stats::ave(seq_len(nrow(munched)), munched$group, FUN = length) munched <- munched[rows >= 2, ] - if (nrow(munched) < 2) return(zeroGrob()) + if (nrow(munched) < 2) return(a_zeroGrob()) # Work out whether we should use lines or segments attr <- plyr::ddply(munched, "group", function(df) { @@ -177,7 +177,7 @@ GeomPath <- ggproto("GeomPath", Geom, solid_lines <- all(attr$solid) constant <- all(attr$constant) if (!solid_lines && !constant) { - stop("geom_path: If you are using dotted or dashed lines", + stop("a_geom_path: If you are using dotted or dashed lines", ", colour, size and linetype must be constant over the line", call. = FALSE) } @@ -220,22 +220,22 @@ GeomPath <- ggproto("GeomPath", Geom, } }, - draw_key = draw_key_path + draw_key = a_draw_key_path ) #' @export -#' @rdname geom_path -geom_line <- function(mapping = NULL, data = NULL, stat = "identity", - position = "identity", na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE, ...) { - layer( +#' @rdname a_geom_path +a_geom_line <- function(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", na.rm = FALSE, + show.legend = NA, inherit.a_aes = TRUE, ...) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomLine, - position = position, + a_stat = a_stat, + a_geom = a_GeomLine, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -243,12 +243,12 @@ geom_line <- function(mapping = NULL, data = NULL, stat = "identity", ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export #' @include geom-path.r -GeomLine <- ggproto("GeomLine", GeomPath, +a_GeomLine <- a_ggproto("a_GeomLine", a_GeomPath, setup_data = function(data, params) { data[order(data$PANEL, data$group, data$x), ] } @@ -257,18 +257,18 @@ GeomLine <- ggproto("GeomLine", GeomPath, #' @param direction direction of stairs: 'vh' for vertical then horizontal, or #' 'hv' for horizontal then vertical #' @export -#' @rdname geom_path -geom_step <- function(mapping = NULL, data = NULL, stat = "identity", - position = "identity", direction = "hv", - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { - layer( +#' @rdname a_geom_path +a_geom_step <- function(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", direction = "hv", + na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE, ...) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomStep, - position = position, + a_stat = a_stat, + a_geom = a_GeomStep, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( direction = direction, na.rm = na.rm, @@ -277,23 +277,24 @@ geom_step <- function(mapping = NULL, data = NULL, stat = "identity", ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export #' @include geom-path.r -GeomStep <- ggproto("GeomStep", GeomPath, - draw_panel = function(data, panel_scales, coord, direction = "hv") { - data <- plyr::ddply(data, "group", stairstep, direction = direction) - GeomPath$draw_panel(data, panel_scales, coord) +a_GeomStep <- a_ggproto("a_GeomStep", a_GeomPath, + draw_panel = function(data, panel_scales, a_coord, direction = "hv") { + data <- plyr::ddply(data, "group", a_stairstep, direction = direction) + a_GeomPath$draw_panel(data, panel_scales, a_coord) } ) -# Calculate stairsteps -# Used by \code{\link{geom_step}} -# -# @keyword internal -stairstep <- function(data, direction="hv") { +#' Calculate a_stairsteps +#' Used by \code{\link{a_geom_step}} +#' @param data ... +#' @param direction ... +#' @export +a_stairstep <- function(data, direction="hv") { direction <- match.arg(direction, c("hv", "vh")) data <- as.data.frame(data)[order(data$x), ] n <- nrow(data) diff --git a/R/geom-point.r b/R/geom-point.r index e1eacf60c1..b8e6ee5c7a 100644 --- a/R/geom-point.r +++ b/R/geom-point.r @@ -5,7 +5,7 @@ #' The scatterplot is useful for displaying the relationship between two #' continuous variables, although it can also be used with one continuous #' and one categorical variable, or two categorical variables. See -#' \code{\link{geom_jitter}} for possibilities. +#' \code{\link{a_geom_jitter}} for possibilities. #' #' The \emph{bubblechart} is a scatterplot with a third variable mapped to #' the size of points. There are no special names for scatterplots where @@ -16,94 +16,94 @@ #' another. This can severely distort the visual appearance of the plot. #' There is no one solution to this problem, but there are some techniques #' that can help. You can add additional information with -#' \code{\link{geom_smooth}}, \code{\link{geom_quantile}} or -#' \code{\link{geom_density_2d}}. If you have few unique x values, -#' \code{\link{geom_boxplot}} may also be useful. Alternatively, you can +#' \code{\link{a_geom_smooth}}, \code{\link{a_geom_quantile}} or +#' \code{\link{a_geom_density_2d}}. If you have few unique x values, +#' \code{\link{a_geom_boxplot}} may also be useful. Alternatively, you can #' summarise the number of points at each location and display that in some -#' way, using \code{\link{stat_sum}}. Another technique is to use transparent -#' points, e.g. \code{geom_point(alpha = 0.05)}. +#' way, using \code{\link{a_stat_sum}}. Another technique is to use transparent +#' points, e.g. \code{a_geom_point(alpha = 0.05)}. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "point")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "point")} #' -#' @seealso \code{\link{scale_size}} to see scale area of points, instead of -#' radius, \code{\link{geom_jitter}} to jitter points to reduce (mild) +#' @seealso \code{\link{a_scale_size}} to see scale area of points, instead of +#' radius, \code{\link{a_geom_jitter}} to jitter points to reduce (mild) #' overplotting -#' @inheritParams layer +#' @inheritParams a_layer #' @param na.rm If \code{FALSE} (the default), removes missing values with #' a warning. If \code{TRUE} silently removes missing values. -#' @param ... other arguments passed on to \code{\link{layer}}. These are +#' @param ... other arguments passed on to \code{\link{a_layer}}. These are #' often aesthetics, used to set an aesthetic to a fixed value, like #' \code{color = "red"} or \code{size = 3}. They may also be parameters -#' to the paired geom/stat. -#' @inheritParams layer +#' to the paired a_geom/a_stat. +#' @inheritParams a_layer #' @export #' @examples -#' p <- ggplot(mtcars, aes(wt, mpg)) -#' p + geom_point() +#' p <- a_plot(mtcars, a_aes(wt, mpg)) +#' p + a_geom_point() #' -#' # Add aesthetic mappings -#' p + geom_point(aes(colour = factor(cyl))) -#' p + geom_point(aes(shape = factor(cyl))) -#' p + geom_point(aes(size = qsec)) +#' # Add a_aesthetic mappings +#' p + a_geom_point(a_aes(colour = factor(cyl))) +#' p + a_geom_point(a_aes(shape = factor(cyl))) +#' p + a_geom_point(a_aes(size = qsec)) #' #' # Change scales -#' p + geom_point(aes(colour = cyl)) + scale_colour_gradient(low = "blue") -#' p + geom_point(aes(shape = factor(cyl))) + scale_shape(solid = FALSE) +#' p + a_geom_point(a_aes(colour = cyl)) + a_scale_colour_gradient(low = "blue") +#' p + a_geom_point(a_aes(shape = factor(cyl))) + a_scale_shape(solid = FALSE) #' -#' # Set aesthetics to fixed value -#' ggplot(mtcars, aes(wt, mpg)) + geom_point(colour = "red", size = 3) +#' # Set a_aesthetics to fixed value +#' a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point(colour = "red", size = 3) #' #' \donttest{ #' # Varying alpha is useful for large datasets -#' d <- ggplot(diamonds, aes(carat, price)) -#' d + geom_point(alpha = 1/10) -#' d + geom_point(alpha = 1/20) -#' d + geom_point(alpha = 1/100) +#' d <- a_plot(diamonds, a_aes(carat, price)) +#' d + a_geom_point(alpha = 1/10) +#' d + a_geom_point(alpha = 1/20) +#' d + a_geom_point(alpha = 1/100) #' } #' #' # For shapes that have a border (like 21), you can colour the inside and #' # outside separately. Use the stroke aesthetic to modify the width of the #' # border -#' ggplot(mtcars, aes(wt, mpg)) + -#' geom_point(shape = 21, colour = "black", fill = "white", size = 5, stroke = 5) +#' a_plot(mtcars, a_aes(wt, mpg)) + +#' a_geom_point(shape = 21, colour = "black", fill = "white", size = 5, stroke = 5) #' #' \donttest{ #' # You can create interesting shapes by layering multiple points of #' # different sizes -#' p <- ggplot(mtcars, aes(mpg, wt, shape = factor(cyl))) -#' p + geom_point(aes(colour = factor(cyl)), size = 4) + -#' geom_point(colour = "grey90", size = 1.5) -#' p + geom_point(colour = "black", size = 4.5) + -#' geom_point(colour = "pink", size = 4) + -#' geom_point(aes(shape = factor(cyl))) +#' p <- a_plot(mtcars, a_aes(mpg, wt, shape = factor(cyl))) +#' p + a_geom_point(a_aes(colour = factor(cyl)), size = 4) + +#' a_geom_point(colour = "grey90", size = 1.5) +#' p + a_geom_point(colour = "black", size = 4.5) + +#' a_geom_point(colour = "pink", size = 4) + +#' a_geom_point(a_aes(shape = factor(cyl))) #' #' # These extra layers don't usually appear in the legend, but we can #' # force their inclusion -#' p + geom_point(colour = "black", size = 4.5, show.legend = TRUE) + -#' geom_point(colour = "pink", size = 4, show.legend = TRUE) + -#' geom_point(aes(shape = factor(cyl))) +#' p + a_geom_point(colour = "black", size = 4.5, show.legend = TRUE) + +#' a_geom_point(colour = "pink", size = 4, show.legend = TRUE) + +#' a_geom_point(a_aes(shape = factor(cyl))) #' -#' # geom_point warns when missing values have been dropped from the data set +#' # a_geom_point warns when missing values have been dropped from the data set #' # and not plotted, you can turn this off by setting na.rm = TRUE #' mtcars2 <- transform(mtcars, mpg = ifelse(runif(32) < 0.2, NA, mpg)) -#' ggplot(mtcars2, aes(wt, mpg)) + geom_point() -#' ggplot(mtcars2, aes(wt, mpg)) + geom_point(na.rm = TRUE) +#' a_plot(mtcars2, a_aes(wt, mpg)) + a_geom_point() +#' a_plot(mtcars2, a_aes(wt, mpg)) + a_geom_point(na.rm = TRUE) #' } -geom_point <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +a_geom_point <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomPoint, - position = position, + a_stat = a_stat, + a_geom = a_GeomPoint, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -111,20 +111,20 @@ geom_point <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomPoint <- ggproto("GeomPoint", Geom, +a_GeomPoint <- a_ggproto("a_GeomPoint", a_Geom, required_aes = c("x", "y"), non_missing_aes = c("size", "shape"), - default_aes = aes( + default_aes = a_aes( shape = 19, colour = "black", size = 1.5, fill = NA, alpha = NA, stroke = 0.5 ), - draw_panel = function(data, panel_scales, coord, na.rm = FALSE) { - coords <- coord$transform(data, panel_scales) + draw_panel = function(data, panel_scales, a_coord, na.rm = FALSE) { + coords <- a_coord$transform(data, panel_scales) ggname("geom_point", pointsGrob( coords$x, coords$y, @@ -140,5 +140,5 @@ GeomPoint <- ggproto("GeomPoint", Geom, ) }, - draw_key = draw_key_point + draw_key = a_draw_key_point ) diff --git a/R/geom-pointrange.r b/R/geom-pointrange.r index 32c706a219..a615339719 100644 --- a/R/geom-pointrange.r +++ b/R/geom-pointrange.r @@ -1,20 +1,20 @@ #' @export -#' @rdname geom_linerange -geom_pointrange <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' @rdname a_geom_linerange +a_geom_pointrange <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., fatten = 4, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomPointrange, - position = position, + a_stat = a_stat, + a_geom = a_GeomPointrange, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( fatten = fatten, na.rm = na.rm, @@ -23,26 +23,26 @@ geom_pointrange <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomPointrange <- ggproto("GeomPointrange", Geom, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, shape = 19, +a_GeomPointrange <- a_ggproto("a_GeomPointrange", a_Geom, + default_aes = a_aes(colour = "black", size = 0.5, linetype = 1, shape = 19, fill = NA, alpha = NA, stroke = 1), - draw_key = draw_key_pointrange, + draw_key = a_draw_key_pointrange, required_aes = c("x", "y", "ymin", "ymax"), - draw_panel = function(data, panel_scales, coord, fatten = 4) { + draw_panel = function(data, panel_scales, a_coord, fatten = 4) { if (is.null(data$y)) - return(GeomLinerange$draw_panel(data, panel_scales, coord)) + return(a_GeomLinerange$draw_panel(data, panel_scales, a_coord)) ggname("geom_pointrange", gTree(children = gList( - GeomLinerange$draw_panel(data, panel_scales, coord), - GeomPoint$draw_panel(transform(data, size = size * fatten), panel_scales, coord) + a_GeomLinerange$draw_panel(data, panel_scales, a_coord), + a_GeomPoint$draw_panel(transform(data, size = size * fatten), panel_scales, a_coord) )) ) } diff --git a/R/geom-polygon.r b/R/geom-polygon.r index 0cad2c56ee..353799b084 100644 --- a/R/geom-polygon.r +++ b/R/geom-polygon.r @@ -1,16 +1,16 @@ #' Polygon, a filled path. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "polygon")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "polygon")} #' #' @seealso -#' \code{\link{geom_path}} for an unfilled polygon, -#' \code{\link{geom_ribbon}} for a polygon anchored on the x-axis +#' \code{\link{a_geom_path}} for an unfilled polygon, +#' \code{\link{a_geom_ribbon}} for a polygon anchored on the x-axis #' @export -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @examples -#' # When using geom_polygon, you will typically need two data frames: +#' # When using a_geom_polygon, you will typically need two data frames: #' # one contains the coordinates of each polygon (positions), and the #' # other the values associated with each polygon (values). An id #' # variable links the two together @@ -33,7 +33,7 @@ #' # Currently we need to manually merge the two together #' datapoly <- merge(values, positions, by = c("id")) #' -#' (p <- ggplot(datapoly, aes(x = x, y = y)) + geom_polygon(aes(fill = value, group = id))) +#' (p <- a_plot(datapoly, a_aes(x = x, y = y)) + a_geom_polygon(a_aes(fill = value, group = id))) #' #' # Which seems like a lot of work, but then it's easy to add on #' # other features in this coordinate system, e.g.: @@ -43,24 +43,24 @@ #' y = cumsum(runif(50,max = 0.1)) #' ) #' -#' p + geom_line(data = stream, colour = "grey30", size = 5) +#' p + a_geom_line(data = stream, colour = "grey30", size = 5) #' #' # And if the positions are in longitude and latitude, you can use -#' # coord_map to produce different map projections. -geom_polygon <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' # a_coord_map to produce different map projections. +a_geom_polygon <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomPolygon, - position = position, + a_stat = a_stat, + a_geom = a_GeomPolygon, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -68,16 +68,16 @@ geom_polygon <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomPolygon <- ggproto("GeomPolygon", Geom, - draw_panel = function(data, panel_scales, coord) { +a_GeomPolygon <- a_ggproto("a_GeomPolygon", a_Geom, + draw_panel = function(data, panel_scales, a_coord) { n <- nrow(data) - if (n == 1) return(zeroGrob()) + if (n == 1) return(a_zeroGrob()) - munched <- coord_munch(coord, data, panel_scales) + munched <- a_coord_munch(a_coord, data, panel_scales) # Sort by group to make sure that colors, fill, etc. come in same order munched <- munched[order(munched$group), ] @@ -100,7 +100,7 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, ) }, - default_aes = aes(colour = "NA", fill = "grey20", size = 0.5, linetype = 1, + default_aes = a_aes(colour = "NA", fill = "grey20", size = 0.5, linetype = 1, alpha = NA), handle_na = function(data, params) { @@ -109,6 +109,6 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, required_aes = c("x", "y"), - draw_key = draw_key_polygon + draw_key = a_draw_key_polygon ) diff --git a/R/geom-quantile.r b/R/geom-quantile.r index cc18c69aa1..4c781b45ad 100644 --- a/R/geom-quantile.r +++ b/R/geom-quantile.r @@ -1,51 +1,51 @@ #' Add quantile lines from a quantile regression. #' -#' This can be used as a continuous analogue of a geom_boxplot. +#' This can be used as a continuous analogue of a a_geom_boxplot. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "quantile")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "quantile")} #' #' @export -#' @inheritParams layer -#' @inheritParams geom_point -#' @inheritParams geom_path +#' @inheritParams a_layer +#' @inheritParams a_geom_point +#' @inheritParams a_geom_path #' @param method.args List of additional arguments passed on to the modelling #' function defined by \code{method}. -#' @param geom,stat Use to override the default connection between -#' \code{geom_quantile} and \code{stat_quantile}. +#' @param a_geom,a_stat Use to override the default connection between +#' \code{a_geom_quantile} and \code{a_stat_quantile}. #' @examples -#' m <- ggplot(mpg, aes(displ, 1 / hwy)) + geom_point() -#' m + geom_quantile() -#' m + geom_quantile(quantiles = 0.5) +#' m <- a_plot(mpg, a_aes(displ, 1 / hwy)) + a_geom_point() +#' m + a_geom_quantile() +#' m + a_geom_quantile(quantiles = 0.5) #' q10 <- seq(0.05, 0.95, by = 0.05) -#' m + geom_quantile(quantiles = q10) +#' m + a_geom_quantile(quantiles = q10) #' #' # You can also use rqss to fit smooth quantiles -#' m + geom_quantile(method = "rqss") +#' m + a_geom_quantile(method = "rqss") #' # Note that rqss doesn't pick a smoothing constant automatically, so #' # you'll need to tweak lambda yourself -#' m + geom_quantile(method = "rqss", lambda = 0.1) +#' m + a_geom_quantile(method = "rqss", lambda = 0.1) #' #' # Set aesthetics to fixed value -#' m + geom_quantile(colour = "red", size = 2, alpha = 0.5) -geom_quantile <- function(mapping = NULL, data = NULL, - stat = "quantile", position = "identity", +#' m + a_geom_quantile(colour = "red", size = 2, alpha = 0.5) +a_geom_quantile <- function(mapping = NULL, data = NULL, + a_stat = "quantile", a_position = "identity", ..., lineend = "butt", linejoin = "round", linemitre = 1, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.a_aes = TRUE) { - layer( + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomQuantile, - position = position, + a_stat = a_stat, + a_geom = a_GeomQuantile, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( lineend = lineend, linejoin = linejoin, @@ -56,14 +56,14 @@ geom_quantile <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export #' @include geom-path.r -GeomQuantile <- ggproto("GeomQuantile", GeomPath, +a_GeomQuantile <- a_ggproto("a_GeomQuantile", a_GeomPath, default_aes = defaults( - aes(weight = 1, colour = "#3366FF", size = 0.5), - GeomPath$default_aes + a_aes(weight = 1, colour = "#3366FF", size = 0.5), + a_GeomPath$default_aes ) ) diff --git a/R/geom-raster.r b/R/geom-raster.r index d13d752727..a7f63f6261 100644 --- a/R/geom-raster.r +++ b/R/geom-raster.r @@ -2,33 +2,33 @@ NULL #' @export -#' @rdname geom_tile +#' @rdname a_geom_tile #' @param hjust,vjust horizontal and vertical justification of the grob. Each #' justification value should be a number between 0 and 1. Defaults to 0.5 #' for both, centering each pixel over its data location. #' @param interpolate If \code{TRUE} interpolate linearly, if \code{FALSE} #' (the default) don't interpolate. -geom_raster <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +a_geom_raster <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., hjust = 0.5, vjust = 0.5, interpolate = FALSE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + inherit.a_aes = TRUE) { stopifnot(is.numeric(hjust), length(hjust) == 1) stopifnot(is.numeric(vjust), length(vjust) == 1) - layer( + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomRaster, - position = position, + a_stat = a_stat, + a_geom = a_GeomRaster, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( hjust = hjust, vjust = vjust, @@ -39,12 +39,12 @@ geom_raster <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomRaster <- ggproto("GeomRaster", Geom, - default_aes = aes(fill = "grey20", alpha = NA), +a_GeomRaster <- a_ggproto("a_GeomRaster", a_Geom, + default_aes = a_aes(fill = "grey20", alpha = NA), non_missing_aes = "fill", required_aes = c("x", "y"), @@ -52,8 +52,8 @@ GeomRaster <- ggproto("GeomRaster", Geom, hjust <- params$hjust %||% 0.5 vjust <- params$vjust %||% 0.5 - w <- resolution(data$x, FALSE) - h <- resolution(data$y, FALSE) + w <- a_resolution(data$x, FALSE) + h <- a_resolution(data$y, FALSE) data$xmin <- data$x - w * (1 - hjust) data$xmax <- data$x + w * hjust @@ -62,16 +62,16 @@ GeomRaster <- ggproto("GeomRaster", Geom, data }, - draw_panel = function(data, panel_scales, coord, interpolate = FALSE, + draw_panel = function(data, panel_scales, a_coord, interpolate = FALSE, hjust = 0.5, vjust = 0.5) { - if (!inherits(coord, "CoordCartesian")) { - stop("geom_raster only works with Cartesian coordinates", call. = FALSE) + if (!inherits(a_coord, "a_CoordCartesian")) { + stop("a_geom_raster only works with Cartesian coordinates", call. = FALSE) } - data <- coord$transform(data, panel_scales) + data <- a_coord$transform(data, panel_scales) # Convert vector of data to raster - x_pos <- as.integer((data$x - min(data$x)) / resolution(data$x, FALSE)) - y_pos <- as.integer((data$y - min(data$y)) / resolution(data$y, FALSE)) + x_pos <- as.integer((data$x - min(data$x)) / a_resolution(data$x, FALSE)) + y_pos <- as.integer((data$y - min(data$y)) / a_resolution(data$y, FALSE)) nrow <- max(y_pos) + 1 ncol <- max(x_pos) + 1 @@ -89,5 +89,5 @@ GeomRaster <- ggproto("GeomRaster", Geom, default.units = "native", interpolate = interpolate ) }, - draw_key = draw_key_rect + draw_key = a_draw_key_rect ) diff --git a/R/geom-rect.r b/R/geom-rect.r index 863d2abef8..d798ed6195 100644 --- a/R/geom-rect.r +++ b/R/geom-rect.r @@ -1,19 +1,19 @@ #' @export -#' @rdname geom_tile -geom_rect <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' @rdname a_geom_tile +a_geom_rect <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomRect, - position = position, + a_stat = a_stat, + a_geom = a_GeomRect, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -21,33 +21,33 @@ geom_rect <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomRect <- ggproto("GeomRect", Geom, - default_aes = aes(colour = NA, fill = "grey35", size = 0.5, linetype = 1, +a_GeomRect <- a_ggproto("a_GeomRect", a_Geom, + default_aes = a_aes(colour = NA, fill = "grey35", size = 0.5, linetype = 1, alpha = NA), required_aes = c("xmin", "xmax", "ymin", "ymax"), - draw_panel = function(self, data, panel_scales, coord) { - if (!coord$is_linear()) { - aesthetics <- setdiff( + draw_panel = function(self, data, panel_scales, a_coord) { + if (!a_coord$is_linear()) { + a_aesthetics <- setdiff( names(data), c("x", "y", "xmin", "xmax", "ymin", "ymax") ) polys <- plyr::alply(data, 1, function(row) { poly <- rect_to_poly(row$xmin, row$xmax, row$ymin, row$ymax) - aes <- as.data.frame(row[aesthetics], + a_aes <- as.data.frame(row[a_aesthetics], stringsAsFactors = FALSE)[rep(1,5), ] - GeomPolygon$draw_panel(cbind(poly, aes), panel_scales, coord) + a_GeomPolygon$draw_panel(cbind(poly, a_aes), panel_scales, a_coord) }) ggname("bar", do.call("grobTree", polys)) } else { - coords <- coord$transform(data, panel_scales) + coords <- a_coord$transform(data, panel_scales) ggname("geom_rect", rectGrob( coords$xmin, coords$ymax, width = coords$xmax - coords$xmin, @@ -65,7 +65,7 @@ GeomRect <- ggproto("GeomRect", Geom, } }, - draw_key = draw_key_polygon + draw_key = a_draw_key_polygon ) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 54a946f51a..c709ac9d3a 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -1,51 +1,51 @@ #' Ribbons and area plots. #' -#' For each continuous x value, \code{geom_interval} displays a y interval. -#' \code{geom_area} is a special case of \code{geom_ribbon}, where the +#' For each continuous x value, \code{a_geom_interval} displays a y interval. +#' \code{a_geom_area} is a special case of \code{a_geom_ribbon}, where the #' minimum of the range is fixed to 0. #' #' An area plot is the continuous analog of a stacked bar chart (see -#' \code{\link{geom_bar}}), and can be used to show how composition of the +#' \code{\link{a_geom_bar}}), and can be used to show how composition of the #' whole varies over the range of x. Choosing the order in which different #' components is stacked is very important, as it becomes increasing hard to #' see the individual pattern as you move up the stack. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "ribbon")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "ribbon")} #' #' @seealso -#' \code{\link{geom_bar}} for discrete intervals (bars), -#' \code{\link{geom_linerange}} for discrete intervals (lines), -#' \code{\link{geom_polygon}} for general polygons -#' @inheritParams layer -#' @inheritParams geom_point +#' \code{\link{a_geom_bar}} for discrete intervals (bars), +#' \code{\link{a_geom_linerange}} for discrete intervals (lines), +#' \code{\link{a_geom_polygon}} for general polygons +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @export #' @examples #' # Generate data #' huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron)) -#' h <- ggplot(huron, aes(year)) +#' h <- a_plot(huron, a_aes(year)) #' -#' h + geom_ribbon(aes(ymin=0, ymax=level)) -#' h + geom_area(aes(y = level)) +#' h + a_geom_ribbon(a_aes(ymin=0, ymax=level)) +#' h + a_geom_area(a_aes(y = level)) #' -#' # Add aesthetic mappings +#' # Add a_aesthetic mappings #' h + -#' geom_ribbon(aes(ymin = level - 1, ymax = level + 1), fill = "grey70") + -#' geom_line(aes(y = level)) -geom_ribbon <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' a_geom_ribbon(a_aes(ymin = level - 1, ymax = level + 1), fill = "grey70") + +#' a_geom_line(a_aes(y = level)) +a_geom_ribbon <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomRibbon, - position = position, + a_stat = a_stat, + a_geom = a_GeomRibbon, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -53,32 +53,32 @@ geom_ribbon <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomRibbon <- ggproto("GeomRibbon", Geom, - default_aes = aes(colour = NA, fill = "grey20", size = 0.5, linetype = 1, +a_GeomRibbon <- a_ggproto("a_GeomRibbon", a_Geom, + default_aes = a_aes(colour = NA, fill = "grey20", size = 0.5, linetype = 1, alpha = NA), required_aes = c("x", "ymin", "ymax"), - draw_key = draw_key_polygon, + draw_key = a_draw_key_polygon, handle_na = function(data, params) { data }, - draw_group = function(data, panel_scales, coord, na.rm = FALSE) { + draw_group = function(data, panel_scales, a_coord, na.rm = FALSE) { if (na.rm) data <- data[stats::complete.cases(data[c("x", "ymin", "ymax")]), ] data <- data[order(data$group, data$x), ] # Check that aesthetics are constant - aes <- unique(data[c("colour", "fill", "size", "linetype", "alpha")]) - if (nrow(aes) > 1) { + a_aes <- unique(data[c("colour", "fill", "size", "linetype", "alpha")]) + if (nrow(a_aes) > 1) { stop("Aesthetics can not vary with a ribbon") } - aes <- as.list(aes) + a_aes <- as.list(a_aes) # Instead of removing NA values from the data and plotting a single # polygon, we want to "stop" plotting the polygon whenever we're @@ -93,33 +93,33 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, positions <- plyr::summarise(data, x = c(x, rev(x)), y = c(ymax, rev(ymin)), id = c(ids, rev(ids))) - munched <- coord_munch(coord, positions, panel_scales) + munched <- a_coord_munch(a_coord, positions, panel_scales) ggname("geom_ribbon", polygonGrob( munched$x, munched$y, id = munched$id, default.units = "native", gp = gpar( - fill = alpha(aes$fill, aes$alpha), - col = aes$colour, - lwd = aes$size * .pt, - lty = aes$linetype) + fill = alpha(a_aes$fill, a_aes$alpha), + col = a_aes$colour, + lwd = a_aes$size * .pt, + lty = a_aes$linetype) )) } ) -#' @rdname geom_ribbon +#' @rdname a_geom_ribbon #' @export -geom_area <- function(mapping = NULL, data = NULL, stat = "identity", - position = "stack", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) { - layer( +a_geom_area <- function(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "stack", na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE, ...) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomArea, - position = position, + a_stat = a_stat, + a_geom = a_GeomArea, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -127,12 +127,12 @@ geom_area <- function(mapping = NULL, data = NULL, stat = "identity", ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomArea <- ggproto("GeomArea", GeomRibbon, - default_aes = aes(colour = NA, fill = "grey20", size = 0.5, linetype = 1, +a_GeomArea <- a_ggproto("a_GeomArea", a_GeomRibbon, + default_aes = a_aes(colour = NA, fill = "grey20", size = 0.5, linetype = 1, alpha = NA), required_aes = c("x", "y"), diff --git a/R/geom-rug.r b/R/geom-rug.r index eebe6c745c..d8f94a7172 100644 --- a/R/geom-rug.r +++ b/R/geom-rug.r @@ -1,36 +1,36 @@ #' Marginal rug plots. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "rug")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "rug")} #' -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @param sides A string that controls which sides of the plot the rugs appear on. #' It can be set to a string containing any of \code{"trbl"}, for top, right, #' bottom, and left. #' @export #' @examples -#' p <- ggplot(mtcars, aes(wt, mpg)) -#' p + geom_point() -#' p + geom_point() + geom_rug() -#' p + geom_point() + geom_rug(sides="b") # Rug on bottom only -#' p + geom_point() + geom_rug(sides="trbl") # All four sides -#' p + geom_point() + geom_rug(position='jitter') -geom_rug <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' p <- a_plot(mtcars, a_aes(wt, mpg)) +#' p + a_geom_point() +#' p + a_geom_point() + a_geom_rug() +#' p + a_geom_point() + a_geom_rug(sides="b") # Rug on bottom only +#' p + a_geom_point() + a_geom_rug(sides="trbl") # All four sides +#' p + a_geom_point() + a_geom_rug(a_position='jitter') +a_geom_rug <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., sides = "bl", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomRug, - position = position, + a_stat = a_stat, + a_geom = a_GeomRug, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( sides = sides, na.rm = na.rm, @@ -40,14 +40,14 @@ geom_rug <- function(mapping = NULL, data = NULL, } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomRug <- ggproto("GeomRug", Geom, - draw_panel = function(data, panel_scales, coord, sides = "bl") { +a_GeomRug <- a_ggproto("a_GeomRug", a_Geom, + draw_panel = function(data, panel_scales, a_coord, sides = "bl") { rugs <- list() - data <- coord$transform(data, panel_scales) + data <- a_coord$transform(data, panel_scales) gp <- gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt) if (!is.null(data$x)) { @@ -89,7 +89,7 @@ GeomRug <- ggproto("GeomRug", Geom, gTree(children = do.call("gList", rugs)) }, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), + default_aes = a_aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), - draw_key = draw_key_path + draw_key = a_draw_key_path ) diff --git a/R/geom-segment.r b/R/geom-segment.r index a8e04b299d..7fc34d5211 100644 --- a/R/geom-segment.r +++ b/R/geom-segment.r @@ -1,65 +1,65 @@ #' Line segments and curves. #' -#' \code{geom_segment} draws a straight line between points (x1, y1) and -#' (x2, y2). \code{geom_curve} draws a curved line. +#' \code{a_geom_segment} draws a straight line between points (x1, y1) and +#' (x2, y2). \code{a_geom_curve} draws a curved line. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "segment")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "segment")} #' -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @param arrow specification for arrow heads, as created by arrow() #' @param lineend Line end style (round, butt, square) -#' @seealso \code{\link{geom_path}} and \code{\link{geom_line}} for multi- +#' @seealso \code{\link{a_geom_path}} and \code{\link{a_geom_line}} for multi- #' segment lines and paths. -#' @seealso \code{\link{geom_spoke}} for a segment parameterised by a location +#' @seealso \code{\link{a_geom_spoke}} for a segment parameterised by a location #' (x, y), and an angle and radius. #' @export #' @examples -#' b <- ggplot(mtcars, aes(wt, mpg)) + -#' geom_point() +#' b <- a_plot(mtcars, a_aes(wt, mpg)) + +#' a_geom_point() #' #' df <- data.frame(x1 = 2.62, x2 = 3.57, y1 = 21.0, y2 = 15.0) #' b + -#' geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "curve"), data = df) + -#' geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "segment"), data = df) +#' a_geom_curve(a_aes(x = x1, y = y1, xend = x2, yend = y2, colour = "curve"), data = df) + +#' a_geom_segment(a_aes(x = x1, y = y1, xend = x2, yend = y2, colour = "segment"), data = df) #' -#' b + geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2), data = df, curvature = -0.2) -#' b + geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2), data = df, curvature = 1) -#' b + geom_curve( -#' aes(x = x1, y = y1, xend = x2, yend = y2), +#' b + a_geom_curve(a_aes(x = x1, y = y1, xend = x2, yend = y2), data = df, curvature = -0.2) +#' b + a_geom_curve(a_aes(x = x1, y = y1, xend = x2, yend = y2), data = df, curvature = 1) +#' b + a_geom_curve( +#' a_aes(x = x1, y = y1, xend = x2, yend = y2), #' data = df, #' arrow = arrow(length = unit(0.03, "npc")) #' ) #' -#' ggplot(seals, aes(long, lat)) + -#' geom_segment(aes(xend = long + delta_long, yend = lat + delta_lat), +#' a_plot(seals, a_aes(long, lat)) + +#' a_geom_segment(a_aes(xend = long + delta_long, yend = lat + delta_lat), #' arrow = arrow(length = unit(0.1,"cm"))) + -#' borders("state") +#' ggplot2Animint:::borders("state") #' -#' # You can also use geom_segment to recreate plot(type = "h") : +#' # You can also use a_geom_segment to recreate plot(type = "h") : #' counts <- as.data.frame(table(x = rpois(100,5))) #' counts$x <- as.numeric(as.character(counts$x)) #' with(counts, plot(x, Freq, type = "h", lwd = 10)) #' -#' ggplot(counts, aes(x, Freq)) + -#' geom_segment(aes(xend = x, yend = 0), size = 10, lineend = "butt") -geom_segment <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' a_plot(counts, a_aes(x, Freq)) + +#' a_geom_segment(a_aes(xend = x, yend = 0), size = 10, lineend = "butt") +a_geom_segment <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., arrow = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomSegment, - position = position, + a_stat = a_stat, + a_geom = a_GeomSegment, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( arrow = arrow, lineend = lineend, @@ -69,32 +69,32 @@ geom_segment <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomSegment <- ggproto("GeomSegment", Geom, +a_GeomSegment <- a_ggproto("a_GeomSegment", a_Geom, required_aes = c("x", "y", "xend", "yend"), non_missing_aes = c("linetype", "size", "shape"), - default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), + default_aes = a_aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), - draw_panel = function(data, panel_scales, coord, arrow = NULL, + draw_panel = function(data, panel_scales, a_coord, arrow = NULL, lineend = "butt", na.rm = FALSE) { data <- remove_missing(data, na.rm = na.rm, c("x", "y", "xend", "yend", "linetype", "size", "shape"), - name = "geom_segment") - if (empty(data)) return(zeroGrob()) + name = "a_geom_segment") + if (empty(data)) return(a_zeroGrob()) - if (coord$is_linear()) { - coord <- coord$transform(data, panel_scales) - return(segmentsGrob(coord$x, coord$y, coord$xend, coord$yend, + if (a_coord$is_linear()) { + a_coord <- a_coord$transform(data, panel_scales) + return(segmentsGrob(a_coord$x, a_coord$y, a_coord$xend, a_coord$yend, default.units = "native", gp = gpar( - col = alpha(coord$colour, coord$alpha), - fill = alpha(coord$colour, coord$alpha), - lwd = coord$size * .pt, - lty = coord$linetype, + col = alpha(a_coord$colour, a_coord$alpha), + fill = alpha(a_coord$colour, a_coord$alpha), + lwd = a_coord$size * .pt, + lty = a_coord$linetype, lineend = lineend ), arrow = arrow @@ -109,9 +109,9 @@ GeomSegment <- ggproto("GeomSegment", Geom, pieces <- rbind(starts, ends) pieces <- pieces[order(pieces$group),] - GeomPath$draw_panel(pieces, panel_scales, coord, arrow = arrow, + a_GeomPath$draw_panel(pieces, panel_scales, a_coord, arrow = arrow, lineend = lineend) }, - draw_key = draw_key_path + draw_key = a_draw_key_path ) diff --git a/R/geom-smooth.r b/R/geom-smooth.r index 04a4e650b4..d73a5c574c 100644 --- a/R/geom-smooth.r +++ b/R/geom-smooth.r @@ -1,8 +1,8 @@ #' Add a smoothed conditional mean. #' #' Aids the eye in seeing patterns in the presence of overplotting. -#' \code{geom_smooth} and \code{stat_smooth} are effectively aliases: they -#' both use the same arguments. Use \code{geom_smooth} unless you want to +#' \code{a_geom_smooth} and \code{a_stat_smooth} are effectively aliases: they +#' both use the same arguments. Use \code{a_geom_smooth} unless you want to #' display the results with a non-standard geom. #' #' Calculation is performed by the (currently undocumented) @@ -13,123 +13,123 @@ #' scale, and then back-transformed to the response scale. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "smooth")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "smooth")} #' -#' @inheritParams layer -#' @inheritParams geom_point -#' @param geom,stat Use to override the default connection between -#' \code{geom_smooth} and \code{stat_smooth}. +#' @inheritParams a_layer +#' @inheritParams a_geom_point +#' @param a_geom,a_stat Use to override the default connection between +#' \code{a_geom_smooth} and \code{a_stat_smooth}. #' @seealso See individual modelling functions for more details: #' \code{\link{lm}} for linear smooths, #' \code{\link{glm}} for generalised linear smooths, #' \code{\link{loess}} for local smooths #' @export #' @examples -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + -#' geom_smooth() +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point() + +#' a_geom_smooth() #' #' # Use span to control the "wiggliness" of the default loess smoother #' # The span is the fraction of points used to fit each local regression: #' # small numbers make a wigglier curve, larger numbers make a smoother curve. -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + -#' geom_smooth(span = 0.3) +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point() + +#' a_geom_smooth(span = 0.3) #' #' # Instead of a loess smooth, you can use any other modelling function: -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + -#' geom_smooth(method = "lm", se = FALSE) +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point() + +#' a_geom_smooth(method = "lm", se = FALSE) #' -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + -#' geom_smooth(method = "lm", formula = y ~ splines::bs(x, 3), se = FALSE) +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point() + +#' a_geom_smooth(method = "lm", formula = y ~ splines::bs(x, 3), se = FALSE) #' #' # Smoothes are automatically fit to each group (defined by categorical #' # aesthetics or the group aesthetic) and for each facet #' -#' ggplot(mpg, aes(displ, hwy, colour = class)) + -#' geom_point() + -#' geom_smooth(se = FALSE, method = "lm") -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point() + -#' geom_smooth(span = 0.8) + -#' facet_wrap(~drv) +#' a_plot(mpg, a_aes(displ, hwy, colour = class)) + +#' a_geom_point() + +#' a_geom_smooth(se = FALSE, method = "lm") +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point() + +#' a_geom_smooth(span = 0.8) + +#' ggplot2Animint:::a_facet_wrap(~drv) #' #' \donttest{ #' binomial_smooth <- function(...) { -#' geom_smooth(method = "glm", method.args = list(family = "binomial"), ...) +#' a_geom_smooth(method = "glm", method.args = list(family = "binomial"), ...) #' } #' # To fit a logistic regression, you need to coerce the values to #' # a numeric vector lying between 0 and 1. -#' ggplot(rpart::kyphosis, aes(Age, Kyphosis)) + -#' geom_jitter(height = 0.05) + +#' a_plot(rpart::kyphosis, a_aes(Age, Kyphosis)) + +#' a_geom_jitter(height = 0.05) + #' binomial_smooth() #' -#' ggplot(rpart::kyphosis, aes(Age, as.numeric(Kyphosis) - 1)) + -#' geom_jitter(height = 0.05) + +#' a_plot(rpart::kyphosis, a_aes(Age, as.numeric(Kyphosis) - 1)) + +#' a_geom_jitter(height = 0.05) + #' binomial_smooth() #' -#' ggplot(rpart::kyphosis, aes(Age, as.numeric(Kyphosis) - 1)) + -#' geom_jitter(height = 0.05) + +#' a_plot(rpart::kyphosis, a_aes(Age, as.numeric(Kyphosis) - 1)) + +#' a_geom_jitter(height = 0.05) + #' binomial_smooth(formula = y ~ splines::ns(x, 2)) #' #' # But in this case, it's probably better to fit the model yourself #' # so you can exercise more control and see whether or not it's a good model #' } -geom_smooth <- function(mapping = NULL, data = NULL, - stat = "smooth", position = "identity", +a_geom_smooth <- function(mapping = NULL, data = NULL, + a_stat = "smooth", a_position = "identity", ..., method = "auto", formula = y ~ x, se = TRUE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.a_aes = TRUE) { params <- list( na.rm = na.rm, ... ) - if (identical(stat, "smooth")) { + if (identical(a_stat, "smooth")) { params$method <- method params$formula <- formula params$se <- se } - layer( + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomSmooth, - position = position, + a_stat = a_stat, + a_geom = a_GeomSmooth, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = params ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomSmooth <- ggproto("GeomSmooth", Geom, - draw_group = function(data, panel_scales, coord) { +a_GeomSmooth <- a_ggproto("a_GeomSmooth", a_Geom, + draw_group = function(data, panel_scales, a_coord) { ribbon <- transform(data, colour = NA) path <- transform(data, alpha = NA) has_ribbon <- !is.null(data$ymax) && !is.null(data$ymin) gList( - if (has_ribbon) GeomRibbon$draw_group(ribbon, panel_scales, coord), - GeomLine$draw_panel(path, panel_scales, coord) + if (has_ribbon) a_GeomRibbon$draw_group(ribbon, panel_scales, a_coord), + a_GeomLine$draw_panel(path, panel_scales, a_coord) ) }, - draw_key = draw_key_smooth, + draw_key = a_draw_key_smooth, required_aes = c("x", "y"), - default_aes = aes(colour = "#3366FF", fill = "grey60", size = 1, + default_aes = a_aes(colour = "#3366FF", fill = "grey60", size = 1, linetype = 1, weight = 1, alpha = 0.4) ) diff --git a/R/geom-spoke.r b/R/geom-spoke.r index 6c17911c8f..6ddb1b162c 100644 --- a/R/geom-spoke.r +++ b/R/geom-spoke.r @@ -1,37 +1,37 @@ #' A line segment parameterised by location, direction and distance. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "spoke")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "spoke")} #' -#' @inheritParams layer -#' @inheritParams geom_segment +#' @inheritParams a_layer +#' @inheritParams a_geom_segment #' @export #' @examples #' df <- expand.grid(x = 1:10, y=1:10) #' df$angle <- runif(100, 0, 2*pi) #' df$speed <- runif(100, 0, sqrt(0.1 * df$x)) #' -#' ggplot(df, aes(x, y)) + -#' geom_point() + -#' geom_spoke(aes(angle = angle), radius = 0.5) +#' a_plot(df, a_aes(x, y)) + +#' a_geom_point() + +#' a_geom_spoke(a_aes(angle = angle), radius = 0.5) #' -#' ggplot(df, aes(x, y)) + -#' geom_point() + -#' geom_spoke(aes(angle = angle, radius = speed)) -geom_spoke <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +#' a_plot(df, a_aes(x, y)) + +#' a_geom_point() + +#' a_geom_spoke(a_aes(angle = angle, radius = speed)) +a_geom_spoke <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - geom = GeomSpoke, - stat = stat, - position = position, + a_geom = a_GeomSpoke, + a_stat = a_stat, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -40,18 +40,18 @@ geom_spoke <- function(mapping = NULL, data = NULL, } #' @export -#' @rdname geom_spoke +#' @rdname a_geom_spoke #' @usage NULL -stat_spoke <- function(...) { - message("stat_spoke is deprecated, please use geom_spoke") - geom_spoke(...) +a_stat_spoke <- function(...) { + message("a_stat_spoke is deprecated, please use a_geom_spoke") + a_geom_spoke(...) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomSpoke <- ggproto("GeomSpoke", GeomSegment, +a_GeomSpoke <- a_ggproto("a_GeomSpoke", a_GeomSegment, setup_data = function(data, params) { data$radius <- data$radius %||% params$radius data$angle <- data$angle %||% params$angle diff --git a/R/geom-text.r b/R/geom-text.r index 84d1189736..3abb18f747 100644 --- a/R/geom-text.r +++ b/R/geom-text.r @@ -1,6 +1,6 @@ #' Textual annotations. #' -#' \code{geom_text} adds text directly to the plot. \code{geom_label} draws +#' \code{a_geom_text} adds text directly to the plot. \code{a_geom_label} draws #' a rectangle underneath the text, making it easier to read. #' #' Note the the "width" and "height" of a text element are 0, so stacking @@ -11,11 +11,11 @@ #' resize a plot, labels stay the same size, but the size of the axes changes. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "text")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "text")} #' -#' @section \code{geom_label}: -#' Currently \code{geom_label} does not support the \code{rot} parameter and -#' is considerably slower than \code{geom_text}. The \code{fill} aesthetic +#' @section \code{a_geom_label}: +#' Currently \code{a_geom_label} does not support the \code{rot} parameter and +#' is considerably slower than \code{a_geom_text}. The \code{fill} aesthetic #' controls the background colour of the label. #' #' @section Alignment: @@ -26,55 +26,56 @@ #' Inward always aligns text towards the center, and outward aligns #' it away from the center #' -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @param parse If TRUE, the labels will be parsed into expressions and #' displayed as described in ?plotmath #' @param nudge_x,nudge_y Horizontal and vertical adjustment to nudge labels by. #' Useful for offsetting text from points, particularly on discrete scales. #' @param check_overlap If \code{TRUE}, text that overlaps previous text in the -#' same layer will not be plotted. A quick and dirty way +#' same a_layer will not be plotted. A quick and dirty way #' @export #' @examples -#' p <- ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars))) +#' p <- a_plot(mtcars, a_aes(wt, mpg, a_label = rownames(mtcars))) #' -#' p + geom_text() +#' p + a_geom_text() #' # Avoid overlaps -#' p + geom_text(check_overlap = TRUE) +#' p + a_geom_text(check_overlap = TRUE) #' # Labels with background -#' p + geom_label() +#' p + a_geom_label() #' # Change size of the label -#' p + geom_text(size = 10) +#' p + a_geom_text(size = 10) #' #' # Set aesthetics to fixed value -#' p + geom_point() + geom_text(hjust = 0, nudge_x = 0.05) -#' p + geom_point() + geom_text(vjust = 0, nudge_y = 0.5) -#' p + geom_point() + geom_text(angle = 45) +#' p + a_geom_point() + a_geom_text(hjust = 0, nudge_x = 0.05) +#' p + a_geom_point() + a_geom_text(vjust = 0, nudge_y = 0.5) +#' p + a_geom_point() + a_geom_text(angle = 45) #' \dontrun{ #' # Doesn't work on all systems -#' p + geom_text(family = "Times New Roman") +#' p + a_geom_text(family = "Times New Roman") #' } #' #' # Add aesthetic mappings -#' p + geom_text(aes(colour = factor(cyl))) -#' p + geom_text(aes(colour = factor(cyl))) + -#' scale_colour_discrete(l = 40) -#' p + geom_label(aes(fill = factor(cyl)), colour = "white", fontface = "bold") +#' p + a_geom_text(a_aes(colour = factor(cyl))) +#' p + a_geom_text(a_aes(colour = factor(cyl))) + +#' a_scale_colour_discrete(l = 40) +#' p + a_geom_label(a_aes(fill = factor(cyl)), colour = "white", fontface = "bold") #' -#' p + geom_text(aes(size = wt)) -#' # Scale height of text, rather than sqrt(height) -#' p + geom_text(aes(size = wt)) + scale_radius(range = c(3,6)) +#' p + a_geom_text(a_aes(size = wt)) +#' # a_scale height of text, rather than sqrt(height) +#' p + a_geom_text(a_aes(size = wt)) + a_scale_radius(range = c(3,6)) #' #' # You can display expressions by setting parse = TRUE. The #' # details of the display are described in ?plotmath, but note that -#' # geom_text uses strings, not expressions. -#' p + geom_text(aes(label = paste(wt, "^(", cyl, ")", sep = "")), +#' # a_geom_text uses strings, not expressions. +#' p + a_geom_text(a_aes(a_label = paste(wt, "^(", cyl, ")", sep = "")), #' parse = TRUE) #' #' # Add a text annotation #' p + -#' geom_text() + -#' annotate("text", label = "plot mpg vs. wt", x = 2, y = 15, size = 8, colour = "red") +#' a_geom_text() + +#' ggplot2Animint:::a_annotate("text", +#' a_label = "plot mpg vs. wt", x = 2, y = 15, size = 8, colour = "red") #' #' \donttest{ #' # Aligning labels and bars -------------------------------------------------- @@ -86,25 +87,25 @@ #' #' # ggplot2 doesn't know you want to give the labels the same virtual width #' # as the bars: -#' ggplot(data = df, aes(x, y, fill = grp, label = y)) + -#' geom_bar(stat = "identity", position = "dodge") + -#' geom_text(position = "dodge") +#' a_plot(data = df, a_aes(x, y, fill = grp, a_label = y)) + +#' a_geom_bar(a_stat = "identity", a_position = "dodge") + +#' a_geom_text(a_position = "dodge") #' # So tell it: -#' ggplot(data = df, aes(x, y, fill = grp, label = y)) + -#' geom_bar(stat = "identity", position = "dodge") + -#' geom_text(position = position_dodge(0.9)) +#' a_plot(data = df, a_aes(x, y, fill = grp, a_label = y)) + +#' a_geom_bar(a_stat = "identity", a_position = "dodge") + +#' a_geom_text(a_position = a_position_dodge(0.9)) #' # Use you can't nudge and dodge text, so instead adjust the y postion -#' ggplot(data = df, aes(x, y, fill = grp, label = y)) + -#' geom_bar(stat = "identity", position = "dodge") + -#' geom_text(aes(y = y + 0.05), position = position_dodge(0.9), vjust = 0) +#' a_plot(data = df, a_aes(x, y, fill = grp, a_label = y)) + +#' a_geom_bar(a_stat = "identity", a_position = "dodge") + +#' a_geom_text(a_aes(y = y + 0.05), a_position = a_position_dodge(0.9), vjust = 0) #' #' # To place text in the middle of each bar in a stacked barplot, you #' # need to do the computation yourself #' df <- transform(df, mid_y = ave(df$y, df$x, FUN = function(val) cumsum(val) - (0.5 * val))) #' -#' ggplot(data = df, aes(x, y, fill = grp, label = y)) + -#' geom_bar(stat = "identity") + -#' geom_text(aes(y = mid_y)) +#' a_plot(data = df, a_aes(x, y, fill = grp, a_label = y)) + +#' a_geom_bar(a_stat = "identity") + +#' a_geom_text(a_aes(y = mid_y)) #' #' # Justification ------------------------------------------------------------- #' df <- data.frame( @@ -112,13 +113,13 @@ #' y = c(1, 2, 1, 2, 1.5), #' text = c("bottom-left", "bottom-right", "top-left", "top-right", "center") #' ) -#' ggplot(df, aes(x, y)) + -#' geom_text(aes(label = text)) -#' ggplot(df, aes(x, y)) + -#' geom_text(aes(label = text), vjust = "inward", hjust = "inward") +#' a_plot(df, a_aes(x, y)) + +#' a_geom_text(a_aes(a_label = text)) +#' a_plot(df, a_aes(x, y)) + +#' a_geom_text(a_aes(a_label = text), vjust = "inward", hjust = "inward") #' } -geom_text <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +a_geom_text <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., parse = FALSE, nudge_x = 0, @@ -126,24 +127,24 @@ geom_text <- function(mapping = NULL, data = NULL, check_overlap = FALSE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + inherit.a_aes = TRUE) { if (!missing(nudge_x) || !missing(nudge_y)) { - if (!missing(position)) { - stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE) + if (!missing(a_position)) { + stop("Specify either `a_position` or `nudge_x`/`nudge_y`", call. = FALSE) } - position <- position_nudge(nudge_x, nudge_y) + a_position <- a_position_nudge(nudge_x, nudge_y) } - layer( + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomText, - position = position, + a_stat = a_stat, + a_geom = a_GeomText, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( parse = parse, check_overlap = check_overlap, @@ -154,26 +155,26 @@ geom_text <- function(mapping = NULL, data = NULL, } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomText <- ggproto("GeomText", Geom, - required_aes = c("x", "y", "label"), +a_GeomText <- a_ggproto("a_GeomText", a_Geom, + required_aes = c("x", "y", "a_label"), - default_aes = aes( + default_aes = a_aes( colour = "black", size = 3.88, angle = 0, hjust = 0.5, vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2 ), - draw_panel = function(data, panel_scales, coord, parse = FALSE, + draw_panel = function(data, panel_scales, a_coord, parse = FALSE, na.rm = FALSE, check_overlap = FALSE) { - lab <- data$label + lab <- data$a_label if (parse) { lab <- parse(text = as.character(lab)) } - data <- coord$transform(data, panel_scales) + data <- a_coord$transform(data, panel_scales) if (is.character(data$vjust)) { data$vjust <- compute_just(data$vjust, data$y) } @@ -197,7 +198,7 @@ GeomText <- ggproto("GeomText", Geom, ) }, - draw_key = draw_key_text + draw_key = a_draw_key_text ) compute_just <- function(just, x) { diff --git a/R/geom-tile.r b/R/geom-tile.r index dc188ff4af..47fc60b1d0 100644 --- a/R/geom-tile.r +++ b/R/geom-tile.r @@ -1,75 +1,75 @@ #' Draw rectangles. #' -#' \code{geom_rect} and \code{geom_tile} do the same thing, but are -#' parameterised differently. \code{geom_rect} uses the locations of the four +#' \code{a_geom_rect} and \code{a_geom_tile} do the same thing, but are +#' parameterised differently. \code{a_geom_rect} uses the locations of the four #' corners (\code{xmin}, \code{xmax}, \code{ymin} and \code{ymax}). -#' \code{geom_tile} uses the center of the tile and its size (\code{x}, -#' \code{y}, \code{width}, \code{height}). \code{geom_raster} is a high +#' \code{a_geom_tile} uses the center of the tile and its size (\code{x}, +#' \code{y}, \code{width}, \code{height}). \code{a_geom_raster} is a high #' performance special case for when all the tiles are the same size. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "tile")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "tile")} #' -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @export #' @examples #' # The most common use for rectangles is to draw a surface. You always want -#' # to use geom_raster here because it's so much faster, and produces +#' # to use a_geom_raster here because it's so much faster, and produces #' # smaller output when saving to PDF -#' ggplot(faithfuld, aes(waiting, eruptions)) + -#' geom_raster(aes(fill = density)) +#' a_plot(faithfuld, a_aes(waiting, eruptions)) + +#' a_geom_raster(a_aes(fill = density)) #' #' # Interpolation smooths the surface & is most helpful when rendering images. -#' ggplot(faithfuld, aes(waiting, eruptions)) + -#' geom_raster(aes(fill = density), interpolate = TRUE) +#' a_plot(faithfuld, a_aes(waiting, eruptions)) + +#' a_geom_raster(a_aes(fill = density), interpolate = TRUE) #' -#' # If you want to draw arbitrary rectangles, use geom_tile() or geom_rect() +#' # If you want to draw arbitrary rectangles, use a_geom_tile() or a_geom_rect() #' df <- data.frame( #' x = rep(c(2, 5, 7, 9, 12), 2), #' y = rep(c(1, 2), each = 5), #' z = factor(rep(1:5, each = 2)), #' w = rep(diff(c(0, 4, 6, 8, 10, 14)), 2) #' ) -#' ggplot(df, aes(x, y)) + -#' geom_tile(aes(fill = z)) -#' ggplot(df, aes(x, y)) + -#' geom_tile(aes(fill = z, width = w), colour = "grey50") -#' ggplot(df, aes(xmin = x - w / 2, xmax = x + w / 2, ymin = y, ymax = y + 1)) + -#' geom_rect(aes(fill = z, width = w), colour = "grey50") +#' a_plot(df, a_aes(x, y)) + +#' a_geom_tile(a_aes(fill = z)) +#' a_plot(df, a_aes(x, y)) + +#' a_geom_tile(a_aes(fill = z, width = w), colour = "grey50") +#' a_plot(df, a_aes(xmin = x - w / 2, xmax = x + w / 2, ymin = y, ymax = y + 1)) + +#' a_geom_rect(a_aes(fill = z, width = w), colour = "grey50") #' #' \donttest{ #' # Justification controls where the cells are anchored #' df <- expand.grid(x = 0:5, y = 0:5) #' df$z <- runif(nrow(df)) -#' # default is compatible with geom_tile() -#' ggplot(df, aes(x, y, fill = z)) + geom_raster() +#' # default is compatible with a_geom_tile() +#' a_plot(df, a_aes(x, y, fill = z)) + a_geom_raster() #' # zero padding -#' ggplot(df, aes(x, y, fill = z)) + geom_raster(hjust = 0, vjust = 0) +#' a_plot(df, a_aes(x, y, fill = z)) + a_geom_raster(hjust = 0, vjust = 0) #' #' # Inspired by the image-density plots of Ken Knoblauch -#' cars <- ggplot(mtcars, aes(mpg, factor(cyl))) -#' cars + geom_point() -#' cars + stat_bin2d(aes(fill = ..count..), binwidth = c(3,1)) -#' cars + stat_bin2d(aes(fill = ..density..), binwidth = c(3,1)) +#' cars <- a_plot(mtcars, a_aes(mpg, factor(cyl))) +#' cars + a_geom_point() +#' cars + a_stat_bin2d(a_aes(fill = ..count..), binwidth = c(3,1)) +#' cars + a_stat_bin2d(a_aes(fill = ..density..), binwidth = c(3,1)) #' -#' cars + stat_density(aes(fill = ..density..), geom = "raster", position = "identity") -#' cars + stat_density(aes(fill = ..count..), geom = "raster", position = "identity") +#' cars + a_stat_density(a_aes(fill = ..density..), a_geom = "raster", a_position = "identity") +#' cars + a_stat_density(a_aes(fill = ..count..), a_geom = "raster", a_position = "identity") #' } -geom_tile <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", +a_geom_tile <- function(mapping = NULL, data = NULL, + a_stat = "identity", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomTile, - position = position, + a_stat = a_stat, + a_geom = a_GeomTile, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -77,17 +77,17 @@ geom_tile <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export #' @include geom-rect.r -GeomTile <- ggproto("GeomTile", GeomRect, +a_GeomTile <- a_ggproto("a_GeomTile", a_GeomRect, extra_params = c("na.rm", "width", "height"), setup_data = function(data, params) { - data$width <- data$width %||% params$width %||% resolution(data$x, FALSE) - data$height <- data$height %||% params$height %||% resolution(data$y, FALSE) + data$width <- data$width %||% params$width %||% a_resolution(data$x, FALSE) + data$height <- data$height %||% params$height %||% a_resolution(data$y, FALSE) transform(data, xmin = x - width / 2, xmax = x + width / 2, width = NULL, @@ -95,10 +95,10 @@ GeomTile <- ggproto("GeomTile", GeomRect, ) }, - default_aes = aes(fill = "grey20", colour = NA, size = 0.1, linetype = 1, + default_aes = a_aes(fill = "grey20", colour = NA, size = 0.1, linetype = 1, alpha = NA), required_aes = c("x", "y"), - draw_key = draw_key_polygon + draw_key = a_draw_key_polygon ) diff --git a/R/geom-violin.r b/R/geom-violin.r index e1446d6bb4..b0fa5ccdbb 100644 --- a/R/geom-violin.r +++ b/R/geom-violin.r @@ -1,91 +1,91 @@ #' Violin plot. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "violin")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "violin")} #' -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @param draw_quantiles If \code{not(NULL)} (default), draw horizontal lines #' at the given quantiles of the density estimate. #' @param trim If \code{TRUE} (default), trim the tails of the violins #' to the range of the data. If \code{FALSE}, don't trim the tails. -#' @param geom,stat Use to override the default connection between -#' \code{geom_violin} and \code{stat_ydensity}. +#' @param a_geom,a_stat Use to override the default connection between +#' \code{a_geom_violin} and \code{a_stat_ydensity}. #' @export #' @references Hintze, J. L., Nelson, R. D. (1998) Violin Plots: A Box #' Plot-Density Trace Synergism. The American Statistician 52, 181-184. #' @examples -#' p <- ggplot(mtcars, aes(factor(cyl), mpg)) -#' p + geom_violin() +#' p <- a_plot(mtcars, a_aes(factor(cyl), mpg)) +#' p + a_geom_violin() #' #' \donttest{ -#' p + geom_violin() + geom_jitter(height = 0) -#' p + geom_violin() + coord_flip() +#' p + a_geom_violin() + a_geom_jitter(height = 0) +#' p + a_geom_violin() + ggplot2Animint:::a_coord_flip() #' #' # Scale maximum width proportional to sample size: -#' p + geom_violin(scale = "count") +#' p + a_geom_violin(a_scale = "count") #' #' # Scale maximum width to 1 for all violins: -#' p + geom_violin(scale = "width") +#' p + a_geom_violin(a_scale = "width") #' #' # Default is to trim violins to the range of the data. To disable: -#' p + geom_violin(trim = FALSE) +#' p + a_geom_violin(trim = FALSE) #' #' # Use a smaller bandwidth for closer density fit (default is 1). -#' p + geom_violin(adjust = .5) +#' p + a_geom_violin(adjust = .5) #' #' # Add aesthetic mappings #' # Note that violins are automatically dodged when any aesthetic is #' # a factor -#' p + geom_violin(aes(fill = cyl)) -#' p + geom_violin(aes(fill = factor(cyl))) -#' p + geom_violin(aes(fill = factor(vs))) -#' p + geom_violin(aes(fill = factor(am))) +#' p + a_geom_violin(a_aes(fill = cyl)) +#' p + a_geom_violin(a_aes(fill = factor(cyl))) +#' p + a_geom_violin(a_aes(fill = factor(vs))) +#' p + a_geom_violin(a_aes(fill = factor(am))) #' -#' # Set aesthetics to fixed value -#' p + geom_violin(fill = "grey80", colour = "#3366FF") +#' # Set a_aesthetics to fixed value +#' p + a_geom_violin(fill = "grey80", colour = "#3366FF") #' #' # Show quartiles -#' p + geom_violin(draw_quantiles = c(0.25, 0.5, 0.75)) +#' p + a_geom_violin(draw_quantiles = c(0.25, 0.5, 0.75)) #' #' # Scales vs. coordinate transforms ------- #' if (require("ggplot2movies")) { #' # Scale transformations occur before the density statistics are computed. #' # Coordinate transformations occur afterwards. Observe the effect on the #' # number of outliers. -#' m <- ggplot(movies, aes(y = votes, x = rating, group = cut_width(rating, 0.5))) -#' m + geom_violin() -#' m + geom_violin() + scale_y_log10() -#' m + geom_violin() + coord_trans(y = "log10") -#' m + geom_violin() + scale_y_log10() + coord_trans(y = "log10") +#' m <- a_plot(movies, a_aes(y = votes, x = rating, group = cut_width(rating, 0.5))) +#' m + a_geom_violin() +#' m + a_geom_violin() + a_scale_y_log10() +#' m + a_geom_violin() + ggplot2Animint:::a_coord_trans(y = "log10") +#' m + a_geom_violin() + a_scale_y_log10() + ggplot2Animint:::a_coord_trans(y = "log10") #' #' # Violin plots with continuous x: -#' # Use the group aesthetic to group observations in violins -#' ggplot(movies, aes(year, budget)) + geom_violin() -#' ggplot(movies, aes(year, budget)) + -#' geom_violin(aes(group = cut_width(year, 10)), scale = "width") +#' # Use the group a_aesthetic to group observations in violins +#' a_plot(movies, a_aes(year, budget)) + a_geom_violin() +#' a_plot(movies, a_aes(year, budget)) + +#' a_geom_violin(a_aes(group = cut_width(year, 10)), a_scale = "width") #' } #' } -geom_violin <- function(mapping = NULL, data = NULL, - stat = "ydensity", position = "dodge", +a_geom_violin <- function(mapping = NULL, data = NULL, + a_stat = "ydensity", a_position = "dodge", ..., draw_quantiles = NULL, trim = TRUE, - scale = "area", + a_scale = "area", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = stat, - geom = GeomViolin, - position = position, + a_stat = a_stat, + a_geom = a_GeomViolin, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( trim = trim, - scale = scale, + a_scale = a_scale, draw_quantiles = draw_quantiles, na.rm = na.rm, ... @@ -93,14 +93,14 @@ geom_violin <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomViolin <- ggproto("GeomViolin", Geom, +a_GeomViolin <- a_ggproto("a_GeomViolin", a_Geom, setup_data = function(data, params) { data$width <- data$width %||% - params$width %||% (resolution(data$x, FALSE) * 0.9) + params$width %||% (a_resolution(data$x, FALSE) * 0.9) # ymin, ymax, xmin, and xmax define the bounding rectangle for each group plyr::ddply(data, "group", transform, @@ -123,7 +123,7 @@ GeomViolin <- ggproto("GeomViolin", Geom, ) # Close the polygon: set first and last point the same - # Needed for coord_polar and such + # Needed for a_coord_polar and such newdata <- rbind(newdata, newdata[1,]) # Draw quantiles if requested @@ -132,26 +132,26 @@ GeomViolin <- ggproto("GeomViolin", Geom, # Compute the quantile segments and combine with existing aesthetics quantiles <- create_quantile_segment_frame(data, draw_quantiles) - aesthetics <- data[ + a_aesthetics <- data[ rep(1, nrow(quantiles)), setdiff(names(data), c("x", "y")), drop = FALSE ] - both <- cbind(quantiles, aesthetics) - quantile_grob <- GeomPath$draw_panel(both, ...) + both <- cbind(quantiles, a_aesthetics) + quantile_grob <- a_GeomPath$draw_panel(both, ...) ggname("geom_violin", grobTree( - GeomPolygon$draw_panel(newdata, ...), + a_GeomPolygon$draw_panel(newdata, ...), quantile_grob) ) } else { - ggname("geom_violin", GeomPolygon$draw_panel(newdata, ...)) + ggname("geom_violin", a_GeomPolygon$draw_panel(newdata, ...)) } }, - draw_key = draw_key_polygon, + draw_key = a_draw_key_polygon, - default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5, + default_aes = a_aes(weight = 1, colour = "grey20", fill = "white", size = 0.5, alpha = NA, linetype = "solid"), required_aes = c("x", "y") diff --git a/R/geom-vline.r b/R/geom-vline.r index 5d1280463c..aa0060e647 100644 --- a/R/geom-vline.r +++ b/R/geom-vline.r @@ -2,8 +2,8 @@ NULL #' @export -#' @rdname geom_abline -geom_vline <- function(mapping = NULL, data = NULL, +#' @rdname a_geom_abline +a_geom_vline <- function(mapping = NULL, data = NULL, ..., xintercept, na.rm = FALSE, @@ -12,18 +12,18 @@ geom_vline <- function(mapping = NULL, data = NULL, # Act like an annotation if (!missing(xintercept)) { data <- data.frame(xintercept = xintercept) - mapping <- aes(xintercept = xintercept) + mapping <- a_aes(xintercept = xintercept) show.legend <- FALSE } - layer( + a_layer( data = data, mapping = mapping, - stat = StatIdentity, - geom = GeomVline, - position = PositionIdentity, + a_stat = a_StatIdentity, + a_geom = a_GeomVline, + a_position = a_PositionIdentity, show.legend = show.legend, - inherit.aes = FALSE, + inherit.a_aes = FALSE, params = list( na.rm = na.rm, ... @@ -31,24 +31,24 @@ geom_vline <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -GeomVline <- ggproto("GeomVline", Geom, - draw_panel = function(data, panel_scales, coord) { - ranges <- coord$range(panel_scales) +a_GeomVline <- a_ggproto("a_GeomVline", a_Geom, + draw_panel = function(data, panel_scales, a_coord) { + ranges <- a_coord$range(panel_scales) data$x <- data$xintercept data$xend <- data$xintercept data$y <- ranges$y[1] data$yend <- ranges$y[2] - GeomSegment$draw_panel(unique(data), panel_scales, coord) + a_GeomSegment$draw_panel(unique(data), panel_scales, a_coord) }, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), + default_aes = a_aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), required_aes = "xintercept", - draw_key = draw_key_vline + draw_key = a_draw_key_vline ) diff --git a/R/ggplot2.r b/R/ggplot2.r index 90f86f657e..f05bb9283b 100644 --- a/R/ggplot2.r +++ b/R/ggplot2.r @@ -1,3 +1,6 @@ +#' @keywords internal +"_PACKAGE" + #' @import scales grid gtable #' @importFrom plyr defaults #' @importFrom stats setNames diff --git a/R/ggproto.r b/R/ggproto.r index 4168907671..9cb0dfa2ab 100644 --- a/R/ggproto.r +++ b/R/ggproto.r @@ -1,16 +1,16 @@ -#' Create a new ggproto object +#' Create a new a_ggproto object #' -#' ggproto is inspired by the proto package, but it has some important +#' a_ggproto is inspired by the proto package, but it has some important #' differences. Notably, it cleanly supports cross-package inheritance, and has #' faster performance. #' -#' @section Calling ggproto methods: +#' @section Calling a_ggproto methods: #' -#' ggproto methods can take an optional \code{self} argument: if it is present, +#' a_ggproto methods can take an optional \code{self} argument: if it is present, #' it is a regular method; if it's absent, it's a "static" method (i.e. it #' doesn't use any fields). #' -#' Imagine you have a ggproto object \code{Adder}, which has a +#' Imagine you have a a_ggproto object \code{Adder}, which has a #' method \code{addx = function(self, n) n + self$x}. Then, to call this #' function, you would use \code{Adder$addx(10)} -- the \code{self} is passed #' in automatically by the wrapper function. \code{self} be located anywhere @@ -19,22 +19,22 @@ #' @section Calling methods in a parent: #' #' To explicitly call a methods in a parent, use -#' \code{ggproto_parent(Parent, self)}. +#' \code{a_ggproto_parent(Parent, self)}. #' #' @param _class Class name to assign to the object. This is stored as the class #' attribute of the object. If \code{NULL} (the default), no class name will #' be added to the object. -#' @param _inherit ggproto object to inherit from. If \code{NULL}, don't inherit +#' @param _inherit a_ggproto object to inherit from. If \code{NULL}, don't inherit #' from any object. #' @param parent,self Access parent class \code{parent} of object \code{self}. -#' @param ... A list of members in the ggproto object. +#' @param ... A list of members in the a_ggproto object. #' @export -ggproto <- function(`_class` = NULL, `_inherit` = NULL, ...) { +a_ggproto <- function(`_class` = NULL, `_inherit` = NULL, ...) { e <- new.env(parent = emptyenv()) members <- list(...) if (length(members) != sum(nzchar(names(members)))) { - stop("All members of a ggproto object must be named.") + stop("All members of a a_ggproto object must be named.") } # R <3.1.2 will error when list2env() is given an empty list, so we need to @@ -44,26 +44,26 @@ ggproto <- function(`_class` = NULL, `_inherit` = NULL, ...) { } if (!is.null(`_inherit`)) { - if (!is.ggproto(`_inherit`)) { - stop("`_inherit` must be a ggproto object.") + if (!is.a_ggproto(`_inherit`)) { + stop("`_inherit` must be a a_ggproto object.") } e$super <- `_inherit` class(e) <- c(`_class`, class(`_inherit`)) } else { - class(e) <- c(`_class`, "ggproto") + class(e) <- c(`_class`, "a_ggproto") } e } -#' Is an object a ggproto object? +#' Is an object a a_ggproto object? #' #' @param x An object to test. #' @export -is.ggproto <- function(x) inherits(x, "ggproto") +is.a_ggproto <- function(x) inherits(x, "a_ggproto") -fetch_ggproto <- function(x, name) { +fetch_a_ggproto <- function(x, name) { res <- NULL val <- .subset2(x, name) @@ -74,22 +74,22 @@ fetch_ggproto <- function(x, name) { } else { # If not found here, recurse into super environments super <- .subset2(x, "super") - if (is.ggproto(super)) - res <- fetch_ggproto(super, name) + if (is.a_ggproto(super)) + res <- fetch_a_ggproto(super, name) } res } #' @export -#' @rdname ggproto -ggproto_parent <- function(parent, self) { - structure(list(parent = parent, self = self), class = "ggproto_parent") +#' @rdname a_ggproto +a_ggproto_parent <- function(parent, self) { + structure(list(parent = parent, self = self), class = "a_ggproto_parent") } #' @export -`$.ggproto` <- function(x, name) { - res <- fetch_ggproto(x, name) +`$.a_ggproto` <- function(x, name) { + res <- fetch_a_ggproto(x, name) if (!is.function(res)) { return(res) } @@ -98,8 +98,8 @@ ggproto_parent <- function(parent, self) { } #' @export -`$.ggproto_parent` <- function(x, name) { - res <- fetch_ggproto(.subset2(x, "parent"), name) +`$.a_ggproto_parent` <- function(x, name) { + res <- fetch_a_ggproto(.subset2(x, "parent"), name) if (!is.function(res)) { return(res) } @@ -107,36 +107,36 @@ ggproto_parent <- function(parent, self) { make_proto_method(.subset2(x, "self"), res) } -make_proto_method <- function(self, f) { - args <- formals(f) +make_proto_method <- function(self, ff) { + args <- formals(ff) # is.null is a fast path for a common case; the %in% check is slower but also # catches the case where there's a `self = NULL` argument. has_self <- !is.null(args[["self"]]) || "self" %in% names(args) if (has_self) { - fun <- function(...) f(..., self = self) + fun <- function(...) ff(..., self = self) } else { - fun <- function(...) f(...) + fun <- function(...) ff(...) } - class(fun) <- "ggproto_method" + class(fun) <- "a_ggproto_method" fun } #' @export -`[[.ggproto` <- `$.ggproto` +`[[.a_ggproto` <- `$.a_ggproto` -#' Convert a ggproto object to a list +#' Convert a a_ggproto object to a list #' #' This will not include the object's \code{super} member. #' -#' @param x A ggproto object to convert to a list. +#' @param x A a_ggproto object to convert to a list. #' @param inherit If \code{TRUE} (the default), flatten all inherited items into #' the returned list. If \code{FALSE}, do not include any inherited items. #' @param ... Further arguments to pass to \code{as.list.environment}. #' @export -as.list.ggproto <- function(x, inherit = TRUE, ...) { +as.list.a_ggproto <- function(x, inherit = TRUE, ...) { res <- list() if (inherit) { @@ -152,20 +152,20 @@ as.list.ggproto <- function(x, inherit = TRUE, ...) { } -#' Print a ggproto object +#' Print a a_ggproto object #' -#' If a ggproto object has a \code{$print} method, this will call that method. +#' If a a_ggproto object has a \code{$print} method, this will call that method. #' Otherwise, it will print out the members of the object, and optionally, the #' members of the inherited objects. #' -#' @param x A ggproto object to print. +#' @param x A a_ggproto object to print. #' @param flat If \code{TRUE} (the default), show a flattened list of all local #' and inherited members. If \code{FALSE}, show the inheritance hierarchy. -#' @param ... If the ggproto object has a \code{print} method, further arguments +#' @param ... If the a_ggproto object has a \code{print} method, further arguments #' will be passed to it. Otherwise, these arguments are unused. #' #' @export -print.ggproto <- function(x, ..., flat = TRUE) { +print.a_ggproto <- function(x, ..., flat = TRUE) { if (is.function(x$print)) { x$print(...) @@ -176,13 +176,13 @@ print.ggproto <- function(x, ..., flat = TRUE) { } -#' Format a ggproto object +#' Format a a_ggproto object #' -#' @inheritParams print.ggproto +#' @inheritParams print.a_ggproto #' @export -format.ggproto <- function(x, ..., flat = TRUE) { +format.a_ggproto <- function(x, ..., flat = TRUE) { classes_str <- function(obj) { - classes <- setdiff(class(obj), "ggproto") + classes <- setdiff(class(obj), "a_ggproto") if (length(classes) == 0) return("") paste0(": Class ", paste(classes, collapse = ', ')) @@ -196,7 +196,7 @@ format.ggproto <- function(x, ..., flat = TRUE) { } str <- paste0( - "\n", + "\n", indent(object_summaries(objs, flat = flat), 4) ) @@ -204,7 +204,7 @@ format.ggproto <- function(x, ..., flat = TRUE) { str <- paste0( str, "\n", indent( - paste0("super: ", " "), + paste0("super: ", " "), 4 ) ) @@ -229,7 +229,7 @@ object_summaries <- function(x, exclude = NULL, flat = TRUE) { values <- vapply(obj_names, function(name) { obj <- x[[name]] if (is.function(obj)) "function" - else if (is.ggproto(obj)) format(obj, flat = flat) + else if (is.a_ggproto(obj)) format(obj, flat = flat) else if (is.environment(obj)) "environment" else if (is.null(obj)) "NULL" else if (is.atomic(obj)) trim(paste(as.character(obj), collapse = " ")) @@ -243,9 +243,9 @@ object_summaries <- function(x, exclude = NULL, flat = TRUE) { # The exception is to not add spaces after a trailing \n. indent <- function(str, indent = 0) { gsub("(\\n|^)(?!$)", - paste0("\\1", paste(rep(" ", indent), collapse = "")), - str, - perl = TRUE + paste0("\\1", paste(rep(" ", indent), collapse = "")), + str, + perl = TRUE ) } @@ -256,12 +256,12 @@ trim <- function(str, n = 60) { } #' @export -print.ggproto_method <- function(x, ...) { +print.a_ggproto_method <- function(x, ...) { cat(format(x), sep = "") } #' @export -format.ggproto_method <- function(x, ...) { +format.a_ggproto_method <- function(x, ...) { # Given a function, return a string from srcref if present. If not present, # paste the deparsed lines of code together. @@ -275,11 +275,11 @@ format.ggproto_method <- function(x, ...) { x <- unclass(x) paste0( - "", + "", "\n \n ", format_fun(x), - "\n\n \n ", format_fun(environment(x)$f) + "\n\n \n ", format_fun(environment(x)$ff) ) } # proto2 TODO: better way of getting formals for self$draw -ggproto_formals <- function(x) formals(environment(x)$f) +a_ggproto_formals <- function(x) formals(environment(x)$ff) diff --git a/R/grob-absolute.r b/R/grob-absolute.r index cce138712a..da1a36df7a 100644 --- a/R/grob-absolute.r +++ b/R/grob-absolute.r @@ -1,10 +1,13 @@ #' Absolute grob -#' #' This grob has fixed dimensions and position. -#' #' It's still experimental -#' -#' @keywords internal +#' @param grob .... +#' @param width ..... +#' @param height ..... +#' @param xmin ...... +#' @param ymin ....... +#' @param vp .... +#' @export absoluteGrob <- function(grob, width = NULL, height = NULL, xmin = NULL, ymin = NULL, vp = NULL) { diff --git a/R/grob-null.r b/R/grob-null.r index 5af4c40ca5..fd5cf43e44 100644 --- a/R/grob-null.r +++ b/R/grob-null.r @@ -2,23 +2,23 @@ #' #' @keywords internal #' @export -zeroGrob <- function() .zeroGrob +a_zeroGrob <- function() .a_zeroGrob -.zeroGrob <- grob(cl = "zeroGrob", name = "NULL") +.a_zeroGrob <- grob(cl = "a_zeroGrob", name = "NULL") #' @export -#' @method widthDetails zeroGrob -widthDetails.zeroGrob <- function(x) unit(0, "cm") +#' @method widthDetails a_zeroGrob +widthDetails.a_zeroGrob <- function(x) unit(0, "cm") #' @export -#' @method heightDetails zeroGrob -heightDetails.zeroGrob <- function(x) unit(0, "cm") +#' @method heightDetails a_zeroGrob +heightDetails.a_zeroGrob <- function(x) unit(0, "cm") #' @export -#' @method grobWidth zeroGrob -grobWidth.zeroGrob <- function(x) unit(0, "cm") +#' @method grobWidth a_zeroGrob +grobWidth.a_zeroGrob <- function(x) unit(0, "cm") #' @export -#' @method grobHeight zeroGrob -grobHeight.zeroGrob <- function(x) unit(0, "cm") +#' @method grobHeight a_zeroGrob +grobHeight.a_zeroGrob <- function(x) unit(0, "cm") #' @export -#' @method drawDetails zeroGrob -drawDetails.zeroGrob <- function(x, recording) {} +#' @method drawDetails a_zeroGrob +drawDetails.a_zeroGrob <- function(x, recording) {} -is.zero <- function(x) is.null(x) || inherits(x, "zeroGrob") +is.zero <- function(x) is.null(x) || inherits(x, "a_zeroGrob") diff --git a/R/grouping.r b/R/grouping.r index 52c343292e..59c3fd1ebe 100644 --- a/R/grouping.r +++ b/R/grouping.r @@ -6,14 +6,14 @@ NO_GROUP <- -1L # # If the \code{group} variable is not present, then a new group # variable is generated from the interaction of all discrete (factor or -# character) vectors, excluding \code{label}. The special value \code{NO_GROUP} +# character) vectors, excluding \code{a_label}. The special value \code{NO_GROUP} # is used for all observations if no discrete variables exist. add_group <- function(data) { if (empty(data)) return(data) if (is.null(data$group)) { disc <- vapply(data, is.discrete, logical(1)) - disc[names(disc) %in% c("label", "PANEL")] <- FALSE + disc[names(disc) %in% c("a_label", "PANEL")] <- FALSE if (any(disc)) { data$group <- plyr::id(data[disc], drop = TRUE) diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index 4e95635ffe..0aba2b8dd5 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -1,23 +1,23 @@ #' Continuous colour bar guide. #' #' Colour bar guide shows continuous color scales mapped onto values. -#' Colour bar is available with \code{scale_fill} and \code{scale_colour}. +#' Colour bar is available with \code{a_scale_fill} and \code{a_scale_colour}. #' For more information, see the inspiration for this function: #' \href{http://www.mathworks.com/help/techdoc/ref/colorbar.html}{Matlab's colorbar function}. #' -#' Guides can be specified in each \code{scale_*} or in \code{\link{guides}}. -#' \code{guide="legend"} in \code{scale_*} is syntactic sugar for -#' \code{guide=guide_legend()} (e.g. \code{scale_color_manual(guide = "legend")}). -#' As for how to specify the guide for each scale in more detail, -#' see \code{\link{guides}}. +#' Guides can be specified in each \code{a_scale_*} or in \code{\link{a_guides}}. +#' \code{a_guide="legend"} in \code{a_scale_*} is syntactic sugar for +#' \code{a_guide=a_guide_legend()} (e.g. \code{a_scale_color_manual(a_guide = "legend")}). +#' As for how to specify the a_guide for each scale in more detail, +#' see \code{\link{a_guides}}. #' -#' @inheritParams guide_legend +#' @inheritParams a_guide_legend #' @param barwidth A numeric or a \code{\link[grid]{unit}} object specifying #' the width of the colorbar. Default value is \code{legend.key.width} or -#' \code{legend.key.size} in \code{\link{theme}} or theme. +#' \code{legend.key.size} in \code{\link{a_theme}} or a_theme. #' @param barheight A numeric or a \code{\link[grid]{unit}} object specifying #' the height of the colorbar. Default value is \code{legend.key.height} or -#' \code{legend.key.size} in \code{\link{theme}} or theme. +#' \code{legend.key.size} in \code{\link{a_theme}} or a_theme. #' @param nbin A numeric specifying the number of bins for drawing colorbar. A #' smoother colorbar for a larger value. #' @param raster A logical. If \code{TRUE} then the colorbar is rendered as a @@ -39,69 +39,69 @@ #' @param ... ignored. #' @return A guide object #' @export -#' @family guides +#' @family a_guides #' @examples #' df <- reshape2::melt(outer(1:4, 1:4), varnames = c("X1", "X2")) #' -#' p1 <- ggplot(df, aes(X1, X2)) + geom_tile(aes(fill = value)) -#' p2 <- p1 + geom_point(aes(size = value)) +#' p1 <- a_plot(df, a_aes(X1, X2)) + a_geom_tile(a_aes(fill = value)) +#' p2 <- p1 + a_geom_point(a_aes(size = value)) #' #' # Basic form -#' p1 + scale_fill_continuous(guide = "colorbar") -#' p1 + scale_fill_continuous(guide = guide_colorbar()) -#' p1 + guides(fill = guide_colorbar()) +#' p1 + a_scale_fill_continuous(a_guide = "colorbar") +#' p1 + a_scale_fill_continuous(a_guide = a_guide_colorbar()) +#' p1 + a_guides(fill = a_guide_colorbar()) #' #' # Control styles #' #' # bar size -#' p1 + guides(fill = guide_colorbar(barwidth = 0.5, barheight = 10)) +#' p1 + a_guides(fill = a_guide_colorbar(barwidth = 0.5, barheight = 10)) #' -#' # no label -#' p1 + guides(fill = guide_colorbar(label = FALSE)) +#' # no a_label +#' p1 + a_guides(fill = a_guide_colorbar(a_label = FALSE)) #' #' # no tick marks -#' p1 + guides(fill = guide_colorbar(ticks = FALSE)) +#' p1 + a_guides(fill = a_guide_colorbar(ticks = FALSE)) #' -#' # label position -#' p1 + guides(fill = guide_colorbar(label.position = "left")) +#' # a_label a_position +#' p1 + a_guides(fill = a_guide_colorbar(a_label.a_position = "left")) #' -#' # label theme -#' p1 + guides(fill = guide_colorbar(label.theme = element_text(colour = "blue", angle = 0))) +#' # a_label a_theme +#' p1 + a_guides(fill = a_guide_colorbar(a_label.a_theme = a_element_text(colour = "blue", angle = 0))) #' #' # small number of bins -#' p1 + guides(fill = guide_colorbar(nbin = 3)) +#' p1 + a_guides(fill = a_guide_colorbar(nbin = 3)) #' #' # large number of bins -#' p1 + guides(fill = guide_colorbar(nbin = 100)) +#' p1 + a_guides(fill = a_guide_colorbar(nbin = 100)) #' #' # make top- and bottom-most ticks invisible -#' p1 + scale_fill_continuous(limits = c(0,20), breaks = c(0, 5, 10, 15, 20), -#' guide = guide_colorbar(nbin=100, draw.ulim = FALSE, draw.llim = FALSE)) +#' p1 + a_scale_fill_continuous(limits = c(0,20), breaks = c(0, 5, 10, 15, 20), +#' a_guide = a_guide_colorbar(nbin=100, draw.ulim = FALSE, draw.llim = FALSE)) #' #' # guides can be controlled independently #' p2 + -#' scale_fill_continuous(guide = "colorbar") + -#' scale_size(guide = "legend") -#' p2 + guides(fill = "colorbar", size = "legend") +#' a_scale_fill_continuous(a_guide = "colorbar") + +#' a_scale_size(a_guide = "legend") +#' p2 + a_guides(fill = "colorbar", size = "legend") #' #' p2 + -#' scale_fill_continuous(guide = guide_colorbar(direction = "horizontal")) + -#' scale_size(guide = guide_legend(direction = "vertical")) -guide_colourbar <- function( +#' a_scale_fill_continuous(a_guide = a_guide_colorbar(direction = "horizontal")) + +#' a_scale_size(a_guide = a_guide_legend(direction = "vertical")) +a_guide_colourbar <- function( # title title = waiver(), - title.position = NULL, - title.theme = NULL, + title.a_position = NULL, + title.a_theme = NULL, title.hjust = NULL, title.vjust = NULL, - # label - label = TRUE, - label.position = NULL, - label.theme = NULL, - label.hjust = NULL, - label.vjust = NULL, + # a_label + a_label = TRUE, + a_label.a_position = NULL, + a_label.a_theme = NULL, + a_label.hjust = NULL, + a_label.vjust = NULL, # bar barwidth = NULL, @@ -128,17 +128,17 @@ guide_colourbar <- function( structure(list( # title title = title, - title.position = title.position, - title.theme = title.theme, + title.a_position = title.a_position, + title.a_theme = title.a_theme, title.hjust = title.hjust, title.vjust = title.vjust, - # label - label = label, - label.position = label.position, - label.theme = label.theme, - label.hjust = label.hjust, - label.vjust = label.vjust, + # a_label + a_label = a_label, + a_label.a_position = a_label.a_position, + a_label.a_theme = a_label.a_theme, + a_label.hjust = a_label.hjust, + a_label.vjust = a_label.vjust, # bar barwidth = barwidth, @@ -159,124 +159,124 @@ guide_colourbar <- function( # parameter available_aes = c("colour", "color", "fill"), ..., name = "colorbar"), - class = c("guide", "colorbar") + class = c("a_guide", "colorbar") ) } #' @export -guide_train.colorbar <- function(guide, scale) { +a_guide_train.colorbar <- function(a_guide, a_scale) { # do nothing if scale are inappropriate - if (length(intersect(scale$aesthetics, c("color", "colour", "fill"))) == 0) { + if (length(intersect(a_scale$a_aesthetics, c("color", "colour", "fill"))) == 0) { warning("colorbar guide needs colour or fill scales.") return(NULL) } - if (scale$is_discrete()) { + if (a_scale$is_discrete()) { warning("colorbar guide needs continuous scales.") return(NULL) } # create data frame for tick display - breaks <- scale$get_breaks() + breaks <- a_scale$get_breaks() if (length(breaks) == 0 || all(is.na(breaks))) return() - ticks <- as.data.frame(setNames(list(scale$map(breaks)), scale$aesthetics[1])) + ticks <- as.data.frame(setNames(list(a_scale$map(breaks)), a_scale$a_aesthetics[1])) ticks$.value <- breaks - ticks$.label <- scale$get_labels(breaks) + ticks$.a_label <- a_scale$get_labels(breaks) - guide$key <- ticks + a_guide$key <- ticks # bar specification (number of divs etc) - .limits <- scale$get_limits() - .bar <- discard(pretty(.limits, n = guide$nbin), scale$get_limits()) + .limits <- a_scale$get_limits() + .bar <- discard(pretty(.limits, n = a_guide$nbin), a_scale$get_limits()) if (length(.bar) == 0) { .bar = unique(.limits) } - guide$bar <- data.frame(colour = scale$map(.bar), value = .bar, stringsAsFactors = FALSE) - if (guide$reverse) { - guide$key <- guide$key[nrow(guide$key):1, ] - guide$bar <- guide$bar[nrow(guide$bar):1, ] + a_guide$bar <- data.frame(colour = a_scale$map(.bar), value = .bar, stringsAsFactors = FALSE) + if (a_guide$reverse) { + a_guide$key <- a_guide$key[nrow(a_guide$key):1, ] + a_guide$bar <- a_guide$bar[nrow(a_guide$bar):1, ] } - guide$hash <- with(guide, digest::digest(list(title, key$.label, bar, name))) - guide + a_guide$hash <- with(a_guide, digest::digest(list(title, key$.a_label, bar, name))) + a_guide } -# simply discards the new guide +# simply discards the new a_guide #' @export -guide_merge.colorbar <- function(guide, new_guide) { - guide +a_guide_merge.colorbar <- function(a_guide, new_guide) { + a_guide } # this guide is not geom-based. #' @export -guide_geom.colorbar <- function(guide, ...) { - guide +a_guide_geom.colorbar <- function(a_guide, ...) { + a_guide } #' @export -guide_gengrob.colorbar <- function(guide, theme) { +a_guide_gengrob.colorbar <- function(a_guide, a_theme) { # settings of location and size - switch(guide$direction, + switch(a_guide$direction, "horizontal" = { - label.position <- guide$label.position %||% "bottom" - if (!label.position %in% c("top", "bottom")) stop("label position \"", label.position, "\" is invalid") + a_label.a_position <- a_guide$a_label.a_position %||% "bottom" + if (!a_label.a_position %in% c("top", "bottom")) stop("a_label a_position \"", a_label.a_position, "\" is invalid") - barwidth <- convertWidth(guide$barwidth %||% (theme$legend.key.width * 5), "mm") - barheight <- convertHeight(guide$barheight %||% theme$legend.key.height, "mm") + barwidth <- convertWidth(a_guide$barwidth %||% (a_theme$legend.key.width * 5), "mm") + barheight <- convertHeight(a_guide$barheight %||% a_theme$legend.key.height, "mm") }, "vertical" = { - label.position <- guide$label.position %||% "right" - if (!label.position %in% c("left", "right")) stop("label position \"", label.position, "\" is invalid") + a_label.a_position <- a_guide$a_label.a_position %||% "right" + if (!a_label.a_position %in% c("left", "right")) stop("a_label a_position \"", a_label.a_position, "\" is invalid") - barwidth <- convertWidth(guide$barwidth %||% theme$legend.key.width, "mm") - barheight <- convertHeight(guide$barheight %||% (theme$legend.key.height * 5), "mm") + barwidth <- convertWidth(a_guide$barwidth %||% a_theme$legend.key.width, "mm") + barheight <- convertHeight(a_guide$barheight %||% (a_theme$legend.key.height * 5), "mm") }) barwidth.c <- c(barwidth) barheight.c <- c(barheight) - barlength.c <- switch(guide$direction, "horizontal" = barwidth.c, "vertical" = barheight.c) - nbreak <- nrow(guide$key) + barlength.c <- switch(a_guide$direction, "horizontal" = barwidth.c, "vertical" = barheight.c) + nbreak <- nrow(a_guide$key) # gap between keys etc hgap <- c(convertWidth(unit(0.3, "lines"), "mm")) vgap <- hgap grob.bar <- - if (guide$raster) { - image <- switch(guide$direction, horizontal = t(guide$bar$colour), vertical = rev(guide$bar$colour)) + if (a_guide$raster) { + image <- switch(a_guide$direction, horizontal = t(a_guide$bar$colour), vertical = rev(a_guide$bar$colour)) rasterGrob(image = image, width = barwidth.c, height = barheight.c, default.units = "mm", gp = gpar(col = NA), interpolate = TRUE) } else { - switch(guide$direction, + switch(a_guide$direction, horizontal = { - bw <- barwidth.c / nrow(guide$bar) - bx <- (seq(nrow(guide$bar)) - 1) * bw + bw <- barwidth.c / nrow(a_guide$bar) + bx <- (seq(nrow(a_guide$bar)) - 1) * bw rectGrob(x = bx, y = 0, vjust = 0, hjust = 0, width = bw, height = barheight.c, default.units = "mm", - gp = gpar(col = NA, fill = guide$bar$colour)) + gp = gpar(col = NA, fill = a_guide$bar$colour)) }, vertical = { - bh <- barheight.c / nrow(guide$bar) - by <- (seq(nrow(guide$bar)) - 1) * bh + bh <- barheight.c / nrow(a_guide$bar) + by <- (seq(nrow(a_guide$bar)) - 1) * bh rectGrob(x = 0, y = by, vjust = 0, hjust = 0, width = barwidth.c, height = bh, default.units = "mm", - gp = gpar(col = NA, fill = guide$bar$colour)) + gp = gpar(col = NA, fill = a_guide$bar$colour)) }) } - # tick and label position - tic_pos.c <- rescale(guide$key$.value, c(0.5, guide$nbin - 0.5), guide$bar$value[c(1, nrow(guide$bar))]) * barlength.c / guide$nbin - label_pos <- unit(tic_pos.c, "mm") - if (!guide$draw.ulim) tic_pos.c <- tic_pos.c[-1] - if (!guide$draw.llim) tic_pos.c <- tic_pos.c[-length(tic_pos.c)] + # tick and a_label position + tic_pos.c <- rescale(a_guide$key$.value, c(0.5, a_guide$nbin - 0.5), a_guide$bar$value[c(1, nrow(a_guide$bar))]) * barlength.c / a_guide$nbin + a_label_pos <- unit(tic_pos.c, "mm") + if (!a_guide$draw.ulim) tic_pos.c <- tic_pos.c[-1] + if (!a_guide$draw.llim) tic_pos.c <- tic_pos.c[-length(tic_pos.c)] # title - grob.title <- ggname("guide.title", - element_grob( - guide$title.theme %||% calc_element("legend.title", theme), - label = guide$title, - hjust = guide$title.hjust %||% theme$legend.title.align %||% 0, - vjust = guide$title.vjust %||% 0.5 + grob.title <- ggname("a_guide.title", + a_element_grob( + a_guide$title.a_theme %||% a_calc_element("legend.title", a_theme), + a_label = a_guide$title, + hjust = a_guide$title.hjust %||% a_theme$legend.title.align %||% 0, + vjust = a_guide$title.vjust %||% 0.5 ) ) @@ -286,44 +286,44 @@ guide_gengrob.colorbar <- function(guide, theme) { title_height <- convertHeight(grobHeight(grob.title), "mm") title_height.c <- c(title_height) - # label - label.theme <- guide$label.theme %||% calc_element("legend.text", theme) - grob.label <- { - if (!guide$label) - zeroGrob() + # a_label + a_label.a_theme <- a_guide$a_label.a_theme %||% a_calc_element("legend.text", a_theme) + grob.a_label <- { + if (!a_guide$a_label) + a_zeroGrob() else { - hjust <- x <- guide$label.hjust %||% theme$legend.text.align %||% - if (any(is.expression(guide$key$.label))) 1 else switch(guide$direction, horizontal = 0.5, vertical = 0) - vjust <- y <- guide$label.vjust %||% 0.5 - switch(guide$direction, horizontal = {x <- label_pos; y <- vjust}, "vertical" = {x <- hjust; y <- label_pos}) + hjust <- x <- a_guide$a_label.hjust %||% a_theme$legend.text.align %||% + if (any(is.expression(a_guide$key$.a_label))) 1 else switch(a_guide$direction, horizontal = 0.5, vertical = 0) + vjust <- y <- a_guide$a_label.vjust %||% 0.5 + switch(a_guide$direction, horizontal = {x <- a_label_pos; y <- vjust}, "vertical" = {x <- hjust; y <- a_label_pos}) - label <- guide$key$.label + a_label <- a_guide$key$.a_label - # If any of the labels are quoted language objects, convert them - # to expressions. Labels from formatter functions can return these - if (any(vapply(label, is.call, logical(1)))) { - label <- lapply(label, function(l) { + # If any of the a_labels are quoted language objects, convert them + # to expressions. a_labels from formatter functions can return these + if (any(vapply(a_label, is.call, logical(1)))) { + a_label <- lapply(a_label, function(l) { if (is.call(l)) substitute(expression(x), list(x = l)) else l }) - label <- do.call(c, label) + a_label <- do.call(c, a_label) } - g <- element_grob(element = label.theme, label = label, + g <- a_element_grob(a_element = a_label.a_theme, a_label = a_label, x = x, y = y, hjust = hjust, vjust = vjust) - ggname("guide.label", g) + ggname("a_guide.a_label", g) } } - label_width <- convertWidth(grobWidth(grob.label), "mm") - label_width.c <- c(label_width) - label_height <- convertHeight(grobHeight(grob.label), "mm") - label_height.c <- c(label_height) + a_label_width <- convertWidth(grobWidth(grob.a_label), "mm") + a_label_width.c <- c(a_label_width) + a_label_height <- convertHeight(grobHeight(grob.a_label), "mm") + a_label_height.c <- c(a_label_height) # ticks grob.ticks <- - if (!guide$ticks) zeroGrob() + if (!a_guide$ticks) a_zeroGrob() else { - switch(guide$direction, + switch(a_guide$direction, "horizontal" = { x0 = rep(tic_pos.c, 2) y0 = c(rep(0, nbreak), rep(barheight.c * (4/5), nbreak)) @@ -340,47 +340,47 @@ guide_gengrob.colorbar <- function(guide, theme) { default.units = "mm", gp = gpar(col = "white", lwd = 0.5, lineend = "butt")) } - # layout of bar and label - switch(guide$direction, + # layout of bar and a_label + switch(a_guide$direction, "horizontal" = { - switch(label.position, + switch(a_label.a_position, "top" = { bl_widths <- barwidth.c - bl_heights <- c(label_height.c, vgap, barheight.c) + bl_heights <- c(a_label_height.c, vgap, barheight.c) vps <- list(bar.row = 3, bar.col = 1, - label.row = 1, label.col = 1) + a_label.row = 1, a_label.col = 1) }, "bottom" = { bl_widths <- barwidth.c - bl_heights <- c(barheight.c, vgap, label_height.c) + bl_heights <- c(barheight.c, vgap, a_label_height.c) vps <- list(bar.row = 1, bar.col = 1, - label.row = 3, label.col = 1) + a_label.row = 3, a_label.col = 1) }) }, "vertical" = { - switch(label.position, + switch(a_label.a_position, "left" = { - bl_widths <- c(label_width.c, vgap, barwidth.c) + bl_widths <- c(a_label_width.c, vgap, barwidth.c) bl_heights <- barheight.c vps <- list(bar.row = 1, bar.col = 3, - label.row = 1, label.col = 1) + a_label.row = 1, a_label.col = 1) }, "right" = { - bl_widths <- c(barwidth.c, vgap, label_width.c) + bl_widths <- c(barwidth.c, vgap, a_label_width.c) bl_heights <- barheight.c vps <- list(bar.row = 1, bar.col = 1, - label.row = 1, label.col = 3) + a_label.row = 1, a_label.col = 3) }) }) - # layout of title and bar+label - switch(guide$title.position, + # layout of title and bar+a_label + switch(a_guide$title.a_position, "top" = { widths <- c(bl_widths, max(0, title_width.c - sum(bl_widths))) heights <- c(title_height.c, vgap, bl_heights) vps <- with(vps, list(bar.row = bar.row + 2, bar.col = bar.col, - label.row = label.row + 2, label.col = label.col, + a_label.row = a_label.row + 2, a_label.col = a_label.col, title.row = 1, title.col = 1:length(widths))) }, "bottom" = { @@ -388,7 +388,7 @@ guide_gengrob.colorbar <- function(guide, theme) { heights <- c(bl_heights, vgap, title_height.c) vps <- with(vps, list(bar.row = bar.row, bar.col = bar.col, - label.row = label.row, label.col = label.col, + a_label.row = a_label.row, a_label.col = a_label.col, title.row = length(heights), title.col = 1:length(widths))) }, "left" = { @@ -396,7 +396,7 @@ guide_gengrob.colorbar <- function(guide, theme) { heights <- c(bl_heights, max(0, title_height.c - sum(bl_heights))) vps <- with(vps, list(bar.row = bar.row, bar.col = bar.col + 2, - label.row = label.row, label.col = label.col + 2, + a_label.row = a_label.row, a_label.col = a_label.col + 2, title.row = 1:length(heights), title.col = 1)) }, "right" = { @@ -404,12 +404,12 @@ guide_gengrob.colorbar <- function(guide, theme) { heights <- c(bl_heights, max(0, title_height.c - sum(bl_heights))) vps <- with(vps, list(bar.row = bar.row, bar.col = bar.col, - label.row = label.row, label.col = label.col, + a_label.row = a_label.row, a_label.col = a_label.col, title.row = 1:length(heights), title.col = length(widths))) }) # background - grob.background <- element_render(theme, "legend.background") + grob.background <- a_element_render(a_theme, "legend.background") # padding padding <- unit(1.5, "mm") @@ -422,9 +422,9 @@ guide_gengrob.colorbar <- function(guide, theme) { gt <- gtable_add_grob(gt, grob.bar, name = "bar", clip = "off", t = 1 + min(vps$bar.row), r = 1 + max(vps$bar.col), b = 1 + max(vps$bar.row), l = 1 + min(vps$bar.col)) - gt <- gtable_add_grob(gt, grob.label, name = "label", clip = "off", - t = 1 + min(vps$label.row), r = 1 + max(vps$label.col), - b = 1 + max(vps$label.row), l = 1 + min(vps$label.col)) + gt <- gtable_add_grob(gt, grob.a_label, name = "a_label", clip = "off", + t = 1 + min(vps$a_label.row), r = 1 + max(vps$a_label.col), + b = 1 + max(vps$a_label.row), l = 1 + min(vps$a_label.col)) gt <- gtable_add_grob(gt, grob.title, name = "title", clip = "off", t = 1 + min(vps$title.row), r = 1 + max(vps$title.col), b = 1 + max(vps$title.row), l = 1 + min(vps$title.col)) @@ -436,5 +436,5 @@ guide_gengrob.colorbar <- function(guide, theme) { } #' @export -#' @rdname guide_colourbar -guide_colorbar <- guide_colourbar +#' @rdname a_guide_colourbar +a_guide_colorbar <- a_guide_colourbar diff --git a/R/guide-legend.r b/R/guide-legend.r index bee2208be2..25d304146f 100644 --- a/R/guide-legend.r +++ b/R/guide-legend.r @@ -3,49 +3,49 @@ #' Legend type guide shows key (i.e., geoms) mapped onto values. #' Legend guides for various scales are integrated if possible. #' -#' Guides can be specified in each \code{scale_*} or in \code{\link{guides}}. -#' \code{guide="legend"} in \code{scale_*} is syntactic sugar for -#' \code{guide=guide_legend()} (e.g. \code{scale_color_manual(guide = "legend")}). +#' Guides can be specified in each \code{a_scale_*} or in \code{\link{a_guides}}. +#' \code{a_guide="legend"} in \code{a_scale_*} is syntactic sugar for +#' \code{a_guide=a_guide_legend()} (e.g. \code{a_scale_color_manual(a_guide = "legend")}). #' As for how to specify the guide for each scale in more detail, -#' see \code{\link{guides}}. +#' see \code{\link{a_guides}}. #' -#' @param title A character string or expression indicating a title of guide. +#' @param title A character string or expression indicating a title of a_guide. #' If \code{NULL}, the title is not shown. By default #' (\code{\link{waiver}}), the name of the scale object or the name #' specified in \code{\link{labs}} is used for the title. -#' @param title.position A character string indicating the position of a -#' title. One of "top" (default for a vertical guide), "bottom", "left" -#' (default for a horizontal guide), or "right." -#' @param title.theme A theme object for rendering the title text. Usually the -#' object of \code{\link{element_text}} is expected. By default, the theme is -#' specified by \code{legend.title} in \code{\link{theme}} or theme. +#' @param title.a_position A character string indicating the a_position of a +#' title. One of "top" (default for a vertical a_guide), "bottom", "left" +#' (default for a horizontal a_guide), or "right." +#' @param title.a_theme A theme object for rendering the title text. Usually the +#' object of \code{\link{a_element_text}} is expected. By default, the theme is +#' specified by \code{legend.title} in \code{\link{a_theme}} or theme. #' @param title.hjust A number specifying horizontal justification of the #' title text. #' @param title.vjust A number specifying vertical justification of the title #' text. -#' @param label logical. If \code{TRUE} then the labels are drawn. If +#' @param a_label logical. If \code{TRUE} then the labels are drawn. If #' \code{FALSE} then the labels are invisible. -#' @param label.position A character string indicating the position of a -#' label. One of "top", "bottom" (default for horizontal guide), "left", or -#' "right" (default for vertical guide). -#' @param label.theme A theme object for rendering the label text. Usually the -#' object of \code{\link{element_text}} is expected. By default, the theme is -#' specified by \code{legend.text} in \code{\link{theme}} or theme. -#' @param label.hjust A numeric specifying horizontal justification of the +#' @param a_label.a_position A character string indicating the a_position of a +#' label. One of "top", "bottom" (default for horizontal a_guide), "left", or +#' "right" (default for vertical a_guide). +#' @param a_label.a_theme A theme object for rendering the label text. Usually the +#' object of \code{\link{a_element_text}} is expected. By default, the theme is +#' specified by \code{legend.text} in \code{\link{a_theme}} or theme. +#' @param a_label.hjust A numeric specifying horizontal justification of the #' label text. -#' @param label.vjust A numeric specifying vertical justification of the label +#' @param a_label.vjust A numeric specifying vertical justification of the label #' text. #' @param keywidth A numeric or a \code{\link[grid]{unit}} object specifying #' the width of the legend key. Default value is \code{legend.key.width} or -#' \code{legend.key.size} in \code{\link{theme}} or theme. +#' \code{legend.key.size} in \code{\link{a_theme}} or theme. #' @param keyheight A numeric or a \code{\link[grid]{unit}} object specifying #' the height of the legend key. Default value is \code{legend.key.height} or -#' \code{legend.key.size} in \code{\link{theme}} or theme. +#' \code{legend.key.size} in \code{\link{a_theme}} or theme. #' @param direction A character string indicating the direction of the guide. #' One of "horizontal" or "vertical." #' @param default.unit A character string indicating \code{\link[grid]{unit}} #' for \code{keywidth} and \code{keyheight}. -#' @param override.aes A list specifying aesthetic parameters of legend key. +#' @param override.a_aes A list specifying aesthetic parameters of legend key. #' See details and examples. #' @param nrow The desired number of rows of legends. #' @param ncol The desired number of column of legends. @@ -59,34 +59,34 @@ #' @param ... ignored. #' @return A guide object #' @export -#' @family guides +#' @family a_guides #' @examples #' \donttest{ #' df <- reshape2::melt(outer(1:4, 1:4), varnames = c("X1", "X2")) #' -#' p1 <- ggplot(df, aes(X1, X2)) + geom_tile(aes(fill = value)) -#' p2 <- p1 + geom_point(aes(size = value)) +#' p1 <- a_plot(df, a_aes(X1, X2)) + a_geom_tile(a_aes(fill = value)) +#' p2 <- p1 + a_geom_point(a_aes(size = value)) #' #' # Basic form -#' p1 + scale_fill_continuous(guide = "legend") -#' p1 + scale_fill_continuous(guide = guide_legend()) +#' p1 + a_scale_fill_continuous(a_guide = "legend") +#' p1 + a_scale_fill_continuous(a_guide = a_guide_legend()) #' #' # Guide title -#' p1 + scale_fill_continuous(guide = guide_legend(title = "V")) # title text -#' p1 + scale_fill_continuous(guide = guide_legend(title = NULL)) # no title +#' p1 + a_scale_fill_continuous(a_guide = a_guide_legend(title = "V")) # title text +#' p1 + a_scale_fill_continuous(a_guide = a_guide_legend(title = NULL)) # no title #' #' # Control styles #' #' # key size -#' p1 + guides(fill = guide_legend(keywidth = 3, keyheight = 1)) +#' p1 + a_guides(fill = a_guide_legend(keywidth = 3, keyheight = 1)) #' -#' # title position -#' p1 + guides(fill = guide_legend(title = "LEFT", title.position = "left")) +#' # title a_position +#' p1 + a_guides(fill = a_guide_legend(title = "LEFT", title.a_position = "left")) #' -#' # title text styles via element_text -#' p1 + guides(fill = -#' guide_legend( -#' title.theme = element_text( +#' # title text styles via a_element_text +#' p1 + a_guides(fill = +#' a_guide_legend( +#' title.a_theme = a_element_text( #' size = 15, #' face = "italic", #' colour = "red", @@ -95,59 +95,59 @@ #' ) #' ) #' -#' # label position -#' p1 + guides(fill = guide_legend(label.position = "left", label.hjust = 1)) +#' # label a_position +#' p1 + a_guides(fill = a_guide_legend(a_label.a_position = "left", a_label.hjust = 1)) #' -#' # label styles -#' p1 + scale_fill_continuous(breaks = c(5, 10, 15), -#' labels = paste("long", c(5, 10, 15)), -#' guide = guide_legend( +#' # a_label styles +#' p1 + a_scale_fill_continuous(breaks = c(5, 10, 15), +#' a_labels = paste("long", c(5, 10, 15)), +#' a_guide = a_guide_legend( #' direction = "horizontal", -#' title.position = "top", -#' label.position = "bottom", -#' label.hjust = 0.5, -#' label.vjust = 1, -#' label.theme = element_text(angle = 90) +#' title.a_position = "top", +#' a_label.a_position = "bottom", +#' a_label.hjust = 0.5, +#' a_label.vjust = 1, +#' a_label.a_theme = a_element_text(angle = 90) #' ) #' ) #' -#' # Set aesthetic of legend key +#' # Set a_aesthetic of legend key #' #' # very low alpha value make it difficult to see legend key -#' p3 <- ggplot(diamonds, aes(carat, price)) + -#' geom_point(aes(colour = color), alpha = 1/100) +#' p3 <- a_plot(diamonds, a_aes(carat, price)) + +#' a_geom_point(a_aes(colour = color), alpha = 1/100) #' p3 #' -#' # override.aes overwrites the alpha -#' p3 + guides(colour = guide_legend(override.aes = list(alpha = 1))) +#' # override.a_aes overwrites the alpha +#' p3 + a_guides(colour = a_guide_legend(override.a_aes = list(alpha = 1))) #' #' # multiple row/col legends #' df <- data.frame(x = 1:20, y = 1:20, color = letters[1:20]) -#' p <- ggplot(df, aes(x, y)) + -#' geom_point(aes(colour = color)) -#' p + guides(col = guide_legend(nrow = 8)) -#' p + guides(col = guide_legend(ncol = 8)) -#' p + guides(col = guide_legend(nrow = 8, byrow = TRUE)) -#' p + guides(col = guide_legend(ncol = 8, byrow = TRUE)) +#' p <- a_plot(df, a_aes(x, y)) + +#' a_geom_point(a_aes(colour = color)) +#' p + a_guides(col = a_guide_legend(nrow = 8)) +#' p + a_guides(col = a_guide_legend(ncol = 8)) +#' p + a_guides(col = a_guide_legend(nrow = 8, byrow = TRUE)) +#' p + a_guides(col = a_guide_legend(ncol = 8, byrow = TRUE)) #' #' # reversed order legend -#' p + guides(col = guide_legend(reverse = TRUE)) +#' p + a_guides(col = a_guide_legend(reverse = TRUE)) #' } -guide_legend <- function( +a_guide_legend <- function( # title title = waiver(), - title.position = NULL, - title.theme = NULL, + title.a_position = NULL, + title.a_theme = NULL, title.hjust = NULL, title.vjust = NULL, - # label - label = TRUE, - label.position = NULL, - label.theme = NULL, - label.hjust = NULL, - label.vjust = NULL, + # a_label + a_label = TRUE, + a_label.a_position = NULL, + a_label.a_theme = NULL, + a_label.hjust = NULL, + a_label.vjust = NULL, # key keywidth = NULL, @@ -156,7 +156,7 @@ guide_legend <- function( # general direction = NULL, default.unit = "line", - override.aes = list(), + override.a_aes = list(), nrow = NULL, ncol = NULL, byrow = FALSE, @@ -172,17 +172,17 @@ guide_legend <- function( list( # title title = title, - title.position = title.position, - title.theme = title.theme, + title.a_position = title.a_position, + title.a_theme = title.a_theme, title.hjust = title.hjust, title.vjust = title.vjust, - # label - label = label, - label.position = label.position, - label.theme = label.theme, - label.hjust = label.hjust, - label.vjust = label.vjust, + # a_label + a_label = a_label, + a_label.a_position = a_label.a_position, + a_label.a_theme = a_label.a_theme, + a_label.hjust = a_label.hjust, + a_label.vjust = a_label.vjust, # size of key keywidth = keywidth, @@ -190,7 +190,7 @@ guide_legend <- function( # general direction = direction, - override.aes = rename_aes(override.aes), + override.a_aes = rename_aes(override.a_aes), nrow = nrow, ncol = ncol, byrow = byrow, @@ -202,19 +202,19 @@ guide_legend <- function( ..., name = "legend" ), - class = c("guide", "legend") + class = c("a_guide", "legend") ) } #' @export -guide_train.legend <- function(guide, scale) { - breaks <- scale$get_breaks() +a_guide_train.legend <- function(a_guide, a_scale) { + breaks <- a_scale$get_breaks() if (length(breaks) == 0 || all(is.na(breaks))) return() - key <- as.data.frame(setNames(list(scale$map(breaks)), scale$aesthetics[1]), + key <- as.data.frame(setNames(list(a_scale$map(breaks)), a_scale$a_aesthetics[1]), stringsAsFactors = FALSE) - key$.label <- scale$get_labels(breaks) + key$.a_label <- a_scale$get_labels(breaks) # this is a quick fix for #118 # some scales have NA as na.value (e.g., size) @@ -222,98 +222,98 @@ guide_train.legend <- function(guide, scale) { # drop rows if data (instead of the mapped value) is NA # # Also, drop out-of-range values for continuous scale - # (should use scale$oob?) - if (scale$is_discrete()) { + # (should use a_scale$oob?) + if (a_scale$is_discrete()) { key <- key[!is.na(breaks), , drop = FALSE] } else { - limits <- scale$get_limits() + limits <- a_scale$get_limits() noob <- !is.na(breaks) & limits[1] <= breaks & breaks <= limits[2] key <- key[noob, , drop = FALSE] } - if (guide$reverse) key <- key[nrow(key):1, ] + if (a_guide$reverse) key <- key[nrow(key):1, ] - guide$key <- key - guide$hash <- with(guide, digest::digest(list(title, key$.label, direction, name))) - guide + a_guide$key <- key + a_guide$hash <- with(a_guide, digest::digest(list(title, key$.a_label, direction, name))) + a_guide } #' @export -guide_merge.legend <- function(guide, new_guide) { - guide$key <- merge(guide$key, new_guide$key, sort = FALSE) - guide$override.aes <- c(guide$override.aes, new_guide$override.aes) - if (any(duplicated(names(guide$override.aes)))) warning("Duplicated override.aes is ignored.") - guide$override.aes <- guide$override.aes[!duplicated(names(guide$override.aes))] - guide +a_guide_merge.legend <- function(a_guide, new_guide) { + a_guide$key <- merge(a_guide$key, new_guide$key, sort = FALSE) + a_guide$override.a_aes <- c(a_guide$override.a_aes, new_guide$override.a_aes) + if (any(duplicated(names(a_guide$override.a_aes)))) warning("Duplicated override.a_aes is ignored.") + a_guide$override.a_aes <- a_guide$override.a_aes[!duplicated(names(a_guide$override.a_aes))] + a_guide } #' @export -guide_geom.legend <- function(guide, layers, default_mapping) { +a_guide_geom.legend <- function(a_guide, layers, default_mapping) { # arrange common data for vertical and horizontal guide - guide$geoms <- plyr::llply(layers, function(layer) { - all <- names(c(layer$mapping, if (layer$inherit.aes) default_mapping, layer$stat$default_aes)) - geom <- c(layer$geom$required_aes, names(layer$geom$default_aes)) - matched <- intersect(intersect(all, geom), names(guide$key)) - matched <- setdiff(matched, names(layer$geom_params)) - matched <- setdiff(matched, names(layer$aes_params)) + a_guide$geoms <- plyr::llply(layers, function(a_layer) { + all <- names(c(a_layer$mapping, if (a_layer$inherit.a_aes) default_mapping, a_layer$a_stat$default_aes)) + a_geom <- c(a_layer$a_geom$required_aes, names(a_layer$a_geom$default_aes)) + matched <- intersect(intersect(all, a_geom), names(a_guide$key)) + matched <- setdiff(matched, names(a_layer$a_geom_params)) + matched <- setdiff(matched, names(a_layer$a_aes_params)) if (length(matched) > 0) { - # This layer contributes to the legend - if (is.na(layer$show.legend) || layer$show.legend) { + # This a_layer contributes to the legend + if (is.na(a_layer$show.legend) || a_layer$show.legend) { # Default is to include it - data <- layer$geom$use_defaults(guide$key[matched], layer$aes_params) + data <- a_layer$a_geom$use_defaults(a_guide$key[matched], a_layer$a_aes_params) } else { return(NULL) } } else { - # This layer does not contribute to the legend - if (is.na(layer$show.legend) || !layer$show.legend) { + # This a_layer does not contribute to the legend + if (is.na(a_layer$show.legend) || !a_layer$show.legend) { # Default is to exclude it return(NULL) } else { - data <- layer$geom$use_defaults(NULL, layer$aes_params)[rep(1, nrow(guide$key)), ] + data <- a_layer$a_geom$use_defaults(NULL, a_layer$a_aes_params)[rep(1, nrow(a_guide$key)), ] } } - # override.aes in guide_legend manually changes the geom - data <- utils::modifyList(data, guide$override.aes) + # override.a_aes in guide_legend manually changes the geom + data <- utils::modifyList(data, a_guide$override.a_aes) list( - draw_key = layer$geom$draw_key, + draw_key = a_layer$a_geom$draw_key, data = data, - params = c(layer$geom_params, layer$stat_params) + params = c(a_layer$a_geom_params, a_layer$a_stat_params) ) }) # remove null geom - guide$geoms <- compact(guide$geoms) + a_guide$geoms <- compact(a_guide$geoms) - # Finally, remove this guide if no layer is drawn - if (length(guide$geoms) == 0) guide <- NULL - guide + # Finally, remove this a_guide if no a_layer is drawn + if (length(a_guide$geoms) == 0) a_guide <- NULL + a_guide } #' @export -guide_gengrob.legend <- function(guide, theme) { +a_guide_gengrob.legend <- function(a_guide, a_theme) { # default setting - label.position <- guide$label.position %||% "right" - if (!label.position %in% c("top", "bottom", "left", "right")) - stop("label position \"", label.position, "\" is invalid") + a_label.a_position <- a_guide$a_label.a_position %||% "right" + if (!a_label.a_position %in% c("top", "bottom", "left", "right")) + stop("a_label a_position \"", a_label.a_position, "\" is invalid") - nbreak <- nrow(guide$key) + nbreak <- nrow(a_guide$key) # gap between keys etc hgap <- width_cm(unit(0.3, "lines")) vgap <- hgap - grob.title <- ggname("guide.title", - element_grob( - guide$title.theme %||% calc_element("legend.title", theme), - label = guide$title, - hjust = guide$title.hjust %||% theme$legend.title.align %||% 0, - vjust = guide$title.vjust %||% 0.5, + grob.title <- ggname("a_guide.title", + a_element_grob( + a_guide$title.a_theme %||% a_calc_element("legend.title", a_theme), + a_label = a_guide$title, + hjust = a_guide$title.hjust %||% a_theme$legend.title.align %||% 0, + vjust = a_guide$title.vjust %||% 0.5, expand_x = FALSE, expand_y = FALSE ) @@ -323,21 +323,21 @@ guide_gengrob.legend <- function(guide, theme) { title_height <- height_cm(grob.title) # Labels - if (!guide$label || is.null(guide$key$.label)) { - grob.labels <- rep(list(zeroGrob()), nrow(guide$key)) + if (!a_guide$a_label || is.null(a_guide$key$.a_label)) { + grob.a_labels <- rep(list(a_zeroGrob()), nrow(a_guide$key)) } else { - label.theme <- guide$label.theme %||% calc_element("legend.text", theme) - - # label.theme in param of guide_legend() > theme$legend.text.align > default - # hjust/vjust in theme$legend.text and label.theme are ignored. - hjust <- x <- guide$label.hjust %||% theme$legend.text.align %||% - if (any(is.expression(guide$key$.label))) 1 else 0 - vjust <- y <- guide$label.vjust %||% 0.5 - - grob.labels <- lapply(guide$key$.label, function(label, ...) { - g <- element_grob( - element = label.theme, - label = label, + a_label.a_theme <- a_guide$a_label.a_theme %||% a_calc_element("legend.text", a_theme) + + # a_label.a_theme in param of guide_legend() > a_theme$legend.text.align > default + # hjust/vjust in a_theme$legend.text and a_label.a_theme are ignored. + hjust <- x <- a_guide$a_label.hjust %||% a_theme$legend.text.align %||% + if (any(is.expression(a_guide$key$.a_label))) 1 else 0 + vjust <- y <- a_guide$a_label.vjust %||% 0.5 + + grob.a_labels <- lapply(a_guide$key$.a_label, function(a_label, ...) { + g <- a_element_grob( + a_element = a_label.a_theme, + a_label = a_label, x = x, y = y, hjust = hjust, @@ -345,51 +345,51 @@ guide_gengrob.legend <- function(guide, theme) { expand_x = FALSE, expand_y = FALSE ) - ggname("guide.label", g) + ggname("a_guide.a_label", g) }) } - label_widths <- width_cm(grob.labels) - label_heights <- height_cm(grob.labels) + a_label_widths <- width_cm(grob.a_labels) + a_label_heights <- height_cm(grob.a_labels) # Keys - key_width <- width_cm(guide$keywidth %||% theme$legend.key.width %||% theme$legend.key.size) - key_height <- height_cm(guide$keyheight %||% theme$legend.key.height %||% theme$legend.key.size) + key_width <- width_cm(a_guide$keywidth %||% a_theme$legend.key.width %||% a_theme$legend.key.size) + key_height <- height_cm(a_guide$keyheight %||% a_theme$legend.key.height %||% a_theme$legend.key.size) - key_size_mat <- do.call("cbind", lapply(guide$geoms, function(g) g$data$size / 10)) + key_size_mat <- do.call("cbind", lapply(a_guide$geoms, function(g) g$data$size / 10)) if (nrow(key_size_mat) == 0 || ncol(key_size_mat) == 0) { key_size_mat <- matrix(0, ncol = 1, nrow = nbreak) } key_sizes <- apply(key_size_mat, 1, max) - if (!is.null(guide$nrow) && !is.null(guide$ncol) && guide$nrow * guide$ncol < nbreak) + if (!is.null(a_guide$nrow) && !is.null(a_guide$ncol) && a_guide$nrow * a_guide$ncol < nbreak) stop("`nrow` * `ncol` needs to be larger than the number of breaks", call. = FALSE) # If neither nrow/ncol specified, guess with "reasonable" values - if (is.null(guide$nrow) && is.null(guide$ncol)) { - if (guide$direction == "horizontal") { - guide$nrow <- ceiling(nbreak / 5) + if (is.null(a_guide$nrow) && is.null(a_guide$ncol)) { + if (a_guide$direction == "horizontal") { + a_guide$nrow <- ceiling(nbreak / 5) } else { - guide$ncol <- ceiling(nbreak / 20) + a_guide$ncol <- ceiling(nbreak / 20) } } - legend.nrow <- guide$nrow %||% ceiling(nbreak / guide$ncol) - legend.ncol <- guide$ncol %||% ceiling(nbreak / guide$nrow) + legend.nrow <- a_guide$nrow %||% ceiling(nbreak / a_guide$ncol) + legend.ncol <- a_guide$ncol %||% ceiling(nbreak / a_guide$nrow) key_sizes <- matrix(c(key_sizes, rep(0, legend.nrow * legend.ncol - nbreak)), - legend.nrow, legend.ncol, byrow = guide$byrow) + legend.nrow, legend.ncol, byrow = a_guide$byrow) key_widths <- pmax(key_width, apply(key_sizes, 2, max)) key_heights <- pmax(key_height, apply(key_sizes, 1, max)) - label_widths <- apply(matrix(c(label_widths, rep(0, legend.nrow * legend.ncol - nbreak)), - legend.nrow, legend.ncol, byrow = guide$byrow), + a_label_widths <- apply(matrix(c(a_label_widths, rep(0, legend.nrow * legend.ncol - nbreak)), + legend.nrow, legend.ncol, byrow = a_guide$byrow), 2, max) - label_heights <- apply(matrix(c(label_heights, rep(0, legend.nrow * legend.ncol - nbreak)), - legend.nrow, legend.ncol, byrow = guide$byrow), + a_label_heights <- apply(matrix(c(a_label_heights, rep(0, legend.nrow * legend.ncol - nbreak)), + legend.nrow, legend.ncol, byrow = a_guide$byrow), 1, max) - if (guide$byrow) { + if (a_guide$byrow) { vps <- data.frame( R = ceiling(seq(nbreak) / legend.ncol), C = (seq(nbreak) - 1) %% legend.ncol + 1 @@ -399,77 +399,77 @@ guide_gengrob.legend <- function(guide, theme) { names(vps) <- c("R", "C") } - # layout of key-label depends on the direction of the guide - if (guide$byrow == TRUE) { - switch(label.position, + # layout of key-a_label depends on the direction of the guide + if (a_guide$byrow == TRUE) { + switch(a_label.a_position, "top" = { - kl_widths <- pmax(label_widths, key_widths) - kl_heights <- utils::head(interleave(label_heights, vgap/2, key_heights, vgap/2), -1) - vps <- transform(vps, key.row = R * 4 - 1, key.col = C, label.row = R * 4 - 3, label.col = C) + kl_widths <- pmax(a_label_widths, key_widths) + kl_heights <- utils::head(interleave(a_label_heights, vgap/2, key_heights, vgap/2), -1) + vps <- transform(vps, key.row = R * 4 - 1, key.col = C, a_label.row = R * 4 - 3, a_label.col = C) }, "bottom" = { - kl_widths <- pmax(label_widths, key_widths) - kl_heights <- utils::head(interleave(key_heights, vgap/2, label_heights, vgap/2), -1) - vps <- transform(vps, key.row = R * 4 - 3, key.col = C, label.row = R * 4 - 1, label.col = C) + kl_widths <- pmax(a_label_widths, key_widths) + kl_heights <- utils::head(interleave(key_heights, vgap/2, a_label_heights, vgap/2), -1) + vps <- transform(vps, key.row = R * 4 - 3, key.col = C, a_label.row = R * 4 - 1, a_label.col = C) }, "left" = { - kl_widths <- utils::head(interleave(label_widths, hgap/2, key_widths, hgap/2), -1) - kl_heights <- utils::head(interleave(pmax(label_heights, key_heights), vgap/2), -1) - vps <- transform(vps, key.row = R * 2 - 1, key.col = C * 4 - 1, label.row = R * 2 - 1, label.col = C * 4 - 3) + kl_widths <- utils::head(interleave(a_label_widths, hgap/2, key_widths, hgap/2), -1) + kl_heights <- utils::head(interleave(pmax(a_label_heights, key_heights), vgap/2), -1) + vps <- transform(vps, key.row = R * 2 - 1, key.col = C * 4 - 1, a_label.row = R * 2 - 1, a_label.col = C * 4 - 3) }, "right" = { - kl_widths <- utils::head(interleave(key_widths, hgap/2, label_widths, hgap/2), -1) - kl_heights <- utils::head(interleave(pmax(label_heights, key_heights), vgap/2), -1) - vps <- transform(vps, key.row = R * 2 - 1, key.col = C * 4 - 3, label.row = R * 2 - 1, label.col = C * 4 - 1) + kl_widths <- utils::head(interleave(key_widths, hgap/2, a_label_widths, hgap/2), -1) + kl_heights <- utils::head(interleave(pmax(a_label_heights, key_heights), vgap/2), -1) + vps <- transform(vps, key.row = R * 2 - 1, key.col = C * 4 - 3, a_label.row = R * 2 - 1, a_label.col = C * 4 - 1) }) } else { - switch(label.position, + switch(a_label.a_position, "top" = { - kl_widths <- utils::head(interleave(pmax(label_widths, key_widths), hgap/2), -1) - kl_heights <- utils::head(interleave(label_heights, vgap/2, key_heights, vgap/2), -1) - vps <- transform(vps, key.row = R * 4 - 1, key.col = C * 2 - 1, label.row = R * 4 - 3, label.col = C * 2 - 1) + kl_widths <- utils::head(interleave(pmax(a_label_widths, key_widths), hgap/2), -1) + kl_heights <- utils::head(interleave(a_label_heights, vgap/2, key_heights, vgap/2), -1) + vps <- transform(vps, key.row = R * 4 - 1, key.col = C * 2 - 1, a_label.row = R * 4 - 3, a_label.col = C * 2 - 1) }, "bottom" = { - kl_widths <- utils::head(interleave(pmax(label_widths, key_widths), hgap/2), -1) - kl_heights <- utils::head(interleave(key_heights, vgap/2, label_heights, vgap/2), -1) - vps <- transform(vps, key.row = R * 4 - 3, key.col = C * 2 - 1, label.row = R * 4 - 1, label.col = C * 2 - 1) + kl_widths <- utils::head(interleave(pmax(a_label_widths, key_widths), hgap/2), -1) + kl_heights <- utils::head(interleave(key_heights, vgap/2, a_label_heights, vgap/2), -1) + vps <- transform(vps, key.row = R * 4 - 3, key.col = C * 2 - 1, a_label.row = R * 4 - 1, a_label.col = C * 2 - 1) }, "left" = { - kl_widths <- utils::head(interleave(label_widths, hgap/2, key_widths, hgap/2), -1) - kl_heights <- pmax(key_heights, label_heights) - vps <- transform(vps, key.row = R, key.col = C * 4 - 1, label.row = R, label.col = C * 4 - 3) + kl_widths <- utils::head(interleave(a_label_widths, hgap/2, key_widths, hgap/2), -1) + kl_heights <- pmax(key_heights, a_label_heights) + vps <- transform(vps, key.row = R, key.col = C * 4 - 1, a_label.row = R, a_label.col = C * 4 - 3) }, "right" = { - kl_widths <- utils::head(interleave(key_widths, hgap/2, label_widths, hgap/2), -1) - kl_heights <- pmax(key_heights, label_heights) - vps <- transform(vps, key.row = R, key.col = C * 4 - 3, label.row = R, label.col = C * 4 - 1) + kl_widths <- utils::head(interleave(key_widths, hgap/2, a_label_widths, hgap/2), -1) + kl_heights <- pmax(key_heights, a_label_heights) + vps <- transform(vps, key.row = R, key.col = C * 4 - 3, a_label.row = R, a_label.col = C * 4 - 1) }) } - # layout the title over key-label - switch(guide$title.position, + # layout the title over key-a_label + switch(a_guide$title.a_position, "top" = { widths <- c(kl_widths, max(0, title_width - sum(kl_widths))) heights <- c(title_height, vgap, kl_heights) - vps <- transform(vps, key.row = key.row + 2, key.col = key.col, label.row = label.row + 2, label.col = label.col) + vps <- transform(vps, key.row = key.row + 2, key.col = key.col, a_label.row = a_label.row + 2, a_label.col = a_label.col) vps.title.row = 1; vps.title.col = 1:length(widths) }, "bottom" = { widths <- c(kl_widths, max(0, title_width - sum(kl_widths))) heights <- c(kl_heights, vgap, title_height) - vps <- transform(vps, key.row = key.row, key.col = key.col, label.row = label.row, label.col = label.col) + vps <- transform(vps, key.row = key.row, key.col = key.col, a_label.row = a_label.row, a_label.col = a_label.col) vps.title.row = length(heights); vps.title.col = 1:length(widths) }, "left" = { widths <- c(title_width, hgap, kl_widths) heights <- c(kl_heights, max(0, title_height - sum(kl_heights))) - vps <- transform(vps, key.row = key.row, key.col = key.col + 2, label.row = label.row, label.col = label.col + 2) + vps <- transform(vps, key.row = key.row, key.col = key.col + 2, a_label.row = a_label.row, a_label.col = a_label.col + 2) vps.title.row = 1:length(heights); vps.title.col = 1 }, "right" = { widths <- c(kl_widths, hgap, title_width) heights <- c(kl_heights, max(0, title_height - sum(kl_heights))) - vps <- transform(vps, key.row = key.row, key.col = key.col, label.row = label.row, label.col = label.col) + vps <- transform(vps, key.row = key.row, key.col = key.col, a_label.row = a_label.row, a_label.col = a_label.col) vps.title.row = 1:length(heights); vps.title.col = length(widths) }) @@ -477,8 +477,8 @@ guide_gengrob.legend <- function(guide, theme) { key_size <- c(key_width, key_height) * 10 draw_key <- function(i) { - bg <- element_render(theme, "legend.key") - keys <- lapply(guide$geoms, function(g) { + bg <- a_element_render(a_theme, "legend.key") + keys <- lapply(a_guide$geoms, function(g) { g$draw_key(g$data[i, ], g$params, key_size) }) c(list(bg), keys) @@ -486,9 +486,9 @@ guide_gengrob.legend <- function(guide, theme) { grob.keys <- unlist(lapply(seq_len(nbreak), draw_key), recursive = FALSE) # background - grob.background <- element_render(theme, "legend.background") + grob.background <- a_element_render(a_theme, "legend.background") - ngeom <- length(guide$geoms) + 1 + ngeom <- length(a_guide$geoms) + 1 kcols <- rep(vps$key.col, each = ngeom) krows <- rep(vps$key.row, each = ngeom) @@ -508,12 +508,12 @@ guide_gengrob.legend <- function(guide, theme) { name = paste("key", krows, kcols, c("bg", seq(ngeom - 1)), sep = "-"), clip = "off", t = 1 + krows, r = 1 + kcols, b = 1 + krows, l = 1 + kcols) - gt <- gtable_add_grob(gt, grob.labels, - name = paste("label", vps$label.row, vps$label.col, sep = "-"), clip = "off", - t = 1 + vps$label.row, r = 1 + vps$label.col, - b = 1 + vps$label.row, l = 1 + vps$label.col) + gt <- gtable_add_grob(gt, grob.a_labels, + name = paste("a_label", vps$a_label.row, vps$a_label.col, sep = "-"), clip = "off", + t = 1 + vps$a_label.row, r = 1 + vps$a_label.col, + b = 1 + vps$a_label.row, l = 1 + vps$a_label.col) gt } -globalVariables(c("C", "R", "key.row", "key.col", "label.row", "label.col")) +globalVariables(c("C", "R", "key.row", "key.col", "a_label.row", "a_label.col")) diff --git a/R/guides-.r b/R/guides-.r index 4f6ddf9c3d..2fdbc3411e 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -1,19 +1,19 @@ #' Set guides for each scale. #' -#' Guides for each scale can be set in call of \code{scale_*} with argument -#' \code{guide}, or in \code{guides}. +#' Guides for each scale can be set in call of \code{a_scale_*} with argument +#' \code{a_guide}, or in \code{a_guides}. #' #' @param ... List of scale guide pairs #' @return A list containing the mapping between scale and guide. #' @export -#' @family guides +#' @family a_guides #' @examples #' \donttest{ #' # ggplot object #' #' dat <- data.frame(x = 1:5, y = 1:5, p = 1:5, q = factor(1:5), #' r = factor(1:5)) -#' p <- ggplot(dat, aes(x, y, colour = p, size = q, shape = r)) + geom_point() +#' p <- a_plot(dat, a_aes(x, y, colour = p, size = q, shape = r)) + a_geom_point() #' #' # without guide specification #' p @@ -21,51 +21,51 @@ #' # Show colorbar guide for colour. #' # All these examples below have a same effect. #' -#' p + guides(colour = "colorbar", size = "legend", shape = "legend") -#' p + guides(colour = guide_colorbar(), size = guide_legend(), -#' shape = guide_legend()) +#' p + a_guides(colour = "colorbar", size = "legend", shape = "legend") +#' p + a_guides(colour = a_guide_colorbar(), size = a_guide_legend(), +#' shape = a_guide_legend()) #' p + -#' scale_colour_continuous(guide = "colorbar") + -#' scale_size_discrete(guide = "legend") + -#' scale_shape(guide = "legend") +#' a_scale_colour_continuous(a_guide = "colorbar") + +#' a_scale_size_discrete(a_guide = "legend") + +#' a_scale_shape(a_guide = "legend") #' -#' # Remove some guides -#' p + guides(colour = "none") -#' p + guides(colour = "colorbar",size = "none") +#' # Remove some a_guides +#' p + a_guides(colour = "none") +#' p + a_guides(colour = "colorbar",size = "none") #' #' # Guides are integrated where possible #' -#' p + guides(colour = guide_legend("title"), size = guide_legend("title"), -#' shape = guide_legend("title")) +#' p + a_guides(colour = a_guide_legend("title"), size = a_guide_legend("title"), +#' shape = a_guide_legend("title")) #' # same as -#' g <- guide_legend("title") -#' p + guides(colour = g, size = g, shape = g) +#' g <- a_guide_legend("title") +#' p + a_guides(colour = g, size = g, shape = g) #' -#' p + theme(legend.position = "bottom") +#' p + a_theme(legend.a_position = "bottom") #' -#' # position of guides +#' # a_position of guides #' -#' p + theme(legend.position = "bottom", legend.box = "horizontal") +#' p + a_theme(legend.a_position = "bottom", legend.box = "horizontal") #' -#' # Set order for multiple guides -#' ggplot(mpg, aes(displ, cty)) + -#' geom_point(aes(size = hwy, colour = cyl, shape = drv)) + -#' guides( -#' colour = guide_colourbar(order = 1), -#' shape = guide_legend(order = 2), -#' size = guide_legend(order = 3) +#' # Set order for multiple a_guides +#' a_plot(mpg, a_aes(displ, cty)) + +#' a_geom_point(a_aes(size = hwy, colour = cyl, shape = drv)) + +#' a_guides( +#' colour = a_guide_colourbar(order = 1), +#' shape = a_guide_legend(order = 2), +#' size = a_guide_legend(order = 3) #' ) #' } -guides <- function(...) { +a_guides <- function(...) { args <- list(...) - if (is.list(args[[1]]) && !inherits(args[[1]], "guide")) args <- args[[1]] + if (is.list(args[[1]]) && !inherits(args[[1]], "a_guide")) args <- args[[1]] args <- rename_aes(args) - structure(args, class = "guides") + structure(args, class = "a_guides") } -update_guides <- function(p, guides) { - p <- plot_clone(p) - p$guides <- defaults(guides, p$guides) +update_a_guides <- function(p, a_guides) { + p <- a_plot_clone(p) + p$a_guides <- defaults(a_guides, p$a_guides) p } @@ -74,126 +74,136 @@ update_guides <- function(p, guides) { # # the procedure is as follows: # -# 1. guides_train() +# 1. a_guides_train() # train each scale and generate guide definition for all guides # here, one gdef for one scale # -# 2. guides_merge() +# 2. a_guides_merge() # merge gdefs if they are overlayed # number of gdefs may be less than number of scales # -# 3. guides_geom() +# 3. a_guides_geom() # process layer information and generate geom info. # -# 4. guides_gengrob() +# 4. a_guides_gengrob() # generate ggrob from each gdef # one ggrob for one gdef # -# 5. guides_build() +# 5. a_guides_build() # arrange all ggrobs -build_guides <- function(scales, layers, default_mapping, position, theme, guides, labels) { +build_guides <- function(scales, layers, default_mapping, a_position, a_theme, a_guides, a_labels) { - # set themes w.r.t. guides - # should these theme$legend.XXX be renamed to theme$guide.XXX ? + # set a_themes w.r.t. guides + # should these a_theme$legend.XXX be renamed to a_theme$guide.XXX ? # by default, guide boxes are vertically aligned - theme$legend.box <- theme$legend.box %||% "vertical" + a_theme$legend.box <- a_theme$legend.box %||% "vertical" - # size of key (also used for bar in colorbar guide) - theme$legend.key.width <- theme$legend.key.width %||% theme$legend.key.size - theme$legend.key.height <- theme$legend.key.height %||% theme$legend.key.size + # size of key (also used for bar in colorbar a_guide) + a_theme$legend.key.width <- a_theme$legend.key.width %||% a_theme$legend.key.size + a_theme$legend.key.height <- a_theme$legend.key.height %||% a_theme$legend.key.size - # by default, direction of each guide depends on the position of the guide. - theme$legend.direction <- - theme$legend.direction %||% - if (length(position) == 1 && position %in% c("top", "bottom", "left", "right")) - switch(position[1], top = , bottom = "horizontal", left = , right = "vertical") + # by default, direction of each guide depends on the a_position of the guide. + a_theme$legend.direction <- + a_theme$legend.direction %||% + if (length(a_position) == 1 && a_position %in% c("top", "bottom", "left", "right")) + switch(a_position[1], top = , bottom = "horizontal", left = , right = "vertical") else "vertical" # justification of legend boxes - theme$legend.box.just <- - theme$legend.box.just %||% - if (length(position) == 1 && position %in% c("top", "bottom", "left", "right")) - switch(position, bottom = , top = c("center", "top"), left = , right = c("left", "top")) + a_theme$legend.box.just <- + a_theme$legend.box.just %||% + if (length(a_position) == 1 && a_position %in% c("top", "bottom", "left", "right")) + switch(a_position, bottom = , top = c("center", "top"), left = , right = c("left", "top")) else c("center", "center") # scales -> data for guides - gdefs <- guides_train(scales = scales, theme = theme, guides = guides, labels = labels) - if (length(gdefs) == 0) return(zeroGrob()) + gdefs <- a_guides_train(scales = scales, a_theme = a_theme, a_guides = a_guides, a_labels = a_labels) + if (length(gdefs) == 0) return(a_zeroGrob()) # merge overlay guides - gdefs <- guides_merge(gdefs) + gdefs <- a_guides_merge(gdefs) # process layer information - gdefs <- guides_geom(gdefs, layers, default_mapping) - if (length(gdefs) == 0) return(zeroGrob()) + gdefs <- a_guides_geom(gdefs, layers, default_mapping) + if (length(gdefs) == 0) return(a_zeroGrob()) # generate grob of each guides - ggrobs <- guides_gengrob(gdefs, theme) + ggrobs <- a_guides_gengrob(gdefs, a_theme) - # build up guides - grobs <- guides_build(ggrobs, theme) + # build up a_guides + grobs <- a_guides_build(ggrobs, a_theme) grobs } -# validate guide object -validate_guide <- function(guide) { - # if guide is specified by character, then find the corresponding guide - if (is.character(guide)) - match.fun(paste("guide_", guide, sep = ""))() - else if (inherits(guide, "guide")) - guide +#' validate_guide function +#' +#' @param a_guide ... +#' @export +validate_guide <- function(a_guide) { + # if a_guide is specified by character, then find the corresponding guide + if (is.character(a_guide)) + match.fun(paste("a_guide_", a_guide, sep = ""))() + else if (inherits(a_guide, "a_guide")) + a_guide else - stop("Unknown guide: ", guide) + stop("Unknown a_guide: ", a_guide) } -# train each scale in scales and generate the definition of guide -guides_train <- function(scales, theme, guides, labels) { +#' train each scale in scales and generate the definition of guide +#' @param scales ... +#' @param a_theme ... +#' @param a_guides ... +#' @param a_labels .... +#' @export +a_guides_train <- function(scales, a_theme, a_guides, a_labels) { gdefs <- list() - for (scale in scales$scales) { + for (a_scale in scales$scales) { - # guides(XXX) is stored in guides[[XXX]], - # which is prior to scale_ZZZ(guide=XXX) - # guide is determined in order of: - # + guides(XXX) > + scale_ZZZ(guide=XXX) > default(i.e., legend) - output <- scale$aesthetics[1] - guide <- guides[[output]] %||% scale$guide + # a_guides(XXX) is stored in a_guides[[XXX]], + # which is prior to scale_ZZZ(a_guide=XXX) + # a_guide is determined in order of: + # + a_guides(XXX) > + scale_ZZZ(a_guide=XXX) > default(i.e., legend) + output <- a_scale$a_aesthetics[1] + a_guide <- a_guides[[output]] %||% a_scale$a_guide - # this should be changed to testing guide == "none" - # scale$legend is backward compatibility - # if guides(XXX=FALSE), then scale_ZZZ(guides=XXX) is discarded. - if (guide == "none" || (is.logical(guide) && !guide)) next + # this should be changed to testing a_guide == "none" + # a_scale$legend is backward compatibility + # if guides(XXX=FALSE), then a_scale_ZZZ(guides=XXX) is discarded. + if (a_guide == "none" || (is.logical(a_guide) && !a_guide)) next # check the validity of guide. # if guide is character, then find the guide object - guide <- validate_guide(guide) + a_guide <- validate_guide(a_guide) - # check the consistency of the guide and scale. - if (guide$available_aes != "any" && !scale$aesthetics %in% guide$available_aes) - stop("Guide '", guide$name, "' cannot be used for '", scale$aesthetics, "'.") + # check the consistency of the guide and a_scale. + if (a_guide$available_aes != "any" && !a_scale$a_aesthetics %in% a_guide$available_aes) + stop("Guide '", a_guide$name, "' cannot be used for '", a_scale$a_aesthetics, "'.") - guide$title <- guide$title %|W|% scale$name %|W|% labels[[output]] + a_guide$title <- a_guide$title %|W|% a_scale$name %|W|% a_labels[[output]] # direction of this grob - guide$direction <- guide$direction %||% theme$legend.direction + a_guide$direction <- a_guide$direction %||% a_theme$legend.direction - # each guide object trains scale within the object, + # each a_guide object trains scale within the object, # so Guides (i.e., the container of guides) need not to know about them - guide <- guide_train(guide, scale) + a_guide <- a_guide_train(a_guide, a_scale) - if (!is.null(guide)) gdefs[[length(gdefs) + 1]] <- guide + if (!is.null(a_guide)) gdefs[[length(gdefs) + 1]] <- a_guide } gdefs } -# merge overlapped guides -guides_merge <- function(gdefs) { - # split gdefs based on hash, and apply Reduce (guide_merge) to each gdef group. +#' merge overlapped guides +#' @param gdefs ... +#' @export +a_guides_merge <- function(gdefs) { + # split gdefs based on hash, and apply Reduce (a_guide_merge) to each gdef group. gdefs <- lapply(gdefs, function(g) { if (g$order == 0) { order <- "99" @@ -203,45 +213,52 @@ guides_merge <- function(gdefs) { g$hash <- paste(order, g$hash, sep = "_") g }) - tapply(gdefs, sapply(gdefs, function(g)g$hash), function(gs)Reduce(guide_merge, gs)) + tapply(gdefs, sapply(gdefs, function(g)g$hash), function(gs)Reduce(a_guide_merge, gs)) } -# process layer information -guides_geom <- function(gdefs, layers, default_mapping) { - compact(lapply(gdefs, guide_geom, layers, default_mapping)) +#' a_guides_geom function +#' @param gdefs ... +#' @param layers .... +#' @param default_mapping ... +#' @export +a_guides_geom <- function(gdefs, layers, default_mapping) { + compact(lapply(gdefs, a_guide_geom, layers, default_mapping)) } # generate grob from each gdef (needs to write this function?) -guides_gengrob <- function(gdefs, theme) { +a_guides_gengrob <- function(gdefs, a_theme) { # common drawing process for all guides gdefs <- lapply(gdefs, function(g) { - g$title.position <- g$title.position %||% switch(g$direction, vertical = "top", horizontal = "left") - if (!g$title.position %in% c("top", "bottom", "left", "right")) - stop("title position \"", g$title.position, "\" is invalid") + g$title.a_position <- g$title.a_position %||% switch(g$direction, vertical = "top", horizontal = "left") + if (!g$title.a_position %in% c("top", "bottom", "left", "right")) + stop("title a_position \"", g$title.a_position, "\" is invalid") g }) - lapply(gdefs, guide_gengrob, theme) + lapply(gdefs, a_guide_gengrob, a_theme) } -# build up all guide boxes into one guide-boxes. -guides_build <- function(ggrobs, theme) { - theme$legend.margin <- theme$legend.margin %||% unit(0.5, "lines") - theme$legend.vmargin <- theme$legend.vmargin %||% theme$legend.margin - theme$legend.hmargin <- theme$legend.hmargin %||% theme$legend.margin +#' build up all guide boxes into one guide-boxes. +#' @param ggrobs ... +#' @param a_theme ... +#' @export +a_guides_build <- function(ggrobs, a_theme) { + a_theme$legend.margin <- a_theme$legend.margin %||% unit(0.5, "lines") + a_theme$legend.vmargin <- a_theme$legend.vmargin %||% a_theme$legend.margin + a_theme$legend.hmargin <- a_theme$legend.hmargin %||% a_theme$legend.margin widths <- do.call("unit.c", lapply(ggrobs, function(g)sum(g$widths))) heights <- do.call("unit.c", lapply(ggrobs, function(g)sum(g$heights))) # Set the justification of each legend within the legend box # First value is xjust, second value is yjust - just <- valid.just(theme$legend.box.just) + just <- valid.just(a_theme$legend.box.just) xjust <- just[1] yjust <- just[2] # setting that is different for vertical and horizontal guide-boxes. - if (theme$legend.box == "horizontal") { + if (a_theme$legend.box == "horizontal") { # Set justification for each legend for (i in seq_along(ggrobs)) { ggrobs[[i]] <- editGrob(ggrobs[[i]], @@ -249,14 +266,14 @@ guides_build <- function(ggrobs, theme) { height = heightDetails(ggrobs[[i]]))) } - guides <- gtable_row(name = "guides", + a_guides <- gtable_row(name = "a_guides", grobs = ggrobs, widths = widths, height = max(heights)) - # add space between the guide-boxes - guides <- gtable_add_col_space(guides, theme$legend.hmargin) + # add space between the a_guide-boxes + a_guides <- gtable_add_col_space(a_guides, a_theme$legend.hmargin) - } else if (theme$legend.box == "vertical") { + } else if (a_theme$legend.box == "vertical") { # Set justification for each legend for (i in seq_along(ggrobs)) { ggrobs[[i]] <- editGrob(ggrobs[[i]], @@ -264,30 +281,30 @@ guides_build <- function(ggrobs, theme) { width = widthDetails(ggrobs[[i]]))) } - guides <- gtable_col(name = "guides", + a_guides <- gtable_col(name = "a_guides", grobs = ggrobs, width = max(widths), heights = heights) - # add space between the guide-boxes - guides <- gtable_add_row_space(guides, theme$legend.vmargin) + # add space between the a_guide-boxes + a_guides <- gtable_add_row_space(a_guides, a_theme$legend.vmargin) } - # add margins around the guide-boxes. - guides <- gtable_add_cols(guides, theme$legend.hmargin, pos = 0) - guides <- gtable_add_cols(guides, theme$legend.hmargin, pos = ncol(guides)) - guides <- gtable_add_rows(guides, theme$legend.vmargin, pos = 0) - guides <- gtable_add_rows(guides, theme$legend.vmargin, pos = nrow(guides)) + # add margins around the a_guide-boxes. + a_guides <- gtable_add_cols(a_guides, a_theme$legend.hmargin, pos = 0) + a_guides <- gtable_add_cols(a_guides, a_theme$legend.hmargin, pos = ncol(a_guides)) + a_guides <- gtable_add_rows(a_guides, a_theme$legend.vmargin, pos = 0) + a_guides <- gtable_add_rows(a_guides, a_theme$legend.vmargin, pos = nrow(a_guides)) - guides$name <- "guide-box" - guides + a_guides$name <- "a_guide-box" + a_guides } # S3 dispatches -guide_train <- function(...) UseMethod("guide_train") +a_guide_train <- function(...) UseMethod("a_guide_train") -guide_merge <- function(...) UseMethod("guide_merge") +a_guide_merge <- function(...) UseMethod("a_guide_merge") -guide_geom <- function(...) UseMethod("guide_geom") +a_guide_geom <- function(...) UseMethod("a_guide_geom") -guide_gengrob <- function(...) UseMethod("guide_gengrob") +a_guide_gengrob <- function(...) UseMethod("a_guide_gengrob") diff --git a/R/guides-axis.r b/R/guides-axis.r index 715bb2ac2b..2630b27850 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -1,105 +1,105 @@ -# Grob for axes -# -# @param position of ticks -# @param labels at ticks -# @param position of axis (top, bottom, left or right) -# @param range of data values -guide_axis <- function(at, labels, position = "right", theme) { +#' Grob for axes +#' @param at ... +#' @param a_position of ticks +#' @param a_labels at ticks +#' @param a_theme ... +# @param a_position of axis (top, bottom, left or right) +a_guide_axis <- function(at, a_labels, a_position = "right", a_theme) { if (length(at) == 0) - return(zeroGrob()) + return(a_zeroGrob()) at <- unit(at, "native") - position <- match.arg(position, c("top", "bottom", "right", "left")) + a_position <- match.arg(a_position, c("top", "bottom", "right", "left")) zero <- unit(0, "npc") one <- unit(1, "npc") - label_render <- switch(position, + a_label_render <- switch(a_position, top = , bottom = "axis.text.x", left = , right = "axis.text.y" ) - label_x <- switch(position, + a_label_x <- switch(a_position, top = , bottom = at, - right = theme$axis.ticks.length, - left = one - theme$axis.ticks.length + right = a_theme$axis.ticks.length, + left = one - a_theme$axis.ticks.length ) - label_y <- switch(position, - top = theme$axis.ticks.length, - bottom = one - theme$axis.ticks.length, + a_label_y <- switch(a_position, + top = a_theme$axis.ticks.length, + bottom = one - a_theme$axis.ticks.length, right = , left = at ) - if (is.list(labels)) { - if (any(sapply(labels, is.language))) { - labels <- do.call(expression, labels) + if (is.list(a_labels)) { + if (any(sapply(a_labels, is.language))) { + a_labels <- do.call(expression, a_labels) } else { - labels <- unlist(labels) + a_labels <- unlist(a_labels) } } - labels <- switch(position, + a_labels <- switch(a_position, top = , - bottom = element_render(theme, label_render, labels, x = label_x, expand_y = TRUE), + bottom = a_element_render(a_theme, a_label_render, a_labels, x = a_label_x, expand_y = TRUE), right = , - left = element_render(theme, label_render, labels, y = label_y, expand_x = TRUE)) + left = a_element_render(a_theme, a_label_render, a_labels, y = a_label_y, expand_x = TRUE)) - line <- switch(position, - top = element_render(theme, "axis.line.x", c(0, 1), c(0, 0), id.lengths = 2), - bottom = element_render(theme, "axis.line.x", c(0, 1), c(1, 1), id.lengths = 2), - right = element_render(theme, "axis.line.y", c(0, 0), c(0, 1), id.lengths = 2), - left = element_render(theme, "axis.line.y", c(1, 1), c(0, 1), id.lengths = 2) + line <- switch(a_position, + top = a_element_render(a_theme, "axis.line.x", c(0, 1), c(0, 0), id.lengths = 2), + bottom = a_element_render(a_theme, "axis.line.x", c(0, 1), c(1, 1), id.lengths = 2), + right = a_element_render(a_theme, "axis.line.y", c(0, 0), c(0, 1), id.lengths = 2), + left = a_element_render(a_theme, "axis.line.y", c(1, 1), c(0, 1), id.lengths = 2) ) nticks <- length(at) - ticks <- switch(position, - top = element_render(theme, "axis.ticks.x", + ticks <- switch(a_position, + top = a_element_render(a_theme, "axis.ticks.x", x = rep(at, each = 2), - y = rep(unit.c(zero, theme$axis.ticks.length), nticks), + y = rep(unit.c(zero, a_theme$axis.ticks.length), nticks), id.lengths = rep(2, nticks)), - bottom = element_render(theme, "axis.ticks.x", + bottom = a_element_render(a_theme, "axis.ticks.x", x = rep(at, each = 2), - y = rep(unit.c(one - theme$axis.ticks.length, one), nticks), + y = rep(unit.c(one - a_theme$axis.ticks.length, one), nticks), id.lengths = rep(2, nticks)), - right = element_render(theme, "axis.ticks.y", - x = rep(unit.c(zero, theme$axis.ticks.length), nticks), + right = a_element_render(a_theme, "axis.ticks.y", + x = rep(unit.c(zero, a_theme$axis.ticks.length), nticks), y = rep(at, each = 2), id.lengths = rep(2, nticks)), - left = element_render(theme, "axis.ticks.y", - x = rep(unit.c(one - theme$axis.ticks.length, one), nticks), + left = a_element_render(a_theme, "axis.ticks.y", + x = rep(unit.c(one - a_theme$axis.ticks.length, one), nticks), y = rep(at, each = 2), id.lengths = rep(2, nticks)) ) - # Create the gtable for the ticks + labels - gt <- switch(position, + # Create the gtable for the ticks + a_labels + gt <- switch(a_position, top = gtable_col("axis", - grobs = list(labels, ticks), + grobs = list(a_labels, ticks), width = one, - heights = unit.c(grobHeight(labels), theme$axis.ticks.length) + heights = unit.c(grobHeight(a_labels), a_theme$axis.ticks.length) ), bottom = gtable_col("axis", - grobs = list(ticks, labels), + grobs = list(ticks, a_labels), width = one, - heights = unit.c(theme$axis.ticks.length, grobHeight(labels)) + heights = unit.c(a_theme$axis.ticks.length, grobHeight(a_labels)) ), right = gtable_row("axis", - grobs = list(ticks, labels), - widths = unit.c(theme$axis.ticks.length, grobWidth(labels)), + grobs = list(ticks, a_labels), + widths = unit.c(a_theme$axis.ticks.length, grobWidth(a_labels)), height = one ), left = gtable_row("axis", - grobs = list(labels, ticks), - widths = unit.c(grobWidth(labels), theme$axis.ticks.length), + grobs = list(a_labels, ticks), + widths = unit.c(grobWidth(a_labels), a_theme$axis.ticks.length), height = one ) ) # Viewport for justifying the axis grob - justvp <- switch(position, + justvp <- switch(a_position, top = viewport(y = 0, just = "bottom", height = gtable_height(gt)), bottom = viewport(y = 1, just = "top", height = gtable_height(gt)), right = viewport(x = 0, just = "left", width = gtable_width(gt)), diff --git a/R/guides-grid.r b/R/guides-grid.r index ef24733b60..58751bfd7f 100644 --- a/R/guides-grid.r +++ b/R/guides-grid.r @@ -1,28 +1,28 @@ # Produce a grob to be used as for panel backgrounds -guide_grid <- function(theme, x.minor, x.major, y.minor, y.major) { +a_guide_grid <- function(a_theme, x.minor, x.major, y.minor, y.major) { x.minor <- setdiff(x.minor, x.major) y.minor <- setdiff(y.minor, y.major) ggname("grill", grobTree( - element_render(theme, "panel.background"), - if (length(y.minor) > 0) element_render( - theme, "panel.grid.minor.y", + a_element_render(a_theme, "panel.background"), + if (length(y.minor) > 0) a_element_render( + a_theme, "panel.grid.minor.y", x = rep(0:1, length(y.minor)), y = rep(y.minor, each = 2), id.lengths = rep(2, length(y.minor)) ), - if (length(x.minor) > 0) element_render( - theme, "panel.grid.minor.x", + if (length(x.minor) > 0) a_element_render( + a_theme, "panel.grid.minor.x", x = rep(x.minor, each = 2), y = rep(0:1, length(x.minor)), id.lengths = rep(2, length(x.minor)) ), - if (length(y.major) > 0) element_render( - theme, "panel.grid.major.y", + if (length(y.major) > 0) a_element_render( + a_theme, "panel.grid.major.y", x = rep(0:1, length(y.major)), y = rep(y.major, each = 2), id.lengths = rep(2, length(y.major)) ), - if (length(x.major) > 0) element_render( - theme, "panel.grid.major.x", + if (length(x.major) > 0) a_element_render( + a_theme, "panel.grid.major.x", x = rep(x.major, each = 2), y = rep(0:1, length(x.major)), id.lengths = rep(2, length(x.major)) ) diff --git a/R/labels.r b/R/labels.r index 5ee0889a29..fc5a23e09a 100644 --- a/R/labels.r +++ b/R/labels.r @@ -1,91 +1,91 @@ #' Update axis/legend labels #' #' @param p plot to modify -#' @param labels named list of new labels +#' @param a_labels named list of new labels #' @export #' @examples -#' p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() -#' update_labels(p, list(x = "New x")) -#' update_labels(p, list(x = expression(x / y ^ 2))) -#' update_labels(p, list(x = "New x", y = "New Y")) -#' update_labels(p, list(colour = "Fail silently")) -update_labels <- function(p, labels) { - p <- plot_clone(p) - p$labels <- defaults(labels, p$labels) +#' p <- a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() +#' update_a_labels(p, list(x = "New x")) +#' update_a_labels(p, list(x = expression(x / y ^ 2))) +#' update_a_labels(p, list(x = "New x", y = "New Y")) +#' update_a_labels(p, list(colour = "Fail silently")) +update_a_labels <- function(p, a_labels) { + p <- a_plot_clone(p) + p$a_labels <- defaults(a_labels, p$a_labels) p } -#' Change axis labels, legend titles, plot title/subtitle and below-plot +#' Change axis a_labels, legend titles, plot title/subtitle and below-plot #' caption. #' -#' @param label The text for the axis, plot title or caption below the plot. +#' @param a_label The text for the axis, plot title or caption below the plot. #' @param subtitle the text for the subtitle for the plot which will be #' displayed below the title. Leave \code{NULL} for no subtitle. -#' @param ... a list of new names in the form aesthetic = "new name" -#' @export +#' @param ... a list of new names in the form a_aesthetic = "new name" +#' @keywords internal #' @examples -#' p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() -#' p + labs(title = "New plot title") -#' p + labs(x = "New x label") -#' p + xlab("New x label") -#' p + ylab("New y label") +#' p <- a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() +#' p + ggplot2Animint:::labs(title = "New plot title") +#' p + ggplot2Animint:::labs(x = "New x a_label") +#' p + xlab("New x a_label") +#' p + ylab("New y a_label") #' p + ggtitle("New plot title") #' #' # Can add a subtitle to plots with either of the following #' p + ggtitle("New plot title", subtitle = "A subtitle") -#' p + labs(title = "New plot title", subtitle = "A subtitle") +#' p + ggplot2Animint:::labs(title = "New plot title", subtitle = "A subtitle") #' #' # Can add a plot caption underneath the whole plot (for sources, notes or #' # copyright), similar to the \code{sub} parameter in base R, with the #' # following -#' p + labs(caption = "(based on data from ...)") +#' p + ggplot2Animint:::labs(caption = "(based on data from ...)") #' #' # This should work independently of other functions that modify the #' # the scale names -#' p + ylab("New y label") + ylim(2, 4) -#' p + ylim(2, 4) + ylab("New y label") +#' p + ylab("New y a_label") + ylim(2, 4) +#' p + ylim(2, 4) + ylab("New y a_label") #' -#' # The labs function also modifies legend labels -#' p <- ggplot(mtcars, aes(mpg, wt, colour = cyl)) + geom_point() -#' p + labs(colour = "Cylinders") +#' # The labs function also modifies legend a_labels +#' p <- a_plot(mtcars, a_aes(mpg, wt, colour = cyl)) + a_geom_point() +#' p + ggplot2Animint:::labs(colour = "Cylinders") #' #' # Can also pass in a list, if that is more convenient -#' p + labs(list(title = "Title", subtitle = "Subtitle", x = "X", y = "Y")) +#' p + ggplot2Animint:::labs(list(title = "Title", subtitle = "Subtitle", x = "X", y = "Y")) labs <- function(...) { args <- list(...) if (is.list(args[[1]])) args <- args[[1]] args <- rename_aes(args) - structure(args, class = "labels") + structure(args, class = "a_labels") } #' @rdname labs #' @export -xlab <- function(label) { - labs(x = label) +xlab <- function(a_label) { + labs(x = a_label) } #' @rdname labs #' @export -ylab <- function(label) { - labs(y = label) +ylab <- function(a_label) { + labs(y = a_label) } #' @rdname labs #' @export -ggtitle <- function(label, subtitle = NULL) { - labs(title = label, subtitle = subtitle) +ggtitle <- function(a_label, subtitle = NULL) { + labs(title = a_label, subtitle = subtitle) } -# Convert aesthetic mapping into text labels +# Convert aesthetic mapping into text a_labels make_labels <- function(mapping) { remove_dots <- function(x) { gsub(match_calculated_aes, "\\1", x) } - default_label <- function(aesthetic, mapping) { - # e.g., geom_smooth(aes(colour = "loess")) + default_label <- function(a_aesthetic, mapping) { + # e.g., a_geom_smooth(a_aes(colour = "loess")) if (is.character(mapping)) { - aesthetic + a_aesthetic } else { remove_dots(deparse(mapping)) } diff --git a/R/layer.r b/R/layer.r index 125557c386..0667e5c041 100644 --- a/R/layer.r +++ b/R/layer.r @@ -1,67 +1,67 @@ #' Create a new layer #' #' A layer is a combination of data, stat and geom with a potential position -#' adjustment. Usually layers are created using \code{geom_*} or \code{stat_*} +#' adjustment. Usually layers are created using \code{a_geom_*} or \code{a_stat_*} #' calls but it can also be created directly using this function. #' #' @export -#' @inheritParams geom_point -#' @param mapping Set of aesthetic mappings created by \code{\link{aes}} or -#' \code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +#' @inheritParams a_geom_point +#' @param mapping Set of aesthetic mappings created by \code{\link{a_aes}} or +#' \code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the #' default), it is combined with the default mapping at the top level of the #' plot. You must supply \code{mapping} if there is no plot mapping. #' @param data The data to be displayed in this layer. There are three #' options: #' #' If \code{NULL}, the default, the data is inherited from the plot -#' data as specified in the call to \code{\link{ggplot}}. +#' data as specified in the call to \code{\link{a_plot}}. #' #' A \code{data.frame}, or other object, will override the plot #' data. All objects will be fortified to produce a data frame. See -#' \code{\link{fortify}} for which variables will be created. +#' \code{\link{a_fortify}} for which variables will be created. #' #' A \code{function} will be called with a single argument, #' the plot data. The return value must be a \code{data.frame.}, and #' will be used as the layer data. -#' @param geom The geometric object to use display the data -#' @param stat The statistical transformation to use on the data for this +#' @param a_geom The geometric object to use display the data +#' @param a_stat The statistical transformation to use on the data for this #' layer, as a string. -#' @param position Position adjustment, either as a string, or the result of +#' @param a_position Position adjustment, either as a string, or the result of #' a call to a position adjustment function. #' @param show.legend logical. Should this layer be included in the legends? #' \code{NA}, the default, includes if any aesthetics are mapped. #' \code{FALSE} never includes, and \code{TRUE} always includes. -#' @param inherit.aes If \code{FALSE}, overrides the default aesthetics, +#' @param inherit.a_aes If \code{FALSE}, overrides the default aesthetics, #' rather than combining with them. This is most useful for helper functions #' that define both data and aesthetics and shouldn't inherit behaviour from #' the default plot specification, e.g. \code{\link{borders}}. -#' @param params Additional parameters to the \code{geom} and \code{stat}. +#' @param params Additional parameters to the \code{a_geom} and \code{a_stat}. #' @param subset DEPRECATED. An older way of subsetting the dataset used in a #' layer. #' @examples #' # geom calls are just a short cut for layer -#' ggplot(mpg, aes(displ, hwy)) + geom_point() +#' a_plot(mpg, a_aes(displ, hwy)) + a_geom_point() #' # shortcut for -#' ggplot(mpg, aes(displ, hwy)) + -#' layer(geom = "point", stat = "identity", position = "identity", +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_layer(a_geom = "point", a_stat = "identity", a_position = "identity", #' params = list(na.rm = FALSE) #' ) #' #' # use a function as data to plot a subset of global data -#' ggplot(mpg, aes(displ, hwy)) + -#' layer(geom = "point", stat = "identity", position = "identity", +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_layer(a_geom = "point", a_stat = "identity", a_position = "identity", #' data = head, params = list(na.rm = FALSE) #' ) #' -layer <- function(geom = NULL, stat = NULL, +a_layer <- function(a_geom = NULL, a_stat = NULL, data = NULL, mapping = NULL, - position = NULL, params = list(), - inherit.aes = TRUE, subset = NULL, show.legend = NA) { - if (is.null(geom)) + a_position = NULL, params = list(), + inherit.a_aes = TRUE, subset = NULL, show.legend = NA) { + if (is.null(a_geom)) stop("Attempted to create layer with no geom.", call. = FALSE) - if (is.null(stat)) + if (is.null(a_stat)) stop("Attempted to create layer with no stat.", call. = FALSE) - if (is.null(position)) + if (is.null(a_position)) stop("Attempted to create layer with no position.", call. = FALSE) # Handle show_guide/show.legend @@ -76,73 +76,87 @@ layer <- function(geom = NULL, stat = NULL, show.legend <- FALSE } - data <- fortify(data) + data <- a_fortify(data) if (!is.null(mapping) && !inherits(mapping, "uneval")) { - stop("Mapping must be created by `aes()` or `aes_()`", call. = FALSE) + stop("Mapping must be created by `a_aes()` or `a_aes_()`", call. = FALSE) } - if (is.character(geom)) - geom <- find_subclass("Geom", geom) - if (is.character(stat)) - stat <- find_subclass("Stat", stat) - if (is.character(position)) - position <- find_subclass("Position", position) + if (is.character(a_geom)) + a_geom <- find_subclass("a_Geom", a_geom) + if (is.character(a_stat)) + a_stat <- find_subclass("a_Stat", a_stat) + if (is.character(a_position)) + a_position <- find_subclass("a_Position", a_position) # Special case for na.rm parameter needed by all layers if (is.null(params$na.rm)) { params$na.rm <- FALSE } - # Split up params between aesthetics, geom, and stat + # Split up params between a_aesthetics, geom, and a_stat params <- rename_aes(params) - aes_params <- params[intersect(names(params), geom$aesthetics())] - geom_params <- params[intersect(names(params), geom$parameters(TRUE))] - stat_params <- params[intersect(names(params), stat$parameters(TRUE))] + a_aes_params <- params[intersect(names(params), a_geom$a_aesthetics())] + a_geom_params <- params[intersect(names(params), a_geom$parameters(TRUE))] + a_stat_params <- params[intersect(names(params), a_stat$parameters(TRUE))] - all <- c(geom$parameters(TRUE), stat$parameters(TRUE), geom$aesthetics()) + all <- c(a_geom$parameters(TRUE), a_stat$parameters(TRUE), a_geom$a_aesthetics()) extra <- setdiff(names(params), all) - if (length(extra) > 0) { + + # Handle extra params + if (is.null(params$validate_params)) { + ## If validate_params has not been defined, default is set to TRUE + ## TODO: Since we don't have to worry about ggplot2 compatability now, + ## we could get rid of this altogether for a better implementation?? + params$validate_params <- FALSE + extra_params <- NULL + } + + if (length(extra) > 0 && params$validate_params) { stop("Unknown parameters: ", paste(extra, collapse = ", "), call. = FALSE) + }else if (length(extra) > 0) { + extra <- extra[!extra == "validate_params"] + extra_params <- params[extra] } - ggproto("LayerInstance", Layer, - geom = geom, - geom_params = geom_params, - stat = stat, - stat_params = stat_params, + a_ggproto("a_LayerInstance", a_Layer, + a_geom = a_geom, + a_geom_params = a_geom_params, + a_stat = a_stat, + a_stat_params = a_stat_params, data = data, mapping = mapping, - aes_params = aes_params, + a_aes_params = a_aes_params, subset = subset, - position = position, - inherit.aes = inherit.aes, - show.legend = show.legend + a_position = a_position, + inherit.a_aes = inherit.a_aes, + show.legend = show.legend, + extra_params = extra_params ) } -Layer <- ggproto("Layer", NULL, - geom = NULL, - geom_params = NULL, - stat = NULL, - stat_params = NULL, +a_Layer <- a_ggproto("a_Layer", NULL, + a_geom = NULL, + a_geom_params = NULL, + a_stat = NULL, + a_stat_params = NULL, data = NULL, - aes_params = NULL, + a_aes_params = NULL, mapping = NULL, - position = NULL, - inherit.aes = FALSE, - + a_position = NULL, + inherit.a_aes = FALSE, + extra_params = NULL, print = function(self) { if (!is.null(self$mapping)) { cat("mapping:", clist(self$mapping), "\n") } - cat(snakeize(class(self$geom)[[1]]), ": ", clist(self$geom_params), "\n", + cat(snakeize(class(self$a_geom)[[1]]), ": ", clist(self$a_geom_params), "\n", sep = "") - cat(snakeize(class(self$stat)[[1]]), ": ", clist(self$stat_params), "\n", + cat(snakeize(class(self$a_stat)[[1]]), ": ", clist(self$a_stat_params), "\n", sep = "") - cat(snakeize(class(self$position)[[1]]), "\n") + cat(snakeize(class(self$a_position)[[1]]), "\n") }, - layer_data = function(self, plot_data) { + a_layer_data = function(self, plot_data) { if (is.waive(self$data)) { plot_data } else if (is.function(self$data)) { @@ -158,20 +172,20 @@ Layer <- ggproto("Layer", NULL, compute_aesthetics = function(self, data, plot) { # For annotation geoms, it is useful to be able to ignore the default aes - if (self$inherit.aes) { - aesthetics <- defaults(self$mapping, plot$mapping) + if (self$inherit.a_aes) { + a_aesthetics <- defaults(self$mapping, plot$mapping) } else { - aesthetics <- self$mapping + a_aesthetics <- self$mapping } # Drop aesthetics that are set or calculated - set <- names(aesthetics) %in% names(self$aes_params) - calculated <- is_calculated_aes(aesthetics) - aesthetics <- aesthetics[!set & !calculated] + set <- names(a_aesthetics) %in% names(self$a_aes_params) + calculated <- is_calculated_aes(a_aesthetics) + a_aesthetics <- a_aesthetics[!set & !calculated] # Override grouping if set in layer - if (!is.null(self$geom_params$group)) { - aesthetics[["group"]] <- self$aes_params$group + if (!is.null(self$a_geom_params$group)) { + a_aesthetics[["group"]] <- self$a_aes_params$group } # Old subsetting method @@ -180,15 +194,15 @@ Layer <- ggproto("Layer", NULL, data <- data[rowSums(include, na.rm = TRUE) == ncol(include), ] } - scales_add_defaults(plot$scales, data, aesthetics, plot$plot_env) + scales_add_defaults(plot$scales, data, a_aesthetics, plot$plot_env) - # Evaluate and check aesthetics - aesthetics <- compact(aesthetics) - evaled <- lapply(aesthetics, eval, envir = data, enclos = plot$plot_env) + # Evaluate and check a_aesthetics + a_aesthetics <- compact(a_aesthetics) + evaled <- lapply(a_aesthetics, eval, envir = data, enclos = plot$plot_env) n <- nrow(data) if (n == 0) { - # No data, so look at longest evaluated aesthetic + # No data, so look at longest evaluated a_aesthetic if (length(evaled) == 0) { n <- 0 } else { @@ -213,48 +227,48 @@ Layer <- ggproto("Layer", NULL, if (empty(data)) return(data.frame()) - params <- self$stat$setup_params(data, self$stat_params) - data <- self$stat$setup_data(data, params) - self$stat$compute_layer(data, params, panel) + params <- self$a_stat$setup_params(data, self$a_stat_params) + data <- self$a_stat$setup_data(data, params) + self$a_stat$compute_layer(data, params, panel) }, map_statistic = function(self, data, plot) { if (empty(data)) return(data.frame()) # Assemble aesthetics from layer, plot and stat mappings - aesthetics <- self$mapping - if (self$inherit.aes) { - aesthetics <- defaults(aesthetics, plot$mapping) + a_aesthetics <- self$mapping + if (self$inherit.a_aes) { + a_aesthetics <- defaults(a_aesthetics, plot$mapping) } - aesthetics <- defaults(aesthetics, self$stat$default_aes) - aesthetics <- compact(aesthetics) + a_aesthetics <- defaults(a_aesthetics, self$a_stat$default_aes) + a_aesthetics <- compact(a_aesthetics) - new <- strip_dots(aesthetics[is_calculated_aes(aesthetics)]) + new <- strip_dots(a_aesthetics[is_calculated_aes(a_aesthetics)]) if (length(new) == 0) return(data) # Add map stat output to aesthetics - stat_data <- plyr::quickdf(lapply(new, eval, data, baseenv())) - names(stat_data) <- names(new) + a_stat_data <- plyr::quickdf(lapply(new, eval, data, baseenv())) + names(a_stat_data) <- names(new) # Add any new scales, if needed scales_add_defaults(plot$scales, data, new, plot$plot_env) # Transform the values, if the scale say it's ok - # (see stat_spoke for one exception) - if (self$stat$retransform) { - stat_data <- scales_transform_df(plot$scales, stat_data) + # (see a_stat_spoke for one exception) + if (self$a_stat$retransform) { + a_stat_data <- scales_transform_df(plot$scales, a_stat_data) } - cunion(stat_data, data) + cunion(a_stat_data, data) }, compute_geom_1 = function(self, data) { if (empty(data)) return(data.frame()) - data <- self$geom$setup_data(data, c(self$geom_params, self$aes_params)) + data <- self$a_geom$setup_data(data, c(self$a_geom_params, self$a_aes_params)) check_required_aesthetics( - self$geom$required_aes, - c(names(data), names(self$aes_params)), - snake_class(self$geom) + self$a_geom$required_aes, + c(names(data), names(self$a_aes_params)), + snake_class(self$a_geom) ) data @@ -263,31 +277,31 @@ Layer <- ggproto("Layer", NULL, compute_position = function(self, data, panel) { if (empty(data)) return(data.frame()) - params <- self$position$setup_params(data) - data <- self$position$setup_data(data, params) + params <- self$a_position$setup_params(data) + data <- self$a_position$setup_data(data, params) - self$position$compute_layer(data, params, panel) + self$a_position$compute_layer(data, params, panel) }, compute_geom_2 = function(self, data) { - # Combine aesthetics, defaults, & params + # Combine a_aesthetics, defaults, & params if (empty(data)) return(data) - self$geom$use_defaults(data, self$aes_params) + self$a_geom$use_defaults(data, self$a_aes_params) }, - draw_geom = function(self, data, panel, coord) { + draw_geom = function(self, data, panel, a_coord) { if (empty(data)) { n <- nrow(panel$layout) - return(rep(list(zeroGrob()), n)) + return(rep(list(a_zeroGrob()), n)) } - data <- self$geom$handle_na(data, self$geom_params) - self$geom$draw_layer(data, self$geom_params, panel, coord) + data <- self$a_geom$handle_na(data, self$a_geom_params) + self$a_geom$draw_layer(data, self$a_geom_params, panel, a_coord) } ) -is.layer <- function(x) inherits(x, "Layer") +is.a_layer <- function(x) inherits(x, "a_Layer") find_subclass <- function(super, class) { diff --git a/R/legend-draw.r b/R/legend-draw.r index 8d82fafce8..a66b452908 100644 --- a/R/legend-draw.r +++ b/R/legend-draw.r @@ -9,12 +9,12 @@ #' @param params A list of additional parameters supplied to the geom. #' @param size Width and height of key in mm. #' @keywords internal -#' @name draw_key +#' @name a_draw_key NULL #' @export -#' @rdname draw_key -draw_key_point <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_point <- function(data, params, size) { pointsGrob(0.5, 0.5, pch = data$shape, gp = gpar( @@ -27,8 +27,8 @@ draw_key_point <- function(data, params, size) { } #' @export -#' @rdname draw_key -draw_key_abline <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_abline <- function(data, params, size) { segmentsGrob(0, 0, 1, 1, gp = gpar( col = alpha(data$colour, data$alpha), @@ -40,8 +40,8 @@ draw_key_abline <- function(data, params, size) { } #' @export -#' @rdname draw_key -draw_key_rect <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_rect <- function(data, params, size) { rectGrob(gp = gpar( col = NA, fill = alpha(data$fill, data$alpha), @@ -49,8 +49,8 @@ draw_key_rect <- function(data, params, size) { )) } #' @export -#' @rdname draw_key -draw_key_polygon <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_polygon <- function(data, params, size) { lwd <- min(data$size, min(size) / 4) rectGrob( @@ -66,14 +66,14 @@ draw_key_polygon <- function(data, params, size) { } #' @export -#' @rdname draw_key -draw_key_blank <- function(data, params, size) { - zeroGrob() +#' @rdname a_draw_key +a_draw_key_blank <- function(data, params, size) { + a_zeroGrob() } #' @export -#' @rdname draw_key -draw_key_boxplot <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_boxplot <- function(data, params, size) { grobTree( linesGrob(0.5, c(0.1, 0.25)), linesGrob(0.5, c(0.75, 0.9)), @@ -89,8 +89,8 @@ draw_key_boxplot <- function(data, params, size) { } #' @export -#' @rdname draw_key -draw_key_crossbar <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_crossbar <- function(data, params, size) { grobTree( rectGrob(height = 0.5, width = 0.75), linesGrob(c(0.125, 0.875), 0.5), @@ -104,8 +104,8 @@ draw_key_crossbar <- function(data, params, size) { } #' @export -#' @rdname draw_key -draw_key_path <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_path <- function(data, params, size) { segmentsGrob(0.1, 0.5, 0.9, 0.5, gp = gpar( col = alpha(data$colour, data$alpha), @@ -118,8 +118,8 @@ draw_key_path <- function(data, params, size) { } #' @export -#' @rdname draw_key -draw_key_vpath <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_vpath <- function(data, params, size) { segmentsGrob(0.5, 0.1, 0.5, 0.9, gp = gpar( col = alpha(data$colour, data$alpha), @@ -132,8 +132,8 @@ draw_key_vpath <- function(data, params, size) { } #' @export -#' @rdname draw_key -draw_key_dotplot <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_dotplot <- function(data, params, size) { pointsGrob(0.5, 0.5, size = unit(.5, "npc"), pch = 21, gp = gpar( @@ -144,29 +144,29 @@ draw_key_dotplot <- function(data, params, size) { } #' @export -#' @rdname draw_key -draw_key_pointrange <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_pointrange <- function(data, params, size) { grobTree( - draw_key_vpath(data, params, size), - draw_key_point(transform(data, size = data$size * 4), params) + a_draw_key_vpath(data, params, size), + a_draw_key_point(transform(data, size = data$size * 4), params) ) } #' @export -#' @rdname draw_key -draw_key_smooth <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_smooth <- function(data, params, size) { data$fill <- alpha(data$fill, data$alpha) data$alpha <- 1 grobTree( if (isTRUE(params$se)) rectGrob(gp = gpar(col = NA, fill = data$fill)), - draw_key_path(data, params) + a_draw_key_path(data, params) ) } #' @export -#' @rdname draw_key -draw_key_text <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_text <- function(data, params, size) { textGrob("a", 0.5, 0.5, rot = data$angle, gp = gpar( @@ -179,17 +179,17 @@ draw_key_text <- function(data, params, size) { } #' @export -#' @rdname draw_key -draw_key_label <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_label <- function(data, params, size) { grobTree( - draw_key_rect(data, list()), - draw_key_text(data, list()) + a_draw_key_rect(data, list()), + a_draw_key_text(data, list()) ) } #' @export -#' @rdname draw_key -draw_key_vline <- function(data, params, size) { +#' @rdname a_draw_key +a_draw_key_vline <- function(data, params, size) { segmentsGrob(0.5, 0, 0.5, 1, gp = gpar( col = alpha(data$colour, data$alpha), diff --git a/R/limits.r b/R/limits.r index 315f4425f6..f56619f1f9 100644 --- a/R/limits.r +++ b/R/limits.r @@ -4,11 +4,11 @@ #' not passed to any other layers. If a NA value is substituted for one of the #' limits that limit is automatically calculated. #' -#' @param ... If numeric, will create a continuous scale, if factor or -#' character, will create a discrete scale. For \code{lims}, every +#' @param ... If numeric, will create a continuous a_scale, if factor or +#' character, will create a discrete a_scale. For \code{lims}, every #' argument must be named. #' @seealso For changing x or y axis limits \strong{without} dropping data -#' observations, see \code{\link{coord_cartesian}}. +#' observations, see \code{\link{a_coord_cartesian}}. #' @export #' @examples #' # xlim @@ -17,17 +17,17 @@ #' xlim(c(10, 20)) #' xlim("a", "b", "c") #' -#' ggplot(mtcars, aes(mpg, wt)) + -#' geom_point() + +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point() + #' xlim(15, 20) #' # with automatic lower limit -#' ggplot(mtcars, aes(mpg, wt)) + -#' geom_point() + +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point() + #' xlim(NA, 20) #' #' # Change both xlim and ylim -#' ggplot(mtcars, aes(mpg, wt)) + -#' geom_point() + +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point() + #' lims(x = c(10, 20), y = c(3, 5)) lims <- function(...) { args <- list(...) @@ -53,15 +53,15 @@ ylim <- function(...) { #' Generate correct scale type for specified limits #' -#' @param limits vector of limits +#' @param lims vector of limits #' @param var name of variable -#' @keywords internal +#' @export #' @examples -#' ggplot2:::limits(c(1, 5), "x") -#' ggplot2:::limits(c(5, 1), "x") -#' ggplot2:::limits(c("A", "b", "c"), "x") -#' ggplot2:::limits(c("A", "b", "c"), "fill") -#' ggplot2:::limits(as.Date(c("2008-01-01", "2009-01-01")), "x") +#' limits(c(1, 5), "x") +#' limits(c(5, 1), "x") +#' limits(c("A", "b", "c"), "x") +#' limits(c("A", "b", "c"), "fill") +#' limits(as.Date(c("2008-01-01", "2009-01-01")), "x") limits <- function(lims, var) UseMethod("limits") #' @export limits.numeric <- function(lims, var) { @@ -72,61 +72,61 @@ limits.numeric <- function(lims, var) { trans <- "identity" } - make_scale("continuous", var, limits = lims, trans = trans) + make_a_scale("continuous", var, limits = lims, trans = trans) } -make_scale <- function(type, var, ...) { - scale <- match.fun(paste("scale_", var, "_", type, sep = "")) - scale(...) +make_a_scale <- function(type, var, ...) { + a_scale <- match.fun(paste("a_scale_", var, "_", type, sep = "")) + a_scale(...) } #' @export limits.character <- function(lims, var) { - make_scale("discrete", var, limits = lims) + make_a_scale("discrete", var, limits = lims) } #' @export limits.factor <- function(lims, var) { - make_scale("discrete", var, limits = as.character(lims)) + make_a_scale("discrete", var, limits = as.character(lims)) } #' @export limits.Date <- function(lims, var) { stopifnot(length(lims) == 2) - make_scale("date", var, limits = lims) + make_a_scale("date", var, limits = lims) } #' @export limits.POSIXct <- function(lims, var) { stopifnot(length(lims) == 2) - make_scale("datetime", var, limits = lims) + make_a_scale("datetime", var, limits = lims) } #' @export limits.POSIXlt <- function(lims, var) { stopifnot(length(lims) == 2) - make_scale("datetime", var, limits = as.POSIXct(lims)) + make_a_scale("datetime", var, limits = as.POSIXct(lims)) } #' Expand the plot limits with data. #' #. Sometimes you may want to ensure limits include a single value, for all #' panels or all plots. This function is a thin wrapper around -#' \code{\link{geom_blank}} that makes it easy to add such values. +#' \code{\link{a_geom_blank}} that makes it easy to add such values. #' #' @param ... named list of aesthetics specifying the value (or values) that #' should be included in each scale. #' @export #' @examples -#' p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() +#' p <- a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() #' p + expand_limits(x = 0) #' p + expand_limits(y = c(1, 9)) #' p + expand_limits(x = 0, y = 0) #' -#' ggplot(mtcars, aes(mpg, wt)) + -#' geom_point(aes(colour = cyl)) + +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point(a_aes(colour = cyl)) + #' expand_limits(colour = seq(2, 10, by = 2)) -#' ggplot(mtcars, aes(mpg, wt)) + -#' geom_point(aes(colour = factor(cyl))) + +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point(a_aes(colour = factor(cyl))) + #' expand_limits(colour = factor(seq(2, 10, by = 2))) expand_limits <- function(...) { data <- data.frame(..., stringsAsFactors = FALSE) - geom_blank(aes_all(names(data)), data, inherit.aes = FALSE) + a_geom_blank(a_aes_all(names(data)), data, inherit.a_aes = FALSE) } diff --git a/R/margins.R b/R/margins.R index 837f964bcc..611e43a78b 100644 --- a/R/margins.R +++ b/R/margins.R @@ -29,12 +29,12 @@ margin_width <- function(grob, margins) { grobWidth(grob) + margins[2] + margins[4] } -titleGrob <- function(label, x, y, hjust, vjust, angle = 0, gp = gpar(), +titleGrob <- function(a_label, x, y, hjust, vjust, angle = 0, gp = gpar(), margin = NULL, expand_x = FALSE, expand_y = FALSE, debug = FALSE) { - if (is.null(label)) - return(zeroGrob()) + if (is.null(a_label)) + return(a_zeroGrob()) if (is.null(margin)) { margin <- margin(0, 0, 0, 0) @@ -59,7 +59,7 @@ titleGrob <- function(label, x, y, hjust, vjust, angle = 0, gp = gpar(), x <- x %||% unit(rep(xp, n), "npc") y <- y %||% unit(rep(yp, n), "npc") - text_grob <- textGrob(label, x, y, hjust = hjust, vjust = vjust, + text_grob <- textGrob(a_label, x, y, hjust = hjust, vjust = vjust, rot = angle, gp = gp) if (expand_x && expand_y) { @@ -117,13 +117,13 @@ heightDetails.titleGrob <- function(x) { # Works like titleGrob, but designed to place one label per viewport. # This means it doesn't have the lengths of labels available, so must use # alternative layout strategy -stripGrob <- function(label, hjust, vjust, angle = 0, gp = gpar(), +stripGrob <- function(a_label, hjust, vjust, angle = 0, gp = gpar(), margin = NULL, debug = FALSE) { if (is.null(margin)) { margin <- margin() } - text_grob <- textGrob(label, rot = angle, gp = gp) + text_grob <- textGrob(a_label, rot = angle, gp = gp) widths <- unit.c(margin[4], unit(1, "grobwidth", text_grob), margin[2]) heights <- unit.c(margin[1], unit(1, "grobheight", text_grob), margin[3]) diff --git a/R/panel.r b/R/panel.r index 1cbf4514e3..5dc30e4579 100644 --- a/R/panel.r +++ b/R/panel.r @@ -11,55 +11,58 @@ new_panel <- function() { structure(list(), class = "panel") } -# Learn the layout of panels within a plot. -# -# This is determined by the facet, which returns a data frame, than -# when joined to the data to be plotted tells us which panel it should -# appear in, where that panel appears in the grid, and what scales it -# uses. -# -# As well as the layout info, this function also adds empty lists in which -# to house the x and y scales. -# -# @param the panel object to train -# @param the facetting specification -# @param data a list of data frames (one for each layer), and one for the plot -# @param plot_data the default data frame -# @return an updated panel object -train_layout <- function(panel, facet, data, plot_data) { - layout <- facet_train_layout(facet, c(list(plot_data), data)) +#' Learn the layout of panels within a plot. +#' +#' This is determined by the facet, which returns a data frame, than +#' when joined to the data to be plotted tells us which panel it should +#' appear in, where that panel appears in the grid, and what scales it +#' uses. +#' +#' As well as the layout info, this function also adds empty lists in which +#' to house the x and y scales. +#' +#' @param panel the panel object to train +#' @param a_facet the facetting specification +#' @param data a list of data frames (one for each a_layer), and one for the plot +#' @param plot_data the default data frame +#' @return an updated panel object +#' @keywords internal +a_train_layout <- function(panel, a_facet, data, plot_data) { + layout <- a_facet_train_layout(a_facet, c(list(plot_data), data)) panel$layout <- layout - panel$shrink <- facet$shrink + panel$shrink <- a_facet$shrink panel } -# Map data to find out where it belongs in the plot. -# -# Layout map ensures that all layer data has extra copies of data for margins -# and missing facetting variables, and has a PANEL variable that tells that -# so it know what panel it belongs to. This is a change from the previous -# design which added facetting variables directly to the data frame and -# caused problems when they had names of aesthetics (like colour or group). -# -# @param panel a trained panel object -# @param the facetting specification -# @param data list of data frames (one for each layer) -map_layout <- function(panel, facet, data) { +#' Map data to find out where it belongs in the plot. +#' +#' Layout map ensures that all a_layer data has extra copies of data for margins +#' and missing facetting variables, and has a PANEL variable that tells that +#' so it know what panel it belongs to. This is a change from the previous +#' design which added facetting variables directly to the data frame and +#' caused problems when they had names of aesthetics (like colour or group). +#' +#' @param panel a trained panel object +#' @param the facetting specification +#' @param data list of data frames (one for each a_layer) +#' @keywords internal +map_layout <- function(panel, a_facet, data) { lapply(data, function(data) { - facet_map_layout(facet, data, panel$layout) + a_facet_map_layout(a_facet, data, panel$layout) }) } -# Train position scales with data -# -# If panel-specific scales are not already present, will clone from -# the scales provided in the parameter -# -# @param panel the panel object to train -# @param data a list of data frames (one for each layer) -# @param x_scale x scale for the plot -# @param y_scale y scale for the plot +#' Train position scales with data +#' +#' If panel-specific scales are not already present, will clone from +#' the scales provided in the parameter +#' +#' @param panel the panel object to train +#' @param data a list of data frames (one for each a_layer) +#' @param x_scale x scale for the plot +#' @param y_scale y scale for the plot +#' @keywords internal train_position <- function(panel, data, x_scale, y_scale) { # Initialise scales if needed, and possible. layout <- panel$layout @@ -70,23 +73,23 @@ train_position <- function(panel, data, x_scale, y_scale) { panel$y_scales <- plyr::rlply(max(layout$SCALE_Y), y_scale$clone()) } - # loop over each layer, training x and y scales in turn - for (layer_data in data) { + # loop over each a_layer, training x and y scales in turn + for (a_layer_data in data) { - match_id <- match(layer_data$PANEL, layout$PANEL) + match_id <- match(a_layer_data$PANEL, layout$PANEL) if (!is.null(x_scale)) { - x_vars <- intersect(x_scale$aesthetics, names(layer_data)) + x_vars <- intersect(x_scale$a_aesthetics, names(a_layer_data)) SCALE_X <- layout$SCALE_X[match_id] - scale_apply(layer_data, x_vars, "train", SCALE_X, panel$x_scales) + scale_apply(a_layer_data, x_vars, "train", SCALE_X, panel$x_scales) } if (!is.null(y_scale)) { - y_vars <- intersect(y_scale$aesthetics, names(layer_data)) + y_vars <- intersect(y_scale$a_aesthetics, names(a_layer_data)) SCALE_Y <- layout$SCALE_Y[match_id] - scale_apply(layer_data, y_vars, "train", SCALE_Y, panel$y_scales) + scale_apply(a_layer_data, y_vars, "train", SCALE_Y, panel$y_scales) } } @@ -101,33 +104,34 @@ reset_scales <- function(panel) { invisible() } -# Map data with scales. -# -# This operation must be idempotent because it is applied twice: both before -# and after statistical transformation. -# -# @param data a list of data frames (one for each layer) +#' Map data with scales. +#' +#' This operation must be idempotent because it is applied twice: both before +#' and after statistical transformation. +#' +#' @param data a list of data frames (one for each layer) +#' @keywords internal map_position <- function(panel, data, x_scale, y_scale) { layout <- panel$layout - lapply(data, function(layer_data) { - match_id <- match(layer_data$PANEL, layout$PANEL) + lapply(data, function(a_layer_data) { + match_id <- match(a_layer_data$PANEL, layout$PANEL) # Loop through each variable, mapping across each scale, then joining # back together - x_vars <- intersect(x_scale$aesthetics, names(layer_data)) + x_vars <- intersect(x_scale$a_aesthetics, names(a_layer_data)) names(x_vars) <- x_vars SCALE_X <- layout$SCALE_X[match_id] - new_x <- scale_apply(layer_data, x_vars, "map", SCALE_X, panel$x_scales) - layer_data[, x_vars] <- new_x + new_x <- scale_apply(a_layer_data, x_vars, "map", SCALE_X, panel$x_scales) + a_layer_data[, x_vars] <- new_x - y_vars <- intersect(y_scale$aesthetics, names(layer_data)) + y_vars <- intersect(y_scale$a_aesthetics, names(a_layer_data)) names(y_vars) <- y_vars SCALE_Y <- layout$SCALE_Y[match_id] - new_y <- scale_apply(layer_data, y_vars, "map", SCALE_Y, panel$y_scales) + new_y <- scale_apply(a_layer_data, y_vars, "map", SCALE_Y, panel$y_scales) - layer_data[, y_vars] <- new_y - layer_data + a_layer_data[, y_vars] <- new_y + a_layer_data }) } @@ -164,11 +168,11 @@ panel_scales <- function(panel, i) { ) } -# Compute ranges and dimensions of each panel, using the coord. -train_ranges <- function(panel, coord) { +# Compute ranges and dimensions of each panel, using the a_coord. +train_ranges <- function(panel, a_coord) { compute_range <- function(ix, iy) { - # TODO: change coord_train method to take individual x and y scales - coord$train(list(x = panel$x_scales[[ix]], y = panel$y_scales[[iy]])) + # TODO: change a_coord_train method to take individual x and y scales + a_coord$train(list(x = panel$x_scales[[ix]], y = panel$y_scales[[iy]])) } panel$ranges <- Map(compute_range, @@ -176,10 +180,10 @@ train_ranges <- function(panel, coord) { panel } -xlabel <- function(panel, labels) { - panel$x_scales[[1]]$name %|W|% labels$x +xlabel <- function(panel, a_labels) { + panel$x_scales[[1]]$name %|W|% a_labels$x } -ylabel <- function(panel, labels) { - panel$y_scales[[1]]$name %|W|% labels$y +ylabel <- function(panel, a_labels) { + panel$y_scales[[1]]$name %|W|% a_labels$y } diff --git a/R/plot-build.r b/R/plot-build.r index 9bab5d93de..4866bb0355 100644 --- a/R/plot-build.r +++ b/R/plot-build.r @@ -1,35 +1,35 @@ -#' Build ggplot for rendering. +#' Build a_plot for rendering. #' -#' \code{ggplot_build} takes the plot object, and performs all steps necessary +#' \code{a_plot_build} takes the plot object, and performs all steps necessary #' to produce an object that can be rendered. This function outputs two pieces: #' a list of data frames (one for each layer), and a panel object, which #' contain all information about axis limits, breaks etc. #' -#' \code{layer_data}, \code{layer_grob}, and \code{layer_scales} are helper +#' \code{a_layer_data}, \code{a_layer_grob}, and \code{a_layer_scales} are helper #' functions that returns the data, grob, or scales associated with a given #' layer. These are useful for tests. #' -#' @param plot ggplot object -#' @seealso \code{\link{print.ggplot}} and \code{\link{benchplot}} for +#' @param plot a_plot object +#' @seealso \code{\link{print.a_plot}} and \code{\link{a_benchplot}} for #' functions that contain the complete set of steps for generating -#' a ggplot2 plot. +#' a a_plot2 plot. #' @keywords internal #' @export -ggplot_build <- function(plot) { - plot <- plot_clone(plot) +a_plot_build <- function(plot) { + plot <- a_plot_clone(plot) if (length(plot$layers) == 0) { - plot <- plot + geom_blank() + plot <- plot + a_geom_blank() } layers <- plot$layers - layer_data <- lapply(layers, function(y) y$layer_data(plot$data)) + a_layer_data <- lapply(layers, function(y) y$a_layer_data(plot$data)) scales <- plot$scales # Apply function to layer and matching data - by_layer <- function(f) { + by_layer <- function(ff) { out <- vector("list", length(data)) for (i in seq_along(data)) { - out[[i]] <- f(l = layers[[i]], d = data[[i]]) + out[[i]] <- ff(l = layers[[i]], d = data[[i]]) } out } @@ -38,8 +38,8 @@ ggplot_build <- function(plot) { # variables, and add on a PANEL variable to data panel <- new_panel() - panel <- train_layout(panel, plot$facet, layer_data, plot$data) - data <- map_layout(panel, plot$facet, layer_data) + panel <- a_train_layout(panel, plot$a_facet, a_layer_data, plot$data) + data <- map_layout(panel, plot$a_facet, a_layer_data) # Compute aesthetics to produce data with generalised variable names data <- by_layer(function(l, d) l$compute_aesthetics(d, plot)) @@ -92,15 +92,15 @@ ggplot_build <- function(plot) { } #' @export -#' @rdname ggplot_build -layer_data <- function(plot, i = 1L) { - ggplot_build(plot)$data[[i]] +#' @rdname a_plot_build +a_layer_data <- function(plot, i = 1L) { + a_plot_build(plot)$data[[i]] } #' @export -#' @rdname ggplot_build -layer_scales <- function(plot, i = 1L, j = 1L) { - b <- ggplot_build(plot) +#' @rdname a_plot_build +a_layer_scales <- function(plot, i = 1L, j = 1L) { + b <- a_plot_build(plot) layout <- b$panel$layout selected <- layout[layout$ROW == i & layout$COL == j, , drop = FALSE] @@ -112,9 +112,9 @@ layer_scales <- function(plot, i = 1L, j = 1L) { } #' @export -#' @rdname ggplot_build -layer_grob <- function(plot, i = 1L) { - b <- ggplot_build(plot) +#' @rdname a_plot_build +a_layer_grob <- function(plot, i = 1L) { + b <- a_plot_build(plot) b$plot$layers[[i]]$draw_geom(b$data[[i]], b$panel, b$plot$coordinates) } @@ -127,33 +127,33 @@ layer_grob <- function(plot, i = 1L) { #' to (e.g.) make the legend box 2 cm wide, or combine multiple plots into #' a single display, preserving aspect ratios across the plots. #' -#' @seealso \code{\link{print.ggplot}} and \code{link{benchplot}} for +#' @seealso \code{\link{print.a_plot}} and \code{link{a_benchplot}} for #' for functions that contain the complete set of steps for generating -#' a ggplot2 plot. +#' a a_plot2 plot. #' @return a \code{\link{gtable}} object #' @keywords internal #' @param plot plot object -#' @param data plot data generated by \code{\link{ggplot_build}} +#' @param data plot data generated by \code{\link{a_plot_build}} #' @export -ggplot_gtable <- function(data) { +a_plot_gtable <- function(data) { plot <- data$plot panel <- data$panel data <- data$data - theme <- plot_theme(plot) + a_theme <- plot_a_theme(plot) - geom_grobs <- Map(function(l, d) l$draw_geom(d, panel, plot$coordinates), + a_geom_grobs <- Map(function(l, d) l$draw_geom(d, panel, plot$coordinates), plot$layers, data) - plot_table <- facet_render(plot$facet, panel, plot$coordinates, - theme, geom_grobs) + plot_table <- a_facet_render(plot$a_facet, panel, plot$coordinates, + a_theme, a_geom_grobs) # Axis labels - labels <- plot$coordinates$labels(list( - x = xlabel(panel, plot$labels), - y = ylabel(panel, plot$labels) + a_labels <- plot$coordinates$a_labels(list( + x = xlabel(panel, plot$a_labels), + y = ylabel(panel, plot$a_labels) )) - xlabel <- element_render(theme, "axis.title.x", labels$x, expand_y = TRUE) - ylabel <- element_render(theme, "axis.title.y", labels$y, expand_x = TRUE) + xlabel <- a_element_render(a_theme, "axis.title.x", a_labels$x, expand_y = TRUE) + ylabel <- a_element_render(a_theme, "axis.title.y", a_labels$y, expand_x = TRUE) # helper function return the position of panels in plot_table find_panel <- function(table) { @@ -180,40 +180,40 @@ ggplot_gtable <- function(data) { l = 1, b = panel_dim$b, t = panel_dim$t, clip = "off") # Legends - position <- theme$legend.position - if (length(position) == 2) { - position <- "manual" + a_position <- a_theme$legend.a_position + if (length(a_position) == 2) { + a_position <- "manual" } - legend_box <- if (position != "none") { - build_guides(plot$scales, plot$layers, plot$mapping, position, theme, plot$guides, plot$labels) + legend_box <- if (a_position != "none") { + build_guides(plot$scales, plot$layers, plot$mapping, a_position, a_theme, plot$a_guides, plot$a_labels) } else { - zeroGrob() + a_zeroGrob() } if (is.zero(legend_box)) { - position <- "none" + a_position <- "none" } else { # these are a bad hack, since it modifies the contents of viewpoint directly... - legend_width <- gtable_width(legend_box) + theme$legend.margin - legend_height <- gtable_height(legend_box) + theme$legend.margin + legend_width <- gtable_width(legend_box) + a_theme$legend.margin + legend_height <- gtable_height(legend_box) + a_theme$legend.margin # Set the justification of the legend box # First value is xjust, second value is yjust - just <- valid.just(theme$legend.justification) + just <- valid.just(a_theme$legend.justification) xjust <- just[1] yjust <- just[2] - if (position == "manual") { - xpos <- theme$legend.position[1] - ypos <- theme$legend.position[2] + if (a_position == "manual") { + xpos <- a_theme$legend.a_position[1] + ypos <- a_theme$legend.a_position[2] - # x and y are specified via theme$legend.position (i.e., coords) + # x and y are specified via a_theme$legend.a_position (i.e., coords) legend_box <- editGrob(legend_box, vp = viewport(x = xpos, y = ypos, just = c(xjust, yjust), height = legend_height, width = legend_width)) } else { - # x and y are adjusted using justification of legend box (i.e., theme$legend.justification) + # x and y are adjusted using justification of legend box (i.e., a_theme$legend.justification) legend_box <- editGrob(legend_box, vp = viewport(x = xjust, y = yjust, just = c(xjust, yjust))) } @@ -223,39 +223,39 @@ ggplot_gtable <- function(data) { # for align-to-device, use this: # panel_dim <- summarise(plot_table$layout, t = min(t), r = max(r), b = max(b), l = min(l)) - if (position == "left") { + if (a_position == "left") { plot_table <- gtable_add_cols(plot_table, legend_width, pos = 0) plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = panel_dim$t, b = panel_dim$b, l = 1, r = 1, name = "guide-box") - } else if (position == "right") { + t = panel_dim$t, b = panel_dim$b, l = 1, r = 1, name = "a_guide-box") + } else if (a_position == "right") { plot_table <- gtable_add_cols(plot_table, legend_width, pos = -1) plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = panel_dim$t, b = panel_dim$b, l = -1, r = -1, name = "guide-box") - } else if (position == "bottom") { + t = panel_dim$t, b = panel_dim$b, l = -1, r = -1, name = "a_guide-box") + } else if (a_position == "bottom") { plot_table <- gtable_add_rows(plot_table, legend_height, pos = -1) plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = -1, b = -1, l = panel_dim$l, r = panel_dim$r, name = "guide-box") - } else if (position == "top") { + t = -1, b = -1, l = panel_dim$l, r = panel_dim$r, name = "a_guide-box") + } else if (a_position == "top") { plot_table <- gtable_add_rows(plot_table, legend_height, pos = 0) plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = 1, b = 1, l = panel_dim$l, r = panel_dim$r, name = "guide-box") - } else if (position == "manual") { + t = 1, b = 1, l = panel_dim$l, r = panel_dim$r, name = "a_guide-box") + } else if (a_position == "manual") { # should guide box expand whole region or region without margin? plot_table <- gtable_add_grob(plot_table, legend_box, t = panel_dim$t, b = panel_dim$b, l = panel_dim$l, r = panel_dim$r, - clip = "off", name = "guide-box") + clip = "off", name = "a_guide-box") } # Title - title <- element_render(theme, "plot.title", plot$labels$title, expand_y = TRUE) + title <- a_element_render(a_theme, "plot.title", plot$a_labels$title, expand_y = TRUE) title_height <- grobHeight(title) # Subtitle - subtitle <- element_render(theme, "plot.subtitle", plot$labels$subtitle, expand_y = TRUE) + subtitle <- a_element_render(a_theme, "plot.subtitle", plot$a_labels$subtitle, expand_y = TRUE) subtitle_height <- grobHeight(subtitle) # whole plot annotation - caption <- element_render(theme, "plot.caption", plot$labels$caption, expand_y = TRUE) + caption <- a_element_render(a_theme, "plot.caption", plot$a_labels$caption, expand_y = TRUE) caption_height <- grobHeight(caption) pans <- plot_table$layout[grepl("^panel", plot_table$layout$name), , @@ -274,14 +274,14 @@ ggplot_gtable <- function(data) { t = -1, b = -1, l = min(pans$l), r = max(pans$r), clip = "off") # Margins - plot_table <- gtable_add_rows(plot_table, theme$plot.margin[1], pos = 0) - plot_table <- gtable_add_cols(plot_table, theme$plot.margin[2]) - plot_table <- gtable_add_rows(plot_table, theme$plot.margin[3]) - plot_table <- gtable_add_cols(plot_table, theme$plot.margin[4], pos = 0) + plot_table <- gtable_add_rows(plot_table, a_theme$plot.margin[1], pos = 0) + plot_table <- gtable_add_cols(plot_table, a_theme$plot.margin[2]) + plot_table <- gtable_add_rows(plot_table, a_theme$plot.margin[3]) + plot_table <- gtable_add_cols(plot_table, a_theme$plot.margin[4], pos = 0) - if (inherits(theme$plot.background, "element")) { + if (inherits(a_theme$plot.background, "a_element")) { plot_table <- gtable_add_grob(plot_table, - element_render(theme, "plot.background"), + a_element_render(a_theme, "plot.background"), t = 1, l = 1, b = -1, r = -1, name = "background", z = -Inf) plot_table$layout <- plot_table$layout[c(nrow(plot_table$layout), 1:(nrow(plot_table$layout) - 1)),] plot_table$grobs <- plot_table$grobs[c(nrow(plot_table$layout), 1:(nrow(plot_table$layout) - 1))] @@ -289,11 +289,11 @@ ggplot_gtable <- function(data) { plot_table } -#' Generate a ggplot2 plot grob. +#' Generate a ggplot2 (a_plot) plot grob. #' -#' @param x ggplot2 object +#' @param x a_plot2 object #' @keywords internal #' @export ggplotGrob <- function(x) { - ggplot_gtable(ggplot_build(x)) + a_plot_gtable(a_plot_build(x)) } diff --git a/R/plot-construction.r b/R/plot-construction.r index dc10caf6d1..298fe54be5 100644 --- a/R/plot-construction.r +++ b/R/plot-construction.r @@ -1,23 +1,23 @@ -#' Add a new component to a ggplot or theme object. +#' Add a new component to a a_plot or theme object. #' -#' This operator allows you to add objects to a ggplot or theme object. +#' This operator allows you to add objects to a a_plot or theme object. #' -#' If the first object is an object of class \code{ggplot}, you can add -#' the following types of objects, and it will return a modified ggplot +#' If the first object is an object of class \code{a_plot}, you can add +#' the following types of objects, and it will return a modified a_plot #' object. #' #' \itemize{ #' \item \code{data.frame}: replace current data.frame #' (must use \code{\%+\%}) #' \item \code{uneval}: replace current aesthetics -#' \item \code{layer}: add new layer -#' \item \code{theme}: update plot theme -#' \item \code{scale}: replace current scale -#' \item \code{coord}: override current coordinate system -#' \item \code{facet}: override current coordinate faceting +#' \item \code{a_layer}: add new a_layer +#' \item \code{a_theme}: update plot theme +#' \item \code{a_scale}: replace current a_scale +#' \item \code{a_coord}: override current coordinate system +#' \item \code{a_facet}: override current coordinate faceting #' } #' -#' If the first object is an object of class \code{theme}, you can add +#' If the first object is an object of class \code{a_theme}, you can add #' another theme object. This will return a modified theme object. #' #' For theme objects, the \code{+} operator and the \code{\%+replace\%} @@ -26,7 +26,7 @@ #' The \code{+} operator updates the elements of e1 that differ from #' elements specified (not NULL) in e2. #' Thus this operator can be used to incrementally add or modify attributes -#' of a ggplot theme. +#' of a a_plot theme. #' #' In contrast, the \code{\%+replace\%} operator replaces the #' entire element; any element of a theme not specified in e2 will not be @@ -34,14 +34,14 @@ #' Thus this operator can be used to overwrite an entire theme. #' #' @examples -#' ### Adding objects to a ggplot object -#' p <- ggplot(mtcars, aes(wt, mpg, colour = disp)) + -#' geom_point() +#' ### Adding objects to a a_plot object +#' p <- a_plot(mtcars, a_aes(wt, mpg, colour = disp)) + +#' a_geom_point() #' #' p -#' p + coord_cartesian(ylim = c(0, 40)) -#' p + scale_colour_continuous(breaks = c(100, 300)) -#' p + guides(colour = "colourbar") +#' p + ggplot2Animint:::a_coord_cartesian(ylim = c(0, 40)) +#' p + a_scale_colour_continuous(breaks = c(100, 300)) +#' p + a_guides(colour = "colourbar") #' #' # Use a different data frame #' m <- mtcars[1:10, ] @@ -49,71 +49,71 @@ #' #' ### Adding objects to a theme object #' # Compare these results of adding theme objects to other theme objects -#' add_el <- theme_grey() + theme(text = element_text(family = "Times")) -#' rep_el <- theme_grey() %+replace% theme(text = element_text(family = "Times")) +#' add_el <- a_theme_grey() + a_theme(text = a_element_text(family = "Times")) +#' rep_el <- a_theme_grey() %+replace% a_theme(text = a_element_text(family = "Times")) #' #' add_el$text #' rep_el$text #' -#' @param e1 An object of class \code{ggplot} or \code{theme} +#' @param e1 An object of class \code{a_plot} or \code{a_theme} #' @param e2 A component to add to \code{e1} #' @export -#' @seealso \code{\link{theme}} -#' @method + gg -#' @rdname gg-add -"+.gg" <- function(e1, e2) { +#' @seealso \code{\link{a_theme}} +#' @method + aaa +#' @rdname aaa-add +"+.aaa" <- function(e1, e2) { # Get the name of what was passed in as e2, and pass along so that it # can be displayed in error messages e2name <- deparse(substitute(e2)) - if (is.theme(e1)) add_theme(e1, e2, e2name) - else if (is.ggplot(e1)) add_ggplot(e1, e2, e2name) + if (is.a_theme(e1)) add_a_theme(e1, e2, e2name) + else if (is.a_plot(e1)) add_a_plot(e1, e2, e2name) } -#' @rdname gg-add +#' @rdname aaa-add #' @export -"%+%" <- `+.gg` +"%+%" <- `+.aaa` -add_ggplot <- function(p, object, objectname) { +add_a_plot <- function(p, object, objectname) { if (is.null(object)) return(p) - p <- plot_clone(p) + p <- a_plot_clone(p) if (is.data.frame(object)) { p$data <- object - } else if (is.theme(object)) { - p$theme <- update_theme(p$theme, object) - } else if (inherits(object, "Scale")) { + } else if (is.a_theme(object)) { + p$a_theme <- update_a_theme(p$a_theme, object) + } else if (inherits(object, "a_Scale")) { p$scales$add(object) - } else if (inherits(object, "labels")) { - p <- update_labels(p, object) - } else if (inherits(object, "guides")) { - p <- update_guides(p, object) + } else if (inherits(object, "a_labels")) { + p <- update_a_labels(p, object) + } else if (inherits(object, "a_guides")) { + p <- update_a_guides(p, object) } else if (inherits(object, "uneval")) { p$mapping <- defaults(object, p$mapping) - labels <- lapply(object, deparse) - names(labels) <- names(object) - p <- update_labels(p, labels) - } else if (is.Coord(object)) { + a_labels <- lapply(object, deparse) + names(a_labels) <- names(object) + p <- update_a_labels(p, a_labels) + } else if (is.a_Coord(object)) { p$coordinates <- object p - } else if (is.facet(object)) { - p$facet <- object + } else if (is.a_facet(object)) { + p$a_facet <- object p } else if (is.list(object)) { for (o in object) { p <- p + o } - } else if (is.layer(object)) { + } else if (is.a_layer(object)) { p$layers <- append(p$layers, object) - # Add any new labels + # Add any new a_labels mapping <- make_labels(object$mapping) - default <- make_labels(object$stat$default_aes) + default <- make_labels(object$a_stat$default_aes) new_labels <- defaults(mapping, default) - p$labels <- defaults(p$labels, new_labels) + p$a_labels <- defaults(p$a_labels, new_labels) } else { stop("Don't know how to add ", objectname, " to a plot", call. = FALSE) diff --git a/R/plot.r b/R/plot.r index e3ad241e12..7cf22386c8 100644 --- a/R/plot.r +++ b/R/plot.r @@ -1,22 +1,22 @@ -#' Create a new ggplot plot. +#' Create a new a_plot plot. #' -#' \code{ggplot()} initializes a ggplot object. It can be used to +#' \code{a_plot()} initializes a a_plot object. It can be used to #' declare the input data frame for a graphic and to specify the #' set of plot aesthetics intended to be common throughout all #' subsequent layers unless specifically overridden. #' -#' \code{ggplot()} is typically used to construct a plot +#' \code{a_plot()} is typically used to construct a plot #' incrementally, using the + operator to add layers to the -#' existing ggplot object. This is advantageous in that the +#' existing a_plot object. This is advantageous in that the #' code is explicit about which layers are added and the order #' in which they are added. For complex graphics with multiple -#' layers, initialization with \code{ggplot} is recommended. +#' layers, initialization with \code{a_plot} is recommended. #' -#' There are three common ways to invoke \code{ggplot}: +#' There are three common ways to invoke \code{a_plot}: #' \itemize{ -#' \item \code{ggplot(df, aes(x, y, ))} -#' \item \code{ggplot(df)} -#' \item \code{ggplot()} +#' \item \code{a_plot(df, a_aes(x, y, ))} +#' \item \code{a_plot(df)} +#' \item \code{a_plot()} #' } #' The first method is recommended if all layers use the same #' data and the same set of aesthetics, although this method @@ -26,20 +26,20 @@ #' but no aesthetics are defined up front. This is useful when #' one data frame is used predominantly as layers are added, #' but the aesthetics may vary from one layer to another. The -#' third method initializes a skeleton \code{ggplot} object which +#' third method initializes a skeleton \code{a_plot} object which #' is fleshed out as layers are added. This method is useful when #' multiple data frames are used to produce different layers, as #' is often the case in complex graphics. #' #' @param data Default dataset to use for plot. If not already a data.frame, -#' will be converted to one by \code{\link{fortify}}. If not specified, +#' will be converted to one by \code{\link{a_fortify}}. If not specified, #' must be suppled in each layer added to the plot. #' @param mapping Default list of aesthetic mappings to use for plot. #' If not specified, must be suppled in each layer added to the plot. #' @param ... Other arguments passed on to methods. Not currently used. #' @param environment If an variable defined in the aesthetic mapping is not -#' found in the data, ggplot will look for it in this environment. It defaults -#' to using the environment in which \code{ggplot()} is called. +#' found in the data, a_plot will look for it in this environment. It defaults +#' to using the environment in which \code{a_plot()} is called. #' @export #' @examples #' df <- data.frame(gp = factor(rep(letters[1:3], each = 10)), @@ -49,79 +49,79 @@ #' #' # Declare the data frame and common aesthetics. #' # The summary data frame ds is used to plot -#' # larger red points in a second geom_point() layer. +#' # larger red points in a second a_geom_point() layer. #' # If the data = argument is not specified, it uses the -#' # declared data frame from ggplot(); ditto for the aesthetics. -#' ggplot(df, aes(x = gp, y = y)) + -#' geom_point() + -#' geom_point(data = ds, aes(y = mean), +#' # declared data frame from a_plot(); ditto for the aesthetics. +#' a_plot(df, a_aes(x = gp, y = y)) + +#' a_geom_point() + +#' a_geom_point(data = ds, a_aes(y = mean), #' colour = 'red', size = 3) -#' # Same plot as above, declaring only the data frame in ggplot(). +#' # Same plot as above, declaring only the data frame in a_plot(). #' # Note how the x and y aesthetics must now be declared in -#' # each geom_point() layer. -#' ggplot(df) + -#' geom_point(aes(x = gp, y = y)) + -#' geom_point(data = ds, aes(x = gp, y = mean), +#' # each a_geom_point() layer. +#' a_plot(df) + +#' a_geom_point(a_aes(x = gp, y = y)) + +#' a_geom_point(data = ds, a_aes(x = gp, y = mean), #' colour = 'red', size = 3) -#' # Set up a skeleton ggplot object and add layers: -#' ggplot() + -#' geom_point(data = df, aes(x = gp, y = y)) + -#' geom_point(data = ds, aes(x = gp, y = mean), +#' # Set up a skeleton a_plot object and add layers: +#' a_plot() + +#' a_geom_point(data = df, a_aes(x = gp, y = y)) + +#' a_geom_point(data = ds, a_aes(x = gp, y = mean), #' colour = 'red', size = 3) + -#' geom_errorbar(data = ds, aes(x = gp, y = mean, +#' a_geom_errorbar(data = ds, a_aes(x = gp, y = mean, #' ymin = mean - sd, ymax = mean + sd), #' colour = 'red', width = 0.4) -ggplot <- function(data = NULL, mapping = aes(), ..., +a_plot <- function(data = NULL, mapping = a_aes(), ..., environment = parent.frame()) { - UseMethod("ggplot") + UseMethod("a_plot") } #' @export -#' @rdname ggplot +#' @rdname a_plot #' @usage NULL -ggplot.default <- function(data = NULL, mapping = aes(), ..., +a_plot.default <- function(data = NULL, mapping = a_aes(), ..., environment = parent.frame()) { - ggplot.data.frame(fortify(data, ...), mapping, environment = environment) + a_plot.data.frame(a_fortify(data, ...), mapping, environment = environment) } #' @export -#' @rdname ggplot +#' @rdname a_plot #' @usage NULL -ggplot.data.frame <- function(data, mapping = aes(), ..., +a_plot.data.frame <- function(data, mapping = a_aes(), ..., environment = parent.frame()) { if (!missing(mapping) && !inherits(mapping, "uneval")) { - stop("Mapping should be created with `aes() or `aes_()`.", call. = FALSE) + stop("Mapping should be created with `a_aes() or `a_aes_()`.", call. = FALSE) } p <- structure(list( data = data, layers = list(), - scales = scales_list(), + scales = a_scales_list(), mapping = mapping, - theme = list(), - coordinates = coord_cartesian(), - facet = facet_null(), + a_theme = list(), + coordinates = a_coord_cartesian(), + a_facet = a_facet_null(), plot_env = environment - ), class = c("gg", "ggplot")) + ), class = c("aaa", "a_plot")) - p$labels <- make_labels(mapping) + p$a_labels <- make_labels(mapping) set_last_plot(p) p } -plot_clone <- function(plot) { +a_plot_clone <- function(plot) { p <- plot p$scales <- plot$scales$clone() p } -#' Reports whether x is a ggplot object +#' Reports whether x is a a_plot object #' @param x An object to test #' @keywords internal #' @export -is.ggplot <- function(x) inherits(x, "ggplot") +is.a_plot <- function(x) inherits(x, "a_plot") #' Draw plot on current graphics device. #' @@ -130,26 +130,26 @@ is.ggplot <- function(x) inherits(x, "ggplot") #' @param vp viewport to draw plot in #' @param ... other arguments not used by this method #' @keywords hplot -#' @return Invisibly returns the result of \code{\link{ggplot_build}}, which +#' @return Invisibly returns the result of \code{\link{a_plot_build}}, which #' is a list with components that contain the plot itself, the data, #' information about the scales, panels etc. #' @export -#' @method print ggplot -print.ggplot <- function(x, newpage = is.null(vp), vp = NULL, ...) { +#' @method print a_plot +print.a_plot <- function(x, newpage = is.null(vp), vp = NULL, ...) { set_last_plot(x) if (newpage) grid.newpage() - # Record dependency on 'ggplot2' on the display list + # Record dependency on 'ggplot2Animint' on the display list # (AFTER grid.newpage()) grDevices::recordGraphics( - requireNamespace("ggplot2", quietly = TRUE), + requireNamespace("ggplot2Animint", quietly = TRUE), list(), - getNamespace("ggplot2") + getNamespace("ggplot2Animint") ) - data <- ggplot_build(x) + data <- a_plot_build(x) - gtable <- ggplot_gtable(data) + gtable <- a_plot_gtable(data) if (is.null(vp)) { grid.draw(gtable) } else { @@ -160,7 +160,7 @@ print.ggplot <- function(x, newpage = is.null(vp), vp = NULL, ...) { invisible(data) } -#' @rdname print.ggplot -#' @method plot ggplot +#' @rdname print.a_plot +#' @method plot a_plot #' @export -plot.ggplot <- print.ggplot +plot.a_plot <- print.a_plot diff --git a/R/position-.r b/R/position-.r index 253b796077..a801a85a21 100644 --- a/R/position-.r +++ b/R/position-.r @@ -1,16 +1,16 @@ -#' @section Positions: +#' @section a_Positions: #' -#' All \code{position_*} functions (like \code{position_dodge}) return a -#' \code{Position*} object (like \code{PositionDodge}). The \code{Position*} +#' All \code{a_position_*} functions (like \code{a_position_dodge}) return a +#' \code{a_Position*} object (like \code{a_PositionDodge}). The \code{a_Position*} #' object is responsible for adjusting the position of overlapping geoms. #' -#' The way that the \code{position_*} functions work is slightly different from -#' the \code{geom_*} and \code{stat_*} functions, because a \code{position_*} -#' function actually "instantiates" the \code{Position*} object by creating a +#' The way that the \code{a_position_*} functions work is slightly different from +#' the \code{a_geom_*} and \code{a_stat_*} functions, because a \code{a_position_*} +#' function actually "instantiates" the \code{a_Position*} object by creating a #' descendant, and returns that. #' -#' Each of the \code{Position*} objects is a \code{\link{ggproto}} object, -#' descended from the top-level \code{Position}, and each implements the +#' Each of the \code{a_Position*} objects is a \code{\link{a_ggproto}} object, +#' descended from the top-level \code{a_Position}, and each implements the #' following methods: #' #' \itemize{ @@ -41,11 +41,11 @@ #' that must be present for this position adjustment to work. #' } #' -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -Position <- ggproto("Position", +a_Position <- a_ggproto("a_Position", required_aes = character(), setup_params = function(self, data) { @@ -75,11 +75,11 @@ Position <- ggproto("Position", #' #' @param trans_x,trans_y Transformation functions for x and y aesthetics. #' (will transform x, xmin, xmax, xend etc) +#' @param df .... #' @param ... Additional arguments passed to \code{trans_x} and \code{trans_y}. -#' @keywords internal #' @export transform_position <- function(df, trans_x = NULL, trans_y = NULL, ...) { - scales <- aes_to_scale(names(df)) + scales <- a_aes_to_scale(names(df)) if (!is.null(trans_x)) { df[scales == "x"] <- lapply(df[scales == "x"], trans_x, ...) diff --git a/R/position-collide.r b/R/position-collide.r index 551688644c..863a7c0f9e 100644 --- a/R/position-collide.r +++ b/R/position-collide.r @@ -95,7 +95,7 @@ pos_dodge <- function(df, width) { d_width <- max(df$xmax - df$xmin) # df <- data.frame(n = c(2:5, 10, 26), div = c(4, 3, 2.666666, 2.5, 2.2, 2.1)) - # ggplot(df, aes(n, div)) + geom_point() + # a_plot(df, a_aes(n, div)) + geom_point() # Have a new group index from 1 to number of groups. # This might be needed if the group numbers in this set don't include all of 1:n diff --git a/R/position-dodge.r b/R/position-dodge.r index 1149821547..5bd2e9f433 100644 --- a/R/position-dodge.r +++ b/R/position-dodge.r @@ -1,60 +1,60 @@ #' Adjust position by dodging overlaps to the side. #' -#' @inheritParams position_identity +#' @inheritParams a_position_identity #' @param width Dodging width, when different to the width of the individual #' elements. This is useful when you want to align narrow geoms with wider #' geoms. See the examples for a use case. #' @family position adjustments #' @export #' @examples -#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) + -#' geom_bar(position = "dodge") +#' a_plot(mtcars, a_aes(factor(cyl), fill = factor(vs))) + +#' a_geom_bar(a_position = "dodge") #' \donttest{ -#' ggplot(diamonds, aes(price, fill = cut)) + -#' geom_histogram(position="dodge") -#' # see ?geom_boxplot and ?geom_bar for more examples +#' a_plot(diamonds, a_aes(price, fill = cut)) + +#' a_geom_histogram(a_position="dodge") +#' # see ?a_geom_boxplot and ?a_geom_bar for more examples #' #' # To dodge items with different widths, you need to be explicit #' df <- data.frame(x = c("a","a","b","b"), y = 2:5, g = rep(1:2, 2)) -#' p <- ggplot(df, aes(x, y, group = g)) + -#' geom_bar( -#' stat = "identity", position = "dodge", +#' p <- a_plot(df, a_aes(x, y, group = g)) + +#' a_geom_bar( +#' a_stat = "identity", a_position = "dodge", #' fill = "grey50", colour = "black" #' ) #' p #' #' # A line range has no width: -#' p + geom_linerange(aes(ymin = y-1, ymax = y+1), position = "dodge") +#' p + a_geom_linerange(a_aes(ymin = y-1, ymax = y+1), a_position = "dodge") #' # You need to explicitly specify the width for dodging -#' p + geom_linerange(aes(ymin = y-1, ymax = y+1), -#' position = position_dodge(width = 0.9)) +#' p + a_geom_linerange(a_aes(ymin = y-1, ymax = y+1), +#' a_position = a_position_dodge(width = 0.9)) #' #' # Similarly with error bars: -#' p + geom_errorbar(aes(ymin = y-1, ymax = y+1), width = 0.2, -#' position = "dodge") -#' p + geom_errorbar(aes(ymin = y-1, ymax = y+1, width = 0.2), -#' position = position_dodge(width = 0.90)) +#' p + a_geom_errorbar(a_aes(ymin = y-1, ymax = y+1), width = 0.2, +#' a_position = "dodge") +#' p + a_geom_errorbar(a_aes(ymin = y-1, ymax = y+1, width = 0.2), +#' a_position = a_position_dodge(width = 0.90)) #' } -position_dodge <- function(width = NULL) { - ggproto(NULL, PositionDodge, width = width) +a_position_dodge <- function(width = NULL) { + a_ggproto(NULL, a_PositionDodge, width = width) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -PositionDodge <- ggproto("PositionDodge", Position, +a_PositionDodge <- a_ggproto("a_PositionDodge", a_Position, required_aes = "x", width = NULL, setup_params = function(self, data) { if (is.null(data$xmin) && is.null(data$xmax) && is.null(self$width)) { - warning("Width not defined. Set with `position_dodge(width = ?)`", + warning("Width not defined. Set with `a_position_dodge(width = ?)`", call. = FALSE) } list(width = self$width) }, compute_panel = function(data, params, scales) { - collide(data, params$width, "position_dodge", pos_dodge, check.width = FALSE) + collide(data, params$width, "a_position_dodge", pos_dodge, check.width = FALSE) } ) diff --git a/R/position-fill.r b/R/position-fill.r index 1d6b66a842..81fd7c5020 100644 --- a/R/position-fill.r +++ b/R/position-fill.r @@ -1,24 +1,24 @@ #' @export -#' @rdname position_stack -position_fill <- function() { - PositionFill +#' @rdname a_position_stack +a_position_fill <- function() { + a_PositionFill } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -PositionFill <- ggproto("PositionFill", Position, +a_PositionFill <- a_ggproto("a_PositionFill", a_Position, required_aes = c("x", "ymax"), setup_data = function(self, data, params) { if (!is.null(data$ymin) && !all(data$ymin == 0)) warning("Filling not well defined when ymin != 0", call. = FALSE) - ggproto_parent(Position, self)$setup_data(data) + a_ggproto_parent(a_Position, self)$setup_data(data) }, compute_panel = function(data, params, scales) { - collide(data, NULL, "position_fill", pos_fill) + collide(data, NULL, "a_position_fill", pos_fill) } ) diff --git a/R/position-identity.r b/R/position-identity.r index 956efd1f41..aea34db812 100644 --- a/R/position-identity.r +++ b/R/position-identity.r @@ -2,15 +2,15 @@ #' #' @family position adjustments #' @export -position_identity <- function() { - PositionIdentity +a_position_identity <- function() { + a_PositionIdentity } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -PositionIdentity <- ggproto("PositionIdentity", Position, +a_PositionIdentity <- a_ggproto("a_PositionIdentity", a_Position, compute_layer = function(data, params, scales) { data } diff --git a/R/position-jitter.r b/R/position-jitter.r index 1a5bc2cc84..22cabbc1c4 100644 --- a/R/position-jitter.r +++ b/R/position-jitter.r @@ -11,41 +11,41 @@ #' data so it's not possible to see the distinction between the categories. #' @export #' @examples -#' ggplot(mtcars, aes(am, vs)) + geom_point() +#' a_plot(mtcars, a_aes(am, vs)) + a_geom_point() #' #' # Default amount of jittering will generally be too much for #' # small datasets: -#' ggplot(mtcars, aes(am, vs)) + geom_jitter() +#' a_plot(mtcars, a_aes(am, vs)) + a_geom_jitter() #' #' # Two ways to override -#' ggplot(mtcars, aes(am, vs)) + -#' geom_jitter(width = 0.1, height = 0.1) -#' ggplot(mtcars, aes(am, vs)) + -#' geom_jitter(position = position_jitter(width = 0.1, height = 0.1)) +#' a_plot(mtcars, a_aes(am, vs)) + +#' a_geom_jitter(width = 0.1, height = 0.1) +#' a_plot(mtcars, a_aes(am, vs)) + +#' a_geom_jitter(a_position = a_position_jitter(width = 0.1, height = 0.1)) #' #' # The default works better for large datasets, where it will #' # take up as much space as a boxplot or a bar -#' ggplot(mpg, aes(class, hwy)) + -#' geom_jitter() + -#' geom_boxplot() -position_jitter <- function(width = NULL, height = NULL) { - ggproto(NULL, PositionJitter, +#' a_plot(mpg, a_aes(class, hwy)) + +#' a_geom_jitter() + +#' a_geom_boxplot() +a_position_jitter <- function(width = NULL, height = NULL) { + a_ggproto(NULL, a_PositionJitter, width = width, height = height ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -PositionJitter <- ggproto("PositionJitter", Position, +a_PositionJitter <- a_ggproto("a_PositionJitter", a_Position, required_aes = c("x", "y"), setup_params = function(self, data) { list( - width = self$width %||% resolution(data$x, zero = FALSE) * 0.4, - height = self$height %||% resolution(data$y, zero = FALSE) * 0.4 + width = self$width %||% a_resolution(data$x, zero = FALSE) * 0.4, + height = self$height %||% a_resolution(data$y, zero = FALSE) * 0.4 ) }, diff --git a/R/position-jitterdodge.R b/R/position-jitterdodge.R index f87ce4c6e3..36728f4760 100644 --- a/R/position-jitterdodge.R +++ b/R/position-jitterdodge.R @@ -1,7 +1,7 @@ #' Adjust position by simultaneously dodging and jittering #' #' This is primarily used for aligning points generated through -#' \code{geom_point()} with dodged boxplots (e.g., a \code{geom_boxplot()} with +#' \code{a_geom_point()} with dodged boxplots (e.g., a \code{a_geom_boxplot()} with #' a fill aesthetic supplied). #' #' @family position adjustments @@ -9,28 +9,28 @@ #' resolution of the data. #' @param jitter.height degree of jitter in y direction. Defaults to 0. #' @param dodge.width the amount to dodge in the x direction. Defaults to 0.75, -#' the default \code{position_dodge()} width. +#' the default \code{a_position_dodge()} width. #' @export #' @examples #' dsub <- diamonds[ sample(nrow(diamonds), 1000), ] -#' ggplot(dsub, aes(x = cut, y = carat, fill = clarity)) + -#' geom_boxplot(outlier.size = 0) + -#' geom_point(pch = 21, position = position_jitterdodge()) -position_jitterdodge <- function(jitter.width = NULL, jitter.height = 0, +#' a_plot(dsub, a_aes(x = cut, y = carat, fill = clarity)) + +#' a_geom_boxplot(outlier.size = 0) + +#' a_geom_point(pch = 21, a_position = a_position_jitterdodge()) +a_position_jitterdodge <- function(jitter.width = NULL, jitter.height = 0, dodge.width = 0.75) { - ggproto(NULL, PositionJitterdodge, + a_ggproto(NULL, a_PositionJitterdodge, jitter.width = jitter.width, jitter.height = jitter.height, dodge.width = dodge.width ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -PositionJitterdodge <- ggproto("PositionJitterdodge", Position, +a_PositionJitterdodge <- a_ggproto("a_PositionJitterdodge", a_Position, jitter.width = NULL, jitter.height = NULL, dodge.width = NULL, @@ -38,15 +38,15 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position, required_aes = c("x", "y"), setup_params = function(self, data) { - width <- self$jitter.width %||% resolution(data$x, zero = FALSE) * 0.4 + width <- self$jitter.width %||% a_resolution(data$x, zero = FALSE) * 0.4 # Adjust the x transformation based on the number of 'dodge' variables - dodgecols <- intersect(c("fill", "colour", "linetype", "shape", "size", "alpha"), colnames(data)) + dodgecols <- intersect(c("fill", "colour", "linetype", "shape", "size", "alpha"), colnames(data)) if (length(dodgecols) == 0) { - stop("`position_jitterdodge()` requires at least one aesthetic to dodge by", call. = FALSE) + stop("`a_position_jitterdodge()` requires at least one aesthetic to dodge by", call. = FALSE) } ndodge <- lapply(data[dodgecols], levels) # returns NULL for numeric, i.e. non-dodge layers ndodge <- length(unique(unlist(ndodge))) - + list( dodge.width = self$dodge.width, jitter.height = self$jitter.height, @@ -56,7 +56,7 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position, compute_panel = function(data, params, scales) { - data <- collide(data, params$dodge.width, "position_jitterdodge", pos_dodge, + data <- collide(data, params$dodge.width, "a_position_jitterdodge", pos_dodge, check.width = FALSE) # then jitter diff --git a/R/position-nudge.R b/R/position-nudge.R index 1ed8e9e791..4fd43e33ae 100644 --- a/R/position-nudge.R +++ b/R/position-nudge.R @@ -12,25 +12,25 @@ #' y = c("a","c","d","c") #' ) #' -#' ggplot(df, aes(x, y)) + -#' geom_point() + -#' geom_text(aes(label = y)) +#' a_plot(df, a_aes(x, y)) + +#' a_geom_point() + +#' a_geom_text(a_aes(a_label = y)) #' -#' ggplot(df, aes(x, y)) + -#' geom_point() + -#' geom_text(aes(label = y), position = position_nudge(y = -0.1)) -position_nudge <- function(x = 0, y = 0) { - ggproto(NULL, PositionNudge, +#' a_plot(df, a_aes(x, y)) + +#' a_geom_point() + +#' a_geom_text(a_aes(a_label = y), a_position = a_position_nudge(y = -0.1)) +a_position_nudge <- function(x = 0, y = 0) { + a_ggproto(NULL, a_PositionNudge, x = x, y = y ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -PositionNudge <- ggproto("PositionNudge", Position, +a_PositionNudge <- a_ggproto("a_PositionNudge", a_Position, x = 0, y = 0, diff --git a/R/position-stack.r b/R/position-stack.r index 42679281be..f91968c762 100644 --- a/R/position-stack.r +++ b/R/position-stack.r @@ -1,29 +1,29 @@ #' Stack overlapping objects on top of one another. #' -#' \code{position_fill} additionally standardises each stack to have unit +#' \code{a_position_fill} additionally standardises each stack to have unit #' height. #' #' @family position adjustments -#' @seealso See \code{\link{geom_bar}} and \code{\link{geom_area}} for +#' @seealso See \code{\link{a_geom_bar}} and \code{\link{a_geom_area}} for #' more examples. #' @export #' @examples #' # Stacking is the default behaviour for most area plots: -#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) + geom_bar() +#' a_plot(mtcars, a_aes(factor(cyl), fill = factor(vs))) + a_geom_bar() #' # Fill makes it easier to compare proportions -#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) + -#' geom_bar(position = "fill") +#' a_plot(mtcars, a_aes(factor(cyl), fill = factor(vs))) + +#' a_geom_bar(a_position = "fill") #' #' # To change stacking order, use factor() to change order of levels #' mtcars$vs <- factor(mtcars$vs, levels = c(1,0)) -#' ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) + geom_bar() +#' a_plot(mtcars, a_aes(factor(cyl), fill = factor(vs))) + a_geom_bar() #' -#' ggplot(diamonds, aes(price, fill = cut)) + -#' geom_histogram(binwidth = 500) -#' # When used with a histogram, position_fill creates a conditional density +#' a_plot(diamonds, a_aes(price, fill = cut)) + +#' a_geom_histogram(binwidth = 500) +#' # When used with a histogram, a_position_fill creates a conditional density #' # estimate -#' ggplot(diamonds, aes(price, fill = cut)) + -#' geom_histogram(binwidth = 500, position = "fill") +#' a_plot(diamonds, a_aes(price, fill = cut)) + +#' a_geom_histogram(binwidth = 500, a_position = "fill") #' #' # Stacking is also useful for time series #' data.set <- data.frame( @@ -32,33 +32,33 @@ #' Value = rpois(16, 10) #' ) #' -#' ggplot(data.set, aes(Time, Value)) + geom_area(aes(fill = Type)) +#' a_plot(data.set, a_aes(Time, Value)) + a_geom_area(a_aes(fill = Type)) #' #' # If you want to stack lines, you need to say so: -#' ggplot(data.set, aes(Time, Value)) + geom_line(aes(colour = Type)) -#' ggplot(data.set, aes(Time, Value)) + -#' geom_line(position = "stack", aes(colour = Type)) +#' a_plot(data.set, a_aes(Time, Value)) + a_geom_line(a_aes(colour = Type)) +#' a_plot(data.set, a_aes(Time, Value)) + +#' a_geom_line(a_position = "stack", a_aes(colour = Type)) #' #' # But realise that this makes it *much* harder to compare individual #' # trends -position_stack <- function() { - PositionStack +a_position_stack <- function() { + a_PositionStack } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -PositionStack <- ggproto("PositionStack", Position, +a_PositionStack <- a_ggproto("a_PositionStack", a_Position, # requires one of c("ymax", "y"), setup_data = function(self, data, params) { data = remove_missing(data, FALSE, - c("x", "y", "ymin", "ymax", "xmin", "xmax"), name = "position_stack") + c("x", "y", "ymin", "ymax", "xmin", "xmax"), name = "a_position_stack") if (is.null(data$ymax) && is.null(data$y)) { - message("Missing y and ymax in position = 'stack'. ", - "Maybe you want position = 'identity'?") + message("Missing y and ymax in a_position = 'stack'. ", + "Maybe you want a_position = 'identity'?") return(data) } @@ -69,6 +69,6 @@ PositionStack <- ggproto("PositionStack", Position, }, compute_panel = function(data, params, scales) { - collide(data, NULL, "position_stack", pos_stack) + collide(data, NULL, "a_position_stack", pos_stack) } ) diff --git a/R/quick-plot.r b/R/quick-plot.r index 942188338c..e9185b8b42 100644 --- a/R/quick-plot.r +++ b/R/quick-plot.r @@ -8,13 +8,13 @@ #' @param x,y,... Aesthetics passed into each layer #' @param data Data frame to use (optional). If not specified, will create #' one, extracting vectors from the current environment. -#' @param facets faceting formula to use. Picks \code{\link{facet_wrap}} or -#' \code{\link{facet_grid}} depending on whether the formula is one- +#' @param facets faceting formula to use. Picks \code{\link{a_facet_wrap}} or +#' \code{\link{a_facet_grid}} depending on whether the formula is one- #' or two-sided -#' @param margins See \code{facet_grid}: display marginal facets? -#' @param geom Character vector specifying geom(s) to draw. Defaults to +#' @param margins See \code{a_facet_grid}: display marginal facets? +#' @param a_geom Character vector specifying geom(s) to draw. Defaults to #' "point" if x and y are specified, and "histogram" if only x is specified. -#' @param stat,position DEPRECATED. +#' @param a_stat,a_position DEPRECATED. #' @param xlim,ylim X and y axis limits #' @param log Which variables to log transform ("x", "y", or "xy") #' @param main,xlab,ylab Character vector (or expression) giving plot title, @@ -53,29 +53,29 @@ #' qplot(y = mpg, data = mtcars) #' #' # Use different geoms -#' qplot(mpg, wt, data = mtcars, geom = "path") -#' qplot(factor(cyl), wt, data = mtcars, geom = c("boxplot", "jitter")) -#' qplot(mpg, data = mtcars, geom = "dotplot") +#' qplot(mpg, wt, data = mtcars, a_geom = "path") +#' qplot(factor(cyl), wt, data = mtcars, a_geom = c("boxplot", "jitter")) +#' qplot(mpg, data = mtcars, a_geom = "dotplot") #' } qplot <- function(x, y = NULL, ..., data, facets = NULL, margins = FALSE, - geom = "auto", xlim = c(NA, NA), + a_geom = "auto", xlim = c(NA, NA), ylim = c(NA, NA), log = "", main = NULL, xlab = deparse(substitute(x)), ylab = deparse(substitute(y)), - asp = NA, stat = NULL, position = NULL) { + asp = NA, a_stat = NULL, a_position = NULL) { - if (!missing(stat)) warning("`stat` is deprecated", call. = FALSE) - if (!missing(position)) warning("`position` is deprecated", call. = FALSE) - if (!is.character(geom)) stop("`geom` must be a character vector", call. = FALSE) + if (!missing(a_stat)) warning("`stat` is deprecated", call. = FALSE) + if (!missing(a_position)) warning("`position` is deprecated", call. = FALSE) + if (!is.character(a_geom)) stop("`geom` must be a character vector", call. = FALSE) argnames <- names(as.list(match.call(expand.dots = FALSE)[-1])) arguments <- as.list(match.call()[-1]) env <- parent.frame() - aesthetics <- compact(arguments[.all_aesthetics]) - aesthetics <- aesthetics[!is.constant(aesthetics)] - aes_names <- names(aesthetics) - aesthetics <- rename_aes(aesthetics) - class(aesthetics) <- "uneval" + a_aesthetics <- compact(arguments[.all_aesthetics]) + a_aesthetics <- a_aesthetics[!is.constant(a_aesthetics)] + a_aes_names <- names(a_aesthetics) + a_aesthetics <- rename_aes(a_aesthetics) + class(a_aesthetics) <- "uneval" if (missing(data)) { # If data not explicitly specified, will be pulled from workspace @@ -90,54 +90,54 @@ qplot <- function(x, y = NULL, ..., data, facets = NULL, margins = FALSE, } # Work out plot data, and modify aesthetics, if necessary - if ("auto" %in% geom) { - if ("sample" %in% aes_names) { - geom[geom == "auto"] <- "qq" + if ("auto" %in% a_geom) { + if ("sample" %in% a_aes_names) { + a_geom[a_geom == "auto"] <- "qq" } else if (missing(y)) { - x <- eval(aesthetics$x, data, env) + x <- eval(a_aesthetics$x, data, env) if (is.discrete(x)) { - geom[geom == "auto"] <- "bar" + a_geom[a_geom == "auto"] <- "bar" } else { - geom[geom == "auto"] <- "histogram" + a_geom[a_geom == "auto"] <- "histogram" } if (missing(ylab)) ylab <- "count" } else { if (missing(x)) { - aesthetics$x <- bquote(seq_along(.(y)), aesthetics) + a_aesthetics$x <- bquote(seq_along(.(y)), a_aesthetics) } - geom[geom == "auto"] <- "point" + a_geom[a_geom == "auto"] <- "point" } } - p <- ggplot(data, aesthetics, environment = env) + p <- a_plot(data, a_aesthetics, environment = env) if (is.null(facets)) { - p <- p + facet_null() + p <- p + a_facet_null() } else if (is.formula(facets) && length(facets) == 2) { - p <- p + facet_wrap(facets) + p <- p + a_facet_wrap(facets) } else { - p <- p + facet_grid(facets = deparse(facets), margins = margins) + p <- p + a_facet_grid(facets = deparse(facets), margins = margins) } if (!is.null(main)) p <- p + ggtitle(main) # Add geoms/statistics - for (g in geom) { + for (g in a_geom) { # Arguments are unevaluated because some are aesthetics. Need to evaluate # params - can't do in correct env because that's lost (no lazyeval) # so do the best we can by evaluating in parent frame. - params <- arguments[setdiff(names(arguments), c(aes_names, argnames))] + params <- arguments[setdiff(names(arguments), c(a_aes_names, argnames))] params <- lapply(params, eval, parent.frame()) - p <- p + do.call(paste0("geom_", g), params) + p <- p + do.call(paste0("a_geom_", g), params) } logv <- function(var) var %in% strsplit(log, "")[[1]] - if (logv("x")) p <- p + scale_x_log10() - if (logv("y")) p <- p + scale_y_log10() + if (logv("x")) p <- p + a_scale_x_log10() + if (logv("y")) p <- p + a_scale_y_log10() - if (!is.na(asp)) p <- p + theme(aspect.ratio = asp) + if (!is.na(asp)) p <- p + a_theme(aspect.ratio = asp) if (!missing(xlab)) p <- p + xlab(xlab) if (!missing(ylab)) p <- p + ylab(ylab) diff --git a/R/range.r b/R/range.r index 5d363ad6a0..cddf3a28bd 100644 --- a/R/range.r +++ b/R/range.r @@ -5,29 +5,29 @@ #' \code{\link{continuous_range}} and \code{\link{discrete_range}}. #' #' @noRd -Range <- ggproto("Range", NULL, +a_Range <- a_ggproto("a_Range", NULL, range = NULL, reset = function(self) { self$range <- NULL } ) -RangeDiscrete <- ggproto("RangeDiscrete", Range, +a_RangeDiscrete <- a_ggproto("a_RangeDiscrete", a_Range, train = function(self, x, drop = FALSE) { self$range <- scales::train_discrete(x, self$range, drop) } ) -RangeContinuous <- ggproto("RangeContinuous", Range, +a_RangeContinuous <- a_ggproto("a_RangeContinuous", a_Range, train = function(self, x) { self$range <- scales::train_continuous(x, self$range) } ) continuous_range <- function() { - ggproto(NULL, RangeContinuous) + a_ggproto(NULL, a_RangeContinuous) } discrete_range <- function() { - ggproto(NULL, RangeDiscrete) + a_ggproto(NULL, a_RangeDiscrete) } diff --git a/R/save.r b/R/save.r index c7139b7b87..53a35ed295 100644 --- a/R/save.r +++ b/R/save.r @@ -12,7 +12,7 @@ #' \code{ggsave} currently recognises eps/ps, tex (pictex), pdf, jpeg, tiff, #' png, bmp, svg and wmf (windows only). #' @param path Path to save plot to (combined with filename). -#' @param scale Multiplicative scaling factor. +#' @param a_scale Multiplicative scaling factor. #' @param width,height Plot dimensions, defaults to size of current graphics #' device. #' @param units Units for width and height when specified explicitly (in, cm, @@ -25,7 +25,7 @@ #' @export #' @examples #' \dontrun{ -#' ggplot(mtcars, aes(mpg, wt)) + geom_point() +#' a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() #' #' ggsave("mtcars.pdf") #' ggsave("mtcars.png") @@ -43,12 +43,12 @@ #' unlink(file) #' } ggsave <- function(filename, plot = last_plot(), - device = NULL, path = NULL, scale = 1, + device = NULL, path = NULL, a_scale = 1, width = NA, height = NA, units = c("in", "cm", "mm"), dpi = 300, limitsize = TRUE, ...) { dev <- plot_dev(device, filename, dpi = dpi) - dim <- plot_dim(c(width, height), scale = scale, units = units, + dim <- plot_dim(c(width, height), a_scale = a_scale, units = units, limitsize = limitsize) if (!is.null(path)) { @@ -61,20 +61,20 @@ ggsave <- function(filename, plot = last_plot(), invisible() } -plot_dim <- function(dim = c(NA, NA), scale = 1, units = c("in", "cm", "mm"), +plot_dim <- function(dim = c(NA, NA), a_scale = 1, units = c("in", "cm", "mm"), limitsize = TRUE) { units <- match.arg(units) to_inches <- function(x) x / c(`in` = 1, cm = 2.54, mm = 2.54 * 10)[units] from_inches <- function(x) x * c(`in` = 1, cm = 2.54, mm = 2.54 * 10)[units] - dim <- to_inches(dim) * scale + dim <- to_inches(dim) * a_scale if (any(is.na(dim))) { if (length(grDevices::dev.list()) == 0) { default_dim <- c(7, 7) } else { - default_dim <- grDevices::dev.size() * scale + default_dim <- grDevices::dev.size() * a_scale } dim[is.na(dim)] <- default_dim[is.na(dim)] dim_f <- prettyNum(from_inches(dim), digits = 3) @@ -130,6 +130,6 @@ plot_dev <- function(device, filename, dpi = 300) { } #' @export -grid.draw.ggplot <- function(x, recording = TRUE) { +grid.draw.a_plot <- function(x, recording = TRUE) { print(x) } diff --git a/R/scale-.r b/R/scale-.r index fe0aac19f0..2cef63e95b 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -1,471 +1,471 @@ -#' @section Scales: +#' @section a_Scales: #' -#' All \code{scale_*} functions (like \code{scale_x_continuous}) return a -#' \code{Scale*} object (like \code{ScaleContinuous}). The \code{Scale*} +#' All \code{a_scale_*} functions (like \code{a_scale_x_continuous}) return a +#' \code{a_Scale*} object (like \code{a_ScaleContinuous}). The \code{a_Scale*} #' object represents a single scale. #' -#' Each of the \code{Scale*} objects is a \code{\link{ggproto}} object, -#' descended from the top-level \code{Scale}. +#' Each of the \code{a_Scale*} objects is a \code{\link{a_ggproto}} object, +#' descended from the top-level \code{a_Scale}. #' -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -Scale <- ggproto("Scale", NULL, - - call = NULL, - - aesthetics = aes(), - scale_name = NULL, - palette = function() { - stop("Not implemented", call. = FALSE) - }, - - range = ggproto(NULL, Range), - limits = NULL, - na.value = NA, - expand = waiver(), - - name = waiver(), - breaks = waiver(), - labels = waiver(), - guide = "legend", - - - is_discrete = function() { - stop("Not implemented", call. = FALSE) - }, - - # Train scale from a data frame. - # - # @return updated range (invisibly) - # @seealso \code{\link{scale_train}} for scale specific generic method - train_df = function(self, df) { - if (empty(df)) return() - - aesthetics <- intersect(self$aesthetics, names(df)) - for (aesthetic in aesthetics) { - self$train(df[[aesthetic]]) - } - invisible() - }, - - # Train an individual scale from a vector of data. - train = function(self, x) { - stop("Not implemented", call. = FALSE) - }, - - # Reset scale, untraining ranges - reset = function(self) { - self$range$reset() - }, - - is_empty = function(self) { - is.null(self$range$range) && is.null(self$limits) - }, - - # @return list of transformed variables - transform_df = function(self, df) { - if (empty(df)) return() - - aesthetics <- intersect(self$aesthetics, names(df)) - if (length(aesthetics) == 0) return() - - lapply(df[aesthetics], self$transform) - }, - - transform = function(self, x) { - stop("Not implemented", call. = FALSE) - }, - - # @return list of mapped variables - map_df = function(self, df, i = NULL) { - if (empty(df)) return() - - aesthetics <- intersect(self$aesthetics, names(df)) - names(aesthetics) <- aesthetics - if (length(aesthetics) == 0) return() - - if (is.null(i)) { - lapply(aesthetics, function(j) self$map(df[[j]])) - } else { - lapply(aesthetics, function(j) self$map(df[[j]][i])) - } - }, - - # @kohske - # map tentatively accept limits argument. - # map replaces oob (i.e., outside limits) values with NA. - # - # Previously limits are always scale_limits(scale). - # But if this function is called to get breaks, - # and breaks spans oob, the oob breaks is replaces by NA. - # This makes impossible to display oob breaks. - # Now coord_train calls this function with limits determined by coord (with expansion). - map = function(self, x, limits = self$get_limits()) { - stop("Not implemented", call. = FALSE) - }, - - # if scale contains a NULL, use the default scale range - # if scale contains a NA, use the default range for that axis, otherwise - # use the user defined limit for that axis - get_limits = function(self) { - if (self$is_empty()) return(c(0, 1)) - - if (!is.null(self$limits)) { - ifelse(!is.na(self$limits), self$limits, self$range$range) - } else { - self$range$range - } - }, - - # The physical size of the scale. - # This always returns a numeric vector of length 2, giving the physical - # dimensions of a scale. - dimension = function(self, expand = c(0, 0)) { - stop("Not implemented", call. = FALSE) - }, - - get_breaks = function(self, limits = self$get_limits()) { - stop("Not implemented", call. = FALSE) - }, - - # The numeric position of scale breaks, used by coord/guide - break_positions = function(self, range = self$get_limits()) { - self$map(self$get_breaks(range)) - }, - - get_breaks_minor = function(self, n = 2, b = self$break_positions(), limits = self$get_limits()) { - stop("Not implemented", call. = FALSE) - }, - - get_labels = function(self, breaks = self$get_breaks()) { - stop("Not implemented", call. = FALSE) - }, - - # Each implementation of a Scale must implement a clone method that makes - # copies of reference objecsts. - clone = function(self) { - stop("Not implemented", call. = FALSE) - }, - - break_info = function(self, range = NULL) { - stop("Not implemented", call. = FALSE) - } +a_Scale <- a_ggproto("a_Scale", NULL, + + call = NULL, + + a_aesthetics = a_aes(), + a_scale_name = NULL, + palette = function() { + stop("Not implemented", call. = FALSE) + }, + + range = a_ggproto(NULL, a_Range), + limits = NULL, + na.value = NA, + expand = waiver(), + + name = waiver(), + breaks = waiver(), + a_labels = waiver(), + a_guide = "legend", + + + is_discrete = function() { + stop("Not implemented", call. = FALSE) + }, + + # Train scale from a data frame. + # + # @return updated range (invisibly) + # @seealso \code{\link{a_scale_train}} for scale specific generic method + train_df = function(self, df) { + if (empty(df)) return() + + a_aesthetics <- intersect(self$a_aesthetics, names(df)) + for (a_aesthetic in a_aesthetics) { + self$train(df[[a_aesthetic]]) + } + invisible() + }, + + # Train an individual scale from a vector of data. + train = function(self, x) { + stop("Not implemented", call. = FALSE) + }, + + # Reset scale, untraining ranges + reset = function(self) { + self$range$reset() + }, + + is_empty = function(self) { + is.null(self$range$range) && is.null(self$limits) + }, + + # @return list of transformed variables + transform_df = function(self, df) { + if (empty(df)) return() + + a_aesthetics <- intersect(self$a_aesthetics, names(df)) + if (length(a_aesthetics) == 0) return() + + lapply(df[a_aesthetics], self$transform) + }, + + transform = function(self, x) { + stop("Not implemented", call. = FALSE) + }, + + # @return list of mapped variables + map_df = function(self, df, i = NULL) { + if (empty(df)) return() + + a_aesthetics <- intersect(self$a_aesthetics, names(df)) + names(a_aesthetics) <- a_aesthetics + if (length(a_aesthetics) == 0) return() + + if (is.null(i)) { + lapply(a_aesthetics, function(j) self$map(df[[j]])) + } else { + lapply(a_aesthetics, function(j) self$map(df[[j]][i])) + } + }, + + # @kohske + # map tentatively accept limits argument. + # map replaces oob (i.e., outside limits) values with NA. + # + # Previously limits are always a_scale_limits(a_scale). + # But if this function is called to get breaks, + # and breaks spans oob, the oob breaks is replaces by NA. + # This makes impossible to display oob breaks. + # Now coord_train calls this function with limits determined by coord (with expansion). + map = function(self, x, limits = self$get_limits()) { + stop("Not implemented", call. = FALSE) + }, + + # if a_scale contains a NULL, use the default a_scale range + # if a_scale contains a NA, use the default range for that axis, otherwise + # use the user defined limit for that axis + get_limits = function(self) { + if (self$is_empty()) return(c(0, 1)) + + if (!is.null(self$limits)) { + ifelse(!is.na(self$limits), self$limits, self$range$range) + } else { + self$range$range + } + }, + + # The physical size of the a_scale. + # This always returns a numeric vector of length 2, giving the physical + # dimensions of a a_scale. + dimension = function(self, expand = c(0, 0)) { + stop("Not implemented", call. = FALSE) + }, + + get_breaks = function(self, limits = self$get_limits()) { + stop("Not implemented", call. = FALSE) + }, + + # The numeric position of scale breaks, used by coord/guide + break_positions = function(self, range = self$get_limits()) { + self$map(self$get_breaks(range)) + }, + + get_breaks_minor = function(self, n = 2, b = self$break_positions(), limits = self$get_limits()) { + stop("Not implemented", call. = FALSE) + }, + + get_labels = function(self, breaks = self$get_breaks()) { + stop("Not implemented", call. = FALSE) + }, + + # Each implementation of a Scale must implement a clone method that makes + # copies of reference objecsts. + clone = function(self) { + stop("Not implemented", call. = FALSE) + }, + + break_info = function(self, range = NULL) { + stop("Not implemented", call. = FALSE) + } ) -check_breaks_labels <- function(breaks, labels) { +check_breaks_labels <- function(breaks, a_labels) { if (is.null(breaks)) return(TRUE) - if (is.null(labels)) return(TRUE) + if (is.null(a_labels)) return(TRUE) - bad_labels <- is.atomic(breaks) && is.atomic(labels) && - length(breaks) != length(labels) + bad_labels <- is.atomic(breaks) && is.atomic(a_labels) && + length(breaks) != length(a_labels) if (bad_labels) { - stop("`breaks` and `labels` must have the same length", call. = FALSE) + stop("`breaks` and `a_labels` must have the same length", call. = FALSE) } TRUE } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -ScaleContinuous <- ggproto("ScaleContinuous", Scale, - range = continuous_range(), - na.value = NA_real_, - rescaler = rescale, # Used by diverging and n colour gradients x - oob = censor, - minor_breaks = waiver(), - - is_discrete = function() FALSE, - - train = function(self, x) { - if (length(x) == 0) return() - self$range$train(x) - }, - - transform = function(self, x) { - self$trans$transform(x) - }, - - map = function(self, x, limits = self$get_limits()) { - x <- self$oob(self$rescaler(x, from = limits)) - - uniq <- unique(x) - pal <- self$palette(uniq) - scaled <- pal[match(x, uniq)] - - ifelse(!is.na(scaled), scaled, self$na.value) - }, - - dimension = function(self, expand = c(0, 0)) { - expand_range(self$get_limits(), expand[1], expand[2]) - }, - - get_breaks = function(self, limits = self$get_limits()) { - if (self$is_empty()) return(numeric()) - - # Limits in transformed space need to be converted back to data space - limits <- self$trans$inverse(limits) - - if (is.null(self$breaks)) { - return(NULL) - } else if (identical(self$breaks, NA)) { - stop("Invalid breaks specification. Use NULL, not NA") - } else if (zero_range(as.numeric(limits))) { - breaks <- limits[1] - } else if (is.waive(self$breaks)) { - breaks <- self$trans$breaks(limits) - } else if (is.function(self$breaks)) { - breaks <- self$breaks(limits) - } else { - breaks <- self$breaks - } - - # Breaks in data space need to be converted back to transformed space - # And any breaks outside the dimensions need to be flagged as missing - # - # @kohske - # TODO: replace NA with something else for flag. - # guides cannot discriminate oob from missing value. - breaks <- censor(self$trans$transform(breaks), self$trans$transform(limits), - only.finite = FALSE) - if (length(breaks) == 0) { - stop("Zero breaks in scale for ", paste(self$aesthetics, collapse = "/"), - call. = FALSE) - } - breaks - }, - - get_breaks_minor = function(self, n = 2, b = self$break_positions(), limits = self$get_limits()) { - if (zero_range(as.numeric(limits))) { - return() - } - - if (is.null(self$minor_breaks)) { - return(NULL) - } else if (identical(self$minor_breaks, NA)) { - stop("Invalid minor_breaks specification. Use NULL, not NA", call. = FALSE) - } else if (is.waive(self$minor_breaks)) { - if (is.null(b)) { - breaks <- NULL - } else { - b <- b[!is.na(b)] - if (length(b) < 2) return() - - bd <- diff(b)[1] - if (min(limits) < min(b)) b <- c(b[1] - bd, b) - if (max(limits) > max(b)) b <- c(b, b[length(b)] + bd) - breaks <- unique(unlist(mapply(seq, b[-length(b)], b[-1], length.out = n + 1, - SIMPLIFY = FALSE))) - } - } else if (is.function(self$minor_breaks)) { - # Find breaks in data space, and convert to numeric - breaks <- self$minor_breaks(self$trans$inverse(limits)) - breaks <- self$trans$transform(breaks) - } else { - breaks <- self$trans$transform(self$minor_breaks) - } - - # Any minor breaks outside the dimensions need to be thrown away - discard(breaks, limits) - }, - - get_labels = function(self, breaks = self$get_breaks()) { - if (is.null(breaks)) return(NULL) - - breaks <- self$trans$inverse(breaks) - - if (is.null(self$labels)) { - return(NULL) - } else if (identical(self$labels, NA)) { - stop("Invalid labels specification. Use NULL, not NA", call. = FALSE) - } else if (is.waive(self$labels)) { - labels <- self$trans$format(breaks) - } else if (is.function(self$labels)) { - labels <- self$labels(breaks) - } else { - labels <- self$labels - } - if (length(labels) != length(breaks)) { - stop("Breaks and labels are different lengths") - } - labels - }, - - clone = function(self) { - new <- ggproto(NULL, self) - new$range <- continuous_range() - new - }, - - break_info = function(self, range = NULL) { - # range - if (is.null(range)) range <- self$dimension() - - # major breaks - major <- self$get_breaks(range) - - # labels - labels <- self$get_labels(major) - - # drop oob breaks/labels by testing major == NA - if (!is.null(labels)) labels <- labels[!is.na(major)] - if (!is.null(major)) major <- major[!is.na(major)] - - # minor breaks - minor <- self$get_breaks_minor(b = major, limits = range) - if (!is.null(minor)) minor <- minor[!is.na(minor)] - - # rescale breaks [0, 1], which are used by coord/guide - major_n <- rescale(major, from = range) - minor_n <- rescale(minor, from = range) - - list(range = range, labels = labels, - major = major_n, minor = minor_n, - major_source = major, minor_source = minor) - }, - - print = function(self, ...) { - show_range <- function(x) paste0(formatC(x, digits = 3), collapse = " -- ") - - cat("<", class(self)[[1]], ">\n", sep = "") - cat(" Range: ", show_range(self$range$range), "\n", sep = "") - cat(" Limits: ", show_range(self$dimension()), "\n", sep = "") - } +a_ScaleContinuous <- a_ggproto("a_ScaleContinuous", a_Scale, + range = continuous_range(), + na.value = NA_real_, + rescaler = rescale, # Used by diverging and n colour gradients x + oob = censor, + minor_breaks = waiver(), + + is_discrete = function() FALSE, + + train = function(self, x) { + if (length(x) == 0) return() + self$range$train(x) + }, + + transform = function(self, x) { + self$trans$transform(x) + }, + + map = function(self, x, limits = self$get_limits()) { + x <- self$oob(self$rescaler(x, from = limits)) + + uniq <- unique(x) + pal <- self$palette(uniq) + scaled <- pal[match(x, uniq)] + + ifelse(!is.na(scaled), scaled, self$na.value) + }, + + dimension = function(self, expand = c(0, 0)) { + expand_range(self$get_limits(), expand[1], expand[2]) + }, + + get_breaks = function(self, limits = self$get_limits()) { + if (self$is_empty()) return(numeric()) + + # Limits in transformed space need to be converted back to data space + limits <- self$trans$inverse(limits) + + if (is.null(self$breaks)) { + return(NULL) + } else if (identical(self$breaks, NA)) { + stop("Invalid breaks specification. Use NULL, not NA") + } else if (zero_range(as.numeric(limits))) { + breaks <- limits[1] + } else if (is.waive(self$breaks)) { + breaks <- self$trans$breaks(limits) + } else if (is.function(self$breaks)) { + breaks <- self$breaks(limits) + } else { + breaks <- self$breaks + } + + # Breaks in data space need to be converted back to transformed space + # And any breaks outside the dimensions need to be flagged as missing + # + # @kohske + # TODO: replace NA with something else for flag. + # guides cannot discriminate oob from missing value. + breaks <- censor(self$trans$transform(breaks), self$trans$transform(limits), + only.finite = FALSE) + if (length(breaks) == 0) { + stop("Zero breaks in scale for ", paste(self$a_aesthetics, collapse = "/"), + call. = FALSE) + } + breaks + }, + + get_breaks_minor = function(self, n = 2, b = self$break_positions(), limits = self$get_limits()) { + if (zero_range(as.numeric(limits))) { + return() + } + + if (is.null(self$minor_breaks)) { + return(NULL) + } else if (identical(self$minor_breaks, NA)) { + stop("Invalid minor_breaks specification. Use NULL, not NA", call. = FALSE) + } else if (is.waive(self$minor_breaks)) { + if (is.null(b)) { + breaks <- NULL + } else { + b <- b[!is.na(b)] + if (length(b) < 2) return() + + bd <- diff(b)[1] + if (min(limits) < min(b)) b <- c(b[1] - bd, b) + if (max(limits) > max(b)) b <- c(b, b[length(b)] + bd) + breaks <- unique(unlist(mapply(seq, b[-length(b)], b[-1], length.out = n + 1, + SIMPLIFY = FALSE))) + } + } else if (is.function(self$minor_breaks)) { + # Find breaks in data space, and convert to numeric + breaks <- self$minor_breaks(self$trans$inverse(limits)) + breaks <- self$trans$transform(breaks) + } else { + breaks <- self$trans$transform(self$minor_breaks) + } + + # Any minor breaks outside the dimensions need to be thrown away + discard(breaks, limits) + }, + + get_labels = function(self, breaks = self$get_breaks()) { + if (is.null(breaks)) return(NULL) + + breaks <- self$trans$inverse(breaks) + + if (is.null(self$a_labels)) { + return(NULL) + } else if (identical(self$a_labels, NA)) { + stop("Invalid labels specification. Use NULL, not NA", call. = FALSE) + } else if (is.waive(self$a_labels)) { + a_labels <- self$trans$format(breaks) + } else if (is.function(self$a_labels)) { + a_labels <- self$a_labels(breaks) + } else { + a_labels <- self$a_labels + } + if (length(a_labels) != length(breaks)) { + stop("Breaks and labels are different lengths") + } + a_labels + }, + + clone = function(self) { + new <- a_ggproto(NULL, self) + new$range <- continuous_range() + new + }, + + break_info = function(self, range = NULL) { + # range + if (is.null(range)) range <- self$dimension() + + # major breaks + major <- self$get_breaks(range) + + # a_labels + a_labels <- self$get_labels(major) + + # drop oob breaks/labels by testing major == NA + if (!is.null(a_labels)) a_labels <- a_labels[!is.na(major)] + if (!is.null(major)) major <- major[!is.na(major)] + + # minor breaks + minor <- self$get_breaks_minor(b = major, limits = range) + if (!is.null(minor)) minor <- minor[!is.na(minor)] + + # rescale breaks [0, 1], which are used by coord/guide + major_n <- rescale(major, from = range) + minor_n <- rescale(minor, from = range) + + list(range = range, a_labels = a_labels, + major = major_n, minor = minor_n, + major_source = major, minor_source = minor) + }, + + print = function(self, ...) { + show_range <- function(x) paste0(formatC(x, digits = 3), collapse = " -- ") + + cat("<", class(self)[[1]], ">\n", sep = "") + cat(" Range: ", show_range(self$range$range), "\n", sep = "") + cat(" Limits: ", show_range(self$dimension()), "\n", sep = "") + } ) -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, - drop = TRUE, - na.value = NA, - - is_discrete = function() TRUE, - - train = function(self, x) { - if (length(x) == 0) return() - self$range$train(x, drop = self$drop) - }, - - transform = function(x) { - x - }, - - map = function(self, x, limits = self$get_limits()) { - n <- sum(!is.na(limits)) - pal <- self$palette(n) - - if (is.null(names(pal))) { - pal_match <- pal[match(as.character(x), limits)] - } else { - pal_match <- pal[match(as.character(x), names(pal))] - pal_match <- unname(pal_match) - } - - ifelse(is.na(x) | is.na(pal_match), self$na.value, pal_match) - }, - - dimension = function(self, expand = c(0, 0)) { - expand_range(length(self$get_limits()), expand[1], expand[2]) - }, - - get_breaks = function(self, limits = self$get_limits()) { - if (self$is_empty()) return(numeric()) - - if (is.null(self$breaks)) { - return(NULL) - } else if (identical(self$breaks, NA)) { - stop("Invalid breaks specification. Use NULL, not NA", call. = FALSE) - } else if (is.waive(self$breaks)) { - breaks <- limits - } else if (is.function(self$breaks)) { - breaks <- self$breaks(limits) - } else { - breaks <- self$breaks - } - - # Breaks can only occur only on values in domain - in_domain <- intersect(breaks, self$get_limits()) - structure(in_domain, pos = match(in_domain, breaks)) - }, - - get_breaks_minor = function(...) NULL, - - get_labels = function(self, breaks = self$get_breaks()) { - if (self$is_empty()) return(character()) - - if (is.null(breaks)) return(NULL) - - if (is.null(self$labels)) { - return(NULL) - } else if (identical(self$labels, NA)) { - stop("Invalid labels specification. Use NULL, not NA", call. = FALSE) - }else if (is.waive(self$labels)) { - format(self$get_breaks(), justify = "none", trim = TRUE) - } else if (is.function(self$labels)) { - self$labels(breaks) - } else { - if (!is.null(names(self$labels))) { - # If labels have names, use them to match with breaks - labels <- breaks - - map <- match(names(self$labels), labels, nomatch = 0) - labels[map] <- self$labels[map != 0] - labels - } else { - labels <- self$labels - - # Need to ensure that if breaks were dropped, corresponding labels are too - pos <- attr(breaks, "pos") - if (!is.null(pos)) { - labels <- labels[pos] - } - labels - } - } - }, - - clone = function(self) { - new <- ggproto(NULL, self) - new$range <- discrete_range() - new - }, - - break_info = function(self, range = NULL) { - # for discrete, limits != range - limits <- self$get_limits() - - major <- self$get_breaks(limits) - if (is.null(major)) { - labels <- major_n <- NULL - } else { - - labels <- self$get_labels(major) - - major <- self$map(major) - major <- major[!is.na(major)] - - # rescale breaks [0, 1], which are used by coord/guide - major_n <- rescale(major, from = range) - } - - list(range = range, labels = labels, - major = major_n, minor = NULL, - major_source = major, minor_source = NULL) - } +a_ScaleDiscrete <- a_ggproto("a_ScaleDiscrete", a_Scale, + drop = TRUE, + na.value = NA, + + is_discrete = function() TRUE, + + train = function(self, x) { + if (length(x) == 0) return() + self$range$train(x, drop = self$drop) + }, + + transform = function(x) { + x + }, + + map = function(self, x, limits = self$get_limits()) { + n <- sum(!is.na(limits)) + pal <- self$palette(n) + + if (is.null(names(pal))) { + pal_match <- pal[match(as.character(x), limits)] + } else { + pal_match <- pal[match(as.character(x), names(pal))] + pal_match <- unname(pal_match) + } + + ifelse(is.na(x) | is.na(pal_match), self$na.value, pal_match) + }, + + dimension = function(self, expand = c(0, 0)) { + expand_range(length(self$get_limits()), expand[1], expand[2]) + }, + + get_breaks = function(self, limits = self$get_limits()) { + if (self$is_empty()) return(numeric()) + + if (is.null(self$breaks)) { + return(NULL) + } else if (identical(self$breaks, NA)) { + stop("Invalid breaks specification. Use NULL, not NA", call. = FALSE) + } else if (is.waive(self$breaks)) { + breaks <- limits + } else if (is.function(self$breaks)) { + breaks <- self$breaks(limits) + } else { + breaks <- self$breaks + } + + # Breaks can only occur only on values in domain + in_domain <- intersect(breaks, self$get_limits()) + structure(in_domain, pos = match(in_domain, breaks)) + }, + + get_breaks_minor = function(...) NULL, + + get_labels = function(self, breaks = self$get_breaks()) { + if (self$is_empty()) return(character()) + + if (is.null(breaks)) return(NULL) + + if (is.null(self$a_labels)) { + return(NULL) + } else if (identical(self$a_labels, NA)) { + stop("Invalid labels specification. Use NULL, not NA", call. = FALSE) + }else if (is.waive(self$a_labels)) { + format(self$get_breaks(), justify = "none", trim = TRUE) + } else if (is.function(self$a_labels)) { + self$a_labels(breaks) + } else { + if (!is.null(names(self$a_labels))) { + # If labels have names, use them to match with breaks + a_labels <- breaks + + map <- match(names(self$a_labels), a_labels, nomatch = 0) + a_labels[map] <- self$a_labels[map != 0] + a_labels + } else { + a_labels <- self$a_labels + + # Need to ensure that if breaks were dropped, corresponding labels are too + pos <- attr(breaks, "pos") + if (!is.null(pos)) { + a_labels <- a_labels[pos] + } + a_labels + } + } + }, + + clone = function(self) { + new <- a_ggproto(NULL, self) + new$range <- discrete_range() + new + }, + + break_info = function(self, range = NULL) { + # for discrete, limits != range + limits <- self$get_limits() + + major <- self$get_breaks(limits) + if (is.null(major)) { + a_labels <- major_n <- NULL + } else { + + a_labels <- self$get_labels(major) + + major <- self$map(major) + major <- major[!is.na(major)] + + # rescale breaks [0, 1], which are used by coord/guide + major_n <- rescale(major, from = range) + } + + list(range = range, a_labels = a_labels, + major = major_n, minor = NULL, + major_source = major, minor_source = NULL) + } ) #' Continuous scale constructor. #' #' @export -#' @inheritParams discrete_scale +#' @inheritParams discrete_a_scale #' @param name The name of the scale. Used as axis or legend title. If #' \code{NULL}, the default, the name of the scale is taken from the first #' mapping used for that aesthetic. @@ -484,7 +484,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, #' \item A numeric vector of positions #' \item A function that given the limits returns a vector of minor breaks. #' } -#' @param labels One of: \itemize{ +#' @param a_labels One of: \itemize{ #' \item \code{NULL} for no labels #' \item \code{waiver()} for the default labels computed by the #' transformation object @@ -495,7 +495,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, #' @param limits A numeric vector of length two providing limits of the scale. #' Use \code{NA} to refer to the existing minimum or maximum. #' @param rescaler Used by diverging and n colour gradients -#' (i.e. \code{\link{scale_colour_gradient2}}, \code{\link{scale_colour_gradientn}}). +#' (i.e. \code{\link{a_scale_colour_gradient2}}, \code{\link{a_scale_colour_gradientn}}). #' A function used to scale the input values to the range [0, 1]. #' @param oob Function that handles limits outside of the scale limits #' (out of bounds). The default replaces out of bounds values with NA. @@ -515,19 +515,19 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, #' placed some distance away from the axes. The defaults are #' \code{c(0.05, 0)} for continuous variables, and \code{c(0, 0.6)} for #' discrete variables. -#' @param guide Name of guide object, or object itself. -#' @keywords internal -continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(), +#' @param a_guide Name of guide object, or object itself. +#' @export +continuous_a_scale <- function(a_aesthetics, a_scale_name, palette, name = waiver(), breaks = waiver(), minor_breaks = waiver(), - labels = waiver(), limits = NULL, + a_labels = waiver(), limits = NULL, rescaler = rescale, oob = censor, expand = waiver(), na.value = NA_real_, - trans = "identity", guide = "legend") { + trans = "identity", a_guide = "legend") { - check_breaks_labels(breaks, labels) + check_breaks_labels(breaks, a_labels) - if (is.null(breaks) && !is_position_aes(aesthetics) && guide != "none") { - guide <- "none" + if (is.null(breaks) && !is_position_aes(a_aesthetics) && a_guide != "none") { + a_guide <- "none" } trans <- as.trans(trans) @@ -535,35 +535,35 @@ continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(), limits <- trans$transform(limits) } - ggproto(NULL, ScaleContinuous, - call = match.call(), + a_ggproto(NULL, a_ScaleContinuous, + call = match.call(), - aesthetics = aesthetics, - scale_name = scale_name, - palette = palette, + a_aesthetics = a_aesthetics, + a_scale_name = a_scale_name, + palette = palette, - range = continuous_range(), - limits = limits, - trans = trans, - na.value = na.value, - expand = expand, - rescaler = rescaler, # Used by diverging and n colour gradients - oob = oob, + range = continuous_range(), + limits = limits, + trans = trans, + na.value = na.value, + expand = expand, + rescaler = rescaler, # Used by diverging and n colour gradients + oob = oob, - name = name, - breaks = breaks, - minor_breaks = minor_breaks, + name = name, + breaks = breaks, + minor_breaks = minor_breaks, - labels = labels, - guide = guide + a_labels = a_labels, + a_guide = a_guide ) } #' Discrete scale constructor. #' #' @export -#' @param aesthetics the names of the aesthetics that this scale works with -#' @param scale_name the name of the scale +#' @param a_aesthetics the names of the aesthetics that this scale works with +#' @param a_scale_name the name of the scale #' @param palette a palette function that when called with a single integer #' argument (the number of levels in the scale) returns the values that #' they should take @@ -588,7 +588,7 @@ continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(), #' @param limits A character vector specifying the data range for the scale. # The limits control what levels are displayed in the plot, their order, #' and the default order of their display in guides. -#' @param labels \code{NULL} for no labels, \code{waiver()} for default +#' @param a_labels \code{NULL} for no labels, \code{waiver()} for default #' labels (labels the same as breaks), a character vector the same length #' as breaks, or a named character vector whose names are used to match #' replacement the labels for matching breaks. @@ -597,35 +597,35 @@ continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(), #' is a small gap between the data and the axes. The defaults are (0,0.6) #' for discrete scales and (0.05,0) for continuous scales. #' @param na.value how should missing values be displayed? -#' @param guide the name of, or actual function, used to create the -#' guide. See \code{\link{guides}} for more info. -#' @keywords internal -discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), breaks = waiver(), - labels = waiver(), limits = NULL, expand = waiver(), na.value = NA, drop = TRUE, - guide = "legend") { +#' @param a_guide the name of, or actual function, used to create the +#' a_guide. See \code{\link{a_guides}} for more info. +#' @export +discrete_a_scale <- function(a_aesthetics, a_scale_name, palette, name = waiver(), breaks = waiver(), + a_labels = waiver(), limits = NULL, expand = waiver(), na.value = NA, drop = TRUE, + a_guide = "legend") { - check_breaks_labels(breaks, labels) + check_breaks_labels(breaks, a_labels) - if (is.null(breaks) && !is_position_aes(aesthetics) && guide != "none") { - guide <- "none" + if (is.null(breaks) && !is_position_aes(a_aesthetics) && a_guide != "none") { + a_guide <- "none" } - ggproto(NULL, ScaleDiscrete, - call = match.call(), + a_ggproto(NULL, a_ScaleDiscrete, + call = match.call(), - aesthetics = aesthetics, - scale_name = scale_name, - palette = palette, + a_aesthetics = a_aesthetics, + a_scale_name = a_scale_name, + palette = palette, - range = discrete_range(), - limits = limits, - na.value = na.value, - expand = expand, + range = discrete_range(), + limits = limits, + na.value = na.value, + expand = expand, - name = name, - breaks = breaks, - labels = labels, - drop = drop, - guide = guide + name = name, + breaks = breaks, + a_labels = a_labels, + drop = drop, + a_guide = a_guide ) } diff --git a/R/scale-alpha.r b/R/scale-alpha.r index 06026e4e26..cf3d639250 100644 --- a/R/scale-alpha.r +++ b/R/scale-alpha.r @@ -1,35 +1,35 @@ #' Alpha scales. #' -#' \code{scale_alpha} is an alias for \code{scale_alpha_continuous} since +#' \code{a_scale_alpha} is an alias for \code{a_scale_alpha_continuous} since #' that is the most common use of alpha, and it saves a bit of typing. #' -#' @param ... Other arguments passed on to \code{\link{continuous_scale}} -#' or \code{\link{discrete_scale}} as appropriate, to control name, limits, +#' @param ... Other arguments passed on to \code{\link{continuous_a_scale}} +#' or \code{\link{discrete_a_scale}} as appropriate, to control name, limits, #' breaks, labels and so forth. #' @param range range of output alpha values. Should lie between 0 and 1. #' @export #' @examples -#' (p <- ggplot(mtcars, aes(mpg, cyl)) + -#' geom_point(aes(alpha = cyl))) -#' p + scale_alpha("cylinders") -#' p + scale_alpha("number\nof\ncylinders") +#' (p <- a_plot(mtcars, a_aes(mpg, cyl)) + +#' a_geom_point(a_aes(alpha = cyl))) +#' p + a_scale_alpha("cylinders") +#' p + a_scale_alpha("number\nof\ncylinders") #' -#' p + scale_alpha(range = c(0.4, 0.8)) +#' p + a_scale_alpha(range = c(0.4, 0.8)) #' -#' (p <- ggplot(mtcars, aes(mpg, cyl)) + -#' geom_point(aes(alpha = factor(cyl)))) -#' p + scale_alpha_discrete(range = c(0.4, 0.8)) -scale_alpha <- function(..., range = c(0.1, 1)) { - continuous_scale("alpha", "alpha_c", rescale_pal(range), ...) +#' (p <- a_plot(mtcars, a_aes(mpg, cyl)) + +#' a_geom_point(a_aes(alpha = factor(cyl)))) +#' p + a_scale_alpha_discrete(range = c(0.4, 0.8)) +a_scale_alpha <- function(..., range = c(0.1, 1)) { + continuous_a_scale("alpha", "alpha_c", rescale_pal(range), ...) } -#' @rdname scale_alpha +#' @rdname a_scale_alpha #' @export -scale_alpha_continuous <- scale_alpha +a_scale_alpha_continuous <- a_scale_alpha -#' @rdname scale_alpha +#' @rdname a_scale_alpha #' @export -scale_alpha_discrete <- function(..., range = c(0.1, 1)) { - discrete_scale("alpha", "alpha_d", +a_scale_alpha_discrete <- function(..., range = c(0.1, 1)) { + discrete_a_scale("alpha", "alpha_d", function(n) seq(range[1], range[2], length.out = n), ...) } diff --git a/R/scale-brewer.r b/R/scale-brewer.r index 70d5b90084..ae6aa05434 100644 --- a/R/scale-brewer.r +++ b/R/scale-brewer.r @@ -20,78 +20,78 @@ #' } #' #' @inheritParams scales::brewer_pal -#' @inheritParams scale_colour_hue -#' @inheritParams scale_colour_gradient +#' @inheritParams a_scale_colour_hue +#' @inheritParams a_scale_colour_gradient #' @inheritParams scales::gradient_n_pal #' @seealso Other colour scales: -#' \code{\link{scale_colour_gradient}}, -#' \code{\link{scale_colour_grey}}, -#' \code{\link{scale_colour_hue}} -#' @rdname scale_brewer +#' \code{\link{a_scale_colour_gradient}}, +#' \code{\link{a_scale_colour_grey}}, +#' \code{\link{a_scale_colour_hue}} +#' @rdname a_scale_brewer #' @export #' @examples #' dsamp <- diamonds[sample(nrow(diamonds), 1000), ] -#' (d <- ggplot(dsamp, aes(carat, price)) + -#' geom_point(aes(colour = clarity))) +#' (d <- a_plot(dsamp, a_aes(carat, price)) + +#' a_geom_point(a_aes(colour = clarity))) #' #' # Change scale label -#' d + scale_colour_brewer() -#' d + scale_colour_brewer("Diamond\nclarity") +#' d + a_scale_colour_brewer() +#' d + a_scale_colour_brewer("Diamond\nclarity") #' #' # Select brewer palette to use, see ?scales::brewer_pal for more details -#' d + scale_colour_brewer(palette = "Greens") -#' d + scale_colour_brewer(palette = "Set1") +#' d + a_scale_colour_brewer(palette = "Greens") +#' d + a_scale_colour_brewer(palette = "Set1") #' #' \donttest{ -#' # scale_fill_brewer works just the same as -#' # scale_colour_brewer but for fill colours -#' p <- ggplot(diamonds, aes(x = price, fill = cut)) + -#' geom_histogram(position = "dodge", binwidth = 1000) -#' p + scale_fill_brewer() +#' # a_scale_fill_brewer works just the same as +#' # a_scale_colour_brewer but for fill colours +#' p <- a_plot(diamonds, a_aes(x = price, fill = cut)) + +#' a_geom_histogram(a_position = "dodge", binwidth = 1000) +#' p + a_scale_fill_brewer() #' # the order of colour can be reversed -#' p + scale_fill_brewer(direction = -1) +#' p + a_scale_fill_brewer(direction = -1) #' # the brewer scales look better on a darker background -#' p + scale_fill_brewer(direction = -1) + theme_dark() +#' p + a_scale_fill_brewer(direction = -1) + a_theme_dark() #' } #' #' # Use distiller variant with continous data -#' v <- ggplot(faithfuld) + -#' geom_tile(aes(waiting, eruptions, fill = density)) +#' v <- a_plot(faithfuld) + +#' a_geom_tile(a_aes(waiting, eruptions, fill = density)) #' v -#' v + scale_fill_distiller() -#' v + scale_fill_distiller(palette = "Spectral") -scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1) { - discrete_scale("colour", "brewer", brewer_pal(type, palette, direction), ...) +#' v + a_scale_fill_distiller() +#' v + a_scale_fill_distiller(palette = "Spectral") +a_scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1) { + discrete_a_scale("colour", "brewer", brewer_pal(type, palette, direction), ...) } #' @export -#' @rdname scale_brewer -scale_fill_brewer <- function(..., type = "seq", palette = 1, direction = 1) { - discrete_scale("fill", "brewer", brewer_pal(type, palette, direction), ...) +#' @rdname a_scale_brewer +a_scale_fill_brewer <- function(..., type = "seq", palette = 1, direction = 1) { + discrete_a_scale("fill", "brewer", brewer_pal(type, palette, direction), ...) } #' @export -#' @rdname scale_brewer -scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar") { +#' @rdname a_scale_brewer +a_scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", a_guide = "colourbar") { # warn about using a qualitative brewer palette to generate the gradient type <- match.arg(type, c("seq", "div", "qual")) if (type == "qual") { - warning("Using a discrete colour palette in a continuous scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) + warning("Using a discrete colour palette in a continuous a_scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) } - continuous_scale("colour", "distiller", - gradient_n_pal(brewer_pal(type, palette, direction)(6), values, space), na.value = na.value, guide = guide, ...) + continuous_a_scale("colour", "distiller", + gradient_n_pal(brewer_pal(type, palette, direction)(6), values, space), na.value = na.value, a_guide = a_guide, ...) # NB: 6 colours per palette gives nice gradients; more results in more saturated colours which do not look as good } #' @export -#' @rdname scale_brewer -scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar") { +#' @rdname a_scale_brewer +a_scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", a_guide = "colourbar") { type <- match.arg(type, c("seq", "div", "qual")) if (type == "qual") { - warning("Using a discrete colour palette in a continuous scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) + warning("Using a discrete colour palette in a continuous a_scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) } - continuous_scale("fill", "distiller", - gradient_n_pal(brewer_pal(type, palette, direction)(6), values, space), na.value = na.value, guide = guide, ...) + continuous_a_scale("fill", "distiller", + gradient_n_pal(brewer_pal(type, palette, direction)(6), values, space), na.value = na.value, a_guide = a_guide, ...) } # icon.brewer <- function() { diff --git a/R/scale-continuous.r b/R/scale-continuous.r index 56714284b4..6bbbd01dd7 100644 --- a/R/scale-continuous.r +++ b/R/scale-continuous.r @@ -1,29 +1,29 @@ #' Continuous position scales (x & y). #' -#' \code{scale_x_continuous} and \code{scale_y_continuous} are the key functions. -#' The others, \code{scale_x_log10}, \code{scale_y_sqrt} etc, are aliases +#' \code{a_scale_x_continuous} and \code{a_scale_y_continuous} are the key functions. +#' The others, \code{a_scale_x_log10}, \code{a_scale_y_sqrt} etc, are aliases #' that set the \code{trans} argument to commonly used transformations. #' -#' @inheritParams continuous_scale -#' @seealso \code{\link{scale_date}} for date/time position scales. -#' @param ... Other arguments passed on to \code{scale_(x|y)_continuous} +#' @inheritParams continuous_a_scale +#' @seealso \code{\link{a_scale_date}} for date/time position scales. +#' @param ... Other arguments passed on to \code{a_scale_(x|y)_continuous} #' @examples #' \donttest{ #' if (require(ggplot2movies)) { -#' m <- ggplot(subset(movies, votes > 1000), aes(rating, votes)) + -#' geom_point(na.rm = TRUE) +#' m <- a_plot(subset(movies, votes > 1000), a_aes(rating, votes)) + +#' a_geom_point(na.rm = TRUE) #' m #' #' # Manipulating the default position scales lets you: #' #' # * change the axis labels -#' m + scale_y_continuous("number of votes") -#' m + scale_y_continuous(quote(votes ^ alpha)) +#' m + a_scale_y_continuous("number of votes") +#' m + a_scale_y_continuous(quote(votes ^ alpha)) #' #' # * modify the axis limits -#' m + scale_y_continuous(limits = c(0, 5000)) -#' m + scale_y_continuous(limits = c(1000, 10000)) -#' m + scale_x_continuous(limits = c(7, 8)) +#' m + a_scale_y_continuous(limits = c(0, 5000)) +#' m + a_scale_y_continuous(limits = c(1000, 10000)) +#' m + a_scale_x_continuous(limits = c(7, 8)) #' #' # you can also use the short hand functions xlim and ylim #' m + ylim(0, 5000) @@ -31,18 +31,18 @@ #' m + xlim(7, 8) #' #' # * choose where the ticks appear -#' m + scale_x_continuous(breaks = 1:10) -#' m + scale_x_continuous(breaks = c(1,3,7,9)) +#' m + a_scale_x_continuous(breaks = 1:10) +#' m + a_scale_x_continuous(breaks = c(1,3,7,9)) #' #' # * manually label the ticks -#' m + scale_x_continuous(breaks = c(2,5,8), labels = c("two", "five", "eight")) -#' m + scale_x_continuous(breaks = c(2,5,8), labels = c("horrible", "ok", "awesome")) -#' m + scale_x_continuous(breaks = c(2,5,8), labels = expression(Alpha, Beta, Omega)) +#' m + a_scale_x_continuous(breaks = c(2,5,8), a_labels = c("two", "five", "eight")) +#' m + a_scale_x_continuous(breaks = c(2,5,8), a_labels = c("horrible", "ok", "awesome")) +#' m + a_scale_x_continuous(breaks = c(2,5,8), a_labels = expression(Alpha, Beta, Omega)) #' #' # There are a few built in transformation that you can use: -#' m + scale_y_log10() -#' m + scale_y_sqrt() -#' m + scale_y_reverse() +#' m + a_scale_y_log10() +#' m + a_scale_y_sqrt() +#' m + a_scale_y_reverse() #' # You can also create your own and supply them to the trans argument. #' # See ?scales::trans_new #' @@ -52,117 +52,117 @@ #' x = rnorm(10) * 100000, #' y = seq(0, 1, length.out = 10) #' ) -#' p <- ggplot(df, aes(x, y)) + geom_point() -#' p + scale_y_continuous(labels = scales::percent) -#' p + scale_y_continuous(labels = scales::dollar) -#' p + scale_x_continuous(labels = scales::comma) +#' p <- a_plot(df, a_aes(x, y)) + a_geom_point() +#' p + a_scale_y_continuous(a_labels = scales::percent) +#' p + a_scale_y_continuous(a_labels = scales::dollar) +#' p + a_scale_x_continuous(a_labels = scales::comma) #' #' # Other shortcut functions -#' ggplot(movies, aes(rating, votes)) + -#' geom_point() + +#' a_plot(movies, a_aes(rating, votes)) + +#' a_geom_point() + #' ylim(1e4, 5e4) #' # * axis labels -#' ggplot(movies, aes(rating, votes)) + -#' geom_point() + +#' a_plot(movies, a_aes(rating, votes)) + +#' a_geom_point() + #' labs(x = "My x axis", y = "My y axis") #' # * log scaling -#' ggplot(movies, aes(rating, votes)) + -#' geom_point() + -#' scale_x_log10() + -#' scale_y_log10() +#' a_plot(movies, a_aes(rating, votes)) + +#' a_geom_point() + +#' a_scale_x_log10() + +#' a_scale_y_log10() #' } #' } -#' @name scale_continuous +#' @name a_scale_continuous NULL -#' @rdname scale_continuous +#' @rdname a_scale_continuous #' @export -scale_x_continuous <- function(name = waiver(), breaks = waiver(), - minor_breaks = waiver(), labels = waiver(), +a_scale_x_continuous <- function(name = waiver(), breaks = waiver(), + minor_breaks = waiver(), a_labels = waiver(), limits = NULL, expand = waiver(), oob = censor, na.value = NA_real_, trans = "identity") { - sc <- continuous_scale( + sc <- continuous_a_scale( c("x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper"), "position_c", identity, name = name, breaks = breaks, - minor_breaks = minor_breaks, labels = labels, limits = limits, + minor_breaks = minor_breaks, a_labels = a_labels, limits = limits, expand = expand, oob = oob, na.value = na.value, trans = trans, - guide = "none" + a_guide = "none" ) # TODO: Fix this hack. We're reassigning the parent ggproto object, but this # object should in the first place be created with the correct parent. - sc$super <- ScaleContinuousPosition - class(sc) <- class(ScaleContinuousPosition) + sc$super <- a_ScaleContinuousPosition + class(sc) <- class(a_ScaleContinuousPosition) sc } -#' @rdname scale_continuous +#' @rdname a_scale_continuous #' @export -scale_y_continuous <- function(name = waiver(), breaks = waiver(), - minor_breaks = waiver(), labels = waiver(), +a_scale_y_continuous <- function(name = waiver(), breaks = waiver(), + minor_breaks = waiver(), a_labels = waiver(), limits = NULL, expand = waiver(), oob = censor, na.value = NA_real_, trans = "identity") { - sc <- continuous_scale( + sc <- continuous_a_scale( c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final", "lower", "middle", "upper"), "position_c", identity, name = name, breaks = breaks, - minor_breaks = minor_breaks, labels = labels, limits = limits, + minor_breaks = minor_breaks, a_labels = a_labels, limits = limits, expand = expand, oob = oob, na.value = na.value, trans = trans, - guide = "none" + a_guide = "none" ) # TODO: Fix this hack. We're reassigning the parent ggproto object, but this # object should in the first place be created with the correct parent. - sc$super <- ScaleContinuousPosition - class(sc) <- class(ScaleContinuousPosition) + sc$super <- a_ScaleContinuousPosition + class(sc) <- class(a_ScaleContinuousPosition) sc } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -ScaleContinuousPosition <- ggproto("ScaleContinuousPosition", ScaleContinuous, - # Position aesthetics don't map, because the coordinate system takes - # care of it. But they do need to be made in to doubles, so stat methods - # can tell the difference between continuous and discrete data. - map = function(self, x, limits = self$get_limits()) { - scaled <- as.numeric(self$oob(x, limits)) - ifelse(!is.na(scaled), scaled, self$na.value) - } +a_ScaleContinuousPosition <- a_ggproto("a_ScaleContinuousPosition", a_ScaleContinuous, + # Position aesthetics don't map, because the coordinate system takes + # care of it. But they do need to be made in to doubles, so stat methods + # can tell the difference between continuous and discrete data. + map = function(self, x, limits = self$get_limits()) { + scaled <- as.numeric(self$oob(x, limits)) + ifelse(!is.na(scaled), scaled, self$na.value) + } ) # Transformed scales --------------------------------------------------------- -#' @rdname scale_continuous +#' @rdname a_scale_continuous #' @export -scale_x_log10 <- function(...) { - scale_x_continuous(..., trans = log10_trans()) +a_scale_x_log10 <- function(...) { + a_scale_x_continuous(..., trans = log10_trans()) } -#' @rdname scale_continuous +#' @rdname a_scale_continuous #' @export -scale_y_log10 <- function(...) { - scale_y_continuous(..., trans = log10_trans()) +a_scale_y_log10 <- function(...) { + a_scale_y_continuous(..., trans = log10_trans()) } -#' @rdname scale_continuous +#' @rdname a_scale_continuous #' @export -scale_x_reverse <- function(...) { - scale_x_continuous(..., trans = reverse_trans()) +a_scale_x_reverse <- function(...) { + a_scale_x_continuous(..., trans = reverse_trans()) } -#' @rdname scale_continuous +#' @rdname a_scale_continuous #' @export -scale_y_reverse <- function(...) { - scale_y_continuous(..., trans = reverse_trans()) +a_scale_y_reverse <- function(...) { + a_scale_y_continuous(..., trans = reverse_trans()) } -#' @rdname scale_continuous +#' @rdname a_scale_continuous #' @export -scale_x_sqrt <- function(...) { - scale_x_continuous(..., trans = sqrt_trans()) +a_scale_x_sqrt <- function(...) { + a_scale_x_continuous(..., trans = sqrt_trans()) } -#' @rdname scale_continuous +#' @rdname a_scale_continuous #' @export -scale_y_sqrt <- function(...) { - scale_y_continuous(..., trans = sqrt_trans()) +a_scale_y_sqrt <- function(...) { + a_scale_y_continuous(..., trans = sqrt_trans()) } diff --git a/R/scale-date.r b/R/scale-date.r index a437adf219..288f26dd25 100644 --- a/R/scale-date.r +++ b/R/scale-date.r @@ -1,10 +1,10 @@ #' Position scale, date & date times #' -#' Use \code{scale_*_date} with \code{Date} variables, and -#' \code{scale_*_datetime} with \code{POSIXct} variables. +#' Use \code{a_scale_*_date} with \code{Date} variables, and +#' \code{a_scale_*_datetime} with \code{POSIXct} variables. #' -#' @name scale_date -#' @inheritParams continuous_scale +#' @name a_scale_date +#' @inheritParams continuous_a_scale #' @param date_breaks A string giving the distance between breaks like "2 #' weeks", or "10 years". If both \code{breaks} and \code{date_breaks} are #' specified, \code{date_breaks} wins. @@ -12,102 +12,102 @@ #' like "2 weeks", or "10 years". If both \code{minor_breaks} and #' \code{date_minor_breaks} are specified, \code{date_minor_breaks} wins. #' @param date_labels A string giving the formatting specification for the -#' labels. Codes are defined in \code{\link{strftime}}. If both \code{labels} +#' labels. Codes are defined in \code{\link{strftime}}. If both \code{a_labels} #' and \code{date_labels} are specified, \code{date_labels} wins. -#' @seealso \code{\link{scale_continuous}} for continuous position scales. +#' @seealso \code{\link{a_scale_continuous}} for continuous position scales. #' @examples #' last_month <- Sys.Date() - 0:29 #' df <- data.frame( #' date = last_month, #' price = runif(30) #' ) -#' base <- ggplot(df, aes(date, price)) + -#' geom_line() +#' base <- a_plot(df, a_aes(date, price)) + +#' a_geom_line() #' #' # The date scale will attempt to pick sensible defaults for #' # major and minor tick marks. Override with date_breaks, date_labels #' # date_minor_breaks arguments. -#' base + scale_x_date(date_labels = "%b %d") -#' base + scale_x_date(date_breaks = "1 week", date_labels = "%W") -#' base + scale_x_date(date_minor_breaks = "1 day") +#' base + a_scale_x_date(date_labels = "%b %d") +#' base + a_scale_x_date(date_breaks = "1 week", date_labels = "%W") +#' base + a_scale_x_date(date_minor_breaks = "1 day") #' #' # Set limits -#' base + scale_x_date(limits = c(Sys.Date() - 7, NA)) +#' base + a_scale_x_date(limits = c(Sys.Date() - 7, NA)) NULL -#' @rdname scale_date +#' @rdname a_scale_date #' @export -scale_x_date <- function(name = waiver(), +a_scale_x_date <- function(name = waiver(), breaks = waiver(), date_breaks = waiver(), - labels = waiver(), date_labels = waiver(), + a_labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), limits = NULL, expand = waiver()) { - scale_datetime(c("x", "xmin", "xmax", "xend"), "date", - name = name, - breaks = breaks, date_breaks = date_breaks, - labels = labels, date_labels = date_labels, - minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, - limits = limits, expand = expand + a_scale_datetime(c("x", "xmin", "xmax", "xend"), "date", + name = name, + breaks = breaks, date_breaks = date_breaks, + a_labels = a_labels, date_labels = date_labels, + minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, + limits = limits, expand = expand ) } -#' @rdname scale_date +#' @rdname a_scale_date #' @export -scale_y_date <- function(name = waiver(), +a_scale_y_date <- function(name = waiver(), breaks = waiver(), date_breaks = waiver(), - labels = waiver(), date_labels = waiver(), + a_labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), limits = NULL, expand = waiver()) { - scale_datetime(c("y", "ymin", "ymax", "yend"), "date", - name = name, - breaks = breaks, date_breaks = date_breaks, - labels = labels, date_labels = date_labels, - minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, - limits = limits, expand = expand + a_scale_datetime(c("y", "ymin", "ymax", "yend"), "date", + name = name, + breaks = breaks, date_breaks = date_breaks, + a_labels = a_labels, date_labels = date_labels, + minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, + limits = limits, expand = expand ) } #' @export -#' @rdname scale_date -scale_x_datetime <- function(name = waiver(), +#' @rdname a_scale_date +a_scale_x_datetime <- function(name = waiver(), breaks = waiver(), date_breaks = waiver(), - labels = waiver(), date_labels = waiver(), + a_labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), limits = NULL, expand = waiver()) { - scale_datetime(c("x", "xmin", "xmax", "xend"), "time", - name = name, - breaks = breaks, date_breaks = date_breaks, - labels = labels, date_labels = date_labels, - minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, - limits = limits, expand = expand + a_scale_datetime(c("x", "xmin", "xmax", "xend"), "time", + name = name, + breaks = breaks, date_breaks = date_breaks, + a_labels = a_labels, date_labels = date_labels, + minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, + limits = limits, expand = expand ) } -#' @rdname scale_date +#' @rdname a_scale_date #' @export -scale_y_datetime <- function(name = waiver(), +a_scale_y_datetime <- function(name = waiver(), breaks = waiver(), date_breaks = waiver(), - labels = waiver(), date_labels = waiver(), + a_labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), limits = NULL, expand = waiver()) { - scale_datetime(c("y", "ymin", "ymax", "yend"), "time", - name = name, - breaks = breaks, date_breaks = date_breaks, - labels = labels, date_labels = date_labels, - minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, - limits = limits, expand = expand + a_scale_datetime(c("y", "ymin", "ymax", "yend"), "time", + name = name, + breaks = breaks, date_breaks = date_breaks, + a_labels = a_labels, date_labels = date_labels, + minor_breaks = minor_breaks, date_minor_breaks = date_minor_breaks, + limits = limits, expand = expand ) } -scale_datetime <- function(aesthetics, trans, +a_scale_datetime <- function(a_aesthetics, trans, breaks = pretty_breaks(), minor_breaks = waiver(), - labels = waiver(), date_breaks = waiver(), + a_labels = waiver(), date_breaks = waiver(), date_labels = waiver(), date_minor_breaks = waiver(), ...) { @@ -125,38 +125,38 @@ scale_datetime <- function(aesthetics, trans, minor_breaks <- date_breaks(date_minor_breaks) } if (!is.waive(date_labels)) { - labels <- date_format(date_labels) + a_labels <- date_format(date_labels) } - sc <- continuous_scale(aesthetics, name, identity, - breaks = breaks, minor_breaks = minor_breaks, labels = labels, - guide = "none", trans = trans, ...) + sc <- continuous_a_scale(a_aesthetics, name, identity, + breaks = breaks, minor_breaks = minor_breaks, a_labels = a_labels, + a_guide = "none", trans = trans, ...) - # TODO: Fix this hack. We're reassigning the parent ggproto object, but this + # TODO: Fix this hack. We're reassigning the parent a_ggproto object, but this # object should in the first place be created with the correct parent. - scale_class <- switch(trans, date = ScaleContinuousDate, time = ScaleContinuousDatetime) - sc$super <- scale_class - class(sc) <- class(scale_class) + a_scale_class <- switch(trans, date = a_ScaleContinuousDate, time = a_ScaleContinuousDatetime) + sc$super <- a_scale_class + class(sc) <- class(a_scale_class) sc } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous, - map = function(self, x, limits = self$get_limits()) { - self$oob(x, limits) - } +a_ScaleContinuousDatetime <- a_ggproto("a_ScaleContinuousDatetime", a_ScaleContinuous, + map = function(self, x, limits = self$get_limits()) { + self$oob(x, limits) + } ) -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -ScaleContinuousDate <- ggproto("ScaleContinuousDate", ScaleContinuous, - map = function(self, x, limits = self$get_limits()) { - self$oob(x, limits) - } +a_ScaleContinuousDate <- a_ggproto("a_ScaleContinuousDate", a_ScaleContinuous, + map = function(self, x, limits = self$get_limits()) { + self$oob(x, limits) + } ) diff --git a/R/scale-discrete-.r b/R/scale-discrete-.r index 8e8096282a..306c2efd74 100644 --- a/R/scale-discrete-.r +++ b/R/scale-discrete-.r @@ -7,67 +7,67 @@ #' at integer positions). This is what allows jittering to work. #' #' @param ... common discrete scale parameters: \code{name}, \code{breaks}, -#' \code{labels}, \code{na.value}, \code{limits} and \code{guide}. See -#' \code{\link{discrete_scale}} for more details +#' \code{a_labels}, \code{na.value}, \code{limits} and \code{a_guide}. See +#' \code{\link{discrete_a_scale}} for more details #' @param expand a numeric vector of length two giving multiplicative and #' additive expansion constants. These constants ensure that the data is #' placed some distance away from the axes. -#' @rdname scale_discrete +#' @rdname a_scale_discrete #' @export #' @examples -#' ggplot(diamonds, aes(cut)) + geom_bar() +#' a_plot(diamonds, a_aes(cut)) + a_geom_bar() #' #' \donttest{ #' # The discrete position scale is added automatically whenever you #' # have a discrete position. #' -#' (d <- ggplot(subset(diamonds, carat > 1), aes(cut, clarity)) + -#' geom_jitter()) +#' (d <- a_plot(subset(diamonds, carat > 1), a_aes(cut, clarity)) + +#' a_geom_jitter()) #' -#' d + scale_x_discrete("Cut") -#' d + scale_x_discrete("Cut", labels = c("Fair" = "F","Good" = "G", +#' d + a_scale_x_discrete("Cut") +#' d + a_scale_x_discrete("Cut", a_labels = c("Fair" = "F","Good" = "G", #' "Very Good" = "VG","Perfect" = "P","Ideal" = "I")) #' #' # Use limits to adjust the which levels (and in what order) #' # are displayed -#' d + scale_x_discrete(limits = c("Fair","Ideal")) +#' d + a_scale_x_discrete(limits = c("Fair","Ideal")) #' #' # you can also use the short hand functions xlim and ylim #' d + xlim("Fair","Ideal", "Good") #' d + ylim("I1", "IF") #' #' # See ?reorder to reorder based on the values of another variable -#' ggplot(mpg, aes(manufacturer, cty)) + geom_point() -#' ggplot(mpg, aes(reorder(manufacturer, cty), cty)) + geom_point() -#' ggplot(mpg, aes(reorder(manufacturer, displ), cty)) + geom_point() +#' a_plot(mpg, a_aes(manufacturer, cty)) + a_geom_point() +#' a_plot(mpg, a_aes(reorder(manufacturer, cty), cty)) + a_geom_point() +#' a_plot(mpg, a_aes(reorder(manufacturer, displ), cty)) + a_geom_point() #' #' # Use abbreviate as a formatter to reduce long names -#' ggplot(mpg, aes(reorder(manufacturer, displ), cty)) + -#' geom_point() + -#' scale_x_discrete(labels = abbreviate) +#' a_plot(mpg, a_aes(reorder(manufacturer, displ), cty)) + +#' a_geom_point() + +#' a_scale_x_discrete(a_labels = abbreviate) #' } -scale_x_discrete <- function(..., expand = waiver()) { - sc <- discrete_scale(c("x", "xmin", "xmax", "xend"), "position_d", identity, ..., - expand = expand, guide = "none") +a_scale_x_discrete <- function(..., expand = waiver()) { + sc <- discrete_a_scale(c("x", "xmin", "xmax", "xend"), "position_d", identity, ..., + expand = expand, a_guide = "none") - # TODO: Fix this hack. We're reassigning the parent ggproto object, but this + # TODO: Fix this hack. We're reassigning the parent a_ggproto object, but this # object should in the first place be created with the correct parent. - sc$super <- ScaleDiscretePosition - class(sc) <- class(ScaleDiscretePosition) + sc$super <- a_ScaleDiscretePosition + class(sc) <- class(a_ScaleDiscretePosition) sc$range_c <- continuous_range() sc } -#' @rdname scale_discrete +#' @rdname a_scale_discrete #' @export -scale_y_discrete <- function(..., expand = waiver()) { - sc <- discrete_scale(c("y", "ymin", "ymax", "yend"), "position_d", identity, ..., - expand = expand, guide = "none") +a_scale_y_discrete <- function(..., expand = waiver()) { + sc <- discrete_a_scale(c("y", "ymin", "ymax", "yend"), "position_d", identity, ..., + expand = expand, a_guide = "none") - # TODO: Fix this hack. We're reassigning the parent ggproto object, but this + # TODO: Fix this hack. We're reassigning the parent a_ggproto object, but this # object should in the first place be created with the correct parent. - sc$super <- ScaleDiscretePosition - class(sc) <- class(ScaleDiscretePosition) + sc$super <- a_ScaleDiscretePosition + class(sc) <- class(a_ScaleDiscretePosition) sc$range_c <- continuous_range() sc @@ -78,64 +78,64 @@ scale_y_discrete <- function(..., expand = waiver()) { # mapping, but makes it possible to place objects at non-integer positions, # as is necessary for jittering etc. -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -ScaleDiscretePosition <- ggproto("ScaleDiscretePosition", ScaleDiscrete, +a_ScaleDiscretePosition <- a_ggproto("a_ScaleDiscretePosition", a_ScaleDiscrete, - train = function(self, x) { - if (is.discrete(x)) { - self$range$train(x, drop = self$drop) - } else { - self$range_c$train(x) - } - }, + train = function(self, x) { + if (is.discrete(x)) { + self$range$train(x, drop = self$drop) + } else { + self$range_c$train(x) + } + }, - get_limits = function(self) { - if (self$is_empty()) return(c(0, 1)) - self$limits %||% self$range$range %||% integer() - }, + get_limits = function(self) { + if (self$is_empty()) return(c(0, 1)) + self$limits %||% self$range$range %||% integer() + }, - is_empty = function(self) { - is.null(self$range$range) && is.null(self$limits) && is.null(self$range_c$range) - }, + is_empty = function(self) { + is.null(self$range$range) && is.null(self$limits) && is.null(self$range_c$range) + }, - reset = function(self) { - # Can't reset discrete scale because no way to recover values - self$range_c$reset() - }, + reset = function(self) { + # Can't reset discrete scale because no way to recover values + self$range_c$reset() + }, - map = function(self, x, limits = self$get_limits()) { - if (is.discrete(x)) { - seq_along(limits)[match(as.character(x), limits)] - } else { - x - } - }, + map = function(self, x, limits = self$get_limits()) { + if (is.discrete(x)) { + seq_along(limits)[match(as.character(x), limits)] + } else { + x + } + }, - dimension = function(self, expand = c(0, 0)) { - c_range <- self$range_c$range - d_range <- self$range$range + dimension = function(self, expand = c(0, 0)) { + c_range <- self$range_c$range + d_range <- self$range$range - if (self$is_empty()) { - c(0, 1) - } else if (is.null(d_range)) { # only continuous - expand_range(c_range, expand[1], 0 , 1) - } else if (is.null(c_range)) { # only discrete - expand_range(c(1, length(d_range)), 0, expand[2], 1) - } else { # both - range( - expand_range(c_range, expand[1], 0 , 1), - expand_range(c(1, length(d_range)), 0, expand[2], 1) - ) - } - }, + if (self$is_empty()) { + c(0, 1) + } else if (is.null(d_range)) { # only continuous + expand_range(c_range, expand[1], 0 , 1) + } else if (is.null(c_range)) { # only discrete + expand_range(c(1, length(d_range)), 0, expand[2], 1) + } else { # both + range( + expand_range(c_range, expand[1], 0 , 1), + expand_range(c(1, length(d_range)), 0, expand[2], 1) + ) + } + }, - clone = function(self) { - new <- ggproto(NULL, self) - new$range <- discrete_range() - new$range_c <- continuous_range() - new - } + clone = function(self) { + new <- a_ggproto(NULL, self) + new$range <- discrete_range() + new$range_c <- continuous_range() + new + } ) diff --git a/R/scale-gradient.r b/R/scale-gradient.r index ad57695652..43d7f0df1e 100644 --- a/R/scale-gradient.r +++ b/R/scale-gradient.r @@ -1,8 +1,8 @@ #' Smooth gradient between two colours #' -#' \code{scale_*_gradient} creates a two colour gradient (low-high), -#' \code{scale_*_gradient2} creates a diverging colour gradient (low-mid-high), -#' \code{scale_*_gradientn} creats a n-colour gradient. +#' \code{a_scale_*_gradient} creates a two colour gradient (low-high), +#' \code{a_scale_*_gradient2} creates a diverging colour gradient (low-mid-high), +#' \code{a_scale_*_gradientn} creats a n-colour gradient. #' #' Default colours are generated with \pkg{munsell} and #' \code{mnsl(c("2.5PB 2/4", "2.5PB 7/10")}. Generally, for continuous @@ -11,17 +11,17 @@ #' Munsell colour system. #' #' @inheritParams scales::seq_gradient_pal -#' @inheritParams scale_colour_hue +#' @inheritParams a_scale_colour_hue #' @param low,high Colours for low and high ends of the gradient. -#' @param guide Type of legend. Use \code{"colourbar"} for continuous +#' @param a_guide Type of legend. Use \code{"colourbar"} for continuous #' colour bar, or \code{"legend"} for discrete colour legend. #' @seealso \code{\link[scales]{seq_gradient_pal}} for details on underlying #' palette #' @seealso Other colour scales: -#' \code{\link{scale_colour_brewer}}, -#' \code{\link{scale_colour_grey}}, -#' \code{\link{scale_colour_hue}} -#' @rdname scale_gradient +#' \code{\link{a_scale_colour_brewer}}, +#' \code{\link{a_scale_colour_grey}}, +#' \code{\link{a_scale_colour_hue}} +#' @rdname a_scale_gradient #' @export #' @examples #' df <- data.frame( @@ -32,58 +32,58 @@ #' ) #' #' # Default colour scale colours from light blue to dark blue -#' ggplot(df, aes(x, y)) + -#' geom_point(aes(colour = z2)) +#' a_plot(df, a_aes(x, y)) + +#' a_geom_point(a_aes(colour = z2)) #' #' # For diverging colour scales use gradient2 -#' ggplot(df, aes(x, y)) + -#' geom_point(aes(colour = z1)) + -#' scale_colour_gradient2() +#' a_plot(df, a_aes(x, y)) + +#' a_geom_point(a_aes(colour = z1)) + +#' a_scale_colour_gradient2() #' #' # Use your own colour scale with gradientn -#' ggplot(df, aes(x, y)) + -#' geom_point(aes(colour = z1)) + -#' scale_colour_gradientn(colours = terrain.colors(10)) +#' a_plot(df, a_aes(x, y)) + +#' a_geom_point(a_aes(colour = z1)) + +#' a_scale_colour_gradientn(colours = terrain.colors(10)) #' -#' # Equivalent fill scales do the same job for the fill aesthetic -#' ggplot(faithfuld, aes(waiting, eruptions)) + -#' geom_raster(aes(fill = density)) + -#' scale_fill_gradientn(colours = terrain.colors(10)) +#' # Equivalent fill scales do the same job for the fill a_aesthetic +#' a_plot(faithfuld, a_aes(waiting, eruptions)) + +#' a_geom_raster(a_aes(fill = density)) + +#' a_scale_fill_gradientn(colours = terrain.colors(10)) #' #' # Adjust colour choices with low and high -#' ggplot(df, aes(x, y)) + -#' geom_point(aes(colour = z2)) + -#' scale_colour_gradient(low = "white", high = "black") +#' a_plot(df, a_aes(x, y)) + +#' a_geom_point(a_aes(colour = z2)) + +#' a_scale_colour_gradient(low = "white", high = "black") #' # Avoid red-green colour contrasts because ~10% of men have difficulty #' # seeing them -scale_colour_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "colourbar") { - continuous_scale("colour", "gradient", seq_gradient_pal(low, high, space), - na.value = na.value, guide = guide, ...) +a_scale_colour_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", a_guide = "colourbar") { + continuous_a_scale("colour", "gradient", seq_gradient_pal(low, high, space), + na.value = na.value, a_guide = a_guide, ...) } -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @export -scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "colourbar") { - continuous_scale("fill", "gradient", seq_gradient_pal(low, high, space), - na.value = na.value, guide = guide, ...) +a_scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", a_guide = "colourbar") { + continuous_a_scale("fill", "gradient", seq_gradient_pal(low, high, space), + na.value = na.value, a_guide = a_guide, ...) } #' @inheritParams scales::div_gradient_pal #' @param midpoint The midpoint (in data value) of the diverging scale. #' Defaults to 0. -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @export -scale_colour_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), midpoint = 0, space = "Lab", na.value = "grey50", guide = "colourbar") { - continuous_scale("colour", "gradient2", - div_gradient_pal(low, mid, high, space), na.value = na.value, guide = guide, ..., +a_scale_colour_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), midpoint = 0, space = "Lab", na.value = "grey50", a_guide = "colourbar") { + continuous_a_scale("colour", "gradient2", + div_gradient_pal(low, mid, high, space), na.value = na.value, a_guide = a_guide, ..., rescaler = mid_rescaler(mid = midpoint)) } -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @export -scale_fill_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), midpoint = 0, space = "Lab", na.value = "grey50", guide = "colourbar") { - continuous_scale("fill", "gradient2", - div_gradient_pal(low, mid, high, space), na.value = na.value, guide = guide, ..., +a_scale_fill_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), midpoint = 0, space = "Lab", na.value = "grey50", a_guide = "colourbar") { + continuous_a_scale("fill", "gradient2", + div_gradient_pal(low, mid, high, space), na.value = na.value, a_guide = a_guide, ..., rescaler = mid_rescaler(mid = midpoint)) } @@ -95,19 +95,19 @@ mid_rescaler <- function(mid) { #' @inheritParams scales::gradient_n_pal #' @param colours,colors Vector of colours to use for n-colour gradient. -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @export -scale_colour_gradientn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", colors) { +a_scale_colour_gradientn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", a_guide = "colourbar", colors) { colours <- if (missing(colours)) colors else colours - continuous_scale("colour", "gradientn", - gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...) + continuous_a_scale("colour", "gradientn", + gradient_n_pal(colours, values, space), na.value = na.value, a_guide = a_guide, ...) } -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @export -scale_fill_gradientn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", colors) { +a_scale_fill_gradientn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", a_guide = "colourbar", colors) { colours <- if (missing(colours)) colors else colours - continuous_scale("fill", "gradientn", - gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...) + continuous_a_scale("fill", "gradientn", + gradient_n_pal(colours, values, space), na.value = na.value, a_guide = a_guide, ...) } diff --git a/R/scale-grey.r b/R/scale-grey.r index fc941f5a97..61ffd2fc22 100644 --- a/R/scale-grey.r +++ b/R/scale-grey.r @@ -3,37 +3,37 @@ #' Based on \code{\link{gray.colors}} #' #' @inheritParams scales::grey_pal -#' @inheritParams scale_colour_hue +#' @inheritParams a_scale_colour_hue #' @seealso Other colour scales: -#' \code{\link{scale_colour_brewer}}, -#' \code{\link{scale_colour_gradient}}, -#' \code{\link{scale_colour_hue}} -#' @rdname scale_grey +#' \code{\link{a_scale_colour_brewer}}, +#' \code{\link{a_scale_colour_gradient}}, +#' \code{\link{a_scale_colour_hue}} +#' @rdname a_scale_grey #' @export #' @examples -#' p <- ggplot(mtcars, aes(mpg, wt)) + geom_point(aes(colour = factor(cyl))) -#' p + scale_colour_grey() -#' p + scale_colour_grey(end = 0) +#' p <- a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point(a_aes(colour = factor(cyl))) +#' p + a_scale_colour_grey() +#' p + a_scale_colour_grey(end = 0) #' #' # You may want to turn off the pale grey background with this scale -#' p + scale_colour_grey() + theme_bw() +#' p + a_scale_colour_grey() + a_theme_bw() #' #' # Colour of missing values is controlled with na.value: #' miss <- factor(sample(c(NA, 1:5), nrow(mtcars), replace = TRUE)) -#' ggplot(mtcars, aes(mpg, wt)) + -#' geom_point(aes(colour = miss)) + -#' scale_colour_grey() -#' ggplot(mtcars, aes(mpg, wt)) + -#' geom_point(aes(colour = miss)) + -#' scale_colour_grey(na.value = "green") -scale_colour_grey <- function(..., start = 0.2, end = 0.8, na.value = "red") { - discrete_scale("colour", "grey", grey_pal(start, end), +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point(a_aes(colour = miss)) + +#' a_scale_colour_grey() +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point(a_aes(colour = miss)) + +#' a_scale_colour_grey(na.value = "green") +a_scale_colour_grey <- function(..., start = 0.2, end = 0.8, na.value = "red") { + discrete_a_scale("colour", "grey", grey_pal(start, end), na.value = na.value, ...) } -#' @rdname scale_grey +#' @rdname a_scale_grey #' @export -scale_fill_grey <- function(..., start = 0.2, end = 0.8, na.value = "red") { - discrete_scale("fill", "grey", grey_pal(start, end), +a_scale_fill_grey <- function(..., start = 0.2, end = 0.8, na.value = "red") { + discrete_a_scale("fill", "grey", grey_pal(start, end), na.value = na.value, ...) } diff --git a/R/scale-hue.r b/R/scale-hue.r index 02dcc0a81e..88808009f8 100644 --- a/R/scale-hue.r +++ b/R/scale-hue.r @@ -1,59 +1,59 @@ #' Qualitative colour scale with evenly spaced hues. #' #' @param na.value Colour to use for missing values -#' @param ... Other arguments passed on to \code{\link{discrete_scale}} +#' @param ... Other arguments passed on to \code{\link{discrete_a_scale}} #' to control name, limits, breaks, labels and so forth. #' @inheritParams scales::hue_pal -#' @rdname scale_hue +#' @rdname a_scale_hue #' @export #' @seealso Other colour scales: -#' \code{\link{scale_colour_brewer}}, -#' \code{\link{scale_colour_gradient}}, -#' \code{\link{scale_colour_grey}} +#' \code{\link{a_scale_colour_brewer}}, +#' \code{\link{a_scale_colour_gradient}}, +#' \code{\link{a_scale_colour_grey}} #' @examples #' \donttest{ #' dsamp <- diamonds[sample(nrow(diamonds), 1000), ] -#' (d <- ggplot(dsamp, aes(carat, price)) + geom_point(aes(colour = clarity))) +#' (d <- a_plot(dsamp, a_aes(carat, price)) + a_geom_point(a_aes(colour = clarity))) #' -#' # Change scale label -#' d + scale_colour_hue() -#' d + scale_colour_hue("clarity") -#' d + scale_colour_hue(expression(clarity[beta])) +#' # Change a_scale label +#' d + a_scale_colour_hue() +#' d + a_scale_colour_hue("clarity") +#' d + a_scale_colour_hue(expression(clarity[beta])) #' #' # Adjust luminosity and chroma -#' d + scale_colour_hue(l = 40, c = 30) -#' d + scale_colour_hue(l = 70, c = 30) -#' d + scale_colour_hue(l = 70, c = 150) -#' d + scale_colour_hue(l = 80, c = 150) +#' d + a_scale_colour_hue(l = 40, c = 30) +#' d + a_scale_colour_hue(l = 70, c = 30) +#' d + a_scale_colour_hue(l = 70, c = 150) +#' d + a_scale_colour_hue(l = 80, c = 150) #' #' # Change range of hues used -#' d + scale_colour_hue(h = c(0, 90)) -#' d + scale_colour_hue(h = c(90, 180)) -#' d + scale_colour_hue(h = c(180, 270)) -#' d + scale_colour_hue(h = c(270, 360)) +#' d + a_scale_colour_hue(h = c(0, 90)) +#' d + a_scale_colour_hue(h = c(90, 180)) +#' d + a_scale_colour_hue(h = c(180, 270)) +#' d + a_scale_colour_hue(h = c(270, 360)) #' #' # Vary opacity #' # (only works with pdf, quartz and cairo devices) -#' d <- ggplot(dsamp, aes(carat, price, colour = clarity)) -#' d + geom_point(alpha = 0.9) -#' d + geom_point(alpha = 0.5) -#' d + geom_point(alpha = 0.2) +#' d <- a_plot(dsamp, a_aes(carat, price, colour = clarity)) +#' d + a_geom_point(alpha = 0.9) +#' d + a_geom_point(alpha = 0.5) +#' d + a_geom_point(alpha = 0.2) #' #' # Colour of missing values is controlled with na.value: #' miss <- factor(sample(c(NA, 1:5), nrow(mtcars), replace = TRUE)) -#' ggplot(mtcars, aes(mpg, wt)) + geom_point(aes(colour = miss)) -#' ggplot(mtcars, aes(mpg, wt)) + -#' geom_point(aes(colour = miss)) + -#' scale_colour_hue(na.value = "black") +#' a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point(a_aes(colour = miss)) +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point(a_aes(colour = miss)) + +#' a_scale_colour_hue(na.value = "black") #' } -scale_colour_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50") { - discrete_scale("colour", "hue", hue_pal(h, c, l, h.start, direction), +a_scale_colour_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50") { + discrete_a_scale("colour", "hue", hue_pal(h, c, l, h.start, direction), na.value = na.value, ...) } -#' @rdname scale_hue +#' @rdname a_scale_hue #' @export -scale_fill_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50") { - discrete_scale("fill", "hue", hue_pal(h, c, l, h.start, direction), +a_scale_fill_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50") { + discrete_a_scale("fill", "hue", hue_pal(h, c, l, h.start, direction), na.value = na.value, ...) } diff --git a/R/scale-identity.r b/R/scale-identity.r index 4c771cc4ea..fe611097f1 100644 --- a/R/scale-identity.r +++ b/R/scale-identity.r @@ -1,154 +1,154 @@ #' Use values without scaling. #' -#' @name scale_identity -#' @param ... Other arguments passed on to \code{\link{discrete_scale}} or -#' \code{\link{continuous_scale}} -#' @param guide Guide to use for this scale - defaults to \code{"none"}. +#' @name a_scale_identity +#' @param ... Other arguments passed on to \code{\link{discrete_a_scale}} or +#' \code{\link{continuous_a_scale}} +#' @param a_guide Guide to use for this scale - defaults to \code{"none"}. #' @examples -#' ggplot(luv_colours, aes(u, v)) + -#' geom_point(aes(colour = col), size = 3) + -#' scale_color_identity() + -#' coord_equal() +#' a_plot(luv_colours, a_aes(u, v)) + +#' a_geom_point(a_aes(colour = col), size = 3) + +#' a_scale_color_identity() + +#' a_coord_equal() #' #' df <- data.frame( #' x = 1:4, #' y = 1:4, #' colour = c("red", "green", "blue", "yellow") #' ) -#' ggplot(df, aes(x, y)) + geom_tile(aes(fill = colour)) -#' ggplot(df, aes(x, y)) + -#' geom_tile(aes(fill = colour)) + -#' scale_fill_identity() +#' a_plot(df, a_aes(x, y)) + a_geom_tile(a_aes(fill = colour)) +#' a_plot(df, a_aes(x, y)) + +#' a_geom_tile(a_aes(fill = colour)) + +#' a_scale_fill_identity() #' -#' # To get a legend guide, specify guide = "legend" -#' ggplot(df, aes(x, y)) + -#' geom_tile(aes(fill = colour)) + -#' scale_fill_identity(guide = "legend") +#' # To get a legend a_guide, specify a_guide = "legend" +#' a_plot(df, a_aes(x, y)) + +#' a_geom_tile(a_aes(fill = colour)) + +#' a_scale_fill_identity(a_guide = "legend") #' # But you'll typically also need to supply breaks and labels: -#' ggplot(df, aes(x, y)) + -#' geom_tile(aes(fill = colour)) + -#' scale_fill_identity("trt", labels = letters[1:4], breaks = df$colour, -#' guide = "legend") +#' a_plot(df, a_aes(x, y)) + +#' a_geom_tile(a_aes(fill = colour)) + +#' a_scale_fill_identity("trt", a_labels = letters[1:4], breaks = df$colour, +#' a_guide = "legend") #' #' # cyl scaled to appropriate size -#' ggplot(mtcars, aes(mpg, wt)) + geom_point(aes(size = cyl)) +#' a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point(a_aes(size = cyl)) #' #' # cyl used as point size -#' ggplot(mtcars, aes(mpg, wt)) + -#' geom_point(aes(size = cyl)) + -#' scale_size_identity() +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point(a_aes(size = cyl)) + +#' a_scale_size_identity() NULL -#' @rdname scale_identity +#' @rdname a_scale_identity #' @export -scale_colour_identity <- function(..., guide = "none") { - sc <- discrete_scale("colour", "identity", identity_pal(), ..., guide = guide) +a_scale_colour_identity <- function(..., a_guide = "none") { + sc <- discrete_a_scale("colour", "identity", identity_pal(), ..., a_guide = a_guide) - # TODO: Fix this hack. We're reassigning the parent ggproto object, but this + # TODO: Fix this hack. We're reassigning the parent a_ggproto object, but this # object should in the first place be created with the correct parent. - sc$super <- ScaleDiscreteIdentity - class(sc) <- class(ScaleDiscreteIdentity) + sc$super <- a_ScaleDiscreteIdentity + class(sc) <- class(a_ScaleDiscreteIdentity) sc } -#' @rdname scale_identity +#' @rdname a_scale_identity #' @export -scale_fill_identity <- function(..., guide = "none") { - sc <- discrete_scale("fill", "identity", identity_pal(), ..., guide = guide) +a_scale_fill_identity <- function(..., a_guide = "none") { + sc <- discrete_a_scale("fill", "identity", identity_pal(), ..., a_guide = a_guide) - # TODO: Fix this hack. We're reassigning the parent ggproto object, but this + # TODO: Fix this hack. We're reassigning the parent a_ggproto object, but this # object should in the first place be created with the correct parent. - sc$super <- ScaleDiscreteIdentity - class(sc) <- class(ScaleDiscreteIdentity) + sc$super <- a_ScaleDiscreteIdentity + class(sc) <- class(a_ScaleDiscreteIdentity) sc } -#' @rdname scale_identity +#' @rdname a_scale_identity #' @export -scale_shape_identity <- function(..., guide = "none") { - sc <- continuous_scale("shape", "identity", identity_pal(), ..., guide = guide) +a_scale_shape_identity <- function(..., a_guide = "none") { + sc <- continuous_a_scale("shape", "identity", identity_pal(), ..., a_guide = a_guide) - # TODO: Fix this hack. We're reassigning the parent ggproto object, but this + # TODO: Fix this hack. We're reassigning the parent a_ggproto object, but this # object should in the first place be created with the correct parent. - sc$super <- ScaleContinuousIdentity - class(sc) <- class(ScaleContinuousIdentity) + sc$super <- a_ScaleContinuousIdentity + class(sc) <- class(a_ScaleContinuousIdentity) sc } -#' @rdname scale_identity +#' @rdname a_scale_identity #' @export -scale_linetype_identity <- function(..., guide = "none") { - sc <- discrete_scale("linetype", "identity", identity_pal(), ..., guide = guide) +a_scale_linetype_identity <- function(..., a_guide = "none") { + sc <- discrete_a_scale("linetype", "identity", identity_pal(), ..., a_guide = a_guide) - # TODO: Fix this hack. We're reassigning the parent ggproto object, but this + # TODO: Fix this hack. We're reassigning the parent a_ggproto object, but this # object should in the first place be created with the correct parent. - sc$super <- ScaleDiscreteIdentity - class(sc) <- class(ScaleDiscreteIdentity) + sc$super <- a_ScaleDiscreteIdentity + class(sc) <- class(a_ScaleDiscreteIdentity) sc } -#' @rdname scale_identity +#' @rdname a_scale_identity #' @export -scale_alpha_identity <- function(..., guide = "none") { - sc <- continuous_scale("alpha", "identity", identity_pal(), ..., guide = guide) +a_scale_alpha_identity <- function(..., a_guide = "none") { + sc <- continuous_a_scale("alpha", "identity", identity_pal(), ..., a_guide = a_guide) - # TODO: Fix this hack. We're reassigning the parent ggproto object, but this + # TODO: Fix this hack. We're reassigning the parent a_ggproto object, but this # object should in the first place be created with the correct parent. - sc$super <- ScaleContinuousIdentity - class(sc) <- class(ScaleContinuousIdentity) + sc$super <- a_ScaleContinuousIdentity + class(sc) <- class(a_ScaleContinuousIdentity) sc } -#' @rdname scale_identity +#' @rdname a_scale_identity #' @export -scale_size_identity <- function(..., guide = "none") { - sc <- continuous_scale("size", "identity", identity_pal(), ..., guide = guide) +a_scale_size_identity <- function(..., a_guide = "none") { + sc <- continuous_a_scale("size", "identity", identity_pal(), ..., a_guide = a_guide) - # TODO: Fix this hack. We're reassigning the parent ggproto object, but this + # TODO: Fix this hack. We're reassigning the parent a_ggproto object, but this # object should in the first place be created with the correct parent. - sc$super <- ScaleContinuousIdentity - class(sc) <- class(ScaleContinuousIdentity) + sc$super <- a_ScaleContinuousIdentity + class(sc) <- class(a_ScaleContinuousIdentity) sc } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -ScaleDiscreteIdentity <- ggproto("ScaleDiscreteIdentity", ScaleDiscrete, - map = function(x) { - if (is.factor(x)) { - as.character(x) - } else { - x - } - }, - - train = function(self, x) { - # do nothing if no guide, otherwise train so we know what breaks to use - if (self$guide == "none") return() - ggproto_parent(ScaleDiscrete, self)$train(x) - } +a_ScaleDiscreteIdentity <- a_ggproto("a_ScaleDiscreteIdentity", a_ScaleDiscrete, + map = function(x) { + if (is.factor(x)) { + as.character(x) + } else { + x + } + }, + + train = function(self, x) { + # do nothing if no a_guide, otherwise train so we know what breaks to use + if (self$a_guide == "none") return() + a_ggproto_parent(a_ScaleDiscrete, self)$train(x) + } ) -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -ScaleContinuousIdentity <- ggproto("ScaleContinuousIdentity", ScaleContinuous, - map = function(x) { - if (is.factor(x)) { - as.character(x) - } else { - x - } - }, - - train = function(self, x) { - # do nothing if no guide, otherwise train so we know what breaks to use - if (self$guide == "none") return() - ggproto_parent(ScaleDiscrete, self)$train(x) - } +a_ScaleContinuousIdentity <- a_ggproto("a_ScaleContinuousIdentity", a_ScaleContinuous, + map = function(x) { + if (is.factor(x)) { + as.character(x) + } else { + x + } + }, + + train = function(self, x) { + # do nothing if no a_guide, otherwise train so we know what breaks to use + if (self$a_guide == "none") return() + a_ggproto_parent(a_ScaleDiscrete, self)$train(x) + } ) diff --git a/R/scale-linetype.r b/R/scale-linetype.r index f505b60c1c..4ce61be9cd 100644 --- a/R/scale-linetype.r +++ b/R/scale-linetype.r @@ -4,26 +4,26 @@ #' University of Manchester. Line types can not be mapped to continuous #' values. #' -#' @inheritParams scale_x_discrete +#' @inheritParams a_scale_x_discrete #' @param na.value The linetype to use for \code{NA} values. -#' @rdname scale_linetype +#' @rdname a_scale_linetype #' @export #' @examples -#' base <- ggplot(economics_long, aes(date, value01)) -#' base + geom_line(aes(group = variable)) -#' base + geom_line(aes(linetype = variable)) +#' base <- a_plot(economics_long, a_aes(date, value01)) +#' base + a_geom_line(a_aes(group = variable)) +#' base + a_geom_line(a_aes(linetype = variable)) #' -#' # See scale_manual for more flexibility -scale_linetype <- function(..., na.value = "blank") { - discrete_scale("linetype", "linetype_d", linetype_pal(), +#' # See a_scale_manual for more flexibility +a_scale_linetype <- function(..., na.value = "blank") { + discrete_a_scale("linetype", "linetype_d", linetype_pal(), na.value = na.value, ...) } -#' @rdname scale_linetype +#' @rdname a_scale_linetype #' @export -scale_linetype_continuous <- function(...) { +a_scale_linetype_continuous <- function(...) { stop("A continuous variable can not be mapped to linetype", call. = FALSE) } -#' @rdname scale_linetype +#' @rdname a_scale_linetype #' @export -scale_linetype_discrete <- scale_linetype +a_scale_linetype_discrete <- a_scale_linetype diff --git a/R/scale-manual.r b/R/scale-manual.r index 4ff4037d04..2cd6777518 100644 --- a/R/scale-manual.r +++ b/R/scale-manual.r @@ -1,80 +1,80 @@ #' Create your own discrete scale. #' -#' @name scale_manual -#' @inheritParams scale_x_discrete +#' @name a_scale_manual +#' @inheritParams a_scale_x_discrete #' @param values a set of aesthetic values to map data values to. If this #' is a named vector, then the values will be matched based on the names. #' If unnamed, values will be matched in order (usually alphabetical) with -#' the limits of the scale. Any data values that don't match will be +#' the limits of the a_scale. Any data values that don't match will be #' given \code{na.value}. #' @examples #' \donttest{ -#' p <- ggplot(mtcars, aes(mpg, wt)) + -#' geom_point(aes(colour = factor(cyl))) +#' p <- a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point(a_aes(colour = factor(cyl))) #' -#' p + scale_colour_manual(values = c("red","blue", "green")) -#' p + scale_colour_manual( +#' p + a_scale_colour_manual(values = c("red","blue", "green")) +#' p + a_scale_colour_manual( #' values = c("8" = "red","4" = "blue","6" = "green")) #' # With rgb hex values -#' p + scale_colour_manual(values = c("#FF0000", "#0000FF", "#00FF00")) +#' p + a_scale_colour_manual(values = c("#FF0000", "#0000FF", "#00FF00")) #' #' # As with other scales you can use breaks to control the appearance #' # of the legend #' cols <- c("8" = "red","4" = "blue","6" = "darkgreen", "10" = "orange") -#' p + scale_colour_manual(values = cols) -#' p + scale_colour_manual(values = cols, breaks = c("4", "6", "8")) -#' p + scale_colour_manual(values = cols, breaks = c("8", "6", "4")) -#' p + scale_colour_manual(values = cols, breaks = c("4", "6", "8"), -#' labels = c("four", "six", "eight")) +#' p + a_scale_colour_manual(values = cols) +#' p + a_scale_colour_manual(values = cols, breaks = c("4", "6", "8")) +#' p + a_scale_colour_manual(values = cols, breaks = c("8", "6", "4")) +#' p + a_scale_colour_manual(values = cols, breaks = c("4", "6", "8"), +#' a_labels = c("four", "six", "eight")) #' -#' # And limits to control the possible values of the scale -#' p + scale_colour_manual(values = cols, limits = c("4", "8")) -#' p + scale_colour_manual(values = cols, limits = c("4", "6", "8", "10")) +#' # And limits to control the possible values of the a_scale +#' p + a_scale_colour_manual(values = cols, limits = c("4", "8")) +#' p + a_scale_colour_manual(values = cols, limits = c("4", "6", "8", "10")) #' #' # Notice that the values are matched with limits, and not breaks -#' p + scale_colour_manual(limits = c(6, 8, 4), breaks = c(8, 4, 6), +#' p + a_scale_colour_manual(limits = c(6, 8, 4), breaks = c(8, 4, 6), #' values = c("grey50", "grey80", "black")) #' } NULL -#' @rdname scale_manual +#' @rdname a_scale_manual #' @export -scale_colour_manual <- function(..., values) { - manual_scale("colour", values, ...) +a_scale_colour_manual <- function(..., values) { + manual_a_scale("colour", values, ...) } -#' @rdname scale_manual +#' @rdname a_scale_manual #' @export -scale_fill_manual <- function(..., values) { - manual_scale("fill", values, ...) +a_scale_fill_manual <- function(..., values) { + manual_a_scale("fill", values, ...) } -#' @rdname scale_manual +#' @rdname a_scale_manual #' @export -scale_size_manual <- function(..., values) { - manual_scale("size", values, ...) +a_scale_size_manual <- function(..., values) { + manual_a_scale("size", values, ...) } -#' @rdname scale_manual +#' @rdname a_scale_manual #' @export -scale_shape_manual <- function(..., values) { - manual_scale("shape", values, ...) +a_scale_shape_manual <- function(..., values) { + manual_a_scale("shape", values, ...) } -#' @rdname scale_manual +#' @rdname a_scale_manual #' @export -scale_linetype_manual <- function(..., values) { - manual_scale("linetype", values, ...) +a_scale_linetype_manual <- function(..., values) { + manual_a_scale("linetype", values, ...) } -#' @rdname scale_manual +#' @rdname a_scale_manual #' @export -scale_alpha_manual <- function(..., values) { - manual_scale("alpha", values, ...) +a_scale_alpha_manual <- function(..., values) { + manual_a_scale("alpha", values, ...) } -manual_scale <- function(aesthetic, values, ...) { +manual_a_scale <- function(a_aesthetic, values, ...) { pal <- function(n) { if (n > length(values)) { stop("Insufficient values in manual scale. ", n, " needed but only ", @@ -82,5 +82,5 @@ manual_scale <- function(aesthetic, values, ...) { } values } - discrete_scale(aesthetic, "manual", pal, ...) + discrete_a_scale(a_aesthetic, "manual", pal, ...) } diff --git a/R/scale-shape.r b/R/scale-shape.r index 4b602a98a0..a6ba3b0d11 100644 --- a/R/scale-shape.r +++ b/R/scale-shape.r @@ -3,39 +3,39 @@ #' A continuous variable can not be mapped to shape. #' #' @param solid Are the shapes solid, \code{TRUE}, or hollow \code{FALSE}? -#' @inheritParams scale_x_discrete -#' @rdname scale_shape +#' @inheritParams a_scale_x_discrete +#' @rdname a_scale_shape #' @export #' @examples #' dsmall <- diamonds[sample(nrow(diamonds), 100), ] #' -#' (d <- ggplot(dsmall, aes(carat, price)) + geom_point(aes(shape = cut))) -#' d + scale_shape(solid = TRUE) # the default -#' d + scale_shape(solid = FALSE) -#' d + scale_shape(name = "Cut of diamond") -#' d + scale_shape(name = "Cut of\ndiamond") +#' (d <- a_plot(dsmall, a_aes(carat, price)) + a_geom_point(a_aes(shape = cut))) +#' d + a_scale_shape(solid = TRUE) # the default +#' d + a_scale_shape(solid = FALSE) +#' d + a_scale_shape(name = "Cut of diamond") +#' d + a_scale_shape(name = "Cut of\ndiamond") #' #' # To change order of levels, change order of #' # underlying factor #' levels(dsmall$cut) <- c("Fair", "Good", "Very Good", "Premium", "Ideal") #' #' # Need to recreate plot to pick up new data -#' ggplot(dsmall, aes(price, carat)) + geom_point(aes(shape = cut)) +#' a_plot(dsmall, a_aes(price, carat)) + a_geom_point(a_aes(shape = cut)) #' #' # Or for short: #' d %+% dsmall -scale_shape <- function(..., solid = TRUE) { - discrete_scale("shape", "shape_d", shape_pal(solid), ...) +a_scale_shape <- function(..., solid = TRUE) { + discrete_a_scale("shape", "shape_d", shape_pal(solid), ...) } -#' @rdname scale_shape +#' @rdname a_scale_shape #' @export #' @usage NULL -scale_shape_discrete <- scale_shape +a_scale_shape_discrete <- a_scale_shape -#' @rdname scale_shape +#' @rdname a_scale_shape #' @export #' @usage NULL -scale_shape_continuous <- function(...) { +a_scale_shape_continuous <- function(...) { stop("A continuous variable can not be mapped to shape", call. = FALSE) } diff --git a/R/scale-size.r b/R/scale-size.r index a8da39420c..4a8342611d 100644 --- a/R/scale-size.r +++ b/R/scale-size.r @@ -1,94 +1,94 @@ #' Scale size (area or radius). #' -#' \code{scale_size} scales area, \code{scale_radius} scales radius. The size +#' \code{a_scale_size} a_scales area, \code{a_scale_radius} scales radius. The size #' aesthetic is most commonly used for points and text, and humans perceive #' the area of points (not their radius), so this provides for optimal -#' perception. \code{scale_size_area} ensures that a value of 0 is mapped +#' perception. \code{a_scale_size_area} ensures that a value of 0 is mapped #' to a size of 0. #' -#' @name scale_size -#' @inheritParams continuous_scale +#' @name a_scale_size +#' @inheritParams continuous_a_scale #' @param range a numeric vector of length 2 that specifies the minimum and #' maximum size of the plotting symbol after transformation. -#' @seealso \code{\link{scale_size_area}} if you want 0 values to be mapped +#' @seealso \code{\link{a_scale_size_area}} if you want 0 values to be mapped #' to points with size 0. #' @examples -#' p <- ggplot(mpg, aes(displ, hwy, size = hwy)) + -#' geom_point() +#' p <- a_plot(mpg, a_aes(displ, hwy, size = hwy)) + +#' a_geom_point() #' p -#' p + scale_size("Highway mpg") -#' p + scale_size(range = c(0, 10)) +#' p + a_scale_size("Highway mpg") +#' p + a_scale_size(range = c(0, 10)) #' -#' # If you want zero value to have zero size, use scale_size_area: -#' p + scale_size_area() +#' # If you want zero value to have zero size, use a_scale_size_area: +#' p + a_scale_size_area() #' #' # This is most useful when size is a count -#' ggplot(mpg, aes(class, cyl)) + -#' geom_count() + -#' scale_size_area() +#' a_plot(mpg, a_aes(class, cyl)) + +#' a_geom_count() + +#' a_scale_size_area() #' -#' # If you want to map size to radius (usually bad idea), use scale_radius -#' p + scale_radius() +#' # If you want to map size to radius (usually bad idea), use a_scale_radius +#' p + a_scale_radius() NULL -#' @rdname scale_size +#' @rdname a_scale_size #' @export #' @usage NULL -scale_size_continuous <- function(name = waiver(), breaks = waiver(), labels = waiver(), +a_scale_size_continuous <- function(name = waiver(), breaks = waiver(), a_labels = waiver(), limits = NULL, range = c(1, 6), - trans = "identity", guide = "legend") { - continuous_scale("size", "area", area_pal(range), name = name, - breaks = breaks, labels = labels, limits = limits, trans = trans, - guide = guide) + trans = "identity", a_guide = "legend") { + continuous_a_scale("size", "area", area_pal(range), name = name, + breaks = breaks, a_labels = a_labels, limits = limits, trans = trans, + a_guide = a_guide) } -#' @rdname scale_size +#' @rdname a_scale_size #' @export -scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), +a_scale_radius <- function(name = waiver(), breaks = waiver(), a_labels = waiver(), limits = NULL, range = c(1, 6), - trans = "identity", guide = "legend") { - continuous_scale("size", "radius", rescale_pal(range), name = name, - breaks = breaks, labels = labels, limits = limits, trans = trans, - guide = guide) + trans = "identity", a_guide = "legend") { + continuous_a_scale("size", "radius", rescale_pal(range), name = name, + breaks = breaks, a_labels = a_labels, limits = limits, trans = trans, + a_guide = a_guide) } -#' @rdname scale_size +#' @rdname a_scale_size #' @export -scale_size <- scale_size_continuous +a_scale_size <- a_scale_size_continuous -#' @rdname scale_size +#' @rdname a_scale_size #' @export #' @usage NULL -scale_size_discrete <- function(..., range = c(2, 6)) { +a_scale_size_discrete <- function(..., range = c(2, 6)) { warning("Using size for a discrete variable is not advised.", call. = FALSE) - discrete_scale("size", "size_d", function(n) { + discrete_a_scale("size", "size_d", function(n) { area <- seq(range[1] ^ 2, range[2] ^ 2, length.out = n) sqrt(area) }, ...) } -#' @param ... Other arguments passed on to \code{\link{continuous_scale}} -#' to control name, limits, breaks, labels and so forth. +#' @param ... Other arguments passed on to \code{\link{continuous_a_scale}} +#' to control name, limits, breaks, a_labels and so forth. #' @param max_size Size of largest points. #' @export -#' @rdname scale_size -scale_size_area <- function(..., max_size = 6) { - continuous_scale("size", "area", +#' @rdname a_scale_size +a_scale_size_area <- function(..., max_size = 6) { + continuous_a_scale("size", "area", palette = abs_area(max_size), rescaler = rescale_max, ...) } -#' @rdname scale_size +#' @rdname a_scale_size #' @export #' @usage NULL -scale_size_datetime <- function() { - scale_size_continuous(trans = "time") +a_scale_size_datetime <- function() { + a_scale_size_continuous(trans = "time") } -#' @rdname scale_size +#' @rdname a_scale_size #' @export #' @usage NULL -scale_size_date <- function() { - scale_size_continuous(trans = "date") +a_scale_size_date <- function() { + a_scale_size_continuous(trans = "date") } diff --git a/R/scale-type.R b/R/scale-type.R index b08b1f973b..05530cc94e 100644 --- a/R/scale-type.R +++ b/R/scale-type.R @@ -1,14 +1,14 @@ -find_scale <- function(aes, x, env = parent.frame()) { - type <- scale_type(x) - candidates <- paste("scale", aes, type, sep = "_") - - for (scale in candidates) { - scale_f <- find_global(scale, env, mode = "function") - if (!is.null(scale_f)) - return(scale_f()) +find_a_scale <- function(a_aes, x, env = parent.frame()) { + type <- a_scale_type(x) + candidates <- paste("a_scale", a_aes, type, sep = "_") + + for (a_scale in candidates) { + a_scale_f <- find_global(a_scale, env, mode = "function") + if (!is.null(a_scale_f)) + return(a_scale_f()) } - # Failure to find a scale is not an error because some "aesthetics" don't + # Failure to find a a_scale is not an error because some "a_aesthetics" don't # need scales (e.g. group), and it allows others to extend ggplot2 with # their own aesthetics @@ -23,7 +23,7 @@ find_global <- function(name, env, mode = "any") { return(get(name, envir = env, mode = mode)) } - nsenv <- asNamespace("ggplot2") + nsenv <- asNamespace("ggplot2Animint") if (exists(name, envir = nsenv, mode = mode)) { return(get(name, envir = nsenv, mode = mode)) } @@ -32,35 +32,35 @@ find_global <- function(name, env, mode = "any") { } # Determine default type of a scale -scale_type <- function(x) UseMethod("scale_type") +a_scale_type <- function(x) UseMethod("a_scale_type") #' @export -scale_type.default <- function(x) { +a_scale_type.default <- function(x) { message("Don't know how to automatically pick scale for object of type ", paste(class(x), collapse = "/"), ". Defaulting to continuous.") "continuous" } #' @export -scale_type.AsIs <- function(x) "identity" +a_scale_type.AsIs <- function(x) "identity" #' @export -scale_type.logical <- function(x) "discrete" +a_scale_type.logical <- function(x) "discrete" #' @export -scale_type.character <- function(x) "discrete" +a_scale_type.character <- function(x) "discrete" #' @export -scale_type.ordered <- function(x) c("ordinal", "discrete") +a_scale_type.ordered <- function(x) c("ordinal", "discrete") #' @export -scale_type.factor <- function(x) "discrete" +a_scale_type.factor <- function(x) "discrete" #' @export -scale_type.POSIXt <- function(x) c("datetime", "continuous") +a_scale_type.POSIXt <- function(x) c("datetime", "continuous") #' @export -scale_type.Date <- function(x) c("date", "continuous") +a_scale_type.Date <- function(x) c("date", "continuous") #' @export -scale_type.numeric <- function(x) "continuous" +a_scale_type.numeric <- function(x) "continuous" diff --git a/R/scales-.r b/R/scales-.r index 2330d8ae61..f1e65236c4 100644 --- a/R/scales-.r +++ b/R/scales-.r @@ -1,39 +1,43 @@ -# Scales object encapsulates multiple scales. -# All input and output done with data.frames to facilitate -# multiple input and output variables - -scales_list <- function() { - ggproto(NULL, ScalesList) +#' Scales object encapsulates multiple scales. +#' All input and output done with data.frames to facilitate +#' multiple input and output variables +#' @export +a_scales_list <- function() { + a_ggproto(NULL, a_ScalesList) } -ScalesList <- ggproto("ScalesList", NULL, +#' @rdname ggplot2Animint-ggproto +#' @format NULL +#' @usage NULL +#' @export +a_ScalesList <- a_ggproto("a_ScalesList", NULL, scales = NULL, - find = function(self, aesthetic) { - vapply(self$scales, function(x) any(aesthetic %in% x$aesthetics), logical(1)) + find = function(self, a_aesthetic) { + vapply(self$scales, function(x) any(a_aesthetic %in% x$a_aesthetics), logical(1)) }, - has_scale = function(self, aesthetic) { - any(self$find(aesthetic)) + has_scale = function(self, a_aesthetic) { + any(self$find(a_aesthetic)) }, - add = function(self, scale) { - if (is.null(scale)) { + add = function(self, a_scale) { + if (is.null(a_scale)) { return() } - prev_aes <- self$find(scale$aesthetics) + prev_aes <- self$find(a_scale$a_aesthetics) if (any(prev_aes)) { # Get only the first aesthetic name in the returned vector -- it can # sometimes be c("x", "xmin", "xmax", ....) - scalename <- self$scales[prev_aes][[1]]$aesthetics[1] + scalename <- self$scales[prev_aes][[1]]$a_aesthetics[1] message_wrap("Scale for '", scalename, "' is already present. Adding another scale for '", scalename, "', which will replace the existing scale.") } - # Remove old scale for this aesthetic (if it exists) - self$scales <- c(self$scales[!prev_aes], list(scale)) + # Remove old scale for this a_aesthetic (if it exists) + self$scales <- c(self$scales[!prev_aes], list(a_scale)) }, n = function(self) { @@ -41,23 +45,23 @@ ScalesList <- ggproto("ScalesList", NULL, }, input = function(self) { - unlist(lapply(self$scales, "[[", "aesthetics")) + unlist(lapply(self$scales, "[[", "a_aesthetics")) }, # This actually makes a descendant of self, which is functionally the same # as a actually clone for most purposes. clone = function(self) { - ggproto(NULL, self, scales = lapply(self$scales, function(s) s$clone())) + a_ggproto(NULL, self, scales = lapply(self$scales, function(s) s$clone())) }, non_position_scales = function(self) { - ggproto(NULL, self, scales = self$scales[!self$find("x") & !self$find("y")]) + a_ggproto(NULL, self, scales = self$scales[!self$find("x") & !self$find("y")]) }, get_scales = function(self, output) { - scale <- self$scales[self$find(output)] - if (length(scale) == 0) return() - scale[[1]] + a_scale <- self$scales[self$find(output)] + if (length(a_scale) == 0) return() + a_scale[[1]] } ) @@ -65,14 +69,14 @@ ScalesList <- ggproto("ScalesList", NULL, scales_train_df <- function(scales, df, drop = FALSE) { if (empty(df) || length(scales$scales) == 0) return() - lapply(scales$scales, function(scale) scale$train_df(df = df)) + lapply(scales$scales, function(a_scale) a_scale$train_df(df = df)) } # Map values from a data.frame. Returns data.frame scales_map_df <- function(scales, df) { if (empty(df) || length(scales$scales) == 0) return(df) - mapped <- unlist(lapply(scales$scales, function(scale) scale$map_df(df = df)), recursive = FALSE) + mapped <- unlist(lapply(scales$scales, function(a_scale) a_scale$map_df(df = df)), recursive = FALSE) plyr::quickdf(c(mapped, df[setdiff(names(df), names(mapped))])) } @@ -86,39 +90,39 @@ scales_transform_df <- function(scales, df) { plyr::quickdf(c(transformed, df[setdiff(names(df), names(transformed))])) } -# @param aesthetics A list of aesthetic-variable mappings. The name of each +# @param a_aesthetics A list of aesthetic-variable mappings. The name of each # item is the aesthetic, and the value of each item is the variable in data. -scales_add_defaults <- function(scales, data, aesthetics, env) { - if (is.null(aesthetics)) return() - names(aesthetics) <- unlist(lapply(names(aesthetics), aes_to_scale)) +scales_add_defaults <- function(scales, data, a_aesthetics, env) { + if (is.null(a_aesthetics)) return() + names(a_aesthetics) <- unlist(lapply(names(a_aesthetics), a_aes_to_scale)) - new_aesthetics <- setdiff(names(aesthetics), scales$input()) - # No new aesthetics, so no new scales to add + new_aesthetics <- setdiff(names(a_aesthetics), scales$input()) + # No new a_aesthetics, so no new scales to add if (is.null(new_aesthetics)) return() datacols <- plyr::tryapply( - aesthetics[new_aesthetics], eval, + a_aesthetics[new_aesthetics], eval, envir = data, enclos = env ) - for (aes in names(datacols)) { - scales$add(find_scale(aes, datacols[[aes]], env)) + for (a_aes in names(datacols)) { + scales$add(find_a_scale(a_aes, datacols[[a_aes]], env)) } } # Add missing but required scales. -# @param aesthetics A character vector of aesthetics. Typically c("x", "y"). -scales_add_missing <- function(plot, aesthetics, env) { +# @param a_aesthetics A character vector of a_aesthetics. Typically c("x", "y"). +scales_add_missing <- function(plot, a_aesthetics, env) { - # Keep only aesthetics that aren't already in plot$scales - aesthetics <- setdiff(aesthetics, plot$scales$input()) + # Keep only a_aesthetics that aren't already in plot$scales + a_aesthetics <- setdiff(a_aesthetics, plot$scales$input()) - for (aes in aesthetics) { - scale_name <- paste("scale", aes, "continuous", sep = "_") + for (a_aes in a_aesthetics) { + a_scale_name <- paste("a_scale", a_aes, "continuous", sep = "_") - scale_f <- find_global(scale_name, env, mode = "function") - plot$scales$add(scale_f()) + a_scale_f <- find_global(a_scale_name, env, mode = "function") + plot$scales$add(a_scale_f()) } } diff --git a/R/stat-.r b/R/stat-.r index 25879f5ab2..5b39e04672 100644 --- a/R/stat-.r +++ b/R/stat-.r @@ -1,11 +1,11 @@ -#' @section Stats: +#' @section a_Stats: #' -#' All \code{stat_*} functions (like \code{stat_bin}) return a layer that -#' contains a \code{Stat*} object (like \code{StatBin}). The \code{Stat*} +#' All \code{a_stat_*} functions (like \code{a_stat_bin}) return a layer that +#' contains a \code{a_Stat*} object (like \code{a_StatBin}). The \code{a_Stat*} #' object is responsible for rendering the data in the plot. #' -#' Each of the \code{Stat*} objects is a \code{\link{ggproto}} object, descended -#' from the top-level \code{Stat}, and each implements various methods and +#' Each of the \code{a_Stat*} objects is a \code{\link{a_ggproto}} object, descended +#' from the top-level \code{a_Stat}, and each implements various methods and #' fields. To create a new type of Stat object, you typically will want to #' implement one or more of the following: #' @@ -39,20 +39,20 @@ #' required aesthetics (with a warning if \code{!na.rm}). #' \item \code{required_aes}: A character vector of aesthetics needed to #' render the geom. -#' \item \code{default_aes}: A list (generated by \code{\link{aes}()} of +#' \item \code{default_aes}: A list (generated by \code{\link{a_aes}()} of #' default values for aesthetics. #' } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -Stat <- ggproto("Stat", +a_Stat <- a_ggproto("a_Stat", # Should the values produced by the statistic also be transformed # in the second pass when recently added statistics are trained to # the scales retransform = TRUE, - default_aes = aes(), + default_aes = a_aes(), required_aes = character(), @@ -68,9 +68,9 @@ Stat <- ggproto("Stat", compute_layer = function(self, data, params, panels) { check_required_aesthetics( - self$stat$required_aes, + self$a_stat$required_aes, c(names(data), names(params)), - snake_class(self$stat) + snake_class(self$a_stat) ) data <- remove_missing(data, params$na.rm, @@ -123,12 +123,12 @@ Stat <- ggproto("Stat", extra_params = "na.rm", parameters = function(self, extra = FALSE) { # Look first in compute_panel. If it contains ... then look in compute_group - panel_args <- names(ggproto_formals(self$compute_panel)) - group_args <- names(ggproto_formals(self$compute_group)) + panel_args <- names(a_ggproto_formals(self$compute_panel)) + group_args <- names(a_ggproto_formals(self$compute_group)) args <- if ("..." %in% panel_args) group_args else panel_args # Remove arguments of defaults - args <- setdiff(args, names(ggproto_formals(Stat$compute_group))) + args <- setdiff(args, names(a_ggproto_formals(a_Stat$compute_group))) if (extra) { args <- union(args, self$extra_params) diff --git a/R/stat-bin.r b/R/stat-bin.r index b6a9f3db4e..710a958455 100644 --- a/R/stat-bin.r +++ b/R/stat-bin.r @@ -1,5 +1,5 @@ -#' \code{stat_bin} is suitable only for continuous x data. If your x data is -#' discrete, you probably want to use \code{\link{stat_count}}. +#' \code{a_stat_bin} is suitable only for continuous x data. If your x data is +#' discrete, you probably want to use \code{\link{a_stat_count}}. #' #' @param binwidth The width of the bins. The default is to use \code{bins} #' bins that cover the range of the data. You should always override @@ -32,13 +32,13 @@ #' \item{ndensity}{density, scaled to maximum of 1} #' } #' -#' @seealso \code{\link{stat_count}}, which counts the number of cases at each x +#' @seealso \code{\link{a_stat_count}}, which counts the number of cases at each x #' posotion, without binning. It is suitable for both discrete and continuous -#' x data, whereas \link{stat_bin} is suitable only for continuous x data. +#' x data, whereas \link{a_stat_bin} is suitable only for continuous x data. #' @export -#' @rdname geom_histogram -stat_bin <- function(mapping = NULL, data = NULL, - geom = "bar", position = "stack", +#' @rdname a_geom_histogram +a_stat_bin <- function(mapping = NULL, data = NULL, + a_geom = "bar", a_position = "stack", ..., binwidth = NULL, bins = NULL, @@ -48,16 +48,16 @@ stat_bin <- function(mapping = NULL, data = NULL, pad = FALSE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.a_aes = TRUE) { - layer( + a_layer( data = data, mapping = mapping, - stat = StatBin, - geom = geom, - position = position, + a_stat = a_StatBin, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( binwidth = binwidth, bins = bins, @@ -71,13 +71,16 @@ stat_bin <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatBin <- ggproto("StatBin", Stat, +a_StatBin <- a_ggproto("a_StatBin", a_Stat, setup_params = function(data, params) { - if (!is.null(data$y) || !is.null(params$y)) { + if (!is.null(data$y)){ + stop("stat_bin() must not be used with a y aesthetic.", call. = FALSE) + } + if (!is.null(params$y)) { stop("stat_bin() must not be used with a y aesthetic.", call. = FALSE) } if (is.integer(data$x)) { @@ -100,7 +103,7 @@ StatBin <- ggproto("StatBin", Stat, params$right <- NULL } if (!is.null(params$width)) { - stop("`width` is deprecated. Do you want `geom_bar()`?", call. = FALSE) + stop("`width` is deprecated. Do you want `a_geom_bar()`?", call. = FALSE) } if (!is.null(params$boundary) && !is.null(params$center)) { stop("Only one of `boundary` and `center` may be specified.", call. = FALSE) @@ -134,7 +137,7 @@ StatBin <- ggproto("StatBin", Stat, bin_vector(data$x, bins, weight = data$weight, pad = pad) }, - default_aes = aes(y = ..count..), + default_aes = a_aes(y = ..count..), required_aes = c("x") ) diff --git a/R/stat-bin2d.r b/R/stat-bin2d.r index 202a74b968..0c5f6e4435 100644 --- a/R/stat-bin2d.r +++ b/R/stat-bin2d.r @@ -4,24 +4,24 @@ #' horizontal directions. Overrides \code{bins} if both set. #' @param drop if \code{TRUE} removes all cells with 0 counts. #' @export -#' @rdname geom_bin2d -stat_bin_2d <- function(mapping = NULL, data = NULL, - geom = "tile", position = "identity", +#' @rdname a_geom_bin2d +a_stat_bin_2d <- function(mapping = NULL, data = NULL, + a_geom = "tile", a_position = "identity", ..., bins = 30, binwidth = NULL, drop = TRUE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatBin2d, - geom = geom, - position = position, + a_stat = a_StatBin2d, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( bins = bins, binwidth = binwidth, @@ -34,16 +34,16 @@ stat_bin_2d <- function(mapping = NULL, data = NULL, #' @export -#' @rdname geom_bin2d +#' @rdname a_geom_bin2d #' @usage NULL -stat_bin2d <- stat_bin_2d +a_stat_bin2d <- a_stat_bin_2d -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatBin2d <- ggproto("StatBin2d", Stat, - default_aes = aes(fill = ..count..), +a_StatBin2d <- a_ggproto("a_StatBin2d", a_Stat, + default_aes = a_aes(fill = ..count..), required_aes = c("x", "y"), compute_group = function(data, scales, binwidth = NULL, bins = 30, diff --git a/R/stat-bindot.r b/R/stat-bindot.r index 660cf02c11..410386c278 100644 --- a/R/stat-bindot.r +++ b/R/stat-bindot.r @@ -1,11 +1,11 @@ -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatBindot <- ggproto("StatBindot", Stat, +a_StatBindot <- a_ggproto("a_StatBindot", a_Stat, required_aes = "x", non_missing_aes = "weight", - default_aes = aes(y = ..count..), + default_aes = a_aes(y = ..count..), setup_params = function(data, params) { if (is.null(params$binwidth)) { @@ -20,7 +20,7 @@ StatBindot <- ggproto("StatBindot", Stat, snake_class(self), finite = TRUE ) - ggproto_parent(Stat, self)$compute_layer(data, params, panels) + a_ggproto_parent(a_Stat, self)$compute_layer(data, params, panels) }, compute_panel = function(self, data, scales, na.rm = FALSE, binwidth = NULL, @@ -54,7 +54,7 @@ StatBindot <- ggproto("StatBindot", Stat, } - ggproto_parent(Stat, self)$compute_panel(data, scales, binwidth = binwidth, + a_ggproto_parent(a_Stat, self)$compute_panel(data, scales, binwidth = binwidth, binaxis = binaxis, method = method, binpositions = binpositions, origin = origin, width = width, drop = drop, right = right) diff --git a/R/stat-binhex.r b/R/stat-binhex.r index d64761c890..4894ca9217 100644 --- a/R/stat-binhex.r +++ b/R/stat-binhex.r @@ -1,22 +1,22 @@ #' @export -#' @rdname geom_hex -#' @inheritParams stat_bin_2d -stat_bin_hex <- function(mapping = NULL, data = NULL, - geom = "hex", position = "identity", +#' @rdname a_geom_hex +#' @inheritParams a_stat_bin_2d +a_stat_bin_hex <- function(mapping = NULL, data = NULL, + a_geom = "hex", a_position = "identity", ..., bins = 30, binwidth = NULL, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatBinhex, - geom = geom, - position = position, + a_stat = a_StatBinhex, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( bins = bins, binwidth = binwidth, @@ -27,22 +27,22 @@ stat_bin_hex <- function(mapping = NULL, data = NULL, } #' @export -#' @rdname geom_hex +#' @rdname a_geom_hex #' @usage NULL -stat_binhex <- stat_bin_hex +a_stat_binhex <- a_stat_bin_hex -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatBinhex <- ggproto("StatBinhex", Stat, - default_aes = aes(fill = ..value..), +a_StatBinhex <- a_ggproto("a_StatBinhex", a_Stat, + default_aes = a_aes(fill = ..value..), required_aes = c("x", "y"), compute_group = function(data, scales, binwidth = NULL, bins = 30, na.rm = FALSE) { - try_require("hexbin", "stat_binhex") + try_require("hexbin", "a_stat_binhex") binwidth <- binwidth %||% hex_binwidth(bins, scales) wt <- data$weight %||% rep(1L, nrow(data)) diff --git a/R/stat-boxplot.r b/R/stat-boxplot.r index 8909ae1c7d..09d1af2929 100644 --- a/R/stat-boxplot.r +++ b/R/stat-boxplot.r @@ -1,6 +1,6 @@ -#' @rdname geom_boxplot +#' @rdname a_geom_boxplot #' @param coef length of the whiskers as multiple of IQR. Defaults to 1.5 -#' @inheritParams stat_identity +#' @inheritParams a_stat_identity #' @section Computed variables: #' \describe{ #' \item{width}{width of boxplot} @@ -13,21 +13,21 @@ #' \item{ymax}{upper whisker = largest observation less than or equal to upper hinge + 1.5 * IQR} #' } #' @export -stat_boxplot <- function(mapping = NULL, data = NULL, - geom = "boxplot", position = "dodge", +a_stat_boxplot <- function(mapping = NULL, data = NULL, + a_geom = "boxplot", a_position = "dodge", ..., coef = 1.5, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatBoxplot, - geom = geom, - position = position, + a_stat = a_StatBoxplot, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, coef = coef, @@ -37,20 +37,20 @@ stat_boxplot <- function(mapping = NULL, data = NULL, } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatBoxplot <- ggproto("StatBoxplot", Stat, +a_StatBoxplot <- a_ggproto("a_StatBoxplot", a_Stat, required_aes = c("x", "y"), non_missing_aes = "weight", setup_params = function(data, params) { - params$width <- params$width %||% resolution(data$x) * 0.75 + params$width <- params$width %||% a_resolution(data$x) * 0.75 if (is.double(data$x) && !has_groups(data) && any(data$x != data$x[1L])) { warning( - "Continuous x aesthetic -- did you forget aes(group=...)?", + "Continuous x aesthetic -- did you forget a_aes(group=...)?", call. = FALSE) } diff --git a/R/stat-contour.r b/R/stat-contour.r index 7eb6ac9a88..d1d65474e7 100644 --- a/R/stat-contour.r +++ b/R/stat-contour.r @@ -1,24 +1,24 @@ -#' @inheritParams stat_identity +#' @inheritParams a_stat_identity #' @export #' @section Computed variables: #' \describe{ #' \item{level}{height of contour} #' } -#' @rdname geom_contour -stat_contour <- function(mapping = NULL, data = NULL, - geom = "contour", position = "identity", +#' @rdname a_geom_contour +a_stat_contour <- function(mapping = NULL, data = NULL, + a_geom = "contour", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatContour, - geom = geom, - position = position, + a_stat = a_StatContour, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -26,13 +26,13 @@ stat_contour <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatContour <- ggproto("StatContour", Stat, +a_StatContour <- a_ggproto("a_StatContour", a_Stat, required_aes = c("x", "y", "z"), - default_aes = aes(order = ..level..), + default_aes = a_aes(order = ..level..), compute_group = function(data, scales, bins = NULL, binwidth = NULL, breaks = NULL, complete = FALSE, na.rm = FALSE) { @@ -60,8 +60,8 @@ StatContour <- ggproto("StatContour", Stat, # # breaks <- seq(95, 195, length.out = 10) # contours <- contourLines(v3d, breaks) -# ggplot(contours, aes(x, y)) + -# geom_path() + +# a_plot(contours, a_aes(x, y)) + +# a_geom_path() + # facet_wrap(~piece) contour_lines <- function(data, breaks, complete = FALSE) { z <- tapply(data$z, data[c("x", "y")], identity) @@ -106,8 +106,8 @@ poly_dir <- function(x, y) { # To fix breaks and complete the polygons, we need to add 0-4 corner points. # -# contours <- ddply(contours, "piece", mutate, dir = ggplot2:::poly_dir(x, y)) -# ggplot(contours, aes(x, y)) + -# geom_path(aes(group = piece, colour = factor(dir))) +# contours <- ddply(contours, "piece", mutate, dir = ggplot2Animint:::poly_dir(x, y)) +# a_plot(contours, a_aes(x, y)) + +# a_geom_path(a_aes(group = piece, colour = factor(dir))) # last_plot() + facet_wrap(~ level) diff --git a/R/stat-count.r b/R/stat-count.r index c0b7285b22..e4e443a1c8 100644 --- a/R/stat-count.r +++ b/R/stat-count.r @@ -1,34 +1,34 @@ -#' \code{stat_count} counts the number of cases at each x position. If you want -#' to bin the data in ranges, you should use \code{\link{stat_bin}} instead. +#' \code{a_stat_count} counts the number of cases at each x position. If you want +#' to bin the data in ranges, you should use \code{\link{a_stat_bin}} instead. #' #' @section Computed variables: #' \describe{ #' \item{count}{number of points in bin} #' \item{prop}{groupwise proportion} #' } -#' @seealso \code{\link{stat_bin}}, which bins data in ranges and counts the -#' cases in each range. It differs from \code{stat_count}, which counts the +#' @seealso \code{\link{a_stat_bin}}, which bins data in ranges and counts the +#' cases in each range. It differs from \code{a_stat_count}, which counts the #' number of cases at each x position (without binning into ranges). -#' \code{\link{stat_bin}} requires continuous x data, whereas -#' \code{stat_count} can be used for both discrete and continuous x data. +#' \code{\link{a_stat_bin}} requires continuous x data, whereas +#' \code{a_stat_count} can be used for both discrete and continuous x data. #' #' @export -#' @rdname geom_bar -stat_count <- function(mapping = NULL, data = NULL, - geom = "bar", position = "stack", +#' @rdname a_geom_bar +a_stat_count <- function(mapping = NULL, data = NULL, + a_geom = "bar", a_position = "stack", ..., width = NULL, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatCount, - geom = geom, - position = position, + a_stat = a_StatCount, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, width = width, @@ -37,17 +37,20 @@ stat_count <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export #' @include stat-.r -StatCount <- ggproto("StatCount", Stat, +a_StatCount <- a_ggproto("a_StatCount", a_Stat, required_aes = "x", - default_aes = aes(y = ..count..), + default_aes = a_aes(y = ..count..), setup_params = function(data, params) { - if (!is.null(data$y) || !is.null(params$y)) { + if (!is.null(data$y)){ + stop("stat_count() must not be used with a y aesthetic.", call. = FALSE) + } + if (!is.null(params$y)) { stop("stat_count() must not be used with a y aesthetic.", call. = FALSE) } params @@ -56,7 +59,7 @@ StatCount <- ggproto("StatCount", Stat, compute_group = function(self, data, scales, width = NULL) { x <- data$x weight <- data$weight %||% rep(1, length(x)) - width <- width %||% (resolution(x) * 0.9) + width <- width %||% (a_resolution(x) * 0.9) count <- as.numeric(tapply(weight, x, sum, na.rm = TRUE)) count[is.na(count)] <- 0 diff --git a/R/stat-density-2d.r b/R/stat-density-2d.r index 3dfa844e62..245e5534b4 100644 --- a/R/stat-density-2d.r +++ b/R/stat-density-2d.r @@ -1,29 +1,29 @@ #' @export -#' @rdname geom_density_2d +#' @rdname a_geom_density_2d #' @param contour If \code{TRUE}, contour the results of the 2d density #' estimation #' @param n number of grid points in each direction #' @param h Bandwidth (vector of length two). If \code{NULL}, estimated #' using \code{\link[MASS]{bandwidth.nrd}}. #' @section Computed variables: -#' Same as \code{\link{stat_contour}} -stat_density_2d <- function(mapping = NULL, data = NULL, - geom = "density_2d", position = "identity", +#' Same as \code{\link{a_stat_contour}} +a_stat_density_2d <- function(mapping = NULL, data = NULL, + a_geom = "density_2d", a_position = "identity", ..., contour = TRUE, n = 100, h = NULL, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatDensity2d, - geom = geom, - position = position, + a_stat = a_StatDensity2d, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, contour = contour, @@ -35,16 +35,16 @@ stat_density_2d <- function(mapping = NULL, data = NULL, } #' @export -#' @rdname geom_density_2d +#' @rdname a_geom_density_2d #' @usage NULL -stat_density2d <- stat_density_2d +a_stat_density2d <- a_stat_density_2d -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatDensity2d <- ggproto("StatDensity2d", Stat, - default_aes = aes(colour = "#3366FF", size = 0.5), +a_StatDensity2d <- a_ggproto("a_StatDensity2d", a_Stat, + default_aes = a_aes(colour = "#3366FF", size = 0.5), required_aes = c("x", "y"), @@ -63,7 +63,7 @@ StatDensity2d <- ggproto("StatDensity2d", Stat, df$group <- data$group[1] if (contour) { - StatContour$compute_panel(df, scales, bins, binwidth) + a_StatContour$compute_panel(df, scales, bins, binwidth) } else { names(df) <- c("x", "y", "density", "group") df$level <- 1 diff --git a/R/stat-density.r b/R/stat-density.r index c1707ed885..50d009b944 100644 --- a/R/stat-density.r +++ b/R/stat-density.r @@ -18,9 +18,9 @@ #' \item{scaled}{density estimate, scaled to maximum of 1} #' } #' @export -#' @rdname geom_density -stat_density <- function(mapping = NULL, data = NULL, - geom = "area", position = "stack", +#' @rdname a_geom_density +a_stat_density <- function(mapping = NULL, data = NULL, + a_geom = "area", a_position = "stack", ..., bw = "nrd0", adjust = 1, @@ -28,16 +28,16 @@ stat_density <- function(mapping = NULL, data = NULL, trim = FALSE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.a_aes = TRUE) { - layer( + a_layer( data = data, mapping = mapping, - stat = StatDensity, - geom = geom, - position = position, + a_stat = a_StatDensity, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( bw = bw, adjust = adjust, @@ -49,13 +49,13 @@ stat_density <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatDensity <- ggproto("StatDensity", Stat, +a_StatDensity <- a_ggproto("a_StatDensity", a_Stat, required_aes = "x", - default_aes = aes(y = ..density.., fill = NA), + default_aes = a_aes(y = ..density.., fill = NA), compute_group = function(data, scales, bw = "nrd0", adjust = 1, kernel = "gaussian", trim = FALSE, na.rm = FALSE) { diff --git a/R/stat-ecdf.r b/R/stat-ecdf.r index 6663da7fa4..fff8600b00 100644 --- a/R/stat-ecdf.r +++ b/R/stat-ecdf.r @@ -1,7 +1,7 @@ #' Empirical Cumulative Density Function #' -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @param na.rm If \code{FALSE} (the default), removes missing values with #' a warning. If \code{TRUE} silently removes missing values. #' @param n if NULL, do not interpolate. If not NULL, this is the number @@ -17,29 +17,29 @@ #' @examples #' \donttest{ #' df <- data.frame(x = rnorm(1000)) -#' ggplot(df, aes(x)) + stat_ecdf(geom = "step") +#' a_plot(df, a_aes(x)) + a_stat_ecdf(a_geom = "step") #' #' df <- data.frame(x = c(rnorm(100, 0, 3), rnorm(100, 0, 10)), #' g = gl(2, 100)) #' -#' ggplot(df, aes(x, colour = g)) + stat_ecdf() +#' a_plot(df, a_aes(x, colour = g)) + a_stat_ecdf() #' } -stat_ecdf <- function(mapping = NULL, data = NULL, - geom = "step", position = "identity", +a_stat_ecdf <- function(mapping = NULL, data = NULL, + a_geom = "step", a_position = "identity", ..., n = NULL, pad = TRUE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatEcdf, - geom = geom, - position = position, + a_stat = a_StatEcdf, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( n = n, na.rm = na.rm, @@ -49,11 +49,11 @@ stat_ecdf <- function(mapping = NULL, data = NULL, } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatEcdf <- ggproto("StatEcdf", Stat, +a_StatEcdf <- a_ggproto("a_StatEcdf", a_Stat, compute_group = function(data, scales, n = NULL, pad = TRUE) { # If n is NULL, use raw values; otherwise interpolate if (is.null(n)) { @@ -70,7 +70,7 @@ StatEcdf <- ggproto("StatEcdf", Stat, data.frame(x = x, y = y) }, - default_aes = aes(y = ..y..), + default_aes = a_aes(y = ..y..), required_aes = c("x") ) diff --git a/R/stat-ellipse.R b/R/stat-ellipse.R index 97c01e3cd6..7477bb242a 100644 --- a/R/stat-ellipse.R +++ b/R/stat-ellipse.R @@ -13,50 +13,50 @@ #' \code{"norm"} assumes a multivariate normal distribution. #' \code{"euclid"} draws a circle with the radius equal to \code{level}, #' representing the euclidean distance from the center. -#' This ellipse probably won't appear circular unless \code{coord_fixed()} is applied. +#' This ellipse probably won't appear circular unless \code{a_coord_fixed()} is applied. #' @param segments The number of segments to be used in drawing the ellipse. -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @export #' @examples -#' ggplot(faithful, aes(waiting, eruptions)) + -#' geom_point() + -#' stat_ellipse() +#' a_plot(faithful, a_aes(waiting, eruptions)) + +#' a_geom_point() + +#' a_stat_ellipse() #' -#' ggplot(faithful, aes(waiting, eruptions, color = eruptions > 3)) + -#' geom_point() + -#' stat_ellipse() +#' a_plot(faithful, a_aes(waiting, eruptions, color = eruptions > 3)) + +#' a_geom_point() + +#' a_stat_ellipse() #' -#' ggplot(faithful, aes(waiting, eruptions, color = eruptions > 3)) + -#' geom_point() + -#' stat_ellipse(type = "norm", linetype = 2) + -#' stat_ellipse(type = "t") +#' a_plot(faithful, a_aes(waiting, eruptions, color = eruptions > 3)) + +#' a_geom_point() + +#' a_stat_ellipse(type = "norm", linetype = 2) + +#' a_stat_ellipse(type = "t") #' -#' ggplot(faithful, aes(waiting, eruptions, color = eruptions > 3)) + -#' geom_point() + -#' stat_ellipse(type = "norm", linetype = 2) + -#' stat_ellipse(type = "euclid", level = 3) + -#' coord_fixed() +#' a_plot(faithful, a_aes(waiting, eruptions, color = eruptions > 3)) + +#' a_geom_point() + +#' a_stat_ellipse(type = "norm", linetype = 2) + +#' a_stat_ellipse(type = "euclid", level = 3) + +#' ggplot2Animint:::a_coord_fixed() #' -#' ggplot(faithful, aes(waiting, eruptions, fill = eruptions > 3)) + -#' stat_ellipse(geom = "polygon") -stat_ellipse <- function(mapping = NULL, data = NULL, - geom = "path", position = "identity", +#' a_plot(faithful, a_aes(waiting, eruptions, fill = eruptions > 3)) + +#' a_stat_ellipse(a_geom = "polygon") +a_stat_ellipse <- function(mapping = NULL, data = NULL, + a_geom = "path", a_position = "identity", ..., type = "t", level = 0.95, segments = 51, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatEllipse, - geom = geom, - position = position, + a_stat = a_StatEllipse, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( type = type, level = level, @@ -67,21 +67,21 @@ stat_ellipse <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatEllipse <- ggproto("StatEllipse", Stat, +a_StatEllipse <- a_ggproto("a_StatEllipse", a_Stat, required_aes = c("x", "y"), compute_group = function(data, scales, type = "t", level = 0.95, segments = 51, na.rm = FALSE) { - calculate_ellipse(data = data, vars = c("x", "y"), type = type, + a_calculate_ellipse(data = data, vars = c("x", "y"), type = type, level = level, segments = segments) } ) -calculate_ellipse <- function(data, vars, type, level, segments){ +a_calculate_ellipse <- function(data, vars, type, level, segments){ dfn <- 2 dfd <- nrow(data) - 1 diff --git a/R/stat-function.r b/R/stat-function.r index ed499b8e9e..9bed5971b8 100644 --- a/R/stat-function.r +++ b/R/stat-function.r @@ -1,14 +1,14 @@ #' Superimpose a function. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("stat", "function")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_stat", "function")} #' #' @param fun function to use #' @param n number of points to interpolate along #' @param args list of additional arguments to pass to \code{fun} #' @param xlim Optionally, restrict the range of the function to this range. -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @section Computed variables: #' \describe{ #' \item{x}{x's along a grid} @@ -21,34 +21,34 @@ #' x = rnorm(100) #' ) #' x <- df$x -#' base <- ggplot(df, aes(x)) + geom_density() -#' base + stat_function(fun = dnorm, colour = "red") -#' base + stat_function(fun = dnorm, colour = "red", args = list(mean = 3)) +#' base <- a_plot(df, a_aes(x)) + a_geom_density() +#' base + a_stat_function(fun = dnorm, colour = "red") +#' base + a_stat_function(fun = dnorm, colour = "red", args = list(mean = 3)) #' #' # Plot functions without data #' # Examples adapted from Kohske Takahashi #' #' # Specify range of x-axis -#' ggplot(data.frame(x = c(0, 2)), aes(x)) + -#' stat_function(fun = exp, geom = "line") +#' a_plot(data.frame(x = c(0, 2)), a_aes(x)) + +#' a_stat_function(fun = exp, a_geom = "line") #' #' # Plot a normal curve -#' ggplot(data.frame(x = c(-5, 5)), aes(x)) + stat_function(fun = dnorm) +#' a_plot(data.frame(x = c(-5, 5)), a_aes(x)) + a_stat_function(fun = dnorm) #' #' # To specify a different mean or sd, use the args parameter to supply new values -#' ggplot(data.frame(x = c(-5, 5)), aes(x)) + -#' stat_function(fun = dnorm, args = list(mean = 2, sd = .5)) +#' a_plot(data.frame(x = c(-5, 5)), a_aes(x)) + +#' a_stat_function(fun = dnorm, args = list(mean = 2, sd = .5)) #' #' # Two functions on the same plot -#' f <- ggplot(data.frame(x = c(0, 10)), aes(x)) -#' f + stat_function(fun = sin, colour = "red") + -#' stat_function(fun = cos, colour = "blue") +#' f <- a_plot(data.frame(x = c(0, 10)), a_aes(x)) +#' f + a_stat_function(fun = sin, colour = "red") + +#' a_stat_function(fun = cos, colour = "blue") #' #' # Using a custom function #' test <- function(x) {x ^ 2 + x + 20} -#' f + stat_function(fun = test) -stat_function <- function(mapping = NULL, data = NULL, - geom = "path", position = "identity", +#' f + a_stat_function(fun = test) +a_stat_function <- function(mapping = NULL, data = NULL, + a_geom = "path", a_position = "identity", ..., fun, xlim = NULL, @@ -56,15 +56,15 @@ stat_function <- function(mapping = NULL, data = NULL, args = list(), na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatFunction, - geom = geom, - position = position, + a_stat = a_StatFunction, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( fun = fun, n = n, @@ -76,12 +76,12 @@ stat_function <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatFunction <- ggproto("StatFunction", Stat, - default_aes = aes(y = ..y..), +a_StatFunction <- a_ggproto("a_StatFunction", a_Stat, + default_aes = a_aes(y = ..y..), compute_group = function(data, scales, fun, xlim = NULL, n = 101, args = list()) { range <- xlim %||% scales$x$dimension() diff --git a/R/stat-identity.r b/R/stat-identity.r index 71bfb89b42..7feda6896c 100644 --- a/R/stat-identity.r +++ b/R/stat-identity.r @@ -2,25 +2,25 @@ #' #' The identity statistic leaves the data unchanged. #' -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @export #' @examples -#' p <- ggplot(mtcars, aes(wt, mpg)) -#' p + stat_identity() -stat_identity <- function(mapping = NULL, data = NULL, - geom = "point", position = "identity", +#' p <- a_plot(mtcars, a_aes(wt, mpg)) +#' p + a_stat_identity() +a_stat_identity <- function(mapping = NULL, data = NULL, + a_geom = "point", a_position = "identity", ..., show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatIdentity, - geom = geom, - position = position, + a_stat = a_StatIdentity, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = FALSE, ... @@ -28,11 +28,11 @@ stat_identity <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatIdentity <- ggproto("StatIdentity", Stat, +a_StatIdentity <- a_ggproto("a_StatIdentity", a_Stat, compute_layer = function(data, scales, params) { data } diff --git a/R/stat-qq.r b/R/stat-qq.r index 23e8e61142..b96328a2c3 100644 --- a/R/stat-qq.r +++ b/R/stat-qq.r @@ -1,13 +1,13 @@ #' Calculation for quantile-quantile plot. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("stat", "qq")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_stat", "qq")} #' #' @param distribution Distribution function to use, if x not specified #' @param dparams Additional parameters passed on to \code{distribution} #' function. -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @section Computed variables: #' \describe{ #' \item{sample}{sample quantiles} @@ -17,37 +17,37 @@ #' @examples #' \donttest{ #' df <- data.frame(y = rt(200, df = 5)) -#' p <- ggplot(df, aes(sample = y)) -#' p + stat_qq() -#' p + geom_point(stat = "qq") +#' p <- a_plot(df, a_aes(sample = y)) +#' p + a_stat_qq() +#' p + a_geom_point(a_stat = "qq") #' #' # Use fitdistr from MASS to estimate distribution params #' params <- as.list(MASS::fitdistr(df$y, "t")$estimate) -#' ggplot(df, aes(sample = y)) + -#' stat_qq(distribution = qt, dparams = params["df"]) +#' a_plot(df, a_aes(sample = y)) + +#' a_stat_qq(distribution = qt, dparams = params["df"]) #' #' # Using to explore the distribution of a variable -#' ggplot(mtcars) + -#' stat_qq(aes(sample = mpg)) -#' ggplot(mtcars) + -#' stat_qq(aes(sample = mpg, colour = factor(cyl))) +#' a_plot(mtcars) + +#' a_stat_qq(a_aes(sample = mpg)) +#' a_plot(mtcars) + +#' a_stat_qq(a_aes(sample = mpg, colour = factor(cyl))) #' } -stat_qq <- function(mapping = NULL, data = NULL, - geom = "point", position = "identity", +a_stat_qq <- function(mapping = NULL, data = NULL, + a_geom = "point", a_position = "identity", ..., distribution = stats::qnorm, dparams = list(), na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatQq, - geom = geom, - position = position, + a_stat = a_StatQq, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( distribution = distribution, dparams = dparams, @@ -58,15 +58,15 @@ stat_qq <- function(mapping = NULL, data = NULL, } #' @export -#' @rdname stat_qq -geom_qq <- stat_qq +#' @rdname a_stat_qq +a_geom_qq <- a_stat_qq -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatQq <- ggproto("StatQq", Stat, - default_aes = aes(y = ..sample.., x = ..theoretical..), +a_StatQq <- a_ggproto("a_StatQq", a_Stat, + default_aes = a_aes(y = ..sample.., x = ..theoretical..), required_aes = c("sample"), diff --git a/R/stat-quantile.r b/R/stat-quantile.r index ace21c7569..bda345f355 100644 --- a/R/stat-quantile.r +++ b/R/stat-quantile.r @@ -2,16 +2,16 @@ #' @param formula formula relating y variables to x variables #' @param method Quantile regression method to use. Currently only supports #' \code{\link[quantreg]{rq}}. -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @section Computed variables: #' \describe{ #' \item{quantile}{quantile of distribution} #' } #' @export -#' @rdname geom_quantile -stat_quantile <- function(mapping = NULL, data = NULL, - geom = "quantile", position = "identity", +#' @rdname a_geom_quantile +a_stat_quantile <- function(mapping = NULL, data = NULL, + a_geom = "quantile", a_position = "identity", ..., quantiles = c(0.25, 0.5, 0.75), formula = NULL, @@ -19,15 +19,15 @@ stat_quantile <- function(mapping = NULL, data = NULL, method.args = list(), na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatQuantile, - geom = geom, - position = position, + a_stat = a_StatQuantile, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( quantiles = quantiles, formula = formula, @@ -40,21 +40,21 @@ stat_quantile <- function(mapping = NULL, data = NULL, } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatQuantile <- ggproto("StatQuantile", Stat, +a_StatQuantile <- a_ggproto("a_StatQuantile", a_Stat, required_aes = c("x", "y"), compute_group = function(data, scales, quantiles = c(0.25, 0.5, 0.75), formula = NULL, xseq = NULL, method = "rq", method.args = list(), lambda = 1, na.rm = FALSE) { - try_require("quantreg", "stat_quantile") + try_require("quantreg", "a_stat_quantile") if (is.null(formula)) { if (method == "rqss") { - try_require("MatrixModels", "stat_quantile") + try_require("MatrixModels", "a_stat_quantile") formula <- eval(substitute(y ~ qss(x, lambda = lambda)), list(lambda = lambda)) } else { diff --git a/R/stat-smooth.r b/R/stat-smooth.r index f275fb60b0..3e3bd6391a 100644 --- a/R/stat-smooth.r +++ b/R/stat-smooth.r @@ -23,9 +23,9 @@ #' \item{se}{standard error} #' } #' @export -#' @rdname geom_smooth -stat_smooth <- function(mapping = NULL, data = NULL, - geom = "smooth", position = "identity", +#' @rdname a_geom_smooth +a_stat_smooth <- function(mapping = NULL, data = NULL, + a_geom = "smooth", a_position = "identity", ..., method = "auto", formula = y ~ x, @@ -37,15 +37,15 @@ stat_smooth <- function(mapping = NULL, data = NULL, method.args = list(), na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatSmooth, - geom = geom, - position = position, + a_stat = a_StatSmooth, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( method = method, formula = formula, @@ -61,11 +61,11 @@ stat_smooth <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatSmooth <- ggproto("StatSmooth", Stat, +a_StatSmooth <- a_ggproto("a_StatSmooth", a_Stat, setup_params = function(data, params) { # Figure out what type of smoothing to do: loess for small datasets, diff --git a/R/stat-sum.r b/R/stat-sum.r index 62cf8ec803..cd463a5507 100644 --- a/R/stat-sum.r +++ b/R/stat-sum.r @@ -1,26 +1,26 @@ -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @section Computed variables: #' \describe{ #' \item{n}{number of observations at position} -#' \item{prop}{percent of points in that panel at that position} +#' \item{prop}{percent of points in that panel at that a_position} #' } #' @export -#' @rdname geom_count -stat_sum <- function(mapping = NULL, data = NULL, - geom = "point", position = "identity", +#' @rdname a_geom_count +a_stat_sum <- function(mapping = NULL, data = NULL, + a_geom = "point", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatSum, - geom = geom, - position = position, + a_stat = a_StatSum, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -28,12 +28,12 @@ stat_sum <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatSum <- ggproto("StatSum", Stat, - default_aes = aes(size = ..n..), +a_StatSum <- a_ggproto("a_StatSum", a_Stat, + default_aes = a_aes(size = ..n..), required_aes = c("x", "y"), diff --git a/R/stat-summary-2d.r b/R/stat-summary-2d.r index 4869038a5a..a0a20b7326 100644 --- a/R/stat-summary-2d.r +++ b/R/stat-summary-2d.r @@ -1,8 +1,8 @@ #' Bin and summarise in 2d (rectangle & hexagons) #' -#' \code{stat_summary_2d} is a 2d variation of \code{\link{stat_summary}}. -#' \code{stat_summary_hex} is a hexagonal variation of -#' \code{\link{stat_summary_2d}}. The data are divided into bins defined +#' \code{a_stat_summary_2d} is a 2d variation of \code{\link{a_stat_summary}}. +#' \code{a_stat_summary_hex} is a hexagonal variation of +#' \code{\link{a_stat_summary_2d}}. The data are divided into bins defined #' by \code{x} and \code{y}, and then the values of \code{z} in each cell is #' are summarised with \code{fun}. #' @@ -17,29 +17,29 @@ #' \item{x,y}{Location} #' \item{value}{Value of summary statistic.} #' } -#' @seealso \code{\link{stat_summary_hex}} for hexagonal summarization. -#' \code{\link{stat_bin2d}} for the binning options. -#' @inheritParams layer -#' @inheritParams geom_point -#' @inheritParams stat_bin_2d +#' @seealso \code{\link{a_stat_summary_hex}} for hexagonal summarization. +#' \code{\link{a_stat_bin2d}} for the binning options. +#' @inheritParams a_layer +#' @inheritParams a_geom_point +#' @inheritParams a_stat_bin_2d #' @param drop drop if the output of \code{fun} is \code{NA}. #' @param fun function for summary. #' @param fun.args A list of extra arguments to pass to \code{fun} #' @export #' @examples -#' d <- ggplot(diamonds, aes(carat, depth, z = price)) -#' d + stat_summary_2d() +#' d <- a_plot(diamonds, a_aes(carat, depth, z = price)) +#' d + a_stat_summary_2d() #' #' # Specifying function -#' d + stat_summary_2d(fun = function(x) sum(x^2)) -#' d + stat_summary_2d(fun = var) -#' d + stat_summary_2d(fun = "quantile", fun.args = list(probs = 0.1)) +#' d + a_stat_summary_2d(fun = function(x) sum(x^2)) +#' d + a_stat_summary_2d(fun = var) +#' d + a_stat_summary_2d(fun = "quantile", fun.args = list(probs = 0.1)) #' #' if (requireNamespace("hexbin")) { -#' d + stat_summary_hex() +#' d + a_stat_summary_hex() #' } -stat_summary_2d <- function(mapping = NULL, data = NULL, - geom = "tile", position = "identity", +a_stat_summary_2d <- function(mapping = NULL, data = NULL, + a_geom = "tile", a_position = "identity", ..., bins = 30, binwidth = NULL, @@ -48,15 +48,15 @@ stat_summary_2d <- function(mapping = NULL, data = NULL, fun.args = list(), na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatSummary2d, - geom = geom, - position = position, + a_stat = a_StatSummary2d, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( bins = bins, binwidth = binwidth, @@ -70,19 +70,19 @@ stat_summary_2d <- function(mapping = NULL, data = NULL, } #' @export -#' @rdname stat_summary_2d +#' @rdname a_stat_summary_2d #' @usage NULL -stat_summary2d <- function(...) { - message("Please use stat_summary_2d() instead") - stat_summary_2d(...) +a_stat_summary2d <- function(...) { + message("Please use a_stat_summary_2d() instead") + a_stat_summary_2d(...) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatSummary2d <- ggproto("StatSummary2d", Stat, - default_aes = aes(fill = ..value..), +a_StatSummary2d <- a_ggproto("a_StatSummary2d", a_Stat, + default_aes = a_aes(fill = ..value..), required_aes = c("x", "y", "z"), diff --git a/R/stat-summary-bin.R b/R/stat-summary-bin.R index 2df1a28ec1..cb68c8f682 100644 --- a/R/stat-summary-bin.R +++ b/R/stat-summary-bin.R @@ -1,8 +1,8 @@ -#' @rdname stat_summary -#' @inheritParams stat_bin +#' @rdname a_stat_summary +#' @inheritParams a_stat_bin #' @export -stat_summary_bin <- function(mapping = NULL, data = NULL, - geom = "pointrange", position = "identity", +a_stat_summary_bin <- function(mapping = NULL, data = NULL, + a_geom = "pointrange", a_position = "identity", ..., fun.data = NULL, fun.y = NULL, @@ -11,15 +11,15 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, fun.args = list(), na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatSummaryBin, - geom = geom, - position = position, + a_stat = a_StatSummaryBin, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( fun.data = fun.data, fun.y = fun.y, @@ -32,11 +32,11 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatSummaryBin <- ggproto("StatSummaryBin", Stat, +a_StatSummaryBin <- a_ggproto("a_StatSummaryBin", a_Stat, required_aes = c("x", "y"), compute_group = function(data, scales, fun.data = NULL, fun.y = NULL, @@ -44,7 +44,7 @@ StatSummaryBin <- ggproto("StatSummaryBin", Stat, bins = 30, binwidth = NULL, origin = NULL, right = FALSE, na.rm = FALSE) { - fun <- make_summary_fun(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) + fun <- a_make_summary_fun(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) breaks <- bin2d_breaks(scales$x, NULL, origin, binwidth, bins, right = right) @@ -58,7 +58,7 @@ StatSummaryBin <- ggproto("StatSummaryBin", Stat, } ) -make_summary_fun <- function(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) { +a_make_summary_fun <- function(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) { if (!is.null(fun.data)) { # Function that takes complete data frame as input fun.data <- match.fun(fun.data) @@ -81,9 +81,9 @@ make_summary_fun <- function(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) { ) } } else { - message("No summary function supplied, defaulting to `mean_se()") + message("No summary function supplied, defaulting to `a_mean_se()") function(df) { - mean_se(df$y) + a_mean_se(df$y) } } } diff --git a/R/stat-summary-hex.r b/R/stat-summary-hex.r index 844b5eb4c1..75d693e51a 100644 --- a/R/stat-summary-hex.r +++ b/R/stat-summary-hex.r @@ -1,8 +1,8 @@ #' @export -#' @rdname stat_summary_2d -#' @inheritParams stat_bin_hex -stat_summary_hex <- function(mapping = NULL, data = NULL, - geom = "hex", position = "identity", +#' @rdname a_stat_summary_2d +#' @inheritParams a_stat_bin_hex +a_stat_summary_hex <- function(mapping = NULL, data = NULL, + a_geom = "hex", a_position = "identity", ..., bins = 30, binwidth = NULL, @@ -11,15 +11,15 @@ stat_summary_hex <- function(mapping = NULL, data = NULL, fun.args = list(), na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatSummaryHex, - geom = geom, - position = position, + a_stat = a_StatSummaryHex, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( bins = bins, binwidth = binwidth, @@ -32,18 +32,18 @@ stat_summary_hex <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatSummaryHex <- ggproto("StatSummaryHex", Stat, - default_aes = aes(fill = ..value..), +a_StatSummaryHex <- a_ggproto("a_StatSummaryHex", a_Stat, + default_aes = a_aes(fill = ..value..), required_aes = c("x", "y", "z"), compute_group = function(data, scales, binwidth = NULL, bins = 30, drop = TRUE, fun = "mean", fun.args = list()) { - try_require("hexbin", "stat_summary_hex") + try_require("hexbin", "a_stat_summary_hex") binwidth <- binwidth %||% hex_binwidth(bins, scales) hexBinSummarise(data$x, data$y, data$z, binwidth, diff --git a/R/stat-summary.r b/R/stat-summary.r index 83be6351bd..26122604d6 100644 --- a/R/stat-summary.r +++ b/R/stat-summary.r @@ -1,17 +1,17 @@ #' Summarise y values at unique/binned x x. #' -#' \code{stat_summary} operates on unique \code{x}; \code{stat_summary_bin} +#' \code{a_stat_summary} operates on unique \code{x}; \code{a_stat_summary_bin} #' operators on binned \code{x}. They are more flexible versions of -#' \code{\link{stat_bin}}: instead of just counting, they can compute any +#' \code{\link{a_stat_bin}}: instead of just counting, they can compute any #' aggregate. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("stat", "summary")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_stat", "summary")} #' -#' @seealso \code{\link{geom_errorbar}}, \code{\link{geom_pointrange}}, -#' \code{\link{geom_linerange}}, \code{\link{geom_crossbar}} for geoms to +#' @seealso \code{\link{a_geom_errorbar}}, \code{\link{a_geom_pointrange}}, +#' \code{\link{a_geom_linerange}}, \code{\link{a_geom_crossbar}} for geoms to #' display summarised data -#' @inheritParams stat_identity +#' @inheritParams a_stat_identity #' @section Summary functions: #' You can either supply summary functions individually (\code{fun.y}, #' \code{fun.ymax}, \code{fun.ymin}), or as a single function (\code{fun.data}): @@ -32,7 +32,7 @@ #' multiple values at once (e.g. ymin and ymax), use \code{fun.data}. #' #' If no aggregation functions are suppled, will default to -#' \code{\link{mean_se}}. +#' \code{\link{a_mean_se}}. #' #' @param fun.data A function that is given the complete data and should #' return a data frame with variables \code{ymin}, \code{y}, and \code{ymax}. @@ -42,50 +42,49 @@ #' @param fun.args Optional additional arguments passed on to the functions. #' @export #' @examples -#' d <- ggplot(mtcars, aes(cyl, mpg)) + geom_point() -#' d + stat_summary(fun.data = "mean_cl_boot", colour = "red", size = 2) +#' d <- a_plot(mtcars, a_aes(cyl, mpg)) + a_geom_point() #' #' # You can supply individual functions to summarise the value at #' # each x: -#' d + stat_summary(fun.y = "median", colour = "red", size = 2, geom = "point") -#' d + stat_summary(fun.y = "mean", colour = "red", size = 2, geom = "point") -#' d + aes(colour = factor(vs)) + stat_summary(fun.y = mean, geom="line") +#' d + a_stat_summary(fun.y = "median", colour = "red", size = 2, a_geom = "point") +#' d + a_stat_summary(fun.y = "mean", colour = "red", size = 2, a_geom = "point") +#' d + a_aes(colour = factor(vs)) + a_stat_summary(fun.y = mean, a_geom="line") #' -#' d + stat_summary(fun.y = mean, fun.ymin = min, fun.ymax = max, +#' d + a_stat_summary(fun.y = mean, fun.ymin = min, fun.ymax = max, #' colour = "red") #' -#' d <- ggplot(diamonds, aes(cut)) -#' d + geom_bar() -#' d + stat_summary_bin(aes(y = price), fun.y = "mean", geom = "bar") +#' d <- a_plot(diamonds, a_aes(cut)) +#' d + a_geom_bar() +#' d + a_stat_summary_bin(a_aes(y = price), fun.y = "mean", a_geom = "bar") #' #' \donttest{ #' # Don't use ylim to zoom into a summary plot - this throws the #' # data away -#' p <- ggplot(mtcars, aes(cyl, mpg)) + -#' stat_summary(fun.y = "mean", geom = "point") +#' p <- a_plot(mtcars, a_aes(cyl, mpg)) + +#' a_stat_summary(fun.y = "mean", a_geom = "point") #' p #' p + ylim(15, 30) -#' # Instead use coord_cartesian -#' p + coord_cartesian(ylim = c(15, 30)) +#' # Instead use a_coord_cartesian +#' p + a_coord_cartesian(ylim = c(15, 30)) #' #' # A set of useful summary functions is provided from the Hmisc package: -#' stat_sum_df <- function(fun, geom="crossbar", ...) { -#' stat_summary(fun.data = fun, colour = "red", geom = geom, width = 0.2, ...) +#' a_stat_sum_df <- function(fun, a_geom="crossbar", ...) { +#' a_stat_summary(fun.data = fun, colour = "red", a_geom = a_geom, width = 0.2, ...) #' } -#' d <- ggplot(mtcars, aes(cyl, mpg)) + geom_point() +#' d <- a_plot(mtcars, a_aes(cyl, mpg)) + a_geom_point() #' # The crossbar geom needs grouping to be specified when used with #' # a continuous x axis. -#' d + stat_sum_df("mean_cl_boot", mapping = aes(group = cyl)) -#' d + stat_sum_df("mean_sdl", mapping = aes(group = cyl)) -#' d + stat_sum_df("mean_sdl", fun.args = list(mult = 1), mapping = aes(group = cyl)) -#' d + stat_sum_df("median_hilow", mapping = aes(group = cyl)) +#' # d + a_stat_sum_df("a_mean_cl_boot", mapping = a_aes(group = cyl)) +#' d + a_stat_sum_df("a_mean_sdl", mapping = a_aes(group = cyl)) +#' d + a_stat_sum_df("a_mean_sdl", fun.args = list(mult = 1), mapping = a_aes(group = cyl)) +#' d + a_stat_sum_df("a_median_hilow", mapping = a_aes(group = cyl)) #' #' # An example with highly skewed distributions: #' if (require("ggplot2movies")) { #' set.seed(596) #' mov <- movies[sample(nrow(movies), 1000), ] -#' m2 <- ggplot(mov, aes(x = factor(round(rating)), y = votes)) + geom_point() -#' m2 <- m2 + stat_summary(fun.data = "mean_cl_boot", geom = "crossbar", +#' m2 <- a_plot(mov, a_aes(x = factor(round(rating)), y = votes)) + a_geom_point() +#' m2 <- m2 + a_stat_summary(fun.data = "a_mean_cl_boot", a_geom = "crossbar", #' colour = "red", width = 0.3) + xlab("rating") #' m2 #' # Notice how the overplotting skews off visual perception of the mean @@ -95,16 +94,16 @@ #' #' # Transforming the scale means the data are transformed #' # first, after which statistics are computed: -#' m2 + scale_y_log10() +#' m2 + a_scale_y_log10() #' # Transforming the coordinate system occurs after the #' # statistic has been computed. This means we're calculating the summary on the raw data #' # and stretching the geoms onto the log scale. Compare the widths of the #' # standard errors. -#' m2 + coord_trans(y="log10") +#' m2 + a_coord_trans(y="log10") #' } #' } -stat_summary <- function(mapping = NULL, data = NULL, - geom = "pointrange", position = "identity", +a_stat_summary <- function(mapping = NULL, data = NULL, + a_geom = "pointrange", a_position = "identity", ..., fun.data = NULL, fun.y = NULL, @@ -113,15 +112,15 @@ stat_summary <- function(mapping = NULL, data = NULL, fun.args = list(), na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatSummary, - geom = geom, - position = position, + a_stat = a_StatSummary, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( fun.data = fun.data, fun.y = fun.y, @@ -134,18 +133,18 @@ stat_summary <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatSummary <- ggproto("StatSummary", Stat, +a_StatSummary <- a_ggproto("a_StatSummary", a_Stat, required_aes = c("x", "y"), compute_panel = function(data, scales, fun.data = NULL, fun.y = NULL, fun.ymax = NULL, fun.ymin = NULL, fun.args = list(), na.rm = FALSE) { - fun <- make_summary_fun(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) + fun <- a_make_summary_fun(fun.data, fun.y, fun.ymax, fun.ymin, fun.args) summarise_by_x(data, fun) } ) @@ -153,7 +152,7 @@ StatSummary <- ggproto("StatSummary", Stat, # Summarise a data.frame by parts # Summarise a data frame by unique value of x # -# This function is used by \code{\link{stat_summary}} to break a +# This function is used by \code{\link{a_stat_summary}} to break a # data.frame into pieces, summarise each piece, and join the pieces # back together, retaining original columns unaffected by the summary. # @@ -171,7 +170,7 @@ summarise_by_x <- function(data, summary, ...) { } #' Wrap up a selection of summary functions from Hmisc to make it easy to use -#' with \code{\link{stat_summary}}. +#' with \code{\link{a_stat_summary}}. #' #' See the Hmisc documentation for details of their options. #' @@ -183,7 +182,7 @@ summarise_by_x <- function(data, summary, ...) { #' @name hmisc NULL -wrap_hmisc <- function(fun) { +a_wrap_hmisc <- function(fun) { function(x, ...) { if (!requireNamespace("Hmisc", quietly = TRUE)) @@ -201,24 +200,24 @@ wrap_hmisc <- function(fun) { } #' @export #' @rdname hmisc -mean_cl_boot <- wrap_hmisc("smean.cl.boot") +a_mean_cl_boot <- a_wrap_hmisc("smean.cl.boot") #' @export #' @rdname hmisc -mean_cl_normal <- wrap_hmisc("smean.cl.normal") +a_mean_cl_normal <- a_wrap_hmisc("smean.cl.normal") #' @export #' @rdname hmisc -mean_sdl <- wrap_hmisc("smean.sdl") +a_mean_sdl <- a_wrap_hmisc("smean.sdl") #' @export #' @rdname hmisc -median_hilow <- wrap_hmisc("smedian.hilow") +a_median_hilow <- a_wrap_hmisc("smedian.hilow") #' Calculate mean and standard errors on either side. #' #' @param x numeric vector #' @param mult number of multiples of standard error -#' @seealso for use with \code{\link{stat_summary}} +#' @seealso for use with \code{\link{a_stat_summary}} #' @export -mean_se <- function(x, mult = 1) { +a_mean_se <- function(x, mult = 1) { x <- stats::na.omit(x) se <- mult * sqrt(stats::var(x) / length(x)) mean <- mean(x) diff --git a/R/stat-unique.r b/R/stat-unique.r index 73a1a0dabb..fb6ae6b5b8 100644 --- a/R/stat-unique.r +++ b/R/stat-unique.r @@ -1,28 +1,28 @@ #' Remove duplicates. #' #' @section Aesthetics: -#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("stat", "unique")} +#' \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_stat", "unique")} #' #' @export -#' @inheritParams layer -#' @inheritParams geom_point +#' @inheritParams a_layer +#' @inheritParams a_geom_point #' @examples -#' ggplot(mtcars, aes(vs, am)) + geom_point(alpha = 0.1) -#' ggplot(mtcars, aes(vs, am)) + geom_point(alpha = 0.1, stat="unique") -stat_unique <- function(mapping = NULL, data = NULL, - geom = "point", position = "identity", +#' a_plot(mtcars, a_aes(vs, am)) + a_geom_point(alpha = 0.1) +#' a_plot(mtcars, a_aes(vs, am)) + a_geom_point(alpha = 0.1, a_stat="unique") +a_stat_unique <- function(mapping = NULL, data = NULL, + a_geom = "point", a_position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - layer( + inherit.a_aes = TRUE) { + a_layer( data = data, mapping = mapping, - stat = StatUnique, - geom = geom, - position = position, + a_stat = a_StatUnique, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( na.rm = na.rm, ... @@ -30,10 +30,10 @@ stat_unique <- function(mapping = NULL, data = NULL, ) } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatUnique <- ggproto("StatUnique", Stat, +a_StatUnique <- a_ggproto("a_StatUnique", a_Stat, compute_panel = function(data, scales) unique(data) ) diff --git a/R/stat-ydensity.r b/R/stat-ydensity.r index bda4fe39a6..29b9e581cf 100644 --- a/R/stat-ydensity.r +++ b/R/stat-ydensity.r @@ -1,7 +1,7 @@ -#' @inheritParams layer -#' @inheritParams geom_point -#' @inheritParams stat_density -#' @param scale if "area" (default), all violins have the same area (before trimming +#' @inheritParams a_layer +#' @inheritParams a_geom_point +#' @inheritParams a_stat_density +#' @param a_scale if "area" (default), all violins have the same area (before trimming #' the tails). If "count", areas are scaled proportionally to the number of #' observations. If "width", all violins have the same maximum width. #' @section Computed variables: @@ -14,37 +14,37 @@ #' \item{n}{number of points} #' \item{width}{width of violin bounding box} #' } -#' @seealso \code{\link{geom_violin}} for examples, and \code{\link{stat_density}} +#' @seealso \code{\link{a_geom_violin}} for examples, and \code{\link{a_stat_density}} #' for examples with data along the x axis. #' @export -#' @rdname geom_violin -stat_ydensity <- function(mapping = NULL, data = NULL, - geom = "violin", position = "dodge", +#' @rdname a_geom_violin +a_stat_ydensity <- function(mapping = NULL, data = NULL, + a_geom = "violin", a_position = "dodge", ..., bw = "nrd0", adjust = 1, kernel = "gaussian", trim = TRUE, - scale = "area", + a_scale = "area", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { - scale <- match.arg(scale, c("area", "count", "width")) + inherit.a_aes = TRUE) { + a_scale <- match.arg(a_scale, c("area", "count", "width")) - layer( + a_layer( data = data, mapping = mapping, - stat = StatYdensity, - geom = geom, - position = position, + a_stat = a_StatYdensity, + a_geom = a_geom, + a_position = a_position, show.legend = show.legend, - inherit.aes = inherit.aes, + inherit.a_aes = inherit.a_aes, params = list( bw = bw, adjust = adjust, kernel = kernel, trim = trim, - scale = scale, + a_scale = a_scale, na.rm = na.rm, ... ) @@ -52,11 +52,11 @@ stat_ydensity <- function(mapping = NULL, data = NULL, } -#' @rdname ggplot2-ggproto +#' @rdname ggplot2Animint-ggproto #' @format NULL #' @usage NULL #' @export -StatYdensity <- ggproto("StatYdensity", Stat, +a_StatYdensity <- a_ggproto("a_StatYdensity", a_Stat, required_aes = c("x", "y"), non_missing_aes = "weight", @@ -86,14 +86,14 @@ StatYdensity <- ggproto("StatYdensity", Stat, compute_panel = function(self, data, scales, width = NULL, bw = "nrd0", adjust = 1, kernel = "gaussian", trim = TRUE, na.rm = FALSE, - scale = "area") { - data <- ggproto_parent(Stat, self)$compute_panel( + a_scale = "area") { + data <- a_ggproto_parent(a_Stat, self)$compute_panel( data, scales, width = width, bw = bw, adjust = adjust, kernel = kernel, trim = trim, na.rm = na.rm ) # choose how violins are scaled relative to each other - data$violinwidth <- switch(scale, + data$violinwidth <- switch(a_scale, # area : keep the original densities but scale them to a max width of 1 # for plotting purposes only area = data$density / max(data$density), diff --git a/R/summary.r b/R/summary.r index e5422f8ad4..baec3a8ea4 100644 --- a/R/summary.r +++ b/R/summary.r @@ -3,13 +3,13 @@ #' @param object ggplot2 object to summarise #' @param ... other arguments ignored (for compatibility with generic) #' @keywords internal -#' @method summary ggplot +#' @method summary a_plot #' @export #' @examples -#' p <- ggplot(mtcars, aes(mpg, wt)) + -#' geom_point() +#' p <- a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point() #' summary(p) -summary.ggplot <- function(object, ...) { +summary.a_plot <- function(object, ...) { wrap <- function(x) paste( paste(strwrap(x, exdent = 2), collapse = "\n"), "\n", sep = "" diff --git a/R/theme-defaults.r b/R/theme-defaults.r index 4a178314a5..257841e2fa 100644 --- a/R/theme-defaults.r +++ b/R/theme-defaults.r @@ -8,133 +8,133 @@ #' #' @details \describe{ #' -#' \item{\code{theme_gray}}{ +#' \item{\code{a_theme_gray}}{ #' The signature ggplot2 theme with a grey background and white gridlines, #' designed to put the data forward yet make comparisons easy.} #' -#' \item{\code{theme_bw}}{ +#' \item{\code{a_theme_bw}}{ #' The classic dark-on-light ggplot2 theme. May work better for presentations #' displayed with a projector.} #' -#' \item{\code{theme_linedraw}}{ +#' \item{\code{a_theme_linedraw}}{ #' A theme with only black lines of various widths on white backgrounds, -#' reminiscent of a line drawings. Serves a purpose similar to \code{theme_bw}. +#' reminiscent of a line drawings. Serves a purpose similar to \code{a_theme_bw}. #' Note that this theme has some very thin lines (<< 1 pt) which some journals #' may refuse.} #' -#' \item{\code{theme_light}}{ -#' A theme similar to \code{theme_linedraw} but with light grey lines and axes, +#' \item{\code{a_theme_light}}{ +#' A theme similar to \code{a_theme_linedraw} but with light grey lines and axes, #' to direct more attention towards the data.} #' -#' \item{\code{theme_dark}}{ -#' The dark cousin of \code{theme_light}, with similar line sizes but a dark background. Useful to make thin coloured lines pop out.} +#' \item{\code{a_theme_dark}}{ +#' The dark cousin of \code{a_theme_light}, with similar line sizes but a dark background. Useful to make thin coloured lines pop out.} #' -#' \item{\code{theme_minimal}}{ +#' \item{\code{a_theme_minimal}}{ #' A minimalistic theme with no background annotations.} #' -#' \item{\code{theme_classic}}{ +#' \item{\code{a_theme_classic}}{ #' A classic-looking theme, with x and y axis lines and no gridlines.} #' -#' \item{\code{theme_void}}{ +#' \item{\code{a_theme_void}}{ #' A completely empty theme.} #' #' } #' #' @examples -#' p <- ggplot(mtcars) + geom_point(aes(x = wt, y = mpg, -#' colour = factor(gear))) + facet_wrap(~am) +#' p <- a_plot(mtcars) + a_geom_point(a_aes(x = wt, y = mpg, +#' colour = factor(gear))) + ggplot2Animint:::a_facet_wrap(~am) #' #' p -#' p + theme_gray() -#' p + theme_bw() -#' p + theme_linedraw() -#' p + theme_light() -#' p + theme_dark() -#' p + theme_minimal() -#' p + theme_classic() -#' p + theme_void() +#' p + a_theme_gray() +#' p + a_theme_bw() +#' p + a_theme_linedraw() +#' p + a_theme_light() +#' p + a_theme_dark() +#' p + a_theme_minimal() +#' p + a_theme_classic() +#' p + a_theme_void() #' -#' @name ggtheme +#' @name aatheme NULL #' @export -#' @rdname ggtheme -theme_grey <- function(base_size = 11, base_family = "") { +#' @rdname aatheme +a_theme_grey <- function(base_size = 11, base_family = "") { half_line <- base_size / 2 - theme( + a_theme( # Elements in this first block aren't used directly, but are inherited # by others - line = element_line(colour = "black", size = 0.5, linetype = 1, + line = a_element_line(colour = "black", size = 0.5, linetype = 1, lineend = "butt"), - rect = element_rect(fill = "white", colour = "black", + rect = a_element_rect(fill = "white", colour = "black", size = 0.5, linetype = 1), - text = element_text( + text = a_element_text( family = base_family, face = "plain", colour = "black", size = base_size, lineheight = 0.9, hjust = 0.5, vjust = 0.5, angle = 0, margin = margin(), debug = FALSE ), - axis.line = element_line(), - axis.line.x = element_blank(), - axis.line.y = element_blank(), - axis.text = element_text(size = rel(0.8), colour = "grey30"), - axis.text.x = element_text(margin = margin(t = 0.8 * half_line / 2), vjust = 1), - axis.text.y = element_text(margin = margin(r = 0.8 * half_line / 2), hjust = 1), - axis.ticks = element_line(colour = "grey20"), + axis.line = a_element_line(), + axis.line.x = a_element_blank(), + axis.line.y = a_element_blank(), + axis.text = a_element_text(size = rel(0.8), colour = "grey30"), + axis.text.x = a_element_text(margin = margin(t = 0.8 * half_line / 2), vjust = 1), + axis.text.y = a_element_text(margin = margin(r = 0.8 * half_line / 2), hjust = 1), + axis.ticks = a_element_line(colour = "grey20"), axis.ticks.length = unit(half_line / 2, "pt"), - axis.title.x = element_text( + axis.title.x = a_element_text( margin = margin(t = 0.8 * half_line, b = 0.8 * half_line / 2) ), - axis.title.y = element_text( + axis.title.y = a_element_text( angle = 90, margin = margin(r = 0.8 * half_line, l = 0.8 * half_line / 2) ), - legend.background = element_rect(colour = NA), + legend.background = a_element_rect(colour = NA), legend.margin = unit(0.2, "cm"), - legend.key = element_rect(fill = "grey95", colour = "white"), + legend.key = a_element_rect(fill = "grey95", colour = "white"), legend.key.size = unit(1.2, "lines"), legend.key.height = NULL, legend.key.width = NULL, - legend.text = element_text(size = rel(0.8)), + legend.text = a_element_text(size = rel(0.8)), legend.text.align = NULL, - legend.title = element_text(hjust = 0), + legend.title = a_element_text(hjust = 0), legend.title.align = NULL, - legend.position = "right", + legend.a_position = "right", legend.direction = NULL, legend.justification = "center", legend.box = NULL, - panel.background = element_rect(fill = "grey92", colour = NA), - panel.border = element_blank(), - panel.grid.major = element_line(colour = "white"), - panel.grid.minor = element_line(colour = "white", size = 0.25), + panel.background = a_element_rect(fill = "grey92", colour = NA), + panel.border = a_element_blank(), + panel.grid.major = a_element_line(colour = "white"), + panel.grid.minor = a_element_line(colour = "white", size = 0.25), panel.margin = unit(half_line, "pt"), panel.margin.x = NULL, panel.margin.y = NULL, panel.ontop = FALSE, - strip.background = element_rect(fill = "grey85", colour = NA), - strip.text = element_text(colour = "grey10", size = rel(0.8)), - strip.text.x = element_text(margin = margin(t = half_line, b = half_line)), - strip.text.y = element_text(angle = -90, margin = margin(l = half_line, r = half_line)), + strip.background = a_element_rect(fill = "grey85", colour = NA), + strip.text = a_element_text(colour = "grey10", size = rel(0.8)), + strip.text.x = a_element_text(margin = margin(t = half_line, b = half_line)), + strip.text.y = a_element_text(angle = -90, margin = margin(l = half_line, r = half_line)), strip.switch.pad.grid = unit(0.1, "cm"), strip.switch.pad.wrap = unit(0.1, "cm"), - plot.background = element_rect(colour = "white"), - plot.title = element_text( + plot.background = a_element_rect(colour = "white"), + plot.title = a_element_text( size = rel(1.2), hjust = 0, margin = margin(b = half_line * 1.2) ), - plot.subtitle = element_text( + plot.subtitle = a_element_text( size = rel(0.9), hjust = 0, margin = margin(b = half_line * 0.9) ), - plot.caption = element_text( + plot.caption = a_element_text( size = rel(0.9), hjust = 1, margin = margin(b = half_line * 0.9) @@ -145,46 +145,46 @@ theme_grey <- function(base_size = 11, base_family = "") { ) } #' @export -#' @rdname ggtheme -theme_gray <- theme_grey +#' @rdname aatheme +a_theme_gray <- a_theme_grey #' @export -#' @rdname ggtheme -theme_bw <- function(base_size = 12, base_family = "") { - # Starts with theme_grey and then modify some parts - theme_grey(base_size = base_size, base_family = base_family) %+replace% - theme( - axis.text = element_text(size = rel(0.8)), - axis.ticks = element_line(colour = "black"), - legend.key = element_rect(colour = "grey80"), - panel.background = element_rect(fill = "white", colour = NA), - panel.border = element_rect(fill = NA, colour = "grey50"), - panel.grid.major = element_line(colour = "grey90", size = 0.2), - panel.grid.minor = element_line(colour = "grey98", size = 0.5), - strip.background = element_rect(fill = "grey80", colour = "grey50", size = 0.2) +#' @rdname aatheme +a_theme_bw <- function(base_size = 12, base_family = "") { + # Starts with a_theme_grey and then modify some parts + a_theme_grey(base_size = base_size, base_family = base_family) %+replace% + a_theme( + axis.text = a_element_text(size = rel(0.8)), + axis.ticks = a_element_line(colour = "black"), + legend.key = a_element_rect(colour = "grey80"), + panel.background = a_element_rect(fill = "white", colour = NA), + panel.border = a_element_rect(fill = NA, colour = "grey50"), + panel.grid.major = a_element_line(colour = "grey90", size = 0.2), + panel.grid.minor = a_element_line(colour = "grey98", size = 0.5), + strip.background = a_element_rect(fill = "grey80", colour = "grey50", size = 0.2) ) } #' @export -#' @rdname ggtheme -theme_linedraw <- function(base_size = 12, base_family = "") { +#' @rdname aatheme +a_theme_linedraw <- function(base_size = 12, base_family = "") { half_line <- base_size / 2 - # Starts with theme_grey and then modify some parts - theme_grey(base_size = base_size, base_family = base_family) %+replace% - theme( - axis.text = element_text(colour = "black", size = rel(0.8)), - axis.ticks = element_line(colour = "black", size = 0.25), - legend.key = element_rect(colour = "black", size = 0.25), - panel.background = element_rect(fill = "white", colour = NA), - panel.border = element_rect(fill = NA, colour = "black", size = 0.5), - panel.grid.major = element_line(colour = "black", size = 0.05), - panel.grid.minor = element_line(colour = "black", size = 0.01), - strip.background = element_rect(fill = "black", colour = NA), - strip.text.x = element_text( + # Starts with a_theme_grey and then modify some parts + a_theme_grey(base_size = base_size, base_family = base_family) %+replace% + a_theme( + axis.text = a_element_text(colour = "black", size = rel(0.8)), + axis.ticks = a_element_line(colour = "black", size = 0.25), + legend.key = a_element_rect(colour = "black", size = 0.25), + panel.background = a_element_rect(fill = "white", colour = NA), + panel.border = a_element_rect(fill = NA, colour = "black", size = 0.5), + panel.grid.major = a_element_line(colour = "black", size = 0.05), + panel.grid.minor = a_element_line(colour = "black", size = 0.01), + strip.background = a_element_rect(fill = "black", colour = NA), + strip.text.x = a_element_text( colour = "white", margin = margin(t = half_line, b = half_line) ), - strip.text.y = element_text( + strip.text.y = a_element_text( colour = "white", angle = 90, margin = margin(l = half_line, r = half_line) @@ -193,24 +193,24 @@ theme_linedraw <- function(base_size = 12, base_family = "") { } #' @export -#' @rdname ggtheme -theme_light <- function(base_size = 12, base_family = "") { +#' @rdname aatheme +a_theme_light <- function(base_size = 12, base_family = "") { half_line <- base_size / 2 - # Starts with theme_grey and then modify some parts - theme_grey(base_size = base_size, base_family = base_family) %+replace% - theme( - axis.ticks = element_line(colour = "grey70", size = 0.25), - legend.key = element_rect(fill = "white", colour = "grey50", size = 0.25), - panel.background = element_rect(fill = "white", colour = NA), - panel.border = element_rect(fill = NA, colour = "grey70", size = 0.5), - panel.grid.major = element_line(colour = "grey85", size = 0.25), - panel.grid.minor = element_line(colour = "grey93", size = 0.125), - strip.background = element_rect(fill = "grey70", colour = NA), - strip.text.x = element_text( + # Starts with a_theme_grey and then modify some parts + a_theme_grey(base_size = base_size, base_family = base_family) %+replace% + a_theme( + axis.ticks = a_element_line(colour = "grey70", size = 0.25), + legend.key = a_element_rect(fill = "white", colour = "grey50", size = 0.25), + panel.background = a_element_rect(fill = "white", colour = NA), + panel.border = a_element_rect(fill = NA, colour = "grey70", size = 0.5), + panel.grid.major = a_element_line(colour = "grey85", size = 0.25), + panel.grid.minor = a_element_line(colour = "grey93", size = 0.125), + strip.background = a_element_rect(fill = "grey70", colour = NA), + strip.text.x = a_element_text( colour = "white", margin = margin(t = half_line, b = half_line) ), - strip.text.y = element_text( + strip.text.y = a_element_text( colour = "white", angle = -90, margin = margin(l = half_line, r = half_line) @@ -220,60 +220,60 @@ theme_light <- function(base_size = 12, base_family = "") { } #' @export -#' @rdname ggtheme -theme_minimal <- function(base_size = 12, base_family = "") { - # Starts with theme_bw and then modify some parts - theme_bw(base_size = base_size, base_family = base_family) %+replace% - theme( - legend.background = element_blank(), - legend.key = element_blank(), - panel.background = element_blank(), - panel.border = element_blank(), - strip.background = element_blank(), - plot.background = element_blank(), - axis.ticks = element_line(), - axis.ticks.x = element_blank(), - axis.ticks.y = element_blank(), +#' @rdname aatheme +a_theme_minimal <- function(base_size = 12, base_family = "") { + # Starts with a_theme_bw and then modify some parts + a_theme_bw(base_size = base_size, base_family = base_family) %+replace% + a_theme( + legend.background = a_element_blank(), + legend.key = a_element_blank(), + panel.background = a_element_blank(), + panel.border = a_element_blank(), + strip.background = a_element_blank(), + plot.background = a_element_blank(), + axis.ticks = a_element_line(), + axis.ticks.x = a_element_blank(), + axis.ticks.y = a_element_blank(), axis.ticks.length = unit(1, "lines") ) } #' @export -#' @rdname ggtheme -theme_classic <- function(base_size = 12, base_family = ""){ - theme_bw(base_size = base_size, base_family = base_family) %+replace% - theme( - panel.border = element_blank(), - axis.line = element_line(colour = "black"), - panel.grid.major = element_line(), - panel.grid.major.x = element_blank(), - panel.grid.major.y = element_blank(), - panel.grid.minor = element_line(), - panel.grid.minor.x = element_blank(), - panel.grid.minor.y = element_blank(), - strip.background = element_rect(colour = "black", size = 0.5), - legend.key = element_blank() +#' @rdname aatheme +a_theme_classic <- function(base_size = 12, base_family = ""){ + a_theme_bw(base_size = base_size, base_family = base_family) %+replace% + a_theme( + panel.border = a_element_blank(), + axis.line = a_element_line(colour = "black"), + panel.grid.major = a_element_line(), + panel.grid.major.x = a_element_blank(), + panel.grid.major.y = a_element_blank(), + panel.grid.minor = a_element_line(), + panel.grid.minor.x = a_element_blank(), + panel.grid.minor.y = a_element_blank(), + strip.background = a_element_rect(colour = "black", size = 0.5), + legend.key = a_element_blank() ) } #' @export -#' @rdname ggtheme -theme_dark <- function(base_size = 12, base_family = "") { +#' @rdname aatheme +a_theme_dark <- function(base_size = 12, base_family = "") { half_line <- base_size / 2 - # Starts with theme_grey and then modify some parts - theme_grey(base_size = base_size, base_family = base_family) %+replace% - theme( - axis.ticks = element_line(colour = "grey40", size = 0.25), - legend.key = element_rect(fill = "grey50", colour = "grey40", size = 0.25), - panel.background = element_rect(fill = "grey50", colour = NA), - panel.grid.major = element_line(colour = "grey40", size = 0.25), - panel.grid.minor = element_line(colour = "grey45", size = 0.125), - strip.background = element_rect(fill = "grey20", colour = NA), - strip.text.x = element_text( + # Starts with a_theme_grey and then modify some parts + a_theme_grey(base_size = base_size, base_family = base_family) %+replace% + a_theme( + axis.ticks = a_element_line(colour = "grey40", size = 0.25), + legend.key = a_element_rect(fill = "grey50", colour = "grey40", size = 0.25), + panel.background = a_element_rect(fill = "grey50", colour = NA), + panel.grid.major = a_element_line(colour = "grey40", size = 0.25), + panel.grid.minor = a_element_line(colour = "grey45", size = 0.125), + strip.background = a_element_rect(fill = "grey20", colour = NA), + strip.text.x = a_element_text( colour = "white", margin = margin(t = half_line, b = half_line) ), - strip.text.y = element_text( + strip.text.y = a_element_text( colour = "white", angle = -90, margin = margin(l = half_line, r = half_line) @@ -282,26 +282,26 @@ theme_dark <- function(base_size = 12, base_family = "") { } #' @export -#' @rdname ggtheme -theme_void <- function(base_size = 12, base_family = "") { - theme( - # Use only inherited elements and make everything blank - line = element_blank(), - rect = element_blank(), - text = element_text( +#' @rdname aatheme +a_theme_void <- function(base_size = 12, base_family = "") { + a_theme( + # Use only inherited a_elements and make everything blank + line = a_element_blank(), + rect = a_element_blank(), + text = a_element_text( family = base_family, face = "plain", colour = "black", size = base_size, lineheight = 0.9, hjust = 0.5, vjust = 0.5, angle = 0, margin = margin(), debug = FALSE ), plot.margin = unit(c(0, 0, 0, 0), "lines"), - axis.text.x = element_blank(), - axis.text.y = element_blank(), - axis.title.x = element_blank(), - axis.title.y = element_blank(), - legend.text = element_text(size = rel(0.8)), - legend.title = element_blank(), - strip.text = element_text(size = rel(0.8)), + axis.text.x = a_element_blank(), + axis.text.y = a_element_blank(), + axis.title.x = a_element_blank(), + axis.title.y = a_element_blank(), + legend.text = a_element_text(size = rel(0.8)), + legend.title = a_element_blank(), + strip.text = a_element_text(size = rel(0.8)), complete = TRUE ) diff --git a/R/theme-elements.r b/R/theme-elements.r index d72b415078..6703cdb74d 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -2,10 +2,10 @@ #' This theme element draws nothing, and assigns no space #' #' @export -element_blank <- function() { +a_element_blank <- function() { structure( list(), - class = c("element_blank", "element") + class = c("a_element_blank", "a_element") ) } @@ -19,13 +19,13 @@ element_blank <- function() { #' @param linetype border linetype #' @param color an alias for \code{colour} #' @export -element_rect <- function(fill = NULL, colour = NULL, size = NULL, +a_element_rect <- function(fill = NULL, colour = NULL, size = NULL, linetype = NULL, color = NULL) { if (!is.null(color)) colour <- color structure( list(fill = fill, colour = colour, size = size, linetype = linetype), - class = c("element_rect", "element") + class = c("a_element_rect", "a_element") ) } @@ -37,13 +37,13 @@ element_rect <- function(fill = NULL, colour = NULL, size = NULL, #' @param lineend line end #' @param color an alias for \code{colour} #' @export -element_line <- function(colour = NULL, size = NULL, linetype = NULL, +a_element_line <- function(colour = NULL, size = NULL, linetype = NULL, lineend = NULL, color = NULL) { if (!is.null(color)) colour <- color structure( list(colour = colour, size = size, linetype = linetype, lineend = lineend), - class = c("element_line", "element") + class = c("a_element_line", "a_element") ) } @@ -63,10 +63,10 @@ element_line <- function(colour = NULL, size = NULL, linetype = NULL, #' details. When creating a theme, the margins should be placed on the #' side of the text facing towards the center of the plot. #' @param debug If \code{TRUE}, aids visual debugging by drawing a solid -#' rectangle behind the complete text area, and a point where each label +#' rectangle behind the complete text area, and a point where each a_label #' is anchored. #' @export -element_text <- function(family = NULL, face = NULL, colour = NULL, +a_element_text <- function(family = NULL, face = NULL, colour = NULL, size = NULL, hjust = NULL, vjust = NULL, angle = NULL, lineheight = NULL, color = NULL, margin = NULL, debug = NULL) { @@ -75,13 +75,13 @@ element_text <- function(family = NULL, face = NULL, colour = NULL, list(family = family, face = face, colour = colour, size = size, hjust = hjust, vjust = vjust, angle = angle, lineheight = lineheight, margin = margin, debug = debug), - class = c("element_text", "element") + class = c("a_element_text", "a_element") ) } #' @export -print.element <- function(x, ...) utils::str(x) +print.a_element <- function(x, ...) utils::str(x) #' Relative sizing for theme elements @@ -89,9 +89,9 @@ print.element <- function(x, ...) utils::str(x) #' @param x A number representing the relative size #' @examples #' df <- data.frame(x = 1:3, y = 1:3) -#' ggplot(df, aes(x, y)) + -#' geom_point() + -#' theme(axis.title.x = element_text(size = rel(2.5))) +#' a_plot(df, a_aes(x, y)) + +#' a_geom_point() + +#' a_theme(axis.title.x = a_element_text(size = rel(2.5))) #' @export rel <- function(x) { structure(x, class = "rel") @@ -105,16 +105,16 @@ print.rel <- function(x, ...) print(noquote(paste(x, " *", sep = ""))) is.rel <- function(x) inherits(x, "rel") # Given a theme object and element name, return a grob for the element -element_render <- function(theme, element, ..., name = NULL) { +a_element_render <- function(a_theme, a_element, ..., name = NULL) { - # Get the element from the theme, calculating inheritance - el <- calc_element(element, theme) + # Get the element from the a_theme, calculating inheritance + el <- a_calc_element(a_element, a_theme) if (is.null(el)) { - message("Theme element ", element, " missing") - return(zeroGrob()) + message("Theme element ", a_element, " missing") + return(a_zeroGrob()) } - ggname(paste(element, name, sep = "."), element_grob(el, ...)) + ggname(paste(a_element, name, sep = "."), a_element_grob(el, ...)) } @@ -127,46 +127,46 @@ len0_null <- function(x) { #' Generate grid grob from theme element #' -#' @param element Theme element, i.e. \code{element_rect} or similar. +#' @param a_element Theme element, i.e. \code{a_element_rect} or similar. #' @param ... Other arguments to control specific of rendering. This is #' usually at least position. See the source code for individual methods. #' @keywords internal #' @export -element_grob <- function(element, ...) { - UseMethod("element_grob") +a_element_grob <- function(a_element, ...) { + UseMethod("a_element_grob") } #' @export -element_grob.element_blank <- function(element, ...) zeroGrob() +a_element_grob.a_element_blank <- function(a_element, ...) a_zeroGrob() #' @export -element_grob.element_rect <- function(element, x = 0.5, y = 0.5, +a_element_grob.a_element_rect <- function(a_element, x = 0.5, y = 0.5, width = 1, height = 1, fill = NULL, colour = NULL, size = NULL, linetype = NULL, ...) { # The gp settings can override element_gp gp <- gpar(lwd = len0_null(size * .pt), col = colour, fill = fill, lty = linetype) - element_gp <- gpar(lwd = len0_null(element$size * .pt), col = element$colour, - fill = element$fill, lty = element$linetype) + a_element_gp <- gpar(lwd = len0_null(a_element$size * .pt), col = a_element$colour, + fill = a_element$fill, lty = a_element$linetype) - rectGrob(x, y, width, height, gp = utils::modifyList(element_gp, gp), ...) + rectGrob(x, y, width, height, gp = utils::modifyList(a_element_gp, gp), ...) } #' @export -element_grob.element_text <- function(element, label = "", x = NULL, y = NULL, +a_element_grob.a_element_text <- function(a_element, a_label = "", x = NULL, y = NULL, family = NULL, face = NULL, colour = NULL, size = NULL, hjust = NULL, vjust = NULL, angle = NULL, lineheight = NULL, margin = NULL, expand_x = FALSE, expand_y = FALSE, ...) { - if (is.null(label)) - return(zeroGrob()) + if (is.null(a_label)) + return(a_zeroGrob()) - vj <- vjust %||% element$vjust - hj <- hjust %||% element$hjust - margin <- margin %||% element$margin + vj <- vjust %||% a_element$vjust + hj <- hjust %||% a_element$hjust + margin <- margin %||% a_element$margin - angle <- angle %||% element$angle + angle <- angle %||% a_element$angle if (is.null(angle)) { stop("Text element requires non-NULL value for 'angle'.") } @@ -175,30 +175,30 @@ element_grob.element_text <- function(element, label = "", x = NULL, y = NULL, gp <- gpar(fontsize = size, col = colour, fontfamily = family, fontface = face, lineheight = lineheight) - element_gp <- gpar(fontsize = element$size, col = element$colour, - fontfamily = element$family, fontface = element$face, - lineheight = element$lineheight) + a_element_gp <- gpar(fontsize = a_element$size, col = a_element$colour, + fontfamily = a_element$family, fontface = a_element$face, + lineheight = a_element$lineheight) - titleGrob(label, x, y, hjust = hj, vjust = vj, angle = angle, - gp = utils::modifyList(element_gp, gp), margin = margin, - expand_x = expand_x, expand_y = expand_y, debug = element$debug) + titleGrob(a_label, x, y, hjust = hj, vjust = vj, angle = angle, + gp = utils::modifyList(a_element_gp, gp), margin = margin, + expand_x = expand_x, expand_y = expand_y, debug = a_element$debug) } #' @export -element_grob.element_line <- function(element, x = 0:1, y = 0:1, +a_element_grob.a_element_line <- function(a_element, x = 0:1, y = 0:1, colour = NULL, size = NULL, linetype = NULL, lineend = NULL, default.units = "npc", id.lengths = NULL, ...) { - # The gp settings can override element_gp + # The gp settings can override a_element_gp gp <- gpar(lwd = len0_null(size * .pt), col = colour, lty = linetype, lineend = lineend) - element_gp <- gpar(lwd = len0_null(element$size * .pt), col = element$colour, - lty = element$linetype, lineend = element$lineend) + a_element_gp <- gpar(lwd = len0_null(a_element$size * .pt), col = a_element$colour, + lty = a_element$linetype, lineend = a_element$lineend) polylineGrob( x, y, default.units = default.units, - gp = utils::modifyList(element_gp, gp), + gp = utils::modifyList(a_element_gp, gp), id.lengths = id.lengths, ... ) } @@ -207,7 +207,7 @@ 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", +# @param class The name of class (like "a_element_line", "a_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 @@ -219,74 +219,74 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { # This data structure represents the theme elements and the inheritance # among them. -.element_tree <- list( - line = el_def("element_line"), - rect = el_def("element_rect"), - text = el_def("element_text"), - title = el_def("element_text", "text"), - axis.line = el_def("element_line", "line"), - axis.text = el_def("element_text", "text"), - axis.title = el_def("element_text", "title"), - axis.ticks = el_def("element_line", "line"), +.a_element_tree <- list( + line = el_def("a_element_line"), + rect = el_def("a_element_rect"), + text = el_def("a_element_text"), + title = el_def("a_element_text", "text"), + axis.line = el_def("a_element_line", "line"), + axis.text = el_def("a_element_text", "text"), + axis.title = el_def("a_element_text", "title"), + axis.ticks = el_def("a_element_line", "line"), legend.key.size = el_def("unit"), - panel.grid = el_def("element_line", "line"), - panel.grid.major = el_def("element_line", "panel.grid"), - panel.grid.minor = el_def("element_line", "panel.grid"), - strip.text = el_def("element_text", "text"), - - axis.line.x = el_def("element_line", "axis.line"), - axis.line.y = el_def("element_line", "axis.line"), - axis.text.x = el_def("element_text", "axis.text"), - axis.text.y = el_def("element_text", "axis.text"), + panel.grid = el_def("a_element_line", "line"), + panel.grid.major = el_def("a_element_line", "panel.grid"), + panel.grid.minor = el_def("a_element_line", "panel.grid"), + strip.text = el_def("a_element_text", "text"), + + axis.line.x = el_def("a_element_line", "axis.line"), + axis.line.y = el_def("a_element_line", "axis.line"), + axis.text.x = el_def("a_element_text", "axis.text"), + axis.text.y = el_def("a_element_text", "axis.text"), axis.ticks.length = el_def("unit"), - axis.ticks.x = el_def("element_line", "axis.ticks"), - axis.ticks.y = el_def("element_line", "axis.ticks"), - axis.title.x = el_def("element_text", "axis.title"), - axis.title.y = el_def("element_text", "axis.title"), + axis.ticks.x = el_def("a_element_line", "axis.ticks"), + axis.ticks.y = el_def("a_element_line", "axis.ticks"), + axis.title.x = el_def("a_element_text", "axis.title"), + axis.title.y = el_def("a_element_text", "axis.title"), - legend.background = el_def("element_rect", "rect"), + legend.background = el_def("a_element_rect", "rect"), legend.margin = el_def("unit"), - legend.key = el_def("element_rect", "rect"), + legend.key = el_def("a_element_rect", "rect"), legend.key.height = el_def("unit", "legend.key.size"), legend.key.width = el_def("unit", "legend.key.size"), - legend.text = el_def("element_text", "text"), + legend.text = el_def("a_element_text", "text"), legend.text.align = el_def("character"), - legend.title = el_def("element_text", "title"), + legend.title = el_def("a_element_text", "title"), legend.title.align = el_def("character"), - legend.position = el_def("character"), # Need to also accept numbers + legend.a_position = el_def("character"), # Need to also accept numbers legend.direction = el_def("character"), legend.justification = el_def("character"), legend.box = el_def("character"), legend.box.just = el_def("character"), - panel.background = el_def("element_rect", "rect"), - panel.border = el_def("element_rect", "rect"), + panel.background = el_def("a_element_rect", "rect"), + panel.border = el_def("a_element_rect", "rect"), panel.margin = el_def("unit"), panel.margin.x = el_def("unit", "panel.margin"), panel.margin.y = el_def("unit", "panel.margin"), - panel.grid.major.x = el_def("element_line", "panel.grid.major"), - panel.grid.major.y = el_def("element_line", "panel.grid.major"), - panel.grid.minor.x = el_def("element_line", "panel.grid.minor"), - panel.grid.minor.y = el_def("element_line", "panel.grid.minor"), + panel.grid.major.x = el_def("a_element_line", "panel.grid.major"), + panel.grid.major.y = el_def("a_element_line", "panel.grid.major"), + panel.grid.minor.x = el_def("a_element_line", "panel.grid.minor"), + panel.grid.minor.y = el_def("a_element_line", "panel.grid.minor"), panel.ontop = el_def("logical"), - strip.background = el_def("element_rect", "rect"), - strip.text.x = el_def("element_text", "strip.text"), - strip.text.y = el_def("element_text", "strip.text"), + strip.background = el_def("a_element_rect", "rect"), + strip.text.x = el_def("a_element_text", "strip.text"), + strip.text.y = el_def("a_element_text", "strip.text"), strip.switch.pad.grid = el_def("unit"), strip.switch.pad.wrap = el_def("unit"), - plot.background = el_def("element_rect", "rect"), - plot.title = el_def("element_text", "title"), - plot.subtitle = el_def("element_text", "title"), - plot.caption = el_def("element_text", "title"), + plot.background = el_def("a_element_rect", "rect"), + plot.title = el_def("a_element_text", "title"), + plot.subtitle = el_def("a_element_text", "title"), + plot.caption = el_def("a_element_text", "title"), plot.margin = el_def("margin"), aspect.ratio = el_def("character") ) -# Check that an element object has the proper class +# Check that an a_element object has the proper class # # Given an element object and the name of the element, this function # checks it against the element inheritance tree to make sure the @@ -297,7 +297,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { # @param el an element # @param elname the name of the element validate_element <- function(el, elname) { - eldef <- .element_tree[[elname]] + eldef <- .a_element_tree[[elname]] if (is.null(eldef)) { stop('"', elname, '" is not a valid theme element name.') @@ -314,7 +314,7 @@ validate_element <- function(el, elname) { } else if (eldef$class == "margin") { if (!is.unit(el) && length(el) == 4) stop("Element ", elname, " must be a unit vector of length 4.") - } else if (!inherits(el, eldef$class) && !inherits(el, "element_blank")) { + } else if (!inherits(el, eldef$class) && !inherits(el, "a_element_blank")) { stop("Element ", elname, " must be a ", eldef$class, " object.") } invisible() diff --git a/R/theme.r b/R/theme.r index ea9778cd8f..076d7a0154 100644 --- a/R/theme.r +++ b/R/theme.r @@ -1,72 +1,72 @@ #' Get, set and update themes. #' -#' Use \code{theme_get} to get the current theme, and \code{theme_set} to -#' completely override it. \code{theme_update} and \code{theme_replace} are +#' Use \code{a_theme_get} to get the current theme, and \code{a_theme_set} to +#' completely override it. \code{a_theme_update} and \code{a_theme_replace} are #' shorthands for changing individual elements in the current theme. -#' \code{theme_update} uses the \code{+} operator, so that any unspecified +#' \code{a_theme_update} uses the \code{+} operator, so that any unspecified #' values in the theme element will default to the values they are set in the -#' theme. \code{theme_replace} will completely replace the element, so any +#' theme. \code{a_theme_replace} will completely replace the element, so any #' unspecified values will overwrite the current value in the theme with \code{NULL}s. #' #' #' @param ... named list of theme settings -#' @seealso \code{\link{\%+replace\%}} and \code{\link{+.gg}} +#' @seealso \code{\link{\%+replace\%}} and \code{\link{+.aaa}} #' @export #' @examples -#' p <- ggplot(mtcars, aes(mpg, wt)) + -#' geom_point() +#' p <- a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point() #' p -#' old <- theme_set(theme_bw()) +#' old <- a_theme_set(a_theme_bw()) #' p -#' theme_set(old) +#' a_theme_set(old) #' p #' -#' #theme_replace NULLs out the fill attribute of panel.background, +#' #a_theme_replace NULLs out the fill attribute of panel.background, #' #resulting in a white background: -#' theme_get()$panel.background -#' old <- theme_replace(panel.background = element_rect(colour = "pink")) -#' theme_get()$panel.background +#' a_theme_get()$panel.background +#' old <- a_theme_replace(panel.background = a_element_rect(colour = "pink")) +#' a_theme_get()$panel.background #' p -#' theme_set(old) +#' a_theme_set(old) #' -#' #theme_update only changes the colour attribute, leaving the others intact: -#' old <- theme_update(panel.background = element_rect(colour = "pink")) -#' theme_get()$panel.background +#' #a_theme_update only changes the colour attribute, leaving the others intact: +#' old <- a_theme_update(panel.background = a_element_rect(colour = "pink")) +#' a_theme_get()$panel.background #' p -#' theme_set(old) +#' a_theme_set(old) #' -#' theme_get() +#' a_theme_get() #' #' -#' ggplot(mtcars, aes(mpg, wt)) + -#' geom_point(aes(color = mpg)) + -#' theme(legend.position = c(0.95, 0.95), +#' a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point(a_aes(color = mpg)) + +#' a_theme(legend.a_position = c(0.95, 0.95), #' legend.justification = c(1, 1)) #' last_plot() + -#' theme(legend.background = element_rect(fill = "white", colour = "white", size = 3)) +#' a_theme(legend.background = a_element_rect(fill = "white", colour = "white", size = 3)) #' -theme_update <- function(...) { - theme_set(theme_get() + theme(...)) +a_theme_update <- function(...) { + a_theme_set(a_theme_get() + a_theme(...)) } -#' @rdname theme_update +#' @rdname a_theme_update #' @export -theme_replace <- function(...) { - theme_set(theme_get() %+replace% theme(...)) +a_theme_replace <- function(...) { + a_theme_set(a_theme_get() %+replace% a_theme(...)) } -#' Reports whether x is a theme object +#' Reports whether x is a a_theme object #' @param x An object to test #' @export -is.theme <- function(x) inherits(x, "theme") +is.a_theme <- function(x) inherits(x, "a_theme") #' @export -print.theme <- function(x, ...) utils::str(x) +print.a_theme <- function(x, ...) utils::str(x) -#' Set theme elements +#' Set a_theme elements #' #' -#' Use this function to modify theme settings. +#' Use this function to modify a_theme settings. #' #' Theme elements can inherit properties from other theme elements. #' For example, \code{axis.title.x} inherits from \code{axis.title}, @@ -75,7 +75,7 @@ print.theme <- function(x, ...) utils::str(x) #' \code{line}, and all rectangular objects inherit from \code{rect}. #' #' For more examples of modifying properties using inheritance, see -#' \code{\link{+.gg}} and \code{\link{\%+replace\%}}. +#' \code{\link{+.aaa}} and \code{\link{\%+replace\%}}. #' #' To see a graphical representation of the inheritance tree, see the #' last example below. @@ -85,48 +85,48 @@ print.theme <- function(x, ...) utils::str(x) #' #' \tabular{ll}{ #' line \tab all line elements -#' (\code{element_line}) \cr +#' (\code{a_element_line}) \cr #' rect \tab all rectangular elements -#' (\code{element_rect}) \cr +#' (\code{a_element_rect}) \cr #' text \tab all text elements -#' (\code{element_text}) \cr +#' (\code{a_element_text}) \cr #' title \tab all title elements: plot, axes, legends -#' (\code{element_text}; inherits from \code{text}) \cr +#' (\code{a_element_text}; inherits from \code{text}) \cr #' aspect.ratio \tab aspect ratio of the panel \cr #' -#' axis.title \tab label of axes -#' (\code{element_text}; inherits from \code{text}) \cr +#' axis.title \tab a_label of axes +#' (\code{a_element_text}; inherits from \code{text}) \cr #' axis.title.x \tab x axis label -#' (\code{element_text}; inherits from \code{axis.title}) \cr +#' (\code{a_element_text}; inherits from \code{axis.title}) \cr #' axis.title.y \tab y axis label -#' (\code{element_text}; inherits from \code{axis.title}) \cr +#' (\code{a_element_text}; inherits from \code{axis.title}) \cr #' axis.text \tab tick labels along axes -#' (\code{element_text}; inherits from \code{text}) \cr +#' (\code{a_element_text}; inherits from \code{text}) \cr #' axis.text.x \tab x axis tick labels -#' (\code{element_text}; inherits from \code{axis.text}) \cr +#' (\code{a_element_text}; inherits from \code{axis.text}) \cr #' axis.text.y \tab y axis tick labels -#' (\code{element_text}; inherits from \code{axis.text}) \cr +#' (\code{a_element_text}; inherits from \code{axis.text}) \cr #' axis.ticks \tab tick marks along axes -#' (\code{element_line}; inherits from \code{line}) \cr +#' (\code{a_element_line}; inherits from \code{line}) \cr #' axis.ticks.x \tab x axis tick marks -#' (\code{element_line}; inherits from \code{axis.ticks}) \cr +#' (\code{a_element_line}; inherits from \code{axis.ticks}) \cr #' axis.ticks.y \tab y axis tick marks -#' (\code{element_line}; inherits from \code{axis.ticks}) \cr +#' (\code{a_element_line}; inherits from \code{axis.ticks}) \cr #' axis.ticks.length \tab length of tick marks #' (\code{unit}) \cr #' axis.line \tab lines along axes -#' (\code{element_line}; inherits from \code{line}) \cr +#' (\code{a_element_line}; inherits from \code{line}) \cr #' axis.line.x \tab line along x axis -#' (\code{element_line}; inherits from \code{axis.line}) \cr +#' (\code{a_element_line}; inherits from \code{axis.line}) \cr #' axis.line.y \tab line along y axis -#' (\code{element_line}; inherits from \code{axis.line}) \cr +#' (\code{a_element_line}; inherits from \code{axis.line}) \cr #' #' legend.background \tab background of legend -#' (\code{element_rect}; inherits from \code{rect}) \cr +#' (\code{a_element_rect}; inherits from \code{rect}) \cr #' legend.margin \tab extra space added around legend #' (\code{unit}) \cr #' legend.key \tab background underneath legend keys -#' (\code{element_rect}; inherits from \code{rect}) \cr +#' (\code{a_element_rect}; inherits from \code{rect}) \cr #' legend.key.size \tab size of legend keys #' (\code{unit}; inherits from \code{legend.key.size}) \cr #' legend.key.height \tab key background height @@ -134,14 +134,14 @@ print.theme <- function(x, ...) utils::str(x) #' legend.key.width \tab key background width #' (\code{unit}; inherits from \code{legend.key.size}) \cr #' legend.text \tab legend item labels -#' (\code{element_text}; inherits from \code{text}) \cr +#' (\code{a_element_text}; inherits from \code{text}) \cr #' legend.text.align \tab alignment of legend labels #' (number from 0 (left) to 1 (right)) \cr #' legend.title \tab title of legend -#' (\code{element_text}; inherits from \code{title}) \cr +#' (\code{a_element_text}; inherits from \code{title}) \cr #' legend.title.align \tab alignment of legend title #' (number from 0 (left) to 1 (right)) \cr -#' legend.position \tab the position of legends +#' legend.a_position \tab the a_position of legends #' ("none", "left", "right", "bottom", "top", or two-element #' numeric vector) \cr #' legend.direction \tab layout of items in legends @@ -155,11 +155,11 @@ print.theme <- function(x, ...) utils::str(x) #' ("top", "bottom", "left", or "right")\cr #' #' panel.background \tab background of plotting area, drawn underneath plot -#' (\code{element_rect}; inherits from \code{rect}) \cr +#' (\code{a_element_rect}; inherits from \code{rect}) \cr #' panel.border \tab border around plotting area, drawn on top of plot #' so that it covers tick marks and grid lines. This should #' be used with \code{fill=NA} -#' (\code{element_rect}; inherits from \code{rect}) \cr +#' (\code{a_element_rect}; inherits from \code{rect}) \cr #' panel.margin \tab margin around facet panels #' (\code{unit}) \cr #' panel.margin.x \tab horizontal margin around facet panels @@ -167,46 +167,46 @@ print.theme <- function(x, ...) utils::str(x) #' panel.margin.y \tab vertical margin around facet panels #' (\code{unit}; inherits from \code{panel.margin}) \cr #' panel.grid \tab grid lines -#' (\code{element_line}; inherits from \code{line}) \cr +#' (\code{a_element_line}; inherits from \code{line}) \cr #' panel.grid.major \tab major grid lines -#' (\code{element_line}; inherits from \code{panel.grid}) \cr +#' (\code{a_element_line}; inherits from \code{panel.grid}) \cr #' panel.grid.minor \tab minor grid lines -#' (\code{element_line}; inherits from \code{panel.grid}) \cr +#' (\code{a_element_line}; inherits from \code{panel.grid}) \cr #' panel.grid.major.x \tab vertical major grid lines -#' (\code{element_line}; inherits from \code{panel.grid.major}) \cr +#' (\code{a_element_line}; inherits from \code{panel.grid.major}) \cr #' panel.grid.major.y \tab horizontal major grid lines -#' (\code{element_line}; inherits from \code{panel.grid.major}) \cr +#' (\code{a_element_line}; inherits from \code{panel.grid.major}) \cr #' panel.grid.minor.x \tab vertical minor grid lines -#' (\code{element_line}; inherits from \code{panel.grid.minor}) \cr +#' (\code{a_element_line}; inherits from \code{panel.grid.minor}) \cr #' panel.grid.minor.y \tab horizontal minor grid lines -#' (\code{element_line}; inherits from \code{panel.grid.minor}) \cr +#' (\code{a_element_line}; inherits from \code{panel.grid.minor}) \cr #' panel.ontop \tab option to place the panel (background, gridlines) #' over the data layers. Usually used with a transparent #' or blank \code{panel.background}. (\code{logical}) \cr #' #' plot.background \tab background of the entire plot -#' (\code{element_rect}; inherits from \code{rect}) \cr +#' (\code{a_element_rect}; inherits from \code{rect}) \cr #' plot.title \tab plot title (text appearance) -#' (\code{element_text}; inherits from \code{title}) +#' (\code{a_element_text}; inherits from \code{title}) #' left-aligned by default\cr #' plot.subtitle \tab plot subtitle (text appearance) -#' (\code{element_text}; inherits from \code{title}) +#' (\code{a_element_text}; inherits from \code{title}) #' left-aligned by default\cr #' plot.caption \tab caption below the plot (text appearance) -#' (\code{element_text}; inherits from \code{title}) +#' (\code{a_element_text}; inherits from \code{title}) #' right-aligned by default\cr #' plot.margin \tab margin around entire plot #' (\code{unit} with the sizes of the top, right, bottom, and #' left margins) \cr #' #' strip.background \tab background of facet labels -#' (\code{element_rect}; inherits from \code{rect}) \cr +#' (\code{a_element_rect}; inherits from \code{rect}) \cr #' strip.text \tab facet labels -#' (\code{element_text}; inherits from \code{text}) \cr +#' (\code{a_element_text}; inherits from \code{text}) \cr #' strip.text.x \tab facet labels along horizontal direction -#' (\code{element_text}; inherits from \code{strip.text}) \cr +#' (\code{a_element_text}; inherits from \code{strip.text}) \cr #' strip.text.y \tab facet labels along vertical direction -#' (\code{element_text}; inherits from \code{strip.text}) \cr +#' (\code{a_element_text}; inherits from \code{strip.text}) \cr #' strip.switch.pad.grid \tab space between strips and axes when strips are switched #' (\code{unit}) \cr #' strip.switch.pad.wrap \tab space between strips and axes when strips are switched @@ -216,143 +216,143 @@ print.theme <- function(x, ...) utils::str(x) #' @param ... a list of element name, element pairings that modify the #' existing theme. #' @param complete set this to TRUE if this is a complete theme, such as -#' the one returned \code{by theme_grey()}. Complete themes behave +#' the one returned \code{by a_theme_grey()}. Complete themes behave #' differently when added to a ggplot object. #' @param validate TRUE to run validate_element, FALSE to bypass checks. #' -#' @seealso \code{\link{+.gg}} +#' @seealso \code{\link{+.aaa}} #' @seealso \code{\link{\%+replace\%}} #' @seealso \code{\link{rel}} -#' @seealso \code{\link{element_blank}} -#' @seealso \code{\link{element_line}} -#' @seealso \code{\link{element_rect}} -#' @seealso \code{\link{element_text}} +#' @seealso \code{\link{a_element_blank}} +#' @seealso \code{\link{a_element_line}} +#' @seealso \code{\link{a_element_rect}} +#' @seealso \code{\link{a_element_text}} #' @export #' @examples #' \donttest{ -#' p <- ggplot(mtcars, aes(mpg, wt)) + -#' geom_point() +#' p <- a_plot(mtcars, a_aes(mpg, wt)) + +#' a_geom_point() #' p -#' p + theme(panel.background = element_rect(colour = "pink")) -#' p + theme_bw() +#' p + a_theme(panel.background = a_element_rect(colour = "pink")) +#' p + a_theme_bw() #' #' # Scatter plot of gas mileage by vehicle weight -#' p <- ggplot(mtcars, aes(wt, mpg)) + -#' geom_point() +#' p <- a_plot(mtcars, a_aes(wt, mpg)) + +#' a_geom_point() #' # Calculate slope and intercept of line of best fit #' coef(lm(mpg ~ wt, data = mtcars)) -#' p + geom_abline(intercept = 37, slope = -5) +#' p + a_geom_abline(intercept = 37, slope = -5) #' # Calculate correlation coefficient #' with(mtcars, cor(wt, mpg, use = "everything", method = "pearson")) #' #annotate the plot -#' p + geom_abline(intercept = 37, slope = -5) + -#' geom_text(data = data.frame(), aes(4.5, 30, label = "Pearson-R = -.87")) +#' p + a_geom_abline(intercept = 37, slope = -5) + +#' a_geom_text(data = data.frame(), a_aes(4.5, 30, a_label = "Pearson-R = -.87")) #' #' # Change the axis labels #' # Original plot #' p -#' p + labs(x = "Vehicle Weight", y = "Miles per Gallon") +#' p + ggplot2Animint:::labs(x = "Vehicle Weight", y = "Miles per Gallon") #' # Or -#' p + labs(x = "Vehicle Weight", y = "Miles per Gallon") +#' p + ggplot2Animint:::labs(x = "Vehicle Weight", y = "Miles per Gallon") #' #' # Change title appearance #' p <- p + labs(title = "Vehicle Weight-Gas Mileage Relationship") #' # Set title to twice the base font size -#' p + theme(plot.title = element_text(size = rel(2))) -#' p + theme(plot.title = element_text(size = rel(2), colour = "blue")) +#' p + a_theme(plot.title = a_element_text(size = rel(2))) +#' p + a_theme(plot.title = a_element_text(size = rel(2), colour = "blue")) #' #' # Add a subtitle and adjust bottom margin #' p + labs(title = "Vehicle Weight-Gas Mileage Relationship", #' subtitle = "You need to wrap long subtitleson manually") + -#' theme(plot.subtitle = element_text(margin = margin(b = 20))) +#' a_theme(plot.subtitle = a_element_text(margin = margin(b = 20))) #' #' # Changing plot look with themes #' DF <- data.frame(x = rnorm(400)) -#' m <- ggplot(DF, aes(x = x)) + -#' geom_histogram() -#' # Default is theme_grey() +#' m <- a_plot(DF, a_aes(x = x)) + +#' a_geom_histogram() +#' # Default is a_theme_grey() #' m #' # Compare with -#' m + theme_bw() +#' m + a_theme_bw() #' #' # Manipulate Axis Attributes -#' m + theme(axis.line = element_line(size = 3, colour = "red", linetype = "dotted")) -#' m + theme(axis.text = element_text(colour = "blue")) -#' m + theme(axis.text.y = element_blank()) -#' m + theme(axis.ticks = element_line(size = 2)) -#' m + theme(axis.title.y = element_text(size = rel(1.5), angle = 90)) -#' m + theme(axis.title.x = element_blank()) -#' m + theme(axis.ticks.length = unit(.85, "cm")) +#' m + a_theme(axis.line = a_element_line(size = 3, colour = "red", linetype = "dotted")) +#' m + a_theme(axis.text = a_element_text(colour = "blue")) +#' m + a_theme(axis.text.y = a_element_blank()) +#' m + a_theme(axis.ticks = a_element_line(size = 2)) +#' m + a_theme(axis.title.y = a_element_text(size = rel(1.5), angle = 90)) +#' m + a_theme(axis.title.x = a_element_blank()) +#' m + a_theme(axis.ticks.length = unit(.85, "cm")) #' #' # Legend Attributes -#' z <- ggplot(mtcars, aes(wt, mpg)) + -#' geom_point(aes(colour = factor(cyl))) +#' z <- a_plot(mtcars, a_aes(wt, mpg)) + +#' a_geom_point(a_aes(colour = factor(cyl))) #' z -#' z + theme(legend.position = "none") -#' z + theme(legend.position = "bottom") +#' z + a_theme(legend.a_position = "none") +#' z + a_theme(legend.a_position = "bottom") #' # Or use relative coordinates between 0 and 1 -#' z + theme(legend.position = c(.5, .5)) +#' z + a_theme(legend.a_position = c(.5, .5)) #' # Add a border to the whole legend -#' z + theme(legend.background = element_rect(colour = "black")) +#' z + a_theme(legend.background = a_element_rect(colour = "black")) #' # Legend margin controls extra space around outside of legend: -#' z + theme(legend.background = element_rect(), +#' z + a_theme(legend.background = a_element_rect(), #' legend.margin = unit(1, "cm")) -#' z + theme(legend.background = element_rect(), +#' z + a_theme(legend.background = a_element_rect(), #' legend.margin = unit(0, "cm")) #' # Or to just the keys -#' z + theme(legend.key = element_rect(colour = "black")) -#' z + theme(legend.key = element_rect(fill = "yellow")) -#' z + theme(legend.key.size = unit(2.5, "cm")) -#' z + theme(legend.text = element_text(size = 20, colour = "red", angle = 45)) -#' z + theme(legend.title = element_text(face = "italic")) +#' z + a_theme(legend.key = a_element_rect(colour = "black")) +#' z + a_theme(legend.key = a_element_rect(fill = "yellow")) +#' z + a_theme(legend.key.size = unit(2.5, "cm")) +#' z + a_theme(legend.text = a_element_text(size = 20, colour = "red", angle = 45)) +#' z + a_theme(legend.title = a_element_text(face = "italic")) #' #' # To change the title of the legend use the name argument #' # in one of the scale options -#' z + scale_colour_brewer(name = "My Legend") -#' z + scale_colour_grey(name = "Number of \nCylinders") +#' z + a_scale_colour_brewer(name = "My Legend") +#' z + a_scale_colour_grey(name = "Number of \nCylinders") #' #' # Panel and Plot Attributes -#' z + theme(panel.background = element_rect(fill = "black")) -#' z + theme(panel.border = element_rect(linetype = "dashed", colour = "black")) -#' z + theme(panel.grid.major = element_line(colour = "blue")) -#' z + theme(panel.grid.minor = element_line(colour = "red", linetype = "dotted")) -#' z + theme(panel.grid.major = element_line(size = 2)) -#' z + theme(panel.grid.major.y = element_blank(), -#' panel.grid.minor.y = element_blank()) -#' z + theme(plot.background = element_rect()) -#' z + theme(plot.background = element_rect(fill = "green")) +#' z + a_theme(panel.background = a_element_rect(fill = "black")) +#' z + a_theme(panel.border = a_element_rect(linetype = "dashed", colour = "black")) +#' z + a_theme(panel.grid.major = a_element_line(colour = "blue")) +#' z + a_theme(panel.grid.minor = a_element_line(colour = "red", linetype = "dotted")) +#' z + a_theme(panel.grid.major = a_element_line(size = 2)) +#' z + a_theme(panel.grid.major.y = a_element_blank(), +#' panel.grid.minor.y = a_element_blank()) +#' z + a_theme(plot.background = a_element_rect()) +#' z + a_theme(plot.background = a_element_rect(fill = "green")) #' #' # Faceting Attributes #' set.seed(4940) #' dsmall <- diamonds[sample(nrow(diamonds), 1000), ] -#' k <- ggplot(dsmall, aes(carat, ..density..)) + -#' geom_histogram(binwidth = 0.2) + -#' facet_grid(. ~ cut) -#' k + theme(strip.background = element_rect(colour = "purple", fill = "pink", +#' k <- a_plot(dsmall, a_aes(carat, ..density..)) + +#' a_geom_histogram(binwidth = 0.2) + +#' a_facet_grid(. ~ cut) +#' k + a_theme(strip.background = a_element_rect(colour = "purple", fill = "pink", #' size = 3, linetype = "dashed")) -#' k + theme(strip.text.x = element_text(colour = "red", angle = 45, size = 10, +#' k + a_theme(strip.text.x = a_element_text(colour = "red", angle = 45, size = 10, #' hjust = 0.5, vjust = 0.5)) -#' k + theme(panel.margin = unit(5, "lines")) -#' k + theme(panel.margin.y = unit(0, "lines")) +#' k + a_theme(panel.margin = unit(5, "lines")) +#' k + a_theme(panel.margin.y = unit(0, "lines")) #' #' # Put gridlines on top #' meanprice <- tapply(diamonds$price, diamonds$cut, mean) #' cut <- factor(levels(diamonds$cut), levels = levels(diamonds$cut)) #' df <- data.frame(meanprice, cut) -#' g <- ggplot(df, aes(cut, meanprice)) + geom_bar(stat = "identity") -#' g + geom_bar(stat = "identity") + -#' theme(panel.background = element_blank(), -#' panel.grid.major.x = element_blank(), -#' panel.grid.minor.x = element_blank(), -#' panel.grid.minor.y = element_blank(), +#' g <- a_plot(df, a_aes(cut, meanprice)) + a_geom_bar(a_stat = "identity") +#' g + a_geom_bar(a_stat = "identity") + +#' a_theme(panel.background = a_element_blank(), +#' panel.grid.major.x = a_element_blank(), +#' panel.grid.minor.x = a_element_blank(), +#' panel.grid.minor.y = a_element_blank(), #' panel.ontop = TRUE) #' -#' # Modify a theme and save it -#' mytheme <- theme_grey() + theme(plot.title = element_text(colour = "red")) -#' p + mytheme +#' # Modify a a_theme and save it +#' mya_theme <- a_theme_grey() + a_theme(plot.title = a_element_text(colour = "red")) +#' p + mya_theme #' #' } -theme <- function(..., complete = FALSE, validate = TRUE) { +a_theme <- function(..., complete = FALSE, validate = TRUE) { elements <- list(...) if (!is.null(elements$axis.ticks.margin)) { @@ -361,55 +361,56 @@ theme <- function(..., complete = FALSE, validate = TRUE) { elements$axis.ticks.margin <- NULL } - # Check that all elements have the correct class (element_text, unit, etc) + # Check that all elements have the correct class (a_element_text, unit, etc) if (validate) { mapply(validate_element, elements, names(elements)) } - structure(elements, class = c("theme", "gg"), + structure(elements, class = c("a_theme", "aaa"), complete = complete, validate = validate) } - -# Combine plot defaults with current theme to get complete theme for a plot -plot_theme <- function(x) { - defaults(x$theme, theme_get()) +#' Combine plot defaults with current theme to get complete theme for a plot +#' @param x .... +#' @export +plot_a_theme <- function(x) { + defaults(x$a_theme, a_theme_get()) } -.theme <- (function() { - theme <- theme_gray() +.a_theme <- (function() { + a_theme <- a_theme_gray() list( - get = function() theme, + get = function() a_theme, set = function(new) { - missing <- setdiff(names(theme_gray()), names(new)) + missing <- setdiff(names(a_theme_gray()), names(new)) if (length(missing) > 0) { - warning("New theme missing the following elements: ", + warning("New a_theme missing the following elements: ", paste(missing, collapse = ", "), call. = FALSE) } - old <- theme - theme <<- new + old <- a_theme + a_theme <<- new invisible(old) } ) })() -#' @rdname theme_update +#' @rdname a_theme_update #' @export -theme_get <- .theme$get -#' @rdname theme_update +a_theme_get <- .a_theme$get +#' @rdname a_theme_update #' @param new new theme (a list of theme elements) #' @export -theme_set <- .theme$set +a_theme_set <- .a_theme$set -#' @rdname gg-add +#' @rdname aaa-add #' @export "%+replace%" <- function(e1, e2) { - if (!is.theme(e1) || !is.theme(e2)) { + if (!is.a_theme(e1) || !is.a_theme(e2)) { stop("%+replace% requires two theme objects", call. = FALSE) } @@ -426,10 +427,10 @@ theme_set <- .theme$set #' @param t2name A name of the t2 object. This is used for printing #' informative error messages. #' -#' @seealso +.gg +#' @seealso +.aaa #' -add_theme <- function(t1, t2, t2name) { - if (!is.theme(t2)) { +add_a_theme <- function(t1, t2, t2name) { + if (!is.a_theme(t2)) { stop("Don't know how to add ", t2name, " to a theme object", call. = FALSE) } @@ -439,12 +440,12 @@ add_theme <- function(t1, t2, t2name) { x <- t1[[item]] y <- t2[[item]] - if (is.null(x) || inherits(x, "element_blank")) { - # If x is NULL or element_blank, then just assign it y + if (is.null(x) || inherits(x, "a_element_blank")) { + # If x is NULL or a_element_blank, then just assign it y x <- y } else if (is.null(y) || is.character(y) || is.numeric(y) || - is.logical(y) || inherits(y, "element_blank")) { - # If y is NULL, or a string or numeric vector, or is element_blank, just replace x + is.logical(y) || inherits(y, "a_element_blank")) { + # If y is NULL, or a string or numeric vector, or is a_element_blank, just replace x x <- y } else { # If x is not NULL, then copy over the non-NULL properties from y @@ -469,29 +470,30 @@ add_theme <- function(t1, t2, t2name) { } -# Update a theme from a plot object -# -# This is called from add_ggplot. -# -# If newtheme is a *complete* theme, then it is meant to replace -# oldtheme; this function just returns newtheme. -# -# Otherwise, it adds elements from newtheme to oldtheme: -# If oldtheme doesn't already contain those elements, -# it searches the current default theme, grabs the elements with the -# same name as those from newtheme, and puts them in oldtheme. Then -# it adds elements from newtheme to oldtheme. -# This makes it possible to do things like: -# ggplot(data.frame(x = 1:3, y = 1:3)) + -# geom_point() + theme(text = element_text(colour = 'red')) -# and have 'text' keep properties from the default theme. Otherwise -# you would have to set all the element properties, like family, size, -# etc. -# -# @param oldtheme an existing theme, usually from a plot object, like -# plot$theme. This could be an empty list. -# @param newtheme a new theme object to add to the existing theme -update_theme <- function(oldtheme, newtheme) { +#' Update a theme from a plot object +#' +#' This is called from add_a_plot. +#' +#' If newtheme is a *complete* theme, then it is meant to replace +#' oldtheme; this function just returns newtheme. +#' +#' Otherwise, it adds elements from newtheme to oldtheme: +#' If oldtheme doesn't already contain those elements, +#' it searches the current default theme, grabs the elements with the +#' same name as those from newtheme, and puts them in oldtheme. Then +#' it adds elements from newtheme to oldtheme. +#' This makes it possible to do things like: +#' a_plot(data.frame(x = 1:3, y = 1:3)) + +#' a_geom_point() + a_theme(text = a_element_text(colour = 'red')) +#' and have 'text' keep properties from the default theme. Otherwise +#' you would have to set all the element properties, like family, size, +#' etc. +#' +#' @param oldtheme an existing theme, usually from a plot object, like +#' plot$a_theme. This could be an empty list. +#' @param newtheme a new theme object to add to the existing theme +#' @export +update_a_theme <- function(oldtheme, newtheme) { # If the newtheme is a complete one, don't bother searching # the default theme -- just replace everything with newtheme if (attr(newtheme, "complete")) @@ -501,7 +503,7 @@ update_theme <- function(oldtheme, newtheme) { # They will be pulled from the default theme. newitems <- !names(newtheme) %in% names(oldtheme) newitem_names <- names(newtheme)[newitems] - oldtheme[newitem_names] <- theme_get()[newitem_names] + oldtheme[newitem_names] <- a_theme_get()[newitem_names] # Update the theme elements with the things from newtheme # Turn the 'theme' list into a proper theme object first, and preserve @@ -509,7 +511,7 @@ update_theme <- function(oldtheme, newtheme) { # list, and in that case, set complete to FALSE. old.validate <- isTRUE(attr(oldtheme, "validate")) new.validate <- isTRUE(attr(newtheme, "validate")) - oldtheme <- do.call(theme, c(oldtheme, + oldtheme <- do.call(a_theme, c(oldtheme, complete = isTRUE(attr(oldtheme, "complete")), validate = old.validate & new.validate)) @@ -518,16 +520,16 @@ update_theme <- function(oldtheme, newtheme) { #' Calculate the element properties, by inheriting properties from its parents #' -#' @param element The name of the theme element to calculate -#' @param theme A theme object (like theme_grey()) +#' @param a_element The name of the theme element to calculate +#' @param a_theme A theme object (like a_theme_grey()) #' @param verbose If TRUE, print out which elements this one inherits from #' @examples -#' t <- theme_grey() -#' calc_element('text', t) +#' t <- a_theme_grey() +#' a_calc_element('text', t) #' #' # Compare the "raw" element definition to the element with calculated inheritance #' t$axis.text.x -#' calc_element('axis.text.x', t, verbose = TRUE) +#' a_calc_element('axis.text.x', t, verbose = TRUE) #' #' # This reports that axis.text.x inherits from axis.text, #' # which inherits from text. You can view each of them with: @@ -536,44 +538,44 @@ update_theme <- function(oldtheme, newtheme) { #' t$text #' #' @export -calc_element <- function(element, theme, verbose = FALSE) { - if (verbose) message(element, " --> ", appendLF = FALSE) +a_calc_element <- function(a_element, a_theme, verbose = FALSE) { + if (verbose) message(a_element, " --> ", appendLF = FALSE) - # If this is element_blank, don't inherit anything from parents - if (inherits(theme[[element]], "element_blank")) { - if (verbose) message("element_blank (no inheritance)") - return(theme[[element]]) + # If this is a_element_blank, don't inherit anything from parents + if (inherits(a_theme[[a_element]], "a_element_blank")) { + if (verbose) message("a_element_blank (no inheritance)") + return(a_theme[[a_element]]) } # If the element is defined (and not just inherited), check that - # it is of the class specified in .element_tree - if (!is.null(theme[[element]]) && - !inherits(theme[[element]], .element_tree[[element]]$class)) { - stop(element, " should have class ", .element_tree[[element]]$class) + # it is of the class specified in .a_element_tree + if (!is.null(a_theme[[a_element]]) && + !inherits(a_theme[[a_element]], .a_element_tree[[a_element]]$class)) { + stop(a_element, " should have class ", .a_element_tree[[a_element]]$class) } # Get the names of parents from the inheritance tree - pnames <- .element_tree[[element]]$inherit + pnames <- .a_element_tree[[a_element]]$inherit # If no parents, this is a "root" node. Just return this element. if (is.null(pnames)) { # Check that all the properties of this element are non-NULL - nullprops <- vapply(theme[[element]], is.null, logical(1)) + nullprops <- vapply(a_theme[[a_element]], is.null, logical(1)) if (any(nullprops)) { - stop("Theme element '", element, "' has NULL property: ", + stop("Theme element '", a_element, "' has NULL property: ", paste(names(nullprops)[nullprops], collapse = ", ")) } if (verbose) message("nothing (top level)") - return(theme[[element]]) + return(a_theme[[a_element]]) } # Calculate the parent objects' inheritance if (verbose) message(paste(pnames, collapse = ", ")) - parents <- lapply(pnames, calc_element, theme, verbose) + parents <- lapply(pnames, a_calc_element, a_theme, verbose) # Combine the properties of this element with all parents - Reduce(combine_elements, parents, theme[[element]]) + Reduce(combine_elements, parents, a_theme[[a_element]]) } @@ -586,8 +588,8 @@ combine_elements <- function(e1, e2) { # If e2 is NULL, nothing to inherit if (is.null(e2)) return(e1) - # If e1 is NULL, or if e2 is element_blank, inherit everything from e2 - if (is.null(e1) || inherits(e2, "element_blank")) return(e2) + # If e1 is NULL, or if e2 is a_element_blank, inherit everything from e2 + if (is.null(e1) || inherits(e2, "a_element_blank")) return(e2) # If e1 has any NULL properties, inherit them from e2 n <- vapply(e1[names(e2)], is.null, logical(1)) diff --git a/R/translate-qplot-ggplot.r b/R/translate-qplot-ggplot.r index 86de9423da..db0b4cb98a 100644 --- a/R/translate-qplot-ggplot.r +++ b/R/translate-qplot-ggplot.r @@ -1,19 +1,19 @@ -#' Translating between qplot and ggplot +#' Translating between qplot and a_plot #' #' Within ggplot2, there are two basic methods to create plots, with qplot() -#' and ggplot(). qplot() is designed primarily for interactive use: it makes +#' and a_plot(). qplot() is designed primarily for interactive use: it makes #' a number of assumptions that speed most cases, but when designing multilayered #' plots with different data sources it can get in the way. This section -#' describes what those defaults are, and how they map to the fuller ggplot() +#' describes what those defaults are, and how they map to the fuller a_plot() #' syntax. #' -#' @name translate_qplot_ggplot +#' @name translate_qplot_a_plot #' @examples #' #' # By default, qplot() assumes that you want a scatterplot, -#' # i.e., you want to use geom_point() +#' # i.e., you want to use a_geom_point() #' # qplot(x, y, data = data) -#' # ggplot(data, aes(x, y)) + geom_point() +#' # a_plot(data, a_aes(x, y)) + a_geom_point() #' #' # Using Aesthetics #' @@ -21,7 +21,7 @@ #' # qplot() there is no way to use different aesthetic mappings (or data) in #' # different layers #' # qplot(x, y, data = data, shape = shape, colour = colour) -#' # ggplot(data, aes(x, y, shape = shape, colour = colour)) + geom_point() +#' # a_plot(data, a_aes(x, y, shape = shape, colour = colour)) + a_geom_point() #' # #' # Aesthetic parameters in qplot() always try to map the aesthetic to a #' # variable. If the argument is not a variable but a value, effectively a new column @@ -29,54 +29,54 @@ #' # value and override the default appearance, you surround the value with I() in #' # qplot(), or pass it as a parameter to the layer. #' # qplot(x, y, data = data, colour = I("red")) -#' # ggplot(data, aes(x, y)) + geom_point(colour = "red") +#' # a_plot(data, a_aes(x, y)) + a_geom_point(colour = "red") #' -#' # Changing the geom parameter changes the geom added to the plot -#' # qplot(x, y, data = data, geom = "line") -#' # ggplot(data, aes(x, y)) + geom_line() +#' # Changing the a_geom parameter changes the a_geom added to the plot +#' # qplot(x, y, data = data, a_geom = "line") +#' # a_plot(data, a_aes(x, y)) + a_geom_line() #' -#' # Not all geoms require both x and y, e.g., geom_bar() and geom_histogram(). +#' # Not all geoms require both x and y, e.g., a_geom_bar() and a_geom_histogram(). #' # For these two geoms, if the y aesthetic is not supplied, both qplot and -#' # ggplot commands default to "count" on the y-axis -#' # ggplot(data, aes(x)) + geom_bar() -#' # qplot(x, data = data, geom = "bar") +#' # a_plot commands default to "count" on the y-axis +#' # a_plot(data, a_aes(x)) + a_geom_bar() +#' # qplot(x, data = data, a_geom = "bar") #' -#' # If a vector of multiple geom names is supplied to the geom argument, each -#' # geom will be added in turn -#' # qplot(x, y, data = data, geom = c("point", "smooth")) -#' # ggplot(data, aes(x, y)) + geom_point() + geom_smooth() +#' # If a vector of multiple a_geom names is supplied to the a_geom argument, each +#' # a_geom will be added in turn +#' # qplot(x, y, data = data, a_geom = c("point", "smooth")) +#' # a_plot(data, a_aes(x, y)) + a_geom_point() + a_geom_smooth() #' #' # Unlike the rest of ggplot2, stats and geoms are independent -#' # qplot(x, y, data = data, stat = "bin") -#' # ggplot(data, aes(x, y)) + geom_point(stat = "bin") +#' # qplot(x, y, data = data, a_stat = "bin") +#' # a_plot(data, a_aes(x, y)) + a_geom_point(a_stat = "bin") #' # #' # Any layer parameters will be passed on to all layers. Most layers will ignore #' # parameters that they don't need -#' # qplot(x, y, data = data, geom = c("point", "smooth"), method = "lm") -#' # ggplot(data, aes(x, y)) + geom_point(method = "lm") + geom_smooth(method = "lm") +#' # qplot(x, y, data = data, a_geom = c("point", "smooth"), method = "lm") +#' # a_plot(data, a_aes(x, y)) + a_geom_point(method = "lm") + a_geom_smooth(method = "lm") #' #' # Scales and axes #' #' # You can control basic properties of the x and y scales with the xlim, ylim, #' # xlab and ylab arguments #' # qplot(x, y, data = data, xlim = c(1, 5), xlab = "my label") -#' # ggplot(data, aes(x, y)) + geom_point() + -#' # scale_x_continuous("my label", limits = c(1, 5)) +#' # a_plot(data, a_aes(x, y)) + a_geom_point() + +#' # a_scale_x_continuous("my label", limits = c(1, 5)) #' #' # qplot(x, y, data = data, xlim = c(1, 5), ylim = c(10, 20)) -#' # ggplot(data, aes(x, y)) + geom_point() + -#' # scale_x_continuous(limits = c(1, 5)) + scale_y_continuous(limits = c(10, 20)) +#' # a_plot(data, a_aes(x, y)) + a_geom_point() + +#' # a_scale_x_continuous(limits = c(1, 5)) + a_scale_y_continuous(limits = c(10, 20)) #' #' # Like plot(), qplot() has a convenient way of log transforming the axes. #' # qplot(x, y, data = data, log = "xy") -#' # ggplot(data, aes(x, y)) + geom_point() + scale_x_log10() + scale_y_log10() +#' # a_plot(data, a_aes(x, y)) + a_geom_point() + a_scale_x_log10() + a_scale_y_log10() #' # There are many other possible transformations, but not all are -#' # accessible from within qplot(), see ?scale_continuous for more +#' # accessible from within qplot(), see ?a_scale_continuous for more #' #' # Plot options #' #' # qplot() recognises the same options as plot does, and converts them to their -#' # ggplot2 equivalents. See ?theme for more on ggplot options +#' # ggplot2 equivalents. See ?a_theme for more on ggplot options #' # qplot(x, y, data = data, main="title", asp = 1) -#' # ggplot(data, aes(x, y)) + geom_point() + labs(title = "title") + theme(aspect.ratio = 1) +#' # a_plot(data, a_aes(x, y)) + a_geom_point() + labs(title = "title") + a_theme(aspect.ratio = 1) NULL diff --git a/R/translate-qplot-lattice.r b/R/translate-qplot-lattice.r index 1a97b6ea9b..13438fdc4d 100644 --- a/R/translate-qplot-lattice.r +++ b/R/translate-qplot-lattice.r @@ -23,16 +23,16 @@ #' # ggplot2 has qplot(). #' #' stripplot(~ rating, data = movies, jitter.data = TRUE) -#' qplot(rating, 1, data = movies, geom = "jitter") +#' qplot(rating, 1, data = movies, a_geom = "jitter") #' #' histogram(~ rating, data = movies) -#' qplot(rating, data = movies, geom = "histogram") +#' qplot(rating, data = movies, a_geom = "histogram") #' #' bwplot(Comedy ~ rating ,data = movies) -#' qplot(factor(Comedy), rating, data = movies, geom = "boxplot") +#' qplot(factor(Comedy), rating, data = movies, a_geom = "boxplot") #' #' xyplot(wt ~ mpg, mtcars, type = c("p","smooth")) -#' qplot(mpg, wt, data = mtcars, geom = c("point","smooth")) +#' qplot(mpg, wt, data = mtcars, a_geom = c("point","smooth")) #' } #' #' # The capabilities for scale manipulations are similar in both ggplot2 and @@ -46,8 +46,8 @@ #' #' xyplot(wt ~ mpg | cyl, mtcars, scales = list(log = 2)) #' qplot(mpg, wt, data = mtcars) + -#' scale_x_continuous(trans = scales::log2_trans()) + -#' scale_y_continuous(trans = scales::log2_trans()) +#' a_scale_x_continuous(trans = scales::log2_trans()) + +#' a_scale_y_continuous(trans = scales::log2_trans()) #' #' xyplot(wt ~ mpg, mtcars, group = cyl, auto.key = TRUE) #' # Map directly to an aesthetic like colour, size, or shape. @@ -68,8 +68,8 @@ #' xyplot(wt ~ mpg, mtcars, aspect = 1) #' qplot(mpg, wt, data = mtcars, asp = 1) #' -#' # par.settings() is equivalent to + theme() and trellis.options.set() -#' # and trellis.par.get() to theme_set() and theme_get(). +#' # par.settings() is equivalent to + a_theme() and trellis.options.set() +#' # and trellis.par.get() to a_theme_set() and a_theme_get(). #' # More complicated lattice formulas are equivalent to rearranging the data #' # before using ggplot2. #' } diff --git a/R/utilities-help.r b/R/utilities-help.r index 66d16a6a68..26fd43348c 100644 --- a/R/utilities-help.r +++ b/R/utilities-help.r @@ -1,4 +1,4 @@ -aesthetics <- function(x) { +a_aesthetics <- function(x) { req_aes <- x$required_aes def_aes <- names(x$default_aes) def_aes <- setdiff(def_aes, req_aes) @@ -11,23 +11,23 @@ aesthetics <- function(x) { } return(c(paste("\\strong{", sort(x$required_aes), "}", sep = ""), sort(def_aes))) } -geom_aesthetics <- function(x) { - aesthetics(find_subclass("Geom", x)) +a_geom_aesthetics <- function(x) { + a_aesthetics(find_subclass("a_Geom", x)) } -stat_aesthetics <- function(x) { - aesthetics(find_subclass("Stat", x)) +a_stat_aesthetics <- function(x) { + a_aesthetics(find_subclass("a_Stat", x)) } rd_aesthetics <- function(type, name) { obj <- switch(type, - geom = find_subclass("Geom", name), - stat = find_subclass("Stat", name) + a_geom = find_subclass("a_Geom", name), + a_stat = find_subclass("a_Stat", name) ) - aes <- aesthetics(obj) + a_aes <- a_aesthetics(obj) paste("\\code{", type, "_", name, "} ", "understands the following aesthetics (required aesthetics are in bold):\n\n", "\\itemize{\n", - paste(" \\item \\code{", aes, "}", collapse = "\n", sep = ""), + paste(" \\item \\code{", a_aes, "}", collapse = "\n", sep = ""), "\n}\n", sep = "") } diff --git a/R/utilities-resolution.r b/R/utilities-resolution.r index 11a0f0fafb..1707c12c04 100644 --- a/R/utilities-resolution.r +++ b/R/utilities-resolution.r @@ -1,23 +1,23 @@ -#' Compute the "resolution" of a data vector. +#' Compute the "a_resolution" of a data vector. #' -#' The resolution is is the smallest non-zero distance between adjacent -#' values. If there is only one unique value, then the resolution is defined +#' The a_resolution is is the smallest non-zero distance between adjacent +#' values. If there is only one unique value, then the a_resolution is defined #' to be one. #' #' If x is an integer vector, then it is assumed to represent a discrete -#' variable, and the resolution is 1. +#' variable, and the a_resolution is 1. #' #' @param x numeric vector #' @param zero should a zero value be automatically included in the -#' computation of resolution +#' computation of a_resolution #' @export #' @examples -#' resolution(1:10) -#' resolution((1:10) - 0.5) -#' resolution((1:10) - 0.5, FALSE) -#' resolution(c(1,2, 10, 20, 50)) -#' resolution(as.integer(c(1, 10, 20, 50))) # Returns 1 -resolution <- function(x, zero = TRUE) { +#' a_resolution(1:10) +#' a_resolution((1:10) - 0.5) +#' a_resolution((1:10) - 0.5, FALSE) +#' a_resolution(c(1,2, 10, 20, 50)) +#' a_resolution(as.integer(c(1, 10, 20, 50))) # Returns 1 +a_resolution <- function(x, zero = TRUE) { if (is.integer(x) || zero_range(range(x, na.rm = TRUE))) return(1) diff --git a/R/utilities.r b/R/utilities.r index cc2966c9d4..afe17b69f1 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -1,10 +1,10 @@ #' @export #' @examples -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point(alpha = 0.5, colour = "blue") +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point(alpha = 0.5, colour = "blue") #' -#' ggplot(mpg, aes(displ, hwy)) + -#' geom_point(colour = alpha("blue", 0.5)) +#' a_plot(mpg, a_aes(displ, hwy)) + +#' a_geom_point(colour = alpha("blue", 0.5)) scales::alpha "%||%" <- function(a, b) { @@ -146,7 +146,7 @@ should_stop <- function(expr) { #' #' @export #' @keywords internal -waiver <- function() structure(NULL, class = "waiver") +waiver <- function() structure(list(), class = "waiver") is.waive <- function(x) inherits(x, "waiver") @@ -184,7 +184,7 @@ rescale01 <- function(x) { #' @export gg_dep <- function(version, msg) { v <- as.package_version(version) - cv <- utils::packageVersion("ggplot2") + cv <- utils::packageVersion("ggplot2Animint") # If current major number is greater than last-good major number, or if # current minor number is more than 1 greater than last-good minor number, diff --git a/R/zxx.r b/R/zxx.r index e3d8e67ce5..c7c18ad2eb 100644 --- a/R/zxx.r +++ b/R/zxx.r @@ -1,107 +1,107 @@ # Default scales ------------------------------------------------------------- #' @export -#' @rdname scale_hue +#' @rdname a_scale_hue #' @usage NULL -scale_colour_discrete <- scale_colour_hue +a_scale_colour_discrete <- a_scale_colour_hue #' @export -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @usage NULL -scale_colour_continuous <- scale_colour_gradient +a_scale_colour_continuous <- a_scale_colour_gradient #' @export -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @usage NULL -scale_colour_datetime <- function() { - scale_colour_continuous(trans = "time") +a_scale_colour_datetime <- function() { + a_scale_colour_continuous(trans = "time") } #' @export -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @usage NULL -scale_colour_date <- function() { - scale_colour_continuous(trans = "date") +a_scale_colour_date <- function() { + a_scale_colour_continuous(trans = "date") } #' @export -#' @rdname scale_hue +#' @rdname a_scale_hue #' @usage NULL -scale_fill_discrete <- scale_fill_hue +a_scale_fill_discrete <- a_scale_fill_hue #' @export -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @usage NULL -scale_fill_continuous <- scale_fill_gradient +a_scale_fill_continuous <- a_scale_fill_gradient #' @export -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @usage NULL -scale_fill_datetime <- function() { - scale_fill_continuous(trans = "time") +a_scale_fill_datetime <- function() { + a_scale_fill_continuous(trans = "time") } #' @export -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @usage NULL -scale_fill_date <- function() { - scale_fill_continuous(trans = "date") +a_scale_fill_date <- function() { + a_scale_fill_continuous(trans = "date") } # British to American spellings ---------------------------------------------- #' @export -#' @rdname scale_brewer +#' @rdname a_scale_brewer #' @usage NULL -scale_color_brewer <- scale_colour_brewer +a_scale_color_brewer <- a_scale_colour_brewer #' @export -#' @rdname scale_brewer +#' @rdname a_scale_brewer #' @usage NULL -scale_color_distiller <- scale_colour_distiller +a_scale_color_distiller <- a_scale_colour_distiller #' @export -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @usage NULL -scale_color_continuous <- scale_colour_gradient +a_scale_color_continuous <- a_scale_colour_gradient #' @export -#' @rdname scale_hue +#' @rdname a_scale_hue #' @usage NULL -scale_color_discrete <- scale_colour_hue +a_scale_color_discrete <- a_scale_colour_hue #' @export -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @usage NULL -scale_color_gradient <- scale_colour_gradient +a_scale_color_gradient <- a_scale_colour_gradient #' @export -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @usage NULL -scale_color_gradient2 <- scale_colour_gradient2 +a_scale_color_gradient2 <- a_scale_colour_gradient2 #' @export -#' @rdname scale_gradient +#' @rdname a_scale_gradient #' @usage NULL -scale_color_gradientn <- scale_colour_gradientn +a_scale_color_gradientn <- a_scale_colour_gradientn #' @export -#' @rdname scale_grey +#' @rdname a_scale_grey #' @usage NULL -scale_color_grey <- scale_colour_grey +a_scale_color_grey <- a_scale_colour_grey #' @export -#' @rdname scale_hue +#' @rdname a_scale_hue #' @usage NULL -scale_color_hue <- scale_colour_hue +a_scale_color_hue <- a_scale_colour_hue #' @export -#' @rdname scale_identity +#' @rdname a_scale_identity #' @usage NULL -scale_color_identity <- scale_colour_identity +a_scale_color_identity <- a_scale_colour_identity #' @export -#' @rdname scale_manual +#' @rdname a_scale_manual #' @usage NULL -scale_color_manual <- scale_colour_manual +a_scale_color_manual <- a_scale_colour_manual diff --git a/README.md b/README.md index 7a28545078..08c004439f 100644 --- a/README.md +++ b/README.md @@ -1,26 +1,47 @@ -# ggplot2 +# ggplot2Animint -[![Build Status](https://travis-ci.org/hadley/ggplot2.svg?branch=master)](https://travis-ci.org/hadley/ggplot2) -[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/ggplot2)](http://cran.r-project.org/package=ggplot2) +[![Build Status](https://travis-ci.org/faizan-khan-iit/ggplot2.svg?branch=cran)](https://travis-ci.org/faizan-khan-iit/ggplot2) -ggplot2 is a plotting system for R, based on the grammar of graphics, which tries to take the good parts of base and lattice graphics and avoid bad parts. It takes care of many of the fiddly details -that make plotting a hassle (like drawing legends) as well as providing a powerful model of graphics that makes it easy to produce complex multi-layered graphics. +## Overview + +ggplot2Animint is the customized version of ggplot2 which passes the static plots generated by it for rendering. It is [animint2](https://github.com/tdhock/animint2) specific version of ggplot2. It has been done so to avoid WARNINGS from constant changes in new version of ggplot2 as animint2 earlier depend on it and also to avoid error from functions that are non-specific to animint code base. + +ggplot2Animint also drops major dependency packages that can be directly imported to animint2. -Find out more at , and check out the nearly 500 -examples of ggplot in use. If you're interested, you can also sign up to -the ggplot2 mailing list at . + +Major Update: ggplot2Animint is now compatable with other base packages in RStudio with changes in [ggproto function](https://github.com/faizan-khan-iit/ggplot2/pull/7) + +Package is ready for CRAN submission. ## Installation -Get the released version from CRAN: ```R -install.packages("ggplot2") +# install.packages("devtools") +devtools::install_github("faizan-khan-iit/ggplot2@e62066b462070a3a46f403d6f63531413a3a20ce") ``` -Or the development version from github: + +## About ggpolot2 + +ggplot2 is a plotting system for R, based on the grammar of graphics, which tries to take the good parts of base and lattice graphics and avoid bad parts. It takes care of many of the fiddly details that make plotting a hassle (like drawing legends) as well as providing a powerful model of graphics that makes it easy to produce complex multi-layered graphics. + + +Find out more at , and check out the nearly 500 +examples of ggplot in use. If you're interested, you can also sign up to +the ggplot2 mailing list at . + +If you looking for ggplot2 offical repository, visit at + +## Usage +The syntax and major functions like ```ggplot()``` and layers like ```geom_point()``` or ```geom_histogram()```, scales (like ```scale_colour_brewer()```) remains same. ```R -# install.packages("devtools") -devtools::install_github("hadley/ggplot2") +library(ggplot2Animint) + +ggplot(mtcars, aes(cyl, mpg)) + +geom_point() + aes(colour = factor(vs)) + stat_summary(fun.y = mean, geom="line") + ``` + +![](man/figures/README-Example-1.png) diff --git a/ggplot2-vivek.Rproj b/ggplot2-vivek.Rproj new file mode 100644 index 0000000000..21a4da087e --- /dev/null +++ b/ggplot2-vivek.Rproj @@ -0,0 +1,17 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/inst/staticdocs/icons.R b/inst/staticdocs/icons.R index 4897cd7af9..ccc46a3a6a 100644 --- a/inst/staticdocs/icons.R +++ b/inst/staticdocs/icons.R @@ -63,7 +63,7 @@ coord_transform <- sd_icon({ # Faceting --------------------------------------------------------------------- -facet_grid <- sd_icon({ +a_facet_grid <- sd_icon({ gTree(children = gList( rectGrob( 0, @@ -87,7 +87,7 @@ facet_grid <- sd_icon({ )) }) -facet_null <- sd_icon({ +a_facet_null <- sd_icon({ gTree(children = gList( rectGrob( 0, diff --git a/man/aes.Rd b/man/a_aes.Rd similarity index 55% rename from man/aes.Rd rename to man/a_aes.Rd index 93787b9c55..ff3f3780a9 100644 --- a/man/aes.Rd +++ b/man/a_aes.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aes.r -\name{aes} -\alias{aes} +\name{a_aes} +\alias{a_aes} \title{Define aesthetic mappings.} \usage{ -aes(x, y, ...) +a_aes(x, y, ...) } \arguments{ \item{x, y, ...}{List of name value pairs giving aesthetics to map to @@ -19,32 +19,31 @@ color to colour, and old style R names to ggplot names (eg. pch to shape, cex to size) } \examples{ -aes(x = mpg, y = wt) -aes(mpg, wt) +a_aes(x = mpg, y = wt) +a_aes(mpg, wt) -# You can also map aesthetics to functions of variables -aes(x = mpg ^ 2, y = wt / cyl) +# You can also map a_aesthetics to functions of variables +a_aes(x = mpg ^ 2, y = wt / cyl) # Aesthetic names are automatically standardised -aes(col = x) -aes(fg = x) -aes(color = x) -aes(colour = x) +a_aes(col = x) +a_aes(fg = x) +a_aes(color = x) +a_aes(colour = x) -# aes is almost always used with ggplot() or a layer -ggplot(mpg, aes(displ, hwy)) + geom_point() -ggplot(mpg) + geom_point(aes(displ, hwy)) +# a_aes is almost always used with a_plot() or a layer +a_plot(mpg, a_aes(displ, hwy)) + a_geom_point() +a_plot(mpg) + a_geom_point(a_aes(displ, hwy)) -# Aesthetics supplied to ggplot() are used as defaults for every layer +# Aesthetics supplied to a_plot() are used as defaults for every layer # you can override them, or supply different aesthetics for each layer } \seealso{ -See \code{\link{aes_q}}/\code{\link{aes_string}} for standard - evaluation versions of \code{aes}. +See \code{\link{a_aes_q}}/\code{\link{a_aes_string}} for standard + evaluation versions of \code{a_aes}. See - \code{\link{aes_colour_fill_alpha}}, \code{\link{aes_group_order}}, - \code{\link{aes_linetype_size_shape}} and \code{\link{aes_position}} + \code{\link{a_aes_colour_fill_alpha}}, \code{\link{a_aes_group_order}}, + \code{\link{a_aes_linetype_size_shape}} and \code{\link{a_aes_position}} for more specific examples with different aesthetics. } - diff --git a/man/a_aes_.Rd b/man/a_aes_.Rd new file mode 100644 index 0000000000..607109e1ec --- /dev/null +++ b/man/a_aes_.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aes.r +\name{a_aes_} +\alias{a_aes_} +\alias{a_aes_string} +\alias{a_aes_q} +\title{Define aesthetic mappings from strings, or quoted calls and formulas.} +\usage{ +a_aes_(x, y, ...) + +a_aes_string(x, y, ...) + +a_aes_q(x, y, ...) +} +\arguments{ +\item{x, y, ...}{List of name value pairs. Elements must be either +quoted calls, strings, one-sided formulas or constants.} +} +\description{ +Aesthetic mappings describe how variables in the data are mapped to visual +properties (aesthetics) of geoms. \code{\link{a_aes}} uses non-standard +evaluation to capture the variable names. \code{a_aes_} and \code{a_aes_string} +require you to explicitly quote the inputs either with \code{""} for +\code{a_aes_string()}, or with \code{quote} or \code{~} for \code{a_aes_()}. +(\code{a_aes_q} is an alias to \code{a_aes_}) +} +\details{ +It's better to use \code{a_aes_q()}, because there's no easy way to create the +equivalent to \code{a_aes(colour = "my colour")} or \code{a_aes{x = `X$1`}} +with \code{a_aes_string()}. + +\code{a_aes_string} and \code{a_aes_} are particularly useful when writing +functions that create plots because you can use strings or quoted +names/calls to define the aesthetic mappings, rather than having to use +\code{\link{substitute}} to generate a call to \code{a_aes()}. +} +\examples{ +# Three ways of generating the same aesthetics +a_aes(mpg, wt, col = cyl) +a_aes_(quote(mpg), quote(wt), col = quote(cyl)) +a_aes_(~mpg, ~wt, col = ~cyl) +a_aes_string("mpg", "wt", col = "cyl") + +# You can't easily mimic these calls with a_aes_string +a_aes(`$100`, colour = "smooth") +a_aes_(~ `$100`, colour = "smooth") +# Ok, you can, but it requires a _lot_ of quotes +a_aes_string("`$100`", colour = '"smooth"') + +# Convert strings to names with as.name +var <- "cyl" +a_aes(col = x) +a_aes_(col = as.name(var)) +} +\seealso{ +\code{\link{a_aes}} +} diff --git a/man/aes_all.Rd b/man/a_aes_all.Rd similarity index 74% rename from man/aes_all.Rd rename to man/a_aes_all.Rd index 2aba9e61cc..69431d3705 100644 --- a/man/aes_all.Rd +++ b/man/a_aes_all.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aes.r -\name{aes_all} -\alias{aes_all} +\name{a_aes_all} +\alias{a_aes_all} \title{Given a character vector, create a set of identity mappings} \usage{ -aes_all(vars) +a_aes_all(vars) } \arguments{ \item{vars}{vector of variable names} @@ -13,8 +13,7 @@ aes_all(vars) Given a character vector, create a set of identity mappings } \examples{ -aes_all(names(mtcars)) -aes_all(c("x", "y", "col", "pch")) +a_aes_all(names(mtcars)) +a_aes_all(c("x", "y", "col", "pch")) } \keyword{internal} - diff --git a/man/aes_auto.Rd b/man/a_aes_auto.Rd similarity index 82% rename from man/aes_auto.Rd rename to man/a_aes_auto.Rd index 9533ce5788..82e224f5c9 100644 --- a/man/aes_auto.Rd +++ b/man/a_aes_auto.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aes.r -\name{aes_auto} -\alias{aes_auto} +\name{a_aes_auto} +\alias{a_aes_auto} \title{Automatic aesthetic mapping} \usage{ -aes_auto(data = NULL, ...) +a_aes_auto(data = NULL, ...) } \arguments{ \item{data}{data.frame or names of variables} @@ -15,4 +15,3 @@ aes_auto(data = NULL, ...) Automatic aesthetic mapping } \keyword{internal} - diff --git a/man/aes_colour_fill_alpha.Rd b/man/a_aes_colour_fill_alpha.Rd similarity index 50% rename from man/aes_colour_fill_alpha.Rd rename to man/a_aes_colour_fill_alpha.Rd index d7211fb696..4aa26fde4a 100644 --- a/man/aes_colour_fill_alpha.Rd +++ b/man/a_aes_colour_fill_alpha.Rd @@ -1,9 +1,9 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aes-colour-fill-alpha.r -\name{aes_colour_fill_alpha} -\alias{aes_colour_fill_alpha} -\alias{color} +\name{a_aes_colour_fill_alpha} +\alias{a_aes_colour_fill_alpha} \alias{colour} +\alias{color} \alias{fill} \title{Colour related aesthetics: colour, fill and alpha} \description{ @@ -14,49 +14,48 @@ of aesthetics; colour, fill and alpha. \donttest{ # Bar chart example -c <- ggplot(mtcars, aes(factor(cyl))) +c <- a_plot(mtcars, a_aes(factor(cyl))) # Default plotting -c + geom_bar() +c + a_geom_bar() # To change the interior colouring use fill aesthetic -c + geom_bar(fill = "red") +c + a_geom_bar(fill = "red") # Compare with the colour aesthetic which changes just the bar outline -c + geom_bar(colour = "red") +c + a_geom_bar(colour = "red") # Combining both, you can see the changes more clearly -c + geom_bar(fill = "white", colour = "red") +c + a_geom_bar(fill = "white", colour = "red") # The aesthetic fill also takes different colouring scales # setting fill equal to a factor variable uses a discrete colour scale -k <- ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) -k + geom_bar() +k <- a_plot(mtcars, a_aes(factor(cyl), fill = factor(vs))) +k + a_geom_bar() # Fill aesthetic can also be used with a continuous variable -m <- ggplot(faithfuld, aes(waiting, eruptions)) -m + geom_raster() -m + geom_raster(aes(fill = density)) +m <- a_plot(faithfuld, a_aes(waiting, eruptions)) +m + a_geom_raster() +m + a_geom_raster(a_aes(fill = density)) -# Some geoms don't use both aesthetics (i.e. geom_point or geom_line) -b <- ggplot(economics, aes(x = date, y = unemploy)) -b + geom_line() -b + geom_line(colour = "green") -b + geom_point() -b + geom_point(colour = "red") +# Some geoms don't use both a_aesthetics (i.e. geom_point or geom_line) +b <- a_plot(economics, a_aes(x = date, y = unemploy)) +b + a_geom_line() +b + a_geom_line(colour = "green") +b + a_geom_point() +b + a_geom_point(colour = "red") # For large datasets with overplotting the alpha -# aesthetic will make the points more transparent +# a_aesthetic will make the points more transparent df <- data.frame(x = rnorm(5000), y = rnorm(5000)) -h <- ggplot(df, aes(x,y)) -h + geom_point() -h + geom_point(alpha = 0.5) -h + geom_point(alpha = 1/10) +h <- a_plot(df, a_aes(x,y)) +h + a_geom_point() +h + a_geom_point(alpha = 0.5) +h + a_geom_point(alpha = 1/10) # Alpha can also be used to add shading -j <- b + geom_line() +j <- b + a_geom_line() j yrng <- range(economics$unemploy) -j <- j + geom_rect(aes(NULL, NULL, xmin = start, xmax = end, fill = party), +j <- j + a_geom_rect(a_aes(NULL, NULL, xmin = start, xmax = end, fill = party), ymin = yrng[1], ymax = yrng[2], data = presidential) j -j + scale_fill_manual(values = alpha(c("blue", "red"), .3)) +j + a_scale_fill_manual(values = alpha(c("blue", "red"), .3)) } } - diff --git a/man/aes_group_order.Rd b/man/a_aes_group_order.Rd similarity index 63% rename from man/aes_group_order.Rd rename to man/a_aes_group_order.Rd index c54f6802e0..3f7b184181 100644 --- a/man/aes_group_order.Rd +++ b/man/a_aes_group_order.Rd @@ -1,7 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aes-group-order.r -\name{aes_group_order} -\alias{aes_group_order} +\name{a_aes_group_order} +\alias{a_aes_group_order} \alias{group} \title{Aesthetics: group} \description{ @@ -19,19 +19,19 @@ Aesthetics: group # For most applications you can simply specify the grouping with # various aesthetics (colour, shape, fill, linetype) or with facets. -p <- ggplot(mtcars, aes(wt, mpg)) +p <- a_plot(mtcars, a_aes(wt, mpg)) # A basic scatter plot -p + geom_point(size = 4) -# The colour aesthetic -p + geom_point(aes(colour = factor(cyl)), size = 4) +p + a_geom_point(size = 4) +# The colour a_aesthetic +p + a_geom_point(a_aes(colour = factor(cyl)), size = 4) # Or you can use shape to distinguish the data -p + geom_point(aes(shape = factor(cyl)), size = 4) +p + a_geom_point(a_aes(shape = factor(cyl)), size = 4) # Using fill -a <- ggplot(mtcars, aes(factor(cyl))) -a + geom_bar() -a + geom_bar(aes(fill = factor(cyl))) -a + geom_bar(aes(fill = factor(vs))) +a <- a_plot(mtcars, a_aes(factor(cyl))) +a + a_geom_bar() +a + a_geom_bar(a_aes(fill = factor(cyl))) +a + a_geom_bar(a_aes(fill = factor(vs))) # Using linetypes rescale01 <- function(x) (x - min(x)) / diff(range(x)) @@ -39,11 +39,11 @@ ec_scaled <- data.frame( date = economics$date, plyr::colwise(rescale01)(economics[, -(1:2)])) ecm <- reshape2::melt(ec_scaled, id.vars = "date") -f <- ggplot(ecm, aes(date, value)) -f + geom_line(aes(linetype = variable)) +f <- a_plot(ecm, a_aes(date, value)) +f + a_geom_line(a_aes(linetype = variable)) # Using facets -k <- ggplot(diamonds, aes(carat, ..density..)) + geom_histogram(binwidth = 0.2) +k <- a_plot(diamonds, a_aes(carat, ..density..)) + a_geom_histogram(binwidth = 0.2) k + facet_grid(. ~ cut) # There are three common cases where the default is not enough, and we @@ -52,34 +52,33 @@ k + facet_grid(. ~ cut) # (height) and centered ages (age) of 26 boys (Subject), measured on nine # occasions (Occasion). -# Multiple groups with one aesthetic -h <- ggplot(nlme::Oxboys, aes(age, height)) +# Multiple groups with one a_aesthetic +h <- a_plot(nlme::Oxboys, a_aes(age, height)) # A single line tries to connect all the observations -h + geom_line() -# The group aesthetic maps a different line for each subject -h + geom_line(aes(group = Subject)) +h + a_geom_line() +# The group a_aesthetic maps a different line for each subject +h + a_geom_line(a_aes(group = Subject)) # Different groups on different layers -h <- h + geom_line(aes(group = Subject)) -# Using the group aesthetic with both geom_line() and geom_smooth() +h <- h + a_geom_line(a_aes(group = Subject)) +# Using the group a_aesthetic with both a_geom_line() and a_geom_smooth() # groups the data the same way for both layers -h + geom_smooth(aes(group = Subject), method = "lm", se = FALSE) +h + a_geom_smooth(a_aes(group = Subject), method = "lm", se = FALSE) # Changing the group aesthetic for the smoother layer # fits a single line of best fit across all boys -h + geom_smooth(aes(group = 1), size = 2, method = "lm", se = FALSE) +h + a_geom_smooth(a_aes(group = 1), size = 2, method = "lm", se = FALSE) # Overriding the default grouping # The plot has a discrete scale but you want to draw lines that connect across # groups. This is the strategy used in interaction plots, profile plots, and parallel # coordinate plots, among others. For example, we draw boxplots of height at # each measurement occasion -boysbox <- ggplot(nlme::Oxboys, aes(Occasion, height)) -boysbox + geom_boxplot() +boysbox <- a_plot(nlme::Oxboys, a_aes(Occasion, height)) +boysbox + a_geom_boxplot() # There is no need to specify the group aesthetic here; the default grouping # works because occasion is a discrete variable. To overlay individual trajectories -# we again need to override the default grouping for that layer with aes(group = Subject) -boysbox <- boysbox + geom_boxplot() -boysbox + geom_line(aes(group = Subject), colour = "blue") +# we again need to override the default grouping for that layer with a_aes(group = Subject) +boysbox <- boysbox + a_geom_boxplot() +boysbox + a_geom_line(a_aes(group = Subject), colour = "blue") } } - diff --git a/man/aes_linetype_size_shape.Rd b/man/a_aes_linetype_size_shape.Rd similarity index 56% rename from man/aes_linetype_size_shape.Rd rename to man/a_aes_linetype_size_shape.Rd index d6025b11ae..9a0b877665 100644 --- a/man/aes_linetype_size_shape.Rd +++ b/man/a_aes_linetype_size_shape.Rd @@ -1,14 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aes-linetype-size-shape.r -\name{aes_linetype_size_shape} -\alias{aes_linetype_size_shape} +\name{a_aes_linetype_size_shape} +\alias{a_aes_linetype_size_shape} \alias{linetype} -\alias{shape} \alias{size} -\title{Differentiation related aesthetics: linetype, size, shape} +\alias{shape} +\title{Differentiation related a_aesthetics: linetype, size, shape} \description{ This page demonstrates the usage of a sub-group -of aesthetics; linetype, size and shape. +of a_aesthetics; linetype, size and shape. } \examples{ @@ -19,52 +19,51 @@ of aesthetics; linetype, size and shape. # Data df <- data.frame(x = 1:10 , y = 1:10) -f <- ggplot(df, aes(x, y)) -f + geom_line(linetype = 2) -f + geom_line(linetype = "dotdash") +f <- a_plot(df, a_aes(x, y)) +f + a_geom_line(linetype = 2) +f + a_geom_line(linetype = "dotdash") # An example with hex strings, the string "33" specifies three units on followed # by three off and "3313" specifies three units on followed by three off followed # by one on and finally three off. -f + geom_line(linetype = "3313") +f + a_geom_line(linetype = "3313") # Mapping line type from a variable -ggplot(economics_long, aes(date, value01)) + - geom_line(aes(linetype = variable)) +a_plot(economics_long, a_aes(date, value01)) + + a_geom_line(a_aes(linetype = variable)) # Size examples # Should be specified with a numerical value (in millimetres), # or from a variable source -p <- ggplot(mtcars, aes(wt, mpg)) -p + geom_point(size = 4) -p + geom_point(aes(size = qsec)) -p + geom_point(size = 2.5) + - geom_hline(yintercept = 25, size = 3.5) +p <- a_plot(mtcars, a_aes(wt, mpg)) +p + a_geom_point(size = 4) +p + a_geom_point(a_aes(size = qsec)) +p + a_geom_point(size = 2.5) + + a_geom_hline(yintercept = 25, size = 3.5) # Shape examples # Shape takes four types of values: an integer in [0, 25], # a single character-- which uses that character as the plotting symbol, # a . to draw the smallest rectangle that is visible (i.e., about one pixel) # an NA to draw nothing -p + geom_point() -p + geom_point(shape = 5) -p + geom_point(shape = "k", size = 3) -p + geom_point(shape = ".") -p + geom_point(shape = NA) +p + a_geom_point() +p + a_geom_point(shape = 5) +p + a_geom_point(shape = "k", size = 3) +p + a_geom_point(shape = ".") +p + a_geom_point(shape = NA) # Shape can also be mapped from a variable -p + geom_point(aes(shape = factor(cyl))) +p + a_geom_point(a_aes(shape = factor(cyl))) # A look at all 25 symbols df2 <- data.frame(x = 1:5 , y = 1:25, z = 1:25) -s <- ggplot(df2, aes(x, y)) -s + geom_point(aes(shape = z), size = 4) + - scale_shape_identity() +s <- a_plot(df2, a_aes(x, y)) +s + a_geom_point(a_aes(shape = z), size = 4) + + a_scale_shape_identity() # While all symbols have a foreground colour, symbols 19-25 also take a # background colour (fill) -s + geom_point(aes(shape = z), size = 4, colour = "Red") + - scale_shape_identity() -s + geom_point(aes(shape = z), size = 4, colour = "Red", fill = "Black") + - scale_shape_identity() +s + a_geom_point(a_aes(shape = z), size = 4, colour = "Red") + + a_scale_shape_identity() +s + a_geom_point(a_aes(shape = z), size = 4, colour = "Red", fill = "Black") + + a_scale_shape_identity() } - diff --git a/man/aes_position.Rd b/man/a_aes_position.Rd similarity index 58% rename from man/aes_position.Rd rename to man/a_aes_position.Rd index 5c9acc6c73..859a551fc8 100644 --- a/man/aes_position.Rd +++ b/man/a_aes_position.Rd @@ -1,19 +1,19 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aes-position.r -\name{aes_position} -\alias{aes_position} +\name{a_aes_position} +\alias{a_aes_position} \alias{x} -\alias{xend} -\alias{xmax} -\alias{xmin} \alias{y} -\alias{yend} -\alias{ymax} +\alias{xmin} +\alias{xmax} \alias{ymin} +\alias{ymax} +\alias{xend} +\alias{yend} \title{Position related aesthetics: x, y, xmin, xmax, ymin, ymax, xend, yend} \description{ This page demonstrates the usage of a sub-group -of aesthetics; x, y, xmin, xmax, ymin, ymax, xend, and yend. +of a_aesthetics; x, y, xmin, xmax, ymin, ymax, xend, and yend. } \examples{ @@ -22,29 +22,28 @@ of aesthetics; x, y, xmin, xmax, ymin, ymax, xend, and yend. dmod <- lm(price ~ cut, data = diamonds) cuts <- data.frame(cut = unique(diamonds$cut), predict(dmod, data.frame(cut = unique(diamonds$cut)), se = TRUE)[c("fit", "se.fit")]) -se <- ggplot(cuts, aes(x = cut, y = fit, ymin = fit - se.fit, +se <- a_plot(cuts, a_aes(x = cut, y = fit, ymin = fit - se.fit, ymax = fit + se.fit, colour = cut)) -se + geom_pointrange() +se + a_geom_pointrange() -# Using annotate -p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() -p + annotate("rect", xmin = 2, xmax = 3.5, ymin = 2, ymax = 25, +# Using a_annotate +p <- a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point() +p + ggplot2Animint:::a_annotate("rect", xmin = 2, xmax = 3.5, ymin = 2, ymax = 25, fill = "dark grey", alpha = .5) # Geom_segment examples -p + geom_segment(aes(x = 2, y = 15, xend = 2, yend = 25), +p + a_geom_segment(a_aes(x = 2, y = 15, xend = 2, yend = 25), arrow = arrow(length = unit(0.5, "cm"))) -p + geom_segment(aes(x = 2, y = 15, xend = 3, yend = 15), +p + a_geom_segment(a_aes(x = 2, y = 15, xend = 3, yend = 15), arrow = arrow(length = unit(0.5, "cm"))) -p + geom_segment(aes(x = 5, y = 30, xend = 3.5, yend = 25), +p + a_geom_segment(a_aes(x = 5, y = 30, xend = 3.5, yend = 25), arrow = arrow(length = unit(0.5, "cm"))) -# You can also use geom_segment to recreate plot(type = "h") : +# You can also use a_geom_segment to recreate plot(type = "h") : counts <- as.data.frame(table(x = rpois(100, 5))) counts$x <- as.numeric(as.character(counts$x)) with(counts, plot(x, Freq, type = "h", lwd = 10)) -ggplot(counts, aes(x, Freq)) + - geom_segment(aes(yend = 0, xend = x), size = 10) +a_plot(counts, a_aes(x, Freq)) + + a_geom_segment(a_aes(yend = 0, xend = x), size = 10) } - diff --git a/man/annotate.Rd b/man/a_annotate.Rd similarity index 60% rename from man/annotate.Rd rename to man/a_annotate.Rd index 5c2e4304e1..4b5676fc14 100644 --- a/man/annotate.Rd +++ b/man/a_annotate.Rd @@ -1,23 +1,23 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/annotation.r -\name{annotate} -\alias{annotate} +\name{a_annotate} +\alias{a_annotate} \title{Create an annotation layer.} \usage{ -annotate(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL, +a_annotate(a_geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL, ymin = NULL, ymax = NULL, xend = NULL, yend = NULL, ..., na.rm = FALSE) } \arguments{ -\item{geom}{name of geom to use for annotation} +\item{a_geom}{name of geom to use for annotation} \item{x, y, xmin, ymin, xmax, ymax, xend, yend}{positioning aesthetics - you must specify at least one of these.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -36,16 +36,16 @@ set. This means that layers created with this function will never affect the legend. } \examples{ -p <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_point() -p + annotate("text", x = 4, y = 25, label = "Some text") -p + annotate("text", x = 2:5, y = 25, label = "Some text") -p + annotate("rect", xmin = 3, xmax = 4.2, ymin = 12, ymax = 21, +p <- a_plot(mtcars, a_aes(x = wt, y = mpg)) + a_geom_point() +p + ggplot2Animint:::a_annotate("text", x = 4, y = 25, a_label = "Some text") +p + ggplot2Animint:::a_annotate("text", x = 2:5, y = 25, a_label = "Some text") +p + ggplot2Animint:::a_annotate("rect", xmin = 3, xmax = 4.2, ymin = 12, ymax = 21, alpha = .2) -p + annotate("segment", x = 2.5, xend = 4, y = 15, yend = 25, +p + ggplot2Animint:::a_annotate("segment", x = 2.5, xend = 4, y = 15, yend = 25, colour = "blue") -p + annotate("pointrange", x = 3.5, y = 20, ymin = 12, ymax = 28, +p + ggplot2Animint:::a_annotate("pointrange", x = 3.5, y = 20, ymin = 12, ymax = 28, colour = "red", size = 1.5) -p + annotate("text", x = 2:3, y = 20:21, label = c("my label", "label 2")) +p + ggplot2Animint:::a_annotate("text", x = 2:3, y = 20:21, a_label = c("my label", "label 2")) } - +\keyword{internal} diff --git a/man/annotation_custom.Rd b/man/a_annotation_custom.Rd similarity index 66% rename from man/annotation_custom.Rd rename to man/a_annotation_custom.Rd index 0a4d6a6f71..78e1cce8ce 100644 --- a/man/annotation_custom.Rd +++ b/man/a_annotation_custom.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/annotation-custom.r -\name{annotation_custom} -\alias{annotation_custom} +\name{a_annotation_custom} +\alias{a_annotation_custom} \title{Annotation: Custom grob.} \usage{ -annotation_custom(grob, xmin = -Inf, xmax = Inf, ymin = -Inf, +a_annotation_custom(grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) } \arguments{ @@ -26,7 +26,7 @@ of the grob, and the grob will not be modified by any ggplot settings or mapping Most useful for adding tables, inset plots, and other grid-based decorations. } \note{ -\code{annotation_custom} expects the grob to fill the entire viewport +\code{a_annotation_custom} expects the grob to fill the entire viewport defined by xmin, xmax, ymin, ymax. Grobs with a different (absolute) size will be center-justified in that region. Inf values can be used to fill the full plot panel (see examples). @@ -34,22 +34,21 @@ Inf values can be used to fill the full plot panel (see examples). \examples{ # Dummy plot df <- data.frame(x = 1:10, y = 1:10) -base <- ggplot(df, aes(x, y)) + - geom_blank() + - theme_bw() +base <- a_plot(df, a_aes(x, y)) + + a_geom_blank() + + a_theme_bw() -# Full panel annotation -base + annotation_custom( +# Full panel a_annotation +base + ggplot2Animint:::a_annotation_custom( grob = grid::roundrectGrob(), xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf ) # Inset plot df2 <- data.frame(x = 1 , y = 1) -g <- ggplotGrob(ggplot(df2, aes(x, y)) + - geom_point() + - theme(plot.background = element_rect(colour = "black"))) -base + - annotation_custom(grob = g, xmin = 1, xmax = 10, ymin = 8, ymax = 10) +g <- ggplotGrob(a_plot(df2, a_aes(x, y)) + + a_geom_point() + + a_theme(plot.background = a_element_rect(colour = "black"))) +base + ggplot2Animint:::a_annotation_custom(grob = g, xmin = 1, xmax = 10, ymin = 8, ymax = 10) } - +\keyword{internal} diff --git a/man/annotation_logticks.Rd b/man/a_annotation_logticks.Rd similarity index 55% rename from man/annotation_logticks.Rd rename to man/a_annotation_logticks.Rd index 4a703147d9..4028eb8b0e 100644 --- a/man/annotation_logticks.Rd +++ b/man/a_annotation_logticks.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/annotation-logticks.r -\name{annotation_logticks} -\alias{annotation_logticks} +\name{a_annotation_logticks} +\alias{a_annotation_logticks} \title{Annotation: log tick marks} \usage{ -annotation_logticks(base = 10, sides = "bl", scaled = TRUE, +a_annotation_logticks(base = 10, sides = "bl", scaled = TRUE, short = unit(0.1, "cm"), mid = unit(0.2, "cm"), long = unit(0.3, "cm"), colour = "black", size = 0.5, linetype = 1, alpha = 1, color = NULL, ...) @@ -18,8 +18,8 @@ bottom, and left.} \item{scaled}{is the data already log-scaled? This should be \code{TRUE} (default) when the data is already transformed with \code{log10()} or when -using \code{scale_y_log10}. It should be \code{FALSE} when using -\code{coord_trans(y = "log10")}.} +using \code{a_scale_y_log10}. It should be \code{FALSE} when using +\code{a_coord_trans(y = "log10")}.} \item{short}{a \code{\link[grid]{unit}} object specifying the length of the short tick marks} @@ -48,53 +48,54 @@ These tick marks probably make sense only for base 10. } \examples{ # Make a log-log plot (without log ticks) -a <- ggplot(msleep, aes(bodywt, brainwt)) + - geom_point(na.rm = TRUE) + - scale_x_log10( +a <- a_plot(msleep, a_aes(bodywt, brainwt)) + + a_geom_point(na.rm = TRUE) + + a_scale_x_log10( breaks = scales::trans_breaks("log10", function(x) 10^x), - labels = scales::trans_format("log10", scales::math_format(10^.x)) + a_labels = scales::trans_format("log10", scales::math_format(10^.x)) ) + - scale_y_log10( + a_scale_y_log10( breaks = scales::trans_breaks("log10", function(x) 10^x), - labels = scales::trans_format("log10", scales::math_format(10^.x)) + a_labels = scales::trans_format("log10", scales::math_format(10^.x)) ) + - theme_bw() + a_theme_bw() -a + annotation_logticks() # Default: log ticks on bottom and left -a + annotation_logticks(sides = "lr") # Log ticks for y, on left and right -a + annotation_logticks(sides = "trbl") # All four sides +a + ggplot2Animint:::a_annotation_logticks() # Default: log ticks on bottom and left +a + ggplot2Animint:::a_annotation_logticks(sides = "lr") # Log ticks for y, on left and right +a + ggplot2Animint:::a_annotation_logticks(sides = "trbl") # All four sides # Hide the minor grid lines because they don't align with the ticks -a + annotation_logticks(sides = "trbl") + theme(panel.grid.minor = element_blank()) +a + ggplot2Animint:::a_annotation_logticks(sides = "trbl") + +a_theme(panel.grid.minor = a_element_blank()) # Another way to get the same results as 'a' above: log-transform the data before # plotting it. Also hide the minor grid lines. -b <- ggplot(msleep, aes(log10(bodywt), log10(brainwt))) + - geom_point(na.rm = TRUE) + - scale_x_continuous(name = "body", labels = scales::math_format(10^.x)) + - scale_y_continuous(name = "brain", labels = scales::math_format(10^.x)) + - theme_bw() + theme(panel.grid.minor = element_blank()) +b <- a_plot(msleep, a_aes(log10(bodywt), log10(brainwt))) + + a_geom_point(na.rm = TRUE) + + a_scale_x_continuous(name = "body", a_labels = scales::math_format(10^.x)) + + a_scale_y_continuous(name = "brain", a_labels = scales::math_format(10^.x)) + + a_theme_bw() + a_theme(panel.grid.minor = a_element_blank()) -b + annotation_logticks() +b + ggplot2Animint:::a_annotation_logticks() # Using a coordinate transform requires scaled = FALSE -t <- ggplot(msleep, aes(bodywt, brainwt)) + - geom_point() + - coord_trans(x = "log10", y = "log10") + - theme_bw() -t + annotation_logticks(scaled = FALSE) +t <- a_plot(msleep, a_aes(bodywt, brainwt)) + + a_geom_point() + + ggplot2Animint:::a_coord_trans(x = "log10", y = "log10") + + a_theme_bw() +t + ggplot2Animint:::a_annotation_logticks(scaled = FALSE) # Change the length of the ticks -a + annotation_logticks( +a + ggplot2Animint:::a_annotation_logticks( short = unit(.5,"mm"), mid = unit(3,"mm"), long = unit(4,"mm") ) } \seealso{ -\code{\link{scale_y_continuous}}, \code{\link{scale_y_log10}} for log scale +\code{\link{a_scale_y_continuous}}, \code{\link{a_scale_y_log10}} for log scale transformations. -\code{\link{coord_trans}} for log coordinate transformations. +\code{\link{a_coord_trans}} for log coordinate transformations. } - +\keyword{internal} diff --git a/man/a_annotation_map.Rd b/man/a_annotation_map.Rd new file mode 100644 index 0000000000..93cf0f5e88 --- /dev/null +++ b/man/a_annotation_map.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/annotation-map.r +\name{a_annotation_map} +\alias{a_annotation_map} +\title{Annotation: maps.} +\usage{ +a_annotation_map(map, ...) +} +\arguments{ +\item{map}{data frame representing a map. Most map objects can be +converted into the right format by using \code{\link{a_fortify}}} + +\item{...}{other arguments used to modify aesthetics} +} +\description{ +Annotation: maps. +} +\examples{ +if (require("maps")) { +usamap <- map_data("state") + +seal.sub <- subset(seals, long > -130 & lat < 45 & lat > 40) +a_plot(seal.sub, a_aes(x = long, y = lat)) + + ggplot2Animint:::a_annotation_map(usamap, fill = "NA", colour = "grey50") + + a_geom_segment(a_aes(xend = long + delta_long, yend = lat + delta_lat)) + +seal2 <- transform(seal.sub, + latr = cut(lat, 2), + longr = cut(long, 2)) + +a_plot(seal2, a_aes(x = long, y = lat)) + + ggplot2Animint:::a_annotation_map(usamap, fill = "NA", colour = "grey50") + + a_geom_segment(a_aes(xend = long + delta_long, yend = lat + delta_lat)) + + ggplot2Animint:::a_facet_grid(latr ~ longr, scales = "free", space = "free") +} +} +\keyword{internal} diff --git a/man/annotation_raster.Rd b/man/a_annotation_raster.Rd similarity index 59% rename from man/annotation_raster.Rd rename to man/a_annotation_raster.Rd index c56340fa29..59793b5aac 100644 --- a/man/annotation_raster.Rd +++ b/man/a_annotation_raster.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/annotation-raster.r -\name{annotation_raster} -\alias{annotation_raster} +\name{a_annotation_raster} +\alias{a_annotation_raster} \title{Annotation: High-performance rectangular tiling.} \usage{ -annotation_raster(raster, xmin, xmax, ymin, ymax, interpolate = FALSE) +a_annotation_raster(raster, xmin, xmax, ymin, ymax, interpolate = FALSE) } \arguments{ \item{raster}{raster object to display} @@ -19,7 +19,7 @@ location of raster} (the default) don't interpolate.} } \description{ -This is a special version of \code{\link{geom_raster}} optimised for static +This is a special version of \code{\link{a_geom_raster}} optimised for static annotations that are the same in every panel. These annotations will not affect scales (i.e. the x and y axes will not grow to cover the range of the raster, and the raster must already have its own colours). @@ -30,21 +30,21 @@ Most useful for adding bitmap images. \examples{ # Generate data rainbow <- matrix(hcl(seq(0, 360, length.out = 50 * 50), 80, 70), nrow = 50) -ggplot(mtcars, aes(mpg, wt)) + - geom_point() + - annotation_raster(rainbow, 15, 20, 3, 4) +a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point() + + ggplot2Animint:::a_annotation_raster(rainbow, 15, 20, 3, 4) # To fill up whole plot -ggplot(mtcars, aes(mpg, wt)) + - annotation_raster(rainbow, -Inf, Inf, -Inf, Inf) + - geom_point() +a_plot(mtcars, a_aes(mpg, wt)) + + ggplot2Animint:::a_annotation_raster(rainbow, -Inf, Inf, -Inf, Inf) + + a_geom_point() rainbow2 <- matrix(hcl(seq(0, 360, length.out = 10), 80, 70), nrow = 1) -ggplot(mtcars, aes(mpg, wt)) + - annotation_raster(rainbow2, -Inf, Inf, -Inf, Inf) + - geom_point() +a_plot(mtcars, a_aes(mpg, wt)) + + ggplot2Animint:::a_annotation_raster(rainbow2, -Inf, Inf, -Inf, Inf) + + a_geom_point() rainbow2 <- matrix(hcl(seq(0, 360, length.out = 10), 80, 70), nrow = 1) -ggplot(mtcars, aes(mpg, wt)) + - annotation_raster(rainbow2, -Inf, Inf, -Inf, Inf, interpolate = TRUE) + - geom_point() +a_plot(mtcars, a_aes(mpg, wt)) + + ggplot2Animint:::a_annotation_raster(rainbow2, -Inf, Inf, -Inf, Inf, interpolate = TRUE) + + a_geom_point() } - +\keyword{internal} diff --git a/man/benchplot.Rd b/man/a_benchplot.Rd similarity index 64% rename from man/benchplot.Rd rename to man/a_benchplot.Rd index 97f5a9fd4e..c3fadbb966 100644 --- a/man/benchplot.Rd +++ b/man/a_benchplot.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/bench.r -\name{benchplot} -\alias{benchplot} +\name{a_benchplot} +\alias{a_benchplot} \title{Benchmark plot creation time. Broken down into construct, build, render and draw times.} \usage{ -benchplot(x) +a_benchplot(x) } \arguments{ \item{x}{code to create ggplot2 plot} @@ -15,8 +15,7 @@ Benchmark plot creation time. Broken down into construct, build, render and draw times. } \examples{ -benchplot(ggplot(mtcars, aes(mpg, wt)) + geom_point()) -benchplot(ggplot(mtcars, aes(mpg, wt)) + geom_point() + facet_grid(. ~ cyl)) +a_benchplot(a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point()) +a_benchplot(a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() + +a_facet_grid(. ~ cyl)) } -\keyword{internal} - diff --git a/man/a_build_strip.Rd b/man/a_build_strip.Rd new file mode 100644 index 0000000000..23b4690c9f --- /dev/null +++ b/man/a_build_strip.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/facet-labels.r +\name{a_build_strip} +\alias{a_build_strip} +\title{a_build strip function} +\usage{ +a_build_strip(panel, a_label_df, labeller, a_theme, side = "right", + switch = NULL) +} +\arguments{ +\item{panel}{....} + +\item{a_label_df}{....} + +\item{labeller}{....} + +\item{a_theme}{.....} + +\item{side}{.....} + +\item{switch}{....} +} +\description{ +a_build strip function +} diff --git a/man/calc_element.Rd b/man/a_calc_element.Rd similarity index 67% rename from man/calc_element.Rd rename to man/a_calc_element.Rd index 09e2a78675..07f2046e14 100644 --- a/man/calc_element.Rd +++ b/man/a_calc_element.Rd @@ -1,15 +1,15 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/theme.r -\name{calc_element} -\alias{calc_element} +\name{a_calc_element} +\alias{a_calc_element} \title{Calculate the element properties, by inheriting properties from its parents} \usage{ -calc_element(element, theme, verbose = FALSE) +a_calc_element(a_element, a_theme, verbose = FALSE) } \arguments{ -\item{element}{The name of the theme element to calculate} +\item{a_element}{The name of the theme element to calculate} -\item{theme}{A theme object (like theme_grey())} +\item{a_theme}{A theme object (like a_theme_grey())} \item{verbose}{If TRUE, print out which elements this one inherits from} } @@ -17,12 +17,12 @@ calc_element(element, theme, verbose = FALSE) Calculate the element properties, by inheriting properties from its parents } \examples{ -t <- theme_grey() -calc_element('text', t) +t <- a_theme_grey() +a_calc_element('text', t) # Compare the "raw" element definition to the element with calculated inheritance t$axis.text.x -calc_element('axis.text.x', t, verbose = TRUE) +a_calc_element('axis.text.x', t, verbose = TRUE) # This reports that axis.text.x inherits from axis.text, # which inherits from text. You can view each of them with: @@ -31,4 +31,3 @@ t$axis.text t$text } - diff --git a/man/coord_cartesian.Rd b/man/a_coord_cartesian.Rd similarity index 75% rename from man/coord_cartesian.Rd rename to man/a_coord_cartesian.Rd index 7d4a6d1aed..f23857bd81 100644 --- a/man/coord_cartesian.Rd +++ b/man/a_coord_cartesian.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/coord-cartesian-.r -\name{coord_cartesian} -\alias{coord_cartesian} +\name{a_coord_cartesian} +\alias{a_coord_cartesian} \title{Cartesian coordinates.} \usage{ -coord_cartesian(xlim = NULL, ylim = NULL, expand = TRUE) +a_coord_cartesian(xlim = NULL, ylim = NULL, expand = TRUE) } \arguments{ \item{xlim, ylim}{Limits for the x and y axes.} @@ -23,38 +23,37 @@ change the underlying data like setting limits on a scale will. # There are two ways of zooming the plot display: with scales or # with coordinate systems. They work in two rather different ways. -p <- ggplot(mtcars, aes(disp, wt)) + - geom_point() + - geom_smooth() +p <- a_plot(mtcars, a_aes(disp, wt)) + + a_geom_point() + + a_geom_smooth() p # Setting the limits on a scale converts all values outside the range to NA. -p + scale_x_continuous(limits = c(325, 500)) +p + a_scale_x_continuous(limits = c(325, 500)) # Setting the limits on the coordinate system performs a visual zoom. # The data is unchanged, and we just view a small portion of the original # plot. Note how smooth continues past the points visible on this plot. -p + coord_cartesian(xlim = c(325, 500)) +p + a_coord_cartesian(xlim = c(325, 500)) # By default, the same expansion factor is applied as when setting scale # limits. You can set the limits precisely by setting expand = FALSE -p + coord_cartesian(xlim = c(325, 500), expand = FALSE) +p + a_coord_cartesian(xlim = c(325, 500), expand = FALSE) # Simiarly, we can use expand = FALSE to turn off expansion with the # default limits -p + coord_cartesian(expand = FALSE) +p + a_coord_cartesian(expand = FALSE) # You can see the same thing with this 2d histogram -d <- ggplot(diamonds, aes(carat, price)) + - stat_bin2d(bins = 25, colour = "white") +d <- a_plot(diamonds, a_aes(carat, price)) + + a_stat_bin2d(bins = 25, colour = "white") d # When zooming the scale, the we get 25 new bins that are the same # size on the plot, but represent smaller regions of the data space -d + scale_x_continuous(limits = c(0, 1)) +d + a_scale_x_continuous(limits = c(0, 1)) # When zooming the coordinate system, we see a subset of original 50 bins, # displayed bigger -d + coord_cartesian(xlim = c(0, 1)) +d + a_coord_cartesian(xlim = c(0, 1)) } - diff --git a/man/coord_fixed.Rd b/man/a_coord_fixed.Rd similarity index 82% rename from man/coord_fixed.Rd rename to man/a_coord_fixed.Rd index 1574f91c47..e1a297a3b2 100644 --- a/man/coord_fixed.Rd +++ b/man/a_coord_fixed.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/coord-fixed.r -\name{coord_fixed} -\alias{coord_equal} -\alias{coord_fixed} +\name{a_coord_fixed} +\alias{a_coord_fixed} +\alias{a_coord_equal} \title{Cartesian coordinates with fixed relationship between x and y scales.} \usage{ -coord_fixed(ratio = 1, xlim = NULL, ylim = NULL, expand = TRUE) +a_coord_fixed(ratio = 1, xlim = NULL, ylim = NULL, expand = TRUE) } \arguments{ \item{ratio}{aspect ratio, expressed as \code{y / x}} @@ -31,11 +31,10 @@ y axis longer than units on the x-axis, and vice versa. This is similar to # ensures that the ranges of axes are equal to the specified ratio by # adjusting the plot aspect ratio -p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() -p + coord_fixed(ratio = 1) -p + coord_fixed(ratio = 5) -p + coord_fixed(ratio = 1/5) +p <- a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() +p + a_coord_fixed(ratio = 1) +p + a_coord_fixed(ratio = 5) +p + a_coord_fixed(ratio = 1/5) # Resize the plot to see that the specified aspect ratio is maintained } - diff --git a/man/coord_flip.Rd b/man/a_coord_flip.Rd similarity index 71% rename from man/coord_flip.Rd rename to man/a_coord_flip.Rd index 234b0c058f..6e56ba76fd 100644 --- a/man/coord_flip.Rd +++ b/man/a_coord_flip.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/coord-flip.r -\name{coord_flip} -\alias{coord_flip} +\name{a_coord_flip} +\alias{a_coord_flip} \title{Flipped cartesian coordinates.} \usage{ -coord_flip(xlim = NULL, ylim = NULL, expand = TRUE) +a_coord_flip(xlim = NULL, ylim = NULL, expand = TRUE) } \arguments{ \item{xlim}{Limits for the x and y axes.} @@ -24,20 +24,19 @@ statistics which display y conditional on x, to x conditional on y. # Very useful for creating boxplots, and other interval # geoms in the horizontal instead of vertical position. -ggplot(diamonds, aes(cut, price)) + - geom_boxplot() + - coord_flip() +a_plot(diamonds, a_aes(cut, price)) + + a_geom_boxplot() + + a_coord_flip() -h <- ggplot(diamonds, aes(carat)) + - geom_histogram() +h <- a_plot(diamonds, a_aes(carat)) + + a_geom_histogram() h -h + coord_flip() -h + coord_flip() + scale_x_reverse() +h + a_coord_flip() +h + a_coord_flip() + a_scale_x_reverse() # You can also use it to flip line and area plots: df <- data.frame(x = 1:5, y = (1:5) ^ 2) -ggplot(df, aes(x, y)) + - geom_area() -last_plot() + coord_flip() +a_plot(df, a_aes(x, y)) + + a_geom_area() +last_plot() + a_coord_flip() } - diff --git a/man/coord_map.Rd b/man/a_coord_map.Rd similarity index 62% rename from man/coord_map.Rd rename to man/a_coord_map.Rd index 5758f2b9ba..0b5e3d375a 100644 --- a/man/coord_map.Rd +++ b/man/a_coord_map.Rd @@ -1,14 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/coord-map.r, R/coord-quickmap.R -\name{coord_map} -\alias{coord_map} -\alias{coord_quickmap} +\name{a_coord_map} +\alias{a_coord_map} +\alias{a_coord_quickmap} \title{Map projections.} \usage{ -coord_map(projection = "mercator", ..., orientation = NULL, xlim = NULL, +a_coord_map(projection = "mercator", ..., orientation = NULL, xlim = NULL, ylim = NULL) -coord_quickmap(xlim = NULL, ylim = NULL, expand = TRUE) +a_coord_quickmap(xlim = NULL, ylim = NULL, expand = TRUE) } \arguments{ \item{projection}{projection to use, see @@ -33,7 +33,7 @@ limits are taken exactly from the data or \code{xlim}/\code{ylim}.} \description{ The representation of a portion of the earth, which is approximately spherical, onto a flat 2D plane requires a projection. This is what -\code{\link{coord_map}} does. These projections account for the fact that the +\code{\link{a_coord_map}} does. These projections account for the fact that the actual length (in km) of one degree of longitude varies between the equator and the pole. Near the equator, the ratio between the lengths of one degree of latitude and one degree of longitude is approximately 1. Near the pole, it @@ -41,11 +41,11 @@ is tends towards infinity because the length of one degree of longitude tends towards 0. For regions that span only a few degrees and are not too close to the poles, setting the aspect ratio of the plot to the appropriate lat/lon ratio approximates the usual mercator projection. This is what -\code{coord_quickmap} does. With \code{\link{coord_map}} all elements of the +\code{a_coord_quickmap} does. With \code{\link{a_coord_map}} all elements of the graphic have to be projected which is not the case here. So -\code{\link{coord_quickmap}} has the advantage of being much faster, in +\code{\link{a_coord_quickmap}} has the advantage of being much faster, in particular for complex plots such as those using with -\code{\link{geom_tile}}, at the expense of correctness in the projection. +\code{\link{a_geom_tile}}, at the expense of correctness in the projection. This coordinate system provides the full range of map projections available in the mapproj package. } @@ -53,54 +53,53 @@ in the mapproj package. if (require("maps")) { nz <- map_data("nz") # Prepare a map of NZ -nzmap <- ggplot(nz, aes(x = long, y = lat, group = group)) + - geom_polygon(fill = "white", colour = "black") +nzmap <- a_plot(nz, a_aes(x = long, y = lat, group = group)) + + a_geom_polygon(fill = "white", colour = "black") # Plot it in cartesian coordinates nzmap # With correct mercator projection -nzmap + coord_map() +nzmap + a_coord_map() # With the aspect ratio approximation -nzmap + coord_quickmap() +nzmap + a_coord_quickmap() # Other projections -nzmap + coord_map("cylindrical") -nzmap + coord_map("azequalarea", orientation = c(-36.92,174.6,0)) +nzmap + a_coord_map("cylindrical") +nzmap + a_coord_map("azequalarea", orientation = c(-36.92,174.6,0)) states <- map_data("state") -usamap <- ggplot(states, aes(long, lat, group = group)) + - geom_polygon(fill = "white", colour = "black") +usamap <- a_plot(states, a_aes(long, lat, group = group)) + + a_geom_polygon(fill = "white", colour = "black") # Use cartesian coordinates usamap # With mercator projection -usamap + coord_map() -usamap + coord_quickmap() +usamap + a_coord_map() +usamap + a_coord_quickmap() # See ?mapproject for coordinate systems and their parameters -usamap + coord_map("gilbert") -usamap + coord_map("lagrange") +usamap + a_coord_map("gilbert") +usamap + a_coord_map("lagrange") # For most projections, you'll need to set the orientation yourself # as the automatic selection done by mapproject is not available to # ggplot -usamap + coord_map("orthographic") -usamap + coord_map("stereographic") -usamap + coord_map("conic", lat0 = 30) -usamap + coord_map("bonne", lat0 = 50) +usamap + a_coord_map("orthographic") +usamap + a_coord_map("stereographic") +usamap + a_coord_map("conic", lat0 = 30) +usamap + a_coord_map("bonne", lat0 = 50) -# World map, using geom_path instead of geom_polygon +# World map, using a_geom_path instead of a_geom_polygon world <- map_data("world") -worldmap <- ggplot(world, aes(x = long, y = lat, group = group)) + - geom_path() + - scale_y_continuous(breaks = (-2:2) * 30) + - scale_x_continuous(breaks = (-4:4) * 45) +worldmap <- a_plot(world, a_aes(x = long, y = lat, group = group)) + + a_geom_path() + + a_scale_y_continuous(breaks = (-2:2) * 30) + + a_scale_x_continuous(breaks = (-4:4) * 45) # Orthographic projection with default orientation (looking down at North pole) -worldmap + coord_map("ortho") +worldmap + a_coord_map("ortho") # Looking up up at South Pole -worldmap + coord_map("ortho", orientation = c(-90, 0, 0)) +worldmap + a_coord_map("ortho", orientation = c(-90, 0, 0)) # Centered on New York (currently has issues with closing polygons) -worldmap + coord_map("ortho", orientation = c(41, -74, 0)) +worldmap + a_coord_map("ortho", orientation = c(41, -74, 0)) } } - diff --git a/man/coord_munch.Rd b/man/a_coord_munch.Rd similarity index 78% rename from man/coord_munch.Rd rename to man/a_coord_munch.Rd index 9ab2bd6707..fa163f31b1 100644 --- a/man/coord_munch.Rd +++ b/man/a_coord_munch.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/coord-munch.r -\name{coord_munch} -\alias{coord_munch} +\name{a_coord_munch} +\alias{a_coord_munch} \title{Munch coordinates data} \usage{ -coord_munch(coord, data, range, segment_length = 0.01) +a_coord_munch(a_coord, data, range, segment_length = 0.01) } \arguments{ -\item{coord}{Coordinate system definition.} +\item{a_coord}{Coordinate system definition.} \item{data}{Data set to transform - should have variables \code{x} and \code{y} are chopped up into small pieces (as defined by \code{group}). @@ -21,5 +21,3 @@ All other variables are duplicated as needed.} This function "munches" lines, dividing each line into many small pieces so they can be transformed independently. Used inside geom functions. } -\keyword{internal} - diff --git a/man/coord_polar.Rd b/man/a_coord_polar.Rd similarity index 61% rename from man/coord_polar.Rd rename to man/a_coord_polar.Rd index 49550c90af..59b11a4068 100644 --- a/man/coord_polar.Rd +++ b/man/a_coord_polar.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/coord-polar.r -\name{coord_polar} -\alias{coord_polar} +\name{a_coord_polar} +\alias{a_coord_polar} \title{Polar coordinates.} \usage{ -coord_polar(theta = "x", start = 0, direction = 1) +a_coord_polar(theta = "x", start = 0, direction = 1) } \arguments{ \item{theta}{variable to map angle to (\code{x} or \code{y})} @@ -24,31 +24,31 @@ are a stacked bar chart in polar coordinates. # grammar. Use with EXTREME caution. #' # A pie chart = stacked bar chart + polar coordinates -pie <- ggplot(mtcars, aes(x = factor(1), fill = factor(cyl))) + - geom_bar(width = 1) -pie + coord_polar(theta = "y") +pie <- a_plot(mtcars, a_aes(x = factor(1), fill = factor(cyl))) + + a_geom_bar(width = 1) +pie + a_coord_polar(theta = "y") \donttest{ # A coxcomb plot = bar chart + polar coordinates -cxc <- ggplot(mtcars, aes(x = factor(cyl))) + - geom_bar(width = 1, colour = "black") -cxc + coord_polar() +cxc <- a_plot(mtcars, a_aes(x = factor(cyl))) + + a_geom_bar(width = 1, colour = "black") +cxc + a_coord_polar() # A new type of plot? -cxc + coord_polar(theta = "y") +cxc + a_coord_polar(theta = "y") # The bullseye chart -pie + coord_polar() +pie + a_coord_polar() # Hadley's favourite pie chart df <- data.frame( variable = c("does not resemble", "resembles"), value = c(20, 80) ) -ggplot(df, aes(x = "", y = value, fill = variable)) + - geom_bar(width = 1, stat = "identity") + - scale_fill_manual(values = c("red", "yellow")) + - coord_polar("y", start = pi / 3) + +a_plot(df, a_aes(x = "", y = value, fill = variable)) + + a_geom_bar(width = 1, a_stat = "identity") + + a_scale_fill_manual(values = c("red", "yellow")) + + a_coord_polar("y", start = pi / 3) + labs(title = "Pac man") # Windrose + doughnut plot @@ -56,13 +56,12 @@ if (require("ggplot2movies")) { movies$rrating <- cut_interval(movies$rating, length = 1) movies$budgetq <- cut_number(movies$budget, 4) -doh <- ggplot(movies, aes(x = rrating, fill = budgetq)) +doh <- a_plot(movies, a_aes(x = rrating, fill = budgetq)) # Wind rose -doh + geom_bar(width = 1) + coord_polar() +doh + a_geom_bar(width = 1) + a_coord_polar() # Race track plot -doh + geom_bar(width = 0.9, position = "fill") + coord_polar(theta = "y") +doh + a_geom_bar(width = 0.9, position = "fill") + a_coord_polar(theta = "y") } } } - diff --git a/man/coord_trans.Rd b/man/a_coord_trans.Rd similarity index 56% rename from man/coord_trans.Rd rename to man/a_coord_trans.Rd index 50aa82ece7..38109948b2 100644 --- a/man/coord_trans.Rd +++ b/man/a_coord_trans.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/coord-transform.r -\name{coord_trans} -\alias{coord_trans} +\name{a_coord_trans} +\alias{a_coord_trans} \title{Transformed cartesian coordinate system.} \usage{ -coord_trans(x = "identity", y = "identity", limx = NULL, limy = NULL, +a_coord_trans(x = "identity", y = "identity", limx = NULL, limy = NULL, xtrans, ytrans) } \arguments{ @@ -16,7 +16,7 @@ compatibility)} \item{xtrans, ytrans}{Deprecated; use \code{x} and \code{y} instead.} } \description{ -\code{coord_trans} is different to scale transformations in that it occurs after +\code{a_coord_trans} is different to scale transformations in that it occurs after statistical transformation and will affect the visual appearance of geoms - there is no guarantee that straight lines will continue to be straight. } @@ -27,21 +27,21 @@ how to create your own. } \examples{ \donttest{ -# See ?geom_boxplot for other examples +# See ?a_geom_boxplot for other examples # Three ways of doing transformation in ggplot: # * by transforming the data -ggplot(diamonds, aes(log10(carat), log10(price))) + - geom_point() +a_plot(diamonds, a_aes(log10(carat), log10(price))) + + a_geom_point() # * by transforming the scales -ggplot(diamonds, aes(carat, price)) + - geom_point() + - scale_x_log10() + - scale_y_log10() +a_plot(diamonds, a_aes(carat, price)) + + a_geom_point() + + a_scale_x_log10() + + a_scale_y_log10() # * by transforming the coordinate system: -ggplot(diamonds, aes(carat, price)) + - geom_point() + - coord_trans(x = "log10", y = "log10") +a_plot(diamonds, a_aes(carat, price)) + + a_geom_point() + + a_coord_trans(x = "log10", y = "log10") # The difference between transforming the scales and # transforming the coordinate system is that scale @@ -51,16 +51,16 @@ ggplot(diamonds, aes(carat, price)) + d <- subset(diamonds, carat > 0.5) -ggplot(d, aes(carat, price)) + - geom_point() + - geom_smooth(method = "lm") + - scale_x_log10() + - scale_y_log10() +a_plot(d, a_aes(carat, price)) + + a_geom_point() + + a_geom_smooth(method = "lm") + + a_scale_x_log10() + + a_scale_y_log10() -ggplot(d, aes(carat, price)) + - geom_point() + - geom_smooth(method = "lm") + - coord_trans(x = "log10", y = "log10") +a_plot(d, a_aes(carat, price)) + + a_geom_point() + + a_geom_smooth(method = "lm") + + a_coord_trans(x = "log10", y = "log10") # Here I used a subset of diamonds so that the smoothed line didn't # drop below zero, which obviously causes problems on the log-transformed @@ -68,24 +68,23 @@ ggplot(d, aes(carat, price)) + # With a combination of scale and coordinate transformation, it's # possible to do back-transformations: -ggplot(diamonds, aes(carat, price)) + - geom_point() + - geom_smooth(method = "lm") + - scale_x_log10() + - scale_y_log10() + - coord_trans(x = scales::exp_trans(10), y = scales::exp_trans(10)) +a_plot(diamonds, a_aes(carat, price)) + + a_geom_point() + + a_geom_smooth(method = "lm") + + a_scale_x_log10() + + a_scale_y_log10() + + a_coord_trans(x = scales::exp_trans(10), y = scales::exp_trans(10)) # cf. -ggplot(diamonds, aes(carat, price)) + - geom_point() + - geom_smooth(method = "lm") +a_plot(diamonds, a_aes(carat, price)) + + a_geom_point() + + a_geom_smooth(method = "lm") # Also works with discrete scales df <- data.frame(a = abs(rnorm(26)),letters) -plot <- ggplot(df,aes(a,letters)) + geom_point() +plot <- a_plot(df,a_aes(a,letters)) + a_geom_point() -plot + coord_trans(x = "log10") -plot + coord_trans(x = "sqrt") +plot + a_coord_trans(x = "log10") +plot + a_coord_trans(x = "sqrt") } } - diff --git a/man/a_draw_key.Rd b/man/a_draw_key.Rd new file mode 100644 index 0000000000..caae53ce87 --- /dev/null +++ b/man/a_draw_key.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/legend-draw.r +\name{a_draw_key} +\alias{a_draw_key} +\alias{a_draw_key_point} +\alias{a_draw_key_abline} +\alias{a_draw_key_rect} +\alias{a_draw_key_polygon} +\alias{a_draw_key_blank} +\alias{a_draw_key_boxplot} +\alias{a_draw_key_crossbar} +\alias{a_draw_key_path} +\alias{a_draw_key_vpath} +\alias{a_draw_key_dotplot} +\alias{a_draw_key_pointrange} +\alias{a_draw_key_smooth} +\alias{a_draw_key_text} +\alias{a_draw_key_label} +\alias{a_draw_key_vline} +\title{Key drawing functions} +\usage{ +a_draw_key_point(data, params, size) + +a_draw_key_abline(data, params, size) + +a_draw_key_rect(data, params, size) + +a_draw_key_polygon(data, params, size) + +a_draw_key_blank(data, params, size) + +a_draw_key_boxplot(data, params, size) + +a_draw_key_crossbar(data, params, size) + +a_draw_key_path(data, params, size) + +a_draw_key_vpath(data, params, size) + +a_draw_key_dotplot(data, params, size) + +a_draw_key_pointrange(data, params, size) + +a_draw_key_smooth(data, params, size) + +a_draw_key_text(data, params, size) + +a_draw_key_label(data, params, size) + +a_draw_key_vline(data, params, size) +} +\arguments{ +\item{data}{A single row data frame containing the scaled aesthetics to +display in this key} + +\item{params}{A list of additional parameters supplied to the geom.} + +\item{size}{Width and height of key in mm.} +} +\value{ +A grid grob. +} +\description{ +Each Geom has an associated function that draws the key when the geom needs +to be displayed in a legend. These are the options built into ggplot2. +} +\keyword{internal} diff --git a/man/element_blank.Rd b/man/a_element_blank.Rd similarity index 81% rename from man/element_blank.Rd rename to man/a_element_blank.Rd index 042adcb770..634f71764d 100644 --- a/man/element_blank.Rd +++ b/man/a_element_blank.Rd @@ -1,14 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/theme-elements.r -\name{element_blank} -\alias{element_blank} +\name{a_element_blank} +\alias{a_element_blank} \title{Theme element: blank. This theme element draws nothing, and assigns no space} \usage{ -element_blank() +a_element_blank() } \description{ Theme element: blank. This theme element draws nothing, and assigns no space } - diff --git a/man/element_grob.Rd b/man/a_element_grob.Rd similarity index 71% rename from man/element_grob.Rd rename to man/a_element_grob.Rd index 04c6a0761d..a6fc88de88 100644 --- a/man/element_grob.Rd +++ b/man/a_element_grob.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/theme-elements.r -\name{element_grob} -\alias{element_grob} +\name{a_element_grob} +\alias{a_element_grob} \title{Generate grid grob from theme element} \usage{ -element_grob(element, ...) +a_element_grob(a_element, ...) } \arguments{ -\item{element}{Theme element, i.e. \code{element_rect} or similar.} +\item{a_element}{Theme element, i.e. \code{a_element_rect} or similar.} \item{...}{Other arguments to control specific of rendering. This is usually at least position. See the source code for individual methods.} @@ -16,4 +16,3 @@ usually at least position. See the source code for individual methods.} Generate grid grob from theme element } \keyword{internal} - diff --git a/man/element_line.Rd b/man/a_element_line.Rd similarity index 77% rename from man/element_line.Rd rename to man/a_element_line.Rd index 1f2ce79c0a..873f96dc13 100644 --- a/man/element_line.Rd +++ b/man/a_element_line.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/theme-elements.r -\name{element_line} -\alias{element_line} +\name{a_element_line} +\alias{a_element_line} \title{Theme element: line.} \usage{ -element_line(colour = NULL, size = NULL, linetype = NULL, +a_element_line(colour = NULL, size = NULL, linetype = NULL, lineend = NULL, color = NULL) } \arguments{ @@ -21,4 +21,3 @@ element_line(colour = NULL, size = NULL, linetype = NULL, \description{ Theme element: line. } - diff --git a/man/element_rect.Rd b/man/a_element_rect.Rd similarity index 76% rename from man/element_rect.Rd rename to man/a_element_rect.Rd index bc034f259d..f3bfde6062 100644 --- a/man/element_rect.Rd +++ b/man/a_element_rect.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/theme-elements.r -\name{element_rect} -\alias{element_rect} +\name{a_element_rect} +\alias{a_element_rect} \title{Theme element: rectangle.} \usage{ -element_rect(fill = NULL, colour = NULL, size = NULL, linetype = NULL, +a_element_rect(fill = NULL, colour = NULL, size = NULL, linetype = NULL, color = NULL) } \arguments{ @@ -21,4 +21,3 @@ element_rect(fill = NULL, colour = NULL, size = NULL, linetype = NULL, \description{ Most often used for backgrounds and borders. } - diff --git a/man/element_text.Rd b/man/a_element_text.Rd similarity index 89% rename from man/element_text.Rd rename to man/a_element_text.Rd index 55433b4281..8327fa3100 100644 --- a/man/element_text.Rd +++ b/man/a_element_text.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/theme-elements.r -\name{element_text} -\alias{element_text} +\name{a_element_text} +\alias{a_element_text} \title{Theme element: text.} \usage{ -element_text(family = NULL, face = NULL, colour = NULL, size = NULL, +a_element_text(family = NULL, face = NULL, colour = NULL, size = NULL, hjust = NULL, vjust = NULL, angle = NULL, lineheight = NULL, color = NULL, margin = NULL, debug = NULL) } @@ -32,10 +32,9 @@ details. When creating a theme, the margins should be placed on the side of the text facing towards the center of the plot.} \item{debug}{If \code{TRUE}, aids visual debugging by drawing a solid -rectangle behind the complete text area, and a point where each label +rectangle behind the complete text area, and a point where each a_label is anchored.} } \description{ Theme element: text. } - diff --git a/man/facet.Rd b/man/a_facet.Rd similarity index 74% rename from man/facet.Rd rename to man/a_facet.Rd index da462e8c36..f48b3c54a6 100644 --- a/man/facet.Rd +++ b/man/a_facet.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet-.r -\name{facet} -\alias{facet} -\title{Facet specification.} +\name{a_facet} +\alias{a_facet} +\title{a_facet specification.} \usage{ -facet(..., shrink = TRUE, subclass = c()) +a_facet(..., shrink = TRUE, subclass = c()) } \arguments{ \item{...}{object fields} @@ -15,4 +15,3 @@ facet(..., shrink = TRUE, subclass = c()) Create new facetting specification. For internal use only. } \keyword{internal} - diff --git a/man/facet_grid.Rd b/man/a_facet_grid.Rd similarity index 70% rename from man/facet_grid.Rd rename to man/a_facet_grid.Rd index f099188861..7077199a74 100644 --- a/man/facet_grid.Rd +++ b/man/a_facet_grid.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet-grid-.r -\name{facet_grid} -\alias{facet_grid} +\name{a_facet_grid} +\alias{a_facet_grid} \title{Lay out panels in a grid.} \usage{ -facet_grid(facets, margins = FALSE, scales = "fixed", space = "fixed", - shrink = TRUE, labeller = "label_value", as.table = TRUE, +a_facet_grid(facets, margins = FALSE, scales = "fixed", space = "fixed", + shrink = TRUE, labeller = "a_label_value", as.table = TRUE, switch = NULL, drop = TRUE) } \arguments{ @@ -44,7 +44,7 @@ one with formulae of the type \code{~cyl + am}. Each output column gets displayed as one separate line in the strip label. This function should inherit from the "labeller" S3 class for compatibility with \code{\link{labeller}()}. See -\code{\link{label_value}} for more details and pointers to other +\code{\link{a_label_value}} for more details and pointers to other options.} \item{as.table}{If \code{TRUE}, the default, the facets are laid out like @@ -65,11 +65,11 @@ will be shown, regardless of whether or not they appear in the data.} Lay out panels in a grid. } \examples{ -p <- ggplot(mpg, aes(displ, cty)) + geom_point() +p <- a_plot(mpg, a_aes(displ, cty)) + a_geom_point() -p + facet_grid(. ~ cyl) -p + facet_grid(drv ~ .) -p + facet_grid(drv ~ cyl) +p + a_facet_grid(. ~ cyl) +p + a_facet_grid(drv ~ .) +p + a_facet_grid(drv ~ cyl) # To change plot order of facet grid, # change the order of variable levels with factor() @@ -79,67 +79,66 @@ p + facet_grid(drv ~ cyl) # combinations: df <- data.frame(displ = mean(mpg$displ), cty = mean(mpg$cty)) p + - facet_grid(. ~ cyl) + - geom_point(data = df, colour = "red", size = 2) + a_facet_grid(. ~ cyl) + + a_geom_point(data = df, colour = "red", size = 2) # Free scales ------------------------------------------------------- # You can also choose whether the scales should be constant # across all panels (the default), or whether they should be allowed # to vary -mt <- ggplot(mtcars, aes(mpg, wt, colour = factor(cyl))) + - geom_point() +mt <- a_plot(mtcars, a_aes(mpg, wt, colour = factor(cyl))) + + a_geom_point() -mt + facet_grid(. ~ cyl, scales = "free") +mt + a_facet_grid(. ~ cyl, scales = "free") # If scales and space are free, then the mapping between position # and values in the data will be the same across all panels. This # is particularly useful for categorical axes -ggplot(mpg, aes(drv, model)) + - geom_point() + - facet_grid(manufacturer ~ ., scales = "free", space = "free") + - theme(strip.text.y = element_text(angle = 0)) +a_plot(mpg, a_aes(drv, model)) + + a_geom_point() + + a_facet_grid(manufacturer ~ ., scales = "free", space = "free") + + a_theme(strip.text.y = a_element_text(angle = 0)) # Facet labels ------------------------------------------------------ -p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() +p <- a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point() p -# label_both() displays both variable name and value -p + facet_grid(vs ~ cyl, labeller = label_both) +# a_label_both() displays both variable name and value +p + a_facet_grid(vs ~ cyl, labeller = a_label_both) -# label_parsed() parses text into mathematical expressions, see ?plotmath +# a_label_parsed() parses text into mathematical expressions, see ?plotmath mtcars$cyl2 <- factor(mtcars$cyl, labels = c("alpha", "beta", "sqrt(x, y)")) -ggplot(mtcars, aes(wt, mpg)) + - geom_point() + - facet_grid(. ~ cyl2, labeller = label_parsed) +a_plot(mtcars, a_aes(wt, mpg)) + + a_geom_point() + + a_facet_grid(. ~ cyl2, labeller = a_label_parsed) -# label_bquote() makes it easy to construct math expressions -p + facet_grid(. ~ vs, labeller = label_bquote(cols = alpha ^ .(vs))) +# a_label_bquote() makes it easy to construct math expressions +p + a_facet_grid(. ~ vs, labeller = a_label_bquote(cols = alpha ^ .(vs))) # The facet strips can be displayed near the axes with switch data <- transform(mtcars, am = factor(am, levels = 0:1, c("Automatic", "Manual")), gear = factor(gear, levels = 3:5, labels = c("Three", "Four", "Five")) ) -p <- ggplot(data, aes(mpg, disp)) + geom_point() -p + facet_grid(am ~ gear, switch = "both") +p <- a_plot(data, a_aes(mpg, disp)) + a_geom_point() +p + a_facet_grid(am ~ gear, switch = "both") # It looks better without boxes around the strips -p + facet_grid(am ~ gear, switch = "both") + - theme(strip.background = element_blank()) +p + a_facet_grid(am ~ gear, switch = "both") + + a_theme(strip.background = a_element_blank()) # Margins ---------------------------------------------------------- \donttest{ # Margins can be specified by logically (all yes or all no) or by specific # variables as (character) variable names -mg <- ggplot(mtcars, aes(x = mpg, y = wt)) + geom_point() -mg + facet_grid(vs + am ~ gear) -mg + facet_grid(vs + am ~ gear, margins = TRUE) -mg + facet_grid(vs + am ~ gear, margins = "am") +mg <- a_plot(mtcars, a_aes(x = mpg, y = wt)) + a_geom_point() +mg + a_facet_grid(vs + am ~ gear) +mg + a_facet_grid(vs + am ~ gear, margins = TRUE) +mg + a_facet_grid(vs + am ~ gear, margins = "am") # when margins are made over "vs", since the facets for "am" vary # within the values of "vs", the marginal facet for "vs" is also # a margin over "am". -mg + facet_grid(vs + am ~ gear, margins = "vs") -mg + facet_grid(vs + am ~ gear, margins = "gear") -mg + facet_grid(vs + am ~ gear, margins = c("gear", "am")) +mg + a_facet_grid(vs + am ~ gear, margins = "vs") +mg + a_facet_grid(vs + am ~ gear, margins = "gear") +mg + a_facet_grid(vs + am ~ gear, margins = c("gear", "am")) } } - diff --git a/man/facet_null.Rd b/man/a_facet_null.Rd similarity index 81% rename from man/facet_null.Rd rename to man/a_facet_null.Rd index c1b302b0cb..0df46fe739 100644 --- a/man/facet_null.Rd +++ b/man/a_facet_null.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet-null.r -\name{facet_null} -\alias{facet_null} +\name{a_facet_null} +\alias{a_facet_null} \title{Facet specification: a single panel.} \usage{ -facet_null(shrink = TRUE) +a_facet_null(shrink = TRUE) } \arguments{ \item{shrink}{If \code{TRUE}, will shrink scales to fit output of @@ -17,6 +17,5 @@ Facet specification: a single panel. \examples{ # facet_null is the default facetting specification if you # don't override it with facet_grid or facet_wrap -ggplot(mtcars, aes(mpg, wt)) + geom_point() +a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() } - diff --git a/man/facet_wrap.Rd b/man/a_facet_wrap.Rd similarity index 74% rename from man/facet_wrap.Rd rename to man/a_facet_wrap.Rd index c20baa741f..4b7c7f4403 100644 --- a/man/facet_wrap.Rd +++ b/man/a_facet_wrap.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet-wrap.r -\name{facet_wrap} -\alias{facet_wrap} +\name{a_facet_wrap} +\alias{a_facet_wrap} \title{Wrap a 1d ribbon of panels into 2d.} \usage{ -facet_wrap(facets, nrow = NULL, ncol = NULL, scales = "fixed", - shrink = TRUE, labeller = "label_value", as.table = TRUE, +a_facet_wrap(facets, nrow = NULL, ncol = NULL, scales = "fixed", + shrink = TRUE, labeller = "a_label_value", as.table = TRUE, switch = NULL, drop = TRUE, dir = "h") } \arguments{ @@ -29,7 +29,7 @@ one with formulae of the type \code{~cyl + am}. Each output column gets displayed as one separate line in the strip label. This function should inherit from the "labeller" S3 class for compatibility with \code{\link{labeller}()}. See -\code{\link{label_value}} for more details and pointers to other +\code{\link{a_label_value}} for more details and pointers to other options.} \item{as.table}{If \code{TRUE}, the default, the facets are laid out like @@ -51,63 +51,62 @@ vertical.} \description{ Most displays are roughly rectangular, so if you have a categorical variable with many levels, it doesn't make sense to try and display them -all in one row (or one column). To solve this dilemma, \code{facet_wrap} +all in one row (or one column). To solve this dilemma, \code{a_facet_wrap} wraps a 1d sequence of panels into 2d, making best use of screen real estate. } \examples{ -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - facet_wrap(~class) +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_facet_wrap(~class) # Control the number of rows and columns with nrow and ncol -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - facet_wrap(~class, nrow = 4) +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_facet_wrap(~class, nrow = 4) \donttest{ # You can facet by multiple variables -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - facet_wrap(~ cyl + drv) +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_facet_wrap(~ cyl + drv) # Or use a character vector: -ggplot(mpg, aes(displ, hwy)) + - geom_point() + +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + facet_wrap(c("cyl", "drv")) # Use the `labeller` option to control how labels are printed: -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - facet_wrap(c("cyl", "drv"), labeller = "label_both") +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + facet_wrap(c("cyl", "drv"), labeller = "a_label_both") # To change the order in which the panels appear, change the levels # of the underlying factor. mpg$class2 <- reorder(mpg$class, mpg$displ) -ggplot(mpg, aes(displ, hwy)) + - geom_point() + +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + facet_wrap(~class2) # By default, the same scales are used for all panels. You can allow # scales to vary across the panels with the `scales` argument. # Free scales make it easier to see patterns within each panel, but # harder to compare across panels. -ggplot(mpg, aes(displ, hwy)) + - geom_point() + +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + facet_wrap(~class, scales = "free") # To repeat the same data in every panel, simply construct a data frame # that does not contain the facetting variable. -ggplot(mpg, aes(displ, hwy)) + - geom_point(data = transform(mpg, class = NULL), colour = "grey85") + - geom_point() + +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point(data = transform(mpg, class = NULL), colour = "grey85") + + a_geom_point() + facet_wrap(~class) # Use `switch` to display the facet labels near an axis, acting as # a subtitle for this axis. This is typically used with free scales -# and a theme without boxes around strip labels. -ggplot(economics_long, aes(date, value)) + - geom_line() + +# and a a_theme without boxes around strip labels. +a_plot(economics_long, a_aes(date, value)) + + a_geom_line() + facet_wrap(~variable, scales = "free_y", nrow = 2, switch = "x") + - theme(strip.background = element_blank()) + a_theme(strip.background = a_element_blank()) } } - diff --git a/man/a_fortify-multcomp.Rd b/man/a_fortify-multcomp.Rd new file mode 100644 index 0000000000..2cd4c4974a --- /dev/null +++ b/man/a_fortify-multcomp.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fortify-multcomp.r +\name{a_fortify-multcomp} +\alias{a_fortify-multcomp} +\alias{a_fortify.glht} +\alias{a_fortify.confint.glht} +\alias{a_fortify.summary.glht} +\alias{a_fortify.cld} +\title{Fortify methods for objects produced by \pkg{multcomp}} +\usage{ +\method{a_fortify}{glht}(model, data, ...) + +\method{a_fortify}{confint.glht}(model, data, ...) + +\method{a_fortify}{summary.glht}(model, data, ...) + +\method{a_fortify}{cld}(model, data, ...) +} +\arguments{ +\item{model}{an object of class \code{glht}, \code{confint.glht}, +\code{summary.glht} or \code{\link[multcomp]{cld}}} + +\item{data, ...}{other arguments to the generic ignored in this method.} +} +\description{ +Fortify methods for objects produced by \pkg{multcomp} +} +\examples{ +if (require("multcomp")) { +amod <- aov(breaks ~ wool + tension, data = warpbreaks) +wht <- glht(amod, linfct = mcp(tension = "Tukey")) + +a_fortify(wht) +a_plot(wht, a_aes(lhs, estimate)) + a_geom_point() + +CI <- confint(wht) +a_fortify(CI) +a_plot(CI, a_aes(lhs, estimate, ymin = lwr, ymax = upr)) + + a_geom_pointrange() + +a_fortify(summary(wht)) +a_plot(mapping = a_aes(lhs, estimate)) + + a_geom_linerange(a_aes(ymin = lwr, ymax = upr), data = CI) + + a_geom_point(a_aes(size = p), data = summary(wht)) + + a_scale_size(trans = "reverse") + +cld <- cld(wht) +a_fortify(cld) +} +} diff --git a/man/fortify.Rd b/man/a_fortify.Rd similarity index 72% rename from man/fortify.Rd rename to man/a_fortify.Rd index e80157fa0c..1f87a7af6e 100644 --- a/man/fortify.Rd +++ b/man/a_fortify.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/fortify.r -\name{fortify} -\alias{fortify} +\name{a_fortify} +\alias{a_fortify} \title{Fortify a model with data.} \usage{ -fortify(model, data, ...) +a_fortify(model, data, ...) } \arguments{ \item{model}{model or other R object to convert to data frame} @@ -15,10 +15,9 @@ fortify(model, data, ...) } \description{ Rather than using this function, I now recomend using the \pkg{broom} -package, which implements a much wider range of methods. \code{fortify} +package, which implements a much wider range of methods. \code{a_fortify} may be deprecated in the future. } \seealso{ -\code{\link{fortify.lm}} +\code{\link{a_fortify.lm}} } - diff --git a/man/a_fortify.lm.Rd b/man/a_fortify.lm.Rd new file mode 100644 index 0000000000..12cb3fdb57 --- /dev/null +++ b/man/a_fortify.lm.Rd @@ -0,0 +1,87 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fortify-lm.r +\name{a_fortify.lm} +\alias{a_fortify.lm} +\title{Supplement the data fitted to a linear model with model fit statistics.} +\usage{ +\method{a_fortify}{lm}(model, data = model$model, ...) +} +\arguments{ +\item{model}{linear model} + +\item{data}{data set, defaults to data used to fit model} + +\item{...}{not used by this method} +} +\value{ +The original data with extra columns: + \item{.hat}{Diagonal of the hat matrix} + \item{.sigma}{Estimate of residual standard deviation when + corresponding observation is dropped from model} + \item{.cooksd}{Cooks distance, \code{\link{cooks.distance}}} + \item{.fitted}{Fitted values of model} + \item{.resid}{Residuals} + \item{.stdresid}{Standardised residuals} +} +\description{ +If you have missing values in your model data, you may need to refit +the model with \code{na.action = na.exclude}. +} +\examples{ +mod <- lm(mpg ~ wt, data = mtcars) +head(a_fortify(mod)) +head(a_fortify(mod, mtcars)) + +plot(mod, which = 1) + +a_plot(mod, a_aes(.fitted, .resid)) + + a_geom_point() + + a_geom_hline(yintercept = 0) + + a_geom_smooth(se = FALSE) + +a_plot(mod, a_aes(.fitted, .stdresid)) + + a_geom_point() + + a_geom_hline(yintercept = 0) + + a_geom_smooth(se = FALSE) + +a_plot(a_fortify(mod, mtcars), a_aes(.fitted, .stdresid)) + + a_geom_point(a_aes(colour = factor(cyl))) + +a_plot(a_fortify(mod, mtcars), a_aes(mpg, .stdresid)) + + a_geom_point(a_aes(colour = factor(cyl))) + +plot(mod, which = 2) +a_plot(mod) + + a_stat_qq(a_aes(sample = .stdresid)) + + a_geom_abline() + +plot(mod, which = 3) +a_plot(mod, a_aes(.fitted, sqrt(abs(.stdresid)))) + + a_geom_point() + + a_geom_smooth(se = FALSE) + +plot(mod, which = 4) +a_plot(mod, a_aes(seq_along(.cooksd), .cooksd)) + + a_geom_bar(a_stat = "identity") + +plot(mod, which = 5) +a_plot(mod, a_aes(.hat, .stdresid)) + + a_geom_vline(size = 2, colour = "white", xintercept = 0) + + a_geom_hline(size = 2, colour = "white", yintercept = 0) + + a_geom_point() + a_geom_smooth(se = FALSE) + +a_plot(mod, a_aes(.hat, .stdresid)) + + a_geom_point(a_aes(size = .cooksd)) + + a_geom_smooth(se = FALSE, size = 0.5) + +plot(mod, which = 6) +a_plot(mod, a_aes(.hat, .cooksd)) + + a_geom_vline(xintercept = 0, colour = NA) + + a_geom_abline(slope = seq(0, 3, by = 0.5), colour = "white") + + a_geom_smooth(se = FALSE) + + a_geom_point() + +a_plot(mod, a_aes(.hat, .cooksd)) + + a_geom_point(a_aes(size = .cooksd / .hat)) + + a_scale_size_area() +} diff --git a/man/fortify.map.Rd b/man/a_fortify.map.Rd similarity index 66% rename from man/fortify.map.Rd rename to man/a_fortify.map.Rd index 84454ac41f..01c3ceaeb9 100644 --- a/man/fortify.map.Rd +++ b/man/a_fortify.map.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/fortify-map.r -\name{fortify.map} -\alias{fortify.map} +\name{a_fortify.map} +\alias{a_fortify.map} \title{Fortify method for map objects.} \usage{ -\method{fortify}{map}(model, data, ...) +\method{a_fortify}{map}(model, data, ...) } \arguments{ \item{model}{map object} @@ -20,17 +20,16 @@ plotted with ggplot2. \examples{ if (require("maps")) { ca <- map("county", "ca", plot = FALSE, fill = TRUE) -head(fortify(ca)) -ggplot(ca, aes(long, lat)) + - geom_polygon(aes(group = group)) +head(a_fortify(ca)) +a_plot(ca, a_aes(long, lat)) + + a_geom_polygon(a_aes(group = group)) tx <- map("county", "texas", plot = FALSE, fill = TRUE) -head(fortify(tx)) -ggplot(tx, aes(long, lat)) + - geom_polygon(aes(group = group), colour = "white") +head(a_fortify(tx)) +a_plot(tx, a_aes(long, lat)) + + a_geom_polygon(a_aes(group = group), colour = "white") } } \seealso{ \code{\link{map_data}} and \code{\link{borders}} } - diff --git a/man/fortify.sp.Rd b/man/a_fortify.sp.Rd similarity index 50% rename from man/fortify.sp.Rd rename to man/a_fortify.sp.Rd index 211b19f911..2b9533fc31 100644 --- a/man/fortify.sp.Rd +++ b/man/a_fortify.sp.Rd @@ -1,29 +1,29 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/fortify-spatial.r -\name{fortify.sp} -\alias{fortify.Line} -\alias{fortify.Lines} -\alias{fortify.Polygon} -\alias{fortify.Polygons} -\alias{fortify.SpatialLinesDataFrame} -\alias{fortify.SpatialPolygons} -\alias{fortify.SpatialPolygonsDataFrame} -\alias{fortify.sp} +\name{a_fortify.sp} +\alias{a_fortify.sp} +\alias{a_fortify.SpatialPolygonsDataFrame} +\alias{a_fortify.SpatialPolygons} +\alias{a_fortify.Polygons} +\alias{a_fortify.Polygon} +\alias{a_fortify.SpatialLinesDataFrame} +\alias{a_fortify.Lines} +\alias{a_fortify.Line} \title{Fortify method for classes from the sp package.} \usage{ -\method{fortify}{SpatialPolygonsDataFrame}(model, data, region = NULL, ...) +\method{a_fortify}{SpatialPolygonsDataFrame}(model, data, region = NULL, ...) -\method{fortify}{SpatialPolygons}(model, data, ...) +\method{a_fortify}{SpatialPolygons}(model, data, ...) -\method{fortify}{Polygons}(model, data, ...) +\method{a_fortify}{Polygons}(model, data, ...) -\method{fortify}{Polygon}(model, data, ...) +\method{a_fortify}{Polygon}(model, data, ...) -\method{fortify}{SpatialLinesDataFrame}(model, data, ...) +\method{a_fortify}{SpatialLinesDataFrame}(model, data, ...) -\method{fortify}{Lines}(model, data, ...) +\method{a_fortify}{Lines}(model, data, ...) -\method{fortify}{Line}(model, data, ...) +\method{a_fortify}{Line}(model, data, ...) } \arguments{ \item{model}{\code{SpatialPolygonsDataFrame} to convert into a dataframe.} @@ -43,7 +43,6 @@ if (require("maptools")) { sids <- system.file("shapes/sids.shp", package="maptools") nc1 <- readShapePoly(sids, proj4string = CRS("+proj=longlat +datum=NAD27")) - nc1_df <- fortify(nc1) + nc1_df <- a_fortify(nc1) } } - diff --git a/man/geom_abline.Rd b/man/a_geom_abline.Rd similarity index 63% rename from man/geom_abline.Rd rename to man/a_geom_abline.Rd index 8fb31c2434..fd5a6e2ef5 100644 --- a/man/geom_abline.Rd +++ b/man/a_geom_abline.Rd @@ -1,23 +1,23 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-abline.r, R/geom-hline.r, R/geom-vline.r -\name{geom_abline} -\alias{geom_abline} -\alias{geom_hline} -\alias{geom_vline} +\name{a_geom_abline} +\alias{a_geom_abline} +\alias{a_geom_hline} +\alias{a_geom_vline} \title{Lines: horizontal, vertical, and specified by slope and intercept.} \usage{ -geom_abline(mapping = NULL, data = NULL, ..., slope, intercept, +a_geom_abline(mapping = NULL, data = NULL, ..., slope, intercept, na.rm = FALSE, show.legend = NA) -geom_hline(mapping = NULL, data = NULL, ..., yintercept, na.rm = FALSE, +a_geom_hline(mapping = NULL, data = NULL, ..., yintercept, na.rm = FALSE, show.legend = NA) -geom_vline(mapping = NULL, data = NULL, ..., xintercept, na.rm = FALSE, +a_geom_vline(mapping = NULL, data = NULL, ..., xintercept, na.rm = FALSE, show.legend = NA) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -25,20 +25,20 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -60,7 +60,7 @@ for annotating plots. These geoms act slightly different to other geoms. You can supply the parameters in two ways: either as arguments to the layer function, or via aesthetics. If you use arguments, e.g. -\code{geom_abline(intercept = 0, slope = 1)}, then behind the scenes +\code{a_geom_abline(intercept = 0, slope = 1)}, then behind the scenes the geom makes a new data frame containing just the data you've supplied. That means that the lines will be the same in all facets; if you want them to vary across facets, construct the data frame yourself and use aesthetics. @@ -71,49 +71,49 @@ commonly set in the plot. They also do not affect the x and y scales. } \section{Aesthetics}{ -These geoms are drawn using with \code{\link{geom_line}} so support the +These geoms are drawn using with \code{\link{a_geom_line}} so support the same aesthetics: alpha, colour, linetype and size. They also each have aesthetics that control the position of the line: \itemize{ - \item \code{geom_vline}: \code{xintercept} - \item \code{geom_hline}: \code{yintercept} - \item \code{geom_abline}: \code{slope} and \code{intercept} + \item \code{a_geom_vline}: \code{xintercept} + \item \code{a_geom_hline}: \code{yintercept} + \item \code{a_geom_abline}: \code{slope} and \code{intercept} } } + \examples{ -p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() +p <- a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point() # Fixed values -p + geom_vline(xintercept = 5) -p + geom_vline(xintercept = 1:5) -p + geom_hline(yintercept = 20) +p + a_geom_vline(xintercept = 5) +p + a_geom_vline(xintercept = 1:5) +p + a_geom_hline(yintercept = 20) -p + geom_abline() # Can't see it - outside the range of the data -p + geom_abline(intercept = 20) +p + a_geom_abline() # Can't see it - outside the range of the data +p + a_geom_abline(intercept = 20) # Calculate slope and intercept of line of best fit coef(lm(mpg ~ wt, data = mtcars)) -p + geom_abline(intercept = 37, slope = -5) -# But this is easier to do with geom_smooth: -p + geom_smooth(method = "lm", se = FALSE) +p + a_geom_abline(intercept = 37, slope = -5) +# But this is easier to do with a_geom_smooth: +p + a_geom_smooth(method = "lm", se = FALSE) # To show different lines in different facets, use aesthetics -p <- ggplot(mtcars, aes(mpg, wt)) + - geom_point() + - facet_wrap(~ cyl) +p <- a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point() + + a_facet_wrap(~ cyl) mean_wt <- data.frame(cyl = c(4, 6, 8), wt = c(2.28, 3.11, 4.00)) -p + geom_hline(aes(yintercept = wt), mean_wt) +p + a_geom_hline(a_aes(yintercept = wt), mean_wt) # You can also control other aesthetics -ggplot(mtcars, aes(mpg, wt, colour = wt)) + - geom_point() + - geom_hline(aes(yintercept = wt, colour = wt), mean_wt) + - facet_wrap(~ cyl) +a_plot(mtcars, a_aes(mpg, wt, colourffa = wt)) + + a_geom_point() + + a_geom_hline(a_aes(yintercept = wt, colour = wt), mean_wt) + + a_facet_wrap(~ cyl) } \seealso{ -See \code{\link{geom_segment}} for a more general approach to +See \code{\link{a_geom_segment}} for a more general approach to adding straight line segments to a plot. } - diff --git a/man/geom_bar.Rd b/man/a_geom_bar.Rd similarity index 54% rename from man/geom_bar.Rd rename to man/a_geom_bar.Rd index bfeec9b4c4..5de0fa4934 100644 --- a/man/geom_bar.Rd +++ b/man/a_geom_bar.Rd @@ -1,21 +1,21 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-bar.r, R/stat-count.r -\name{geom_bar} -\alias{geom_bar} -\alias{stat_count} +\name{a_geom_bar} +\alias{a_geom_bar} +\alias{a_stat_count} \title{Bars, rectangles with bases on x-axis} \usage{ -geom_bar(mapping = NULL, data = NULL, stat = "count", - position = "stack", ..., width = NULL, binwidth = NULL, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) +a_geom_bar(mapping = NULL, data = NULL, a_stat = "count", + a_position = "stack", ..., width = NULL, binwidth = NULL, + na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) -stat_count(mapping = NULL, data = NULL, geom = "bar", - position = "stack", ..., width = NULL, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) +a_stat_count(mapping = NULL, data = NULL, a_geom = "bar", + a_position = "stack", ..., width = NULL, na.rm = FALSE, + show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -23,29 +23,29 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{width}{Bar width. By default, set to 90\% of the resolution of the data.} -\item{binwidth}{\code{geom_bar} no longer has a binwidth argument - if +\item{binwidth}{\code{a_geom_bar} no longer has a binwidth argument - if you use it you'll get an warning telling to you use -\code{\link{geom_histogram}} instead.} +\code{\link{a_geom_histogram}} instead.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -54,24 +54,24 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} -\item{geom, stat}{Override the default connection between \code{geom_bar} and -\code{stat_count}.} +\item{a_geom, a_stat}{Override the default connection between \code{a_geom_bar} and +\code{a_stat_count}.} } \description{ There are two types of bar charts, determined by what is mapped to bar -height. By default, \code{geom_bar} uses \code{stat="count"} which makes the +height. By default, \code{a_geom_bar} uses \code{a_stat="count"} which makes the height of the bar proportion to the number of cases in each group (or if the \code{weight} aethetic is supplied, the sum of the weights). If you want the heights of the bars to represent values in the data, use -\code{stat="identity"} and map a variable to the \code{y} aesthetic. +\code{a_stat="identity"} and map a variable to the \code{y} aesthetic. -\code{stat_count} counts the number of cases at each x position. If you want -to bin the data in ranges, you should use \code{\link{stat_bin}} instead. +\code{a_stat_count} counts the number of cases at each x position. If you want +to bin the data in ranges, you should use \code{\link{a_stat_bin}} instead. } \details{ A bar chart maps the height of the bar to a variable, and so the base of the @@ -82,14 +82,14 @@ topic}. This is why it doesn't make sense to use a log-scaled y axis with a bar chart. By default, multiple x's occurring in the same place will be stacked atop one -another by \code{\link{position_stack}}. If you want them to be dodged -side-to-side, see \code{\link{position_dodge}}. Finally, -\code{\link{position_fill}} shows relative proportions at each x by stacking +another by \code{\link{a_position_stack}}. If you want them to be dodged +side-to-side, see \code{\link{a_position_dodge}}. Finally, +\code{\link{a_position_fill}} shows relative proportions at each x by stacking the bars and then stretching or squashing to the same height. } \section{Aesthetics}{ - \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "bar")} + \Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "bar")} } \section{Computed variables}{ @@ -99,55 +99,55 @@ the bars and then stretching or squashing to the same height. \item{prop}{groupwise proportion} } } + \examples{ -# geom_bar is designed to make it easy to create bar charts that show +# a_geom_bar is designed to make it easy to create bar charts that show # counts (or sums of weights) -g <- ggplot(mpg, aes(class)) +g <- a_plot(mpg, a_aes(class)) # Number of cars in each class: -g + geom_bar() +g + a_geom_bar() # Total engine displacement of each class -g + geom_bar(aes(weight = displ)) +g + a_geom_bar(a_aes(weight = displ)) -# To show (e.g.) means, you need stat = "identity" +# To show (e.g.) means, you need a_stat = "identity" df <- data.frame(trt = c("a", "b", "c"), outcome = c(2.3, 1.9, 3.2)) -ggplot(df, aes(trt, outcome)) + - geom_bar(stat = "identity") -# But geom_point() display exactly the same information and doesn't +a_plot(df, a_aes(trt, outcome)) + + a_geom_bar(a_stat = "identity") +# But a_geom_point() display exactly the same information and doesn't # require the y-axis to touch zero. -ggplot(df, aes(trt, outcome)) + - geom_point() +a_plot(df, a_aes(trt, outcome)) + + a_geom_point() -# You can also use geom_bar() with continuous data, in which case +# You can also use a_geom_bar() with continuous data, in which case # it will show counts at unique locations df <- data.frame(x = rep(c(2.9, 3.1, 4.5), c(5, 10, 4))) -ggplot(df, aes(x)) + geom_bar() +a_plot(df, a_aes(x)) + a_geom_bar() # cf. a histogram of the same data -ggplot(df, aes(x)) + geom_histogram(binwidth = 0.5) +a_plot(df, a_aes(x)) + a_geom_histogram(binwidth = 0.5) \donttest{ # Bar charts are automatically stacked when multiple bars are placed # at the same location -g + geom_bar(aes(fill = drv)) +g + a_geom_bar(a_aes(fill = drv)) # You can instead dodge, or fill them -g + geom_bar(aes(fill = drv), position = "dodge") -g + geom_bar(aes(fill = drv), position = "fill") +g + a_geom_bar(a_aes(fill = drv), a_position = "dodge") +g + a_geom_bar(a_aes(fill = drv), a_position = "fill") # To change plot order of bars, change levels in underlying factor reorder_size <- function(x) { factor(x, levels = names(sort(table(x)))) } -ggplot(mpg, aes(reorder_size(class))) + geom_bar() +a_plot(mpg, a_aes(reorder_size(class))) + a_geom_bar() } } \seealso{ -\code{\link{geom_histogram}} for continuous data, - \code{\link{position_dodge}} for creating side-by-side barcharts. +\code{\link{a_geom_histogram}} for continuous data, + \code{\link{a_position_dodge}} for creating side-by-side barcharts. -\code{\link{stat_bin}}, which bins data in ranges and counts the - cases in each range. It differs from \code{stat_count}, which counts the +\code{\link{a_stat_bin}}, which bins data in ranges and counts the + cases in each range. It differs from \code{a_stat_count}, which counts the number of cases at each x position (without binning into ranges). - \code{\link{stat_bin}} requires continuous x data, whereas - \code{stat_count} can be used for both discrete and continuous x data. + \code{\link{a_stat_bin}} requires continuous x data, whereas + \code{a_stat_count} can be used for both discrete and continuous x data. } - diff --git a/man/geom_bin2d.Rd b/man/a_geom_bin2d.Rd similarity index 61% rename from man/geom_bin2d.Rd rename to man/a_geom_bin2d.Rd index d87d064f99..0f4d351a34 100644 --- a/man/geom_bin2d.Rd +++ b/man/a_geom_bin2d.Rd @@ -1,22 +1,22 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-bin2d.r, R/stat-bin2d.r -\name{geom_bin2d} -\alias{geom_bin2d} -\alias{stat_bin2d} -\alias{stat_bin_2d} +\name{a_geom_bin2d} +\alias{a_geom_bin2d} +\alias{a_stat_bin_2d} +\alias{a_stat_bin2d} \title{Add heatmap of 2d bin counts.} \usage{ -geom_bin2d(mapping = NULL, data = NULL, stat = "bin2d", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_geom_bin2d(mapping = NULL, data = NULL, a_stat = "bin2d", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) -stat_bin_2d(mapping = NULL, data = NULL, geom = "tile", - position = "identity", ..., bins = 30, binwidth = NULL, drop = TRUE, - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) +a_stat_bin_2d(mapping = NULL, data = NULL, a_geom = "tile", + a_position = "identity", ..., bins = 30, binwidth = NULL, drop = TRUE, + na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -24,23 +24,23 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -49,13 +49,13 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} -\item{geom, stat}{Use to override the default connection between -\code{geom_bin2d} and \code{stat_bin2d}.} +\item{a_geom, a_stat}{Use to override the default connection between +\code{a_geom_bin2d} and \code{a_stat_bin2d}.} \item{bins}{numeric vector giving number of bins in both vertical and horizontal directions. Set to 30 by default.} @@ -70,21 +70,21 @@ Add heatmap of 2d bin counts. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("stat", "bin2d")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_stat", "bin2d")} } + \examples{ -d <- ggplot(diamonds, aes(x, y)) + xlim(4, 10) + ylim(4, 10) -d + geom_bin2d() +d <- a_plot(diamonds, a_aes(x, y)) + xlim(4, 10) + ylim(4, 10) +d + a_geom_bin2d() # You can control the size of the bins by specifying the number of # bins in each direction: -d + geom_bin2d(bins = 10) -d + geom_bin2d(bins = 30) +d + a_geom_bin2d(bins = 10) +d + a_geom_bin2d(bins = 30) # Or by specifying the width of the bins -d + geom_bin2d(binwidth = c(0.1, 0.1)) +d + a_geom_bin2d(binwidth = c(0.1, 0.1)) } \seealso{ -\code{\link{stat_binhex}} for hexagonal binning +\code{\link{a_stat_binhex}} for hexagonal binning } - diff --git a/man/geom_blank.Rd b/man/a_geom_blank.Rd similarity index 68% rename from man/geom_blank.Rd rename to man/a_geom_blank.Rd index 5938f28b6d..43d483c5c8 100644 --- a/man/geom_blank.Rd +++ b/man/a_geom_blank.Rd @@ -1,15 +1,15 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-blank.r -\name{geom_blank} -\alias{geom_blank} +\name{a_geom_blank} +\alias{a_geom_blank} \title{Blank, draws nothing.} \usage{ -geom_blank(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., show.legend = NA, inherit.aes = TRUE) +a_geom_blank(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -17,32 +17,32 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -52,7 +52,6 @@ The blank geom draws nothing, but can be a useful way of ensuring common scales between different plots. } \examples{ -ggplot(mtcars, aes(wt, mpg)) +a_plot(mtcars, a_aes(wt, mpg)) # Nothing to see here! } - diff --git a/man/geom_boxplot.Rd b/man/a_geom_boxplot.Rd similarity index 71% rename from man/geom_boxplot.Rd rename to man/a_geom_boxplot.Rd index da1779819b..4491d97f6a 100644 --- a/man/geom_boxplot.Rd +++ b/man/a_geom_boxplot.Rd @@ -1,23 +1,23 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-boxplot.r, R/stat-boxplot.r -\name{geom_boxplot} -\alias{geom_boxplot} -\alias{stat_boxplot} +\name{a_geom_boxplot} +\alias{a_geom_boxplot} +\alias{a_stat_boxplot} \title{Box and whiskers plot.} \usage{ -geom_boxplot(mapping = NULL, data = NULL, stat = "boxplot", - position = "dodge", ..., outlier.colour = NULL, outlier.color = NULL, +a_geom_boxplot(mapping = NULL, data = NULL, a_stat = "boxplot", + a_position = "dodge", ..., outlier.colour = NULL, outlier.color = NULL, outlier.shape = 19, outlier.size = 1.5, outlier.stroke = 0.5, notch = FALSE, notchwidth = 0.5, varwidth = FALSE, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + show.legend = NA, inherit.a_aes = TRUE) -stat_boxplot(mapping = NULL, data = NULL, geom = "boxplot", - position = "dodge", ..., coef = 1.5, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_stat_boxplot(mapping = NULL, data = NULL, a_geom = "boxplot", + a_position = "dodge", ..., coef = 1.5, na.rm = FALSE, + show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -25,23 +25,23 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{outlier.colour, outlier.color, outlier.shape, outlier.size, outlier.stroke}{Default aesthetics for outliers. Set to \code{NULL} to inherit from the aesthetics used for the box. @@ -69,13 +69,13 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} -\item{geom, stat}{Use to override the default connection between -\code{geom_boxplot} and \code{stat_boxplot}.} +\item{a_geom, a_stat}{Use to override the default connection between +\code{a_geom_boxplot} and \code{a_stat_boxplot}.} \item{coef}{length of the whiskers as multiple of IQR. Defaults to 1.5} } @@ -99,7 +99,7 @@ See McGill et al. (1978) for more details. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "boxplot")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "boxplot")} } \section{Computed variables}{ @@ -115,32 +115,33 @@ See McGill et al. (1978) for more details. \item{ymax}{upper whisker = largest observation less than or equal to upper hinge + 1.5 * IQR} } } + \examples{ -p <- ggplot(mpg, aes(class, hwy)) -p + geom_boxplot() -p + geom_boxplot() + geom_jitter(width = 0.2) -p + geom_boxplot() + coord_flip() - -p + geom_boxplot(notch = TRUE) -p + geom_boxplot(varwidth = TRUE) -p + geom_boxplot(fill = "white", colour = "#3366FF") +p <- a_plot(mpg, a_aes(class, hwy)) +p + a_geom_boxplot() +p + a_geom_boxplot() + a_geom_jitter(width = 0.2) +p + a_geom_boxplot() + ggplot2Animint:::a_coord_flip() + +p + a_geom_boxplot(notch = TRUE) +p + a_geom_boxplot(varwidth = TRUE) +p + a_geom_boxplot(fill = "white", colour = "#3366FF") # By default, outlier points match the colour of the box. Use # outlier.colour to override -p + geom_boxplot(outlier.colour = "red", outlier.shape = 1) +p + a_geom_boxplot(outlier.colour = "red", outlier.shape = 1) # Boxplots are automatically dodged when any aesthetic is a factor -p + geom_boxplot(aes(colour = drv)) +p + a_geom_boxplot(a_aes(colour = drv)) # You can also use boxplots with continuous x, as long as you supply # a grouping variable. cut_width is particularly useful -ggplot(diamonds, aes(carat, price)) + - geom_boxplot() -ggplot(diamonds, aes(carat, price)) + - geom_boxplot(aes(group = cut_width(carat, 0.25))) +a_plot(diamonds, a_aes(carat, price)) + + a_geom_boxplot() +a_plot(diamonds, a_aes(carat, price)) + + a_geom_boxplot(a_aes(group = cut_width(carat, 0.25))) \donttest{ # It's possible to draw a boxplot with your own computations if you -# use stat = "identity": +# use a_stat = "identity": y <- rnorm(100) df <- data.frame( x = 1, @@ -150,10 +151,10 @@ df <- data.frame( y75 = quantile(y, 0.75), y100 = max(y) ) -ggplot(df, aes(x)) + - geom_boxplot( - aes(ymin = y0, lower = y25, middle = y50, upper = y75, ymax = y100), - stat = "identity" +a_plot(df, a_aes(x)) + + a_geom_boxplot( + a_aes(ymin = y0, lower = y25, middle = y50, upper = y75, ymax = y100), + a_stat = "identity" ) } } @@ -162,8 +163,7 @@ McGill, R., Tukey, J. W. and Larsen, W. A. (1978) Variations of box plots. The American Statistician 32, 12-16. } \seealso{ -\code{\link{stat_quantile}} to view quantiles conditioned on a - continuous variable, \code{\link{geom_jitter}} for another way to look +\code{\link{a_stat_quantile}} to view quantiles conditioned on a + continuous variable, \code{\link{a_geom_jitter}} for another way to look at conditional distributions. } - diff --git a/man/geom_contour.Rd b/man/a_geom_contour.Rd similarity index 57% rename from man/geom_contour.Rd rename to man/a_geom_contour.Rd index 8e1474b731..97d11b585f 100644 --- a/man/geom_contour.Rd +++ b/man/a_geom_contour.Rd @@ -1,21 +1,21 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-contour.r, R/stat-contour.r -\name{geom_contour} -\alias{geom_contour} -\alias{stat_contour} +\name{a_geom_contour} +\alias{a_geom_contour} +\alias{a_stat_contour} \title{Display contours of a 3d surface in 2d.} \usage{ -geom_contour(mapping = NULL, data = NULL, stat = "contour", - position = "identity", ..., lineend = "butt", linejoin = "round", - linemitre = 1, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) +a_geom_contour(mapping = NULL, data = NULL, a_stat = "contour", + a_position = "identity", ..., lineend = "butt", linejoin = "round", + linemitre = 1, na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) -stat_contour(mapping = NULL, data = NULL, geom = "contour", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_stat_contour(mapping = NULL, data = NULL, a_geom = "contour", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -23,26 +23,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{lineend}{Line end style (round, butt, square)} @@ -57,19 +57,19 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} -\item{geom}{The geometric object to use display the data} +\item{a_geom}{The geometric object to use display the data} } \description{ Display contours of a 3d surface in 2d. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "contour")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "contour")} } \section{Computed variables}{ @@ -78,33 +78,33 @@ Display contours of a 3d surface in 2d. \item{level}{height of contour} } } + \examples{ #' # Basic plot -v <- ggplot(faithfuld, aes(waiting, eruptions, z = density)) -v + geom_contour() +v <- a_plot(faithfuld, a_aes(waiting, eruptions, z = density)) +v + a_geom_contour() # Or compute from raw data -ggplot(faithful, aes(waiting, eruptions)) + - geom_density_2d() +a_plot(faithful, a_aes(waiting, eruptions)) + + a_geom_density_2d() \donttest{ # Setting bins creates evenly spaced contours in the range of the data -v + geom_contour(bins = 2) -v + geom_contour(bins = 10) +v + a_geom_contour(bins = 2) +v + a_geom_contour(bins = 10) # Setting binwidth does the same thing, parameterised by the distance # between contours -v + geom_contour(binwidth = 0.01) -v + geom_contour(binwidth = 0.001) +v + a_geom_contour(binwidth = 0.01) +v + a_geom_contour(binwidth = 0.001) # Other parameters -v + geom_contour(aes(colour = ..level..)) -v + geom_contour(colour = "red") -v + geom_raster(aes(fill = density)) + - geom_contour(colour = "white") +v + a_geom_contour(a_aes(colour = ..level..)) +v + a_geom_contour(colour = "red") +v + a_geom_raster(a_aes(fill = density)) + + a_geom_contour(colour = "white") } } \seealso{ -\code{\link{geom_density_2d}}: 2d density contours +\code{\link{a_geom_density_2d}}: 2d density contours } - diff --git a/man/geom_count.Rd b/man/a_geom_count.Rd similarity index 55% rename from man/geom_count.Rd rename to man/a_geom_count.Rd index e8904f70bd..b50ba9f0c8 100644 --- a/man/geom_count.Rd +++ b/man/a_geom_count.Rd @@ -1,21 +1,21 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-count.r, R/stat-sum.r -\name{geom_count} -\alias{geom_count} -\alias{stat_sum} +\name{a_geom_count} +\alias{a_geom_count} +\alias{a_stat_sum} \title{Count the number of observations at each location.} \usage{ -geom_count(mapping = NULL, data = NULL, stat = "sum", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_geom_count(mapping = NULL, data = NULL, a_stat = "sum", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) -stat_sum(mapping = NULL, data = NULL, geom = "point", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_stat_sum(mapping = NULL, data = NULL, a_geom = "point", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -23,23 +23,23 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -48,60 +48,60 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} -\item{geom, stat}{Use to override the default connection between -\code{geom_count} and \code{stat_sum}.} +\item{a_geom, a_stat}{Use to override the default connection between +\code{a_geom_count} and \code{a_stat_sum}.} } \description{ -This is a variant \code{\link{geom_point}} that counts the number of +This is a variant \code{\link{a_geom_point}} that counts the number of observations at each location, then maps the count to point size. It useful when you have discrete data. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "point")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "point")} } \section{Computed variables}{ \describe{ \item{n}{number of observations at position} - \item{prop}{percent of points in that panel at that position} + \item{prop}{percent of points in that panel at that a_position} } } + \examples{ -ggplot(mpg, aes(cty, hwy)) + - geom_point() +a_plot(mpg, a_aes(cty, hwy)) + + a_geom_point() -ggplot(mpg, aes(cty, hwy)) + - geom_count() +a_plot(mpg, a_aes(cty, hwy)) + + a_geom_count() -# Best used in conjunction with scale_size_area which ensures that +# Best used in conjunction with a_scale_size_area which ensures that # counts of zero would be given size 0. Doesn't make much different # here because the smallest count is already close to 0. -ggplot(mpg, aes(cty, hwy)) + - geom_count() - scale_size_area() +a_plot(mpg, a_aes(cty, hwy)) + + a_geom_count() + a_scale_size_area() # Display proportions instead of counts ------------------------------------- # By default, all categorical variables in the plot form the groups. -# Specifying geom_count without a group identifier leads to a plot which is +# Specifying a_geom_count without a group identifier leads to a plot which is # not useful: -d <- ggplot(diamonds, aes(x = cut, y = clarity)) -d + geom_count(aes(size = ..prop..)) +d <- a_plot(diamonds, a_aes(x = cut, y = clarity)) +d + a_geom_count(a_aes(size = ..prop..)) # To correct this problem and achieve a more desirable plot, we need # to specify which group the proportion is to be calculated over. -d + geom_count(aes(size = ..prop.., group = 1)) + - scale_size_area(max_size = 10) +d + a_geom_count(a_aes(size = ..prop.., group = 1)) + + a_scale_size_area(max_size = 10) # Or group by x/y variables to have rows/columns sum to 1. -d + geom_count(aes(size = ..prop.., group = cut)) + - scale_size_area(max_size = 10) -d + geom_count(aes(size = ..prop.., group = clarity)) + - scale_size_area(max_size = 10) +d + a_geom_count(a_aes(size = ..prop.., group = cut)) + + a_scale_size_area(max_size = 10) +d + a_geom_count(a_aes(size = ..prop.., group = clarity)) + + a_scale_size_area(max_size = 10) } - diff --git a/man/geom_density.Rd b/man/a_geom_density.Rd similarity index 60% rename from man/geom_density.Rd rename to man/a_geom_density.Rd index 6b6ad69bfc..13b3abc00e 100644 --- a/man/geom_density.Rd +++ b/man/a_geom_density.Rd @@ -1,21 +1,22 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-density.r, R/stat-density.r -\name{geom_density} -\alias{geom_density} -\alias{stat_density} +\name{a_geom_density} +\alias{a_geom_density} +\alias{a_stat_density} \title{Display a smooth density estimate.} \usage{ -geom_density(mapping = NULL, data = NULL, stat = "density", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) - -stat_density(mapping = NULL, data = NULL, geom = "area", - position = "stack", ..., bw = "nrd0", adjust = 1, kernel = "gaussian", - trim = FALSE, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) +a_geom_density(mapping = NULL, data = NULL, a_stat = "density", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) + +a_stat_density(mapping = NULL, data = NULL, a_geom = "area", + a_position = "stack", ..., bw = "nrd0", adjust = 1, + kernel = "gaussian", trim = FALSE, na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -23,23 +24,23 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -48,13 +49,13 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} -\item{geom, stat}{Use to override the default connection between -\code{geom_density} and \code{stat_density}.} +\item{a_geom, a_stat}{Use to override the default connection between +\code{a_geom_density} and \code{a_stat_density}.} \item{bw}{the smoothing bandwidth to be used, see \code{\link{density}} for details} @@ -78,7 +79,7 @@ with underlying smoothness. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "density")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "density")} } \section{Computed variables}{ @@ -90,20 +91,21 @@ with underlying smoothness. \item{scaled}{density estimate, scaled to maximum of 1} } } + \examples{ -ggplot(diamonds, aes(carat)) + - geom_density() +a_plot(diamonds, a_aes(carat)) + + a_geom_density() -ggplot(diamonds, aes(carat)) + - geom_density(adjust = 1/5) -ggplot(diamonds, aes(carat)) + - geom_density(adjust = 5) +a_plot(diamonds, a_aes(carat)) + + a_geom_density(adjust = 1/5) +a_plot(diamonds, a_aes(carat)) + + a_geom_density(adjust = 5) -ggplot(diamonds, aes(depth, colour = cut)) + - geom_density() + +a_plot(diamonds, a_aes(depth, colour = cut)) + + a_geom_density() + xlim(55, 70) -ggplot(diamonds, aes(depth, fill = cut, colour = cut)) + - geom_density(alpha = 0.1) + +a_plot(diamonds, a_aes(depth, fill = cut, colour = cut)) + + a_geom_density(alpha = 0.1) + xlim(55, 70) \donttest{ @@ -112,20 +114,19 @@ ggplot(diamonds, aes(depth, fill = cut, colour = cut)) + # density # Loses marginal densities -ggplot(diamonds, aes(carat, fill = cut)) + - geom_density(position = "stack") +a_plot(diamonds, a_aes(carat, fill = cut)) + + a_geom_density(a_position = "stack") # Preserves marginal densities -ggplot(diamonds, aes(carat, ..count.., fill = cut)) + - geom_density(position = "stack") +a_plot(diamonds, a_aes(carat, ..count.., fill = cut)) + + a_geom_density(a_position = "stack") -# You can use position="fill" to produce a conditional density estimate -ggplot(diamonds, aes(carat, ..count.., fill = cut)) + - geom_density(position = "fill") +# You can use a_position="fill" to produce a conditional density estimate +a_plot(diamonds, a_aes(carat, ..count.., fill = cut)) + + a_geom_density(a_position = "fill") } } \seealso{ -See \code{\link{geom_histogram}}, \code{\link{geom_freqpoly}} for +See \code{\link{a_geom_histogram}}, \code{\link{a_geom_freqpoly}} for other methods of displaying continuous distribution. - See \code{\link{geom_violin}} for a compact density display. + See \code{\link{a_geom_violin}} for a compact density display. } - diff --git a/man/geom_density_2d.Rd b/man/a_geom_density_2d.Rd similarity index 57% rename from man/geom_density_2d.Rd rename to man/a_geom_density_2d.Rd index 6129c18ae1..8c78d53241 100644 --- a/man/geom_density_2d.Rd +++ b/man/a_geom_density_2d.Rd @@ -1,23 +1,23 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-density2d.r, R/stat-density-2d.r -\name{geom_density_2d} -\alias{geom_density2d} -\alias{geom_density_2d} -\alias{stat_density2d} -\alias{stat_density_2d} +\name{a_geom_density_2d} +\alias{a_geom_density_2d} +\alias{a_geom_density2d} +\alias{a_stat_density_2d} +\alias{a_stat_density2d} \title{Contours from a 2d density estimate.} \usage{ -geom_density_2d(mapping = NULL, data = NULL, stat = "density2d", - position = "identity", ..., lineend = "butt", linejoin = "round", - linemitre = 1, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) +a_geom_density_2d(mapping = NULL, data = NULL, a_stat = "density2d", + a_position = "identity", ..., lineend = "butt", linejoin = "round", + linemitre = 1, na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) -stat_density_2d(mapping = NULL, data = NULL, geom = "density_2d", - position = "identity", ..., contour = TRUE, n = 100, h = NULL, - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) +a_stat_density_2d(mapping = NULL, data = NULL, a_geom = "density_2d", + a_position = "identity", ..., contour = TRUE, n = 100, h = NULL, + na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -25,23 +25,23 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{lineend}{Line end style (round, butt, square)} @@ -56,13 +56,13 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} -\item{geom, stat}{Use to override the default connection between -\code{geom_density_2d} and \code{stat_density_2d}.} +\item{a_geom, a_stat}{Use to override the default connection between +\code{a_geom_density_2d} and \code{a_stat_density_2d}.} \item{contour}{If \code{TRUE}, contour the results of the 2d density estimation} @@ -78,37 +78,37 @@ results with contours. This can be useful for dealing with overplotting. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "density_2d")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "density_2d")} } \section{Computed variables}{ -Same as \code{\link{stat_contour}} +Same as \code{\link{a_stat_contour}} } + \examples{ -m <- ggplot(faithful, aes(x = eruptions, y = waiting)) + - geom_point() + +m <- a_plot(faithful, a_aes(x = eruptions, y = waiting)) + + a_geom_point() + xlim(0.5, 6) + ylim(40, 110) -m + geom_density_2d() +m + a_geom_density_2d() \donttest{ -m + stat_density_2d(aes(fill = ..level..), geom = "polygon") +m + a_stat_density_2d(a_aes(fill = ..level..), a_geom = "polygon") set.seed(4393) dsmall <- diamonds[sample(nrow(diamonds), 1000), ] -d <- ggplot(dsmall, aes(x, y)) -# If you map an aesthetic to a categorical variable, you will get a +d <- a_plot(dsmall, a_aes(x, y)) +# If you map an a_aesthetic to a categorical variable, you will get a # set of contours for each value of that variable -d + geom_density_2d(aes(colour = cut)) +d + a_geom_density_2d(a_aes(colour = cut)) # If we turn contouring off, we can use use geoms like tiles: -d + stat_density_2d(geom = "raster", aes(fill = ..density..), contour = FALSE) +d + a_stat_density_2d(a_geom = "raster", a_aes(fill = ..density..), contour = FALSE) # Or points: -d + stat_density_2d(geom = "point", aes(size = ..density..), n = 20, contour = FALSE) +d + a_stat_density_2d(a_geom = "point", a_aes(size = ..density..), n = 20, contour = FALSE) } } \seealso{ -\code{\link{geom_contour}} for contour drawing geom, - \code{\link{stat_sum}} for another way of dealing with overplotting +\code{\link{a_geom_contour}} for contour drawing geom, + \code{\link{a_stat_sum}} for another way of dealing with overplotting } - diff --git a/man/geom_dotplot.Rd b/man/a_geom_dotplot.Rd similarity index 66% rename from man/geom_dotplot.Rd rename to man/a_geom_dotplot.Rd index b6401239e1..5fc81dfc5c 100644 --- a/man/geom_dotplot.Rd +++ b/man/a_geom_dotplot.Rd @@ -1,19 +1,19 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-dotplot.r -\name{geom_dotplot} -\alias{geom_dotplot} +\name{a_geom_dotplot} +\alias{a_geom_dotplot} \title{Dot plot} \usage{ -geom_dotplot(mapping = NULL, data = NULL, position = "identity", ..., +a_geom_dotplot(mapping = NULL, data = NULL, a_position = "identity", ..., binwidth = NULL, binaxis = "x", method = "dotdensity", binpositions = "bygroup", stackdir = "up", stackratio = 1, dotsize = 1, stackgroups = FALSE, origin = NULL, right = TRUE, width = 0.9, drop = FALSE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -21,23 +21,23 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{binwidth}{When \code{method} is "dotdensity", this specifies maximum bin width. When \code{method} is "histodot", this specifies bin width. @@ -46,7 +46,7 @@ Defaults to 1/30 of the range of the data} \item{binaxis}{The axis to bin along, "x" (default) or "y"} \item{method}{"dotdensity" (default) for dot-density binning, or -"histodot" for fixed bin widths (like stat_bin)} +"histodot" for fixed bin widths (like a_stat_bin)} \item{binpositions}{When \code{method} is "dotdensity", "bygroup" (default) determines positions of the bins for each group separately. "all" determines @@ -62,7 +62,7 @@ just touch. Use smaller values for closer, overlapping dots.} \item{dotsize}{The diameter of the dots relative to \code{binwidth}, default 1.} \item{stackgroups}{should dots be stacked across groups? This has the effect -that \code{position = "stack"} should have, but can't (because this geom has +that \code{a_position = "stack"} should have, but can't (because this geom has some odd properties).} \item{origin}{When \code{method} is "histodot", origin of first bin} @@ -82,7 +82,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -107,7 +107,7 @@ to match the number of dots. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "dotplot")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "dotplot")} } \section{Computed variables}{ @@ -124,61 +124,61 @@ to match the number of dots. \item{ndensity}{density, scaled to maximum of 1, if method is "histodot"} } } + \examples{ -ggplot(mtcars, aes(x = mpg)) + geom_dotplot() -ggplot(mtcars, aes(x = mpg)) + geom_dotplot(binwidth = 1.5) +a_plot(mtcars, a_aes(x = mpg)) + a_geom_dotplot() +a_plot(mtcars, a_aes(x = mpg)) + a_geom_dotplot(binwidth = 1.5) # Use fixed-width bins -ggplot(mtcars, aes(x = mpg)) + - geom_dotplot(method="histodot", binwidth = 1.5) +a_plot(mtcars, a_aes(x = mpg)) + + a_geom_dotplot(method="histodot", binwidth = 1.5) # Some other stacking methods -ggplot(mtcars, aes(x = mpg)) + - geom_dotplot(binwidth = 1.5, stackdir = "center") -ggplot(mtcars, aes(x = mpg)) + - geom_dotplot(binwidth = 1.5, stackdir = "centerwhole") +a_plot(mtcars, a_aes(x = mpg)) + + a_geom_dotplot(binwidth = 1.5, stackdir = "center") +a_plot(mtcars, a_aes(x = mpg)) + + a_geom_dotplot(binwidth = 1.5, stackdir = "centerwhole") # y axis isn't really meaningful, so hide it -ggplot(mtcars, aes(x = mpg)) + geom_dotplot(binwidth = 1.5) + - scale_y_continuous(NULL, breaks = NULL) +a_plot(mtcars, a_aes(x = mpg)) + a_geom_dotplot(binwidth = 1.5) + + a_scale_y_continuous(NULL, breaks = NULL) # Overlap dots vertically -ggplot(mtcars, aes(x = mpg)) + geom_dotplot(binwidth = 1.5, stackratio = .7) +a_plot(mtcars, a_aes(x = mpg)) + a_geom_dotplot(binwidth = 1.5, stackratio = .7) # Expand dot diameter -ggplot(mtcars, aes(x = mpg)) + geom_dotplot(binwidth = 1.5, dotsize = 1.25) +a_plot(mtcars, a_aes(x = mpg)) + a_geom_dotplot(binwidth = 1.5, dotsize = 1.25) \donttest{ # Examples with stacking along y axis instead of x -ggplot(mtcars, aes(x = 1, y = mpg)) + - geom_dotplot(binaxis = "y", stackdir = "center") +a_plot(mtcars, a_aes(x = 1, y = mpg)) + + a_geom_dotplot(binaxis = "y", stackdir = "center") -ggplot(mtcars, aes(x = factor(cyl), y = mpg)) + - geom_dotplot(binaxis = "y", stackdir = "center") +a_plot(mtcars, a_aes(x = factor(cyl), y = mpg)) + + a_geom_dotplot(binaxis = "y", stackdir = "center") -ggplot(mtcars, aes(x = factor(cyl), y = mpg)) + - geom_dotplot(binaxis = "y", stackdir = "centerwhole") +a_plot(mtcars, a_aes(x = factor(cyl), y = mpg)) + + a_geom_dotplot(binaxis = "y", stackdir = "centerwhole") -ggplot(mtcars, aes(x = factor(vs), fill = factor(cyl), y = mpg)) + - geom_dotplot(binaxis = "y", stackdir = "center", position = "dodge") +a_plot(mtcars, a_aes(x = factor(vs), fill = factor(cyl), y = mpg)) + + a_geom_dotplot(binaxis = "y", stackdir = "center", a_position = "dodge") # binpositions="all" ensures that the bins are aligned between groups -ggplot(mtcars, aes(x = factor(am), y = mpg)) + - geom_dotplot(binaxis = "y", stackdir = "center", binpositions="all") +a_plot(mtcars, a_aes(x = factor(am), y = mpg)) + + a_geom_dotplot(binaxis = "y", stackdir = "center", binpositions="all") # Stacking multiple groups, with different fill -ggplot(mtcars, aes(x = mpg, fill = factor(cyl))) + - geom_dotplot(stackgroups = TRUE, binwidth = 1, binpositions = "all") +a_plot(mtcars, a_aes(x = mpg, fill = factor(cyl))) + + a_geom_dotplot(stackgroups = TRUE, binwidth = 1, binpositions = "all") -ggplot(mtcars, aes(x = mpg, fill = factor(cyl))) + - geom_dotplot(stackgroups = TRUE, binwidth = 1, method = "histodot") +a_plot(mtcars, a_aes(x = mpg, fill = factor(cyl))) + + a_geom_dotplot(stackgroups = TRUE, binwidth = 1, method = "histodot") -ggplot(mtcars, aes(x = 1, y = mpg, fill = factor(cyl))) + - geom_dotplot(binaxis = "y", stackgroups = TRUE, binwidth = 1, method = "histodot") +a_plot(mtcars, a_aes(x = 1, y = mpg, fill = factor(cyl))) + + a_geom_dotplot(binaxis = "y", stackgroups = TRUE, binwidth = 1, method = "histodot") } } \references{ Wilkinson, L. (1999) Dot plots. The American Statistician, 53(3), 276-281. } - diff --git a/man/geom_errorbarh.Rd b/man/a_geom_errorbarh.Rd similarity index 62% rename from man/geom_errorbarh.Rd rename to man/a_geom_errorbarh.Rd index b19f68e22f..f5332b9fce 100644 --- a/man/geom_errorbarh.Rd +++ b/man/a_geom_errorbarh.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-errorbarh.r -\name{geom_errorbarh} -\alias{geom_errorbarh} +\name{a_geom_errorbarh} +\alias{a_geom_errorbarh} \title{Horizontal error bars} \usage{ -geom_errorbarh(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_geom_errorbarh(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -18,26 +18,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -46,7 +46,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -56,8 +56,9 @@ Horizontal error bars } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "errorbarh")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "errorbarh")} } + \examples{ df <- data.frame( trt = factor(c(1, 1, 2, 2)), @@ -68,13 +69,12 @@ df <- data.frame( # Define the top and bottom of the errorbars -p <- ggplot(df, aes(resp, trt, colour = group)) -p + geom_point() + - geom_errorbarh(aes(xmax = resp + se, xmin = resp - se)) -p + geom_point() + - geom_errorbarh(aes(xmax = resp + se, xmin = resp - se, height = .2)) +p <- a_plot(df, a_aes(resp, trt, colour = group)) +p + a_geom_point() + + a_geom_errorbarh(a_aes(xmax = resp + se, xmin = resp - se)) +p + a_geom_point() + + a_geom_errorbarh(a_aes(xmax = resp + se, xmin = resp - se, height = .2)) } \seealso{ -\code{\link{geom_errorbar}}: vertical error bars +\code{\link{a_geom_errorbar}}: vertical error bars } - diff --git a/man/geom_hex.Rd b/man/a_geom_hex.Rd similarity index 60% rename from man/geom_hex.Rd rename to man/a_geom_hex.Rd index 573da8c9aa..832cd44333 100644 --- a/man/geom_hex.Rd +++ b/man/a_geom_hex.Rd @@ -1,22 +1,22 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-hex.r, R/stat-binhex.r -\name{geom_hex} -\alias{geom_hex} -\alias{stat_bin_hex} -\alias{stat_binhex} +\name{a_geom_hex} +\alias{a_geom_hex} +\alias{a_stat_bin_hex} +\alias{a_stat_binhex} \title{Hexagon binning.} \usage{ -geom_hex(mapping = NULL, data = NULL, stat = "binhex", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_geom_hex(mapping = NULL, data = NULL, a_stat = "binhex", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) -stat_bin_hex(mapping = NULL, data = NULL, geom = "hex", - position = "identity", ..., bins = 30, binwidth = NULL, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) +a_stat_bin_hex(mapping = NULL, data = NULL, a_geom = "hex", + a_position = "identity", ..., bins = 30, binwidth = NULL, + na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -24,23 +24,23 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -49,13 +49,13 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} -\item{geom, stat}{Override the default connection between \code{geom_hex} and -\code{stat_binhex.}} +\item{a_geom, a_stat}{Override the default connection between \code{a_geom_hex} and +\code{a_stat_binhex.}} \item{bins}{numeric vector giving number of bins in both vertical and horizontal directions. Set to 30 by default.} @@ -68,24 +68,24 @@ Hexagon binning. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "hex")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "hex")} } + \examples{ -d <- ggplot(diamonds, aes(carat, price)) -d + geom_hex() +d <- a_plot(diamonds, a_aes(carat, price)) +d + a_geom_hex() \donttest{ # You can control the size of the bins by specifying the number of # bins in each direction: -d + geom_hex(bins = 10) -d + geom_hex(bins = 30) +d + a_geom_hex(bins = 10) +d + a_geom_hex(bins = 30) # Or by specifying the width of the bins -d + geom_hex(binwidth = c(1, 1000)) -d + geom_hex(binwidth = c(.1, 500)) +d + a_geom_hex(binwidth = c(1, 1000)) +d + a_geom_hex(binwidth = c(.1, 500)) } } \seealso{ -\code{\link{stat_bin2d}} for rectangular binning +\code{\link{a_stat_bin2d}} for rectangular binning } - diff --git a/man/geom_histogram.Rd b/man/a_geom_histogram.Rd similarity index 62% rename from man/geom_histogram.Rd rename to man/a_geom_histogram.Rd index 5b749eec20..12e16a7847 100644 --- a/man/geom_histogram.Rd +++ b/man/a_geom_histogram.Rd @@ -1,27 +1,28 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/geom-freqpoly.r, R/geom-histogram.r, R/stat-bin.r -\name{geom_freqpoly} -\alias{geom_freqpoly} -\alias{geom_histogram} -\alias{stat_bin} +% Please edit documentation in R/geom-freqpoly.r, R/geom-histogram.r, +% R/stat-bin.r +\name{a_geom_freqpoly} +\alias{a_geom_freqpoly} +\alias{a_geom_histogram} +\alias{a_stat_bin} \title{Histograms and frequency polygons.} \usage{ -geom_freqpoly(mapping = NULL, data = NULL, stat = "bin", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) - -geom_histogram(mapping = NULL, data = NULL, stat = "bin", - position = "stack", ..., binwidth = NULL, bins = NULL, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) - -stat_bin(mapping = NULL, data = NULL, geom = "bar", position = "stack", - ..., binwidth = NULL, bins = NULL, center = NULL, boundary = NULL, - closed = c("right", "left"), pad = FALSE, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) +a_geom_freqpoly(mapping = NULL, data = NULL, a_stat = "bin", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) + +a_geom_histogram(mapping = NULL, data = NULL, a_stat = "bin", + a_position = "stack", ..., binwidth = NULL, bins = NULL, + na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) + +a_stat_bin(mapping = NULL, data = NULL, a_geom = "bar", + a_position = "stack", ..., binwidth = NULL, bins = NULL, + center = NULL, boundary = NULL, closed = c("right", "left"), + pad = FALSE, na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -29,23 +30,23 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -54,7 +55,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -69,8 +70,8 @@ the default plot specification, e.g. \code{\link{borders}}.} \item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30} -\item{geom, stat}{Use to override the default connection between -\code{geom_histogram}/\code{geom_freqpoly} and \code{stat_bin}.} +\item{a_geom, a_stat}{Use to override the default connection between +\code{a_geom_histogram}/\code{a_geom_freqpoly} and \code{a_stat_bin}.} \item{center}{The center of one of the bins. Note that if center is above or below the range of the data, things will be shifted by an appropriate @@ -96,18 +97,18 @@ Display a 1d distribution by dividing into bins and counting the number of observations in each bin. Histograms use bars; frequency polygons use lines. -\code{stat_bin} is suitable only for continuous x data. If your x data is - discrete, you probably want to use \code{\link{stat_count}}. +\code{a_stat_bin} is suitable only for continuous x data. If your x data is + discrete, you probably want to use \code{\link{a_stat_count}}. } \details{ -By default, \code{stat_bin} uses 30 bins - this is not a good default, +By default, \code{a_stat_bin} uses 30 bins - this is not a good default, but the idea is to get you experimenting with different binwidths. You may need to look at a few to uncover the full story behind your data. } \section{Aesthetics}{ -\code{geom_histogram} uses the same aesthetics as \code{geom_bar}; -\code{geom_freqpoly} uses the same aesthetics as \code{geom_line}. +\code{a_geom_histogram} uses the same aesthetics as \code{a_geom_bar}; +\code{a_geom_freqpoly} uses the same aesthetics as \code{a_geom_line}. } \section{Computed variables}{ @@ -119,64 +120,64 @@ may need to look at a few to uncover the full story behind your data. \item{ndensity}{density, scaled to maximum of 1} } } + \examples{ -ggplot(diamonds, aes(carat)) + - geom_histogram() -ggplot(diamonds, aes(carat)) + - geom_histogram(binwidth = 0.01) -ggplot(diamonds, aes(carat)) + - geom_histogram(bins = 200) +a_plot(diamonds, a_aes(carat)) + + a_geom_histogram() +a_plot(diamonds, a_aes(carat)) + + a_geom_histogram(binwidth = 0.01) +a_plot(diamonds, a_aes(carat)) + + a_geom_histogram(bins = 200) # Rather than stacking histograms, it's easier to compare frequency # polygons -ggplot(diamonds, aes(price, fill = cut)) + - geom_histogram(binwidth = 500) -ggplot(diamonds, aes(price, colour = cut)) + - geom_freqpoly(binwidth = 500) +a_plot(diamonds, a_aes(price, fill = cut)) + + a_geom_histogram(binwidth = 500) +a_plot(diamonds, a_aes(price, colour = cut)) + + a_geom_freqpoly(binwidth = 500) # To make it easier to compare distributions with very different counts, # put density on the y axis instead of the default count -ggplot(diamonds, aes(price, ..density.., colour = cut)) + - geom_freqpoly(binwidth = 500) +a_plot(diamonds, a_aes(price, ..density.., colour = cut)) + + a_geom_freqpoly(binwidth = 500) if (require("ggplot2movies")) { # Often we don't want the height of the bar to represent the # count of observations, but the sum of some other variable. # For example, the following plot shows the number of movies # in each rating. -m <- ggplot(movies, aes(rating)) -m + geom_histogram(binwidth = 0.1) +m <- a_plot(movies, a_aes(rating)) +m + a_geom_histogram(binwidth = 0.1) # If, however, we want to see the number of votes cast in each # category, we need to weight by the votes variable -m + geom_histogram(aes(weight = votes), binwidth = 0.1) + ylab("votes") +m + a_geom_histogram(a_aes(weight = votes), binwidth = 0.1) + ylab("votes") # For transformed scales, binwidth applies to the transformed data. # The bins have constant width on the transformed scale. -m + geom_histogram() + scale_x_log10() -m + geom_histogram(binwidth = 0.05) + scale_x_log10() +m + a_geom_histogram() + a_scale_x_log10() +m + a_geom_histogram(binwidth = 0.05) + a_scale_x_log10() # For transformed coordinate systems, the binwidth applies to the -# raw data. The bins have constant width on the original scale. +# raw data. The bins have constant width on the original a_scale. # Using log scales does not work here, because the first -# bar is anchored at zero, and so when transformed becomes negative +# bar is anchored at zero, and so whens transformed becomes negative # infinity. This is not a problem when transforming the scales, because # no observations have 0 ratings. -m + geom_histogram(origin = 0) + coord_trans(x = "log10") +m + a_geom_histogram(origin = 0) + ggplot2Animint:::a_coord_trans(x = "log10") # Use origin = 0, to make sure we don't take sqrt of negative values -m + geom_histogram(origin = 0) + coord_trans(x = "sqrt") +m + a_geom_histogram(origin = 0) + ggplot2Animint:::a_coord_trans(x = "sqrt") # You can also transform the y axis. Remember that the base of the bars # has value 0, so log transformations are not appropriate -m <- ggplot(movies, aes(x = rating)) -m + geom_histogram(binwidth = 0.5) + scale_y_sqrt() +m <- a_plot(movies, a_aes(x = rating)) +m + a_geom_histogram(binwidth = 0.5) + a_scale_y_sqrt() } rm(movies) } \seealso{ -\code{\link{stat_count}}, which counts the number of cases at each x +\code{\link{a_stat_count}}, which counts the number of cases at each x posotion, without binning. It is suitable for both discrete and continuous - x data, whereas \link{stat_bin} is suitable only for continuous x data. + x data, whereas \link{a_stat_bin} is suitable only for continuous x data. } - diff --git a/man/geom_jitter.Rd b/man/a_geom_jitter.Rd similarity index 66% rename from man/geom_jitter.Rd rename to man/a_geom_jitter.Rd index 787defef4d..1fd69fa240 100644 --- a/man/geom_jitter.Rd +++ b/man/a_geom_jitter.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-jitter.r -\name{geom_jitter} -\alias{geom_jitter} +\name{a_geom_jitter} +\alias{a_geom_jitter} \title{Points, jittered to reduce overplotting.} \usage{ -geom_jitter(mapping = NULL, data = NULL, stat = "identity", - position = "jitter", ..., width = NULL, height = NULL, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) +a_geom_jitter(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "jitter", ..., width = NULL, height = NULL, + na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -18,26 +18,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{width}{Amount of vertical and horizontal jitter. The jitter is added in both positive and negative directions, so the total spread @@ -64,39 +64,39 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} } \description{ -The jitter geom is a convenient default for geom_point with position = +The jitter geom is a convenient default for a_geom_point with a_position = 'jitter'. It's a useful way of handling overplotting caused by discreteness in smaller datasets. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "point")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "point")} } + \examples{ -p <- ggplot(mpg, aes(cyl, hwy)) -p + geom_point() -p + geom_jitter() +p <- a_plot(mpg, a_aes(cyl, hwy)) +p + a_geom_point() +p + a_geom_jitter() -# Add aesthetic mappings -p + geom_jitter(aes(colour = class)) +# Add a_aesthetic mappings +p + a_geom_jitter(a_aes(colour = class)) # Use smaller width/height to emphasise categories -ggplot(mpg, aes(cyl, hwy)) + geom_jitter() -ggplot(mpg, aes(cyl, hwy)) + geom_jitter(width = 0.25) +a_plot(mpg, a_aes(cyl, hwy)) + a_geom_jitter() +a_plot(mpg, a_aes(cyl, hwy)) + a_geom_jitter(width = 0.25) # Use larger width/height to completely smooth away discreteness -ggplot(mpg, aes(cty, hwy)) + geom_jitter() -ggplot(mpg, aes(cty, hwy)) + geom_jitter(width = 0.5, height = 0.5) +a_plot(mpg, a_aes(cty, hwy)) + a_geom_jitter() +a_plot(mpg, a_aes(cty, hwy)) + a_geom_jitter(width = 0.5, height = 0.5) } \seealso{ -\code{\link{geom_point}} for regular, unjittered points, - \code{\link{geom_boxplot}} for another way of looking at the conditional +\code{\link{a_geom_point}} for regular, unjittered points, + \code{\link{a_geom_boxplot}} for another way of looking at the conditional distribution of a variable } - diff --git a/man/a_geom_linerange.Rd b/man/a_geom_linerange.Rd new file mode 100644 index 0000000000..3fbe0d323d --- /dev/null +++ b/man/a_geom_linerange.Rd @@ -0,0 +1,121 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/geom-crossbar.r, R/geom-errorbar.r, +% R/geom-linerange.r, R/geom-pointrange.r +\name{a_geom_crossbar} +\alias{a_geom_crossbar} +\alias{a_geom_errorbar} +\alias{a_geom_linerange} +\alias{a_geom_pointrange} +\title{Vertical intervals: lines, crossbars & errorbars.} +\usage{ +a_geom_crossbar(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., fatten = 2.5, na.rm = FALSE, + show.legend = NA, inherit.a_aes = TRUE) + +a_geom_errorbar(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) + +a_geom_linerange(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) + +a_geom_pointrange(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., fatten = 4, na.rm = FALSE, + show.legend = NA, inherit.a_aes = TRUE) +} +\arguments{ +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the +default), it is combined with the default mapping at the top level of the +plot. You must supply \code{mapping} if there is no plot mapping.} + +\item{data}{The data to be displayed in this layer. There are three + options: + + If \code{NULL}, the default, the data is inherited from the plot + data as specified in the call to \code{\link{a_plot}}. + + A \code{data.frame}, or other object, will override the plot + data. All objects will be fortified to produce a data frame. See + \code{\link{a_fortify}} for which variables will be created. + + A \code{function} will be called with a single argument, + the plot data. The return value must be a \code{data.frame.}, and + will be used as the layer data.} + +\item{a_stat}{The statistical transformation to use on the data for this +layer, as a string.} + +\item{a_position}{Position adjustment, either as a string, or the result of +a call to a position adjustment function.} + +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are +often aesthetics, used to set an aesthetic to a fixed value, like +\code{color = "red"} or \code{size = 3}. They may also be parameters +to the paired a_geom/a_stat.} + +\item{fatten}{A multiplicative factor used to increase the size of the +middle bar in \code{a_geom_crossbar()} and the middle point in +\code{a_geom_pointrange()}.} + +\item{na.rm}{If \code{FALSE} (the default), removes missing values with +a warning. If \code{TRUE} silently removes missing values.} + +\item{show.legend}{logical. Should this layer be included in the legends? +\code{NA}, the default, includes if any aesthetics are mapped. +\code{FALSE} never includes, and \code{TRUE} always includes.} + +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, +rather than combining with them. This is most useful for helper functions +that define both data and aesthetics and shouldn't inherit behaviour from +the default plot specification, e.g. \code{\link{borders}}.} +} +\description{ +Various ways of representing a vertical interval defined by \code{x}, +\code{ymin} and \code{ymax}. +} +\section{Aesthetics}{ + +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "linerange")} +} + +\examples{ +#' # Create a simple example dataset +df <- data.frame( + trt = factor(c(1, 1, 2, 2)), + resp = c(1, 5, 3, 4), + group = factor(c(1, 2, 1, 2)), + upper = c(1.1, 5.3, 3.3, 4.2), + lower = c(0.8, 4.6, 2.4, 3.6) +) + +p <- a_plot(df, a_aes(trt, resp, colour = group)) +p + a_geom_linerange(a_aes(ymin = lower, ymax = upper)) +p + a_geom_pointrange(a_aes(ymin = lower, ymax = upper)) +p + a_geom_crossbar(a_aes(ymin = lower, ymax = upper), width = 0.2) +p + a_geom_errorbar(a_aes(ymin = lower, ymax = upper), width = 0.2) + +# Draw lines connecting group means +p + + a_geom_line(a_aes(group = group)) + + a_geom_errorbar(a_aes(ymin = lower, ymax = upper), width = 0.2) + +# If you want to dodge bars and errorbars, you need to manually +# specify the dodge width +p <- a_plot(df, a_aes(trt, resp, fill = group)) +p + + a_geom_bar(a_position = "dodge", a_stat = "identity") + + a_geom_errorbar(a_aes(ymin = lower, ymax = upper), a_position = "dodge", width = 0.25) + +# Because the bars and errorbars have different widths +# we need to specify how wide the objects we are dodging are +dodge <- a_position_dodge(width=0.9) +p + + a_geom_bar(a_position = dodge, a_stat = "identity") + + a_geom_errorbar(a_aes(ymin = lower, ymax = upper), a_position = dodge, width = 0.25) +} +\seealso{ +\code{\link{a_stat_summary}} for examples of these guys in use, + \code{\link{a_geom_smooth}} for continuous analog +} diff --git a/man/geom_map.Rd b/man/a_geom_map.Rd similarity index 60% rename from man/geom_map.Rd rename to man/a_geom_map.Rd index 900c430fe6..5b2c82b9f8 100644 --- a/man/geom_map.Rd +++ b/man/a_geom_map.Rd @@ -1,15 +1,15 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-map.r -\name{geom_map} -\alias{geom_map} +\name{a_geom_map} +\alias{a_geom_map} \title{Polygons from a reference map.} \usage{ -geom_map(mapping = NULL, data = NULL, stat = "identity", ..., map, - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) +a_geom_map(mapping = NULL, data = NULL, a_stat = "identity", ..., map, + na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -17,26 +17,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{map}{Data frame that contains the map coordinates. This will -typically be created using \code{\link{fortify}} on a spatial object. +typically be created using \code{\link{a_fortify}} on a spatial object. It must contain columns \code{x} or \code{long}, \code{y} or \code{lat}, and \code{region} or \code{id}.} @@ -47,7 +47,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -57,10 +57,11 @@ Does not affect position scales. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "map")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "map")} } + \examples{ -# When using geom_polygon, you will typically need two data frames: +# When using a_geom_polygon, you will typically need two data frames: # one contains the coordinates of each polygon (positions), and the # other the values associated with each polygon (values). An id # variable links the two together @@ -80,29 +81,28 @@ positions <- data.frame( 2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2) ) -ggplot(values) + geom_map(aes(map_id = id), map = positions) + - expand_limits(positions) -ggplot(values, aes(fill = value)) + - geom_map(aes(map_id = id), map = positions) + - expand_limits(positions) -ggplot(values, aes(fill = value)) + - geom_map(aes(map_id = id), map = positions) + - expand_limits(positions) + ylim(0, 3) +a_plot(values) + a_geom_map(a_aes(map_id = id), map = positions) + + ggplot2Animint:::expand_limits(positions) +a_plot(values, a_aes(fill = value)) + + a_geom_map(a_aes(map_id = id), map = positions) + + ggplot2Animint:::expand_limits(positions) +a_plot(values, a_aes(fill = value)) + + a_geom_map(a_aes(map_id = id), map = positions) + + ggplot2Animint:::expand_limits(positions) + ylim(0, 3) # Better example crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests) crimesm <- reshape2::melt(crimes, id = 1) if (require(maps)) { states_map <- map_data("state") - ggplot(crimes, aes(map_id = state)) + - geom_map(aes(fill = Murder), map = states_map) + - expand_limits(x = states_map$long, y = states_map$lat) - - last_plot() + coord_map() - ggplot(crimesm, aes(map_id = state)) + - geom_map(aes(fill = value), map = states_map) + - expand_limits(x = states_map$long, y = states_map$lat) + - facet_wrap( ~ variable) + a_plot(crimes, a_aes(map_id = state)) + + a_geom_map(a_aes(fill = Murder), map = states_map) + + ggplot2Animint:::expand_limits(x = states_map$long, y = states_map$lat) + + last_plot() + ggplot2Animint:::a_coord_map() + a_plot(crimesm, a_aes(map_id = state)) + + a_geom_map(a_aes(fill = value), map = states_map) + + ggplot2Animint:::expand_limits(x = states_map$long, y = states_map$lat) + + ggplot2Animint:::a_facet_wrap( ~ variable) } } - diff --git a/man/geom_path.Rd b/man/a_geom_path.Rd similarity index 51% rename from man/geom_path.Rd rename to man/a_geom_path.Rd index 458d8d9170..0b843c6965 100644 --- a/man/geom_path.Rd +++ b/man/a_geom_path.Rd @@ -1,27 +1,27 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-path.r -\name{geom_path} -\alias{geom_line} -\alias{geom_path} -\alias{geom_step} +\name{a_geom_path} +\alias{a_geom_path} +\alias{a_geom_line} +\alias{a_geom_step} \title{Connect observations.} \usage{ -geom_path(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., lineend = "butt", linejoin = "round", +a_geom_path(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., lineend = "butt", linejoin = "round", linemitre = 1, arrow = NULL, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + inherit.a_aes = TRUE) -geom_line(mapping = NULL, data = NULL, stat = "identity", - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) +a_geom_line(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE, ...) -geom_step(mapping = NULL, data = NULL, stat = "identity", - position = "identity", direction = "hv", na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE, ...) +a_geom_step(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", direction = "hv", na.rm = FALSE, + show.legend = NA, inherit.a_aes = TRUE, ...) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -29,26 +29,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{lineend}{Line end style (round, butt, square)} @@ -65,7 +65,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -74,51 +74,52 @@ the default plot specification, e.g. \code{\link{borders}}.} 'hv' for horizontal then vertical} } \description{ -\code{geom_path()} connects the observations in the order in which they appear -in the data. \code{geom_line()} connects them in order of the variable on the -x axis. \code{geom_step()} creates a stairstep plot, highlighting exactly +\code{a_geom_path()} connects the observations in the order in which they appear +in the data. \code{a_geom_line()} connects them in order of the variable on the +x axis. \code{a_geom_step()} creates a a_stairstep plot, highlighting exactly when changes occur. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "path")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "path")} } + \examples{ -# geom_line() is suitable for time series -ggplot(economics, aes(date, unemploy)) + geom_line() -ggplot(economics_long, aes(date, value01, colour = variable)) + - geom_line() +# a_geom_line() is suitable for time series +a_plot(economics, a_aes(date, unemploy)) + a_geom_line() +a_plot(economics_long, a_aes(date, value01, colour = variable)) + + a_geom_line() -# geom_step() is useful when you want to highlight exactly when +# a_geom_step() is useful when you want to highlight exactly when # the y value chanes recent <- economics[economics$date > as.Date("2013-01-01"), ] -ggplot(recent, aes(date, unemploy)) + geom_line() -ggplot(recent, aes(date, unemploy)) + geom_step() +a_plot(recent, a_aes(date, unemploy)) + a_geom_line() +a_plot(recent, a_aes(date, unemploy)) + a_geom_step() -# geom_path lets you explore how two variables are related over time, +# a_geom_path lets you explore how two variables are related over time, # e.g. unemployment and personal savings rate -m <- ggplot(economics, aes(unemploy/pop, psavert)) -m + geom_path() -m + geom_path(aes(colour = as.numeric(date))) +m <- a_plot(economics, a_aes(unemploy/pop, psavert)) +m + a_geom_path() +m + a_geom_path(a_aes(colour = as.numeric(date))) # Changing parameters ---------------------------------------------- -ggplot(economics, aes(date, unemploy)) + - geom_line(colour = "red") +a_plot(economics, a_aes(date, unemploy)) + + a_geom_line(colour = "red") # Use the arrow parameter to add an arrow to the line # See ?arrow for more details -c <- ggplot(economics, aes(x = date, y = pop)) -c + geom_line(arrow = arrow()) -c + geom_line( +c <- a_plot(economics, a_aes(x = date, y = pop)) +c + a_geom_line(arrow = arrow()) +c + a_geom_line( arrow = arrow(angle = 15, ends = "both", type = "closed") ) # Control line join parameters df <- data.frame(x = 1:3, y = c(4, 1, 9)) -base <- ggplot(df, aes(x, y)) -base + geom_path(size = 10) -base + geom_path(size = 10, lineend = "round") -base + geom_path(size = 10, linejoin = "mitre", lineend = "butt") +base <- a_plot(df, a_aes(x, y)) +base + a_geom_path(size = 10) +base + a_geom_path(size = 10, lineend = "round") +base + a_geom_path(size = 10, linejoin = "mitre", lineend = "butt") # NAs break the line. Use na.rm = T to suppress the warning message df <- data.frame( @@ -127,9 +128,9 @@ df <- data.frame( y2 = c(NA, 2, 3, 4, 5), y3 = c(1, 2, NA, 4, 5) ) -ggplot(df, aes(x, y1)) + geom_point() + geom_line() -ggplot(df, aes(x, y2)) + geom_point() + geom_line() -ggplot(df, aes(x, y3)) + geom_point() + geom_line() +a_plot(df, a_aes(x, y1)) + a_geom_point() + a_geom_line() +a_plot(df, a_aes(x, y2)) + a_geom_point() + a_geom_line() +a_plot(df, a_aes(x, y3)) + a_geom_point() + a_geom_line() \donttest{ # Setting line type vs colour/size @@ -142,17 +143,16 @@ df <- data.frame( group = rep(c("a","b"), each = 100) ) -p <- ggplot(df, aes(x=x, y=y, group=group)) +p <- a_plot(df, a_aes(x=x, y=y, group=group)) # These work -p + geom_line(linetype = 2) -p + geom_line(aes(colour = group), linetype = 2) -p + geom_line(aes(colour = x)) +p + a_geom_line(linetype = 2) +p + a_geom_line(a_aes(colour = group), linetype = 2) +p + a_geom_line(a_aes(colour = x)) # But this doesn't -should_stop(p + geom_line(aes(colour = x), linetype=2)) +should_stop(p + a_geom_line(a_aes(colour = x), linetype=2)) } } \seealso{ -\code{\link{geom_polygon}}: Filled paths (polygons); - \code{\link{geom_segment}}: Line segments +\code{\link{a_geom_polygon}}: Filled paths (polygons); + \code{\link{a_geom_segment}}: Line segments } - diff --git a/man/geom_point.Rd b/man/a_geom_point.Rd similarity index 53% rename from man/geom_point.Rd rename to man/a_geom_point.Rd index 9f09da5d52..94fa02d80d 100644 --- a/man/geom_point.Rd +++ b/man/a_geom_point.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-point.r -\name{geom_point} -\alias{geom_point} +\name{a_geom_point} +\alias{a_geom_point} \title{Points, as for a scatterplot} \usage{ -geom_point(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_geom_point(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -18,26 +18,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -46,7 +46,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -58,7 +58,7 @@ The point geom is used to create scatterplots. The scatterplot is useful for displaying the relationship between two continuous variables, although it can also be used with one continuous and one categorical variable, or two categorical variables. See -\code{\link{geom_jitter}} for possibilities. +\code{\link{a_geom_jitter}} for possibilities. The \emph{bubblechart} is a scatterplot with a third variable mapped to the size of points. There are no special names for scatterplots where @@ -69,73 +69,73 @@ you have more than a few points, points may be plotted on top of one another. This can severely distort the visual appearance of the plot. There is no one solution to this problem, but there are some techniques that can help. You can add additional information with -\code{\link{geom_smooth}}, \code{\link{geom_quantile}} or -\code{\link{geom_density_2d}}. If you have few unique x values, -\code{\link{geom_boxplot}} may also be useful. Alternatively, you can +\code{\link{a_geom_smooth}}, \code{\link{a_geom_quantile}} or +\code{\link{a_geom_density_2d}}. If you have few unique x values, +\code{\link{a_geom_boxplot}} may also be useful. Alternatively, you can summarise the number of points at each location and display that in some -way, using \code{\link{stat_sum}}. Another technique is to use transparent -points, e.g. \code{geom_point(alpha = 0.05)}. +way, using \code{\link{a_stat_sum}}. Another technique is to use transparent +points, e.g. \code{a_geom_point(alpha = 0.05)}. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "point")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "point")} } + \examples{ -p <- ggplot(mtcars, aes(wt, mpg)) -p + geom_point() +p <- a_plot(mtcars, a_aes(wt, mpg)) +p + a_geom_point() -# Add aesthetic mappings -p + geom_point(aes(colour = factor(cyl))) -p + geom_point(aes(shape = factor(cyl))) -p + geom_point(aes(size = qsec)) +# Add a_aesthetic mappings +p + a_geom_point(a_aes(colour = factor(cyl))) +p + a_geom_point(a_aes(shape = factor(cyl))) +p + a_geom_point(a_aes(size = qsec)) # Change scales -p + geom_point(aes(colour = cyl)) + scale_colour_gradient(low = "blue") -p + geom_point(aes(shape = factor(cyl))) + scale_shape(solid = FALSE) +p + a_geom_point(a_aes(colour = cyl)) + a_scale_colour_gradient(low = "blue") +p + a_geom_point(a_aes(shape = factor(cyl))) + a_scale_shape(solid = FALSE) -# Set aesthetics to fixed value -ggplot(mtcars, aes(wt, mpg)) + geom_point(colour = "red", size = 3) +# Set a_aesthetics to fixed value +a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point(colour = "red", size = 3) \donttest{ # Varying alpha is useful for large datasets -d <- ggplot(diamonds, aes(carat, price)) -d + geom_point(alpha = 1/10) -d + geom_point(alpha = 1/20) -d + geom_point(alpha = 1/100) +d <- a_plot(diamonds, a_aes(carat, price)) +d + a_geom_point(alpha = 1/10) +d + a_geom_point(alpha = 1/20) +d + a_geom_point(alpha = 1/100) } # For shapes that have a border (like 21), you can colour the inside and # outside separately. Use the stroke aesthetic to modify the width of the # border -ggplot(mtcars, aes(wt, mpg)) + - geom_point(shape = 21, colour = "black", fill = "white", size = 5, stroke = 5) +a_plot(mtcars, a_aes(wt, mpg)) + + a_geom_point(shape = 21, colour = "black", fill = "white", size = 5, stroke = 5) \donttest{ # You can create interesting shapes by layering multiple points of # different sizes -p <- ggplot(mtcars, aes(mpg, wt, shape = factor(cyl))) -p + geom_point(aes(colour = factor(cyl)), size = 4) + - geom_point(colour = "grey90", size = 1.5) -p + geom_point(colour = "black", size = 4.5) + - geom_point(colour = "pink", size = 4) + - geom_point(aes(shape = factor(cyl))) +p <- a_plot(mtcars, a_aes(mpg, wt, shape = factor(cyl))) +p + a_geom_point(a_aes(colour = factor(cyl)), size = 4) + + a_geom_point(colour = "grey90", size = 1.5) +p + a_geom_point(colour = "black", size = 4.5) + + a_geom_point(colour = "pink", size = 4) + + a_geom_point(a_aes(shape = factor(cyl))) # These extra layers don't usually appear in the legend, but we can # force their inclusion -p + geom_point(colour = "black", size = 4.5, show.legend = TRUE) + - geom_point(colour = "pink", size = 4, show.legend = TRUE) + - geom_point(aes(shape = factor(cyl))) +p + a_geom_point(colour = "black", size = 4.5, show.legend = TRUE) + + a_geom_point(colour = "pink", size = 4, show.legend = TRUE) + + a_geom_point(a_aes(shape = factor(cyl))) -# geom_point warns when missing values have been dropped from the data set +# a_geom_point warns when missing values have been dropped from the data set # and not plotted, you can turn this off by setting na.rm = TRUE mtcars2 <- transform(mtcars, mpg = ifelse(runif(32) < 0.2, NA, mpg)) -ggplot(mtcars2, aes(wt, mpg)) + geom_point() -ggplot(mtcars2, aes(wt, mpg)) + geom_point(na.rm = TRUE) +a_plot(mtcars2, a_aes(wt, mpg)) + a_geom_point() +a_plot(mtcars2, a_aes(wt, mpg)) + a_geom_point(na.rm = TRUE) } } \seealso{ -\code{\link{scale_size}} to see scale area of points, instead of - radius, \code{\link{geom_jitter}} to jitter points to reduce (mild) +\code{\link{a_scale_size}} to see scale area of points, instead of + radius, \code{\link{a_geom_jitter}} to jitter points to reduce (mild) overplotting } - diff --git a/man/geom_polygon.Rd b/man/a_geom_polygon.Rd similarity index 68% rename from man/geom_polygon.Rd rename to man/a_geom_polygon.Rd index 743c3b31f7..61772b8bef 100644 --- a/man/geom_polygon.Rd +++ b/man/a_geom_polygon.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-polygon.r -\name{geom_polygon} -\alias{geom_polygon} +\name{a_geom_polygon} +\alias{a_geom_polygon} \title{Polygon, a filled path.} \usage{ -geom_polygon(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_geom_polygon(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -18,26 +18,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -46,7 +46,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -56,10 +56,11 @@ Polygon, a filled path. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "polygon")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "polygon")} } + \examples{ -# When using geom_polygon, you will typically need two data frames: +# When using a_geom_polygon, you will typically need two data frames: # one contains the coordinates of each polygon (positions), and the # other the values associated with each polygon (values). An id # variable links the two together @@ -82,7 +83,7 @@ positions <- data.frame( # Currently we need to manually merge the two together datapoly <- merge(values, positions, by = c("id")) -(p <- ggplot(datapoly, aes(x = x, y = y)) + geom_polygon(aes(fill = value, group = id))) +(p <- a_plot(datapoly, a_aes(x = x, y = y)) + a_geom_polygon(a_aes(fill = value, group = id))) # Which seems like a lot of work, but then it's easy to add on # other features in this coordinate system, e.g.: @@ -92,13 +93,12 @@ stream <- data.frame( y = cumsum(runif(50,max = 0.1)) ) -p + geom_line(data = stream, colour = "grey30", size = 5) +p + a_geom_line(data = stream, colour = "grey30", size = 5) # And if the positions are in longitude and latitude, you can use -# coord_map to produce different map projections. +# a_coord_map to produce different map projections. } \seealso{ -\code{\link{geom_path}} for an unfilled polygon, - \code{\link{geom_ribbon}} for a polygon anchored on the x-axis +\code{\link{a_geom_path}} for an unfilled polygon, + \code{\link{a_geom_ribbon}} for a polygon anchored on the x-axis } - diff --git a/man/geom_quantile.Rd b/man/a_geom_quantile.Rd similarity index 63% rename from man/geom_quantile.Rd rename to man/a_geom_quantile.Rd index 1760e9f9bd..95dbafac89 100644 --- a/man/geom_quantile.Rd +++ b/man/a_geom_quantile.Rd @@ -1,22 +1,22 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-quantile.r, R/stat-quantile.r -\name{geom_quantile} -\alias{geom_quantile} -\alias{stat_quantile} +\name{a_geom_quantile} +\alias{a_geom_quantile} +\alias{a_stat_quantile} \title{Add quantile lines from a quantile regression.} \usage{ -geom_quantile(mapping = NULL, data = NULL, stat = "quantile", - position = "identity", ..., lineend = "butt", linejoin = "round", - linemitre = 1, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) +a_geom_quantile(mapping = NULL, data = NULL, a_stat = "quantile", + a_position = "identity", ..., lineend = "butt", linejoin = "round", + linemitre = 1, na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) -stat_quantile(mapping = NULL, data = NULL, geom = "quantile", - position = "identity", ..., quantiles = c(0.25, 0.5, 0.75), +a_stat_quantile(mapping = NULL, data = NULL, a_geom = "quantile", + a_position = "identity", ..., quantiles = c(0.25, 0.5, 0.75), formula = NULL, method = "rq", method.args = list(), na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -24,23 +24,23 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{lineend}{Line end style (round, butt, square)} @@ -55,13 +55,13 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} -\item{geom, stat}{Use to override the default connection between -\code{geom_quantile} and \code{stat_quantile}.} +\item{a_geom, a_stat}{Use to override the default connection between +\code{a_geom_quantile} and \code{a_stat_quantile}.} \item{quantiles}{conditional quantiles of y to calculate and display} @@ -74,11 +74,11 @@ the default plot specification, e.g. \code{\link{borders}}.} function defined by \code{method}.} } \description{ -This can be used as a continuous analogue of a geom_boxplot. +This can be used as a continuous analogue of a a_geom_boxplot. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "quantile")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "quantile")} } \section{Computed variables}{ @@ -87,20 +87,20 @@ This can be used as a continuous analogue of a geom_boxplot. \item{quantile}{quantile of distribution} } } + \examples{ -m <- ggplot(mpg, aes(displ, 1 / hwy)) + geom_point() -m + geom_quantile() -m + geom_quantile(quantiles = 0.5) +m <- a_plot(mpg, a_aes(displ, 1 / hwy)) + a_geom_point() +m + a_geom_quantile() +m + a_geom_quantile(quantiles = 0.5) q10 <- seq(0.05, 0.95, by = 0.05) -m + geom_quantile(quantiles = q10) +m + a_geom_quantile(quantiles = q10) # You can also use rqss to fit smooth quantiles -m + geom_quantile(method = "rqss") +m + a_geom_quantile(method = "rqss") # Note that rqss doesn't pick a smoothing constant automatically, so # you'll need to tweak lambda yourself -m + geom_quantile(method = "rqss", lambda = 0.1) +m + a_geom_quantile(method = "rqss", lambda = 0.1) # Set aesthetics to fixed value -m + geom_quantile(colour = "red", size = 2, alpha = 0.5) +m + a_geom_quantile(colour = "red", size = 2, alpha = 0.5) } - diff --git a/man/geom_ribbon.Rd b/man/a_geom_ribbon.Rd similarity index 55% rename from man/geom_ribbon.Rd rename to man/a_geom_ribbon.Rd index 73dc9303c3..989460d3a0 100644 --- a/man/geom_ribbon.Rd +++ b/man/a_geom_ribbon.Rd @@ -1,21 +1,21 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-ribbon.r -\name{geom_ribbon} -\alias{geom_area} -\alias{geom_ribbon} +\name{a_geom_ribbon} +\alias{a_geom_ribbon} +\alias{a_geom_area} \title{Ribbons and area plots.} \usage{ -geom_ribbon(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_geom_ribbon(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) -geom_area(mapping = NULL, data = NULL, stat = "identity", - position = "stack", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) +a_geom_area(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "stack", na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE, ...) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -23,26 +23,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -51,43 +51,43 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} } \description{ -For each continuous x value, \code{geom_interval} displays a y interval. -\code{geom_area} is a special case of \code{geom_ribbon}, where the +For each continuous x value, \code{a_geom_interval} displays a y interval. +\code{a_geom_area} is a special case of \code{a_geom_ribbon}, where the minimum of the range is fixed to 0. } \details{ An area plot is the continuous analog of a stacked bar chart (see -\code{\link{geom_bar}}), and can be used to show how composition of the +\code{\link{a_geom_bar}}), and can be used to show how composition of the whole varies over the range of x. Choosing the order in which different components is stacked is very important, as it becomes increasing hard to see the individual pattern as you move up the stack. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "ribbon")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "ribbon")} } + \examples{ # Generate data huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron)) -h <- ggplot(huron, aes(year)) +h <- a_plot(huron, a_aes(year)) -h + geom_ribbon(aes(ymin=0, ymax=level)) -h + geom_area(aes(y = level)) +h + a_geom_ribbon(a_aes(ymin=0, ymax=level)) +h + a_geom_area(a_aes(y = level)) -# Add aesthetic mappings +# Add a_aesthetic mappings h + - geom_ribbon(aes(ymin = level - 1, ymax = level + 1), fill = "grey70") + - geom_line(aes(y = level)) + a_geom_ribbon(a_aes(ymin = level - 1, ymax = level + 1), fill = "grey70") + + a_geom_line(a_aes(y = level)) } \seealso{ -\code{\link{geom_bar}} for discrete intervals (bars), - \code{\link{geom_linerange}} for discrete intervals (lines), - \code{\link{geom_polygon}} for general polygons +\code{\link{a_geom_bar}} for discrete intervals (bars), + \code{\link{a_geom_linerange}} for discrete intervals (lines), + \code{\link{a_geom_polygon}} for general polygons } - diff --git a/man/geom_rug.Rd b/man/a_geom_rug.Rd similarity index 62% rename from man/geom_rug.Rd rename to man/a_geom_rug.Rd index 165e91320a..c0172a1bf7 100644 --- a/man/geom_rug.Rd +++ b/man/a_geom_rug.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-rug.r -\name{geom_rug} -\alias{geom_rug} +\name{a_geom_rug} +\alias{a_geom_rug} \title{Marginal rug plots.} \usage{ -geom_rug(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., sides = "bl", na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) +a_geom_rug(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., sides = "bl", na.rm = FALSE, + show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -18,26 +18,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{sides}{A string that controls which sides of the plot the rugs appear on. It can be set to a string containing any of \code{"trbl"}, for top, right, @@ -50,7 +50,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -60,14 +60,14 @@ Marginal rug plots. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "rug")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "rug")} } + \examples{ -p <- ggplot(mtcars, aes(wt, mpg)) -p + geom_point() -p + geom_point() + geom_rug() -p + geom_point() + geom_rug(sides="b") # Rug on bottom only -p + geom_point() + geom_rug(sides="trbl") # All four sides -p + geom_point() + geom_rug(position='jitter') +p <- a_plot(mtcars, a_aes(wt, mpg)) +p + a_geom_point() +p + a_geom_point() + a_geom_rug() +p + a_geom_point() + a_geom_rug(sides="b") # Rug on bottom only +p + a_geom_point() + a_geom_rug(sides="trbl") # All four sides +p + a_geom_point() + a_geom_rug(a_position='jitter') } - diff --git a/man/geom_segment.Rd b/man/a_geom_segment.Rd similarity index 57% rename from man/geom_segment.Rd rename to man/a_geom_segment.Rd index 3a5e0b7332..2457503606 100644 --- a/man/geom_segment.Rd +++ b/man/a_geom_segment.Rd @@ -1,22 +1,22 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-segment.r, R/geom-curve.r -\name{geom_segment} -\alias{geom_curve} -\alias{geom_segment} +\name{a_geom_segment} +\alias{a_geom_segment} +\alias{a_geom_curve} \title{Line segments and curves.} \usage{ -geom_segment(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., arrow = NULL, lineend = "butt", - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) +a_geom_segment(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., arrow = NULL, lineend = "butt", + na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) -geom_curve(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., curvature = 0.5, angle = 90, ncp = 5, +a_geom_curve(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., curvature = 0.5, angle = 90, ncp = 5, arrow = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -24,26 +24,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{arrow}{specification for arrow heads, as created by arrow()} @@ -56,7 +56,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -75,48 +75,48 @@ the default plot specification, e.g. \code{\link{borders}}.} More control points creates a smoother curve.} } \description{ -\code{geom_segment} draws a straight line between points (x1, y1) and -(x2, y2). \code{geom_curve} draws a curved line. +\code{a_geom_segment} draws a straight line between points (x1, y1) and +(x2, y2). \code{a_geom_curve} draws a curved line. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "segment")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "segment")} } + \examples{ -b <- ggplot(mtcars, aes(wt, mpg)) + - geom_point() +b <- a_plot(mtcars, a_aes(wt, mpg)) + + a_geom_point() df <- data.frame(x1 = 2.62, x2 = 3.57, y1 = 21.0, y2 = 15.0) b + - geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "curve"), data = df) + - geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "segment"), data = df) + a_geom_curve(a_aes(x = x1, y = y1, xend = x2, yend = y2, colour = "curve"), data = df) + + a_geom_segment(a_aes(x = x1, y = y1, xend = x2, yend = y2, colour = "segment"), data = df) -b + geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2), data = df, curvature = -0.2) -b + geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2), data = df, curvature = 1) -b + geom_curve( - aes(x = x1, y = y1, xend = x2, yend = y2), +b + a_geom_curve(a_aes(x = x1, y = y1, xend = x2, yend = y2), data = df, curvature = -0.2) +b + a_geom_curve(a_aes(x = x1, y = y1, xend = x2, yend = y2), data = df, curvature = 1) +b + a_geom_curve( + a_aes(x = x1, y = y1, xend = x2, yend = y2), data = df, arrow = arrow(length = unit(0.03, "npc")) ) -ggplot(seals, aes(long, lat)) + - geom_segment(aes(xend = long + delta_long, yend = lat + delta_lat), +a_plot(seals, a_aes(long, lat)) + + a_geom_segment(a_aes(xend = long + delta_long, yend = lat + delta_lat), arrow = arrow(length = unit(0.1,"cm"))) + - borders("state") + ggplot2Animint:::borders("state") -# You can also use geom_segment to recreate plot(type = "h") : +# You can also use a_geom_segment to recreate plot(type = "h") : counts <- as.data.frame(table(x = rpois(100,5))) counts$x <- as.numeric(as.character(counts$x)) with(counts, plot(x, Freq, type = "h", lwd = 10)) -ggplot(counts, aes(x, Freq)) + - geom_segment(aes(xend = x, yend = 0), size = 10, lineend = "butt") +a_plot(counts, a_aes(x, Freq)) + + a_geom_segment(a_aes(xend = x, yend = 0), size = 10, lineend = "butt") } \seealso{ -\code{\link{geom_path}} and \code{\link{geom_line}} for multi- +\code{\link{a_geom_path}} and \code{\link{a_geom_line}} for multi- segment lines and paths. -\code{\link{geom_spoke}} for a segment parameterised by a location +\code{\link{a_geom_spoke}} for a segment parameterised by a location (x, y), and an angle and radius. } - diff --git a/man/geom_smooth.Rd b/man/a_geom_smooth.Rd similarity index 67% rename from man/geom_smooth.Rd rename to man/a_geom_smooth.Rd index 67a36ca42f..8c42fa3ff4 100644 --- a/man/geom_smooth.Rd +++ b/man/a_geom_smooth.Rd @@ -1,23 +1,23 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-smooth.r, R/stat-smooth.r -\name{geom_smooth} -\alias{geom_smooth} -\alias{stat_smooth} +\name{a_geom_smooth} +\alias{a_geom_smooth} +\alias{a_stat_smooth} \title{Add a smoothed conditional mean.} \usage{ -geom_smooth(mapping = NULL, data = NULL, stat = "smooth", - position = "identity", ..., method = "auto", formula = y ~ x, - se = TRUE, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) +a_geom_smooth(mapping = NULL, data = NULL, a_stat = "smooth", + a_position = "identity", ..., method = "auto", formula = y ~ x, + se = TRUE, na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) -stat_smooth(mapping = NULL, data = NULL, geom = "smooth", - position = "identity", ..., method = "auto", formula = y ~ x, +a_stat_smooth(mapping = NULL, data = NULL, a_geom = "smooth", + a_position = "identity", ..., method = "auto", formula = y ~ x, se = TRUE, n = 80, span = 0.75, fullrange = FALSE, level = 0.95, method.args = list(), na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -25,23 +25,23 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{method}{smoothing method (function) to use, eg. lm, glm, gam, loess, rlm. For datasets with n < 1000 default is \code{\link{loess}}. For datasets @@ -61,13 +61,13 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} -\item{geom, stat}{Use to override the default connection between -\code{geom_smooth} and \code{stat_smooth}.} +\item{a_geom, a_stat}{Use to override the default connection between +\code{a_geom_smooth} and \code{a_stat_smooth}.} \item{n}{number of points to evaluate smoother at} @@ -85,8 +85,8 @@ function defined by \code{method}.} } \description{ Aids the eye in seeing patterns in the presence of overplotting. -\code{geom_smooth} and \code{stat_smooth} are effectively aliases: they -both use the same arguments. Use \code{geom_smooth} unless you want to +\code{a_geom_smooth} and \code{a_stat_smooth} are effectively aliases: they +both use the same arguments. Use \code{a_geom_smooth} unless you want to display the results with a non-standard geom. } \details{ @@ -99,7 +99,7 @@ scale, and then back-transformed to the response scale. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "smooth")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "smooth")} } \section{Computed variables}{ @@ -111,54 +111,55 @@ scale, and then back-transformed to the response scale. \item{se}{standard error} } } + \examples{ -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - geom_smooth() +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_geom_smooth() # Use span to control the "wiggliness" of the default loess smoother # The span is the fraction of points used to fit each local regression: # small numbers make a wigglier curve, larger numbers make a smoother curve. -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - geom_smooth(span = 0.3) +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_geom_smooth(span = 0.3) # Instead of a loess smooth, you can use any other modelling function: -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - geom_smooth(method = "lm", se = FALSE) +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_geom_smooth(method = "lm", se = FALSE) -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - geom_smooth(method = "lm", formula = y ~ splines::bs(x, 3), se = FALSE) +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_geom_smooth(method = "lm", formula = y ~ splines::bs(x, 3), se = FALSE) # Smoothes are automatically fit to each group (defined by categorical # aesthetics or the group aesthetic) and for each facet -ggplot(mpg, aes(displ, hwy, colour = class)) + - geom_point() + - geom_smooth(se = FALSE, method = "lm") -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - geom_smooth(span = 0.8) + - facet_wrap(~drv) +a_plot(mpg, a_aes(displ, hwy, colour = class)) + + a_geom_point() + + a_geom_smooth(se = FALSE, method = "lm") +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_geom_smooth(span = 0.8) + + ggplot2Animint:::a_facet_wrap(~drv) \donttest{ binomial_smooth <- function(...) { - geom_smooth(method = "glm", method.args = list(family = "binomial"), ...) + a_geom_smooth(method = "glm", method.args = list(family = "binomial"), ...) } # To fit a logistic regression, you need to coerce the values to # a numeric vector lying between 0 and 1. -ggplot(rpart::kyphosis, aes(Age, Kyphosis)) + - geom_jitter(height = 0.05) + +a_plot(rpart::kyphosis, a_aes(Age, Kyphosis)) + + a_geom_jitter(height = 0.05) + binomial_smooth() -ggplot(rpart::kyphosis, aes(Age, as.numeric(Kyphosis) - 1)) + - geom_jitter(height = 0.05) + +a_plot(rpart::kyphosis, a_aes(Age, as.numeric(Kyphosis) - 1)) + + a_geom_jitter(height = 0.05) + binomial_smooth() -ggplot(rpart::kyphosis, aes(Age, as.numeric(Kyphosis) - 1)) + - geom_jitter(height = 0.05) + +a_plot(rpart::kyphosis, a_aes(Age, as.numeric(Kyphosis) - 1)) + + a_geom_jitter(height = 0.05) + binomial_smooth(formula = y ~ splines::ns(x, 2)) # But in this case, it's probably better to fit the model yourself @@ -171,4 +172,3 @@ See individual modelling functions for more details: \code{\link{glm}} for generalised linear smooths, \code{\link{loess}} for local smooths } - diff --git a/man/geom_spoke.Rd b/man/a_geom_spoke.Rd similarity index 64% rename from man/geom_spoke.Rd rename to man/a_geom_spoke.Rd index 0e0316f5af..ac65da0a9b 100644 --- a/man/geom_spoke.Rd +++ b/man/a_geom_spoke.Rd @@ -1,17 +1,17 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-spoke.r -\name{geom_spoke} -\alias{geom_spoke} -\alias{stat_spoke} +\name{a_geom_spoke} +\alias{a_geom_spoke} +\alias{a_stat_spoke} \title{A line segment parameterised by location, direction and distance.} \usage{ -geom_spoke(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_geom_spoke(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -19,26 +19,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -47,7 +47,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -57,19 +57,19 @@ A line segment parameterised by location, direction and distance. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "spoke")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "spoke")} } + \examples{ df <- expand.grid(x = 1:10, y=1:10) df$angle <- runif(100, 0, 2*pi) df$speed <- runif(100, 0, sqrt(0.1 * df$x)) -ggplot(df, aes(x, y)) + - geom_point() + - geom_spoke(aes(angle = angle), radius = 0.5) +a_plot(df, a_aes(x, y)) + + a_geom_point() + + a_geom_spoke(a_aes(angle = angle), radius = 0.5) -ggplot(df, aes(x, y)) + - geom_point() + - geom_spoke(aes(angle = angle, radius = speed)) +a_plot(df, a_aes(x, y)) + + a_geom_point() + + a_geom_spoke(a_aes(angle = angle, radius = speed)) } - diff --git a/man/geom_text.Rd b/man/a_geom_text.Rd similarity index 54% rename from man/geom_text.Rd rename to man/a_geom_text.Rd index 5efb40f6ad..10cc9c9dcf 100644 --- a/man/geom_text.Rd +++ b/man/a_geom_text.Rd @@ -1,24 +1,24 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-label.R, R/geom-text.r -\name{geom_label} -\alias{geom_label} -\alias{geom_text} +\name{a_geom_label} +\alias{a_geom_label} +\alias{a_geom_text} \title{Textual annotations.} \usage{ -geom_label(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., parse = FALSE, nudge_x = 0, nudge_y = 0, - label.padding = unit(0.25, "lines"), label.r = unit(0.15, "lines"), - label.size = 0.25, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) - -geom_text(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., parse = FALSE, nudge_x = 0, nudge_y = 0, +a_geom_label(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., parse = FALSE, nudge_x = 0, nudge_y = 0, + a_label.padding = unit(0.25, "lines"), a_label.r = unit(0.15, "lines"), + a_label.size = 0.25, na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) + +a_geom_text(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., parse = FALSE, nudge_x = 0, nudge_y = 0, check_overlap = FALSE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -26,26 +26,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{parse}{If TRUE, the labels will be parsed into expressions and displayed as described in ?plotmath} @@ -53,11 +53,11 @@ displayed as described in ?plotmath} \item{nudge_x, nudge_y}{Horizontal and vertical adjustment to nudge labels by. Useful for offsetting text from points, particularly on discrete scales.} -\item{label.padding}{Amount of padding around label. Defaults to 0.25 lines.} +\item{a_label.padding}{Amount of padding around a_label. Defaults to 0.25 lines.} -\item{label.r}{Radius of rounded corners. Defaults to 0.15 lines.} +\item{a_label.r}{Radius of rounded corners. Defaults to 0.15 lines.} -\item{label.size}{Size of label border, in mm.} +\item{a_label.size}{Size of label border, in mm.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -66,16 +66,16 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} \item{check_overlap}{If \code{TRUE}, text that overlaps previous text in the -same layer will not be plotted. A quick and dirty way} +same a_layer will not be plotted. A quick and dirty way} } \description{ -\code{geom_text} adds text directly to the plot. \code{geom_label} draws +\code{a_geom_text} adds text directly to the plot. \code{a_geom_label} draws a rectangle underneath the text, making it easier to read. } \details{ @@ -88,13 +88,13 @@ resize a plot, labels stay the same size, but the size of the axes changes. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "text")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "text")} } -\section{\code{geom_label}}{ +\section{\code{a_geom_label}}{ -Currently \code{geom_label} does not support the \code{rot} parameter and -is considerably slower than \code{geom_text}. The \code{fill} aesthetic +Currently \code{a_geom_label} does not support the \code{rot} parameter and +is considerably slower than \code{a_geom_text}. The \code{fill} aesthetic controls the background colour of the label. } @@ -107,46 +107,48 @@ aesthetics. These can either be a number between 0 (right/bottom) and Inward always aligns text towards the center, and outward aligns it away from the center } + \examples{ -p <- ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars))) +p <- a_plot(mtcars, a_aes(wt, mpg, a_label = rownames(mtcars))) -p + geom_text() +p + a_geom_text() # Avoid overlaps -p + geom_text(check_overlap = TRUE) +p + a_geom_text(check_overlap = TRUE) # Labels with background -p + geom_label() +p + a_geom_label() # Change size of the label -p + geom_text(size = 10) +p + a_geom_text(size = 10) # Set aesthetics to fixed value -p + geom_point() + geom_text(hjust = 0, nudge_x = 0.05) -p + geom_point() + geom_text(vjust = 0, nudge_y = 0.5) -p + geom_point() + geom_text(angle = 45) +p + a_geom_point() + a_geom_text(hjust = 0, nudge_x = 0.05) +p + a_geom_point() + a_geom_text(vjust = 0, nudge_y = 0.5) +p + a_geom_point() + a_geom_text(angle = 45) \dontrun{ # Doesn't work on all systems -p + geom_text(family = "Times New Roman") +p + a_geom_text(family = "Times New Roman") } # Add aesthetic mappings -p + geom_text(aes(colour = factor(cyl))) -p + geom_text(aes(colour = factor(cyl))) + - scale_colour_discrete(l = 40) -p + geom_label(aes(fill = factor(cyl)), colour = "white", fontface = "bold") +p + a_geom_text(a_aes(colour = factor(cyl))) +p + a_geom_text(a_aes(colour = factor(cyl))) + + a_scale_colour_discrete(l = 40) +p + a_geom_label(a_aes(fill = factor(cyl)), colour = "white", fontface = "bold") -p + geom_text(aes(size = wt)) -# Scale height of text, rather than sqrt(height) -p + geom_text(aes(size = wt)) + scale_radius(range = c(3,6)) +p + a_geom_text(a_aes(size = wt)) +# a_scale height of text, rather than sqrt(height) +p + a_geom_text(a_aes(size = wt)) + a_scale_radius(range = c(3,6)) # You can display expressions by setting parse = TRUE. The # details of the display are described in ?plotmath, but note that -# geom_text uses strings, not expressions. -p + geom_text(aes(label = paste(wt, "^(", cyl, ")", sep = "")), +# a_geom_text uses strings, not expressions. +p + a_geom_text(a_aes(a_label = paste(wt, "^(", cyl, ")", sep = "")), parse = TRUE) # Add a text annotation p + - geom_text() + - annotate("text", label = "plot mpg vs. wt", x = 2, y = 15, size = 8, colour = "red") + a_geom_text() + + ggplot2Animint:::a_annotate("text", + a_label = "plot mpg vs. wt", x = 2, y = 15, size = 8, colour = "red") \donttest{ # Aligning labels and bars -------------------------------------------------- @@ -158,25 +160,25 @@ df <- data.frame( # ggplot2 doesn't know you want to give the labels the same virtual width # as the bars: -ggplot(data = df, aes(x, y, fill = grp, label = y)) + - geom_bar(stat = "identity", position = "dodge") + - geom_text(position = "dodge") +a_plot(data = df, a_aes(x, y, fill = grp, a_label = y)) + + a_geom_bar(a_stat = "identity", a_position = "dodge") + + a_geom_text(a_position = "dodge") # So tell it: -ggplot(data = df, aes(x, y, fill = grp, label = y)) + - geom_bar(stat = "identity", position = "dodge") + - geom_text(position = position_dodge(0.9)) +a_plot(data = df, a_aes(x, y, fill = grp, a_label = y)) + + a_geom_bar(a_stat = "identity", a_position = "dodge") + + a_geom_text(a_position = a_position_dodge(0.9)) # Use you can't nudge and dodge text, so instead adjust the y postion -ggplot(data = df, aes(x, y, fill = grp, label = y)) + - geom_bar(stat = "identity", position = "dodge") + - geom_text(aes(y = y + 0.05), position = position_dodge(0.9), vjust = 0) +a_plot(data = df, a_aes(x, y, fill = grp, a_label = y)) + + a_geom_bar(a_stat = "identity", a_position = "dodge") + + a_geom_text(a_aes(y = y + 0.05), a_position = a_position_dodge(0.9), vjust = 0) # To place text in the middle of each bar in a stacked barplot, you # need to do the computation yourself df <- transform(df, mid_y = ave(df$y, df$x, FUN = function(val) cumsum(val) - (0.5 * val))) -ggplot(data = df, aes(x, y, fill = grp, label = y)) + - geom_bar(stat = "identity") + - geom_text(aes(y = mid_y)) +a_plot(data = df, a_aes(x, y, fill = grp, a_label = y)) + + a_geom_bar(a_stat = "identity") + + a_geom_text(a_aes(y = mid_y)) # Justification ------------------------------------------------------------- df <- data.frame( @@ -184,10 +186,9 @@ df <- data.frame( y = c(1, 2, 1, 2, 1.5), text = c("bottom-left", "bottom-right", "top-left", "top-right", "center") ) -ggplot(df, aes(x, y)) + - geom_text(aes(label = text)) -ggplot(df, aes(x, y)) + - geom_text(aes(label = text), vjust = "inward", hjust = "inward") +a_plot(df, a_aes(x, y)) + + a_geom_text(a_aes(a_label = text)) +a_plot(df, a_aes(x, y)) + + a_geom_text(a_aes(a_label = text), vjust = "inward", hjust = "inward") } } - diff --git a/man/geom_tile.Rd b/man/a_geom_tile.Rd similarity index 50% rename from man/geom_tile.Rd rename to man/a_geom_tile.Rd index 096b101ddb..3b2525b627 100644 --- a/man/geom_tile.Rd +++ b/man/a_geom_tile.Rd @@ -1,27 +1,27 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-raster.r, R/geom-rect.r, R/geom-tile.r -\name{geom_raster} -\alias{geom_raster} -\alias{geom_rect} -\alias{geom_tile} +\name{a_geom_raster} +\alias{a_geom_raster} +\alias{a_geom_rect} +\alias{a_geom_tile} \title{Draw rectangles.} \usage{ -geom_raster(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., hjust = 0.5, vjust = 0.5, +a_geom_raster(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., hjust = 0.5, vjust = 0.5, interpolate = FALSE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + inherit.a_aes = TRUE) -geom_rect(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_geom_rect(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) -geom_tile(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_geom_tile(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -29,26 +29,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{hjust, vjust}{horizontal and vertical justification of the grob. Each justification value should be a number between 0 and 1. Defaults to 0.5 @@ -64,65 +64,65 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} } \description{ -\code{geom_rect} and \code{geom_tile} do the same thing, but are -parameterised differently. \code{geom_rect} uses the locations of the four +\code{a_geom_rect} and \code{a_geom_tile} do the same thing, but are +parameterised differently. \code{a_geom_rect} uses the locations of the four corners (\code{xmin}, \code{xmax}, \code{ymin} and \code{ymax}). -\code{geom_tile} uses the center of the tile and its size (\code{x}, -\code{y}, \code{width}, \code{height}). \code{geom_raster} is a high +\code{a_geom_tile} uses the center of the tile and its size (\code{x}, +\code{y}, \code{width}, \code{height}). \code{a_geom_raster} is a high performance special case for when all the tiles are the same size. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "tile")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "tile")} } + \examples{ # The most common use for rectangles is to draw a surface. You always want -# to use geom_raster here because it's so much faster, and produces +# to use a_geom_raster here because it's so much faster, and produces # smaller output when saving to PDF -ggplot(faithfuld, aes(waiting, eruptions)) + - geom_raster(aes(fill = density)) +a_plot(faithfuld, a_aes(waiting, eruptions)) + + a_geom_raster(a_aes(fill = density)) # Interpolation smooths the surface & is most helpful when rendering images. -ggplot(faithfuld, aes(waiting, eruptions)) + - geom_raster(aes(fill = density), interpolate = TRUE) +a_plot(faithfuld, a_aes(waiting, eruptions)) + + a_geom_raster(a_aes(fill = density), interpolate = TRUE) -# If you want to draw arbitrary rectangles, use geom_tile() or geom_rect() +# If you want to draw arbitrary rectangles, use a_geom_tile() or a_geom_rect() df <- data.frame( x = rep(c(2, 5, 7, 9, 12), 2), y = rep(c(1, 2), each = 5), z = factor(rep(1:5, each = 2)), w = rep(diff(c(0, 4, 6, 8, 10, 14)), 2) ) -ggplot(df, aes(x, y)) + - geom_tile(aes(fill = z)) -ggplot(df, aes(x, y)) + - geom_tile(aes(fill = z, width = w), colour = "grey50") -ggplot(df, aes(xmin = x - w / 2, xmax = x + w / 2, ymin = y, ymax = y + 1)) + - geom_rect(aes(fill = z, width = w), colour = "grey50") +a_plot(df, a_aes(x, y)) + + a_geom_tile(a_aes(fill = z)) +a_plot(df, a_aes(x, y)) + + a_geom_tile(a_aes(fill = z, width = w), colour = "grey50") +a_plot(df, a_aes(xmin = x - w / 2, xmax = x + w / 2, ymin = y, ymax = y + 1)) + + a_geom_rect(a_aes(fill = z, width = w), colour = "grey50") \donttest{ # Justification controls where the cells are anchored df <- expand.grid(x = 0:5, y = 0:5) df$z <- runif(nrow(df)) -# default is compatible with geom_tile() -ggplot(df, aes(x, y, fill = z)) + geom_raster() +# default is compatible with a_geom_tile() +a_plot(df, a_aes(x, y, fill = z)) + a_geom_raster() # zero padding -ggplot(df, aes(x, y, fill = z)) + geom_raster(hjust = 0, vjust = 0) +a_plot(df, a_aes(x, y, fill = z)) + a_geom_raster(hjust = 0, vjust = 0) # Inspired by the image-density plots of Ken Knoblauch -cars <- ggplot(mtcars, aes(mpg, factor(cyl))) -cars + geom_point() -cars + stat_bin2d(aes(fill = ..count..), binwidth = c(3,1)) -cars + stat_bin2d(aes(fill = ..density..), binwidth = c(3,1)) +cars <- a_plot(mtcars, a_aes(mpg, factor(cyl))) +cars + a_geom_point() +cars + a_stat_bin2d(a_aes(fill = ..count..), binwidth = c(3,1)) +cars + a_stat_bin2d(a_aes(fill = ..density..), binwidth = c(3,1)) -cars + stat_density(aes(fill = ..density..), geom = "raster", position = "identity") -cars + stat_density(aes(fill = ..count..), geom = "raster", position = "identity") +cars + a_stat_density(a_aes(fill = ..density..), a_geom = "raster", a_position = "identity") +cars + a_stat_density(a_aes(fill = ..count..), a_geom = "raster", a_position = "identity") } } - diff --git a/man/geom_violin.Rd b/man/a_geom_violin.Rd similarity index 59% rename from man/geom_violin.Rd rename to man/a_geom_violin.Rd index 545833be3f..502fd9bea8 100644 --- a/man/geom_violin.Rd +++ b/man/a_geom_violin.Rd @@ -1,22 +1,23 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-violin.r, R/stat-ydensity.r -\name{geom_violin} -\alias{geom_violin} -\alias{stat_ydensity} +\name{a_geom_violin} +\alias{a_geom_violin} +\alias{a_stat_ydensity} \title{Violin plot.} \usage{ -geom_violin(mapping = NULL, data = NULL, stat = "ydensity", - position = "dodge", ..., draw_quantiles = NULL, trim = TRUE, - scale = "area", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) - -stat_ydensity(mapping = NULL, data = NULL, geom = "violin", - position = "dodge", ..., bw = "nrd0", adjust = 1, kernel = "gaussian", - trim = TRUE, scale = "area", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_geom_violin(mapping = NULL, data = NULL, a_stat = "ydensity", + a_position = "dodge", ..., draw_quantiles = NULL, trim = TRUE, + a_scale = "area", na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) + +a_stat_ydensity(mapping = NULL, data = NULL, a_geom = "violin", + a_position = "dodge", ..., bw = "nrd0", adjust = 1, + kernel = "gaussian", trim = TRUE, a_scale = "area", na.rm = FALSE, + show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -24,23 +25,23 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{draw_quantiles}{If \code{not(NULL)} (default), draw horizontal lines at the given quantiles of the density estimate.} @@ -48,7 +49,7 @@ at the given quantiles of the density estimate.} \item{trim}{If \code{TRUE} (default), trim the tails of the violins to the range of the data. If \code{FALSE}, don't trim the tails.} -\item{scale}{if "area" (default), all violins have the same area (before trimming +\item{a_scale}{if "area" (default), all violins have the same area (before trimming the tails). If "count", areas are scaled proportionally to the number of observations. If "width", all violins have the same maximum width.} @@ -59,13 +60,13 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} -\item{geom, stat}{Use to override the default connection between -\code{geom_violin} and \code{stat_ydensity}.} +\item{a_geom, a_stat}{Use to override the default connection between +\code{a_geom_violin} and \code{a_stat_ydensity}.} \item{bw}{the smoothing bandwidth to be used, see \code{\link{density}} for details} @@ -81,7 +82,7 @@ Violin plot. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "violin")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_geom", "violin")} } \section{Computed variables}{ @@ -96,56 +97,57 @@ Violin plot. \item{width}{width of violin bounding box} } } + \examples{ -p <- ggplot(mtcars, aes(factor(cyl), mpg)) -p + geom_violin() +p <- a_plot(mtcars, a_aes(factor(cyl), mpg)) +p + a_geom_violin() \donttest{ -p + geom_violin() + geom_jitter(height = 0) -p + geom_violin() + coord_flip() +p + a_geom_violin() + a_geom_jitter(height = 0) +p + a_geom_violin() + ggplot2Animint:::a_coord_flip() # Scale maximum width proportional to sample size: -p + geom_violin(scale = "count") +p + a_geom_violin(a_scale = "count") # Scale maximum width to 1 for all violins: -p + geom_violin(scale = "width") +p + a_geom_violin(a_scale = "width") # Default is to trim violins to the range of the data. To disable: -p + geom_violin(trim = FALSE) +p + a_geom_violin(trim = FALSE) # Use a smaller bandwidth for closer density fit (default is 1). -p + geom_violin(adjust = .5) +p + a_geom_violin(adjust = .5) # Add aesthetic mappings # Note that violins are automatically dodged when any aesthetic is # a factor -p + geom_violin(aes(fill = cyl)) -p + geom_violin(aes(fill = factor(cyl))) -p + geom_violin(aes(fill = factor(vs))) -p + geom_violin(aes(fill = factor(am))) +p + a_geom_violin(a_aes(fill = cyl)) +p + a_geom_violin(a_aes(fill = factor(cyl))) +p + a_geom_violin(a_aes(fill = factor(vs))) +p + a_geom_violin(a_aes(fill = factor(am))) -# Set aesthetics to fixed value -p + geom_violin(fill = "grey80", colour = "#3366FF") +# Set a_aesthetics to fixed value +p + a_geom_violin(fill = "grey80", colour = "#3366FF") # Show quartiles -p + geom_violin(draw_quantiles = c(0.25, 0.5, 0.75)) +p + a_geom_violin(draw_quantiles = c(0.25, 0.5, 0.75)) # Scales vs. coordinate transforms ------- if (require("ggplot2movies")) { # Scale transformations occur before the density statistics are computed. # Coordinate transformations occur afterwards. Observe the effect on the # number of outliers. -m <- ggplot(movies, aes(y = votes, x = rating, group = cut_width(rating, 0.5))) -m + geom_violin() -m + geom_violin() + scale_y_log10() -m + geom_violin() + coord_trans(y = "log10") -m + geom_violin() + scale_y_log10() + coord_trans(y = "log10") +m <- a_plot(movies, a_aes(y = votes, x = rating, group = cut_width(rating, 0.5))) +m + a_geom_violin() +m + a_geom_violin() + a_scale_y_log10() +m + a_geom_violin() + ggplot2Animint:::a_coord_trans(y = "log10") +m + a_geom_violin() + a_scale_y_log10() + ggplot2Animint:::a_coord_trans(y = "log10") # Violin plots with continuous x: -# Use the group aesthetic to group observations in violins -ggplot(movies, aes(year, budget)) + geom_violin() -ggplot(movies, aes(year, budget)) + - geom_violin(aes(group = cut_width(year, 10)), scale = "width") +# Use the group a_aesthetic to group observations in violins +a_plot(movies, a_aes(year, budget)) + a_geom_violin() +a_plot(movies, a_aes(year, budget)) + + a_geom_violin(a_aes(group = cut_width(year, 10)), a_scale = "width") } } } @@ -154,7 +156,6 @@ Hintze, J. L., Nelson, R. D. (1998) Violin Plots: A Box Plot-Density Trace Synergism. The American Statistician 52, 181-184. } \seealso{ -\code{\link{geom_violin}} for examples, and \code{\link{stat_density}} +\code{\link{a_geom_violin}} for examples, and \code{\link{a_stat_density}} for examples with data along the x axis. } - diff --git a/man/ggproto.Rd b/man/a_ggproto.Rd similarity index 61% rename from man/ggproto.Rd rename to man/a_ggproto.Rd index a1c8cf85c0..a89bc9a5d7 100644 --- a/man/ggproto.Rd +++ b/man/a_ggproto.Rd @@ -1,39 +1,39 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggproto.r -\name{ggproto} -\alias{ggproto} -\alias{ggproto_parent} -\title{Create a new ggproto object} +\name{a_ggproto} +\alias{a_ggproto} +\alias{a_ggproto_parent} +\title{Create a new a_ggproto object} \usage{ -ggproto(`_class` = NULL, `_inherit` = NULL, ...) +a_ggproto(`_class` = NULL, `_inherit` = NULL, ...) -ggproto_parent(parent, self) +a_ggproto_parent(parent, self) } \arguments{ \item{_class}{Class name to assign to the object. This is stored as the class attribute of the object. If \code{NULL} (the default), no class name will be added to the object.} -\item{_inherit}{ggproto object to inherit from. If \code{NULL}, don't inherit +\item{_inherit}{a_ggproto object to inherit from. If \code{NULL}, don't inherit from any object.} -\item{...}{A list of members in the ggproto object.} +\item{...}{A list of members in the a_ggproto object.} \item{parent, self}{Access parent class \code{parent} of object \code{self}.} } \description{ -ggproto is inspired by the proto package, but it has some important +a_ggproto is inspired by the proto package, but it has some important differences. Notably, it cleanly supports cross-package inheritance, and has faster performance. } -\section{Calling ggproto methods}{ +\section{Calling a_ggproto methods}{ -ggproto methods can take an optional \code{self} argument: if it is present, +a_ggproto methods can take an optional \code{self} argument: if it is present, it is a regular method; if it's absent, it's a "static" method (i.e. it doesn't use any fields). -Imagine you have a ggproto object \code{Adder}, which has a +Imagine you have a a_ggproto object \code{Adder}, which has a method \code{addx = function(self, n) n + self$x}. Then, to call this function, you would use \code{Adder$addx(10)} -- the \code{self} is passed in automatically by the wrapper function. \code{self} be located anywhere @@ -44,6 +44,6 @@ in the function signature, although customarily it comes first. To explicitly call a methods in a parent, use -\code{ggproto_parent(Parent, self)}. +\code{a_ggproto_parent(Parent, self)}. } diff --git a/man/a_guide_axis.Rd b/man/a_guide_axis.Rd new file mode 100644 index 0000000000..a7418d1552 --- /dev/null +++ b/man/a_guide_axis.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guides-axis.r +\name{a_guide_axis} +\alias{a_guide_axis} +\title{Grob for axes} +\usage{ +a_guide_axis(at, a_labels, a_position = "right", a_theme) +} +\arguments{ +\item{at}{...} + +\item{a_labels}{at ticks} + +\item{a_position}{of ticks} + +\item{a_theme}{...} +} +\description{ +Grob for axes +} diff --git a/man/a_guide_colourbar.Rd b/man/a_guide_colourbar.Rd new file mode 100644 index 0000000000..54a7d25452 --- /dev/null +++ b/man/a_guide_colourbar.Rd @@ -0,0 +1,169 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guide-colorbar.r +\name{a_guide_colourbar} +\alias{a_guide_colourbar} +\alias{a_guide_colorbar} +\title{Continuous colour bar guide.} +\usage{ +a_guide_colourbar(title = waiver(), title.a_position = NULL, + title.a_theme = NULL, title.hjust = NULL, title.vjust = NULL, + a_label = TRUE, a_label.a_position = NULL, a_label.a_theme = NULL, + a_label.hjust = NULL, a_label.vjust = NULL, barwidth = NULL, + barheight = NULL, nbin = 20, raster = TRUE, ticks = TRUE, + draw.ulim = TRUE, draw.llim = TRUE, direction = NULL, + default.unit = "line", reverse = FALSE, order = 0, ...) + +a_guide_colorbar(title = waiver(), title.a_position = NULL, + title.a_theme = NULL, title.hjust = NULL, title.vjust = NULL, + a_label = TRUE, a_label.a_position = NULL, a_label.a_theme = NULL, + a_label.hjust = NULL, a_label.vjust = NULL, barwidth = NULL, + barheight = NULL, nbin = 20, raster = TRUE, ticks = TRUE, + draw.ulim = TRUE, draw.llim = TRUE, direction = NULL, + default.unit = "line", reverse = FALSE, order = 0, ...) +} +\arguments{ +\item{title}{A character string or expression indicating a title of a_guide. +If \code{NULL}, the title is not shown. By default +(\code{\link{waiver}}), the name of the scale object or the name +specified in \code{\link{labs}} is used for the title.} + +\item{title.a_position}{A character string indicating the a_position of a + title. One of "top" (default for a vertical a_guide), "bottom", "left" +(default for a horizontal a_guide), or "right."} + +\item{title.a_theme}{A theme object for rendering the title text. Usually the +object of \code{\link{a_element_text}} is expected. By default, the theme is +specified by \code{legend.title} in \code{\link{a_theme}} or theme.} + +\item{title.hjust}{A number specifying horizontal justification of the +title text.} + +\item{title.vjust}{A number specifying vertical justification of the title +text.} + +\item{a_label}{logical. If \code{TRUE} then the labels are drawn. If +\code{FALSE} then the labels are invisible.} + +\item{a_label.a_position}{A character string indicating the a_position of a +label. One of "top", "bottom" (default for horizontal a_guide), "left", or +"right" (default for vertical a_guide).} + +\item{a_label.a_theme}{A theme object for rendering the label text. Usually the +object of \code{\link{a_element_text}} is expected. By default, the theme is +specified by \code{legend.text} in \code{\link{a_theme}} or theme.} + +\item{a_label.hjust}{A numeric specifying horizontal justification of the +label text.} + +\item{a_label.vjust}{A numeric specifying vertical justification of the label +text.} + +\item{barwidth}{A numeric or a \code{\link[grid]{unit}} object specifying +the width of the colorbar. Default value is \code{legend.key.width} or +\code{legend.key.size} in \code{\link{a_theme}} or a_theme.} + +\item{barheight}{A numeric or a \code{\link[grid]{unit}} object specifying +the height of the colorbar. Default value is \code{legend.key.height} or +\code{legend.key.size} in \code{\link{a_theme}} or a_theme.} + +\item{nbin}{A numeric specifying the number of bins for drawing colorbar. A +smoother colorbar for a larger value.} + +\item{raster}{A logical. If \code{TRUE} then the colorbar is rendered as a +raster object. If \code{FALSE} then the colorbar is rendered as a set of +rectangles. Note that not all graphics devices are capable of rendering +raster image.} + +\item{ticks}{A logical specifying if tick marks on colorbar should be +visible.} + +\item{draw.ulim}{A logical specifying if the upper limit tick marks should +be visible.} + +\item{draw.llim}{A logical specifying if the lower limit tick marks should +be visible.} + +\item{direction}{A character string indicating the direction of the guide. +One of "horizontal" or "vertical."} + +\item{default.unit}{A character string indicating \code{\link[grid]{unit}} +for \code{barwidth} and \code{barheight}.} + +\item{reverse}{logical. If \code{TRUE} the colorbar is reversed. By default, +the highest value is on the top and the lowest value is on the bottom} + +\item{order}{positive integer less that 99 that specifies the order of +this guide among multiple guides. This controls the order in which +multiple guides are displayed, not the contents of the guide itself. +If 0 (default), the order is determined by a secret algorithm.} + +\item{...}{ignored.} +} +\value{ +A guide object +} +\description{ +Colour bar guide shows continuous color scales mapped onto values. +Colour bar is available with \code{a_scale_fill} and \code{a_scale_colour}. +For more information, see the inspiration for this function: +\href{http://www.mathworks.com/help/techdoc/ref/colorbar.html}{Matlab's colorbar function}. +} +\details{ +Guides can be specified in each \code{a_scale_*} or in \code{\link{a_guides}}. +\code{a_guide="legend"} in \code{a_scale_*} is syntactic sugar for +\code{a_guide=a_guide_legend()} (e.g. \code{a_scale_color_manual(a_guide = "legend")}). +As for how to specify the a_guide for each scale in more detail, +see \code{\link{a_guides}}. +} +\examples{ +df <- reshape2::melt(outer(1:4, 1:4), varnames = c("X1", "X2")) + +p1 <- a_plot(df, a_aes(X1, X2)) + a_geom_tile(a_aes(fill = value)) +p2 <- p1 + a_geom_point(a_aes(size = value)) + +# Basic form +p1 + a_scale_fill_continuous(a_guide = "colorbar") +p1 + a_scale_fill_continuous(a_guide = a_guide_colorbar()) +p1 + a_guides(fill = a_guide_colorbar()) + +# Control styles + +# bar size +p1 + a_guides(fill = a_guide_colorbar(barwidth = 0.5, barheight = 10)) + +# no a_label +p1 + a_guides(fill = a_guide_colorbar(a_label = FALSE)) + +# no tick marks +p1 + a_guides(fill = a_guide_colorbar(ticks = FALSE)) + +# a_label a_position +p1 + a_guides(fill = a_guide_colorbar(a_label.a_position = "left")) + +# a_label a_theme +p1 + a_guides(fill = a_guide_colorbar(a_label.a_theme = a_element_text(colour = "blue", angle = 0))) + +# small number of bins +p1 + a_guides(fill = a_guide_colorbar(nbin = 3)) + +# large number of bins +p1 + a_guides(fill = a_guide_colorbar(nbin = 100)) + +# make top- and bottom-most ticks invisible +p1 + a_scale_fill_continuous(limits = c(0,20), breaks = c(0, 5, 10, 15, 20), + a_guide = a_guide_colorbar(nbin=100, draw.ulim = FALSE, draw.llim = FALSE)) + +# guides can be controlled independently +p2 + + a_scale_fill_continuous(a_guide = "colorbar") + + a_scale_size(a_guide = "legend") +p2 + a_guides(fill = "colorbar", size = "legend") + +p2 + + a_scale_fill_continuous(a_guide = a_guide_colorbar(direction = "horizontal")) + + a_scale_size(a_guide = a_guide_legend(direction = "vertical")) +} +\seealso{ +Other a_guides: \code{\link{a_guide_legend}}, + \code{\link{a_guides}} +} diff --git a/man/a_guide_legend.Rd b/man/a_guide_legend.Rd new file mode 100644 index 0000000000..22b3dcdb18 --- /dev/null +++ b/man/a_guide_legend.Rd @@ -0,0 +1,176 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guide-legend.r +\name{a_guide_legend} +\alias{a_guide_legend} +\title{Legend guide.} +\usage{ +a_guide_legend(title = waiver(), title.a_position = NULL, + title.a_theme = NULL, title.hjust = NULL, title.vjust = NULL, + a_label = TRUE, a_label.a_position = NULL, a_label.a_theme = NULL, + a_label.hjust = NULL, a_label.vjust = NULL, keywidth = NULL, + keyheight = NULL, direction = NULL, default.unit = "line", + override.a_aes = list(), nrow = NULL, ncol = NULL, byrow = FALSE, + reverse = FALSE, order = 0, ...) +} +\arguments{ +\item{title}{A character string or expression indicating a title of a_guide. +If \code{NULL}, the title is not shown. By default +(\code{\link{waiver}}), the name of the scale object or the name +specified in \code{\link{labs}} is used for the title.} + +\item{title.a_position}{A character string indicating the a_position of a + title. One of "top" (default for a vertical a_guide), "bottom", "left" +(default for a horizontal a_guide), or "right."} + +\item{title.a_theme}{A theme object for rendering the title text. Usually the +object of \code{\link{a_element_text}} is expected. By default, the theme is +specified by \code{legend.title} in \code{\link{a_theme}} or theme.} + +\item{title.hjust}{A number specifying horizontal justification of the +title text.} + +\item{title.vjust}{A number specifying vertical justification of the title +text.} + +\item{a_label}{logical. If \code{TRUE} then the labels are drawn. If +\code{FALSE} then the labels are invisible.} + +\item{a_label.a_position}{A character string indicating the a_position of a +label. One of "top", "bottom" (default for horizontal a_guide), "left", or +"right" (default for vertical a_guide).} + +\item{a_label.a_theme}{A theme object for rendering the label text. Usually the +object of \code{\link{a_element_text}} is expected. By default, the theme is +specified by \code{legend.text} in \code{\link{a_theme}} or theme.} + +\item{a_label.hjust}{A numeric specifying horizontal justification of the +label text.} + +\item{a_label.vjust}{A numeric specifying vertical justification of the label +text.} + +\item{keywidth}{A numeric or a \code{\link[grid]{unit}} object specifying +the width of the legend key. Default value is \code{legend.key.width} or +\code{legend.key.size} in \code{\link{a_theme}} or theme.} + +\item{keyheight}{A numeric or a \code{\link[grid]{unit}} object specifying +the height of the legend key. Default value is \code{legend.key.height} or +\code{legend.key.size} in \code{\link{a_theme}} or theme.} + +\item{direction}{A character string indicating the direction of the guide. +One of "horizontal" or "vertical."} + +\item{default.unit}{A character string indicating \code{\link[grid]{unit}} +for \code{keywidth} and \code{keyheight}.} + +\item{override.a_aes}{A list specifying aesthetic parameters of legend key. +See details and examples.} + +\item{nrow}{The desired number of rows of legends.} + +\item{ncol}{The desired number of column of legends.} + +\item{byrow}{logical. If \code{FALSE} (the default) the legend-matrix is +filled by columns, otherwise the legend-matrix is filled by rows.} + +\item{reverse}{logical. If \code{TRUE} the order of legends is reversed.} + +\item{order}{positive integer less that 99 that specifies the order of +this guide among multiple guides. This controls the order in which +multiple guides are displayed, not the contents of the guide itself. +If 0 (default), the order is determined by a secret algorithm.} + +\item{...}{ignored.} +} +\value{ +A guide object +} +\description{ +Legend type guide shows key (i.e., geoms) mapped onto values. +Legend guides for various scales are integrated if possible. +} +\details{ +Guides can be specified in each \code{a_scale_*} or in \code{\link{a_guides}}. +\code{a_guide="legend"} in \code{a_scale_*} is syntactic sugar for +\code{a_guide=a_guide_legend()} (e.g. \code{a_scale_color_manual(a_guide = "legend")}). +As for how to specify the guide for each scale in more detail, +see \code{\link{a_guides}}. +} +\examples{ +\donttest{ +df <- reshape2::melt(outer(1:4, 1:4), varnames = c("X1", "X2")) + +p1 <- a_plot(df, a_aes(X1, X2)) + a_geom_tile(a_aes(fill = value)) +p2 <- p1 + a_geom_point(a_aes(size = value)) + +# Basic form +p1 + a_scale_fill_continuous(a_guide = "legend") +p1 + a_scale_fill_continuous(a_guide = a_guide_legend()) + +# Guide title +p1 + a_scale_fill_continuous(a_guide = a_guide_legend(title = "V")) # title text +p1 + a_scale_fill_continuous(a_guide = a_guide_legend(title = NULL)) # no title + +# Control styles + +# key size +p1 + a_guides(fill = a_guide_legend(keywidth = 3, keyheight = 1)) + +# title a_position +p1 + a_guides(fill = a_guide_legend(title = "LEFT", title.a_position = "left")) + +# title text styles via a_element_text +p1 + a_guides(fill = + a_guide_legend( + title.a_theme = a_element_text( + size = 15, + face = "italic", + colour = "red", + angle = 0 + ) + ) +) + +# label a_position +p1 + a_guides(fill = a_guide_legend(a_label.a_position = "left", a_label.hjust = 1)) + +# a_label styles +p1 + a_scale_fill_continuous(breaks = c(5, 10, 15), + a_labels = paste("long", c(5, 10, 15)), + a_guide = a_guide_legend( + direction = "horizontal", + title.a_position = "top", + a_label.a_position = "bottom", + a_label.hjust = 0.5, + a_label.vjust = 1, + a_label.a_theme = a_element_text(angle = 90) + ) +) + +# Set a_aesthetic of legend key + +# very low alpha value make it difficult to see legend key +p3 <- a_plot(diamonds, a_aes(carat, price)) + + a_geom_point(a_aes(colour = color), alpha = 1/100) +p3 + +# override.a_aes overwrites the alpha +p3 + a_guides(colour = a_guide_legend(override.a_aes = list(alpha = 1))) + +# multiple row/col legends +df <- data.frame(x = 1:20, y = 1:20, color = letters[1:20]) +p <- a_plot(df, a_aes(x, y)) + + a_geom_point(a_aes(colour = color)) +p + a_guides(col = a_guide_legend(nrow = 8)) +p + a_guides(col = a_guide_legend(ncol = 8)) +p + a_guides(col = a_guide_legend(nrow = 8, byrow = TRUE)) +p + a_guides(col = a_guide_legend(ncol = 8, byrow = TRUE)) + +# reversed order legend +p + a_guides(col = a_guide_legend(reverse = TRUE)) +} +} +\seealso{ +Other a_guides: \code{\link{a_guide_colourbar}}, + \code{\link{a_guides}} +} diff --git a/man/a_guides.Rd b/man/a_guides.Rd new file mode 100644 index 0000000000..baff1637c3 --- /dev/null +++ b/man/a_guides.Rd @@ -0,0 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guides-.r +\name{a_guides} +\alias{a_guides} +\title{Set guides for each scale.} +\usage{ +a_guides(...) +} +\arguments{ +\item{...}{List of scale guide pairs} +} +\value{ +A list containing the mapping between scale and guide. +} +\description{ +Guides for each scale can be set in call of \code{a_scale_*} with argument +\code{a_guide}, or in \code{a_guides}. +} +\examples{ +\donttest{ +# ggplot object + +dat <- data.frame(x = 1:5, y = 1:5, p = 1:5, q = factor(1:5), + r = factor(1:5)) +p <- a_plot(dat, a_aes(x, y, colour = p, size = q, shape = r)) + a_geom_point() + +# without guide specification +p + +# Show colorbar guide for colour. +# All these examples below have a same effect. + +p + a_guides(colour = "colorbar", size = "legend", shape = "legend") +p + a_guides(colour = a_guide_colorbar(), size = a_guide_legend(), + shape = a_guide_legend()) +p + + a_scale_colour_continuous(a_guide = "colorbar") + + a_scale_size_discrete(a_guide = "legend") + + a_scale_shape(a_guide = "legend") + + # Remove some a_guides + p + a_guides(colour = "none") + p + a_guides(colour = "colorbar",size = "none") + +# Guides are integrated where possible + +p + a_guides(colour = a_guide_legend("title"), size = a_guide_legend("title"), + shape = a_guide_legend("title")) +# same as +g <- a_guide_legend("title") +p + a_guides(colour = g, size = g, shape = g) + +p + a_theme(legend.a_position = "bottom") + +# a_position of guides + +p + a_theme(legend.a_position = "bottom", legend.box = "horizontal") + +# Set order for multiple a_guides +a_plot(mpg, a_aes(displ, cty)) + + a_geom_point(a_aes(size = hwy, colour = cyl, shape = drv)) + + a_guides( + colour = a_guide_colourbar(order = 1), + shape = a_guide_legend(order = 2), + size = a_guide_legend(order = 3) + ) +} +} +\seealso{ +Other a_guides: \code{\link{a_guide_colourbar}}, + \code{\link{a_guide_legend}} +} diff --git a/man/a_guides_build.Rd b/man/a_guides_build.Rd new file mode 100644 index 0000000000..fbff37d2d5 --- /dev/null +++ b/man/a_guides_build.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guides-.r +\name{a_guides_build} +\alias{a_guides_build} +\title{build up all guide boxes into one guide-boxes.} +\usage{ +a_guides_build(ggrobs, a_theme) +} +\arguments{ +\item{ggrobs}{...} + +\item{a_theme}{...} +} +\description{ +build up all guide boxes into one guide-boxes. +} diff --git a/man/a_guides_geom.Rd b/man/a_guides_geom.Rd new file mode 100644 index 0000000000..9e303a3401 --- /dev/null +++ b/man/a_guides_geom.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guides-.r +\name{a_guides_geom} +\alias{a_guides_geom} +\title{a_guides_geom function} +\usage{ +a_guides_geom(gdefs, layers, default_mapping) +} +\arguments{ +\item{gdefs}{...} + +\item{layers}{....} + +\item{default_mapping}{...} +} +\description{ +a_guides_geom function +} diff --git a/man/a_guides_merge.Rd b/man/a_guides_merge.Rd new file mode 100644 index 0000000000..3981b02c77 --- /dev/null +++ b/man/a_guides_merge.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guides-.r +\name{a_guides_merge} +\alias{a_guides_merge} +\title{merge overlapped guides} +\usage{ +a_guides_merge(gdefs) +} +\arguments{ +\item{gdefs}{...} +} +\description{ +merge overlapped guides +} diff --git a/man/a_guides_train.Rd b/man/a_guides_train.Rd new file mode 100644 index 0000000000..ee3215b669 --- /dev/null +++ b/man/a_guides_train.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guides-.r +\name{a_guides_train} +\alias{a_guides_train} +\title{train each scale in scales and generate the definition of guide} +\usage{ +a_guides_train(scales, a_theme, a_guides, a_labels) +} +\arguments{ +\item{scales}{...} + +\item{a_theme}{...} + +\item{a_guides}{...} + +\item{a_labels}{....} +} +\description{ +train each scale in scales and generate the definition of guide +} diff --git a/man/label_bquote.Rd b/man/a_label_bquote.Rd similarity index 57% rename from man/label_bquote.Rd rename to man/a_label_bquote.Rd index 6e0fa6e4f9..703d50f269 100644 --- a/man/label_bquote.Rd +++ b/man/a_label_bquote.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet-labels.r -\name{label_bquote} -\alias{label_bquote} +\name{a_label_bquote} +\alias{a_label_bquote} \title{Backquoted labeller} \usage{ -label_bquote(rows = NULL, cols = NULL, default = label_value) +a_label_bquote(rows = NULL, cols = NULL, default = a_label_value) } \arguments{ \item{rows}{Backquoted labelling expression for rows.} @@ -15,19 +15,18 @@ label_bquote(rows = NULL, cols = NULL, default = label_value) columns when no plotmath expression is provided.} } \description{ -\code{\link{label_bquote}()} offers a flexible way of labelling +\code{\link{a_label_bquote}()} offers a flexible way of labelling facet rows or columns with plotmath expressions. Backquoted variables will be replaced with their value in the facet. } \examples{ # The variables mentioned in the plotmath expression must be # backquoted and referred to by their names. -p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() -p + facet_grid(vs ~ ., labeller = label_bquote(alpha ^ .(vs))) -p + facet_grid(. ~ vs, labeller = label_bquote(cols = .(vs) ^ .(vs))) -p + facet_grid(. ~ vs + am, labeller = label_bquote(cols = .(am) ^ .(vs))) +p <- a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point() +p + ggplot2Animint:::a_facet_grid(vs ~ ., labeller = a_label_bquote(alpha ^ .(vs))) +p + ggplot2Animint:::a_facet_grid(. ~ vs, labeller = a_label_bquote(cols = .(vs) ^ .(vs))) +p + ggplot2Animint:::a_facet_grid(. ~ vs + am, labeller = a_label_bquote(cols = .(am) ^ .(vs))) } \seealso{ \link{labellers}, \code{\link{labeller}()}, } - diff --git a/man/layer.Rd b/man/a_layer.Rd similarity index 61% rename from man/layer.Rd rename to man/a_layer.Rd index 050e38ebba..64af680443 100644 --- a/man/layer.Rd +++ b/man/a_layer.Rd @@ -1,44 +1,44 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/layer.r -\name{layer} -\alias{layer} +\name{a_layer} +\alias{a_layer} \title{Create a new layer} \usage{ -layer(geom = NULL, stat = NULL, data = NULL, mapping = NULL, - position = NULL, params = list(), inherit.aes = TRUE, subset = NULL, - show.legend = NA) +a_layer(a_geom = NULL, a_stat = NULL, data = NULL, mapping = NULL, + a_position = NULL, params = list(), inherit.a_aes = TRUE, + subset = NULL, show.legend = NA) } \arguments{ -\item{geom}{The geometric object to use display the data} +\item{a_geom}{The geometric object to use display the data} -\item{stat}{The statistical transformation to use on the data for this +\item{a_stat}{The statistical transformation to use on the data for this layer, as a string.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{params}{Additional parameters to the \code{geom} and \code{stat}.} +\item{params}{Additional parameters to the \code{a_geom} and \code{a_stat}.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -52,23 +52,22 @@ layer.} } \description{ A layer is a combination of data, stat and geom with a potential position -adjustment. Usually layers are created using \code{geom_*} or \code{stat_*} +adjustment. Usually layers are created using \code{a_geom_*} or \code{a_stat_*} calls but it can also be created directly using this function. } \examples{ # geom calls are just a short cut for layer -ggplot(mpg, aes(displ, hwy)) + geom_point() +a_plot(mpg, a_aes(displ, hwy)) + a_geom_point() # shortcut for -ggplot(mpg, aes(displ, hwy)) + - layer(geom = "point", stat = "identity", position = "identity", +a_plot(mpg, a_aes(displ, hwy)) + + a_layer(a_geom = "point", a_stat = "identity", a_position = "identity", params = list(na.rm = FALSE) ) # use a function as data to plot a subset of global data -ggplot(mpg, aes(displ, hwy)) + - layer(geom = "point", stat = "identity", position = "identity", +a_plot(mpg, a_aes(displ, hwy)) + + a_layer(a_geom = "point", a_stat = "identity", a_position = "identity", data = head, params = list(na.rm = FALSE) ) } - diff --git a/man/mean_se.Rd b/man/a_mean_se.Rd similarity index 76% rename from man/mean_se.Rd rename to man/a_mean_se.Rd index b0a0d25281..c057b76d45 100644 --- a/man/mean_se.Rd +++ b/man/a_mean_se.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat-summary.r -\name{mean_se} -\alias{mean_se} +\name{a_mean_se} +\alias{a_mean_se} \title{Calculate mean and standard errors on either side.} \usage{ -mean_se(x, mult = 1) +a_mean_se(x, mult = 1) } \arguments{ \item{x}{numeric vector} @@ -15,6 +15,5 @@ mean_se(x, mult = 1) Calculate mean and standard errors on either side. } \seealso{ -for use with \code{\link{stat_summary}} +for use with \code{\link{a_stat_summary}} } - diff --git a/man/ggplot.Rd b/man/a_plot.Rd similarity index 60% rename from man/ggplot.Rd rename to man/a_plot.Rd index a6554ea846..1c6bf0001e 100644 --- a/man/ggplot.Rd +++ b/man/a_plot.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.r -\name{ggplot} -\alias{ggplot} -\alias{ggplot.data.frame} -\alias{ggplot.default} -\title{Create a new ggplot plot.} +\name{a_plot} +\alias{a_plot} +\alias{a_plot.default} +\alias{a_plot.data.frame} +\title{Create a new a_plot plot.} \usage{ -ggplot(data = NULL, mapping = aes(), ..., environment = parent.frame()) +a_plot(data = NULL, mapping = a_aes(), ..., environment = parent.frame()) } \arguments{ \item{data}{Default dataset to use for plot. If not already a data.frame, -will be converted to one by \code{\link{fortify}}. If not specified, +will be converted to one by \code{\link{a_fortify}}. If not specified, must be suppled in each layer added to the plot.} \item{mapping}{Default list of aesthetic mappings to use for plot. @@ -19,28 +19,28 @@ If not specified, must be suppled in each layer added to the plot.} \item{...}{Other arguments passed on to methods. Not currently used.} \item{environment}{If an variable defined in the aesthetic mapping is not -found in the data, ggplot will look for it in this environment. It defaults -to using the environment in which \code{ggplot()} is called.} +found in the data, a_plot will look for it in this environment. It defaults +to using the environment in which \code{a_plot()} is called.} } \description{ -\code{ggplot()} initializes a ggplot object. It can be used to +\code{a_plot()} initializes a a_plot object. It can be used to declare the input data frame for a graphic and to specify the set of plot aesthetics intended to be common throughout all subsequent layers unless specifically overridden. } \details{ -\code{ggplot()} is typically used to construct a plot +\code{a_plot()} is typically used to construct a plot incrementally, using the + operator to add layers to the -existing ggplot object. This is advantageous in that the +existing a_plot object. This is advantageous in that the code is explicit about which layers are added and the order in which they are added. For complex graphics with multiple -layers, initialization with \code{ggplot} is recommended. +layers, initialization with \code{a_plot} is recommended. -There are three common ways to invoke \code{ggplot}: +There are three common ways to invoke \code{a_plot}: \itemize{ - \item \code{ggplot(df, aes(x, y, ))} - \item \code{ggplot(df)} - \item \code{ggplot()} + \item \code{a_plot(df, a_aes(x, y, ))} + \item \code{a_plot(df)} + \item \code{a_plot()} } The first method is recommended if all layers use the same data and the same set of aesthetics, although this method @@ -50,7 +50,7 @@ method specifies the default data frame to use for the plot, but no aesthetics are defined up front. This is useful when one data frame is used predominantly as layers are added, but the aesthetics may vary from one layer to another. The -third method initializes a skeleton \code{ggplot} object which +third method initializes a skeleton \code{a_plot} object which is fleshed out as layers are added. This method is useful when multiple data frames are used to produce different layers, as is often the case in complex graphics. @@ -63,27 +63,26 @@ ds <- plyr::ddply(df, "gp", plyr::summarise, mean = mean(y), sd = sd(y)) # Declare the data frame and common aesthetics. # The summary data frame ds is used to plot -# larger red points in a second geom_point() layer. +# larger red points in a second a_geom_point() layer. # If the data = argument is not specified, it uses the -# declared data frame from ggplot(); ditto for the aesthetics. -ggplot(df, aes(x = gp, y = y)) + - geom_point() + - geom_point(data = ds, aes(y = mean), +# declared data frame from a_plot(); ditto for the aesthetics. +a_plot(df, a_aes(x = gp, y = y)) + + a_geom_point() + + a_geom_point(data = ds, a_aes(y = mean), colour = 'red', size = 3) -# Same plot as above, declaring only the data frame in ggplot(). +# Same plot as above, declaring only the data frame in a_plot(). # Note how the x and y aesthetics must now be declared in -# each geom_point() layer. -ggplot(df) + - geom_point(aes(x = gp, y = y)) + - geom_point(data = ds, aes(x = gp, y = mean), +# each a_geom_point() layer. +a_plot(df) + + a_geom_point(a_aes(x = gp, y = y)) + + a_geom_point(data = ds, a_aes(x = gp, y = mean), colour = 'red', size = 3) -# Set up a skeleton ggplot object and add layers: -ggplot() + - geom_point(data = df, aes(x = gp, y = y)) + - geom_point(data = ds, aes(x = gp, y = mean), +# Set up a skeleton a_plot object and add layers: +a_plot() + + a_geom_point(data = df, a_aes(x = gp, y = y)) + + a_geom_point(data = ds, a_aes(x = gp, y = mean), colour = 'red', size = 3) + - geom_errorbar(data = ds, aes(x = gp, y = mean, + a_geom_errorbar(data = ds, a_aes(x = gp, y = mean, ymin = mean - sd, ymax = mean + sd), colour = 'red', width = 0.4) } - diff --git a/man/ggplot_build.Rd b/man/a_plot_build.Rd similarity index 53% rename from man/ggplot_build.Rd rename to man/a_plot_build.Rd index 0d6f3a6c40..721304df89 100644 --- a/man/ggplot_build.Rd +++ b/man/a_plot_build.Rd @@ -1,38 +1,37 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot-build.r -\name{ggplot_build} -\alias{ggplot_build} -\alias{layer_data} -\alias{layer_grob} -\alias{layer_scales} -\title{Build ggplot for rendering.} +\name{a_plot_build} +\alias{a_plot_build} +\alias{a_layer_data} +\alias{a_layer_scales} +\alias{a_layer_grob} +\title{Build a_plot for rendering.} \usage{ -ggplot_build(plot) +a_plot_build(plot) -layer_data(plot, i = 1L) +a_layer_data(plot, i = 1L) -layer_scales(plot, i = 1L, j = 1L) +a_layer_scales(plot, i = 1L, j = 1L) -layer_grob(plot, i = 1L) +a_layer_grob(plot, i = 1L) } \arguments{ -\item{plot}{ggplot object} +\item{plot}{a_plot object} } \description{ -\code{ggplot_build} takes the plot object, and performs all steps necessary +\code{a_plot_build} takes the plot object, and performs all steps necessary to produce an object that can be rendered. This function outputs two pieces: a list of data frames (one for each layer), and a panel object, which contain all information about axis limits, breaks etc. } \details{ -\code{layer_data}, \code{layer_grob}, and \code{layer_scales} are helper +\code{a_layer_data}, \code{a_layer_grob}, and \code{a_layer_scales} are helper functions that returns the data, grob, or scales associated with a given layer. These are useful for tests. } \seealso{ -\code{\link{print.ggplot}} and \code{\link{benchplot}} for +\code{\link{print.a_plot}} and \code{\link{a_benchplot}} for functions that contain the complete set of steps for generating - a ggplot2 plot. + a a_plot2 plot. } \keyword{internal} - diff --git a/man/ggplot_gtable.Rd b/man/a_plot_gtable.Rd similarity index 77% rename from man/ggplot_gtable.Rd rename to man/a_plot_gtable.Rd index 6248f3aa86..345d9a9775 100644 --- a/man/ggplot_gtable.Rd +++ b/man/a_plot_gtable.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot-build.r -\name{ggplot_gtable} -\alias{ggplot_gtable} +\name{a_plot_gtable} +\alias{a_plot_gtable} \title{Build a plot with all the usual bits and pieces.} \usage{ -ggplot_gtable(data) +a_plot_gtable(data) } \arguments{ -\item{data}{plot data generated by \code{\link{ggplot_build}}} +\item{data}{plot data generated by \code{\link{a_plot_build}}} \item{plot}{plot object} } @@ -22,9 +22,8 @@ to (e.g.) make the legend box 2 cm wide, or combine multiple plots into a single display, preserving aspect ratios across the plots. } \seealso{ -\code{\link{print.ggplot}} and \code{link{benchplot}} for +\code{\link{print.a_plot}} and \code{link{a_benchplot}} for for functions that contain the complete set of steps for generating - a ggplot2 plot. + a a_plot2 plot. } \keyword{internal} - diff --git a/man/a_position_dodge.Rd b/man/a_position_dodge.Rd new file mode 100644 index 0000000000..c35492000f --- /dev/null +++ b/man/a_position_dodge.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/position-dodge.r +\name{a_position_dodge} +\alias{a_position_dodge} +\title{Adjust position by dodging overlaps to the side.} +\usage{ +a_position_dodge(width = NULL) +} +\arguments{ +\item{width}{Dodging width, when different to the width of the individual +elements. This is useful when you want to align narrow geoms with wider +geoms. See the examples for a use case.} +} +\description{ +Adjust position by dodging overlaps to the side. +} +\examples{ +a_plot(mtcars, a_aes(factor(cyl), fill = factor(vs))) + + a_geom_bar(a_position = "dodge") +\donttest{ +a_plot(diamonds, a_aes(price, fill = cut)) + + a_geom_histogram(a_position="dodge") +# see ?a_geom_boxplot and ?a_geom_bar for more examples + +# To dodge items with different widths, you need to be explicit +df <- data.frame(x = c("a","a","b","b"), y = 2:5, g = rep(1:2, 2)) +p <- a_plot(df, a_aes(x, y, group = g)) + + a_geom_bar( + a_stat = "identity", a_position = "dodge", + fill = "grey50", colour = "black" + ) +p + +# A line range has no width: +p + a_geom_linerange(a_aes(ymin = y-1, ymax = y+1), a_position = "dodge") +# You need to explicitly specify the width for dodging +p + a_geom_linerange(a_aes(ymin = y-1, ymax = y+1), + a_position = a_position_dodge(width = 0.9)) + +# Similarly with error bars: +p + a_geom_errorbar(a_aes(ymin = y-1, ymax = y+1), width = 0.2, + a_position = "dodge") +p + a_geom_errorbar(a_aes(ymin = y-1, ymax = y+1, width = 0.2), + a_position = a_position_dodge(width = 0.90)) +} +} +\seealso{ +Other position adjustments: \code{\link{a_position_fill}}, + \code{\link{a_position_identity}}, + \code{\link{a_position_jitterdodge}}, + \code{\link{a_position_jitter}}, + \code{\link{a_position_nudge}} +} diff --git a/man/a_position_identity.Rd b/man/a_position_identity.Rd new file mode 100644 index 0000000000..fc3c356179 --- /dev/null +++ b/man/a_position_identity.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/position-identity.r +\name{a_position_identity} +\alias{a_position_identity} +\title{Don't adjust position} +\usage{ +a_position_identity() +} +\description{ +Don't adjust position +} +\seealso{ +Other position adjustments: \code{\link{a_position_dodge}}, + \code{\link{a_position_fill}}, + \code{\link{a_position_jitterdodge}}, + \code{\link{a_position_jitter}}, + \code{\link{a_position_nudge}} +} diff --git a/man/position_jitter.Rd b/man/a_position_jitter.Rd similarity index 59% rename from man/position_jitter.Rd rename to man/a_position_jitter.Rd index 8676fbd24b..21bdad6e57 100644 --- a/man/position_jitter.Rd +++ b/man/a_position_jitter.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/position-jitter.r -\name{position_jitter} -\alias{position_jitter} +\name{a_position_jitter} +\alias{a_position_jitter} \title{Jitter points to avoid overplotting.} \usage{ -position_jitter(width = NULL, height = NULL) +a_position_jitter(width = NULL, height = NULL) } \arguments{ \item{width, height}{Amount of vertical and horizontal jitter. The jitter @@ -20,29 +20,28 @@ position_jitter(width = NULL, height = NULL) Jitter points to avoid overplotting. } \examples{ -ggplot(mtcars, aes(am, vs)) + geom_point() +a_plot(mtcars, a_aes(am, vs)) + a_geom_point() # Default amount of jittering will generally be too much for # small datasets: -ggplot(mtcars, aes(am, vs)) + geom_jitter() +a_plot(mtcars, a_aes(am, vs)) + a_geom_jitter() # Two ways to override -ggplot(mtcars, aes(am, vs)) + - geom_jitter(width = 0.1, height = 0.1) -ggplot(mtcars, aes(am, vs)) + - geom_jitter(position = position_jitter(width = 0.1, height = 0.1)) +a_plot(mtcars, a_aes(am, vs)) + + a_geom_jitter(width = 0.1, height = 0.1) +a_plot(mtcars, a_aes(am, vs)) + + a_geom_jitter(a_position = a_position_jitter(width = 0.1, height = 0.1)) # The default works better for large datasets, where it will # take up as much space as a boxplot or a bar -ggplot(mpg, aes(class, hwy)) + - geom_jitter() + - geom_boxplot() +a_plot(mpg, a_aes(class, hwy)) + + a_geom_jitter() + + a_geom_boxplot() } \seealso{ -Other position adjustments: \code{\link{position_dodge}}, - \code{\link{position_fill}}, - \code{\link{position_identity}}, - \code{\link{position_jitterdodge}}, - \code{\link{position_nudge}} +Other position adjustments: \code{\link{a_position_dodge}}, + \code{\link{a_position_fill}}, + \code{\link{a_position_identity}}, + \code{\link{a_position_jitterdodge}}, + \code{\link{a_position_nudge}} } - diff --git a/man/position_jitterdodge.Rd b/man/a_position_jitterdodge.Rd similarity index 51% rename from man/position_jitterdodge.Rd rename to man/a_position_jitterdodge.Rd index c792ccfb96..507836796f 100644 --- a/man/position_jitterdodge.Rd +++ b/man/a_position_jitterdodge.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/position-jitterdodge.R -\name{position_jitterdodge} -\alias{position_jitterdodge} +\name{a_position_jitterdodge} +\alias{a_position_jitterdodge} \title{Adjust position by simultaneously dodging and jittering} \usage{ -position_jitterdodge(jitter.width = NULL, jitter.height = 0, +a_position_jitterdodge(jitter.width = NULL, jitter.height = 0, dodge.width = 0.75) } \arguments{ @@ -14,24 +14,23 @@ resolution of the data.} \item{jitter.height}{degree of jitter in y direction. Defaults to 0.} \item{dodge.width}{the amount to dodge in the x direction. Defaults to 0.75, -the default \code{position_dodge()} width.} +the default \code{a_position_dodge()} width.} } \description{ This is primarily used for aligning points generated through -\code{geom_point()} with dodged boxplots (e.g., a \code{geom_boxplot()} with +\code{a_geom_point()} with dodged boxplots (e.g., a \code{a_geom_boxplot()} with a fill aesthetic supplied). } \examples{ dsub <- diamonds[ sample(nrow(diamonds), 1000), ] -ggplot(dsub, aes(x = cut, y = carat, fill = clarity)) + - geom_boxplot(outlier.size = 0) + - geom_point(pch = 21, position = position_jitterdodge()) +a_plot(dsub, a_aes(x = cut, y = carat, fill = clarity)) + + a_geom_boxplot(outlier.size = 0) + + a_geom_point(pch = 21, a_position = a_position_jitterdodge()) } \seealso{ -Other position adjustments: \code{\link{position_dodge}}, - \code{\link{position_fill}}, - \code{\link{position_identity}}, - \code{\link{position_jitter}}, - \code{\link{position_nudge}} +Other position adjustments: \code{\link{a_position_dodge}}, + \code{\link{a_position_fill}}, + \code{\link{a_position_identity}}, + \code{\link{a_position_jitter}}, + \code{\link{a_position_nudge}} } - diff --git a/man/a_position_nudge.Rd b/man/a_position_nudge.Rd new file mode 100644 index 0000000000..ea90287133 --- /dev/null +++ b/man/a_position_nudge.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/position-nudge.R +\name{a_position_nudge} +\alias{a_position_nudge} +\title{Nudge points.} +\usage{ +a_position_nudge(x = 0, y = 0) +} +\arguments{ +\item{x, y}{Amount of vertical and horizontal distance to move.} +} +\description{ +This is useful if you want to nudge labels a little ways from their +points. +} +\examples{ +df <- data.frame( + x = c(1,3,2,5), + y = c("a","c","d","c") +) + +a_plot(df, a_aes(x, y)) + + a_geom_point() + + a_geom_text(a_aes(a_label = y)) + +a_plot(df, a_aes(x, y)) + + a_geom_point() + + a_geom_text(a_aes(a_label = y), a_position = a_position_nudge(y = -0.1)) +} +\seealso{ +Other position adjustments: \code{\link{a_position_dodge}}, + \code{\link{a_position_fill}}, + \code{\link{a_position_identity}}, + \code{\link{a_position_jitterdodge}}, + \code{\link{a_position_jitter}} +} diff --git a/man/a_position_stack.Rd b/man/a_position_stack.Rd new file mode 100644 index 0000000000..494093e4df --- /dev/null +++ b/man/a_position_stack.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/position-fill.r, R/position-stack.r +\name{a_position_fill} +\alias{a_position_fill} +\alias{a_position_stack} +\title{Stack overlapping objects on top of one another.} +\usage{ +a_position_fill() + +a_position_stack() +} +\description{ +\code{a_position_fill} additionally standardises each stack to have unit +height. +} +\examples{ +# Stacking is the default behaviour for most area plots: +a_plot(mtcars, a_aes(factor(cyl), fill = factor(vs))) + a_geom_bar() +# Fill makes it easier to compare proportions +a_plot(mtcars, a_aes(factor(cyl), fill = factor(vs))) + + a_geom_bar(a_position = "fill") + +# To change stacking order, use factor() to change order of levels +mtcars$vs <- factor(mtcars$vs, levels = c(1,0)) +a_plot(mtcars, a_aes(factor(cyl), fill = factor(vs))) + a_geom_bar() + +a_plot(diamonds, a_aes(price, fill = cut)) + + a_geom_histogram(binwidth = 500) +# When used with a histogram, a_position_fill creates a conditional density +# estimate +a_plot(diamonds, a_aes(price, fill = cut)) + + a_geom_histogram(binwidth = 500, a_position = "fill") + +# Stacking is also useful for time series +data.set <- data.frame( + Time = c(rep(1, 4),rep(2, 4), rep(3, 4), rep(4, 4)), + Type = rep(c('a', 'b', 'c', 'd'), 4), + Value = rpois(16, 10) +) + +a_plot(data.set, a_aes(Time, Value)) + a_geom_area(a_aes(fill = Type)) + +# If you want to stack lines, you need to say so: +a_plot(data.set, a_aes(Time, Value)) + a_geom_line(a_aes(colour = Type)) +a_plot(data.set, a_aes(Time, Value)) + + a_geom_line(a_position = "stack", a_aes(colour = Type)) + +# But realise that this makes it *much* harder to compare individual +# trends +} +\seealso{ +See \code{\link{a_geom_bar}} and \code{\link{a_geom_area}} for + more examples. + +Other position adjustments: \code{\link{a_position_dodge}}, + \code{\link{a_position_identity}}, + \code{\link{a_position_jitterdodge}}, + \code{\link{a_position_jitter}}, + \code{\link{a_position_nudge}} +} diff --git a/man/a_resolution.Rd b/man/a_resolution.Rd new file mode 100644 index 0000000000..dc21b25d0c --- /dev/null +++ b/man/a_resolution.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-resolution.r +\name{a_resolution} +\alias{a_resolution} +\title{Compute the "a_resolution" of a data vector.} +\usage{ +a_resolution(x, zero = TRUE) +} +\arguments{ +\item{x}{numeric vector} + +\item{zero}{should a zero value be automatically included in the +computation of a_resolution} +} +\description{ +The a_resolution is is the smallest non-zero distance between adjacent +values. If there is only one unique value, then the a_resolution is defined +to be one. +} +\details{ +If x is an integer vector, then it is assumed to represent a discrete +variable, and the a_resolution is 1. +} +\examples{ +a_resolution(1:10) +a_resolution((1:10) - 0.5) +a_resolution((1:10) - 0.5, FALSE) +a_resolution(c(1,2, 10, 20, 50)) +a_resolution(as.integer(c(1, 10, 20, 50))) # Returns 1 +} diff --git a/man/a_scale_alpha.Rd b/man/a_scale_alpha.Rd new file mode 100644 index 0000000000..311159ad8c --- /dev/null +++ b/man/a_scale_alpha.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-alpha.r +\name{a_scale_alpha} +\alias{a_scale_alpha} +\alias{a_scale_alpha_continuous} +\alias{a_scale_alpha_discrete} +\title{Alpha scales.} +\usage{ +a_scale_alpha(..., range = c(0.1, 1)) + +a_scale_alpha_continuous(..., range = c(0.1, 1)) + +a_scale_alpha_discrete(..., range = c(0.1, 1)) +} +\arguments{ +\item{...}{Other arguments passed on to \code{\link{continuous_a_scale}} +or \code{\link{discrete_a_scale}} as appropriate, to control name, limits, +breaks, labels and so forth.} + +\item{range}{range of output alpha values. Should lie between 0 and 1.} +} +\description{ +\code{a_scale_alpha} is an alias for \code{a_scale_alpha_continuous} since +that is the most common use of alpha, and it saves a bit of typing. +} +\examples{ +(p <- a_plot(mtcars, a_aes(mpg, cyl)) + + a_geom_point(a_aes(alpha = cyl))) +p + a_scale_alpha("cylinders") +p + a_scale_alpha("number\\nof\\ncylinders") + +p + a_scale_alpha(range = c(0.4, 0.8)) + +(p <- a_plot(mtcars, a_aes(mpg, cyl)) + + a_geom_point(a_aes(alpha = factor(cyl)))) +p + a_scale_alpha_discrete(range = c(0.4, 0.8)) +} diff --git a/man/scale_brewer.Rd b/man/a_scale_brewer.Rd similarity index 63% rename from man/scale_brewer.Rd rename to man/a_scale_brewer.Rd index 8814fb726e..f7584fe688 100644 --- a/man/scale_brewer.Rd +++ b/man/a_scale_brewer.Rd @@ -1,28 +1,28 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-brewer.r, R/zxx.r -\name{scale_colour_brewer} -\alias{scale_color_brewer} -\alias{scale_color_distiller} -\alias{scale_colour_brewer} -\alias{scale_colour_distiller} -\alias{scale_fill_brewer} -\alias{scale_fill_distiller} +\name{a_scale_colour_brewer} +\alias{a_scale_colour_brewer} +\alias{a_scale_fill_brewer} +\alias{a_scale_colour_distiller} +\alias{a_scale_fill_distiller} +\alias{a_scale_color_brewer} +\alias{a_scale_color_distiller} \title{Sequential, diverging and qualitative colour scales from colorbrewer.org} \usage{ -scale_colour_brewer(..., type = "seq", palette = 1, direction = 1) +a_scale_colour_brewer(..., type = "seq", palette = 1, direction = 1) -scale_fill_brewer(..., type = "seq", palette = 1, direction = 1) +a_scale_fill_brewer(..., type = "seq", palette = 1, direction = 1) -scale_colour_distiller(..., type = "seq", palette = 1, direction = -1, +a_scale_colour_distiller(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", - guide = "colourbar") + a_guide = "colourbar") -scale_fill_distiller(..., type = "seq", palette = 1, direction = -1, +a_scale_fill_distiller(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", - guide = "colourbar") + a_guide = "colourbar") } \arguments{ -\item{...}{Other arguments passed on to \code{\link{discrete_scale}} +\item{...}{Other arguments passed on to \code{\link{discrete_a_scale}} to control name, limits, breaks, labels and so forth.} \item{type}{One of seq (sequential), div (diverging) or qual (qualitative)} @@ -44,7 +44,7 @@ other values are deprecated.} \item{na.value}{Colour to use for missing values} -\item{guide}{Type of legend. Use \code{"colourbar"} for continuous +\item{a_guide}{Type of legend. Use \code{"colourbar"} for continuous colour bar, or \code{"legend"} for discrete colour legend.} } \description{ @@ -68,42 +68,42 @@ The following palettes are available for use with these scales: OrRd, PuBu, PuBuGn, PuRd, Purples, RdPu, Reds, YlGn, YlGnBu, YlOrBr, YlOrRd} } } + \examples{ dsamp <- diamonds[sample(nrow(diamonds), 1000), ] -(d <- ggplot(dsamp, aes(carat, price)) + - geom_point(aes(colour = clarity))) +(d <- a_plot(dsamp, a_aes(carat, price)) + + a_geom_point(a_aes(colour = clarity))) # Change scale label -d + scale_colour_brewer() -d + scale_colour_brewer("Diamond\\nclarity") +d + a_scale_colour_brewer() +d + a_scale_colour_brewer("Diamond\\nclarity") # Select brewer palette to use, see ?scales::brewer_pal for more details -d + scale_colour_brewer(palette = "Greens") -d + scale_colour_brewer(palette = "Set1") +d + a_scale_colour_brewer(palette = "Greens") +d + a_scale_colour_brewer(palette = "Set1") \donttest{ -# scale_fill_brewer works just the same as -# scale_colour_brewer but for fill colours -p <- ggplot(diamonds, aes(x = price, fill = cut)) + - geom_histogram(position = "dodge", binwidth = 1000) -p + scale_fill_brewer() +# a_scale_fill_brewer works just the same as +# a_scale_colour_brewer but for fill colours +p <- a_plot(diamonds, a_aes(x = price, fill = cut)) + + a_geom_histogram(a_position = "dodge", binwidth = 1000) +p + a_scale_fill_brewer() # the order of colour can be reversed -p + scale_fill_brewer(direction = -1) +p + a_scale_fill_brewer(direction = -1) # the brewer scales look better on a darker background -p + scale_fill_brewer(direction = -1) + theme_dark() +p + a_scale_fill_brewer(direction = -1) + a_theme_dark() } # Use distiller variant with continous data -v <- ggplot(faithfuld) + - geom_tile(aes(waiting, eruptions, fill = density)) +v <- a_plot(faithfuld) + + a_geom_tile(a_aes(waiting, eruptions, fill = density)) v -v + scale_fill_distiller() -v + scale_fill_distiller(palette = "Spectral") +v + a_scale_fill_distiller() +v + a_scale_fill_distiller(palette = "Spectral") } \seealso{ Other colour scales: - \code{\link{scale_colour_gradient}}, - \code{\link{scale_colour_grey}}, - \code{\link{scale_colour_hue}} + \code{\link{a_scale_colour_gradient}}, + \code{\link{a_scale_colour_grey}}, + \code{\link{a_scale_colour_hue}} } - diff --git a/man/scale_continuous.Rd b/man/a_scale_continuous.Rd similarity index 62% rename from man/scale_continuous.Rd rename to man/a_scale_continuous.Rd index 9602800846..8972b88680 100644 --- a/man/scale_continuous.Rd +++ b/man/a_scale_continuous.Rd @@ -1,38 +1,38 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-continuous.r -\name{scale_continuous} -\alias{scale_continuous} -\alias{scale_x_continuous} -\alias{scale_x_log10} -\alias{scale_x_reverse} -\alias{scale_x_sqrt} -\alias{scale_y_continuous} -\alias{scale_y_log10} -\alias{scale_y_reverse} -\alias{scale_y_sqrt} +\name{a_scale_continuous} +\alias{a_scale_continuous} +\alias{a_scale_x_continuous} +\alias{a_scale_y_continuous} +\alias{a_scale_x_log10} +\alias{a_scale_y_log10} +\alias{a_scale_x_reverse} +\alias{a_scale_y_reverse} +\alias{a_scale_x_sqrt} +\alias{a_scale_y_sqrt} \title{Continuous position scales (x & y).} \usage{ -scale_x_continuous(name = waiver(), breaks = waiver(), - minor_breaks = waiver(), labels = waiver(), limits = NULL, +a_scale_x_continuous(name = waiver(), breaks = waiver(), + minor_breaks = waiver(), a_labels = waiver(), limits = NULL, expand = waiver(), oob = censor, na.value = NA_real_, trans = "identity") -scale_y_continuous(name = waiver(), breaks = waiver(), - minor_breaks = waiver(), labels = waiver(), limits = NULL, +a_scale_y_continuous(name = waiver(), breaks = waiver(), + minor_breaks = waiver(), a_labels = waiver(), limits = NULL, expand = waiver(), oob = censor, na.value = NA_real_, trans = "identity") -scale_x_log10(...) +a_scale_x_log10(...) -scale_y_log10(...) +a_scale_y_log10(...) -scale_x_reverse(...) +a_scale_x_reverse(...) -scale_y_reverse(...) +a_scale_y_reverse(...) -scale_x_sqrt(...) +a_scale_x_sqrt(...) -scale_y_sqrt(...) +a_scale_y_sqrt(...) } \arguments{ \item{name}{The name of the scale. Used as axis or legend title. If @@ -56,7 +56,7 @@ mapping used for that aesthetic.} \item A function that given the limits returns a vector of minor breaks. }} -\item{labels}{One of: \itemize{ +\item{a_labels}{One of: \itemize{ \item \code{NULL} for no labels \item \code{waiver()} for the default labels computed by the transformation object @@ -90,30 +90,30 @@ discrete variables.} \code{\link[scales]{boxcox_trans}}. You can create your own transformation with \code{\link[scales]{trans_new}}.} -\item{...}{Other arguments passed on to \code{scale_(x|y)_continuous}} +\item{...}{Other arguments passed on to \code{a_scale_(x|y)_continuous}} } \description{ -\code{scale_x_continuous} and \code{scale_y_continuous} are the key functions. -The others, \code{scale_x_log10}, \code{scale_y_sqrt} etc, are aliases +\code{a_scale_x_continuous} and \code{a_scale_y_continuous} are the key functions. +The others, \code{a_scale_x_log10}, \code{a_scale_y_sqrt} etc, are aliases that set the \code{trans} argument to commonly used transformations. } \examples{ \donttest{ if (require(ggplot2movies)) { -m <- ggplot(subset(movies, votes > 1000), aes(rating, votes)) + - geom_point(na.rm = TRUE) +m <- a_plot(subset(movies, votes > 1000), a_aes(rating, votes)) + + a_geom_point(na.rm = TRUE) m # Manipulating the default position scales lets you: # * change the axis labels -m + scale_y_continuous("number of votes") -m + scale_y_continuous(quote(votes ^ alpha)) +m + a_scale_y_continuous("number of votes") +m + a_scale_y_continuous(quote(votes ^ alpha)) # * modify the axis limits -m + scale_y_continuous(limits = c(0, 5000)) -m + scale_y_continuous(limits = c(1000, 10000)) -m + scale_x_continuous(limits = c(7, 8)) +m + a_scale_y_continuous(limits = c(0, 5000)) +m + a_scale_y_continuous(limits = c(1000, 10000)) +m + a_scale_x_continuous(limits = c(7, 8)) # you can also use the short hand functions xlim and ylim m + ylim(0, 5000) @@ -121,18 +121,18 @@ m + ylim(1000, 10000) m + xlim(7, 8) # * choose where the ticks appear -m + scale_x_continuous(breaks = 1:10) -m + scale_x_continuous(breaks = c(1,3,7,9)) +m + a_scale_x_continuous(breaks = 1:10) +m + a_scale_x_continuous(breaks = c(1,3,7,9)) # * manually label the ticks -m + scale_x_continuous(breaks = c(2,5,8), labels = c("two", "five", "eight")) -m + scale_x_continuous(breaks = c(2,5,8), labels = c("horrible", "ok", "awesome")) -m + scale_x_continuous(breaks = c(2,5,8), labels = expression(Alpha, Beta, Omega)) +m + a_scale_x_continuous(breaks = c(2,5,8), a_labels = c("two", "five", "eight")) +m + a_scale_x_continuous(breaks = c(2,5,8), a_labels = c("horrible", "ok", "awesome")) +m + a_scale_x_continuous(breaks = c(2,5,8), a_labels = expression(Alpha, Beta, Omega)) # There are a few built in transformation that you can use: -m + scale_y_log10() -m + scale_y_sqrt() -m + scale_y_reverse() +m + a_scale_y_log10() +m + a_scale_y_sqrt() +m + a_scale_y_reverse() # You can also create your own and supply them to the trans argument. # See ?scales::trans_new @@ -142,28 +142,27 @@ df <- data.frame( x = rnorm(10) * 100000, y = seq(0, 1, length.out = 10) ) -p <- ggplot(df, aes(x, y)) + geom_point() -p + scale_y_continuous(labels = scales::percent) -p + scale_y_continuous(labels = scales::dollar) -p + scale_x_continuous(labels = scales::comma) +p <- a_plot(df, a_aes(x, y)) + a_geom_point() +p + a_scale_y_continuous(a_labels = scales::percent) +p + a_scale_y_continuous(a_labels = scales::dollar) +p + a_scale_x_continuous(a_labels = scales::comma) # Other shortcut functions -ggplot(movies, aes(rating, votes)) + - geom_point() + +a_plot(movies, a_aes(rating, votes)) + + a_geom_point() + ylim(1e4, 5e4) # * axis labels -ggplot(movies, aes(rating, votes)) + - geom_point() + +a_plot(movies, a_aes(rating, votes)) + + a_geom_point() + labs(x = "My x axis", y = "My y axis") # * log scaling -ggplot(movies, aes(rating, votes)) + - geom_point() + - scale_x_log10() + - scale_y_log10() +a_plot(movies, a_aes(rating, votes)) + + a_geom_point() + + a_scale_x_log10() + + a_scale_y_log10() } } } \seealso{ -\code{\link{scale_date}} for date/time position scales. +\code{\link{a_scale_date}} for date/time position scales. } - diff --git a/man/scale_date.Rd b/man/a_scale_date.Rd similarity index 70% rename from man/scale_date.Rd rename to man/a_scale_date.Rd index cc759646b0..8afdd33d97 100644 --- a/man/scale_date.Rd +++ b/man/a_scale_date.Rd @@ -1,28 +1,28 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-date.r -\name{scale_date} -\alias{scale_date} -\alias{scale_x_date} -\alias{scale_x_datetime} -\alias{scale_y_date} -\alias{scale_y_datetime} +\name{a_scale_date} +\alias{a_scale_date} +\alias{a_scale_x_date} +\alias{a_scale_y_date} +\alias{a_scale_x_datetime} +\alias{a_scale_y_datetime} \title{Position scale, date & date times} \usage{ -scale_x_date(name = waiver(), breaks = waiver(), date_breaks = waiver(), - labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), +a_scale_x_date(name = waiver(), breaks = waiver(), date_breaks = waiver(), + a_labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), limits = NULL, expand = waiver()) -scale_y_date(name = waiver(), breaks = waiver(), date_breaks = waiver(), - labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), +a_scale_y_date(name = waiver(), breaks = waiver(), date_breaks = waiver(), + a_labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), limits = NULL, expand = waiver()) -scale_x_datetime(name = waiver(), breaks = waiver(), - date_breaks = waiver(), labels = waiver(), date_labels = waiver(), +a_scale_x_datetime(name = waiver(), breaks = waiver(), + date_breaks = waiver(), a_labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), limits = NULL, expand = waiver()) -scale_y_datetime(name = waiver(), breaks = waiver(), - date_breaks = waiver(), labels = waiver(), date_labels = waiver(), +a_scale_y_datetime(name = waiver(), breaks = waiver(), + date_breaks = waiver(), a_labels = waiver(), date_labels = waiver(), minor_breaks = waiver(), date_minor_breaks = waiver(), limits = NULL, expand = waiver()) } @@ -44,7 +44,7 @@ mapping used for that aesthetic.} weeks", or "10 years". If both \code{breaks} and \code{date_breaks} are specified, \code{date_breaks} wins.} -\item{labels}{One of: \itemize{ +\item{a_labels}{One of: \itemize{ \item \code{NULL} for no labels \item \code{waiver()} for the default labels computed by the transformation object @@ -54,7 +54,7 @@ specified, \code{date_breaks} wins.} }} \item{date_labels}{A string giving the formatting specification for the -labels. Codes are defined in \code{\link{strftime}}. If both \code{labels} +labels. Codes are defined in \code{\link{strftime}}. If both \code{a_labels} and \code{date_labels} are specified, \code{date_labels} wins.} \item{minor_breaks}{One of: \itemize{ @@ -79,8 +79,8 @@ placed some distance away from the axes. The defaults are discrete variables.} } \description{ -Use \code{scale_*_date} with \code{Date} variables, and -\code{scale_*_datetime} with \code{POSIXct} variables. +Use \code{a_scale_*_date} with \code{Date} variables, and +\code{a_scale_*_datetime} with \code{POSIXct} variables. } \examples{ last_month <- Sys.Date() - 0:29 @@ -88,20 +88,19 @@ df <- data.frame( date = last_month, price = runif(30) ) -base <- ggplot(df, aes(date, price)) + - geom_line() +base <- a_plot(df, a_aes(date, price)) + + a_geom_line() # The date scale will attempt to pick sensible defaults for # major and minor tick marks. Override with date_breaks, date_labels # date_minor_breaks arguments. -base + scale_x_date(date_labels = "\%b \%d") -base + scale_x_date(date_breaks = "1 week", date_labels = "\%W") -base + scale_x_date(date_minor_breaks = "1 day") +base + a_scale_x_date(date_labels = "\%b \%d") +base + a_scale_x_date(date_breaks = "1 week", date_labels = "\%W") +base + a_scale_x_date(date_minor_breaks = "1 day") # Set limits -base + scale_x_date(limits = c(Sys.Date() - 7, NA)) +base + a_scale_x_date(limits = c(Sys.Date() - 7, NA)) } \seealso{ -\code{\link{scale_continuous}} for continuous position scales. +\code{\link{a_scale_continuous}} for continuous position scales. } - diff --git a/man/scale_discrete.Rd b/man/a_scale_discrete.Rd similarity index 58% rename from man/scale_discrete.Rd rename to man/a_scale_discrete.Rd index 96032e5223..d6136837c2 100644 --- a/man/scale_discrete.Rd +++ b/man/a_scale_discrete.Rd @@ -1,18 +1,18 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-discrete-.r -\name{scale_x_discrete} -\alias{scale_x_discrete} -\alias{scale_y_discrete} +\name{a_scale_x_discrete} +\alias{a_scale_x_discrete} +\alias{a_scale_y_discrete} \title{Discrete position.} \usage{ -scale_x_discrete(..., expand = waiver()) +a_scale_x_discrete(..., expand = waiver()) -scale_y_discrete(..., expand = waiver()) +a_scale_y_discrete(..., expand = waiver()) } \arguments{ \item{...}{common discrete scale parameters: \code{name}, \code{breaks}, -\code{labels}, \code{na.value}, \code{limits} and \code{guide}. See -\code{\link{discrete_scale}} for more details} +\code{a_labels}, \code{na.value}, \code{limits} and \code{a_guide}. See +\code{\link{discrete_a_scale}} for more details} \item{expand}{a numeric vector of length two giving multiplicative and additive expansion constants. These constants ensure that the data is @@ -26,36 +26,35 @@ level, and increasing by one for each level (i.e. the labels are placed at integer positions). This is what allows jittering to work. } \examples{ -ggplot(diamonds, aes(cut)) + geom_bar() +a_plot(diamonds, a_aes(cut)) + a_geom_bar() \donttest{ # The discrete position scale is added automatically whenever you # have a discrete position. -(d <- ggplot(subset(diamonds, carat > 1), aes(cut, clarity)) + - geom_jitter()) +(d <- a_plot(subset(diamonds, carat > 1), a_aes(cut, clarity)) + + a_geom_jitter()) -d + scale_x_discrete("Cut") -d + scale_x_discrete("Cut", labels = c("Fair" = "F","Good" = "G", +d + a_scale_x_discrete("Cut") +d + a_scale_x_discrete("Cut", a_labels = c("Fair" = "F","Good" = "G", "Very Good" = "VG","Perfect" = "P","Ideal" = "I")) # Use limits to adjust the which levels (and in what order) # are displayed -d + scale_x_discrete(limits = c("Fair","Ideal")) +d + a_scale_x_discrete(limits = c("Fair","Ideal")) # you can also use the short hand functions xlim and ylim d + xlim("Fair","Ideal", "Good") d + ylim("I1", "IF") # See ?reorder to reorder based on the values of another variable -ggplot(mpg, aes(manufacturer, cty)) + geom_point() -ggplot(mpg, aes(reorder(manufacturer, cty), cty)) + geom_point() -ggplot(mpg, aes(reorder(manufacturer, displ), cty)) + geom_point() +a_plot(mpg, a_aes(manufacturer, cty)) + a_geom_point() +a_plot(mpg, a_aes(reorder(manufacturer, cty), cty)) + a_geom_point() +a_plot(mpg, a_aes(reorder(manufacturer, displ), cty)) + a_geom_point() # Use abbreviate as a formatter to reduce long names -ggplot(mpg, aes(reorder(manufacturer, displ), cty)) + - geom_point() + - scale_x_discrete(labels = abbreviate) +a_plot(mpg, a_aes(reorder(manufacturer, displ), cty)) + + a_geom_point() + + a_scale_x_discrete(a_labels = abbreviate) } } - diff --git a/man/a_scale_gradient.Rd b/man/a_scale_gradient.Rd new file mode 100644 index 0000000000..7b5913f9ab --- /dev/null +++ b/man/a_scale_gradient.Rd @@ -0,0 +1,122 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-gradient.r, R/zxx.r +\name{a_scale_colour_gradient} +\alias{a_scale_colour_gradient} +\alias{a_scale_fill_gradient} +\alias{a_scale_colour_gradient2} +\alias{a_scale_fill_gradient2} +\alias{a_scale_colour_gradientn} +\alias{a_scale_fill_gradientn} +\alias{a_scale_colour_continuous} +\alias{a_scale_colour_datetime} +\alias{a_scale_colour_date} +\alias{a_scale_fill_continuous} +\alias{a_scale_fill_datetime} +\alias{a_scale_fill_date} +\alias{a_scale_color_continuous} +\alias{a_scale_color_gradient} +\alias{a_scale_color_gradient2} +\alias{a_scale_color_gradientn} +\title{Smooth gradient between two colours} +\usage{ +a_scale_colour_gradient(..., low = "#132B43", high = "#56B1F7", + space = "Lab", na.value = "grey50", a_guide = "colourbar") + +a_scale_fill_gradient(..., low = "#132B43", high = "#56B1F7", + space = "Lab", na.value = "grey50", a_guide = "colourbar") + +a_scale_colour_gradient2(..., low = muted("red"), mid = "white", + high = muted("blue"), midpoint = 0, space = "Lab", + na.value = "grey50", a_guide = "colourbar") + +a_scale_fill_gradient2(..., low = muted("red"), mid = "white", + high = muted("blue"), midpoint = 0, space = "Lab", + na.value = "grey50", a_guide = "colourbar") + +a_scale_colour_gradientn(..., colours, values = NULL, space = "Lab", + na.value = "grey50", a_guide = "colourbar", colors) + +a_scale_fill_gradientn(..., colours, values = NULL, space = "Lab", + na.value = "grey50", a_guide = "colourbar", colors) +} +\arguments{ +\item{...}{Other arguments passed on to \code{\link{discrete_a_scale}} +to control name, limits, breaks, labels and so forth.} + +\item{low, high}{Colours for low and high ends of the gradient.} + +\item{space}{colour space in which to calculate gradient. Must be "Lab" - +other values are deprecated.} + +\item{na.value}{Colour to use for missing values} + +\item{a_guide}{Type of legend. Use \code{"colourbar"} for continuous +colour bar, or \code{"legend"} for discrete colour legend.} + +\item{mid}{colour for mid point} + +\item{midpoint}{The midpoint (in data value) of the diverging scale. +Defaults to 0.} + +\item{colours, colors}{Vector of colours to use for n-colour gradient.} + +\item{values}{if colours should not be evenly positioned along the gradient +this vector gives the position (between 0 and 1) for each colour in the +\code{colours} vector. See \code{\link{rescale}} for a convience function +to map an arbitrary range to between 0 and 1.} +} +\description{ +\code{a_scale_*_gradient} creates a two colour gradient (low-high), +\code{a_scale_*_gradient2} creates a diverging colour gradient (low-mid-high), +\code{a_scale_*_gradientn} creats a n-colour gradient. +} +\details{ +Default colours are generated with \pkg{munsell} and +\code{mnsl(c("2.5PB 2/4", "2.5PB 7/10")}. Generally, for continuous +colour scales you want to keep hue constant, but vary chroma and +luminance. The \pkg{munsell} package makes this easy to do using the +Munsell colour system. +} +\examples{ +df <- data.frame( + x = runif(100), + y = runif(100), + z1 = rnorm(100), + z2 = abs(rnorm(100)) +) + +# Default colour scale colours from light blue to dark blue +a_plot(df, a_aes(x, y)) + + a_geom_point(a_aes(colour = z2)) + +# For diverging colour scales use gradient2 +a_plot(df, a_aes(x, y)) + + a_geom_point(a_aes(colour = z1)) + + a_scale_colour_gradient2() + +# Use your own colour scale with gradientn +a_plot(df, a_aes(x, y)) + + a_geom_point(a_aes(colour = z1)) + + a_scale_colour_gradientn(colours = terrain.colors(10)) + +# Equivalent fill scales do the same job for the fill a_aesthetic +a_plot(faithfuld, a_aes(waiting, eruptions)) + + a_geom_raster(a_aes(fill = density)) + + a_scale_fill_gradientn(colours = terrain.colors(10)) + +# Adjust colour choices with low and high +a_plot(df, a_aes(x, y)) + + a_geom_point(a_aes(colour = z2)) + + a_scale_colour_gradient(low = "white", high = "black") +# Avoid red-green colour contrasts because ~10\% of men have difficulty +# seeing them +} +\seealso{ +\code{\link[scales]{seq_gradient_pal}} for details on underlying + palette + +Other colour scales: + \code{\link{a_scale_colour_brewer}}, + \code{\link{a_scale_colour_grey}}, + \code{\link{a_scale_colour_hue}} +} diff --git a/man/a_scale_grey.Rd b/man/a_scale_grey.Rd new file mode 100644 index 0000000000..bbe796c4ad --- /dev/null +++ b/man/a_scale_grey.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-grey.r, R/zxx.r +\name{a_scale_colour_grey} +\alias{a_scale_colour_grey} +\alias{a_scale_fill_grey} +\alias{a_scale_color_grey} +\title{Sequential grey colour scale.} +\usage{ +a_scale_colour_grey(..., start = 0.2, end = 0.8, na.value = "red") + +a_scale_fill_grey(..., start = 0.2, end = 0.8, na.value = "red") +} +\arguments{ +\item{...}{Other arguments passed on to \code{\link{discrete_a_scale}} +to control name, limits, breaks, labels and so forth.} + +\item{start}{gray value at low end of palette} + +\item{end}{gray value at high end of palette} + +\item{na.value}{Colour to use for missing values} +} +\description{ +Based on \code{\link{gray.colors}} +} +\examples{ +p <- a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point(a_aes(colour = factor(cyl))) +p + a_scale_colour_grey() +p + a_scale_colour_grey(end = 0) + +# You may want to turn off the pale grey background with this scale +p + a_scale_colour_grey() + a_theme_bw() + +# Colour of missing values is controlled with na.value: +miss <- factor(sample(c(NA, 1:5), nrow(mtcars), replace = TRUE)) +a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point(a_aes(colour = miss)) + + a_scale_colour_grey() +a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point(a_aes(colour = miss)) + + a_scale_colour_grey(na.value = "green") +} +\seealso{ +Other colour scales: + \code{\link{a_scale_colour_brewer}}, + \code{\link{a_scale_colour_gradient}}, + \code{\link{a_scale_colour_hue}} +} diff --git a/man/a_scale_hue.Rd b/man/a_scale_hue.Rd new file mode 100644 index 0000000000..738bc3d859 --- /dev/null +++ b/man/a_scale_hue.Rd @@ -0,0 +1,81 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-hue.r, R/zxx.r +\name{a_scale_colour_hue} +\alias{a_scale_colour_hue} +\alias{a_scale_fill_hue} +\alias{a_scale_colour_discrete} +\alias{a_scale_fill_discrete} +\alias{a_scale_color_discrete} +\alias{a_scale_color_hue} +\title{Qualitative colour scale with evenly spaced hues.} +\usage{ +a_scale_colour_hue(..., h = c(0, 360) + 15, c = 100, l = 65, + h.start = 0, direction = 1, na.value = "grey50") + +a_scale_fill_hue(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, + direction = 1, na.value = "grey50") +} +\arguments{ +\item{...}{Other arguments passed on to \code{\link{discrete_a_scale}} +to control name, limits, breaks, labels and so forth.} + +\item{h}{range of hues to use, in [0, 360]} + +\item{c}{chroma (intensity of colour), maximum value varies depending on +combination of hue and luminance.} + +\item{l}{luminance (lightness), in [0, 100]} + +\item{h.start}{hue to start at} + +\item{direction}{direction to travel around the colour wheel, +1 = clockwise, -1 = counter-clockwise} + +\item{na.value}{Colour to use for missing values} +} +\description{ +Qualitative colour scale with evenly spaced hues. +} +\examples{ +\donttest{ +dsamp <- diamonds[sample(nrow(diamonds), 1000), ] +(d <- a_plot(dsamp, a_aes(carat, price)) + a_geom_point(a_aes(colour = clarity))) + +# Change a_scale label +d + a_scale_colour_hue() +d + a_scale_colour_hue("clarity") +d + a_scale_colour_hue(expression(clarity[beta])) + +# Adjust luminosity and chroma +d + a_scale_colour_hue(l = 40, c = 30) +d + a_scale_colour_hue(l = 70, c = 30) +d + a_scale_colour_hue(l = 70, c = 150) +d + a_scale_colour_hue(l = 80, c = 150) + +# Change range of hues used +d + a_scale_colour_hue(h = c(0, 90)) +d + a_scale_colour_hue(h = c(90, 180)) +d + a_scale_colour_hue(h = c(180, 270)) +d + a_scale_colour_hue(h = c(270, 360)) + +# Vary opacity +# (only works with pdf, quartz and cairo devices) +d <- a_plot(dsamp, a_aes(carat, price, colour = clarity)) +d + a_geom_point(alpha = 0.9) +d + a_geom_point(alpha = 0.5) +d + a_geom_point(alpha = 0.2) + +# Colour of missing values is controlled with na.value: +miss <- factor(sample(c(NA, 1:5), nrow(mtcars), replace = TRUE)) +a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point(a_aes(colour = miss)) +a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point(a_aes(colour = miss)) + + a_scale_colour_hue(na.value = "black") +} +} +\seealso{ +Other colour scales: + \code{\link{a_scale_colour_brewer}}, + \code{\link{a_scale_colour_gradient}}, + \code{\link{a_scale_colour_grey}} +} diff --git a/man/a_scale_identity.Rd b/man/a_scale_identity.Rd new file mode 100644 index 0000000000..b5cce46835 --- /dev/null +++ b/man/a_scale_identity.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-identity.r, R/zxx.r +\name{a_scale_identity} +\alias{a_scale_identity} +\alias{a_scale_colour_identity} +\alias{a_scale_fill_identity} +\alias{a_scale_shape_identity} +\alias{a_scale_linetype_identity} +\alias{a_scale_alpha_identity} +\alias{a_scale_size_identity} +\alias{a_scale_color_identity} +\title{Use values without scaling.} +\usage{ +a_scale_colour_identity(..., a_guide = "none") + +a_scale_fill_identity(..., a_guide = "none") + +a_scale_shape_identity(..., a_guide = "none") + +a_scale_linetype_identity(..., a_guide = "none") + +a_scale_alpha_identity(..., a_guide = "none") + +a_scale_size_identity(..., a_guide = "none") +} +\arguments{ +\item{...}{Other arguments passed on to \code{\link{discrete_a_scale}} or +\code{\link{continuous_a_scale}}} + +\item{a_guide}{Guide to use for this scale - defaults to \code{"none"}.} +} +\description{ +Use values without scaling. +} +\examples{ +a_plot(luv_colours, a_aes(u, v)) + + a_geom_point(a_aes(colour = col), size = 3) + + a_scale_color_identity() + + a_coord_equal() + +df <- data.frame( + x = 1:4, + y = 1:4, + colour = c("red", "green", "blue", "yellow") +) +a_plot(df, a_aes(x, y)) + a_geom_tile(a_aes(fill = colour)) +a_plot(df, a_aes(x, y)) + + a_geom_tile(a_aes(fill = colour)) + + a_scale_fill_identity() + +# To get a legend a_guide, specify a_guide = "legend" +a_plot(df, a_aes(x, y)) + + a_geom_tile(a_aes(fill = colour)) + + a_scale_fill_identity(a_guide = "legend") +# But you'll typically also need to supply breaks and labels: +a_plot(df, a_aes(x, y)) + + a_geom_tile(a_aes(fill = colour)) + + a_scale_fill_identity("trt", a_labels = letters[1:4], breaks = df$colour, + a_guide = "legend") + +# cyl scaled to appropriate size +a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point(a_aes(size = cyl)) + +# cyl used as point size +a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point(a_aes(size = cyl)) + + a_scale_size_identity() +} diff --git a/man/a_scale_linetype.Rd b/man/a_scale_linetype.Rd new file mode 100644 index 0000000000..8d9fb2dd6c --- /dev/null +++ b/man/a_scale_linetype.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-linetype.r +\name{a_scale_linetype} +\alias{a_scale_linetype} +\alias{a_scale_linetype_continuous} +\alias{a_scale_linetype_discrete} +\title{Scale for line patterns.} +\usage{ +a_scale_linetype(..., na.value = "blank") + +a_scale_linetype_continuous(...) + +a_scale_linetype_discrete(..., na.value = "blank") +} +\arguments{ +\item{...}{common discrete scale parameters: \code{name}, \code{breaks}, +\code{a_labels}, \code{na.value}, \code{limits} and \code{a_guide}. See +\code{\link{discrete_a_scale}} for more details} + +\item{na.value}{The linetype to use for \code{NA} values.} +} +\description{ +Default line types based on a set supplied by Richard Pearson, +University of Manchester. Line types can not be mapped to continuous +values. +} +\examples{ +base <- a_plot(economics_long, a_aes(date, value01)) +base + a_geom_line(a_aes(group = variable)) +base + a_geom_line(a_aes(linetype = variable)) + +# See a_scale_manual for more flexibility +} diff --git a/man/a_scale_manual.Rd b/man/a_scale_manual.Rd new file mode 100644 index 0000000000..fbc163b863 --- /dev/null +++ b/man/a_scale_manual.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale-manual.r, R/zxx.r +\name{a_scale_manual} +\alias{a_scale_manual} +\alias{a_scale_colour_manual} +\alias{a_scale_fill_manual} +\alias{a_scale_size_manual} +\alias{a_scale_shape_manual} +\alias{a_scale_linetype_manual} +\alias{a_scale_alpha_manual} +\alias{a_scale_color_manual} +\title{Create your own discrete scale.} +\usage{ +a_scale_colour_manual(..., values) + +a_scale_fill_manual(..., values) + +a_scale_size_manual(..., values) + +a_scale_shape_manual(..., values) + +a_scale_linetype_manual(..., values) + +a_scale_alpha_manual(..., values) +} +\arguments{ +\item{...}{common discrete scale parameters: \code{name}, \code{breaks}, +\code{a_labels}, \code{na.value}, \code{limits} and \code{a_guide}. See +\code{\link{discrete_a_scale}} for more details} + +\item{values}{a set of aesthetic values to map data values to. If this +is a named vector, then the values will be matched based on the names. +If unnamed, values will be matched in order (usually alphabetical) with +the limits of the a_scale. Any data values that don't match will be +given \code{na.value}.} +} +\description{ +Create your own discrete scale. +} +\examples{ +\donttest{ +p <- a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point(a_aes(colour = factor(cyl))) + +p + a_scale_colour_manual(values = c("red","blue", "green")) +p + a_scale_colour_manual( + values = c("8" = "red","4" = "blue","6" = "green")) +# With rgb hex values +p + a_scale_colour_manual(values = c("#FF0000", "#0000FF", "#00FF00")) + +# As with other scales you can use breaks to control the appearance +# of the legend +cols <- c("8" = "red","4" = "blue","6" = "darkgreen", "10" = "orange") +p + a_scale_colour_manual(values = cols) +p + a_scale_colour_manual(values = cols, breaks = c("4", "6", "8")) +p + a_scale_colour_manual(values = cols, breaks = c("8", "6", "4")) +p + a_scale_colour_manual(values = cols, breaks = c("4", "6", "8"), +a_labels = c("four", "six", "eight")) + +# And limits to control the possible values of the a_scale +p + a_scale_colour_manual(values = cols, limits = c("4", "8")) +p + a_scale_colour_manual(values = cols, limits = c("4", "6", "8", "10")) + +# Notice that the values are matched with limits, and not breaks +p + a_scale_colour_manual(limits = c(6, 8, 4), breaks = c(8, 4, 6), + values = c("grey50", "grey80", "black")) +} +} diff --git a/man/scale_shape.Rd b/man/a_scale_shape.Rd similarity index 52% rename from man/scale_shape.Rd rename to man/a_scale_shape.Rd index fc4f6ea8f4..cd10e64322 100644 --- a/man/scale_shape.Rd +++ b/man/a_scale_shape.Rd @@ -1,17 +1,17 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-shape.r -\name{scale_shape} -\alias{scale_shape} -\alias{scale_shape_continuous} -\alias{scale_shape_discrete} +\name{a_scale_shape} +\alias{a_scale_shape} +\alias{a_scale_shape_discrete} +\alias{a_scale_shape_continuous} \title{Scale for shapes, aka glyphs.} \usage{ -scale_shape(..., solid = TRUE) +a_scale_shape(..., solid = TRUE) } \arguments{ \item{...}{common discrete scale parameters: \code{name}, \code{breaks}, -\code{labels}, \code{na.value}, \code{limits} and \code{guide}. See -\code{\link{discrete_scale}} for more details} +\code{a_labels}, \code{na.value}, \code{limits} and \code{a_guide}. See +\code{\link{discrete_a_scale}} for more details} \item{solid}{Are the shapes solid, \code{TRUE}, or hollow \code{FALSE}?} } @@ -21,20 +21,19 @@ A continuous variable can not be mapped to shape. \examples{ dsmall <- diamonds[sample(nrow(diamonds), 100), ] -(d <- ggplot(dsmall, aes(carat, price)) + geom_point(aes(shape = cut))) -d + scale_shape(solid = TRUE) # the default -d + scale_shape(solid = FALSE) -d + scale_shape(name = "Cut of diamond") -d + scale_shape(name = "Cut of\\ndiamond") +(d <- a_plot(dsmall, a_aes(carat, price)) + a_geom_point(a_aes(shape = cut))) +d + a_scale_shape(solid = TRUE) # the default +d + a_scale_shape(solid = FALSE) +d + a_scale_shape(name = "Cut of diamond") +d + a_scale_shape(name = "Cut of\\ndiamond") # To change order of levels, change order of # underlying factor levels(dsmall$cut) <- c("Fair", "Good", "Very Good", "Premium", "Ideal") # Need to recreate plot to pick up new data -ggplot(dsmall, aes(price, carat)) + geom_point(aes(shape = cut)) +a_plot(dsmall, a_aes(price, carat)) + a_geom_point(a_aes(shape = cut)) # Or for short: d \%+\% dsmall } - diff --git a/man/scale_size.Rd b/man/a_scale_size.Rd similarity index 59% rename from man/scale_size.Rd rename to man/a_scale_size.Rd index 86c76e8e5b..d3de14d6df 100644 --- a/man/scale_size.Rd +++ b/man/a_scale_size.Rd @@ -1,22 +1,25 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-size.r -\name{scale_size} -\alias{scale_radius} -\alias{scale_size} -\alias{scale_size_area} -\alias{scale_size_continuous} -\alias{scale_size_date} -\alias{scale_size_datetime} -\alias{scale_size_discrete} +\name{a_scale_size} +\alias{a_scale_size} +\alias{a_scale_size_continuous} +\alias{a_scale_radius} +\alias{a_scale_size} +\alias{a_scale_size_discrete} +\alias{a_scale_size_area} +\alias{a_scale_size_datetime} +\alias{a_scale_size_date} \title{Scale size (area or radius).} \usage{ -scale_radius(name = waiver(), breaks = waiver(), labels = waiver(), - limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") +a_scale_radius(name = waiver(), breaks = waiver(), a_labels = waiver(), + limits = NULL, range = c(1, 6), trans = "identity", + a_guide = "legend") -scale_size(name = waiver(), breaks = waiver(), labels = waiver(), - limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") +a_scale_size(name = waiver(), breaks = waiver(), a_labels = waiver(), + limits = NULL, range = c(1, 6), trans = "identity", + a_guide = "legend") -scale_size_area(..., max_size = 6) +a_scale_size_area(..., max_size = 6) } \arguments{ \item{name}{The name of the scale. Used as axis or legend title. If @@ -32,7 +35,7 @@ mapping used for that aesthetic.} as output }} -\item{labels}{One of: \itemize{ +\item{a_labels}{One of: \itemize{ \item \code{NULL} for no labels \item \code{waiver()} for the default labels computed by the transformation object @@ -58,40 +61,39 @@ maximum size of the plotting symbol after transformation.} \code{\link[scales]{boxcox_trans}}. You can create your own transformation with \code{\link[scales]{trans_new}}.} -\item{guide}{Name of guide object, or object itself.} +\item{a_guide}{Name of guide object, or object itself.} -\item{...}{Other arguments passed on to \code{\link{continuous_scale}} -to control name, limits, breaks, labels and so forth.} +\item{...}{Other arguments passed on to \code{\link{continuous_a_scale}} +to control name, limits, breaks, a_labels and so forth.} \item{max_size}{Size of largest points.} } \description{ -\code{scale_size} scales area, \code{scale_radius} scales radius. The size +\code{a_scale_size} a_scales area, \code{a_scale_radius} scales radius. The size aesthetic is most commonly used for points and text, and humans perceive the area of points (not their radius), so this provides for optimal -perception. \code{scale_size_area} ensures that a value of 0 is mapped +perception. \code{a_scale_size_area} ensures that a value of 0 is mapped to a size of 0. } \examples{ -p <- ggplot(mpg, aes(displ, hwy, size = hwy)) + - geom_point() +p <- a_plot(mpg, a_aes(displ, hwy, size = hwy)) + + a_geom_point() p -p + scale_size("Highway mpg") -p + scale_size(range = c(0, 10)) +p + a_scale_size("Highway mpg") +p + a_scale_size(range = c(0, 10)) -# If you want zero value to have zero size, use scale_size_area: -p + scale_size_area() +# If you want zero value to have zero size, use a_scale_size_area: +p + a_scale_size_area() # This is most useful when size is a count -ggplot(mpg, aes(class, cyl)) + - geom_count() + - scale_size_area() +a_plot(mpg, a_aes(class, cyl)) + + a_geom_count() + + a_scale_size_area() -# If you want to map size to radius (usually bad idea), use scale_radius -p + scale_radius() +# If you want to map size to radius (usually bad idea), use a_scale_radius +p + a_scale_radius() } \seealso{ -\code{\link{scale_size_area}} if you want 0 values to be mapped +\code{\link{a_scale_size_area}} if you want 0 values to be mapped to points with size 0. } - diff --git a/man/a_scales_list.Rd b/man/a_scales_list.Rd new file mode 100644 index 0000000000..e6587d551b --- /dev/null +++ b/man/a_scales_list.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scales-.r +\name{a_scales_list} +\alias{a_scales_list} +\title{Scales object encapsulates multiple scales. +All input and output done with data.frames to facilitate +multiple input and output variables} +\usage{ +a_scales_list() +} +\description{ +Scales object encapsulates multiple scales. +All input and output done with data.frames to facilitate +multiple input and output variables +} diff --git a/man/a_stairstep.Rd b/man/a_stairstep.Rd new file mode 100644 index 0000000000..4e7e63b4b6 --- /dev/null +++ b/man/a_stairstep.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/geom-path.r +\name{a_stairstep} +\alias{a_stairstep} +\title{Calculate a_stairsteps +Used by \code{\link{a_geom_step}}} +\usage{ +a_stairstep(data, direction = "hv") +} +\arguments{ +\item{data}{...} + +\item{direction}{...} +} +\description{ +Calculate a_stairsteps +Used by \code{\link{a_geom_step}} +} diff --git a/man/stat_ecdf.Rd b/man/a_stat_ecdf.Rd similarity index 71% rename from man/stat_ecdf.Rd rename to man/a_stat_ecdf.Rd index d396dbaa69..ae2ccb9ed8 100644 --- a/man/stat_ecdf.Rd +++ b/man/a_stat_ecdf.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat-ecdf.r -\name{stat_ecdf} -\alias{stat_ecdf} +\name{a_stat_ecdf} +\alias{a_stat_ecdf} \title{Empirical Cumulative Density Function} \usage{ -stat_ecdf(mapping = NULL, data = NULL, geom = "step", - position = "identity", ..., n = NULL, pad = TRUE, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) +a_stat_ecdf(mapping = NULL, data = NULL, a_geom = "step", + a_position = "identity", ..., n = NULL, pad = TRUE, na.rm = FALSE, + show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -18,25 +18,25 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{geom}{The geometric object to use display the data} +\item{a_geom}{The geometric object to use display the data} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{n}{if NULL, do not interpolate. If not NULL, this is the number of points to interpolate with.} @@ -51,7 +51,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -66,15 +66,15 @@ Empirical Cumulative Density Function \item{y}{cumulative density corresponding x} } } + \examples{ \donttest{ df <- data.frame(x = rnorm(1000)) -ggplot(df, aes(x)) + stat_ecdf(geom = "step") +a_plot(df, a_aes(x)) + a_stat_ecdf(a_geom = "step") df <- data.frame(x = c(rnorm(100, 0, 3), rnorm(100, 0, 10)), g = gl(2, 100)) -ggplot(df, aes(x, colour = g)) + stat_ecdf() +a_plot(df, a_aes(x, colour = g)) + a_stat_ecdf() } } - diff --git a/man/stat_ellipse.Rd b/man/a_stat_ellipse.Rd similarity index 61% rename from man/stat_ellipse.Rd rename to man/a_stat_ellipse.Rd index 9fdb2b8c1f..65144c3906 100644 --- a/man/stat_ellipse.Rd +++ b/man/a_stat_ellipse.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat-ellipse.R -\name{stat_ellipse} -\alias{stat_ellipse} +\name{a_stat_ellipse} +\alias{a_stat_ellipse} \title{Plot data ellipses.} \usage{ -stat_ellipse(mapping = NULL, data = NULL, geom = "path", - position = "identity", ..., type = "t", level = 0.95, segments = 51, - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) +a_stat_ellipse(mapping = NULL, data = NULL, a_geom = "path", + a_position = "identity", ..., type = "t", level = 0.95, segments = 51, + na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -18,32 +18,32 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{geom}{The geometric object to use display the data} +\item{a_geom}{The geometric object to use display the data} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{type}{The type of ellipse. The default \code{"t"} assumes a multivariate t-distribution, and \code{"norm"} assumes a multivariate normal distribution. \code{"euclid"} draws a circle with the radius equal to \code{level}, representing the euclidean distance from the center. -This ellipse probably won't appear circular unless \code{coord_fixed()} is applied.} +This ellipse probably won't appear circular unless \code{a_coord_fixed()} is applied.} \item{level}{The confidence level at which to draw an ellipse (default is 0.95), or, if \code{type="euclid"}, the radius of the circle to be drawn.} @@ -57,7 +57,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -67,31 +67,30 @@ The method for calculating the ellipses has been modified from \code{car::ellipse} (Fox and Weisberg, 2011) } \examples{ -ggplot(faithful, aes(waiting, eruptions)) + - geom_point() + - stat_ellipse() - -ggplot(faithful, aes(waiting, eruptions, color = eruptions > 3)) + - geom_point() + - stat_ellipse() - -ggplot(faithful, aes(waiting, eruptions, color = eruptions > 3)) + - geom_point() + - stat_ellipse(type = "norm", linetype = 2) + - stat_ellipse(type = "t") - -ggplot(faithful, aes(waiting, eruptions, color = eruptions > 3)) + - geom_point() + - stat_ellipse(type = "norm", linetype = 2) + - stat_ellipse(type = "euclid", level = 3) + - coord_fixed() - -ggplot(faithful, aes(waiting, eruptions, fill = eruptions > 3)) + - stat_ellipse(geom = "polygon") +a_plot(faithful, a_aes(waiting, eruptions)) + + a_geom_point() + + a_stat_ellipse() + +a_plot(faithful, a_aes(waiting, eruptions, color = eruptions > 3)) + + a_geom_point() + + a_stat_ellipse() + +a_plot(faithful, a_aes(waiting, eruptions, color = eruptions > 3)) + + a_geom_point() + + a_stat_ellipse(type = "norm", linetype = 2) + + a_stat_ellipse(type = "t") + +a_plot(faithful, a_aes(waiting, eruptions, color = eruptions > 3)) + + a_geom_point() + + a_stat_ellipse(type = "norm", linetype = 2) + + a_stat_ellipse(type = "euclid", level = 3) + + ggplot2Animint:::a_coord_fixed() + +a_plot(faithful, a_aes(waiting, eruptions, fill = eruptions > 3)) + + a_stat_ellipse(a_geom = "polygon") } \references{ John Fox and Sanford Weisberg (2011). An {R} Companion to Applied Regression, Second Edition. Thousand Oaks CA: Sage. URL: \url{http://socserv.socsci.mcmaster.ca/jfox/Books/Companion} } - diff --git a/man/stat_function.Rd b/man/a_stat_function.Rd similarity index 61% rename from man/stat_function.Rd rename to man/a_stat_function.Rd index fedd28d3bd..0c454fa756 100644 --- a/man/stat_function.Rd +++ b/man/a_stat_function.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat-function.r -\name{stat_function} -\alias{stat_function} +\name{a_stat_function} +\alias{a_stat_function} \title{Superimpose a function.} \usage{ -stat_function(mapping = NULL, data = NULL, geom = "path", - position = "identity", ..., fun, xlim = NULL, n = 101, args = list(), - na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) +a_stat_function(mapping = NULL, data = NULL, a_geom = "path", + a_position = "identity", ..., fun, xlim = NULL, n = 101, + args = list(), na.rm = FALSE, show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -18,25 +18,25 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{geom}{The geometric object to use display the data} +\item{a_geom}{The geometric object to use display the data} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{fun}{function to use} @@ -53,7 +53,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -63,7 +63,7 @@ Superimpose a function. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("stat", "function")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_stat", "function")} } \section{Computed variables}{ @@ -73,37 +73,37 @@ Superimpose a function. \item{y}{value of function evaluated at corresponding x} } } + \examples{ set.seed(1492) df <- data.frame( x = rnorm(100) ) x <- df$x -base <- ggplot(df, aes(x)) + geom_density() -base + stat_function(fun = dnorm, colour = "red") -base + stat_function(fun = dnorm, colour = "red", args = list(mean = 3)) +base <- a_plot(df, a_aes(x)) + a_geom_density() +base + a_stat_function(fun = dnorm, colour = "red") +base + a_stat_function(fun = dnorm, colour = "red", args = list(mean = 3)) # Plot functions without data # Examples adapted from Kohske Takahashi # Specify range of x-axis -ggplot(data.frame(x = c(0, 2)), aes(x)) + - stat_function(fun = exp, geom = "line") +a_plot(data.frame(x = c(0, 2)), a_aes(x)) + + a_stat_function(fun = exp, a_geom = "line") # Plot a normal curve -ggplot(data.frame(x = c(-5, 5)), aes(x)) + stat_function(fun = dnorm) +a_plot(data.frame(x = c(-5, 5)), a_aes(x)) + a_stat_function(fun = dnorm) # To specify a different mean or sd, use the args parameter to supply new values -ggplot(data.frame(x = c(-5, 5)), aes(x)) + - stat_function(fun = dnorm, args = list(mean = 2, sd = .5)) +a_plot(data.frame(x = c(-5, 5)), a_aes(x)) + + a_stat_function(fun = dnorm, args = list(mean = 2, sd = .5)) # Two functions on the same plot -f <- ggplot(data.frame(x = c(0, 10)), aes(x)) -f + stat_function(fun = sin, colour = "red") + - stat_function(fun = cos, colour = "blue") +f <- a_plot(data.frame(x = c(0, 10)), a_aes(x)) +f + a_stat_function(fun = sin, colour = "red") + + a_stat_function(fun = cos, colour = "blue") # Using a custom function test <- function(x) {x ^ 2 + x + 20} -f + stat_function(fun = test) +f + a_stat_function(fun = test) } - diff --git a/man/stat_identity.Rd b/man/a_stat_identity.Rd similarity index 66% rename from man/stat_identity.Rd rename to man/a_stat_identity.Rd index ffeb036e09..ac976956a3 100644 --- a/man/stat_identity.Rd +++ b/man/a_stat_identity.Rd @@ -1,15 +1,15 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat-identity.r -\name{stat_identity} -\alias{stat_identity} +\name{a_stat_identity} +\alias{a_stat_identity} \title{Identity statistic.} \usage{ -stat_identity(mapping = NULL, data = NULL, geom = "point", - position = "identity", ..., show.legend = NA, inherit.aes = TRUE) +a_stat_identity(mapping = NULL, data = NULL, a_geom = "point", + a_position = "identity", ..., show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -17,31 +17,31 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{geom}{The geometric object to use display the data} +\item{a_geom}{The geometric object to use display the data} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -50,7 +50,6 @@ the default plot specification, e.g. \code{\link{borders}}.} The identity statistic leaves the data unchanged. } \examples{ -p <- ggplot(mtcars, aes(wt, mpg)) -p + stat_identity() +p <- a_plot(mtcars, a_aes(wt, mpg)) +p + a_stat_identity() } - diff --git a/man/stat_qq.Rd b/man/a_stat_qq.Rd similarity index 61% rename from man/stat_qq.Rd rename to man/a_stat_qq.Rd index 9af1e22c08..6c9ecfb0de 100644 --- a/man/stat_qq.Rd +++ b/man/a_stat_qq.Rd @@ -1,21 +1,23 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat-qq.r -\name{stat_qq} -\alias{geom_qq} -\alias{stat_qq} +\name{a_stat_qq} +\alias{a_stat_qq} +\alias{a_geom_qq} \title{Calculation for quantile-quantile plot.} \usage{ -stat_qq(mapping = NULL, data = NULL, geom = "point", - position = "identity", ..., distribution = stats::qnorm, - dparams = list(), na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) - -geom_qq(mapping = NULL, data = NULL, geom = "point", - position = "identity", ..., distribution = stats::qnorm, - dparams = list(), na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) +a_stat_qq(mapping = NULL, data = NULL, a_geom = "point", + a_position = "identity", ..., distribution = stats::qnorm, + dparams = list(), na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) + +a_geom_qq(mapping = NULL, data = NULL, a_geom = "point", + a_position = "identity", ..., distribution = stats::qnorm, + dparams = list(), na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -23,25 +25,25 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{geom}{The geometric object to use display the data} +\item{a_geom}{The geometric object to use display the data} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{distribution}{Distribution function to use, if x not specified} @@ -55,7 +57,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -65,7 +67,7 @@ Calculation for quantile-quantile plot. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("stat", "qq")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_stat", "qq")} } \section{Computed variables}{ @@ -75,23 +77,23 @@ Calculation for quantile-quantile plot. \item{theoretical}{theoretical quantiles} } } + \examples{ \donttest{ df <- data.frame(y = rt(200, df = 5)) -p <- ggplot(df, aes(sample = y)) -p + stat_qq() -p + geom_point(stat = "qq") +p <- a_plot(df, a_aes(sample = y)) +p + a_stat_qq() +p + a_geom_point(a_stat = "qq") # Use fitdistr from MASS to estimate distribution params params <- as.list(MASS::fitdistr(df$y, "t")$estimate) -ggplot(df, aes(sample = y)) + - stat_qq(distribution = qt, dparams = params["df"]) +a_plot(df, a_aes(sample = y)) + + a_stat_qq(distribution = qt, dparams = params["df"]) # Using to explore the distribution of a variable -ggplot(mtcars) + - stat_qq(aes(sample = mpg)) -ggplot(mtcars) + - stat_qq(aes(sample = mpg, colour = factor(cyl))) +a_plot(mtcars) + + a_stat_qq(a_aes(sample = mpg)) +a_plot(mtcars) + + a_stat_qq(a_aes(sample = mpg, colour = factor(cyl))) } } - diff --git a/man/stat_summary.Rd b/man/a_stat_summary.Rd similarity index 60% rename from man/stat_summary.Rd rename to man/a_stat_summary.Rd index b8ca9d369e..7db96263b5 100644 --- a/man/stat_summary.Rd +++ b/man/a_stat_summary.Rd @@ -1,23 +1,23 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat-summary-bin.R, R/stat-summary.r -\name{stat_summary_bin} -\alias{stat_summary} -\alias{stat_summary_bin} +\name{a_stat_summary_bin} +\alias{a_stat_summary_bin} +\alias{a_stat_summary} \title{Summarise y values at unique/binned x x.} \usage{ -stat_summary_bin(mapping = NULL, data = NULL, geom = "pointrange", - position = "identity", ..., fun.data = NULL, fun.y = NULL, +a_stat_summary_bin(mapping = NULL, data = NULL, a_geom = "pointrange", + a_position = "identity", ..., fun.data = NULL, fun.y = NULL, fun.ymax = NULL, fun.ymin = NULL, fun.args = list(), na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + show.legend = NA, inherit.a_aes = TRUE) -stat_summary(mapping = NULL, data = NULL, geom = "pointrange", - position = "identity", ..., fun.data = NULL, fun.y = NULL, +a_stat_summary(mapping = NULL, data = NULL, a_geom = "pointrange", + a_position = "identity", ..., fun.data = NULL, fun.y = NULL, fun.ymax = NULL, fun.ymin = NULL, fun.args = list(), na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) + show.legend = NA, inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -25,26 +25,26 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{geom}{Use to override the default connection between -\code{geom_histogram}/\code{geom_freqpoly} and \code{stat_bin}.} +\item{a_geom}{Use to override the default connection between +\code{a_geom_histogram}/\code{a_geom_freqpoly} and \code{a_stat_bin}.} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{fun.data}{A function that is given the complete data and should return a data frame with variables \code{ymin}, \code{y}, and \code{ymax}.} @@ -62,20 +62,20 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} } \description{ -\code{stat_summary} operates on unique \code{x}; \code{stat_summary_bin} +\code{a_stat_summary} operates on unique \code{x}; \code{a_stat_summary_bin} operators on binned \code{x}. They are more flexible versions of -\code{\link{stat_bin}}: instead of just counting, they can compute any +\code{\link{a_stat_bin}}: instead of just counting, they can compute any aggregate. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("stat", "summary")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_stat", "summary")} } \section{Summary functions}{ @@ -99,53 +99,53 @@ number, but is somewhat less flexible. If your summary function computes multiple values at once (e.g. ymin and ymax), use \code{fun.data}. If no aggregation functions are suppled, will default to -\code{\link{mean_se}}. +\code{\link{a_mean_se}}. } + \examples{ -d <- ggplot(mtcars, aes(cyl, mpg)) + geom_point() -d + stat_summary(fun.data = "mean_cl_boot", colour = "red", size = 2) +d <- a_plot(mtcars, a_aes(cyl, mpg)) + a_geom_point() # You can supply individual functions to summarise the value at # each x: -d + stat_summary(fun.y = "median", colour = "red", size = 2, geom = "point") -d + stat_summary(fun.y = "mean", colour = "red", size = 2, geom = "point") -d + aes(colour = factor(vs)) + stat_summary(fun.y = mean, geom="line") +d + a_stat_summary(fun.y = "median", colour = "red", size = 2, a_geom = "point") +d + a_stat_summary(fun.y = "mean", colour = "red", size = 2, a_geom = "point") +d + a_aes(colour = factor(vs)) + a_stat_summary(fun.y = mean, a_geom="line") -d + stat_summary(fun.y = mean, fun.ymin = min, fun.ymax = max, +d + a_stat_summary(fun.y = mean, fun.ymin = min, fun.ymax = max, colour = "red") -d <- ggplot(diamonds, aes(cut)) -d + geom_bar() -d + stat_summary_bin(aes(y = price), fun.y = "mean", geom = "bar") +d <- a_plot(diamonds, a_aes(cut)) +d + a_geom_bar() +d + a_stat_summary_bin(a_aes(y = price), fun.y = "mean", a_geom = "bar") \donttest{ # Don't use ylim to zoom into a summary plot - this throws the # data away -p <- ggplot(mtcars, aes(cyl, mpg)) + - stat_summary(fun.y = "mean", geom = "point") +p <- a_plot(mtcars, a_aes(cyl, mpg)) + + a_stat_summary(fun.y = "mean", a_geom = "point") p p + ylim(15, 30) -# Instead use coord_cartesian -p + coord_cartesian(ylim = c(15, 30)) +# Instead use a_coord_cartesian +p + a_coord_cartesian(ylim = c(15, 30)) # A set of useful summary functions is provided from the Hmisc package: -stat_sum_df <- function(fun, geom="crossbar", ...) { - stat_summary(fun.data = fun, colour = "red", geom = geom, width = 0.2, ...) +a_stat_sum_df <- function(fun, a_geom="crossbar", ...) { + a_stat_summary(fun.data = fun, colour = "red", a_geom = a_geom, width = 0.2, ...) } -d <- ggplot(mtcars, aes(cyl, mpg)) + geom_point() +d <- a_plot(mtcars, a_aes(cyl, mpg)) + a_geom_point() # The crossbar geom needs grouping to be specified when used with # a continuous x axis. -d + stat_sum_df("mean_cl_boot", mapping = aes(group = cyl)) -d + stat_sum_df("mean_sdl", mapping = aes(group = cyl)) -d + stat_sum_df("mean_sdl", fun.args = list(mult = 1), mapping = aes(group = cyl)) -d + stat_sum_df("median_hilow", mapping = aes(group = cyl)) +# d + a_stat_sum_df("a_mean_cl_boot", mapping = a_aes(group = cyl)) +d + a_stat_sum_df("a_mean_sdl", mapping = a_aes(group = cyl)) +d + a_stat_sum_df("a_mean_sdl", fun.args = list(mult = 1), mapping = a_aes(group = cyl)) +d + a_stat_sum_df("a_median_hilow", mapping = a_aes(group = cyl)) # An example with highly skewed distributions: if (require("ggplot2movies")) { set.seed(596) mov <- movies[sample(nrow(movies), 1000), ] - m2 <- ggplot(mov, aes(x = factor(round(rating)), y = votes)) + geom_point() - m2 <- m2 + stat_summary(fun.data = "mean_cl_boot", geom = "crossbar", + m2 <- a_plot(mov, a_aes(x = factor(round(rating)), y = votes)) + a_geom_point() + m2 <- m2 + a_stat_summary(fun.data = "a_mean_cl_boot", a_geom = "crossbar", colour = "red", width = 0.3) + xlab("rating") m2 # Notice how the overplotting skews off visual perception of the mean @@ -155,18 +155,17 @@ m2 # Transforming the scale means the data are transformed # first, after which statistics are computed: -m2 + scale_y_log10() +m2 + a_scale_y_log10() # Transforming the coordinate system occurs after the # statistic has been computed. This means we're calculating the summary on the raw data # and stretching the geoms onto the log scale. Compare the widths of the # standard errors. -m2 + coord_trans(y="log10") +m2 + a_coord_trans(y="log10") } } } \seealso{ -\code{\link{geom_errorbar}}, \code{\link{geom_pointrange}}, - \code{\link{geom_linerange}}, \code{\link{geom_crossbar}} for geoms to +\code{\link{a_geom_errorbar}}, \code{\link{a_geom_pointrange}}, + \code{\link{a_geom_linerange}}, \code{\link{a_geom_crossbar}} for geoms to display summarised data } - diff --git a/man/stat_summary_2d.Rd b/man/a_stat_summary_2d.Rd similarity index 63% rename from man/stat_summary_2d.Rd rename to man/a_stat_summary_2d.Rd index 6674b31e81..3c0f56b7ed 100644 --- a/man/stat_summary_2d.Rd +++ b/man/a_stat_summary_2d.Rd @@ -1,24 +1,24 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat-summary-2d.r, R/stat-summary-hex.r -\name{stat_summary_2d} -\alias{stat_summary2d} -\alias{stat_summary_2d} -\alias{stat_summary_hex} +\name{a_stat_summary_2d} +\alias{a_stat_summary_2d} +\alias{a_stat_summary2d} +\alias{a_stat_summary_hex} \title{Bin and summarise in 2d (rectangle & hexagons)} \usage{ -stat_summary_2d(mapping = NULL, data = NULL, geom = "tile", - position = "identity", ..., bins = 30, binwidth = NULL, drop = TRUE, +a_stat_summary_2d(mapping = NULL, data = NULL, a_geom = "tile", + a_position = "identity", ..., bins = 30, binwidth = NULL, drop = TRUE, fun = "mean", fun.args = list(), na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + inherit.a_aes = TRUE) -stat_summary_hex(mapping = NULL, data = NULL, geom = "hex", - position = "identity", ..., bins = 30, binwidth = NULL, drop = TRUE, +a_stat_summary_hex(mapping = NULL, data = NULL, a_geom = "hex", + a_position = "identity", ..., bins = 30, binwidth = NULL, drop = TRUE, fun = "mean", fun.args = list(), na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -26,25 +26,25 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{geom}{The geometric object to use display the data} +\item{a_geom}{The geometric object to use display the data} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{bins}{numeric vector giving number of bins in both vertical and horizontal directions. Set to 30 by default.} @@ -65,15 +65,15 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} } \description{ -\code{stat_summary_2d} is a 2d variation of \code{\link{stat_summary}}. -\code{stat_summary_hex} is a hexagonal variation of -\code{\link{stat_summary_2d}}. The data are divided into bins defined +\code{a_stat_summary_2d} is a 2d variation of \code{\link{a_stat_summary}}. +\code{a_stat_summary_hex} is a hexagonal variation of +\code{\link{a_stat_summary_2d}}. The data are divided into bins defined by \code{x} and \code{y}, and then the values of \code{z} in each cell is are summarised with \code{fun}. } @@ -93,21 +93,21 @@ are summarised with \code{fun}. \item{value}{Value of summary statistic.} } } + \examples{ -d <- ggplot(diamonds, aes(carat, depth, z = price)) -d + stat_summary_2d() +d <- a_plot(diamonds, a_aes(carat, depth, z = price)) +d + a_stat_summary_2d() # Specifying function -d + stat_summary_2d(fun = function(x) sum(x^2)) -d + stat_summary_2d(fun = var) -d + stat_summary_2d(fun = "quantile", fun.args = list(probs = 0.1)) +d + a_stat_summary_2d(fun = function(x) sum(x^2)) +d + a_stat_summary_2d(fun = var) +d + a_stat_summary_2d(fun = "quantile", fun.args = list(probs = 0.1)) if (requireNamespace("hexbin")) { -d + stat_summary_hex() +d + a_stat_summary_hex() } } \seealso{ -\code{\link{stat_summary_hex}} for hexagonal summarization. - \code{\link{stat_bin2d}} for the binning options. +\code{\link{a_stat_summary_hex}} for hexagonal summarization. + \code{\link{a_stat_bin2d}} for the binning options. } - diff --git a/man/stat_unique.Rd b/man/a_stat_unique.Rd similarity index 63% rename from man/stat_unique.Rd rename to man/a_stat_unique.Rd index 886614ea26..57e498d413 100644 --- a/man/stat_unique.Rd +++ b/man/a_stat_unique.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat-unique.r -\name{stat_unique} -\alias{stat_unique} +\name{a_stat_unique} +\alias{a_stat_unique} \title{Remove duplicates.} \usage{ -stat_unique(mapping = NULL, data = NULL, geom = "point", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) +a_stat_unique(mapping = NULL, data = NULL, a_geom = "point", + a_position = "identity", ..., na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +\item{mapping}{Set of aesthetic mappings created by \code{\link{a_aes}} or +\code{\link{a_aes_}}. If specified and \code{inherit.a_aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} @@ -18,25 +18,25 @@ plot. You must supply \code{mapping} if there is no plot mapping.} options: If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. + data as specified in the call to \code{\link{a_plot}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. + \code{\link{a_fortify}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame.}, and will be used as the layer data.} -\item{geom}{The geometric object to use display the data} +\item{a_geom}{The geometric object to use display the data} -\item{position}{Position adjustment, either as a string, or the result of +\item{a_position}{Position adjustment, either as a string, or the result of a call to a position adjustment function.} -\item{...}{other arguments passed on to \code{\link{layer}}. These are +\item{...}{other arguments passed on to \code{\link{a_layer}}. These are often aesthetics, used to set an aesthetic to a fixed value, like \code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +to the paired a_geom/a_stat.} \item{na.rm}{If \code{FALSE} (the default), removes missing values with a warning. If \code{TRUE} silently removes missing values.} @@ -45,7 +45,7 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes.} -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +\item{inherit.a_aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link{borders}}.} @@ -55,10 +55,10 @@ Remove duplicates. } \section{Aesthetics}{ -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("stat", "unique")} +\Sexpr[results=rd,stage=build]{ggplot2Animint:::rd_aesthetics("a_stat", "unique")} } + \examples{ -ggplot(mtcars, aes(vs, am)) + geom_point(alpha = 0.1) -ggplot(mtcars, aes(vs, am)) + geom_point(alpha = 0.1, stat="unique") +a_plot(mtcars, a_aes(vs, am)) + a_geom_point(alpha = 0.1) +a_plot(mtcars, a_aes(vs, am)) + a_geom_point(alpha = 0.1, a_stat="unique") } - diff --git a/man/theme.Rd b/man/a_theme.Rd similarity index 51% rename from man/theme.Rd rename to man/a_theme.Rd index 29bcba8391..009aa692b4 100644 --- a/man/theme.Rd +++ b/man/a_theme.Rd @@ -1,23 +1,23 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/theme.r -\name{theme} -\alias{theme} -\title{Set theme elements} +\name{a_theme} +\alias{a_theme} +\title{Set a_theme elements} \usage{ -theme(..., complete = FALSE, validate = TRUE) +a_theme(..., complete = FALSE, validate = TRUE) } \arguments{ \item{...}{a list of element name, element pairings that modify the existing theme.} \item{complete}{set this to TRUE if this is a complete theme, such as -the one returned \code{by theme_grey()}. Complete themes behave +the one returned \code{by a_theme_grey()}. Complete themes behave differently when added to a ggplot object.} \item{validate}{TRUE to run validate_element, FALSE to bypass checks.} } \description{ -Use this function to modify theme settings. +Use this function to modify a_theme settings. } \details{ Theme elements can inherit properties from other theme elements. @@ -27,7 +27,7 @@ directly or indirectly from \code{text}; all lines inherit from \code{line}, and all rectangular objects inherit from \code{rect}. For more examples of modifying properties using inheritance, see -\code{\link{+.gg}} and \code{\link{\%+replace\%}}. +\code{\link{+.aaa}} and \code{\link{\%+replace\%}}. To see a graphical representation of the inheritance tree, see the last example below. @@ -38,48 +38,48 @@ The individual theme elements are: \tabular{ll}{ line \tab all line elements - (\code{element_line}) \cr + (\code{a_element_line}) \cr rect \tab all rectangular elements - (\code{element_rect}) \cr + (\code{a_element_rect}) \cr text \tab all text elements - (\code{element_text}) \cr + (\code{a_element_text}) \cr title \tab all title elements: plot, axes, legends - (\code{element_text}; inherits from \code{text}) \cr + (\code{a_element_text}; inherits from \code{text}) \cr aspect.ratio \tab aspect ratio of the panel \cr - axis.title \tab label of axes - (\code{element_text}; inherits from \code{text}) \cr + axis.title \tab a_label of axes + (\code{a_element_text}; inherits from \code{text}) \cr axis.title.x \tab x axis label - (\code{element_text}; inherits from \code{axis.title}) \cr + (\code{a_element_text}; inherits from \code{axis.title}) \cr axis.title.y \tab y axis label - (\code{element_text}; inherits from \code{axis.title}) \cr + (\code{a_element_text}; inherits from \code{axis.title}) \cr axis.text \tab tick labels along axes - (\code{element_text}; inherits from \code{text}) \cr + (\code{a_element_text}; inherits from \code{text}) \cr axis.text.x \tab x axis tick labels - (\code{element_text}; inherits from \code{axis.text}) \cr + (\code{a_element_text}; inherits from \code{axis.text}) \cr axis.text.y \tab y axis tick labels - (\code{element_text}; inherits from \code{axis.text}) \cr + (\code{a_element_text}; inherits from \code{axis.text}) \cr axis.ticks \tab tick marks along axes - (\code{element_line}; inherits from \code{line}) \cr + (\code{a_element_line}; inherits from \code{line}) \cr axis.ticks.x \tab x axis tick marks - (\code{element_line}; inherits from \code{axis.ticks}) \cr + (\code{a_element_line}; inherits from \code{axis.ticks}) \cr axis.ticks.y \tab y axis tick marks - (\code{element_line}; inherits from \code{axis.ticks}) \cr + (\code{a_element_line}; inherits from \code{axis.ticks}) \cr axis.ticks.length \tab length of tick marks (\code{unit}) \cr axis.line \tab lines along axes - (\code{element_line}; inherits from \code{line}) \cr + (\code{a_element_line}; inherits from \code{line}) \cr axis.line.x \tab line along x axis - (\code{element_line}; inherits from \code{axis.line}) \cr + (\code{a_element_line}; inherits from \code{axis.line}) \cr axis.line.y \tab line along y axis - (\code{element_line}; inherits from \code{axis.line}) \cr + (\code{a_element_line}; inherits from \code{axis.line}) \cr legend.background \tab background of legend - (\code{element_rect}; inherits from \code{rect}) \cr + (\code{a_element_rect}; inherits from \code{rect}) \cr legend.margin \tab extra space added around legend (\code{unit}) \cr legend.key \tab background underneath legend keys - (\code{element_rect}; inherits from \code{rect}) \cr + (\code{a_element_rect}; inherits from \code{rect}) \cr legend.key.size \tab size of legend keys (\code{unit}; inherits from \code{legend.key.size}) \cr legend.key.height \tab key background height @@ -87,14 +87,14 @@ The individual theme elements are: legend.key.width \tab key background width (\code{unit}; inherits from \code{legend.key.size}) \cr legend.text \tab legend item labels - (\code{element_text}; inherits from \code{text}) \cr + (\code{a_element_text}; inherits from \code{text}) \cr legend.text.align \tab alignment of legend labels (number from 0 (left) to 1 (right)) \cr legend.title \tab title of legend - (\code{element_text}; inherits from \code{title}) \cr + (\code{a_element_text}; inherits from \code{title}) \cr legend.title.align \tab alignment of legend title (number from 0 (left) to 1 (right)) \cr - legend.position \tab the position of legends + legend.a_position \tab the a_position of legends ("none", "left", "right", "bottom", "top", or two-element numeric vector) \cr legend.direction \tab layout of items in legends @@ -108,11 +108,11 @@ The individual theme elements are: ("top", "bottom", "left", or "right")\cr panel.background \tab background of plotting area, drawn underneath plot - (\code{element_rect}; inherits from \code{rect}) \cr + (\code{a_element_rect}; inherits from \code{rect}) \cr panel.border \tab border around plotting area, drawn on top of plot so that it covers tick marks and grid lines. This should be used with \code{fill=NA} - (\code{element_rect}; inherits from \code{rect}) \cr + (\code{a_element_rect}; inherits from \code{rect}) \cr panel.margin \tab margin around facet panels (\code{unit}) \cr panel.margin.x \tab horizontal margin around facet panels @@ -120,190 +120,190 @@ The individual theme elements are: panel.margin.y \tab vertical margin around facet panels (\code{unit}; inherits from \code{panel.margin}) \cr panel.grid \tab grid lines - (\code{element_line}; inherits from \code{line}) \cr + (\code{a_element_line}; inherits from \code{line}) \cr panel.grid.major \tab major grid lines - (\code{element_line}; inherits from \code{panel.grid}) \cr + (\code{a_element_line}; inherits from \code{panel.grid}) \cr panel.grid.minor \tab minor grid lines - (\code{element_line}; inherits from \code{panel.grid}) \cr + (\code{a_element_line}; inherits from \code{panel.grid}) \cr panel.grid.major.x \tab vertical major grid lines - (\code{element_line}; inherits from \code{panel.grid.major}) \cr + (\code{a_element_line}; inherits from \code{panel.grid.major}) \cr panel.grid.major.y \tab horizontal major grid lines - (\code{element_line}; inherits from \code{panel.grid.major}) \cr + (\code{a_element_line}; inherits from \code{panel.grid.major}) \cr panel.grid.minor.x \tab vertical minor grid lines - (\code{element_line}; inherits from \code{panel.grid.minor}) \cr + (\code{a_element_line}; inherits from \code{panel.grid.minor}) \cr panel.grid.minor.y \tab horizontal minor grid lines - (\code{element_line}; inherits from \code{panel.grid.minor}) \cr + (\code{a_element_line}; inherits from \code{panel.grid.minor}) \cr panel.ontop \tab option to place the panel (background, gridlines) over the data layers. Usually used with a transparent or blank \code{panel.background}. (\code{logical}) \cr plot.background \tab background of the entire plot - (\code{element_rect}; inherits from \code{rect}) \cr + (\code{a_element_rect}; inherits from \code{rect}) \cr plot.title \tab plot title (text appearance) - (\code{element_text}; inherits from \code{title}) + (\code{a_element_text}; inherits from \code{title}) left-aligned by default\cr plot.subtitle \tab plot subtitle (text appearance) - (\code{element_text}; inherits from \code{title}) + (\code{a_element_text}; inherits from \code{title}) left-aligned by default\cr plot.caption \tab caption below the plot (text appearance) - (\code{element_text}; inherits from \code{title}) + (\code{a_element_text}; inherits from \code{title}) right-aligned by default\cr plot.margin \tab margin around entire plot (\code{unit} with the sizes of the top, right, bottom, and left margins) \cr strip.background \tab background of facet labels - (\code{element_rect}; inherits from \code{rect}) \cr + (\code{a_element_rect}; inherits from \code{rect}) \cr strip.text \tab facet labels - (\code{element_text}; inherits from \code{text}) \cr + (\code{a_element_text}; inherits from \code{text}) \cr strip.text.x \tab facet labels along horizontal direction - (\code{element_text}; inherits from \code{strip.text}) \cr + (\code{a_element_text}; inherits from \code{strip.text}) \cr strip.text.y \tab facet labels along vertical direction - (\code{element_text}; inherits from \code{strip.text}) \cr + (\code{a_element_text}; inherits from \code{strip.text}) \cr strip.switch.pad.grid \tab space between strips and axes when strips are switched (\code{unit}) \cr strip.switch.pad.wrap \tab space between strips and axes when strips are switched (\code{unit}) \cr } } + \examples{ \donttest{ -p <- ggplot(mtcars, aes(mpg, wt)) + - geom_point() +p <- a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point() p -p + theme(panel.background = element_rect(colour = "pink")) -p + theme_bw() +p + a_theme(panel.background = a_element_rect(colour = "pink")) +p + a_theme_bw() # Scatter plot of gas mileage by vehicle weight -p <- ggplot(mtcars, aes(wt, mpg)) + - geom_point() +p <- a_plot(mtcars, a_aes(wt, mpg)) + + a_geom_point() # Calculate slope and intercept of line of best fit coef(lm(mpg ~ wt, data = mtcars)) -p + geom_abline(intercept = 37, slope = -5) +p + a_geom_abline(intercept = 37, slope = -5) # Calculate correlation coefficient with(mtcars, cor(wt, mpg, use = "everything", method = "pearson")) #annotate the plot -p + geom_abline(intercept = 37, slope = -5) + -geom_text(data = data.frame(), aes(4.5, 30, label = "Pearson-R = -.87")) +p + a_geom_abline(intercept = 37, slope = -5) + +a_geom_text(data = data.frame(), a_aes(4.5, 30, a_label = "Pearson-R = -.87")) # Change the axis labels # Original plot p -p + labs(x = "Vehicle Weight", y = "Miles per Gallon") +p + ggplot2Animint:::labs(x = "Vehicle Weight", y = "Miles per Gallon") # Or -p + labs(x = "Vehicle Weight", y = "Miles per Gallon") +p + ggplot2Animint:::labs(x = "Vehicle Weight", y = "Miles per Gallon") # Change title appearance p <- p + labs(title = "Vehicle Weight-Gas Mileage Relationship") # Set title to twice the base font size -p + theme(plot.title = element_text(size = rel(2))) -p + theme(plot.title = element_text(size = rel(2), colour = "blue")) +p + a_theme(plot.title = a_element_text(size = rel(2))) +p + a_theme(plot.title = a_element_text(size = rel(2), colour = "blue")) # Add a subtitle and adjust bottom margin p + labs(title = "Vehicle Weight-Gas Mileage Relationship", subtitle = "You need to wrap long subtitleson manually") + - theme(plot.subtitle = element_text(margin = margin(b = 20))) + a_theme(plot.subtitle = a_element_text(margin = margin(b = 20))) # Changing plot look with themes DF <- data.frame(x = rnorm(400)) -m <- ggplot(DF, aes(x = x)) + - geom_histogram() -# Default is theme_grey() +m <- a_plot(DF, a_aes(x = x)) + + a_geom_histogram() +# Default is a_theme_grey() m # Compare with -m + theme_bw() +m + a_theme_bw() # Manipulate Axis Attributes -m + theme(axis.line = element_line(size = 3, colour = "red", linetype = "dotted")) -m + theme(axis.text = element_text(colour = "blue")) -m + theme(axis.text.y = element_blank()) -m + theme(axis.ticks = element_line(size = 2)) -m + theme(axis.title.y = element_text(size = rel(1.5), angle = 90)) -m + theme(axis.title.x = element_blank()) -m + theme(axis.ticks.length = unit(.85, "cm")) +m + a_theme(axis.line = a_element_line(size = 3, colour = "red", linetype = "dotted")) +m + a_theme(axis.text = a_element_text(colour = "blue")) +m + a_theme(axis.text.y = a_element_blank()) +m + a_theme(axis.ticks = a_element_line(size = 2)) +m + a_theme(axis.title.y = a_element_text(size = rel(1.5), angle = 90)) +m + a_theme(axis.title.x = a_element_blank()) +m + a_theme(axis.ticks.length = unit(.85, "cm")) # Legend Attributes -z <- ggplot(mtcars, aes(wt, mpg)) + - geom_point(aes(colour = factor(cyl))) +z <- a_plot(mtcars, a_aes(wt, mpg)) + + a_geom_point(a_aes(colour = factor(cyl))) z -z + theme(legend.position = "none") -z + theme(legend.position = "bottom") +z + a_theme(legend.a_position = "none") +z + a_theme(legend.a_position = "bottom") # Or use relative coordinates between 0 and 1 -z + theme(legend.position = c(.5, .5)) +z + a_theme(legend.a_position = c(.5, .5)) # Add a border to the whole legend -z + theme(legend.background = element_rect(colour = "black")) +z + a_theme(legend.background = a_element_rect(colour = "black")) # Legend margin controls extra space around outside of legend: -z + theme(legend.background = element_rect(), +z + a_theme(legend.background = a_element_rect(), legend.margin = unit(1, "cm")) -z + theme(legend.background = element_rect(), +z + a_theme(legend.background = a_element_rect(), legend.margin = unit(0, "cm")) # Or to just the keys -z + theme(legend.key = element_rect(colour = "black")) -z + theme(legend.key = element_rect(fill = "yellow")) -z + theme(legend.key.size = unit(2.5, "cm")) -z + theme(legend.text = element_text(size = 20, colour = "red", angle = 45)) -z + theme(legend.title = element_text(face = "italic")) +z + a_theme(legend.key = a_element_rect(colour = "black")) +z + a_theme(legend.key = a_element_rect(fill = "yellow")) +z + a_theme(legend.key.size = unit(2.5, "cm")) +z + a_theme(legend.text = a_element_text(size = 20, colour = "red", angle = 45)) +z + a_theme(legend.title = a_element_text(face = "italic")) # To change the title of the legend use the name argument # in one of the scale options -z + scale_colour_brewer(name = "My Legend") -z + scale_colour_grey(name = "Number of \\nCylinders") +z + a_scale_colour_brewer(name = "My Legend") +z + a_scale_colour_grey(name = "Number of \\nCylinders") # Panel and Plot Attributes -z + theme(panel.background = element_rect(fill = "black")) -z + theme(panel.border = element_rect(linetype = "dashed", colour = "black")) -z + theme(panel.grid.major = element_line(colour = "blue")) -z + theme(panel.grid.minor = element_line(colour = "red", linetype = "dotted")) -z + theme(panel.grid.major = element_line(size = 2)) -z + theme(panel.grid.major.y = element_blank(), - panel.grid.minor.y = element_blank()) -z + theme(plot.background = element_rect()) -z + theme(plot.background = element_rect(fill = "green")) +z + a_theme(panel.background = a_element_rect(fill = "black")) +z + a_theme(panel.border = a_element_rect(linetype = "dashed", colour = "black")) +z + a_theme(panel.grid.major = a_element_line(colour = "blue")) +z + a_theme(panel.grid.minor = a_element_line(colour = "red", linetype = "dotted")) +z + a_theme(panel.grid.major = a_element_line(size = 2)) +z + a_theme(panel.grid.major.y = a_element_blank(), + panel.grid.minor.y = a_element_blank()) +z + a_theme(plot.background = a_element_rect()) +z + a_theme(plot.background = a_element_rect(fill = "green")) # Faceting Attributes set.seed(4940) dsmall <- diamonds[sample(nrow(diamonds), 1000), ] -k <- ggplot(dsmall, aes(carat, ..density..)) + - geom_histogram(binwidth = 0.2) + - facet_grid(. ~ cut) -k + theme(strip.background = element_rect(colour = "purple", fill = "pink", +k <- a_plot(dsmall, a_aes(carat, ..density..)) + + a_geom_histogram(binwidth = 0.2) + + a_facet_grid(. ~ cut) +k + a_theme(strip.background = a_element_rect(colour = "purple", fill = "pink", size = 3, linetype = "dashed")) -k + theme(strip.text.x = element_text(colour = "red", angle = 45, size = 10, +k + a_theme(strip.text.x = a_element_text(colour = "red", angle = 45, size = 10, hjust = 0.5, vjust = 0.5)) -k + theme(panel.margin = unit(5, "lines")) -k + theme(panel.margin.y = unit(0, "lines")) +k + a_theme(panel.margin = unit(5, "lines")) +k + a_theme(panel.margin.y = unit(0, "lines")) # Put gridlines on top meanprice <- tapply(diamonds$price, diamonds$cut, mean) cut <- factor(levels(diamonds$cut), levels = levels(diamonds$cut)) df <- data.frame(meanprice, cut) -g <- ggplot(df, aes(cut, meanprice)) + geom_bar(stat = "identity") -g + geom_bar(stat = "identity") + - theme(panel.background = element_blank(), - panel.grid.major.x = element_blank(), - panel.grid.minor.x = element_blank(), - panel.grid.minor.y = element_blank(), +g <- a_plot(df, a_aes(cut, meanprice)) + a_geom_bar(a_stat = "identity") +g + a_geom_bar(a_stat = "identity") + + a_theme(panel.background = a_element_blank(), + panel.grid.major.x = a_element_blank(), + panel.grid.minor.x = a_element_blank(), + panel.grid.minor.y = a_element_blank(), panel.ontop = TRUE) -# Modify a theme and save it -mytheme <- theme_grey() + theme(plot.title = element_text(colour = "red")) -p + mytheme +# Modify a a_theme and save it +mya_theme <- a_theme_grey() + a_theme(plot.title = a_element_text(colour = "red")) +p + mya_theme } } \seealso{ -\code{\link{+.gg}} +\code{\link{+.aaa}} \code{\link{\%+replace\%}} \code{\link{rel}} -\code{\link{element_blank}} +\code{\link{a_element_blank}} -\code{\link{element_line}} +\code{\link{a_element_line}} -\code{\link{element_rect}} +\code{\link{a_element_rect}} -\code{\link{element_text}} +\code{\link{a_element_text}} } - diff --git a/man/a_theme_update.Rd b/man/a_theme_update.Rd new file mode 100644 index 0000000000..e6320f11c7 --- /dev/null +++ b/man/a_theme_update.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/theme.r +\name{a_theme_update} +\alias{a_theme_update} +\alias{a_theme_replace} +\alias{a_theme_get} +\alias{a_theme_set} +\title{Get, set and update themes.} +\usage{ +a_theme_update(...) + +a_theme_replace(...) + +a_theme_get() + +a_theme_set(new) +} +\arguments{ +\item{...}{named list of theme settings} + +\item{new}{new theme (a list of theme elements)} +} +\description{ +Use \code{a_theme_get} to get the current theme, and \code{a_theme_set} to +completely override it. \code{a_theme_update} and \code{a_theme_replace} are +shorthands for changing individual elements in the current theme. +\code{a_theme_update} uses the \code{+} operator, so that any unspecified +values in the theme element will default to the values they are set in the +theme. \code{a_theme_replace} will completely replace the element, so any +unspecified values will overwrite the current value in the theme with \code{NULL}s. +} +\examples{ +p <- a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point() +p +old <- a_theme_set(a_theme_bw()) +p +a_theme_set(old) +p + +#a_theme_replace NULLs out the fill attribute of panel.background, +#resulting in a white background: +a_theme_get()$panel.background +old <- a_theme_replace(panel.background = a_element_rect(colour = "pink")) +a_theme_get()$panel.background +p +a_theme_set(old) + +#a_theme_update only changes the colour attribute, leaving the others intact: +old <- a_theme_update(panel.background = a_element_rect(colour = "pink")) +a_theme_get()$panel.background +p +a_theme_set(old) + +a_theme_get() + + +a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point(a_aes(color = mpg)) + + a_theme(legend.a_position = c(0.95, 0.95), + legend.justification = c(1, 1)) +last_plot() + + a_theme(legend.background = a_element_rect(fill = "white", colour = "white", size = 3)) + +} +\seealso{ +\code{\link{\%+replace\%}} and \code{\link{+.aaa}} +} diff --git a/man/a_train_layout.Rd b/man/a_train_layout.Rd new file mode 100644 index 0000000000..0fbb4be1b9 --- /dev/null +++ b/man/a_train_layout.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/panel.r +\name{a_train_layout} +\alias{a_train_layout} +\title{Learn the layout of panels within a plot.} +\usage{ +a_train_layout(panel, a_facet, data, plot_data) +} +\arguments{ +\item{panel}{the panel object to train} + +\item{a_facet}{the facetting specification} + +\item{data}{a list of data frames (one for each a_layer), and one for the plot} + +\item{plot_data}{the default data frame} +} +\value{ +an updated panel object +} +\description{ +This is determined by the facet, which returns a data frame, than +when joined to the data to be plotted tells us which panel it should +appear in, where that panel appears in the grid, and what scales it +uses. +} +\details{ +As well as the layout info, this function also adds empty lists in which +to house the x and y scales. +} +\keyword{internal} diff --git a/man/zeroGrob.Rd b/man/a_zeroGrob.Rd similarity index 82% rename from man/zeroGrob.Rd rename to man/a_zeroGrob.Rd index 0de1127669..d89abac706 100644 --- a/man/zeroGrob.Rd +++ b/man/a_zeroGrob.Rd @@ -1,13 +1,12 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/grob-null.r -\name{zeroGrob} -\alias{zeroGrob} +\name{a_zeroGrob} +\alias{a_zeroGrob} \title{The zero grob draws nothing and has zero size.} \usage{ -zeroGrob() +a_zeroGrob() } \description{ The zero grob draws nothing and has zero size. } \keyword{internal} - diff --git a/man/gg-add.Rd b/man/aaa-add.Rd similarity index 52% rename from man/gg-add.Rd rename to man/aaa-add.Rd index f72e242b74..022710a8ab 100644 --- a/man/gg-add.Rd +++ b/man/aaa-add.Rd @@ -1,42 +1,42 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot-construction.r, R/theme.r -\name{+.gg} -\alias{+.gg} +\name{+.aaa} +\alias{+.aaa} \alias{\%+\%} \alias{\%+replace\%} -\title{Add a new component to a ggplot or theme object.} +\title{Add a new component to a a_plot or theme object.} \usage{ -\method{+}{gg}(e1, e2) +\method{+}{aaa}(e1, e2) e1 \%+\% e2 e1 \%+replace\% e2 } \arguments{ -\item{e1}{An object of class \code{ggplot} or \code{theme}} +\item{e1}{An object of class \code{a_plot} or \code{a_theme}} \item{e2}{A component to add to \code{e1}} } \description{ -This operator allows you to add objects to a ggplot or theme object. +This operator allows you to add objects to a a_plot or theme object. } \details{ -If the first object is an object of class \code{ggplot}, you can add -the following types of objects, and it will return a modified ggplot +If the first object is an object of class \code{a_plot}, you can add +the following types of objects, and it will return a modified a_plot object. \itemize{ \item \code{data.frame}: replace current data.frame (must use \code{\%+\%}) \item \code{uneval}: replace current aesthetics - \item \code{layer}: add new layer - \item \code{theme}: update plot theme - \item \code{scale}: replace current scale - \item \code{coord}: override current coordinate system - \item \code{facet}: override current coordinate faceting + \item \code{a_layer}: add new a_layer + \item \code{a_theme}: update plot theme + \item \code{a_scale}: replace current a_scale + \item \code{a_coord}: override current coordinate system + \item \code{a_facet}: override current coordinate faceting } -If the first object is an object of class \code{theme}, you can add +If the first object is an object of class \code{a_theme}, you can add another theme object. This will return a modified theme object. For theme objects, the \code{+} operator and the \code{\%+replace\%} @@ -45,7 +45,7 @@ can be used to modify elements in themes. The \code{+} operator updates the elements of e1 that differ from elements specified (not NULL) in e2. Thus this operator can be used to incrementally add or modify attributes -of a ggplot theme. +of a a_plot theme. In contrast, the \code{\%+replace\%} operator replaces the entire element; any element of a theme not specified in e2 will not be @@ -53,14 +53,14 @@ present in the resulting theme (i.e. NULL). Thus this operator can be used to overwrite an entire theme. } \examples{ -### Adding objects to a ggplot object -p <- ggplot(mtcars, aes(wt, mpg, colour = disp)) + - geom_point() +### Adding objects to a a_plot object +p <- a_plot(mtcars, a_aes(wt, mpg, colour = disp)) + + a_geom_point() p -p + coord_cartesian(ylim = c(0, 40)) -p + scale_colour_continuous(breaks = c(100, 300)) -p + guides(colour = "colourbar") +p + ggplot2Animint:::a_coord_cartesian(ylim = c(0, 40)) +p + a_scale_colour_continuous(breaks = c(100, 300)) +p + a_guides(colour = "colourbar") # Use a different data frame m <- mtcars[1:10, ] @@ -68,14 +68,13 @@ p \%+\% m ### Adding objects to a theme object # Compare these results of adding theme objects to other theme objects -add_el <- theme_grey() + theme(text = element_text(family = "Times")) -rep_el <- theme_grey() \%+replace\% theme(text = element_text(family = "Times")) +add_el <- a_theme_grey() + a_theme(text = a_element_text(family = "Times")) +rep_el <- a_theme_grey() \%+replace\% a_theme(text = a_element_text(family = "Times")) add_el$text rep_el$text } \seealso{ -\code{\link{theme}} +\code{\link{a_theme}} } - diff --git a/man/aatheme.Rd b/man/aatheme.Rd new file mode 100644 index 0000000000..5122dcd85d --- /dev/null +++ b/man/aatheme.Rd @@ -0,0 +1,92 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/theme-defaults.r +\name{aatheme} +\alias{aatheme} +\alias{a_theme_grey} +\alias{a_theme_gray} +\alias{a_theme_bw} +\alias{a_theme_linedraw} +\alias{a_theme_light} +\alias{a_theme_minimal} +\alias{a_theme_classic} +\alias{a_theme_dark} +\alias{a_theme_void} +\title{ggplot2 themes} +\usage{ +a_theme_grey(base_size = 11, base_family = "") + +a_theme_gray(base_size = 11, base_family = "") + +a_theme_bw(base_size = 12, base_family = "") + +a_theme_linedraw(base_size = 12, base_family = "") + +a_theme_light(base_size = 12, base_family = "") + +a_theme_minimal(base_size = 12, base_family = "") + +a_theme_classic(base_size = 12, base_family = "") + +a_theme_dark(base_size = 12, base_family = "") + +a_theme_void(base_size = 12, base_family = "") +} +\arguments{ +\item{base_size}{base font size} + +\item{base_family}{base font family} +} +\description{ +Themes set the general aspect of the plot such as the colour of the +background, gridlines, the size and colour of fonts. +} +\details{ +\describe{ + +\item{\code{a_theme_gray}}{ +The signature ggplot2 theme with a grey background and white gridlines, +designed to put the data forward yet make comparisons easy.} + +\item{\code{a_theme_bw}}{ +The classic dark-on-light ggplot2 theme. May work better for presentations +displayed with a projector.} + +\item{\code{a_theme_linedraw}}{ +A theme with only black lines of various widths on white backgrounds, +reminiscent of a line drawings. Serves a purpose similar to \code{a_theme_bw}. +Note that this theme has some very thin lines (<< 1 pt) which some journals +may refuse.} + +\item{\code{a_theme_light}}{ +A theme similar to \code{a_theme_linedraw} but with light grey lines and axes, +to direct more attention towards the data.} + +\item{\code{a_theme_dark}}{ +The dark cousin of \code{a_theme_light}, with similar line sizes but a dark background. Useful to make thin coloured lines pop out.} + +\item{\code{a_theme_minimal}}{ +A minimalistic theme with no background annotations.} + +\item{\code{a_theme_classic}}{ +A classic-looking theme, with x and y axis lines and no gridlines.} + +\item{\code{a_theme_void}}{ +A completely empty theme.} + +} +} +\examples{ +p <- a_plot(mtcars) + a_geom_point(a_aes(x = wt, y = mpg, + colour = factor(gear))) + ggplot2Animint:::a_facet_wrap(~am) + +p +p + a_theme_gray() +p + a_theme_bw() +p + a_theme_linedraw() +p + a_theme_light() +p + a_theme_dark() +p + a_theme_minimal() +p + a_theme_classic() +p + a_theme_void() + +} diff --git a/man/absoluteGrob.Rd b/man/absoluteGrob.Rd index dae8332c6f..5c908a9edb 100644 --- a/man/absoluteGrob.Rd +++ b/man/absoluteGrob.Rd @@ -2,16 +2,28 @@ % Please edit documentation in R/grob-absolute.r \name{absoluteGrob} \alias{absoluteGrob} -\title{Absolute grob} +\title{Absolute grob +This grob has fixed dimensions and position. +It's still experimental} \usage{ absoluteGrob(grob, width = NULL, height = NULL, xmin = NULL, ymin = NULL, vp = NULL) } +\arguments{ +\item{grob}{....} + +\item{width}{.....} + +\item{height}{.....} + +\item{xmin}{......} + +\item{ymin}{.......} + +\item{vp}{....} +} \description{ +Absolute grob This grob has fixed dimensions and position. -} -\details{ It's still experimental } -\keyword{internal} - diff --git a/man/add_theme.Rd b/man/add_a_theme.Rd similarity index 85% rename from man/add_theme.Rd rename to man/add_a_theme.Rd index 9c3680e0cc..c52185b169 100644 --- a/man/add_theme.Rd +++ b/man/add_a_theme.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/theme.r -\name{add_theme} -\alias{add_theme} +\name{add_a_theme} +\alias{add_a_theme} \title{Modify properties of an element in a theme object} \usage{ -add_theme(t1, t2, t2name) +add_a_theme(t1, t2, t2name) } \arguments{ \item{t1}{A theme object} @@ -18,6 +18,5 @@ informative error messages.} Modify properties of an element in a theme object } \seealso{ -+.gg ++.aaa } - diff --git a/man/aes_.Rd b/man/aes_.Rd deleted file mode 100644 index c8af6658f2..0000000000 --- a/man/aes_.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/aes.r -\name{aes_} -\alias{aes_} -\alias{aes_q} -\alias{aes_string} -\title{Define aesthetic mappings from strings, or quoted calls and formulas.} -\usage{ -aes_(x, y, ...) - -aes_string(x, y, ...) - -aes_q(x, y, ...) -} -\arguments{ -\item{x, y, ...}{List of name value pairs. Elements must be either -quoted calls, strings, one-sided formulas or constants.} -} -\description{ -Aesthetic mappings describe how variables in the data are mapped to visual -properties (aesthetics) of geoms. \code{\link{aes}} uses non-standard -evaluation to capture the variable names. \code{aes_} and \code{aes_string} -require you to explicitly quote the inputs either with \code{""} for -\code{aes_string()}, or with \code{quote} or \code{~} for \code{aes_()}. -(\code{aes_q} is an alias to \code{aes_}) -} -\details{ -It's better to use \code{aes_q()}, because there's no easy way to create the -equivalent to \code{aes(colour = "my colour")} or \code{aes{x = `X$1`}} -with \code{aes_string()}. - -\code{aes_string} and \code{aes_} are particularly useful when writing -functions that create plots because you can use strings or quoted -names/calls to define the aesthetic mappings, rather than having to use -\code{\link{substitute}} to generate a call to \code{aes()}. -} -\examples{ -# Three ways of generating the same aesthetics -aes(mpg, wt, col = cyl) -aes_(quote(mpg), quote(wt), col = quote(cyl)) -aes_(~mpg, ~wt, col = ~cyl) -aes_string("mpg", "wt", col = "cyl") - -# You can't easily mimic these calls with aes_string -aes(`$100`, colour = "smooth") -aes_(~ `$100`, colour = "smooth") -# Ok, you can, but it requires a _lot_ of quotes -aes_string("`$100`", colour = '"smooth"') - -# Convert strings to names with as.name -var <- "cyl" -aes(col = x) -aes_(col = as.name(var)) -} -\seealso{ -\code{\link{aes}} -} - diff --git a/man/annotation_map.Rd b/man/annotation_map.Rd deleted file mode 100644 index 2b2928a200..0000000000 --- a/man/annotation_map.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/annotation-map.r -\name{annotation_map} -\alias{annotation_map} -\title{Annotation: maps.} -\usage{ -annotation_map(map, ...) -} -\arguments{ -\item{map}{data frame representing a map. Most map objects can be -converted into the right format by using \code{\link{fortify}}} - -\item{...}{other arguments used to modify aesthetics} -} -\description{ -Annotation: maps. -} -\examples{ -if (require("maps")) { -usamap <- map_data("state") - -seal.sub <- subset(seals, long > -130 & lat < 45 & lat > 40) -ggplot(seal.sub, aes(x = long, y = lat)) + - annotation_map(usamap, fill = "NA", colour = "grey50") + - geom_segment(aes(xend = long + delta_long, yend = lat + delta_lat)) - -seal2 <- transform(seal.sub, - latr = cut(lat, 2), - longr = cut(long, 2)) - -ggplot(seal2, aes(x = long, y = lat)) + - annotation_map(usamap, fill = "NA", colour = "grey50") + - geom_segment(aes(xend = long + delta_long, yend = lat + delta_lat)) + - facet_grid(latr ~ longr, scales = "free", space = "free") -} -} - diff --git a/man/as.list.ggproto.Rd b/man/as.list.a_ggproto.Rd similarity index 67% rename from man/as.list.ggproto.Rd rename to man/as.list.a_ggproto.Rd index 8b0a64e823..bf49efa5ce 100644 --- a/man/as.list.ggproto.Rd +++ b/man/as.list.a_ggproto.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggproto.r -\name{as.list.ggproto} -\alias{as.list.ggproto} -\title{Convert a ggproto object to a list} +\name{as.list.a_ggproto} +\alias{as.list.a_ggproto} +\title{Convert a a_ggproto object to a list} \usage{ -\method{as.list}{ggproto}(x, inherit = TRUE, ...) +\method{as.list}{a_ggproto}(x, inherit = TRUE, ...) } \arguments{ -\item{x}{A ggproto object to convert to a list.} +\item{x}{A a_ggproto object to convert to a list.} \item{inherit}{If \code{TRUE} (the default), flatten all inherited items into the returned list. If \code{FALSE}, do not include any inherited items.} @@ -17,4 +17,3 @@ the returned list. If \code{FALSE}, do not include any inherited items.} \description{ This will not include the object's \code{super} member. } - diff --git a/man/as_labeller.Rd b/man/as_labeller.Rd index 20c105b66c..1006c7a952 100644 --- a/man/as_labeller.Rd +++ b/man/as_labeller.Rd @@ -4,7 +4,7 @@ \alias{as_labeller} \title{Coerce to labeller function} \usage{ -as_labeller(x, default = label_value, multi_line = TRUE) +as_labeller(x, default = a_label_value, multi_line = TRUE) } \arguments{ \item{x}{Object to coerce to a labeller function. If a named @@ -24,23 +24,22 @@ This transforms objects to labeller functions. Used internally by \code{\link{labeller}()}. } \examples{ -p <- ggplot(mtcars, aes(disp, drat)) + geom_point() -p + facet_wrap(~am) +p <- a_plot(mtcars, a_aes(disp, drat)) + a_geom_point() +p + ggplot2Animint:::a_facet_wrap(~am) # Rename labels on the fly with a lookup character vector to_string <- as_labeller(c(`0` = "Zero", `1` = "One")) -p + facet_wrap(~am, labeller = to_string) +p + ggplot2Animint:::a_facet_wrap(~am, labeller = to_string) # Quickly transform a function operating on character vectors to a # labeller function: appender <- function(string, suffix = "-foo") paste0(string, suffix) -p + facet_wrap(~am, labeller = as_labeller(appender)) +p + ggplot2Animint:::a_facet_wrap(~am, labeller = as_labeller(appender)) # If you have more than one facetting variable, be sure to dispatch # your labeller to the right variable with labeller() -p + facet_grid(cyl ~ am, labeller = labeller(am = to_string)) +p + ggplot2Animint:::a_facet_grid(cyl ~ am, labeller = labeller(am = to_string)) } \seealso{ \code{\link{labeller}()}, \link{labellers} } - diff --git a/man/autoplot.Rd b/man/autoplot.Rd index 6899d56acc..7880b45b73 100644 --- a/man/autoplot.Rd +++ b/man/autoplot.Rd @@ -20,6 +20,6 @@ particular class in a single command. This defines the S3 generic that other classes and packages can extend. } \seealso{ -\code{\link{ggplot}} and \code{\link{fortify}} +\code{\link{a_plot}} and \code{\link{a_fortify}} } - +\keyword{internal} diff --git a/man/borders.Rd b/man/borders.Rd index c54b8f9230..590ddbde89 100644 --- a/man/borders.Rd +++ b/man/borders.Rd @@ -19,7 +19,7 @@ borders(database = "world", regions = ".", fill = NA, colour = "grey50", \item{xlim, ylim}{latitudinal and logitudinal range for extracting map polygons, see \code{\link[maps]{map}} for details.} -\item{...}{other arguments passed onto \code{\link{geom_polygon}}} +\item{...}{other arguments passed onto \code{\link{a_geom_polygon}}} } \description{ Create a layer of map borders. @@ -30,24 +30,24 @@ if (require("maps")) { ia <- map_data("county", "iowa") mid_range <- function(x) mean(range(x)) seats <- plyr::ddply(ia, "subregion", plyr::colwise(mid_range, c("lat", "long"))) -ggplot(ia, aes(long, lat)) + - geom_polygon(aes(group = group), fill = NA, colour = "grey60") + - geom_text(aes(label = subregion), data = seats, size = 2, angle = 45) +a_plot(ia, a_aes(long, lat)) + + a_geom_polygon(a_aes(group = group), fill = NA, colour = "grey60") + + a_geom_text(a_aes(label = subregion), data = seats, size = 2, angle = 45) data(us.cities) capitals <- subset(us.cities, capital == 2) -ggplot(capitals, aes(long, lat)) + - borders("state") + - geom_point(aes(size = pop)) + - scale_size_area() + - coord_quickmap() +a_plot(capitals, a_aes(long, lat)) + + ggplot2Animint:::borders("state") + + a_geom_point(a_aes(size = pop)) + + a_scale_size_area() + + ggplot2Animint:::a_coord_quickmap() # Same map, with some world context -ggplot(capitals, aes(long, lat)) + - borders("world", xlim = c(-130, -60), ylim = c(20, 50)) + - geom_point(aes(size = pop)) + - scale_size_area() + - coord_quickmap() +a_plot(capitals, a_aes(long, lat)) + + ggplot2Animint:::borders("world", xlim = c(-130, -60), ylim = c(20, 50)) + + a_geom_point(a_aes(size = pop)) + + a_scale_size_area() + + ggplot2Animint:::a_coord_quickmap() } } - +\keyword{internal} diff --git a/man/continuous_scale.Rd b/man/continuous_a_scale.Rd similarity index 83% rename from man/continuous_scale.Rd rename to man/continuous_a_scale.Rd index d135fe1e22..b856a5efd4 100644 --- a/man/continuous_scale.Rd +++ b/man/continuous_a_scale.Rd @@ -1,18 +1,18 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-.r -\name{continuous_scale} -\alias{continuous_scale} +\name{continuous_a_scale} +\alias{continuous_a_scale} \title{Continuous scale constructor.} \usage{ -continuous_scale(aesthetics, scale_name, palette, name = waiver(), - breaks = waiver(), minor_breaks = waiver(), labels = waiver(), +continuous_a_scale(a_aesthetics, a_scale_name, palette, name = waiver(), + breaks = waiver(), minor_breaks = waiver(), a_labels = waiver(), limits = NULL, rescaler = rescale, oob = censor, expand = waiver(), - na.value = NA_real_, trans = "identity", guide = "legend") + na.value = NA_real_, trans = "identity", a_guide = "legend") } \arguments{ -\item{aesthetics}{the names of the aesthetics that this scale works with} +\item{a_aesthetics}{the names of the aesthetics that this scale works with} -\item{scale_name}{the name of the scale} +\item{a_scale_name}{the name of the scale} \item{palette}{a palette function that when called with a single integer argument (the number of levels in the scale) returns the values that @@ -39,7 +39,7 @@ mapping used for that aesthetic.} \item A function that given the limits returns a vector of minor breaks. }} -\item{labels}{One of: \itemize{ +\item{a_labels}{One of: \itemize{ \item \code{NULL} for no labels \item \code{waiver()} for the default labels computed by the transformation object @@ -52,7 +52,7 @@ mapping used for that aesthetic.} Use \code{NA} to refer to the existing minimum or maximum.} \item{rescaler}{Used by diverging and n colour gradients -(i.e. \code{\link{scale_colour_gradient2}}, \code{\link{scale_colour_gradientn}}). +(i.e. \code{\link{a_scale_colour_gradient2}}, \code{\link{a_scale_colour_gradientn}}). A function used to scale the input values to the range [0, 1].} \item{oob}{Function that handles limits outside of the scale limits @@ -77,10 +77,8 @@ discrete variables.} \code{\link[scales]{boxcox_trans}}. You can create your own transformation with \code{\link[scales]{trans_new}}.} -\item{guide}{Name of guide object, or object itself.} +\item{a_guide}{Name of guide object, or object itself.} } \description{ Continuous scale constructor. } -\keyword{internal} - diff --git a/man/cut_interval.Rd b/man/cut_interval.Rd index 27ef250c1d..2073898e72 100644 --- a/man/cut_interval.Rd +++ b/man/cut_interval.Rd @@ -51,11 +51,10 @@ table(cut_width(runif(1000), 0.1)) table(cut_width(runif(1000), 0.1, boundary = 0)) table(cut_width(runif(1000), 0.1, center = 0)) } +\seealso{ +\code{\link{cut_number}} +} \author{ Randall Prium contributed most of the implementation of \code{cut_width}. } -\seealso{ -\code{\link{cut_number}} -} - diff --git a/man/diamonds.Rd b/man/diamonds.Rd index 08e61e9c2a..2c2cf93ce1 100644 --- a/man/diamonds.Rd +++ b/man/diamonds.Rd @@ -26,4 +26,3 @@ A dataset containing the prices and other attributes of almost 54,000 diamonds. The variables are as follows: } \keyword{datasets} - diff --git a/man/discrete_scale.Rd b/man/discrete_a_scale.Rd similarity index 77% rename from man/discrete_scale.Rd rename to man/discrete_a_scale.Rd index 46b4a9e4f3..b3c1a7d299 100644 --- a/man/discrete_scale.Rd +++ b/man/discrete_a_scale.Rd @@ -1,17 +1,17 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-.r -\name{discrete_scale} -\alias{discrete_scale} +\name{discrete_a_scale} +\alias{discrete_a_scale} \title{Discrete scale constructor.} \usage{ -discrete_scale(aesthetics, scale_name, palette, name = waiver(), - breaks = waiver(), labels = waiver(), limits = NULL, - expand = waiver(), na.value = NA, drop = TRUE, guide = "legend") +discrete_a_scale(a_aesthetics, a_scale_name, palette, name = waiver(), + breaks = waiver(), a_labels = waiver(), limits = NULL, + expand = waiver(), na.value = NA, drop = TRUE, a_guide = "legend") } \arguments{ -\item{aesthetics}{the names of the aesthetics that this scale works with} +\item{a_aesthetics}{the names of the aesthetics that this scale works with} -\item{scale_name}{the name of the scale} +\item{a_scale_name}{the name of the scale} \item{palette}{a palette function that when called with a single integer argument (the number of levels in the scale) returns the values that @@ -34,7 +34,7 @@ types of input: This parameter does not affect in any way how the data is scaled - it only affects the appearance of the legend.} -\item{labels}{\code{NULL} for no labels, \code{waiver()} for default +\item{a_labels}{\code{NULL} for no labels, \code{waiver()} for default labels (labels the same as breaks), a character vector the same length as breaks, or a named character vector whose names are used to match replacement the labels for matching breaks.} @@ -53,11 +53,9 @@ for discrete scales and (0.05,0) for continuous scales.} The default, \code{TRUE}, uses the levels that appear in the data; \code{FALSE} uses all the levels in the factor.} -\item{guide}{the name of, or actual function, used to create the -guide. See \code{\link{guides}} for more info.} +\item{a_guide}{the name of, or actual function, used to create the +a_guide. See \code{\link{a_guides}} for more info.} } \description{ Discrete scale constructor. } -\keyword{internal} - diff --git a/man/dist_central_angle.Rd b/man/dist_central_angle.Rd new file mode 100644 index 0000000000..80c7c49040 --- /dev/null +++ b/man/dist_central_angle.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/coord-munch.r +\name{dist_central_angle} +\alias{dist_central_angle} +\title{Compute central angle between two points. +Multiple by radius of sphere to get great circle distance} +\usage{ +dist_central_angle(lon, lat) +} +\arguments{ +\item{lon}{longitude} + +\item{lat}{latitude} +} +\description{ +Compute central angle between two points. +Multiple by radius of sphere to get great circle distance +} diff --git a/man/draw_key.Rd b/man/draw_key.Rd deleted file mode 100644 index aa01550353..0000000000 --- a/man/draw_key.Rd +++ /dev/null @@ -1,68 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/legend-draw.r -\name{draw_key} -\alias{draw_key} -\alias{draw_key_abline} -\alias{draw_key_blank} -\alias{draw_key_boxplot} -\alias{draw_key_crossbar} -\alias{draw_key_dotplot} -\alias{draw_key_label} -\alias{draw_key_path} -\alias{draw_key_point} -\alias{draw_key_pointrange} -\alias{draw_key_polygon} -\alias{draw_key_rect} -\alias{draw_key_smooth} -\alias{draw_key_text} -\alias{draw_key_vline} -\alias{draw_key_vpath} -\title{Key drawing functions} -\usage{ -draw_key_point(data, params, size) - -draw_key_abline(data, params, size) - -draw_key_rect(data, params, size) - -draw_key_polygon(data, params, size) - -draw_key_blank(data, params, size) - -draw_key_boxplot(data, params, size) - -draw_key_crossbar(data, params, size) - -draw_key_path(data, params, size) - -draw_key_vpath(data, params, size) - -draw_key_dotplot(data, params, size) - -draw_key_pointrange(data, params, size) - -draw_key_smooth(data, params, size) - -draw_key_text(data, params, size) - -draw_key_label(data, params, size) - -draw_key_vline(data, params, size) -} -\arguments{ -\item{data}{A single row data frame containing the scaled aesthetics to -display in this key} - -\item{params}{A list of additional parameters supplied to the geom.} - -\item{size}{Width and height of key in mm.} -} -\value{ -A grid grob. -} -\description{ -Each Geom has an associated function that draws the key when the geom needs -to be displayed in a legend. These are the options built into ggplot2. -} -\keyword{internal} - diff --git a/man/economics.Rd b/man/economics.Rd index 921a79bc11..3074e066d5 100644 --- a/man/economics.Rd +++ b/man/economics.Rd @@ -30,4 +30,3 @@ This dataset was produced from US economic time series data available from format, \code{economics_long} is in "long" format. } \keyword{datasets} - diff --git a/man/expand_limits.Rd b/man/expand_limits.Rd index 1759ffc593..aec6de3f25 100644 --- a/man/expand_limits.Rd +++ b/man/expand_limits.Rd @@ -12,19 +12,18 @@ should be included in each scale.} } \description{ panels or all plots. This function is a thin wrapper around -\code{\link{geom_blank}} that makes it easy to add such values. +\code{\link{a_geom_blank}} that makes it easy to add such values. } \examples{ -p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() +p <- a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() p + expand_limits(x = 0) p + expand_limits(y = c(1, 9)) p + expand_limits(x = 0, y = 0) -ggplot(mtcars, aes(mpg, wt)) + - geom_point(aes(colour = cyl)) + +a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point(a_aes(colour = cyl)) + expand_limits(colour = seq(2, 10, by = 2)) -ggplot(mtcars, aes(mpg, wt)) + - geom_point(aes(colour = factor(cyl))) + +a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point(a_aes(colour = factor(cyl))) + expand_limits(colour = factor(seq(2, 10, by = 2))) } - diff --git a/man/faithfuld.Rd b/man/faithfuld.Rd index 1f75e913ee..440b3999d1 100644 --- a/man/faithfuld.Rd +++ b/man/faithfuld.Rd @@ -13,4 +13,3 @@ A 2d density estimate of the waiting and eruptions variables data \link{faithful}. } \keyword{datasets} - diff --git a/man/figures/README-Example-1.png b/man/figures/README-Example-1.png new file mode 100644 index 0000000000..e26c700186 Binary files /dev/null and b/man/figures/README-Example-1.png differ diff --git a/man/find_line_formula.Rd b/man/find_line_formula.Rd new file mode 100644 index 0000000000..e60b67d877 --- /dev/null +++ b/man/find_line_formula.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/coord-munch.r +\name{find_line_formula} +\alias{find_line_formula} +\title{Given n points, find the slope, xintercept, and yintercept of +the lines connecting them.} +\usage{ +find_line_formula(x, y) +} +\arguments{ +\item{x}{A vector of x values} + +\item{y}{A vector of y values} +} +\description{ +This returns a data frame with length(x)-1 rows +} +\examples{ +find_line_formula(c(4, 7), c(1, 5)) +find_line_formula(c(4, 7, 9), c(1, 5, 3)) +} diff --git a/man/format.ggproto.Rd b/man/format.a_ggproto.Rd similarity index 55% rename from man/format.ggproto.Rd rename to man/format.a_ggproto.Rd index e2c12ecf8f..7662d00bb7 100644 --- a/man/format.ggproto.Rd +++ b/man/format.a_ggproto.Rd @@ -1,21 +1,20 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggproto.r -\name{format.ggproto} -\alias{format.ggproto} -\title{Format a ggproto object} +\name{format.a_ggproto} +\alias{format.a_ggproto} +\title{Format a a_ggproto object} \usage{ -\method{format}{ggproto}(x, ..., flat = TRUE) +\method{format}{a_ggproto}(x, ..., flat = TRUE) } \arguments{ -\item{x}{A ggproto object to print.} +\item{x}{A a_ggproto object to print.} -\item{...}{If the ggproto object has a \code{print} method, further arguments +\item{...}{If the a_ggproto object has a \code{print} method, further arguments will be passed to it. Otherwise, these arguments are unused.} \item{flat}{If \code{TRUE} (the default), show a flattened list of all local and inherited members. If \code{FALSE}, show the inheritance hierarchy.} } \description{ -Format a ggproto object +Format a a_ggproto object } - diff --git a/man/fortify-multcomp.Rd b/man/fortify-multcomp.Rd deleted file mode 100644 index b2174c2bc2..0000000000 --- a/man/fortify-multcomp.Rd +++ /dev/null @@ -1,51 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fortify-multcomp.r -\name{fortify-multcomp} -\alias{fortify-multcomp} -\alias{fortify.cld} -\alias{fortify.confint.glht} -\alias{fortify.glht} -\alias{fortify.summary.glht} -\title{Fortify methods for objects produced by \pkg{multcomp}} -\usage{ -\method{fortify}{glht}(model, data, ...) - -\method{fortify}{confint.glht}(model, data, ...) - -\method{fortify}{summary.glht}(model, data, ...) - -\method{fortify}{cld}(model, data, ...) -} -\arguments{ -\item{model}{an object of class \code{glht}, \code{confint.glht}, -\code{summary.glht} or \code{\link[multcomp]{cld}}} - -\item{data, ...}{other arguments to the generic ignored in this method.} -} -\description{ -Fortify methods for objects produced by \pkg{multcomp} -} -\examples{ -if (require("multcomp")) { -amod <- aov(breaks ~ wool + tension, data = warpbreaks) -wht <- glht(amod, linfct = mcp(tension = "Tukey")) - -fortify(wht) -ggplot(wht, aes(lhs, estimate)) + geom_point() - -CI <- confint(wht) -fortify(CI) -ggplot(CI, aes(lhs, estimate, ymin = lwr, ymax = upr)) + - geom_pointrange() - -fortify(summary(wht)) -ggplot(mapping = aes(lhs, estimate)) + - geom_linerange(aes(ymin = lwr, ymax = upr), data = CI) + - geom_point(aes(size = p), data = summary(wht)) + - scale_size(trans = "reverse") - -cld <- cld(wht) -fortify(cld) -} -} - diff --git a/man/fortify.lm.Rd b/man/fortify.lm.Rd deleted file mode 100644 index f4e5e3fb2b..0000000000 --- a/man/fortify.lm.Rd +++ /dev/null @@ -1,88 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fortify-lm.r -\name{fortify.lm} -\alias{fortify.lm} -\title{Supplement the data fitted to a linear model with model fit statistics.} -\usage{ -\method{fortify}{lm}(model, data = model$model, ...) -} -\arguments{ -\item{model}{linear model} - -\item{data}{data set, defaults to data used to fit model} - -\item{...}{not used by this method} -} -\value{ -The original data with extra columns: - \item{.hat}{Diagonal of the hat matrix} - \item{.sigma}{Estimate of residual standard deviation when - corresponding observation is dropped from model} - \item{.cooksd}{Cooks distance, \code{\link{cooks.distance}}} - \item{.fitted}{Fitted values of model} - \item{.resid}{Residuals} - \item{.stdresid}{Standardised residuals} -} -\description{ -If you have missing values in your model data, you may need to refit -the model with \code{na.action = na.exclude}. -} -\examples{ -mod <- lm(mpg ~ wt, data = mtcars) -head(fortify(mod)) -head(fortify(mod, mtcars)) - -plot(mod, which = 1) - -ggplot(mod, aes(.fitted, .resid)) + - geom_point() + - geom_hline(yintercept = 0) + - geom_smooth(se = FALSE) - -ggplot(mod, aes(.fitted, .stdresid)) + - geom_point() + - geom_hline(yintercept = 0) + - geom_smooth(se = FALSE) - -ggplot(fortify(mod, mtcars), aes(.fitted, .stdresid)) + - geom_point(aes(colour = factor(cyl))) - -ggplot(fortify(mod, mtcars), aes(mpg, .stdresid)) + - geom_point(aes(colour = factor(cyl))) - -plot(mod, which = 2) -ggplot(mod) + - stat_qq(aes(sample = .stdresid)) + - geom_abline() - -plot(mod, which = 3) -ggplot(mod, aes(.fitted, sqrt(abs(.stdresid)))) + - geom_point() + - geom_smooth(se = FALSE) - -plot(mod, which = 4) -ggplot(mod, aes(seq_along(.cooksd), .cooksd)) + - geom_bar(stat = "identity") - -plot(mod, which = 5) -ggplot(mod, aes(.hat, .stdresid)) + - geom_vline(size = 2, colour = "white", xintercept = 0) + - geom_hline(size = 2, colour = "white", yintercept = 0) + - geom_point() + geom_smooth(se = FALSE) - -ggplot(mod, aes(.hat, .stdresid)) + - geom_point(aes(size = .cooksd)) + - geom_smooth(se = FALSE, size = 0.5) - -plot(mod, which = 6) -ggplot(mod, aes(.hat, .cooksd)) + - geom_vline(xintercept = 0, colour = NA) + - geom_abline(slope = seq(0, 3, by = 0.5), colour = "white") + - geom_smooth(se = FALSE) + - geom_point() - -ggplot(mod, aes(.hat, .cooksd)) + - geom_point(aes(size = .cooksd / .hat)) + - scale_size_area() -} - diff --git a/man/geom_linerange.Rd b/man/geom_linerange.Rd deleted file mode 100644 index 2571bb5694..0000000000 --- a/man/geom_linerange.Rd +++ /dev/null @@ -1,120 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/geom-crossbar.r, R/geom-errorbar.r, R/geom-linerange.r, R/geom-pointrange.r -\name{geom_crossbar} -\alias{geom_crossbar} -\alias{geom_errorbar} -\alias{geom_linerange} -\alias{geom_pointrange} -\title{Vertical intervals: lines, crossbars & errorbars.} -\usage{ -geom_crossbar(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., fatten = 2.5, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) - -geom_errorbar(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) - -geom_linerange(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) - -geom_pointrange(mapping = NULL, data = NULL, stat = "identity", - position = "identity", ..., fatten = 4, na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) -} -\arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or -\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the -default), it is combined with the default mapping at the top level of the -plot. You must supply \code{mapping} if there is no plot mapping.} - -\item{data}{The data to be displayed in this layer. There are three - options: - - If \code{NULL}, the default, the data is inherited from the plot - data as specified in the call to \code{\link{ggplot}}. - - A \code{data.frame}, or other object, will override the plot - data. All objects will be fortified to produce a data frame. See - \code{\link{fortify}} for which variables will be created. - - A \code{function} will be called with a single argument, - the plot data. The return value must be a \code{data.frame.}, and - will be used as the layer data.} - -\item{stat}{The statistical transformation to use on the data for this -layer, as a string.} - -\item{position}{Position adjustment, either as a string, or the result of -a call to a position adjustment function.} - -\item{...}{other arguments passed on to \code{\link{layer}}. These are -often aesthetics, used to set an aesthetic to a fixed value, like -\code{color = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} - -\item{fatten}{A multiplicative factor used to increase the size of the -middle bar in \code{geom_crossbar()} and the middle point in -\code{geom_pointrange()}.} - -\item{na.rm}{If \code{FALSE} (the default), removes missing values with -a warning. If \code{TRUE} silently removes missing values.} - -\item{show.legend}{logical. Should this layer be included in the legends? -\code{NA}, the default, includes if any aesthetics are mapped. -\code{FALSE} never includes, and \code{TRUE} always includes.} - -\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, -rather than combining with them. This is most useful for helper functions -that define both data and aesthetics and shouldn't inherit behaviour from -the default plot specification, e.g. \code{\link{borders}}.} -} -\description{ -Various ways of representing a vertical interval defined by \code{x}, -\code{ymin} and \code{ymax}. -} -\section{Aesthetics}{ - -\Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "linerange")} -} -\examples{ -#' # Create a simple example dataset -df <- data.frame( - trt = factor(c(1, 1, 2, 2)), - resp = c(1, 5, 3, 4), - group = factor(c(1, 2, 1, 2)), - upper = c(1.1, 5.3, 3.3, 4.2), - lower = c(0.8, 4.6, 2.4, 3.6) -) - -p <- ggplot(df, aes(trt, resp, colour = group)) -p + geom_linerange(aes(ymin = lower, ymax = upper)) -p + geom_pointrange(aes(ymin = lower, ymax = upper)) -p + geom_crossbar(aes(ymin = lower, ymax = upper), width = 0.2) -p + geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2) - -# Draw lines connecting group means -p + - geom_line(aes(group = group)) + - geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.2) - -# If you want to dodge bars and errorbars, you need to manually -# specify the dodge width -p <- ggplot(df, aes(trt, resp, fill = group)) -p + - geom_bar(position = "dodge", stat = "identity") + - geom_errorbar(aes(ymin = lower, ymax = upper), position = "dodge", width = 0.25) - -# Because the bars and errorbars have different widths -# we need to specify how wide the objects we are dodging are -dodge <- position_dodge(width=0.9) -p + - geom_bar(position = dodge, stat = "identity") + - geom_errorbar(aes(ymin = lower, ymax = upper), position = dodge, width = 0.25) -} -\seealso{ -\code{\link{stat_summary}} for examples of these guys in use, - \code{\link{geom_smooth}} for continuous analog -} - diff --git a/man/gg_dep.Rd b/man/gg_dep.Rd index d79206f429..3317018869 100644 --- a/man/gg_dep.Rd +++ b/man/gg_dep.Rd @@ -34,4 +34,3 @@ If the current subminor number differs from \code{version}'s subminor number, print a message. } \keyword{internal} - diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd deleted file mode 100644 index 8fb1e01224..0000000000 --- a/man/ggplot2-ggproto.Rd +++ /dev/null @@ -1,290 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/aaa-.r, R/geom-.r, R/annotation-custom.r, R/annotation-logticks.r, R/geom-polygon.r, R/geom-map.r, R/annotation-map.r, R/geom-raster.r, R/annotation-raster.r, R/coord-.r, R/coord-cartesian-.r, R/coord-fixed.r, R/coord-flip.r, R/coord-map.r, R/coord-polar.r, R/coord-quickmap.R, R/coord-transform.r, R/stat-.r, R/geom-abline.r, R/geom-rect.r, R/geom-bar.r, R/geom-blank.r, R/geom-boxplot.r, R/geom-path.r, R/geom-contour.r, R/geom-crossbar.r, R/geom-segment.r, R/geom-curve.r, R/geom-ribbon.r, R/geom-density.r, R/geom-density2d.r, R/geom-dotplot.r, R/geom-errorbar.r, R/geom-errorbarh.r, R/geom-hex.r, R/geom-hline.r, R/geom-label.R, R/geom-linerange.r, R/geom-point.r, R/geom-pointrange.r, R/geom-quantile.r, R/geom-rug.r, R/geom-smooth.r, R/geom-spoke.r, R/geom-text.r, R/geom-tile.r, R/geom-violin.r, R/geom-vline.r, R/position-.r, R/position-dodge.r, R/position-fill.r, R/position-identity.r, R/position-jitter.r, R/position-jitterdodge.R, R/position-nudge.R, R/position-stack.r, R/scale-.r, R/scale-continuous.r, R/scale-date.r, R/scale-discrete-.r, R/scale-identity.r, R/stat-bin.r, R/stat-bin2d.r, R/stat-bindot.r, R/stat-binhex.r, R/stat-boxplot.r, R/stat-contour.r, R/stat-count.r, R/stat-density-2d.r, R/stat-density.r, R/stat-ecdf.r, R/stat-ellipse.R, R/stat-function.r, R/stat-identity.r, R/stat-qq.r, R/stat-quantile.r, R/stat-smooth.r, R/stat-sum.r, R/stat-summary-2d.r, R/stat-summary-bin.R, R/stat-summary-hex.r, R/stat-summary.r, R/stat-unique.r, R/stat-ydensity.r -\docType{data} -\name{ggplot2-ggproto} -\alias{Coord} -\alias{CoordCartesian} -\alias{CoordFixed} -\alias{CoordFlip} -\alias{CoordMap} -\alias{CoordPolar} -\alias{CoordQuickmap} -\alias{CoordTrans} -\alias{Geom} -\alias{GeomAbline} -\alias{GeomAnnotationMap} -\alias{GeomArea} -\alias{GeomBar} -\alias{GeomBlank} -\alias{GeomBoxplot} -\alias{GeomContour} -\alias{GeomCrossbar} -\alias{GeomCurve} -\alias{GeomCustomAnn} -\alias{GeomDensity} -\alias{GeomDensity2d} -\alias{GeomDotplot} -\alias{GeomErrorbar} -\alias{GeomErrorbarh} -\alias{GeomHex} -\alias{GeomHline} -\alias{GeomLabel} -\alias{GeomLine} -\alias{GeomLinerange} -\alias{GeomLogticks} -\alias{GeomMap} -\alias{GeomPath} -\alias{GeomPoint} -\alias{GeomPointrange} -\alias{GeomPolygon} -\alias{GeomQuantile} -\alias{GeomRaster} -\alias{GeomRasterAnn} -\alias{GeomRect} -\alias{GeomRibbon} -\alias{GeomRug} -\alias{GeomSegment} -\alias{GeomSmooth} -\alias{GeomSpoke} -\alias{GeomStep} -\alias{GeomText} -\alias{GeomTile} -\alias{GeomViolin} -\alias{GeomVline} -\alias{Position} -\alias{PositionDodge} -\alias{PositionFill} -\alias{PositionIdentity} -\alias{PositionJitter} -\alias{PositionJitterdodge} -\alias{PositionNudge} -\alias{PositionStack} -\alias{Scale} -\alias{ScaleContinuous} -\alias{ScaleContinuousDate} -\alias{ScaleContinuousDatetime} -\alias{ScaleContinuousIdentity} -\alias{ScaleContinuousPosition} -\alias{ScaleDiscrete} -\alias{ScaleDiscreteIdentity} -\alias{ScaleDiscretePosition} -\alias{Stat} -\alias{StatBin} -\alias{StatBin2d} -\alias{StatBindot} -\alias{StatBinhex} -\alias{StatBoxplot} -\alias{StatContour} -\alias{StatCount} -\alias{StatDensity} -\alias{StatDensity2d} -\alias{StatEcdf} -\alias{StatEllipse} -\alias{StatFunction} -\alias{StatIdentity} -\alias{StatQq} -\alias{StatQuantile} -\alias{StatSmooth} -\alias{StatSum} -\alias{StatSummary} -\alias{StatSummary2d} -\alias{StatSummaryBin} -\alias{StatSummaryHex} -\alias{StatUnique} -\alias{StatYdensity} -\alias{ggplot2-ggproto} -\title{Base ggproto classes for ggplot2} -\description{ -If you are creating a new geom, stat, position, or scale in another package, -you'll need to extend from \code{ggplot2::Geom}, \code{ggplot2::Stat}, -\code{ggplot2::Position}, or \code{ggplot2::Scale}. -} -\section{Geoms}{ - - -All \code{geom_*} functions (like \code{geom_point}) return a layer that -contains a \code{Geom*} object (like \code{GeomPoint}). The \code{Geom*} -object is responsible for rendering the data in the plot. - -Each of the \code{Geom*} objects is a \code{\link{ggproto}} object, descended -from the top-level \code{Geom}, and each implements various methods and -fields. To create a new type of Geom object, you typically will want to -implement one or more of the following: - -Compared to \code{Stat} and \code{Position}, \code{Geom} is a little -different because the execution of the setup and compute functions is -split up. \code{setup_data} runs before position adjustments, and -\code{draw_layer} is not run until render time, much later. This -means there is no \code{setup_params} because it's hard to communicate -the changes. - -\itemize{ - \item Override either \code{draw_panel(self, data, panel_scales, coord)} or - \code{draw_group(self, data, panel_scales, coord)}. \code{draw_panel} is - called once per panel, \code{draw_group} is called once per group. - - Use \code{draw_panel} if each row in the data represents a - single element. Use \code{draw_group} if each group represents - an element (e.g. a smooth, a violin). - - \code{data} is a data frame of scaled aesthetics. \code{panel_scales} - is a list containing information about the scales in the current - panel. \code{coord} is a coordinate specification. You'll - need to call \code{coord$transform(data, panel_scales)} to work - with non-Cartesian coords. To work with non-linear coordinate systems, - you typically need to convert into a primitive geom (e.g. point, path - or polygon), and then pass on to the corresponding draw method - for munching. - - Must return a grob. Use \code{\link{zeroGrob}} if there's nothing to - draw. - \item \code{draw_key}: Renders a single legend key. - \item \code{required_aes}: A character vector of aesthetics needed to - render the geom. - \item \code{default_aes}: A list (generated by \code{\link{aes}()} of - default values for aesthetics. - \item \code{reparameterise}: Converts width and height to xmin and xmax, - and ymin and ymax values. It can potentially set other values as well. -} -} - -\section{Coordinate systems}{ - - -All \code{coord_*} functions (like \code{coord_trans}) return a \code{Coord*} -object (like \code{CoordTrans}). The \code{Coord*} object is responsible for -adjusting the position of overlapping geoms. - -The way that the \code{coord_*} functions work is slightly different from the -\code{geom_*} and \code{stat_*} functions, because a \code{coord_*} function -actually "instantiates" the \code{Coord*} object by creating a descendant, -and returns that. - -Each of the \code{Coord*} objects is a \code{\link{ggproto}} object, -descended from the top-level \code{Coord}. To create a new type of Coord -object, you typically will want to implement one or more of the following: - -\itemize{ - \item \code{aspect}: Returns the desired aspect ratio for the plot. - \item \code{labels}: Returns a list containing labels for x and y. - \item \code{render_fg}: Renders foreground elements. - \item \code{render_bg}: Renders background elements. - \item \code{render_axis_h}: Renders the horizontal axis. - \item \code{render_axis_v}: Renders the vertical axis. - \item \code{range}: Returns the x and y ranges - \item \code{train}: Return the trained scale ranges. - \item \code{transform}: Transforms x and y coordinates. - \item \code{distance}: Calculates distance. - \item \code{is_linear}: Returns \code{TRUE} if the coordinate system is - linear; \code{FALSE} otherwise. -} -} - -\section{Stats}{ - - -All \code{stat_*} functions (like \code{stat_bin}) return a layer that -contains a \code{Stat*} object (like \code{StatBin}). The \code{Stat*} -object is responsible for rendering the data in the plot. - -Each of the \code{Stat*} objects is a \code{\link{ggproto}} object, descended -from the top-level \code{Stat}, and each implements various methods and -fields. To create a new type of Stat object, you typically will want to -implement one or more of the following: - -\itemize{ - \item Override one of : - \code{compute_layer(self, data, scales, ...)}, - \code{compute_panel(self, data, scales, ...)}, or - \code{compute_group(self, data, scales, ...)}. - - \code{compute_layer()} is called once per layer, \code{compute_panel_()} - is called once per panel, and \code{compute_group()} is called once per - group. All must return a data frame. - - It's usually best to start by overriding \code{compute_group}: if - you find substantial performance optimisations, override higher up. - You'll need to read the source code of the default methods to see - what else you should be doing. - - \code{data} is a data frame containing the variables named according - to the aesthetics that they're mapped to. \code{scales} is a list - containing the \code{x} and \code{y} scales. There functions are called - before the facets are trained, so they are global scales, not local - to the individual panels.\code{...} contains the parameters returned by - \code{setup_params()}. - \item \code{setup_params(data, params)}: called once for each layer. - Used to setup defaults that need to complete dataset, and to inform - the user of important choices. Should return list of parameters. - \item \code{setup_data(data, params)}: called once for each layer, - after \code{setp_params()}. Should return modified \code{data}. - Default methods removes all rows containing a missing value in - required aesthetics (with a warning if \code{!na.rm}). - \item \code{required_aes}: A character vector of aesthetics needed to - render the geom. - \item \code{default_aes}: A list (generated by \code{\link{aes}()} of - default values for aesthetics. -} -} - -\section{Positions}{ - - -All \code{position_*} functions (like \code{position_dodge}) return a -\code{Position*} object (like \code{PositionDodge}). The \code{Position*} -object is responsible for adjusting the position of overlapping geoms. - -The way that the \code{position_*} functions work is slightly different from -the \code{geom_*} and \code{stat_*} functions, because a \code{position_*} -function actually "instantiates" the \code{Position*} object by creating a -descendant, and returns that. - -Each of the \code{Position*} objects is a \code{\link{ggproto}} object, -descended from the top-level \code{Position}, and each implements the -following methods: - -\itemize{ - \item \code{compute_layer(self, data, params, panel)} is called once - per layer. \code{panel} is currently an internal data structure, so - this method should not be overriden. - - \item \code{compute_panel(self, data, params, panel)} is called once per - panel and should return a modified data frame. - - \code{data} is a data frame containing the variables named according - to the aesthetics that they're mapped to. \code{scales} is a list - containing the \code{x} and \code{y} scales. There functions are called - before the facets are trained, so they are global scales, not local - to the individual panels. \code{params} contains the parameters returned by - \code{setup_params()}. - \item \code{setup_params(data, params)}: called once for each layer. - Used to setup defaults that need to complete dataset, and to inform - the user of important choices. Should return list of parameters. - \item \code{setup_data(data, params)}: called once for each layer, - after \code{setp_params()}. Should return modified \code{data}. - Default checks that required aesthetics are present. -} - -And the following fields -\itemize{ - \item \code{required_aes}: a character vector giving the aesthetics - that must be present for this position adjustment to work. -} -} - -\section{Scales}{ - - -All \code{scale_*} functions (like \code{scale_x_continuous}) return a -\code{Scale*} object (like \code{ScaleContinuous}). The \code{Scale*} -object represents a single scale. - -Each of the \code{Scale*} objects is a \code{\link{ggproto}} object, -descended from the top-level \code{Scale}. -} -\seealso{ -ggproto -} -\keyword{datasets} -\keyword{internal} - diff --git a/man/ggplot2Animint-ggproto.Rd b/man/ggplot2Animint-ggproto.Rd new file mode 100644 index 0000000000..5d7e14c814 --- /dev/null +++ b/man/ggplot2Animint-ggproto.Rd @@ -0,0 +1,312 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aaa-.r, R/geom-.r, R/annotation-custom.r, +% R/annotation-logticks.r, R/geom-polygon.r, R/geom-map.r, R/annotation-map.r, +% R/geom-raster.r, R/annotation-raster.r, R/coord-.r, R/coord-cartesian-.r, +% R/coord-fixed.r, R/coord-flip.r, R/coord-map.r, R/coord-polar.r, +% R/coord-quickmap.R, R/coord-transform.r, R/stat-.r, R/geom-abline.r, +% R/geom-rect.r, R/geom-bar.r, R/geom-blank.r, R/geom-boxplot.r, +% R/geom-path.r, R/geom-contour.r, R/geom-crossbar.r, R/geom-segment.r, +% R/geom-curve.r, R/geom-ribbon.r, R/geom-density.r, R/geom-density2d.r, +% R/geom-dotplot.r, R/geom-errorbar.r, R/geom-errorbarh.r, R/geom-hex.r, +% R/geom-hline.r, R/geom-label.R, R/geom-linerange.r, R/geom-point.r, +% R/geom-pointrange.r, R/geom-quantile.r, R/geom-rug.r, R/geom-smooth.r, +% R/geom-spoke.r, R/geom-text.r, R/geom-tile.r, R/geom-violin.r, +% R/geom-vline.r, R/position-.r, R/position-dodge.r, R/position-fill.r, +% R/position-identity.r, R/position-jitter.r, R/position-jitterdodge.R, +% R/position-nudge.R, R/position-stack.r, R/scale-.r, R/scale-continuous.r, +% R/scale-date.r, R/scale-discrete-.r, R/scale-identity.r, R/scales-.r, +% R/stat-bin.r, R/stat-bin2d.r, R/stat-bindot.r, R/stat-binhex.r, +% R/stat-boxplot.r, R/stat-contour.r, R/stat-count.r, R/stat-density-2d.r, +% R/stat-density.r, R/stat-ecdf.r, R/stat-ellipse.R, R/stat-function.r, +% R/stat-identity.r, R/stat-qq.r, R/stat-quantile.r, R/stat-smooth.r, +% R/stat-sum.r, R/stat-summary-2d.r, R/stat-summary-bin.R, +% R/stat-summary-hex.r, R/stat-summary.r, R/stat-unique.r, R/stat-ydensity.r +\docType{data} +\name{ggplot2Animint-ggproto} +\alias{ggplot2Animint-ggproto} +\alias{a_Geom} +\alias{a_GeomCustomAnn} +\alias{a_GeomLogticks} +\alias{a_GeomPolygon} +\alias{a_GeomMap} +\alias{a_GeomAnnotationMap} +\alias{a_GeomRaster} +\alias{a_GeomRasterAnn} +\alias{a_Coord} +\alias{a_CoordCartesian} +\alias{a_CoordFixed} +\alias{a_CoordFlip} +\alias{a_CoordMap} +\alias{a_CoordPolar} +\alias{a_CoordQuickmap} +\alias{a_CoordTrans} +\alias{a_Stat} +\alias{a_GeomAbline} +\alias{a_GeomRect} +\alias{a_GeomBar} +\alias{a_GeomBlank} +\alias{a_GeomBoxplot} +\alias{a_GeomPath} +\alias{a_GeomLine} +\alias{a_GeomStep} +\alias{a_GeomContour} +\alias{a_GeomCrossbar} +\alias{a_GeomSegment} +\alias{a_GeomCurve} +\alias{a_GeomRibbon} +\alias{a_GeomArea} +\alias{a_GeomDensity} +\alias{a_GeomDensity2d} +\alias{a_GeomDotplot} +\alias{a_GeomErrorbar} +\alias{a_GeomErrorbarh} +\alias{a_GeomHex} +\alias{a_GeomHline} +\alias{a_GeomLabel} +\alias{a_GeomLinerange} +\alias{a_GeomPoint} +\alias{a_GeomPointrange} +\alias{a_GeomQuantile} +\alias{a_GeomRug} +\alias{a_GeomSmooth} +\alias{a_GeomSpoke} +\alias{a_GeomText} +\alias{a_GeomTile} +\alias{a_GeomViolin} +\alias{a_GeomVline} +\alias{a_Position} +\alias{a_PositionDodge} +\alias{a_PositionFill} +\alias{a_PositionIdentity} +\alias{a_PositionJitter} +\alias{a_PositionJitterdodge} +\alias{a_PositionNudge} +\alias{a_PositionStack} +\alias{a_Scale} +\alias{a_ScaleContinuous} +\alias{a_ScaleDiscrete} +\alias{a_ScaleContinuousPosition} +\alias{a_ScaleContinuousDatetime} +\alias{a_ScaleContinuousDate} +\alias{a_ScaleDiscretePosition} +\alias{a_ScaleDiscreteIdentity} +\alias{a_ScaleContinuousIdentity} +\alias{a_ScalesList} +\alias{a_StatBin} +\alias{a_StatBin2d} +\alias{a_StatBindot} +\alias{a_StatBinhex} +\alias{a_StatBoxplot} +\alias{a_StatContour} +\alias{a_StatCount} +\alias{a_StatDensity2d} +\alias{a_StatDensity} +\alias{a_StatEcdf} +\alias{a_StatEllipse} +\alias{a_StatFunction} +\alias{a_StatIdentity} +\alias{a_StatQq} +\alias{a_StatQuantile} +\alias{a_StatSmooth} +\alias{a_StatSum} +\alias{a_StatSummary2d} +\alias{a_StatSummaryBin} +\alias{a_StatSummaryHex} +\alias{a_StatSummary} +\alias{a_StatUnique} +\alias{a_StatYdensity} +\title{Base ggproto classes for ggplot2Animint} +\description{ +If you are creating a new geom, stat, position, or scale in another package, +you'll need to extend from \code{ggplot2Animint::a_Geom}, \code{ggplot2Animint::a_Stat}, +\code{ggplot2Animint::a_Position}, or \code{ggplot2Animint::a_Scale}. +} +\section{a_Geoms}{ + + +All \code{a_geom_*} functions (like \code{a_geom_point}) return a layer that +contains a \code{a_Geom*} object (like \code{a_GeomPoint}). The \code{a_Geom*} +object is responsible for rendering the data in the plot. + +Each of the \code{a_Geom*} objects is a \code{\link{a_ggproto}} object, descended +from the top-level \code{a_Geom}, and each implements various methods and +fields. To create a new type of Geom object, you typically will want to +implement one or more of the following: + +Compared to \code{a_Stat} and \code{a_Position}, \code{a_Geom} is a little +different because the execution of the setup and compute functions is +split up. \code{setup_data} runs before position adjustments, and +\code{draw_layer} is not run until render time, much later. This +means there is no \code{setup_params} because it's hard to communicate +the changes. + +\itemize{ + \item Override either \code{draw_panel(self, data, panel_scales, a_coord)} or + \code{draw_group(self, data, panel_scales, a_coord)}. \code{draw_panel} is + called once per panel, \code{draw_group} is called once per group. + + Use \code{draw_panel} if each row in the data represents a + single element. Use \code{draw_group} if each group represents + an element (e.g. a smooth, a violin). + + \code{data} is a data frame of scaled aesthetics. \code{panel_scales} + is a list containing information about the scales in the current + panel. \code{a_coord} is a coordinate specification. You'll + need to call \code{a_coord$transform(data, panel_scales)} to work + with non-Cartesian coords. To work with non-linear coordinate systems, + you typically need to convert into a primitive geom (e.g. point, path + or polygon), and then pass on to the corresponding draw method + for munching. + + Must return a grob. Use \code{\link{a_zeroGrob}} if there's nothing to + draw. + \item \code{draw_key}: Renders a single legend key. + \item \code{required_aes}: A character vector of aesthetics needed to + render the geom. + \item \code{default_aes}: A list (generated by \code{\link{a_aes}()} of + default values for aesthetics. + \item \code{reparameterise}: Converts width and height to xmin and xmax, + and ymin and ymax values. It can potentially set other values as well. +} +} + +\section{a_Coordinate systems}{ + + +All \code{a_coord_*} functions (like \code{a_coord_trans}) return a \code{a_Coord*} +object (like \code{a_CoordTrans}). The \code{a_Coord*} object is responsible for +adjusting the position of overlapping geoms. + +The way that the \code{a_coord_*} functions work is slightly different from the +\code{a_geom_*} and \code{a_stat_*} functions, because a \code{a_coord_*} function +actually "instantiates" the \code{a_Coord*} object by creating a descendant, +and returns that. + +Each of the \code{a_Coord*} objects is a \code{\link{a_ggproto}} object, +descended from the top-level \code{a_Coord}. To create a new type of Coord +object, you typically will want to implement one or more of the following: + +\itemize{ + \item \code{aspect}: Returns the desired aspect ratio for the plot. + \item \code{a_labels}: Returns a list containing labels for x and y. + \item \code{render_fg}: Renders foreground elements. + \item \code{render_bg}: Renders background elements. + \item \code{render_axis_h}: Renders the horizontal axis. + \item \code{render_axis_v}: Renders the vertical axis. + \item \code{range}: Returns the x and y ranges + \item \code{train}: Return the trained scale ranges. + \item \code{transform}: Transforms x and y coordinates. + \item \code{distance}: Calculates distance. + \item \code{is_linear}: Returns \code{TRUE} if the coordinate system is + linear; \code{FALSE} otherwise. +} +} + +\section{a_Stats}{ + + +All \code{a_stat_*} functions (like \code{a_stat_bin}) return a layer that +contains a \code{a_Stat*} object (like \code{a_StatBin}). The \code{a_Stat*} +object is responsible for rendering the data in the plot. + +Each of the \code{a_Stat*} objects is a \code{\link{a_ggproto}} object, descended +from the top-level \code{a_Stat}, and each implements various methods and +fields. To create a new type of Stat object, you typically will want to +implement one or more of the following: + +\itemize{ + \item Override one of : + \code{compute_layer(self, data, scales, ...)}, + \code{compute_panel(self, data, scales, ...)}, or + \code{compute_group(self, data, scales, ...)}. + + \code{compute_layer()} is called once per layer, \code{compute_panel_()} + is called once per panel, and \code{compute_group()} is called once per + group. All must return a data frame. + + It's usually best to start by overriding \code{compute_group}: if + you find substantial performance optimisations, override higher up. + You'll need to read the source code of the default methods to see + what else you should be doing. + + \code{data} is a data frame containing the variables named according + to the aesthetics that they're mapped to. \code{scales} is a list + containing the \code{x} and \code{y} scales. There functions are called + before the facets are trained, so they are global scales, not local + to the individual panels.\code{...} contains the parameters returned by + \code{setup_params()}. + \item \code{setup_params(data, params)}: called once for each layer. + Used to setup defaults that need to complete dataset, and to inform + the user of important choices. Should return list of parameters. + \item \code{setup_data(data, params)}: called once for each layer, + after \code{setp_params()}. Should return modified \code{data}. + Default methods removes all rows containing a missing value in + required aesthetics (with a warning if \code{!na.rm}). + \item \code{required_aes}: A character vector of aesthetics needed to + render the geom. + \item \code{default_aes}: A list (generated by \code{\link{a_aes}()} of + default values for aesthetics. +} +} + +\section{a_Positions}{ + + +All \code{a_position_*} functions (like \code{a_position_dodge}) return a +\code{a_Position*} object (like \code{a_PositionDodge}). The \code{a_Position*} +object is responsible for adjusting the position of overlapping geoms. + +The way that the \code{a_position_*} functions work is slightly different from +the \code{a_geom_*} and \code{a_stat_*} functions, because a \code{a_position_*} +function actually "instantiates" the \code{a_Position*} object by creating a +descendant, and returns that. + +Each of the \code{a_Position*} objects is a \code{\link{a_ggproto}} object, +descended from the top-level \code{a_Position}, and each implements the +following methods: + +\itemize{ + \item \code{compute_layer(self, data, params, panel)} is called once + per layer. \code{panel} is currently an internal data structure, so + this method should not be overriden. + + \item \code{compute_panel(self, data, params, panel)} is called once per + panel and should return a modified data frame. + + \code{data} is a data frame containing the variables named according + to the aesthetics that they're mapped to. \code{scales} is a list + containing the \code{x} and \code{y} scales. There functions are called + before the facets are trained, so they are global scales, not local + to the individual panels. \code{params} contains the parameters returned by + \code{setup_params()}. + \item \code{setup_params(data, params)}: called once for each layer. + Used to setup defaults that need to complete dataset, and to inform + the user of important choices. Should return list of parameters. + \item \code{setup_data(data, params)}: called once for each layer, + after \code{setp_params()}. Should return modified \code{data}. + Default checks that required aesthetics are present. +} + +And the following fields +\itemize{ + \item \code{required_aes}: a character vector giving the aesthetics + that must be present for this position adjustment to work. +} +} + +\section{a_Scales}{ + + +All \code{a_scale_*} functions (like \code{a_scale_x_continuous}) return a +\code{a_Scale*} object (like \code{a_ScaleContinuous}). The \code{a_Scale*} +object represents a single scale. + +Each of the \code{a_Scale*} objects is a \code{\link{a_ggproto}} object, +descended from the top-level \code{a_Scale}. +} + +\seealso{ +a_ggproto +} +\keyword{datasets} +\keyword{internal} diff --git a/man/ggplot2Animint-package.Rd b/man/ggplot2Animint-package.Rd new file mode 100644 index 0000000000..08adf13362 --- /dev/null +++ b/man/ggplot2Animint-package.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ggplot2.r +\docType{package} +\name{ggplot2Animint-package} +\alias{ggplot2Animint} +\alias{ggplot2Animint-package} +\title{ggplot2Animint: An Implementation of the Grammar of Graphics} +\description{ +An implementation of the grammar of graphics in R. It combines the +advantages of both base and lattice graphics: conditioning and shared axes +are handled automatically, and you can still build up a plot step by step +from multiple data sources. It also implements a sophisticated +multidimensional conditioning system and a consistent interface to map +data to aesthetic attributes. See http://ggplot2.org for more information, +documentation and examples. +} +\seealso{ +Useful links: +\itemize{ + \item \url{http://ggplot2.org} + \item \url{https://github.com/hadley/ggplot2} + \item Report bugs at \url{https://github.com/hadley/ggplot2/issues} +} + +} +\author{ +\strong{Maintainer}: Faizan Khan \email{faizan.khan.iitbhu@gmail.com} + +Authors: +\itemize{ + \item Hadley Wickham \email{hadley@rstudio.com} + \item Winston Chang \email{winston@rstudio.com} +} + +Other contributors: +\itemize{ + \item RStudio [copyright holder] +} + +} +\keyword{internal} diff --git a/man/ggplotGrob.Rd b/man/ggplotGrob.Rd index f97e4dae33..7bba08a010 100644 --- a/man/ggplotGrob.Rd +++ b/man/ggplotGrob.Rd @@ -2,15 +2,14 @@ % Please edit documentation in R/plot-build.r \name{ggplotGrob} \alias{ggplotGrob} -\title{Generate a ggplot2 plot grob.} +\title{Generate a ggplot2 (a_plot) plot grob.} \usage{ ggplotGrob(x) } \arguments{ -\item{x}{ggplot2 object} +\item{x}{a_plot2 object} } \description{ -Generate a ggplot2 plot grob. +Generate a ggplot2 (a_plot) plot grob. } \keyword{internal} - diff --git a/man/ggsave.Rd b/man/ggsave.Rd index d2ea2ff3a0..f4d358bee6 100644 --- a/man/ggsave.Rd +++ b/man/ggsave.Rd @@ -5,7 +5,7 @@ \title{Save a ggplot (or other grid object) with sensible defaults} \usage{ ggsave(filename, plot = last_plot(), device = NULL, path = NULL, - scale = 1, width = NA, height = NA, units = c("in", "cm", "mm"), + a_scale = 1, width = NA, height = NA, units = c("in", "cm", "mm"), dpi = 300, limitsize = TRUE, ...) } \arguments{ @@ -20,7 +20,7 @@ png, bmp, svg and wmf (windows only).} \item{path}{Path to save plot to (combined with filename).} -\item{scale}{Multiplicative scaling factor.} +\item{a_scale}{Multiplicative scaling factor.} \item{width, height}{Plot dimensions, defaults to size of current graphics device.} @@ -44,7 +44,7 @@ extension. } \examples{ \dontrun{ -ggplot(mtcars, aes(mpg, wt)) + geom_point() +a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() ggsave("mtcars.pdf") ggsave("mtcars.png") @@ -62,4 +62,3 @@ ggsave(file, device = "pdf") unlink(file) } } - diff --git a/man/ggtheme.Rd b/man/ggtheme.Rd deleted file mode 100644 index 9b46f202e2..0000000000 --- a/man/ggtheme.Rd +++ /dev/null @@ -1,93 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/theme-defaults.r -\name{ggtheme} -\alias{ggtheme} -\alias{theme_bw} -\alias{theme_classic} -\alias{theme_dark} -\alias{theme_gray} -\alias{theme_grey} -\alias{theme_light} -\alias{theme_linedraw} -\alias{theme_minimal} -\alias{theme_void} -\title{ggplot2 themes} -\usage{ -theme_grey(base_size = 11, base_family = "") - -theme_gray(base_size = 11, base_family = "") - -theme_bw(base_size = 12, base_family = "") - -theme_linedraw(base_size = 12, base_family = "") - -theme_light(base_size = 12, base_family = "") - -theme_minimal(base_size = 12, base_family = "") - -theme_classic(base_size = 12, base_family = "") - -theme_dark(base_size = 12, base_family = "") - -theme_void(base_size = 12, base_family = "") -} -\arguments{ -\item{base_size}{base font size} - -\item{base_family}{base font family} -} -\description{ -Themes set the general aspect of the plot such as the colour of the -background, gridlines, the size and colour of fonts. -} -\details{ -\describe{ - -\item{\code{theme_gray}}{ -The signature ggplot2 theme with a grey background and white gridlines, -designed to put the data forward yet make comparisons easy.} - -\item{\code{theme_bw}}{ -The classic dark-on-light ggplot2 theme. May work better for presentations -displayed with a projector.} - -\item{\code{theme_linedraw}}{ -A theme with only black lines of various widths on white backgrounds, -reminiscent of a line drawings. Serves a purpose similar to \code{theme_bw}. -Note that this theme has some very thin lines (<< 1 pt) which some journals -may refuse.} - -\item{\code{theme_light}}{ -A theme similar to \code{theme_linedraw} but with light grey lines and axes, -to direct more attention towards the data.} - -\item{\code{theme_dark}}{ -The dark cousin of \code{theme_light}, with similar line sizes but a dark background. Useful to make thin coloured lines pop out.} - -\item{\code{theme_minimal}}{ -A minimalistic theme with no background annotations.} - -\item{\code{theme_classic}}{ -A classic-looking theme, with x and y axis lines and no gridlines.} - -\item{\code{theme_void}}{ -A completely empty theme.} - -} -} -\examples{ -p <- ggplot(mtcars) + geom_point(aes(x = wt, y = mpg, - colour = factor(gear))) + facet_wrap(~am) - -p -p + theme_gray() -p + theme_bw() -p + theme_linedraw() -p + theme_light() -p + theme_dark() -p + theme_minimal() -p + theme_classic() -p + theme_void() - -} - diff --git a/man/graphical-units.Rd b/man/graphical-units.Rd index c6b406d9d8..1953f75e93 100644 --- a/man/graphical-units.Rd +++ b/man/graphical-units.Rd @@ -2,9 +2,9 @@ % Please edit documentation in R/geom-.r \docType{data} \name{graphical-units} +\alias{graphical-units} \alias{.pt} \alias{.stroke} -\alias{graphical-units} \title{Graphical units} \format{An object of class \code{numeric} of length 1.} \usage{ @@ -17,4 +17,3 @@ Multiply size in mm by these constants in order to convert to the units that grid uses internally for \code{lwd} and \code{fontsize}. } \keyword{datasets} - diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd deleted file mode 100644 index 5bda90a632..0000000000 --- a/man/guide_colourbar.Rd +++ /dev/null @@ -1,170 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/guide-colorbar.r -\name{guide_colourbar} -\alias{guide_colorbar} -\alias{guide_colourbar} -\title{Continuous colour bar guide.} -\usage{ -guide_colourbar(title = waiver(), title.position = NULL, - title.theme = NULL, title.hjust = NULL, title.vjust = NULL, - label = TRUE, label.position = NULL, label.theme = NULL, - label.hjust = NULL, label.vjust = NULL, barwidth = NULL, - barheight = NULL, nbin = 20, raster = TRUE, ticks = TRUE, - draw.ulim = TRUE, draw.llim = TRUE, direction = NULL, - default.unit = "line", reverse = FALSE, order = 0, ...) - -guide_colorbar(title = waiver(), title.position = NULL, - title.theme = NULL, title.hjust = NULL, title.vjust = NULL, - label = TRUE, label.position = NULL, label.theme = NULL, - label.hjust = NULL, label.vjust = NULL, barwidth = NULL, - barheight = NULL, nbin = 20, raster = TRUE, ticks = TRUE, - draw.ulim = TRUE, draw.llim = TRUE, direction = NULL, - default.unit = "line", reverse = FALSE, order = 0, ...) -} -\arguments{ -\item{title}{A character string or expression indicating a title of guide. -If \code{NULL}, the title is not shown. By default -(\code{\link{waiver}}), the name of the scale object or the name -specified in \code{\link{labs}} is used for the title.} - -\item{title.position}{A character string indicating the position of a - title. One of "top" (default for a vertical guide), "bottom", "left" -(default for a horizontal guide), or "right."} - -\item{title.theme}{A theme object for rendering the title text. Usually the -object of \code{\link{element_text}} is expected. By default, the theme is -specified by \code{legend.title} in \code{\link{theme}} or theme.} - -\item{title.hjust}{A number specifying horizontal justification of the -title text.} - -\item{title.vjust}{A number specifying vertical justification of the title -text.} - -\item{label}{logical. If \code{TRUE} then the labels are drawn. If -\code{FALSE} then the labels are invisible.} - -\item{label.position}{A character string indicating the position of a -label. One of "top", "bottom" (default for horizontal guide), "left", or -"right" (default for vertical guide).} - -\item{label.theme}{A theme object for rendering the label text. Usually the -object of \code{\link{element_text}} is expected. By default, the theme is -specified by \code{legend.text} in \code{\link{theme}} or theme.} - -\item{label.hjust}{A numeric specifying horizontal justification of the -label text.} - -\item{label.vjust}{A numeric specifying vertical justification of the label -text.} - -\item{barwidth}{A numeric or a \code{\link[grid]{unit}} object specifying -the width of the colorbar. Default value is \code{legend.key.width} or -\code{legend.key.size} in \code{\link{theme}} or theme.} - -\item{barheight}{A numeric or a \code{\link[grid]{unit}} object specifying -the height of the colorbar. Default value is \code{legend.key.height} or -\code{legend.key.size} in \code{\link{theme}} or theme.} - -\item{nbin}{A numeric specifying the number of bins for drawing colorbar. A -smoother colorbar for a larger value.} - -\item{raster}{A logical. If \code{TRUE} then the colorbar is rendered as a -raster object. If \code{FALSE} then the colorbar is rendered as a set of -rectangles. Note that not all graphics devices are capable of rendering -raster image.} - -\item{ticks}{A logical specifying if tick marks on colorbar should be -visible.} - -\item{draw.ulim}{A logical specifying if the upper limit tick marks should -be visible.} - -\item{draw.llim}{A logical specifying if the lower limit tick marks should -be visible.} - -\item{direction}{A character string indicating the direction of the guide. -One of "horizontal" or "vertical."} - -\item{default.unit}{A character string indicating \code{\link[grid]{unit}} -for \code{barwidth} and \code{barheight}.} - -\item{reverse}{logical. If \code{TRUE} the colorbar is reversed. By default, -the highest value is on the top and the lowest value is on the bottom} - -\item{order}{positive integer less that 99 that specifies the order of -this guide among multiple guides. This controls the order in which -multiple guides are displayed, not the contents of the guide itself. -If 0 (default), the order is determined by a secret algorithm.} - -\item{...}{ignored.} -} -\value{ -A guide object -} -\description{ -Colour bar guide shows continuous color scales mapped onto values. -Colour bar is available with \code{scale_fill} and \code{scale_colour}. -For more information, see the inspiration for this function: -\href{http://www.mathworks.com/help/techdoc/ref/colorbar.html}{Matlab's colorbar function}. -} -\details{ -Guides can be specified in each \code{scale_*} or in \code{\link{guides}}. -\code{guide="legend"} in \code{scale_*} is syntactic sugar for -\code{guide=guide_legend()} (e.g. \code{scale_color_manual(guide = "legend")}). -As for how to specify the guide for each scale in more detail, -see \code{\link{guides}}. -} -\examples{ -df <- reshape2::melt(outer(1:4, 1:4), varnames = c("X1", "X2")) - -p1 <- ggplot(df, aes(X1, X2)) + geom_tile(aes(fill = value)) -p2 <- p1 + geom_point(aes(size = value)) - -# Basic form -p1 + scale_fill_continuous(guide = "colorbar") -p1 + scale_fill_continuous(guide = guide_colorbar()) -p1 + guides(fill = guide_colorbar()) - -# Control styles - -# bar size -p1 + guides(fill = guide_colorbar(barwidth = 0.5, barheight = 10)) - -# no label -p1 + guides(fill = guide_colorbar(label = FALSE)) - -# no tick marks -p1 + guides(fill = guide_colorbar(ticks = FALSE)) - -# label position -p1 + guides(fill = guide_colorbar(label.position = "left")) - -# label theme -p1 + guides(fill = guide_colorbar(label.theme = element_text(colour = "blue", angle = 0))) - -# small number of bins -p1 + guides(fill = guide_colorbar(nbin = 3)) - -# large number of bins -p1 + guides(fill = guide_colorbar(nbin = 100)) - -# make top- and bottom-most ticks invisible -p1 + scale_fill_continuous(limits = c(0,20), breaks = c(0, 5, 10, 15, 20), - guide = guide_colorbar(nbin=100, draw.ulim = FALSE, draw.llim = FALSE)) - -# guides can be controlled independently -p2 + - scale_fill_continuous(guide = "colorbar") + - scale_size(guide = "legend") -p2 + guides(fill = "colorbar", size = "legend") - -p2 + - scale_fill_continuous(guide = guide_colorbar(direction = "horizontal")) + - scale_size(guide = guide_legend(direction = "vertical")) -} -\seealso{ -Other guides: \code{\link{guide_legend}}, - \code{\link{guides}} -} - diff --git a/man/guide_legend.Rd b/man/guide_legend.Rd deleted file mode 100644 index e40dc89386..0000000000 --- a/man/guide_legend.Rd +++ /dev/null @@ -1,177 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/guide-legend.r -\name{guide_legend} -\alias{guide_legend} -\title{Legend guide.} -\usage{ -guide_legend(title = waiver(), title.position = NULL, title.theme = NULL, - title.hjust = NULL, title.vjust = NULL, label = TRUE, - label.position = NULL, label.theme = NULL, label.hjust = NULL, - label.vjust = NULL, keywidth = NULL, keyheight = NULL, - direction = NULL, default.unit = "line", override.aes = list(), - nrow = NULL, ncol = NULL, byrow = FALSE, reverse = FALSE, order = 0, - ...) -} -\arguments{ -\item{title}{A character string or expression indicating a title of guide. -If \code{NULL}, the title is not shown. By default -(\code{\link{waiver}}), the name of the scale object or the name -specified in \code{\link{labs}} is used for the title.} - -\item{title.position}{A character string indicating the position of a - title. One of "top" (default for a vertical guide), "bottom", "left" -(default for a horizontal guide), or "right."} - -\item{title.theme}{A theme object for rendering the title text. Usually the -object of \code{\link{element_text}} is expected. By default, the theme is -specified by \code{legend.title} in \code{\link{theme}} or theme.} - -\item{title.hjust}{A number specifying horizontal justification of the -title text.} - -\item{title.vjust}{A number specifying vertical justification of the title -text.} - -\item{label}{logical. If \code{TRUE} then the labels are drawn. If -\code{FALSE} then the labels are invisible.} - -\item{label.position}{A character string indicating the position of a -label. One of "top", "bottom" (default for horizontal guide), "left", or -"right" (default for vertical guide).} - -\item{label.theme}{A theme object for rendering the label text. Usually the -object of \code{\link{element_text}} is expected. By default, the theme is -specified by \code{legend.text} in \code{\link{theme}} or theme.} - -\item{label.hjust}{A numeric specifying horizontal justification of the -label text.} - -\item{label.vjust}{A numeric specifying vertical justification of the label -text.} - -\item{keywidth}{A numeric or a \code{\link[grid]{unit}} object specifying -the width of the legend key. Default value is \code{legend.key.width} or -\code{legend.key.size} in \code{\link{theme}} or theme.} - -\item{keyheight}{A numeric or a \code{\link[grid]{unit}} object specifying -the height of the legend key. Default value is \code{legend.key.height} or -\code{legend.key.size} in \code{\link{theme}} or theme.} - -\item{direction}{A character string indicating the direction of the guide. -One of "horizontal" or "vertical."} - -\item{default.unit}{A character string indicating \code{\link[grid]{unit}} -for \code{keywidth} and \code{keyheight}.} - -\item{override.aes}{A list specifying aesthetic parameters of legend key. -See details and examples.} - -\item{nrow}{The desired number of rows of legends.} - -\item{ncol}{The desired number of column of legends.} - -\item{byrow}{logical. If \code{FALSE} (the default) the legend-matrix is -filled by columns, otherwise the legend-matrix is filled by rows.} - -\item{reverse}{logical. If \code{TRUE} the order of legends is reversed.} - -\item{order}{positive integer less that 99 that specifies the order of -this guide among multiple guides. This controls the order in which -multiple guides are displayed, not the contents of the guide itself. -If 0 (default), the order is determined by a secret algorithm.} - -\item{...}{ignored.} -} -\value{ -A guide object -} -\description{ -Legend type guide shows key (i.e., geoms) mapped onto values. -Legend guides for various scales are integrated if possible. -} -\details{ -Guides can be specified in each \code{scale_*} or in \code{\link{guides}}. -\code{guide="legend"} in \code{scale_*} is syntactic sugar for -\code{guide=guide_legend()} (e.g. \code{scale_color_manual(guide = "legend")}). -As for how to specify the guide for each scale in more detail, -see \code{\link{guides}}. -} -\examples{ -\donttest{ -df <- reshape2::melt(outer(1:4, 1:4), varnames = c("X1", "X2")) - -p1 <- ggplot(df, aes(X1, X2)) + geom_tile(aes(fill = value)) -p2 <- p1 + geom_point(aes(size = value)) - -# Basic form -p1 + scale_fill_continuous(guide = "legend") -p1 + scale_fill_continuous(guide = guide_legend()) - -# Guide title -p1 + scale_fill_continuous(guide = guide_legend(title = "V")) # title text -p1 + scale_fill_continuous(guide = guide_legend(title = NULL)) # no title - -# Control styles - -# key size -p1 + guides(fill = guide_legend(keywidth = 3, keyheight = 1)) - -# title position -p1 + guides(fill = guide_legend(title = "LEFT", title.position = "left")) - -# title text styles via element_text -p1 + guides(fill = - guide_legend( - title.theme = element_text( - size = 15, - face = "italic", - colour = "red", - angle = 0 - ) - ) -) - -# label position -p1 + guides(fill = guide_legend(label.position = "left", label.hjust = 1)) - -# label styles -p1 + scale_fill_continuous(breaks = c(5, 10, 15), - labels = paste("long", c(5, 10, 15)), - guide = guide_legend( - direction = "horizontal", - title.position = "top", - label.position = "bottom", - label.hjust = 0.5, - label.vjust = 1, - label.theme = element_text(angle = 90) - ) -) - -# Set aesthetic of legend key - -# very low alpha value make it difficult to see legend key -p3 <- ggplot(diamonds, aes(carat, price)) + - geom_point(aes(colour = color), alpha = 1/100) -p3 - -# override.aes overwrites the alpha -p3 + guides(colour = guide_legend(override.aes = list(alpha = 1))) - -# multiple row/col legends -df <- data.frame(x = 1:20, y = 1:20, color = letters[1:20]) -p <- ggplot(df, aes(x, y)) + - geom_point(aes(colour = color)) -p + guides(col = guide_legend(nrow = 8)) -p + guides(col = guide_legend(ncol = 8)) -p + guides(col = guide_legend(nrow = 8, byrow = TRUE)) -p + guides(col = guide_legend(ncol = 8, byrow = TRUE)) - -# reversed order legend -p + guides(col = guide_legend(reverse = TRUE)) -} -} -\seealso{ -Other guides: \code{\link{guide_colourbar}}, - \code{\link{guides}} -} - diff --git a/man/guides.Rd b/man/guides.Rd deleted file mode 100644 index c4ead6b499..0000000000 --- a/man/guides.Rd +++ /dev/null @@ -1,73 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/guides-.r -\name{guides} -\alias{guides} -\title{Set guides for each scale.} -\usage{ -guides(...) -} -\arguments{ -\item{...}{List of scale guide pairs} -} -\value{ -A list containing the mapping between scale and guide. -} -\description{ -Guides for each scale can be set in call of \code{scale_*} with argument -\code{guide}, or in \code{guides}. -} -\examples{ -\donttest{ -# ggplot object - -dat <- data.frame(x = 1:5, y = 1:5, p = 1:5, q = factor(1:5), - r = factor(1:5)) -p <- ggplot(dat, aes(x, y, colour = p, size = q, shape = r)) + geom_point() - -# without guide specification -p - -# Show colorbar guide for colour. -# All these examples below have a same effect. - -p + guides(colour = "colorbar", size = "legend", shape = "legend") -p + guides(colour = guide_colorbar(), size = guide_legend(), - shape = guide_legend()) -p + - scale_colour_continuous(guide = "colorbar") + - scale_size_discrete(guide = "legend") + - scale_shape(guide = "legend") - - # Remove some guides - p + guides(colour = "none") - p + guides(colour = "colorbar",size = "none") - -# Guides are integrated where possible - -p + guides(colour = guide_legend("title"), size = guide_legend("title"), - shape = guide_legend("title")) -# same as -g <- guide_legend("title") -p + guides(colour = g, size = g, shape = g) - -p + theme(legend.position = "bottom") - -# position of guides - -p + theme(legend.position = "bottom", legend.box = "horizontal") - -# Set order for multiple guides -ggplot(mpg, aes(displ, cty)) + - geom_point(aes(size = hwy, colour = cyl, shape = drv)) + - guides( - colour = guide_colourbar(order = 1), - shape = guide_legend(order = 2), - size = guide_legend(order = 3) - ) -} -} -\seealso{ -Other guides: \code{\link{guide_colourbar}}, - \code{\link{guide_legend}} -} - diff --git a/man/hmisc.Rd b/man/hmisc.Rd index 8de36cdfa1..68d8b94908 100644 --- a/man/hmisc.Rd +++ b/man/hmisc.Rd @@ -2,20 +2,20 @@ % Please edit documentation in R/stat-summary.r \name{hmisc} \alias{hmisc} -\alias{mean_cl_boot} -\alias{mean_cl_normal} -\alias{mean_sdl} -\alias{median_hilow} +\alias{a_mean_cl_boot} +\alias{a_mean_cl_normal} +\alias{a_mean_sdl} +\alias{a_median_hilow} \title{Wrap up a selection of summary functions from Hmisc to make it easy to use -with \code{\link{stat_summary}}.} +with \code{\link{a_stat_summary}}.} \usage{ -mean_cl_boot(x, ...) +a_mean_cl_boot(x, ...) -mean_cl_normal(x, ...) +a_mean_cl_normal(x, ...) -mean_sdl(x, ...) +a_mean_sdl(x, ...) -median_hilow(x, ...) +a_median_hilow(x, ...) } \arguments{ \item{x}{a numeric vector} @@ -30,4 +30,3 @@ See the Hmisc documentation for details of their options. \code{\link[Hmisc]{smean.cl.normal}}, \code{\link[Hmisc]{smean.sdl}}, \code{\link[Hmisc]{smedian.hilow}} } - diff --git a/man/is.Coord.Rd b/man/is.a_Coord.Rd similarity index 80% rename from man/is.Coord.Rd rename to man/is.a_Coord.Rd index 6cb932fc55..999d9845eb 100644 --- a/man/is.Coord.Rd +++ b/man/is.a_Coord.Rd @@ -1,13 +1,12 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/coord-.r -\name{is.Coord} -\alias{is.Coord} +\name{is.a_Coord} +\alias{is.a_Coord} \title{Is this object a coordinate system?} \usage{ -is.Coord(x) +is.a_Coord(x) } \description{ Is this object a coordinate system? } \keyword{internal} - diff --git a/man/is.facet.Rd b/man/is.a_facet.Rd similarity index 83% rename from man/is.facet.Rd rename to man/is.a_facet.Rd index df3b398943..14040234d7 100644 --- a/man/is.facet.Rd +++ b/man/is.a_facet.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet-.r -\name{is.facet} -\alias{is.facet} +\name{is.a_facet} +\alias{is.a_facet} \title{Is this object a facetting specification?} \usage{ -is.facet(x) +is.a_facet(x) } \arguments{ \item{x}{object to test} @@ -13,4 +13,3 @@ is.facet(x) Is this object a facetting specification? } \keyword{internal} - diff --git a/man/is.ggproto.Rd b/man/is.a_ggproto.Rd similarity index 54% rename from man/is.ggproto.Rd rename to man/is.a_ggproto.Rd index 49ad4ef5a0..93b1fc8855 100644 --- a/man/is.ggproto.Rd +++ b/man/is.a_ggproto.Rd @@ -1,15 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggproto.r -\name{is.ggproto} -\alias{is.ggproto} -\title{Is an object a ggproto object?} +\name{is.a_ggproto} +\alias{is.a_ggproto} +\title{Is an object a a_ggproto object?} \usage{ -is.ggproto(x) +is.a_ggproto(x) } \arguments{ \item{x}{An object to test.} } \description{ -Is an object a ggproto object? +Is an object a a_ggproto object? } - diff --git a/man/is.ggplot.Rd b/man/is.a_plot.Rd similarity index 56% rename from man/is.ggplot.Rd rename to man/is.a_plot.Rd index e4ceff6bf5..7d1774a6f1 100644 --- a/man/is.ggplot.Rd +++ b/man/is.a_plot.Rd @@ -1,16 +1,15 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.r -\name{is.ggplot} -\alias{is.ggplot} -\title{Reports whether x is a ggplot object} +\name{is.a_plot} +\alias{is.a_plot} +\title{Reports whether x is a a_plot object} \usage{ -is.ggplot(x) +is.a_plot(x) } \arguments{ \item{x}{An object to test} } \description{ -Reports whether x is a ggplot object +Reports whether x is a a_plot object } \keyword{internal} - diff --git a/man/is.theme.Rd b/man/is.a_theme.Rd similarity index 53% rename from man/is.theme.Rd rename to man/is.a_theme.Rd index b8e94f522c..77a92f01ca 100644 --- a/man/is.theme.Rd +++ b/man/is.a_theme.Rd @@ -1,15 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/theme.r -\name{is.theme} -\alias{is.theme} -\title{Reports whether x is a theme object} +\name{is.a_theme} +\alias{is.a_theme} +\title{Reports whether x is a a_theme object} \usage{ -is.theme(x) +is.a_theme(x) } \arguments{ \item{x}{An object to test} } \description{ -Reports whether x is a theme object +Reports whether x is a a_theme object } - diff --git a/man/is.rel.Rd b/man/is.rel.Rd index 12aafc1aed..394a774a15 100644 --- a/man/is.rel.Rd +++ b/man/is.rel.Rd @@ -12,4 +12,3 @@ is.rel(x) \description{ Reports whether x is a rel object } - diff --git a/man/labeller.Rd b/man/labeller.Rd index 99bba090b1..0b860726ff 100644 --- a/man/labeller.Rd +++ b/man/labeller.Rd @@ -5,7 +5,7 @@ \title{Generic labeller function for facets} \usage{ labeller(..., .rows = NULL, .cols = NULL, keep.as.numeric = NULL, - .multi_line = TRUE, .default = label_value) + .multi_line = TRUE, .default = a_label_value) } \arguments{ \item{...}{Named arguments of the form \code{variable = @@ -30,7 +30,7 @@ function.} used with lookup tables or non-labeller functions.} } \value{ -A labeller function to supply to \code{\link{facet_grid}} +A labeller function to supply to \code{\link{a_facet_grid}} for the argument \code{labeller}. } \description{ @@ -49,22 +49,22 @@ functions taking a character vector such as } \examples{ \donttest{ -p1 <- ggplot(mtcars, aes(x = mpg, y = wt)) + geom_point() +p1 <- a_plot(mtcars, a_aes(x = mpg, y = wt)) + a_geom_point() # You can assign different labellers to variables: p1 + facet_grid(vs + am ~ gear, - labeller = labeller(vs = label_both, am = label_value)) + labeller = labeller(vs = a_label_both, am = a_label_value)) # Or whole margins: p1 + facet_grid(vs + am ~ gear, - labeller = labeller(.rows = label_both, .cols = label_value)) + labeller = labeller(.rows = a_label_both, .cols = a_label_value)) # You can supply functions operating on strings: capitalize <- function(string) { substr(string, 1, 1) <- toupper(substr(string, 1, 1)) string } -p2 <- ggplot(msleep, aes(x = sleep_total, y = awake)) + geom_point() +p2 <- a_plot(msleep, a_aes(x = sleep_total, y = awake)) + a_geom_point() p2 + facet_grid(vore ~ conservation, labeller = labeller(vore = capitalize)) # Or use character vectors as lookup tables: @@ -91,7 +91,7 @@ msleep$conservation2 <- plyr::revalue(msleep$conservation, p2 \%+\% msleep + facet_grid(vore ~ conservation2) p2 \%+\% msleep + facet_grid(vore ~ conservation2, - labeller = labeller(conservation2 = label_wrap_gen(10)) + labeller = labeller(conservation2 = a_label_wrap_gen(10)) ) # labeller() is especially useful to act as a global labeller. You @@ -101,8 +101,8 @@ p2 \%+\% msleep + global_labeller <- labeller( vore = capitalize, conservation = conservation_status, - conservation2 = label_wrap_gen(10), - .default = label_both + conservation2 = a_label_wrap_gen(10), + .default = a_label_both ) p2 + facet_grid(vore ~ conservation, labeller = global_labeller) @@ -113,4 +113,3 @@ p2 \%+\% msleep + facet_wrap(~conservation2, labeller = global_labeller) \seealso{ \code{\link{as_labeller}()}, \link{labellers} } - diff --git a/man/labellers.Rd b/man/labellers.Rd index e006f9591f..a7680da6bf 100644 --- a/man/labellers.Rd +++ b/man/labellers.Rd @@ -1,26 +1,26 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet-labels.r \name{labellers} -\alias{label_both} -\alias{label_context} -\alias{label_parsed} -\alias{label_value} -\alias{label_wrap_gen} \alias{labellers} +\alias{a_label_value} +\alias{a_label_both} +\alias{a_label_context} +\alias{a_label_parsed} +\alias{a_label_wrap_gen} \title{Labeller functions} \usage{ -label_value(labels, multi_line = TRUE) +a_label_value(a_labels, multi_line = TRUE) -label_both(labels, multi_line = TRUE, sep = ": ") +a_label_both(a_labels, multi_line = TRUE, sep = ": ") -label_context(labels, multi_line = TRUE, sep = ": ") +a_label_context(a_labels, multi_line = TRUE, sep = ": ") -label_parsed(labels, multi_line = TRUE) +a_label_parsed(a_labels, multi_line = TRUE) -label_wrap_gen(width = 25, multi_line = TRUE) +a_label_wrap_gen(width = 25, multi_line = TRUE) } \arguments{ -\item{labels}{Data frame of labels. Usually contains only one +\item{a_labels}{Data frame of labels. Usually contains only one element, but facetting over multiple factors entails multiple label variables.} @@ -39,16 +39,16 @@ such as \code{~first + second}) should be displayed on a single line separated with commas, or each on their own line. } \details{ -\code{label_value()} only displays the value of a factor while -\code{label_both()} displays both the variable name and the factor -value. \code{label_context()} is context-dependent and uses -\code{label_value()} for single factor facetting and -\code{label_both()} when multiple factors are -involved. \code{label_wrap_gen()} uses \code{\link[base]{strwrap}()} +\code{a_label_value()} only displays the value of a factor while +\code{a_label_both()} displays both the variable name and the factor +value. \code{a_label_context()} is context-dependent and uses +\code{a_label_value()} for single factor facetting and +\code{a_label_both()} when multiple factors are +involved. \code{a_label_wrap_gen()} uses \code{\link[base]{strwrap}()} for line wrapping. -\code{label_parsed()} interprets the labels as plotmath -expressions. \code{\link{label_bquote}()} offers a more flexible +\code{a_label_parsed()} interprets the labels as plotmath +expressions. \code{\link{a_label_bquote}()} offers a more flexible way of constructing plotmath expressions. See examples and \code{\link{bquote}()} for details on the syntax of the argument. @@ -81,38 +81,39 @@ argument. attribute of the incoming data frame of labels. The value of this attribute reflects the kind of strips your labeller is dealing with: \code{"cols"} for columns and \code{"rows"} for rows. Note - that \code{\link{facet_wrap}()} has columns by default and rows + that \code{\link{a_facet_wrap}()} has columns by default and rows when the strips are switched with the \code{switch} option. The - \code{facet} attribute also provides metadata on the labels. It + \code{a_facet} attribute also provides metadata on the labels. It takes the values \code{"grid"} or \code{"wrap"}. For compatibility with \code{\link{labeller}()}, each labeller function must have the \code{labeller} S3 class. } + \examples{ mtcars$cyl2 <- factor(mtcars$cyl, labels = c("alpha", "beta", "gamma")) -p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() +p <- a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point() # Displaying only the values -p + facet_grid(. ~ cyl) -p + facet_grid(. ~ cyl, labeller = label_value) +p + ggplot2Animint:::a_facet_grid(. ~ cyl) +p + ggplot2Animint:::a_facet_grid(. ~ cyl, labeller = a_label_value) \donttest{ # Displaying both the values and the variables -p + facet_grid(. ~ cyl, labeller = label_both) +p + facet_grid(. ~ cyl, labeller = a_label_both) # Displaying only the values or both the values and variables # depending on whether multiple factors are facetted over -p + facet_grid(am ~ vs+cyl, labeller = label_context) +p + facet_grid(am ~ vs+cyl, labeller = a_label_context) # Interpreting the labels as plotmath expressions p + facet_grid(. ~ cyl2) -p + facet_grid(. ~ cyl2, labeller = label_parsed) -p + facet_wrap(~vs + cyl2, labeller = label_parsed) +p + facet_grid(. ~ cyl2, labeller = a_label_parsed) +p + facet_wrap(~vs + cyl2, labeller = a_label_parsed) } } \seealso{ \code{\link{labeller}()}, \code{\link{as_labeller}()}, - \code{\link{label_bquote}()} + \code{\link{a_label_bquote}()} } - +\keyword{internal} diff --git a/man/labs.Rd b/man/labs.Rd index 15c057f3f7..5ffc541412 100644 --- a/man/labs.Rd +++ b/man/labs.Rd @@ -1,60 +1,60 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/labels.r \name{labs} -\alias{ggtitle} \alias{labs} \alias{xlab} \alias{ylab} -\title{Change axis labels, legend titles, plot title/subtitle and below-plot +\alias{ggtitle} +\title{Change axis a_labels, legend titles, plot title/subtitle and below-plot caption.} \usage{ labs(...) -xlab(label) +xlab(a_label) -ylab(label) +ylab(a_label) -ggtitle(label, subtitle = NULL) +ggtitle(a_label, subtitle = NULL) } \arguments{ -\item{...}{a list of new names in the form aesthetic = "new name"} +\item{...}{a list of new names in the form a_aesthetic = "new name"} -\item{label}{The text for the axis, plot title or caption below the plot} +\item{a_label}{The text for the axis, plot title or caption below the plot.} \item{subtitle}{the text for the subtitle for the plot which will be displayed below the title. Leave \code{NULL} for no subtitle.} } \description{ -Change axis labels, legend titles, plot title/subtitle and below-plot +Change axis a_labels, legend titles, plot title/subtitle and below-plot caption. } \examples{ -p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() -p + labs(title = "New plot title") -p + labs(x = "New x label") -p + xlab("New x label") -p + ylab("New y label") +p <- a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() +p + ggplot2Animint:::labs(title = "New plot title") +p + ggplot2Animint:::labs(x = "New x a_label") +p + xlab("New x a_label") +p + ylab("New y a_label") p + ggtitle("New plot title") # Can add a subtitle to plots with either of the following p + ggtitle("New plot title", subtitle = "A subtitle") -p + labs(title = "New plot title", subtitle = "A subtitle") +p + ggplot2Animint:::labs(title = "New plot title", subtitle = "A subtitle") # Can add a plot caption underneath the whole plot (for sources, notes or # copyright), similar to the \\code{sub} parameter in base R, with the # following -p + labs(caption = "(based on data from ...)") +p + ggplot2Animint:::labs(caption = "(based on data from ...)") # This should work independently of other functions that modify the # the scale names -p + ylab("New y label") + ylim(2, 4) -p + ylim(2, 4) + ylab("New y label") +p + ylab("New y a_label") + ylim(2, 4) +p + ylim(2, 4) + ylab("New y a_label") -# The labs function also modifies legend labels -p <- ggplot(mtcars, aes(mpg, wt, colour = cyl)) + geom_point() -p + labs(colour = "Cylinders") +# The labs function also modifies legend a_labels +p <- a_plot(mtcars, a_aes(mpg, wt, colour = cyl)) + a_geom_point() +p + ggplot2Animint:::labs(colour = "Cylinders") # Can also pass in a list, if that is more convenient -p + labs(list(title = "Title", subtitle = "Subtitle", x = "X", y = "Y")) +p + ggplot2Animint:::labs(list(title = "Title", subtitle = "Subtitle", x = "X", y = "Y")) } - +\keyword{internal} diff --git a/man/last_plot.Rd b/man/last_plot.Rd index 53590c4f75..e527dcfb1c 100644 --- a/man/last_plot.Rd +++ b/man/last_plot.Rd @@ -12,4 +12,3 @@ Retrieve the last plot to be modified or created. \seealso{ \code{\link{ggsave}} } - diff --git a/man/layout_base.Rd b/man/layout_base.Rd new file mode 100644 index 0000000000..37abee986d --- /dev/null +++ b/man/layout_base.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/facet-layout.r +\name{layout_base} +\alias{layout_base} +\title{Base layout function that generates all combinations of data needed for +facetting +The first data frame in the list should be the default data for the plot. +Other data frames in the list are ones that are added to layers.} +\usage{ +layout_base(data, vars = NULL, drop = TRUE) +} +\arguments{ +\item{data}{list of data frames (one for each layer)} +} +\description{ +Base layout function that generates all combinations of data needed for +facetting +The first data frame in the list should be the default data for the plot. +Other data frames in the list are ones that are added to layers. +} +\keyword{internal} diff --git a/man/layout_grid.Rd b/man/layout_grid.Rd new file mode 100644 index 0000000000..e5f5e9bb1d --- /dev/null +++ b/man/layout_grid.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/facet-layout.r +\name{layout_grid} +\alias{layout_grid} +\title{Layout panels in a 2d grid.} +\usage{ +layout_grid(data, rows = NULL, cols = NULL, margins = NULL, drop = TRUE, + as.table = TRUE) +} +\arguments{ +\item{data}{list of data frames, one for each layer} + +\item{rows}{variables that form the rows} + +\item{cols}{variables that form the columns} + +\item{margins}{......} + +\item{drop}{....} + +\item{as.table}{....} +} +\value{ +a data frame with columns \code{PANEL}, \code{ROW} and \code{COL}, + that match the facetting variable values up with their position in the + grid +} +\description{ +Layout panels in a 2d grid. +} diff --git a/man/layout_wrap.Rd b/man/layout_wrap.Rd new file mode 100644 index 0000000000..f78f382725 --- /dev/null +++ b/man/layout_wrap.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/facet-layout.r +\name{layout_wrap} +\alias{layout_wrap} +\title{Layout out panels in a 1d ribbon.} +\usage{ +layout_wrap(data, vars = NULL, nrow = NULL, ncol = NULL, + as.table = TRUE, drop = TRUE, dir = "h") +} +\arguments{ +\item{drop}{should missing combinations be excluded from the plot?} +} +\description{ +Layout out panels in a 1d ribbon. +} +\keyword{internal} diff --git a/man/limits.Rd b/man/limits.Rd index b236d80cf6..0d9005739a 100644 --- a/man/limits.Rd +++ b/man/limits.Rd @@ -7,19 +7,17 @@ limits(lims, var) } \arguments{ -\item{var}{name of variable} +\item{lims}{vector of limits} -\item{limits}{vector of limits} +\item{var}{name of variable} } \description{ Generate correct scale type for specified limits } \examples{ -ggplot2:::limits(c(1, 5), "x") -ggplot2:::limits(c(5, 1), "x") -ggplot2:::limits(c("A", "b", "c"), "x") -ggplot2:::limits(c("A", "b", "c"), "fill") -ggplot2:::limits(as.Date(c("2008-01-01", "2009-01-01")), "x") +limits(c(1, 5), "x") +limits(c(5, 1), "x") +limits(c("A", "b", "c"), "x") +limits(c("A", "b", "c"), "fill") +limits(as.Date(c("2008-01-01", "2009-01-01")), "x") } -\keyword{internal} - diff --git a/man/lims.Rd b/man/lims.Rd index 8894f10cc2..60f54d38f6 100644 --- a/man/lims.Rd +++ b/man/lims.Rd @@ -13,8 +13,8 @@ xlim(...) ylim(...) } \arguments{ -\item{...}{If numeric, will create a continuous scale, if factor or -character, will create a discrete scale. For \code{lims}, every +\item{...}{If numeric, will create a continuous a_scale, if factor or +character, will create a discrete a_scale. For \code{lims}, every argument must be named.} } \description{ @@ -29,21 +29,20 @@ xlim(20, 15) xlim(c(10, 20)) xlim("a", "b", "c") -ggplot(mtcars, aes(mpg, wt)) + - geom_point() + +a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point() + xlim(15, 20) # with automatic lower limit -ggplot(mtcars, aes(mpg, wt)) + - geom_point() + +a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point() + xlim(NA, 20) # Change both xlim and ylim -ggplot(mtcars, aes(mpg, wt)) + - geom_point() + +a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point() + lims(x = c(10, 20), y = c(3, 5)) } \seealso{ For changing x or y axis limits \strong{without} dropping data - observations, see \code{\link{coord_cartesian}}. + observations, see \code{\link{a_coord_cartesian}}. } - diff --git a/man/luv_colours.Rd b/man/luv_colours.Rd index f36ca05bdb..b5cf019742 100644 --- a/man/luv_colours.Rd +++ b/man/luv_colours.Rd @@ -16,4 +16,3 @@ luv_colours All built-in \code{\link{colors}()} translated into Luv colour space. } \keyword{datasets} - diff --git a/man/map_data.Rd b/man/map_data.Rd index f73b6ae895..9797f004d2 100644 --- a/man/map_data.Rd +++ b/man/map_data.Rd @@ -34,13 +34,12 @@ arrests$region <- tolower(rownames(USArrests)) choro <- merge(states, arrests, sort = FALSE, by = "region") choro <- choro[order(choro$order), ] -ggplot(choro, aes(long, lat)) + - geom_polygon(aes(group = group, fill = assault)) + - coord_map("albers", at0 = 45.5, lat1 = 29.5) +a_plot(choro, a_aes(long, lat)) + + a_geom_polygon(a_aes(group = group, fill = assault)) + + ggplot2Animint:::a_coord_map("albers", at0 = 45.5, lat1 = 29.5) -ggplot(choro, aes(long, lat)) + - geom_polygon(aes(group = group, fill = assault / murder)) + - coord_map("albers", at0 = 45.5, lat1 = 29.5) +a_plot(choro, a_aes(long, lat)) + + a_geom_polygon(a_aes(group = group, fill = assault / murder)) + + ggplot2Animint:::a_coord_map("albers", at0 = 45.5, lat1 = 29.5) } } - diff --git a/man/map_layout.Rd b/man/map_layout.Rd new file mode 100644 index 0000000000..8d317bd103 --- /dev/null +++ b/man/map_layout.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/panel.r +\name{map_layout} +\alias{map_layout} +\title{Map data to find out where it belongs in the plot.} +\usage{ +map_layout(panel, a_facet, data) +} +\arguments{ +\item{panel}{a trained panel object} + +\item{data}{list of data frames (one for each a_layer)} + +\item{the}{facetting specification} +} +\description{ +Layout map ensures that all a_layer data has extra copies of data for margins +and missing facetting variables, and has a PANEL variable that tells that +so it know what panel it belongs to. This is a change from the previous +design which added facetting variables directly to the data frame and +caused problems when they had names of aesthetics (like colour or group). +} +\keyword{internal} diff --git a/man/map_position.Rd b/man/map_position.Rd new file mode 100644 index 0000000000..f77a125a3a --- /dev/null +++ b/man/map_position.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/panel.r +\name{map_position} +\alias{map_position} +\title{Map data with scales.} +\usage{ +map_position(panel, data, x_scale, y_scale) +} +\arguments{ +\item{data}{a list of data frames (one for each layer)} +} +\description{ +This operation must be idempotent because it is applied twice: both before +and after statistical transformation. +} +\keyword{internal} diff --git a/man/margin.Rd b/man/margin.Rd index 96c15ed1b3..639ad5b95b 100644 --- a/man/margin.Rd +++ b/man/margin.Rd @@ -21,4 +21,3 @@ margin(4) margin(4, 2) margin(4, 3, 2, 1) } - diff --git a/man/midwest.Rd b/man/midwest.Rd index adce5e7b2e..ec1cb31cd7 100644 --- a/man/midwest.Rd +++ b/man/midwest.Rd @@ -42,4 +42,3 @@ midwest Demographic information of midwest counties } \keyword{datasets} - diff --git a/man/mpg.Rd b/man/mpg.Rd index 5cd49351e3..4835cea04f 100644 --- a/man/mpg.Rd +++ b/man/mpg.Rd @@ -28,4 +28,3 @@ had a new release every year between 1999 and 2008 - this was used as a proxy for the popularity of the car. } \keyword{datasets} - diff --git a/man/msleep.Rd b/man/msleep.Rd index b4537192a6..dc4ad39b9e 100644 --- a/man/msleep.Rd +++ b/man/msleep.Rd @@ -33,4 +33,3 @@ Additional variables order, conservation status and vore were added from wikipedia. } \keyword{datasets} - diff --git a/man/munch_data.Rd b/man/munch_data.Rd new file mode 100644 index 0000000000..fe5e043bce --- /dev/null +++ b/man/munch_data.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/coord-munch.r +\name{munch_data} +\alias{munch_data} +\title{For munching, only grobs are lines and polygons: everything else is +transformed into those special cases by the geom.} +\usage{ +munch_data(data, dist = NULL, segment_length = 0.01) +} +\arguments{ +\item{dist}{distance, scaled from 0 to 1 (maximum distance on plot)} +} +\description{ +For munching, only grobs are lines and polygons: everything else is +transformed into those special cases by the geom. +} +\keyword{internal} diff --git a/man/plot_a_theme.Rd b/man/plot_a_theme.Rd new file mode 100644 index 0000000000..980fd96372 --- /dev/null +++ b/man/plot_a_theme.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/theme.r +\name{plot_a_theme} +\alias{plot_a_theme} +\title{Combine plot defaults with current theme to get complete theme for a plot} +\usage{ +plot_a_theme(x) +} +\arguments{ +\item{x}{....} +} +\description{ +Combine plot defaults with current theme to get complete theme for a plot +} diff --git a/man/position_dodge.Rd b/man/position_dodge.Rd deleted file mode 100644 index 2e49807d70..0000000000 --- a/man/position_dodge.Rd +++ /dev/null @@ -1,54 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/position-dodge.r -\name{position_dodge} -\alias{position_dodge} -\title{Adjust position by dodging overlaps to the side.} -\usage{ -position_dodge(width = NULL) -} -\arguments{ -\item{width}{Dodging width, when different to the width of the individual -elements. This is useful when you want to align narrow geoms with wider -geoms. See the examples for a use case.} -} -\description{ -Adjust position by dodging overlaps to the side. -} -\examples{ -ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) + - geom_bar(position = "dodge") -\donttest{ -ggplot(diamonds, aes(price, fill = cut)) + - geom_histogram(position="dodge") -# see ?geom_boxplot and ?geom_bar for more examples - -# To dodge items with different widths, you need to be explicit -df <- data.frame(x = c("a","a","b","b"), y = 2:5, g = rep(1:2, 2)) -p <- ggplot(df, aes(x, y, group = g)) + - geom_bar( - stat = "identity", position = "dodge", - fill = "grey50", colour = "black" - ) -p - -# A line range has no width: -p + geom_linerange(aes(ymin = y-1, ymax = y+1), position = "dodge") -# You need to explicitly specify the width for dodging -p + geom_linerange(aes(ymin = y-1, ymax = y+1), - position = position_dodge(width = 0.9)) - -# Similarly with error bars: -p + geom_errorbar(aes(ymin = y-1, ymax = y+1), width = 0.2, - position = "dodge") -p + geom_errorbar(aes(ymin = y-1, ymax = y+1, width = 0.2), - position = position_dodge(width = 0.90)) -} -} -\seealso{ -Other position adjustments: \code{\link{position_fill}}, - \code{\link{position_identity}}, - \code{\link{position_jitterdodge}}, - \code{\link{position_jitter}}, - \code{\link{position_nudge}} -} - diff --git a/man/position_identity.Rd b/man/position_identity.Rd deleted file mode 100644 index d15fe2ce8b..0000000000 --- a/man/position_identity.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/position-identity.r -\name{position_identity} -\alias{position_identity} -\title{Don't adjust position} -\usage{ -position_identity() -} -\description{ -Don't adjust position -} -\seealso{ -Other position adjustments: \code{\link{position_dodge}}, - \code{\link{position_fill}}, - \code{\link{position_jitterdodge}}, - \code{\link{position_jitter}}, - \code{\link{position_nudge}} -} - diff --git a/man/position_nudge.Rd b/man/position_nudge.Rd deleted file mode 100644 index fee17cda33..0000000000 --- a/man/position_nudge.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/position-nudge.R -\name{position_nudge} -\alias{position_nudge} -\title{Nudge points.} -\usage{ -position_nudge(x = 0, y = 0) -} -\arguments{ -\item{x, y}{Amount of vertical and horizontal distance to move.} -} -\description{ -This is useful if you want to nudge labels a little ways from their -points. -} -\examples{ -df <- data.frame( - x = c(1,3,2,5), - y = c("a","c","d","c") -) - -ggplot(df, aes(x, y)) + - geom_point() + - geom_text(aes(label = y)) - -ggplot(df, aes(x, y)) + - geom_point() + - geom_text(aes(label = y), position = position_nudge(y = -0.1)) -} -\seealso{ -Other position adjustments: \code{\link{position_dodge}}, - \code{\link{position_fill}}, - \code{\link{position_identity}}, - \code{\link{position_jitterdodge}}, - \code{\link{position_jitter}} -} - diff --git a/man/position_stack.Rd b/man/position_stack.Rd deleted file mode 100644 index 6bbde035a6..0000000000 --- a/man/position_stack.Rd +++ /dev/null @@ -1,61 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/position-fill.r, R/position-stack.r -\name{position_fill} -\alias{position_fill} -\alias{position_stack} -\title{Stack overlapping objects on top of one another.} -\usage{ -position_fill() - -position_stack() -} -\description{ -\code{position_fill} additionally standardises each stack to have unit -height. -} -\examples{ -# Stacking is the default behaviour for most area plots: -ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) + geom_bar() -# Fill makes it easier to compare proportions -ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) + - geom_bar(position = "fill") - -# To change stacking order, use factor() to change order of levels -mtcars$vs <- factor(mtcars$vs, levels = c(1,0)) -ggplot(mtcars, aes(factor(cyl), fill = factor(vs))) + geom_bar() - -ggplot(diamonds, aes(price, fill = cut)) + - geom_histogram(binwidth = 500) -# When used with a histogram, position_fill creates a conditional density -# estimate -ggplot(diamonds, aes(price, fill = cut)) + - geom_histogram(binwidth = 500, position = "fill") - -# Stacking is also useful for time series -data.set <- data.frame( - Time = c(rep(1, 4),rep(2, 4), rep(3, 4), rep(4, 4)), - Type = rep(c('a', 'b', 'c', 'd'), 4), - Value = rpois(16, 10) -) - -ggplot(data.set, aes(Time, Value)) + geom_area(aes(fill = Type)) - -# If you want to stack lines, you need to say so: -ggplot(data.set, aes(Time, Value)) + geom_line(aes(colour = Type)) -ggplot(data.set, aes(Time, Value)) + - geom_line(position = "stack", aes(colour = Type)) - -# But realise that this makes it *much* harder to compare individual -# trends -} -\seealso{ -See \code{\link{geom_bar}} and \code{\link{geom_area}} for - more examples. - -Other position adjustments: \code{\link{position_dodge}}, - \code{\link{position_identity}}, - \code{\link{position_jitterdodge}}, - \code{\link{position_jitter}}, - \code{\link{position_nudge}} -} - diff --git a/man/presidential.Rd b/man/presidential.Rd index 26a70daf95..e44659cd28 100644 --- a/man/presidential.Rd +++ b/man/presidential.Rd @@ -13,4 +13,3 @@ The names of each president, the start and end date of their term, and their party of 11 US presidents from Eisenhower to Obama. } \keyword{datasets} - diff --git a/man/print.ggproto.Rd b/man/print.a_ggproto.Rd similarity index 58% rename from man/print.ggproto.Rd rename to man/print.a_ggproto.Rd index 273236d9e3..4cb1de9406 100644 --- a/man/print.ggproto.Rd +++ b/man/print.a_ggproto.Rd @@ -1,23 +1,22 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggproto.r -\name{print.ggproto} -\alias{print.ggproto} -\title{Print a ggproto object} +\name{print.a_ggproto} +\alias{print.a_ggproto} +\title{Print a a_ggproto object} \usage{ -\method{print}{ggproto}(x, ..., flat = TRUE) +\method{print}{a_ggproto}(x, ..., flat = TRUE) } \arguments{ -\item{x}{A ggproto object to print.} +\item{x}{A a_ggproto object to print.} -\item{...}{If the ggproto object has a \code{print} method, further arguments +\item{...}{If the a_ggproto object has a \code{print} method, further arguments will be passed to it. Otherwise, these arguments are unused.} \item{flat}{If \code{TRUE} (the default), show a flattened list of all local and inherited members. If \code{FALSE}, show the inheritance hierarchy.} } \description{ -If a ggproto object has a \code{$print} method, this will call that method. +If a a_ggproto object has a \code{$print} method, this will call that method. Otherwise, it will print out the members of the object, and optionally, the members of the inherited objects. } - diff --git a/man/print.ggplot.Rd b/man/print.a_plot.Rd similarity index 66% rename from man/print.ggplot.Rd rename to man/print.a_plot.Rd index ce6a8f1324..91616d5cfe 100644 --- a/man/print.ggplot.Rd +++ b/man/print.a_plot.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.r -\name{print.ggplot} -\alias{plot.ggplot} -\alias{print.ggplot} +\name{print.a_plot} +\alias{print.a_plot} +\alias{plot.a_plot} \title{Draw plot on current graphics device.} \usage{ -\method{print}{ggplot}(x, newpage = is.null(vp), vp = NULL, ...) +\method{print}{a_plot}(x, newpage = is.null(vp), vp = NULL, ...) -\method{plot}{ggplot}(x, newpage = is.null(vp), vp = NULL, ...) +\method{plot}{a_plot}(x, newpage = is.null(vp), vp = NULL, ...) } \arguments{ \item{x}{plot to display} @@ -19,7 +19,7 @@ \item{...}{other arguments not used by this method} } \value{ -Invisibly returns the result of \code{\link{ggplot_build}}, which +Invisibly returns the result of \code{\link{a_plot_build}}, which is a list with components that contain the plot itself, the data, information about the scales, panels etc. } @@ -27,4 +27,3 @@ Invisibly returns the result of \code{\link{ggplot_build}}, which Draw plot on current graphics device. } \keyword{hplot} - diff --git a/man/qplot.Rd b/man/qplot.Rd index 8e68bab533..148c555300 100644 --- a/man/qplot.Rd +++ b/man/qplot.Rd @@ -6,14 +6,16 @@ \title{Quick plot} \usage{ qplot(x, y = NULL, ..., data, facets = NULL, margins = FALSE, - geom = "auto", xlim = c(NA, NA), ylim = c(NA, NA), log = "", + a_geom = "auto", xlim = c(NA, NA), ylim = c(NA, NA), log = "", main = NULL, xlab = deparse(substitute(x)), - ylab = deparse(substitute(y)), asp = NA, stat = NULL, position = NULL) + ylab = deparse(substitute(y)), asp = NA, a_stat = NULL, + a_position = NULL) quickplot(x, y = NULL, ..., data, facets = NULL, margins = FALSE, - geom = "auto", xlim = c(NA, NA), ylim = c(NA, NA), log = "", + a_geom = "auto", xlim = c(NA, NA), ylim = c(NA, NA), log = "", main = NULL, xlab = deparse(substitute(x)), - ylab = deparse(substitute(y)), asp = NA, stat = NULL, position = NULL) + ylab = deparse(substitute(y)), asp = NA, a_stat = NULL, + a_position = NULL) } \arguments{ \item{x, y, ...}{Aesthetics passed into each layer} @@ -21,13 +23,13 @@ quickplot(x, y = NULL, ..., data, facets = NULL, margins = FALSE, \item{data}{Data frame to use (optional). If not specified, will create one, extracting vectors from the current environment.} -\item{facets}{faceting formula to use. Picks \code{\link{facet_wrap}} or -\code{\link{facet_grid}} depending on whether the formula is one- +\item{facets}{faceting formula to use. Picks \code{\link{a_facet_wrap}} or +\code{\link{a_facet_grid}} depending on whether the formula is one- or two-sided} -\item{margins}{See \code{facet_grid}: display marginal facets?} +\item{margins}{See \code{a_facet_grid}: display marginal facets?} -\item{geom}{Character vector specifying geom(s) to draw. Defaults to +\item{a_geom}{Character vector specifying geom(s) to draw. Defaults to "point" if x and y are specified, and "histogram" if only x is specified.} \item{xlim, ylim}{X and y axis limits} @@ -39,7 +41,7 @@ x axis label, and y axis label respectively.} \item{asp}{The y/x aspect ratio} -\item{stat, position}{DEPRECATED.} +\item{a_stat, a_position}{DEPRECATED.} } \description{ \code{qplot} is the basic plotting function in the ggplot2 package, @@ -79,9 +81,8 @@ qplot(mpg, data = mtcars) qplot(y = mpg, data = mtcars) # Use different geoms -qplot(mpg, wt, data = mtcars, geom = "path") -qplot(factor(cyl), wt, data = mtcars, geom = c("boxplot", "jitter")) -qplot(mpg, data = mtcars, geom = "dotplot") +qplot(mpg, wt, data = mtcars, a_geom = "path") +qplot(factor(cyl), wt, data = mtcars, a_geom = c("boxplot", "jitter")) +qplot(mpg, data = mtcars, a_geom = "dotplot") } } - diff --git a/man/reexports.Rd b/man/reexports.Rd index d83c0f6124..bf7477ecca 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -2,11 +2,21 @@ % Please edit documentation in R/utilities.r, R/utilities-grid.r \docType{import} \name{reexports} +\alias{reexports} \alias{alpha} -\alias{arrow} \alias{reexports} \alias{unit} +\alias{reexports} +\alias{arrow} \title{Objects exported from other packages} +\examples{ +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point(alpha = 0.5, colour = "blue") + +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point(colour = alpha("blue", 0.5)) +} +\keyword{internal} \description{ These objects are imported from other packages. Follow the links below to see their documentation. @@ -16,12 +26,4 @@ below to see their documentation. \item{scales}{\code{\link[scales]{alpha}}} }} -\examples{ -ggplot(mpg, aes(displ, hwy)) + - geom_point(alpha = 0.5, colour = "blue") - -ggplot(mpg, aes(displ, hwy)) + - geom_point(colour = alpha("blue", 0.5)) -} -\keyword{internal} diff --git a/man/rel.Rd b/man/rel.Rd index 8728154792..e247968573 100644 --- a/man/rel.Rd +++ b/man/rel.Rd @@ -14,8 +14,7 @@ Relative sizing for theme elements } \examples{ df <- data.frame(x = 1:3, y = 1:3) -ggplot(df, aes(x, y)) + - geom_point() + - theme(axis.title.x = element_text(size = rel(2.5))) +a_plot(df, a_aes(x, y)) + + a_geom_point() + + a_theme(axis.title.x = a_element_text(size = rel(2.5))) } - diff --git a/man/remove_missing.Rd b/man/remove_missing.Rd index 4748e7807f..213beb73d9 100644 --- a/man/remove_missing.Rd +++ b/man/remove_missing.Rd @@ -26,4 +26,3 @@ automatically removed with a warning. If \code{na.rm = TRUE} is supplied to the statistic, the warning will be suppressed. } \keyword{internal} - diff --git a/man/resolution.Rd b/man/resolution.Rd deleted file mode 100644 index be2e1dd564..0000000000 --- a/man/resolution.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities-resolution.r -\name{resolution} -\alias{resolution} -\title{Compute the "resolution" of a data vector.} -\usage{ -resolution(x, zero = TRUE) -} -\arguments{ -\item{x}{numeric vector} - -\item{zero}{should a zero value be automatically included in the -computation of resolution} -} -\description{ -The resolution is is the smallest non-zero distance between adjacent -values. If there is only one unique value, then the resolution is defined -to be one. -} -\details{ -If x is an integer vector, then it is assumed to represent a discrete -variable, and the resolution is 1. -} -\examples{ -resolution(1:10) -resolution((1:10) - 0.5) -resolution((1:10) - 0.5, FALSE) -resolution(c(1,2, 10, 20, 50)) -resolution(as.integer(c(1, 10, 20, 50))) # Returns 1 -} - diff --git a/man/scale_alpha.Rd b/man/scale_alpha.Rd deleted file mode 100644 index 8da57a0e47..0000000000 --- a/man/scale_alpha.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scale-alpha.r -\name{scale_alpha} -\alias{scale_alpha} -\alias{scale_alpha_continuous} -\alias{scale_alpha_discrete} -\title{Alpha scales.} -\usage{ -scale_alpha(..., range = c(0.1, 1)) - -scale_alpha_continuous(..., range = c(0.1, 1)) - -scale_alpha_discrete(..., range = c(0.1, 1)) -} -\arguments{ -\item{...}{Other arguments passed on to \code{\link{continuous_scale}} -or \code{\link{discrete_scale}} as appropriate, to control name, limits, -breaks, labels and so forth.} - -\item{range}{range of output alpha values. Should lie between 0 and 1.} -} -\description{ -\code{scale_alpha} is an alias for \code{scale_alpha_continuous} since -that is the most common use of alpha, and it saves a bit of typing. -} -\examples{ -(p <- ggplot(mtcars, aes(mpg, cyl)) + - geom_point(aes(alpha = cyl))) -p + scale_alpha("cylinders") -p + scale_alpha("number\\nof\\ncylinders") - -p + scale_alpha(range = c(0.4, 0.8)) - -(p <- ggplot(mtcars, aes(mpg, cyl)) + - geom_point(aes(alpha = factor(cyl)))) -p + scale_alpha_discrete(range = c(0.4, 0.8)) -} - diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd deleted file mode 100644 index 1f77123ffe..0000000000 --- a/man/scale_gradient.Rd +++ /dev/null @@ -1,123 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scale-gradient.r, R/zxx.r -\name{scale_colour_gradient} -\alias{scale_color_continuous} -\alias{scale_color_gradient} -\alias{scale_color_gradient2} -\alias{scale_color_gradientn} -\alias{scale_colour_continuous} -\alias{scale_colour_date} -\alias{scale_colour_datetime} -\alias{scale_colour_gradient} -\alias{scale_colour_gradient2} -\alias{scale_colour_gradientn} -\alias{scale_fill_continuous} -\alias{scale_fill_date} -\alias{scale_fill_datetime} -\alias{scale_fill_gradient} -\alias{scale_fill_gradient2} -\alias{scale_fill_gradientn} -\title{Smooth gradient between two colours} -\usage{ -scale_colour_gradient(..., low = "#132B43", high = "#56B1F7", - space = "Lab", na.value = "grey50", guide = "colourbar") - -scale_fill_gradient(..., low = "#132B43", high = "#56B1F7", space = "Lab", - na.value = "grey50", guide = "colourbar") - -scale_colour_gradient2(..., low = muted("red"), mid = "white", - high = muted("blue"), midpoint = 0, space = "Lab", - na.value = "grey50", guide = "colourbar") - -scale_fill_gradient2(..., low = muted("red"), mid = "white", - high = muted("blue"), midpoint = 0, space = "Lab", - na.value = "grey50", guide = "colourbar") - -scale_colour_gradientn(..., colours, values = NULL, space = "Lab", - na.value = "grey50", guide = "colourbar", colors) - -scale_fill_gradientn(..., colours, values = NULL, space = "Lab", - na.value = "grey50", guide = "colourbar", colors) -} -\arguments{ -\item{...}{Other arguments passed on to \code{\link{discrete_scale}} -to control name, limits, breaks, labels and so forth.} - -\item{low, high}{Colours for low and high ends of the gradient.} - -\item{space}{colour space in which to calculate gradient. Must be "Lab" - -other values are deprecated.} - -\item{na.value}{Colour to use for missing values} - -\item{guide}{Type of legend. Use \code{"colourbar"} for continuous -colour bar, or \code{"legend"} for discrete colour legend.} - -\item{mid}{colour for mid point} - -\item{midpoint}{The midpoint (in data value) of the diverging scale. -Defaults to 0.} - -\item{colours, colors}{Vector of colours to use for n-colour gradient.} - -\item{values}{if colours should not be evenly positioned along the gradient -this vector gives the position (between 0 and 1) for each colour in the -\code{colours} vector. See \code{\link{rescale}} for a convience function -to map an arbitrary range to between 0 and 1.} -} -\description{ -\code{scale_*_gradient} creates a two colour gradient (low-high), -\code{scale_*_gradient2} creates a diverging colour gradient (low-mid-high), -\code{scale_*_gradientn} creats a n-colour gradient. -} -\details{ -Default colours are generated with \pkg{munsell} and -\code{mnsl(c("2.5PB 2/4", "2.5PB 7/10")}. Generally, for continuous -colour scales you want to keep hue constant, but vary chroma and -luminance. The \pkg{munsell} package makes this easy to do using the -Munsell colour system. -} -\examples{ -df <- data.frame( - x = runif(100), - y = runif(100), - z1 = rnorm(100), - z2 = abs(rnorm(100)) -) - -# Default colour scale colours from light blue to dark blue -ggplot(df, aes(x, y)) + - geom_point(aes(colour = z2)) - -# For diverging colour scales use gradient2 -ggplot(df, aes(x, y)) + - geom_point(aes(colour = z1)) + - scale_colour_gradient2() - -# Use your own colour scale with gradientn -ggplot(df, aes(x, y)) + - geom_point(aes(colour = z1)) + - scale_colour_gradientn(colours = terrain.colors(10)) - -# Equivalent fill scales do the same job for the fill aesthetic -ggplot(faithfuld, aes(waiting, eruptions)) + - geom_raster(aes(fill = density)) + - scale_fill_gradientn(colours = terrain.colors(10)) - -# Adjust colour choices with low and high -ggplot(df, aes(x, y)) + - geom_point(aes(colour = z2)) + - scale_colour_gradient(low = "white", high = "black") -# Avoid red-green colour contrasts because ~10\% of men have difficulty -# seeing them -} -\seealso{ -\code{\link[scales]{seq_gradient_pal}} for details on underlying - palette - -Other colour scales: - \code{\link{scale_colour_brewer}}, - \code{\link{scale_colour_grey}}, - \code{\link{scale_colour_hue}} -} - diff --git a/man/scale_grey.Rd b/man/scale_grey.Rd deleted file mode 100644 index 7b9cf754d9..0000000000 --- a/man/scale_grey.Rd +++ /dev/null @@ -1,49 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scale-grey.r, R/zxx.r -\name{scale_colour_grey} -\alias{scale_color_grey} -\alias{scale_colour_grey} -\alias{scale_fill_grey} -\title{Sequential grey colour scale.} -\usage{ -scale_colour_grey(..., start = 0.2, end = 0.8, na.value = "red") - -scale_fill_grey(..., start = 0.2, end = 0.8, na.value = "red") -} -\arguments{ -\item{...}{Other arguments passed on to \code{\link{discrete_scale}} -to control name, limits, breaks, labels and so forth.} - -\item{start}{gray value at low end of palette} - -\item{end}{gray value at high end of palette} - -\item{na.value}{Colour to use for missing values} -} -\description{ -Based on \code{\link{gray.colors}} -} -\examples{ -p <- ggplot(mtcars, aes(mpg, wt)) + geom_point(aes(colour = factor(cyl))) -p + scale_colour_grey() -p + scale_colour_grey(end = 0) - -# You may want to turn off the pale grey background with this scale -p + scale_colour_grey() + theme_bw() - -# Colour of missing values is controlled with na.value: -miss <- factor(sample(c(NA, 1:5), nrow(mtcars), replace = TRUE)) -ggplot(mtcars, aes(mpg, wt)) + - geom_point(aes(colour = miss)) + - scale_colour_grey() -ggplot(mtcars, aes(mpg, wt)) + - geom_point(aes(colour = miss)) + - scale_colour_grey(na.value = "green") -} -\seealso{ -Other colour scales: - \code{\link{scale_colour_brewer}}, - \code{\link{scale_colour_gradient}}, - \code{\link{scale_colour_hue}} -} - diff --git a/man/scale_hue.Rd b/man/scale_hue.Rd deleted file mode 100644 index 98a8c3d567..0000000000 --- a/man/scale_hue.Rd +++ /dev/null @@ -1,82 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scale-hue.r, R/zxx.r -\name{scale_colour_hue} -\alias{scale_color_discrete} -\alias{scale_color_hue} -\alias{scale_colour_discrete} -\alias{scale_colour_hue} -\alias{scale_fill_discrete} -\alias{scale_fill_hue} -\title{Qualitative colour scale with evenly spaced hues.} -\usage{ -scale_colour_hue(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, - direction = 1, na.value = "grey50") - -scale_fill_hue(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, - direction = 1, na.value = "grey50") -} -\arguments{ -\item{...}{Other arguments passed on to \code{\link{discrete_scale}} -to control name, limits, breaks, labels and so forth.} - -\item{h}{range of hues to use, in [0, 360]} - -\item{c}{chroma (intensity of colour), maximum value varies depending on -combination of hue and luminance.} - -\item{l}{luminance (lightness), in [0, 100]} - -\item{h.start}{hue to start at} - -\item{direction}{direction to travel around the colour wheel, -1 = clockwise, -1 = counter-clockwise} - -\item{na.value}{Colour to use for missing values} -} -\description{ -Qualitative colour scale with evenly spaced hues. -} -\examples{ -\donttest{ -dsamp <- diamonds[sample(nrow(diamonds), 1000), ] -(d <- ggplot(dsamp, aes(carat, price)) + geom_point(aes(colour = clarity))) - -# Change scale label -d + scale_colour_hue() -d + scale_colour_hue("clarity") -d + scale_colour_hue(expression(clarity[beta])) - -# Adjust luminosity and chroma -d + scale_colour_hue(l = 40, c = 30) -d + scale_colour_hue(l = 70, c = 30) -d + scale_colour_hue(l = 70, c = 150) -d + scale_colour_hue(l = 80, c = 150) - -# Change range of hues used -d + scale_colour_hue(h = c(0, 90)) -d + scale_colour_hue(h = c(90, 180)) -d + scale_colour_hue(h = c(180, 270)) -d + scale_colour_hue(h = c(270, 360)) - -# Vary opacity -# (only works with pdf, quartz and cairo devices) -d <- ggplot(dsamp, aes(carat, price, colour = clarity)) -d + geom_point(alpha = 0.9) -d + geom_point(alpha = 0.5) -d + geom_point(alpha = 0.2) - -# Colour of missing values is controlled with na.value: -miss <- factor(sample(c(NA, 1:5), nrow(mtcars), replace = TRUE)) -ggplot(mtcars, aes(mpg, wt)) + geom_point(aes(colour = miss)) -ggplot(mtcars, aes(mpg, wt)) + - geom_point(aes(colour = miss)) + - scale_colour_hue(na.value = "black") -} -} -\seealso{ -Other colour scales: - \code{\link{scale_colour_brewer}}, - \code{\link{scale_colour_gradient}}, - \code{\link{scale_colour_grey}} -} - diff --git a/man/scale_identity.Rd b/man/scale_identity.Rd deleted file mode 100644 index 8b637546eb..0000000000 --- a/man/scale_identity.Rd +++ /dev/null @@ -1,69 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scale-identity.r, R/zxx.r -\name{scale_identity} -\alias{scale_alpha_identity} -\alias{scale_color_identity} -\alias{scale_colour_identity} -\alias{scale_fill_identity} -\alias{scale_identity} -\alias{scale_linetype_identity} -\alias{scale_shape_identity} -\alias{scale_size_identity} -\title{Use values without scaling.} -\usage{ -scale_colour_identity(..., guide = "none") - -scale_fill_identity(..., guide = "none") - -scale_shape_identity(..., guide = "none") - -scale_linetype_identity(..., guide = "none") - -scale_alpha_identity(..., guide = "none") - -scale_size_identity(..., guide = "none") -} -\arguments{ -\item{...}{Other arguments passed on to \code{\link{discrete_scale}} or -\code{\link{continuous_scale}}} - -\item{guide}{Guide to use for this scale - defaults to \code{"none"}.} -} -\description{ -Use values without scaling. -} -\examples{ -ggplot(luv_colours, aes(u, v)) + - geom_point(aes(colour = col), size = 3) + - scale_color_identity() + - coord_equal() - -df <- data.frame( - x = 1:4, - y = 1:4, - colour = c("red", "green", "blue", "yellow") -) -ggplot(df, aes(x, y)) + geom_tile(aes(fill = colour)) -ggplot(df, aes(x, y)) + - geom_tile(aes(fill = colour)) + - scale_fill_identity() - -# To get a legend guide, specify guide = "legend" -ggplot(df, aes(x, y)) + - geom_tile(aes(fill = colour)) + - scale_fill_identity(guide = "legend") -# But you'll typically also need to supply breaks and labels: -ggplot(df, aes(x, y)) + - geom_tile(aes(fill = colour)) + - scale_fill_identity("trt", labels = letters[1:4], breaks = df$colour, - guide = "legend") - -# cyl scaled to appropriate size -ggplot(mtcars, aes(mpg, wt)) + geom_point(aes(size = cyl)) - -# cyl used as point size -ggplot(mtcars, aes(mpg, wt)) + - geom_point(aes(size = cyl)) + - scale_size_identity() -} - diff --git a/man/scale_linetype.Rd b/man/scale_linetype.Rd deleted file mode 100644 index 35f5b3152e..0000000000 --- a/man/scale_linetype.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scale-linetype.r -\name{scale_linetype} -\alias{scale_linetype} -\alias{scale_linetype_continuous} -\alias{scale_linetype_discrete} -\title{Scale for line patterns.} -\usage{ -scale_linetype(..., na.value = "blank") - -scale_linetype_continuous(...) - -scale_linetype_discrete(..., na.value = "blank") -} -\arguments{ -\item{...}{common discrete scale parameters: \code{name}, \code{breaks}, -\code{labels}, \code{na.value}, \code{limits} and \code{guide}. See -\code{\link{discrete_scale}} for more details} - -\item{na.value}{The linetype to use for \code{NA} values.} -} -\description{ -Default line types based on a set supplied by Richard Pearson, -University of Manchester. Line types can not be mapped to continuous -values. -} -\examples{ -base <- ggplot(economics_long, aes(date, value01)) -base + geom_line(aes(group = variable)) -base + geom_line(aes(linetype = variable)) - -# See scale_manual for more flexibility -} - diff --git a/man/scale_manual.Rd b/man/scale_manual.Rd deleted file mode 100644 index 06e7786fbb..0000000000 --- a/man/scale_manual.Rd +++ /dev/null @@ -1,69 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scale-manual.r, R/zxx.r -\name{scale_manual} -\alias{scale_alpha_manual} -\alias{scale_color_manual} -\alias{scale_colour_manual} -\alias{scale_fill_manual} -\alias{scale_linetype_manual} -\alias{scale_manual} -\alias{scale_shape_manual} -\alias{scale_size_manual} -\title{Create your own discrete scale.} -\usage{ -scale_colour_manual(..., values) - -scale_fill_manual(..., values) - -scale_size_manual(..., values) - -scale_shape_manual(..., values) - -scale_linetype_manual(..., values) - -scale_alpha_manual(..., values) -} -\arguments{ -\item{...}{common discrete scale parameters: \code{name}, \code{breaks}, -\code{labels}, \code{na.value}, \code{limits} and \code{guide}. See -\code{\link{discrete_scale}} for more details} - -\item{values}{a set of aesthetic values to map data values to. If this -is a named vector, then the values will be matched based on the names. -If unnamed, values will be matched in order (usually alphabetical) with -the limits of the scale. Any data values that don't match will be -given \code{na.value}.} -} -\description{ -Create your own discrete scale. -} -\examples{ -\donttest{ -p <- ggplot(mtcars, aes(mpg, wt)) + - geom_point(aes(colour = factor(cyl))) - -p + scale_colour_manual(values = c("red","blue", "green")) -p + scale_colour_manual( - values = c("8" = "red","4" = "blue","6" = "green")) -# With rgb hex values -p + scale_colour_manual(values = c("#FF0000", "#0000FF", "#00FF00")) - -# As with other scales you can use breaks to control the appearance -# of the legend -cols <- c("8" = "red","4" = "blue","6" = "darkgreen", "10" = "orange") -p + scale_colour_manual(values = cols) -p + scale_colour_manual(values = cols, breaks = c("4", "6", "8")) -p + scale_colour_manual(values = cols, breaks = c("8", "6", "4")) -p + scale_colour_manual(values = cols, breaks = c("4", "6", "8"), - labels = c("four", "six", "eight")) - -# And limits to control the possible values of the scale -p + scale_colour_manual(values = cols, limits = c("4", "8")) -p + scale_colour_manual(values = cols, limits = c("4", "6", "8", "10")) - -# Notice that the values are matched with limits, and not breaks -p + scale_colour_manual(limits = c(6, 8, 4), breaks = c(8, 4, 6), - values = c("grey50", "grey80", "black")) -} -} - diff --git a/man/seals.Rd b/man/seals.Rd index 1e9d475203..6e6a8a8fb0 100644 --- a/man/seals.Rd +++ b/man/seals.Rd @@ -20,4 +20,3 @@ Letters. December (2007). \url{http://www.stat.berkeley.edu/~brill/Papers/jspifinal.pdf} } \keyword{datasets} - diff --git a/man/should_stop.Rd b/man/should_stop.Rd index e0113c93f4..3234ef6e66 100644 --- a/man/should_stop.Rd +++ b/man/should_stop.Rd @@ -17,4 +17,3 @@ should_stop(stop("Hi!")) should_stop(should_stop("Hi!")) } \keyword{internal} - diff --git a/man/spiral_arc_length.Rd b/man/spiral_arc_length.Rd new file mode 100644 index 0000000000..e0abb53aa6 --- /dev/null +++ b/man/spiral_arc_length.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/coord-munch.r +\name{spiral_arc_length} +\alias{spiral_arc_length} +\title{Spiral arc length} +\usage{ +spiral_arc_length(a, theta1, theta2) +} +\arguments{ +\item{a}{A vector of spiral "slopes". Each spiral is defined as r = a * theta.} + +\item{theta1}{A vector of starting theta values.} + +\item{theta2}{A vector of ending theta values.} +} +\description{ +Each segment consists of a spiral line of slope 'a' between angles +'theta1' and 'theta2'. Because each segment has its own _normalized_ +slope, the ending theta2 value may not be the same as the starting +theta1 value of the next point. +} +\examples{ +ggplot2Animint:::spiral_arc_length(a = c(0.2, 0.5), c(0.5 * pi, pi), c(pi, 1.25 * pi)) +} +\keyword{internal} diff --git a/man/summary.ggplot.Rd b/man/summary.a_plot.Rd similarity index 73% rename from man/summary.ggplot.Rd rename to man/summary.a_plot.Rd index 0e841d4a7a..df4ac3d2be 100644 --- a/man/summary.ggplot.Rd +++ b/man/summary.a_plot.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary.r -\name{summary.ggplot} -\alias{summary.ggplot} +\name{summary.a_plot} +\alias{summary.a_plot} \title{Displays a useful description of a ggplot object} \usage{ -\method{summary}{ggplot}(object, ...) +\method{summary}{a_plot}(object, ...) } \arguments{ \item{object}{ggplot2 object to summarise} @@ -15,9 +15,8 @@ Displays a useful description of a ggplot object } \examples{ -p <- ggplot(mtcars, aes(mpg, wt)) + - geom_point() +p <- a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point() summary(p) } \keyword{internal} - diff --git a/man/theme_update.Rd b/man/theme_update.Rd deleted file mode 100644 index ec90647127..0000000000 --- a/man/theme_update.Rd +++ /dev/null @@ -1,69 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/theme.r -\name{theme_update} -\alias{theme_get} -\alias{theme_replace} -\alias{theme_set} -\alias{theme_update} -\title{Get, set and update themes.} -\usage{ -theme_update(...) - -theme_replace(...) - -theme_get() - -theme_set(new) -} -\arguments{ -\item{...}{named list of theme settings} - -\item{new}{new theme (a list of theme elements)} -} -\description{ -Use \code{theme_get} to get the current theme, and \code{theme_set} to -completely override it. \code{theme_update} and \code{theme_replace} are -shorthands for changing individual elements in the current theme. -\code{theme_update} uses the \code{+} operator, so that any unspecified -values in the theme element will default to the values they are set in the -theme. \code{theme_replace} will completely replace the element, so any -unspecified values will overwrite the current value in the theme with \code{NULL}s. -} -\examples{ -p <- ggplot(mtcars, aes(mpg, wt)) + - geom_point() -p -old <- theme_set(theme_bw()) -p -theme_set(old) -p - -#theme_replace NULLs out the fill attribute of panel.background, -#resulting in a white background: -theme_get()$panel.background -old <- theme_replace(panel.background = element_rect(colour = "pink")) -theme_get()$panel.background -p -theme_set(old) - -#theme_update only changes the colour attribute, leaving the others intact: -old <- theme_update(panel.background = element_rect(colour = "pink")) -theme_get()$panel.background -p -theme_set(old) - -theme_get() - - -ggplot(mtcars, aes(mpg, wt)) + - geom_point(aes(color = mpg)) + - theme(legend.position = c(0.95, 0.95), - legend.justification = c(1, 1)) -last_plot() + - theme(legend.background = element_rect(fill = "white", colour = "white", size = 3)) - -} -\seealso{ -\code{\link{\%+replace\%}} and \code{\link{+.gg}} -} - diff --git a/man/train_position.Rd b/man/train_position.Rd new file mode 100644 index 0000000000..4fcb8c5593 --- /dev/null +++ b/man/train_position.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/panel.r +\name{train_position} +\alias{train_position} +\title{Train position scales with data} +\usage{ +train_position(panel, data, x_scale, y_scale) +} +\arguments{ +\item{panel}{the panel object to train} + +\item{data}{a list of data frames (one for each a_layer)} + +\item{x_scale}{x scale for the plot} + +\item{y_scale}{y scale for the plot} +} +\description{ +If panel-specific scales are not already present, will clone from +the scales provided in the parameter +} +\keyword{internal} diff --git a/man/transform_position.Rd b/man/transform_position.Rd index b549ad5f43..c1d842aa57 100644 --- a/man/transform_position.Rd +++ b/man/transform_position.Rd @@ -7,6 +7,8 @@ transform_position(df, trans_x = NULL, trans_y = NULL, ...) } \arguments{ +\item{df}{....} + \item{trans_x, trans_y}{Transformation functions for x and y aesthetics. (will transform x, xmin, xmax, xend etc)} @@ -15,5 +17,3 @@ transform_position(df, trans_x = NULL, trans_y = NULL, ...) \description{ Convenience function to transform all position variables. } -\keyword{internal} - diff --git a/man/translate_qplot_ggplot.Rd b/man/translate_qplot_a_plot.Rd similarity index 52% rename from man/translate_qplot_ggplot.Rd rename to man/translate_qplot_a_plot.Rd index 7c705af4bf..12f48c3e67 100644 --- a/man/translate_qplot_ggplot.Rd +++ b/man/translate_qplot_a_plot.Rd @@ -1,22 +1,22 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/translate-qplot-ggplot.r -\name{translate_qplot_ggplot} -\alias{translate_qplot_ggplot} -\title{Translating between qplot and ggplot} +\name{translate_qplot_a_plot} +\alias{translate_qplot_a_plot} +\title{Translating between qplot and a_plot} \description{ Within ggplot2, there are two basic methods to create plots, with qplot() -and ggplot(). qplot() is designed primarily for interactive use: it makes +and a_plot(). qplot() is designed primarily for interactive use: it makes a number of assumptions that speed most cases, but when designing multilayered plots with different data sources it can get in the way. This section -describes what those defaults are, and how they map to the fuller ggplot() +describes what those defaults are, and how they map to the fuller a_plot() syntax. } \examples{ # By default, qplot() assumes that you want a scatterplot, -# i.e., you want to use geom_point() +# i.e., you want to use a_geom_point() # qplot(x, y, data = data) -# ggplot(data, aes(x, y)) + geom_point() +# a_plot(data, a_aes(x, y)) + a_geom_point() # Using Aesthetics @@ -24,7 +24,7 @@ syntax. # qplot() there is no way to use different aesthetic mappings (or data) in # different layers # qplot(x, y, data = data, shape = shape, colour = colour) -# ggplot(data, aes(x, y, shape = shape, colour = colour)) + geom_point() +# a_plot(data, a_aes(x, y, shape = shape, colour = colour)) + a_geom_point() # # Aesthetic parameters in qplot() always try to map the aesthetic to a # variable. If the argument is not a variable but a value, effectively a new column @@ -32,55 +32,54 @@ syntax. # value and override the default appearance, you surround the value with I() in # qplot(), or pass it as a parameter to the layer. # qplot(x, y, data = data, colour = I("red")) -# ggplot(data, aes(x, y)) + geom_point(colour = "red") +# a_plot(data, a_aes(x, y)) + a_geom_point(colour = "red") -# Changing the geom parameter changes the geom added to the plot -# qplot(x, y, data = data, geom = "line") -# ggplot(data, aes(x, y)) + geom_line() +# Changing the a_geom parameter changes the a_geom added to the plot +# qplot(x, y, data = data, a_geom = "line") +# a_plot(data, a_aes(x, y)) + a_geom_line() -# Not all geoms require both x and y, e.g., geom_bar() and geom_histogram(). +# Not all geoms require both x and y, e.g., a_geom_bar() and a_geom_histogram(). # For these two geoms, if the y aesthetic is not supplied, both qplot and -# ggplot commands default to "count" on the y-axis -# ggplot(data, aes(x)) + geom_bar() -# qplot(x, data = data, geom = "bar") +# a_plot commands default to "count" on the y-axis +# a_plot(data, a_aes(x)) + a_geom_bar() +# qplot(x, data = data, a_geom = "bar") -# If a vector of multiple geom names is supplied to the geom argument, each -# geom will be added in turn -# qplot(x, y, data = data, geom = c("point", "smooth")) -# ggplot(data, aes(x, y)) + geom_point() + geom_smooth() +# If a vector of multiple a_geom names is supplied to the a_geom argument, each +# a_geom will be added in turn +# qplot(x, y, data = data, a_geom = c("point", "smooth")) +# a_plot(data, a_aes(x, y)) + a_geom_point() + a_geom_smooth() # Unlike the rest of ggplot2, stats and geoms are independent -# qplot(x, y, data = data, stat = "bin") -# ggplot(data, aes(x, y)) + geom_point(stat = "bin") +# qplot(x, y, data = data, a_stat = "bin") +# a_plot(data, a_aes(x, y)) + a_geom_point(a_stat = "bin") # # Any layer parameters will be passed on to all layers. Most layers will ignore # parameters that they don't need -# qplot(x, y, data = data, geom = c("point", "smooth"), method = "lm") -# ggplot(data, aes(x, y)) + geom_point(method = "lm") + geom_smooth(method = "lm") +# qplot(x, y, data = data, a_geom = c("point", "smooth"), method = "lm") +# a_plot(data, a_aes(x, y)) + a_geom_point(method = "lm") + a_geom_smooth(method = "lm") # Scales and axes # You can control basic properties of the x and y scales with the xlim, ylim, # xlab and ylab arguments # qplot(x, y, data = data, xlim = c(1, 5), xlab = "my label") -# ggplot(data, aes(x, y)) + geom_point() + -# scale_x_continuous("my label", limits = c(1, 5)) +# a_plot(data, a_aes(x, y)) + a_geom_point() + +# a_scale_x_continuous("my label", limits = c(1, 5)) # qplot(x, y, data = data, xlim = c(1, 5), ylim = c(10, 20)) -# ggplot(data, aes(x, y)) + geom_point() + -# scale_x_continuous(limits = c(1, 5)) + scale_y_continuous(limits = c(10, 20)) +# a_plot(data, a_aes(x, y)) + a_geom_point() + +# a_scale_x_continuous(limits = c(1, 5)) + a_scale_y_continuous(limits = c(10, 20)) # Like plot(), qplot() has a convenient way of log transforming the axes. # qplot(x, y, data = data, log = "xy") -# ggplot(data, aes(x, y)) + geom_point() + scale_x_log10() + scale_y_log10() +# a_plot(data, a_aes(x, y)) + a_geom_point() + a_scale_x_log10() + a_scale_y_log10() # There are many other possible transformations, but not all are -# accessible from within qplot(), see ?scale_continuous for more +# accessible from within qplot(), see ?a_scale_continuous for more # Plot options # qplot() recognises the same options as plot does, and converts them to their -# ggplot2 equivalents. See ?theme for more on ggplot options +# ggplot2 equivalents. See ?a_theme for more on ggplot options # qplot(x, y, data = data, main="title", asp = 1) -# ggplot(data, aes(x, y)) + geom_point() + labs(title = "title") + theme(aspect.ratio = 1) +# a_plot(data, a_aes(x, y)) + a_geom_point() + labs(title = "title") + a_theme(aspect.ratio = 1) } - diff --git a/man/translate_qplot_lattice.Rd b/man/translate_qplot_lattice.Rd index 4ffbeb4073..9cb62651eb 100644 --- a/man/translate_qplot_lattice.Rd +++ b/man/translate_qplot_lattice.Rd @@ -26,16 +26,16 @@ qplot(year, rating, data = movies, facets = Comedy ~ Action) # ggplot2 has qplot(). stripplot(~ rating, data = movies, jitter.data = TRUE) -qplot(rating, 1, data = movies, geom = "jitter") +qplot(rating, 1, data = movies, a_geom = "jitter") histogram(~ rating, data = movies) -qplot(rating, data = movies, geom = "histogram") +qplot(rating, data = movies, a_geom = "histogram") bwplot(Comedy ~ rating ,data = movies) -qplot(factor(Comedy), rating, data = movies, geom = "boxplot") +qplot(factor(Comedy), rating, data = movies, a_geom = "boxplot") xyplot(wt ~ mpg, mtcars, type = c("p","smooth")) -qplot(mpg, wt, data = mtcars, geom = c("point","smooth")) +qplot(mpg, wt, data = mtcars, a_geom = c("point","smooth")) } # The capabilities for scale manipulations are similar in both ggplot2 and @@ -49,8 +49,8 @@ qplot(mpg, wt, data = mtcars, log = "xy") xyplot(wt ~ mpg | cyl, mtcars, scales = list(log = 2)) qplot(mpg, wt, data = mtcars) + - scale_x_continuous(trans = scales::log2_trans()) + - scale_y_continuous(trans = scales::log2_trans()) + a_scale_x_continuous(trans = scales::log2_trans()) + + a_scale_y_continuous(trans = scales::log2_trans()) xyplot(wt ~ mpg, mtcars, group = cyl, auto.key = TRUE) # Map directly to an aesthetic like colour, size, or shape. @@ -71,10 +71,9 @@ qplot(mpg, wt, data = mtcars, xlab = "Miles per gallon", ylab = "Weight", xyplot(wt ~ mpg, mtcars, aspect = 1) qplot(mpg, wt, data = mtcars, asp = 1) -# par.settings() is equivalent to + theme() and trellis.options.set() -# and trellis.par.get() to theme_set() and theme_get(). +# par.settings() is equivalent to + a_theme() and trellis.options.set() +# and trellis.par.get() to a_theme_set() and a_theme_get(). # More complicated lattice formulas are equivalent to rearranging the data # before using ggplot2. } } - diff --git a/man/txhousing.Rd b/man/txhousing.Rd index 54de48b5c6..cd5ca73168 100644 --- a/man/txhousing.Rd +++ b/man/txhousing.Rd @@ -23,4 +23,3 @@ Information about the housing market in Texas provided by the TAMU real estate center, \url{http://recenter.tamu.edu/}. } \keyword{datasets} - diff --git a/man/update_a_labels.Rd b/man/update_a_labels.Rd new file mode 100644 index 0000000000..bf23b44961 --- /dev/null +++ b/man/update_a_labels.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/labels.r +\name{update_a_labels} +\alias{update_a_labels} +\title{Update axis/legend labels} +\usage{ +update_a_labels(p, a_labels) +} +\arguments{ +\item{p}{plot to modify} + +\item{a_labels}{named list of new labels} +} +\description{ +Update axis/legend labels +} +\examples{ +p <- a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() +update_a_labels(p, list(x = "New x")) +update_a_labels(p, list(x = expression(x / y ^ 2))) +update_a_labels(p, list(x = "New x", y = "New Y")) +update_a_labels(p, list(colour = "Fail silently")) +} diff --git a/man/update_a_theme.Rd b/man/update_a_theme.Rd new file mode 100644 index 0000000000..89273bcaec --- /dev/null +++ b/man/update_a_theme.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/theme.r +\name{update_a_theme} +\alias{update_a_theme} +\title{Update a theme from a plot object} +\usage{ +update_a_theme(oldtheme, newtheme) +} +\arguments{ +\item{oldtheme}{an existing theme, usually from a plot object, like +plot$a_theme. This could be an empty list.} + +\item{newtheme}{a new theme object to add to the existing theme} +} +\description{ +This is called from add_a_plot. +} +\details{ +If newtheme is a *complete* theme, then it is meant to replace +oldtheme; this function just returns newtheme. + +Otherwise, it adds elements from newtheme to oldtheme: +If oldtheme doesn't already contain those elements, +it searches the current default theme, grabs the elements with the +same name as those from newtheme, and puts them in oldtheme. Then +it adds elements from newtheme to oldtheme. +This makes it possible to do things like: + a_plot(data.frame(x = 1:3, y = 1:3)) + + a_geom_point() + a_theme(text = a_element_text(colour = 'red')) +and have 'text' keep properties from the default theme. Otherwise +you would have to set all the element properties, like family, size, +etc. +} diff --git a/man/update_defaults.Rd b/man/update_defaults.Rd index f97f003ed5..efac816503 100644 --- a/man/update_defaults.Rd +++ b/man/update_defaults.Rd @@ -1,27 +1,26 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-defaults.r -\name{update_geom_defaults} -\alias{update_geom_defaults} -\alias{update_stat_defaults} +\name{update_a_geom_defaults} +\alias{update_a_geom_defaults} +\alias{update_a_stat_defaults} \title{Modify geom/stat aesthetic defaults for future plots} \usage{ -update_geom_defaults(geom, new) +update_a_geom_defaults(a_geom, new) -update_stat_defaults(stat, new) +update_a_stat_defaults(a_stat, new) } \arguments{ \item{new}{Named list of aesthetics.} -\item{stat, geom}{Name of geom/stat to modify (like \code{"point"} or -\code{"bin"}), or a Geom/Stat object (like \code{GeomPoint} or -\code{StatBin}).} +\item{a_stat, a_geom}{Name of a_geom/a_stat to modify (like \code{"point"} or +\code{"bin"}), or a a_Geom/a_Stat object (like \code{a_GeomPoint} or +\code{a_StatBin}).} } \description{ Modify geom/stat aesthetic defaults for future plots } \examples{ -update_geom_defaults("point", list(colour = "darkblue")) -ggplot(mtcars, aes(mpg, wt)) + geom_point() -update_geom_defaults("point", list(colour = "black")) +update_a_geom_defaults("point", list(colour = "darkblue")) +a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() +update_a_geom_defaults("point", list(colour = "black")) } - diff --git a/man/update_labels.Rd b/man/update_labels.Rd deleted file mode 100644 index 7c4363efee..0000000000 --- a/man/update_labels.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/labels.r -\name{update_labels} -\alias{update_labels} -\title{Update axis/legend labels} -\usage{ -update_labels(p, labels) -} -\arguments{ -\item{p}{plot to modify} - -\item{labels}{named list of new labels} -} -\description{ -Update axis/legend labels -} -\examples{ -p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() -update_labels(p, list(x = "New x")) -update_labels(p, list(x = expression(x / y ^ 2))) -update_labels(p, list(x = "New x", y = "New Y")) -update_labels(p, list(colour = "Fail silently")) -} - diff --git a/man/validate_guide.Rd b/man/validate_guide.Rd new file mode 100644 index 0000000000..463cd32a4c --- /dev/null +++ b/man/validate_guide.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guides-.r +\name{validate_guide} +\alias{validate_guide} +\title{validate_guide function} +\usage{ +validate_guide(a_guide) +} +\arguments{ +\item{a_guide}{...} +} +\description{ +validate_guide function +} diff --git a/man/waiver.Rd b/man/waiver.Rd index e17f00bb28..b5397f58c0 100644 --- a/man/waiver.Rd +++ b/man/waiver.Rd @@ -13,4 +13,3 @@ functions to distinguish between displaying nothing (\code{NULL}) and displaying a default value calculated elsewhere (\code{waiver()}) } \keyword{internal} - diff --git a/tests/testthat.R b/tests/testthat.R index 8954463b44..efd9b80392 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,4 @@ library(testthat) -library(ggplot2) +library(ggplot2Animint) -test_check("ggplot2") +test_check("ggplot2Animint") diff --git a/tests/testthat/Rplot001.png b/tests/testthat/Rplot001.png new file mode 100644 index 0000000000..84b6189d6c Binary files /dev/null and b/tests/testthat/Rplot001.png differ diff --git a/tests/testthat/helper-plot-data.r b/tests/testthat/helper-plot-data.r index 69e8717ccf..b540950e07 100644 --- a/tests/testthat/helper-plot-data.r +++ b/tests/testthat/helper-plot-data.r @@ -1,6 +1,6 @@ # Transform the data as the coordinate system does cdata <- function(plot) { - pieces <- ggplot_build(plot) + pieces <- a_plot_build(plot) lapply(pieces$data, function(d) { plyr::ddply(d, "PANEL", function(panel_data) { @@ -12,7 +12,7 @@ cdata <- function(plot) { } pranges <- function(plot) { - panels <- ggplot_build(plot)$panel + panels <- a_plot_build(plot)$panel x_ranges <- lapply(panels$x_scales, function(scale) scale$get_limits()) y_ranges <- lapply(panels$y_scales, function(scale) scale$get_limits()) diff --git a/tests/testthat/test-aes-grouping.r b/tests/testthat/test-aes-grouping.r index aec0500a92..bdb663e156 100644 --- a/tests/testthat/test-aes-grouping.r +++ b/tests/testthat/test-aes-grouping.r @@ -6,39 +6,39 @@ df <- data.frame( b = c("a", "b", "a", "b") ) -group <- function(x) as.vector(layer_data(x, 1)$group) +group <- function(x) as.vector(a_layer_data(x, 1)$group) groups <- function(x) length(unique(group(x))) test_that("one group per combination of discrete vars", { - plot <- ggplot(df, aes(x, x)) + geom_point() + plot <- a_plot(df, a_aes(x, x)) + a_geom_point() expect_equal(group(plot), rep(NO_GROUP, 4)) - plot <- ggplot(df, aes(x, a)) + geom_point() + plot <- a_plot(df, a_aes(x, a)) + a_geom_point() expect_equal(group(plot), c(1, 1, 2, 2)) - plot <- ggplot(df, aes(x, b)) + geom_point() + plot <- a_plot(df, a_aes(x, b)) + a_geom_point() expect_equal(group(plot), c(1, 2, 1, 2)) - plot <- ggplot(df, aes(a, b)) + geom_point() + plot <- a_plot(df, a_aes(a, b)) + a_geom_point() expect_equal(groups(plot), 4) }) -test_that("label is not used as a grouping var", { - plot <- ggplot(df, aes(x, x, label = a)) + geom_point() +test_that("a_label is not used as a grouping var", { + plot <- a_plot(df, a_aes(x, x, a_label = a)) + a_geom_point() expect_equal(group(plot), rep(NO_GROUP, 4)) - plot <- ggplot(df, aes(x, x, colour = a, label = b)) + geom_point() + plot <- a_plot(df, a_aes(x, x, colour = a, a_label = b)) + a_geom_point() expect_equal(group(plot), c(1, 1, 2, 2)) }) -test_that("group aesthetic overrides defaults", { - plot <- ggplot(df, aes(x, x, group = x)) + geom_point() +test_that("group a_aesthetic overrides defaults", { + plot <- a_plot(df, a_aes(x, x, group = x)) + a_geom_point() expect_equal(groups(plot), 4) - plot <- ggplot(df, aes(a, b, group = 1)) + geom_point() + plot <- a_plot(df, a_aes(a, b, group = 1)) + a_geom_point() expect_equal(groups(plot), 1) }) test_that("group param overrides defaults", { - plot <- ggplot(df, aes(a, b)) + geom_point(group = 1) + plot <- a_plot(df, a_aes(a, b)) + a_geom_point(group = 1) expect_equal(groups(plot), 1) }) diff --git a/tests/testthat/test-aes-setting.r b/tests/testthat/test-aes-setting.r index fd4e732f16..6ae0ca20b3 100644 --- a/tests/testthat/test-aes-setting.r +++ b/tests/testthat/test-aes-setting.r @@ -2,10 +2,10 @@ context("Aes - setting values") test_that("Aesthetic parameters must match length of data", { df <- data.frame(x = 1:5, y = 1:5) - p <- ggplot(df, aes(x, y)) + p <- a_plot(df, a_aes(x, y)) set_colours <- function(colours) { - layer_data(p + geom_point(colour = colours)) + a_layer_data(p + a_geom_point(colour = colours)) } set_colours("red") @@ -19,18 +19,18 @@ test_that("Aesthetic parameters must match length of data", { test_that("alpha affects only fill colour of solid geoms", { df <- data.frame(x = 1:2, y = 1) - poly <- ggplot(df, aes(x = x, y)) + - geom_polygon(fill = "red", colour = "red", alpha = 0.5) - rect <- ggplot(df, aes(xmin = x, xmax = x + 1, ymin = 1, ymax = y + 1)) + - geom_rect(fill = "red", colour = "red", alpha = 0.5) - ribb <- ggplot(df, aes(x = x, ymin = 1, ymax = y + 1)) + - geom_ribbon(fill = "red", colour = "red", alpha = 0.5) + poly <- a_plot(df, a_aes(x = x, y)) + + a_geom_polygon(fill = "red", colour = "red", alpha = 0.5) + rect <- a_plot(df, a_aes(xmin = x, xmax = x + 1, ymin = 1, ymax = y + 1)) + + a_geom_rect(fill = "red", colour = "red", alpha = 0.5) + ribb <- a_plot(df, a_aes(x = x, ymin = 1, ymax = y + 1)) + + a_geom_ribbon(fill = "red", colour = "red", alpha = 0.5) - expect_equal(layer_grob(poly)[[1]]$gp$col[[1]], "red") - expect_equal(layer_grob(rect)[[1]]$gp$col[[1]], "red") - expect_equal(layer_grob(ribb)[[1]]$children[[1]]$gp$col[[1]], "red") + expect_equal(a_layer_grob(poly)[[1]]$gp$col[[1]], "red") + expect_equal(a_layer_grob(rect)[[1]]$gp$col[[1]], "red") + expect_equal(a_layer_grob(ribb)[[1]]$children[[1]]$gp$col[[1]], "red") - expect_equal(layer_grob(poly)[[1]]$gp$fill[[1]], "#FF000080") - expect_equal(layer_grob(rect)[[1]]$gp$fill[[1]], "#FF000080") - expect_equal(layer_grob(ribb)[[1]]$children[[1]]$gp$fill[[1]], "#FF000080") + expect_equal(a_layer_grob(poly)[[1]]$gp$fill[[1]], "#FF000080") + expect_equal(a_layer_grob(rect)[[1]]$gp$fill[[1]], "#FF000080") + expect_equal(a_layer_grob(ribb)[[1]]$children[[1]]$gp$fill[[1]], "#FF000080") }) diff --git a/tests/testthat/test-aes.r b/tests/testthat/test-aes.r index 10396a60b4..abc6d1edd2 100644 --- a/tests/testthat/test-aes.r +++ b/tests/testthat/test-aes.r @@ -1,60 +1,60 @@ context("Creating aesthetic mappings") -test_that("aes() captures input expressions", { - out <- aes(mpg, wt + 1) +test_that("a_aes() captures input expressions", { + out <- a_aes(mpg, wt + 1) expect_equal(out$x, quote(mpg)) expect_equal(out$y, quote(wt + 1)) }) -test_that("aes_q() uses quoted calls and formulas", { - out <- aes_q(quote(mpg), ~ wt + 1) +test_that("a_aes_q() uses quoted calls and formulas", { + out <- a_aes_q(quote(mpg), ~ wt + 1) expect_equal(out$x, quote(mpg)) expect_equal(out$y, quote(wt + 1)) }) -test_that("aes_string() parses strings", { - expect_equal(aes_string("a + b")$x, quote(a + b)) +test_that("a_aes_string() parses strings", { + expect_equal(a_aes_string("a + b")$x, quote(a + b)) }) -test_that("aes_string() doesn't parse non-strings", { +test_that("a_aes_string() doesn't parse non-strings", { old <- options(OutDec = ",") on.exit(options(old)) - expect_equal(aes_string(0.4)$x, 0.4) + expect_equal(a_aes_string(0.4)$x, 0.4) }) -test_that("aes_q() & aes_string() preserves explicit NULLs", { - expect_equal(aes_q(NULL), aes(NULL)) - expect_equal(aes_q(x = NULL), aes(NULL)) - expect_equal(aes_q(colour = NULL), aes(colour = NULL)) +test_that("a_aes_q() & a_aes_string() preserves explicit NULLs", { + expect_equal(a_aes_q(NULL), a_aes(NULL)) + expect_equal(a_aes_q(x = NULL), a_aes(NULL)) + expect_equal(a_aes_q(colour = NULL), a_aes(colour = NULL)) - expect_equal(aes_string(NULL), aes(NULL)) - expect_equal(aes_string(x = NULL), aes(NULL)) - expect_equal(aes_string(colour = NULL), aes(colour = NULL)) + expect_equal(a_aes_string(NULL), a_aes(NULL)) + expect_equal(a_aes_string(x = NULL), a_aes(NULL)) + expect_equal(a_aes_string(colour = NULL), a_aes(colour = NULL)) }) -test_that("aes_all() converts strings into mappings", { +test_that("a_aes_all() converts strings into mappings", { expect_equal( - aes_all(c("x", "y", "col", "pch")), - aes(x, y, colour = col, shape = pch) + a_aes_all(c("x", "y", "col", "pch")), + a_aes(x, y, colour = col, shape = pch) ) }) -test_that("aes evaluated in environment where plot created", { +test_that("a_aes evaluated in environment where plot created", { df <- data.frame(x = 1, y = 1) - p <- ggplot(df, aes(foo, y)) + geom_point() + p <- a_plot(df, a_aes(foo, y)) + a_geom_point() # Accessing an undefined variable should result in error - expect_error(layer_data(p), "'foo' not found") + expect_error(a_layer_data(p), "'foo' not found") # Once it's defined we should get it back foo <- 0 - expect_equal(layer_data(p)$x, 0) + expect_equal(a_layer_data(p)$x, 0) # And regular variable shadowing should work f <- function() { foo <- 10 - ggplot(df, aes(foo, y)) + geom_point() + a_plot(df, a_aes(foo, y)) + a_geom_point() } - expect_equal(layer_data(f())$x, 10) + expect_equal(a_layer_data(f())$x, 10) }) diff --git a/tests/testthat/test-annotate.r b/tests/testthat/test-annotate.r index 4308fdf7ca..e1af78908a 100644 --- a/tests/testthat/test-annotate.r +++ b/tests/testthat/test-annotate.r @@ -1,4 +1,4 @@ -context("annotate") +context("a_annotate") test_that("dates in segment annotation work", { dt <- structure(list(month = structure(c(1364774400, 1377993600), @@ -6,23 +6,23 @@ test_that("dates in segment annotation work", { 11.7)), .Names = c("month", "total"), row.names = c(NA, -2L), class = "data.frame") - p <- ggplot(dt, aes(month, total)) + - geom_point() + - annotate("segment", + p <- a_plot(dt, a_aes(month, total)) + + a_geom_point() + + a_annotate("segment", x = as.POSIXct("2013-04-01"), xend = as.POSIXct("2013-07-01"), y = -10, yend = 10 ) - expect_true(all(c("xend", "yend") %in% names(layer_data(p, 2)))) + expect_true(all(c("xend", "yend") %in% names(a_layer_data(p, 2)))) }) test_that("segment annotations transform with scales", { # This should be a visual test, but contriubtion documentation does not # explain how to make one - ggplot(mtcars, aes(wt, mpg)) + - geom_point() + - annotate("segment", x = 2, y = 10, xend = 5, yend = 30, colour = "red") + - scale_y_reverse() + a_plot(mtcars, a_aes(wt, mpg)) + + a_geom_point() + + a_annotate("segment", x = 2, y = 10, xend = 5, yend = 30, colour = "red") + + a_scale_y_reverse() }) diff --git a/tests/testthat/test-boxplot.r b/tests/testthat/test-boxplot.r index 8f25116cb7..fe48e5087d 100644 --- a/tests/testthat/test-boxplot.r +++ b/tests/testthat/test-boxplot.r @@ -1,9 +1,9 @@ context("Boxplot") # thanks wch for providing the test code -test_that("geom_boxplot range includes all outliers", { +test_that("a_geom_boxplot range includes all outliers", { dat <- data.frame(x = 1, y = c(-(1:20) ^ 3, (1:20) ^ 3) ) - p <- ggplot_build(ggplot(dat, aes(x,y)) + geom_boxplot()) + p <- a_plot_build(a_plot(dat, a_aes(x,y)) + a_geom_boxplot()) miny <- p$panel$ranges[[1]]$y.range[1] maxy <- p$panel$ranges[[1]]$y.range[2] @@ -12,20 +12,20 @@ test_that("geom_boxplot range includes all outliers", { expect_true(maxy >= max(dat$y)) }) -test_that("geom_boxplot for continuous x gives warning if more than one x (#992)", { +test_that("a_geom_boxplot for continuous x gives warning if more than one x (#992)", { dat <- expand.grid(x = 1:2, y = c(-(1:5) ^ 3, (1:5) ^ 3) ) - bplot <- function(aes = NULL, extra = list()) { - ggplot_build(ggplot(dat, aes) + geom_boxplot(aes) + extra) + bplot <- function(a_aes = NULL, extra = list()) { + a_plot_build(a_plot(dat, a_aes) + a_geom_boxplot(a_aes) + extra) } - expect_warning(bplot(aes(x, y)), "Continuous x aesthetic") - expect_warning(bplot(aes(x, y), facet_wrap(~x)), "Continuous x aesthetic") - expect_warning(bplot(aes(Sys.Date() + x, y)), "Continuous x aesthetic") + expect_warning(bplot(a_aes(x, y)), "Continuous x aesthetic") + expect_warning(bplot(a_aes(x, y), a_facet_wrap(~x)), "Continuous x aesthetic") + expect_warning(bplot(a_aes(Sys.Date() + x, y)), "Continuous x aesthetic") - expect_warning(bplot(aes(x, group = x, y)), NA) - expect_warning(bplot(aes(1, y)), NA) - expect_warning(bplot(aes(factor(x), y)), NA) - expect_warning(bplot(aes(x == 1, y)), NA) - expect_warning(bplot(aes(as.character(x), y)), NA) + expect_warning(bplot(a_aes(x, group = x, y)), NA) + expect_warning(bplot(a_aes(1, y)), NA) + expect_warning(bplot(a_aes(factor(x), y)), NA) + expect_warning(bplot(a_aes(x == 1, y)), NA) + expect_warning(bplot(a_aes(as.character(x), y)), NA) }) diff --git a/tests/testthat/test-build.r b/tests/testthat/test-build.r index b6082cd966..c064282d89 100644 --- a/tests/testthat/test-build.r +++ b/tests/testthat/test-build.r @@ -4,11 +4,11 @@ context("Plot building") df <- data.frame(x = 1:3, y = 3:1, z = letters[1:3]) test_that("there is one data frame for each layer", { - nlayers <- function(x) length(ggplot_build(x)$data) + nlayers <- function(x) length(a_plot_build(x)$data) - l1 <- ggplot(df, aes(x, y)) + geom_point() - l2 <- ggplot(df, aes(x, y)) + geom_point() + geom_line() - l3 <- ggplot(df, aes(x, y)) + geom_point() + geom_line() + geom_point() + l1 <- a_plot(df, a_aes(x, y)) + a_geom_point() + l2 <- a_plot(df, a_aes(x, y)) + a_geom_point() + a_geom_line() + l3 <- a_plot(df, a_aes(x, y)) + a_geom_point() + a_geom_line() + a_geom_point() expect_equal(nlayers(l1), 1) expect_equal(nlayers(l2), 2) @@ -16,36 +16,36 @@ test_that("there is one data frame for each layer", { }) test_that("position aesthetics coerced to correct type", { - l1 <- ggplot(df, aes(x, y)) + geom_point() - d1 <- layer_data(l1, 1) + l1 <- a_plot(df, a_aes(x, y)) + a_geom_point() + d1 <- a_layer_data(l1, 1) expect_is(d1$x, "numeric") expect_is(d1$y, "numeric") - l2 <- ggplot(df, aes(x, z)) + geom_point() + scale_x_discrete() - d2 <- layer_data(l2, 1) + l2 <- a_plot(df, a_aes(x, z)) + a_geom_point() + a_scale_x_discrete() + d2 <- a_layer_data(l2, 1) expect_is(d2$x, "integer") expect_is(d2$y, "integer") }) test_that("non-position aesthetics are mapped", { - l1 <- ggplot(df, aes(x, y, fill = z, colour = z, shape = z, size = z)) + - geom_point() - d1 <- layer_data(l1, 1) + l1 <- a_plot(df, a_aes(x, y, fill = z, colour = z, shape = z, size = z)) + + a_geom_point() + d1 <- a_layer_data(l1, 1) expect_equal(sort(names(d1)), sort(c("x", "y", "fill", "group", "colour", "shape", "size", "PANEL", "alpha", "stroke"))) - l2 <- l1 + scale_colour_manual(values = c("blue", "red", "yellow")) - d2 <- layer_data(l2, 1) + l2 <- l1 + a_scale_colour_manual(values = c("blue", "red", "yellow")) + d2 <- a_layer_data(l2, 1) expect_equal(d2$colour, c("blue", "red", "yellow")) }) test_that("strings are not converted to factors", { - df <- data.frame(x = 1:2, y = 2:1, label = c("alpha", "beta"), stringsAsFactors = FALSE) - p <- ggplot(df, aes(x, y)) + - geom_text(aes(label = label), parse = TRUE) + df <- data.frame(x = 1:2, y = 2:1, a_label = c("alpha", "beta"), stringsAsFactors = FALSE) + p <- a_plot(df, a_aes(x, y)) + + a_geom_text(a_aes(a_label = a_label), parse = TRUE) - expect_is(layer_data(p)$label, "character") + expect_is(a_layer_data(p)$a_label, "character") }) diff --git a/tests/testthat/test-coord-polar.r b/tests/testthat/test-coord-polar.r index 7cb3d9b840..1c73c53d79 100644 --- a/tests/testthat/test-coord-polar.r +++ b/tests/testthat/test-coord-polar.r @@ -1,4 +1,4 @@ -context("coord_polar") +context("a_coord_polar") test_that("Polar distance calculation", { dat <- data.frame( @@ -6,11 +6,11 @@ test_that("Polar distance calculation", { r = c(0, 0, 0.5, 0.5, 1, 1, 0.75, .5)) scales <- list( - x = scale_x_continuous(limits = c(0, 2*pi)), - y = scale_y_continuous(limits = c(0, 1)) + x = a_scale_x_continuous(limits = c(0, 2*pi)), + y = a_scale_y_continuous(limits = c(0, 1)) ) - coord <- coord_polar() - dists <- coord$distance(dat$theta, dat$r, coord$train(scales)) + a_coord <- a_coord_polar() + dists <- a_coord$distance(dat$theta, dat$r, a_coord$train(scales)) # dists is normalized by dividing by this value, so we'll add it back # The maximum length of a spiral arc, from (t,r) = (0,0) to (2*pi,1) @@ -21,8 +21,8 @@ test_that("Polar distance calculation", { c(0, -1.225737494, -2, -0.5, -5, -0.25, -0.6736885011) / maxlen) # The picture can be visualized with: - # ggplot(dat, aes(x=theta, y=r)) + geom_path() + - # geom_point(alpha=0.3) + coord_polar() + # a_plot(dat, a_aes(x=theta, y=r)) + geom_path() + + # geom_point(alpha=0.3) + a_coord_polar() }) diff --git a/tests/testthat/test-coord-train.r b/tests/testthat/test-coord-train.r index 81d0b14a79..c64b6d57b4 100644 --- a/tests/testthat/test-coord-train.r +++ b/tests/testthat/test-coord-train.r @@ -1,4 +1,4 @@ -context("coord_train") +context("a_coord_train") test_that("NA's don't appear in breaks", { @@ -15,21 +15,21 @@ test_that("NA's don't appear in breaks", { } scales <- list( - x = scale_x_continuous(limits = c(1, 12)), - y = scale_y_continuous(limits = c(1, 12)) + x = a_scale_x_continuous(limits = c(1, 12)), + y = a_scale_y_continuous(limits = c(1, 12)) ) - # First have to test that scale_breaks_positions will return a vector with NA + # First have to test that a_scale_breaks_positions will return a vector with NA # This is a test to make sure the later tests will be useful! # It's possible that changes to the the way that breaks are calculated will - # make it so that scale_break_positions will no longer give NA for range 1, 12 + # make it so that a_scale_break_positions will no longer give NA for range 1, 12 expect_true(any(is.na((scales$x$break_positions())))) expect_true(any(is.na((scales$y$break_positions())))) # Check the various types of coords to make sure they don't have NA breaks - expect_false(any_NA_major_minor(coord_polar()$train(scales))) - expect_false(any_NA_major_minor(coord_cartesian()$train(scales))) - expect_false(any_NA_major_minor(coord_trans()$train(scales))) - expect_false(any_NA_major_minor(coord_fixed()$train(scales))) - expect_false(any_NA_major_minor(coord_map()$train(scales))) + expect_false(any_NA_major_minor(a_coord_polar()$train(scales))) + expect_false(any_NA_major_minor(a_coord_cartesian()$train(scales))) + expect_false(any_NA_major_minor(a_coord_trans()$train(scales))) + expect_false(any_NA_major_minor(a_coord_fixed()$train(scales))) + expect_false(any_NA_major_minor(a_coord_map()$train(scales))) }) diff --git a/tests/testthat/test-data.r b/tests/testthat/test-data.r index d295088e88..2813ddaba2 100644 --- a/tests/testthat/test-data.r +++ b/tests/testthat/test-data.r @@ -6,16 +6,16 @@ test_that("stringsAsFactors doesn't affect results", { dat.character <- data.frame(x = letters[5:1], y = 1:5, stringsAsFactors = FALSE) dat.factor <- data.frame(x = letters[5:1], y = 1:5, stringsAsFactors = TRUE) - base <- ggplot(mapping = aes(x, y)) + geom_point() - xlabels <- function(x) x$panel$ranges[[1]]$x.labels + base <- a_plot(mapping = a_aes(x, y)) + a_geom_point() + xlabels <- function(x) x$panel$ranges[[1]]$x.a_labels options(stringsAsFactors = TRUE) - char_true <- ggplot_build(base %+% dat.character) - factor_true <- ggplot_build(base %+% dat.factor) + char_true <- a_plot_build(base %+% dat.character) + factor_true <- a_plot_build(base %+% dat.factor) options(stringsAsFactors = FALSE) - char_false <- ggplot_build(base %+% dat.character) - factor_false <- ggplot_build(base %+% dat.factor) + char_false <- a_plot_build(base %+% dat.character) + factor_false <- a_plot_build(base %+% dat.factor) options(stringsAsFactors = sAF) diff --git a/tests/testthat/test-dotplot.r b/tests/testthat/test-dotplot.r index d92456b26b..ca2034506a 100644 --- a/tests/testthat/test-dotplot.r +++ b/tests/testthat/test-dotplot.r @@ -4,14 +4,14 @@ set.seed(111) dat <- data.frame(x = LETTERS[1:2], y = rnorm(30), g = LETTERS[3:5]) test_that("Dodging works", { - p <- ggplot(dat, aes(x = x, y = y, fill = g)) + - geom_dotplot( + p <- a_plot(dat, a_aes(x = x, y = y, fill = g)) + + a_geom_dotplot( binwidth = 0.2, binaxis = "y", - position = "dodge", + a_position = "dodge", stackdir = "center" ) - df <- layer_data(p) + df <- a_layer_data(p) # Number of levels in the dodged variable ndodge <- 3 @@ -36,17 +36,17 @@ test_that("Dodging works", { test_that("Binning works", { - bp <- ggplot(dat, aes(y)) + - geom_dotplot(binwidth = .4, method = "histodot") - x <- layer_data(bp)$x + bp <- a_plot(dat, a_aes(y)) + + a_geom_dotplot(binwidth = .4, method = "histodot") + x <- a_layer_data(bp)$x # Need ugly hack to make sure mod function doesn't give values like -3.99999 # due to floating point error expect_true(all(abs((x - min(x) + 1e-7) %% .4) < 1e-6)) - bp <- ggplot(dat, aes(x = y)) + - geom_dotplot(binwidth = .4, method = "dotdensity") - x <- layer_data(bp)$x + bp <- a_plot(dat, a_aes(x = y)) + + a_geom_dotplot(binwidth = .4, method = "dotdensity") + x <- a_layer_data(bp)$x # This one doesn't ensure that dotdensity works, but it does check that it's not # doing fixed bin sizes @@ -60,6 +60,6 @@ test_that("NA's result in warning from stat_bindot", { dat$x[c(2,10)] <- NA # Need to assign it to a var here so that it doesn't automatically print - expect_warning(ggplot_build(ggplot(dat, aes(x)) + geom_dotplot(binwidth = .2)), + expect_warning(a_plot_build(a_plot(dat, a_aes(x)) + a_geom_dotplot(binwidth = .2)), "Removed 2 rows.*stat_bindot") }) diff --git a/tests/testthat/test-empty-data.r b/tests/testthat/test-empty-data.r index 4555442ea8..bce4fc436b 100644 --- a/tests/testthat/test-empty-data.r +++ b/tests/testthat/test-empty-data.r @@ -4,102 +4,102 @@ df0 <- data.frame(mpg = numeric(0), wt = numeric(0), am = numeric(0), cyl = nume test_that("layers with empty data are silently omitted", { # Empty data (no visible points) - d <- ggplot(df0, aes(mpg,wt)) + geom_point() - expect_equal(nrow(layer_data(d)), 0) + d <- a_plot(df0, a_aes(mpg,wt)) + a_geom_point() + expect_equal(nrow(a_layer_data(d)), 0) - d <- ggplot() + geom_point(data = df0, aes(mpg,wt)) - expect_equal(nrow(layer_data(d)), 0) + d <- a_plot() + a_geom_point(data = df0, a_aes(mpg,wt)) + expect_equal(nrow(a_layer_data(d)), 0) # Regular mtcars data, x=mpg, y=wt, normal points and points from empty data frame - d <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_point(data = df0) - expect_equal(nrow(layer_data(d, 1)), nrow(mtcars)) - expect_equal(nrow(layer_data(d, 2)), 0) + d <- a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point() + a_geom_point(data = df0) + expect_equal(nrow(a_layer_data(d, 1)), nrow(mtcars)) + expect_equal(nrow(a_layer_data(d, 2)), 0) # Regular mtcars data, but points only from empty data frame - d <- ggplot(mtcars, aes(mpg, wt)) + geom_point(data = df0) - expect_equal(nrow(layer_data(d, 1)), 0) + d <- a_plot(mtcars, a_aes(mpg, wt)) + a_geom_point(data = df0) + expect_equal(nrow(a_layer_data(d, 1)), 0) }) test_that("plots with empty data and vectors for aesthetics work", { - d <- ggplot(NULL, aes(1:5, 1:5)) + geom_point() - expect_equal(nrow(layer_data(d)), 5) + d <- a_plot(NULL, a_aes(1:5, 1:5)) + a_geom_point() + expect_equal(nrow(a_layer_data(d)), 5) - d <- ggplot(data.frame(), aes(1:5, 1:5)) + geom_point() - expect_equal(nrow(layer_data(d)), 5) + d <- a_plot(data.frame(), a_aes(1:5, 1:5)) + a_geom_point() + expect_equal(nrow(a_layer_data(d)), 5) - d <- ggplot() + geom_point(aes(1:5, 1:5)) - expect_equal(nrow(layer_data(d)), 5) + d <- a_plot() + a_geom_point(a_aes(1:5, 1:5)) + expect_equal(nrow(a_layer_data(d)), 5) }) -test_that("layers with empty data are silently omitted with facet_wrap", { +test_that("layers with empty data are silently omitted with a_facet_wrap", { # Empty data, facet_wrap, throws error - d <- ggplot(df0, aes(mpg, wt)) + - geom_point() + - facet_wrap(~cyl) - expect_error(layer_data(d), "must have at least one value") - - d <- d + geom_point(data = mtcars) - expect_equal(nrow(layer_data(d, 1)), 0) - expect_equal(nrow(layer_data(d, 2)), nrow(mtcars)) + d <- a_plot(df0, a_aes(mpg, wt)) + + a_geom_point() + + a_facet_wrap(~cyl) + expect_error(a_layer_data(d), "must have at least one value") + + d <- d + a_geom_point(data = mtcars) + expect_equal(nrow(a_layer_data(d, 1)), 0) + expect_equal(nrow(a_layer_data(d, 2)), nrow(mtcars)) }) test_that("layers with empty data are silently omitted with facet_grid", { - d <- ggplot(df0, aes(mpg, wt)) + - geom_point() + - facet_grid(am ~ cyl) - expect_error(layer_data(d), "must have at least one value") - - d <- d + geom_point(data = mtcars) - expect_equal(nrow(layer_data(d, 1)), 0) - expect_equal(nrow(layer_data(d, 2)), nrow(mtcars)) + d <- a_plot(df0, a_aes(mpg, wt)) + + a_geom_point() + + a_facet_grid(am ~ cyl) + expect_error(a_layer_data(d), "must have at least one value") + + d <- d + a_geom_point(data = mtcars) + expect_equal(nrow(a_layer_data(d, 1)), 0) + expect_equal(nrow(a_layer_data(d, 2)), nrow(mtcars)) }) test_that("empty data overrides plot defaults", { # Should error when totally empty data frame because there's no x and y - d <- ggplot(mtcars, aes(mpg, wt)) + - geom_point() + - geom_point(data = data.frame()) - expect_error(layer_data(d), "not found") + d <- a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point() + + a_geom_point(data = data.frame()) + expect_error(a_layer_data(d), "not found") # No extra points when x and y vars don't exist but are set - d <- ggplot(mtcars, aes(mpg, wt)) + - geom_point() + - geom_point(data = data.frame(), x = 20, y = 3) - expect_equal(nrow(layer_data(d, 1)), nrow(mtcars)) - expect_equal(nrow(layer_data(d, 2)), 0) + d <- a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point() + + a_geom_point(data = data.frame(), x = 20, y = 3) + expect_equal(nrow(a_layer_data(d, 1)), nrow(mtcars)) + expect_equal(nrow(a_layer_data(d, 2)), 0) # No extra points when x and y vars are empty, even when aesthetics are set - d <- ggplot(mtcars, aes(mpg, wt)) + - geom_point() + - geom_point(data = df0, x = 20, y = 3) - expect_equal(nrow(layer_data(d, 1)), nrow(mtcars)) - expect_equal(nrow(layer_data(d, 2)), 0) + d <- a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point() + + a_geom_point(data = df0, x = 20, y = 3) + expect_equal(nrow(a_layer_data(d, 1)), nrow(mtcars)) + expect_equal(nrow(a_layer_data(d, 2)), 0) }) -test_that("layer inherits data from plot when data = NULL", { - d <- ggplot(mtcars, aes(mpg, wt)) + - geom_point(data = NULL) - expect_equal(nrow(layer_data(d)), nrow(mtcars)) +test_that("a_layer inherits data from plot when data = NULL", { + d <- a_plot(mtcars, a_aes(mpg, wt)) + + a_geom_point(data = NULL) + expect_equal(nrow(a_layer_data(d)), nrow(mtcars)) }) test_that("empty layers still generate one grob per panel", { df <- data.frame(x = 1:3, y = c("a", "b", "c")) - d <- ggplot(df, aes(x, y)) + - geom_point(data = df[0, ]) + - geom_point() + - facet_wrap(~y) + d <- a_plot(df, a_aes(x, y)) + + a_geom_point(data = df[0, ]) + + a_geom_point() + + a_facet_wrap(~y) - expect_equal(length(layer_grob(d)), 3) + expect_equal(length(a_layer_grob(d)), 3) }) test_that("missing layers generate one grob per panel", { df <- data.frame(x = 1:4, y = 1:2, g = 1:2) - base <- ggplot(df, aes(x, y)) + geom_point(shape = NA, na.rm = TRUE) + base <- a_plot(df, a_aes(x, y)) + a_geom_point(shape = NA, na.rm = TRUE) - expect_equal(length(layer_grob(base)), 1) - expect_equal(length(layer_grob(base + facet_wrap(~ g))), 2) + expect_equal(length(a_layer_grob(base)), 1) + expect_equal(length(a_layer_grob(base + a_facet_wrap(~ g))), 2) }) diff --git a/tests/testthat/test-facet-.r b/tests/testthat/test-facet-.r index e41decf78c..644ce3bec6 100644 --- a/tests/testthat/test-facet-.r +++ b/tests/testthat/test-facet-.r @@ -3,13 +3,13 @@ context("Facetting") df <- data.frame(x = 1:3, y = 3:1, z = letters[1:3]) test_that("facets split up the data", { - l1 <- ggplot(df, aes(x, y)) + geom_point() + facet_wrap(~z) - l2 <- ggplot(df, aes(x, y)) + geom_point() + facet_grid(. ~ z) - l3 <- ggplot(df, aes(x, y)) + geom_point() + facet_grid(z ~ .) + l1 <- a_plot(df, a_aes(x, y)) + a_geom_point() + a_facet_wrap(~z) + l2 <- a_plot(df, a_aes(x, y)) + a_geom_point() + a_facet_grid(. ~ z) + l3 <- a_plot(df, a_aes(x, y)) + a_geom_point() + a_facet_grid(z ~ .) - d1 <- layer_data(l1) - d2 <- layer_data(l2) - d3 <- layer_data(l3) + d1 <- a_layer_data(l1) + d2 <- a_layer_data(l2) + d3 <- a_layer_data(l3) expect_equal(d1, d2) expect_equal(d1, d3) @@ -17,20 +17,20 @@ test_that("facets split up the data", { }) test_that("facets with free scales scale independently", { - l1 <- ggplot(df, aes(x, y)) + geom_point() + - facet_wrap(~z, scales = "free") + l1 <- a_plot(df, a_aes(x, y)) + a_geom_point() + + a_facet_wrap(~z, scales = "free") d1 <- cdata(l1)[[1]] expect_true(sd(d1$x) < 1e-10) expect_true(sd(d1$y) < 1e-10) - l2 <- ggplot(df, aes(x, y)) + geom_point() + - facet_grid(. ~ z, scales = "free") + l2 <- a_plot(df, a_aes(x, y)) + a_geom_point() + + a_facet_grid(. ~ z, scales = "free") d2 <- cdata(l2)[[1]] expect_true(sd(d2$x) < 1e-10) expect_equal(length(unique(d2$y)), 3) - l3 <- ggplot(df, aes(x, y)) + geom_point() + - facet_grid(z ~ ., scales = "free") + l3 <- a_plot(df, a_aes(x, y)) + a_geom_point() + + a_facet_grid(z ~ ., scales = "free") d3 <- cdata(l3)[[1]] expect_equal(length(unique(d3$x)), 3) expect_true(sd(d3$y) < 1e-10) @@ -38,18 +38,18 @@ test_that("facets with free scales scale independently", { test_that("shrink parameter affects scaling", { - l1 <- ggplot(df, aes(1, y)) + geom_point() + l1 <- a_plot(df, a_aes(1, y)) + a_geom_point() r1 <- pranges(l1) expect_equal(r1$x[[1]], c(1, 1)) expect_equal(r1$y[[1]], c(1, 3)) - l2 <- ggplot(df, aes(1, y)) + stat_summary(fun.y = "mean") + l2 <- a_plot(df, a_aes(1, y)) + a_stat_summary(fun.y = "mean") r2 <- pranges(l2) expect_equal(r2$y[[1]], c(2, 2)) - l3 <- ggplot(df, aes(1, y)) + stat_summary(fun.y = "mean") + - facet_null(shrink = FALSE) + l3 <- a_plot(df, a_aes(1, y)) + a_stat_summary(fun.y = "mean") + + a_facet_null(shrink = FALSE) r3 <- pranges(l3) expect_equal(r3$y[[1]], c(1, 3)) }) diff --git a/tests/testthat/test-facet-labels.r b/tests/testthat/test-facet-labels.r index 9abf3a93e4..4d2bc1b6b9 100644 --- a/tests/testthat/test-facet-labels.r +++ b/tests/testthat/test-facet-labels.r @@ -1,112 +1,112 @@ context("Facet Labels") get_labels_matrix <- function(plot, ...) { - data <- ggplot_build(plot) - facet <- data$plot$facet + data <- a_plot_build(plot) + a_facet <- data$plot$a_facet panel <- data$panel - labels <- get_labels_info(facet, panel, ...) - labeller <- match.fun(facet$labeller) + a_labels <- get_labels_info(a_facet, panel, ...) + labeller <- match.fun(a_facet$labeller) # Create matrix of labels - matrix <- lapply(labeller(labels), cbind) + matrix <- lapply(labeller(a_labels), cbind) matrix <- do.call("cbind", matrix) matrix } -get_labels_info <- function(facet, panel, ...) { +get_labels_info <- function(a_facet, panel, ...) { UseMethod("get_labels_info") } -get_labels_info.grid <- function(facet, panel, type) { +get_labels_info.grid <- function(a_facet, panel, type) { if (type == "rows") { - labels <- unique(panel$layout[names(facet$rows)]) - attr(labels, "type") <- "rows" - attr(labels, "facet") <- "grid" + a_labels <- unique(panel$layout[names(a_facet$rows)]) + attr(a_labels, "type") <- "rows" + attr(a_labels, "a_facet") <- "grid" } else { - labels <- unique(panel$layout[names(facet$cols)]) - attr(labels, "type") <- "cols" - attr(labels, "facet") <- "grid" + a_labels <- unique(panel$layout[names(a_facet$cols)]) + attr(a_labels, "type") <- "cols" + attr(a_labels, "a_facet") <- "grid" } - labels + a_labels } -get_labels_info.wrap <- function(facet, panel) { - labels <- panel$layout[names(facet$facets)] - attr(labels, "facet") <- "wrap" - if (!is.null(facet$switch) && facet$switch == "x") { - attr(labels, "type") <- "rows" +get_labels_info.wrap <- function(a_facet, panel) { + a_labels <- panel$layout[names(a_facet$facets)] + attr(a_labels, "a_facet") <- "wrap" + if (!is.null(a_facet$switch) && a_facet$switch == "x") { + attr(a_labels, "type") <- "rows" } else { - attr(labels, "type") <- "cols" + attr(a_labels, "type") <- "cols" } - labels + a_labels } test_that("labellers handle facet labels properly", { - labels <- list(var1 = letters[1:2], var2 = letters[3:4]) + a_labels <- list(var1 = letters[1:2], var2 = letters[3:4]) - expect_identical(label_value(labels), labels) - expect_identical(label_value(labels, FALSE), list(c("a, c", "b, d"))) + expect_identical(a_label_value(a_labels), a_labels) + expect_identical(a_label_value(a_labels, FALSE), list(c("a, c", "b, d"))) - expect_identical(label_both(labels), list(c("var1: a", "var1: b"), c("var2: c", "var2: d"))) - expect_identical(label_both(labels, FALSE), list(c("var1, var2: a, c", "var1, var2: b, d"))) + expect_identical(a_label_both(a_labels), list(c("var1: a", "var1: b"), c("var2: c", "var2: d"))) + expect_identical(a_label_both(a_labels, FALSE), list(c("var1, var2: a, c", "var1, var2: b, d"))) }) test_that("labellers handle plotmath expressions", { - labels <- list(var1 = c("alpha", "beta"), var2 = letters[3:4]) + a_labels <- list(var1 = c("alpha", "beta"), var2 = letters[3:4]) expected_parsed <- list( list(expression(alpha), expression(beta)), list(expression(c), expression(d)) ) - expect_identical(label_parsed(labels), expected_parsed) + expect_identical(a_label_parsed(a_labels), expected_parsed) expected_parsed_multi <- list(list( expression(list(alpha, c)), expression(list(beta, d)) )) - expect_identical(label_parsed(labels, FALSE), expected_parsed_multi) + expect_identical(a_label_parsed(a_labels, FALSE), expected_parsed_multi) }) -test_that("label_value() handles factors", { - labels_chr <- list(var1 = letters[1:2], var2 = letters[3:4]) - labels <- lapply(labels_chr, factor) +test_that("a_label_value() handles factors", { + a_labels_chr <- list(var1 = letters[1:2], var2 = letters[3:4]) + a_labels <- lapply(a_labels_chr, factor) - expect_identical(label_value(labels), labels_chr) + expect_identical(a_label_value(a_labels), a_labels_chr) }) test_that("labeller() dispatches labellers", { - p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() + p <- a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point() expected_cyl_both <- cbind(paste("cyl:", c(4, 6, 8))) expected_am_both <- cbind(paste("am:", 0:1)) - # Rows and cols dispatch with facet_wrap() - p1 <- p + facet_wrap(~cyl, labeller = labeller(.rows = label_both)) - p2 <- p + facet_wrap(~cyl, labeller = labeller(.cols = label_both)) + # Rows and cols dispatch with a_facet_wrap() + p1 <- p + a_facet_wrap(~cyl, labeller = labeller(.rows = a_label_both)) + p2 <- p + a_facet_wrap(~cyl, labeller = labeller(.cols = a_label_both)) expect_equal(get_labels_matrix(p1), expected_cyl_both) expect_equal(get_labels_matrix(p2), expected_cyl_both) - # facet_wrap() shouldn't get both rows and cols - p3 <- p + facet_wrap(~cyl, labeller = labeller( - .cols = label_both, .rows = label_both)) + # a_facet_wrap() shouldn't get both rows and cols + p3 <- p + a_facet_wrap(~cyl, labeller = labeller( + .cols = a_label_both, .rows = a_label_both)) expect_error(ggplotGrob(p3)) - # facet_grid() can get both rows and cols - p4 <- p + facet_grid(am ~ cyl, labeller = labeller( - .cols = label_both, .rows = label_both)) + # a_facet_grid() can get both rows and cols + p4 <- p + a_facet_grid(am ~ cyl, labeller = labeller( + .cols = a_label_both, .rows = a_label_both)) expect_equal(get_labels_matrix(p4, "rows"), expected_am_both) expect_equal(get_labels_matrix(p4, "cols"), expected_cyl_both) # Cannot have a specific labeller for a variable which already has a # margin-wide labeller - p5 <- p + facet_wrap(~cyl, labeller = labeller( - .rows = label_both, cyl = label_value)) + p5 <- p + a_facet_wrap(~cyl, labeller = labeller( + .rows = a_label_both, cyl = a_label_value)) expect_error(ggplotGrob(p5)) # Variables can be attributed labellers - p6 <- p + facet_grid(am + cyl ~ ., labeller = labeller( - am = label_both, cyl = label_both)) + p6 <- p + a_facet_grid(am + cyl ~ ., labeller = labeller( + am = a_label_both, cyl = a_label_both)) expect_equal( get_labels_matrix(p6, "rows"), cbind( @@ -116,21 +116,21 @@ test_that("labeller() dispatches labellers", { ) # Default labeller is used for other variables - p7 <- p + facet_grid(am ~ cyl, labeller = labeller(.default = label_both)) + p7 <- p + a_facet_grid(am ~ cyl, labeller = labeller(.default = a_label_both)) expect_equal(get_labels_matrix(p7, "rows"), expected_am_both) expect_equal(get_labels_matrix(p7, "cols"), expected_cyl_both) }) test_that("as_labeller() deals with non-labellers", { - p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() + p <- a_plot(mtcars, a_aes(wt, mpg)) + a_geom_point() lookup <- c(`0` = "zero", `1` = "one") # Lookup table - p1 <- p + facet_wrap(~am, labeller = labeller(am = lookup)) + p1 <- p + a_facet_wrap(~am, labeller = labeller(am = lookup)) expect_equal(get_labels_matrix(p1), cbind(c("zero", "one"))) # Non-labeller function taking character vectors - p2 <- p + facet_wrap(~am, labeller = labeller(am = function(x) paste0(x, "-foo"))) + p2 <- p + a_facet_wrap(~am, labeller = labeller(am = function(x) paste0(x, "-foo"))) expect_equal(get_labels_matrix(p2), cbind(c("0-foo", "1-foo"))) }) @@ -140,9 +140,9 @@ test_that("old school labellers still work", { } expect_warning(p <- - ggplot(mtcars, aes(disp, drat)) + - geom_point() + - facet_grid(~cyl, labeller = my_labeller)) + a_plot(mtcars, a_aes(disp, drat)) + + a_geom_point() + + a_facet_grid(~cyl, labeller = my_labeller)) expected_labels <- cbind(paste("var =", c(4, 6, 8))) expect_identical(get_labels_matrix(p, "cols"), expected_labels) diff --git a/tests/testthat/test-facet-locate.r b/tests/testthat/test-facet-locate.r index a2b0628564..85a8a91377 100644 --- a/tests/testthat/test-facet-locate.r +++ b/tests/testthat/test-facet-locate.r @@ -91,7 +91,7 @@ test_that("grid: missing values located correctly", { # Facet order ---------------------------------------------------------------- -get_layout <- function(p) ggplot_build(p)$panel$layout +get_layout <- function(p) a_plot_build(p)$panel$layout # Data with factor f with levels CBA d <- data.frame(x = 1:9, y = 1:9, @@ -106,31 +106,31 @@ test_that("grid: facet order follows default data frame order", { # Facets should be in order: # CBA for rows 1:3 # cba for cols 1:3 - lay <- get_layout(ggplot(d, aes(x, y)) + facet_grid(fy ~ fx) + geom_point()) + lay <- get_layout(a_plot(d, a_aes(x, y)) + a_facet_grid(fy ~ fx) + a_geom_point()) expect_equal(as.character(lay$fy), c("C","B","A")[lay$ROW]) expect_equal(as.character(lay$fx), c("c","b","a")[lay$COL]) # When adding d2, facets should still be in order: # CBA for rows 1:3 # cba for cols 1:3 - lay <- get_layout(ggplot(d, aes(x, y)) + facet_grid(fy ~ fx) + - geom_blank(data = d2) + geom_point()) + lay <- get_layout(a_plot(d, a_aes(x, y)) + a_facet_grid(fy ~ fx) + + a_geom_blank(data = d2) + a_geom_point()) expect_equal(as.character(lay$fy), c("C","B","A")[lay$ROW]) expect_equal(as.character(lay$fx), c("c","b","a")[lay$COL]) # With no default data: should search each layer in order # BCA for rows 1:3 # acb for cols 1:3 - lay <- get_layout(ggplot(mapping = aes(x, y)) + facet_grid(fy ~ fx) + - geom_blank(data = d2) + geom_point(data = d)) + lay <- get_layout(a_plot(mapping = a_aes(x, y)) + a_facet_grid(fy ~ fx) + + a_geom_blank(data = d2) + a_geom_point(data = d)) expect_equal(as.character(lay$fy), c("B","C","A")[lay$ROW]) expect_equal(as.character(lay$fx), c("a","c","b")[lay$COL]) # Same as previous, but different layer order. # CBA for rows 1:3 # cba for cols 1:3 - lay <- get_layout(ggplot(mapping = aes(x, y)) + facet_grid(fy ~ fx) + - geom_point(data = d) + geom_blank(data = d2)) + lay <- get_layout(a_plot(mapping = a_aes(x, y)) + a_facet_grid(fy ~ fx) + + a_geom_point(data = d) + a_geom_blank(data = d2)) expect_equal(as.character(lay$fy), c("C","B","A")[lay$ROW]) expect_equal(as.character(lay$fx), c("c","b","a")[lay$COL]) }) @@ -138,25 +138,25 @@ test_that("grid: facet order follows default data frame order", { test_that("wrap: facet order follows default data frame order", { # Facets should be in order: # cba for panels 1:3 - lay <- get_layout(ggplot(d, aes(x, y)) + facet_wrap(~fx) + geom_point()) + lay <- get_layout(a_plot(d, a_aes(x, y)) + a_facet_wrap(~fx) + a_geom_point()) expect_equal(as.character(lay$fx), c("c","b","a")[lay$PANEL]) # When adding d2, facets should still be in order: # cba for panels 1:3 - lay <- get_layout(ggplot(d, aes(x, y)) + facet_wrap(~fx) + - geom_blank(data = d2) + geom_point()) + lay <- get_layout(a_plot(d, a_aes(x, y)) + a_facet_wrap(~fx) + + a_geom_blank(data = d2) + a_geom_point()) expect_equal(as.character(lay$fx), c("c","b","a")[lay$PANEL]) # With no default data: should search each layer in order # acb for panels 1:3 - lay <- get_layout(ggplot(mapping = aes(x, y)) + facet_wrap(~fx) + - geom_blank(data = d2) + geom_point(data = d)) + lay <- get_layout(a_plot(mapping = a_aes(x, y)) + a_facet_wrap(~fx) + + a_geom_blank(data = d2) + a_geom_point(data = d)) expect_equal(as.character(lay$fx), c("a","c","b")[lay$PANEL]) # Same as previous, but different layer order. # cba for panels 1:3 - lay <- get_layout(ggplot(mapping = aes(x, y)) + facet_wrap(~fx) + - geom_point(data = d) + geom_blank(data = d2)) + lay <- get_layout(a_plot(mapping = a_aes(x, y)) + a_facet_wrap(~fx) + + a_geom_point(data = d) + a_geom_blank(data = d2)) expect_equal(as.character(lay$fx), c("c","b","a")[lay$PANEL]) }) diff --git a/tests/testthat/test-facet-strips.r b/tests/testthat/test-facet-strips.r index c3f4e7e8e1..dd74606a9a 100644 --- a/tests/testthat/test-facet-strips.r +++ b/tests/testthat/test-facet-strips.r @@ -1,26 +1,26 @@ context("Facet Strips") strip_layout <- function(p) { - data <- ggplot_build(p) + data <- a_plot_build(p) plot <- data$plot panel <- data$panel data <- data$data - theme <- plot_theme(plot) + a_theme <- plot_a_theme(plot) - geom_grobs <- Map(function(l, d) l$draw_geom(d, panel, plot$coordinates), + a_geom_grobs <- Map(function(l, d) l$draw_geom(d, panel, plot$coordinates), plot$layers, data) - facet <- facet_render(plot$facet, panel, plot$coordinates, theme, geom_grobs) - layout <- facet$layout + a_facet <- a_facet_render(plot$a_facet, panel, plot$coordinates, a_theme, a_geom_grobs) + layout <- a_facet$layout strip_layout <- layout[grepl("^strip", layout$name), 1:4] as.list(strip_layout) } -p <- ggplot(mtcars, aes(disp, drat)) + geom_point() +p <- a_plot(mtcars, a_aes(disp, drat)) + a_geom_point() -test_that("facet_wrap() builds correct output", { - wrap <- p + facet_wrap(~cyl) +test_that("a_facet_wrap() builds correct output", { + wrap <- p + a_facet_wrap(~cyl) wrap_expected <- list( t = c(1, 1, 1), @@ -32,8 +32,8 @@ test_that("facet_wrap() builds correct output", { expect_equal(strip_layout(wrap), wrap_expected) }) -test_that("facet_wrap() switches to 'x'", { - wrap_x <- p + facet_wrap(~cyl, switch = "x") +test_that("a_facet_wrap() switches to 'x'", { + wrap_x <- p + a_facet_wrap(~cyl, switch = "x") wrap_x_expected <- list( t = c(3, 3, 3), @@ -45,8 +45,8 @@ test_that("facet_wrap() switches to 'x'", { expect_equal(strip_layout(wrap_x), wrap_x_expected) }) -test_that("facet_wrap() switches to 'y'", { - wrap_y <- p + facet_wrap(~cyl, switch = "y") +test_that("a_facet_wrap() switches to 'y'", { + wrap_y <- p + a_facet_wrap(~cyl, switch = "y") wrap_y_expected <- list( t = c(1, 1, 1), @@ -59,8 +59,8 @@ test_that("facet_wrap() switches to 'y'", { }) -test_that("facet_grid() builds correct output", { - grid <- p + facet_grid(~cyl) +test_that("a_facet_grid() builds correct output", { + grid <- p + a_facet_grid(~cyl) grid_expected <- list( t = c(1, 1, 1), @@ -72,8 +72,8 @@ test_that("facet_grid() builds correct output", { expect_equal(strip_layout(grid), grid_expected) }) -test_that("facet_grid() switches to 'x'", { - grid_x <- p + facet_grid(am ~ cyl, switch = "x") +test_that("a_facet_grid() switches to 'x'", { + grid_x <- p + a_facet_grid(am ~ cyl, switch = "x") grid_x_expected <- list( t = c(1, 3, 5), @@ -85,8 +85,8 @@ test_that("facet_grid() switches to 'x'", { expect_equal(strip_layout(grid_x), grid_x_expected) }) -test_that("facet_grid() switches to 'y'", { - grid_y <- p + facet_grid(am ~ cyl, switch = "y") +test_that("a_facet_grid() switches to 'y'", { + grid_y <- p + a_facet_grid(am ~ cyl, switch = "y") grid_y_expected <- list( t = c(1, 1, 1, 2), @@ -98,8 +98,8 @@ test_that("facet_grid() switches to 'y'", { expect_equal(strip_layout(grid_y), grid_y_expected) }) -test_that("facet_grid() switches to both 'x' and 'y'", { - grid_xy <- p + facet_grid(am ~ cyl, switch = "both") +test_that("a_facet_grid() switches to both 'x' and 'y'", { + grid_xy <- p + a_facet_grid(am ~ cyl, switch = "both") grid_xy_expected <- list( t = c(1, 5), diff --git a/tests/testthat/test-fortify.r b/tests/testthat/test-fortify.r index 5265fa482b..b3e5880862 100644 --- a/tests/testthat/test-fortify.r +++ b/tests/testthat/test-fortify.r @@ -1,4 +1,4 @@ -context("Fortify") +context("a_fortify") library(sp) test_that("Spatial polygons have correct ordering", { @@ -32,6 +32,6 @@ test_that("Spatial polygons have correct ordering", { polys2_sp <- SpatialPolygons(polys2) fake_sp2 <- SpatialPolygonsDataFrame(polys2_sp, fake_data) - expect_equivalent(fortify(fake_sp), plyr::arrange(fortify(fake_sp2), id, order)) + expect_equivalent(a_fortify(fake_sp), plyr::arrange(a_fortify(fake_sp2), id, order)) }) diff --git a/tests/testthat/test-function-args.r b/tests/testthat/test-function-args.r index eeaf6823f5..d89bf83ff7 100644 --- a/tests/testthat/test-function-args.r +++ b/tests/testthat/test-function-args.r @@ -7,40 +7,40 @@ filter_args <- function(x) { } test_that("geom_xxx and GeomXxx$draw arg defaults match", { - ggplot2_ns <- asNamespace("ggplot2") + ggplot2_ns <- asNamespace("ggplot2Animint") objs <- ls(ggplot2_ns) - geom_fun_names <- objs[grepl("^(geom|annotation)_", objs)] + a_geom_fun_names <- objs[grepl("^(a_geom|annotation)_", objs)] # These aren't actually geoms, or need special parameters and can't be tested this way. - geom_fun_names <- setdiff( - geom_fun_names, - c("geom_aesthetics", "geom_map", "annotation_custom", "annotation_map", + a_geom_fun_names <- setdiff( + a_geom_fun_names, + c("a_geom_aesthetics", "a_geom_map", "annotation_custom", "annotation_map", "annotation_raster", "annotation_id") ) # For each geom_xxx function and the corresponding GeomXxx$draw and # GeomXxx$draw_groups functions, make sure that if they have same args, that # the args have the same default values. - lapply(geom_fun_names, function(geom_fun_name) { - geom_fun <- ggplot2_ns[[geom_fun_name]] - draw <- geom_fun()$geom$draw_layer - draw_groups <- geom_fun()$geom$draw_group + lapply(a_geom_fun_names, function(a_geom_fun_name) { + a_geom_fun <- ggplot2_ns[[a_geom_fun_name]] + draw <- a_geom_fun()$a_geom$draw_layer + draw_groups <- a_geom_fun()$a_geom$draw_group - fun_args <- formals(geom_fun) - draw_args <- c(ggproto_formals(draw), ggproto_formals(draw_groups)) + fun_args <- formals(a_geom_fun) + draw_args <- c(a_ggproto_formals(draw), a_ggproto_formals(draw_groups)) draw_args <- filter_args(draw_args) common_names <- intersect(names(fun_args), names(draw_args)) expect_identical(fun_args[common_names], draw_args[common_names], - info = paste0("Mismatch between arg defaults for ", geom_fun_name, - " and ", class(geom_fun()$geom)[1], "'s $draw and/or $draw_group functions.") + info = paste0("Mismatch between arg defaults for ", a_geom_fun_name, + " and ", class(a_geom_fun()$a_geom)[1], "'s $draw and/or $draw_group functions.") ) }) }) test_that("stat_xxx and StatXxx$draw arg defaults match", { - ggplot2_ns <- asNamespace("ggplot2") + ggplot2_ns <- asNamespace("ggplot2Animint") objs <- ls(ggplot2_ns) stat_fun_names <- objs[grepl("^stat_", objs)] # These aren't actually stats, or need special parameters and can't be tested this way. @@ -49,7 +49,7 @@ test_that("stat_xxx and StatXxx$draw arg defaults match", { c("stat_aesthetics", "stat_function") ) - # For each geom_xxx function and the corresponding GeomXxx$draw and + # For each a_geom_xxx function and the corresponding GeomXxx$draw and # GeomXxx$draw_groups functions, make sure that if they have same args, that # the args have the same default values. lapply(stat_fun_names, function(stat_fun_name) { @@ -58,7 +58,7 @@ test_that("stat_xxx and StatXxx$draw arg defaults match", { calculate_groups <- stat_fun()$stat$compute_group fun_args <- formals(stat_fun) - calc_args <- c(ggproto_formals(calculate), ggproto_formals(calculate_groups)) + calc_args <- c(a_ggproto_formals(calculate), a_ggproto_formals(calculate_groups)) calc_args <- filter_args(calc_args) common_names <- intersect(names(fun_args), names(calc_args)) diff --git a/tests/testthat/test-geom-boxplot.R b/tests/testthat/test-geom-boxplot.R index b4a4a5863f..1d8814c359 100644 --- a/tests/testthat/test-geom-boxplot.R +++ b/tests/testthat/test-geom-boxplot.R @@ -1,9 +1,9 @@ -context("geom_boxplot") +context("a_geom_boxplot") test_that("can use US spelling of colour", { df <- data.frame(x = 1, y = c(1:5, 100)) - plot <- ggplot(df, aes(x, y)) + geom_boxplot(outlier.color = "red") + plot <- a_plot(df, a_aes(x, y)) + a_geom_boxplot(outlier.color = "red") - gpar <- layer_grob(plot)[[1]]$children[[1]]$children[[1]]$gp + gpar <- a_layer_grob(plot)[[1]]$children[[1]]$children[[1]]$gp expect_equal(gpar$col, "#FF0000FF") }) diff --git a/tests/testthat/test-geom-freqpoly.R b/tests/testthat/test-geom-freqpoly.R index 7793fcb1f0..c6b4747459 100644 --- a/tests/testthat/test-geom-freqpoly.R +++ b/tests/testthat/test-geom-freqpoly.R @@ -3,8 +3,8 @@ context("freqpoly") test_that("can do frequency polygon with categorical x", { df <- data.frame(x = rep(letters[1:3], 3:1)) - p <- ggplot(df, aes(x)) + geom_freqpoly(stat = "count") - d <- layer_data(p) + p <- a_plot(df, a_aes(x)) + a_geom_freqpoly(a_stat = "count") + d <- a_layer_data(p) expect_is(d$x, "integer") expect_equal(d$x, 1:3) diff --git a/tests/testthat/test-geom-ribbon.R b/tests/testthat/test-geom-ribbon.R index 13dade7939..665a5dbad5 100644 --- a/tests/testthat/test-geom-ribbon.R +++ b/tests/testthat/test-geom-ribbon.R @@ -1,10 +1,10 @@ -context("geom_ribbon") +context("a_geom_ribbon") test_that("NAs are not dropped from the data", { df <- data.frame(x = 1:5, y = c(1, 1, NA, 1, 1)) - p <- ggplot(df, aes(x))+ - geom_ribbon(aes(ymin = y - 1, ymax = y + 1)) + p <- a_plot(df, a_aes(x))+ + a_geom_ribbon(a_aes(ymin = y - 1, ymax = y + 1)) - expect_equal(layer_data(p)$ymin, c(0, 0, NA, 0, 0)) + expect_equal(a_layer_data(p)$ymin, c(0, 0, NA, 0, 0)) }) diff --git a/tests/testthat/test-geom-rule.R b/tests/testthat/test-geom-rule.R index 109916fb53..04d62b3d54 100644 --- a/tests/testthat/test-geom-rule.R +++ b/tests/testthat/test-geom-rule.R @@ -1,34 +1,34 @@ -context("geom_rule") -# tests for geom_vline, geom_hline & geom_abline +context("a_geom_rule") +# tests for a_geom_vline, a_geom_hline & a_geom_abline df <- data.frame(x = 1:3, y = 3:1) -p <- ggplot(df, aes(x, y)) + geom_point() -p_col <- ggplot(df, aes(x, y, colour = factor(x))) + geom_point() +p <- a_plot(df, a_aes(x, y)) + a_geom_point() +p_col <- a_plot(df, a_aes(x, y, colour = factor(x))) + a_geom_point() test_that("setting parameters makes one row df", { - b <- p + geom_hline(yintercept = 1.5) - expect_equal(layer_data(b, 2)$yintercept, 1.5) + b <- p + a_geom_hline(yintercept = 1.5) + expect_equal(a_layer_data(b, 2)$yintercept, 1.5) - b <- p + geom_vline(xintercept = 1.5) - expect_equal(layer_data(b, 2)$xintercept, 1.5) + b <- p + a_geom_vline(xintercept = 1.5) + expect_equal(a_layer_data(b, 2)$xintercept, 1.5) - b <- p + geom_abline() - expect_equal(layer_data(b, 2)$intercept, 0) - expect_equal(layer_data(b, 2)$slope, 1) + b <- p + a_geom_abline() + expect_equal(a_layer_data(b, 2)$intercept, 0) + expect_equal(a_layer_data(b, 2)$slope, 1) - b <- p + geom_abline(slope = 0, intercept = 1) - expect_equal(layer_data(b, 2)$intercept, 1) - expect_equal(layer_data(b, 2)$slope, 0) + b <- p + a_geom_abline(slope = 0, intercept = 1) + expect_equal(a_layer_data(b, 2)$intercept, 1) + expect_equal(a_layer_data(b, 2)$slope, 0) }) test_that("setting aesthetics generates one row for each input row", { - b <- p + geom_hline(aes(yintercept = 1.5)) - expect_equal(layer_data(b, 2)$yintercept, rep(1.5, 3)) + b <- p + a_geom_hline(a_aes(yintercept = 1.5)) + expect_equal(a_layer_data(b, 2)$yintercept, rep(1.5, 3)) - b <- p + geom_vline(aes(xintercept = 1.5)) - expect_equal(layer_data(b, 2)$xintercept, rep(1.5, 3)) + b <- p + a_geom_vline(a_aes(xintercept = 1.5)) + expect_equal(a_layer_data(b, 2)$xintercept, rep(1.5, 3)) - b <- p + geom_abline(aes(slope = 0, intercept = 1)) - expect_equal(layer_data(b, 2)$intercept, rep(1, 3)) - expect_equal(layer_data(b, 2)$slope, rep(0, 3)) + b <- p + a_geom_abline(a_aes(slope = 0, intercept = 1)) + expect_equal(a_layer_data(b, 2)$intercept, rep(1, 3)) + expect_equal(a_layer_data(b, 2)$slope, rep(0, 3)) }) diff --git a/tests/testthat/test-geom-text.R b/tests/testthat/test-geom-text.R index ffc3a71bf5..f29f45b83c 100644 --- a/tests/testthat/test-geom-text.R +++ b/tests/testthat/test-geom-text.R @@ -1,4 +1,4 @@ -context("geom_text") +context("a_geom_text") # compute_just ------------------------------------------------------------ diff --git a/tests/testthat/test-geom-tile.R b/tests/testthat/test-geom-tile.R index d40754e280..b138e72546 100644 --- a/tests/testthat/test-geom-tile.R +++ b/tests/testthat/test-geom-tile.R @@ -1,13 +1,13 @@ -context("geom_tile") +context("a_geom_tile") test_that("accepts width and height params", { df <- data.frame(x = c("a", "b"), y = c("a", "b")) - out1 <- layer_data(ggplot(df, aes(x, y)) + geom_tile()) + out1 <- a_layer_data(a_plot(df, a_aes(x, y)) + a_geom_tile()) expect_equal(out1$xmin, c(0.5, 1.5)) expect_equal(out1$xmax, c(1.5, 2.5)) - out2 <- layer_data(ggplot(df, aes(x, y)) + geom_tile(width = 0.5, height = 0.5)) + out2 <- a_layer_data(a_plot(df, a_aes(x, y)) + a_geom_tile(width = 0.5, height = 0.5)) expect_equal(out2$xmin, c(0.75, 1.75)) expect_equal(out2$xmax, c(1.25, 2.25)) }) diff --git a/tests/testthat/test-geom-violin.R b/tests/testthat/test-geom-violin.R index 2f5208b4d1..9b73021bd0 100644 --- a/tests/testthat/test-geom-violin.R +++ b/tests/testthat/test-geom-violin.R @@ -1,4 +1,4 @@ -context("geom_violin") +context("a_geom_violin") test_that("", { df <- rbind( @@ -6,13 +6,13 @@ test_that("", { data.frame(x = "b", y = c(0, runif(10), 2)) ) - p <- ggplot(df, aes(1, y)) + - geom_violin() + - facet_grid(x ~ ., scales = "free") + - coord_cartesian(expand = FALSE) + p <- a_plot(df, a_aes(1, y)) + + a_geom_violin() + + a_facet_grid(x ~ ., scales = "free") + + ggplot2Animint:::a_coord_cartesian(expand = FALSE) - expect_equal(layer_scales(p, 1)$y$dimension(), c(0, 1)) - expect_equal(layer_scales(p, 2)$y$dimension(), c(0, 2)) + expect_equal(a_layer_scales(p, 1)$y$dimension(), c(0, 1)) + expect_equal(a_layer_scales(p, 2)$y$dimension(), c(0, 2)) }) # create_quantile_segment_frame ------------------------------------------------- diff --git a/tests/testthat/test-ggsave.R b/tests/testthat/test-ggsave.R index 0aac88c39b..ed9c2e1251 100644 --- a/tests/testthat/test-ggsave.R +++ b/tests/testthat/test-ggsave.R @@ -4,7 +4,7 @@ test_that("ggsave creates file", { path <- tempfile() on.exit(unlink(path)) - p <- ggplot(mpg, aes(displ, hwy)) + geom_point() + p <- a_plot(mpg, a_aes(displ, hwy)) + a_geom_point() expect_false(file.exists(path)) ggsave(path, p, device = "pdf", width = 5, height = 5) @@ -32,8 +32,8 @@ test_that("warned about large plot unless limitsize = FALSE", { }) test_that("scale multiplies height & width", { - expect_equal(plot_dim(c(10, 10), scale = 1), c(10, 10)) - expect_equal(plot_dim(c(5, 5), scale = 2), c(10, 10)) + expect_equal(plot_dim(c(10, 10), a_scale = 1), c(10, 10)) + expect_equal(plot_dim(c(5, 5), a_scale = 2), c(10, 10)) }) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 0a1aa6d7e1..5d09836c4a 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -1,10 +1,10 @@ context("Guides") test_that("colourbar trains without labels", { - g <- guide_colorbar() - sc <- scale_colour_continuous(limits = c(0, 4), labels = NULL) + g <- a_guide_colorbar() + sc <- a_scale_colour_continuous(limits = c(0, 4), a_labels = NULL) - out <- guide_train(g, sc) + out <- a_guide_train(g, sc) expect_equal(names(out$key), c("colour", ".value")) }) diff --git a/tests/testthat/test-layer.r b/tests/testthat/test-layer.r index 7e4e9f5744..863f4912fc 100644 --- a/tests/testthat/test-layer.r +++ b/tests/testthat/test-layer.r @@ -1,47 +1,65 @@ -context("Layer") +context("a_layer") # Parameters -------------------------------------------------------------- -test_that("aesthetics go in aes_params", { - l <- geom_point(size = "red") - expect_equal(l$aes_params, list(size = "red")) +test_that("a_aesthetics go in a_aes_params", { + l <- a_geom_point(size = "red") + expect_equal(l$a_aes_params, list(size = "red")) }) test_that("unknown params create error", { - expect_error(geom_point(blah = "red"), "Unknown parameters") + skip("passes when validate_params=TRUE") +expect_error(a_geom_point(blah = "red"), "Unknown parameters") + }) + +test_that("Unknown params create error with validate_params = TRUE", { + expect_error(a_geom_point(blah = "red", validate_params = TRUE), + "Unknown parameters") +}) + +test_that("Unknown params don't create error with validate_params = FALSE", { + expect_silent(a_geom_point(blah = "red", validate_params = FALSE)) +}) + +test_that("Unknown params go in extra_params, not a_aes_params", { + l <- a_geom_point(some_param = "value1", + size = "big", + validate_params = FALSE) + expect_equal(l$extra_params, list(some_param = "value1")) + expect_equal(l$a_aes_params, list(size = "big")) }) # Calculated aesthetics --------------------------------------------------- test_that("Bare name surround by .. is calculated", { - expect_true(is_calculated_aes(aes(..density..))) - expect_true(is_calculated_aes(aes(..DENSITY..))) - expect_false(is_calculated_aes(aes(a..x..b))) + expect_true(is_calculated_aes(a_aes(..density..))) + expect_true(is_calculated_aes(a_aes(..DENSITY..))) + expect_false(is_calculated_aes(a_aes(a..x..b))) }) test_that("Calling using variable surround by .. is calculated", { - expect_true(is_calculated_aes(aes(mean(..density..)))) - expect_true(is_calculated_aes(aes(mean(..DENSITY..)))) - expect_false(is_calculated_aes(aes(mean(a..x..b)))) + expect_true(is_calculated_aes(a_aes(mean(..density..)))) + expect_true(is_calculated_aes(a_aes(mean(..DENSITY..)))) + expect_false(is_calculated_aes(a_aes(mean(a..x..b)))) }) test_that("strip_dots remove dots around calculated aesthetics", { - expect_equal(strip_dots(aes(..density..))$x, quote(density)) - expect_equal(strip_dots(aes(mean(..density..)))$x, quote(mean(density))) - expect_equal(strip_dots(aes(sapply(..density.., function(x) mean(x)))$x), + expect_equal(strip_dots(a_aes(..density..))$x, quote(density)) + expect_equal(strip_dots(a_aes(mean(..density..)))$x, quote(mean(density))) + expect_equal(strip_dots(a_aes(sapply(..density.., function(x) mean(x)))$x), quote(sapply(density, function(x) mean(x)))) }) # Data extraction --------------------------------------------------------- -test_that("layer_data returns a data.frame", { - l <- geom_point() - expect_equal(l$layer_data(mtcars), mtcars) - l <- geom_point(data = head(mtcars)) - expect_equal(l$layer_data(mtcars), head(mtcars)) - l <- geom_point(data = head) - expect_equal(l$layer_data(mtcars), head(mtcars)) - l <- geom_point(data = nrow) - expect_error(l$layer_data(mtcars), "Data function must return a data.frame") +test_that("a_layer_data returns a data.frame", { + l <- a_geom_point() + expect_equal(l$a_layer_data(mtcars), mtcars) + l <- a_geom_point(data = head(mtcars)) + expect_equal(l$a_layer_data(mtcars), head(mtcars)) + l <- a_geom_point(data = head) + expect_equal(l$a_layer_data(mtcars), head(mtcars)) + l <- a_geom_point(data = nrow) + expect_error(l$a_layer_data(mtcars), "Data function must return a data.frame") }) diff --git a/tests/testthat/test-munch.r b/tests/testthat/test-munch.r index a765b69cf6..f2bc81e7b6 100644 --- a/tests/testthat/test-munch.r +++ b/tests/testthat/test-munch.r @@ -34,14 +34,14 @@ test_that("munch_data works", { single_munch_test(dat, dist) single_munch_test(dat, dist, segment_length = 10) single_munch_test(dat, dist, segment_length = 100) - dist <- coord_polar(theta = "x")$distance(dat$x, dat$y, + dist <- a_coord_polar(theta = "x")$distance(dat$x, dat$y, list(r.range = range(c(0,dat$y)), theta.range = range(dat$x))) dist[dat$group[-1] != dat$group[-nrow(dat)]] <- NA single_munch_test(dat, dist) single_munch_test(dat, dist, segment_length = 10) single_munch_test(dat, dist, segment_length = 100) - dist <- coord_polar(theta = "y")$distance(dat$x, dat$y, + dist <- a_coord_polar(theta = "y")$distance(dat$x, dat$y, list(r.range = range(c(0,dat$x)), theta.range = range(dat$y))) dist[dat$group[-1] != dat$group[-nrow(dat)]] <- NA diff --git a/tests/testthat/test-qplot.r b/tests/testthat/test-qplot.r index 732e1b1500..98f92530fa 100644 --- a/tests/testthat/test-qplot.r +++ b/tests/testthat/test-qplot.r @@ -5,12 +5,12 @@ test_that("qplot works with variables in data frame and parent env", { y <- 1:10 b <- 1:10 - expect_is(qplot(x, y, data = df), "ggplot") - expect_is(qplot(x, y, data = df, colour = a), "ggplot") - expect_is(qplot(x, y, data = df, colour = b), "ggplot") + expect_is(qplot(x, y, data = df), "a_plot") + expect_is(qplot(x, y, data = df, colour = a), "a_plot") + expect_is(qplot(x, y, data = df, colour = b), "a_plot") bin <- 1 - expect_is(qplot(x, data = df, binwidth = bin), "ggplot") + expect_is(qplot(x, data = df, binwidth = bin), "a_plot") }) test_that("qplot works in non-standard environments", { @@ -21,7 +21,7 @@ test_that("qplot works in non-standard environments", { qplot(x, breaks = 0:`-1-`) }) - expect_is(eval(expr, env), "ggplot") + expect_is(eval(expr, env), "a_plot") }) diff --git a/tests/testthat/test-scale-discrete.R b/tests/testthat/test-scale-discrete.R index 3485576a23..ae4f47fd6d 100644 --- a/tests/testthat/test-scale-discrete.R +++ b/tests/testthat/test-scale-discrete.R @@ -5,14 +5,14 @@ context("scale_discrete") test_that("discrete ranges also encompas continuous values", { df <- data.frame(x1 = c("a", "b", "c"), x2 = c(0, 2, 4), y = 1:3) - base <- ggplot(df, aes(y = y)) + scale_x_discrete() + base <- a_plot(df, a_aes(y = y)) + a_scale_x_discrete() x_range <- function(x) { - layer_scales(x)$x$dimension() + a_layer_scales(x)$x$dimension() } - expect_equal(x_range(base + geom_point(aes(x1))), c(1, 3)) - expect_equal(x_range(base + geom_point(aes(x2))), c(0, 4)) - expect_equal(x_range(base + geom_point(aes(x1)) + geom_point(aes(x2))), c(0, 4)) + expect_equal(x_range(base + a_geom_point(a_aes(x1))), c(1, 3)) + expect_equal(x_range(base + a_geom_point(a_aes(x2))), c(0, 4)) + expect_equal(x_range(base + a_geom_point(a_aes(x1)) + a_geom_point(a_aes(x2))), c(0, 4)) }) diff --git a/tests/testthat/test-scale-manual.r b/tests/testthat/test-scale-manual.r index 1013c83ba9..bfd57a834a 100644 --- a/tests/testthat/test-scale-manual.r +++ b/tests/testthat/test-scale-manual.r @@ -2,20 +2,20 @@ context("scale_manual") test_that("names of values used in manual scales", { - s <- scale_colour_manual(values = c("8" = "c","4" = "a","6" = "b")) + s <- ggplot2Animint:::a_scale_colour_manual(values = c("8" = "c","4" = "a","6" = "b")) s$train(c("4", "6", "8")) expect_equal(s$map(c("4", "6", "8")), c("a", "b", "c")) }) dat <- data.frame(g = c("B","A","A")) -p <- ggplot(dat, aes(g, fill = g)) + geom_bar() +p <- a_plot(dat, a_aes(g, fill = g)) + a_geom_bar() col <- c("A" = "red", "B" = "green", "C" = "blue") -cols <- function(x) ggplot_build(x)$data[[1]][, "fill"] +cols <- function(x) a_plot_build(x)$data[[1]][, "fill"] test_that("named values work regardless of order", { - fill_scale <- function(order) scale_fill_manual(values = col[order], + fill_scale <- function(order) a_scale_fill_manual(values = col[order], na.value = "black") # Order of value vector shouldn't matter @@ -29,27 +29,27 @@ test_that("named values work regardless of order", { test_that("missing values replaced with na.value", { df <- data.frame(x = 1, y = 1:3, z = factor(c(1:2, NA), exclude = NULL)) - p <- ggplot(df, aes(x, y, colour = z)) + - geom_point() + - scale_colour_manual(values = c("black", "black"), na.value = "red") + p <- a_plot(df, a_aes(x, y, colour = z)) + + a_geom_point() + + ggplot2Animint:::a_scale_colour_manual(values = c("black", "black"), na.value = "red") - expect_equal(layer_data(p)$colour, c("black", "black", "red")) + expect_equal(a_layer_data(p)$colour, c("black", "black", "red")) }) test_that("insufficient values raise an error", { df <- data.frame(x = 1, y = 1:3, z = factor(c(1:2, NA), exclude = NULL)) p <- qplot(x, y, data = df, colour = z) - expect_error(ggplot_build(p + scale_colour_manual(values = "black")), + expect_error(a_plot_build(p + ggplot2Animint:::a_scale_colour_manual(values = "black")), "Insufficient values") # Should be sufficient - ggplot_build(p + scale_colour_manual(values = c("black", "black"))) + a_plot_build(p + ggplot2Animint:::a_scale_colour_manual(values = c("black", "black"))) }) test_that("values are matched when scale contains more unique valuesthan are in the data", { - s <- scale_colour_manual(values = c("8" = "c", "4" = "a", + s <- ggplot2Animint:::a_scale_colour_manual(values = c("8" = "c", "4" = "a", "22" = "d", "6" = "b")) s$train(c("4", "6", "8")) expect_equal(s$map(c("4", "6", "8")), c("a", "b", "c")) diff --git a/tests/testthat/test-scales-breaks-labels.r b/tests/testthat/test-scales-breaks-labels.r index 5e0c21ea40..201434a82e 100644 --- a/tests/testthat/test-scales-breaks-labels.r +++ b/tests/testthat/test-scales-breaks-labels.r @@ -1,95 +1,95 @@ context("Scales: breaks and labels") test_that("labels match breaks, even when outside limits", { - sc <- scale_y_continuous(breaks = 1:4, labels = 1:4, limits = c(1, 3)) + sc <- a_scale_y_continuous(breaks = 1:4, a_labels = 1:4, limits = c(1, 3)) expect_equal(sc$get_breaks(), c(1:3, NA)) expect_equal(sc$get_labels(), 1:4) expect_equal(sc$get_breaks_minor(), c(1, 1.5, 2, 2.5, 3)) }) -test_that("labels must match breaks", { - expect_error(scale_x_discrete(breaks = 1:3, labels = 1:2), +test_that("a_labels must match breaks", { + expect_error(a_scale_x_discrete(breaks = 1:3, a_labels = 1:2), "must have the same length") - expect_error(scale_x_continuous(breaks = 1:3, labels = 1:2), + expect_error(a_scale_x_continuous(breaks = 1:3, a_labels = 1:2), "must have the same length") }) -test_that("labels don't have to match null breaks", { - expect_true(check_breaks_labels(breaks = 1:3, labels = NULL)) - expect_true(check_breaks_labels(breaks = NULL, labels = 1:2)) +test_that("a_labels don't have to match null breaks", { + expect_true(check_breaks_labels(breaks = 1:3, a_labels = NULL)) + expect_true(check_breaks_labels(breaks = NULL, a_labels = 1:2)) }) test_that("labels don't have extra spaces", { - labels <- c("a", "abc", "abcdef") + a_labels <- c("a", "abc", "abcdef") - sc1 <- scale_x_discrete(limits = labels) - sc2 <- scale_fill_discrete(limits = labels) + sc1 <- a_scale_x_discrete(limits = a_labels) + sc2 <- a_scale_fill_discrete(limits = a_labels) - expect_equal(sc1$get_labels(), labels) - expect_equal(sc2$get_labels(), labels) + expect_equal(sc1$get_labels(), a_labels) + expect_equal(sc2$get_labels(), a_labels) }) test_that("out-of-range breaks are dropped", { # Limits are explicitly specified, automatic labels - sc <- scale_x_continuous(breaks = 1:5, limits = c(2, 4)) + sc <- a_scale_x_continuous(breaks = 1:5, limits = c(2, 4)) bi <- sc$break_info() - expect_equal(bi$labels, as.character(2:4)) + expect_equal(bi$a_labels, as.character(2:4)) expect_equal(bi$major, c(0, 0.5, 1)) expect_equal(bi$major_source, 2:4) # Limits and labels are explicitly specified - sc <- scale_x_continuous(breaks = 1:5, labels = letters[1:5], limits = c(2, 4)) + sc <- a_scale_x_continuous(breaks = 1:5, a_labels = letters[1:5], limits = c(2, 4)) bi <- sc$break_info() - expect_equal(bi$labels, letters[2:4]) + expect_equal(bi$a_labels, letters[2:4]) expect_equal(bi$major, c(0, 0.5, 1)) expect_equal(bi$major_source, 2:4) # Limits are specified, and all breaks are out of range - sc <- scale_x_continuous(breaks = c(1,5), labels = letters[c(1,5)], limits = c(2, 4)) + sc <- a_scale_x_continuous(breaks = c(1,5), a_labels = letters[c(1,5)], limits = c(2, 4)) bi <- sc$break_info() - expect_equal(length(bi$labels), 0) + expect_equal(length(bi$a_labels), 0) expect_equal(length(bi$major), 0) expect_equal(length(bi$major_source), 0) # limits aren't specified, automatic labels # limits are set by the data - sc <- scale_x_continuous(breaks = 1:5) + sc <- a_scale_x_continuous(breaks = 1:5) sc$train_df(data.frame(x = 2:4)) bi <- sc$break_info() - expect_equal(bi$labels, as.character(2:4)) + expect_equal(bi$a_labels, as.character(2:4)) expect_equal(bi$major_source, 2:4) expect_equal(bi$major, c(0, 0.5, 1)) # Limits and labels are specified - sc <- scale_x_continuous(breaks = 1:5, labels = letters[1:5]) + sc <- a_scale_x_continuous(breaks = 1:5, a_labels = letters[1:5]) sc$train_df(data.frame(x = 2:4)) bi <- sc$break_info() - expect_equal(bi$labels, letters[2:4]) + expect_equal(bi$a_labels, letters[2:4]) expect_equal(bi$major_source, 2:4) expect_equal(bi$major, c(0, 0.5, 1)) # Limits aren't specified, and all breaks are out of range of data - sc <- scale_x_continuous(breaks = c(1,5), labels = letters[c(1,5)]) + sc <- a_scale_x_continuous(breaks = c(1,5), a_labels = letters[c(1,5)]) sc$train_df(data.frame(x = 2:4)) bi <- sc$break_info() - expect_equal(length(bi$labels), 0) + expect_equal(length(bi$a_labels), 0) expect_equal(length(bi$major), 0) expect_equal(length(bi$major_source), 0) }) test_that("no minor breaks when only one break", { - sc1 <- scale_x_discrete(limits = "a") - sc2 <- scale_x_continuous(limits = 1) + sc1 <- a_scale_x_discrete(limits = "a") + sc2 <- a_scale_x_continuous(limits = 1) expect_equal(length(sc1$get_breaks_minor()), 0) expect_equal(length(sc2$get_breaks_minor()), 0) @@ -97,7 +97,7 @@ test_that("no minor breaks when only one break", { }) init_scale <- function(...) { - sc <- scale_x_discrete(...) + sc <- a_scale_x_discrete(...) sc$train(factor(1:100)) expect_equal(length(sc$get_limits()), 100) sc @@ -110,12 +110,12 @@ test_that("discrete labels match breaks", { expect_equal(length(sc$get_labels()), 5) expect_equivalent(sc$get_labels(), sc$get_breaks()) - sc <- init_scale(breaks = 0:5 * 10, labels = letters[1:6]) + sc <- init_scale(breaks = 0:5 * 10, a_labels = letters[1:6]) expect_equal(length(sc$get_breaks()), 5) expect_equal(length(sc$get_labels()), 5) expect_equal(sc$get_labels(), letters[2:6]) - sc <- init_scale(breaks = 0:5 * 10, labels = + sc <- init_scale(breaks = 0:5 * 10, a_labels = function(x) paste(x, "-", sep = "")) expect_equal(sc$get_labels(), c("10-", "20-", "30-", "40-", "50-")) @@ -128,13 +128,13 @@ test_that("discrete labels match breaks", { test_that("scale breaks with numeric log transformation", { - sc <- scale_x_continuous(limits = c(1, 1e5), trans = log10_trans()) + sc <- a_scale_x_continuous(limits = c(1, 1e5), trans = log10_trans()) expect_equal(sc$get_breaks(), c(0, 2, 4)) # 1, 100, 10000 expect_equal(sc$get_breaks_minor(), c(0, 1, 2, 3, 4, 5)) }) test_that("continuous scales with no data have no breaks or labels", { - sc <- scale_x_continuous() + sc <- a_scale_x_continuous() expect_equal(sc$get_breaks(), numeric()) expect_equal(sc$get_labels(), character()) @@ -143,7 +143,7 @@ test_that("continuous scales with no data have no breaks or labels", { }) test_that("discrete scales with no data have no breaks or labels", { - sc <- scale_x_discrete() + sc <- a_scale_x_discrete() expect_equal(sc$get_breaks(), numeric()) expect_equal(sc$get_labels(), character()) @@ -151,66 +151,66 @@ test_that("discrete scales with no data have no breaks or labels", { }) test_that("suppressing breaks, minor_breask, and labels", { - expect_equal(scale_x_continuous(breaks = NULL, limits = c(1, 3))$get_breaks(), NULL) - expect_equal(scale_x_discrete(breaks = NULL, limits = c(1, 3))$get_breaks(), NULL) - expect_equal(scale_x_continuous(minor_breaks = NULL, limits = c(1, 3))$get_breaks_minor(), NULL) + expect_equal(a_scale_x_continuous(breaks = NULL, limits = c(1, 3))$get_breaks(), NULL) + expect_equal(a_scale_x_discrete(breaks = NULL, limits = c(1, 3))$get_breaks(), NULL) + expect_equal(a_scale_x_continuous(minor_breaks = NULL, limits = c(1, 3))$get_breaks_minor(), NULL) - expect_equal(scale_x_continuous(labels = NULL, limits = c(1, 3))$get_labels(), NULL) - expect_equal(scale_x_discrete(labels = NULL, limits = c(1, 3))$get_labels(), NULL) + expect_equal(a_scale_x_continuous(a_labels = NULL, limits = c(1, 3))$get_labels(), NULL) + expect_equal(a_scale_x_discrete(a_labels = NULL, limits = c(1, 3))$get_labels(), NULL) # date, datetime lims <- as.Date(c("2000/1/1", "2000/2/1")) - expect_equal(scale_x_date(breaks = NULL, limits = lims)$get_breaks(), NULL) + expect_equal(a_scale_x_date(breaks = NULL, limits = lims)$get_breaks(), NULL) # NA is defunct, should throw error - expect_error(scale_x_date(breaks = NA, limits = lims)$get_breaks()) - expect_equal(scale_x_date(labels = NULL, limits = lims)$get_labels(), NULL) - expect_error(scale_x_date(labels = NA, limits = lims)$get_labels()) - expect_equal(scale_x_date(minor_breaks = NULL, limits = lims)$get_breaks_minor(), NULL) - expect_error(scale_x_date(minor_breaks = NA, limits = lims)$get_breaks_minor()) + expect_error(a_scale_x_date(breaks = NA, limits = lims)$get_breaks()) + expect_equal(a_scale_x_date(a_labels = NULL, limits = lims)$get_labels(), NULL) + expect_error(a_scale_x_date(a_labels = NA, limits = lims)$get_labels()) + expect_equal(a_scale_x_date(minor_breaks = NULL, limits = lims)$get_breaks_minor(), NULL) + expect_error(a_scale_x_date(minor_breaks = NA, limits = lims)$get_breaks_minor()) # date, datetime lims <- as.POSIXct(c("2000/1/1 0:0:0", "2010/1/1 0:0:0")) - expect_equal(scale_x_datetime(breaks = NULL, limits = lims)$get_breaks(), NULL) - expect_error(scale_x_datetime(breaks = NA, limits = lims)$get_breaks()) - expect_equal(scale_x_datetime(labels = NULL, limits = lims)$get_labels(), NULL) - expect_error(scale_x_datetime(labels = NA, limits = lims)$get_labels()) - expect_equal(scale_x_datetime(minor_breaks = NULL, limits = lims)$get_breaks_minor(), NULL) - expect_error(scale_x_datetime(minor_breaks = NA, limits = lims)$get_breaks_minor()) + expect_equal(a_scale_x_datetime(breaks = NULL, limits = lims)$get_breaks(), NULL) + expect_error(a_scale_x_datetime(breaks = NA, limits = lims)$get_breaks()) + expect_equal(a_scale_x_datetime(a_labels = NULL, limits = lims)$get_labels(), NULL) + expect_error(a_scale_x_datetime(a_labels = NA, limits = lims)$get_labels()) + expect_equal(a_scale_x_datetime(minor_breaks = NULL, limits = lims)$get_breaks_minor(), NULL) + expect_error(a_scale_x_datetime(minor_breaks = NA, limits = lims)$get_breaks_minor()) }) -test_that("scale_breaks with explicit NA options (deprecated)", { +test_that("a_scale_breaks with explicit NA options (deprecated)", { # NA is defunct, should throw error # X - sxc <- scale_x_continuous(breaks = NA) + sxc <- a_scale_x_continuous(breaks = NA) sxc$train(1:3) expect_error(sxc$get_breaks()) expect_error(sxc$get_breaks_minor()) # Y - syc <- scale_y_continuous(breaks = NA) + syc <- a_scale_y_continuous(breaks = NA) syc$train(1:3) expect_error(syc$get_breaks()) expect_error(syc$get_breaks_minor()) # Alpha - sac <- scale_alpha_continuous(breaks = NA) + sac <- a_scale_alpha_continuous(breaks = NA) sac$train(1:3) expect_error(sac$get_breaks()) # Size - ssc <- scale_size_continuous(breaks = NA) + ssc <- a_scale_size_continuous(breaks = NA) ssc$train(1:3) expect_error(ssc$get_breaks()) # Fill - sfc <- scale_fill_continuous(breaks = NA) + sfc <- a_scale_fill_continuous(breaks = NA) sfc$train(1:3) expect_error(sfc$get_breaks()) # Colour - scc <- scale_colour_continuous(breaks = NA) + scc <- a_scale_colour_continuous(breaks = NA) scc$train(1:3) expect_error(scc$get_breaks()) @@ -218,39 +218,39 @@ test_that("scale_breaks with explicit NA options (deprecated)", { test_that("breaks can be specified by names of labels", { - labels <- setNames(LETTERS[1:4], letters[1:4]) + a_labels <- setNames(LETTERS[1:4], letters[1:4]) - s <- scale_x_discrete(limits = letters[1:4], labels = labels) + s <- a_scale_x_discrete(limits = letters[1:4], a_labels = a_labels) expect_equal(as.vector(s$get_breaks()), letters[1:4]) expect_equal(as.vector(s$get_labels()), LETTERS[1:4]) - s <- scale_x_discrete(limits = letters[1:4], labels = rev(labels)) + s <- a_scale_x_discrete(limits = letters[1:4], a_labels = rev(a_labels)) expect_equal(as.vector(s$get_breaks()), letters[1:4]) expect_equal(as.vector(s$get_labels()), LETTERS[1:4]) - s <- scale_x_discrete(limits = letters[1:4], labels = labels[1:2]) + s <- a_scale_x_discrete(limits = letters[1:4], a_labels = a_labels[1:2]) expect_equal(as.vector(s$get_breaks()), letters[1:4]) expect_equal(as.vector(s$get_labels()), c("A", "B", "c", "d")) - s <- scale_x_discrete(limits = letters[1:4], labels = labels[3:4]) + s <- a_scale_x_discrete(limits = letters[1:4], a_labels = a_labels[3:4]) expect_equal(as.vector(s$get_breaks()), letters[1:4]) expect_equal(as.vector(s$get_labels()), c("a", "b", "C", "D")) - s <- scale_x_discrete(limits = letters[1:3], labels = labels) + s <- a_scale_x_discrete(limits = letters[1:3], a_labels = a_labels) expect_equal(as.vector(s$get_breaks()), letters[1:3]) expect_equal(as.vector(s$get_labels()), LETTERS[1:3]) }) test_that("only finite or NA values for breaks for transformed scales (#871)", { - sc <- scale_y_continuous(limits = c(0.01, 0.99), trans = "probit", + sc <- a_scale_y_continuous(limits = c(0.01, 0.99), trans = "probit", breaks = seq(0, 1, 0.2)) breaks <- sc$get_breaks() expect_true(all(is.finite(breaks) | is.na(breaks))) }) test_that("minor breaks are transformed by scales", { - sc <- scale_y_continuous(limits = c(1, 100), trans = "log10", + sc <- a_scale_y_continuous(limits = c(1, 100), trans = "log10", minor_breaks = c(1, 10, 100)) expect_equal(sc$get_breaks_minor(), c(0, 1, 2)) diff --git a/tests/testthat/test-scales.r b/tests/testthat/test-scales.r index 5a205b0767..d2e35330bc 100644 --- a/tests/testthat/test-scales.r +++ b/tests/testthat/test-scales.r @@ -1,17 +1,17 @@ -context("Scales") +context("a_Scales") test_that("buidling a plot does not affect its scales", { dat <- data.frame(x = rnorm(20), y = rnorm(20)) - p <- ggplot(dat, aes(x, y)) + geom_point() + p <- a_plot(dat, a_aes(x, y)) + a_geom_point() expect_equal(length(p$scales$scales), 0) - ggplot_build(p) + a_plot_build(p) expect_equal(length(p$scales$scales), 0) }) -test_that("ranges update only for variables listed in aesthetics", { - sc <- scale_alpha() +test_that("ranges update only for variables listed in a_aesthetics", { + sc <- a_scale_alpha() sc$train_df(data.frame(alpha = 1:10)) expect_equal(sc$range$range, c(1, 10)) @@ -28,7 +28,7 @@ test_that("ranges update only for variables listed in aesthetics", { }) test_that("mapping works", { - sc <- scale_alpha(range = c(0, 1), na.value = 0) + sc <- a_scale_alpha(range = c(0, 1), na.value = 0) sc$train_df(data.frame(alpha = 1:10)) expect_equal( @@ -46,15 +46,15 @@ test_that("mapping works", { test_that("identity scale preserves input values", { df <- data.frame(x = 1:3, z = letters[1:3]) - p1 <- ggplot(df, - aes(x, z, colour = z, fill = z, shape = z, size = x, alpha = x)) + - geom_point() + - scale_colour_identity() + - scale_fill_identity() + - scale_shape_identity() + - scale_size_identity() + - scale_alpha_identity() - d1 <- layer_data(p1) + p1 <- a_plot(df, + a_aes(x, z, colour = z, fill = z, shape = z, size = x, alpha = x)) + + a_geom_point() + + a_scale_colour_identity() + + a_scale_fill_identity() + + a_scale_shape_identity() + + a_scale_size_identity() + + a_scale_alpha_identity() + d1 <- a_layer_data(p1) expect_equal(d1$colour, as.character(df$z)) expect_equal(d1$fill, as.character(df$z)) @@ -63,18 +63,18 @@ test_that("identity scale preserves input values", { expect_equal(d1$alpha, as.numeric(df$z)) }) -test_that("position scales updated by all position aesthetics", { +test_that("position scales updated by all position a_aesthetics", { df <- data.frame(x = 1:3, y = 1:3) - aesthetics <- list( - aes(xend = x, yend = x), - aes(xmin = x, ymin = x), - aes(xmax = x, ymax = x), - aes(xintercept = x, yintercept = y) + a_aesthetics <- list( + a_aes(xend = x, yend = x), + a_aes(xmin = x, ymin = x), + a_aes(xmax = x, ymax = x), + a_aes(xintercept = x, yintercept = y) ) - base <- ggplot(df, aes(x = 1, y = 1)) + geom_point() - plots <- lapply(aesthetics, function(x) base %+% x) + base <- a_plot(df, a_aes(x = 1, y = 1)) + a_geom_point() + plots <- lapply(a_aesthetics, function(x) base %+% x) ranges <- lapply(plots, pranges) lapply(ranges, function(range) { @@ -86,7 +86,7 @@ test_that("position scales updated by all position aesthetics", { test_that("position scales generate after stats", { df <- data.frame(x = factor(c(1, 1, 1))) - plot <- ggplot(df, aes(x)) + geom_bar() + plot <- a_plot(df, a_aes(x)) + a_geom_bar() ranges <- pranges(plot) expect_equal(ranges$x[[1]], c("1")) @@ -96,14 +96,14 @@ test_that("position scales generate after stats", { test_that("oob affects position values", { dat <- data.frame(x = c("a", "b", "c"), y = c(1, 5, 10)) - base <- ggplot(dat, aes(x, y)) + - geom_bar(stat = "identity") + - annotate("point", x = "a", y = c(-Inf, Inf)) + base <- a_plot(dat, a_aes(x, y)) + + a_geom_bar(a_stat = "identity") + + a_annotate("point", x = "a", y = c(-Inf, Inf)) y_scale <- function(limits, oob = censor) { - scale_y_continuous(limits = limits, oob = oob, expand = c(0, 0)) + a_scale_y_continuous(limits = limits, oob = oob, expand = c(0, 0)) } - base + scale_y_continuous(limits = c(-0,5)) + base + a_scale_y_continuous(limits = c(-0,5)) expect_warning(low_censor <- cdata(base + y_scale(c(0, 5), censor)), "Removed 1 rows containing missing values") @@ -129,22 +129,22 @@ test_that("oob affects position values", { }) test_that("scales looked for in appropriate place", { - xlabel <- function(x) ggplot_build(x)$panel$x_scales[[1]]$name - p0 <- qplot(mpg, wt, data = mtcars) + scale_x_continuous("0") + xlabel <- function(x) a_plot_build(x)$panel$x_scales[[1]]$name + p0 <- qplot(mpg, wt, data = mtcars) + a_scale_x_continuous("0") expect_equal(xlabel(p0), "0") - scale_x_continuous <- function(...) ggplot2::scale_x_continuous("1") + a_scale_x_continuous <- function(...) ggplot2Animint::a_scale_x_continuous("1") p1 <- qplot(mpg, wt, data = mtcars) expect_equal(xlabel(p1), "1") f <- function() { - scale_x_continuous <- function(...) ggplot2::scale_x_continuous("2") + a_scale_x_continuous <- function(...) ggplot2Animint::a_scale_x_continuous("2") qplot(mpg, wt, data = mtcars) } p2 <- f() expect_equal(xlabel(p2), "2") - rm(scale_x_continuous) + rm(a_scale_x_continuous) p4 <- qplot(mpg, wt, data = mtcars) expect_equal(xlabel(p4), waiver()) }) @@ -153,17 +153,17 @@ test_that("find_global searches in the right places", { testenv <- new.env(parent = globalenv()) # This should find the scale object in the package environment - expect_identical(find_global("scale_colour_hue", testenv), - ggplot2::scale_colour_hue) + expect_identical(find_global("a_scale_colour_hue", testenv), + ggplot2Animint::a_scale_colour_hue) # Set an object with the same name in the environment - testenv$scale_colour_hue <- "foo" + testenv$a_scale_colour_hue <- "foo" # Now it should return the new object - expect_identical(find_global("scale_colour_hue", testenv), "foo") + expect_identical(find_global("a_scale_colour_hue", testenv), "foo") # If we search in the empty env, we should end up with the object # from the ggplot2 namespace - expect_identical(find_global("scale_colour_hue", emptyenv()), - ggplot2::scale_colour_hue) + expect_identical(find_global("a_scale_colour_hue", emptyenv()), + ggplot2Animint::a_scale_colour_hue) }) diff --git a/tests/testthat/test-stat-bin.R b/tests/testthat/test-stat-bin.R index 395d369248..138d511925 100644 --- a/tests/testthat/test-stat-bin.R +++ b/tests/testthat/test-stat-bin.R @@ -1,35 +1,36 @@ context("stat_bin/stat_count") -test_that("stat_bin throws error when y aesthetic present", { +test_that("a_stat_bin throws error when y aesthetic present", { dat <- data.frame(x = c("a", "b", "c"), y = c(1, 5, 10)) - expect_error(ggplot_build(ggplot(dat, aes(x, y)) + stat_bin()), + expect_error(a_plot_build(a_plot(dat, a_aes(x, y)) + a_stat_bin()), "must not be used with a y aesthetic.") - expect_error(p <- ggplot_build(ggplot(dat, aes(x)) + stat_bin(y = 5)), - "Unknown parameters: y") + skip("passes when validate_params=TRUE") + expect_error(p <- a_plot_build(a_plot(dat, a_aes(x)) + a_stat_bin(y = 5)), + "StatBin requires a continuous x variable the x variable is discrete") }) test_that("bins specifies the number of bins", { df <- data.frame(x = 1:10) out <- function(x, ...) { - layer_data(ggplot(df, aes(x)) + geom_histogram(...)) + a_layer_data(a_plot(df, a_aes(x)) + a_geom_histogram(...)) } expect_equal(nrow(out(bins = 2)), 2) expect_equal(nrow(out(bins = 100)), 100) }) -test_that("geom_histogram defaults to pad = FALSE", { +test_that("a_geom_histogram defaults to pad = FALSE", { df <- data.frame(x = 1:3) - out <- layer_data(ggplot(df, aes(x)) + geom_histogram(binwidth = 1)) + out <- a_layer_data(a_plot(df, a_aes(x)) + a_geom_histogram(binwidth = 1)) expect_equal(out$count, c(1, 1, 1)) }) -test_that("geom_freqpoly defaults to pad = TRUE", { +test_that("a_geom_freqpoly defaults to pad = TRUE", { df <- data.frame(x = 1:3) - out <- layer_data(ggplot(df, aes(x)) + geom_freqpoly(binwidth = 1)) + out <- a_layer_data(a_plot(df, a_aes(x)) + a_geom_freqpoly(binwidth = 1)) expect_equal(out$count, c(0, 1, 1, 1, 0)) }) @@ -38,8 +39,8 @@ test_that("geom_freqpoly defaults to pad = TRUE", { # Underlying binning algorithm -------------------------------------------- comp_bin <- function(df, ...) { - plot <- ggplot(df, aes(x = x)) + stat_bin(...) - layer_data(plot) + plot <- a_plot(df, a_aes(x = x)) + a_stat_bin(...) + a_layer_data(plot) } test_that("Closed left or right", { @@ -85,41 +86,41 @@ test_that("Setting boundary and center", { test_that("weights are added", { df <- data.frame(x = 1:10, y = 1:10) - p <- ggplot(df, aes(x = x, weight = y)) + geom_histogram(binwidth = 1) - out <- layer_data(p) + p <- a_plot(df, a_aes(x = x, weight = y)) + a_geom_histogram(binwidth = 1) + out <- a_layer_data(p) expect_equal(out$count, df$y) }) -# stat_count -------------------------------------------------------------- +# a_stat_count -------------------------------------------------------------- -test_that("stat_count throws error when y aesthetic present", { +test_that("a_stat_count throws error when y aesthetic present", { dat <- data.frame(x = c("a", "b", "c"), y = c(1, 5, 10)) - expect_error(ggplot_build(ggplot(dat, aes(x, y)) + stat_count()), + expect_error(a_plot_build(a_plot(dat, a_aes(x, y)) + a_stat_count()), + "must not be used with a y aesthetic.") + skip("passes when validate_params=TRUE") + expect_error(p <- a_plot_build(a_plot(dat, a_aes(x)) + a_stat_count(y = 5)), "must not be used with a y aesthetic.") - - expect_error(p <- ggplot_build(ggplot(dat, aes(x)) + stat_count(y = 5)), - "Unknown parameters: y") }) -test_that("stat_count preserves x order for continuous and discrete", { +test_that("a_stat_count preserves x order for continuous and discrete", { # x is numeric - b <- ggplot_build(ggplot(mtcars, aes(carb)) + geom_bar()) + b <- a_plot_build(a_plot(mtcars, a_aes(carb)) + a_geom_bar()) expect_identical(b$data[[1]]$x, c(1,2,3,4,6,8)) expect_identical(b$data[[1]]$y, c(7,10,3,10,1,1)) # x is factor where levels match numeric order mtcars$carb2 <- factor(mtcars$carb) - b <- ggplot_build(ggplot(mtcars, aes(carb2)) + geom_bar()) + b <- a_plot_build(a_plot(mtcars, a_aes(carb2)) + a_geom_bar()) expect_identical(b$data[[1]]$x, 1:6) expect_identical(b$data[[1]]$y, c(7,10,3,10,1,1)) # x is factor levels differ from numeric order mtcars$carb3 <- factor(mtcars$carb, levels = c(4,1,2,3,6,8)) - b <- ggplot_build(ggplot(mtcars, aes(carb3)) + geom_bar()) + b <- a_plot_build(a_plot(mtcars, a_aes(carb3)) + a_geom_bar()) expect_identical(b$data[[1]]$x, 1:6) - expect_identical(b$panel$ranges[[1]]$x.labels, c("4","1","2","3","6","8")) + expect_identical(b$panel$ranges[[1]]$x.a_labels, c("4","1","2","3","6","8")) expect_identical(b$data[[1]]$y, c(10,7,10,3,1,1)) }) diff --git a/tests/testthat/test-stat-bin2d.R b/tests/testthat/test-stat-bin2d.R index c1a145329a..6069a3b650 100644 --- a/tests/testthat/test-stat-bin2d.R +++ b/tests/testthat/test-stat-bin2d.R @@ -1,12 +1,13 @@ -context("stat_bin2d") +context("a_stat_bin2d") test_that("binwidth is respected", { df <- data.frame(x = c(1, 1, 1, 2), y = c(1, 1, 1, 2)) - base <- ggplot(df, aes(x, y)) + - stat_bin2d(geom = "tile", binwidth = 0.25) + base <- a_plot(df, a_aes(x, y)) + + a_stat_bin2d(a_geom = "tile", binwidth = 0.25) - out <- layer_data(base) + out <- a_layer_data(base) expect_equal(nrow(out), 2) + # Adjust tolerance to account for fuzzy breaks adjustment expect_equal(out$xmin, c(1, 1.75), tolerance = 1e-7) expect_equal(out$xmax, c(1.25, 2), tolerance = 1e-7) @@ -19,13 +20,13 @@ test_that("breaks override binwidth", { half_breaks <- seq(0, 3.5, 0.5) # Will test against this for y df <- data.frame(x = 0:3, y = 0:3) - base <- ggplot(df, aes(x, y)) + - stat_bin2d( + base <- a_plot(df, a_aes(x, y)) + + a_stat_bin2d( breaks = list(x = integer_breaks, y = NULL), binwidth = c(0.5, 0.5) ) - out <- layer_data(base) + out <- a_layer_data(base) expect_equal(out$xbin, cut(df$x, adjust_breaks(integer_breaks), include.lowest = TRUE, labels = FALSE)) expect_equal(out$ybin, cut(df$y, adjust_breaks(half_breaks), include.lowest = TRUE, labels = FALSE)) }) diff --git a/tests/testthat/test-stat-density2d.R b/tests/testthat/test-stat-density2d.R index 2eb8b35a98..7edd8c7a92 100644 --- a/tests/testthat/test-stat-density2d.R +++ b/tests/testthat/test-stat-density2d.R @@ -1,12 +1,12 @@ -context("stat_density_2d") +context("a_stat_density_2d") test_that("uses scale limits, not data limits", { - base <- ggplot(mtcars, aes(wt, mpg)) + - stat_density_2d() + - scale_x_continuous(limits = c(1, 6)) + - scale_y_continuous(limits = c(5, 40)) + base <- a_plot(mtcars, a_aes(wt, mpg)) + + a_stat_density_2d() + + a_scale_x_continuous(limits = c(1, 6)) + + a_scale_y_continuous(limits = c(5, 40)) - ret <- layer_data(base) + ret <- a_layer_data(base) # Check that the contour data goes beyond data range. # The specific values below are sort of arbitrary; but they go beyond the range # of the data diff --git a/tests/testthat/test-stat-sum.R b/tests/testthat/test-stat-sum.R index 4150a10272..6c914e5a88 100644 --- a/tests/testthat/test-stat-sum.R +++ b/tests/testthat/test-stat-sum.R @@ -4,39 +4,39 @@ test_that("handles grouping correctly", { d <- diamonds[1:1000, ] all_ones <- function(x) all.equal(mean(x), 1) - base <- ggplot(d, aes(cut, clarity)) + base <- a_plot(d, a_aes(cut, clarity)) - ret <- layer_data(base + stat_sum()) + ret <- a_layer_data(base + a_stat_sum()) expect_equal(nrow(ret), 38) expect_equal(sum(ret$n), nrow(d)) expect_true(all_ones(ret$prop)) - ret <- layer_data(base + stat_sum(aes(group = 1))) + ret <- a_layer_data(base + a_stat_sum(a_aes(group = 1))) expect_equal(nrow(ret), 38) expect_equal(sum(ret$n), nrow(d)) expect_equal(sum(ret$prop), 1) - ret <- layer_data(base + stat_sum(aes(group = cut))) + ret <- a_layer_data(base + a_stat_sum(a_aes(group = cut))) expect_equal(nrow(ret), 38) expect_equal(sum(ret$n), nrow(d)) expect_true(all_ones(tapply(ret$prop, ret$x, FUN = sum))) - ret <- layer_data(base + stat_sum(aes(group = cut, colour = cut))) + ret <- a_layer_data(base + a_stat_sum(a_aes(group = cut, colour = cut))) expect_equal(nrow(ret), 38) expect_equal(sum(ret$n), nrow(d)) expect_true(all_ones(tapply(ret$prop, ret$x, FUN = sum))) - ret <- layer_data(base + stat_sum(aes(group = clarity))) + ret <- a_layer_data(base + a_stat_sum(a_aes(group = clarity))) expect_equal(nrow(ret), 38) expect_equal(sum(ret$n), nrow(d)) expect_true(all_ones(tapply(ret$prop, ret$y, FUN = sum))) - ret <- layer_data(base + stat_sum(aes(group = clarity, colour = cut))) + ret <- a_layer_data(base + a_stat_sum(a_aes(group = clarity, colour = cut))) expect_equal(nrow(ret), 38) expect_equal(sum(ret$n), nrow(d)) expect_true(all_ones(tapply(ret$prop, ret$y, FUN = sum))) - ret <- layer_data(base + stat_sum(aes(group = 1, weight = price))) + ret <- a_layer_data(base + a_stat_sum(a_aes(group = 1, weight = price))) expect_equal(nrow(ret), 38) expect_equal(sum(ret$n), sum(d$price)) expect_equal(sum(ret$prop), 1) diff --git a/tests/testthat/test-stats-function.r b/tests/testthat/test-stats-function.r index a97f94fb01..7206fd92cc 100644 --- a/tests/testthat/test-stats-function.r +++ b/tests/testthat/test-stats-function.r @@ -1,21 +1,21 @@ -context("stat_function") +context("a_stat_function") test_that("uses scale limits, not data limits", { dat <- data.frame(x = c(0.1, 1:100)) dat$y <- dexp(dat$x) - base <- ggplot(dat, aes(x, y)) + - stat_function(fun = dexp) + base <- a_plot(dat, a_aes(x, y)) + + a_stat_function(fun = dexp) full <- base + - scale_x_continuous(limits = c(0.1, 100)) + - scale_y_continuous() - ret <- layer_data(full) + a_scale_x_continuous(limits = c(0.1, 100)) + + a_scale_y_continuous() + ret <- a_layer_data(full) full_log <- base + - scale_x_log10(limits = c(0.1, 100)) + - scale_y_continuous() - ret_log <- layer_data(full_log) + a_scale_x_log10(limits = c(0.1, 100)) + + a_scale_y_continuous() + ret_log <- a_layer_data(full_log) expect_equal(ret$y[c(1, 101)], ret_log$y[c(1, 101)]) expect_equal(range(ret$x), c(0.1, 100)) @@ -27,9 +27,9 @@ test_that("uses scale limits, not data limits", { test_that("works with discrete x", { dat <- data.frame(x = c("a", "b")) - base <- ggplot(dat, aes(x, group = 1)) + - stat_function(fun = as.numeric, geom = "point", n = 2) - ret <- layer_data(base) + base <- a_plot(dat, a_aes(x, group = 1)) + + a_stat_function(fun = as.numeric, a_geom = "point", n = 2) + ret <- a_layer_data(base) expect_equal(ret$x, 1:2) expect_equal(ret$y, 1:2) diff --git a/tests/testthat/test-stats.r b/tests/testthat/test-stats.r index 3de4e17d9a..b162c69116 100644 --- a/tests/testthat/test-stats.r +++ b/tests/testthat/test-stats.r @@ -2,12 +2,12 @@ context("Stats") test_that("plot succeeds even if some computation fails", { df <- data.frame(x = 1:2, y = 1) - p1 <- ggplot(df, aes(x, y)) + geom_point() + p1 <- a_plot(df, a_aes(x, y)) + a_geom_point() - b1 <- ggplot_build(p1) + b1 <- a_plot_build(p1) expect_equal(length(b1$data), 1) - p2 <- p1 + geom_smooth() - expect_warning(b2 <- ggplot_build(p2), "Computation failed") + p2 <- p1 + a_geom_smooth() + expect_warning(b2 <- a_plot_build(p2), "Computation failed") expect_equal(length(b2$data), 2) }) diff --git a/tests/testthat/test-theme.r b/tests/testthat/test-theme.r index e3aac629c8..cc9997157d 100644 --- a/tests/testthat/test-theme.r +++ b/tests/testthat/test-theme.r @@ -1,87 +1,87 @@ -context("Themes") +context("a_themes") -test_that("Modifying theme element properties with + operator", { +test_that("Modifying a_theme element properties with + operator", { # Changing a "leaf node" works - t <- theme_grey() + theme(axis.title.x = element_text(colour = 'red', margin = margin())) - expect_identical(t$axis.title.x, element_text(colour = 'red', margin = margin())) - # Make sure the theme class didn't change or get dropped - expect_true(is.theme(t)) + t <- a_theme_grey() + a_theme(axis.title.x = a_element_text(colour = 'red', margin = margin())) + expect_identical(t$axis.title.x, a_element_text(colour = 'red', margin = margin())) + # Make sure the a_theme class didn't change or get dropped + expect_true(is.a_theme(t)) # Make sure the element class didn't change or get dropped - expect_true(inherits(t$axis.title.x, "element")) - expect_true(inherits(t$axis.title.x, "element_text")) + expect_true(inherits(t$axis.title.x, "a_element")) + expect_true(inherits(t$axis.title.x, "a_element_text")) # Modifying an intermediate node works - t <- theme_grey() + theme(axis.title = element_text(colour = 'red')) - expect_identical(t$axis.title, element_text(colour = 'red')) + t <- a_theme_grey() + a_theme(axis.title = a_element_text(colour = 'red')) + expect_identical(t$axis.title, a_element_text(colour = 'red')) # Modifying a root node changes only the specified properties - t <- theme_grey() + theme(text = element_text(colour = 'red')) + t <- a_theme_grey() + a_theme(text = a_element_text(colour = 'red')) expect_identical(t$text$colour, 'red') - expect_identical(t$text$family, theme_grey()$text$family) - expect_identical(t$text$face, theme_grey()$text$face) - expect_identical(t$text$size, theme_grey()$text$size) + expect_identical(t$text$family, a_theme_grey()$text$family) + expect_identical(t$text$face, a_theme_grey()$text$face) + expect_identical(t$text$size, a_theme_grey()$text$size) # Descendent is unchanged - expect_identical(t$axis.title.x, theme_grey()$axis.title.x) + expect_identical(t$axis.title.x, a_theme_grey()$axis.title.x) - # Adding element_blank replaces element - t <- theme_grey() + theme(axis.text.y = element_blank()) - expect_identical(t$axis.text.y, element_blank()) + # Adding a_element_blank replaces a_element + t <- a_theme_grey() + a_theme(axis.text.y = a_element_blank()) + expect_identical(t$axis.text.y, a_element_blank()) - # Adding a non-blank element to an element_blank() replaces it - t <- t + theme(axis.text.y = element_text(colour = 'red')) - expect_identical(t$axis.text.y, element_text(colour = 'red')) + # Adding a non-blank element to an a_element_blank() replaces it + t <- t + a_theme(axis.text.y = a_element_text(colour = 'red')) + expect_identical(t$axis.text.y, a_element_text(colour = 'red')) - # Adding empty theme() has no effect - t <- theme_grey() + theme() - expect_identical(t, theme_grey()) + # Adding empty a_theme() has no effect + t <- a_theme_grey() + a_theme() + expect_identical(t, a_theme_grey()) - expect_error(theme_grey() + "asdf") + expect_error(a_theme_grey() + "asdf") }) -test_that("Adding theme object to ggplot object with + operator", { +test_that("Adding a_theme object to ggplot object with + operator", { p <- qplot(1:3, 1:3) - p <- p + theme(axis.title = element_text(size = 20)) - expect_true(p$theme$axis.title$size == 20) + p <- p + a_theme(axis.title = a_element_text(size = 20)) + expect_true(p$a_theme$axis.title$size == 20) # Should update specified properties, but not reset other properties - p <- p + theme(text = element_text(colour = 'red')) - expect_true(p$theme$text$colour == 'red') - tt <- theme_grey()$text + p <- p + a_theme(text = a_element_text(colour = 'red')) + expect_true(p$a_theme$text$colour == 'red') + tt <- a_theme_grey()$text tt$colour <- 'red' - expect_identical(p$theme$text, tt) + expect_identical(p$a_theme$text, tt) }) -test_that("Replacing theme elements with %+replace% operator", { +test_that("Replacing a_theme elements with %+replace% operator", { # Changing a "leaf node" works - t <- theme_grey() %+replace% theme(axis.title.x = element_text(colour = 'red')) - expect_identical(t$axis.title.x, element_text(colour = 'red')) + t <- a_theme_grey() %+replace% a_theme(axis.title.x = a_element_text(colour = 'red')) + expect_identical(t$axis.title.x, a_element_text(colour = 'red')) # Make sure the class didn't change or get dropped - expect_true(is.theme(t)) + expect_true(is.a_theme(t)) # Changing an intermediate node works - t <- theme_grey() %+replace% theme(axis.title = element_text(colour = 'red')) - expect_identical(t$axis.title, element_text(colour = 'red')) + t <- a_theme_grey() %+replace% a_theme(axis.title = a_element_text(colour = 'red')) + expect_identical(t$axis.title, a_element_text(colour = 'red')) # Descendent is unchanged - expect_identical(t$axis.title.x, theme_grey()$axis.title.x) + expect_identical(t$axis.title.x, a_theme_grey()$axis.title.x) - # Adding empty theme() has no effect - t <- theme_grey() %+replace% theme() - expect_identical(t, theme_grey()) + # Adding empty a_theme() has no effect + t <- a_theme_grey() %+replace% a_theme() + expect_identical(t, a_theme_grey()) - expect_error(theme_grey() + "asdf") + expect_error(a_theme_grey() + "asdf") }) -test_that("Calculating theme element inheritance", { - t <- theme_grey() + theme(axis.title = element_text(colour = 'red')) +test_that("Calculating a_theme element inheritance", { + t <- a_theme_grey() + a_theme(axis.title = a_element_text(colour = 'red')) # Check that properties are passed along from axis.title to axis.title.x - e <- calc_element('axis.title.x', t) + e <- a_calc_element('axis.title.x', t) expect_identical(e$colour, 'red') expect_false(is.null(e$family)) expect_false(is.null(e$face)) @@ -89,102 +89,102 @@ test_that("Calculating theme element inheritance", { # Check that rel() works for relative sizing, and is applied at each level - t <- theme_grey(base_size = 12) + - theme(axis.title = element_text(size = rel(0.5))) + - theme(axis.title.x = element_text(size = rel(0.5))) - e <- calc_element('axis.title', t) + t <- a_theme_grey(base_size = 12) + + a_theme(axis.title = a_element_text(size = rel(0.5))) + + a_theme(axis.title.x = a_element_text(size = rel(0.5))) + e <- a_calc_element('axis.title', t) expect_identical(e$size, 6) - ex <- calc_element('axis.title.x', t) + ex <- a_calc_element('axis.title.x', t) expect_identical(ex$size, 3) - # Check that a theme_blank in a parent node gets passed along to children - t <- theme_grey() + theme(text = element_blank()) - expect_identical(calc_element('axis.title.x', t), element_blank()) + # Check that a a_theme_blank in a parent node gets passed along to children + t <- a_theme_grey() + a_theme(text = a_element_blank()) + expect_identical(a_calc_element('axis.title.x', t), a_element_blank()) }) -test_that("Complete and non-complete themes interact correctly with each other", { +test_that("Complete and non-complete a_themes interact correctly with each other", { # The 'complete' attribute of t1 + t2 is the OR of their 'complete' attributes. # But for _element properties_, the one on the right modifies the one on the left. - t <- theme_bw() + theme(text = element_text(colour = 'red')) + t <- a_theme_bw() + a_theme(text = a_element_text(colour = 'red')) expect_true(attr(t, "complete")) expect_equal(t$text$colour, 'red') - # A complete theme object (like theme_bw) always trumps a non-complete theme object - t <- theme(text = element_text(colour = 'red')) + theme_bw() + # A complete a_theme object (like a_theme_bw) always trumps a non-complete a_theme object + t <- a_theme(text = a_element_text(colour = 'red')) + a_theme_bw() expect_true(attr(t, "complete")) - expect_equal(t$text$colour, theme_bw()$text$colour) + expect_equal(t$text$colour, a_theme_bw()$text$colour) - # Adding two non-complete themes: the one on the right modifies the one on the left. - t <- theme(text = element_text(colour = 'blue')) + - theme(text = element_text(colour = 'red')) + # Adding two non-complete a_themes: the one on the right modifies the one on the left. + t <- a_theme(text = a_element_text(colour = 'blue')) + + a_theme(text = a_element_text(colour = 'red')) expect_false(attr(t, "complete")) expect_equal(t$text$colour, 'red') }) -test_that("Complete and non-complete themes interact correctly with ggplot objects", { - # Check that adding two theme successive theme objects to a ggplot object - # works like adding the two theme object to each other - p <- ggplot_build(qplot(1:3, 1:3) + theme_bw() + theme(text = element_text(colour = 'red'))) - expect_true(attr(p$plot$theme, "complete")) +test_that("Complete and non-complete a_themes interact correctly with ggplot objects", { + # Check that adding two a_theme successive a_theme objects to a ggplot object + # works like adding the two a_theme object to each other + p <- a_plot_build(qplot(1:3, 1:3) + a_theme_bw() + a_theme(text = a_element_text(colour = 'red'))) + expect_true(attr(p$plot$a_theme, "complete")) - # Compare the theme objects, after sorting the items, because item order can differ - pt <- p$plot$theme - tt <- theme_bw() + theme(text = element_text(colour = 'red')) + # Compare the a_theme objects, after sorting the items, because item order can differ + pt <- p$plot$a_theme + tt <- a_theme_bw() + a_theme(text = a_element_text(colour = 'red')) pt <- pt[order(names(pt))] tt <- tt[order(names(tt))] expect_identical(pt, tt) - p <- ggplot_build(qplot(1:3, 1:3) + theme(text = element_text(colour = 'red')) + theme_bw()) - expect_true(attr(p$plot$theme, "complete")) - # Compare the theme objects, after sorting the items, because item order can differ - pt <- p$plot$theme - tt <- theme(text = element_text(colour = 'red')) + theme_bw() + p <- a_plot_build(qplot(1:3, 1:3) + a_theme(text = a_element_text(colour = 'red')) + a_theme_bw()) + expect_true(attr(p$plot$a_theme, "complete")) + # Compare the a_theme objects, after sorting the items, because item order can differ + pt <- p$plot$a_theme + tt <- a_theme(text = a_element_text(colour = 'red')) + a_theme_bw() pt <- pt[order(names(pt))] tt <- tt[order(names(tt))] expect_identical(pt, tt) - p <- ggplot_build(qplot(1:3, 1:3) + theme(text = element_text(colour = 'red', face = 'italic'))) - expect_false(attr(p$plot$theme, "complete")) - expect_equal(p$plot$theme$text$colour, "red") - expect_equal(p$plot$theme$text$face, "italic") + p <- a_plot_build(qplot(1:3, 1:3) + a_theme(text = a_element_text(colour = 'red', face = 'italic'))) + expect_false(attr(p$plot$a_theme, "complete")) + expect_equal(p$plot$a_theme$text$colour, "red") + expect_equal(p$plot$a_theme$text$face, "italic") - p <- ggplot_build(qplot(1:3, 1:3) + - theme(text = element_text(colour = 'red')) + - theme(text = element_text(face = 'italic'))) - expect_false(attr(p$plot$theme, "complete")) - expect_equal(p$plot$theme$text$colour, "red") - expect_equal(p$plot$theme$text$face, "italic") + p <- a_plot_build(qplot(1:3, 1:3) + + a_theme(text = a_element_text(colour = 'red')) + + a_theme(text = a_element_text(face = 'italic'))) + expect_false(attr(p$plot$a_theme, "complete")) + expect_equal(p$plot$a_theme$text$colour, "red") + expect_equal(p$plot$a_theme$text$face, "italic") # Only gets red property; because of the way lists are processed in R, the # the second item doesn't get used properly. But I think that's OK. - p <- ggplot_build(qplot(1:3, 1:3) + - theme(text = element_text(colour = 'red'), text = element_text(face = 'italic'))) - expect_false(attr(p$plot$theme, "complete")) - expect_equal(p$plot$theme$text$colour, "red") - expect_equal(p$plot$theme$text$face, "plain") + p <- a_plot_build(qplot(1:3, 1:3) + + a_theme(text = a_element_text(colour = 'red'), text = a_element_text(face = 'italic'))) + expect_false(attr(p$plot$a_theme, "complete")) + expect_equal(p$plot$a_theme$text$colour, "red") + expect_equal(p$plot$a_theme$text$face, "plain") }) -test_that("theme(validate=FALSE) means do not validate_element", { +test_that("a_theme(validate=FALSE) means do not validate_element", { p <- qplot(1:3, 1:3) - bw <- p + theme_bw() - red.text <- theme(text = element_text(colour = "red")) - bw.before <- bw + theme(animint.width = 500, validate = FALSE) - expect_equal(bw.before$theme$animint.width, 500) + bw <- p + a_theme_bw() + red.text <- a_theme(text = a_element_text(colour = "red")) + bw.before <- bw + a_theme(animint.width = 500, validate = FALSE) + expect_equal(bw.before$a_theme$animint.width, 500) - bw.after <- p + theme(animint.width = 500, validate = FALSE) + theme_bw() - expect_null(bw.after$theme$animint.width) + bw.after <- p + a_theme(animint.width = 500, validate = FALSE) + a_theme_bw() + expect_null(bw.after$a_theme$animint.width) - red.after <- p + theme(animint.width = 500, validate = FALSE) + red.text - expect_equal(red.after$theme$animint.width, 500) + red.after <- p + a_theme(animint.width = 500, validate = FALSE) + red.text + expect_equal(red.after$a_theme$animint.width, 500) - red.before <- p + red.text + theme(animint.width = 500, validate = FALSE) - expect_equal(red.before$theme$animint.width, 500) + red.before <- p + red.text + a_theme(animint.width = 500, validate = FALSE) + expect_equal(red.before$a_theme$animint.width, 500) }) diff --git a/vignettes/extending-ggplot2.Rmd b/vignettes/extending-ggplot2.Rmd index 921c095725..68778ef9f0 100644 --- a/vignettes/extending-ggplot2.Rmd +++ b/vignettes/extending-ggplot2.Rmd @@ -1,24 +1,34 @@ --- -title: "Extending ggplot2" +title: "Extending ggplot2Animint" author: "Hadley Wickham" +maintainer: "Faizan Khan" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > - %\VignetteIndexEntry{Extending ggplot2} + %\VignetteIndexEntry{Extending ggplot2Animint} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") -library(ggplot2) +library(ggplot2Animint) ``` -This vignette documents the official extension mechanism provided in ggplot2 2.0.0. This vignette is a high-level adjunct to the low-level details found in `?Stat`, `?Geom` and `?theme`. You'll learn how to extend ggplot2 by creating a new stat, geom, or theme. + +## Important Note + +ggplot2Animint is the customized version of ggplot2 which passes the static plots generated by it for rendering. It is [animint2](https://github.com/tdhock/animint2) specific version of ggplot2. It has been done so to avoid WARNINGS from constant changes in new version of ggplot2 as animint2 earlier depend on it and also to avoid error from functions that are non-specific to animint code base. + +ggplot2Animint also drops major dependency packages that can be directly imported to animint2. + +This vignette documents the official extension mechanism provided in ggplot2Animint 2.0.0. This vignette is a high-level adjunct to the low-level details found in `?a_Stat`, `?a_Geom` and `?a_theme`. You'll learn how to extend ggplot2 by creating a new stat, geom, or theme. As you read this document, you'll see many things that will make you scratch your head and wonder why on earth is it designed this way? Mostly it's historical accident - I wasn't a terribly good R programmer when I started writing ggplot2 and I made a lot of questionable decisions. We cleaned up as many of those issues as possible in the 2.0.0 release, but some fixes simply weren't worth the effort. -## ggproto +If you are planning to make your own package, make sure you should understand the difference between ```ggplot2``` and ```ggplot2Animint```. + +## a_ggproto All ggplot2 objects are built using the ggproto system of object oriented programming. This OO system is used only in one place: ggplot2. This is mostly historical accident: ggplot2 started off using [proto]( https://cran.r-project.org/package=proto) because I needed mutable objects. This was well before the creation of (the briefly lived) [mutatr](http://vita.had.co.nz/papers/mutatr.html), reference classes and R6: proto was the only game in town. @@ -26,10 +36,12 @@ But why ggproto? Well when we turned to add an official extension mechanism to g It's strange to say, but this is a case where inventing a new OO system was actually the right answer to the problem! Fortunately Winston is now very good at creating OO systems, so it only took him a day to come up with ggproto: it maintains all the features of proto that ggplot2 needs, while allowing cross package inheritance to work. +Recent changes in ggproto feature on inheriting class, we have introduced `super` as new function, which can used as argument in other object oriented functions that requires inheritence class, this has been done to make it compatable with other ggplot2 extension packages and base packages, more specifically in ```a_scale_colour_identity```,```a_scale_fill_identity```, ```a_scale_line_idenitity```, ```a_scale_x_discrete```, ```a_scale_y_discrete```, ```a_scale_datetime``` and other a_scale-related functions. + Here's a quick demo of ggproto in action: ```{r ggproto-intro} -A <- ggproto("A", NULL, +A <- a_ggproto("A", NULL, x = 1, inc = function(self) { self$x <- self$x + 1 @@ -45,16 +57,16 @@ A$x The majority of ggplot2 classes are immutable and static: the methods neither use nor modify state in the class. They're mostly used as a convenient way of bundling related methods together. -To create a new geom or stat, you will just create a new ggproto that inherits from `Stat`, `Geom` and override the methods described below. +To create a new geom or stat, you will just create a new ggproto that inherits from `a_Stat`, `a_Geom` and override the methods described below. -## Creating a new stat +## Creating a new a_stat -### The simplest stat +### The simplest a_stat -We'll start by creating a very simple stat: one that gives the convex hull (the _c_ hull) of a set of points. First we create a new ggproto object that inherits from `Stat`: +We'll start by creating a very simple a_stat: one that gives the convex hull (the _c_ hull) of a set of points. First we create a new ggproto object that inherits from `a_Stat`: ```{r chull} -StatChull <- ggproto("StatChull", Stat, +a_StatChull <- a_ggproto("a_StatChull", a_Stat, compute_group = function(data, scales) { data[chull(data$x, data$y), , drop = FALSE] }, @@ -63,58 +75,58 @@ StatChull <- ggproto("StatChull", Stat, ) ``` -The two most important components are the `compute_group()` method (which does the computation), and the `required_aes` field, which lists which aesthetics must be present in order to for the stat to work. +The two most important components are the `compute_group()` method (which does the computation), and the `required_aes` field, which lists which aesthetics must be present in order to for the a_stat to work. -Next we write a layer function. Unfortunately, due to an early design mistake I called these either `stat_()` or `geom_()`. A better decision would have been to call them `layer_()` functions: that's a more accurate description because every layer involves a stat _and_ a geom. +Next we write a layer function. Unfortunately, due to an early design mistake I called these either `a_stat_()` or `a_geom_()`. A better decision would have been to call them `a_layer_()` functions: that's a more accurate description because every layer involves a a_stat _and_ a a_geom. -All layer functions follow the same form - you specify defaults in the function arguments and then call the `layer()` function, sending `...` into the `params` argument. The arguments in `...` will either be arguments for the geom (if you're making a stat wrapper), arguments for the stat (if you're making a geom wrapper), or aesthetics to be set. `layer()` takes care of teasing the different parameters apart and making sure they're stored in the right place: +All layer functions follow the same form - you specify defaults in the function arguments and then call the `a_layer()` function, sending `...` into the `params` argument. The arguments in `...` will either be arguments for the a_geom (if you're making a stat wrapper), arguments for the stat (if you're making a a_geom wrapper), or a_aesthetics to be set. `a_layer()` takes care of teasing the different parameters apart and making sure they're stored in the right place: ```{r} -stat_chull <- function(mapping = NULL, data = NULL, geom = "polygon", - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) { - layer( - stat = StatChull, data = data, mapping = mapping, geom = geom, - position = position, show.legend = show.legend, inherit.aes = inherit.aes, +a_stat_chull <- function(mapping = NULL, data = NULL, a_geom = "polygon", + a_position = "identity", na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE, ...) { + a_layer( + a_stat = a_StatChull, data = data, mapping = mapping, a_geom = a_geom, + a_position = a_position, show.legend = show.legend, inherit.a_aes = inherit.a_aes, params = list(na.rm = na.rm, ...) ) } ``` -(Note that if you're writing this in your own package, you'll either need to call `ggplot2::layer()` explicitly, or import the `layer()` function into your package namespace.) +(Note that if you're writing this in your own package, you'll either need to call `ggplot2Animint::a_layer()` explicitly, or import the `a_layer()` function into your package namespace.) -Once we have a layer function we can try our new stat: +Once we have a a_layer function we can try our new stat: ```{r} -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - stat_chull(fill = NA, colour = "black") +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_stat_chull(fill = NA, colour = "black") ``` -(We'll see later how to change the defaults of the geom so that you don't need to specify `fill = NA` every time.) +(We'll see later how to change the defaults of the a_geom so that you don't need to specify `fill = NA` every time.) -Once we've written this basic object, ggplot2 gives a lot for free. For example, ggplot2 automatically preserves aesthetics that are constant within each group: +Once we've written this basic object, ggplot2 gives a lot for free. For example, ggplot2 automatically preserves a_aesthetics that are constant within each group: ```{r} -ggplot(mpg, aes(displ, hwy, colour = drv)) + - geom_point() + - stat_chull(fill = NA) +a_plot(mpg, a_aes(displ, hwy, colour = drv)) + + a_geom_point() + + a_stat_chull(fill = NA) ``` -We can also override the default geom to display the convex hull in a different way: +We can also override the default a_geom to display the convex hull in a different way: ```{r} -ggplot(mpg, aes(displ, hwy)) + - stat_chull(geom = "point", size = 4, colour = "red") + - geom_point() +a_plot(mpg, a_aes(displ, hwy)) + + a_stat_chull(a_geom = "point", size = 4, colour = "red") + + a_geom_point() ``` ### Stat parameters -A more complex stat will do some computation. Let's implement a simple version of `geom_smooth()` that adds a line of best fit to a plot. We create a `StatLm` that inherits from `Stat` and a layer function, `stat_lm()`: +A more complex stat will do some computation. Let's implement a simple version of `a_geom_smooth()` that adds a line of best fit to a plot. We create a `a_StatLm` that inherits from `a_Stat` and a a_layer function, `a_stat_lm()`: ```{r} -StatLm <- ggproto("StatLm", Stat, +a_StatLm <- a_ggproto("a_StatLm", a_Stat, required_aes = c("x", "y"), compute_group = function(data, scales) { @@ -128,25 +140,25 @@ StatLm <- ggproto("StatLm", Stat, } ) -stat_lm <- function(mapping = NULL, data = NULL, geom = "line", - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) { - layer( - stat = StatLm, data = data, mapping = mapping, geom = geom, - position = position, show.legend = show.legend, inherit.aes = inherit.aes, +a_stat_lm <- function(mapping = NULL, data = NULL, a_geom = "line", + a_position = "identity", na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE, ...) { + a_layer( + a_stat = a_StatLm, data = data, mapping = mapping, a_geom = a_geom, + a_position = a_position, show.legend = show.legend, inherit.a_aes = inherit.a_aes, params = list(na.rm = na.rm, ...) ) } -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - stat_lm() +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_stat_lm() ``` -`StatLm` is inflexible because it has no parameters. We might want to allow the user to control the model formula and the number of points used to generate the grid. To do so, we add arguments to the `compute_group()` method and our wrapper function: +`a_StatLm` is inflexible because it has no parameters. We might want to allow the user to control the model formula and the number of points used to generate the grid. To do so, we add arguments to the `compute_group()` method and our wrapper function: ```{r} -StatLm <- ggproto("StatLm", Stat, +a_StatLm <- a_ggproto("a_StatLm", a_Stat, required_aes = c("x", "y"), compute_group = function(data, scales, params, n = 100, formula = y ~ x) { @@ -160,37 +172,37 @@ StatLm <- ggproto("StatLm", Stat, } ) -stat_lm <- function(mapping = NULL, data = NULL, geom = "line", - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, n = 50, formula = y ~ x, +a_stat_lm <- function(mapping = NULL, data = NULL, a_geom = "line", + a_position = "identity", na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE, n = 50, formula = y ~ x, ...) { - layer( - stat = StatLm, data = data, mapping = mapping, geom = geom, - position = position, show.legend = show.legend, inherit.aes = inherit.aes, + a_layer( + a_stat = a_StatLm, data = data, mapping = mapping, a_geom = a_geom, + a_position = a_position, show.legend = show.legend, inherit.a_aes = inherit.a_aes, params = list(n = n, formula = formula, na.rm = na.rm, ...) ) } -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - stat_lm(formula = y ~ poly(x, 10)) + - stat_lm(formula = y ~ poly(x, 10), geom = "point", colour = "red", n = 20) +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_stat_lm(formula = y ~ poly(x, 10)) + + a_stat_lm(formula = y ~ poly(x, 10), a_geom = "point", colour = "red", n = 20) ``` -Note that we don't _have_ to explicitly include the new parameters in the arguments for the layer, `...` will get passed to the right place anyway. But you'll need to document them somewhere so the user knows about them. Here's a brief example. Note `@inheritParams ggplot2::stat_identity`: that will automatically inherit documentation for all the parameters also defined for `stat_identity()`. +Note that we don't _have_ to explicitly include the new parameters in the arguments for the a_layer, `...` will get passed to the right place anyway. But you'll need to document them somewhere so the user knows about them. Here's a brief example. Note `@inheritParams ggplot2Animint::a_stat_identity`: that will automatically inherit documentation for all the parameters also defined for `a_stat_identity()`. ```{r} -#' @inheritParams ggplot2::stat_identity +#' @inheritParams ggplot2Animint::a_stat_identity #' @param formula The modelling formula passed to \code{lm}. Should only #' involve \code{y} and \code{x} #' @param n Number of points used for interpolation. -stat_lm <- function(mapping = NULL, data = NULL, geom = "line", - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, n = 50, formula = y ~ x, +a_stat_lm <- function(mapping = NULL, data = NULL, a_geom = "line", + a_position = "identity", na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE, n = 50, formula = y ~ x, ...) { - layer( - stat = StatLm, data = data, mapping = mapping, geom = geom, - position = position, show.legend = show.legend, inherit.aes = inherit.aes, + a_layer( + a_stat = a_StatLm, data = data, mapping = mapping, a_geom = a_geom, + a_position = a_position, show.legend = show.legend, inherit.a_aes = inherit.a_aes, params = list(n = n, formula = formula, na.rm = na.rm, ...) ) } @@ -199,12 +211,12 @@ stat_lm <- function(mapping = NULL, data = NULL, geom = "line", ### Picking defaults -Sometimes you have calculations that should be performed once for the complete dataset, not once for each group. This is useful for picking sensible default values. For example, if we want to do a density estimate, it's reasonable to pick one bandwidth for the whole plot. The following Stat creates a variation of the `stat_density()` that picks one bandwidth for all groups by choosing the mean of the "best" bandwidth for each group (I have no theoretical justification for this, but it doesn't seem unreasonable). +Sometimes you have calculations that should be performed once for the complete dataset, not once for each group. This is useful for picking sensible default values. For example, if we want to do a density estimate, it's reasonable to pick one bandwidth for the whole plot. The following Stat creates a variation of the `a_stat_density()` that picks one bandwidth for all groups by choosing the mean of the "best" bandwidth for each group (I have no theoretical justification for this, but it doesn't seem unreasonable). To do this we override the `setup_params()` method. It's passed the data and a list of params, and returns an updated list. ```{r} -StatDensityCommon <- ggproto("StatDensityCommon", Stat, +a_StatDensityCommon <- a_ggproto("a_StatDensityCommon", a_Stat, required_aes = "x", setup_params = function(data, params) { @@ -226,34 +238,34 @@ StatDensityCommon <- ggproto("StatDensityCommon", Stat, } ) -stat_density_common <- function(mapping = NULL, data = NULL, geom = "line", - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, bandwidth = NULL, +a_stat_density_common <- function(mapping = NULL, data = NULL, a_geom = "line", + a_position = "identity", na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE, bandwidth = NULL, ...) { - layer( - stat = StatDensityCommon, data = data, mapping = mapping, geom = geom, - position = position, show.legend = show.legend, inherit.aes = inherit.aes, + a_layer( + a_stat = a_StatDensityCommon, data = data, mapping = mapping, a_geom = a_geom, + a_position = a_position, show.legend = show.legend, inherit.a_aes = inherit.a_aes, params = list(bandwidth = bandwidth, na.rm = na.rm, ...) ) } -ggplot(mpg, aes(displ, colour = drv)) + - stat_density_common() +a_plot(mpg, a_aes(displ, colour = drv)) + + a_stat_density_common() -ggplot(mpg, aes(displ, colour = drv)) + - stat_density_common(bandwidth = 0.5) +a_plot(mpg, a_aes(displ, colour = drv)) + + a_stat_density_common(bandwidth = 0.5) ``` I recommend using `NULL` as a default value. If you pick important parameters automatically, it's a good idea to `message()` to the user (and when printing a floating point parameter, using `signif()` to show only a few significant digits). ### Variable names and default aesthetics -This stat illustrates another important point. If we want to make this stat usable with other geoms, we should return a variable called `density` instead of `y`. Then we can set up the `default_aes` to automatically map `density` to `y`, which allows the user to override it to use with different geoms: +This a_stat illustrates another important point. If we want to make this stat usable with other geoms, we should return a variable called `density` instead of `y`. Then we can set up the `default_aes` to automatically map `density` to `y`, which allows the user to override it to use with different geoms: ```{r} -StatDensityCommon <- ggproto("StatDensity2", Stat, +a_StatDensityCommon <- a_ggproto("a_StatDensity2", a_Stat, required_aes = "x", - default_aes = aes(y = ..density..), + default_aes = a_aes(y = ..density..), compute_group = function(data, scales, bandwidth = 1) { d <- density(data$x, bw = bandwidth) @@ -261,23 +273,23 @@ StatDensityCommon <- ggproto("StatDensity2", Stat, } ) -ggplot(mpg, aes(displ, drv, colour = ..density..)) + - stat_density_common(bandwidth = 1, geom = "point") +a_plot(mpg, a_aes(displ, drv, colour = ..density..)) + + a_stat_density_common(bandwidth = 1, a_geom = "point") ``` -However, using this stat with the area geom doesn't work quite right. The areas don't stack on top of each other: +However, using this stat with the area a_geom doesn't work quite right. The areas don't stack on top of each other: ```{r} -ggplot(mpg, aes(displ, fill = drv)) + - stat_density_common(bandwidth = 1, geom = "area", position = "stack") +a_plot(mpg, a_aes(displ, fill = drv)) + + a_stat_density_common(bandwidth = 1, a_geom = "area", a_position = "stack") ``` This is because each density is computed independently, and the estimated `x`s don't line up. We can resolve that issue by computing the range of the data once in `setup_params()`. ```{r} -StatDensityCommon <- ggproto("StatDensityCommon", Stat, +a_StatDensityCommon <- a_ggproto("a_StatDensityCommon", a_Stat, required_aes = "x", - default_aes = aes(y = ..density..), + default_aes = a_aes(y = ..density..), setup_params = function(data, params) { min <- min(data$x) - 3 * params$bandwidth @@ -297,41 +309,41 @@ StatDensityCommon <- ggproto("StatDensityCommon", Stat, } ) -ggplot(mpg, aes(displ, fill = drv)) + - stat_density_common(bandwidth = 1, geom = "area", position = "stack") -ggplot(mpg, aes(displ, drv, fill = ..density..)) + - stat_density_common(bandwidth = 1, geom = "raster") +a_plot(mpg, a_aes(displ, fill = drv)) + + a_stat_density_common(bandwidth = 1, a_geom = "area", a_position = "stack") +a_plot(mpg, a_aes(displ, drv, fill = ..density..)) + + a_stat_density_common(bandwidth = 1, a_geom = "raster") ``` ### Exercises -1. Extend `stat_chull` to compute the alpha hull, as from the +1. Extend `a_stat_chull` to compute the alpha hull, as from the [alphahull](https://cran.r-project.org/package=alphahull) package. Your new stat should take an `alpha` argument. -1. Modify the final version of `StatDensityCommon` to allow the user to +1. Modify the final version of `a_StatDensityCommon` to allow the user to specify the `min` and `max` parameters. You'll need to modify both the layer function and the `compute_group()` method. -1. Compare and contrast `StatLm` to `ggplot2::StatSmooth`. What key - differences make `StatSmooth` more complex than `StatLm`? +1. Compare and contrast `a_StatLm` to `ggplot2Animint::a_StatSmooth`. What key + differences make `a_StatSmooth` more complex than `a_StatLm`? -## Creating a new geom +## Creating a new a_geom -It's harder to create a new geom than a new stat because you also need to know some grid. ggplot2 is built on top of grid, so you'll need to know the basics of drawing with grid. If you're serious about adding a new geom, I'd recommend buying [R graphics](http://amzn.com/B00I60M26G) by Paul Murrell. It tells you everything you need to know about drawing with grid. +It's harder to create a new a_geom than a new stat because you also need to know some grid. ggplot2 is built on top of grid, so you'll need to know the basics of drawing with grid. If you're serious about adding a new a_geom, I'd recommend buying [R graphics](http://amzn.com/B00I60M26G) by Paul Murrell. It tells you everything you need to know about drawing with grid. -### A simple geom +### A simple a_geom -It's easiest to start with a simple example. The code below is a simplified version of `geom_point()`: +It's easiest to start with a simple example. The code below is a simplified version of `a_geom_point()`: ```{r GeomSimplePoint} -GeomSimplePoint <- ggproto("GeomSimplePoint", Geom, +a_GeomSimplePoint <- a_ggproto("a_GeomSimplePoint", a_Geom, required_aes = c("x", "y"), - default_aes = aes(shape = 19, colour = "black"), - draw_key = draw_key_point, + default_aes = a_aes(shape = 19, colour = "black"), + draw_key = ggplot2Animint:::a_draw_key_point, - draw_panel = function(data, panel_scales, coord) { - coords <- coord$transform(data, panel_scales) + draw_panel = function(data, panel_scales, a_coord) { + coords <- a_coord$transform(data, panel_scales) grid::pointsGrob( coords$x, coords$y, pch = coords$shape, @@ -340,18 +352,18 @@ GeomSimplePoint <- ggproto("GeomSimplePoint", Geom, } ) -geom_simple_point <- function(mapping = NULL, data = NULL, stat = "identity", - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) { - layer( - geom = GeomSimplePoint, mapping = mapping, data = data, stat = stat, - position = position, show.legend = show.legend, inherit.aes = inherit.aes, +a_geom_simple_point <- function(mapping = NULL, data = NULL, a_stat = "identity", + a_position = "identity", na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE, ...) { + a_layer( + a_geom = a_GeomSimplePoint, mapping = mapping, data = data, a_stat = a_stat, + a_position = a_position, show.legend = show.legend, inherit.a_aes = inherit.a_aes, params = list(na.rm = na.rm, ...) ) } -ggplot(mpg, aes(displ, hwy)) + - geom_simple_point() +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_simple_point() ``` This is very similar to defining a new stat. You always need to provide fields/methods for the four pieces shown above: @@ -375,32 +387,32 @@ This is very similar to defining a new stat. You always need to provide fields/m * `panel_scales`: a list containing information about the x and y scales for the current panel. -* `coord`: an object describing the coordinate system. +* `a_coord`: an object describing the coordinate system. -Generally you won't use `panel_scales` and `coord` directly, but you will always use them to transform the data: `coords <- coord$transform(data, panel_scales)`. This creates a data frame where position variables are scaled to the range 0--1. You then take this data and call a grid grob function. (Transforming for non-Cartesian coordinate systems is quite complex - you're best of transforming your data to the form accepted by an existing ggplot2 geom and passing it.) +Generally you won't use `panel_scales` and `a_coord` directly, but you will always use them to transform the data: `coords <- a_coord$transform(data, panel_scales)`. This creates a data frame where position variables are scaled to the range 0--1. You then take this data and call a grid grob function. (Transforming for non-Cartesian coordinate systems is quite complex - you're best of transforming your data to the form accepted by an existing ggplot2 geom and passing it.) ### Collective geoms Overriding `draw_panel()` is most appropriate if there is one graphic element per row. In other cases, you want graphic element per group. For example, take polygons: each row gives one vertex of a polygon. In this case, you should instead override `draw_group()`: -The following code makes a simplified version of `GeomPolygon`: +The following code makes a simplified version of `a_GeomPolygon`: ```{r} -GeomSimplePolygon <- ggproto("GeomPolygon", Geom, +a_GeomSimplePolygon <- a_ggproto("a_GeomPolygon", a_Geom, required_aes = c("x", "y"), - default_aes = aes( + default_aes = a_aes( colour = NA, fill = "grey20", size = 0.5, linetype = 1, alpha = 1 ), - draw_key = draw_key_polygon, + draw_key = ggplot2Animint:::a_draw_key_polygon, - draw_group = function(data, panel_scales, coord) { + draw_group = function(data, panel_scales, a_coord) { n <- nrow(data) if (n <= 2) return(grid::nullGrob()) - coords <- coord$transform(data, panel_scales) + coords <- a_coord$transform(data, panel_scales) # A polygon can only have a single colour, fill, etc, so take from first row first_row <- coords[1, , drop = FALSE] @@ -416,27 +428,27 @@ GeomSimplePolygon <- ggproto("GeomPolygon", Geom, ) } ) -geom_simple_polygon <- function(mapping = NULL, data = NULL, stat = "chull", - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) { - layer( - geom = GeomSimplePolygon, mapping = mapping, data = data, stat = stat, - position = position, show.legend = show.legend, inherit.aes = inherit.aes, +a_geom_simple_polygon <- function(mapping = NULL, data = NULL, a_stat = "chull", + a_position = "identity", na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE, ...) { + a_layer( + a_geom = a_GeomSimplePolygon, mapping = mapping, data = data, a_stat = a_stat, + a_position = a_position, show.legend = show.legend, inherit.a_aes = inherit.a_aes, params = list(na.rm = na.rm, ...) ) } -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - geom_simple_polygon(aes(colour = class), fill = NA) +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_geom_simple_polygon(a_aes(colour = class), fill = NA) ``` There are a few things to note here: * We override `draw_group()` instead of `draw_layer()` because we want one polygon per group, not one polygon per row. If you look at the source - code for the original `GeomPolygon` you'll see it actually overrides - `geom_layer()` because it uses some tricks to make `polygonGrob()` produce + code for the original `a_GeomPolygon` you'll see it actually overrides + `a_geom_layer()` because it uses some tricks to make `polygonGrob()` produce multiple polygons in one call. This is considerably more complicated, but gives better performance. @@ -452,35 +464,35 @@ There are a few things to note here: ### Inheriting from an existing Geom -Sometimes you just want to make a small modification to an existing geom. In this case, rather than inheriting from `Geom` you can inherit from an existing subclass. For example, we might want to change the defaults for `GeomPolygon` to work better with `StatChull`: +Sometimes you just want to make a small modification to an existing geom. In this case, rather than inheriting from `a_Geom` you can inherit from an existing subclass. For example, we might want to change the defaults for `a_GeomPolygon` to work better with `a_StatChull`: ```{r} -GeomPolygonHollow <- ggproto("GeomPolygonHollow", GeomPolygon, - default_aes = aes(colour = "black", fill = NA, size = 0.5, linetype = 1, +a_GeomPolygonHollow <- a_ggproto("a_GeomPolygonHollow", a_GeomPolygon, + default_aes = a_aes(colour = "black", fill = NA, size = 0.5, linetype = 1, alpha = NA) ) -geom_chull <- function(mapping = NULL, data = NULL, - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) { - layer( - stat = StatChull, geom = GeomPolygonHollow, data = data, mapping = mapping, - position = position, show.legend = show.legend, inherit.aes = inherit.aes, +a_geom_chull <- function(mapping = NULL, data = NULL, + a_position = "identity", na.rm = FALSE, show.legend = NA, + inherit.a_aes = TRUE, ...) { + a_layer( + a_stat = a_StatChull, a_geom = a_GeomPolygonHollow, data = data, mapping = mapping, + a_position = a_position, show.legend = show.legend, inherit.a_aes = inherit.a_aes, params = list(na.rm = na.rm, ...) ) } -ggplot(mpg, aes(displ, hwy)) + - geom_point() + - geom_chull() +a_plot(mpg, a_aes(displ, hwy)) + + a_geom_point() + + a_geom_chull() ``` This doesn't allow you to use different geoms with the stat, but that seems appropriate here since the convex hull is primarily a polygonal feature. ### Exercises -1. Compare and contrast `GeomPoint` with `GeomSimplePoint`. +1. Compare and contrast `a_GeomPoint` with `a_GeomSimplePoint`. -1. Compare and contract `GeomPolygon` with `GeomSimplePolygon`. +1. Compare and contract `a_GeomPolygon` with `a_GeomSimplePolygon`. ## Creating your own theme @@ -495,17 +507,17 @@ If you're going to create your own complete theme, there are a few things you ne By default, when you add a new theme element, it inherits values from the existing theme. For example, the following code sets the key colour to red, but it inherits the existing fill colour: ```{r} -theme_grey()$legend.key +a_theme_grey()$legend.key -new_theme <- theme_grey() + theme(legend.key = element_rect(colour = "red")) -new_theme$legend.key +new_a_theme <- a_theme_grey() + a_theme(legend.key = a_element_rect(colour = "red")) +new_a_theme$legend.key ``` To override it completely, use `%+replace%` instead of `+`: ```{r} -new_theme <- theme_grey() %+replace% theme(legend.key = element_rect(colour = "red")) -new_theme$legend.key +new_a_theme <- a_theme_grey() %+replace% a_theme(legend.key = a_element_rect(colour = "red")) +new_a_theme$legend.key ``` ### Global elements @@ -514,21 +526,21 @@ There are four elements that affect the global appearance of the plot: Element | Theme function | Description -------------|-------------------|------------------------ -line | `element_line()` | all line elements -rect | `element_rect()` | all rectangular elements -text | `element_text()` | all text -title | `element_text()` | all text in title elements (plot, axes & legend) +line | `a_element_line()` | all line elements +rect | `a_element_rect()` | all rectangular elements +text | `a_element_text()` | all text +title | `a_element_text()` | all text in title elements (plot, axes & legend) These set default properties that are inherited by more specific settings. These are most useful for setting an overall "background" colour and overall font settings (e.g. family and size). ```{r axis-line-ex} df <- data.frame(x = 1:3, y = 1:3) -base <- ggplot(df, aes(x, y)) + - geom_point() + - theme_minimal() +base <- a_plot(df, a_aes(x, y)) + + a_geom_point() + + a_theme_minimal() base -base + theme(text = element_text(colour = "red")) +base + a_theme(text = a_element_text(colour = "red")) ``` You should generally start creating a theme by modifying these values. @@ -537,11 +549,11 @@ You should generally start creating a theme by modifying these values. It is useful to understand the difference between complete and incomplete theme objects. A *complete* theme object is one produced by calling a theme function with the attribute `complete = TRUE`. -Theme functions `theme_grey()` and `theme_bw()` are examples of complete theme functions. Calls to `theme()` produce *incomplete* theme objects, since they represent (local) modifications to a theme object rather than returning a complete theme object per se. When adding an incomplete theme to a complete one, the result is a complete theme. +Theme functions `a_theme_grey()` and `a_theme_bw()` are examples of complete theme functions. Calls to `a_theme()` produce *incomplete* theme objects, since they represent (local) modifications to a theme object rather than returning a complete theme object per se. When adding an incomplete theme to a complete one, the result is a complete theme. Complete and incomplete themes behave somewhat differently when added to a ggplot object: * Adding an incomplete theme augments the current theme object, replacing only - those properties of elements defined in the call to `theme()`. + those properties of elements defined in the call to `a_theme()`. -* Adding a complete theme wipes away the existing theme and applies the new theme. +* Adding a complete theme wipes away the existing a_theme and applies the new theme. diff --git a/vignettes/ggplot2-specs.Rmd b/vignettes/ggplot2-specs.Rmd index 4a78e6b235..77c9cf6a67 100644 --- a/vignettes/ggplot2-specs.Rmd +++ b/vignettes/ggplot2-specs.Rmd @@ -1,6 +1,7 @@ --- title: "Aesthetic specifications" author: "Hadley Wickham" +maintainer: "Faizan Khan" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > @@ -10,7 +11,7 @@ vignette: > --- ```{r, include = FALSE} -library(ggplot2) +library(ggplot2Animint) knitr::opts_chunk$set(fig.dpi = 96) ``` @@ -52,12 +53,12 @@ Line types can be specified with: y = seq_along(lty), lty = lty ) - ggplot(linetypes, aes(0, y)) + - geom_segment(aes(xend = 5, yend = y, linetype = lty)) + - scale_linetype_identity() + - geom_text(aes(label = lty), hjust = 0, nudge_y = 0.2) + - scale_x_continuous(NULL, breaks = NULL) + - scale_y_continuous(NULL, breaks = NULL) + a_plot(linetypes, a_aes(0, y)) + + a_geom_segment(a_aes(xend = 5, yend = y, linetype = lty)) + + a_scale_linetype_identity() + + a_geom_text(a_aes(a_label = lty), hjust = 0, nudge_y = 0.2) + + a_scale_x_continuous(NULL, breaks = NULL) + + a_scale_y_continuous(NULL, breaks = NULL) ``` * The lengths of on/off stretches of line. This is done with a string @@ -83,13 +84,13 @@ Shapes take four types of values: x = 0:24 %/% 5, y = -(0:24 %% 5) ) - ggplot(shapes, aes(x, y)) + - geom_point(aes(shape = shape), size = 5, fill = "red") + - geom_text(aes(label = shape), hjust = 0, nudge_x = 0.15) + - scale_shape_identity() + - expand_limits(x = 4.1) + - scale_x_continuous(NULL, breaks = NULL) + - scale_y_continuous(NULL, breaks = NULL) + a_plot(shapes, a_aes(x, y)) + + a_geom_point(a_aes(shape = shape), size = 5, fill = "red") + + a_geom_text(a_aes(a_label = shape), hjust = 0, nudge_x = 0.15) + + a_scale_shape_identity() + + ggplot2Animint:::expand_limits(x = 4.1) + + a_scale_x_continuous(NULL, breaks = NULL) + + a_scale_y_continuous(NULL, breaks = NULL) ``` * A __single character__, to use that character as a plotting symbol. @@ -102,10 +103,10 @@ Note that shapes 21-24 have both stroke `colour` and a `fill`. The size of the f ```{r} sizes <- expand.grid(size = (0:3) * 2, stroke = (0:3) * 2) -ggplot(sizes, aes(size, stroke, size = size, stroke = stroke)) + - geom_abline(slope = -1, intercept = 6, colour = "white", size = 6) + - geom_point(shape = 21, fill = "red") + - scale_size_identity() +a_plot(sizes, a_aes(size, stroke, size = size, stroke = stroke)) + + a_geom_abline(slope = -1, intercept = 6, colour = "white", size = 6) + + a_geom_point(shape = 21, fill = "red") + + a_scale_size_identity() ``` @@ -120,8 +121,8 @@ There are only three fonts that are guaranteed to work everywhere: "sans" (the d ```{r} df <- data.frame(x = 1, y = 3:1, family = c("sans", "serif", "mono")) -ggplot(df, aes(x, y)) + - geom_text(aes(label = family, family = family)) +a_plot(df, a_aes(x, y)) + + a_geom_text(a_aes(a_label = family, family = family)) ``` It's trickier to include a system font on a plot because text drawing is done differently by each graphics device (GD). There are five GDs in common use (`png()`, `pdf()`, on screen devices for Windows, Mac and Linux), so to have a font work everywhere you need to configure five devices in five different ways. Two packages simplify the quandary a bit: @@ -158,11 +159,11 @@ Horizontal and vertical justification have the same parameterisation, either a s ```{r} just <- expand.grid(hjust = c(0, 0.5, 1), vjust = c(0, 0.5, 1)) -just$label <- paste0(just$hjust, ", ", just$vjust) +just$a_label <- paste0(just$hjust, ", ", just$vjust) -ggplot(just, aes(hjust, vjust)) + - geom_point(colour = "grey70", size = 5) + - geom_text(aes(label = label, hjust = hjust, vjust = vjust)) +a_plot(just, a_aes(hjust, vjust)) + + a_geom_point(colour = "grey70", size = 5) + + a_geom_text(a_aes(a_label = a_label, hjust = hjust, vjust = vjust)) ``` Note that you can use numbers outside the range (0, 1), but it's not recommended.