Skip to content

Commit

Permalink
Merge pull request #238 from jpquast/drc_4p_plot-improvement
Browse files Browse the repository at this point in the history 
Improve and simplify drc_4p_plot()
  • Loading branch information
@jpquast
jpquast authored Mar 27, 2024
2 parents b59ff7a + b6bc755 commit 849ea65
Show file tree
Hide file tree
Showing 4 changed files with 69 additions and 137 deletions.
2 changes: 2 additions & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,8 @@
* `facet_title_size`: determines the size of the facet titles.
* `export_height`: determines the output height of an exported plot in inches.
* `export_width`: determines the output width of an exported plot in inches.
* `x_axis_limits`: user supplied x-axis limits for each plot.
* `colours`: determines colours used for the plot.
* `fit_drc_4p()` and `parallel_fit_drc_4p()` have been updated in the latest version of **protti**, leading to slight adjustments in their computational results compared to previous versions.
* We added new arguments:
* `anova_cutoff` lets you define the ANOVA adjusted p-value cutoff (default 0.05).
Expand Down
183 changes: 52 additions & 131 deletions R/drc_4p_plot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,14 +44,19 @@ plot_drc_4p <- function(...) {
#' target was provided) should be \code{"free"} or \code{"fixed"}.
#' @param x_axis_scale_log10 a logical value that indicates if the x-axis scale should be log10
#' transformed.
#' @param x_axis_limits a numeric vector of length 2, defining the lower and upper x-axis limit. The
#' default is `c(NA, NA)`, meaning the limits are not defined by the user but by the data.
#' @param colours a character vector containing at least three colours. The first is used for the points,
#' the second for the confidence interval and the third for the curve. By default the first two
#' protti colours are used for the points and confidence interval and the curve is black.
#' @param export a logical value that indicates if plots should be exported as PDF. The output
#' directory will be the current working directory. The name of the file can be chosen using the
#' \code{export_name} argument. If only one target is selected and \code{export = TRUE},
#' the plot is exported and in addition returned in R.
#' @param export_height a numeric value that specifies the plot height in inches for an exported plot.
#' The default is `37.5`. For a non-facet plot we recommend using 6.
#' The default is `25`. For a non-facet plot we recommend using 8.
#' @param export_width a numeric value that specifies the plot height in inches for an exported plot.
#' The default is `45`. For a non-facet plot we recommend using 8.
#' The default is `30`. For a non-facet plot we recommend using 12.
#' @param export_name a character value providing the name of the exported file if
#' \code{export = TRUE}.
#'
Expand Down Expand Up @@ -119,9 +124,11 @@ drc_4p_plot <- function(data,
facet = TRUE,
scales = "free",
x_axis_scale_log10 = TRUE,
x_axis_limits = c(NA, NA),
colours = NULL,
export = FALSE,
export_height = 37.5,
export_width = 45,
export_height = 25,
export_width = 30,
export_name = "dose-response_curves") {
. <- NULL

Expand All @@ -132,6 +139,24 @@ drc_4p_plot <- function(data,
if (nrow(data) == 0) stop("Target not found in data!")
}

if (missing(colours)) {
protti_colours <- "placeholder" # assign a placeholder to prevent a missing global variable warning
utils::data("protti_colours", envir = environment()) # then overwrite it with real data
colours <- c(protti_colours[1:2], "black")
} else {
if (length(colours) < 3) stop("Please provide at least three colours for the plot!")
}

if (facet == FALSE) {
# If the plot is not faceted and the user didn't provide heights and widths set them here
if (missing(export_height)) {
export_height <- 8
}
if (missing(export_width)) {
export_width <- 12
}
}

data <- data %>%
dplyr::ungroup() %>%
dplyr::mutate(name = paste0(
Expand All @@ -156,105 +181,11 @@ drc_4p_plot <- function(data,
dplyr::select({{ grouping }}, .data$name, .data$group_number, .data$plot_curve) %>%
tidyr::unnest(.data$plot_curve)

if (!"all" %in% targets) {
if (length(targets) == 1) {
input_points_plot <- input_points %>%
dplyr::filter({{ grouping }} == targets)

input_curve_plot <- input_curve %>%
dplyr::filter({{ grouping }} == targets)

plot <- ggplot2::ggplot(
data = input_points_plot,
ggplot2::aes(
x = {{ dose }},
y = {{ response }}
)
) +
ggplot2::geom_point(size = 2, col = "#5680C1") +
{
if (nrow(input_curve_plot) != 1) {
ggplot2::geom_ribbon(
data = input_curve_plot,
ggplot2::aes(
x = .data$dose,
y = .data$Prediction,
ymin = .data$Lower,
ymax = .data$Upper
),
alpha = 0.2,
fill = "#B96DAD"
)
}
} +
{
if (nrow(input_curve_plot) != 1) {
ggplot2::geom_line(
data = input_curve_plot,
ggplot2::aes(
x = .data$dose,
y = .data$Prediction
),
size = 1.2
)
}
} +
ggplot2::labs(
title = unique(input_points_plot$name),
x = paste0("Concentration [", unit, "]"),
y = y_axis_name
) +
ggplot2::scale_x_log10() +
ggplot2::theme_bw() +
ggplot2::theme(
plot.title = ggplot2::element_text(
size = 18
),
axis.text.x = ggplot2::element_text(
size = 15
),
axis.text.y = ggplot2::element_text(
size = 15
),
axis.title.y = ggplot2::element_text(
size = 15
),
axis.title.x = ggplot2::element_text(
size = 15
),
legend.title = ggplot2::element_text(
size = 15
),
legend.text = ggplot2::element_text(
size = 15
),
strip.text.x = ggplot2::element_text(
size = 15
),
strip.text = ggplot2::element_text(
size = 15
),
strip.background = element_blank()
)

if (export == FALSE) {
return(plot)
} else {
grDevices::pdf(
file = paste0(export_name, ".pdf"),
width = 8,
height = 6
)
suppressWarnings(print(plot))
grDevices::dev.off()
return(plot)
}
} else {
input_points <- input_points %>%
dplyr::filter({{ grouping }} %in% targets)

input_curve <- input_curve %>%
dplyr::filter({{ grouping }} %in% targets)
if (length(targets) == 1) {
# If the facet argument was not defined set it to FALSE
# because there is just one plot
if (missing(facet)) {
facet <- FALSE
}
}

Expand Down Expand Up @@ -284,7 +215,7 @@ drc_4p_plot <- function(data,
function(x, y, z) {
pb$tick()
ggplot2::ggplot(data = x, ggplot2::aes(x = {{ dose }}, y = {{ response }})) +
ggplot2::geom_point(size = 2, col = "#5680C1") +
ggplot2::geom_point(size = 2, col = colours[1]) +
{
if (nrow(y) != 1) {
ggplot2::geom_ribbon(
Expand All @@ -296,7 +227,7 @@ drc_4p_plot <- function(data,
ymax = .data$Upper
),
alpha = 0.2,
fill = "#B96DAD"
fill = colours[2]
)
}
} +
Expand All @@ -308,7 +239,8 @@ drc_4p_plot <- function(data,
x = .data$dose,
y = .data$Prediction
),
size = 1.2
size = 1.2,
col = colours[3]
)
}
} +
Expand All @@ -331,41 +263,30 @@ drc_4p_plot <- function(data,
}
} +
{
if (x_axis_scale_log10 == TRUE) ggplot2::scale_x_log10()
if (x_axis_scale_log10 == TRUE) {
ggplot2::scale_x_log10(limits = x_axis_limits)
} else {
ggplot2::scale_x_continuous(limits = x_axis_limits)
}
} +
{
if (facet == TRUE) ggplot2::facet_wrap(~ .data$name, scales = scales, ncol = 4)
} +
ggplot2::theme_bw() +
ggplot2::theme(
plot.title = ggplot2::element_text(
size = 18
),
axis.text.x = ggplot2::element_text(
size = 15
),
axis.text.y = ggplot2::element_text(
size = 15
),
axis.title.y = ggplot2::element_text(
size = 15
),
axis.title.x = ggplot2::element_text(
size = 15
),
legend.title = ggplot2::element_text(
size = 15
),
legend.text = ggplot2::element_text(
size = 15
),
strip.text.x = ggplot2::element_text(
size = facet_title_size
),
plot.title = ggplot2::element_text(size = 18),
axis.text.x = ggplot2::element_text(size = 15),
axis.text.y = ggplot2::element_text(size = 15),
axis.title.y = ggplot2::element_text(size = 15),
axis.title.x = ggplot2::element_text(size = 15),
legend.title = ggplot2::element_text(size = 15),
legend.text = ggplot2::element_text(size = 15),
strip.text.x = ggplot2::element_text(size = facet_title_size),
strip.background = element_blank()
)
}
)

if (export == FALSE) {
plots
} else {
Expand Down
17 changes: 13 additions & 4 deletions man/drc_4p_plot.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 2 additions & 2 deletions tests/testthat/test-workflow.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -677,7 +677,7 @@ if (Sys.getenv("TEST_PROTTI") == "true") {
))
})

expect_is(p, "ggplot")
expect_is(p, "list")
expect_warning(print(p), NA)

rlang::with_options(lifecycle_verbosity = "warning", {
Expand Down Expand Up @@ -707,7 +707,7 @@ if (Sys.getenv("TEST_PROTTI") == "true") {
y_axis_name = "test y-Axis"
)

expect_is(p, "ggplot")
expect_is(p, "list")
expect_warning(print(p), NA)

p_facet <- drc_4p_plot(
Expand Down

0 comments on commit 849ea65

Please sign in to comment.