edits to work with new mdl_ingredients_ls

.github/workflows/R-CMD-check.yaml

@@ -73,7 +73,6 @@ jobs:
  do
  eval sudo $cmd
  done < <(Rscript -e 'cat(remotes::system_requirements("ubuntu", "20.04"), sep = "\n")')
-
  - name: Install system dependencies
  if: runner.os == 'MacOS' && !matrix.config.autobrew
  run: brew install harfbuzz fribidi
@@ -88,13 +87,6 @@ jobs:
  remotes::install_cran("rcmdcheck")
  shell: Rscript {0}
 
- - name: Address conditional specific install fail
- if: runner.os == 'Linux'
- run: |
- Rscript -e "remove.packages(c('igraph'))"
- conda install -c r r-igraph
- Rscript -e "install.packages('remotes')" -e "options(timeout=600)" -e "remotes::install_github('ready4-dev/specific')"
-
  - name: Session info
  run: |
  options(width = 100)

.github/workflows/pkgdown.yaml

@@ -11,7 +11,7 @@ name: pkgdown
 
 jobs:
  pkgdown:
- runs-on: macOS-latest
+ runs-on: ubuntu-latest
  env:
  GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
  steps:

R/fn_get.R

@@ -232,7 +232,7 @@ get_mdl_smrys <- function (ingredients_ls, mdl_nms_chr = NULL)
 #' @export 
 #' @importFrom purrr map2_dfr map_chr map_lgl
 #' @importFrom ready4 get_from_lup_obj
-#' @importFrom dplyr filter mutate
+#' @importFrom dplyr filter mutate case_when
 #' @keywords internal
 get_mdls_lup <- function (ttu_dv_dss_tb = NULL, mdl_predrs_in_ds_chr = NULL, 
  utility_type_chr = NULL, ttu_dv_nms_chr = "TTU", server_1L_chr = "dataverse.harvard.edu", 
@@ -263,6 +263,8 @@ get_mdls_lup <- function (ttu_dv_dss_tb = NULL, mdl_predrs_in_ds_chr = NULL,
  character(0))
  })) %>% dplyr::mutate(ds_url = urls_chr)
  })
+ mdls_lup <- mdls_lup %>% dplyr::mutate(source_chr = dplyr::case_when(is.na(source_chr) ~ 
+ "Primary Analysis", T ~ source_chr))
  }
  else {
  mdls_lup <- NULL
@@ -280,8 +282,8 @@ get_mdls_lup <- function (ttu_dv_dss_tb = NULL, mdl_predrs_in_ds_chr = NULL,
 #' @return Model (a model)
 #' @rdname get_model
 #' @export 
-#' @importFrom specific get_table_predn_mdl
 #' @importFrom ready4 get_from_lup_obj
+#' @importFrom specific get_table_predn_mdl
 #' @keywords internal
 get_model <- function (mdls_lup, mdl_nm_1L_chr, make_from_tbl_1L_lgl = T, 
  mdl_meta_data_ls = NULL, server_1L_chr = "dataverse.harvard.edu", 
@@ -292,10 +294,13 @@ get_model <- function (mdls_lup, mdl_nm_1L_chr, make_from_tbl_1L_lgl = T,
  mdl_meta_data_ls <- get_mdl_metadata(mdls_lup, mdl_nm_1L_chr = mdl_nm_1L_chr, 
  server_1L_chr = server_1L_chr, key_1L_chr = key_1L_chr)
  }
+ analysis_1L_chr <- ready4::get_from_lup_obj(mdls_lup, 
+ match_value_xx = mdl_nm_1L_chr, match_var_nm_1L_chr = "mdl_nms_chr", 
+ target_var_nm_1L_chr = "source_chr", evaluate_1L_lgl = F)
+ if (analysis_1L_chr == "Primary Analysis") 
+ analysis_1L_chr <- NULL
  model_mdl <- specific::get_table_predn_mdl(mdl_nm_1L_chr, 
- ingredients_ls = mdl_meta_data_ls, analysis_1L_chr = ready4::get_from_lup_obj(mdls_lup, 
- match_value_xx = mdl_nm_1L_chr, match_var_nm_1L_chr = "mdl_nms_chr", 
- target_var_nm_1L_chr = "source_chr", evaluate_1L_lgl = F))
+ ingredients_ls = mdl_meta_data_ls, analysis_1L_chr = analysis_1L_chr)
  }
  else {
  model_mdl <- get_mdl_from_dv(mdl_nm_1L_chr, dv_ds_nm_1L_chr = get_mdl_ds_url(mdls_lup, 

R/fn_make.R

@@ -356,6 +356,10 @@ make_predn_metadata_ls <- function (data_tb, cmprsn_groups_chr = NULL, cmprsn_va
  data_tb <- specific::rename_from_nmd_vec(data_tb, nmd_vec_chr = predr_vars_nms_chr, 
  vec_nms_as_new_1L_lgl = T)
  }
+ if (is.null(mdl_meta_data_ls)) {
+ mdl_meta_data_ls <- get_mdl_metadata(mdls_lup, mdl_nm_1L_chr = mdl_nm_1L_chr, 
+ key_1L_chr = key_1L_chr, server_1L_chr = server_1L_chr)
+ }
  predictors_lup <- get_predictors_lup(mdl_meta_data_ls = mdl_meta_data_ls, 
  mdls_lup = mdls_lup, mdl_nm_1L_chr = mdl_nm_1L_chr, outp_is_abbrs_tb = F, 
  server_1L_chr = server_1L_chr, key_1L_chr = key_1L_chr)

data-raw/fns/get.R

@@ -71,11 +71,12 @@ get_mdl_ctlg_url <- function(mdls_lup,
  all_lbls_chr <- purrr::map_chr(ds_ls,~.x$label)
  include_lgl <- all_lbls_chr %>% purrr::map_lgl(~startsWith(.x,"AAA_TTU_MDL_CTG"))
  all_descs_chr <- purrr::map_chr(ds_ls,~.x$description)
- include_lgl <- include_lgl & (all_descs_chr %>% purrr::map_lgl(~stringr::str_detect(.x,
- ready4::get_from_lup_obj(mdls_lup,
- match_value_xx = mdl_nm_1L_chr,
- match_var_nm_1L_chr = "mdl_nms_chr",
- target_var_nm_1L_chr = "source_chr",
+ include_lgl <- include_lgl & (all_descs_chr %>%
+ purrr::map_lgl(~stringr::str_detect(.x,
+ ready4::get_from_lup_obj(mdls_lup,
+ match_value_xx = mdl_nm_1L_chr,
+ match_var_nm_1L_chr = "mdl_nms_chr",
+ target_var_nm_1L_chr = "source_chr",
  evaluate_1L_lgl = F))))
  idx_1L_int <- which(include_lgl)
  if(identical(idx_1L_int,integer(0))){
@@ -147,6 +148,9 @@ get_mdls_lup <- function(ttu_dv_dss_tb = NULL,
  character(0))})) %>%
  dplyr::mutate(ds_url = urls_chr)
  })
+ mdls_lup <- mdls_lup %>%
+ dplyr::mutate(source_chr = dplyr::case_when(is.na(source_chr) ~ "Primary Analysis",
+ T ~ source_chr))
  }else{
  mdls_lup <- NULL
  }
@@ -199,13 +203,16 @@ get_model <- function(mdls_lup,
  server_1L_chr = server_1L_chr,
  key_1L_chr = key_1L_chr)
  }
+ analysis_1L_chr <- ready4::get_from_lup_obj(mdls_lup,
+ match_value_xx = mdl_nm_1L_chr,
+ match_var_nm_1L_chr = "mdl_nms_chr",
+ target_var_nm_1L_chr = "source_chr",
+ evaluate_1L_lgl = F)
+ if(analysis_1L_chr == "Primary Analysis")
+ analysis_1L_chr <- NULL
  model_mdl <- specific::get_table_predn_mdl(mdl_nm_1L_chr,
- ingredients_ls = mdl_meta_data_ls,
- analysis_1L_chr = ready4::get_from_lup_obj(mdls_lup,
- match_value_xx = mdl_nm_1L_chr,
- match_var_nm_1L_chr = "mdl_nms_chr",
- target_var_nm_1L_chr = "source_chr",
- evaluate_1L_lgl = F))
+ ingredients_ls = mdl_meta_data_ls,
+ analysis_1L_chr = analysis_1L_chr)
  }else{
  model_mdl <- get_mdl_from_dv(mdl_nm_1L_chr,
  dv_ds_nm_1L_chr = get_mdl_ds_url(mdls_lup,

data-raw/fns/make.R

@@ -274,11 +274,17 @@ make_predn_metadata_ls <- function(data_tb,
  utl_var_nm_1L_chr = "AQoL6D_HU",
  server_1L_chr = "dataverse.harvard.edu",
  key_1L_chr = NULL){
- if(!is.null(predr_vars_nms_chr)){
- data_tb <- specific::rename_from_nmd_vec(data_tb,
- nmd_vec_chr = predr_vars_nms_chr,
- vec_nms_as_new_1L_lgl = T)
- }
+ if(!is.null(predr_vars_nms_chr)){
+ data_tb <- specific::rename_from_nmd_vec(data_tb,
+ nmd_vec_chr = predr_vars_nms_chr,
+ vec_nms_as_new_1L_lgl = T)
+ }
+ if(is.null(mdl_meta_data_ls)){
+ mdl_meta_data_ls <- get_mdl_metadata(mdls_lup,
+ mdl_nm_1L_chr = mdl_nm_1L_chr,
+ key_1L_chr = key_1L_chr,
+ server_1L_chr = server_1L_chr)
+ }
  predictors_lup <- get_predictors_lup(mdl_meta_data_ls = mdl_meta_data_ls,
  mdls_lup = mdls_lup,
  mdl_nm_1L_chr = mdl_nm_1L_chr,