Skip to content

Commit

Permalink
more checks on inputs, provides meaningful error messages, fixes #11
Browse files Browse the repository at this point in the history
  • Loading branch information
giocomai committed Jan 25, 2024
1 parent 7fdfb17 commit 1176ab6
Show file tree
Hide file tree
Showing 7 changed files with 175 additions and 2 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: ganttrify
Title: Create beautiful Gantt charts with ggplot2
Version: 0.0.0.9014
Version: 0.0.0.9015
Authors@R:
person(given = "Giorgio",
family = "Comai (OBCT/CCI)",
Expand All @@ -11,7 +11,7 @@ Description: 'ganttrify' facilitates the creation of nice-looking Gantt charts,
License: GPL-3
Encoding: UTF-8
LazyData: true
RoxygenNote: 7.3.0
RoxygenNote: 7.3.1
Imports:
magrittr,
tibble,
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
# Generated by roxygen2: do not edit by hand

export("%>%")
export(gantt_verify)
export(ganttrify)
export(shiny_ganttrify)
importFrom(magrittr,"%>%")
78 changes: 78 additions & 0 deletions R/gantt_verify.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,78 @@
#' Check the consistency of the input project data frame
#'
#' Check the consistency of the input project data frame, return meaningful errors or warnings if something is not quite right
#'
#' @inheritParams ganttrify
#'
#' @return A data frame (a tibble) that is consistent with the format expected by [ganttrify()].
#' @export
#'
#' @examples
#' gantt_verify(project = ganttrify::test_project)
gantt_verify <- function(project,
by_date = FALSE,
exact_date = FALSE) {
if (is.data.frame(project) == FALSE) {
cli::cli_abort("{.arg project} must be a data frame.")
}

if (ncol(project) < 4) {
cli::cli_abort("{.arg project} must must have (at least) four columns.")
}

project <- tibble::as_tibble(project)

if (identical(colnames(project)[1:4], colnames(ganttrify::test_project)) == FALSE) {
cli::cli_warn(c(
x = "{.arg project} is expected to have (at least) four columns, in this order: {stringr::str_flatten_comma(string = colnames(ganttrify::test_project))}.",
i = "The first four columns of this data frame will be treated as such, even if column names are different."
))
colnames(project)[1:4] <- colnames(ganttrify::test_project)
}


if (by_date) {
project <- project %>%
dplyr::mutate(
wp = as.character(wp),
activity = as.character(activity),
start_date = as.character(start_date),
end_date = as.character(end_date)
)
} else {
project <- project %>%
dplyr::mutate(
wp = as.character(wp),
activity = as.character(activity),
start_date = as.numeric(start_date),
end_date = as.numeric(end_date)
)
}

if (exact_date) {
project <- project %>%
dplyr::mutate(
wp = as.character(wp),
activity = as.character(activity),
start_date = lubridate::as_date(start_date),
end_date = lubridate::as_date(end_date)
)
}

na_count_v <- sapply(X = project[1:4], FUN = function(x) sum(is.na(x)))

if (sum(na_count_v) > 0) {
project_pre_nrow_v <- nrow(project)
project <- tidyr::drop_na(project)
project_post_nrow_v <- nrow(project)

effective_na_v <- na_count_v[na_count_v > 0]

cli::cli_warn(message = c(
x = "{.val {sum(effective_na_v)}} missing values or wrong format found in the following column{?s}: {.field {stringr::str_flatten_comma(names(effective_na_v))}}",
i = "{.val {project_pre_nrow_v-project_post_nrow_v}} rows with invalid values have been dropped."
))
}

project
}
6 changes: 6 additions & 0 deletions R/ganttrify.R
Original file line number Diff line number Diff line change
Expand Up @@ -139,6 +139,12 @@ ganttrify <- function(project,
month_breaks = 1,
show_vertical_lines = TRUE,
axis_text_align = "right") {
project <- gantt_verify(
project = project,
by_date = by_date,
exact_date = exact_date
)

# arguments consistency check
if (hide_wp & hide_activities) {
cli::cli_abort("At least one of {.arg hide_wp} or {.arg hide_activities} must be {.code TRUE}, otherwise there's nothing left to show.")
Expand Down
29 changes: 29 additions & 0 deletions man/gantt_verify.Rd

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

12 changes: 12 additions & 0 deletions tests/testthat.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
# This file is part of the standard setup for testthat.
# It is recommended that you do not modify it.
#
# Where should you do additional test configuration?
# Learn more about the roles of various files in:
# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
# * https://testthat.r-lib.org/articles/special-files.html

library(testthat)
library(ganttrify)

test_check("ganttrify")
47 changes: 47 additions & 0 deletions tests/testthat/test-gantt_verify.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,47 @@
test_that("NAs are caught by gantt_verify", {
expect_warning(object = {
project <- data.frame(
wp = letters[1:3],
activity = month.name[1:3],
start_date = 1:3,
end_date = 4:6
)

project[2, 2] <- NA_character_
gantt_verify(project)
})

expect_identical(
object = {
project <- data.frame(
wp = letters[1:3],
activity = month.name[1:3],
start_date = 1:3,
end_date = 4:6
)

project[2, 2] <- NA_character_

suppressWarnings(nrow(gantt_verify(project)))
},
expected = 2L
)



expect_identical(
object = {
project <- data.frame(
wp = letters[1:3],
activity = month.name[1:3],
start_date = 1:3,
end_date = 4:6
)

project[2:3, 2] <- NA_character_

suppressWarnings(nrow(gantt_verify(project)))
},
expected = 1L
)
})

0 comments on commit 1176ab6

Please sign in to comment.