Skip to content

Commit d4ca98d

Browse files
jonocarrolljonocarroll
committed
keep easy_labs for CRAN version of ggplot2, but skip if dev
1 parent 5a166da commit d4ca98d

4 files changed

Lines changed: 160 additions & 57 deletions

File tree

‎NAMESPACE‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
# Generated by roxygen2: do not edit by hand
22

3+
S3method(ggplot_add,easy_labs)
34
export(.all_element_text)
45
export(.all_theme_els)
56
export(easy_add_legend_title)
@@ -47,3 +48,4 @@ export(easy_y_axis_labels_size)
4748
export(easy_y_axis_title_size)
4849
import(ggplot2)
4950
importFrom(stats,setNames)
51+
importFrom(utils,modifyList)

‎R/labs2.R‎

Lines changed: 67 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,22 +1,87 @@
11
#' @title Easily add ggplot labels using label attribute of `data.frame` column
22
#' @description Applies same logic as \code{\link[ggplot2]{labs}} but uses as default
33
#' the column label attribute if present as the variable label in the plot.
4+
#' Note that as of ggplot2 3.5.2.9001 this behaviour is native and this function will
5+
#' be deprecated.
46
#' @param ... A list of new name-value pairs. The name should either be an aesthetic,
57
#' or one of "title", "subtitle", or "caption"
68
#' @param teach print longer equivalent \code{\link[ggplot2]{ggplot2}}
79
#' expression?
810
#' @return NULL
11+
#' @examples
12+
#' \dontrun{
13+
#' iris_labs <- iris
914
#'
15+
#' lbl <- c('Sepal Length', 'Sepal Width', 'Petal Length', 'Petal Width', 'Flower Species')
16+
#'
17+
#' labelled::var_label(iris_labs) <- split(lbl,names(iris_labs))
18+
#'
19+
#' p <- ggplot2::ggplot(iris_labs,ggplot2::aes(x=Sepal.Length,y=Sepal.Width))+
20+
#' ggplot2::geom_line(ggplot2::aes(colour=Species))
21+
#'
22+
#' p
23+
#'
24+
#' p + easy_labs()
25+
#' p + easy_labs(title = "Plot Title", subtitle = 'Plot Subtitle', x = 'x axis label')
26+
#'
27+
#' p + easy_labs(teach = TRUE)
28+
#' }
1029
#' @rdname easy_labs
1130
#' @export
1231
easy_labs <- function(..., teach = FALSE) {
13-
.Deprecated("This functionality is now handled natively in ggplot2")
32+
if (utils::packageVersion("ggplot2") > package_version("3.5.2.9001")) {
33+
.Deprecated("This functionality is now handled natively in ggplot2")
34+
}
1435
man_labs <- ggplot2::labs(list(...))
1536
structure(man_labs, teach = teach, class = "easy_labs")
1637
}
1738

39+
#' @export
40+
ggplot_add.easy_labs <- function(object, plot, ...) {
41+
easy_update_labs(plot, object)
42+
}
43+
44+
#' @importFrom utils modifyList
45+
easy_update_labs <- function(p, man_labs) {
46+
p_labs <- get_labs(p)
47+
p_labs <- Filter(\(x) !is.null(x) && x != "", p_labs)
48+
d <- p$data
49+
d_labs <- lapply(d, function(x) attr(x, "label"))
50+
has_labs <- sapply(d_labs, function(x) !is.null(x))
51+
labslist <- d_labs[has_labs]
52+
53+
labs_to_update <- match(p_labs, names(labslist))
54+
for (lab in seq_along(labs_to_update)) {
55+
labval <- labs_to_update[lab]
56+
if (!is.na(labval)) {
57+
p_labs[lab] <- labslist[[labval]]
58+
}
59+
}
60+
## if labs have been manually specified, use those
61+
if (length(unlist(man_labs)) > 0) {
62+
p_labs <- utils::modifyList(p_labs, as.list(unlist(man_labs)))
63+
}
64+
if (attr(man_labs, "teach")) {
65+
message("easy_labs call can be substituted with:")
66+
args <- paste(
67+
names(p_labs),
68+
"=",
69+
sQuote(p_labs, q = 'simple'),
70+
collapse = ", "
71+
)
72+
message(strwrap(
73+
paste0("labs(", args, ")"),
74+
width = 80,
75+
exdent = 2,
76+
prefix = "\n",
77+
initial = ""
78+
))
79+
}
80+
81+
ggplot2::update_labels(p, p_labs)
82+
}
83+
1884
#' @keywords internal
19-
#' @noRd
2085
get_labs <- if ("get_labs" %in% getNamespaceExports("ggplot2")) {
2186
ggplot2::get_labs
2287
} else {

‎man/easy_labs.Rd‎

Lines changed: 21 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-labs.R‎

Lines changed: 70 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -28,58 +28,73 @@ p <- ggplot2::ggplot(
2828
) +
2929
ggplot2::geom_line(ggplot2::aes(colour = Species))
3030

31-
# test_that("easy_labs uses column attrib", {
32-
#
33-
# hard_res <- p + ggplot2::labs(x = 'Sepal Length', y = 'Sepal Width', colour = 'Flower Species')
34-
# easy_res <- p + easy_labs()
35-
#
36-
# expect_mapequal(get_labs(easy_res), get_labs(hard_res))
37-
# expect_message(p + easy_labs(teach = TRUE), regexp = "colour = 'Flower Species'")
38-
#
39-
# easy_res_test_teach <- p + easy_labs()
40-
# teach_message <- capture_messages({p + easy_labs(teach = TRUE)})[2]
41-
# teach_res <- rlang::eval_bare(rlang::parse_expr(teach_message))
42-
# expect_eqNe(easy_res_test_teach, p + teach_res)
43-
#
44-
# expect_doppelganger("labels_attrib", easy_res)
45-
#
46-
# })
47-
48-
# testthat::test_that("regular labs overides easy_labs ", {
49-
#
50-
# hard_res <- p + ggplot2::labs(x = 'x axis', y = 'Sepal Width', colour = 'Flower Species')
51-
# easy_res <- p + easy_labs(x = 'x axis')
52-
#
53-
# expect_mapequal(get_labs(easy_res), get_labs(hard_res))
54-
# expect_doppelganger("labels_manual", easy_res)
55-
#
56-
# })
57-
58-
# testthat::test_that("regular labs pass new labels through easy_labs ", {
59-
#
60-
# hard_res <- p + ggplot2::labs(x = 'Sepal Length', y = 'Sepal Width', colour = 'Flower Species', title = 'my title')
61-
# easy_res <- p + easy_labs(title = 'my title')
62-
#
63-
# expect_eqNe(easy_res$labels[sort(names(easy_res$labels))],
64-
# hard_res$labels[sort(names(hard_res$labels))])
65-
# expect_doppelganger("labels_mytitle", easy_res)
66-
#
67-
# })
68-
69-
# test_that("column name used when no column attrib present", {
70-
#
71-
# labelled::var_label(iris_labs$Sepal.Length) <- NULL
72-
#
73-
# p <- ggplot2::ggplot(iris_labs,
74-
# ggplot2::aes(x = Sepal.Length,
75-
# y = Sepal.Width)) +
76-
# ggplot2::geom_line(ggplot2::aes(colour = Species))
77-
#
78-
#
79-
# hard_res <- p + ggplot2::labs(y = 'Sepal Width', colour = 'Flower Species')
80-
# easy_res <- p + ggeasy::easy_labs()
81-
#
82-
# expect_mapequal(get_labs(easy_res), get_labs(hard_res))
83-
# expect_doppelganger("labels_y_col", easy_res)
84-
#
85-
# })
31+
test_that("easy_labs uses column attrib", {
32+
skip_if(utils::packageVersion("ggplot2") >= package_version("3.5.2.9001"))
33+
hard_res <- p +
34+
ggplot2::labs(
35+
x = 'Sepal Length',
36+
y = 'Sepal Width',
37+
colour = 'Flower Species'
38+
)
39+
easy_res <- p + easy_labs()
40+
41+
expect_mapequal(get_labs(easy_res), get_labs(hard_res))
42+
expect_message(
43+
p + easy_labs(teach = TRUE),
44+
regexp = "colour = 'Flower Species'"
45+
)
46+
47+
easy_res_test_teach <- p + easy_labs()
48+
teach_message <- capture_messages({
49+
p + easy_labs(teach = TRUE)
50+
})[2]
51+
teach_res <- rlang::eval_bare(rlang::parse_expr(teach_message))
52+
expect_eqNe(easy_res_test_teach, p + teach_res)
53+
54+
expect_doppelganger("labels_attrib", easy_res)
55+
})
56+
57+
testthat::test_that("regular labs overides easy_labs ", {
58+
skip_if(utils::packageVersion("ggplot2") >= package_version("3.5.2.9001"))
59+
hard_res <- p +
60+
ggplot2::labs(x = 'x axis', y = 'Sepal Width', colour = 'Flower Species')
61+
easy_res <- p + easy_labs(x = 'x axis')
62+
63+
expect_mapequal(get_labs(easy_res), get_labs(hard_res))
64+
expect_doppelganger("labels_manual", easy_res)
65+
})
66+
67+
testthat::test_that("regular labs pass new labels through easy_labs ", {
68+
skip_if(utils::packageVersion("ggplot2") >= package_version("3.5.2.9001"))
69+
hard_res <- p +
70+
ggplot2::labs(
71+
x = 'Sepal Length',
72+
y = 'Sepal Width',
73+
colour = 'Flower Species',
74+
title = 'my title'
75+
)
76+
easy_res <- p + easy_labs(title = 'my title')
77+
78+
expect_eqNe(
79+
easy_res$labels[sort(names(easy_res$labels))],
80+
hard_res$labels[sort(names(hard_res$labels))]
81+
)
82+
expect_doppelganger("labels_mytitle", easy_res)
83+
})
84+
85+
test_that("column name used when no column attrib present", {
86+
skip_if(utils::packageVersion("ggplot2") >= package_version("3.5.2.9001"))
87+
labelled::var_label(iris_labs$Sepal.Length) <- NULL
88+
89+
p <- ggplot2::ggplot(
90+
iris_labs,
91+
ggplot2::aes(x = Sepal.Length, y = Sepal.Width)
92+
) +
93+
ggplot2::geom_line(ggplot2::aes(colour = Species))
94+
95+
hard_res <- p + ggplot2::labs(y = 'Sepal Width', colour = 'Flower Species')
96+
easy_res <- p + ggeasy::easy_labs()
97+
98+
expect_mapequal(get_labs(easy_res), get_labs(hard_res))
99+
expect_doppelganger("labels_y_col", easy_res)
100+
})

0 commit comments

Comments
 (0)