Merge pull request #8 from PetterHopp/main

OKplan v0.4.1

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),

NAMESPACE

@@ -7,3 +7,4 @@ export(check_OK_selection)
 export(make_random)
 export(style_sum_line)
 export(write_ok_selection_list)
+importFrom(magrittr,"%>%")

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)
 ---------------------------
 

R/OKplan-package.R

@@ -0,0 +1,6 @@
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+## usethis namespace: end
+NULL

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
       }
 
     }

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()

R/append_sum_line.R

@@ -23,8 +23,6 @@
 #'                                             position = "first")
 #' }
 #'
-
-
 append_sum_line <- function(data, column, pretext = "Sum", position = "left") {
 
   # ARGUMENT CHECKING ----

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
   #
 }
-
-

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) {

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)
 
 }

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)
-
-

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

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")))
 
 })
-

tests/testthat/test_make_random.R

@@ -25,4 +25,3 @@ expect_identical(x$random, x$random3)
 expect_identical(x$random2, x$random4)
 
 })
-

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"),