Skip to content

Commit

Permalink
Merge pull request #299 from metrumresearchgroup/release/0.5.1
Browse files Browse the repository at this point in the history
Release/0.5.1
  • Loading branch information
kylebaron authored Aug 19, 2022
2 parents f3623bd + 447e89b commit 7c1c692
Show file tree
Hide file tree
Showing 16 changed files with 190 additions and 33 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: pmtables
Type: Package
Title: Tables for Pharmacometrics
Version: 0.5.0
Version: 0.5.1
Authors@R:
c(
person(given = "Kyle",
Expand Down Expand Up @@ -36,7 +36,7 @@ Suggests: testthat, yaml, fs, texPreview, magick, pdftools
Encoding: UTF-8
Language: en-US
LazyData: true
RoxygenNote: 7.1.2
RoxygenNote: 7.2.0
Roxygen: list(markdown = TRUE)
VignetteBuilder: knitr
Collate:
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -102,6 +102,7 @@ export(st_data)
export(st_drop)
export(st_edit)
export(st_files)
export(st_filter)
export(st_hline)
export(st_image_show)
export(st_it)
Expand Down
16 changes: 16 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,19 @@
# pmtables 0.5.1

- New function `st_filter()` to filter data item in a pipeline (#298).

- Add `summarize_all` and `all_name_stacked` arguments to
`pt_data_inventory()` (#297).

## Bugs Fixed

- Fixed bug where `all_name` was not getting used in `pt_data_inventory()`
(#297).

- Fixed bug where detached table notes were getting rendered too close to the
main table when building standalone pdf under certain TeX distributions
(#286).

# pmtables 0.5.0

- New functions `st_as_image()`, `st2pdf()`, and `st2png()` to render tables with
Expand Down
43 changes: 26 additions & 17 deletions R/data_inventory_table.R
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ data_inventory_chunk <- function(data, by, panel = by, stacked = FALSE,
...) {

if(by==".total" | panel == ".total") {
data <- data_total_col(data,all_name = all_name)
data <- data_total_col(data, all_name = all_name)
}

miss <- FALSE
Expand Down Expand Up @@ -134,7 +134,7 @@ data_inventory_data_split <- function(data,by,panel=by,stacked=FALSE,...) {
#'
#' @export
data_inventory_data <- function(data, by, panel = by, all_name = "all",
stacked = FALSE, ...) {
summarize_all = TRUE, stacked = FALSE, ...) {
by <- unname(by)
panel <- unname(panel)

Expand All @@ -156,7 +156,7 @@ data_inventory_data <- function(data, by, panel = by, all_name = "all",
...
)

if(by != ".total") {
if(by != ".total" && isTRUE(summarize_all)) {
tot <- data_inventory_chunk(
data,
by = ".total",
Expand Down Expand Up @@ -229,6 +229,10 @@ pt_data_study <- function(data, study_col = "STUDY", panel = study_col, ...) {
#' `MISS` values are equal to zero.
#' @param stacked If `TRUE`, then independent summaries are created by `outer`
#' and included in a single table (see examples).
#' @param summarize_all if `TRUE` then a complete data summary will be
#' appended to the bottom of the table when `stacked` is `FALSE`.
#' @param all_name_stacked a name to use for the complete data summary when
#' `stacked` is `TRUE`.
#' @param dv_col Character name of `DV` column.
#' @param bq_col Character name of `BQL` column; see [find_bq_col()].
#' @param id_col Character name of `ID` column.
Expand Down Expand Up @@ -300,12 +304,21 @@ pt_data_study <- function(data, study_col = "STUDY", panel = study_col, ...) {
pt_data_inventory <- function(data, by = ".total", panel = by,
inner_summary = TRUE, drop_miss = FALSE,
stacked = FALSE, table = NULL,
all_name = "all",
summarize_all = TRUE,
all_name = "All data",
all_name_stacked = "Group Total",
dv_col = "DV",
bq_col = find_bq_col(data),
id_col = "ID",
...) {

stacked <- isTRUE(stacked)
if(stacked) all_name <- all_name_stacked
summarize_all <- isTRUE(summarize_all)

assert_that(is.data.frame(data))
data <- as.data.frame(data)

has_panel <- !missing(panel)
panel_data <- as.panel(panel)
panel <- panel_data$col
Expand All @@ -327,24 +340,26 @@ pt_data_inventory <- function(data, by = ".total", panel = by,
inner_summary <- FALSE
}

total_name <- case_when(
isTRUE(stacked) ~ "\\hline {\\it Group Total}",
TRUE ~ "\\hline \\hline {\\bf All data}"
)
if(stacked) {
total_name <- paste0("\\hline {\\it ", all_name, "}")
} else {
total_name <- paste0("\\hline \\hline {\\bf ", all_name, "}")
}

ans <- data_inventory_data(
data,
by = by,
panel = panel,
stacked = stacked,
all_name = all_name,
summarize_all = summarize_all,
dv_col = dv_col,
bq_col = bq_col,
id_col = id_col,
...
)

if(exists(by,ans)) {
if(exists(by, ans)) {
ans <- mutate(
ans,
!!sym(by) := ifelse(!!sym(by)==".total", total_name, !!sym(by))
Expand All @@ -365,7 +380,7 @@ pt_data_inventory <- function(data, by = ".total", panel = by,
`Percent.OBS` = .data[["OOBS"]],
`Percent.BQL` = .data[["OBQL"]]
)
ans <- mutate(ans,POBS=NULL,PBQL=NULL)
ans <- mutate(ans, POBS = NULL, PBQL = NULL)
}

ans <- rename(
Expand All @@ -384,7 +399,7 @@ pt_data_inventory <- function(data, by = ".total", panel = by,
ans <- mutate(ans, Number.MISS = NULL)
}

ans <- mutate(ans,.total = NULL)
ans <- mutate(ans, .total = NULL)
out <- ans

notes <- pt_data_inventory_notes(bq = bq_col, drop_bql = drop_bql)
Expand All @@ -396,8 +411,6 @@ pt_data_inventory <- function(data, by = ".total", panel = by,
out <- select(out, !contains("BQL"))
}

.sumrows <- NULL

.panel <- rowpanel(NULL)
if(has_panel) {
.panel <- panel_data
Expand All @@ -406,10 +419,6 @@ pt_data_inventory <- function(data, by = ".total", panel = by,

if(panel==by) panel <- NULL

if(!stacked & isTRUE(has_by)) {
.sumrows <- sumrow(out[,1]==total_name, bold = TRUE)
}

out <- list(
data = out,
panel = .panel,
Expand Down
10 changes: 7 additions & 3 deletions R/table-notes.R
Original file line number Diff line number Diff line change
Expand Up @@ -108,9 +108,11 @@ noteconf <- function(width = 0.8,
is.noteconfig <- function(x) inherits(x, "noteconfig")

mini_notes <- function(notes, x) {
hline1 <- hline2 <- paste0("\\rule{", 1, "\\linewidth}{",x$hline_pt, "pt}")
tskip <- paste0("\\vskip ", x$table_skip, "cm")
nskip <- paste0("\\vskip ", x$note_skip, "cm")
hline1 <- hline2 <- c(
paste0("\\rule{", 1, "\\linewidth}{",x$hline_pt, "pt}")
)
tskip <- paste0("\\vspace{", x$table_skip, "cm}")
nskip <- paste0("\\vspace{", x$note_skip, "cm}")
if(!x$hline1) {
hline1 <- NULL
}
Expand All @@ -119,7 +121,9 @@ mini_notes <- function(notes, x) {
}
notes <- paste(notes, "\\newline")
out <- c(
" ",
tskip,
" ",
paste0("\\begin{minipage}{",x$width,"\\linewidth}"),
paste0("\\linespread{1.1}\\selectfont"),
hline1,
Expand Down
25 changes: 23 additions & 2 deletions R/table-object.R
Original file line number Diff line number Diff line change
Expand Up @@ -867,8 +867,21 @@ st_drop <- function(x, ...) {
#' These functions modify the input data frame prior to passing it to
#' [stable()] or [stable_long()].
#'
#' @param x an stobject
#' @param ... passed to [dplyr::select()], or [dplyr::mutate()]
#' @param x an stobject.
#' @param ... passed to [dplyr::select()], [dplyr::mutate()], or
#' [dplyr::filter()].
#'
#' @details
#' - `st_select` calls `dplyr::select` on the data
#' - `st_mutate` calls `dplyr::mutate` on the data
#' - `st_filter` calls `dplyr::filter` on the data
#'
#' @examples
#' tab <- pt_data_inventory(pmt_obs, by = "FORM")
#' obj <- st_new(tab)
#' st_filter(obj, FORM != "troche")
#' st_select(obj, -contains("BQL"))
#' st_mutate(obj, FORM = ifelse(FORM=="tablet", "ODT", FORM))
#'
#' @export
st_select <- function(x, ...) {
Expand All @@ -885,6 +898,14 @@ st_mutate <- function(x, ...) {
x
}

#' @rdname st_select
#' @export
st_filter <- function(x, ...) {
check_st(x)
x$data <- filter(x$data, ...)
x
}

#' Edit table contents
#'
#' These functions modify the input data frame prior to passing to [stable()]
Expand Down
4 changes: 2 additions & 2 deletions inst/validation/build-validation-docs.R
Original file line number Diff line number Diff line change
Expand Up @@ -12,11 +12,11 @@
#######################################################

PKGNAME <- "pmtables"
PKGVERSION <- "0.4.1.9003"
PKGVERSION <- "0.5.0"
STYLE_REF_DIR <- "docx-ref-header-image" # set to NULL if not using style ref

# set up directories and clear existing output dirs, if they exist
val_dir <- system.file("validation", package = PKGNAME)
val_dir <- getwd() # system.file("validation", package = PKGNAME)
print(val_dir)

style_ref_path <- NULL
Expand Down
24 changes: 24 additions & 0 deletions inst/validation/pmtables-stories.yaml
Original file line number Diff line number Diff line change
@@ -1,4 +1,28 @@
# Please add user stories at the top of this file
PMT-S082:
name: Filter data from an st object
description: >
As a user, I want to filter data in an st object.
ProductRisk: low-risk
tests:
- PMT-STFUN-0001
PMT-S081:
name: Customize All Data summary in pt inventory table
description: >
As a user, I want to customize the label on All Data summary in
pt_data_inventory.
ProductRisk: low-risk
tests:
- PMT-INVEN-0002
- PMT-INVEN-0003
PMT-S080:
name: Optional All Data summary on pt inventory table
description: >
As a user, I want to opt in to the All Data summary
in pt_data_inventory.
ProductRisk: medium-risk
tests:
- PMT-INVEN-0001
PMT-S079:
name: sig returns character when passed integer
description: >
Expand Down
4 changes: 4 additions & 0 deletions man/data_inventory_data.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

10 changes: 9 additions & 1 deletion man/pt_data_inventory.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

23 changes: 21 additions & 2 deletions man/st_select.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit 7c1c692

Please sign in to comment.