Merge pull request #19 from PetterHopp/main

NVIdb v0.9.0
NorwegianVeterinaryInstitute · Jan 16, 2023 · 00a75e5 · 00a75e5
2 parents 38c625f + 19f97a1
commit 00a75e5
Show file tree

Hide file tree

Showing 43 changed files with 1,186 additions and 238 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: NVIdb
 Title: Tools to facilitate the use of NVI's databases
-Version: 0.8.0
-Date: 2022-10-25
+Version: 0.9.0
+Date: 2023-01-16
 Authors@R: 
   c(person(given = "Petter",
            family = "Hopp",
@@ -32,16 +32,18 @@ Imports:
     utils,
     checkmate,
     data.table,
+    DBI,
     dplyr,
     getPass,
     keyring,
     knitr,
     magrittr,
-    poorman (>= 0.2.3),
+    odbc,
     remotes,
     rlang,
     rmarkdown,
     RODBC,
+    RPostgreSQL,
     R.rsp,
     shiny,
     snakecase,
@@ -63,7 +65,7 @@ LazyData: true
 Encoding: UTF-8
 Language: en-GB
 Roxygen: list(markdown = FALSE)
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.3
 VignetteBuilder: 
     knitr,
     R.rsp
diff --git a/NAMESPACE b/NAMESPACE
@@ -23,6 +23,7 @@ export(copy_Prodtilskudd)
 export(copy_kommune_fylke)
 export(copy_poststed)
 export(copy_prodnr_2_current_prodnr)
+export(cut_slash)
 export(exclude_from_PJSdata)
 export(get_PAT)
 export(login)
@@ -38,12 +39,14 @@ export(read_MT_omrader)
 export(read_PJS_codes_2_text)
 export(read_Pkode_2_text)
 export(read_Prodtilskudd)
+export(read_eos_data)
 export(read_kommune_fylke)
 export(read_leveransereg)
 export(read_poststed)
 export(read_prodnr_2_coordinates)
 export(read_prodnr_2_current_prodnr)
 export(read_sonetilhorighet)
+export(read_varekode)
 export(remove_PAT)
 export(remove_credentials)
 export(set_PAT)

diff --git a/NEWS b/NEWS
@@ -1,32 +1,56 @@
+NVIdb 0.9.0 - (2023-01-16)
+----------------------------------------
+
+New features:
+
+- Created `read_eos_data` for reading one or more years from EOS data for one surveillance programme from exported csv-files.
+
+- Created `read_varekode` for reading the formatted varekoderegister or the raw data to update the formatted varekoderegister.
+
+- `login`, `login_by_credentials` and `login_by_input` now accept the argument `dbinterface` with the R-package names "RODBC", "odbc" or, "RPostgreSQL" as input.
+
+- Created `cut_slash` to remove ending slash from path. This is useful if pathnames should be created using `base::file.path`.
+
+
+Bug fixes:
+
+- Fixed `add_PJS_code_description` when argument `backwards` = "TRUE" for R > 4.2.
+
+
+Other changes:
+
+- Corrected argument checking of `pkode_year` in `read_Prodtilskudd` and `copy_Prodtilskudd`.
+
+
 NVIdb 0.8.0 - (2022-10-25)
 --------------------------
 
 New features:
 
-- build_query_outbreak builds a query for retrieving outbreak data from PJS. Potential inputs are period, hensiktkode, utbrudd_id, analyttkode and metodekode. 
+- `build_query_outbreak` builds a query for retrieving outbreak data from PJS. Potential inputs arguments are `period`, `hensiktkode`, `utbrudd_id`, `analyttkode` and `metodekode`. 
 
-- set_disease_selection_parameters creates a list object with selection parameters from input arguments or by sourcing an R script that sets the input values (a "purpose" file).
+- `set_disease_selection_parameters` creates a list object with selection parameters from input arguments or by sourcing an R script that sets the input values (a "purpose" file).
 
-- read_Pkode_2_text now reads translation table for Pkoder from 1995 to current year as default. Column names are changed in accord with standard conventions. Use keep_old_names = TRUE to keep old names. 
+- `read_Pkode_2_text` now reads translation table for Pkoder from 1995 to current year as default. Column names are changed in accord with standard conventions. Use `keep_old_names` = "TRUE" to keep old names. 
 
-- add_PJS_code_description can now perform backward translation from PJS description text to PJS-code. Use 'backward = TRUE'. Backward translation only works when the description text is unique per code. Case is ignored for backward translation.
+- `add_PJS_code_description` can now perform backward translation from PJS description text to PJS-code. Use `backward` = "TRUE". Backward translation only works when the description text is unique per code. Case is ignored for backward translation.
 
-- add_PJS_code_description, choose_PJS_levels, and standardize_PJS_data now handles the levels subundersokelse and subresultat. 
+- `add_PJS_code_description`, `choose_PJS_levels`, and `standardize_PJS_data` now handles the levels subundersokelse and subresultat. 
 
-- set_dir_NVI now accepts abbreviated input for datasource. The abbreviation must be unique.
+- `set_dir_NVI` now accepts abbreviated input for `datasource`. The abbreviation must be unique.
 
-- add-functions (add_kommune_fylke, add_MT_omrader, add_PJS_code_description, add_poststed and add_produsent_properties) now accepts abbreviated input for position. The abbreviation must be unique.
+- add-functions (`add_kommune_fylke`, `add_MT_omrader`, `add_PJS_code_description`, `add_poststed` and `add_produsent_properties`) now accepts abbreviated input for `position`. The abbreviation must be unique.
 
 
 Bug fixes:
 
-- add_produsent_properties replaces add_produsent. add_produsent_properties now correctly adds geo-coordinates also when information on geo-coordinates is missing.
+- `add_produsent_properties` replaces `add_produsent`. `add_produsent_properties` now correctly adds geo-coordinates also when information on geo-coordinates is missing.
 
-- copy-functions (copy_kommune_fylke, copy_MT_omrader, copy_PJS_code_2_text, copy_Pkode_2_text, copy_poststed, copy_prodnr_2_current_prodnr, and copy_Prodtilskudd),  now accepts "from_path" and "to_path" that ends with "\\".
+- copy-functions (`copy_kommune_fylke`, `copy_MT_omrader`, `copy_PJS_code_2_text`, `copy_Pkode_2_text`, `copy_poststed`, `copy_prodnr_2_current_prodnr`, and `copy_Prodtilskudd`),  now accepts `from_path` and `to_path` that ends with "\\".
 
-- read-functions (read_kommune_fylke, read_leveransereg, read_MT_omrader, read_PJS_code_2_text, read_Pkode_2_text, read_poststed, read_prodnr_2_coordinates, read_prodnr_2_current_prodnr, read_Prodtilskudd, and read_sonetilhorighet),  now accepts "from_path" that ends with "\\".
+- read-functions (`read_kommune_fylke`, `read_leveransereg`, `read_MT_omrader`, `read_PJS_code_2_text`, `read_Pkode_2_text`, `read_poststed`, `read_prodnr_2_coordinates`, `read_prodnr_2_current_prodnr`, `read_Prodtilskudd`, and `read_sonetilhorighet`),  now accepts `from_path` that ends with "\\".
 
-- exclude_from_PJSdata now returns correct data frame if quality = "include".
+- `exclude_from_PJSdata` now returns correct data frame if `quality` = "include".
 
 
 Other changes:
@@ -44,17 +68,17 @@ Other changes:
 
 BREAKING CHANGES:
 
-- add_produsent is deprecated, use add_produsent_properties instead. See NVIdb-deprecated (help("NVIdb-deprecated")).
+- `add_produsent` is deprecated, use `add_produsent_properties` instead. See NVIdb-deprecated (help("NVIdb-deprecated")).
 
-- Default translation table read by read_Pkode_2_text has new default column names. Use keep_old_names = TRUE to keep old names. 
+- Default translation table read by `read_Pkode_2_text` has new default column names. Use `keep_old_names` = "TRUE" to keep old names. 
 
 
 NVIdb 0.7.1 - (2022-08-24)
 --------------------------
 
 Bug fixes:
 
-- fixed problem with installation when build_vignette = TRUE.
+- fixed problem with installation when `build_vignette` = "TRUE".
 
 
 NVIdb 0.7.0 - (2022-03-14)

diff --git a/R/add_PJS_code_description.R b/R/add_PJS_code_description.R
@@ -272,7 +272,7 @@ add_PJS_code_description <- function(data,
 
       # Transforms code_colname in data to lower case.
       data$code_colname_org_case <- data[, code_colname[i]]
-      data[, code_colname[i]] <- tolower(data[, code_colname[i]])
+      data[, code_colname[i]] <- sapply(data[, code_colname[i]], FUN = tolower)
     }
 
     # code_2_description <- translation_table[base::which(translation_table$type == PJS_variable_type[i] & is.na(translation_table$utgatt_dato)), ]

diff --git a/R/copy_Prodtilskudd.R b/R/copy_Prodtilskudd.R
@@ -25,12 +25,12 @@ copy_Prodtilskudd <- function(from_path = paste0(set_dir_NVI("Prodtilskudd"), "F
     checkmate::assert_directory_exists(to_path, access = "r", add = checks)
   }
   checkmate::assert_subset(Pkode_month, choices = c("both", "last", "01", "03", "05", "07", "10", "12"), add = checks)
-  NVIcheckmate::assert(checkmate::check_integerish(as.numeric(Pkode_year[which(!grepl('[:alpha:]', Pkode_year))]),
+  checkmate::assert(checkmate::check_integerish(as.numeric(Pkode_year[grep('[[:alpha:]]', Pkode_year, invert = TRUE)]),
                                                 lower = 1995,
                                                 upper = as.numeric(format(Sys.Date(), "%Y")),
                                                 any.missing = FALSE,
+                                                all.missing = FALSE,
                                                 unique = TRUE),
-                    # checkmate::check_character(Pkode_year, min.chars = 4, min.len = 1, any.missing = FALSE),
                     checkmate::check_choice(Pkode_year, choices = c("last")),
                     add = checks)
 

diff --git a/R/login.R b/R/login.R
@@ -49,7 +49,10 @@
 #'     \code{\link{set_credentials_EOS}}, no input is needed.
 #'
 #'     The login functions returns an open ODBC-channel to the database service.
-#'     The database can then be queried by using functions in the package \code{RODBC}.
+#'     The database can then be queried by using functions in the package used for 
+#'     data base interface. The data base interface must be one of \code{odbc}, 
+#'     \code{RODBC} or, \code{RPostgreSQL}. The default is given in NVIconfig and is 
+#'     \code{RODBC} for "SQL server" and \code{RPostgreSQL} for "PostgreSQL".
 #'
 #'     When the session is finished, the script shall close the ODBC-channel by
 #'     \code{odbcClose("myodbcchannel")} or \code{odbcCloseAll}.
@@ -62,6 +65,8 @@
 #' @param dbserver Name of database server.
 #' @param dbport Port.
 #' @param dbprotocol Protocol to be used.
+#' @param dbinterface The R-package that is used for interface towards the data 
+#'     base.
 #' @param dbtext used in login with input. Gives the possibility of showing
 #'     another name than the dbservice in the windows asking for username and
 #'     password.
@@ -75,7 +80,7 @@
 #' require(RODBC)
 #' journal_rapp <- login_PJS()
 #' # Reads hensiktregistret from PJS
-#'   hensikter <- sqlQuery(journal_rapp,
+#' hensikter <- sqlQuery(journal_rapp,
 #'                        "select * from v_hensikt",
 #'                        as.is = TRUE,
 #'                        stringsAsFactors = FALSE)
@@ -88,7 +93,8 @@ login <- function(dbservice,
                   db = NULL,
                   dbserver = NULL,
                   dbport = NULL,
-                  dbprotocol = NULL) {
+                  dbprotocol = NULL,
+                  dbinterface = NULL) {
 
   # ARGUMENT CHECKING ----
   # Object to store check-results
@@ -100,7 +106,7 @@ login <- function(dbservice,
 
 
   # Identifies if predefined connection parameters are needed
-  if (is.null(dbdriver) | is.null(db) | is.null(dbserver) | is.null(dbport) | is.null(dbprotocol)) {
+  if (is.null(dbdriver) | is.null(db) | is.null(dbserver) | is.null(dbport) | is.null(dbprotocol) | is.null(dbinterface)) {
     # Identify if NVIconfig are installed and parameters for dbservice exists.
     NVIcheckmate::assert_package(x = "NVIconfig",
                                  comment = paste0("Parameters for logging into the database '",
@@ -122,6 +128,7 @@ login <- function(dbservice,
       if (is.null(dbserver)) {dbserver <- connect[, "dbserver"]}
       if (is.null(dbport)) {dbport <- connect[, "dbport"]}
       if (is.null(dbprotocol)) {dbprotocol <- connect[, "dbprotocol"]}
+      if (is.null(dbinterface)) {dbinterface <- connect[, "dbinterface"]}
     }
   }
 
@@ -135,6 +142,8 @@ login <- function(dbservice,
   checkmate::assert_character(dbport, len = 1, any.missing = FALSE, add = checks)
   # dbprotocol
   checkmate::assert_character(dbprotocol, min.chars = 1, len = 1, any.missing = FALSE, add = checks)
+  # dbinterface
+  checkmate::assert_choice(dbinterface, choices = c("odbc", "RODBC", "RPostgreSQL"), add = checks)
 
   # Report check-results
   checkmate::reportAssertions(checks)
@@ -186,7 +195,8 @@ login <- function(dbservice,
                          db,
                          dbserver,
                          dbport,
-                         dbprotocol)
+                         dbprotocol,
+                         dbinterface)
   } else {
     # If credentials are missing from the user profile
     login_by_input(dbservice,
@@ -204,64 +214,56 @@ login <- function(dbservice,
 #' @export
 #' @rdname login
 
-login_PJS <- function() {
+login_PJS <- function(dbinterface = NULL) {
 
+  # ARGUMENT CHECKING ----
+  # Object to store check-results
+  checks <- checkmate::makeAssertCollection()
+
+  # dbinterface
+  checkmate::assert_choice(dbinterface, choices = c("odbc", "RPostgreSQL", "RODBC"), null.ok = TRUE, add = checks)
+
+  # Report check-results
+  checkmate::reportAssertions(checks)
+
   # Set service to PJS
   dbservice <- "PJS"
 
-  # # Check if credentials for PJS is stored in the user profile
-  # # 1. keyring package is missing
-  # # Use of require is avoided as loading packages should be avoided in package functions
-  # # This implies that there is no check if keyring is correctly installed
-  # if (!is.element("keyring", utils::installed.packages()[, 1])) {
-  #   login_by_input(dbservice)
-  # } else {
-  #   if (!is.element(tolower(dbservice), tolower(keyring::key_list()[, 1]))) {
-  #     # 2. Credentials for PJS are missing from the user profile
-  #     login_by_input(dbservice)
-  #   } else {
-  #     login_by_credentials(dbservice)
-  #   }
-  # }
   # Use check for saved credentials to chose between login_by_input and login_by_credentials
   if (isTRUE(NVIcheckmate::check_credentials(dbservice))) {
     # If credentials are saved for the user profile
-    login_by_credentials(dbservice)
+    login_by_credentials(dbservice, dbinterface = dbinterface)
   } else {
     # If credentials are missing from the user profile
-    login_by_input(dbservice)
+    login_by_input(dbservice, dbinterface = dbinterface)
   }
 }
 
 
 #' @export
 #' @rdname login
 
-login_EOS <- function() {
+login_EOS <- function(dbinterface = NULL) {
 
+  # ARGUMENT CHECKING ----
+  # Object to store check-results
+  checks <- checkmate::makeAssertCollection()
+
+  # dbinterface
+  checkmate::assert_choice(dbinterface, choices = c("odbc", "RPostgreSQL", "RODBC"), null.ok = TRUE, add = checks)
+
+  # Report check-results
+  checkmate::reportAssertions(checks)
+
   # Set service to EOS
   dbservice <- "EOS"
 
-  # # Check if credentials for EOS is stored in the user profile
-  # # 1. keyring package is missing
-  # # Use of require is avoided as loading packages should be avoided in package functions
-  # # This implies that there is no check if keyring is correctly installed
-  # if (!is.element("keyring", utils::installed.packages()[, 1])) {
-  #   login_by_input(dbservice)
-  # } else {
-  #   if (!is.element(tolower(dbservice), tolower(keyring::key_list()[, 1]))) {
-  #     # 2. Credentials for PJS are missing from the user profile
-  #     login_by_input(dbservice)
-  #   } else {
-  #     login_by_credentials(dbservice)
-  #   }
-  # }
   # Use check for saved credentials to chose between login_by_input and login_by_credentials
   if (isTRUE(NVIcheckmate::check_credentials(dbservice))) {
     # If credentials are saved for the user profile
-    login_by_credentials(dbservice)
+    login_by_credentials(dbservice, dbinterface = dbinterface)
   } else {
     # If credentials are missing from the user profile
-    login_by_input(dbservice)
+    login_by_input(dbservice, dbinterface = dbinterface)
   }
 }