Skip to content

Commit

Permalink
fix styler
Browse files Browse the repository at this point in the history
  • Loading branch information
@sorinvoicu
sorinvoicu committed May 2, 2024
1 parent a0316c3 commit e84171a
Show file tree
Hide file tree
Showing 13 changed files with 266 additions and 321 deletions.
179 changes: 89 additions & 90 deletions R/helper_functions.R
View file
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
utils::globalVariables(".")

#' Prepare initial data
#'
#' `prepare_initial_data()` prepares data initially by restructuring
#'
#' `prepare_initial_data()` prepares data initially by restructuring
#' and joining DM and LB dataset into one.
#'
#' @param dataset_list `[list(data.frame))]`
#'
#' @param dataset_list `[list(data.frame))]`
#'
#' A list of datasets, containing a Demographics and a Lab Value dataset.
#' @param subjectid_var `[character(1)]`
#'
Expand All @@ -33,70 +33,68 @@ utils::globalVariables(".")
#'
#' Name of the variable containing the reference range upper limits.
#'
#' @return A single dataframe including columns defined by `subjectid_var`,
#' @return A single dataframe including columns defined by `subjectid_var`,
#' `arm_var`, `visit_var`, `lb_test_var`, `lb_result_var`, and `ref_range_upper_lim_var`,
#' as well as the column "BASE" containing the corresponding baseline values.
#' In case of multiple values in `lb_result_var` per `subjectid_var`, `visit_var`, and
#' as well as the column "BASE" containing the corresponding baseline values.
#' In case of multiple values in `lb_result_var` per `subjectid_var`, `visit_var`, and
#' `lb_test_var`, only the maximum value will be used. Note that a NA value in the considered values
#' will cause a value of NA to be returned as maximum value.
#'
#' @importFrom rlang .data
#' @keywords internal
prepare_initial_data <- function(
dataset_list,
subjectid_var,
arm_var,
visit_var,
dataset_list,
subjectid_var,
arm_var,
visit_var,
baseline_visit_val,
lb_test_var,
lb_test_choices,
lb_result_var,
ref_range_upper_lim_var
) {

lb_test_var,
lb_test_choices,
lb_result_var,
ref_range_upper_lim_var) {
sel_dataset_list <- lapply(dataset_list, function(x) {
x %>%
x %>%
dplyr::select(
dplyr::any_of(
c(
subjectid_var,
arm_var,
visit_var,
lb_test_var,
lb_result_var,
subjectid_var,
arm_var,
visit_var,
lb_test_var,
lb_result_var,
ref_range_upper_lim_var
)
)
)
})

dataset <- Reduce(dplyr::full_join, sel_dataset_list) %>%
dplyr::filter(.data[[lb_test_var]] %in% lb_test_choices) %>%
dplyr::group_by(.data[[subjectid_var]], .data[[arm_var]], .data[[lb_test_var]], .data[[visit_var]]) %>%
dplyr::filter(.data[[lb_result_var]] == max(.data[[lb_result_var]])) %>%
dplyr::distinct() %>%
dplyr::ungroup()

base_data <- dataset %>%
dplyr::filter(.data[[visit_var]] == baseline_visit_val) %>%
dplyr::filter(.data[[visit_var]] == baseline_visit_val) %>%
dplyr::mutate(BASE = .data[[lb_result_var]]) %>%
dplyr::select(dplyr::all_of(c(subjectid_var, lb_test_var, arm_var, "BASE")))

dataset <- dataset %>%
dplyr::left_join(base_data, by = c(subjectid_var, lb_test_var, arm_var))

return(dataset)
}



#' Filter data
#'
#' `filter_data()` filters `dataset` to only contain the values of `sel_lb_test`
#'
#' `filter_data()` filters `dataset` to only contain the values of `sel_lb_test`
#' in the `lb_test_var` column and the values of `sel_arm` in the `arm_var` column.
#'
#' @param dataset `[data.frame]`
#'
#' @param dataset `[data.frame]`
#'
#' A dataframe containing the columns specified by `lb_test_var` and `arm_var`.
#' @param arm_var `[character(1)]`
#'
Expand All @@ -114,26 +112,26 @@ prepare_initial_data <- function(
#' @return The filtered dataset.
#'
#' @keywords internal
filter_data <- function(dataset, arm_var, sel_arm, lb_test_var, sel_lb_test) {
filter_data <- function(dataset, arm_var, sel_arm, lb_test_var, sel_lb_test) {
dataset <- dataset %>%
dplyr::filter(
.data[[lb_test_var]] %in% sel_lb_test,
.data[[lb_test_var]] %in% sel_lb_test,
.data[[arm_var]] %in% sel_arm
)
)

return(dataset)
}



#' Derive required variables
#'
#'
#' `derive_req_vars()` restructures the stated dataset to include variables containing
#' the ratio of a lab result divided by ULN or the baseline value. The corresponding variable
#' names are shaped as follows: "r_<ULN or Baseline>_<selected lab test>.
#'
#' @param dataset `[data.frame]`
#'
#' @param dataset `[data.frame]`
#'
#' A dataframe containing the variables listed below as columns.
#' @param subjectid_var `[character(1)]`
#'
Expand All @@ -146,7 +144,7 @@ filter_data <- function(dataset, arm_var, sel_arm, lb_test_var, sel_lb_test) {
#' Name of the variable containing the visit information.
#' @param lb_test_var `[character(1)]`
#'
#' Name of the variable containing the laboratory test information.
#' Name of the variable containing the laboratory test information.
#' @param lb_result_var `[character(1)]`
#'
#' Name of the variable containing results of the laboratory test.
Expand All @@ -164,25 +162,26 @@ filter_data <- function(dataset, arm_var, sel_arm, lb_test_var, sel_lb_test) {
#'
#' @keywords internal
derive_req_vars <- function(
dataset,
subjectid_var,
arm_var,
visit_var,
lb_test_var,
lb_result_var,
ref_range_upper_lim_var,
sel_x,
sel_y
) {

if (nrow(dataset) == 0) return(NULL)
dataset,
subjectid_var,
arm_var,
visit_var,
lb_test_var,
lb_result_var,
ref_range_upper_lim_var,
sel_x,
sel_y) {
if (nrow(dataset) == 0) {
return(NULL)
}

# Get the data-frame in required structure (Pivot wider grouped by certain variables)
dataset <- dataset %>%
dplyr::filter(.data[[lb_test_var]] %in% c(sel_x, sel_y)) %>%
dplyr::mutate(
r_ULN = .data[[lb_result_var]] / .data[[ref_range_upper_lim_var]],
r_Baseline = .data[[lb_result_var]] / .data[["BASE"]]) %>%
r_Baseline = .data[[lb_result_var]] / .data[["BASE"]]
) %>%
dplyr::select(dplyr::all_of(c(subjectid_var, arm_var, lb_test_var, visit_var, "r_ULN", "r_Baseline"))) %>%
dplyr::group_by(.data[[subjectid_var]], .data[[arm_var]], .data[[lb_test_var]], .data[[visit_var]]) %>%
dplyr::mutate(row = dplyr::row_number()) %>%
Expand All @@ -194,18 +193,18 @@ derive_req_vars <- function(
"r_Baseline_{{sel_x}}" = as.numeric(.data[[paste0("r_Baseline_", sel_x)]]),
"r_Baseline_{{sel_y}}" = as.numeric(.data[[paste0("r_Baseline_", sel_y)]])
)

return(dataset)
}



#' Generate plot
#'
#'
#' `generate_plot()` generates an eDISH plot by means of the \pkg{plotly} package.
#'
#' @param dataset `[data.frame]`
#'
#' @param dataset `[data.frame]`
#'
#' A dataframe containing the variables listed below as columns.
#' @param subjectid_var `[character(1)]`
#'
Expand All @@ -224,40 +223,40 @@ derive_req_vars <- function(
#' Character specifying the laboratory test to be displayed on the y-axis.
#' @param x_plot_type `[character(1)]`
#'
#' Character specifying the plot type for the x-axis. This leads to
#' Character specifying the plot type for the x-axis. This leads to
#' using the `dataset`'s column "r_<x_plot_type>_<x_sel>" for the x-values.
#' @param y_plot_type `[character(1)]`
#'
#' Character specifying the plot type for the y-axis. This leads to
#' Character specifying the plot type for the y-axis. This leads to
#' using the `dataset`'s column "r_<y_plot_type>_<y_sel>" for the y-values.
#'
#' @return A plotly object specifying the generated eDISH plot.
#'
#' @keywords internal
generate_plot <- function(
dataset,
subjectid_var,
arm_var,
visit_var,
sel_x,
sel_y,
x_plot_type,
y_plot_type,
x_ref_line_num,
y_ref_line_num
) {

if (is.null(dataset)) return(dataset)
dataset,
subjectid_var,
arm_var,
visit_var,
sel_x,
sel_y,
x_plot_type,
y_plot_type,
x_ref_line_num,
y_ref_line_num) {
if (is.null(dataset)) {
return(dataset)
}

plt_obj <- dataset %>%
plotly::plot_ly(type = "scatter", mode = "markers", color = .[[arm_var]]) %>%
plotly::add_trace(
x = ~ .data[[paste0("r_", x_plot_type, "_", sel_x)]],
y = ~ .data[[paste0("r_", y_plot_type, "_", sel_y)]],
hovertext = ~ paste0(
"Subject: ", .data[[subjectid_var]],
"<br>Arm: ", .data[[arm_var]],
"<br>Visit: ", .data[[visit_var]],
"Subject: ", .data[[subjectid_var]],
"<br>Arm: ", .data[[arm_var]],
"<br>Visit: ", .data[[visit_var]],
"<br>x-axis: ", round(.data[[paste0("r_", x_plot_type, "_", sel_x)]], digits = 3),
"<br>y-axis: ", round(.data[[paste0("r_", y_plot_type, "_", sel_y)]], digits = 3)
),
Expand All @@ -267,26 +266,26 @@ generate_plot <- function(
xaxis = list(title = paste0(sel_x, "/", x_plot_type)),
yaxis = list(title = paste0(sel_y, "/", y_plot_type)),
shapes = list(
list( #vline
type = "line",
y0 = 0,
y1 = 1,
yref = "paper",
x0 = x_ref_line_num,
list( # vline
type = "line",
y0 = 0,
y1 = 1,
yref = "paper",
x0 = x_ref_line_num,
x1 = x_ref_line_num,
line = list(color = "gray", dash = "dot")
),
list( #hline
type = "line",
x0 = 0,
x1 = 1,
xref = "paper",
y0 = y_ref_line_num,
list( # hline
type = "line",
x0 = 0,
x1 = 1,
xref = "paper",
y0 = y_ref_line_num,
y1 = y_ref_line_num,
line = list(color = "gray", dash = "dot")
)
)
)

return(plt_obj)
}
6 changes: 2 additions & 4 deletions R/mock_edish.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,11 +4,10 @@
#'
#' @keywords internal
mock_edish_app <- function() {

dm <- pharmaverseadam::adsl
lb <- pharmaverseadam::adlb

mock_edish_UI <- function() { #nolint
mock_edish_UI <- function() { # nolint
shiny::fluidPage(edish_UI("edish"))
}

Expand All @@ -32,10 +31,9 @@ mock_edish_app <- function() {
#'
#' @keywords internal
mock_edish_mm <- function() {

dm <- pharmaverseadam::adsl
lb <- pharmaverseadam::adlb

module_list <- list(
"edish demo" = mod_edish(
module_id = "edish",
Expand Down
Loading

0 comments on commit e84171a

Please sign in to comment.