Merge pull request #6 from PetterHopp/main

OKplan v0.4.0 2021-12-09

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: OKplan
 Title: Tools to facilitate the Planning of the annual Surveillance Programmes
-Version: 0.3.0
-Date: 2021-11-29
+Version: 0.4.0
+Date: 2021-12-09
 Authors@R: 
   c(person(given = "Petter",
            family = "Hopp",
@@ -20,9 +20,11 @@ Encoding: UTF-8
 LazyData: true
 Imports:
     checkmate,
-    poorman,
+    dplyr,
+    openxlsx,
     stats,
-    NVIdb (>= 0.3.0)
+    NVIdb (>= 0.3.0),
+    NVIpretty
 Suggests:
     covr,
     devtools,
@@ -33,9 +35,11 @@ Suggests:
     styler,
     testthat,
     usethis,
+    utils,
     NVIpackager
 Remotes: 
     NorwegianVeterinaryInstitute/NVIdb,
+    NorwegianVeterinaryInstitute/NVIpretty,
     NorwegianVeterinaryInstitute/NVIpackager
 RoxygenNote: 7.1.1
 VignetteBuilder: knitr

NAMESPACE

@@ -5,3 +5,5 @@ export(append_date_generated_line)
 export(append_sum_line)
 export(check_OK_selection)
 export(make_random)
+export(style_sum_line)
+export(write_ok_selection_list)

NEWS

@@ -1,3 +1,18 @@
+OKplan 0.4.0 - (2021-12-09)
+---------------------------
+
+New features:
+
+- style_sum_line styles the row with sum of samples.
+
+- write_ok_selection_list writes the selection list based on selected data from okplan file and uses standardize_columns to  select, format and style columns.
+
+
+Other changes:
+
+- extended OK_column_standards with tables for samples taken at abbatoirs and the surveillance in pigs.
+
+
 OKplan 0.3.0 - (2021-11-29)
 ---------------------------
 

R/append_sum_line.R

@@ -18,7 +18,7 @@
 #' \dontrun{
 #' # Append row with sum
 #' gris_blodprover_slakteri <- append_sum_line(data = gris_blodprover_slakteri,
-#'                                             col_name = c("ant_prover"),
+#'                                             column = c("ant_prover"),
 #'                                             pretext = "Sum",
 #'                                             position = "first")
 #' }
@@ -27,6 +27,25 @@
 
 append_sum_line <- function(data, column, pretext = "Sum", position = "left") {
 
+  # ARGUMENT CHECKING ----
+  # Object to store check-results
+  checks <- checkmate::makeAssertCollection()
+
+  # Perform assertions
+  # data
+  checkmate::assert_data_frame(data, add = checks)
+  # column
+  checkmate::assert_names(column, type = "unique", subset.of = colnames(data), add = checks)
+  # pretext
+  checkmate::assert_character(pretext, add = checks)
+  # position
+  checkmate::assert_choice(position, choices = c("first", "left"), add = checks)
+
+  # Report errors
+  checkmate::reportAssertions(checks)
+
+  # APPEND SUM LINE ----
+
   # Removes tibble as tibble will not accept the the pretext (character variable) in a numeric variable
   data <- as.data.frame(data)
 
@@ -40,10 +59,10 @@ append_sum_line <- function(data, column, pretext = "Sum", position = "left") {
   # Append a line with the sum. The pretext is placed in accord with position
   if (position == "none") {
     data[dim(data)[1] + 1, c(column)] <- c(sum_column)
-    }
+  }
   if (position == "first") {
     data[dim(data)[1] + 1, c(colnames(data)[1], column)] <- c(pretext, sum_column)
-    }
+  }
   if (position == "left") {
     data[dim(data)[1] + 1, c((colnames(data)[which(colnames(data) == column[1]) - 1]), column)] <- c(pretext, sum_column)
   }

R/check_OK_selection.R

@@ -40,17 +40,17 @@ check_OK_selection <- function(data) {
 
   print("Totalt antall besetninger og prover som skal testes")
   ktr <- data %>%
-    poorman::group_by(ok_artkode, statuskode) %>%
-    poorman::summarise(antall = poorman::n(), ant_prover = sum(ant_prover, na.rm = TRUE), .groups = "keep") %>%
-    poorman::ungroup()
+    dplyr::group_by(ok_artkode, statuskode) %>%
+    dplyr::summarise(antall = dplyr::n(), ant_prover = sum(ant_prover, na.rm = TRUE), .groups = "keep") %>%
+    dplyr::ungroup()
   print(ktr)
 
   print("Antall utvalgte besetninger med mer enn en registrering per prodnr8")
   ktr <- data %>%
-    poorman::add_count(ok_hensiktkode, eier_lokalitetnr) %>%
-    poorman::ungroup() %>%
-    poorman::filter(n > 1) %>%
-    poorman::select(eier_lokalitetnr, eier_lokalitet, postnr, poststed)
+    dplyr::add_count(ok_hensiktkode, eier_lokalitetnr) %>%
+    dplyr::ungroup() %>%
+    dplyr::filter(n > 1) %>%
+    dplyr::select(eier_lokalitetnr, eier_lokalitet, postnr, poststed)
   print(ktr)
 
   print("Utvalgte besetninger med missing prodnr8 eller missing navn")

R/style_sum_line.R

@@ -0,0 +1,54 @@
+#' @title Style row with "Sum" in Excel sheet
+#' @description Style the font with bold for the line with the text "Sum" in on cell.
+#'     It is possible to use other text decoration, see \code{openxlxs::createStyle}.
+#'     A line with the text "Sum" or another text as given by text will be styled.
+#'
+#' @details The whole line will be styled.
+#'
+#' @param workbook The workbook object.
+#' @param sheet The Excel sheet name.
+#' @param data The data frame that have been exported to the Excel sheet. Used to
+#'     find column number and row number for the pretext for which the row should be styled.
+#' @param text The text in the cell for which the row should be styled.
+#'     Defaults to "Sum".
+#' @param text_decoration The text decoration style that should be used, see \code{openxlsx::createStyle}.
+#'     Defaults to "bold".
+#' @param \dots	Other arguments to be passed.
+#'
+#'
+#' @return None. One row in the workbook object is styled.
+#'
+#' @author Petter Hopp Petter.Hopp@@vetinst.no
+#' @export
+
+
+style_sum_line <- function(workbook = workbook,
+                           sheet = sheet,
+                           data,
+                           text = "Sum",
+                           text_decoration = "bold",
+                           ...) {
+
+  # ARGUMENT CHECKING ----
+  # Object to store check-results
+  checks <- checkmate::makeAssertCollection()
+
+  # Perform checks
+  checkmate::assert_class(workbook, classes = "Workbook", add = checks)
+  checkmate::assert_character(sheet, len = 1, min.chars = 1, add = checks)
+  checkmate::assert_data_frame(data, add = checks)
+  checkmate::assert_character(text, len = 1, add = checks)
+  checkmate::assert_character(text_decoration, len = 1, add = checks)
+
+  # Report check-results
+  checkmate::reportAssertions(checks)
+
+  # STYLING ----
+  # Style a row in the Excel sheet with the given text in a cell
+  openxlsx::addStyle(wb = workbook,
+                     sheet = sheet,
+                     style = openxlsx::createStyle(textDecoration = text_decoration),
+                     cols = 1:dim(data)[2],
+                     rows = which(data == text, arr.ind = TRUE)[1] + 1)
+
+}

R/write_ok_selection_list.R

@@ -0,0 +1,88 @@
+#' @title Writes an Excel file with the selection list.
+#'
+#' @description The selection list based on selected data from okplan file and
+#'     uses standardize_columns to  select, format and style columns.
+#'
+#' @param data The data with units that should be tested.
+#' @param filename The name of the Excel file that should be written.
+#' @param filepath The path to the Excel file that should be written.
+#' @param sheet The name of the Excel sheet with the list.
+#' @param calculate_sum \[logical\] Should a line with the sum be appended. Defaults to TRUE.
+#' @param dbsource The name of the dbtable in OK_column_standards that should
+#'     be used for standardizing the columns.
+#' @export
+
+
+write_ok_selection_list <- function(data,
+                                    sheet,
+                                    filename,
+                                    filepath,
+                                    calculate_sum = TRUE,
+                                    dbsource) {
+  # ARGUMENT CHECKING ----
+  # Object to store check-results
+  checks <- checkmate::makeAssertCollection()
+
+  # Perform checks
+  # for (i in 1:length(data)) {
+  checkmate::assert_data_frame(data, max.rows = (1048576 - 1), max.cols = 16384, add = checks)
+  # }
+  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)
+  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)
+  checkmate::assert_choice(dbsource,
+                           choices = unique(OKplan::OK_column_standards[, "table_db"]),
+                           add = checks)
+
+  # Report check-results
+  checkmate::reportAssertions(checks)
+
+  # GENERATE EXCEL WORKBOOK ----
+  okwb <- openxlsx::createWorkbook()
+
+  # for (i in 1:length(data)) {
+  # i <- 1
+  # STANDARDIZE COLUMNS ----
+  # column names
+  okdata <- NVIdb::standardize_columns(data,
+                                       standards = OKplan::OK_column_standards,
+                                       dbsource = dbsource,
+                                       property = "colnames")
+
+  # order columns and keep only designated columns
+  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)) {
+    okdata <- append_sum_line(data = okdata, column = c("ant_prover"), position = "left")
+  }
+
+  # Append date generated
+  okdata  <- append_date_generated_line(okdata)
+
+
+  # STYLE EXCEL SHEET ----
+  NVIpretty::add_formatted_worksheet(data = okdata,
+                                     workbook = okwb,
+                                     sheet = sheet,
+                                     wrapHeadlineText = TRUE,
+                                     collabels = TRUE,
+                                     colwidths = TRUE,
+                                     standards = OKplan::OK_column_standards,
+                                     dbsource = dbsource)
+
+
+  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)
+
+}

data-raw/generate_OK_column_standards.R

@@ -47,35 +47,14 @@ db_tables <- as.data.frame(unique(OK_column_standards$table_db)) %>%
   dplyr::mutate_if(is.list, purrr::simplify_all) %>%    # flatten each list element internally
   tidyr::unnest(cols = "table")# expand
 
-# Started alternative code without dplyr, purr and tidyr
-# # Generate data frame with all table names
-# db_tables <- as.data.frame(unique(OK_column_standards$table_db))
-# colnames(db_tables) <- "tables"
-# db_tables$table <- strsplit(db_tables$tables, split = ",")
-#
-# dplyr::mutate(table =  %>%
-#   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 %>%
   dplyr::left_join(db_tables, by = c("table_db" = "tables")) %>%
   dplyr::mutate(table_db = trimws(table)) %>%
-  dplyr::select(!table)
-
-# unique_colnames <- unique(column_standards[, c("colname_db", "colname")]) %>%
-#   poorman::add_count(colname_db, name = "unique_colnames") %>%
-#   poorman::mutate(unique_colnames = poorman::case_when(unique_colnames == 1 ~ 1,
-#                                                    TRUE ~ 0))
-#
-# OK_column_standards <- OK_column_standards %>%
-#   poorman::left_join(unique_colnames, by = c("colname_db" = "colname_db", "colname" = "colname"))
+  dplyr::select(!table) %>%
+  dplyr::mutate(table_db = tolower(table_db))
 
 # SAVE IN PACKAGE DATA ----
 usethis::use_data(name = OK_column_standards, overwrite = TRUE, internal = FALSE)
 
-# write.csv2(OK_column_standards,
-#            file = paste0(set_dir_NVI("ProgrammeringR"), "standardization/OK_column_standards.csv"),
-#            row.names = FALSE,
-#            fileEncoding = "UTF-8")