From 1bddeb3cbe93d3bb4818caaf61433ae28f39ee19 Mon Sep 17 00:00:00 2001 From: RobertASmith Date: Fri, 30 Aug 2024 14:07:54 +0100 Subject: [PATCH 1/3] changes ready for CRAN --- .Rbuildignore | 1 + DESCRIPTION | 20 ++- NEWS.md | 4 + R/check_functions.R | 339 -------------------------------------- R/check_markov_trace.R | 9 +- README.Rmd | 26 +-- README.md | 25 ++- cran-comments.md | 5 + man/check_markov_trace.Rd | 9 +- 9 files changed, 60 insertions(+), 378 deletions(-) create mode 100644 NEWS.md delete mode 100644 R/check_functions.R create mode 100644 cran-comments.md diff --git a/.Rbuildignore b/.Rbuildignore index 5fb6116..9c2630a 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -9,3 +9,4 @@ ^_pkgdown\.yml$ ^docs$ ^pkgdown$ +^cran-comments\.md$ diff --git a/DESCRIPTION b/DESCRIPTION index c2e81b2..414c8e1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,11 +1,18 @@ Package: assertHE -Title: An R package designed to aid in verification of health economic decision models -Version: 0.0.0.9000 +Title: Visualisation and Verification of Health Economic Decision Models +Version: 0.1.0 Authors@R: c( - person("Robert", "Smith", , "rsmith@darkpeakanalytics.com", role = c("aut", "cre"), - comment = c(ORCID = "0000-0003-0245-3217")) + person("Robert", "Smith", , "rsmith@darkpeakanalytics.com", role = c("aut", "cre", "cph"), + comment = c(ORCID = "0000-0003-0245-3217")), + person("Wael", "Mohammed", , "wmohammed@darkpeakanalytics.com", role = c("aut"), + comment = c(ORCID = "0000-0003-0370-4903")), + person("Jack", "Smith", , "", role = c("aut")), + person("Dark Peak Analytics Ltd", role = c("cph", "fnd")) ) -Description: An R package designed to help health economic modellers when writing unit tests for their models. The asserts contained in this package include black-box and white-box tests for common errors in health economic models. They are not designed to be exhaustive, but rather to provide a starting point with a set of 'standard' tests to free up modellers to focus on tests specific to the individual model in development or review. +Description: An R package designed to help health economic modellers when building and reviewing models. + The visualisation functions allow users to more easily review the network of functions + in a project, and get lay summaries of them. The asserts included are intended to check for common errors, + thereby freeing up time for modellers to focus on tests specific to the individual model in development or review. License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) @@ -41,4 +48,5 @@ Imports: waiter, igraph, httr -URL: https://dark-peak-analytics.github.io/assertHE/ +URL: https://dark-peak-analytics.github.io/assertHE/, https://github.com/dark-peak-analytics/assertHE +BugReports: https://github.com/dark-peak-analytics/assertHE/issues diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..69d8cdf --- /dev/null +++ b/NEWS.md @@ -0,0 +1,4 @@ +# assertHE (development version) + +* Initial CRAN submission. +* Added a `NEWS.md` file to track changes to the package. diff --git a/R/check_functions.R b/R/check_functions.R deleted file mode 100644 index 71a4ccc..0000000 --- a/R/check_functions.R +++ /dev/null @@ -1,339 +0,0 @@ -#' #' @title List all of the functions in a script -#' #' -#' #' @description This function lists all of the functions in a script. It expects the script to be -#' #' an R file, and requires that package libraries are loaded when identifying packages. -#' #' -#' #' @param filename The name of the file to be checked. -#' #' @param alphabetic If TRUE, return the functions in alphabetic order. -#' #' @param by_package If TRUE, return a list of functions by package. Else return a vector of functions. -#' #' -#' #' @return A named list of functions in the script, by package. -#' #' -#' #' @family checking_functions -#' #' -#' #' @export -#' #' @examples -#' #' \dontrun{ -#' #' list_functions_in_script(filename = "./R/check_trans_probs.R") -#' #' -#' #' list_functions_in_script(filename = "./R/check_functions.R", by_package = FALSE) -#' #' list_functions_in_script(filename = -#' #' paste0("https://raw.githubusercontent.com/dark-peak-analytics/", -#' #' "sicksickerPack/main/R/create_Markov_trace.R"), by_package = FALSE) -#' #' -#' #' } -#' list_functions_in_script <- -#' function(filename, -#' by_package = TRUE, -#' alphabetic=TRUE) { -#' -#' # from hrbrmstr, StackExchange 3/1/2015 -#' #if(!file.exists(filename)) { stop("couldn't find file ",filename) } -#' if(!tools::file_ext(filename) == "R") { warning("expecting *.R file, will try to proceed") } -#' # read in parsed data from script -#' tmp <- utils::getParseData(parse(filename, keep.source=TRUE)) -#' # only keep those lines that are identified as function calls -#' nms <- tmp$text[which(tmp$token=="SYMBOL_FUNCTION_CALL")] -#' # only keep unique functions for script -#' funs <- unique(if(alphabetic) { sort(nms) } else { nms }) -#' -#' # if don't want by package just return vector of function names -#' if(!by_package) { -#' return(funs) -#' } -#' -#' # return a list of functions and the file they were found in -#' # take the first only -#' v_packages <- as.vector(sapply(funs, utils::find)) -#' src <- paste(sapply(X = v_packages, FUN = function(x) x[1])) -#' outlist <- tapply(funs, factor(src), c) -#' -#' return(outlist) -#' -#' } -#' -#' -#' #' Create table of all of the functions in a script -#' #' -#' #' This function tabulates all of the functions in a script with the name of the -#' #' package next to it. It expects the script to be an R file, and requires that -#' #' package libraries are loaded when identifying packages. -#' #' -#' #' @param filename The name of the file to be checked. -#' #' @param packages_to_exclude A vector of packages to exclude from the output (e.g. "base") -#' #' -#' #' @return A data-frame of functions and the package the function is from. -#' #' -#' #' @family checking_functions -#' #' -#' #' @export -#' #' @examples -#' #' \dontrun{ -#' #' tabulate_functions_in_script(filename = "./R/check_functions.R") -#' #' tabulate_functions_in_script(filename = "./R/check_trans_probs.R", -#' #' packages_to_exclude = NULL) -#' #' tabulate_functions_in_script(filename = -#' #' paste0("https://raw.githubusercontent.com/dark-peak-analytics/", -#' #' "sicksickerPack/main/R/create_Markov_trace.R"), packages_to_exclude = NULL) -#' #' } -#' tabulate_functions_in_script <- function(filename, -#' packages_to_exclude = c("base", "stats", "utils")) { -#' # list the functions in the file. -#' my_packages <- list_functions_in_script(filename) -#' -#' # convert nested list to a dataframe where each row gives the function name -#' # and the package it belongs to: -#' df <- utils::stack(my_packages) -#' colnames(df) <- c("foo", "package") -#' -#' # remove 'package:' from the strings -#' df$package <- gsub("package:", "", df$package) -#' -#' # remove 'character(0)' and replace with 'local' -#' df$package[df$package == "character(0)"] <- "unknown" -#' -#' # exclude unwanted packages (to reduce size) -#' exclude_index <- df$package %in% packages_to_exclude -#' df <- df[!exclude_index, ] -#' -#' return(df) -#' } -#' -#' -#' #' Create table of all of the functions identified in a project folder -#' #' -#' #' This function tabulates all of the functions identified in R scripts within a -#' #' project folder. It requires that package libraries are loaded when identifying -#' #' a function's package. -#' #' -#' #' @param path The path to the folder to be checked. -#' #' @param collapse If TRUE, return a single data-frame of all functions. Else return a list by file. -#' #' @param packages_to_exclude A vector of packages to exclude from the output (e.g. "base") -#' #' @param path_exclude A string which if found in file path removes file from analysis. -#' #' Defaults to 'testthat/' to exclude functions only found in tests. -#' #' -#' #' @family checking_functions -#' #' -#' #' @return Either a data-frame of functions and the package the function is from, or a list of functions by file. -#' #' @export -#' #' @examples -#' #' -#' #' \dontrun{ -#' #' tabulate_functions_in_folder( -#' #' path = ".", -#' #' path_exclude = "testthat/", -#' #' collapse = T, -#' #' packages_to_exclude = c("base", "stats", "utils") -#' #' ) -#' #' } -#' tabulate_functions_in_folder <- function(path = ".", -#' path_exclude = "testthat/", -#' collapse = T, -#' packages_to_exclude = c("base", "stats", "utils")) { -#' # get all files from the path folder, i.e. everything in repo. -#' my_R_scripts <- list.files( -#' path = path, -#' pattern = "\\.R$", -#' recursive = TRUE, -#' full.names = TRUE -#' ) -#' -#' # exclude those in the testthat (or other specified) folder if not null -#' if(!is.null(path_exclude)){ -#' my_R_scripts <- my_R_scripts[!grepl(pattern = path_exclude, x = my_R_scripts)] -#' } -#' -#' l_foo <- lapply(X = my_R_scripts, -#' FUN = tabulate_functions_in_script, -#' packages_to_exclude = packages_to_exclude) -#' -#' # collapse the list into a single dataframe -#' if (collapse) { -#' df_foo <- do.call(rbind, l_foo) -#' # remove duplicates -#' df_foo <- unique(df_foo) -#' return(df_foo) -#' } else{ -#' names(l_foo) <- my_R_scripts -#' return(l_foo) -#' } -#' -#' } -#' -#' #' Find test for a function in a codebase -#' #' -#' #' This function finds the test for each in a vector of functions in a specified -#' #' testing folder, default = tests/testthat as the relative path from the project folder (path). -#' #' -#' #' @param v_functions A vector of functions to search for. -#' #' @param path The path to the folder to be checked. -#' #' @param test_path The relative path to the test folder from the project folder (path). -#' #' -#' #' @family checking_functions -#' #' -#' #' @return A vector of file paths to the test scripts for each function. -#' #' Returns NA where no script can be found. -#' #' -#' #' @examples -#' #' \dontrun{ -#' #' v_funcs_to_find_tests_for <- c("check_init", "mean", "check_markov_trace", "find_test") -#' #' find_test(v_functions = v_funcs_to_find_tests_for, -#' #' path = ".") -#' #' } -#' #' -#' find_test <- function(v_functions, -#' path = ".", -#' test_path = "tests/testthat") { -#' # get all files from the path folder, i.e. everything in repo. -#' my_test_scripts <- list.files( -#' path = paste0(path, "/", test_path), -#' pattern = "\\.R$", -#' recursive = TRUE, -#' full.names = TRUE -#' ) -#' # create a list of functions in scripts. -#' l_foo <- lapply(X = my_test_scripts, -#' FUN = list_functions_in_script, -#' by_package = FALSE) -#' names(l_foo) <- my_test_scripts -#' -#' # loop through the vector of function names and check if they exist in the list of scripts. -#' l_function_tests <- sapply(v_functions, -#' function(function_name) { -#' # find which elements of the list contain the function -#' v_test_file <- names(l_foo)[sapply(l_foo, -#' function(x) -#' (function_name %in% x) > 0)] -#' -#' # check that a file exists -#' if (length(v_test_file) == 0) { -#' return(NA) -#' } else if (length(v_test_file) > 1) { -#' file_path_match <- -#' grep(pattern = function_name, -#' x = v_test_file, -#' value = TRUE) -#' if (length(file_path_match) == 1) { -#' return(file_path_match) -#' } else{ -#' return(v_test_file[1]) -#' } -#' } else { -#' return(v_test_file) -#' } -#' -#' }) -#' -#' -#' return(l_function_tests) -#' -#' } -#' -#' -#' #' Summarise project functions with details on packages and existence of unit-tests. -#' #' -#' #' Creates a summary table containing the name of each function in the project, -#' #' the package it is from, whether it has a unit-test and the file in which it is tested. -#' #' -#' #' @param path The path to the folder to be checked. -#' #' @param path_exclude A set of strings that will exclude any files if it is present in the file path. -#' #' @param packages_to_exclude A vector of packages to exclude from the search. -#' #' @param test_path The relative path to the test folder from the project folder (path). -#' #' @return A dataframe with the following columns: -#' #' * function_name: The name of the function. -#' #' * package: The package the function is from. -#' #' * file_name: The file in which the function is defined. -#' #' * test_location: The file in which the function is tested. -#' #' @export -#' #' -#' #' @examples -#' #' \dontrun{ -#' #' tabulate_functions_in_folder_with_tests( -#' #' path = ".", -#' #' path_exclude = "testthat/", -#' #' packages_to_exclude = c("base", "stats", "ggplot2"), -#' #' test_path = "tests/testthat" -#' #' ) -#' #' } -#' #' -#' tabulate_functions_in_folder_with_tests <- -#' function(path = ".", -#' path_exclude = "testthat/", -#' packages_to_exclude = .packages(TRUE), -#' test_path = "tests/testthat" -#' ) { -#' -#' # get list of functions (excluding those defined) -#' df_foo <- tabulate_functions_in_folder( -#' path = path, -#' path_exclude = path_exclude, -#' collapse = T, -#' packages_to_exclude = packages_to_exclude -#' ) -#' -#' # attempt to identify the testing file for the function -#' df_foo$test_location <- find_test( -#' v_functions = df_foo$foo, -#' path = path, -#' test_path = test_path -#' ) -#' -#' return(df_foo) -#' -#' } -#' -#' -#' #' @title Summarise project functions with details on packages and existence of unit-tests. -#' #' @description Creates a summary table containing the name of each function in the project, -#' #' the package it is from, whether it has a unit-test and the file in which it is tested. -#' #' @param path The path to the folder to be checked. -#' #' @param path_exclude A set of strings that will exclude any files if it is present in the file path. -#' #' @param packages_to_exclude A vector of packages to exclude from the search. -#' #' @param test_path The relative path to the test folder from the project folder (path). -#' #' @param cheers_pattern A string that will be used to identify the cheers tag. -#' #' @return A dataframe with the following columns: -#' #' * function_name: The name of the function. -#' #' * package: The package the function is from. -#' #' * file_name: The file in which the function is defined. -#' #' * test_location: The file in which the function is tested. -#' #' @export -#' #' @examples -#' #' \dontrun{ -#' #' get_summary_table() -#' #' } -#' #' -#' get_summary_table <- function(path = ".", -#' path_exclude = "testthat/", -#' test_path = "tests/", -#' cheers_pattern = "@family", -#' packages_to_exclude = c("base", "stats", "utils")) { -#' -#' # table with list of functions, packages and tests. -#' df_tests <- tabulate_functions_in_folder_with_tests(path = path, -#' path_exclude = path_exclude, -#' test_path = test_path, -#' packages_to_exclude = packages_to_exclude) -#' -#' # tags relating to classifications and file paths -#' df_cheers <- get_folder_cheers_classifications(path = path, -#' cheers_pattern = cheers_pattern, -#' path_ignore = path_exclude) -#' -#' # merge dataframes together to get one summary dataframe -#' df_merged <- merge(df_tests, -#' df_cheers, -#' by.x = "foo", -#' by.y = "function_name", -#' all = T) -#' -#' # sort by tag in base R -#' column_names <- -#' c("foo", "tag", "package", "script", "test_location") -#' df_summary <- df_merged[order(df_merged$tag), column_names] -#' -#' return(df_summary) -#' -#' } -#' -#' -#' diff --git a/R/check_markov_trace.R b/R/check_markov_trace.R index e65ed18..20deef0 100644 --- a/R/check_markov_trace.R +++ b/R/check_markov_trace.R @@ -10,7 +10,6 @@ #' @param dead_state character vector length 1 denoting dead state (e.g. "D") #' #' @examples -#' \dontrun{ #' v_hs_names <- c("H", "S", "D") #' n_hs <- length(v_hs_names) #' n_t <- 10 @@ -23,13 +22,15 @@ #' m_TR[, "H"] <- seq(1, 0, length.out = n_t) #' m_TR[, "S"] <- seq(0, 0.5, length.out = n_t) #' m_TR[, "D"] <- 1 - m_TR[, "H"] - m_TR[, "S"] -#' check_markov_trace(m_TR = m_TR, dead_state = "D", confirm_ok = T) +#' check_markov_trace(m_TR = m_TR, dead_state = "D", confirm_ok = TRUE) #' +#'\dontrun{ +#'# the following results in an error because the trace has infeasible values #' m_TR[10, "D"] <- 0 #' m_TR[9, "S"] <- 1 -#' check_markov_trace(m_TR = m_TR, stop_if_not = T, dead_state = "D", confirm_ok = T) -#' } +#' check_markov_trace(m_TR = m_TR, stop_if_not = T, dead_state = "D", confirm_ok = TRUE) #' +#'} #' @return A message indicating whether the matrix passed all the checks or an error message if any check failed. #' #' @import assertthat diff --git a/README.Rmd b/README.Rmd index b63b33f..477fbc3 100644 --- a/README.Rmd +++ b/README.Rmd @@ -32,7 +32,17 @@ We are continuing to work to improve the package and welcome contributions. To g ## Installation -You can install the development version of assertHE from [GitHub](https://github.com/) with: +You can install the CRAN version of assertHE from [CRAN](https://CRAN.R-project.org) with: + +``` r +install.packages("assertHE") + +library(assertHE) + +``` + + +Alternatively the development version of assertHE can be installed from [GitHub](https://github.com/) with: ``` r # install.packages("devtools") @@ -143,7 +153,7 @@ The following models have been visualized using the package, as test cases: \ * [NICE RCC Model](https://github.com/nice-digital/NICE-model-repo) \ * [sicksickerPack](https://github.com/dark-peak-analytics/sicksickerPack) teaching model contained in a package. \ -* [cdx2cea](https://github.com/feralaes/cdx2cea) as described in [Alarid-Escudero et al. 2022](https://www.sciencedirect.com/science/article/pii/S1098301521017472) \ +* [cdx2cea](https://github.com/feralaes/cdx2cea) as described in [Alarid-Escudero et al. 2022](https://doi.org/10.1016/j.jval.2021.07.019) \ * [DOACs-AF-Economic-model](https://github.com/Bogdasayen/DOACs-AF-Economic-model) developed by Bristol University \ * The CGD AMR Cost model - in press. \ * [Embedding Economics Analysis](https://github.com/DanPollardSheff/Embedding-Economic-Analysis) Diabetes Microsimulation model described in (in press). \ @@ -151,9 +161,6 @@ The following models have been visualized using the package, as test cases: \ * Several internal models at Maple Health. \ * The National Institute for Health and Care Excellence (NICE) have built the `assertHE` visualiser into their template for model reviews. -Health Economics Modelling Packages: \ -- [voi R package](https://cran.rstudio.com/web/packages/voi/index.html) reviewed by GSK team. \ - ## Sharing interactive model networks Once the model has been generated, it is possible to share the HTML for the @@ -165,10 +172,5 @@ However, all the funtionality from the HTML version (not the shiny version with ## Get in contact -To get in contact about this project or other collaborations please feel free to message me on any of the below. - -[Dr. Robert Smith](https://www.linkedin.com/in/robert-smith-53b28438) - -Contact: [rsmith@darkpeakanalytics.com](mailto:rsmith@darkpeakanalytics.com) - -Website: [Dark Peak Analytics](https://www.darkpeakanalytics.com) +To get in contact about this project or other collaborations please feel free to +email me at [rsmith@darkpeakanalytics.com](mailto:rsmith@darkpeakanalytics.com). diff --git a/README.md b/README.md index 3f3ec4b..e6bfbc0 100644 --- a/README.md +++ b/README.md @@ -39,7 +39,16 @@ wiki](https://github.com/dark-peak-analytics/assertHE/wiki/assertHE:-an-R-packag ## Installation -You can install the development version of assertHE from +You can install the CRAN version of assertHE from +[CRAN](https://CRAN.R-project.org) with: + +``` r +install.packages("assertHE") + +library(assertHE) +``` + +Alternatively the development version of assertHE can be installed from [GitHub](https://github.com/) with: ``` r @@ -176,7 +185,7 @@ cases: teaching model contained in a package. - [cdx2cea](https://github.com/feralaes/cdx2cea) as described in [Alarid-Escudero et - al. 2022](https://www.sciencedirect.com/science/article/pii/S1098301521017472) + al. 2022](https://doi.org/10.1016/j.jval.2021.07.019) - [DOACs-AF-Economic-model](https://github.com/Bogdasayen/DOACs-AF-Economic-model) developed by Bristol University - The CGD AMR Cost model - in press. @@ -188,10 +197,6 @@ cases: - The National Institute for Health and Care Excellence (NICE) have built the `assertHE` visualiser into their template for model reviews. -Health Economics Modelling Packages: -- [voi R package](https://cran.rstudio.com/web/packages/voi/index.html) -reviewed by GSK team. - ## Sharing interactive model networks Once the model has been generated, it is possible to share the HTML for @@ -205,10 +210,4 @@ shiny version with the links) should be there. ## Get in contact To get in contact about this project or other collaborations please feel -free to message me on any of the below. - -[Dr. Robert Smith](https://www.linkedin.com/in/robert-smith-53b28438) - -Contact: - -Website: [Dark Peak Analytics](https://www.darkpeakanalytics.com) +free to email me at . diff --git a/cran-comments.md b/cran-comments.md new file mode 100644 index 0000000..858617d --- /dev/null +++ b/cran-comments.md @@ -0,0 +1,5 @@ +## R CMD check results + +0 errors | 0 warnings | 1 note + +* This is a new release. diff --git a/man/check_markov_trace.Rd b/man/check_markov_trace.Rd index c3eaedf..51453ca 100644 --- a/man/check_markov_trace.Rd +++ b/man/check_markov_trace.Rd @@ -24,7 +24,6 @@ That it is: numeric, values are between 0 and 1 with all rows summing to 1. Also allows users to check that the dead state is monotonically decreasing (if provided) } \examples{ -\dontrun{ v_hs_names <- c("H", "S", "D") n_hs <- length(v_hs_names) n_t <- 10 @@ -37,11 +36,13 @@ m_TR <- matrix(data = NA, m_TR[, "H"] <- seq(1, 0, length.out = n_t) m_TR[, "S"] <- seq(0, 0.5, length.out = n_t) m_TR[, "D"] <- 1 - m_TR[, "H"] - m_TR[, "S"] -check_markov_trace(m_TR = m_TR, dead_state = "D", confirm_ok = T) +check_markov_trace(m_TR = m_TR, dead_state = "D", confirm_ok = TRUE) +\dontrun{ +# the following results in an error because the trace has infeasible values m_TR[10, "D"] <- 0 m_TR[9, "S"] <- 1 -check_markov_trace(m_TR = m_TR, stop_if_not = T, dead_state = "D", confirm_ok = T) -} +check_markov_trace(m_TR = m_TR, stop_if_not = T, dead_state = "D", confirm_ok = TRUE) } +} From 918cec862faa876df60be361cbc93efb1cf24b19 Mon Sep 17 00:00:00 2001 From: RobertASmith Date: Fri, 30 Aug 2024 14:36:46 +0100 Subject: [PATCH 2/3] minor edits to examples --- R/check_PSAstability.R | 33 ++++++++++++------------ R/check_trans_probs.R | 5 ++-- R/cheers_checker.R | 6 ++--- man/check_trans_prob_mat.Rd | 5 ++-- man/find_next_vector_element.Rd | 6 ++--- man/plot_PSA_stability.Rd | 33 ++++++++++++------------ tests/testthat/test-check_PSAstability.R | 4 +-- 7 files changed, 44 insertions(+), 48 deletions(-) diff --git a/R/check_PSAstability.R b/R/check_PSAstability.R index 1c81739..f2e5c42 100644 --- a/R/check_PSAstability.R +++ b/R/check_PSAstability.R @@ -22,33 +22,32 @@ #' @importFrom tidyr pivot_longer #' #' @examples -#' -#' \dontrun{ #' # create example matrices -#' m_eff <- as.matrix(gskVEOutils::Hyperphosphatemia_PSA$e)[,1:5] -#' colnames(m_eff) <- LETTERS[1:length(colnames(m_eff))] +#' n_psa <- 10000 #' -#' m_cost <- as.matrix(gskVEOutils::Hyperphosphatemia_PSA$c)[,1:5] -#' colnames(m_cost) <- LETTERS[1:length(colnames(m_cost))] +#' m_eff <- matrix(data = runif(n = n_psa * 4, min = 0, max = 1), +#' nrow = n_psa, +#' ncol = 4, +#' dimnames = list(NULL, paste0("Strategy ", c("A", "B", "C", "D")))) #' -#' v_strategy_labels <- setNames(object = paste0("Strategy ", colnames(m_eff)), -#' nm = colnames(m_eff)) +#' m_cost <- matrix(data = runif(n = n_psa * 4, min = 5000, max = 20000), +#' nrow = n_psa, +#' ncol = 4, +#' dimnames = list(NULL, paste0("Strategy ", c("A", "B", "C", "D")))) #' #' v_strategy_colors <- setNames(object = grDevices::palette.colors(n = ncol(m_eff)), #' nm = colnames(m_eff)) #' -#' plot_PSA_stability(m_eff = m_eff[, 1:5], -#' m_cost = m_cost[, 1:5], +#' plot_PSA_stability(m_eff = m_eff, +#' m_cost = m_cost, #' lambda = 20000, #' currency_symbol = "\u0024", -#' v_strategy_labels = v_strategy_labels, +#' v_strategy_labels = colnames(m_eff), #' v_strategy_colors = v_strategy_colors, #' comparator = colnames(m_eff)[1], -#' output = "icer", -#' include_reference_line = T, -#' log_x = F) -#' -#' } # end don't run. +#' output = "inmb", +#' include_reference_line = TRUE, +#' log_x = FALSE) #' plot_PSA_stability <- function(m_eff, m_cost, @@ -59,7 +58,7 @@ plot_PSA_stability <- function(m_eff, comparator = NULL, output = "inmb", include_reference_line = T, - log_x = F) { + log_x = FALSE) { assertthat::assert_that(is.matrix(m_eff) & is.matrix(m_cost) & is.numeric(m_eff) & is.numeric(m_cost), msg = "m_eff and m_cost must be numeric matrices") diff --git a/R/check_trans_probs.R b/R/check_trans_probs.R index 0f3d860..e8138cf 100644 --- a/R/check_trans_probs.R +++ b/R/check_trans_probs.R @@ -11,7 +11,6 @@ #' @param dead_state character vector length 1 denoting dead state (e.g. "D") #' #' @examples -#' \dontrun{ #' v_hs_names <- c("H", "S", "D") #' n_hs <- length(v_hs_names) #' m_P <- matrix(data = 0, nrow = n_hs, ncol = n_hs, @@ -22,9 +21,11 @@ #' m_P["S", "H"] <- 0.5 #' diag(m_P) <- (1 - rowSums(m_P)) #' check_trans_prob_mat(m_P) +#' +#' \dontrun{ #' # introduce error #' m_P["H", "S"] <- 0.2 -#' check_trans_prob_mat(m_P, confirm_ok = T, stop_if_not = T) +#' check_trans_prob_mat(m_P, confirm_ok = TRUE, stop_if_not = TRUE) #' } #' #' @return A message indicating whether the matrix passed all the checks or a warning/error message if any check failed. diff --git a/R/cheers_checker.R b/R/cheers_checker.R index 906ae33..b2638ec 100644 --- a/R/cheers_checker.R +++ b/R/cheers_checker.R @@ -6,12 +6,10 @@ #' @return The next element of the vector after the value #' @export #' @examples -#' \dontrun{ #' find_next_vector_element(value = 5, vector = 1:10) #' find_next_vector_element(value = 5, vector = 1:4) -#' find_next_vector_element(value = 5, vector = 1:5, LTE = F) -#' find_next_vector_element(value = 5, vector = 1:5, LTE = T) -#' } +#' find_next_vector_element(value = 5, vector = 1:5, LTE = FALSE) +#' find_next_vector_element(value = 5, vector = 1:5, LTE = TRUE) #' find_next_vector_element <- function(value, vector, LTE=FALSE) { diff --git a/man/check_trans_prob_mat.Rd b/man/check_trans_prob_mat.Rd index e9453b6..31d24b3 100644 --- a/man/check_trans_prob_mat.Rd +++ b/man/check_trans_prob_mat.Rd @@ -25,7 +25,6 @@ and 1 with all rows summing to 1. If a dead state is provided, it checks that th state -> dead state probability is 1. } \examples{ -\dontrun{ v_hs_names <- c("H", "S", "D") n_hs <- length(v_hs_names) m_P <- matrix(data = 0, nrow = n_hs, ncol = n_hs, @@ -36,9 +35,11 @@ m_P["S", "D"] <- 0.1 m_P["S", "H"] <- 0.5 diag(m_P) <- (1 - rowSums(m_P)) check_trans_prob_mat(m_P) + +\dontrun{ # introduce error m_P["H", "S"] <- 0.2 -check_trans_prob_mat(m_P, confirm_ok = T, stop_if_not = T) +check_trans_prob_mat(m_P, confirm_ok = TRUE, stop_if_not = TRUE) } } diff --git a/man/find_next_vector_element.Rd b/man/find_next_vector_element.Rd index 3a2453f..62b657b 100644 --- a/man/find_next_vector_element.Rd +++ b/man/find_next_vector_element.Rd @@ -20,11 +20,9 @@ The next element of the vector after the value Find the next element of the vector after a value } \examples{ -\dontrun{ find_next_vector_element(value = 5, vector = 1:10) find_next_vector_element(value = 5, vector = 1:4) -find_next_vector_element(value = 5, vector = 1:5, LTE = F) -find_next_vector_element(value = 5, vector = 1:5, LTE = T) -} +find_next_vector_element(value = 5, vector = 1:5, LTE = FALSE) +find_next_vector_element(value = 5, vector = 1:5, LTE = TRUE) } diff --git a/man/plot_PSA_stability.Rd b/man/plot_PSA_stability.Rd index c420c5d..0ac329a 100644 --- a/man/plot_PSA_stability.Rd +++ b/man/plot_PSA_stability.Rd @@ -14,7 +14,7 @@ plot_PSA_stability( comparator = NULL, output = "inmb", include_reference_line = T, - log_x = F + log_x = FALSE ) } \arguments{ @@ -47,32 +47,31 @@ incremental cost-effectiveness ratio (ICER), incremental costs, or incremental e for different strategies compared to a specified comparator. } \examples{ - -\dontrun{ # create example matrices -m_eff <- as.matrix(gskVEOutils::Hyperphosphatemia_PSA$e)[,1:5] -colnames(m_eff) <- LETTERS[1:length(colnames(m_eff))] +n_psa <- 10000 -m_cost <- as.matrix(gskVEOutils::Hyperphosphatemia_PSA$c)[,1:5] -colnames(m_cost) <- LETTERS[1:length(colnames(m_cost))] +m_eff <- matrix(data = runif(n = n_psa * 4, min = 0, max = 1), + nrow = n_psa, + ncol = 4, + dimnames = list(NULL, paste0("Strategy ", c("A", "B", "C", "D")))) -v_strategy_labels <- setNames(object = paste0("Strategy ", colnames(m_eff)), - nm = colnames(m_eff)) +m_cost <- matrix(data = runif(n = n_psa * 4, min = 5000, max = 20000), + nrow = n_psa, + ncol = 4, + dimnames = list(NULL, paste0("Strategy ", c("A", "B", "C", "D")))) v_strategy_colors <- setNames(object = grDevices::palette.colors(n = ncol(m_eff)), nm = colnames(m_eff)) -plot_PSA_stability(m_eff = m_eff[, 1:5], - m_cost = m_cost[, 1:5], +plot_PSA_stability(m_eff = m_eff, + m_cost = m_cost, lambda = 20000, currency_symbol = "\u0024", - v_strategy_labels = v_strategy_labels, + v_strategy_labels = colnames(m_eff), v_strategy_colors = v_strategy_colors, comparator = colnames(m_eff)[1], - output = "icer", - include_reference_line = T, - log_x = F) - -} # end don't run. + output = "inmb", + include_reference_line = TRUE, + log_x = FALSE) } diff --git a/tests/testthat/test-check_PSAstability.R b/tests/testthat/test-check_PSAstability.R index aec7c0c..8b20523 100644 --- a/tests/testthat/test-check_PSAstability.R +++ b/tests/testthat/test-check_PSAstability.R @@ -49,7 +49,7 @@ test_that("plot_PSA_stability handles valid input", { comparator = colnames(m_eff)[1], output = "icer", include_reference_line = T, - log_x = F + log_x = FALSE ) }) @@ -121,7 +121,7 @@ test_that("plot_PSA_stability flags errors", { comparator = colnames(m_eff)[1], output = "icer", include_reference_line = T, - log_x = F + log_x = FALSE ) }) From e3a3df75ec484eb89da761e91208e9ba9cfa286d Mon Sep 17 00:00:00 2001 From: RobertASmith Date: Fri, 30 Aug 2024 14:39:04 +0100 Subject: [PATCH 3/3] new version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 414c8e1..2baccca 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: assertHE Title: Visualisation and Verification of Health Economic Decision Models -Version: 0.1.0 +Version: 1.0.0 Authors@R: c( person("Robert", "Smith", , "rsmith@darkpeakanalytics.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0003-0245-3217")),