Dev (#61)

* inframe method working with acceptable performance * inframe vignette start * finished S3 and docs * finished inframe vignette * finished inframe vignette * catch empty study pat pool * fix eval mistake in sim_ur_scenarios() * update funnel plot vignette * new performance vignette * fix linting and checks * update funnel plot performance vignette * add unit test to ensure simulation consistency * fix error for inframe visit_med75 * update man * memory optimisation for sim_ur_scenarios * finished performance vignette * render docs
openpharma · Sep 25, 2024 · acac522 · acac522
1 parent dd5e9e7
commit acac522
Show file tree

Hide file tree

Showing 181 changed files with 34,206 additions and 8,867 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -15,3 +15,4 @@
 ^cran-comments\.md$
 ^data-raw$
 ^CRAN-SUBMISSION$
+^\.tmp$
diff --git a/.gitignore b/.gitignore
@@ -22,3 +22,5 @@ run_remote.md
 *.csv
 
 .DS_Store
+
+.tmp
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: simaerep
 Title: Find Clinical Trial Sites Under-Reporting Adverse Events
-Version: 0.5.0
+Version: 0.5.0.900
 Authors@R: c(
     person(given = "Bjoern",
            family = "Koneswarakantha",
@@ -34,16 +34,20 @@ Imports:
     furrr (>= 0.2.1),
     progressr,
     knitr,
-    tibble
+    tibble,
+    dbplyr
 Suggests:
     testthat,
     devtools,
     pkgdown,
     spelling,
     haven,
     vdiffr,
-    lintr
+    lintr,
+    DBI,
+    duckdb,
+    ggExtra
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Language: en-US
 Config/testthat/edition: 3
diff --git a/NAMESPACE b/NAMESPACE
@@ -16,6 +16,7 @@ export(get_pat_pool_config)
 export(get_portf_perf)
 export(is_orivisit)
 export(is_simaerep)
+export(max_rank)
 export(orivisit)
 export(pat_aggr)
 export(pat_pool)
@@ -29,14 +30,17 @@ export(prep_for_sim)
 export(prob_lower_site_ae_vs_study_ae)
 export(purrr_bar)
 export(sim_after_prep)
+export(sim_inframe)
 export(sim_scenario)
 export(sim_sites)
 export(sim_studies)
 export(sim_test_data_patient)
 export(sim_test_data_portfolio)
 export(sim_test_data_study)
+export(sim_ur)
 export(sim_ur_scenarios)
 export(simaerep)
+export(simaerep_inframe)
 export(site_aggr)
 export(with_progress_cnd)
 import(ggplot2)
@@ -45,13 +49,18 @@ importFrom(cowplot,draw_label)
 importFrom(cowplot,get_plot_component)
 importFrom(cowplot,ggdraw)
 importFrom(cowplot,plot_grid)
+importFrom(dbplyr,window_order)
 importFrom(dplyr,across)
+importFrom(dplyr,all_of)
 importFrom(dplyr,any_of)
 importFrom(dplyr,arrange)
 importFrom(dplyr,between)
 importFrom(dplyr,bind_cols)
 importFrom(dplyr,bind_rows)
 importFrom(dplyr,case_when)
+importFrom(dplyr,collect)
+importFrom(dplyr,cross_join)
+importFrom(dplyr,cume_dist)
 importFrom(dplyr,dense_rank)
 importFrom(dplyr,desc)
 importFrom(dplyr,distinct)
@@ -61,6 +70,7 @@ importFrom(dplyr,group_by)
 importFrom(dplyr,group_by_at)
 importFrom(dplyr,inner_join)
 importFrom(dplyr,is_grouped_df)
+importFrom(dplyr,join_by)
 importFrom(dplyr,lag)
 importFrom(dplyr,lead)
 importFrom(dplyr,left_join)
@@ -69,17 +79,23 @@ importFrom(dplyr,mutate_all)
 importFrom(dplyr,mutate_at)
 importFrom(dplyr,n)
 importFrom(dplyr,n_distinct)
+importFrom(dplyr,near)
 importFrom(dplyr,one_of)
+importFrom(dplyr,percent_rank)
 importFrom(dplyr,pull)
 importFrom(dplyr,rename)
 importFrom(dplyr,right_join)
 importFrom(dplyr,row_number)
 importFrom(dplyr,sample_n)
 importFrom(dplyr,select)
+importFrom(dplyr,slice_sample)
+importFrom(dplyr,starts_with)
 importFrom(dplyr,summarise)
 importFrom(dplyr,summarise_all)
 importFrom(dplyr,summarise_at)
+importFrom(dplyr,tbl)
 importFrom(dplyr,ungroup)
+importFrom(dplyr,union_all)
 importFrom(dplyr,vars)
 importFrom(forcats,fct_relevel)
 importFrom(furrr,furrr_options)
@@ -114,6 +130,7 @@ importFrom(stats,rpois)
 importFrom(stats,runif)
 importFrom(stats,sd)
 importFrom(stringr,str_count)
+importFrom(stringr,str_detect)
 importFrom(stringr,str_length)
 importFrom(stringr,str_pad)
 importFrom(tibble,tibble)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,9 @@
+# simaerep 0.6.0
+- inframe method use table operations only, do not use visit_med75
+- https://github.com/openpharma/simaerep/issues/59
+- https://github.com/openpharma/simaerep/issues/16
+- update vignettes
+
 # simaerep 0.5.0
 - allow flexible AE rates in data simulations
 - add vignette comparing simaerep to gsm performance

diff --git a/R/0_imports.R b/R/0_imports.R
@@ -9,15 +9,17 @@
 #' @importFrom purrr map_int map_chr
 #' @importFrom furrr future_map future_pmap furrr_options
 #' @importFrom progressr with_progress
-#' @importFrom stringr str_count str_pad str_length
+#' @importFrom stringr str_count str_pad str_length str_detect
 #' @importFrom rlang := .data enexpr env_has .env
 #' @importFrom dplyr select mutate filter summarise group_by summarise_all summarise_at
 #' @importFrom dplyr mutate_all mutate_at ungroup vars bind_cols bind_rows pull
 #' @importFrom dplyr n_distinct distinct arrange right_join left_join inner_join
 #' @importFrom dplyr rename sample_n between row_number dense_rank desc case_when
 #' @importFrom dplyr group_by_at n is_grouped_df everything one_of lag any_of across
-#' @importFrom dplyr lead
+#' @importFrom dplyr lead tbl cross_join join_by union_all cume_dist slice_sample
+#' @importFrom dplyr percent_rank all_of starts_with collect near
 #' @importFrom tidyr tibble unnest nest fill
 #' @importFrom knitr kable
 #' @importFrom tibble tibble
+#' @importFrom dbplyr window_order
 NULL
diff --git a/R/S3_orivisit.R b/R/S3_orivisit.R
@@ -15,8 +15,7 @@ validate_orivisit <- function(x) {
   comp <- sort(attributes(x)$names) ==  sort(c("dim", "df_summary", "str_call"))
   stopifnot(all(comp))
   stopifnot(length(x$dim) == 2)
-  stopifnot(is.data.frame(x$df_summary))
-  stopifnot(nrow(x$df_summary) == 1)
+  inherits(x$df_summary, "data.frame") | inherits(x$df_summary, "tbl")
   stopifnot(is.character(x$str_call) | is.na(x$str_call))
   return(x)
 }
@@ -44,7 +43,7 @@ get_str_var <- function(call, env) {
 
   str_call <- deparse(call)
 
-  if (str_length(str_call) > 80) {
+  if (sum(str_length(str_call)) > 80) {
     return(NA)
   }
 
@@ -94,7 +93,7 @@ orivisit <- function(df_visit, call = NULL, env = parent.frame()) {
     call <- rlang::enexpr(df_visit)
   }
 
-  stopifnot(is.data.frame(df_visit))
+  stopifnot(inherits(df_visit, "data.frame") | inherits(df_visit, "tbl"))
 
   dim <- dim(df_visit)
   df_summary <- summarise_df_visit(df_visit)
@@ -117,11 +116,15 @@ as.data.frame.orivisit <- function(x, ..., env = parent.frame()) {
 
   df <- rlang::env_get(env, x$str_call, inherit = TRUE)
 
-  dim <- dim(df)
-  df_summary <- summarise_df_visit(df)
+  df_is_tbl <- ! inherits(df, "data.frame") & inherits(df, "tbl")
 
-  if (! all.equal(df_summary, x$df_summary, tolerance = 1e-4)) stop.orivisit()
-  if (! all(dim == x$dim)) stop.orivisit()
+  if (! df_is_tbl) {
+    dim <- dim(df)
+    df_summary <- summarise_df_visit(df)
+
+    if (! all.equal(df_summary, x$df_summary, tolerance = 1e-4)) stop.orivisit()
+    if (! all(dim == x$dim)) stop.orivisit()
+  }
 
   return(df)
 }