diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index a53dec9..8692c91 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -26,12 +26,22 @@ jobs: - uses: r-lib/actions/setup-tinytex@v2 + - uses: r-lib/actions/setup-tinytex@v2 + - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true + # Addresses issue with incompatibility between libcurl4-gnutls-dev and libcurl4-openssl-dev + # Below fix is a customisation of approach outlined in https://github.com/r-hub/sysreqsdb/issues/77#issuecomment-620025428 + - name: Install libraptor on Linux + if: runner.os == 'Linux' + run: | + sudo add-apt-repository ppa:cran/librdf + sudo apt update + # Addresses issue with incompatibility between libcurl4-gnutls-dev and libcurl4-openssl-dev # Below fix is a customisation of approach outlined in https://github.com/r-hub/sysreqsdb/issues/77#issuecomment-620025428 - name: Install libraptor on Linux diff --git a/DESCRIPTION b/DESCRIPTION index 911fc50..cad5d25 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,13 +13,13 @@ Description: Tools for undertaking unit costing in conjunction with version of the costly package has been made available as part of the process of testing and documenting the package. If you have any questions, please contact the authors (matthew.hamilton2@monash.edu). -License: GPL-3 + file LICENSE +License: GPL (>= 3) URL: https://ready4-dev.github.io/costly/, https://github.com/ready4-dev/costly, https://ready4-dev.github.io/ready4/ Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Imports: countrycode, dplyr, @@ -66,6 +66,7 @@ Collate: 'pkg_costly.R' Suggests: knitrBootstrap, + pkgload, rmarkdown Remotes: ready4-dev/ready4, diff --git a/LICENSE b/LICENSE deleted file mode 100644 index 2fd4dab..0000000 --- a/LICENSE +++ /dev/null @@ -1,16 +0,0 @@ -costly - Develop, Use and Share Unit Cost Datasets for Health Economic - Analysis -Copyright (C) 2023 Orygen - -This program is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program. If not, see . diff --git a/data-raw/DATASET.R b/data-raw/DATASET.R index 769e7ac..2478322 100644 --- a/data-raw/DATASET.R +++ b/data-raw/DATASET.R @@ -21,10 +21,10 @@ x <- ready4fun::make_pkg_desc_ls(pkg_title_1L_chr = "Develop, Use and Share Unit ), build_ignore_ls = ready4fun::make_build_ignore_ls(file_nms_chr = c("initial_setup.R")), check_type_1L_chr = "ready4", - copyright_holders_chr = "Orygen", + copyright_holders_chr = "Monash University", custom_dmt_ls = ready4fun::make_custom_dmt_ls(),## dev_pkgs_chr = c(#"cmdstanr", - "ready4",#"ready4fun", + #"ready4",#"ready4fun", "ready4use","ready4show"#, #"youthvars","scorz", #"specific" @@ -152,11 +152,15 @@ z <- ready4::author(z) readLines("R/C4_CostlySource.R") %>% # Temporary fix until I work out why this stray include has been added. stringr::str_replace_all("#' @include ", "") %>% writeLines(con = "R/C4_CostlySource.R") -ready4::write_extra_pkgs_to_actions(consent_1L_chr = "Y") +#ready4::write_extra_pkgs_to_actions(path_to_dir_1L_chr = ".github/workflows", consent_1L_chr = "Y") ready4::write_to_edit_workflow("pkgdown.yaml", consent_1L_chr = "Y") # In other packages, run for "test-coverage.yaml" as well. -readLines("_pkgdown.yml") %>% - stringr::str_replace_all(" - text: Model", " - text: Framework & Model") %>% - writeLines(con = "_pkgdown.yml") usethis::use_package("ISOcodes") usethis::use_package("maps") -devtools::build_vignettes() +write_to_tidy_pkg(z$x_ready4fun_manifest, build_vignettes_1L_lgl = TRUE, + clean_license_1L_lgl = TRUE, consent_1L_chr = "Y", + examples_chr = character(0), suggest_chr = "pkgload") +# readLines("_pkgdown.yml") %>% +# stringr::str_replace_all(" - text: Model", " - text: Framework & Model") %>% +# writeLines(con = "_pkgdown.yml") + +# devtools::build_vignettes() diff --git a/data-raw/fns/get.R b/data-raw/fns/get.R index a581a38..cd6ce59 100644 --- a/data-raw/fns/get.R +++ b/data-raw/fns/get.R @@ -128,6 +128,269 @@ get_currency_tbls <- function(type_1L_chr = c("Both","Country","Currency"), } return(currency_tbl_xx) } +get_missing_medications <- function(medications_lup, + reference_var_chr = c("DPMQ", "Per Tablet")){ + reference_var_1L_chr <- intersect(reference_var_chr, names(medications_lup))[1] + missing_chr <- medications_lup %>% dplyr::filter(is.na(!!rlang::sym(reference_var_1L_chr))) %>% dplyr::pull(Medication) + return(missing_chr) +} +get_patterns <- function(descriptions_chr, + add_numeric_1L_lgl = TRUE, + flatten_1L_lgl = FALSE, + integers_1L_lgl = TRUE, + plural_chr = "s", + range_int = 1L:12L, + reference_1L_int = integer(0), + replace_blanks_1L_lgl = FALSE, + spaced_1L_lgl = TRUE, + strict_1L_lgl = TRUE, + type_1L_chr = c("pattern", "end", "start", "match", "mismatch", "quantity"), + unique_1L_lgl = TRUE, + units_chr = c("minute","hour","week","month","year"), + what_1L_chr = c("character", "double", "integer", "logical")){ + type_1L_chr <- match.arg(type_1L_chr) + what_1L_chr <- match.arg(what_1L_chr) + if(!is.na(range_int[1]) && ! identical(range_int, integer(0))){ + english_chr <- make_period_patterns(integers_1L_lgl = integers_1L_lgl, plural_chr = plural_chr, range_int = range_int, spaced_1L_lgl = spaced_1L_lgl, type_1L_chr = "english", units_chr = units_chr) + }else{ + english_chr <- character(0) + } + numeric_chr <- make_period_patterns(integers_1L_lgl = ifelse(what_1L_chr == "double", FALSE, integers_1L_lgl), + plural_chr = plural_chr, + spaced_1L_lgl = spaced_1L_lgl, + type_1L_chr = "numeric", + units_chr = units_chr) + patterns_xx <- purrr::map(descriptions_chr, + ~ { + description_1L_chr <- .x + purrr::map(c(english_chr,numeric_chr), + ~ { + periods_chr <- stringr::str_extract_all(description_1L_chr,.x) %>% purrr::flatten_chr() + if(identical(periods_chr, character(0))){ + NA_character_ + }else{periods_chr} + } + ) %>% purrr::flatten_chr() %>% purrr::discard(is.na) + }) + if(unique_1L_lgl){ + patterns_xx <- patterns_xx %>% purrr::map(~unique(.x)) + } + remove_chr <- make_period_patterns(integers_1L_lgl = integers_1L_lgl, plural_chr = plural_chr, spaced_1L_lgl = spaced_1L_lgl, type_1L_chr = "blank", units_chr = units_chr) + + extension_ls <- patterns_xx %>% purrr::map(~{ + all_chr <- .x + extension_ls <- all_chr %>% purrr::map(~{ + extend_1L_chr <- .x + extension_chr <- remove_chr %>% purrr::map_chr(~stringi::stri_replace_last_regex(extend_1L_chr,.x,"")) + extension_chr[nchar(extension_chr)==max(nchar(extension_chr))] %>% unique()}) + #extension_ls + }) + + if(!identical(reference_1L_int, integer(0))){ ## Still to test + patterns_xx <- patterns_xx %>% purrr::map2(extension_ls, + ~{ + all_chr <- .x + if(length(all_chr)>1){ + .y %>% + purrr::map_chr(~ + { + extension_chr <- .x + # extension_chr <- extension_chr[nchar(extension_chr)==max(nchar(extension_chr))] %>% unique() + if(plural_chr[reference_1L_int] == ""){ + extension_chr <- extension_chr[nchar(extension_chr)==min(nchar(extension_chr))] %>% unique() + }else{ + if(any(endsWith(extension_chr, plural_chr[reference_1L_int]))){ + extension_chr <- extension_chr[which(endsWith(extension_chr, plural_chr[reference_1L_int]))] + extension_chr <- extension_chr[nchar(extension_chr)==max(nchar(extension_chr))] + } + extension_chr <- unique(extension_chr) + } + #} + extension_chr + } ) + + }else{ + all_chr + } + }) + } + patterns_xx <- patterns_xx %>% purrr::map2(extension_ls,~{ + all_chr <- .x + if(length(all_chr)>1){ + only_numbers_chr <- .y %>% purrr::flatten_chr() %>% purrr::map_chr(~{ + all_1L_chr <- .x + candidates_chr <- remove_chr %>% + purrr::map_chr(~stringr::str_replace_all(all_1L_chr,.x,"")) + candidates_chr <- suppressWarnings(candidates_chr[!is.na(as.numeric(candidates_chr))]) %>% stringr::str_squish() %>% unique() + if(identical(candidates_chr, character(0))){ + candidates_chr <- NA_character_ + } + candidates_chr + }) %>% purrr::discard(is.na) + + if(identical(only_numbers_chr, character(0))){ + all_chr + }else{ + all_chr[nchar(only_numbers_chr)==max(nchar(only_numbers_chr))] %>% unique() + } + }else{ + all_chr + } + }) + if(type_1L_chr %in% c("start", "end", "match", + "quantity")){ # , "logical" + replace_blanks_1L_lgl <- T + } + if(replace_blanks_1L_lgl){ + patterns_xx <- patterns_xx %>% purrr::map(~{ + if(identical(.x, character(0))){NA_character_}else{.x %>% purrr::map_chr(~if(identical(.x, character(0))){NA_character_}else{.x})} + }) + } + if(type_1L_chr %in% c("start", "end", "match", "mismatch", "quantity")){ # , "logical" + start_ls <- descriptions_chr %>% purrr::map2(patterns_xx, ~ ifelse(is.na(.y[1]), NA_character_, suppressWarnings(sub(paste0(.y,".*"), "", .x)))) ## suppressWarnings? + end_ls <- descriptions_chr %>% purrr::map2(patterns_xx, ~ ifelse(is.na(.y[1]), NA_character_, suppressWarnings(sub(paste0(".*", .y), "", .x)))) ## suppressWarnings? + if(strict_1L_lgl){ + match_ls <- descriptions_chr %>% purrr::map2(patterns_xx, ~ ifelse(is.na(.x) && is.na(.y[1]), NA_character_, + { + all_chr <- ifelse(stringr::str_squish(.x) == .y,.x, NA_character_) %>% + purrr::discard(is.na) + ifelse(length(all_chr)>0,.x,NA_character_) + } + )) + mismatch_ls <- descriptions_chr %>% purrr::map2(patterns_xx, ~ ifelse(is.na(.x) && is.na(.y[1]), NA_character_, + { + all_chr <- ifelse(stringr::str_squish(.x) == .y,.x, NA_character_) %>% + purrr::discard(is.na) + ifelse(length(all_chr)==0,.x,NA_character_) + } + )) + }else{ + match_ls <- descriptions_chr %>% purrr::map2(patterns_xx, ~ ifelse(is.na(.y[1]), NA_character_, .x)) + mismatch_ls <- descriptions_chr %>% purrr::map2(patterns_xx, ~ ifelse(!is.na(.y[1]), NA_character_, .x)) + } + } + if(type_1L_chr == "start"){ + patterns_xx <- start_ls + } + if(type_1L_chr == "end"){ + patterns_xx <- end_ls + } + if(type_1L_chr %in% c("match", "mismatch", "quantity")){ #, "logical" + remove_chr <- make_period_patterns(integers_1L_lgl = integers_1L_lgl, plural_chr = plural_chr, spaced_1L_lgl = spaced_1L_lgl, type_1L_chr = "blank", units_chr = units_chr) + quantity_ls <- patterns_xx %>% purrr::map2(match_ls,~{ + if(!identical(.x,stringr::str_squish(.y))){ + NA_character_#.x + }else{ + phrases_chr <- .x + phrases_chr %>% purrr::map_chr(~{ + phrase_1L_chr <- .x + go_1L_lgl <- remove_chr %>% purrr::map_lgl(~stringr::str_detect(phrase_1L_chr,.x)) %>% any() + ifelse(go_1L_lgl, + { + all_chr <- remove_chr %>% purrr::map_chr(~stringr::str_remove_all(phrase_1L_chr,.x)) + all_chr[nchar(all_chr)==min(nchar(all_chr))] + }, + phrase_1L_chr) + }) + } + }) + if(add_numeric_1L_lgl){ + quantity_ls <- quantity_ls %>% purrr::map2(descriptions_chr, ~ifelse(is.na(.x), + ifelse(as.numeric(.y) %>% suppressWarnings() %>% is.na(),NA_character_,.y), + .x)) + if(type_1L_chr %in% c("match", "mismatch")){ + allowable_chr <- descriptions_chr[!(quantity_ls %>% purrr::flatten_chr() %>% is.na())] %>% unique() + + #if(type_1L_chr == "match"){ + match_ls <- descriptions_chr %>% purrr::map(~ifelse(.x %in% allowable_chr, .x, NA_character_)) + #} + #if(type_1L_chr == "mismatch"){ + mismatch_ls <- descriptions_chr %>% purrr::map(~ifelse(!.x %in% allowable_chr, .x, NA_character_)) + #} + } + } + if(type_1L_chr == "match"){ + patterns_xx <- match_ls + } + if(type_1L_chr == "mismatch"){ + patterns_xx <- mismatch_ls + } + if(type_1L_chr == "quantity"){ + patterns_xx <- quantity_ls + } + if(type_1L_chr %in% c("match", "quantity")){ + if(what_1L_chr == "double"){ + patterns_xx <- quantity_ls %>% purrr::map(~ as.double(.x)) + } + if(what_1L_chr == "integer"){ + patterns_xx <- quantity_ls %>% purrr::map(~ as.integer(.x)) + } + } + } + if(what_1L_chr == "logical"){ + patterns_xx <- patterns_xx %>% purrr::map(~ !is.na(.x[1])) #### + } + if(flatten_1L_lgl){ + if(what_1L_chr == "character"){ + fn <- purrr::flatten_chr + } + if(what_1L_chr == "double"){ + fn <- purrr::flatten_dbl + } + if(what_1L_chr == "integer"){ + fn <- purrr::flatten_int + } + if(what_1L_chr == "logical"){ + fn <- purrr::flatten_lgl + } + patterns_xx <- patterns_xx %>% fn + } + return(patterns_xx) +} +get_pattern_mismatches <- function(ds_tb, # unused? + var_nms_chr, + units_chr, + add_numeric_1L_lgl = TRUE, + integers_1L_lgl = FALSE, + invert_1L_lgl = FALSE, + plural_chr = c("s", ""), + range_int = NA_integer_, + reference_1L_int = 1L, + sort_1L_lgl = FALSE, + spaced_1L_lgl = NA, + strict_1L_lgl = TRUE, + trim_1L_lgl = TRUE, + what_1L_chr = c("unique", "all", "logical") +){ + what_1L_chr <- match.arg(what_1L_chr) + mismatches_xx <- var_nms_chr %>% purrr::map(~ds_tb %>% dplyr::pull(!!rlang::sym(.x)) %>% + get_patterns(integers_1L_lgl = integers_1L_lgl, + add_numeric_1L_lgl = add_numeric_1L_lgl, + plural_chr = plural_chr, + range_int = range_int, + reference_1L_int = reference_1L_int, + replace_blanks_1L_lgl = TRUE, + spaced_1L_lgl = spaced_1L_lgl, + strict_1L_lgl = strict_1L_lgl, + unique_1L_lgl = TRUE, + units_chr = units_chr, + type_1L_chr = ifelse(invert_1L_lgl,"match","mismatch"), + flatten_1L_lgl = TRUE, + #what_1L_chr = "double" + )) + if(trim_1L_lgl){ + mismatches_xx <- mismatches_xx %>% purrr::map(~ifelse(trimws(.x)=="",NA_character_,.x)) + } + if(what_1L_chr == "logical"){ + mismatches_xx <- mismatches_xx %>% purrr::map(~!is.na(.x)) + } + if(what_1L_chr == "unique") + mismatches_xx <- mismatches_xx %>% purrr::flatten_chr() %>% unique() %>% purrr::discard(is.na) + if(sort_1L_lgl){ + mismatches_xx <- mismatches_xx %>% sort() + } + return(mismatches_xx) +} get_seed_cities <- function(names_1L_lgl = F, indices_int = 2L, default_pkg_ds_chr = c("world.cities", "maps"), diff --git a/data-raw/fns/make.R b/data-raw/fns/make.R index 8d2af73..7720574 100644 --- a/data-raw/fns/make.R +++ b/data-raw/fns/make.R @@ -1,3 +1,17 @@ +make_assignment_lup <- function(ds_tb, # export to programs pkg + group_idx_1L_int = 2L, + group_var_nm_1L_chr = "participation", + response_id_indcs_int = integer(0),#3L:6L, + response_id_var_nms_chr = character(0),#c("response_ids_bl_chr","response_ids_8_wk_chr","response_ids_6_mnth_chr","response_ids_ruq_6_mnth_chr") + uid_idx_1L_int = 1L, + uid_var_nm_1L_chr = "uid_chr"){ + if(!tibble::is_tibble(ds_tb)) + ds_tb <- tibble::as_tibble(ds_tb) + assignment_lup <- ds_tb %>% dplyr::select(tidyselect::all_of(c(uid_idx_1L_int, group_idx_1L_int, response_id_indcs_int))) + names(assignment_lup) <- c(uid_var_nm_1L_chr, group_var_nm_1L_chr, response_id_var_nms_chr) + assignment_lup <- dplyr::filter(assignment_lup, !is.na(!!rlang::sym(uid_var_nm_1L_chr))) %>% dplyr::filter(!!rlang::sym(uid_var_nm_1L_chr) != "") + return(assignment_lup) +} make_country_correspondences <- function(option_1L_chr = "custom", old_nms_chr = character(0), new_nms_chr = character(0)){ @@ -123,6 +137,91 @@ make_ds_names <- function(label_1L_chr = "Standardised", } return(names_chr) } +make_medications_lup <- function(key_tb, + prices_tb, + add_dosage_1L_lgl = T, + brand_var_nm_1L_chr = "Brand Name", + # drop_chr = c("Formulary", "Program", "Manufacturer Code", "Responsible Person", "Maximum Repeats", "Claimed Price for Pack", + # "Claimed Price to Pharmacist", "Claimed DPMQ", "Premium","C'wlth Pays Premium"), + integers_1L_lgl = TRUE, ##?? + keep_chr = c("Response", "Medication", "Legal Instrument MoA", "Brand Name", "Maximum Quantity", "DPMQ", "Maximum Patient Charge", "Milligrams", "AMT Trade Product Pack", "Per Tablet", "Per mg"), + #medications_lup = NULL, + medication_var_nm_1L_chr = "`Legal Instrument Drug`", + milligrams_var_nm_1L_chr = "AMT Trade Product Pack", + plural_chr = "", + range_int = NA_integer_, + reference_1L_int = integer(0), + rename_meds_lup = ready4show::ready4show_correspondences(), + replace_blanks_1L_lgl = F, + spaced_1L_lgl = TRUE, + + units_chr = "mg"){ + medications_lup <- key_tb %>% + dplyr::left_join(prices_tb %>% dplyr::mutate(Medication = `Legal Instrument Drug`)) + ### + medications_tb <- medications_lup %>% dplyr::filter(is.na(`Item Code`)) %>% dplyr::select(c("Response", "Medication")) + ### + medications_lup <- medications_lup %>% dplyr::filter(!is.na(`Item Code`)) + ### + medications_lup <- dplyr::bind_rows(medications_lup, medications_tb %>% # make update fn + dplyr::left_join(prices_tb %>% dplyr::mutate(Medication = !!rlang::sym(brand_var_nm_1L_chr)))) %>% # make arg + dplyr::arrange(as.numeric(Response)) # make arg + ### + ## unmatched_chr <- medications_lup %>% dplyr::filter(is.na(`Item Code`)) %>% dplyr::pull(Medication) # make fn + ### + # rename_lup <- ready4show::ready4show_correspondences() %>% # make arg + # ready4show::renew.ready4show_correspondences(old_nms_chr = setdiff(unmatched_chr, c("None","Agomelatine", "Pain relief", "St John’s Wort","Valerian","Vitamins","Other","blank response")), + # new_nms_chr = c("Dosulepin", "Fluvoxamine", "Lithium", "Valproic acid")) + ### + medications_lup <- update_medications_lup(medications_lup, + integers_1L_lgl = integers_1L_lgl, ##?? + keep_chr = keep_chr, + medication_var_nm_1L_chr = medication_var_nm_1L_chr, + milligrams_var_nm_1L_chr = milligrams_var_nm_1L_chr, + plural_chr = plural_chr, + prices_tb = prices_tb, + range_int = range_int, + reference_1L_int = reference_1L_int, + rename_meds_lup = rename_meds_lup, + replace_blanks_1L_lgl = replace_blanks_1L_lgl, + spaced_1L_lgl = spaced_1L_lgl, + type_1L_chr = "dosage", + units_chr = units_chr) + + + return(medications_lup) + +} +make_period_patterns <- function(range_int = 1L:12L, + integers_1L_lgl = TRUE, + plural_chr = "s", + spaced_1L_lgl = TRUE, + type_1L_chr = c("english","numeric","blank"), + units_chr = c("minute","hour","week","month","year")){ + type_1L_chr <- match.arg(type_1L_chr) + period_patterns_chr <- purrr::map(plural_chr, + ~ { + plural_1L_chr <- .x + spacing_chr <- c("","\\s+") + if(!is.na(spaced_1L_lgl)){ + spacing_chr <- spacing_chr[spaced_1L_lgl +1] + } + if(type_1L_chr == "english"){ + patterns_chr <- units_chr %>% purrr::map(~{ + unit_1L_chr <- .x + range_int %>% purrr::map(~paste0(english::words(.x),paste0(spacing_chr, unit_1L_chr),ifelse(.x>1,plural_1L_chr,""))) %>% purrr::flatten_chr()}) %>% purrr::flatten_chr() + } + if(type_1L_chr %in% c("blank","numeric")){ + patterns_chr <- c(paste0(ifelse(type_1L_chr == "blank","",1),spacing_chr,units_chr), + spacing_chr %>% purrr::map(~paste0(ifelse(type_1L_chr == "blank","", + ifelse(integers_1L_lgl,"[[:digit:]]+","\\d*\\.?\\d+")),.x,units_chr,plural_1L_chr)) %>% purrr::flatten_chr()) + } + patterns_chr + }) %>% purrr::flatten_chr() %>% unique() + + + return(period_patterns_chr) +} make_standardised_dss <- function(label_1L_chr = "Country", lookup_Ready4useDyad = ready4use::Ready4useDyad(), seed_Ready4useDyad = ready4use::Ready4useDyad(), diff --git a/data-raw/fns/update.R b/data-raw/fns/update.R index ec23542..6bc62f9 100644 --- a/data-raw/fns/update.R +++ b/data-raw/fns/update.R @@ -110,12 +110,133 @@ update_currency_correspondences <- function(correspondences_x_r3 = ready4show::r } return(correspondences_x_r3) } - update_currency_default_ls <- function(default_ls, force_standard_1L_lgl = F){ default_ls$CostlySeed_r4 <- add_default_currency_seed(default_ls$CostlySeed_r4) return(default_ls) } + +update_medications_lup <- function(medications_lup, + average_chr = character(0), + integers_1L_lgl = TRUE, ##?? + arrange_by_1L_chr = "Response", + arrange_tfmn_fn = identity, + keep_chr = character(0), + medication_var_nm_1L_chr = "Legal Instrument Drug", + milligrams_indx_1L_int = 1L, + milligrams_var_nm_1L_chr = "AMT Trade Product Pack", + new_cases_tb = NULL, + plural_chr = "", + prices_tb = NULL, + range_int = NA_integer_, + reference_1L_int = integer(0), + rename_meds_lup = ready4show::ready4show_correspondences(), + rename_prices_lup = ready4show::ready4show_correspondences(), + replace_blanks_1L_lgl = F, + spaced_1L_lgl = TRUE, + type_1L_chr = c("dosage", "validation", "weighted"), + units_chr = "mg"){ + type_1L_chr <- match.arg(type_1L_chr) + if(is.null(new_cases_tb)){ + new_cases_tb <- medications_lup %>% dplyr::filter(F) + }else{ + new_cases_tb <- dplyr::bind_rows(medications_lup %>% dplyr::filter(F), new_cases_tb) + } + if(!identical(rename_meds_lup, ready4show::ready4show_correspondences()) && !is.null(prices_tb)){ + filtered_tb <- prices_tb %>% + dplyr::filter(!!rlang::sym(medication_var_nm_1L_chr) %in% rename_prices_lup$old_nms_chr) %>% + dplyr::mutate(!!rlang::sym(medication_var_nm_1L_chr) := !!rlang::sym(medication_var_nm_1L_chr) %>% purrr::map_chr(~ready4::get_from_lup_obj(rename_prices_lup, match_var_nm_1L_chr = "old_nms_chr", match_value_xx = .x, target_var_nm_1L_chr = "new_nms_chr"))) + new_cases_tb <- dplyr::bind_rows(new_cases_tb, + medications_lup %>% dplyr::select(c("Response", "Medication")) %>% dplyr::distinct() %>% make_medications_lup(prices_tb = filtered_tb, add_dosage_1L_lgl = F) %>% + dplyr::filter(!is.na(!!rlang::sym(milligrams_var_nm_1L_chr)))) %>% + dplyr::select(names(medications_lup)) + #medications_lup <- medications_lup %>% dplyr::filter(!Medication %in% rename_prices_lup$new_nms_chr) + } + if(!identical(rename_meds_lup, ready4show::ready4show_correspondences()) && !is.null(prices_tb)){ + medications_tb <- medications_lup %>% dplyr::filter(Medication %in% rename_meds_lup$old_nms_chr) %>% dplyr::select(c("Response", "Medication")) %>% + dplyr::mutate(Medication = Medication %>% purrr::map_chr(~ready4::get_from_lup_obj(rename_meds_lup, match_var_nm_1L_chr = "old_nms_chr", match_value_xx = .x, target_var_nm_1L_chr = "new_nms_chr"))) + medications_tb <- medications_tb %>% # make update fn + dplyr::left_join(prices_tb %>% dplyr::mutate(Medication = !!rlang::sym(medication_var_nm_1L_chr))) + medications_tb <- medications_tb %>% + dplyr::select(intersect(names(medications_tb), names(medications_lup))) + medications_lup <- medications_lup %>% dplyr::filter(!Medication %in% rename_meds_lup$old_nms_chr) + medications_lup <- dplyr::bind_rows(medications_lup, + medications_tb ) %>% + dplyr::arrange(as.numeric(Response)) # make arg + } + ### + ## unmatched_chr <- medications_lup %>% dplyr::filter(is.na(`Item Code`)) %>% dplyr::pull(Medication) # make fn + ### + ### + if(nrow(new_cases_tb)>0){ + medications_lup <- dplyr::bind_rows(medications_lup %>% dplyr::filter(!Medication %in% c(rename_prices_lup$new_nms_chr, intersect(new_cases_tb$Medication, get_missing_medications(medications_lup)))), + new_cases_tb %>% + dplyr::mutate(Response = Medication %>% purrr::map_chr(~ready4::get_from_lup_obj(medications_lup, + target_var_nm_1L_chr = "Response", + match_var_nm_1L_chr = "Medication", + match_value_xx = .x)))) %>% dplyr::arrange(!!rlang::sym(arrange_by_1L_chr) %>% arrange_tfmn_fn()) + } + if(type_1L_chr %in% c("dosage", "weighted")){ + if(!"Milligrams" %in% names(medications_lup)){ + medications_lup <- dplyr::mutate(medications_lup, Milligrams = NA_character_) + } + medications_lup <- dplyr::mutate(medications_lup, + Milligrams = dplyr::case_when(is.na(!!rlang::sym(milligrams_var_nm_1L_chr)) ~ Milligrams, + T ~ !!rlang::sym(milligrams_var_nm_1L_chr) %>% #`AMT Trade Product Pack` %>% + get_patterns(integers_1L_lgl = integers_1L_lgl, plural_chr = plural_chr, range_int = range_int, replace_blanks_1L_lgl = replace_blanks_1L_lgl, + spaced_1L_lgl = spaced_1L_lgl, units_chr = units_chr) %>% ## ?? + purrr::map_chr(~paste0(.x,collapse = "_")))) + #if(!"Per Tablet" %in% names(medications_lup)){ + medications_lup <- dplyr::mutate(medications_lup, `Per Tablet` = DPMQ / `Maximum Quantity`) %>% + dplyr::mutate(`Per mg` = `Per Tablet` / (Milligrams %>% get_patterns(flatten_1L_lgl = T, + #integers_1L_lgl = F, + range_int = range_int, + spaced_1L_lgl = spaced_1L_lgl, + type_1L_chr = "quantity", + units_chr = units_chr, what_1L_chr = "double", plural_chr = plural_chr, + reference_1L_int = reference_1L_int))) + #} + } + if(!identical(average_chr, character(0))){ + medications_lup <- #dplyr::left_join(medications_lup, + update_medications_lup(medications_lup, arrange_by_1L_chr = arrange_by_1L_chr, arrange_tfmn_fn = arrange_tfmn_fn, integers_1L_lgl = integers_1L_lgl, milligrams_var_nm_1L_chr = milligrams_var_nm_1L_chr, + new_cases_tb = dplyr::bind_rows(medications_lup %>% dplyr::filter(F), + suppressWarnings(dplyr::summarise(medications_lup, dplyr::across(c(`Maximum Quantity`, DPMQ, Milligrams, `Per Tablet`, `Per mg`), + ~ { + if(is.numeric(.x)){ + mean(.x, na.rm = TRUE) + }else{ + .x %>% get_patterns(flatten_1L_lgl = T, range_int = range_int, type_1L_chr = "quantity", + units_chr = units_chr, what_1L_chr = "integer", plural_chr = plural_chr, + reference_1L_int = reference_1L_int, + spaced_1L_lgl = spaced_1L_lgl) %>% # New + mean(na.rm = TRUE) + }}))) %>% + dplyr::mutate(Medication = average_chr, + Milligrams = paste0(Milligrams, " ", units_chr[1]))), + plural_chr = plural_chr, range_int = range_int, replace_blanks_1L_lgl = replace_blanks_1L_lgl, + spaced_1L_lgl = spaced_1L_lgl, units_chr = units_chr) + } + ### + if(!identical(keep_chr, character(0))){ + medications_lup <- medications_lup %>% + dplyr::select(tidyselect::all_of(keep_chr)) + } + if(type_1L_chr == "weighted"){ + medications_lup <- medications_lup$Response %>% unique() %>% purrr::map_dfr(~dplyr::filter(medications_lup, Response == .x) %>% dplyr::summarise(Response = .x, + Medication = paste0(unique(Medication), collapse = " / "), + `Per Tablet` = mean(`Per Tablet`, na.rm = TRUE), + `Per mg` = mean(`Per mg`, na.rm = TRUE))) %>% + dplyr::mutate(dplyr::across(dplyr::where(is.numeric), ~ ifelse(is.nan(.x),NA_real_,.x))) + } + return(medications_lup) +} + + + + + + update_module_slot <- function(x_r4, # Be careful about potentially making this a Method of Ready4Module - need to think through renew syntax y_r3, what_1L_chr, diff --git a/man/costly-package.Rd b/man/costly-package.Rd index a2539b6..908081d 100644 --- a/man/costly-package.Rd +++ b/man/costly-package.Rd @@ -2,7 +2,6 @@ % Please edit documentation in R/costly-package.R, R/pkg_costly.R \docType{package} \name{costly-package} -\alias{costly} \alias{costly-package} \title{costly: Develop, Use and Share Unit Cost Datasets for Health Economic Analysis} \description{