-
Notifications
You must be signed in to change notification settings - Fork 63
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
more checks on inputs, provides meaningful error messages, fixes #11
- Loading branch information
Showing
7 changed files
with
175 additions
and
2 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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,"%>%") |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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") |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 | ||
) | ||
}) |