Skip to content

Commit

Permalink
Solve lintr marks
Browse files Browse the repository at this point in the history
  • Loading branch information
@mattkorb
mattkorb committed Apr 4, 2024
1 parent d1455b7 commit ec0819a
Show file tree
Hide file tree
Showing 16 changed files with 228 additions and 303 deletions.
39 changes: 17 additions & 22 deletions R/export_helpers.R
View file
Original file line number Diff line number Diff line change
@@ -1,9 +1,9 @@
# CONSTANTS FOR PDF DESIGN ----
PDF_EXP <- pack_of_constants( #nolint
LABEL_WIDTH = 6, # maximal number of rows that can be filled by the labels
COL_TRANSITION = 2, # number of characters corresponding to the transition of one column to the next
N_ROWS = 32, # allowed number of rows per page
N_COL_CHARS = 115 # allowed number of characters within one row per page
PDF_EXP <- pack_of_constants( # nolint
LABEL_WIDTH = 6, # maximal number of rows that can be filled by the labels
COL_TRANSITION = 2, # number of characters corresponding to the transition of one column to the next
N_ROWS = 32, # allowed number of rows per page
N_COL_CHARS = 115 # allowed number of characters within one row per page
)


Expand All @@ -21,7 +21,6 @@ PDF_EXP <- pack_of_constants( #nolint
#'
#' @keywords internal
export_modal_content <- function(ns, file_name, cond, colnames, activate_checkbox = FALSE) {

# Check validity of parameters
checkmate::assert(
checkmate::check_function(ns, args = c("id"), nargs = 1),
Expand Down Expand Up @@ -64,7 +63,7 @@ export_modal_content <- function(ns, file_name, cond, colnames, activate_checkbo
inline = TRUE,
circle = TRUE,
label = "Show more information",
tooltip = TRUE
tooltip = TRUE
)
)
),
Expand All @@ -84,7 +83,7 @@ export_modal_content <- function(ns, file_name, cond, colnames, activate_checkbo
inline = TRUE,
circle = TRUE,
label = "Show more information",
tooltip = TRUE
tooltip = TRUE
)
)
)
Expand Down Expand Up @@ -115,7 +114,6 @@ export_modal_content <- function(ns, file_name, cond, colnames, activate_checkbo
#'
#' @keywords internal
shorten_entries <- function(vec, len_max) {

# Check validity of parameters
checkmate::assert(
checkmate::check_character(vec, null.ok = TRUE),
Expand Down Expand Up @@ -146,7 +144,6 @@ shorten_entries <- function(vec, len_max) {
#'
#' @keywords internal
split_label <- function(label, min_width, max_width, label_width) {

# Check validity of parameters
checkmate::assert(
checkmate::check_string(label, null.ok = FALSE),
Expand All @@ -157,7 +154,9 @@ split_label <- function(label, min_width, max_width, label_width) {
)

# Stop here if no label splitting needed
if (nchar(label) <= min_width) return(list(label_vec = label, col_width = min_width))
if (nchar(label) <= min_width) {
return(list(label_vec = label, col_width = min_width))
}

# Shorten labels that are too long (first shorten single words, then whole labels)
label <- paste(shorten_entries(unlist(strsplit(label, " ")), len_max = as.integer(max_width)), collapse = " ")
Expand All @@ -169,13 +168,13 @@ split_label <- function(label, min_width, max_width, label_width) {
label <- unlist(strsplit(label, " "))
label_vec_ind <- c(0, 0)
label_vec <- c()
word_len_vec <- nchar(label) + 1 # + 1 for the blank between the words
word_len_vec <- nchar(label) + 1 # + 1 for the blank between the words
col_width <- min(max(
min_width * ceiling(sum(as.numeric(word_len_vec <= min_width)) / label_width),
ceiling(sum(word_len_vec) / label_width)
), max_width)

while (length(word_len_vec) > 0 && length(label_vec) < label_width) {
while (length(word_len_vec) > 0 && length(label_vec) < label_width) {
col_width <- max(col_width, word_len_vec[1])
word_cumsum <- cumsum(word_len_vec)
label_vec_ind <- c(label_vec_ind[2] + 1, label_vec_ind[2] + sum(as.numeric(word_cumsum <= col_width)))
Expand Down Expand Up @@ -214,7 +213,6 @@ split_label <- function(label, min_width, max_width, label_width) {
#'
#' @keywords internal
calculate_col_width <- function(df, ref) {

# Check validity of parameters
checkmate::assert(
checkmate::check_data_frame(df, min.rows = 1, min.cols = 1, col.names = "unique", null.ok = FALSE),
Expand Down Expand Up @@ -281,7 +279,6 @@ calculate_col_width <- function(df, ref) {
#'
#' @keywords internal
pdf_preprocessing <- function(df, ref) {

# Check validity of parameters
checkmate::assert(
checkmate::check_data_frame(df, null.ok = FALSE),
Expand All @@ -307,7 +304,8 @@ pdf_preprocessing <- function(df, ref) {
if (nrow(df) > 1) {
df <- apply(
apply(df, 2, as.character),
2, shorten_entries, len_max = as.integer(table_width)
2, shorten_entries,
len_max = as.integer(table_width)
)
} else {
df <- t(data.frame(shorten_entries(
Expand Down Expand Up @@ -409,7 +407,6 @@ pdf_preprocessing <- function(df, ref) {
#'
#' @keywords internal
prep_export_data <- function(data_selection, current_data, data_selection_name, dataset_list) {

# check validity of parameters
checkmate::assert(
checkmate::check_string(data_selection),
Expand Down Expand Up @@ -453,7 +450,6 @@ prep_export_data <- function(data_selection, current_data, data_selection_name,
#'
#' @keywords internal
excel_export <- function(data_to_download, file, intended_use_label) {

# Check validity of parameters
checkmate::assert(
checkmate::check_list(data_to_download, types = "data.frame", null.ok = FALSE),
Expand Down Expand Up @@ -495,7 +491,6 @@ excel_export <- function(data_to_download, file, intended_use_label) {
#'
#' @keywords internal
pdf_export <- function(data_to_download, ref_cols, file, metadata, active_session = TRUE, intended_use_label) {

# Check validity of parameters
checkmate::assert(
checkmate::check_list(data_to_download, types = "data.frame", len = 1, null.ok = FALSE),
Expand All @@ -505,15 +500,16 @@ pdf_export <- function(data_to_download, ref_cols, file, metadata, active_sessio
checkmate::check_logical(active_session, len = 1),
combine = "and"
)

# PDF preprocessing
res_preprocess <- pdf_preprocessing(data_to_download[[1]], ref_cols)

# Copy Rmd file to a folder with writing permissions for deployment
temp_report <- file.path(tempdir(), "create_pdf_export.Rmd")
file.copy(
system.file("rmd", "create_pdf_export.Rmd", package = "dv.listings", mustWork = TRUE),
temp_report, overwrite = TRUE
temp_report,
overwrite = TRUE
)

# Render pdf via RMarkdown file
Expand Down Expand Up @@ -551,7 +547,6 @@ pdf_export <- function(data_to_download, ref_cols, file, metadata, active_sessio
#'
#' @keywords internal
warn_function <- function(cond, input_id, text) {

# Check validity of parameters
checkmate::assert(
checkmate::check_logical(cond, len = 1),
Expand Down
13 changes: 6 additions & 7 deletions R/helpers.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,10 +11,11 @@
#'

get_labels <- function(dataset) {

# Catch special cases (e.g. when global filter returns empty dataset)
return_null <- any(length(dataset) == 0, is.null(dataset))
if (return_null) return(NULL)
if (return_null) {
return(NULL)
}

# Check validity of parameters
# Note: In case you change something here, consider adding a check in generate_choices() instead
Expand Down Expand Up @@ -84,13 +85,11 @@ generate_choices <- function(dataset) {
#' every dataset. List entries are named according to the \code{dataset} names.
#' @keywords internal
fill_default_vars <- function(default_vars, dataset) {

# Check arguments
checkmate::assert(
checkmate::check_list(dataset, types = "data.frame"),
checkmate::check_names(names(dataset), type = "unique"),
checkmate::check_list(default_vars, types = "character", null.ok = TRUE),

combine = "and"
)
if (!is.null(default_vars)) {
Expand Down Expand Up @@ -138,7 +137,6 @@ fill_default_vars <- function(default_vars, dataset) {
#' @keywords internal
#'
set_data <- function(base_data, selector) {

# Check validity of parameters
checkmate::assert(
checkmate::check_data_frame(base_data, null.ok = TRUE),
Expand All @@ -148,7 +146,9 @@ set_data <- function(base_data, selector) {

# Return NULL in case no columns were selected
return_null <- any(is.null(selector), length(selector) == 0)
if (return_null) return(NULL)
if (return_null) {
return(NULL)
}

# Select user specified (or default) columns from data and force order as determined by the user
data <- base_data %>%
Expand Down Expand Up @@ -208,7 +208,6 @@ set_labels <- function(dataset, labels) {
#' @return data.frame with converted data types of data.frame columns
#' @export
convert_data <- function(dataset) {

# check validity of parameter
checkmate::assert_data_frame(dataset)

Expand Down
5 changes: 2 additions & 3 deletions R/mock_listings.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@
mock_listings_app <- function(mode = "single") {
stopifnot(mode %in% c("single", "multi"))

mock_listings_UI <- function(id) { #nolint
mock_listings_UI <- function(id) { # nolint
ns <- ifelse(is.character(id), shiny::NS(id), shiny::NS(NULL))
shiny::fluidPage(listings_UI(ns("listings")))
}
Expand All @@ -33,7 +33,7 @@ mock_listings_app <- function(mode = "single") {

listings_server(
"listings",
dataset_list = shiny::reactive({
dataset_list = shiny::reactive({
data
}), default_vars = def_col,
dataset_metadata = list(
Expand Down Expand Up @@ -61,7 +61,6 @@ mock_listings_app <- function(mode = "single") {
#' @export
#'
mock_listings_mm <- function() {

data <- list()
data[["adsl"]] <- convert_data(pharmaverseadam::adsl)
data[["adae"]] <- convert_data(pharmaverseadam::adae)
Expand Down
25 changes: 9 additions & 16 deletions R/mod_export_listings.R
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
# CONSTANTS ----
EXP <- pack_of_constants( #nolint
EXP <- pack_of_constants( # nolint
EXPORT_WINDOW_TITLE = "Download options",
EXPORTBTN_ID = "download_data",
EXPORTBTN_LABEL = "Download",
Expand Down Expand Up @@ -38,7 +38,7 @@ EXP <- pack_of_constants( #nolint
#'
#' @return A shiny \code{uiOutput} element.
#' @keywords internal
mod_export_listings_UI <- function(module_id) { #nolint
mod_export_listings_UI <- function(module_id) { # nolint

# Check validity of arguments
checkmate::assert_string(module_id, min.chars = 1)
Expand All @@ -47,7 +47,7 @@ mod_export_listings_UI <- function(module_id) { #nolint

ui <- shiny::tagList(
shinyFeedback::useShinyFeedback(), # needed to use shinyFeedback functionalities
shinyjs::useShinyjs(), # needed to use shinyjs functionalities
shinyjs::useShinyjs(), # needed to use shinyjs functionalities

shiny::actionButton(ns(EXP$EXPORTBTN_ID), label = EXP$EXPORTBTN_LABEL)
)
Expand Down Expand Up @@ -91,7 +91,6 @@ mod_export_listings_server <- function(module_id,
data_selection_name,
current_rows,
intended_use_label) {

# check validity of parameters
checkmate::assert(
checkmate::check_string(module_id, min.chars = 1),
Expand All @@ -109,7 +108,6 @@ mod_export_listings_server <- function(module_id,
shiny::moduleServer(
module_id,
function(input, output, session) {

v_dataset_list <- shiny::reactive({
checkmate::assert_list(dataset_list(), types = "data.frame", null.ok = TRUE, names = "named")
dataset_list()
Expand All @@ -134,7 +132,6 @@ mod_export_listings_server <- function(module_id,

# Determine currently displayed data (taking set filters into account)
current_data <- shiny::reactive({

if (is.null(current_rows())) {
NULL
} else {
Expand Down Expand Up @@ -232,10 +229,11 @@ mod_export_listings_server <- function(module_id,
{
dataprotect <- ifelse(!is.null(intended_use_label), input[[EXP$DATAPROTECT_ID]], TRUE)

if (!check_ref_cols()
& (input[[EXP$FILENAME_ID]] != "")
& dataprotect
& (ifelse(is.null(input[[EXP$SNAPSHOT_ID]]), 0, nchar(input[[EXP$SNAPSHOT_ID]])) <= 50)) {
if (!check_ref_cols() &
(input[[EXP$FILENAME_ID]] != "") &
dataprotect &
(ifelse(is.null(input[[EXP$SNAPSHOT_ID]]), 0, nchar(input[[EXP$SNAPSHOT_ID]])) <= 50)
) {
return(TRUE)
} else {
return(FALSE)
Expand Down Expand Up @@ -265,20 +263,16 @@ mod_export_listings_server <- function(module_id,
)

if (input[[EXP$FILETYPE_ID]] == ".xlsx") {

excel_export(data_to_download, file, intended_use_label)

} else {

shiny::withProgress(message = "Creating pdf.", value = 0, {

num_pages <- pdf_export(
data_to_download = data_to_download,
ref_cols = input[[EXP$REFCOL_ID]],
file = file,
metadata = c(
dataset_metadata$name(),
#to make sure that the date is readable and wont display as numeric value
# to make sure that the date is readable and wont display as numeric value
as.character(dataset_metadata$date_range()[2]),
input[[EXP$SNAPSHOT_ID]]
),
Expand All @@ -298,7 +292,6 @@ mod_export_listings_server <- function(module_id,
current_rows()
}
)

}
)
}
Loading

0 comments on commit ec0819a

Please sign in to comment.