Merge pull request #250 from metrumresearchgroup/release/0.4.0

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: pmtables
 Type: Package
 Title: Tables for Pharmacometrics
-Version: 0.3.3
+Version: 0.4.0
 Authors@R: 
     c(
     person(given = "Kyle",
@@ -19,7 +19,11 @@ Authors@R:
     person(given = "Devin",
            family = "Pastoor",
            role = "ctb",
-           email = "devin.pastoor@gmail.com")
+           email = "devin.pastoor@gmail.com"),
+    person(given = "Kyle",
+           family = "Barrett",
+           role = "ctb",
+           email = "barrettk@metrumrg.com") 
     )
 Maintainer: Kyle Baron <kyleb@metrumrg.com>
 Description: Summarize data sets and create publication-quality tables for 
@@ -45,6 +49,7 @@ Collate:
     'class-pmtable.R'
     'continuous_table.R'
     'data_inventory_table.R'
+    'demographics-table.R'
     'discrete_table.R'
     'knit-dependencies.R'
     'preview.R'

NAMESPACE

@@ -48,6 +48,7 @@ export(deduplicate_values)
 export(df_grep_rows)
 export(df_grepl_rows)
 export(digit1)
+export(ensure_parens)
 export(find_bq_col)
 export(get_stable_data)
 export(is.colgroup)
@@ -68,8 +69,10 @@ export(pt_cont_wide_notes)
 export(pt_data_inventory)
 export(pt_data_inventory_notes)
 export(pt_data_study)
+export(pt_demographics)
 export(pt_wrap)
 export(ptdata)
+export(rnd)
 export(rowpanel)
 export(sig)
 export(st2article)
@@ -138,6 +141,7 @@ importFrom(dplyr,bind_rows)
 importFrom(dplyr,case_when)
 importFrom(dplyr,count)
 importFrom(dplyr,distinct)
+importFrom(dplyr,everything)
 importFrom(dplyr,filter)
 importFrom(dplyr,first)
 importFrom(dplyr,group_by)
@@ -147,6 +151,7 @@ importFrom(dplyr,groups)
 importFrom(dplyr,last)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
+importFrom(dplyr,mutate_at)
 importFrom(dplyr,n)
 importFrom(dplyr,rename)
 importFrom(dplyr,select)
@@ -178,6 +183,7 @@ importFrom(rlang,as_string)
 importFrom(rlang,enquo)
 importFrom(rlang,enquos)
 importFrom(rlang,flatten_if)
+importFrom(rlang,have_name)
 importFrom(rlang,is_atomic)
 importFrom(rlang,is_empty)
 importFrom(rlang,is_named)
@@ -195,11 +201,14 @@ importFrom(stringr,str_detect)
 importFrom(stringr,str_replace)
 importFrom(stringr,str_split)
 importFrom(tibble,as_tibble)
+importFrom(tibble,is_tibble)
 importFrom(tibble,tibble)
 importFrom(tidyr,fill)
 importFrom(tidyr,pivot_longer)
 importFrom(tidyr,pivot_wider)
 importFrom(tidyr,replace_na)
+importFrom(tidyr,separate)
+importFrom(tidyr,unite)
 importFrom(tidyselect,all_of)
 importFrom(tidyselect,contains)
 importFrom(tidyselect,eval_rename)

NEWS.md

@@ -1,10 +1,35 @@
+# pmtables 0.4.0
+
+- Add `cols_omit` option to omit column header data  (#213)
+
+- Add `pt_demographics` function to generate a new table of both continuous and
+  categorical data (#186, #249)
+
+- Add `title_side` argument to `colsplit()` so that the title can be taken from
+  left or right side of split (#231)
+
+- Add `hline` argument to `rowgroup()` constructor to make the horizontal line
+  above the panel data optional (#215)
+
+- Refactor `pt_data_inventory()` to calculate percent BLQ using denomninator
+  that is the sum of the number of observations BLQ and non-BLQ / non-missing
+  (#221, #222)
+
+- `st_asis()` gains a method for `pmtable` objects (#236)
+
+- List names are now escaped when passing a list of tables to `st2report()` 
+  and friends (#232)
+
+- Add newline after printing table text using `st_asis()` (#224)
+
 # pmtables 0.3.3
 
 - Fix bug where arguments could not be passed along to `stable_long()` 
   when coercing pmtable output (#203)
 
 - Fix bug where user-specified font size was not getting propagated to 
   long table output with `stable_long()` (#204)
+
 
 # pmtables 0.3.2
 

R/AAAA.R

@@ -3,15 +3,15 @@
 #' @importFrom dplyr mutate bind_rows select ungroup summarise left_join
 #' @importFrom dplyr group_modify rename count vars group_by n first last
 #' @importFrom dplyr case_when filter arrange group_vars distinct bind_cols
-#' @importFrom dplyr groups slice
+#' @importFrom dplyr groups slice everything mutate_at
 #' @importFrom purrr map_dfr walk partial map map_chr modify flatten_chr imap
 #' @importFrom purrr flatten_int map_lgl modify_if map_int map2 keep flatten
-#' @importFrom tidyr pivot_wider pivot_longer replace_na fill
+#' @importFrom tidyr pivot_wider pivot_longer replace_na fill separate unite
 #' @importFrom forcats fct_inorder
 #' @importFrom rlang sym syms quo_get_expr as_string := .data .env is_empty
-#' @importFrom rlang enquo enquos is_named is_atomic flatten_if
+#' @importFrom rlang enquo enquos is_named is_atomic flatten_if have_name
 #' @importFrom glue glue
-#' @importFrom tibble tibble as_tibble
+#' @importFrom tibble tibble as_tibble is_tibble
 #' @importFrom stats median rnorm sd na.omit setNames
 #' @importFrom utils capture.output packageVersion str
 #' @importFrom stringr fixed str_split str_count str_detect str_replace

R/class-digits.R

@@ -14,7 +14,7 @@
 #'
 #' @examples
 #'
-#' x <- new_digits(round, default = 2, WT = 1, ALB = 3)
+#' x <- new_digits(round, .default = 2, WT = 1, ALB = 3)
 #'
 #' as.list(x)
 #'

R/class-new_names.R

@@ -1,17 +1,17 @@
 new_names <- function(x,...) UseMethod("new_names")
 
 #' @export
-new_names.character <- function(x,table=NULL,...) {
-  if(rlang::is_named(x)) return(x)
+new_names.character <- function(x, table = NULL, ...) {
   ans <- cvec_cs(x)
+  have <- have_name(ans)
   if(any(duplicated(ans))) {
     dup <- ans[duplicated(ans)]
     for(d in dup) {
       message(" duplicate value: ", d)
     }
-    stop("duplicated values",call.=FALSE)
+    stop("duplicated values", call. = FALSE)
   }
-  names(ans) <- ans
+  names(ans)[!have] <- ans[!have]
   new_names_update_table(ans,table)
 }
 

R/data_inventory_table.R

@@ -68,33 +68,34 @@ data_inventory_chunk <- function(data, by, panel = by, stacked = FALSE,
 
   data <- ungroup(data)
 
+  # .N is the overall n
+  # ..n is the panel n
   if(stacked) {
     data <- group_by(data, !!sym(panel))
-    data <- mutate(data,.N = n_non_missing(!!sym(dv_col)))
-    data <- ungroup(data)
+    data <- mutate(data, .N = n_non_missing(!!sym(dv_col), !!sym(bq_col)))
   } else {
-    data <- mutate(data,.N = n_non_missing(!!sym(dv_col)))
-    data <- ungroup(data)
+    data <- mutate(data, .N = n_non_missing(!!sym(dv_col), !!sym(bq_col)))
   }
+  data <- ungroup(data)
   data <- group_by(data, !!sym(panel))
-  data <- mutate(data,..n = n_non_missing(!!sym(dv_col)))
+  data <- mutate(data, ..n = n_non_missing(!!sym(dv_col), !!sym(bq_col)))
   data <- ungroup(data)
   data <- group_by(data, !!!syms(.groups))
   body <- summarise(
     data,
     SUBJ = n_unique(!!sym(id_col)),
-    NOBS = n_non_missing(!!sym(dv_col)),
+    NOBS = n_obs(!!sym(dv_col), !!sym(bq_col)),
     NMISS = n_missing(!!sym(dv_col), !!sym(bq_col)),
     POBS = digit1(100*.data[["NOBS"]]/first(.data[["..n"]])),
     OOBS = digit1(100*.data[["NOBS"]]/first(.data[[".N"]]))
   )
   bq <- summarise(
     data,
-    NBQL = sum(!!sym(bq_col) !=0),
+    NBQL = n_bql(!!sym(bq_col)),
     PBQL = digit1(100*.data[["NBQL"]]/first(.data[["..n"]])),
     OBQL = digit1(100*.data[["NBQL"]]/first(.data[[".N"]]))
   )
-  summ <- left_join(body,bq,by = unique(c(by,panel)))
+  summ <- left_join(body, bq, by = unique(c(by, panel)))
   summ <- select(
     summ,
     !!sym(by),
@@ -242,6 +243,24 @@ pt_data_study <- function(data, study_col = "STUDY", panel = study_col, ...) {
 #' for `OBS` and `BQL` are presented for the `Overall` data and for the panel
 #' `Group`.
 #'
+#' Specifically, please note that:
+#' - `MISS` is the number of data records where `DV` is missing (`NA`) and where
+#'   the `BQL` (or `BLQ`) column is `0`
+#' - `OBS` is the number of data records where `DV` is not missing (non-`NA`)
+#'   and the `BQL` (or `BLQ`) column is `0`
+#' - `BQL` are records where the `BQL` (or `BLQ`) column is not equal to `0`
+#'
+#' The sum of `MISS` + `OBS` + `BQL` should equal the number of rows in the
+#' data frame passed to `pt_data_inventory()`.
+#'
+#' When calculating percent `OBS` and percent `BQL`, we use `OBS + BQL` as the
+#' denominator such that the percent `BQL` and percent `OBS` sum to `100`
+#' within a group or panel. When the `panel` argument is set, these percentages
+#' are calculated for the group (or `panel`)  as well as overall. In other
+#' words, records that are `MISS` are not factored into totals for `OBS` or
+#' `BQL` and similarly are not factored into calculation of percent `OBS` or
+#' percent `BQL`.
+#
 #' The summary function is expecting certain columns to be named in a certain
 #' way. This can be modified to suit your need by passing the following
 #' arguments: `dv_col` (for observations), `bq_col` (for BQL observations),