Merge pull request #8 from PetterHopp/main

OKplan v0.4.1

Author: PetterHopp

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