From 21129455fcae8b4ec450171d2bd6cf234e6a9fdd Mon Sep 17 00:00:00 2001 From: Blazewicz Date: Wed, 19 Apr 2023 14:10:44 +0200 Subject: [PATCH 1/7] fixes in example --- R/tm_outliers.R | 50 ++++++++++++++++++++++++++----------------------- 1 file changed, 27 insertions(+), 23 deletions(-) diff --git a/R/tm_outliers.R b/R/tm_outliers.R index 12e212e2e..8adb17648 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -24,25 +24,26 @@ #' vars <- choices_selected(variable_choices(ADSL, fact_vars_adsl)) #' #' app <- init( -#' data = cdisc_data( -#' cdisc_dataset("ADSL", ADSL, code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl"), -#' check = TRUE -#' ), -#' modules = modules( -#' tm_outliers( -#' outlier_var = list( -#' data_extract_spec( -#' dataname = "ADSL", -#' select = select_spec( -#' label = "Select variable:", -#' choices = variable_choices(ADSL, c("AGE", "BMRKR1")), -#' selected = "AGE", -#' multiple = FALSE, -#' fixed = FALSE -#' ) +#' data = cdisc_data( +#' cdisc_dataset("ADSL", ADSL, code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl"), +#' check = TRUE +#' ), +#' modules = modules( +#' tm_outliers( +#' outlier_var = list( +#' data_extract_spec( +#' dataname = "ADSL", +#' select = select_spec( +#' label = "Select variable:", +#' choices = variable_choices(ADSL, c("AGE", "BMRKR1")), +#' selected = "AGE", +#' multiple = FALSE, +#' fixed = FALSE #' ) -#' ), -#' categorical_var = data_extract_spec( +#' ) +#' ), +#' categorical_var = list( +#' data_extract_spec( #' dataname = "ADSL", #' filter = filter_spec( #' vars = vars, @@ -50,16 +51,19 @@ #' selected = value_choices(ADSL, vars$selected), #' multiple = TRUE #' ) -#' ), -#' ggplot2_args = teal.widgets::ggplot2_args( +#' ) +#' ), +#' ggplot2_args = list( +#' teal.widgets::ggplot2_args( #' labs = list(subtitle = "Plot generated by Outliers Module") +#' ) #' ) #' ) #' ) #' ) -#' if (interactive()) { -#' shinyApp(app$ui, app$server) -#' } +# if (interactive()) { +# shinyApp(app$ui, app$server) +# } #' tm_outliers <- function(label = "Outliers Module", outlier_var, From ad5d4e8a249e39a659fc83784dd97c1fe4bdfcbc Mon Sep 17 00:00:00 2001 From: Blazewicz Date: Wed, 19 Apr 2023 14:15:12 +0200 Subject: [PATCH 2/7] fixes in example --- R/tm_outliers.R | 54 ++++++++++++++++++++++++------------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/R/tm_outliers.R b/R/tm_outliers.R index 8adb17648..7dbc830a4 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -24,46 +24,46 @@ #' vars <- choices_selected(variable_choices(ADSL, fact_vars_adsl)) #' #' app <- init( -#' data = cdisc_data( -#' cdisc_dataset("ADSL", ADSL, code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl"), -#' check = TRUE -#' ), -#' modules = modules( -#' tm_outliers( -#' outlier_var = list( -#' data_extract_spec( -#' dataname = "ADSL", -#' select = select_spec( -#' label = "Select variable:", -#' choices = variable_choices(ADSL, c("AGE", "BMRKR1")), -#' selected = "AGE", -#' multiple = FALSE, -#' fixed = FALSE +#' data = cdisc_data( +#' cdisc_dataset("ADSL", ADSL, code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl"), +#' check = TRUE +#' ), +#' modules = modules( +#' tm_outliers( +#' outlier_var = list( +#' data_extract_spec( +#' dataname = "ADSL", +#' select = select_spec( +#' label = "Select variable:", +#' choices = variable_choices(ADSL, c("AGE", "BMRKR1")), +#' selected = "AGE", +#' multiple = FALSE, +#' fixed = FALSE +#' ) #' ) -#' ) -#' ), -#' categorical_var = list( -#' data_extract_spec( +#' ), +#' categorical_var = list( +#' data_extract_spec( #' dataname = "ADSL", #' filter = filter_spec( #' vars = vars, #' choices = value_choices(ADSL, vars$selected), #' selected = value_choices(ADSL, vars$selected), #' multiple = TRUE +#' ) #' ) -#' ) -#' ), -#' ggplot2_args = list( -#' teal.widgets::ggplot2_args( -#' labs = list(subtitle = "Plot generated by Outliers Module") +#' ), +#' ggplot2_args = list( +#' teal.widgets::ggplot2_args( +#' labs = list(subtitle = "Plot generated by Outliers Module") #' ) #' ) #' ) #' ) #' ) -# if (interactive()) { -# shinyApp(app$ui, app$server) -# } +#' if (interactive()) { +#' shinyApp(app$ui, app$server) +#' } #' tm_outliers <- function(label = "Outliers Module", outlier_var, From e2c3de2ffbbb0e275d9b58859cbb291f82797dd2 Mon Sep 17 00:00:00 2001 From: Blazewicz Date: Thu, 20 Apr 2023 15:38:25 +0200 Subject: [PATCH 3/7] fixed validation --- R/tm_outliers.R | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/R/tm_outliers.R b/R/tm_outliers.R index 7dbc830a4..a605f9127 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -244,18 +244,22 @@ ui_outliers <- function(id, ...) { srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, categorical_var, plot_height, plot_width, ggplot2_args) { + with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "tdata") moduleServer(id, function(input, output, session) { + vars <- list(outlier_var = outlier_var, categorical_var = categorical_var) rule_diff <- function(other) { function(value) { - othervalue <- selector_list()[[other]]()[["select"]] - if (!is.null(othervalue)) { - if (identical(othervalue, value)) - "`Variable` and `Categorical factor` cannot be the same" + if (other %in% names(selector_list())){ + othervalue <- selector_list()[[other]]()[["select"]] + if (!is.null(othervalue)) { + if (identical(othervalue, value)) + "`Variable` and `Categorical factor` cannot be the same" + } } } } From 06af706880a7361abcaa83350d1f89ebdedcda20 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 8 May 2023 11:52:14 +0200 Subject: [PATCH 4/7] fix missing summary_table --- R/tm_outliers.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/R/tm_outliers.R b/R/tm_outliers.R index a605f9127..7d6c0909a 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -566,16 +566,16 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, expr = { if (iv_r()$is_valid()) { categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var) - DT::datatable( - common_code_q()[["summary_table"]], - options = list( - dom = "t", - autoWidth = TRUE, - columnDefs = list(list(width = "200px", targets = "_all")) + if (!is.null(categorical_var)) { + DT::datatable( + common_code_q()[["summary_table"]], + options = list( + dom = "t", + autoWidth = TRUE, + columnDefs = list(list(width = "200px", targets = "_all")) + ) ) - ) - } else { - NULL + } } } ) From 85c8eb9fd8028abc5ea404b9dab534389c6ce54b Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 17 May 2023 10:36:58 +0200 Subject: [PATCH 5/7] catch error when categorical var is null --- R/tm_outliers.R | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/R/tm_outliers.R b/R/tm_outliers.R index 7d6c0909a..fac00f0fe 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -254,12 +254,10 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, rule_diff <- function(other) { function(value) { - if (other %in% names(selector_list())){ - othervalue <- selector_list()[[other]]()[["select"]] - if (!is.null(othervalue)) { - if (identical(othervalue, value)) - "`Variable` and `Categorical factor` cannot be the same" - } + othervalue <- tryCatch(selector_list()[["categorical_var"]]()[["select"]], error = function(e) NULL) + if (!is.null(othervalue)) { + if (identical(othervalue, value)) + "`Variable` and `Categorical factor` cannot be the same" } } } From 5314324b28af1fc8eae50a9c9b9a3cff08808c56 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 17 May 2023 08:41:35 +0000 Subject: [PATCH 6/7] [skip actions] Restyle files --- R/tm_outliers.R | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/R/tm_outliers.R b/R/tm_outliers.R index fac00f0fe..a7760eeec 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -25,8 +25,8 @@ #' #' app <- init( #' data = cdisc_data( -#' cdisc_dataset("ADSL", ADSL, code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl"), -#' check = TRUE +#' cdisc_dataset("ADSL", ADSL, code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl"), +#' check = TRUE #' ), #' modules = modules( #' tm_outliers( @@ -44,12 +44,12 @@ #' ), #' categorical_var = list( #' data_extract_spec( -#' dataname = "ADSL", -#' filter = filter_spec( -#' vars = vars, -#' choices = value_choices(ADSL, vars$selected), -#' selected = value_choices(ADSL, vars$selected), -#' multiple = TRUE +#' dataname = "ADSL", +#' filter = filter_spec( +#' vars = vars, +#' choices = value_choices(ADSL, vars$selected), +#' selected = value_choices(ADSL, vars$selected), +#' multiple = TRUE #' ) #' ) #' ), @@ -129,13 +129,16 @@ ui_outliers <- function(id, ...) { id = ns("tabs"), tabPanel( "Boxplot", - teal.widgets::plot_with_settings_ui(id = ns("box_plot"))), + teal.widgets::plot_with_settings_ui(id = ns("box_plot")) + ), tabPanel( "Density Plot", - teal.widgets::plot_with_settings_ui(id = ns("density_plot"))), + teal.widgets::plot_with_settings_ui(id = ns("density_plot")) + ), tabPanel( "Cumulative Distribution Plot", - teal.widgets::plot_with_settings_ui(id = ns("cum_density_plot"))) + teal.widgets::plot_with_settings_ui(id = ns("cum_density_plot")) + ) ), br(), hr(), uiOutput(ns("table_ui_wrap")) @@ -244,20 +247,19 @@ ui_outliers <- function(id, ...) { srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, categorical_var, plot_height, plot_width, ggplot2_args) { - with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "tdata") moduleServer(id, function(input, output, session) { - vars <- list(outlier_var = outlier_var, categorical_var = categorical_var) rule_diff <- function(other) { function(value) { othervalue <- tryCatch(selector_list()[["categorical_var"]]()[["select"]], error = function(e) NULL) if (!is.null(othervalue)) { - if (identical(othervalue, value)) + if (identical(othervalue, value)) { "`Variable` and `Categorical factor` cannot be the same" + } } } } @@ -415,7 +417,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, q1_q3 <- stats::quantile(outlier_var_name, probs = c(0.25, 0.75)) iqr <- q1_q3[2] - q1_q3[1] !(outlier_var_name >= q1_q3[1] - outlier_definition_param * iqr & - outlier_var_name <= q1_q3[2] + outlier_definition_param * iqr) + outlier_var_name <= q1_q3[2] + outlier_definition_param * iqr) }), env = list( outlier_var_name = as.name(outlier_var), From 42f19eaa3e31996db72b099838d9c8d3aa6df7da Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 17 May 2023 11:53:25 +0200 Subject: [PATCH 7/7] amend documentation --- man/tm_outliers.Rd | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/man/tm_outliers.Rd b/man/tm_outliers.Rd index 356f23961..e2b0931bf 100644 --- a/man/tm_outliers.Rd +++ b/man/tm_outliers.Rd @@ -80,17 +80,21 @@ app <- init( ) ) ), - categorical_var = data_extract_spec( - dataname = "ADSL", - filter = filter_spec( - vars = vars, - choices = value_choices(ADSL, vars$selected), - selected = value_choices(ADSL, vars$selected), - multiple = TRUE + categorical_var = list( + data_extract_spec( + dataname = "ADSL", + filter = filter_spec( + vars = vars, + choices = value_choices(ADSL, vars$selected), + selected = value_choices(ADSL, vars$selected), + multiple = TRUE + ) ) ), - ggplot2_args = teal.widgets::ggplot2_args( - labs = list(subtitle = "Plot generated by Outliers Module") + ggplot2_args = list( + teal.widgets::ggplot2_args( + labs = list(subtitle = "Plot generated by Outliers Module") + ) ) ) )