diff --git a/.Rbuildignore b/.Rbuildignore index 20ebdd9..8bbfc42 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -6,7 +6,9 @@ ^build.R ^install.R ^style.R -^README.md +^README\.md +^README\.Rmd ^doc$ ^Meta$ ^OKplan.Rcheck\vign_test$ +^CONTRIBUTING\.md diff --git a/.gitignore b/.gitignore index b7f403a..6d6372a 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,4 @@ .Ruserdata *.Rproj *.Rcheck +inst/doc diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000..96ba540 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,214 @@ +# Contribute to OKplan + + + +Thank you for considering contributing to `OKplan`. + +`OKplan` is one of several packages assembled under the name `NVIverse`, +a collection of R-packages with tools to facilitate data management and +data reporting at the Norwegian Veterinary Institute (NVI). + +### NVIverse packages + + +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
PackageStatusDescription
NVIconfigPrivateConfiguration information necessary for some NVIverse functions
NVIdbPublicTools to facilitate the use of NVI’s databases
NVIprettyPublicTools to make R-output pretty in accord with NVI’s graphical profile
NVIbatchPublicTools to facilitate the running of R-scripts in batch mode at NVI
OKplanPublicTools to facilitate the planning of surveillance programmes for the NFSA
OKcheckPublicTools to facilitate checking of data from national surveillance programmes
NVIcheckmatePublicExtension of checkmate with argument checking adapted for NVIverse
NVIpackagerPublicTools to facilitate the development of NVIverse packages
+ +How you can contribute +---------------------- + +There are several ways you can contribute to this project: ask a +question, propose an idea, report a bug, improve the documentation, or +contribute code. + +### Ask a question + +Using `OKplan` and need help? Browse the package help to see if you can +find a solution. Still problems? Post your question in R-forum at +workplace or contact the package maintainer by +[email](mailto:petter.hopp@vetinst.no). + +### Propose an idea + +Have an idea for a new `OKplan` feature? Take a look at the `OKplan` +help and [issue +list](https://github.com/NorwegianVeterinaryInstitute/OKplan/issues) to +see if it isn’t included or suggested yet. If not, suggest your idea as +an [issue on +GitHub](https://github.com/NorwegianVeterinaryInstitute/OKplan/issues/new). +While we can’t promise to implement your idea, it helps to: + +- Explain in detail how it would work. +- Keep the scope as narrow as possible. + +See below if you want to contribute code for your idea as well. + +### Report a bug + +Using `OKplan` and discovered a bug? Don’t let others have the same +experience and report it as an [issue on +GitHub](https://github.com/NorwegianVeterinaryInstitute/OKplan/issues/new) +so we can fix it. A good bug report makes it easier for us to do so, so +please include: + +- Any details about your local setup that might be helpful in + troubleshooting. +- Detailed steps to reproduce the bug. + +### Improve the documentation + +Noticed a typo on the function help? Think a function could use a better +example? Good documentation makes all the difference, so your help to +improve it is very welcome! + +Functions are described as comments near their code and translated to +documentation using [`roxygen2`](https://klutometis.github.io/roxygen/). +If you want to improve a function description: + +1. Go to `R/` directory in the [code + repository](https://github.com/NorwegianVeterinaryInstitute/OKplan/tree/main/R). +2. Look for the file with the name of the function. +3. [Propose a file + change](https://help.github.com/articles/editing-files-in-another-user-s-repository/) + to update the function documentation in the roxygen comments + (starting with `#'`). + +### Contribute code + +Care to fix bugs or implement new functionality for our\_package? Great! +Have a look at the [issue +list](https://github.com/NorwegianVeterinaryInstitute/OKplan/issues) and +leave a comment on the things you want to work on. See also the +development guidelines below. + +Development guidelines +---------------------- + +If you want to contribute code, you are welcome to do so. Please try to +adhere to some principles and style convention used for +`NVIverse`-packages. + +- Please limit the number of package dependencies for `OKplan`. The + use of base functions is much appreciated. + +- New code should generally follow the tidyverse [style + guide](http://style.tidyverse.org). I recommend to use the + [`styler`](https://CRAN.R-project.org/package=styler) package to + apply spaces: `styler::style_file(filename, scope = "spaces")`. + Please don’t restyle code that has nothing to do with your pull + request. + +- You should add a bullet point to `NEWS.md` motivating the change. + +- You should add yourself as a contributor to the `DESCRIPTION`. + +- If you’re adding a new function or new arguments to an existing + function, you’ll also need to document them. `NVIverse`-packages use + [`roxygen2`](https://cran.r-project.org/package=roxygen2), with + [Markdown + syntax](https://cran.r-project.org/web/packages/roxygen2/vignettes/markdown.html), + for documentation. Make sure to re-run `devtools::document()` on the + code before submitting. + +- `NVIverse`-packages use the assert-functions from + [`checkmate`](https://CRAN.R-project.org/package=checkmate) package + for argument checking as well as some additional assert\_functions + in + [`NVIcheckmate`](https://github.com/NorwegianVeterinaryInstitute/NVIcheckmate). + Adding argument checking for new functions and/or arguments will be + highly appreciated. + +- If you can, also write a test. `NVIverse`-packages use + [`testthat`](https://cran.r-project.org/package=testthat) for tests. + +- Also run `devtools::check()` to make sure your function doesn’t + imply downstream errors or warnings. + +### Git commit standards + +We follow the commit message style guide maintained within the +angular.js project. + +The start of commit messages should be one of the following: + +- feat: A new feature +- fix: A bug fix +- doc: Documentation only changes +- style: Changes that do not affect the meaning of the code + (white-space, formatting, missing semi-colons, etc) +- refactor: A code change that neither fixes a bug or adds a feature +- perf: A code change that improves performance +- test: Adding missing tests +- chore: Changes to the build process or auxiliary tools and libraries + such as documentation generation + +Do not capitalize the first letter. + +Code of conduct +--------------- + +Please note that this project is released with a [Contributor Code of +Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html). +By participating to this project, you agree to abide by its terms. + +References +---------- + +This document is adapted from a +[template](https://gist.github.com/peterdesmet/e90a1b0dc17af6c12daf6e8b2f044e7c) +by @peterdesmet . diff --git a/DESCRIPTION b/DESCRIPTION index 19f9482..c3e210d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,35 +1,42 @@ Package: OKplan -Title: Tools facilitating the planning of surveillance programmes for the NFSA -Version: 0.2.0 -Date: 2021-01-29 -Author: Petter Hopp -Maintainer: Petter Hopp -Description: The R-package include tools facilitating the planning of surveillance programmes - for the Norwegian Food Safety Authority. The package is under development. Included will - be tools for: - 1) Making the target population, - 2) Random selection, - 3) generate lists for the NFSA. +Title: Tools to facilitate the Planning of the annual Surveillance Programmes +Version: 0.3.0 +Date: 2021-11-29 +Authors@R: + c(person(given = "Petter", + family = "Hopp", + role = c("aut", "cre"), + email = "Petter.Hopp@vetinst.no"), + person(given = "Norwegian Veterinary Institute", + role = "cph")) +Description: Provide tools to facilitate the planning of the annual surveillance + programmes. The main focus is tools for generating standardized lists for + NFSA. URL: https://github.com/NorwegianVeterinaryInstitute/OKplan BugReports: https://github.com/NorwegianVeterinaryInstitute/OKplan/issues -Depends: R (>= 3.4.1) -License: Proprietary. Do not distribute outside the Norwegian Veterinary Institute +Depends: R (>= 3.5.0) +License: BSD_3_clause + file LICENSE Encoding: UTF-8 LazyData: true Imports: + checkmate, poorman, - NVIdb, - checkmate -RoxygenNote: 7.1.1 + stats, + NVIdb (>= 0.3.0) Suggests: - usethis, + covr, + devtools, + knitr, remotes, - testthat, + rmarkdown, roxygen2, - withr, - devtools, styler, - knitr, - rmarkdown + testthat, + usethis, + NVIpackager +Remotes: + NorwegianVeterinaryInstitute/NVIdb, + NorwegianVeterinaryInstitute/NVIpackager +RoxygenNote: 7.1.1 VignetteBuilder: knitr Language: en-GB diff --git a/NAMESPACE b/NAMESPACE index f39f8dd..5082727 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,7 @@ # Generated by roxygen2: do not edit by hand -export(control_OK_selection) -export(include_generated_date) +export(adjust_samples_to_budget) +export(append_date_generated_line) +export(append_sum_line) +export(check_OK_selection) export(make_random) diff --git a/NEWS b/NEWS index 08deedf..b8b250f 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,32 @@ +OKplan 0.3.0 - (2021-11-29) +--------------------------- + +New features: + +- adjust_sample_number adjusts the sample numbers per unit up or down to reach the total sample size in accord with the budget. + +- append_sum_line appends a line with the sum of samples to the table in Excel. + + +Bug fixes: + +- Included reference to NVIdb at GitHub to correct potential problems when installing the package. + + +Other changes: + + - Updated licence to BSD_3_clause and the copyright holder to Norwegian Veterinary Institute. + + - Updated documentation and help. + + +BREAKING CHANGES: + + - Renamed to append_date_generated_line from include_generated_date. + + OKplan 0.2.0 - (2021-01-29) --------------------------- +--------------------------- New features: @@ -7,7 +34,7 @@ New features: OKplan 0.1.1 - (2021-01-01) --------------------------- +--------------------------- Other changes: @@ -15,7 +42,7 @@ Other changes: OKplan 0.1.0 - (2020-12-30) --------------------------- +--------------------------- First release: diff --git a/R/adjust_samples_to_budget.R b/R/adjust_samples_to_budget.R new file mode 100644 index 0000000..2a937bd --- /dev/null +++ b/R/adjust_samples_to_budget.R @@ -0,0 +1,83 @@ +#' @title Adjust the sample size per selected unit +#' @description Adds new column with an adjusted the sample size per selected +#' unit. The total sample size is adjusted to be in accord with the total +#' budgeted sample size. +#' +#' @details The sample size should first be estimated by percentage or similar. +#' +#' @param data Data frame +#' @param budget The total budgeted sample number. +#' @param sample_to_adjust The name of the column with the sample number per unit that should be adjusted. +#' @param adjusted_sample The name of the column with the adjusted sample number per unit. +#' @param adjust_by The maximum number of samples that one should adjust by. +#' +#' @return A data frame with a new column with an adjusted sample number. +#' +#' @author Petter Hopp Petter.Hopp@@vetinst.no +#' @export +#' @examples +#' # Add data frame with sample number to adjust +#' x <- as.data.frame(cbind(c(1:10), +#' c(24, 30, 36, 12, 6, 18, 6, 0, 0, 0))) +#' colnames(x) <- c("id", "sample") +#' +#' # Adjust total sample number to budget +#' x <- adjust_samples_to_budget(data = x, +#' budget = 150, +#' 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 ---- + # Object to store check-results + checks <- checkmate::makeAssertCollection() + # Perform assertions + checkmate::assert_data_frame(x = data, all.missing = FALSE, add = checks) + checkmate::assert_integerish(budget, lower = 1, len = 1, any.missing = FALSE, add = checks) + checkmate::assert_choice(sample_to_adjust, choices = colnames(data), add = checks) + checkmate::assert_character(adjusted_sample, len = 1, min.chars = 1, any.missing = FALSE, add = checks) + checkmate::assert_integerish(adjust_by, lower = 1, len = 1, any.missing = FALSE, add = checks) + # Report errors + checkmate::reportAssertions(checks) + + # 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)) + + # 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) { + # Adjust for each sampled unit with the unit having the largest sample size first + for (i in c(1:dim(data)[1])) { + + # Justify by positive or negative number depending on whether sample size is too small or too large. + # If the difference is larger than adjust_by, then adjust by adjust_by + # Else adjust by 1 | -1 + # If no difference "adjust by" 0 + if (abs(difference[i]) >= adjust_by) { + 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))) + } + 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 + } + + } + } + # RETURN RESULT ---- + return(data) +} diff --git a/R/include_generated_date.R b/R/append_date_generated_line.R similarity index 86% rename from R/include_generated_date.R rename to R/append_date_generated_line.R index df96b5f..6937cd1 100644 --- a/R/include_generated_date.R +++ b/R/append_date_generated_line.R @@ -14,11 +14,11 @@ #' @examples #' \dontrun{ #' # Add row with generated date using standard values -#' gris_virus_slaktegris_utvalg <- include_generated_date(gris_virus_slaktegris_utvalg) +#' gris_virus_slaktegris_utvalg <- append_date_generated_line(gris_virus_slaktegris_utvalg) #' #' } #' -include_generated_date <- 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 new file mode 100644 index 0000000..dd165a2 --- /dev/null +++ b/R/append_sum_line.R @@ -0,0 +1,53 @@ +#' @title Append row with column sums +#' @description Appends a new row with column sums for selected columns. A pretext can be placed on the row. +#' +#' @details One row is appended to the data frame. The sum is calculated with na.rm = TRUE. +#' +#' If a tibble, it is transformed to a data frame to avoid errors if the pretext is to be placed in a numeric variable. +#' +#' @param data Data frame to which a row should be appended. +#' @param column Character vector. The column names of columns to sum. +#' @param pretext The explaining text before the sum, defaults to "Sum". +#' @param position The position for the pretext, on of c("first", left", "none"). defaults to left. +#' +#' @return A data frame with an appended row with sums. +#' +#' @author Petter Hopp Petter.Hopp@@vetinst.no +#' @export +#' @examples +#' \dontrun{ +#' # Append row with sum +#' gris_blodprover_slakteri <- append_sum_line(data = gris_blodprover_slakteri, +#' col_name = c("ant_prover"), +#' pretext = "Sum", +#' position = "first") +#' } +#' + + +append_sum_line <- function(data, column, pretext = "Sum", position = "left") { + + # Removes tibble as tibble will not accept the the pretext (character variable) in a numeric variable + data <- as.data.frame(data) + + # Sum for one or more columns + if (length(column) == 1) { + sum_column <- unname(sum(data[, column], na.rm = TRUE)) + } else { + sum_column <- unname(colSums(data[, column], na.rm = TRUE)) + } + + # 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) + } + + # RETURN RESULTS ---- + return(data) +} diff --git a/R/check_OK_selection.R b/R/check_OK_selection.R new file mode 100644 index 0000000..f7e3dac --- /dev/null +++ b/R/check_OK_selection.R @@ -0,0 +1,96 @@ +#' @title Control of standard output file with OK selection +#' @description Standard control by performing descriptive statistics of variables in the output file with OK selection. +#' +#' @details Under development. This should be rewritten to produce nicer output. +#' +#' Gives descriptive statistics of the selection. This is used to see if the number of selected units per category are correct. +#' If any mistakes are found, one must go back and correct in the script that produces the selection. +#' +#' Before the control is run, the column names must have been standardized using \code{NVIdb::standardize_columns}. +#' +#' @param data Data frame with selection for a OK programme. +#' +#' @return Prints results of the control to the output window. +#' +#' @author Petter Hopp Petter.Hopp@@vetinst.no +#' @export +#' @examples +#' \dontrun{ +#' # Checking OK selection data +#' +#' # Read example data +#' okplan_MRSA <- read.csv2(file = paste0( +#' set_dir_NVI("OKprogrammer"), +#' "Rutine", +#' plan_aar, +#' "/planlegging/resultater/utvalgslister/data_MRSA_alle_gris.csv"), +#' colClasses = colclasses, +#' fileEncoding = "UTF-8") +#' +#' # Control +#' check_OK_selection(okplan_MRSA) +#' +#' } +#' +#' +check_OK_selection <- function(data) { + + # Number of herds and samples that should be tested distributed on groups + print(stats::ftable(data[, c("ok_hensiktkode", "kategori", "statuskode")], exclude = NULL)) + + 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() + 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) + print(ktr) + + print("Utvalgte besetninger med missing prodnr8 eller missing navn") + print(subset(data[, c("eier_lokalitetnr", "eier_lokalitet", "postnr", "poststed")], + is.na(data$eier_lokalitetnr) | trimws(data$eier_lokalitetnr) == "" | + is.na(data$eier_lokalitet) | trimws(data$eier_lokalitet) == "")) + + + + # variabelfrekvenser + print(stats::ftable(data[, c("ok_hensiktkode", "statuskode", "kategori")], exclude = NULL)) + + + print(stats::ftable(data[, c("ok_programkode", "analyttkode")], exclude = NULL)) + print(stats::ftable(data[, c("mt_region")], exclude = NULL)) + print(stats::ftable(data[, c("mt_avdeling")], exclude = NULL)) + print(stats::ftable(data[, c("ok_aar")], exclude = NULL)) + print(stats::ftable(data[, c("ok_programkode")], exclude = NULL)) + print(stats::ftable(data[, c("ok_hensiktkode")], exclude = NULL)) + print(stats::ftable(data[, c("eier_lokalitettype")], exclude = NULL)) + print(stats::ftable(data[, c("analyttkode")], exclude = NULL)) + print(stats::ftable(data[, c("annen_aktortype")], exclude = NULL)) + print(stats::ftable(data[, c("annen_aktornr")], exclude = NULL)) + print(stats::ftable(data[, c("annen_aktor")], exclude = NULL)) + print(stats::ftable(data[, c("ant_prover", "statuskode")], exclude = NULL)) + print(stats::ftable(data[, c("ok_artkode")], exclude = NULL)) + print(stats::ftable(data[, c("ok_driftsformkode")], exclude = NULL)) + print(stats::ftable(data[, c("storrelseskategori", "statuskode")], exclude = NULL)) + print(stats::ftable(data[, c("kategori", "statuskode")], exclude = NULL)) + print(stats::ftable(data[, c("materialekode", "statuskode")], exclude = NULL)) + print(stats::ftable(data[, c("statuskode")], exclude = NULL)) + print(stats::ftable(data[, c("status_dato")], exclude = NULL)) + print(stats::ftable(data[, c("prioritet_av_reserve")], exclude = NULL)) + print(stats::ftable(data[, c("utvalg_laget_dato")], exclude = NULL)) + + # &oMTreg*&ostatus &oMTavd*&ostatus + + # &otidspunkt &otidsenhet &olab &oRefNr + # &omottatt + # +} + + diff --git a/R/control_OK_selection.R b/R/control_OK_selection.R deleted file mode 100644 index 004da51..0000000 --- a/R/control_OK_selection.R +++ /dev/null @@ -1,92 +0,0 @@ -#' @title Control of standard output file with OK selection -#' @description Standard control by performing descriptive statistics of variables in the output file with OK selection. -#' -#' @details Under development. This should be rewritten to produce nicer output. -#' -#' Gives descriptive statistics of the selection. This is used to see if the number of selected units per category are correct. -#' If any mistakes are found, one must go back and correct in the script that produces the selection. -#' -#' Before the control is run, the column names must have been standardized using \code{NVIdb::standardize_columns}. -#' -#' @param data Data frame with selection for a OK programme. -#' -#' @return Prints results of the control to the output window. -#' -#' @author Petter Hopp Petter.Hopp@@vetinst.no -#' @export -#' @examples -#' \dontrun{ -#' # Control OK selection data -#' -#' # Read example data -#' okplan_MRSA <- read.csv2(file = paste0(set_dir_NVI("OKprogrammer"), "Rutine", plan_aar, "/planlegging/resultater/utvalgslister/data_MRSA_alle_gris.csv"), -#' colClasses = colclasses, -#' fileEncoding = "UTF-8") -#' -#' # Control -#' control_OK_selection(okplan_MRSA) -#' -#' } -#' -#' -control_OK_selection <- function(data) { - - # Antall besetninger og prøver som skal testes fordelt på grupper - print(ftable(data[, c("ok_hensiktkode", "kategori", "statuskode")], exclude = NULL)) - - print("Totalt antall besetninger og prøver som skal testes") - ktr <- data %>% - poorman::group_by(ok_artkode, statuskode) %>% - poorman::summarise(antall = n(), ant_prover = sum(ant_prover, na.rm = TRUE), .groups = "keep") %>% - poorman::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) - print(ktr) - - print("Utvalgte besetninger med missing prodnr8 eller missing navn") - print(subset(data[, c("eier_lokalitetnr", "eier_lokalitet", "postnr", "poststed")], - is.na(data$eier_lokalitetnr) | trimws(data$eier_lokalitetnr) == "" | - is.na(data$eier_lokalitet) | trimws(data$eier_lokalitet) == "")) - - - - # variabelfrekvenser - print(ftable(data[, c("ok_hensiktkode", "statuskode", "kategori")], exclude = NULL)) - - - print(ftable(data[, c("ok_programkode", "analyttkode")], exclude = NULL)) - print(ftable(data[, c("mt_region")], exclude = NULL)) - print(ftable(data[, c("mt_avdeling")], exclude = NULL)) - print(ftable(data[, c("ok_aar")], exclude = NULL)) - print(ftable(data[, c("ok_programkode")], exclude = NULL)) - print(ftable(data[, c("ok_hensiktkode")], exclude = NULL)) - print(ftable(data[, c("eier_lokalitettype")], exclude = NULL)) - print(ftable(data[, c("analyttkode")], exclude = NULL)) - print(ftable(data[, c("annen_aktortype")], exclude = NULL)) - print(ftable(data[, c("annen_aktornr")], exclude = NULL)) - print(ftable(data[, c("annen_aktor")], exclude = NULL)) - print(ftable(data[, c("ant_prover", "statuskode")], exclude = NULL)) - print(ftable(data[, c("ok_artkode")], exclude = NULL)) - print(ftable(data[, c("ok_driftsformkode")], exclude = NULL)) - print(ftable(data[, c("storrelseskategori", "statuskode")], exclude = NULL)) - print(ftable(data[, c("kategori", "statuskode")], exclude = NULL)) - print(ftable(data[, c("materialekode", "statuskode")], exclude = NULL)) - print(ftable(data[, c("statuskode")], exclude = NULL)) - print(ftable(data[, c("status_dato")], exclude = NULL)) - print(ftable(data[, c("prioritet_av_reserve")], exclude = NULL)) - print(ftable(data[, c("utvalg_laget_dato")], exclude = NULL)) - - # &oMTreg*&ostatus &oMTavd*&ostatus - - # &otidspunkt &otidsenhet &olab &oRefNr - # &omottatt - # -} - - diff --git a/R/make_random.R b/R/make_random.R index 2a9bd52..5865b80 100644 --- a/R/make_random.R +++ b/R/make_random.R @@ -1,12 +1,15 @@ #' @title Add new column with random numbers #' @description Adds new column with random numbers. The function is built to be able to use it in piping. #' -#' @details To make reproducible random numbers the seed can be initialized with a specific value. The first time the seed is used, set \code{init_seed = TRUE}. -#' Thereafter, use \code{init_seed = FALSE} if more random numbers are generated in the session to avoid overlapping random numbers. +#' @details To make reproducible random numbers the seed can be initialized with a +#' specific value. The first time the seed is used, set \code{init_seed = TRUE}. +#' Thereafter, use \code{init_seed = FALSE} if more random numbers are generated +#' in the session to avoid overlapping random numbers. #' #' @param data Data frame #' @param colname The name of the new column with the random number. #' @param seed The initializing seed +#' @param init_seed Should the seed be initialized, defaults to FALSE. #' #' @return A data frame with a new column with a random variable. #' @@ -34,7 +37,7 @@ make_random <- function(data, colname = "random", seed = -1, init_seed = FALSE) # Argument checking checks <- checkmate::makeAssertCollection() checkmate::assert_data_frame(data, add = checks) - checkmate::assert_character(colname, add = checks) + checkmate::assert_character(colname, len = 1, min.chars = 1, any.missing = FALSE, add = checks) checkmate::assert_number(seed, add = checks) checkmate::assert_logical(init_seed, add = checks) checkmate::reportAssertions(checks) @@ -43,7 +46,7 @@ make_random <- function(data, colname = "random", seed = -1, init_seed = FALSE) if (init_seed == TRUE) {set.seed(seed)} # Generates new column with random numbers - data[, colname] <- runif(n = dim(data)[1]) + data[, colname] <- stats::runif(n = dim(data)[1]) return(data) } diff --git a/README.Rmd b/README.Rmd new file mode 100644 index 0000000..85be315 --- /dev/null +++ b/README.Rmd @@ -0,0 +1,71 @@ +--- +title: "README" +output: + md_document: + variant: markdown_github + +params: + NVIpkg: "OKplan" +--- + +```{r, include = FALSE} +NVIpkg <- params$NVIpkg +# NVIpkg <- stringi::stri_extract_last_words(usethis::proj_path()) +NVIpkg_inline <- paste0("`", NVIpkg, "`") + +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +`r paste0(NVIpkg, ": ", desc::desc_get_field(key = "Title"))` +================ + + + + - [Overview](#overview) + - [Installation](#installation) + - [Usage](#usage) + - [Copyright and license](#copyright-and-license) + - [Contributing](#contributing) + +## Overview +```{r, include = FALSE} +description <- desc::desc_get_field(key = "Description") +``` +`r paste0(NVIpkg_inline, + "", + sub(substr(description,1,1), tolower(substr(description,1,1)), description))` + +```{r child=system.file('templates', "README_NVIverse.Rmd", package = "NVIpackager")} +``` + +## Installation +```{r child=system.file('templates', "README_installation.Rmd", package = "NVIpackager")} +``` + +## Usage +```{r child=system.file('templates', "README_usage_attach.Rmd", package = "NVIpackager")} +``` + +`r paste0(NVIpkg_inline, + "", + sub(substr(description,1,1), tolower(substr(description,1,1)), description))` + +```{r child=system.file('templates', "README_usage_help.Rmd", package = "NVIpackager")} +``` + +## Copyright and license +```{r child=system.file('templates', "README_copyright_and_license.Rmd", package = "NVIpackager")} +``` + +## Contributing +```{r child=system.file('templates', "README_contributing.Rmd", package = "NVIpackager")} +``` + + +----- +```{r child=system.file('templates', "README_code_of_conduct.Rmd", package = "NVIpackager")} +``` + diff --git a/README.md b/README.md index f1c330d..f1d6ca1 100644 --- a/README.md +++ b/README.md @@ -1,8 +1,89 @@ -# OKplan -Tools facilitating the planning of surveillance programmes for the NFSA - -The R-package include tools facilitating the planning of surveillance programmes for the Norwegian Food Safety Authority. Tha package is under development. -Included will be tools for -- Making the target population -- Random selection -- generate lists for the NFSA +OKplan: Tools to facilitate the Planning of the annual Surveillance Programmes +============================================================================== + + + +- [Overview](#overview) +- [Installation](#installation) +- [Usage](#usage) +- [Copyright and license](#copyright-and-license) +- [Contributing](#contributing) + +Overview +-------- + +`OKplan`provide tools to facilitate the planning of the annual +surveillance programmes. The main focus is tools for generating +standardized lists for NFSA. + +`OKplan` is part of `NVIverse`, a collection of R-packages with tools to +facilitate data management and data reporting at the Norwegian +Veterinary Institute (NVI). The NVIverse consists of the following +packages: NVIconfig, NVIdb, NVIpretty, NVIbatch, OKplan, OKcheck, +NVIcheckmate, NVIpackager. See the vignette “Contribute to OKplan” for +more information. + +Installation +------------ + +`OKplan` is available at +[GitHub](https://github.com/NorwegianVeterinaryInstitute). To install +`OKplan` you will need: + +- R version > 4.0.0 +- R package `remotes` +- Rtools 4.0 + +First install and attach the `remotes` package. + + install.packages("remotes") + library(remotes) + +To install (or update) the `OKplan` package, run the following code: + + remotes::install_github("NorwegianVeterinaryInstitute/OKplan") + upgrade = FALSE, + build = TRUE, + build_manual = TRUE) + +Usage +----- + +The `OKplan` package needs to be attached. + + library(NVIdb) + +`OKplan`provide tools to facilitate the planning of the annual +surveillance programmes. The main focus is tools for generating +standardized lists for NFSA. + +The list of available functions and datasets can be accessed by typing + + help(package="NVIdb") + +Please check the NEWS for information on new features, bug fixes and +other changes. + +Copyright and license +--------------------- + +Copyright (c) 2021 Norwegian Veterinary Institute. +Licensed under the BSD\_3\_clause License. See +[License](https://github.com/NorwegianVeterinaryInstitute/OKplan/blob/main/LICENSE) +for details. + +Contributing +------------ + +Contributions to develop `OKplan` is highly appreciated. There are +several ways you can contribute to this project: ask a question, propose +an idea, report a bug, improve the documentation, or contribute code. +The vignette “Contribute to OKplan” gives more information. + + +------------------------ + +Please note that the OKplan project is released with a [Contributor Code +of +Conduct](https://github.com/NorwegianVeterinaryInstitute/OKplan/blob/main/CODE_OF_CONDUCT.md). +By contributing to this project, you agree to abide by its terms. diff --git a/data-raw/generate_OK_column_standards.R b/data-raw/generate_OK_column_standards.R index ea07788..ac862bd 100644 --- a/data-raw/generate_OK_column_standards.R +++ b/data-raw/generate_OK_column_standards.R @@ -20,29 +20,29 @@ library(usethis) # READS AND TRANSFORMS EXCEL SHEET WITH COLUMN STANDARD INFORMATION ---- OK_column_standards <- read.xlsx(xlsxFile = paste0(set_dir_NVI("ProgrammeringR"), "standardization/colnames/colnames_translation_table.xlsx")) %>% # Selects only information used in OK-planning - poorman::filter(db == "OK_planlegging") %>% + dplyr::filter(db == "OK_planlegging") %>% # Generates column labels based on label and spec for no and en # Use exactly same transformations as for column_standards - poorman::rename(label_no = collabel_no, label_en = collabel_en) %>% - poorman::mutate(label_1_no = poorman::case_when(is.na(spec_no) ~ label_no, + dplyr::rename(label_no = collabel_no, label_en = collabel_en) %>% + dplyr::mutate(label_1_no = dplyr::case_when(is.na(spec_no) ~ label_no, spec_no %in% c("dato", "geometrisk middel 3") ~ paste(label_no, spec_no), spec_no %in% c("kg", "kjennelse", "tid") ~ label_no, spec_no %in% c("antall undersøkt") ~ paste(spec_no, label_no), TRUE ~ spec_no)) %>% - poorman::mutate(label_1_en = poorman::case_when(is.na(spec_en) ~ label_en, + dplyr::mutate(label_1_en = dplyr::case_when(is.na(spec_en) ~ label_en, spec_en %in% c("date") ~ paste(label_en, spec_en), spec_en %in% c("kg", "time", "determination") ~ label_en, spec_en %in% c("No. tested") ~ paste(spec_en, label_en), TRUE ~ spec_en)) %>% # selects, renames and orders columns - poorman::select(db, table_db, colname_db, colname, label_1_no, label_no, spec_no, label_1_en, label_en, spec_en, + dplyr::select(db, table_db, colname_db, colname, label_1_no, label_no, spec_no, label_1_en, label_en, spec_en, colwidth_Excel = colwidth_excel, colwidth_DT = colwidth_dt_tables, colclasses, colorder) %>% - poorman::distinct() + dplyr::distinct() # Generate data frame with all table names db_tables <- as.data.frame(unique(OK_column_standards$table_db)) %>% - poorman::rename(tables = 1) %>% + 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 @@ -59,9 +59,9 @@ db_tables <- as.data.frame(unique(OK_column_standards$table_db)) %>% # Generate table with each table name on one line OK_column_standards <- OK_column_standards %>% - poorman::left_join(db_tables, by = c("table_db" = "tables")) %>% - poorman::mutate(table_db = trimws(table)) %>% - poorman::select(!table) + 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") %>% diff --git a/data/OK_column_standards.rda b/data/OK_column_standards.rda index b9dbb3f..88e87bf 100644 Binary files a/data/OK_column_standards.rda and b/data/OK_column_standards.rda differ diff --git a/man/adjust_samples_to_budget.Rd b/man/adjust_samples_to_budget.Rd new file mode 100644 index 0000000..0234a87 --- /dev/null +++ b/man/adjust_samples_to_budget.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/adjust_samples_to_budget.R +\name{adjust_samples_to_budget} +\alias{adjust_samples_to_budget} +\title{Adjust the sample size per selected unit} +\usage{ +adjust_samples_to_budget( + data, + budget, + sample_to_adjust, + adjusted_sample = "justert_ant_prover", + adjust_by +) +} +\arguments{ +\item{data}{Data frame} + +\item{budget}{The total budgeted sample number.} + +\item{sample_to_adjust}{The name of the column with the sample number per unit that should be adjusted.} + +\item{adjusted_sample}{The name of the column with the adjusted sample number per unit.} + +\item{adjust_by}{The maximum number of samples that one should adjust by.} +} +\value{ +A data frame with a new column with an adjusted sample number. +} +\description{ +Adds new column with an adjusted the sample size per selected + unit. The total sample size is adjusted to be in accord with the total + budgeted sample size. +} +\details{ +The sample size should first be estimated by percentage or similar. +} +\examples{ +# Add data frame with sample number to adjust +x <- as.data.frame(cbind(c(1:10), + c(24, 30, 36, 12, 6, 18, 6, 0, 0, 0))) +colnames(x) <- c("id", "sample") + +# Adjust total sample number to budget +x <- adjust_samples_to_budget(data = x, + budget = 150, + sample_to_adjust = "sample", + adjusted_sample = "new_sample", + adjust_by = 4) + +} +\author{ +Petter Hopp Petter.Hopp@vetinst.no +} diff --git a/man/include_generated_date.Rd b/man/append_date_generated_line.Rd similarity index 77% rename from man/include_generated_date.Rd rename to man/append_date_generated_line.Rd index edffbd0..64bd8e8 100644 --- a/man/include_generated_date.Rd +++ b/man/append_date_generated_line.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/include_generated_date.R -\name{include_generated_date} -\alias{include_generated_date} +% Please edit documentation in R/append_date_generated_line.R +\name{append_date_generated_line} +\alias{append_date_generated_line} \title{Add new last row with generated date} \usage{ -include_generated_date( +append_date_generated_line( data, pretext = "Datauttrekket er gjort", date = format(Sys.Date(), "\%d/\%m/\%Y") @@ -29,7 +29,7 @@ Two rows are dded to the data frame, the first is empty, the second has the gene \examples{ \dontrun{ # Add row with generated date using standard values -gris_virus_slaktegris_utvalg <- include_generated_date(gris_virus_slaktegris_utvalg) +gris_virus_slaktegris_utvalg <- append_date_generated_line(gris_virus_slaktegris_utvalg) } diff --git a/man/append_sum_line.Rd b/man/append_sum_line.Rd new file mode 100644 index 0000000..a7af178 --- /dev/null +++ b/man/append_sum_line.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/append_sum_line.R +\name{append_sum_line} +\alias{append_sum_line} +\title{Append row with column sums} +\usage{ +append_sum_line(data, column, pretext = "Sum", position = "left") +} +\arguments{ +\item{data}{Data frame to which a row should be appended.} + +\item{column}{Character vector. The column names of columns to sum.} + +\item{pretext}{The explaining text before the sum, defaults to "Sum".} + +\item{position}{The position for the pretext, on of c("first", left", "none"). defaults to left.} +} +\value{ +A data frame with an appended row with sums. +} +\description{ +Appends a new row with column sums for selected columns. A pretext can be placed on the row. +} +\details{ +One row is appended to the data frame. The sum is calculated with na.rm = TRUE. + + If a tibble, it is transformed to a data frame to avoid errors if the pretext is to be placed in a numeric variable. +} +\examples{ +\dontrun{ +# Append row with sum +gris_blodprover_slakteri <- append_sum_line(data = gris_blodprover_slakteri, + col_name = c("ant_prover"), + pretext = "Sum", + position = "first") +} + +} +\author{ +Petter Hopp Petter.Hopp@vetinst.no +} diff --git a/man/control_OK_selection.Rd b/man/check_OK_selection.Rd similarity index 62% rename from man/control_OK_selection.Rd rename to man/check_OK_selection.Rd index bae164b..5afe0a8 100644 --- a/man/control_OK_selection.Rd +++ b/man/check_OK_selection.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/control_OK_selection.R -\name{control_OK_selection} -\alias{control_OK_selection} +% Please edit documentation in R/check_OK_selection.R +\name{check_OK_selection} +\alias{check_OK_selection} \title{Control of standard output file with OK selection} \usage{ -control_OK_selection(data) +check_OK_selection(data) } \arguments{ \item{data}{Data frame with selection for a OK programme.} @@ -25,15 +25,19 @@ Under development. This should be rewritten to produce nicer output. } \examples{ \dontrun{ -# Control OK selection data +# Checking OK selection data # Read example data -okplan_MRSA <- read.csv2(file = paste0(set_dir_NVI("OKprogrammer"), "Rutine", plan_aar, "/planlegging/resultater/utvalgslister/data_MRSA_alle_gris.csv"), - colClasses = colclasses, - fileEncoding = "UTF-8") +okplan_MRSA <- read.csv2(file = paste0( + set_dir_NVI("OKprogrammer"), + "Rutine", + plan_aar, + "/planlegging/resultater/utvalgslister/data_MRSA_alle_gris.csv"), + colClasses = colclasses, + fileEncoding = "UTF-8") # Control -control_OK_selection(okplan_MRSA) +check_OK_selection(okplan_MRSA) } diff --git a/man/make_random.Rd b/man/make_random.Rd index c6998cb..997f3bc 100644 --- a/man/make_random.Rd +++ b/man/make_random.Rd @@ -12,6 +12,8 @@ make_random(data, colname = "random", seed = -1, init_seed = FALSE) \item{colname}{The name of the new column with the random number.} \item{seed}{The initializing seed} + +\item{init_seed}{Should the seed be initialized, defaults to FALSE.} } \value{ A data frame with a new column with a random variable. @@ -20,8 +22,10 @@ A data frame with a new column with a random variable. Adds new column with random numbers. The function is built to be able to use it in piping. } \details{ -To make reproducible random numbers the seed can be initialized with a specific value. The first time the seed is used, set \code{init_seed = TRUE}. - Thereafter, use \code{init_seed = FALSE} if more random numbers are generated in the session to avoid overlapping random numbers. +To make reproducible random numbers the seed can be initialized with a + specific value. The first time the seed is used, set \code{init_seed = TRUE}. + Thereafter, use \code{init_seed = FALSE} if more random numbers are generated + in the session to avoid overlapping random numbers. } \examples{ \dontrun{ diff --git a/notes/build.R b/notes/build.R deleted file mode 100644 index 45f2de3..0000000 --- a/notes/build.R +++ /dev/null @@ -1,59 +0,0 @@ -# TEST, DOCUMENT AND BUILD NVIdb PACKAGE - -# Set up environment -Rlibrary <- R.home() - -library(devtools) -library(roxygen2) -library(withr) - -# Creates new help files -# Should be run before git push when documentation for functions have been changed -devtools::document() - -# Run tests included in ./tests. NVIdb use thestthat -devtools::test() - -# Build the vignette -# devtools::build_vignettes() -# vignetteRDS <- readRDS("./Meta/vignette.rds") - -# devtools::build_manual() - -# Build the package -# system("R CMD build ../NVIdb") -devtools::build(binary = TRUE) -# devtools::build(binary = TRUE, manual = TRUE, vignettes = TRUE) - -# Extensive checking of package. Is done after build. Creates PDF-manual -system("R CMD check --ignore-vignettes ../OKplan") - -# Alternative for creating the PDF-manual. The manual is not put in the correct directory -# system(paste(shQuote(file.path(R.home("bin"), "R")), -# "CMD", -# "Rd2pdf", -# shQuote(paste0(Rlibrary,"/library/OKplan")))) - - - -# Innstall rebuilt package -detach("package:OKplan", unload=TRUE) - -with_libpaths(paste0(Rlibrary,"/library"), - install(sub("notes", "", dirname(rstudioapi::getSourceEditorContext()$path)), - dependencies = TRUE, - upgrade=FALSE, - build_vignettes = TRUE) -) - -# # Install from binary file -# remove.packages("OKplan") -# # install.packages("C:/Users/13hopp/Documents/GitProjects/OKplan_0.1.5.9000.zip", -# install.packages("C:/Users/13hopp/OneDrive - Veterinærinstituttet/R/OKplan_0.2.2.9002.zip", -# repos = NULL, -# type = "binary") - - -help(package="OKplan") -library(OKplan) - diff --git a/notes/develop.R b/notes/develop.R new file mode 100644 index 0000000..db5bd76 --- /dev/null +++ b/notes/develop.R @@ -0,0 +1,91 @@ +# TEST, DOCUMENT AND BUILD NVIdb PACKAGE + +# SET UP ENVIRONMENT ---- +# rm(list = ls()) # Benyttes for å tømme R-environment ved behov + +# Attach packages +# library(devtools) +# library(roxygen2) +library(NVIpackager) +library(spelling) + +# Global variables +pkg <- stringi::stri_extract_last_words(usethis::proj_path()) +pkg_path = usethis::proj_path() +# Rlibrary <- R.home() + +# create_NVIpkg_skeleton(license_keyword = "CC BY 4.0") + +# 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, + contributing = FALSE, + readme = FALSE, + scope = c("spaces", "line_breaks")) + + +# spelling::spell_check_package(vignettes = TRUE, use_wordlist = TRUE) + + +# Alternative for creating the PDF-manual. The manual is not put in the correct directory +# system(paste(shQuote(file.path(R.home("bin"), "R")), +# "CMD", +# "Rd2pdf", +# paste0("../", pkg))) +# file.copy(from = paste0(pkg, ".pdf"), to = "./vignettes", overwrite = TRUE) +# file.remove(".Rd2pdf16372") +# file.remove("NVIdb.pdf") +# check .install_extras + +# TEST PACKAGE ---- +# Run tests included in ./tests. +devtools::test() + +# Test package coverage +# DETACH PACKAGE +# The package must be detached to install it. +if(pkg %in% (.packages())){ + pkgname <- paste0("package:", pkg) + detach(pkgname, unload=TRUE, character.only = TRUE) +} +code_coverage <- covr::package_coverage(path = ".", group = "functions") +print(x = code_coverage, group = "functions") + +# devtools::build_manual(pkg = "../NVIpackager", path = "./vignettes") + +# Build the package +devtools::build(binary = FALSE, manual = TRUE, vignettes = TRUE) +# Test built package. +# Thereby, no problems with files in .Rbuildignore. +version <- packageVersion(pkg, lib.loc = paste0(getwd(),"/..")) +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 +# system("R CMD check --ignore-vignettes ../NVIdb") + + +# INSTALL PACKAGE ---- + +NVIpackager::install_NVIpkg(pkg = pkg, pkg_path = pkg_path, rsource = "local") + +# NVIpackager::install_NVIpkg(pkg = pkg, pkg_path = pkg_path, rsource = "github", username = "PetterHopp") +# +# NVIpackager::install_NVIpkg(pkg = pkg, pkg_path = pkg_path, rsource = "github", username = "NorwegianVeterinaryInstitute") +# +# # # Install from source file in catalog "NVIverse" +# utils::install.packages(pkgs = paste0(NVIconfig:::path_NVI["NVIverse"], "/", pkg, "/Arkiv/", pkg, "_", version, ".tar.gz"), +# repos = NULL, +# type = "source") +# +# # Install from binary file in catalog "NVIverse" +# install.packages(pkgs = paste0(NVIconfig:::path_NVI["NVIverse"], "/", pkg, "/Arkiv/", pkg, "_", version, ".zip"), +# repos = NULL, +# type = "binary") + +# ATTACH PACKAGE ---- +utils::help(package = (pkg)) + +library(package = pkg, character.only = TRUE) + + diff --git a/tests/testthat/test_OK_column_standards.R b/tests/testthat/test_OK_column_standards.R index 899e295..e26cd5c 100644 --- a/tests/testthat/test_OK_column_standards.R +++ b/tests/testthat/test_OK_column_standards.R @@ -1,32 +1,31 @@ library(NVIdb) library(OKplan) library(testthat) -context("OK_column_standards") test_that("Standard colwidths in Excel for OK-selections", { # Generate data frame with column names for table that should be exported to Excel # Example with selection of samples collected in herds - df <- cbind("ok_aar" = "2021", "rapport" = "Brucellose hos geit, utvalgsliste", - "mt_regionnr" = "M22000", "mt_region" = " Region Øst ", - "mt_avdelingnr" = " M22110", "mt_avdeling" = " Glåmdal og Østerdal ", - "eier_lokalitetnr" = "34343434", "eier_lokalitet" = "Gårdsbruk", "postnr" = "2560", "poststed" = " ALVDAL ", - "ant_prover" = 30) + df <- as.data.frame(cbind("ok_aar" = "2021", "rapport" = "Brucellose hos geit, utvalgsliste", + "mt_regionnr" = "M22000", "mt_region" = " Region Øst ", + "mt_avdelingnr" = " M22110", "mt_avdeling" = " Glåmdal og Østerdal ", + "eier_lokalitetnr" = "34343434", "eier_lokalitet" = "Gårdsbruk", "postnr" = "2560", "poststed" = " ALVDAL ", + "ant_prover" = 30)) # Make a vector with correct column names after translation - correct_result <- c(5, 10.78, 12.5, 16, 13, 33, 12, 30, 8, 15, 8.5) + correct_result <- c(5, 10.71, 12.5, 16, 13, 33, 12, 30, 8, 15, 8.5) # Compare Add fylke, current fylkenr and current fylke with correct result expect_equal(standardize_columns(data = df, dbsource = "geit_brucella_utvalg", - standards = OK_column_standards, + standards = OK_column_standards, property = "colwidths_Excel"), correct_result) # Generate data frame with column names for table that should be exported to Excel # Example with selection of samples collected at slaughterhouses - df <- cbind("mt_regionnr" = "M25000", "mt_region" = "Region Nord", - "mt_avdelingnr" = "M25150", "mt_avdeling" = "Finnmark", - "eier_lokalitetnr" = "802", "eier_lokalitet" = "NORTURA SA AVD. FINNMARK/KARASJOK", - "ant_prover" = 30) + df <- as.data.frame(cbind("mt_regionnr" = "M25000", "mt_region" = "Region Nord", + "mt_avdelingnr" = "M25150", "mt_avdeling" = "Finnmark", + "eier_lokalitetnr" = "802", "eier_lokalitet" = "NORTURA SA AVD. FINNMARK/KARASJOK", + "ant_prover" = 30)) # Make a vector with correct column names after translation @@ -34,7 +33,7 @@ test_that("Standard colwidths in Excel for OK-selections", { # Compare Add fylke, current fylkenr and current fylke with correct result expect_identical(standardize_columns(data = df, - dbsource = "sau_brucella_slakteri", + dbsource = "ok_blodprover_slakteri", standards = OK_column_standards, property = "colwidths_Excel"), correct_result) @@ -44,11 +43,11 @@ test_that("Standard colwidths in Excel for OK-selections", { test_that("Standard collabels for OK selections", { # Example with selection of samples collected in herds - df <- cbind("aar" = "2021", "rapport" = "Paratuberkulose hos storfe, utvalgsliste", - "mt_regionnr" = "M21000", "mt_region" = " Region Stor-Oslo", - "mt_avdelingnr" = "M21130", "mt_avdeling" = "Østfold og Follo", - "eier_lokalitetnr" = "3030303030", "eier_lokalitet" = "Gårdsbruk", "postnr" = "1747", "poststed" = "SKJEBERG", - "ant_prover" = 5, "provetakingstidspunkt" = 2) + df <- as.data.frame(cbind("aar" = "2021", "rapport" = "Paratuberkulose hos storfe, utvalgsliste", + "mt_regionnr" = "M21000", "mt_region" = " Region Stor-Oslo", + "mt_avdelingnr" = "M21130", "mt_avdeling" = "Østfold og Follo", + "eier_lokalitetnr" = "3030303030", "eier_lokalitet" = "Gårdsbruk", "postnr" = "1747", "poststed" = "SKJEBERG", + "ant_prover" = 5, "provetakingstidspunkt" = 2)) # Make a vector with correct column names after translation correct_result <- c("År", "Rapport", "MT regionnr", "MT region", "MT avdelingsnr", "MT avdeling", "Produsentnr", @@ -63,10 +62,10 @@ test_that("Standard collabels for OK selections", { # Generate column labels # Example with selection of samples collected at slaughterhouses - df <- cbind("mt_regionnr" = "M25000", "mt_region" = "Region Nord", - "mt_avdelingnr" = "M25150", "mt_avdeling" = "Finnmark", - "eier_lokalitetnr" = "802", "eier_lokalitet" = "NORTURA SA AVD. FINNMARK/KARASJOK", - "ant_prover" = 30) + df <- as.data.frame(cbind("mt_regionnr" = "M25000", "mt_region" = "Region Nord", + "mt_avdelingnr" = "M25150", "mt_avdeling" = "Finnmark", + "eier_lokalitetnr" = "802", "eier_lokalitet" = "NORTURA SA AVD. FINNMARK/KARASJOK", + "ant_prover" = 30)) # Make a vector with correct column names after translation @@ -74,7 +73,7 @@ test_that("Standard collabels for OK selections", { # Compare Add fylke, current fylkenr and current fylke with correct result expect_identical(standardize_columns(data = df, - dbsource = "sau_brucella_slakteri", + dbsource = "ok_blodprover_slakteri", standards = OK_column_standards, property = "collabels"), correct_result) diff --git a/tests/testthat/test_adjust_samples_to_budget.R b/tests/testthat/test_adjust_samples_to_budget.R new file mode 100644 index 0000000..a98d37b --- /dev/null +++ b/tests/testthat/test_adjust_samples_to_budget.R @@ -0,0 +1,104 @@ +library(OKplan) +library(testthat) + +test_that("Adjusting sample number", { + + total_budget <- 150 + # Add data frame with sample number to adjust + x <- as.data.frame(cbind(c(1:10), + c(24, 30, 36, 12, 6, 18, 6, 0, 0, 0))) + colnames(x) <- c("id", "sample") + + x2 <- adjust_samples_to_budget(data = x, + budget = total_budget, + sample_to_adjust = "sample", + adjusted_sample = "new_sample", + adjust_by = 6) + expect_identical(x2$new_sample, + c(42, 36, 30, 18, 12, 6, 6, 0, 0, 0)) + + x2 <- adjust_samples_to_budget(data = x, + budget = total_budget, + sample_to_adjust = "sample", + adjusted_sample = "new_sample", + adjust_by = 4) + expect_identical(x2$new_sample, + c(40, 34, 28, 22, 13, 7, 6, 0, 0, 0)) + + x2 <- adjust_samples_to_budget(data = x, + budget = total_budget, + sample_to_adjust = "sample", + adjusted_sample = "new_sample", + adjust_by = 10) + expect_identical(x2$new_sample, + c(46, 32, 26, 20, 13, 7, 6, 0, 0, 0)) + + total_budget <- 130 + + x2 <- adjust_samples_to_budget(data = x, + budget = total_budget, + sample_to_adjust = "sample", + adjusted_sample = "new_sample", + adjust_by = 6) + expect_identical(x2$new_sample, + c(35, 29, 24, 18, 12, 6, 6, 0, 0, 0)) + + x2 <- adjust_samples_to_budget(data = x, + budget = total_budget, + sample_to_adjust = "sample", + adjusted_sample = "new_sample", + adjust_by = 2) + expect_identical(x2$new_sample, + c(34, 30, 24, 18, 12, 6, 6, 0, 0, 0)) +}) + + +test_that("Errors for adjust_sample_number", { + + total_budget <- 150 + # Add data frame with sample number to adjust + x <- as.data.frame(cbind(c(1:10), + c(24, 30, 36, 12, 6, 18, 6, 0, 0, 0))) + colnames(x) <- c("id", "sample") + + expect_error( + adjust_samples_to_budget(data = total_budget, + budget = total_budget, + sample_to_adjust = "sample", + adjusted_sample = "new_sample", + adjust_by = 6), + regexpr = "Variable \'data\': Must be of type \'data.frame\'") + + expect_error( + adjust_samples_to_budget(data = x, + budget = 0, + sample_to_adjust = "sample", + adjusted_sample = "new_sample", + adjust_by = 6), + regexpr = "Variable \'budget\': Element 1 is not >= 1") + + expect_error( + adjust_samples_to_budget(data = x, + budget = total_budget, + sample_to_adjust = "samples", + adjusted_sample = "new_sample", + adjust_by = 6), + regexpr = "Variable \'sample_to_adjust\': Must be element of set {\'id\',\'sample\'}, but is \'samples\'") + + expect_error( + adjust_samples_to_budget(data = x, + budget = total_budget, + sample_to_adjust = "sample", + adjusted_sample = total_budget, + adjust_by = 6), + regexpr = "Variable \'adjusted_sample\': Must be of type \'character\', not \'double\'") + + expect_error( + adjust_samples_to_budget(data = x, + budget = total_budget, + sample_to_adjust = "sample", + adjusted_sample = "new_sample", + adjust_by = 0), + regexpr = "Variable \'adjust_by\': Element 1 is not >= 1") + +}) diff --git a/tests/testthat/test_include_generated_date.R b/tests/testthat/test_append_date_generated_line.R similarity index 80% rename from tests/testthat/test_include_generated_date.R rename to tests/testthat/test_append_date_generated_line.R index 8b6b315..26524c7 100644 --- a/tests/testthat/test_include_generated_date.R +++ b/tests/testthat/test_append_date_generated_line.R @@ -1,8 +1,7 @@ -context("include_generated_date") library(OKplan) library(testthat) -test_that("Including generated date in last row", { +test_that("Append date generated in last row", { # Make example data @@ -11,7 +10,7 @@ x <- as.data.frame(cbind("År" = 2021, "Rapport" = "Brucellose hos geit, utvalgs "Produsentnr" = "30303030", "Foretak" = "XXX XXXXX", "Postnr" = "0468", "Poststed" = "OSLO", "Antall prøver" = 26)) # Include row with generated date -y <- include_generated_date(x) +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"))) @@ -19,7 +18,7 @@ expect_identical(y[dim(y)[1], 1], paste("Datauttrekket er gjort", format(Sys.Dat # Include row with generated date today <- format(Sys.Date(),"%d/%m/%Y") -y <- include_generated_date(x, pretext = "Data was generated", date = today) +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"))) diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 0000000..097b241 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/Contribute_to_OKplan.Rmd b/vignettes/Contribute_to_OKplan.Rmd new file mode 100644 index 0000000..e02a0e5 --- /dev/null +++ b/vignettes/Contribute_to_OKplan.Rmd @@ -0,0 +1,137 @@ +--- +output: + rmarkdown::html_vignette: + keep_md: true +md_document: + variant: markdown_github + +params: + NVIpkg: "OKplan" +title: "Contribute to `r params$NVIpkg`" + +vignette: > + %\VignetteEngine{knitr::rmarkdown} + %\VignetteIndexEntry{Contribute to OKplan} + %\VignetteEncoding + +--- + + +```{r, include = FALSE} +NVIpkg <- params$NVIpkg +NVIpkg_inline <- paste0("`", NVIpkg, "`") +NVIpkg_code <- "/tree/main/R" +# pkg_name <- NVIpkg_inline +# pkg_name <- "`NVIcheckmate`" +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) + +``` + + + +Thank you for considering contributing to `r NVIpkg_inline`. + +`r NVIpkg_inline` is one of several packages assembled under the name `NVIverse`, a collection of R-packages with tools to facilitate data management and data reporting at the Norwegian Veterinary Institute (NVI). + +### NVIverse packages +```{r echo = FALSE, results = 'asis'} +library(NVIpackager) +knitr::kable(x = NVIpackages) +``` + +## How you can contribute +There are several ways you can contribute to this project: ask a question, propose an idea, report a bug, improve the documentation, or contribute code. + +### Ask a question + +Using `r NVIpkg_inline` and need help? Browse the package help to see if you can find a solution. Still problems? Post your question in R-forum at workplace or contact the package maintainer by [email](mailto:petter.hopp@vetinst.no). + +### Propose an idea + +Have an idea for a new `r NVIpkg_inline` feature? Take a look at the `r NVIpkg_inline` help and `r paste0("[issue list](https://github.com/NorwegianVeterinaryInstitute/",NVIpkg, "/issues)")` to see if it isn't included or suggested yet. If not, suggest your idea as an `r paste0("[issue on GitHub](https://github.com/NorwegianVeterinaryInstitute/",NVIpkg, "/issues/new)")`. While we can't promise to implement your idea, it helps to: + +* Explain in detail how it would work. +* Keep the scope as narrow as possible. + +See below if you want to contribute code for your idea as well. + +### Report a bug + +Using `r NVIpkg_inline` and discovered a bug? Don't let others have the same experience and report it as an `r paste0("[issue on GitHub](https://github.com/NorwegianVeterinaryInstitute/",NVIpkg, "/issues/new)")` so we can fix it. A good bug report makes it easier for us to do so, so please include: + +* Any details about your local setup that might be helpful in troubleshooting. +* Detailed steps to reproduce the bug. + +### Improve the documentation + +Noticed a typo on the function help? Think a function could use a better example? Good documentation makes all the difference, so your help to improve it is very welcome! + +Functions are described as comments near their code and translated to documentation using [`roxygen2`](https://klutometis.github.io/roxygen/). If you want to improve a function description: + +1. Go to `R/` directory in the `r paste0("[code repository](https://github.com/NorwegianVeterinaryInstitute/",NVIpkg, NVIpkg_code,")")`. +2. Look for the file with the name of the function. +3. [Propose a file change](https://help.github.com/articles/editing-files-in-another-user-s-repository/) to update the function documentation in the roxygen comments (starting with `#'`). + +### Contribute code + +Care to fix bugs or implement new functionality for our_package? Great! Have a look at the `r paste0("[issue list](https://github.com/NorwegianVeterinaryInstitute/",NVIpkg, "/issues)")` and leave a comment on the things you want to work on. See also the development guidelines below. + + +## Development guidelines + +If you want to contribute code, you are welcome to do so. Please try to adhere +to some principles and style convention used for `NVIverse`-packages. + +* Please limit the number of package dependencies for `r NVIpkg_inline`. The use of base +functions is much appreciated. + +* New code should generally follow the tidyverse [style guide](http://style.tidyverse.org). +I recommend to use the [`styler`](https://CRAN.R-project.org/package=styler) +package to apply spaces: `styler::style_file(filename, scope = "spaces")`. +Please don't restyle code that has nothing to do with your pull request. + +* You should add a bullet point to `NEWS.md` motivating the change. + +* You should add yourself as a contributor to the `DESCRIPTION`. + +* If you're adding a new function or new arguments to an existing function, you'll also need + to document them. `NVIverse`-packages use [`roxygen2`](https://cran.r-project.org/package=roxygen2), with +[Markdown syntax](https://cran.r-project.org/web/packages/roxygen2/vignettes/markdown.html), +for documentation. Make sure to re-run `devtools::document()` on the code before submitting. + +* `NVIverse`-packages use the assert-functions from [`checkmate`](https://CRAN.R-project.org/package=checkmate) package for argument checking as well as some additional assert_functions in [`NVIcheckmate`](https://github.com/NorwegianVeterinaryInstitute/NVIcheckmate). Adding argument checking for new functions and/or arguments will be highly appreciated. + +* If you can, also write a test. `NVIverse`-packages use [`testthat`](https://cran.r-project.org/package=testthat) for tests. + +* Also run `devtools::check()` to make sure your function doesn't imply downstream errors or warnings. + + +### Git commit standards +We follow the commit message style guide maintained within the angular.js project. + +The start of commit messages should be one of the following: + +* feat: A new feature +* fix: A bug fix +* doc: Documentation only changes +* style: Changes that do not affect the meaning of the code (white-space, formatting, missing semi-colons, etc) +* refactor: A code change that neither fixes a bug or adds a feature +* perf: A code change that improves performance +* test: Adding missing tests +* chore: Changes to the build process or auxiliary tools and libraries such as documentation generation + +Do not capitalize the first letter. + + +## Code of conduct +Please note that this project is released with a +[Contributor Code of Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html). By participating to this project, you agree to abide by its terms. + + +## References +This document is adapted from a [template](https://gist.github.com/peterdesmet/e90a1b0dc17af6c12daf6e8b2f044e7c) by @peterdesmet .