diff --git a/DESCRIPTION b/DESCRIPTION index 88e1c34..389461d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: OKplan Title: Tools to facilitate the Planning of the annual Surveillance Programmes -Version: 0.4.0 -Date: 2021-12-09 +Version: 0.4.1 +Date: 2021-12.17 Authors@R: c(person(given = "Petter", family = "Hopp", @@ -21,6 +21,7 @@ LazyData: true Imports: checkmate, dplyr, + magrittr, openxlsx, stats, NVIdb (>= 0.3.0), diff --git a/NAMESPACE b/NAMESPACE index 6c2b234..ad916ca 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,3 +7,4 @@ export(check_OK_selection) export(make_random) export(style_sum_line) export(write_ok_selection_list) +importFrom(magrittr,"%>%") diff --git a/NEWS b/NEWS index b7fb3cb..bf80eac 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,16 @@ +OKplan 0.4.1 - (2021-12-17) +--------------------------- + +Bug fixes: + +- adjust_samples_to_budget genereates the new column 'adjusted_sample' also when initial sample is correct + + +Other changes: + +- Included package level documentation. + + OKplan 0.4.0 - (2021-12-09) --------------------------- diff --git a/R/OKplan-package.R b/R/OKplan-package.R new file mode 100644 index 0000000..a65cf64 --- /dev/null +++ b/R/OKplan-package.R @@ -0,0 +1,6 @@ +#' @keywords internal +"_PACKAGE" + +## usethis namespace: start +## usethis namespace: end +NULL diff --git a/R/adjust_samples_to_budget.R b/R/adjust_samples_to_budget.R index 2a937bd..b8cb93b 100644 --- a/R/adjust_samples_to_budget.R +++ b/R/adjust_samples_to_budget.R @@ -27,8 +27,6 @@ #' sample_to_adjust = "sample", #' adjusted_sample = "new_sample", #' adjust_by = 4) -#' - adjust_samples_to_budget <- function(data, budget, sample_to_adjust, adjusted_sample = "justert_ant_prover", adjust_by) { # ARGUMENT CHECKING ---- @@ -46,13 +44,18 @@ adjust_samples_to_budget <- function(data, budget, sample_to_adjust, adjusted_sa # INITILIZE VARIABLES ---- total_estimated <- sum(data[, sample_to_adjust], na.rm = TRUE) n_units <- length(which(data[, sample_to_adjust] > 0)) - difference <- c(as.numeric(total_estimated - budget) ,rep(NA, dim(data)[1] - 1)) + difference <- c(as.numeric(total_estimated - budget), rep(NA, dim(data)[1] - 1)) # ADJUST SAMPLE NUMBER ---- # Order data with largest sample size first data <- data[order(data[, sample_to_adjust], decreasing = TRUE), ] - # Only justify sample number when there is disagreement between budget and calculated number of samples + # If total_estimated = budget, make new column adjusted_sample based on sample_to_adjust + if (total_estimated == budget) { + data[, adjusted_sample] <- data[, sample_to_adjust] + } + + # Only justify sample number when there is disagreement between budget and calculated number of samples if (total_estimated != budget) { # Adjust for each sampled unit with the unit having the largest sample size first for (i in c(1:dim(data)[1])) { @@ -65,15 +68,15 @@ adjust_samples_to_budget <- function(data, budget, sample_to_adjust, adjusted_sa justify <- ifelse(difference[i] > 0, -adjust_by, adjust_by) } else { justify <- ifelse(difference[i] > 0, - floor(- difference[i] / (n_units - i)), - ceiling(- difference[i] / (n_units - i))) + floor(-difference[i] / (n_units - i)), + ceiling(-difference[i] / (n_units - i))) } if (difference[i] == 0) {justify <- 0} # Make new column with adjusted number data[i, adjusted_sample] <- data[i, sample_to_adjust] + justify if (i < dim(data)[1]) { - difference[i+1] <- difference[i] + justify + difference[i + 1] <- difference[i] + justify } } diff --git a/R/append_date_generated_line.R b/R/append_date_generated_line.R index 6937cd1..eb5be5c 100644 --- a/R/append_date_generated_line.R +++ b/R/append_date_generated_line.R @@ -15,10 +15,9 @@ #' \dontrun{ #' # Add row with generated date using standard values #' gris_virus_slaktegris_utvalg <- append_date_generated_line(gris_virus_slaktegris_utvalg) -#' #' } #' -append_date_generated_line <- function(data, pretext = "Datauttrekket er gjort", date = format(Sys.Date(),"%d/%m/%Y")) { +append_date_generated_line <- function(data, pretext = "Datauttrekket er gjort", date = format(Sys.Date(), "%d/%m/%Y")) { # Argument checking checks <- checkmate::makeAssertCollection() diff --git a/R/append_sum_line.R b/R/append_sum_line.R index 1fb2f65..c6a7ae2 100644 --- a/R/append_sum_line.R +++ b/R/append_sum_line.R @@ -23,8 +23,6 @@ #' position = "first") #' } #' - - append_sum_line <- function(data, column, pretext = "Sum", position = "left") { # ARGUMENT CHECKING ---- diff --git a/R/check_OK_selection.R b/R/check_OK_selection.R index 282b14d..03ecd7a 100644 --- a/R/check_OK_selection.R +++ b/R/check_OK_selection.R @@ -10,6 +10,8 @@ #' #' @param data Data frame with selection for a OK programme. #' +#' @importFrom magrittr %>% +#' #' @return Prints results of the control to the output window. #' #' @author Petter Hopp Petter.Hopp@@vetinst.no @@ -29,10 +31,8 @@ #' #' # Control #' check_OK_selection(okplan_MRSA) -#' #' } #' -#' check_OK_selection <- function(data) { # Number of herds and samples that should be tested distributed on groups @@ -92,5 +92,3 @@ check_OK_selection <- function(data) { # &omottatt # } - - diff --git a/R/make_random.R b/R/make_random.R index 5865b80..cbf47c7 100644 --- a/R/make_random.R +++ b/R/make_random.R @@ -29,7 +29,6 @@ #' #' # If you initialize again you get overlapping seeds #' x <- make_random(x, seed = seed, init_seed = TRUE) -#' #' } #' make_random <- function(data, colname = "random", seed = -1, init_seed = FALSE) { diff --git a/R/write_ok_selection_list.R b/R/write_ok_selection_list.R index a949afb..fb7e2e8 100644 --- a/R/write_ok_selection_list.R +++ b/R/write_ok_selection_list.R @@ -29,6 +29,8 @@ write_ok_selection_list <- function(data, # } checkmate::assert_character(sheet, min.chars = 1, min.len = 1, max.len = length(data), unique = TRUE, add = checks) checkmate::assert_character(filename, min.chars = 1, len = 1, add = checks) + # Remove trailing backslash or slash before testing path + filepath <- sub("\\\\{1,2}$|/{1,2}$", "", filepath) checkmate::assert_directory_exists(filepath, add = checks) checkmate::assert_logical(calculate_sum, any.missing = FALSE, min.len = 1, add = checks) checkmate::assert_character(dbsource, min.len = 1, add = checks) @@ -52,19 +54,19 @@ write_ok_selection_list <- function(data, property = "colnames") # order columns and keep only designated columns - okdata <- NVIdb::standardize_columns(data = okdata, + okdata <- NVIdb::standardize_columns(data = okdata, standards = OKplan::OK_column_standards, dbsource = dbsource, property = "colorder", exclude = TRUE) # INCLUDE EXTRA INFORMATION ---- # Append sum - if(isTRUE(calculate_sum)) { + if (isTRUE(calculate_sum)) { okdata <- append_sum_line(data = okdata, column = c("ant_prover"), position = "left") } # Append date generated - okdata <- append_date_generated_line(okdata) + okdata <- append_date_generated_line(okdata) # STYLE EXCEL SHEET ---- @@ -78,11 +80,11 @@ write_ok_selection_list <- function(data, dbsource = dbsource) - if(isTRUE(calculate_sum)) { + if (isTRUE(calculate_sum)) { style_sum_line(workbook = okwb, sheet = sheet, data = okdata) } # } # SAVE EXCEL WORKBOOK ---- - openxlsx::saveWorkbook(wb = okwb, file = paste0(filepath, filename), overwrite = TRUE) + openxlsx::saveWorkbook(wb = okwb, file = file.path(filepath, filename), overwrite = TRUE) } diff --git a/data-raw/generate_OK_column_standards.R b/data-raw/generate_OK_column_standards.R index 4d11289..7755244 100644 --- a/data-raw/generate_OK_column_standards.R +++ b/data-raw/generate_OK_column_standards.R @@ -44,8 +44,8 @@ OK_column_standards <- read.xlsx(xlsxFile = paste0(set_dir_NVI("ProgrammeringR") db_tables <- as.data.frame(unique(OK_column_standards$table_db)) %>% dplyr::rename(tables = 1) %>% dplyr::mutate(table = strsplit(tables, split = ",")) %>% - dplyr::mutate_if(is.list, purrr::simplify_all) %>% # flatten each list element internally - tidyr::unnest(cols = "table")# expand + dplyr::mutate_if(is.list, purrr::simplify_all) %>% # flatten each list element internally + tidyr::unnest(cols = "table") # expand # Generate table with each table name on one line OK_column_standards <- OK_column_standards %>% @@ -56,5 +56,3 @@ OK_column_standards <- OK_column_standards %>% # SAVE IN PACKAGE DATA ---- usethis::use_data(name = OK_column_standards, overwrite = TRUE, internal = FALSE) - - diff --git a/data/OK_column_standards.rda b/data/OK_column_standards.rda index 25bec3f..60240e6 100644 Binary files a/data/OK_column_standards.rda and b/data/OK_column_standards.rda differ diff --git a/man/OKplan-package.Rd b/man/OKplan-package.Rd new file mode 100644 index 0000000..7a04b1e --- /dev/null +++ b/man/OKplan-package.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/OKplan-package.R +\docType{package} +\name{OKplan-package} +\alias{OKplan} +\alias{OKplan-package} +\title{OKplan: Tools to facilitate the Planning of the annual Surveillance Programmes} +\description{ +Provide tools to facilitate the planning of the annual surveillance programmes. The main focus is tools for generating standardized lists for NFSA. +} +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/NorwegianVeterinaryInstitute/OKplan} + \item Report bugs at \url{https://github.com/NorwegianVeterinaryInstitute/OKplan/issues} +} + +} +\author{ +\strong{Maintainer}: Petter Hopp \email{Petter.Hopp@vetinst.no} + +Other contributors: +\itemize{ + \item Norwegian Veterinary Institute [copyright holder] +} + +} +\keyword{internal} diff --git a/man/adjust_samples_to_budget.Rd b/man/adjust_samples_to_budget.Rd index 0234a87..cf699e1 100644 --- a/man/adjust_samples_to_budget.Rd +++ b/man/adjust_samples_to_budget.Rd @@ -46,7 +46,6 @@ x <- adjust_samples_to_budget(data = x, sample_to_adjust = "sample", adjusted_sample = "new_sample", adjust_by = 4) - } \author{ Petter Hopp Petter.Hopp@vetinst.no diff --git a/man/append_date_generated_line.Rd b/man/append_date_generated_line.Rd index 64bd8e8..effaec4 100644 --- a/man/append_date_generated_line.Rd +++ b/man/append_date_generated_line.Rd @@ -30,7 +30,6 @@ Two rows are dded to the data frame, the first is empty, the second has the gene \dontrun{ # Add row with generated date using standard values gris_virus_slaktegris_utvalg <- append_date_generated_line(gris_virus_slaktegris_utvalg) - } } diff --git a/man/check_OK_selection.Rd b/man/check_OK_selection.Rd index 5afe0a8..d4a4e97 100644 --- a/man/check_OK_selection.Rd +++ b/man/check_OK_selection.Rd @@ -38,10 +38,8 @@ okplan_MRSA <- read.csv2(file = paste0( # Control check_OK_selection(okplan_MRSA) - } - } \author{ Petter Hopp Petter.Hopp@vetinst.no diff --git a/man/make_random.Rd b/man/make_random.Rd index 997f3bc..f716dbd 100644 --- a/man/make_random.Rd +++ b/man/make_random.Rd @@ -41,7 +41,6 @@ x <- make_random(x, seed = seed, init_seed = FALSE) # If you initialize again you get overlapping seeds x <- make_random(x, seed = seed, init_seed = TRUE) - } } diff --git a/notes/develop.R b/notes/develop.R index 423cfe4..5d1f777 100644 --- a/notes/develop.R +++ b/notes/develop.R @@ -19,7 +19,7 @@ pkg_path = usethis::proj_path() # DOCUMENTATION AND STYLING ---- # Creates new help files # Should be run before git push when documentation for functions have been changed -NVIpackager::document_NVIpkg(style = FALSE, +NVIpackager::document_NVIpkg(style = TRUE, contributing = FALSE, readme = FALSE, scope = c("spaces", "line_breaks")) @@ -58,7 +58,7 @@ print(x = code_coverage, group = "functions") devtools::build(binary = FALSE, manual = TRUE, vignettes = TRUE) # Test built package. # Thereby, no problems with files in .Rbuildignore. -version <- utils::packageVersion(pkg, lib.loc = paste0(getwd(),"/..")) +version <- utils::packageVersion(pkg, lib.loc = paste0(pkg_path, "/..")) devtools::check_built(path = paste0("../", pkg, "_", version, ".tar.gz"), args = c("--no-tests"), manual = TRUE) # Extensive checking of package. Is done after build. Creates PDF-manual diff --git a/tests/testthat/test_append_date_generated_line.R b/tests/testthat/test_append_date_generated_line.R index 26524c7..a6905bb 100644 --- a/tests/testthat/test_append_date_generated_line.R +++ b/tests/testthat/test_append_date_generated_line.R @@ -13,15 +13,14 @@ x <- as.data.frame(cbind("År" = 2021, "Rapport" = "Brucellose hos geit, utvalgs y <- append_date_generated_line(x) expect_equal(dim(y)[1], dim(x)[1] + 2) -expect_identical(y[dim(y)[1], 1], paste("Datauttrekket er gjort", format(Sys.Date(),"%d/%m/%Y"))) +expect_identical(y[dim(y)[1], 1], paste("Datauttrekket er gjort", format(Sys.Date(), "%d/%m/%Y"))) # Include row with generated date -today <- format(Sys.Date(),"%d/%m/%Y") +today <- format(Sys.Date(), "%d/%m/%Y") y <- append_date_generated_line(x, pretext = "Data was generated", date = today) expect_equal(dim(y)[1], dim(x)[1] + 2) -expect_identical(y[dim(y)[1], 1], paste("Data was generated", format(Sys.Date(),"%d/%m/%Y"))) +expect_identical(y[dim(y)[1], 1], paste("Data was generated", format(Sys.Date(), "%d/%m/%Y"))) }) - diff --git a/tests/testthat/test_make_random.R b/tests/testthat/test_make_random.R index d509165..a5c2fa1 100644 --- a/tests/testthat/test_make_random.R +++ b/tests/testthat/test_make_random.R @@ -25,4 +25,3 @@ expect_identical(x$random, x$random3) expect_identical(x$random2, x$random4) }) - diff --git a/tests/testthat/test_write_ok_selection_list.R b/tests/testthat/test_write_ok_selection_list.R index 755ceec..7e0a0cd 100644 --- a/tests/testthat/test_write_ok_selection_list.R +++ b/tests/testthat/test_write_ok_selection_list.R @@ -16,7 +16,7 @@ test_that("write_ok_selection_list", { write_ok_selection_list(data = x, sheet = "ok_test_data", - filename = "/oktest.xlsx", + filename = "oktest.xlsx", filepath = td, calculate_sum = TRUE, dbsource = "ok_avlsgris") @@ -26,7 +26,7 @@ test_that("write_ok_selection_list", { expect_identical(openxlsx::getSheetNames(paste0(td, "/oktest.xlsx")), "ok_test_data") - testwb <- openxlsx::loadWorkbook(xlsxFile = paste0(td, "/oktest.xlsx")) + # testwb <- openxlsx::loadWorkbook(xlsxFile = paste0(td, "/oktest.xlsx")) }) @@ -47,7 +47,7 @@ test_that("Errors for write_ok_selection_list", { # x is not a data frame expect_error(write_ok_selection_list(data = "x", sheet = "avlsgris", - filename = "/oktest.xlsx", + filename = "oktest.xlsx", filepath = td, calculate_sum = TRUE, dbsource = "ok_avlsgris"), @@ -56,7 +56,7 @@ test_that("Errors for write_ok_selection_list", { # Wrong sheet name expect_error(write_ok_selection_list(data = x, sheet = "", - filename = "/oktest.xlsx", + filename = "oktest.xlsx", filepath = td, calculate_sum = TRUE, dbsource = "ok_avlsgris"), @@ -65,7 +65,7 @@ test_that("Errors for write_ok_selection_list", { # Wrong path expect_error(write_ok_selection_list(data = x, sheet = "avlsgris", - filename = "/oktest.xlsx", + filename = "oktest.xlsx", filepath = paste0(td, "/wrongpath"), calculate_sum = TRUE, dbsource = "ok_avlsgris"), @@ -74,7 +74,7 @@ test_that("Errors for write_ok_selection_list", { # Wrong dbsource expect_error(write_ok_selection_list(data = x, sheet = "avlsgris", - filename = "/oktest.xlsx", + filename = "oktest.xlsx", filepath = td, calculate_sum = TRUE, dbsource = "x_avlsgris"),