From 12f095c3a08c3dc17204bf3c38b191089cb74a74 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Tue, 5 Nov 2024 08:26:05 +0100 Subject: [PATCH 01/92] WIP --- R/tm_g_scatterplot.R | 51 ++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 49 insertions(+), 2 deletions(-) diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index d093a4fad..c8be54170 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -343,6 +343,7 @@ ui_g_scatterplot <- function(id, ...) { teal.widgets::plot_with_settings_ui(id = ns("scatter_plot")), tags$h1(tags$strong("Selected points:"), class = "text-center font-150p"), teal.widgets::get_dt_rows(ns("data_table"), ns("data_table_rows")), + uiOutput(ns("brush_filter")), DT::dataTableOutput(ns("data_table"), width = "100%") ), encoding = tags$div( @@ -997,9 +998,55 @@ srv_g_scatterplot <- function(id, plot_r = plot_r, height = plot_height, width = plot_width, - brushing = TRUE + brushing = TRUE, + click = TRUE ) + output$brush_filter <- renderUI({ + states <- get_filter_state(filter_panel_api) + brushed_states <- Filter( + function(state) state$id == "brush_filter", + states + ) + if (!is.null(pws$brush())) { + actionButton(session$ns("apply_brush_filter"), "Apply filter") + } else if (length(brushed_states)) { + actionButton(session$ns("remove_brush_filter"), "Remove applied filter") + } + }) + + observeEvent(input$remove_brush_filter, { + remove_filter_state( + filter_panel_api, + teal_slices( + teal_slice( + dataname = "ADSL", + varname = "USUBJID", + id = "brush_filter" + ) + ) + ) + }) + + observeEvent(input$apply_brush_filter, { + plot_brush <- pws$brush() + merged_data <- isolate(teal.code::dev_suppress(output_q()[["ANL"]])) + filter_call <- str2lang(sprintf( + "merged_data <- dplyr::filter(merged_data, %1$s >= %2$s & %1$s <= %3$s & %4$s >= %5$s & %4$s <= %6$s)", + plot_brush$mapping$x, plot_brush$xmin, plot_brush$xmax, + plot_brush$mapping$y, plot_brush$ymin, plot_brush$ymax + )) + eval(filter_call) + + slice <- teal_slices(teal_slice( + dataname = "ADSL", + varname = "USUBJID", + selected = merged_data$USUBJID, + id = "brush_filter" + )) + set_filter_state(filter_panel_api, slice) + }) + output$data_table <- DT::renderDataTable({ plot_brush <- pws$brush() @@ -1008,7 +1055,6 @@ srv_g_scatterplot <- function(id, } merged_data <- isolate(teal.code::dev_suppress(output_q()[["ANL"]])) - brushed_df <- teal.widgets::clean_brushedPoints(merged_data, plot_brush) numeric_cols <- names(brushed_df)[ vapply(brushed_df, function(x) is.numeric(x) && !is.integer(x), FUN.VALUE = logical(1)) @@ -1028,6 +1074,7 @@ srv_g_scatterplot <- function(id, } }) + teal.widgets::verbatim_popup_srv( id = "rcode", verbatim_content = reactive(teal.code::get_code(output_q())), From d348719310195efeccfc71aed55221a51b54a57e Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Tue, 5 Nov 2024 11:10:15 +0100 Subject: [PATCH 02/92] brush_filter to the module --- R/module_brush_filter.R | 99 +++++++++++++++++++++++++++++++++++++++++ R/tm_g_scatterplot.R | 85 +++++------------------------------ 2 files changed, 110 insertions(+), 74 deletions(-) create mode 100644 R/module_brush_filter.R diff --git a/R/module_brush_filter.R b/R/module_brush_filter.R new file mode 100644 index 000000000..61e2259b2 --- /dev/null +++ b/R/module_brush_filter.R @@ -0,0 +1,99 @@ +ui_brush_filter <- function(id) { + ns <- NS(id) + div( + uiOutput(ns("brush_filter")), + DT::dataTableOutput(ns("data_table"), width = "100%") + ) +} + +srv_brush_filter <- function(id, brush, data, filter_panel_api, selectors, table_dec) { + moduleServer(id, function(input, output, session) { + selector_list <- isolate(selectors()) + + output$brush_filter <- renderUI({ + states <- get_filter_state(filter_panel_api) + brushed_states <- Filter( + function(state) state$id == "brush_filter", + states + ) + if (!is.null(brush())) { + actionButton(session$ns("apply_brush_filter"), "Apply filter") + } else if (length(brushed_states)) { + actionButton(session$ns("remove_brush_filter"), "Remove applied filter") + } + }) + + observeEvent(input$remove_brush_filter, { + remove_filter_state( + filter_panel_api, + teal_slices( + teal_slice( + dataname = "ADSL", + varname = "USUBJID", + id = "brush_filter" + ) + ) + ) + }) + + observeEvent(input$apply_brush_filter, { + plot_brush <- brush() + merged_data <- isolate(teal.code::dev_suppress(data()[["ANL"]])) + filter_call <- str2lang(sprintf( + "merged_data <- dplyr::filter(merged_data, %1$s >= %2$s & %1$s <= %3$s & %4$s >= %5$s & %4$s <= %6$s)", + plot_brush$mapping$x, plot_brush$xmin, plot_brush$xmax, + plot_brush$mapping$y, plot_brush$ymin, plot_brush$ymax + )) + eval(filter_call) + + slice <- teal_slices(teal_slice( + dataname = "ADSL", + varname = "USUBJID", + selected = merged_data$USUBJID, + id = "brush_filter" + )) + set_filter_state(filter_panel_api, slice) + }) + + output$data_table <- DT::renderDataTable({ + plot_brush <- brush() + if (is.null(plot_brush)) { + return(NULL) + } + + isolate({ + foo1(brush, selector_list) + }) + + dataset <- isolate(teal.code::dev_suppress(data()[["ANL"]])) + brushed_df <- teal.widgets::clean_brushedPoints(dataset, plot_brush) + numeric_cols <- names(brushed_df)[ + vapply(brushed_df, function(x) is.numeric(x) && !is.integer(x), FUN.VALUE = logical(1)) + ] + + if (length(numeric_cols) > 0) { + DT::formatRound( + DT::datatable(brushed_df, + rownames = FALSE, + options = list(scrollX = TRUE, pageLength = input$data_table_rows) + ), + numeric_cols, + table_dec + ) + } else { + DT::datatable(brushed_df, rownames = FALSE, options = list(scrollX = TRUE, pageLength = input$data_table_rows)) + } + }) + }) +} + +#' get axis dataname, varname and ranges +foo1 <- function(brush, selector_list) { + lapply(names(brush()$mapping), function(selector) { + list( + dataname = selector_list[[selector]]()$dataname, + varname = brush()$mapping[[selector]], + values = unlist(brush()[paste0(selector, c("min", "max"))]) + ) + }) +} diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index c8be54170..4834c76c4 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -343,8 +343,7 @@ ui_g_scatterplot <- function(id, ...) { teal.widgets::plot_with_settings_ui(id = ns("scatter_plot")), tags$h1(tags$strong("Selected points:"), class = "text-center font-150p"), teal.widgets::get_dt_rows(ns("data_table"), ns("data_table_rows")), - uiOutput(ns("brush_filter")), - DT::dataTableOutput(ns("data_table"), width = "100%") + ui_brush_filter(ns("brush_filter")) ), encoding = tags$div( ### Reporter @@ -1002,78 +1001,16 @@ srv_g_scatterplot <- function(id, click = TRUE ) - output$brush_filter <- renderUI({ - states <- get_filter_state(filter_panel_api) - brushed_states <- Filter( - function(state) state$id == "brush_filter", - states - ) - if (!is.null(pws$brush())) { - actionButton(session$ns("apply_brush_filter"), "Apply filter") - } else if (length(brushed_states)) { - actionButton(session$ns("remove_brush_filter"), "Remove applied filter") - } - }) - - observeEvent(input$remove_brush_filter, { - remove_filter_state( - filter_panel_api, - teal_slices( - teal_slice( - dataname = "ADSL", - varname = "USUBJID", - id = "brush_filter" - ) - ) - ) - }) - - observeEvent(input$apply_brush_filter, { - plot_brush <- pws$brush() - merged_data <- isolate(teal.code::dev_suppress(output_q()[["ANL"]])) - filter_call <- str2lang(sprintf( - "merged_data <- dplyr::filter(merged_data, %1$s >= %2$s & %1$s <= %3$s & %4$s >= %5$s & %4$s <= %6$s)", - plot_brush$mapping$x, plot_brush$xmin, plot_brush$xmax, - plot_brush$mapping$y, plot_brush$ymin, plot_brush$ymax - )) - eval(filter_call) - - slice <- teal_slices(teal_slice( - dataname = "ADSL", - varname = "USUBJID", - selected = merged_data$USUBJID, - id = "brush_filter" - )) - set_filter_state(filter_panel_api, slice) - }) - - output$data_table <- DT::renderDataTable({ - plot_brush <- pws$brush() - - if (!is.null(plot_brush)) { - validate(need(!input$add_density, "Brushing feature is currently not supported when plot has marginal density")) - } - - merged_data <- isolate(teal.code::dev_suppress(output_q()[["ANL"]])) - brushed_df <- teal.widgets::clean_brushedPoints(merged_data, plot_brush) - numeric_cols <- names(brushed_df)[ - vapply(brushed_df, function(x) is.numeric(x) && !is.integer(x), FUN.VALUE = logical(1)) - ] - - if (length(numeric_cols) > 0) { - DT::formatRound( - DT::datatable(brushed_df, - rownames = FALSE, - options = list(scrollX = TRUE, pageLength = input$data_table_rows) - ), - numeric_cols, - table_dec - ) - } else { - DT::datatable(brushed_df, rownames = FALSE, options = list(scrollX = TRUE, pageLength = input$data_table_rows)) - } - }) - + # todo: + # validate(need(!input$add_density, "Brushing feature is currently not supported when plot has marginal density")) + srv_brush_filter( + "brush_filter", + brush = pws$brush, + data = output_q, + filter_panel_api = filter_panel_api, + selectors = selector_list, + table_dec = table_dec + ) teal.widgets::verbatim_popup_srv( id = "rcode", From 947f1513f4daf9801ddb61ab36f5638440bd0e78 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Tue, 5 Nov 2024 11:45:28 +0100 Subject: [PATCH 03/92] encapsulate brushing functionality --- R/module_brush_filter.R | 38 ++++++++++++++++++++++++++++++-------- R/tm_g_scatterplot.R | 2 -- 2 files changed, 30 insertions(+), 10 deletions(-) diff --git a/R/module_brush_filter.R b/R/module_brush_filter.R index 61e2259b2..5878b000c 100644 --- a/R/module_brush_filter.R +++ b/R/module_brush_filter.R @@ -1,7 +1,12 @@ ui_brush_filter <- function(id) { ns <- NS(id) div( - uiOutput(ns("brush_filter")), + tags$h1(id = ns("title"), tags$strong("Selected points:"), class = "text-center font-150p"), + teal.widgets::get_dt_rows(ns("data_table"), ns("data_table_rows")), + div( + actionButton(ns("apply_brush_filter"), "Apply filter"), + actionButton(ns("remove_brush_filter"), "Remove applied filter") + ), DT::dataTableOutput(ns("data_table"), width = "100%") ) } @@ -10,19 +15,36 @@ srv_brush_filter <- function(id, brush, data, filter_panel_api, selectors, table moduleServer(id, function(input, output, session) { selector_list <- isolate(selectors()) - output$brush_filter <- renderUI({ - states <- get_filter_state(filter_panel_api) + observeEvent(brush(), ignoreNULL = FALSE, { + if (is.null(brush())) { + shinyjs::hide("title") + shinyjs::hide("apply_brush_filter") + shinyjs::hide("data_table") + } else { + shinyjs::show("title") + shinyjs::show("apply_brush_filter") + shinyjs::show("data_table") + } + }) + + states_list <- reactive({ + as.list(get_filter_state(filter_panel_api)) + }) + + observeEvent(states_list(), { brushed_states <- Filter( function(state) state$id == "brush_filter", - states + states_list() ) - if (!is.null(brush())) { - actionButton(session$ns("apply_brush_filter"), "Apply filter") - } else if (length(brushed_states)) { - actionButton(session$ns("remove_brush_filter"), "Remove applied filter") + if (length(brushed_states)) { + shinyjs::show("remove_brush_filter") + } else { + shinyjs::hide("remove_brush_filter") } }) + + observeEvent(input$remove_brush_filter, { remove_filter_state( filter_panel_api, diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index 4834c76c4..73d0d5122 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -341,8 +341,6 @@ ui_g_scatterplot <- function(id, ...) { teal.widgets::standard_layout( output = teal.widgets::white_small_well( teal.widgets::plot_with_settings_ui(id = ns("scatter_plot")), - tags$h1(tags$strong("Selected points:"), class = "text-center font-150p"), - teal.widgets::get_dt_rows(ns("data_table"), ns("data_table_rows")), ui_brush_filter(ns("brush_filter")) ), encoding = tags$div( From 842ba1b4b738599830e722021389e3f8138bacd2 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Tue, 5 Nov 2024 12:35:49 +0100 Subject: [PATCH 04/92] fix add filter state --- R/module_brush_filter.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/module_brush_filter.R b/R/module_brush_filter.R index 5878b000c..59af61d1c 100644 --- a/R/module_brush_filter.R +++ b/R/module_brush_filter.R @@ -43,8 +43,6 @@ srv_brush_filter <- function(id, brush, data, filter_panel_api, selectors, table } }) - - observeEvent(input$remove_brush_filter, { remove_filter_state( filter_panel_api, @@ -68,10 +66,11 @@ srv_brush_filter <- function(id, brush, data, filter_panel_api, selectors, table )) eval(filter_call) + # todo: when added another time then it is duplicated slice <- teal_slices(teal_slice( dataname = "ADSL", varname = "USUBJID", - selected = merged_data$USUBJID, + selected = unique(merged_data$USUBJID), id = "brush_filter" )) set_filter_state(filter_panel_api, slice) From a9c9b0681e1205394793d036d858fead0328e430 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 6 Nov 2024 14:11:13 +0100 Subject: [PATCH 05/92] scatterplot + data_table --- R/module_brush_filter.R | 120 ---------------------------------------- R/tm_data_table.R | 69 ++++++++++++++++++++++- R/tm_g_scatterplot.R | 6 +- 3 files changed, 69 insertions(+), 126 deletions(-) delete mode 100644 R/module_brush_filter.R diff --git a/R/module_brush_filter.R b/R/module_brush_filter.R deleted file mode 100644 index 59af61d1c..000000000 --- a/R/module_brush_filter.R +++ /dev/null @@ -1,120 +0,0 @@ -ui_brush_filter <- function(id) { - ns <- NS(id) - div( - tags$h1(id = ns("title"), tags$strong("Selected points:"), class = "text-center font-150p"), - teal.widgets::get_dt_rows(ns("data_table"), ns("data_table_rows")), - div( - actionButton(ns("apply_brush_filter"), "Apply filter"), - actionButton(ns("remove_brush_filter"), "Remove applied filter") - ), - DT::dataTableOutput(ns("data_table"), width = "100%") - ) -} - -srv_brush_filter <- function(id, brush, data, filter_panel_api, selectors, table_dec) { - moduleServer(id, function(input, output, session) { - selector_list <- isolate(selectors()) - - observeEvent(brush(), ignoreNULL = FALSE, { - if (is.null(brush())) { - shinyjs::hide("title") - shinyjs::hide("apply_brush_filter") - shinyjs::hide("data_table") - } else { - shinyjs::show("title") - shinyjs::show("apply_brush_filter") - shinyjs::show("data_table") - } - }) - - states_list <- reactive({ - as.list(get_filter_state(filter_panel_api)) - }) - - observeEvent(states_list(), { - brushed_states <- Filter( - function(state) state$id == "brush_filter", - states_list() - ) - if (length(brushed_states)) { - shinyjs::show("remove_brush_filter") - } else { - shinyjs::hide("remove_brush_filter") - } - }) - - observeEvent(input$remove_brush_filter, { - remove_filter_state( - filter_panel_api, - teal_slices( - teal_slice( - dataname = "ADSL", - varname = "USUBJID", - id = "brush_filter" - ) - ) - ) - }) - - observeEvent(input$apply_brush_filter, { - plot_brush <- brush() - merged_data <- isolate(teal.code::dev_suppress(data()[["ANL"]])) - filter_call <- str2lang(sprintf( - "merged_data <- dplyr::filter(merged_data, %1$s >= %2$s & %1$s <= %3$s & %4$s >= %5$s & %4$s <= %6$s)", - plot_brush$mapping$x, plot_brush$xmin, plot_brush$xmax, - plot_brush$mapping$y, plot_brush$ymin, plot_brush$ymax - )) - eval(filter_call) - - # todo: when added another time then it is duplicated - slice <- teal_slices(teal_slice( - dataname = "ADSL", - varname = "USUBJID", - selected = unique(merged_data$USUBJID), - id = "brush_filter" - )) - set_filter_state(filter_panel_api, slice) - }) - - output$data_table <- DT::renderDataTable({ - plot_brush <- brush() - if (is.null(plot_brush)) { - return(NULL) - } - - isolate({ - foo1(brush, selector_list) - }) - - dataset <- isolate(teal.code::dev_suppress(data()[["ANL"]])) - brushed_df <- teal.widgets::clean_brushedPoints(dataset, plot_brush) - numeric_cols <- names(brushed_df)[ - vapply(brushed_df, function(x) is.numeric(x) && !is.integer(x), FUN.VALUE = logical(1)) - ] - - if (length(numeric_cols) > 0) { - DT::formatRound( - DT::datatable(brushed_df, - rownames = FALSE, - options = list(scrollX = TRUE, pageLength = input$data_table_rows) - ), - numeric_cols, - table_dec - ) - } else { - DT::datatable(brushed_df, rownames = FALSE, options = list(scrollX = TRUE, pageLength = input$data_table_rows)) - } - }) - }) -} - -#' get axis dataname, varname and ranges -foo1 <- function(brush, selector_list) { - lapply(names(brush()$mapping), function(selector) { - list( - dataname = selector_list[[selector]]()$dataname, - varname = brush()$mapping[[selector]], - values = unlist(brush()[paste0(selector, c("min", "max"))]) - ) - }) -} diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 4a2be49d4..598b531cb 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -187,7 +187,8 @@ srv_page_data_table <- function(id, variables_selected, dt_args, dt_options, - server_rendering) { + server_rendering, + filter_panel_api) { checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { @@ -262,7 +263,8 @@ srv_page_data_table <- function(id, if_distinct = if_distinct, dt_args = dt_args, dt_options = dt_options, - server_rendering = server_rendering + server_rendering = server_rendering, + filter_panel_api = filter_panel_api ) } ) @@ -283,6 +285,10 @@ ui_data_table <- function(id, tagList( teal.widgets::get_dt_rows(ns("data_table"), ns("dt_rows")), + div( + actionButton(ns("apply_brush_filter"), "Apply filter"), + actionButton(ns("remove_brush_filter"), "Remove applied filter") + ), fluidRow( teal.widgets::optionalSelectInput( ns("variables"), @@ -307,7 +313,8 @@ srv_data_table <- function(id, if_distinct, dt_args, dt_options, - server_rendering) { + server_rendering, + filter_panel_api) { moduleServer(id, function(input, output, session) { iv <- shinyvalidate::InputValidator$new() iv$add_rule("variables", shinyvalidate::sv_required("Please select valid variable names")) @@ -338,5 +345,61 @@ srv_data_table <- function(id, do.call(DT::datatable, dt_args) }) + + observeEvent(input$data_table_rows_selected, ignoreNULL = FALSE, { + if (is.null(input$data_table_rows_selected)) { + shinyjs::hide("apply_brush_filter") + } else { + shinyjs::show("apply_brush_filter") + } + }) + + observeEvent(input$apply_brush_filter, { + if (is.null(input$data_table_rows_selected)) { + return(NULL) + } + # isolate({ + # foo1(brush, selector_list) + # }) + dataset <- data()[[dataname]][input$data_table_rows_selected, ] + # todo: when added another time then it is duplicated + slice <- teal_slices(teal_slice( + dataname = "ADSL", + varname = "USUBJID", + selected = unique(dataset$USUBJID), # todo: this needs to be parametrised or based on join_keys + id = "brush_filter" + )) + shinyjs::hide("apply_brush_filter") + set_filter_state(filter_panel_api, slice) + }) + + states_list <- reactive({ + as.list(get_filter_state(filter_panel_api)) + }) + + observeEvent(input$remove_brush_filter, { + remove_filter_state( + filter_panel_api, + teal_slices( + teal_slice( + dataname = "ADSL", + varname = "USUBJID", + id = "brush_filter" + ) + ) + ) + }) + + observeEvent(states_list(), { + brushed_states <- Filter( + function(state) state$id == "brush_filter", + states_list() + ) + if (length(brushed_states)) { + shinyjs::show("remove_brush_filter") + } else { + shinyjs::hide("remove_brush_filter") + } + }) }) } diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index 73d0d5122..771b47901 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -341,7 +341,7 @@ ui_g_scatterplot <- function(id, ...) { teal.widgets::standard_layout( output = teal.widgets::white_small_well( teal.widgets::plot_with_settings_ui(id = ns("scatter_plot")), - ui_brush_filter(ns("brush_filter")) + teal::ui_brush_filter(ns("brush_filter")) ), encoding = tags$div( ### Reporter @@ -1001,10 +1001,10 @@ srv_g_scatterplot <- function(id, # todo: # validate(need(!input$add_density, "Brushing feature is currently not supported when plot has marginal density")) - srv_brush_filter( + teal::srv_brush_filter( "brush_filter", brush = pws$brush, - data = output_q, + dataset = reactive(teal.code::dev_suppress(output_q()[["ANL"]])), filter_panel_api = filter_panel_api, selectors = selector_list, table_dec = table_dec From 4b987a66139fff1d6da6002c81cbf8d8067e46ef Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 15 Nov 2024 09:37:04 +0100 Subject: [PATCH 06/92] WIP swimlane POC --- R/tm_p_swimlane.R | 57 +++++++++++++++++++++++++++++++++++++++++++++ inst/swimlane_poc.R | 49 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 106 insertions(+) create mode 100644 R/tm_p_swimlane.R create mode 100644 inst/swimlane_poc.R diff --git a/R/tm_p_swimlane.R b/R/tm_p_swimlane.R new file mode 100644 index 000000000..d1a668fa2 --- /dev/null +++ b/R/tm_p_swimlane.R @@ -0,0 +1,57 @@ +tm_p_swimlane <- function(label = "Swimlane Plot Module", dataname, id_var, avisit_var, shape_var, color_var) { + module( + label = label, + ui = ui_p_swimlane, + server = srv_p_swimlane, + datanames = "synthetic_data", + server_args = list( + dataname = dataname, + id_var = id_var, + avisit_var = avisit_var, + shape_var = shape_var, + color_var = color_var + ) + ) +} + +ui_p_swimlane <- function(id) { + ns <- NS(id) + shiny::tagList( + teal.widgets::plot_with_settings_ui(ns("myplot")), + teal::ui_brush_filter(ns("brush_filter")) + ) +} + +srv_p_swimlane <- function(id, data, dataname, id_var, avisit_var, shape_var, color_var, filter_panel_api) { + moduleServer(id, function(input, output, session) { + output_q <- reactive({ + within(data(), + { + p <- ggplot(dataname, aes(x = avisit_var, y = subjid)) + + ggtitle("Swimlane Efficacy Table") + + geom_line(linewidth = 0.5) + + geom_point(aes(shape = shape_var), size = 5) + + geom_point(aes(color = color_var), size = 2) + + scale_shape_manual(values = c("Drug A" = 1, "Drug B" = 2)) + + scale_color_manual(values = c("CR" = "#9b59b6", "PR" = "#3498db")) + + labs(x = "Study Day", y = "Subject ID") + }, + dataname = as.name(dataname), + id_var = as.name(id_var), + avisit_var = as.name(avisit_var), + shape_var = as.name(shape_var), + color_var = as.name(color_var) + ) + }) + + plot_r <- reactive(output_q()$p) + pws <- teal.widgets::plot_with_settings_srv(id = "myplot", plot_r = plot_r) + + teal::srv_brush_filter( + "brush_filter", + brush = pws$brush, + dataset = reactive(teal.code::dev_suppress(output_q()$synthetic_data)), + filter_panel_api = filter_panel_api + ) + }) +} diff --git a/inst/swimlane_poc.R b/inst/swimlane_poc.R new file mode 100644 index 000000000..7ae420979 --- /dev/null +++ b/inst/swimlane_poc.R @@ -0,0 +1,49 @@ +pkgload::load_all("teal") +pkgload::load_all("teal.widgets") +pkgload::load_all("teal.modules.general") + + +# Example data +data <- within(teal_data(), { + library(dplyr) + library(tidyr) + + set.seed(123) # Setting a seed for reproducibility + # Define possible maximum study days + .possible_end_days <- c(50, 60, 70) + + # Create sample data + synthetic_data <- tibble(subjid = c(1:15)) |> + rowwise() |> + mutate( + max_study_day = sample(.possible_end_days, 1), + study_day = list(seq(10, max_study_day, by = 10)) + ) |> + unnest(study_day) |> + group_by(subjid) |> + mutate( + assigned_drug = sample(c("Drug A", "Drug B"), 1) + ) |> + ungroup() |> + mutate( + response_type = sample(c("CR", "PR"), n(), replace = TRUE), + subjid = reorder(as.character(subjid), max_study_day) + ) |> + select(-max_study_day) +}) + +app <- init( + data = data, + modules = modules( + tm_p_swimlane( + dataname = "synthetic_data", + id_var = "usubjid", + avisit_var = "study_day", + shape_var = "assigned_drug", + color_var = "response_type" + ) + ), + title = "Swimlane Efficacy Plot" +) + +shinyApp(app$ui, app$server) From 089a06ab05d88c5bdd8bcab2781239a6855f078a Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 15 Nov 2024 09:39:12 +0100 Subject: [PATCH 07/92] add data_table module to the app --- inst/swimlane_poc.R | 1 + 1 file changed, 1 insertion(+) diff --git a/inst/swimlane_poc.R b/inst/swimlane_poc.R index 7ae420979..f08269830 100644 --- a/inst/swimlane_poc.R +++ b/inst/swimlane_poc.R @@ -35,6 +35,7 @@ data <- within(teal_data(), { app <- init( data = data, modules = modules( + tm_data_table(), tm_p_swimlane( dataname = "synthetic_data", id_var = "usubjid", From e0969daf71dff56b536f610bf3993f2555ccd491 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Fri, 15 Nov 2024 08:54:50 +0000 Subject: [PATCH 08/92] [skip roxygen] [skip vbump] Roxygen Man Pages Auto Update --- man/tm_a_pca.Rd | 8 ++++---- man/tm_a_regression.Rd | 8 ++++---- man/tm_data_table.Rd | 8 ++++---- man/tm_file_viewer.Rd | 4 ++-- man/tm_front_page.Rd | 4 ++-- man/tm_g_association.Rd | 8 ++++---- man/tm_g_bivariate.Rd | 8 ++++---- man/tm_g_distribution.Rd | 8 ++++---- man/tm_g_response.Rd | 8 ++++---- man/tm_g_scatterplot.Rd | 8 ++++---- man/tm_g_scatterplotmatrix.Rd | 8 ++++---- man/tm_missing_data.Rd | 8 ++++---- man/tm_outliers.Rd | 8 ++++---- man/tm_t_crosstable.Rd | 8 ++++---- man/tm_variable_browser.Rd | 8 ++++---- 15 files changed, 56 insertions(+), 56 deletions(-) diff --git a/man/tm_a_pca.Rd b/man/tm_a_pca.Rd index ac4f506ba..1de282e2f 100644 --- a/man/tm_a_pca.Rd +++ b/man/tm_a_pca.Rd @@ -149,13 +149,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlY4AygCCjNUtonG6fYPDpKJKAL5dSmioYyp57BX+GboAvJtBuBt8QiKju0fCYuvdlbqkMIlQiagEqRs3ugpgAAoAwv2fB2u7xiOz2jzCpGYGkSolQcAIV3ewIy0HgoM+EyGYmmALeSNEcBEGlBBKJpBhcIReKRugI+SItAIYlBWhYtCg9BEiTpDKZokRNKRKVBKWAwAxAyxI0+AF0ZaUqWAALKCRj8GQAj5gfqiURQYSkTUYxj0KAQL5EVBGsBYNBwT5dQU3OSAp2VUnw8j8UGKlVqjV4LU6vUGh2ut0wA20SJ6XYOFzU53hmkmWjUciMUEAOUcABlc4nHc6Nl0urQTLp2CoM+pNDobLZytdRIUIKx+uh2EsACT1Uo9gmMHSdOZKMCzGVAA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWT64bGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0CZVi9lqQ3N0AF5-uFcH8+EIRKIgboIcIxL8BnVdKQYGkoGlUAQsn9kboFGAAApeQYEsFIvGJGGZNLRUjMDRpUSoOAERF4ym5B56YEEqajMm4jmiOAiDQwkVi47M1nsjl4gglJYEMQwrQsWhQegiE5K2gqzZC+V1TLU3LAYB8kYCsAvF5VNkEgBCAFksABpLAARjJ+LAgwA4q48H7nAB5AI+ACaBP6xuRcnJ8bqktZ5H4MMdYFdHu9vr5QdjSeTMCOtDiPPsTlcFI5iaNyJMtGo5EYMIAco5RgLa3U4wm-v1+rQTLp2CpW+pNDobLYakjRGUIKxBuh2GhUAASFpVDebkWMHR9WZKMAzF5AA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_a_regression.Rd b/man/tm_a_regression.Rd index 85b3c578d..c85255c48 100644 --- a/man/tm_a_regression.Rd +++ b/man/tm_a_regression.Rd @@ -195,13 +195,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQDCAPIATHG6-QNKAL5dSmiowyp57BX+GboAvMtBuEt8QiKia7o7wmKL3ZW6pDCJUInVEtWiolYQp+fn1FD0cH7rCmBYcHuYieJD+WzObweqBIoj06xSiTCpGYGkSolQcAIrze5xS0HgBz+ozBSxxulhIg0BwpmNIaIxWNJZN0Hy+P10fwAyt9abotCxaJ8RIgSRDmQR8kRaAQxISwIJUEEANZwUXM840jRwfhyhXK1V4JlkmDCTSROG6ABiAEEADKc5zg9WVEy0ULag4OFxG85dMlyJ04u4PUQdA4IpEounozHYsl42AWomDNXMzWkak81Exxlisms75y7mUjP8xiC+h7EWGvM4iVSmX7dZlisiRL16UnFLAYDJsZgAC6A9KjMIJAIYI5YDs1UC8DIfzkAZ9b3THt+Y4sqfVJuoZpEnqcjpX51d7p16xt9tctcqfpx97vSy6XVoJl07BU5Cj2jgNls5RnKIhQQKw1roOwMwACT1KU0GwowOidBMShgOMA5AA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWT64bGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0CZVi9lqQ3N0AF5-uFcH8+EIRKIgboIcIxL8BnVdKQYGkoGkGhIGqJRFYIIjkcjqFB6HBqDCFGAsHBsWI8SQqWCkUScagSKI9MDMmloqRmBo0qJUHACISicjMg8uboqVNRky-hLdJyRBoYarRcdhaLxcq6iSyRTgVSAuStbotCxaKSRIhFSz9QQSksCGJKWAAEIAWSwAGksABGB365GajRwfgen3+oMh0Owo60OIygBig1GAWczITploUUjMIcLiVEv6yrkOYlWJxol6MJ5fIF2pFYtLRKlsBlcpGCrw7bD5vVwPDLd1A6JhvJHrNatIluttrE9v7juVztd7uBVsYNvoIhOLtobqeuWAwB70zALxeVTbYEGAHFXHhZWAswANJlvrCDLwvuRKwnQc50LE0H2feNQxgJMUyLJxs2AuoTHzMDdHTTNXDXZFyzLUtcP6fpaBMXR2BUchm20OAbFsGokVEMoIFYQZ0HYNBUAAEhaKp2I4zlGB0PpZiUMAZheIA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_data_table.Rd b/man/tm_data_table.Rd index 3d105c6c0..24a713d2b 100644 --- a/man/tm_data_table.Rd +++ b/man/tm_data_table.Rd @@ -110,13 +110,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQ20onG6vaJKAL5dSmioAyp57BX+GboAvAtBuPN8QiL9K5vCYnPdlbqkMMkZiUH0IofHx1ostFDXYomicCIacPzLunQttzuxyGvwIczAAGU4KhuBgADIUCQFBR4XQoqEwngAdVo-GRqJRAAU4EEeAiIEj8ijSkSSbCcXiqQTIag4ARaGIUV0gbo5Osjnc8YkWBIdn8+qR2AQ0JoSL8UQBJLAKiH2Z4iXQAYRlVggXPmlW5vKUXVoJl07BU5GYlh0Nls5SOokKEFYAEF0OxJgASeqlH3vRg6TqjJRgEYAXSAA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWT64bGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0CZVi9lqQ3N0AF5-uFcH8+EIRKIgboIcIxL8BnVdKQYBlcmlwvQRIjkcitCxaFBsWI0qI4CINHB+DC6KJSOwpuNgQRfmAAnZHD4AJp+HwKPC6AWOAKOABCACk+QKqgLRZLpYK5X47M5FbKwIMAOKuJXs5wADQFcjkYKReP4xxYEmhwLpDIIaE0JBhAqZ9mJIm8TqsEGNfzq-UDSn6tBMunYKnIzEsOhsthqSNEZQgrEG6HYaFQABIWlUs9nyYwdH1ZkowDMXkA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_file_viewer.Rd b/man/tm_file_viewer.Rd index cf3b5cdd3..a1617b9db 100644 --- a/man/tm_file_viewer.Rd +++ b/man/tm_file_viewer.Rd @@ -54,8 +54,8 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG3dPbyNdAHdaUgALFXYgqFxdECVdXSSfTLCME2Z4dgBGRQgAX1KlNFRslRj2dJyvXQBeJuTGviERUVbdLuExBogMjNIYfxNaEX8tWjhImWHR0ZVUQVJ-VE9YvrpRUmWV0ZMian4ZPtFWA7gYPOm4BrBRWFQZqZ6FPF1tggBrKBSPrfPy8ASDcRSCBqajfOS4RrHX4QCRXG7ke6fJ7fV4wd5wSaPUQAejxBKJIgwqFR3xSf0BwLaoLg3HB3TEkmksnhiJGyN0pAAHqR0bcsY9nuSPsSyW8ZVThaQ6b91Iy9MywGCBj0uTCeWAEUjjoJGNQQWBYqRSKhRIgSSSTB5JEQtI7ZfxGIIJKT1vR9rE4PwSQAFIiMLz+uCGAAiRAIgngZEMADFwzBPIYAMqoOAEWhTAieKwQcSofgmb7GjKlFa13SlUoF3TsFTkZiWHQ2WxpfmieIQVgAQXQ7GqABJBLQUhPRDIdIxSmUlGAygBdIA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_front_page.Rd b/man/tm_front_page.Rd index 35b1c3e9d..7da5acb05 100644 --- a/man/tm_front_page.Rd +++ b/man/tm_front_page.Rd @@ -85,8 +85,8 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG3dPbyNdAHdaUgALFXYgqFxdECVdXUY4AEdBWiz2CDFSYmoiRkUIDIBBABEAZQAZH0y6pvTdT1JGdjbGlIUweC8kwdsIulFSdkHqwTjywd0AXl1BgDlnertdLhhBgbAk-1EiQUYCOCXVwdFWMli4TQJdUbBKgF9KgCsiFX8ANZwViiRJhcbGfhwExQYSkfwEfi0UQEfy-f5AkHAaDwUFJOQAXTcZCg9BE-gAjC0khgTMx4OwAJIQExEFa6AgzMDVA5rMAAITGKTscAAHqR2ZzZrzBoL3pUvGS4P4AEzUsK0+lwdgAAwAwkRqIIYFUKTrJVy9TKwLUhbp9YbjVUVebVpyAKwYd0pABsGB9chSDqNJt0AGZXRyuTy8Hy5XIFaTyWH1V5NbBtczWRbBq5Y4MAGJ2kXinNgADi1oAEmNKkpFeSVKh5i1JtMOoM7Em9BTrrtu5TcB2wF2lboVX2G8qVUOqnzRyJw5OB2GlHXoOgWioYjM50l2UlZxk+EIRKJ2SfhGJdxkMqQYP46SR4agoFIb7eMo8oFDGP5yKWbofp+GSDIyMCoOUXhkLoKisowMCeFYEB9mBEoEFAVQSGyjxZBgBwdCBfIAPJxDIsEsuUiGaCQqFgHqmG6Nhui4XA+FgIRt6Bpxd7dueqxTv4TbzEeIE-kiNHQAEXgSPxuhVnYACyjTRvwEnIdw8lKc05S6KI8QQKw-ayUxOEyHo+hMAAfEKPGmEQRCkBAjliGWAAadHIrsjymPkUz2Y5znkNaACasHnmRelwMQED8AFTkubZc6fvpRCRP4ww-mE7IOC4nGVBk3Fzt+v7sjJogACSxBSXL1LAqCLtU6B0BhklJRkrIuYwZVvpVqDRs1tCtch8UyEl660CYujsCo5DMJYOg2LYaRzvpKisE1-VoKgFV5Ck20VaIMg6BUSgfEoYAfASQA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_g_association.Rd b/man/tm_g_association.Rd index c239f6051..c6a64f695 100644 --- a/man/tm_g_association.Rd +++ b/man/tm_g_association.Rd @@ -159,13 +159,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQDCAPIATHG6-QMVpuqkHaLD0PCi7ABitNTkjOy0og4upVpokRyjpZsYJpMdpe0StATc7ACMADJyL129g8BnGtMAusPU+2ohw+XymjFEP1KUHEBHyLEmMi6AF8ukp9sMVHl2OMUroALz+DK4cZ8IQiGYE0nCMTY7qVXSkGCJCSJaGiIgEWiBKwQWn0+nVEz4wlBRJhUjMDSJUSoOAEPn8+kpOZ6AkKMCjdXEumK3SiOAiDTC-WG0jS2Xy8a6yoA+gG4XqgDKBrlpF0e0YXPoIkQWqt1thRBuYmFHq9IkSgeDCxSwGA6s1YB+kN0lrAAAUAWQtbp1XZWLKc3nqoF4NmwC9tdb6SbXXB+A6M1nSH6ddaTLRQvXhYsAIKPR2uNv8t6KuRVxUeikiqBi0ISybmuUK3XK2Cq3Mawat6u1o0EvdmmXL-26232tVgZ2m90scNiX14U+KqMEEMEsNQb1wSP5INvmMMjjBNtyTFM00zKBy1KPMCzgIswDsEtGQoFsK3HZ9+UPbtLyQuBS1Qndq10GBhE0SIN22ZwJ2rDsuwbAk+wHIdq1HEd-VHLouloIUNlUSVNB0GxbHKOlREKCBWF7dB2H2AASeooXQOT9UYHROiUJElDAJEfiAA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWT64bGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0CZVi9lqQ3N0AF5-uFcH8+EIRKIgboIcIxL8BnVdKQYGkJGkoKJREQCLQwlYIIjkciGiYYZk0tFSMwNGlRKg4ARiSTkZkHnpgQowFNRtywUjWbpRHARBoYSKxccGUyWUK6tQoPRRTDuQFRUzSLotCx8fQRIh+X95boCCUlgQxDCdYw9SITubaJbNsaTSCoMBgNzedyXi8BW7kcy1c4ABr83TcrCDLyuPCRsBeADyjgAcg4AJoR71YACy2bAAQcgzsgwAjAWi9HSwAmAt+Ox2ABifPj3IAQrmsABpLB1sD9QNyANuyWauD8VVgaOxo2C+UmWhRCcwpuDUYBVzzkmD1nD111G3Q4GU6m06WM4Pbtm5DlTn14A-Isfi4Evi+yp8kxXK6hT9VStqupKlChqPteJJmhaVrAjadpwA60EuhBrKZJ63ojK2fojoGwaFmGBYznGVTcsmaaZgWgx5pWxalhWbaFrRgz9iRYANs2rasZ2PZ9tyu4mvuKF1O+K5cmA3G9ixX7IjARy0HEnL2E4zg4QuS6iboa4bluAlPvxui7v0-S0OS7AqOQ57aHANi2DUSKiGUECsIM6DsGgqAACQtFU7keSKjA6H0sxKGAMwvEAA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_g_bivariate.Rd b/man/tm_g_bivariate.Rd index cce2711a0..7d36cffb9 100644 --- a/man/tm_g_bivariate.Rd +++ b/man/tm_g_bivariate.Rd @@ -228,13 +228,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQDCAPIATHH+GRgmzPDs-QNdAL5dSmiowyp57BUjsQC8m1C4G3xCIqK6O6QwiRKJ9NostIFw692VuqGnu4lhpMwaiaKocAITxeLxS0Hg7wUYGmUP2zxBojgIg070RyNIfwBQI2IMq1Cg9CRkLAAGUkYDSLotHcCSJELCcbiCPkiLQCGJ3tTGPd6CJEszWezRMUMsBgFCYWAALpSuRw3EvNEUuD8YnECwM+G4ky0UIq94AMQAggAZEmuLWVLoguWM1jvFKfULfdQY-6A4G4sGwPQ7CWDTUKpUonbBt1Yz0K-GEvx+0nklFcnl0wMK3QCtkcnZJ2lwfkszPClJi-0DKEy22WxUJ8iquOCVBBADWcFTCpgwk0kV9umNZuc8rTOr1dd7pvNjKtjMrIMYRGyiRM6jglJ2jq+P3DHsnu3BPdLber6NRNcx26reIJRLjZOPOd5cHpeB3lQzQs5NIf+cFYhFQRL0IBtKsqDkGNb6nGdisACh4gsOEFjv2O7Wi8M4vG0i7LquHwbq6Z7YlW3oQnGkqgUeFInui+GRri0bXroUK3hR94ps+F7pgW77Zp+fJvr+xbioBZbAWhYHoghUJ2NUgTwGQsEvPBo59hOVYoVOzxdF0tAmLo7AqOQm7aI8ci2OUzyiIUECsEa6DsEsAAk9SlA5iKMDonRKLMShgLMUpAA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWT64bGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0CZVi9lqQ3N0AF5-uFcH8+EIRKIgbpSDA0hI0vRtCxaGE4L8BnVdFEYZk0tFSMwNGlRKg4ARMdjsZkHnpgQowFNRoywVjqaI4CINDDOdzjmSKVTqdjqFB6FyYYyAlyKaRdFpUeKRIhWX8RboCCUlgQxDDFYw0fQRCdtbRdU9csBgIzmYyXi85GyNXU+XK4PwpUyAOKuPDqkUmWhRD0wgBig1GAVc7Ox-WpToDrDxuQJUSJ6gF5MpAbqtNg9N0tpGLP9sddsp5wLdJMFOfLovFkoZYBl-IVSuNcFVZZdmrNFv1nZNWp1Yi24WtxemYAdiYbFf5oZb0YAGmqF7oYEdaHFCxGo85nS6gyHPcCD9Hc7p43Hj3VGEQCmkDrr5cD8YTiVmhdf8-AvTtXsRRrd9dFA0ls2FDUxQlagvTbOUO0NZVuw3PtR3NPVgQNI0RwHcdMinJkS3tR17xAytyHPIsmSwABZdCT2DZddEvGMNVvOp52pboX3UOAwM-dNv0g38G3-Qtp1LCjFyQ6sqLE+s+1g5taMQnlcNQntZOxTDBxw4c4FNMdLUnG0SJnOddLkjRWMZLwAHlHAAOQcABNJiNVPVj2OvLibz+fp+loExdHYFRyG-bQMTkWwaixUQyggVhBnQdg0FQAASFoqkyrLOUYHQ+lmJQwBmF4gA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_g_distribution.Rd b/man/tm_g_distribution.Rd index 0b7cae9be..78fb42d9c 100644 --- a/man/tm_g_distribution.Rd +++ b/man/tm_g_distribution.Rd @@ -148,13 +148,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBISqDC0ogT+uLpetHCk1Ky6ALz2Ts62AGTpuu7Rvv6B6BFR3rHxSSkuGVk53nkBRCbkoqRF0aUJyQ6VupnZnrVwfmAAsgCCAMrjrSVxHRVpPdX9PoP+TEREMNMxs+VdaUoAxLpSEGrUuvxQpFC6cAAesKgiSlc3BsZc1AD6b1A2r2utyMugA7rRSAALFTsP6REBKXS6HyhD7IxihJQAX0UECUaFQaJUEL8ECRf3KcMRuj4QhEonKdGapKRSNIMG+El+oVIGPogk01mprMuPO+WhYlKB3wevPUpG+olQcAILJFrL+0Hg5X8KNEEWF6tEcBEGnKxtNCqVKvYEoxUHoIm+BEhRFoBDEQz1-jkkX8AAVYtwMAAZCgSKE+w1I3Ei2O6XG42gmXTsFTkZiWHQ2WwIsm6UTQiCsUbodgEgAk3kileNjB0jFxWKUYCxAF0gA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBISqDC0ogT+uLpetHCk1Ky6ALz2Ts62AGTpuu7Rvv6B6BFR3rHxSSkuGVk53nkBRCbkoqRF0aUJyQ6VupnZnrVwfmAAsgCCAMrjrSVxHRVpPdX9PoP+TEREMNMxs+VdaUoAxLoAwgAiAJLjJ7r8UKRQunAAHrCoIkp3DwbGXNQA+l8oDZPvdHkZdAB3WikAAWKnYQMiICUul0ozO4wAMj9shjsUoAL6KCAAKyIKn+AGs4KxRIiwbYIfw4CYoMJSP8CPxQgR-uTKTS6cBoPB6UC5ABdJRKLQsUQARlxBFhFIIYn+ojgIg0cH4fggaLljFoUHoIi5qto6vFYOAwH8+Kx-klksiBCGoywwyK-hOAHlHAA5BwATV9YHGzgAGv45HJcKjdFqdeR+OUg44sc6ICSlGhULiVDCDWigeUkUm+EIRKJytXhGJS2jdKQYP8JIDQqQTfRBJprEmW7du-9jRWwf8Xj31JzRKg4B6h8PbmDRXpko7Mc68MvhynF6RygeNJqF0vDSvhyq1WJysbTea4Jbb7aHvatwSwK73Z6AOKuHguj+AAQsMWAANJYAqcYJnuK4nmm5SgeBUEwbul5XmiMAcrQ7wbroABioxYlGiaYVhJi0M8erlMRpGuBRw4klecFMcmM4PGOLATlx07MKe86Ls2V5AuuyFgE6ETwWiVHUOQjDlHJClnsJMktsadbJJpCrkVhLY4fJeEiHsqTqSxK5sVeEiMEQgioNxinJECU7PDOgnniJK5ibABGfjuemUbQ8kyEpwUqUJF76Ua8r3vKunqdhuH4aZLjmfBFlohZJIkrQJi6OwKgKbO2iDPGugopeojwhArCjOg7AFgAJN4kTNVqjA6IwJKEkoYCEpKQA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_g_response.Rd b/man/tm_g_response.Rd index 4c34a0f6f..e055c1e4c 100644 --- a/man/tm_g_response.Rd +++ b/man/tm_g_response.Rd @@ -184,13 +184,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlTCtLKJxur0E-RWmHbrsWroqugTsCoSs1Iuli1qiq7qLsFuLUiyLcrbl3ZVDfYyiwMBaALp3g1DiJuqkHezD-Tf3d12VAF8lACuko0KhBio8gszildABefwZXBjPhCEQDRFo4RiGHnXSkGCJCSJaqiVAkURwPH43TUKD0OB+RGLLBiCkQKm6AAK7VImzwY3xZI5XMRKUSYVIzA0iXJcHmQtpKWg8AR2zAXyuqyV+KpIg06v1CtIctQCpptPO9MZzI1AGUmSbdFoWLQGSJEDqzlbKgR8kRaAQxOrXYx3fQRIl-YHg6JihkbostQKHqVFUsVngNQdGEc5Cifb7jRo4Px1YsCMtvb7zjBhJpInpEQAxACCABl7c5C7XKiZaKEy+r213XEX8f9aQXdbpQuqJVKZab5YqJ+cVbBmxqUzXi07DYiSyvzWu+3SGUyK2BHQbSC63R64F7Bev8TGgyHEWGI1GP3GEyCJNNUuVM7nTBYwA2PYUBgfNez7Y9hxZKCBQQ2t62oRsRBHTtu3Q30ByHctWzw8daynSclSnLouloExJhUchl20aljjKMZREKCBWDbdB2HBAASepSiEqlGB0TpgSUMAATuIA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWT64bGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0CZVi9lqQ3N0AF5-uFcH8+EIRKIgboIcIxL8BnVdKQYGkJGkGqJUCRRHBEcjkdQoPQ4NQYQowFgxDiIHjdAAFHqkUSUsFIwlY2n04GZNLRUjMDRpbFwAgEwnIzIPPTAylTUZsv6S3R4kQaGFqsXHUXi5Uq3TE0nkuVgAJk7W6LQsWgkkSIJUcg0EEpLAhiGHWxi2+giE6u2jup65YDAeUjRVgF4vKp6sAAIQAslgANJYABMbN0lK8AHlHAA5BwATUpcjk7INyK1Gjg-ApCeTaczeH1KpgR1ocVlugAYoNRgFnJWq6ZaFE6zD+4PXE7Cf0VRW27oojC+QKhTrUGKJSrpbAe+Hpq259WLRrgTWtzvl4SjWSG+b1aQrTa7XAHSfR7oXW6PcCvR9P1f0DBFMlDI9I2jWNfjNZwAA0s0pLBBi8VwwHLEcqyvSdTRQtDHW-DtqE0bspwHIcsINExx1wvsKNnKsF0lZi6mY-p+loExdHYFRyE3bR8XLao-lEMoIFYQZ0HYNBUAAEhaKpZLkvFGB0PpZiUMAZheIA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_g_scatterplot.Rd b/man/tm_g_scatterplot.Rd index 5c1c306f7..ae01d8861 100644 --- a/man/tm_g_scatterplot.Rd +++ b/man/tm_g_scatterplot.Rd @@ -280,13 +280,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBISqDC0ogT+uLpetHCk1Ky6ALz2Ts62AGTpuu7Rvv6BzgAepMwRUd6x8UkpLhlZOd55hETURIKMqLQEANYyZdGVCckOtUoAxLpSEGrUuvxQpFC6cIWwqCJK84sGxlzUAPpbUDabC0tGugDutKQAFirsR5EgSrrZno1w7NOipMStjEUEDeAGEAPIAJh2unBEKUAF8gUo0KhoSobn5gXMztUnq9dHwhCJRNVCcIxJi3m9SDB9hJ9mEFuQOq1SJSqW9qFB6HBZsl-ABlAhMmTrIikGG3IhdMQRfEcwq4s77FYldSkBmoOAEdkct5HaDwar+WFyrF63SiXnaiXJK0iDSa7W6i26Lk8vm6QXWjS6LQsWjckSIM2uqkEKUyknJf2MQP0ET7CPSggUo7AYAmyH+AC6OciOv8xAsZX8glQi16-jkclw8td9ptcH4xuaJbw9YtMGEmnWemSADEAIIAGQFzjr5tdJlohWb1WHY9cU45QIttc7uiG2MWKuKzEdoi1hZXVINsH7XrApo7p7ejd9dp9GqPzs3HPdvNbAuffoDQbgENbzDN5kyjapY3jRMwNTURHjODMszhMA8wLPw23CPAr3LSs4GrDc7ypB9yBbfkwBwqAq2AkDu2oXsRAXUdx0nEDTFnedByY5cwzXPUCItf4iEYfZ6G3I49zVQ9jxdDlzyNMibxYhtfyfB0X2k98qU-T1vTUv84wAoClLDGCxAg-8EzgJNI1gmTXXTTNr2zFD800jlCzAAAFLkyFLMA7FYLU-LsdwFngXysKLEhMMiMsK0ovCwF4njjOUtSON0AA5RwRxHVKux7Wg+0Ypd8r1Gc51I3RF3HTTkqpfi9VEWgAC8rNEpVd1VA91LfQi5MvJDQzSm1qmIp0T1Y7Tv1-SDDOGkybLMmMLOgpa4IcoaXLQqL21i8j4qomsyo5YiMri3CFtdWj6MvGqJzctjKpK2rCPqt5Go5RgiEufYTHUWJOqgCSeomuz9TOQ1Bqc5CTstFT4bUsHHumsifz0ubLKMx7TOjfSoKs3H4MWRCYdzfNdA87yoAi-aAqCyL-NCmkKFIfC4fvZ8Muy3KOYJQris40rHoqjL7rqzdPvDFo-oB20d2B7r1WR-rIYvVtFM04ixufFWpu5L80dm1bAKugT1vMgzLOslM0wQxyb1Qyn0Op2mr3pxK6eZ8K2aSqWLTOqqebyx6bqKhiheYkX2Kq8W3sl+teKBIFaBMXR2BUZl1W0L4a10F4sVEe4IFYId0HYFEABJvEiKurUYHRAQRJQwHhHMgA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBISqDC0ogT+uLpetHCk1Ky6ALz2Ts62AGTpuu7Rvv6BzgAepMwRUd6x8UkpLhlZOd55hETURIKMqLQEANYyZdGVCckOtUoAxLoAwgAiAJIAypO6-FCkULpwhbCoIkorawbGXNQA+vtQNnur60a6AO60pAAWKuznkSBKutmejXDsEDEpGIrUYigg3wAgtN5gAZQ7ZaFwpQAX3BACsiCoTr1WKI3tdbLd+HATFBhKQTgR+KECCdMdjcaJgNB4PjznIALpKJRoVAIlSPPwQ5bXarvL66PhCESiarS4RiYXfb6kGAnCQnMKrcgdVqkZUq77UKD0ODUar+eYEHUyHZEUhTJ5YghiCKSo2FcXXE6bErqSmiVBwAiGo3fc6svTJfxI2HukXh3Sic0hx3JFMiDRa4Ohj1J3Qms0WmNgeapjS6LQsWimkSIBMFlUEZ1dMTVauMWv0ERU1uu9nXYDAWMw+NgTmcyJ5sCQgDirjwun8ACEALJYADSWAAjGVVxvtwAmfxyOS4fNJzNpuD8S2zheNptSim0HbR3QAMUhsPmzgviYFiYtCFLe1Tfr+riAUa4JJuel66EMoprL6xTMNmQYhmG4aRrAH6jsieAId816VhmFaBrm2FJkW5r3uWWaOp23b1k+TYti67bJMxdZwH2nGDmsw4EeOk7Tn4D6LpEB5bru+5gOusknmAZ4Ac+yYUWBpaKdue5EdB4YwK+77gT+f5qc+wGgXeyQQX+xG6LB4bwQZIJEIwJz0Eh5yof6GFUQ5uHwPecZseGpHphpjE5lhDnGqadGlgxaZVjWvENvp6kcW2crcWlPZ8dlA7UQW5zCbOY7+GJcXNhJ85ScuCmHnJS4yce8lYJCkwNf4WDOHOswAPIAHJ6U5TYuepEVabow2OLCsIWU2RnUJoJm2WZ-41VZM12VBE0IZN4W0AAXnxXneihfroZRsUGRG1xRiFlWZQWEXVBFMV5vdKq0SWjXJZWPEFRlS0FkVXGpV2vH8TlBJCSOFWEWJugzvV8k6S1qk1dNNmNejr3LcZIimZBYNJjteN7Q540qkdRqMEQdwnGSrqRT510Bl9JUPWsT2lqFhPhRRH0UdzNV-fRIvA6xQtJhDuVQyxhX9kqZWI4LKMzpjynSWAnXdR1-VDaNp7029ml43NC3k4ZxMfntttGpTpP2T9tPfOb3wgiz6ixJdUC+Td4s-UF+FI+OTtRSl5HRZh33qZLSXS-lstR97quKzLKsCfDUDlZrU6oxJOsdV1PX68bI1jV7wuMTN1uLTVK1rSTG1k9tIG7ZtNOHfmTnguCtAmLo7AqLqAbaP8Z66J8IqiC8ECsJC6DsHyAAk3iRBvKaMDoYKokoYAopyQA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_g_scatterplotmatrix.Rd b/man/tm_g_scatterplotmatrix.Rd index ec2645a59..ecd6434f4 100644 --- a/man/tm_g_scatterplotmatrix.Rd +++ b/man/tm_g_scatterplotmatrix.Rd @@ -188,13 +188,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CmlCkmgRw-ri6XrRwpNSsugC89k7OihAAxLpSEGrUuvyBULpwAB6wqCJK+aSFRrpc1AD6VVA2lQUGxgDutKQAFirszeEgSrq6xOakjFGiHXkFGCbM8H4QY2O0-AnjfmAAIq54uv4AYlhhx2AAknYX-s4AyndgAAq3R-4A4ucfYAByABlngAhQ7hfwAxzPACC7zkuFG6wkRB0jAg8DI2xM6lIREYq3W6wI7AATOEyboKQBGcm03Q0+nhBkk+GIwnUKD0ODUWaJYn+ACyJBYBF6rGeWDgqEE9DoBH8qUJrLW6w5EAkgigUga2JgtFiWJxeIJhJ2DIAzOFLbprdbqUyrUzlabdByuTztvywJ8ZDAoMp5b8ABLckQBiVEP0WUJgRXrZ3rVBEaUczQkT3sAAc1oAbAB2cI5gAM4QALAX6SX6QyqRWqQyixgc+EAJwJsYsOCFPnsc0AVgrfb7FqLDL7Rb7rep5oppZH5Kb4Wz7cy-FQGfNGFLC4rJIwNa34Ub1sbFMbFcbk90jYbW5X-Dg9FIGb3zIwdsPlMXX4-25-C7-PdfzjONRG4MQ5maRZljgE0Ni2RIqUQccERVMYJjINgGk2bYwJgcpYLZIldgOZ4zmeG5nkeZ43meb5nkBEEwUuSEYThVCXVEWgAC89ESFCiLGdxynUPikhcIiV1YLtGFwvFSHYPCCNJUci0QEkiw08IUN0YSORCbYHBcOQVx0CBBDEpSRHYL1RD9ahqGeeB+FoQQYGeDlGCkZ4SDobIFW0qs9NEwzkhXAh-RCBy4AQ3QrNg4kjOccITmhAEHhSQLwmCgzEiSlcvH9TRSDiRI0TxGB2B0qkiyrDTwqIURSF5XSIAqqqq0zOqixXVBGCIEwem2crGEqnStMrEClAAX1SAArIgVAaABrOBWFEQYClsWoFqW1b1pNXaIBWtbdgwqYZmec7pjEZ5NgCxEjpOjh-DAkRRGeN7bt+e7Yw43Qnv2s6iEmG6Pt+L7wfCL1fu2fxrtYbD+AVVJUiUNB11qFQehNZptiGRE+CEd7tiJ4QxDguoYAaCQGlECKghkcoiFIP0LuKSmxjdbk4bAB4GfIRhmefNnpmKMJBN0LQWFoTkScSOgms59ZmgaEophxOnUDgfk0JdeZqmgeBeeuy68ElwlRG5HXn0SK2RA0LWdeVl1udyRJ-Aea2NClmW5bERAJb1-Xxl6RaQha6Xpn9hpRXDinmmAYB4ZBzCzYAXXTlcQ-tm2YozfxOygZ4JDXZ4HyfB7g-1mBhE0AjQpcf6Q7GPEH3cWKkublvBuKfPElS9LXGrpULd0bOVYKNXig1x3RG13WW4N-1YDE17wKhsexkG6hBaxfVBadxel9dTkeY9vnvefKPZdlOBA-NkfTSjlqU9BxHfu7kO49oCPtml6gFlY5h1-gnAoSd17vX8JncEhBU5TA-sjP6W91i5w0P3HY-hSK-HIr8SivxqK-For8eivxGK-FBM8VivxYRVxProWuu9aANzyskFBE9LZX1wlfI+LtTRu15l7B218-Z31EA-L++sf5-0SDfGO0iwHVAgWASG0D07Q12IVMgPRxS-GIE1KGlw+oDR6CjSRnEr4YK9Fo4qujYH6Oas8Yxg1SB0JPow+uIhG7JRQa3Rg7cMFd18aYWgfdYqDwyuwsecZR56ymhAVItATC6HYCoQWOJtCwRMroEYKpRD9AgKwaE6B2AYwACTeHCOUq2jBUSpGmkoMA0105AA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CmlCkmgRw-ri6XrRwpNSsugC89k7OihAAxLoAwgAiAJIAypm6-IFQunAAHrCoIkolpGVGulzUAPr1UDZ1pQbGAO60pAAWKuwd4SBKuroAgtn5ADK9uoxzi1Oz2Vj5y6tb+UoAvqkAVkQqrQDWcKyiY6W2TfxwJlDCpK0E-LSiBK1nF2ut2A0Hgdw6cgAukolGhUMsVIM-BBph0EsVSrgNnwhCJROiccIxMjptNSDBWhJWr9AuRGDUiOTAoxaBUSaTptQoPQ4NR0f58gRaTIGaRdDBmaywhsOVoWLRuXj0XRRKR2RzUaVWpVSMwNNTUHACOqNZqGqC9Il-GsFtKUabSaJeUaxYknSJ9aJDcaZQ7OdzefywPlnRpdHKWYqxIg7X6OQQhucQvjEhGFfQRJ9E7Rk-cGsBgNb5rawJDIXIsfa47p3S64Px0T6wDMAOKuPC6fxYGaZdvhAXOAAa-grvr9MHetBqlqSLkr1emREYz3cDcSDjnY4dJlZ9fRADEZgt8q4qw7Un7R2eOR1tRVdeoPl6jSbTR0LUG5ttY3Gd9Q6eif50gaL5bqaXI8nyVrBqGYoUPwqDnGQogxngYEahGKa6E2AAKMzdgAsjkYSds2ABqBS5HYI7zguCZJmI6JytQghwFmDHgqUBZFt+paQuEuH4TMRHZCR1oUfkVE0dhfhgHhhFieRlHUWAchXguNawXu0G5AAcmRzh2LoxjOLp2S6AA8vuuh6dkjiZHYuQWbpP7VhO-5TiI6Ibqe1bqXGtZhm6sEgT614OhBgbQSGHpimmUYoa5cb0TmjGpvKUbsalnH5oWzb7P4Zb+dWgXkGuMnWm2ikzGRR7VdkACaNHoRy7maNO3nJLR1ZLiu2mzs43W-ru5WHsevlxhe55blN0xTakqS0CYujsCodKPtocA2LYkz2qIIwQKwMzoOwcIACTeOE51OowOiMKkhxKGAhyQkAA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_missing_data.Rd b/man/tm_missing_data.Rd index a758b5a85..42a0303c7 100644 --- a/man/tm_missing_data.Rd +++ b/man/tm_missing_data.Rd @@ -113,13 +113,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBKMtPzOAB6kzP64ul60cKTUrLoAvPZOzrYAZJm67rG+-ozUUBASUTHe8YkpaS6KEADEulIQatS6cKGwqCK6-FCkUEr9gwbGXNQA+iNQNsMDUGO6AO60pAAWKuwz0SBKurme3r6toqTE1ESM9fu6UPz8k9CiS2YWmtahtnsQBwehwFE3RE7FEnkm3BIEnYX2iJkuV3YIlKGxhtgAVLlzLQTOwAIzRDAABgArIS8QB2OTUgC6SwAcgBBW7-W4AXyUtx8tBeRl03NEtxg5xYvOMwoIos5v35QVEwDpfOK6ES7AF0Xuj2e9QOEtFCqWyp6HD1jFEGoeTygoh1ulN8uA-gIrGo-hpiuM1owJnUpER9uAjsILrdNNtAaDUhYoaWXp9Gn9IrNgf8UcYofqbJu0HQSxUaz8MpmNR2QoEwjENT4QhEokLf10pBgkxgPNEKgk0wWcxl9XqON0atUzEsOhs31uok2EFYjPQ7DQqAAJN4Negl2DGDprkoORAwGyaUA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBKMtPzOAB6kzP64ul60cKTUrLoAvPZOzrYAZJm67rG+-ozUUBASUTHe8YkpaS6KEADEugDCACIAkgDKzbpwobCoIrr8UKRQSiNjBsZc1AD6k1A2E6NQ07oA7rSkABYq7IvRIEq6uZ7evhBipMTURIz1pwCCrZ0AMuuML+8nui9YnU+-06SgAvvUAFZEFRzADWcFYogOq1sRmGcBMUGEpDmBH4tFEBDmUJh8MRwGg8CRizkAF0lEo0Kh1iptn4IKdFjVDr8+EIRKIanzhGJ2adTqQYHMYATRCoJAtVssObp6vVaCZdOwVORmJYdDZbMcVaI9hBWE90OwmQASbzRW2iGQ6B5gpRgUG0oA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_outliers.Rd b/man/tm_outliers.Rd index ff738de8d..194a8f14f 100644 --- a/man/tm_outliers.Rd +++ b/man/tm_outliers.Rd @@ -151,13 +151,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6ugDCAPIATHHV9RVNdcDACmCojLQwLKyJANZwrJ0AumONonAAjokiEOwQjETZ7LV1cooQAL7bAFZEKkMjosUZtlmHx8OsZ9cQJxydG52lL814up3dvf1PnS2bggWhYokaBHyRwIYkS0xEGjg-HYoJ6UHoIkSkOhYnOQXaHzq4zGpQI7E6AAVqFAyG9vmA7KxUHA6Z07Iw4IF4LSwFttko0KhGio8uSIJUUroALz+DK4Fp8IQicEyxXCXEtSqkGCJIiCUh0GRnTWVXR6g20GSJVHS3R0USkMWm52yoKJMKkZgaOHMskml2ummwPQywlvf0u+FwDS2qPe0S+p0Bl3U+hwPyhsAAZXT0dIulRtHRIkQ4fFyed2NoMJVBZYRYxcCxUOruJSBLArzAE1J5MIJAIrLAglQQWGgLk8vLFcqcfI-FtnRHY5ZeAjAZgwk0kRDugAYgBBAAyWecU5nppMtFCSNth5Prmnye2FZfLsnEYIgTgEiIPS-SQ2jK9qOuugbuqEnrqKQPrRkmFYpNA8CLp2nznjOV7UOQjC2ph2GwX6T4VqitYkehF5VjWtqgtQghNpRbYZB2XY9nWjCiAAJHOSIfkRybcQuMo0XRzY4mc7YdKhRLdiSbGcQJvEXpUm5YbQO62g4LhgZUb4Brppr6W+2zbLQJi6OwKjYdB2hwDYtjlOWoiFBArAHug7CChxgi0KUnnTIwOiMNsOxKGAOxjEAA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXQBBHwCAGWTdRkaWpQBfRQgAKyIVNIBrOFZRCtzbfP44EyhhUjSCflpRAjTB4bGJ4Gh4Scy5AF03CAWNNK0WUTSoflFqNoOxdgAxWmpyRnZ1hxcVVEaDiHEywGACjAnWaUJOJyq6wwl1IREYcgxShujFEbQIJSGBDEaVEcBEGjg-HY2NoUHoIhWBNoRKOuQhUJhcIRpnUy2xdweT0xECUILaKmK7FqIVyugAvDLwrhpXwhCJcQrVcI3tK6qQYGkiIJSHQZJNdXVdEaTbQZNcWPLdHRRKQpRBLR7FVA0tFSMwrqJUHACG7PZ7Mq9HRymrC8Baw6TyaRHYng8tA8HQ2HPdQ6WSo2AAmS07oaXSRIgocr3dmPfjCWJHWX6XBGQ3WeF2dCY1yqiGOQBxVx4XRQgBCAFksABpLAARihGOrtY9qYp-AL9SHVfj2ZgS1ocT0Cve9WaAWcy5XdRMtCilMdp-Prhrtb6b93civdbCcAkaOZbh7UYR1nVdXc6kyH0oj9XkSSDftX2zCNYGPUduy6OMkLDW9vhkR1cJ+eDMwgz1+SbW5vxXetmUbBUbmoQRWxolkpk7SEMNjeEqn5AASNdyH4L9SNXYt1woxjmKZVjwQ4zkwG40tbn4sTBOE7C9wPI9HQBF9r3fbMDI9IzdAMvo+loExdD+VR-U0HQbFsGoa1EMoIFYep0HYEFeMEWgqh80lGB0dEeiUMBuhOIA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_t_crosstable.Rd b/man/tm_t_crosstable.Rd index a9a1354cd..0d1175647 100644 --- a/man/tm_t_crosstable.Rd +++ b/man/tm_t_crosstable.Rd @@ -159,13 +159,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsIykUPQiov64ul60cKTUrLoAvPZOzooQAMS6UhBq1Lr8UEG6cAAesKgiSgVFRrpc1AD61VA2VYVQBsYA7rSkABYq7M0RIEq6ujCkBCyinRNTM2OmRIy67Fq6KroEfoSs1OG6-lpheEcoMIf+Uiz+crajEOPjk9OMosDAWgC633NQ4hM6lIK3Yrxmnx+3zS4wAvktwe9Pv5UIxaDAWKwGgBrOCsfy-OaiTwNEQQdgQRhELpghbve5KWFpABWRBUOLxoiG7VstVZ7NxrC5-IgHI4-kRpwiErpUvOqPRmLFdzSSjQqDmKl6fie+XaiT1QVwCIEwjEBr4QlCOuedRgDVIDQIVNEoiCITgNttumowTgeSS-gAwi7ZnZgpU8EtbSUDc0GqVSMwNA1RKg4Dto97mtB4AaZW8pVnbcSRBoDaWM460xmvd7nr76P782AAMr+qu6LQsWgRuCIcLF70EPpsgjmpLdtF9p2j2jjrnNZFgSUE74RTN7A5nY5y-ywK5gG6MFXG3X18aVjRwfgGzcEfaH493M8X54wYSaCp6JIOFyvt9dBWfgZBvA0-2cAC3xMWgSjApIADEAEEABlW1cc9vRhLCoOeeIknjRNk2rdNM0w20c1gH9zlXKNyOeK9SArDsUxrMjAJ9P0A3OdsyyYqdew9Ac6I4kcxwnLsexnMT5zEbkgmXWjfg3XYH23aUwBOQ8Dx3I84FuMB7lw+tGPg84tJEwCP2oL8RANZC0MgodbRguDb0Q1D0Oc3RsNtXyfKWNI0loEw1hUchiO0T17l0R5LwGCBWCQ9B2HVAASbwInS4lGB0Rg0nhCAwFhb4gA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsIykUPQiov64ul60cKTUrLoAvPZOzooQAMS6AMIAIgCSAMpZuvxQQbpwAB6wqCJKpeVGulzUAPoNUDb1ZVAGxgDutKQAFirsHREgSrq6AII5BQAyfbqM80tKAL5pAFZEKq0A1nCsouM9tk38cCZQwqStBPy0ogStewfHp8DQ8GcdcgAukolGhUCsVEM-BAZh1EiUerhpro+EJQvDUcIxNCZjNSDBWg8CIwiKJREEQnAcbiZtRgnBqPD-FkSWT7ME6nhkTTKvCOq0qqRmBpWqJUHACNSabCer89El-OtFuFudLRAyJaR4eqRCKxRKpdLafTGQqwAUNRpdFoWLQOXBECqYUbcQRhvsCGJ4TbGHbKY93bRPf8esBgIqFsqwIDARFRIJ6OqtUkzBZNNYAbops6XbjaPxeU0AIQ29Bxc5BCIqYYyIaiCLUIgSIPcdgARjkEUl-hyZTg4V0-gACgB5Ap5AAaGgHw7Hk+opH8cjSuZp7lIgkYEHYcpDQTkwHzlUBK9X2yROZdOs1cH4TLAWRHjgAcg4AJpO1co+60Wry5IuBeX5EIw1zuHeSQOIBqpGiYtCVLe8IAGKzIsBSuJeNKnlhQHSvEST8oKwoPPq3aYbiHRyveSqflelrJro156uKZFfnS9AMveFq6lqPp+iIjpcuRNJuh6XpJHx9oBmJe5QGGEYbNGsaMQmSbwqmlgZhcWYwS6R4rKWtQcBMugvBgtwaCBDZNi21DtsuulGuum7bruFZQAeR4no5uLnj5MxMeQEGDuazgTrRuYwD+f7Iah6G4bmcEIcFKFoRhubYbimWnmkaS0CYujsCo5DEdoVLLjpzqiKMECsLM6DsGCAAk3gRM16qMDojBpJsShgJsgJAA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } diff --git a/man/tm_variable_browser.Rd b/man/tm_variable_browser.Rd index b36911ed4..752c4c83d 100644 --- a/man/tm_variable_browser.Rd +++ b/man/tm_variable_browser.Rd @@ -104,13 +104,13 @@ if (interactive()) { \describe{ \item{example-1}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsKKoLADWdBBw-ri6XrRwpNSsugC89k7OtgBkGbruMb7+ABakMNQA7rT8UqSikdHecQnJqS6Z2bne+WAAVqIkdOS1MQ2JKQ4tSgDEulLhsrr8UKRQunAAHrCoIkoLSwbGXNQA+jtQNtuLy0a65aQFKuwnUSBKuro+tKJ7b4wfL7owpAILE+VwBQMYNQgr1KRHgUKuMLhfxMUFotzM1C+KLRBQxfwAwgB5ABMXyJxKUAF9FBAlGhUF8VGi-FD5hcmo8-nwhCJPilucIxCzXq9ioctCxaFB6CJDkwiKVRDJhSLXtRpXBMSl-AA1SXSkS6eWKmT+P6vGkWpQ02gmXTsFTkZiWHQ2WzPVmiO4QVgAQXQ7HpABJvFFg0rGDpGDTKUowJSALpAA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsKKoLADWdBBw-ri6XrRwpNSsugC89k7OtgBkGbruMb7+ABakMNQA7rT8UqSikdHecQnJqS6Z2bne+WAAVqIkdOS1MQ2JKQ4tSgDEugDCACIAkgDK07pwAB6wqCK6-FCkUEp0TCwcgSFhcIoQu-sGxlzUAPo3UDZKL3e65aQFKuwvURASl0ugAgrNFgAZT6McFQ4Fg2Z2OzOGHg5GuCAAXyuXSIKkewTgrFE-z2UFsRh2cBMUGEpEeBH4tFEBEeeIJRJJwGg8FJLzkAF0lEo0KhPipaKQ-BAQR8UgCEXwhCJRE1lcIxDKQSDio8tCxaFB6CJHkwiKVRDJtTqQdRjXBqE1-AA1Q3G7bmy0yfwIkFXf1KK60Ey6dgqcjMSw6Gy2IGy3SiX4QVig9DsMUAEm8USzVsYOkYVyxSjAWMFQA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} + \if{html}{\out{}} + \if{html}{\out{}} } } } From c5c744d677a7c3811a4d912171cbc4187e5fea23 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 15 Nov 2024 11:54:21 +0100 Subject: [PATCH 09/92] remove unneeded --- R/tm_data_table.R | 34 +--------------------------------- inst/swimlane_poc.R | 1 - 2 files changed, 1 insertion(+), 34 deletions(-) diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 640e9dd07..583707288 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -283,10 +283,7 @@ ui_data_table <- function(id, tagList( teal.widgets::get_dt_rows(ns("data_table"), ns("dt_rows")), - div( - actionButton(ns("apply_brush_filter"), "Apply filter"), - actionButton(ns("remove_brush_filter"), "Remove applied filter") - ), + div(actionButton(ns("apply_brush_filter"), "Apply filter")), fluidRow( teal.widgets::optionalSelectInput( ns("variables"), @@ -370,34 +367,5 @@ srv_data_table <- function(id, shinyjs::hide("apply_brush_filter") set_filter_state(filter_panel_api, slice) }) - - states_list <- reactive({ - as.list(get_filter_state(filter_panel_api)) - }) - - observeEvent(input$remove_brush_filter, { - remove_filter_state( - filter_panel_api, - teal_slices( - teal_slice( - dataname = "ADSL", - varname = "USUBJID", - id = "brush_filter" - ) - ) - ) - }) - - observeEvent(states_list(), { - brushed_states <- Filter( - function(state) state$id == "brush_filter", - states_list() - ) - if (length(brushed_states)) { - shinyjs::show("remove_brush_filter") - } else { - shinyjs::hide("remove_brush_filter") - } - }) }) } diff --git a/inst/swimlane_poc.R b/inst/swimlane_poc.R index f08269830..770d495be 100644 --- a/inst/swimlane_poc.R +++ b/inst/swimlane_poc.R @@ -2,7 +2,6 @@ pkgload::load_all("teal") pkgload::load_all("teal.widgets") pkgload::load_all("teal.modules.general") - # Example data data <- within(teal_data(), { library(dplyr) From 67d4a5c309b1d3006d5f45df259bd01062b0b58d Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Tue, 19 Nov 2024 11:45:14 +0100 Subject: [PATCH 10/92] wip --- R/tm_p_swimlane.R | 69 ++++++++++++++++++++++++++++----------------- inst/swimlane_poc.R | 32 ++++++++++++++++----- 2 files changed, 68 insertions(+), 33 deletions(-) diff --git a/R/tm_p_swimlane.R b/R/tm_p_swimlane.R index d1a668fa2..249abbdc4 100644 --- a/R/tm_p_swimlane.R +++ b/R/tm_p_swimlane.R @@ -1,15 +1,12 @@ -tm_p_swimlane <- function(label = "Swimlane Plot Module", dataname, id_var, avisit_var, shape_var, color_var) { +tm_p_swimlane <- function(label = "Swimlane Plot Module", geom_specs, title, color_manual, shape_manual, size_manual) { module( label = label, ui = ui_p_swimlane, server = srv_p_swimlane, - datanames = "synthetic_data", + datanames = "all", server_args = list( - dataname = dataname, - id_var = id_var, - avisit_var = avisit_var, - shape_var = shape_var, - color_var = color_var + geom_specs = geom_specs, title = title, + color_manual = color_manual, shape_manual = shape_manual, size_manual = size_manual ) ) } @@ -22,30 +19,44 @@ ui_p_swimlane <- function(id) { ) } -srv_p_swimlane <- function(id, data, dataname, id_var, avisit_var, shape_var, color_var, filter_panel_api) { +srv_p_swimlane <- function(id, + data, + geom_specs, + title = "Swimlane plot", + color_manual, + shape_manual, + size_manual, + filter_panel_api) { moduleServer(id, function(input, output, session) { - output_q <- reactive({ - within(data(), - { - p <- ggplot(dataname, aes(x = avisit_var, y = subjid)) + - ggtitle("Swimlane Efficacy Table") + - geom_line(linewidth = 0.5) + - geom_point(aes(shape = shape_var), size = 5) + - geom_point(aes(color = color_var), size = 2) + - scale_shape_manual(values = c("Drug A" = 1, "Drug B" = 2)) + - scale_color_manual(values = c("CR" = "#9b59b6", "PR" = "#3498db")) + - labs(x = "Study Day", y = "Subject ID") - }, - dataname = as.name(dataname), - id_var = as.name(id_var), - avisit_var = as.name(avisit_var), - shape_var = as.name(shape_var), - color_var = as.name(color_var) + ggplot_call <- reactive({ + plot_call <- bquote(ggplot2::ggplot()) + points_calls <- lapply(geom_specs, function(x) { + # todo: convert $geom, $data, and $mapping elements from character to language + # others can be kept as character + basic_call <- as.call( + c( + list( + x$geom, + mapping = as.call(c(as.name("aes"), x$mapping)) + ), + x[!names(x) %in% c("geom", "mapping")] + ) + ) + }) + + title_call <- substitute(ggtitle(title), list(title = title)) + + rhs <- Reduce( + x = c(plot_call, points_calls, title_call), + f = function(x, y) call("+", x, y) ) + substitute(p <- rhs, list(rhs = rhs)) }) + output_q <- reactive(eval_code(data(), ggplot_call())) + plot_r <- reactive(output_q()$p) - pws <- teal.widgets::plot_with_settings_srv(id = "myplot", plot_r = plot_r) + pws <- teal.widgets::plot_with_settings_srv(id = "myplot", plot_r = plot_r, gg2plotly = FALSE) teal::srv_brush_filter( "brush_filter", @@ -55,3 +66,9 @@ srv_p_swimlane <- function(id, data, dataname, id_var, avisit_var, shape_var, co ) }) } + + + +merge_selectors2 <- function() { + lappl +} diff --git a/inst/swimlane_poc.R b/inst/swimlane_poc.R index 770d495be..34e6e4562 100644 --- a/inst/swimlane_poc.R +++ b/inst/swimlane_poc.R @@ -36,14 +36,32 @@ app <- init( modules = modules( tm_data_table(), tm_p_swimlane( - dataname = "synthetic_data", - id_var = "usubjid", - avisit_var = "study_day", - shape_var = "assigned_drug", - color_var = "response_type" + label = "Swimlane", + geom_specs = list( + list( + geom = str2lang("ggplot2::geom_col"), + data = quote(synthetic_data), + mapping = list(y = quote(subjid), x = quote(max(study_day))), + width = 0.2 + ), # geom_col(data = synthetic_data, mapping = aes(x = subjid, x = max(study_day), width = 0.2) + list( + geom = quote(geom_point), + data = quote(synthetic_data), + mapping = list( + y = quote(subjid), x = quote(study_day), color = quote(assigned_drug), shape = quote(assigned_drug) + ) + ), + list( + geom = quote(geom_point), + data = quote(synthetic_data), + mapping = list( + y = quote(subjid), x = quote(study_day), color = quote(response_type), shape = quote(response_type) + ) + ) + ), + title = "Swimlane Efficacy Plot" ) - ), - title = "Swimlane Efficacy Plot" + ) ) shinyApp(app$ui, app$server) From 70d077244dd159dc1d55ae877d9a8eff17e91b7b Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Tue, 19 Nov 2024 11:55:00 +0100 Subject: [PATCH 11/92] quick fix --- R/tm_p_swimlane.R | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/R/tm_p_swimlane.R b/R/tm_p_swimlane.R index 249abbdc4..2ca46af7e 100644 --- a/R/tm_p_swimlane.R +++ b/R/tm_p_swimlane.R @@ -1,4 +1,9 @@ -tm_p_swimlane <- function(label = "Swimlane Plot Module", geom_specs, title, color_manual, shape_manual, size_manual) { +tm_p_swimlane <- function(label = "Swimlane Plot Module", + geom_specs, + title, + color_manual = NULL, + shape_manual = NULL, + size_manual = NULL) { module( label = label, ui = ui_p_swimlane, @@ -56,7 +61,7 @@ srv_p_swimlane <- function(id, output_q <- reactive(eval_code(data(), ggplot_call())) plot_r <- reactive(output_q()$p) - pws <- teal.widgets::plot_with_settings_srv(id = "myplot", plot_r = plot_r, gg2plotly = FALSE) + pws <- teal.widgets::plot_with_settings_srv(id = "myplot", plot_r = plot_r) teal::srv_brush_filter( "brush_filter", From 2e49a7a843a05b0ca2e68472743e6a4052222aaf Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Tue, 19 Nov 2024 12:28:11 +0100 Subject: [PATCH 12/92] generalise to enable faceting --- R/tm_p_swimlane.R | 10 +++++----- inst/swimlane_poc.R | 6 +++++- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/R/tm_p_swimlane.R b/R/tm_p_swimlane.R index 2ca46af7e..97ce99822 100644 --- a/R/tm_p_swimlane.R +++ b/R/tm_p_swimlane.R @@ -38,13 +38,13 @@ srv_p_swimlane <- function(id, points_calls <- lapply(geom_specs, function(x) { # todo: convert $geom, $data, and $mapping elements from character to language # others can be kept as character + if (!is.null(x$mapping)) { + x$mapping <- as.call(c(as.name("aes"), x$mapping)) + } basic_call <- as.call( c( - list( - x$geom, - mapping = as.call(c(as.name("aes"), x$mapping)) - ), - x[!names(x) %in% c("geom", "mapping")] + list(x$geom), + x[!names(x) %in% "geom"] ) ) }) diff --git a/inst/swimlane_poc.R b/inst/swimlane_poc.R index 34e6e4562..d06007e7e 100644 --- a/inst/swimlane_poc.R +++ b/inst/swimlane_poc.R @@ -12,7 +12,7 @@ data <- within(teal_data(), { .possible_end_days <- c(50, 60, 70) # Create sample data - synthetic_data <- tibble(subjid = c(1:15)) |> + synthetic_data <- tibble(subjid = c(1:15), strata = rep(c("category 1", "category 2"), length.out = 15)) |> rowwise() |> mutate( max_study_day = sample(.possible_end_days, 1), @@ -57,6 +57,10 @@ app <- init( mapping = list( y = quote(subjid), x = quote(study_day), color = quote(response_type), shape = quote(response_type) ) + ), + list( + geom = quote(facet_wrap), + facets = quote(vars(strata)) ) ), title = "Swimlane Efficacy Plot" From 4038ba8d48d6b4547858c4b17c21fe3866b97b20 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Tue, 19 Nov 2024 13:09:58 +0100 Subject: [PATCH 13/92] dummy adam example --- inst/poc_adam.r | 69 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 69 insertions(+) create mode 100644 inst/poc_adam.r diff --git a/inst/poc_adam.r b/inst/poc_adam.r new file mode 100644 index 000000000..c0ca7ae3b --- /dev/null +++ b/inst/poc_adam.r @@ -0,0 +1,69 @@ +pkgload::load_all("teal") +pkgload::load_all("teal.widgets") +pkgload::load_all("teal.modules.general") + +# Example data +data <- within(teal_data(), { + library(dplyr) + library(tidyr) + ADSL <- teal.data::rADSL |> mutate( + EOTSTT2 = case_when( + !is.na(DCSREAS) ~ DCSREAS, + TRUE ~ EOTSTT + ) + ) + + ADAE <- teal.data::rADAE + ADRS <- teal.data::rADRS +}) + +join_keys(data) <- default_cdisc_join_keys + +app <- init( + data = data, + modules = modules( + tm_data_table(), + tm_p_swimlane( + label = "Swimlane", + geom_specs = list( + list( + geom = quote(geom_col), + data = quote(ADSL), + mapping = list(y = quote(USUBJID), x = quote(EOSDY)), + width = 0.2 + ), # geom_col(data = synthetic_data, mapping = aes(x = subjid, x = max(study_day), width = 0.2) + list( + geom = quote(geom_point), + data = quote(ADSL), + mapping = list( + y = quote(USUBJID), x = quote(EOSDY), color = quote(EOTSTT2), shape = quote(EOTSTT2) + ) + ), + list( + geom = quote(geom_point), + data = quote(ADRS), + mapping = list( + y = quote(USUBJID), x = quote(ADY), color = quote(PARAMCD), shape = quote(PARAMCD) + ) + ), + list( + geom = quote(geom_point), + data = quote(ADAE), + mapping = list( + y = quote(USUBJID), x = quote(ASTDY), color = quote(AETERM), shape = quote(AETERM) + ) + ), + list( + geom = quote(geom_point), + data = quote(ADAE), + mapping = list( + y = quote(USUBJID), x = quote(AENDY), color = quote(AEOUT), shape = quote(AEOUT) + ) + ) + ), + title = "Swimlane Efficacy Plot" + ) + ) +) + +shinyApp(app$ui, app$server) From 06bf0a4bcbe3cef27f2991d26fa8ce0bf6448c7a Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 19 Nov 2024 20:13:40 +0530 Subject: [PATCH 14/92] feat: add example using the poc data --- R/tm_p_swimlane.R | 16 ++----- inst/poc_crf.R | 112 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 115 insertions(+), 13 deletions(-) create mode 100644 inst/poc_crf.R diff --git a/R/tm_p_swimlane.R b/R/tm_p_swimlane.R index 97ce99822..e0c9481a8 100644 --- a/R/tm_p_swimlane.R +++ b/R/tm_p_swimlane.R @@ -1,17 +1,12 @@ -tm_p_swimlane <- function(label = "Swimlane Plot Module", - geom_specs, - title, - color_manual = NULL, - shape_manual = NULL, - size_manual = NULL) { +tm_p_swimlane <- function(label = "Swimlane Plot Module", geom_specs, title) { module( label = label, ui = ui_p_swimlane, server = srv_p_swimlane, datanames = "all", server_args = list( - geom_specs = geom_specs, title = title, - color_manual = color_manual, shape_manual = shape_manual, size_manual = size_manual + geom_specs = geom_specs, + title = title ) ) } @@ -28,9 +23,6 @@ srv_p_swimlane <- function(id, data, geom_specs, title = "Swimlane plot", - color_manual, - shape_manual, - size_manual, filter_panel_api) { moduleServer(id, function(input, output, session) { ggplot_call <- reactive({ @@ -72,8 +64,6 @@ srv_p_swimlane <- function(id, }) } - - merge_selectors2 <- function() { lappl } diff --git a/inst/poc_crf.R b/inst/poc_crf.R new file mode 100644 index 000000000..5836f3087 --- /dev/null +++ b/inst/poc_crf.R @@ -0,0 +1,112 @@ +pkgload::load_all("teal") +pkgload::load_all("teal.widgets") +pkgload::load_all("teal.modules.general") + +# Example data +data <- within(teal_data(), { + library(dplyr) + library(arrow) + library(forcats) + data_path <- "PATH_TO_DATA" + + swimlane_ds <- read_parquet(file.path(data_path, "swimlane_ds.parquet")) |> + filter(!is.na(event_result), !is.na(event_study_day)) |> + mutate(subject = forcats::fct_reorder(as.factor(subject), event_study_day, .fun = max)) + disposition <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "disposition") |> + transmute(subject, event_type, catagory = event_result, study_day = event_study_day) + + response_assessment <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "response_assessment") |> + transmute(subject, event_type, catagory = event_result, study_day = event_study_day) + + study_drug_administration <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "study_drug_administration") |> + transmute(subject, event_type, catagory = event_result, study_day = event_study_day) + + max_subject_day <- swimlane_ds |> + group_by(subject) |> + summarise(max_study_day = max(event_study_day)) +}) + +color_manual <- c( + "DEATH" = "black", + "WITHDRAWAL BY SUBJECT" = "grey", + "PD (Progressive Disease)" = "red", + "SD (Stable Disease)" = "darkorchid4", + "MR (Minimal/Minor Response)" = "sienna4", + "PR (Partial Response)" = "maroon", + "VGPR (Very Good Partial Response)" = "chartreuse4", + "CR (Complete Response)" = "#3a41fc", + "SCR (Stringent Complete Response)" = "midnightblue" +) +shape_manual <- c( + "DEATH" = 4, + "WITHDRAWAL BY SUBJECT" = 5, + "PD (Progressive Disease)" = 8, + "SD (Stable Disease)" = 5, + "MR (Minimal/Minor Response)" = 5, + "PR (Partial Response)" = 5, + "VGPR (Very Good Partial Response)" = 5, + "CR (Complete Response)" = 5, + "SCR (Stringent Complete Response)" = 5 +) + +app <- init( + data = data, + modules = modules( + tm_data_table(), + tm_p_swimlane( + label = "Swimlane", + geom_specs = list( + list( + geom = str2lang("ggplot2::geom_bar"), + data = quote(max_subject_day), + mapping = list(y = quote(subject), x = quote(max_study_day)), + stat = "identity", + width = 0.1 + ), + list( + geom = quote(geom_point), + data = quote(study_drug_administration), + mapping = list( + y = quote(subject), x = quote(study_day), color = quote(catagory), shape = quote(catagory) + ) + ), + list( + geom = quote(geom_point), + data = quote(disposition), + mapping = list( + y = quote(subject), x = quote(study_day), color = quote(catagory), shape = quote(catagory) + ) + ), + list( + geom = quote(geom_point), + data = quote(response_assessment), + mapping = list( + y = quote(subject), x = quote(study_day), color = quote(catagory), shape = quote(catagory) + ) + ), + list( + geom = quote(scale_color_manual), + values = color_manual, + breaks = names(color_manual) + ), + list( + geom = quote(scale_shape_manual), + values = shape_manual, + breaks = names(shape_manual) + ), + list( + geom = quote(theme_minimal) + ) + ), + title = "Swimlane Efficacy Plot" + ) + ) +) + +shinyApp(app$ui, app$server) From b9e03c25946229348fc4517e63e715724193a734 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Thu, 21 Nov 2024 09:42:08 +0100 Subject: [PATCH 15/92] WIP plotly --- R/tm_p_swimlane2.r | 45 ++++++++++++++++++++++++++++++++++++++++++ inst/poc_adam_plotly.r | 41 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 86 insertions(+) create mode 100644 R/tm_p_swimlane2.r create mode 100644 inst/poc_adam_plotly.r diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r new file mode 100644 index 000000000..e426114c5 --- /dev/null +++ b/R/tm_p_swimlane2.r @@ -0,0 +1,45 @@ +tm_p_swimlane2 <- function(label = "Swimlane Plot Module", plotly_specs, title) { + module( + label = label, + ui = ui_p_swimlane2, + server = srv_p_swimlane2, + datanames = "all", + server_args = list( + plotly_specs = plotly_specs, + title = title + ) + ) +} + + +ui_p_swimlane2 <- function(id) { + ns <- NS(id) + shiny::tagList( + plotly::plotlyOutput(ns("plot")), + verbatimTextOutput(ns("selecting")), + shinyjs::hidden(tableOutput(ns("table"))) + ) +} + +srv_p_swimlane2 <- function(id, + data, + plotly_specs, + title = "Swimlane plot", + filter_panel_api) { + moduleServer(id, function(input, output, session) { + plotly_q <- reactive({ + code <- substitute( + p <- plotly_specs |> plotly::event_register("plotly_selecting"), + list(plotly_specs = plotly_specs) + ) + eval_code(data(), code = code) + }) + + output$plot <- plotly::renderPlotly(plotly_q()$p) + + output$selecting <- renderPrint({ + d <- plotly::event_data("plotly_selecting") + if (is.null(d)) "Brush points appear here (double-click to clear)" else d + }) + }) +} diff --git a/inst/poc_adam_plotly.r b/inst/poc_adam_plotly.r new file mode 100644 index 000000000..15889f5af --- /dev/null +++ b/inst/poc_adam_plotly.r @@ -0,0 +1,41 @@ +pkgload::load_all("teal") +pkgload::load_all("teal.widgets") +pkgload::load_all("teal.modules.general") + +# Example data +data <- within(teal_data(), { + library(dplyr) + library(tidyr) + ADSL <- teal.data::rADSL |> mutate( + EOTSTT2 = case_when( + !is.na(DCSREAS) ~ DCSREAS, + TRUE ~ EOTSTT + ) + ) + + ADAE <- teal.data::rADAE + ADRS <- teal.data::rADRS +}) + +join_keys(data) <- default_cdisc_join_keys + +plotly_specs <- quote( + plotly::plot_ly() |> + plotly::add_bars(x = ~EOSDY, y = ~USUBJID, data = ADSL) |> + plotly::add_markers(x = ~EOSDY, y = ~USUBJID, data = ADSL) |> + plotly::add_markers(x = ~ADY, y = ~USUBJID, data = ADRS) +) + +app <- init( + data = data, + modules = modules( + tm_data_table(), + tm_p_swimlane2( + label = "Swimlane", + plotly_specs = plotly_specs, + title = "Swimlane Efficacy Plot" + ) + ) +) + +shinyApp(app$ui, app$server) From 32ee42fa1a5e4ac9db277a69d4afbfaff2c0bb9c Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Thu, 21 Nov 2024 10:05:17 +0100 Subject: [PATCH 16/92] plotly_specs as simple list --- R/tm_p_swimlane2.r | 27 +++++++++++++++++++++++++-- inst/poc_adam_plotly.r | 11 ++++++----- 2 files changed, 31 insertions(+), 7 deletions(-) diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index e426114c5..8757ad4a0 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -28,9 +28,10 @@ srv_p_swimlane2 <- function(id, filter_panel_api) { moduleServer(id, function(input, output, session) { plotly_q <- reactive({ + plotly_call <- .make_plotly_call(specs = plotly_specs) code <- substitute( - p <- plotly_specs |> plotly::event_register("plotly_selecting"), - list(plotly_specs = plotly_specs) + p <- plotly_call %>% plotly::event_register("plotly_selecting"), + list(plotly_call = plotly_call) ) eval_code(data(), code = code) }) @@ -43,3 +44,25 @@ srv_p_swimlane2 <- function(id, }) }) } + + + +.make_plotly_call <- function(init_call = quote(plotly::plot_ly()), specs) { + points_calls <- lapply(specs, function(x) { + which_fun <- c(which(names(x) == "fun"), 1)[1] + if (is.character(x[[which_fun]])) { + x[[which_fun]] <- str2lang(x[[which_fun]]) + } + basic_call <- as.call( + c( + list(x[[which_fun]]), + x[-which_fun] + ) + ) + }) + + rhs <- Reduce( + x = c(init_call, points_calls), + f = function(x, y) call("%>%", x, y) + ) +} diff --git a/inst/poc_adam_plotly.r b/inst/poc_adam_plotly.r index 15889f5af..6b5ef312d 100644 --- a/inst/poc_adam_plotly.r +++ b/inst/poc_adam_plotly.r @@ -19,13 +19,14 @@ data <- within(teal_data(), { join_keys(data) <- default_cdisc_join_keys -plotly_specs <- quote( - plotly::plot_ly() |> - plotly::add_bars(x = ~EOSDY, y = ~USUBJID, data = ADSL) |> - plotly::add_markers(x = ~EOSDY, y = ~USUBJID, data = ADSL) |> - plotly::add_markers(x = ~ADY, y = ~USUBJID, data = ADRS) + +plotly_specs <- list( + list("plotly::add_bars", x = ~EOSDY, y = ~USUBJID, data = quote(ADSL)), + list("plotly::add_markers", x = ~EOSDY, y = ~USUBJID, color = ~EOTSTT2, data = quote(ADSL)), + list("plotly::add_markers", x = ~ADY, y = ~USUBJID, data = quote(ADRS)) ) + app <- init( data = data, modules = modules( From 4321350415bdb96db064f144344db7a096f2814d Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Thu, 21 Nov 2024 11:55:25 +0100 Subject: [PATCH 17/92] data_table as a brushing table --- R/tm_data_table.R | 15 ++++++++++----- R/tm_p_swimlane2.r | 40 +++++++++++++++++++++++++++++++++------- 2 files changed, 43 insertions(+), 12 deletions(-) diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 583707288..96b0345ca 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -181,11 +181,16 @@ ui_page_data_table <- function(id, # Server page module srv_page_data_table <- function(id, data, - datasets_selected, - variables_selected, - dt_args, - dt_options, - server_rendering, + variables_selected = list(), + datasets_selected = character(0), + dt_args = list(), + dt_options = list( + searching = FALSE, + pageLength = 30, + lengthMenu = c(5, 15, 30, 100), + scrollX = TRUE + ), + server_rendering = FALSE, filter_panel_api) { checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index 8757ad4a0..1b5f08944 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -16,8 +16,7 @@ ui_p_swimlane2 <- function(id) { ns <- NS(id) shiny::tagList( plotly::plotlyOutput(ns("plot")), - verbatimTextOutput(ns("selecting")), - shinyjs::hidden(tableOutput(ns("table"))) + ui_page_data_table(ns("brush_tables")) ) } @@ -30,17 +29,44 @@ srv_p_swimlane2 <- function(id, plotly_q <- reactive({ plotly_call <- .make_plotly_call(specs = plotly_specs) code <- substitute( - p <- plotly_call %>% plotly::event_register("plotly_selecting"), + p <- plotly_call, list(plotly_call = plotly_call) ) eval_code(data(), code = code) }) - output$plot <- plotly::renderPlotly(plotly_q()$p) + output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) - output$selecting <- renderPrint({ - d <- plotly::event_data("plotly_selecting") - if (is.null(d)) "Brush points appear here (double-click to clear)" else d + + brush_filter_call <- reactive({ + d <- plotly::event_data("plotly_selected") + req(d) + calls <- lapply(plotly_specs, function(spec) { + substitute( + dataname <- dplyr::filter(dataname, var_x %in% levels_x, var_y %in% levels_y), + list( + dataname = spec$data, + var_x = str2lang(all.vars(spec$x)), + var_y = str2lang(all.vars(spec$y)), + levels_x = d$x, + levels_y = d$y + ) + ) + }) + unique(calls) + }) + + brush_filtered_data <- reactive({ + if (is.null(brush_filter_call())) { + shinyjs::hide("brush_tables") + } else { + shinyjs::hide("show_tables") + eval_code(plotly_q(), as.expression(brush_filter_call())) + } + }) + + observeEvent(brush_filtered_data(), once = TRUE, { + srv_page_data_table("brush_tables", data = brush_filtered_data, filter_panel_api = filter_panel_api) }) }) } From 4137aa1f687e8c98877fd2ecc8b6f9f2da8bc9bd Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Thu, 21 Nov 2024 16:33:08 +0100 Subject: [PATCH 18/92] hide table when not brushed --- R/tm_p_swimlane2.r | 9 ++++++--- inst/poc_adam_plotly.r | 17 +++++++++-------- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index 1b5f08944..bb1580697 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -16,7 +16,10 @@ ui_p_swimlane2 <- function(id) { ns <- NS(id) shiny::tagList( plotly::plotlyOutput(ns("plot")), - ui_page_data_table(ns("brush_tables")) + shinyjs::hidden(div( + id = ns("brushing_wrapper"), + ui_page_data_table(ns("brush_tables")) + )) ) } @@ -58,9 +61,9 @@ srv_p_swimlane2 <- function(id, brush_filtered_data <- reactive({ if (is.null(brush_filter_call())) { - shinyjs::hide("brush_tables") + shinyjs::hide("brushing_wrapper") } else { - shinyjs::hide("show_tables") + shinyjs::show("brushing_wrapper") eval_code(plotly_q(), as.expression(brush_filter_call())) } }) diff --git a/inst/poc_adam_plotly.r b/inst/poc_adam_plotly.r index 6b5ef312d..673595d01 100644 --- a/inst/poc_adam_plotly.r +++ b/inst/poc_adam_plotly.r @@ -1,5 +1,4 @@ -pkgload::load_all("teal") -pkgload::load_all("teal.widgets") +library(plotly) pkgload::load_all("teal.modules.general") # Example data @@ -10,7 +9,8 @@ data <- within(teal_data(), { EOTSTT2 = case_when( !is.na(DCSREAS) ~ DCSREAS, TRUE ~ EOTSTT - ) + ), + TRTLEN = as.integer(TRTEDTM - TRTSDTM) ) ADAE <- teal.data::rADAE @@ -21,21 +21,22 @@ join_keys(data) <- default_cdisc_join_keys plotly_specs <- list( - list("plotly::add_bars", x = ~EOSDY, y = ~USUBJID, data = quote(ADSL)), - list("plotly::add_markers", x = ~EOSDY, y = ~USUBJID, color = ~EOTSTT2, data = quote(ADSL)), - list("plotly::add_markers", x = ~ADY, y = ~USUBJID, data = quote(ADRS)) + list("plotly::add_bars", x = ~TRTLEN, y = ~USUBJID, color = ~ARM, data = quote(ADSL)), + list("plotly::add_markers", x = ~ADY, y = ~USUBJID, color = ~AVALC, symbol = ~AVALC, data = quote(ADRS)) ) - app <- init( data = data, modules = modules( tm_data_table(), - tm_p_swimlane2( + tm_p_plotly( label = "Swimlane", plotly_specs = plotly_specs, title = "Swimlane Efficacy Plot" ) + ), + filter = teal_slices( + teal_slice("ADSL", "AGE", selected = c(20, 25)) ) ) From f1b5d51dc596f8b1335eb659ae0c8654dc350f20 Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 21 Nov 2024 22:06:35 +0530 Subject: [PATCH 19/92] feat: allow the user to pass custom colors and symbols --- R/tm_p_swimlane2.r | 16 ++++--- inst/poc_crf.R | 103 ++++++++++++++++----------------------------- 2 files changed, 47 insertions(+), 72 deletions(-) diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index bb1580697..32d66a121 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -1,4 +1,4 @@ -tm_p_swimlane2 <- function(label = "Swimlane Plot Module", plotly_specs, title) { +tm_p_swimlane2 <- function(label = "Swimlane Plot Module", plotly_specs, title, colors = c(), symbols = c()) { module( label = label, ui = ui_p_swimlane2, @@ -6,7 +6,9 @@ tm_p_swimlane2 <- function(label = "Swimlane Plot Module", plotly_specs, title) datanames = "all", server_args = list( plotly_specs = plotly_specs, - title = title + title = title, + colors = colors, + symbols = symbols ) ) } @@ -27,10 +29,12 @@ srv_p_swimlane2 <- function(id, data, plotly_specs, title = "Swimlane plot", + colors, + symbols, filter_panel_api) { moduleServer(id, function(input, output, session) { plotly_q <- reactive({ - plotly_call <- .make_plotly_call(specs = plotly_specs) + plotly_call <- .make_plotly_call(specs = plotly_specs, colors = colors, symbols = symbols) code <- substitute( p <- plotly_call, list(plotly_call = plotly_call) @@ -76,20 +80,20 @@ srv_p_swimlane2 <- function(id, -.make_plotly_call <- function(init_call = quote(plotly::plot_ly()), specs) { +.make_plotly_call <- function(specs, colors = c(), symbols = c()) { + init_call <- substitute(plotly::plot_ly(colors = colors, symbols = symbols), list(colors = colors, symbols = symbols)) points_calls <- lapply(specs, function(x) { which_fun <- c(which(names(x) == "fun"), 1)[1] if (is.character(x[[which_fun]])) { x[[which_fun]] <- str2lang(x[[which_fun]]) } - basic_call <- as.call( + as.call( c( list(x[[which_fun]]), x[-which_fun] ) ) }) - rhs <- Reduce( x = c(init_call, points_calls), f = function(x, y) call("%>%", x, y) diff --git a/inst/poc_crf.R b/inst/poc_crf.R index 5836f3087..ecfe2c59b 100644 --- a/inst/poc_crf.R +++ b/inst/poc_crf.R @@ -2,7 +2,8 @@ pkgload::load_all("teal") pkgload::load_all("teal.widgets") pkgload::load_all("teal.modules.general") -# Example data +# Note: Please add the `PATH_TO_DATA` and change the X, Y, and Z Administrations to the actual values in the data + data <- within(teal_data(), { library(dplyr) library(arrow) @@ -32,79 +33,49 @@ data <- within(teal_data(), { summarise(max_study_day = max(event_study_day)) }) -color_manual <- c( - "DEATH" = "black", - "WITHDRAWAL BY SUBJECT" = "grey", - "PD (Progressive Disease)" = "red", - "SD (Stable Disease)" = "darkorchid4", - "MR (Minimal/Minor Response)" = "sienna4", - "PR (Partial Response)" = "maroon", - "VGPR (Very Good Partial Response)" = "chartreuse4", - "CR (Complete Response)" = "#3a41fc", - "SCR (Stringent Complete Response)" = "midnightblue" -) -shape_manual <- c( - "DEATH" = 4, - "WITHDRAWAL BY SUBJECT" = 5, - "PD (Progressive Disease)" = 8, - "SD (Stable Disease)" = 5, - "MR (Minimal/Minor Response)" = 5, - "PR (Partial Response)" = 5, - "VGPR (Very Good Partial Response)" = 5, - "CR (Complete Response)" = 5, - "SCR (Stringent Complete Response)" = 5 +plotly_specs <- list( + list("plotly::add_markers", x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, data = quote(study_drug_administration)), + list("plotly::add_markers", x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, data = quote(response_assessment)), + list("plotly::add_markers", x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, data = quote(disposition)), + list("plotly::add_bars", x = ~max_study_day, y = ~subject, data = quote(max_subject_day), width = 0.1, marker = list(color = "grey"), showlegend = FALSE) ) app <- init( data = data, modules = modules( tm_data_table(), - tm_p_swimlane( + tm_p_swimlane2( label = "Swimlane", - geom_specs = list( - list( - geom = str2lang("ggplot2::geom_bar"), - data = quote(max_subject_day), - mapping = list(y = quote(subject), x = quote(max_study_day)), - stat = "identity", - width = 0.1 - ), - list( - geom = quote(geom_point), - data = quote(study_drug_administration), - mapping = list( - y = quote(subject), x = quote(study_day), color = quote(catagory), shape = quote(catagory) - ) - ), - list( - geom = quote(geom_point), - data = quote(disposition), - mapping = list( - y = quote(subject), x = quote(study_day), color = quote(catagory), shape = quote(catagory) - ) - ), - list( - geom = quote(geom_point), - data = quote(response_assessment), - mapping = list( - y = quote(subject), x = quote(study_day), color = quote(catagory), shape = quote(catagory) - ) - ), - list( - geom = quote(scale_color_manual), - values = color_manual, - breaks = names(color_manual) - ), - list( - geom = quote(scale_shape_manual), - values = shape_manual, - breaks = names(shape_manual) - ), - list( - geom = quote(theme_minimal) - ) + plotly_specs = plotly_specs, + title = "Swimlane Efficacy Plot", + colors = c( + "DEATH" = "black", + "WITHDRAWAL BY SUBJECT" = "grey", + "PD (Progressive Disease)" = "red", + "SD (Stable Disease)" = "darkorchid4", + "MR (Minimal/Minor Response)" = "sienna4", + "PR (Partial Response)" = "maroon", + "VGPR (Very Good Partial Response)" = "chartreuse4", + "CR (Complete Response)" = "#3a41fc", + "SCR (Stringent Complete Response)" = "midnightblue", + "X Administration Injection" = "goldenrod", + "Y Administration Infusion" = "deepskyblue3", + "Z Administration Infusion" = "darkorchid" ), - title = "Swimlane Efficacy Plot" + symbols = c( + "DEATH" = "circle", + "WITHDRAWAL BY SUBJECT" = "square", + "PD (Progressive Disease)" = "circle", + "SD (Stable Disease)" = "square-open", + "MR (Minimal/Minor Response)" = "star-open", + "PR (Partial Response)" = "star-open", + "VGPR (Very Good Partial Response)" = "star-open", + "CR (Complete Response)" = "star-open", + "SCR (Stringent Complete Response)" = "star-open", + "X Administration Injection" = "line-ns-open", + "Y Administration Infusion" = "line-ns-open", + "Z Administration Infusion" = "line-ns-open" + ) ) ) ) From 780924c78509a09a1505817518b36c218482b99b Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 22 Nov 2024 16:01:33 +0530 Subject: [PATCH 20/92] feat: reproduce the osprey example --- inst/poc_osprey.R | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 inst/poc_osprey.R diff --git a/inst/poc_osprey.R b/inst/poc_osprey.R new file mode 100644 index 000000000..02630dd6c --- /dev/null +++ b/inst/poc_osprey.R @@ -0,0 +1,44 @@ +pkgload::load_all("teal") +pkgload::load_all("teal.widgets") +pkgload::load_all("teal.modules.general") + +data <- within(teal_data(), { + library(dplyr) + library(osprey) + + ADSL <- osprey::rADSL[1:20, ] + ADRS <- filter(rADRS, PARAMCD == "OVRINV") +}) + +plotly_specs <- list( + list( + "plotly::add_bars", + data = quote(ADSL), + x = ~ as.integer(TRTEDTM - TRTSDTM), y = ~USUBJID, color = ~ARM, + colors = c("A: Drug X" = "#343CFF", "B: Placebo" = "#FF484B", "C: Combination" = "#222222") + ), + list( + "plotly::add_markers", + data = quote(left_join(ADSL, ADRS)), + x = ~ADY, y = ~USUBJID, symbol = ~AVALC, + marker = list( + size = 10, + color = "#329133" + ) + ) +) + +app <- init( + data = data, + modules = modules( + tm_data_table(), + tm_p_swimlane2( + label = "Swimlane", + plotly_specs = plotly_specs, + title = "Swimlane Efficacy Plot", + symbols = c("CR" = "circle", "PR" = "triangle-up", "SD" = "diamond-wide", "PD" = "square", "NE" = "x-thin-open") + ) + ) +) + +shinyApp(app$ui, app$server) From ea559d3a47c546f80243e8bb69727fd9b9769062 Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 22 Nov 2024 16:22:05 +0530 Subject: [PATCH 21/92] fix: filter using teal.slice and not during data creation --- inst/poc_osprey.R | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/inst/poc_osprey.R b/inst/poc_osprey.R index 02630dd6c..255969014 100644 --- a/inst/poc_osprey.R +++ b/inst/poc_osprey.R @@ -6,20 +6,23 @@ data <- within(teal_data(), { library(dplyr) library(osprey) - ADSL <- osprey::rADSL[1:20, ] - ADRS <- filter(rADRS, PARAMCD == "OVRINV") + ADSL <- osprey::rADSL |> + mutate(x_val = as.integer(TRTEDTM - TRTSDTM)) + ADRS <- osprey::rADRS }) +join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADRS")] + plotly_specs <- list( list( "plotly::add_bars", data = quote(ADSL), - x = ~ as.integer(TRTEDTM - TRTSDTM), y = ~USUBJID, color = ~ARM, + x = ~x_val, y = ~USUBJID, color = ~ARM, colors = c("A: Drug X" = "#343CFF", "B: Placebo" = "#FF484B", "C: Combination" = "#222222") ), list( "plotly::add_markers", - data = quote(left_join(ADSL, ADRS)), + data = quote(ADRS), x = ~ADY, y = ~USUBJID, symbol = ~AVALC, marker = list( size = 10, @@ -30,6 +33,18 @@ plotly_specs <- list( app <- init( data = data, + filter = teal_slices( + teal_slice( + "ADSL", + "AGE", + selected = c(20, 23) + ), + teal_slice( + "ADRS", + "PARAMCD", + selected = "OVRINV" + ) + ), modules = modules( tm_data_table(), tm_p_swimlane2( From 21eff43e9117daea4859d4cc83139cb475be3715 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Fri, 22 Nov 2024 11:26:05 +0000 Subject: [PATCH 22/92] rename srv_page_data_table to srv_data_table --- R/tm_data_table.R | 99 +++++++++++++++++++++++++++------------------- R/tm_p_swimlane2.r | 4 +- 2 files changed, 60 insertions(+), 43 deletions(-) diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 96b0345ca..dd8897ed7 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -125,8 +125,8 @@ tm_data_table <- function(label = "Data Table", ans <- module( label, - server = srv_page_data_table, - ui = ui_page_data_table, + server = srv_data_table, + ui = ui_data_table, datanames = if (length(datasets_selected) == 0) "all" else datasets_selected, server_args = list( variables_selected = variables_selected, @@ -145,7 +145,7 @@ tm_data_table <- function(label = "Data Table", } # UI page module -ui_page_data_table <- function(id, +ui_data_table <- function(id, pre_output = NULL, post_output = NULL) { ns <- NS(id) @@ -168,7 +168,7 @@ ui_page_data_table <- function(id, class = "mb-8", column( width = 12, - uiOutput(ns("dataset_table")) + uiOutput(ns("data_tables")) ) ) ), @@ -179,7 +179,7 @@ ui_page_data_table <- function(id, } # Server page module -srv_page_data_table <- function(id, +srv_data_table <- function(id, data, variables_selected = list(), datasets_selected = character(0), @@ -199,24 +199,38 @@ srv_page_data_table <- function(id, if_filtered <- reactive(as.logical(input$if_filtered)) if_distinct <- reactive(as.logical(input$if_distinct)) - - datanames <- isolate(names(data())) - datanames <- Filter(function(name) { - is.data.frame(isolate(data())[[name]]) - }, datanames) - - if (!identical(datasets_selected, character(0))) { - checkmate::assert_subset(datasets_selected, datanames) - datanames <- datasets_selected - } - - output$dataset_table <- renderUI({ + + datanames <- reactive({ + df_datanames <- Filter( + function(name) is.data.frame(isolate(data())[[name]]), + names(data()) + ) + if (!identical(datasets_selected, character(0))) { + missing_datanames <- setdiff(datasets_selected, df_datanames) + if (length(missing_datanames)) { + shiny::showNotification( + sprintf( + "Some datasets specified `datasets_selected` are missing or are not inheriting from data.frame, those are: %s", + toString(missing_datanames) + ) + ) + } + df_datanames <- intersect(datasets_selected, df_datanames) + } + + df_datanames + }) + + + + output$data_tables <- renderUI({ + req(datanames()) do.call( tabsetPanel, c( list(id = session$ns("dataname_tab")), lapply( - datanames, + datanames(), function(x) { dataset <- isolate(data()[[x]]) choices <- names(dataset) @@ -241,7 +255,7 @@ srv_page_data_table <- function(id, width = 12, div( class = "mt-4", - ui_data_table( + ui_dataset_table( id = session$ns(x), choices = choices, selected = variables_selected @@ -254,28 +268,34 @@ srv_page_data_table <- function(id, ) ) }) - - lapply( - datanames, - function(x) { - srv_data_table( - id = x, - data = data, - dataname = x, - if_filtered = if_filtered, - if_distinct = if_distinct, - dt_args = dt_args, - dt_options = dt_options, - server_rendering = server_rendering, - filter_panel_api = filter_panel_api - ) - } - ) + + # server should be run only once + modules_run <- reactiveVal() + modules_to_run <- reactive(setdiff(datanames(), modules_run())) + observeEvent(modules_to_run(), { + lapply( + modules_to_run(), + function(dataname) { + srv_dataset_table( + id = dataname, + data = data, + dataname = dataname, + if_filtered = if_filtered, + if_distinct = if_distinct, + dt_args = dt_args, + dt_options = dt_options, + server_rendering = server_rendering, + filter_panel_api = filter_panel_api + ) + } + ) + modules_run(union(modules_run(), modules_to_run())) + }) }) } # UI function for the data_table module -ui_data_table <- function(id, +ui_dataset_table <- function(id, choices, selected) { ns <- NS(id) @@ -306,7 +326,7 @@ ui_data_table <- function(id, } # Server function for the data_table module -srv_data_table <- function(id, +srv_dataset_table <- function(id, data, dataname, if_filtered, @@ -358,9 +378,6 @@ srv_data_table <- function(id, if (is.null(input$data_table_rows_selected)) { return(NULL) } - # isolate({ - # foo1(brush, selector_list) - # }) dataset <- data()[[dataname]][input$data_table_rows_selected, ] # todo: when added another time then it is duplicated slice <- teal_slices(teal_slice( diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index 32d66a121..7bf5ac2b8 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -20,7 +20,7 @@ ui_p_swimlane2 <- function(id) { plotly::plotlyOutput(ns("plot")), shinyjs::hidden(div( id = ns("brushing_wrapper"), - ui_page_data_table(ns("brush_tables")) + ui_data_table(ns("brush_tables")) )) ) } @@ -73,7 +73,7 @@ srv_p_swimlane2 <- function(id, }) observeEvent(brush_filtered_data(), once = TRUE, { - srv_page_data_table("brush_tables", data = brush_filtered_data, filter_panel_api = filter_panel_api) + srv_data_table("brush_tables", data = brush_filtered_data, filter_panel_api = filter_panel_api) }) }) } From ea67bd0d6faf2898f1466f07731cbb96e9fa7d9d Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 22 Nov 2024 17:16:24 +0530 Subject: [PATCH 23/92] feat: add refrence lines + filter unwanted data --- inst/poc_osprey.R | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/inst/poc_osprey.R b/inst/poc_osprey.R index 255969014..078b03cdc 100644 --- a/inst/poc_osprey.R +++ b/inst/poc_osprey.R @@ -7,8 +7,12 @@ data <- within(teal_data(), { library(osprey) ADSL <- osprey::rADSL |> - mutate(x_val = as.integer(TRTEDTM - TRTSDTM)) - ADRS <- osprey::rADRS + mutate(x_val = as.integer(TRTEDTM - TRTSDTM)) |> + arrange(x_val) |> + filter(!is.na(x_val)) + ADRS <- osprey::rADRS |> + filter(ADY >= 0, USUBJID %in% ADSL$USUBJID) + reference_lines <- data.frame(x = c(50, 250), xend = c(50, 250), y = min(ADSL$USUBJID), yend = max(ADSL$USUBJID)) }) join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADRS")] @@ -28,6 +32,20 @@ plotly_specs <- list( size = 10, color = "#329133" ) + ), + list( + "plotly::add_segments", + data = quote(reference_lines), + x = ~x, + xend = ~xend, + y = ~y, + yend = ~yend, + line = list( + color = "#CA0E40", + width = 2, + dash = "dash" + ), + showlegend = FALSE ) ) @@ -37,7 +55,7 @@ app <- init( teal_slice( "ADSL", "AGE", - selected = c(20, 23) + selected = c(24, 25) ), teal_slice( "ADRS", From f913acbf02ef242044d1a1a0d0f3fbd4594c50cf Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 22 Nov 2024 13:18:38 +0100 Subject: [PATCH 24/92] display brushed only --- R/tm_p_swimlane2.r | 6 +++++- inst/poc_osprey.R | 2 -- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index 7bf5ac2b8..67a93d793 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -68,7 +68,11 @@ srv_p_swimlane2 <- function(id, shinyjs::hide("brushing_wrapper") } else { shinyjs::show("brushing_wrapper") - eval_code(plotly_q(), as.expression(brush_filter_call())) + q <- eval_code(plotly_q(), as.expression(brush_filter_call())) + module_datanames <- unique(lapply(plotly_specs, function(x) deparse(x$data))) + is_brushed <- sapply(module_datanames, function(x) is.data.frame(q[[x]]) && nrow(q[[x]])) + brushed_datanames <- unique(unlist(module_datanames[is_brushed])) + q[brushed_datanames] # we want to show brushed datanames only } }) diff --git a/inst/poc_osprey.R b/inst/poc_osprey.R index 078b03cdc..b254c43de 100644 --- a/inst/poc_osprey.R +++ b/inst/poc_osprey.R @@ -1,5 +1,3 @@ -pkgload::load_all("teal") -pkgload::load_all("teal.widgets") pkgload::load_all("teal.modules.general") data <- within(teal_data(), { From 7d5bc89ad5933ffda44580eeac5a936cbf77a274 Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 28 Nov 2024 07:48:02 +0530 Subject: [PATCH 25/92] push local changes --- R/tm_p_swimlane2.r | 65 ++++++--------- inst/poc_crf.R | 194 ++++++++++++++++++++++++++++++++++++++------- 2 files changed, 189 insertions(+), 70 deletions(-) diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index 67a93d793..f6403d797 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -1,27 +1,32 @@ -tm_p_swimlane2 <- function(label = "Swimlane Plot Module", plotly_specs, title, colors = c(), symbols = c()) { +tm_p_swimlane2 <- function( + label = "Swimlane Plot Module", plotly_specs, title, + colors = c(), symbols = c(), transformers = list(), + ui_mod = ui_data_table, + srv_mod = srv_data_table) { module( label = label, ui = ui_p_swimlane2, server = srv_p_swimlane2, datanames = "all", + ui_args = list(ui_mod = ui_mod), server_args = list( plotly_specs = plotly_specs, title = title, colors = colors, - symbols = symbols - ) + symbols = symbols, + srv_mod = srv_mod + ), + transformers = transformers ) } -ui_p_swimlane2 <- function(id) { +ui_p_swimlane2 <- function(id, ui_mod) { ns <- NS(id) shiny::tagList( - plotly::plotlyOutput(ns("plot")), - shinyjs::hidden(div( - id = ns("brushing_wrapper"), - ui_data_table(ns("brush_tables")) - )) + sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, 800), + plotly::plotlyOutput(ns("plot"), height = "100%"), + ui_mod(ns("brush_tables")) ) } @@ -31,6 +36,7 @@ srv_p_swimlane2 <- function(id, title = "Swimlane plot", colors, symbols, + srv_mod, filter_panel_api) { moduleServer(id, function(input, output, session) { plotly_q <- reactive({ @@ -42,42 +48,17 @@ srv_p_swimlane2 <- function(id, eval_code(data(), code = code) }) - output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) - - - brush_filter_call <- reactive({ - d <- plotly::event_data("plotly_selected") - req(d) - calls <- lapply(plotly_specs, function(spec) { - substitute( - dataname <- dplyr::filter(dataname, var_x %in% levels_x, var_y %in% levels_y), - list( - dataname = spec$data, - var_x = str2lang(all.vars(spec$x)), - var_y = str2lang(all.vars(spec$y)), - levels_x = d$x, - levels_y = d$y - ) - ) - }) - unique(calls) + output$plot <- plotly::renderPlotly({ + plotly::event_register( + plotly_q()$p |> layout(height = input$plot_height), + "plotly_selected" + ) }) - brush_filtered_data <- reactive({ - if (is.null(brush_filter_call())) { - shinyjs::hide("brushing_wrapper") - } else { - shinyjs::show("brushing_wrapper") - q <- eval_code(plotly_q(), as.expression(brush_filter_call())) - module_datanames <- unique(lapply(plotly_specs, function(x) deparse(x$data))) - is_brushed <- sapply(module_datanames, function(x) is.data.frame(q[[x]]) && nrow(q[[x]])) - brushed_datanames <- unique(unlist(module_datanames[is_brushed])) - q[brushed_datanames] # we want to show brushed datanames only - } - }) + plotly_selected <- reactive(plotly::event_data("plotly_selected")) - observeEvent(brush_filtered_data(), once = TRUE, { - srv_data_table("brush_tables", data = brush_filtered_data, filter_panel_api = filter_panel_api) + observeEvent(plotly_selected(), once = TRUE, { + srv_mod("brush_tables", data = data, filter_panel_api = filter_panel_api, plotly_selected = plotly_selected) }) }) } diff --git a/inst/poc_crf.R b/inst/poc_crf.R index ecfe2c59b..5e96c9209 100644 --- a/inst/poc_crf.R +++ b/inst/poc_crf.R @@ -1,6 +1,8 @@ pkgload::load_all("teal") pkgload::load_all("teal.widgets") pkgload::load_all("teal.modules.general") +library(DT) +library(labelled) # Note: Please add the `PATH_TO_DATA` and change the X, Y, and Z Administrations to the actual values in the data @@ -12,42 +14,155 @@ data <- within(teal_data(), { swimlane_ds <- read_parquet(file.path(data_path, "swimlane_ds.parquet")) |> filter(!is.na(event_result), !is.na(event_study_day)) |> - mutate(subject = forcats::fct_reorder(as.factor(subject), event_study_day, .fun = max)) - disposition <- swimlane_ds |> - filter(!is.na(event_study_day)) |> - filter(event_type == "disposition") |> - transmute(subject, event_type, catagory = event_result, study_day = event_study_day) - - response_assessment <- swimlane_ds |> - filter(!is.na(event_study_day)) |> - filter(event_type == "response_assessment") |> - transmute(subject, event_type, catagory = event_result, study_day = event_study_day) - - study_drug_administration <- swimlane_ds |> - filter(!is.na(event_study_day)) |> - filter(event_type == "study_drug_administration") |> - transmute(subject, event_type, catagory = event_result, study_day = event_study_day) - - max_subject_day <- swimlane_ds |> - group_by(subject) |> - summarise(max_study_day = max(event_study_day)) + mutate(subject = as.character(subject)) |> + mutate( + plot_subject = case_when( + event_type == "disposition" ~ paste0(subject, " - Disposition"), + event_type == "response_assessment" ~ paste0(subject, " - Response Assessment"), + event_type == "study_drug_administration" ~ paste0(subject, " - Drug Administration"), + TRUE ~ as.character(subject) + ) + ) |> + group_by(subject_group = sub(" - .*", "", plot_subject)) |> + mutate(max_event_day = max(event_study_day)) |> + ungroup() |> + mutate( + plot_subject = forcats::fct_reorder(plot_subject, max_event_day, .fun = max) + ) |> + select(-subject_group, -max_event_day) + + spiderplot_ds <- read_parquet(file.path(data_path, "spiderplot_ds.parquet")) |> + mutate(subject = as.character(subject)) }) -plotly_specs <- list( - list("plotly::add_markers", x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, data = quote(study_drug_administration)), - list("plotly::add_markers", x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, data = quote(response_assessment)), - list("plotly::add_markers", x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, data = quote(disposition)), - list("plotly::add_bars", x = ~max_study_day, y = ~subject, data = quote(max_subject_day), width = 0.1, marker = list(color = "grey"), showlegend = FALSE) + +swim_plotly_specs <- list( + list("plotly::add_markers", x = ~study_day, y = ~plot_subject, color = ~catagory, symbol = ~catagory, data = quote(study_drug_administration)), + list("plotly::add_markers", x = ~study_day, y = ~plot_subject, color = ~catagory, symbol = ~catagory, data = quote(response_assessment)), + list("plotly::add_markers", x = ~study_day, y = ~plot_subject, color = ~catagory, symbol = ~catagory, data = quote(disposition)), + list("plotly::add_lines", x = ~study_day, y = ~plot_subject, data = quote(max_subject_day), color = ~plot_subject, line = list(width = 1, color = "grey"), showlegend = FALSE), + list("plotly::layout", xaxis = list(title = "Study Day"), yaxis = list(title = "Subject")) +) + +tm <- teal_transform_module( + server = function(id, data) { + reactive({ + data() |> + within({ + disposition <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "disposition") |> + transmute(plot_subject, event_type, catagory = event_result, study_day = event_study_day) + + response_assessment <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "response_assessment") |> + transmute(plot_subject, event_type, catagory = event_result, study_day = event_study_day) + + study_drug_administration <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "study_drug_administration") |> + transmute(plot_subject, event_type, catagory = event_result, study_day = event_study_day) + + max_subject_day <- swimlane_ds |> + group_by(plot_subject) |> + summarise(study_day = max(event_study_day)) |> + bind_rows(tibble(plot_subject = unique(swimlane_ds$plot_subject), study_day = 0)) + }) + }) + } +) + +ui_mod <- function(id) { + ns <- NS(id) + fluidRow( + column(6, DTOutput(ns("mm_response"))), + column(6, DTOutput(ns("tx_listing"))) + ) +} + +srv_mod <- function(id, + data, + plotly_selected, + filter_panel_api) { + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") + moduleServer(id, function(input, output, session) { + output$test <- renderText({ + print(plotly_selected) + "It works!" + }) + + output$mm_response <- renderDT({ + select_cols <- c( + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", + "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts" + ) + new_col_names <- setNames( + select_cols, + c( + "Subject", "Visit Name", "Visit Date", "Form Name", "Source System URL Link", + "Assessment Performed", "Response Date", "Response Date Study Day", + "Response", "Best Marrow Aspirate", "Best Marrow Biopsy", "Comments" + ) + ) + swimlane_ds <- data()[["swimlane_ds"]] + mm_response <- swimlane_ds |> + filter(event_study_day %in% plotly_selected()$x, plot_subject %in% plotly_selected()$y) |> + select(all_of(select_cols)) + datatable(mm_response, colnames = new_col_names) + }) + + output$tx_listing <- renderDT({ + select_cols <- c( + "site_name", "subject", "visit_name", "visit_date", "form_name", + "source_system_url_link", "txnam", "txrec", "txrecrs", "txd_study_day", + "date_administered", "cydly", "cydlyrs", "cydlyae", "txdly", "txdlyrs", + "txdlyae", "txpdos", "txpdosu", "frqdv", "txrte", "txform", "txdmod", + "txrmod", "txdmae", "txad", "txadu", "txd", "txstm", "txstmu", "txed", + "txetm", "txetmu", "txtm", "txtmu", "txed_study_day", "infrt", "infrtu", + "tximod", "txirmod", "tximae" + ) + new_col_names <- setNames( + select_cols, + c( + "Site Name", "Subject", "Visit Name", "Visit Date", "Form Name", "Source System URL Link", + "Study Drug Name", "Study Drug Administered", "Reason Study Drug Not Admin", + "Date Administered Study Day", "Date Administered", "Cycle Delay", "Cycle Delay Reason", + "Cycle Delay Adverse Event", "Dose Delay", "Dose Delay Reason", "AE related to Dose Delay", + "Planned Dose per Admin", "Planned Dose per Admin Unit", "Frequency", "Route of Administration", + "Dose Formulation", "Dose Modification", "Dose Modification Reason", + "AE related to Dose Modification", "Total Dose Administered", "Total Dose Administered Unit", + "Date Administered", "Start Time Administered", "Start Time Administered Unknown", + "End Date Administered", "End Time Administered", "End Time Administered Unknown", + "Time Administered", "Time Administered Unknown", "End Study Day", "Infusion Rate", + "Infusion Rate Unit", "Infusion Modified?", "Reason for Infusion modification", + "AE related to Infusion Modification" + ) + ) + swimlane_ds <- data()[["swimlane_ds"]] + tx_listing <- swimlane_ds |> + filter(event_study_day %in% plotly_selected()$x, plot_subject %in% plotly_selected()$y) |> + select(all_of(select_cols)) + datatable(tx_listing, colnames = new_col_names) + }) + }) +} + +pkgload::load_all("teal.modules.general") + +spider_plotly_specs <- list( + list("plotly::add_markers", x = ~event_study_day, y = ~event_result, color = ~subject, symbol = ~event_type, data = quote(spiderplot_ds)), + list("plotly::add_lines", x = ~event_study_day, y = ~event_result, data = quote(spiderplot_ds), color = ~subject, showlegend = FALSE) ) app <- init( data = data, modules = modules( - tm_data_table(), tm_p_swimlane2( label = "Swimlane", - plotly_specs = plotly_specs, - title = "Swimlane Efficacy Plot", + plotly_specs = swim_plotly_specs, + title = "Swim Lane - Duration of Tx", colors = c( "DEATH" = "black", "WITHDRAWAL BY SUBJECT" = "grey", @@ -75,7 +190,30 @@ app <- init( "X Administration Injection" = "line-ns-open", "Y Administration Infusion" = "line-ns-open", "Z Administration Infusion" = "line-ns-open" - ) + ), + transformers = list(tm), + ui_mod = ui_mod, + srv_mod = srv_mod + ), + tm_p_swimlane2( + label = "Spiderplot", + plotly_specs = spider_plotly_specs, + title = "Swimlane Efficacy Plot" + ), + tm_data_table() + ), + filter = teal_slices( + teal_slice( + dataname = "swimlane_ds", + varname = "subject" + ), + teal_slice( + dataname = "swimlane_ds", + varname = "cohrt" + ), + teal_slice( + dataname = "swimlane_ds", + varname = "txarm" ) ) ) From 179f145c6bc924ac195d89ef0f5da30321f2ce27 Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 28 Nov 2024 08:23:23 +0530 Subject: [PATCH 26/92] export the custom module for deployment --- NAMESPACE | 1 + R/tm_p_swimlane2.r | 1 + 2 files changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 86c4c2a5a..206de3d31 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -23,6 +23,7 @@ export(tm_g_scatterplot) export(tm_g_scatterplotmatrix) export(tm_missing_data) export(tm_outliers) +export(tm_p_swimlane2) export(tm_t_crosstable) export(tm_variable_browser) import(ggmosaic) diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index f6403d797..c9ae373b6 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -1,3 +1,4 @@ +#' @export tm_p_swimlane2 <- function( label = "Swimlane Plot Module", plotly_specs, title, colors = c(), symbols = c(), transformers = list(), From e18dfc318bfedba8c1c3001eb36d71457f6b1b32 Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 28 Nov 2024 08:31:49 +0530 Subject: [PATCH 27/92] pass plotly_selected only when it is supported --- R/tm_p_swimlane2.r | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index c9ae373b6..bae58df8f 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -59,7 +59,11 @@ srv_p_swimlane2 <- function(id, plotly_selected <- reactive(plotly::event_data("plotly_selected")) observeEvent(plotly_selected(), once = TRUE, { - srv_mod("brush_tables", data = data, filter_panel_api = filter_panel_api, plotly_selected = plotly_selected) + if ("plotly_selected" %in% names(formals(srv_mod))) { + srv_mod("brush_tables", data = data, filter_panel_api = filter_panel_api, plotly_selected = plotly_selected) + } else { + srv_mod("brush_tables", data = data, filter_panel_api = filter_panel_api) + } }) }) } From b5884a2cda8153f9048a8bba28139a3a9c9bf1a8 Mon Sep 17 00:00:00 2001 From: vedhav Date: Mon, 2 Dec 2024 20:59:47 +0530 Subject: [PATCH 28/92] feat: use reactable --- inst/poc_crf.R | 161 +++++++++++++++++++++++++++++++------------------ 1 file changed, 103 insertions(+), 58 deletions(-) diff --git a/inst/poc_crf.R b/inst/poc_crf.R index 5e96c9209..80fe23ab1 100644 --- a/inst/poc_crf.R +++ b/inst/poc_crf.R @@ -3,6 +3,7 @@ pkgload::load_all("teal.widgets") pkgload::load_all("teal.modules.general") library(DT) library(labelled) +library(reactable) # Note: Please add the `PATH_TO_DATA` and change the X, Y, and Z Administrations to the actual values in the data @@ -35,7 +36,6 @@ data <- within(teal_data(), { mutate(subject = as.character(subject)) }) - swim_plotly_specs <- list( list("plotly::add_markers", x = ~study_day, y = ~plot_subject, color = ~catagory, symbol = ~catagory, data = quote(study_drug_administration)), list("plotly::add_markers", x = ~study_day, y = ~plot_subject, color = ~catagory, symbol = ~catagory, data = quote(response_assessment)), @@ -52,17 +52,17 @@ tm <- teal_transform_module( disposition <- swimlane_ds |> filter(!is.na(event_study_day)) |> filter(event_type == "disposition") |> - transmute(plot_subject, event_type, catagory = event_result, study_day = event_study_day) + transmute(subject, plot_subject, event_type, catagory = event_result, study_day = event_study_day) response_assessment <- swimlane_ds |> filter(!is.na(event_study_day)) |> filter(event_type == "response_assessment") |> - transmute(plot_subject, event_type, catagory = event_result, study_day = event_study_day) + transmute(subject, plot_subject, event_type, catagory = event_result, study_day = event_study_day) study_drug_administration <- swimlane_ds |> filter(!is.na(event_study_day)) |> filter(event_type == "study_drug_administration") |> - transmute(plot_subject, event_type, catagory = event_result, study_day = event_study_day) + transmute(subject, plot_subject, event_type, catagory = event_result, study_day = event_study_day) max_subject_day <- swimlane_ds |> group_by(plot_subject) |> @@ -76,8 +76,8 @@ tm <- teal_transform_module( ui_mod <- function(id) { ns <- NS(id) fluidRow( - column(6, DTOutput(ns("mm_response"))), - column(6, DTOutput(ns("tx_listing"))) + column(6, "MM Response", reactableOutput(ns("mm_response"))), + column(6, "", reactableOutput(ns("tx_listing"))) ) } @@ -88,69 +88,112 @@ srv_mod <- function(id, checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { - output$test <- renderText({ - print(plotly_selected) - "It works!" - }) - - output$mm_response <- renderDT({ - select_cols <- c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", - "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts" - ) - new_col_names <- setNames( - select_cols, - c( - "Subject", "Visit Name", "Visit Date", "Form Name", "Source System URL Link", - "Assessment Performed", "Response Date", "Response Date Study Day", - "Response", "Best Marrow Aspirate", "Best Marrow Biopsy", "Comments" - ) - ) + output$mm_response <- renderReactable({ swimlane_ds <- data()[["swimlane_ds"]] + col_defs <- list( + subject = colDef(name = "Subject"), + visit_name = colDef(name = "Visit Name"), + visit_date = colDef(name = "Visit Date"), + form_name = colDef(name = "Form Name"), + source_system_url_link = colDef( + name = "Source System URL Link", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), + rspdn = colDef(name = "Assessment Performed"), + rspd = colDef(name = "Response Date"), + rspd_study_day = colDef(name = "Response Date Study Day"), + orsp = colDef(name = "Response"), + bma = colDef(name = "Best Marrow Aspirate"), + bmb = colDef(name = "Best Marrow Biopsy"), + comnts = colDef(name = "Comments") + ) mm_response <- swimlane_ds |> filter(event_study_day %in% plotly_selected()$x, plot_subject %in% plotly_selected()$y) |> - select(all_of(select_cols)) - datatable(mm_response, colnames = new_col_names) + select(all_of(names(col_defs))) + reactable( + mm_response, + columns = col_defs, + defaultPageSize = 10, + searchable = TRUE, + sortable = TRUE + ) }) - output$tx_listing <- renderDT({ - select_cols <- c( - "site_name", "subject", "visit_name", "visit_date", "form_name", - "source_system_url_link", "txnam", "txrec", "txrecrs", "txd_study_day", - "date_administered", "cydly", "cydlyrs", "cydlyae", "txdly", "txdlyrs", - "txdlyae", "txpdos", "txpdosu", "frqdv", "txrte", "txform", "txdmod", - "txrmod", "txdmae", "txad", "txadu", "txd", "txstm", "txstmu", "txed", - "txetm", "txetmu", "txtm", "txtmu", "txed_study_day", "infrt", "infrtu", - "tximod", "txirmod", "tximae" - ) - new_col_names <- setNames( - select_cols, - c( - "Site Name", "Subject", "Visit Name", "Visit Date", "Form Name", "Source System URL Link", - "Study Drug Name", "Study Drug Administered", "Reason Study Drug Not Admin", - "Date Administered Study Day", "Date Administered", "Cycle Delay", "Cycle Delay Reason", - "Cycle Delay Adverse Event", "Dose Delay", "Dose Delay Reason", "AE related to Dose Delay", - "Planned Dose per Admin", "Planned Dose per Admin Unit", "Frequency", "Route of Administration", - "Dose Formulation", "Dose Modification", "Dose Modification Reason", - "AE related to Dose Modification", "Total Dose Administered", "Total Dose Administered Unit", - "Date Administered", "Start Time Administered", "Start Time Administered Unknown", - "End Date Administered", "End Time Administered", "End Time Administered Unknown", - "Time Administered", "Time Administered Unknown", "End Study Day", "Infusion Rate", - "Infusion Rate Unit", "Infusion Modified?", "Reason for Infusion modification", - "AE related to Infusion Modification" - ) - ) + output$tx_listing <- renderReactable({ swimlane_ds <- data()[["swimlane_ds"]] + + col_defs <- list( + site_name = colDef(name = "Site Name"), + subject = colDef(name = "Subject"), + visit_name = colDef(name = "Visit Name"), + visit_date = colDef(name = "Visit Date"), + form_name = colDef(name = "Form Name"), + source_system_url_link = colDef( + name = "Source System URL Link", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), + txnam = colDef(name = "Study Drug Name"), + txrec = colDef(name = "Study Drug Administered"), + txrecrs = colDef(name = "Reason Study Drug Not Admin"), + txd_study_day = colDef(name = "Date Administered Study Day"), + date_administered = colDef(name = "Date Administered"), + cydly = colDef(name = "Cycle Delay"), + cydlyrs = colDef(name = "Cycle Delay Reason"), + cydlyae = colDef(name = "Cycle Delay Adverse Event"), + txdly = colDef(name = "Dose Delay"), + txdlyrs = colDef(name = "Dose Delay Reason"), + txdlyae = colDef(name = "AE related to Dose Delay"), + txpdos = colDef(name = "Planned Dose per Admin"), + txpdosu = colDef(name = "Planned Dose per Admin Unit"), + frqdv = colDef(name = "Frequency"), + txrte = colDef(name = "Route of Administration"), + txform = colDef(name = "Dose Formulation"), + txdmod = colDef(name = "Dose Modification"), + txrmod = colDef(name = "Dose Modification Reason"), + txdmae = colDef(name = "AE related to Dose Modification"), + txad = colDef(name = "Total Dose Administered"), + txadu = colDef(name = "Total Dose Administered Unit"), + txd = colDef(name = "Date Administered"), + txstm = colDef(name = "Start Time Administered"), + txstmu = colDef(name = "Start Time Administered Unknown"), + txed = colDef(name = "End Date Administered"), + txetm = colDef(name = "End Time Administered"), + txetmu = colDef(name = "End Time Administered Unknown"), + txtm = colDef(name = "Time Administered"), + txtmu = colDef(name = "Time Administered Unknown"), + txed_study_day = colDef(name = "End Study Day"), + infrt = colDef(name = "Infusion Rate"), + infrtu = colDef(name = "Infusion Rate Unit"), + tximod = colDef(name = "Infusion Modified?"), + txirmod = colDef(name = "Reason for Infusion modification"), + tximae = colDef(name = "AE related to Infusion Modification") + ) tx_listing <- swimlane_ds |> filter(event_study_day %in% plotly_selected()$x, plot_subject %in% plotly_selected()$y) |> - select(all_of(select_cols)) - datatable(tx_listing, colnames = new_col_names) + select(all_of(names(col_defs))) + reactable( + tx_listing, + columns = col_defs, + defaultPageSize = 5, + searchable = TRUE, + sortable = TRUE + ) }) }) } -pkgload::load_all("teal.modules.general") - spider_plotly_specs <- list( list("plotly::add_markers", x = ~event_study_day, y = ~event_result, color = ~subject, symbol = ~event_type, data = quote(spiderplot_ds)), list("plotly::add_lines", x = ~event_study_day, y = ~event_result, data = quote(spiderplot_ds), color = ~subject, showlegend = FALSE) @@ -198,7 +241,9 @@ app <- init( tm_p_swimlane2( label = "Spiderplot", plotly_specs = spider_plotly_specs, - title = "Swimlane Efficacy Plot" + title = "Swimlane Efficacy Plot", + ui_mod = ui_mod, + srv_mod = srv_mod ), tm_data_table() ), From ef85449acce3713ac1863b08c90e06a1e81df9a2 Mon Sep 17 00:00:00 2001 From: vedhav Date: Mon, 2 Dec 2024 21:01:07 +0530 Subject: [PATCH 29/92] fix: avoid ns clash of layout --- R/tm_p_swimlane2.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index bae58df8f..39c20ecd1 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -51,7 +51,7 @@ srv_p_swimlane2 <- function(id, output$plot <- plotly::renderPlotly({ plotly::event_register( - plotly_q()$p |> layout(height = input$plot_height), + plotly_q()$p |> plotly::layout(height = input$plot_height), "plotly_selected" ) }) From ef8a5abdff2bba5f966db86d74cb60822eeebbfa Mon Sep 17 00:00:00 2001 From: vedhav Date: Mon, 2 Dec 2024 21:13:14 +0530 Subject: [PATCH 30/92] chore: remove local change --- inst/poc_crf.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/inst/poc_crf.R b/inst/poc_crf.R index 80fe23ab1..24dae4ab7 100644 --- a/inst/poc_crf.R +++ b/inst/poc_crf.R @@ -76,8 +76,8 @@ tm <- teal_transform_module( ui_mod <- function(id) { ns <- NS(id) fluidRow( - column(6, "MM Response", reactableOutput(ns("mm_response"))), - column(6, "", reactableOutput(ns("tx_listing"))) + column(6, reactableOutput(ns("mm_response"))), + column(6, reactableOutput(ns("tx_listing"))) ) } @@ -119,7 +119,7 @@ srv_mod <- function(id, reactable( mm_response, columns = col_defs, - defaultPageSize = 10, + defaultPageSize = 5, searchable = TRUE, sortable = TRUE ) From 0fff2a7d39ee707cb05039ae513eee7554fbc5e1 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 3 Dec 2024 22:25:08 +0530 Subject: [PATCH 31/92] feat: use main version of teal and update spiderplot module --- R/tm_p_swimlane2.r | 33 ++++--- inst/poc_crf.R | 236 +++++++++++++++++++++++++++++++++++---------- 2 files changed, 209 insertions(+), 60 deletions(-) diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index 39c20ecd1..a7fb8fa3e 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -1,31 +1,33 @@ #' @export tm_p_swimlane2 <- function( label = "Swimlane Plot Module", plotly_specs, title, - colors = c(), symbols = c(), transformers = list(), + colors = c(), symbols = c(), transformators = list(), ui_mod = ui_data_table, - srv_mod = srv_data_table) { + srv_mod = srv_data_table, + plot_height = 800) { module( label = label, ui = ui_p_swimlane2, server = srv_p_swimlane2, datanames = "all", - ui_args = list(ui_mod = ui_mod), + ui_args = list(ui_mod = ui_mod, height = plot_height), server_args = list( plotly_specs = plotly_specs, title = title, colors = colors, symbols = symbols, - srv_mod = srv_mod + srv_mod = srv_mod, + height = plot_height ), - transformers = transformers + transformators = transformators ) } -ui_p_swimlane2 <- function(id, ui_mod) { +ui_p_swimlane2 <- function(id, ui_mod, height) { ns <- NS(id) shiny::tagList( - sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, 800), + sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height), plotly::plotlyOutput(ns("plot"), height = "100%"), ui_mod(ns("brush_tables")) ) @@ -37,11 +39,17 @@ srv_p_swimlane2 <- function(id, title = "Swimlane plot", colors, symbols, + height, srv_mod, filter_panel_api) { moduleServer(id, function(input, output, session) { plotly_q <- reactive({ - plotly_call <- .make_plotly_call(specs = plotly_specs, colors = colors, symbols = symbols) + plotly_call <- .make_plotly_call( + specs = plotly_specs, + colors = colors, + symbols = symbols, + height = input$plot_height + ) code <- substitute( p <- plotly_call, list(plotly_call = plotly_call) @@ -51,7 +59,7 @@ srv_p_swimlane2 <- function(id, output$plot <- plotly::renderPlotly({ plotly::event_register( - plotly_q()$p |> plotly::layout(height = input$plot_height), + plotly_q()$p, "plotly_selected" ) }) @@ -70,8 +78,11 @@ srv_p_swimlane2 <- function(id, -.make_plotly_call <- function(specs, colors = c(), symbols = c()) { - init_call <- substitute(plotly::plot_ly(colors = colors, symbols = symbols), list(colors = colors, symbols = symbols)) +.make_plotly_call <- function(specs, colors = c(), symbols = c(), height = 800) { + init_call <- substitute( + plotly::plot_ly(colors = colors, symbols = symbols, height = height), + list(colors = colors, symbols = symbols, height = height) + ) points_calls <- lapply(specs, function(x) { which_fun <- c(which(names(x) == "fun"), 1)[1] if (is.character(x[[which_fun]])) { diff --git a/inst/poc_crf.R b/inst/poc_crf.R index 24dae4ab7..5803a4484 100644 --- a/inst/poc_crf.R +++ b/inst/poc_crf.R @@ -1,9 +1,8 @@ -pkgload::load_all("teal") -pkgload::load_all("teal.widgets") -pkgload::load_all("teal.modules.general") +library(teal) library(DT) library(labelled) library(reactable) +pkgload::load_all("teal.modules.general") # Note: Please add the `PATH_TO_DATA` and change the X, Y, and Z Administrations to the actual values in the data @@ -15,36 +14,21 @@ data <- within(teal_data(), { swimlane_ds <- read_parquet(file.path(data_path, "swimlane_ds.parquet")) |> filter(!is.na(event_result), !is.na(event_study_day)) |> - mutate(subject = as.character(subject)) |> - mutate( - plot_subject = case_when( - event_type == "disposition" ~ paste0(subject, " - Disposition"), - event_type == "response_assessment" ~ paste0(subject, " - Response Assessment"), - event_type == "study_drug_administration" ~ paste0(subject, " - Drug Administration"), - TRUE ~ as.character(subject) - ) - ) |> - group_by(subject_group = sub(" - .*", "", plot_subject)) |> - mutate(max_event_day = max(event_study_day)) |> - ungroup() |> - mutate( - plot_subject = forcats::fct_reorder(plot_subject, max_event_day, .fun = max) - ) |> - select(-subject_group, -max_event_day) + mutate(subject = forcats::fct_reorder(as.factor(subject), event_study_day, .fun = max)) spiderplot_ds <- read_parquet(file.path(data_path, "spiderplot_ds.parquet")) |> mutate(subject = as.character(subject)) }) swim_plotly_specs <- list( - list("plotly::add_markers", x = ~study_day, y = ~plot_subject, color = ~catagory, symbol = ~catagory, data = quote(study_drug_administration)), - list("plotly::add_markers", x = ~study_day, y = ~plot_subject, color = ~catagory, symbol = ~catagory, data = quote(response_assessment)), - list("plotly::add_markers", x = ~study_day, y = ~plot_subject, color = ~catagory, symbol = ~catagory, data = quote(disposition)), - list("plotly::add_lines", x = ~study_day, y = ~plot_subject, data = quote(max_subject_day), color = ~plot_subject, line = list(width = 1, color = "grey"), showlegend = FALSE), + list("plotly::add_markers", x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, data = quote(study_drug_administration)), + list("plotly::add_markers", x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, data = quote(response_assessment)), + list("plotly::add_markers", x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, data = quote(disposition)), + list("plotly::add_segments", x = ~0, xend = ~study_day, y = ~subject, yend = ~subject, data = quote(max_subject_day), line = list(width = 1, color = "grey"), showlegend = FALSE), list("plotly::layout", xaxis = list(title = "Study Day"), yaxis = list(title = "Subject")) ) -tm <- teal_transform_module( +swimlane_tm <- teal_transform_module( server = function(id, data) { reactive({ data() |> @@ -52,28 +36,28 @@ tm <- teal_transform_module( disposition <- swimlane_ds |> filter(!is.na(event_study_day)) |> filter(event_type == "disposition") |> - transmute(subject, plot_subject, event_type, catagory = event_result, study_day = event_study_day) + transmute(subject, event_type, catagory = event_result, study_day = event_study_day) response_assessment <- swimlane_ds |> filter(!is.na(event_study_day)) |> filter(event_type == "response_assessment") |> - transmute(subject, plot_subject, event_type, catagory = event_result, study_day = event_study_day) + transmute(subject, event_type, catagory = event_result, study_day = event_study_day) study_drug_administration <- swimlane_ds |> filter(!is.na(event_study_day)) |> filter(event_type == "study_drug_administration") |> - transmute(subject, plot_subject, event_type, catagory = event_result, study_day = event_study_day) + transmute(subject, event_type, catagory = event_result, study_day = event_study_day) max_subject_day <- swimlane_ds |> - group_by(plot_subject) |> + group_by(subject) |> summarise(study_day = max(event_study_day)) |> - bind_rows(tibble(plot_subject = unique(swimlane_ds$plot_subject), study_day = 0)) + bind_rows(tibble(subject = unique(swimlane_ds$subject), study_day = 0)) }) }) } ) -ui_mod <- function(id) { +swimlane_ui_mod <- function(id) { ns <- NS(id) fluidRow( column(6, reactableOutput(ns("mm_response"))), @@ -81,10 +65,10 @@ ui_mod <- function(id) { ) } -srv_mod <- function(id, - data, - plotly_selected, - filter_panel_api) { +swimlane_srv_mod <- function(id, + data, + plotly_selected, + filter_panel_api) { checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { @@ -114,7 +98,7 @@ srv_mod <- function(id, comnts = colDef(name = "Comments") ) mm_response <- swimlane_ds |> - filter(event_study_day %in% plotly_selected()$x, plot_subject %in% plotly_selected()$y) |> + filter(event_study_day %in% plotly_selected()$x, subject %in% plotly_selected()$y) |> select(all_of(names(col_defs))) reactable( mm_response, @@ -181,7 +165,7 @@ srv_mod <- function(id, tximae = colDef(name = "AE related to Infusion Modification") ) tx_listing <- swimlane_ds |> - filter(event_study_day %in% plotly_selected()$x, plot_subject %in% plotly_selected()$y) |> + filter(event_study_day %in% plotly_selected()$x, subject %in% plotly_selected()$y) |> select(all_of(names(col_defs))) reactable( tx_listing, @@ -195,13 +179,161 @@ srv_mod <- function(id, } spider_plotly_specs <- list( - list("plotly::add_markers", x = ~event_study_day, y = ~event_result, color = ~subject, symbol = ~event_type, data = quote(spiderplot_ds)), - list("plotly::add_lines", x = ~event_study_day, y = ~event_result, data = quote(spiderplot_ds), color = ~subject, showlegend = FALSE) + list("plotly::add_markers", x = ~event_study_day, y = ~event_result, color = ~subject, data = quote(spiderplot_ds_filtered)), + list("plotly::add_lines", x = ~event_study_day, y = ~event_result, data = quote(spiderplot_ds_filtered), color = ~subject, showlegend = FALSE) +) + +spiderplot_tm <- teal_transform_module( + ui = function(id) { + selectInput(NS(id, "event_type"), "Select Event type", NULL) + }, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + spiderplot_ds <- reactive(data()[["spiderplot_ds"]]) + observeEvent(spiderplot_ds(), { + event_types <- unique(spiderplot_ds()$event_type) + updateSelectInput( + inputId = "event_type", + choices = event_types[event_types != "response_assessment"] + ) + }) + reactive({ + data() |> + within( + { + spiderplot_ds_filtered <- spiderplot_ds |> + filter(event_type == selected_event) + }, + selected_event = input$event_type + ) + }) + }) + } ) +spider_ui_mod <- function(id) { + ns <- NS(id) + fluidRow( + column(6, reactableOutput(ns("recent_resp"))), + column(6, reactableOutput(ns("all_resp"))) + ) +} + +spider_srv_mod <- function(id, + data, + plotly_selected, + filter_panel_api) { + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") + moduleServer(id, function(input, output, session) { + all_resp_cols <- list( + txarm = colDef(name = "Study Arm"), + cohrt = colDef(name = "Study Cohort"), + subject = colDef(name = "Subject"), + event_result = colDef(name = "Response"), + event_study_day = colDef(name = "Study Day"), + visit_name = colDef(name = "Visit Name") + ) + + selected_recent_subject <- reactiveVal(NULL) + + all_resp <- reactive({ + if (!is.null(selected_recent_subject())) { + data()[["spiderplot_ds"]] |> + filter(event_type == "response_assessment") |> + select(all_of(names(all_resp_cols))) |> + filter(subject == selected_recent_subject()) + } else { + selected_subjects <- data()[["spiderplot_ds"]] |> + filter(event_study_day %in% plotly_selected()$x, event_result %in% plotly_selected()$y) |> + pull(subject) + data()[["spiderplot_ds"]] |> + filter(event_type == "response_assessment") |> + select(all_of(names(all_resp_cols))) |> + filter(subject %in% selected_subjects) + } + }) + + rank_response <- function(responses) { + responses <- responses[!is.na(responses)] + if (length(responses) == 0) { + return(NA_character_) + } + response_hierarchy <- c( + "SCR (Stringent Complete Response)", + "CR (Complete Response)", + "VGPR (Very Good Partial Response)", + "PR (Partial Response)", + "MR (Minimal/Minor Response)", + "SD (Stable Disease)", + "PD (Progressive Disease)" + ) + responses[which.max(match(responses, response_hierarchy))] + } + + recent_resp_cols <- list( + txarm = colDef(name = "Study Arm"), + cohrt = colDef(name = "Study Cohort"), + subject = colDef(name = "Subject"), + event_result = colDef(name = "Response"), + event_study_day = colDef(name = "Study Day"), + most_recent_response = colDef(name = "Most Recent Response"), + best_response = colDef(name = "Best Response") + ) + + output$recent_resp <- renderReactable({ + best_resp <- all_resp() %>% + group_by(subject) %>% + filter(!is.na(subject)) %>% + arrange(desc(event_study_day)) %>% + slice(1) %>% + mutate( + most_recent_response = event_result, + best_response = rank_response(all_resp()$event_result[all_resp()$subject == cur_group()]) + ) %>% + ungroup() + + reactable( + best_resp, + columns = recent_resp_cols, + selection = "single", + onClick = "select" + ) + }) + + observeEvent(input$recent_resp_selected, { + req(input$recent_resp_selected) + selected_subjects <- reactableProxy("recent_resp") %>% + getReactableState("selected") + + if (length(selected_subjects) > 0) { + selected_subject <- output$recent_resp()$subject[selected_subjects] + selected_recent_subject(selected_subject) + } + }) + + output$all_resp <- renderReactable({ + reactable( + all_resp(), + columns = all_resp_cols + ) + }) + }) +} + + app <- init( data = data, modules = modules( + tm_p_swimlane2( + label = "Spiderplot", + plotly_specs = spider_plotly_specs, + title = "Swimlane Efficacy Plot", + transformators = list(spiderplot_tm), + ui_mod = spider_ui_mod, + srv_mod = spider_srv_mod, + plot_height = 600 + ), tm_p_swimlane2( label = "Swimlane", plotly_specs = swim_plotly_specs, @@ -234,16 +366,9 @@ app <- init( "Y Administration Infusion" = "line-ns-open", "Z Administration Infusion" = "line-ns-open" ), - transformers = list(tm), - ui_mod = ui_mod, - srv_mod = srv_mod - ), - tm_p_swimlane2( - label = "Spiderplot", - plotly_specs = spider_plotly_specs, - title = "Swimlane Efficacy Plot", - ui_mod = ui_mod, - srv_mod = srv_mod + transformators = list(swimlane_tm), + ui_mod = swimlane_ui_mod, + srv_mod = swimlane_srv_mod ), tm_data_table() ), @@ -259,7 +384,20 @@ app <- init( teal_slice( dataname = "swimlane_ds", varname = "txarm" - ) + ), + teal_slice( + dataname = "spiderplot_ds", + varname = "subject" + ), + teal_slice( + dataname = "spiderplot_ds", + varname = "cohrt" + ), + teal_slice( + dataname = "spiderplot_ds", + varname = "txarm" + ), + count_type = "all" ) ) From b8a60c3c47862a93f7eba600b0960dc40f47132f Mon Sep 17 00:00:00 2001 From: vedhav Date: Wed, 4 Dec 2024 23:16:15 +0530 Subject: [PATCH 32/92] feat: update the spiderplot tables + UI enhancements + single parent --- R/tm_p_swimlane2.r | 4 +- inst/poc_crf.R | 328 +++++++++++++++++++++++++++++++++------------ 2 files changed, 246 insertions(+), 86 deletions(-) diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index a7fb8fa3e..c610912ec 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -16,8 +16,7 @@ tm_p_swimlane2 <- function( title = title, colors = colors, symbols = symbols, - srv_mod = srv_mod, - height = plot_height + srv_mod = srv_mod ), transformators = transformators ) @@ -39,7 +38,6 @@ srv_p_swimlane2 <- function(id, title = "Swimlane plot", colors, symbols, - height, srv_mod, filter_panel_api) { moduleServer(id, function(input, output, session) { diff --git a/inst/poc_crf.R b/inst/poc_crf.R index 5803a4484..cb68b745e 100644 --- a/inst/poc_crf.R +++ b/inst/poc_crf.R @@ -18,8 +18,18 @@ data <- within(teal_data(), { spiderplot_ds <- read_parquet(file.path(data_path, "spiderplot_ds.parquet")) |> mutate(subject = as.character(subject)) + + parent_ds <- bind_rows( + swimlane_ds |> select(subject, cohrt, txarm), + spiderplot_ds |> select(subject, cohrt, txarm) + ) |> distinct() }) +join_keys(data) <- join_keys( + join_key("parent_ds", "swimlane_ds", c("subject", "cohrt", "txarm")), + join_key("parent_ds", "spiderplot_ds", c("subject", "cohrt", "txarm")) +) + swim_plotly_specs <- list( list("plotly::add_markers", x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, data = quote(study_drug_administration)), list("plotly::add_markers", x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, data = quote(response_assessment)), @@ -33,6 +43,8 @@ swimlane_tm <- teal_transform_module( reactive({ data() |> within({ + swimlane_ds <- swimlane_ds |> + mutate(subject = forcats::fct_reorder(as.factor(subject), event_study_day, .fun = max)) disposition <- swimlane_ds |> filter(!is.na(event_study_day)) |> filter(event_type == "disposition") |> @@ -59,9 +71,26 @@ swimlane_tm <- teal_transform_module( swimlane_ui_mod <- function(id) { ns <- NS(id) - fluidRow( - column(6, reactableOutput(ns("mm_response"))), - column(6, reactableOutput(ns("tx_listing"))) + shinyjs::hidden( + fluidRow( + id = ns("reactive_tables"), + column( + 6, + class = "simple-card", + tagList( + h4("Multiple Myeloma Response"), + reactableOutput(ns("mm_response")) + ) + ), + column( + 6, + class = "simple-card", + tagList( + h4("Study Tx Listing"), + reactableOutput(ns("tx_listing")) + ) + ) + ) ) } @@ -72,6 +101,10 @@ swimlane_srv_mod <- function(id, checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { + observeEvent(plotly_selected(), once = TRUE, { + shinyjs::show("reactive_tables") + }) + output$mm_response <- renderReactable({ swimlane_ds <- data()[["swimlane_ds"]] col_defs <- list( @@ -180,12 +213,18 @@ swimlane_srv_mod <- function(id, spider_plotly_specs <- list( list("plotly::add_markers", x = ~event_study_day, y = ~event_result, color = ~subject, data = quote(spiderplot_ds_filtered)), - list("plotly::add_lines", x = ~event_study_day, y = ~event_result, data = quote(spiderplot_ds_filtered), color = ~subject, showlegend = FALSE) + list("plotly::add_lines", x = ~event_study_day, y = ~event_result, data = quote(spiderplot_ds_filtered), color = ~subject, showlegend = FALSE), + list( + "plotly::layout", + xaxis = list(title = "Collection Date Study Day", zeroline = FALSE), + yaxis = list(title = ~y_title), + title = ~ paste0(y_title, " Over Time") + ) ) spiderplot_tm <- teal_transform_module( ui = function(id) { - selectInput(NS(id, "event_type"), "Select Event type", NULL) + selectInput(NS(id, "event_type"), "Select Y Axis", NULL) }, server = function(id, data) { moduleServer(id, function(input, output, session) { @@ -194,13 +233,14 @@ spiderplot_tm <- teal_transform_module( event_types <- unique(spiderplot_ds()$event_type) updateSelectInput( inputId = "event_type", - choices = event_types[event_types != "response_assessment"] + choices = event_types[!event_types %in% c("response_assessment", "latest_response_assessment")] ) }) reactive({ data() |> within( { + y_title <- selected_event spiderplot_ds_filtered <- spiderplot_ds |> filter(event_type == selected_event) }, @@ -213,9 +253,46 @@ spiderplot_tm <- teal_transform_module( spider_ui_mod <- function(id) { ns <- NS(id) - fluidRow( - column(6, reactableOutput(ns("recent_resp"))), - column(6, reactableOutput(ns("all_resp"))) + shinyjs::hidden( + fluidRow( + id = ns("reactive_tables"), + fluidRow( + column( + 6, + class = "simple-card", + tagList( + h4("Most Recent Resp and Best Resp"), + reactableOutput(ns("recent_resp")) + ) + ), + column( + 6, + class = "simple-card", + tagList( + h4("Multiple Myeloma Response"), + reactableOutput(ns("all_resp")) + ) + ) + ), + fluidRow( + column( + 6, + class = "simple-card", + tagList( + h4("Disease Assessment - SPEP"), + reactableOutput(ns("spep_listing")) + ) + ), + column( + 6, + class = "simple-card", + tagList( + h4("Disease Assessment - SFLC"), + reactableOutput(ns("sflc_listing")) + ) + ) + ) + ) ) } @@ -237,98 +314,195 @@ spider_srv_mod <- function(id, selected_recent_subject <- reactiveVal(NULL) + observeEvent(plotly_selected(), once = TRUE, { + shinyjs::show("reactive_tables") + }) + all_resp <- reactive({ - if (!is.null(selected_recent_subject())) { - data()[["spiderplot_ds"]] |> - filter(event_type == "response_assessment") |> - select(all_of(names(all_resp_cols))) |> - filter(subject == selected_recent_subject()) - } else { - selected_subjects <- data()[["spiderplot_ds"]] |> - filter(event_study_day %in% plotly_selected()$x, event_result %in% plotly_selected()$y) |> - pull(subject) - data()[["spiderplot_ds"]] |> - filter(event_type == "response_assessment") |> - select(all_of(names(all_resp_cols))) |> - filter(subject %in% selected_subjects) - } + selected_subjects <- data()[["spiderplot_ds"]] |> + filter(event_study_day %in% plotly_selected()$x, event_result %in% plotly_selected()$y) |> + pull(subject) + data()[["spiderplot_ds"]] |> + filter(event_type == "response_assessment") |> + select(all_of(names(all_resp_cols))) |> + filter(subject %in% selected_subjects) }) - rank_response <- function(responses) { - responses <- responses[!is.na(responses)] - if (length(responses) == 0) { - return(NA_character_) - } - response_hierarchy <- c( - "SCR (Stringent Complete Response)", - "CR (Complete Response)", - "VGPR (Very Good Partial Response)", - "PR (Partial Response)", - "MR (Minimal/Minor Response)", - "SD (Stable Disease)", - "PD (Progressive Disease)" + output$all_resp <- renderReactable({ + reactable( + all_resp(), + columns = all_resp_cols ) - responses[which.max(match(responses, response_hierarchy))] - } + }) recent_resp_cols <- list( - txarm = colDef(name = "Study Arm"), - cohrt = colDef(name = "Study Cohort"), subject = colDef(name = "Subject"), - event_result = colDef(name = "Response"), - event_study_day = colDef(name = "Study Day"), - most_recent_response = colDef(name = "Most Recent Response"), - best_response = colDef(name = "Best Response") + visit_name = colDef(name = "Visit Name"), + rspdn = colDef(name = "Assessment Performed"), + rspd = colDef(name = "Response Date"), + rspd_study_day = colDef(name = "Response Date Study Day"), + orsp = colDef(name = "Response"), + bma = colDef(name = "Best Marrow Aspirate"), + bmb = colDef(name = "Best Marrow Biopsy"), + comnts = colDef(name = "Comments") ) - output$recent_resp <- renderReactable({ - best_resp <- all_resp() %>% - group_by(subject) %>% - filter(!is.na(subject)) %>% - arrange(desc(event_study_day)) %>% - slice(1) %>% - mutate( - most_recent_response = event_result, - best_response = rank_response(all_resp()$event_result[all_resp()$subject == cur_group()]) - ) %>% - ungroup() + recent_resp <- reactive({ + data()[["spiderplot_ds"]] |> + filter(event_type == "latest_response_assessment") |> + filter(subject %in% all_resp()$subject) |> + select(all_of(names(recent_resp_cols))) + }) + output$recent_resp <- renderReactable({ reactable( - best_resp, + recent_resp(), columns = recent_resp_cols, selection = "single", onClick = "select" ) }) - observeEvent(input$recent_resp_selected, { - req(input$recent_resp_selected) - selected_subjects <- reactableProxy("recent_resp") %>% - getReactableState("selected") + spep_cols <- list( + subject = colDef(name = "Subject"), + visit_name = colDef(name = "Visit Name"), + visit_date = colDef(name = "Visit Date"), + form_name = colDef(name = "Form Name"), + source_system_url_link = colDef(name = "Source System URL Link"), + rspdn = colDef(name = "Assessment Performed"), + rspd = colDef(name = "Response Date"), + rspd_study_day = colDef(name = "Response Date Study Day"), + orsp = colDef(name = "Response"), + bma = colDef(name = "Best Marrow Aspirate"), + bmb = colDef(name = "Best Marrow Biopsy"), + comnts = colDef(name = "Comments"), + asmntdn = colDef(name = "Assessment Not Done"), + blq = colDef(name = "Serum M-protein too small to quantify"), + coldr = colDef(name = "Collection Date"), + cold_study_day = colDef(name = "Collection Study Day"), + coltm = colDef(name = "Collection Time"), + coltmu = colDef(name = "Collection Time Unknown"), + lrspep1 = colDef(name = "Another Form added?"), + mprte_raw = colDef(name = "Serum M-protein"), + mprtec = colDef(name = "SPEP Serum M-protein detection") + ) - if (length(selected_subjects) > 0) { - selected_subject <- output$recent_resp()$subject[selected_subjects] - selected_recent_subject(selected_subject) - } + spep <- reactive({ + data()[["spiderplot_ds"]] |> + filter(event_type == "Serum M-protein") |> + filter(subject %in% all_resp()$subject) |> + select(all_of(names(spep_cols))) }) - output$all_resp <- renderReactable({ + output$spep_listing <- renderReactable({ reactable( - all_resp(), - columns = all_resp_cols + spep(), + columns = spep_cols ) }) + + + sflc_cols <- list( + subject = colDef(name = "Subject"), + visit_name = colDef(name = "Visit Name"), + visit_date = colDef(name = "Visit Date"), + form_name = colDef(name = "Form Name"), + source_system_url_link = colDef(name = "Source System URL Link"), + rspdn = colDef(name = "Assessment Performed"), + rspd = colDef(name = "Response Date"), + rspd_study_day = colDef(name = "Response Date Study Day"), + orsp = colDef(name = "Response"), + bma = colDef(name = "Best Marrow Aspirate"), + bmb = colDef(name = "Best Marrow Biopsy"), + comnts = colDef(name = "Comments"), + asmntdn = colDef(name = "Assessment Not Done"), + blq = colDef(name = "Serum M-protein too small to quantify"), + coldr = colDef(name = "Collection Date"), + cold_study_day = colDef(name = "Collection Study Day"), + coltm = colDef(name = "Collection Time"), + coltmu = colDef(name = "Collection Time Unknown"), + lchfrc = colDef(name = "Presence of Serum free light chains"), + lchfr_raw = colDef(name = "Serum free light chain results"), + klchf_raw = colDef(name = "Kappa free light chain results"), + llchf_raw = colDef(name = "Lambda free light chain results"), + klchp_raw = colDef(name = "Kappa-Lambda free light chain ratio"), + mprte_raw = colDef(name = "Serum M-protein"), + mprtec = colDef(name = "SPEP Serum M-protein detection") + ) + + sflc <- reactive({ + data()[["spiderplot_ds"]] |> + filter( + event_type %in% c( + "Kappa free light chain quantity", + "Lambda free light chain quantity", + "Kappa-Lambda free light chain ratio" + ) + ) |> + filter(subject %in% all_resp()$subject) |> + select(all_of(names(sflc_cols))) + }) + + output$sflc_listing <- renderReactable({ + reactable( + sflc(), + columns = sflc_cols + ) + }) + + observeEvent(input$recent_resp_selected, { + print(input$recent_resp_selected) + req(input$recent_resp_selected) + selected_subjects <- reactableProxy("recent_resp") %>% + getReactableState("selected") + print(selected_subjects) + }) }) } +# Custom placement of the transformer +# custom_tm_p_swimlane2 <- function(plotly_specs, ui_mod, srv_mod, transformators = list()) { +# mod <- tm_p_swimlane2( +# label = "Spiderplot", +# plotly_specs = plotly_specs, +# title = "Swimlane Plot", +# transformators = transformators, +# ui_mod = ui_mod, +# srv_mod = srv_mod, +# plot_height = 600 +# ) +# mod$ui <- function(id, ui_mod, height) { +# ns <- NS(id) +# shiny::tagList( +# sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height), +# teal::ui_transform_teal_data(NS(gsub("-module$", "", id), "data_transform"), transformators), +# plotly::plotlyOutput(ns("plot"), height = "100%"), +# ui_mod(ns("brush_tables")) +# ) +# } +# mod +# } + app <- init( data = data, + header = tags$head(tags$style( + ".simple-card { + padding: 20px; + border-radius: 10px; + border: 1px solid #ddd; + box-shadow: 0 4px 6px rgba(0, 0, 0, 0.1); + background-color: #fff; + } + .simple-card h4 { + text-align: center; + }" + )), modules = modules( tm_p_swimlane2( label = "Spiderplot", plotly_specs = spider_plotly_specs, - title = "Swimlane Efficacy Plot", + title = "Swimlane Plot", transformators = list(spiderplot_tm), ui_mod = spider_ui_mod, srv_mod = spider_srv_mod, @@ -374,27 +548,15 @@ app <- init( ), filter = teal_slices( teal_slice( - dataname = "swimlane_ds", - varname = "subject" - ), - teal_slice( - dataname = "swimlane_ds", - varname = "cohrt" - ), - teal_slice( - dataname = "swimlane_ds", - varname = "txarm" - ), - teal_slice( - dataname = "spiderplot_ds", + dataname = "parent_ds", varname = "subject" ), teal_slice( - dataname = "spiderplot_ds", + dataname = "parent_ds", varname = "cohrt" ), teal_slice( - dataname = "spiderplot_ds", + dataname = "parent_ds", varname = "txarm" ), count_type = "all" From 17e74e3435b9eb420127d3d6582c144059af52f1 Mon Sep 17 00:00:00 2001 From: vedhav Date: Wed, 4 Dec 2024 23:23:33 +0530 Subject: [PATCH 33/92] fix: format the links in two tables --- inst/poc_crf.R | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/inst/poc_crf.R b/inst/poc_crf.R index cb68b745e..54a862c0f 100644 --- a/inst/poc_crf.R +++ b/inst/poc_crf.R @@ -368,7 +368,16 @@ spider_srv_mod <- function(id, visit_name = colDef(name = "Visit Name"), visit_date = colDef(name = "Visit Date"), form_name = colDef(name = "Form Name"), - source_system_url_link = colDef(name = "Source System URL Link"), + source_system_url_link = colDef( + name = "Source System URL Link", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), rspdn = colDef(name = "Assessment Performed"), rspd = colDef(name = "Response Date"), rspd_study_day = colDef(name = "Response Date Study Day"), @@ -407,7 +416,16 @@ spider_srv_mod <- function(id, visit_name = colDef(name = "Visit Name"), visit_date = colDef(name = "Visit Date"), form_name = colDef(name = "Form Name"), - source_system_url_link = colDef(name = "Source System URL Link"), + source_system_url_link = colDef( + name = "Source System URL Link", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), rspdn = colDef(name = "Assessment Performed"), rspd = colDef(name = "Response Date"), rspd_study_day = colDef(name = "Response Date Study Day"), From d2636fb14caefa713cb9de614fecd22cdf4589a9 Mon Sep 17 00:00:00 2001 From: vedhav Date: Sat, 7 Dec 2024 02:44:33 +0530 Subject: [PATCH 34/92] feat: add a two module POC for easy maintenance --- R/tm_p_swimlane2.r | 10 +- inst/poc_crf.R | 59 +--- inst/poc_crf2.R | 692 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 702 insertions(+), 59 deletions(-) create mode 100644 inst/poc_crf2.R diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r index c610912ec..a1fbef1be 100644 --- a/R/tm_p_swimlane2.r +++ b/R/tm_p_swimlane2.r @@ -38,6 +38,7 @@ srv_p_swimlane2 <- function(id, title = "Swimlane plot", colors, symbols, + plot_source = "A", srv_mod, filter_panel_api) { moduleServer(id, function(input, output, session) { @@ -46,7 +47,8 @@ srv_p_swimlane2 <- function(id, specs = plotly_specs, colors = colors, symbols = symbols, - height = input$plot_height + height = input$plot_height, + source = plot_source ) code <- substitute( p <- plotly_call, @@ -62,7 +64,7 @@ srv_p_swimlane2 <- function(id, ) }) - plotly_selected <- reactive(plotly::event_data("plotly_selected")) + plotly_selected <- reactive(plotly::event_data("plotly_selected"), source = plot_source) observeEvent(plotly_selected(), once = TRUE, { if ("plotly_selected" %in% names(formals(srv_mod))) { @@ -76,9 +78,9 @@ srv_p_swimlane2 <- function(id, -.make_plotly_call <- function(specs, colors = c(), symbols = c(), height = 800) { +.make_plotly_call <- function(specs, colors = c(), symbols = c(), height = 800, source = "A") { init_call <- substitute( - plotly::plot_ly(colors = colors, symbols = symbols, height = height), + plotly::plot_ly(source = source, colors = colors, symbols = symbols, height = height), list(colors = colors, symbols = symbols, height = height) ) points_calls <- lapply(specs, function(x) { diff --git a/inst/poc_crf.R b/inst/poc_crf.R index 54a862c0f..616e496b9 100644 --- a/inst/poc_crf.R +++ b/inst/poc_crf.R @@ -22,7 +22,8 @@ data <- within(teal_data(), { parent_ds <- bind_rows( swimlane_ds |> select(subject, cohrt, txarm), spiderplot_ds |> select(subject, cohrt, txarm) - ) |> distinct() + ) |> + distinct() }) join_keys(data) <- join_keys( @@ -212,8 +213,8 @@ swimlane_srv_mod <- function(id, } spider_plotly_specs <- list( - list("plotly::add_markers", x = ~event_study_day, y = ~event_result, color = ~subject, data = quote(spiderplot_ds_filtered)), - list("plotly::add_lines", x = ~event_study_day, y = ~event_result, data = quote(spiderplot_ds_filtered), color = ~subject, showlegend = FALSE), + list("plotly::add_markers", x = ~event_study_day, y = ~event_result_num, color = ~subject, data = quote(spiderplot_ds_filtered)), + list("plotly::add_lines", x = ~event_study_day, y = ~event_result_num, data = quote(spiderplot_ds_filtered), color = ~subject, showlegend = FALSE), list( "plotly::layout", xaxis = list(title = "Collection Date Study Day", zeroline = FALSE), @@ -222,34 +223,6 @@ spider_plotly_specs <- list( ) ) -spiderplot_tm <- teal_transform_module( - ui = function(id) { - selectInput(NS(id, "event_type"), "Select Y Axis", NULL) - }, - server = function(id, data) { - moduleServer(id, function(input, output, session) { - spiderplot_ds <- reactive(data()[["spiderplot_ds"]]) - observeEvent(spiderplot_ds(), { - event_types <- unique(spiderplot_ds()$event_type) - updateSelectInput( - inputId = "event_type", - choices = event_types[!event_types %in% c("response_assessment", "latest_response_assessment")] - ) - }) - reactive({ - data() |> - within( - { - y_title <- selected_event - spiderplot_ds_filtered <- spiderplot_ds |> - filter(event_type == selected_event) - }, - selected_event = input$event_type - ) - }) - }) - } -) spider_ui_mod <- function(id) { ns <- NS(id) @@ -478,30 +451,6 @@ spider_srv_mod <- function(id, }) } - -# Custom placement of the transformer -# custom_tm_p_swimlane2 <- function(plotly_specs, ui_mod, srv_mod, transformators = list()) { -# mod <- tm_p_swimlane2( -# label = "Spiderplot", -# plotly_specs = plotly_specs, -# title = "Swimlane Plot", -# transformators = transformators, -# ui_mod = ui_mod, -# srv_mod = srv_mod, -# plot_height = 600 -# ) -# mod$ui <- function(id, ui_mod, height) { -# ns <- NS(id) -# shiny::tagList( -# sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height), -# teal::ui_transform_teal_data(NS(gsub("-module$", "", id), "data_transform"), transformators), -# plotly::plotlyOutput(ns("plot"), height = "100%"), -# ui_mod(ns("brush_tables")) -# ) -# } -# mod -# } - app <- init( data = data, header = tags$head(tags$style( diff --git a/inst/poc_crf2.R b/inst/poc_crf2.R new file mode 100644 index 000000000..812ea3e46 --- /dev/null +++ b/inst/poc_crf2.R @@ -0,0 +1,692 @@ +library(teal) +library(DT) +library(labelled) +library(reactable) +pkgload::load_all("teal.modules.general") +# Note: Please add the `PATH_TO_DATA` and change the X, Y, and Z Administrations to the actual values in the data + +with_tooltips <- function(...) { + args <- list(...) + lapply(args, function(col) { + col$header <- tags$span(col$name, title = col$name) + return(col) + }) +} + +data <- within(teal_data(), { + library(dplyr) + library(arrow) + library(forcats) + data_path <- "PATH_TO_DATA" + + swimlane_ds <- read_parquet(file.path(data_path, "swimlane_ds.parquet")) |> + filter(!is.na(event_result), !is.na(event_study_day)) |> + mutate(subject = forcats::fct_reorder(as.factor(subject), event_study_day, .fun = max)) + + spiderplot_ds <- read_parquet(file.path(data_path, "spiderplot_ds.parquet")) |> + mutate(subject = as.character(subject)) + + parent_ds <- bind_rows( + swimlane_ds |> select(subject, cohrt, txarm), + spiderplot_ds |> select(subject, cohrt, txarm) + ) |> + distinct() +}) + +join_keys(data) <- join_keys( + join_key("parent_ds", "swimlane_ds", c("subject", "cohrt", "txarm")), + join_key("parent_ds", "spiderplot_ds", c("subject", "cohrt", "txarm")) +) + +tm_swimlane <- function(label = "Swimlane", plot_height = 700) { + ui <- function(id, height) { + ns <- NS(id) + tagList( + fluidRow( + class = "simple-card", + h4("Swim Lane - Duration of Tx"), + sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height, width = "100%"), + plotly::plotlyOutput(ns("plot"), height = "100%") + ), + fluidRow( + column( + 6, + class = "simple-card", + tagList( + h4("Multiple Myeloma Response"), + reactableOutput(ns("mm_response")) + ) + ), + column( + 6, + class = "simple-card", + tagList( + h4("Study Tx Listing"), + reactableOutput(ns("tx_listing")) + ) + ) + ) + ) + } + server <- function(id, data, filter_panel_api, plot_height = 600) { + moduleServer(id, function(input, output, session) { + plotly_q <- reactive({ + data() |> + within( + { + swimlane_ds <- swimlane_ds |> + mutate(subject = forcats::fct_reorder(as.factor(subject), event_study_day, .fun = max)) |> + mutate( + subject = forcats::fct_reorder(as.factor(subject), event_study_day, .fun = max), + tooltip = case_when( + event_type == "study_drug_administration" ~ paste( + "Subject:", subject, + "
Study Day:", event_study_day, + "
Administration:", event_result + ), + event_type == "response_assessment" ~ paste( + "Subject:", subject, + "
Study Day:", event_study_day, + "
Response Assessment:", event_result + ), + event_type == "disposition" ~ paste( + "Subject:", subject, + "
Study Day:", event_study_day, + "
Disposition:", event_result + ), + TRUE ~ NA_character_ + ) + ) + + swimlane_ds <- swimlane_ds |> + group_by(subject, event_study_day) |> + mutate( + tooltip = paste(unique(tooltip), collapse = "
") + ) |> + ungroup() |> + mutate(tooltip = stringr::str_remove_all(tooltip, "
Subject: [0-9]+
Study Day: [0-9]+")) + + disposition <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "disposition") |> + transmute(subject, event_type, catagory = event_result, study_day = event_study_day, tooltip) + + response_assessment <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "response_assessment") |> + transmute(subject, event_type, catagory = event_result, study_day = event_study_day, tooltip) + + study_drug_administration <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "study_drug_administration") |> + transmute(subject, event_type, catagory = event_result, study_day = event_study_day, tooltip) + + max_subject_day <- swimlane_ds |> + group_by(subject) |> + summarise(study_day = max(event_study_day)) |> + bind_rows(tibble(subject = unique(swimlane_ds$subject), study_day = 0)) + + p <- plotly::plot_ly( + source = "swimlane", + colors = c( + "DEATH" = "black", + "WITHDRAWAL BY SUBJECT" = "grey", + "PD (Progressive Disease)" = "red", + "SD (Stable Disease)" = "darkorchid4", + "MR (Minimal/Minor Response)" = "sienna4", + "PR (Partial Response)" = "maroon", + "VGPR (Very Good Partial Response)" = "chartreuse4", + "CR (Complete Response)" = "#3a41fc", + "SCR (Stringent Complete Response)" = "midnightblue", + "X Administration Injection" = "goldenrod", + "Y Administration Infusion" = "deepskyblue3", + "Z Administration Infusion" = "darkorchid" + ), + symbols = c( + "DEATH" = "circle", + "WITHDRAWAL BY SUBJECT" = "square", + "PD (Progressive Disease)" = "circle", + "SD (Stable Disease)" = "square-open", + "MR (Minimal/Minor Response)" = "star-open", + "PR (Partial Response)" = "star-open", + "VGPR (Very Good Partial Response)" = "star-open", + "CR (Complete Response)" = "star-open", + "SCR (Stringent Complete Response)" = "star-open", + "X Administration Injection" = "line-ns-open", + "Y Administration Infusion" = "line-ns-open", + "Z Administration Infusion" = "line-ns-open" + ), + height = height + ) |> + plotly::add_markers( + x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, + text = ~tooltip, + hoverinfo = "text", + data = study_drug_administration + ) |> + plotly::add_markers( + x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, + text = ~tooltip, + hoverinfo = "text", + data = response_assessment + ) |> + plotly::add_markers( + x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, + text = ~tooltip, + hoverinfo = "text", + data = disposition + ) |> + plotly::add_segments( + x = ~0, xend = ~study_day, y = ~subject, yend = ~subject, + data = max_subject_day, + line = list(width = 1, color = "grey"), + showlegend = FALSE + ) |> + plotly::layout( + xaxis = list(title = "Study Day"), yaxis = list(title = "Subject") + ) |> + plotly::layout(dragmode = "select") |> + plotly::config(displaylogo = FALSE) + }, + height = input$plot_height + ) + }) + + output$plot <- plotly::renderPlotly({ + plotly::event_register( + plotly_q()$p, + "plotly_selected" + ) + }) + + plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "swimlane")) + + output$mm_response <- renderReactable({ + swimlane_ds <- data()[["swimlane_ds"]] + col_defs <- with_tooltips( + subject = colDef(name = "Subject"), + visit_name = colDef(name = "Visit Name", width = 250), + visit_date = colDef(name = "Visit Date"), + form_name = colDef(name = "Form Name", width = 250), + source_system_url_link = colDef( + name = "Source System URL Link", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), + rspdn = colDef(name = "Assessment Performed"), + rspd = colDef(name = "Response Date"), + rspd_study_day = colDef(name = "Response Date Study Day"), + orsp = colDef(name = "Response", width = 250), + bma = colDef(name = "Best Marrow Aspirate"), + bmb = colDef(name = "Best Marrow Biopsy"), + comnts = colDef(name = "Comments") + ) + mm_response <- swimlane_ds |> + filter(event_study_day %in% plotly_selected()$x, subject %in% plotly_selected()$y) |> + select(all_of(names(col_defs))) + if (nrow(mm_response) == 0) { + return() + } + + reactable( + mm_response, + class = "custom-reactable", + columns = col_defs, + defaultPageSize = 10, + wrap = FALSE, + searchable = TRUE, + sortable = TRUE + ) + }) + + output$tx_listing <- renderReactable({ + swimlane_ds <- data()[["swimlane_ds"]] + + col_defs <- with_tooltips( + site_name = colDef(name = "Site Name"), + subject = colDef(name = "Subject"), + visit_name = colDef(name = "Visit Name"), + visit_date = colDef(name = "Visit Date"), + form_name = colDef(name = "Form Name"), + source_system_url_link = colDef( + name = "Source System URL Link", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), + txnam = colDef(name = "Study Drug Name"), + txrec = colDef(name = "Study Drug Administered"), + txrecrs = colDef(name = "Reason Study Drug Not Admin"), + txd_study_day = colDef(name = "Date Administered Study Day"), + date_administered = colDef(name = "Date Administered"), + cydly = colDef(name = "Cycle Delay"), + cydlyrs = colDef(name = "Cycle Delay Reason"), + cydlyae = colDef(name = "Cycle Delay Adverse Event"), + txdly = colDef(name = "Dose Delay"), + txdlyrs = colDef(name = "Dose Delay Reason"), + txdlyae = colDef(name = "AE related to Dose Delay"), + txpdos = colDef(name = "Planned Dose per Admin"), + txpdosu = colDef(name = "Planned Dose per Admin Unit"), + frqdv = colDef(name = "Frequency"), + txrte = colDef(name = "Route of Administration"), + txform = colDef(name = "Dose Formulation"), + txdmod = colDef(name = "Dose Modification"), + txrmod = colDef(name = "Dose Modification Reason"), + txdmae = colDef(name = "AE related to Dose Modification"), + txad = colDef(name = "Total Dose Administered"), + txadu = colDef(name = "Total Dose Administered Unit"), + txd = colDef(name = "Date Administered"), + txstm = colDef(name = "Start Time Administered"), + txstmu = colDef(name = "Start Time Administered Unknown"), + txed = colDef(name = "End Date Administered"), + txetm = colDef(name = "End Time Administered"), + txetmu = colDef(name = "End Time Administered Unknown"), + txtm = colDef(name = "Time Administered"), + txtmu = colDef(name = "Time Administered Unknown"), + txed_study_day = colDef(name = "End Study Day"), + infrt = colDef(name = "Infusion Rate"), + infrtu = colDef(name = "Infusion Rate Unit"), + tximod = colDef(name = "Infusion Modified?"), + txirmod = colDef(name = "Reason for Infusion modification"), + tximae = colDef(name = "AE related to Infusion Modification") + ) + tx_listing <- swimlane_ds |> + filter(event_study_day %in% plotly_selected()$x, subject %in% plotly_selected()$y) |> + select(all_of(names(col_defs))) + if (nrow(tx_listing) == 0) { + return() + } + + reactable( + tx_listing, + columns = col_defs, + defaultPageSize = 10, + wrap = FALSE, + searchable = TRUE, + sortable = TRUE + ) + }) + }) + } + module( + label = label, + ui = ui, + server = server, + datanames = "all", + ui_args = list(height = plot_height) + ) +} + +tm_spider <- function(label = "Spiderplot", plot_height = 600) { + ui <- function(id, height) { + ns <- NS(id) + tagList( + div( + style = "display: flex; justify-content: center; align-items: center; gap: 30px;", + div( + selectInput(NS(id, "event_type"), "Select Y Axis", NULL) + ), + div(sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)) + ), + div( + style = "display: flex", + div( + class = "simple-card", + style = "width: 50%", + tagList( + h4("Most Recent Resp and Best Resp"), + reactableOutput(ns("recent_resp")) + ) + ), + div( + class = "simple-card", + style = "width: 50%", + plotly::plotlyOutput(ns("plot"), height = "100%") + ) + ), + div( + style = "display: flex", + div( + style = "width: 50%", + div( + class = "simple-card", + h4("Disease Assessment - SFLC"), + reactableOutput(ns("sflc_listing")) + ), + div( + class = "simple-card", + h4("Disease Assessment - SPEP"), + reactableOutput(ns("spep_listing")) + ) + ), + div( + class = "simple-card", + style = "width: 50%", + h4("Multiple Myeloma Response"), + reactableOutput(ns("all_resp")) + ) + ) + ) + } + server <- function(id, data, filter_panel_api, plot_height = 600) { + moduleServer(id, function(input, output, session) { + spiderplot_ds <- reactive(data()[["spiderplot_ds"]]) + observeEvent(spiderplot_ds(), { + event_types <- unique(spiderplot_ds()$event_type) + updateSelectInput( + inputId = "event_type", + choices = event_types[!event_types %in% c("response_assessment", "latest_response_assessment")] + ) + }) + plotly_q <- reactive({ + data() |> + within( + { + y_title <- selected_event + spiderplot_ds_filtered <- spiderplot_ds |> + filter(event_type == selected_event) + + p <- plotly::plot_ly(source = "spiderplot", height = height) |> + plotly::add_markers( + x = ~event_study_day, y = ~event_result_num, color = ~subject, + data = spiderplot_ds_filtered + ) |> + plotly::add_lines( + x = ~event_study_day, y = ~event_result_num, color = ~subject, + data = spiderplot_ds_filtered, + showlegend = FALSE + ) |> + plotly::layout( + xaxis = list(title = "Collection Date Study Day", zeroline = FALSE), + yaxis = list(title = ~y_title), + title = ~ paste0(y_title, " Over Time") + ) |> + plotly::layout(dragmode = "select") |> + plotly::config(displaylogo = FALSE) + }, + selected_event = input$event_type, + height = input$plot_height + ) + }) + + output$plot <- plotly::renderPlotly({ + plotly::event_register( + plotly_q()$p, + "plotly_selected" + ) + }) + + plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) + + + resp_cols <- with_tooltips( + subject = colDef(name = "Subject"), + raise_query = colDef( + name = "Raise Query", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), + visit_name = colDef(name = "Visit Name"), + rspdn = colDef(name = "Assessment Performed"), + rspd = colDef(name = "Response Date"), + rspd_study_day = colDef(name = "Response Date Study Day"), + orsp = colDef(name = "Response"), + bma = colDef(name = "Best Marrow Aspirate"), + bmb = colDef(name = "Best Marrow Biopsy"), + comnts = colDef(name = "Comments") + ) + + selected_recent_subject <- reactiveVal(NULL) + + plotly_selected_subjects <- reactive({ + data()[["spiderplot_ds"]] |> + filter(event_study_day %in% plotly_selected()$x, event_result %in% plotly_selected()$y) |> + pull(subject) + }) + + recent_resp_ds <- reactive({ + data()[["spiderplot_ds"]] |> + filter(event_type == "latest_response_assessment") |> + filter(subject %in% plotly_selected_subjects()) |> + select(all_of(names(resp_cols))) + }) + + output$recent_resp <- renderReactable({ + req(plotly_selected_subjects()) + + reactable( + recent_resp_ds(), + columns = resp_cols, + selection = "single", + onClick = "select", + defaultPageSize = 15, + wrap = FALSE, + rowClass = JS(" + function(rowInfo) { + console.log(rowInfo); + if (rowInfo.selected) { + return 'selected-row'; + } + } + ") + ) + }) + + table_selected_subjects <- reactive({ + selected_row <- getReactableState("recent_resp", "selected") + if (!is.null(selected_row)) { + recent_resp_ds()[selected_row, ]$subject + } else { + unique(recent_resp_ds()$subject) + } + }) + + all_resp <- reactive({ + data()[["spiderplot_ds"]] |> + filter(event_type == "response_assessment") |> + select(all_of(names(resp_cols))) |> + filter(subject %in% plotly_selected_subjects()) |> + filter(subject %in% table_selected_subjects()) + }) + + output$all_resp <- renderReactable({ + if (nrow(all_resp()) == 0) { + return() + } + + reactable( + all_resp(), + columns = resp_cols, + defaultPageSize = 15, + wrap = FALSE + ) + }) + + spep_cols <- with_tooltips( + subject = colDef(name = "Subject"), + visit_name = colDef(name = "Visit Name"), + visit_date = colDef(name = "Visit Date"), + form_name = colDef(name = "Form Name"), + source_system_url_link = colDef( + name = "Source System URL Link", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), + rspdn = colDef(name = "Assessment Performed"), + rspd = colDef(name = "Response Date"), + rspd_study_day = colDef(name = "Response Date Study Day"), + orsp = colDef(name = "Response"), + bma = colDef(name = "Best Marrow Aspirate"), + bmb = colDef(name = "Best Marrow Biopsy"), + comnts = colDef(name = "Comments"), + asmntdn = colDef(name = "Assessment Not Done"), + blq = colDef(name = "Serum M-protein too small to quantify"), + coldr = colDef(name = "Collection Date"), + cold_study_day = colDef(name = "Collection Study Day"), + coltm = colDef(name = "Collection Time"), + coltmu = colDef(name = "Collection Time Unknown"), + lrspep1 = colDef(name = "Another Form added?"), + mprte_raw = colDef(name = "Serum M-protein"), + mprtec = colDef(name = "SPEP Serum M-protein detection") + ) + + spep <- reactive({ + data()[["spiderplot_ds"]] |> + filter(event_type == "Serum M-protein") |> + filter(subject %in% table_selected_subjects()) |> + select(all_of(names(spep_cols))) + }) + + output$spep_listing <- renderReactable({ + if (nrow(spep()) == 0) { + return() + } + + reactable( + spep(), + columns = spep_cols, + defaultPageSize = 5, + wrap = FALSE + ) + }) + + + sflc_cols <- with_tooltips( + subject = colDef(name = "Subject"), + visit_name = colDef(name = "Visit Name"), + visit_date = colDef(name = "Visit Date"), + form_name = colDef(name = "Form Name"), + source_system_url_link = colDef( + name = "Source System URL Link", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), + rspdn = colDef(name = "Assessment Performed"), + rspd = colDef(name = "Response Date"), + rspd_study_day = colDef(name = "Response Date Study Day"), + orsp = colDef(name = "Response"), + bma = colDef(name = "Best Marrow Aspirate"), + bmb = colDef(name = "Best Marrow Biopsy"), + comnts = colDef(name = "Comments"), + asmntdn = colDef(name = "Assessment Not Done"), + blq = colDef(name = "Serum M-protein too small to quantify"), + coldr = colDef(name = "Collection Date"), + cold_study_day = colDef(name = "Collection Study Day"), + coltm = colDef(name = "Collection Time"), + coltmu = colDef(name = "Collection Time Unknown"), + lchfrc = colDef(name = "Presence of Serum free light chains"), + lchfr_raw = colDef(name = "Serum free light chain results"), + klchf_raw = colDef(name = "Kappa free light chain results"), + llchf_raw = colDef(name = "Lambda free light chain results"), + klchp_raw = colDef(name = "Kappa-Lambda free light chain ratio"), + mprte_raw = colDef(name = "Serum M-protein"), + mprtec = colDef(name = "SPEP Serum M-protein detection") + ) + + sflc <- reactive({ + data()[["spiderplot_ds"]] |> + filter( + event_type %in% c( + "Kappa free light chain quantity", + "Lambda free light chain quantity", + "Kappa-Lambda free light chain ratio" + ) + ) |> + filter(subject %in% table_selected_subjects()) |> + select(all_of(names(sflc_cols))) + }) + + output$sflc_listing <- renderReactable({ + if (nrow(sflc()) == 0) { + return() + } + + reactable( + sflc(), + columns = sflc_cols, + defaultPageSize = 5, + wrap = FALSE + ) + }) + }) + } + module( + label = label, + ui = ui, + server = server, + datanames = "all", + ui_args = list(height = plot_height) + ) +} + +app <- init( + data = data, + header = tags$head(tags$style( + ".simple-card { + padding: 20px; + border-radius: 10px; + border: 1px solid #ddd; + box-shadow: 0 4px 6px rgba(0, 0, 0, 0.1); + background-color: #fff; + } + .simple-card h4 { + text-align: center; + } + .selected-row { + background-color: #d9edf7; + color: #31708f; + } + .custom-reactable.rt-nowrap .rt-th-inner { + white-space: normal !important; /* Allow text wrapping */ + text-overflow: unset !important; /* Disable ellipsis */ + overflow: visible !important; /* Ensure content is visible and wrapped */ + }" + )), + modules = modules( + tm_swimlane(), + tm_spider(), + tm_data_table() + ), + filter = teal_slices( + teal_slice( + dataname = "parent_ds", + varname = "subject" + ), + teal_slice( + dataname = "parent_ds", + varname = "cohrt" + ), + teal_slice( + dataname = "parent_ds", + varname = "txarm" + ), + count_type = "all" + ) +) + +shinyApp(app$ui, app$server) + From 915ffdf8afcfd5831e919546f6c43187937b88a4 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Fri, 14 Feb 2025 10:38:46 +0000 Subject: [PATCH 35/92] WIP modules --- R/tm_data_table.R | 33 ++-- R/tm_p_spiderplot.R | 363 ++++++++++++++++++++++++++++++++++++++++++++ R/tm_swimlane.R | 287 ++++++++++++++++++++++++++++++++++ 3 files changed, 666 insertions(+), 17 deletions(-) create mode 100644 R/tm_p_spiderplot.R create mode 100644 R/tm_swimlane.R diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 60363c1e6..692d22df9 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -130,11 +130,10 @@ tm_data_table <- function(label = "Data Table", checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) # End of assertions - ans <- module( label, - server = srv_page_data_table, - ui = ui_page_data_table, + server = srv_data_table, + ui = ui_data_table, datanames = datanames, server_args = list( datanames = if (is.null(datanames)) "all" else datanames, @@ -154,7 +153,7 @@ tm_data_table <- function(label = "Data Table", } # UI page module -ui_page_data_table <- function(id, pre_output = NULL, post_output = NULL) { +ui_data_table <- function(id, pre_output = NULL, post_output = NULL) { ns <- NS(id) tagList( @@ -187,18 +186,18 @@ ui_page_data_table <- function(id, pre_output = NULL, post_output = NULL) { # Server page module srv_data_table <- function(id, - data, - datanames, - variables_selected = list(), - dt_args = list(), - dt_options = list( - searching = FALSE, - pageLength = 30, - lengthMenu = c(5, 15, 30, 100), - scrollX = TRUE - ), - server_rendering = FALSE, - filter_panel_api) { + data, + datanames, + variables_selected = list(), + dt_args = list(), + dt_options = list( + searching = FALSE, + pageLength = 30, + lengthMenu = c(5, 15, 30, 100), + scrollX = TRUE + ), + server_rendering = FALSE, + filter_panel_api) { checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { @@ -283,7 +282,7 @@ srv_data_table <- function(id, } # UI function for the data_table module -ui_data_table <- function(id, choices, selected) { +ui_dataset_table <- function(id, choices, selected) { ns <- NS(id) if (!is.null(selected)) { diff --git a/R/tm_p_spiderplot.R b/R/tm_p_spiderplot.R new file mode 100644 index 000000000..acefe34f8 --- /dev/null +++ b/R/tm_p_spiderplot.R @@ -0,0 +1,363 @@ + +tm_p_spiderplot <- function(label = "Spiderplot", + time_var, + subject_var, + value_var, + plot_height = 600) { + module( + label = label, + ui = ui_p_spiderplot, + server = srv_p_spiderplot, + ui_args = list(height = plot_height), + server_args = list( + time_var = time_var, + subject_var = subject_var, + value_var = value_var + ), + datanames = "all", + ) +} + + +ui_p_spiderplot <- function(id, height) { + ns <- NS(id) + tagList( + div( + style = "display: flex; justify-content: center; align-items: center; gap: 30px;", + div( + selectInput(NS(id, "event_type"), "Select Y Axis", NULL) + ), + div(sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)) + ), + div( + style = "display: flex", + div( + class = "simple-card", + style = "width: 50%", + tagList( + h4("Most Recent Resp and Best Resp"), + reactableOutput(ns("recent_resp")) + ) + ), + div( + class = "simple-card", + style = "width: 50%", + plotly::plotlyOutput(ns("plot"), height = "100%") + ) + ), + div( + style = "display: flex", + div( + style = "width: 50%", + div( + class = "simple-card", + h4("Disease Assessment - SFLC"), + reactableOutput(ns("sflc_listing")) + ), + div( + class = "simple-card", + h4("Disease Assessment - SPEP"), + reactableOutput(ns("spep_listing")) + ) + ), + div( + class = "simple-card", + style = "width: 50%", + h4("Multiple Myeloma Response"), + reactableOutput(ns("all_resp")) + ) + ) + ) +} + +srv_p_spiderplot <- function(id, + data, + time_var, + subject_var, + value_var, + filter_panel_api, + plot_height = 600) { + moduleServer(id, function(input, output, session) { + spiderplot_ds <- reactive(data()[["spiderplot_ds"]]) + observeEvent(spiderplot_ds(), { + event_types <- unique(spiderplot_ds()$event_type) + updateSelectInput( + inputId = "event_type", + choices = event_types[!event_types %in% c("response_assessment", "latest_response_assessment")] + ) + }) + plotly_q <- reactive({ + data() |> + within( + selected_event = input$event_type, + height = input$plot_height, + time_var = str2lang(time_var), + subject_var = str2lang(subject_var), + value_var = str2lang(value_var), + expr = { + y_title <- selected_event + spiderplot_ds_filtered <- spiderplot_ds |> + filter(event_type == selected_event) + + p <- plotly::plot_ly(source = "spiderplot", height = height) |> + plotly::add_markers( + x = ~time_var, y = ~value_var, color = ~subject_var, + data = spiderplot_ds_filtered + ) |> + plotly::add_lines( + x = ~time_var, y = ~value_var, color = ~subject_var, + data = spiderplot_ds_filtered, + showlegend = FALSE + ) |> + plotly::layout( + xaxis = list(title = "Collection Date Study Day", zeroline = FALSE), + yaxis = list(title = ~y_title), + title = ~ paste0(y_title, " Over Time") + ) |> + plotly::layout(dragmode = "select") |> + plotly::config(displaylogo = FALSE) + } + ) + }) + + output$plot <- plotly::renderPlotly({ + plotly::event_register( + plotly_q()$p, + "plotly_selected" + ) + }) + + plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) + + + resp_cols <- .with_tooltips( + subject = colDef(name = "Subject"), + raise_query = colDef( + name = "Raise Query", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), + visit_name = colDef(name = "Visit Name"), + rspdn = colDef(name = "Assessment Performed"), + rspd = colDef(name = "Response Date"), + rspd_study_day = colDef(name = "Response Date Study Day"), + orsp = colDef(name = "Response"), + bma = colDef(name = "Best Marrow Aspirate"), + bmb = colDef(name = "Best Marrow Biopsy"), + comnts = colDef(name = "Comments") + ) + + selected_recent_subject <- reactiveVal(NULL) + + data_w_brushed <- reactive({ + req(plotly_selected()) + within( + data(), + time_var = str2lang(time_var), + subject_var = str2lang(subject_var), + value_var = str2lang(value_var), + expr = { + selected_subjects <- spiderplot_ds |> + filter(time_var %in% plotly_selected()$x, value_var %in% plotly_selected()$y) |> + pull(subject_var) + } + ) + + }) + + plotly_selected_subjects <- reactive({ + req(data_w_brushed()) + within( + data_w_brushed(), { + spiderplot_ds <- spiderplot_ds |> + filter(event_type == "latest_response_assessment") |> + filter(subject %in% selected_subjects) |> + select(all_of(names(resp_cols))) + } + ) + + }) + + output$recent_resp <- renderReactable({ + req(plotly_selected_subjects()) + + reactable( + recent_resp_ds(), + columns = resp_cols, + selection = "single", + onClick = "select", + defaultPageSize = 15, + wrap = FALSE, + rowClass = JS(" + function(rowInfo) { + console.log(rowInfo); + if (rowInfo.selected) { + return 'selected-row'; + } + } + ") + ) + }) + + table_selected_subjects <- reactive({ + selected_row <- getReactableState("recent_resp", "selected") + if (!is.null(selected_row)) { + recent_resp_ds()[selected_row, ][[subject_var]] + } else { + unique(recent_resp_ds()[[subject_var]]) + } + }) + + all_resp <- reactive({ + data()[["spiderplot_ds"]] |> + filter(event_type == "response_assessment") |> + select(all_of(names(resp_cols))) |> + filter(subject %in% plotly_selected_subjects()) |> + filter(subject %in% table_selected_subjects()) + }) + + output$all_resp <- renderReactable({ + if (nrow(all_resp()) == 0) { + return() + } + + reactable( + all_resp(), + columns = resp_cols, + defaultPageSize = 15, + wrap = FALSE + ) + }) + + spep_cols <- .with_tooltips( + subject = colDef(name = "Subject"), + visit_name = colDef(name = "Visit Name"), + visit_date = colDef(name = "Visit Date"), + form_name = colDef(name = "Form Name"), + source_system_url_link = colDef( + name = "Source System URL Link", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), + rspdn = colDef(name = "Assessment Performed"), + rspd = colDef(name = "Response Date"), + rspd_study_day = colDef(name = "Response Date Study Day"), + orsp = colDef(name = "Response"), + bma = colDef(name = "Best Marrow Aspirate"), + bmb = colDef(name = "Best Marrow Biopsy"), + comnts = colDef(name = "Comments"), + asmntdn = colDef(name = "Assessment Not Done"), + blq = colDef(name = "Serum M-protein too small to quantify"), + coldr = colDef(name = "Collection Date"), + cold_study_day = colDef(name = "Collection Study Day"), + coltm = colDef(name = "Collection Time"), + coltmu = colDef(name = "Collection Time Unknown"), + lrspep1 = colDef(name = "Another Form added?"), + mprte_raw = colDef(name = "Serum M-protein"), + mprtec = colDef(name = "SPEP Serum M-protein detection") + ) + + spep <- reactive({ + data()[["spiderplot_ds"]] |> + filter(event_type == "Serum M-protein") |> + filter(subject %in% table_selected_subjects()) |> + select(all_of(names(spep_cols))) + }) + + output$spep_listing <- renderReactable({ + if (nrow(spep()) == 0) { + return() + } + + reactable( + spep(), + columns = spep_cols, + defaultPageSize = 5, + wrap = FALSE + ) + }) + + + sflc_cols <- .with_tooltips( + subject = colDef(name = "Subject"), + visit_name = colDef(name = "Visit Name"), + visit_date = colDef(name = "Visit Date"), + form_name = colDef(name = "Form Name"), + source_system_url_link = colDef( + name = "Source System URL Link", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), + rspdn = colDef(name = "Assessment Performed"), + rspd = colDef(name = "Response Date"), + rspd_study_day = colDef(name = "Response Date Study Day"), + orsp = colDef(name = "Response"), + bma = colDef(name = "Best Marrow Aspirate"), + bmb = colDef(name = "Best Marrow Biopsy"), + comnts = colDef(name = "Comments"), + asmntdn = colDef(name = "Assessment Not Done"), + blq = colDef(name = "Serum M-protein too small to quantify"), + coldr = colDef(name = "Collection Date"), + cold_study_day = colDef(name = "Collection Study Day"), + coltm = colDef(name = "Collection Time"), + coltmu = colDef(name = "Collection Time Unknown"), + lchfrc = colDef(name = "Presence of Serum free light chains"), + lchfr_raw = colDef(name = "Serum free light chain results"), + klchf_raw = colDef(name = "Kappa free light chain results"), + llchf_raw = colDef(name = "Lambda free light chain results"), + klchp_raw = colDef(name = "Kappa-Lambda free light chain ratio"), + mprte_raw = colDef(name = "Serum M-protein"), + mprtec = colDef(name = "SPEP Serum M-protein detection") + ) + + sflc <- reactive({ + data()[["spiderplot_ds"]] |> + filter( + event_type %in% c( + "Kappa free light chain quantity", + "Lambda free light chain quantity", + "Kappa-Lambda free light chain ratio" + ) + ) |> + filter(subject %in% table_selected_subjects()) |> + select(all_of(names(sflc_cols))) + }) + + output$sflc_listing <- renderReactable({ + if (nrow(sflc()) == 0) { + return() + } + + reactable( + sflc(), + columns = sflc_cols, + defaultPageSize = 5, + wrap = FALSE + ) + }) + }) +} + + +.with_tooltips <- function(...) { + args <- list(...) + lapply(args, function(col) { + col$header <- tags$span(col$name, title = col$name) + return(col) + }) +} diff --git a/R/tm_swimlane.R b/R/tm_swimlane.R new file mode 100644 index 000000000..772f5ca03 --- /dev/null +++ b/R/tm_swimlane.R @@ -0,0 +1,287 @@ +tm_swimlane <- function(label = "Swimlane", plot_height = 700) { + ui <- function(id, height) { + ns <- NS(id) + tagList( + fluidRow( + class = "simple-card", + h4("Swim Lane - Duration of Tx"), + sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height, width = "100%"), + plotly::plotlyOutput(ns("plot"), height = "100%") + ), + fluidRow( + column( + 6, + class = "simple-card", + tagList( + h4("Multiple Myeloma Response"), + reactableOutput(ns("mm_response")) + ) + ), + column( + 6, + class = "simple-card", + tagList( + h4("Study Tx Listing"), + reactableOutput(ns("tx_listing")) + ) + ) + ) + ) + } + server <- function(id, data, filter_panel_api, plot_height = 600) { + moduleServer(id, function(input, output, session) { + plotly_q <- reactive({ + data() |> + within( + { + swimlane_ds <- swimlane_ds |> + mutate(subject = forcats::fct_reorder(as.factor(subject), event_study_day, .fun = max)) |> + mutate( + subject = forcats::fct_reorder(as.factor(subject), event_study_day, .fun = max), + tooltip = case_when( + event_type == "study_drug_administration" ~ paste( + "Subject:", subject, + "
Study Day:", event_study_day, + "
Administration:", event_result + ), + event_type == "response_assessment" ~ paste( + "Subject:", subject, + "
Study Day:", event_study_day, + "
Response Assessment:", event_result + ), + event_type == "disposition" ~ paste( + "Subject:", subject, + "
Study Day:", event_study_day, + "
Disposition:", event_result + ), + TRUE ~ NA_character_ + ) + ) + + swimlane_ds <- swimlane_ds |> + group_by(subject, event_study_day) |> + mutate( + tooltip = paste(unique(tooltip), collapse = "
") + ) |> + ungroup() |> + mutate(tooltip = stringr::str_remove_all(tooltip, "
Subject: [0-9]+
Study Day: [0-9]+")) + + disposition <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "disposition") |> + transmute(subject, event_type, catagory = event_result, study_day = event_study_day, tooltip) + + response_assessment <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "response_assessment") |> + transmute(subject, event_type, catagory = event_result, study_day = event_study_day, tooltip) + + study_drug_administration <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "study_drug_administration") |> + transmute(subject, event_type, catagory = event_result, study_day = event_study_day, tooltip) + + max_subject_day <- swimlane_ds |> + group_by(subject) |> + summarise(study_day = max(event_study_day)) |> + bind_rows(tibble(subject = unique(swimlane_ds$subject), study_day = 0)) + + p <- plotly::plot_ly( + source = "swimlane", + colors = c( + "DEATH" = "black", + "WITHDRAWAL BY SUBJECT" = "grey", + "PD (Progressive Disease)" = "red", + "SD (Stable Disease)" = "darkorchid4", + "MR (Minimal/Minor Response)" = "sienna4", + "PR (Partial Response)" = "maroon", + "VGPR (Very Good Partial Response)" = "chartreuse4", + "CR (Complete Response)" = "#3a41fc", + "SCR (Stringent Complete Response)" = "midnightblue", + "X Administration Injection" = "goldenrod", + "Y Administration Infusion" = "deepskyblue3", + "Z Administration Infusion" = "darkorchid" + ), + symbols = c( + "DEATH" = "circle", + "WITHDRAWAL BY SUBJECT" = "square", + "PD (Progressive Disease)" = "circle", + "SD (Stable Disease)" = "square-open", + "MR (Minimal/Minor Response)" = "star-open", + "PR (Partial Response)" = "star-open", + "VGPR (Very Good Partial Response)" = "star-open", + "CR (Complete Response)" = "star-open", + "SCR (Stringent Complete Response)" = "star-open", + "X Administration Injection" = "line-ns-open", + "Y Administration Infusion" = "line-ns-open", + "Z Administration Infusion" = "line-ns-open" + ), + height = height + ) |> + plotly::add_markers( + x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, + text = ~tooltip, + hoverinfo = "text", + data = study_drug_administration + ) |> + plotly::add_markers( + x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, + text = ~tooltip, + hoverinfo = "text", + data = response_assessment + ) |> + plotly::add_markers( + x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, + text = ~tooltip, + hoverinfo = "text", + data = disposition + ) |> + plotly::add_segments( + x = ~0, xend = ~study_day, y = ~subject, yend = ~subject, + data = max_subject_day, + line = list(width = 1, color = "grey"), + showlegend = FALSE + ) |> + plotly::layout( + xaxis = list(title = "Study Day"), yaxis = list(title = "Subject") + ) |> + plotly::layout(dragmode = "select") |> + plotly::config(displaylogo = FALSE) + }, + height = input$plot_height + ) + }) + + output$plot <- plotly::renderPlotly({ + plotly::event_register( + plotly_q()$p, + "plotly_selected" + ) + }) + + plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "swimlane")) + + output$mm_response <- renderReactable({ + swimlane_ds <- data()[["swimlane_ds"]] + col_defs <- .with_tooltips( + subject = colDef(name = "Subject"), + visit_name = colDef(name = "Visit Name", width = 250), + visit_date = colDef(name = "Visit Date"), + form_name = colDef(name = "Form Name", width = 250), + source_system_url_link = colDef( + name = "Source System URL Link", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), + rspdn = colDef(name = "Assessment Performed"), + rspd = colDef(name = "Response Date"), + rspd_study_day = colDef(name = "Response Date Study Day"), + orsp = colDef(name = "Response", width = 250), + bma = colDef(name = "Best Marrow Aspirate"), + bmb = colDef(name = "Best Marrow Biopsy"), + comnts = colDef(name = "Comments") + ) + mm_response <- swimlane_ds |> + filter(event_study_day %in% plotly_selected()$x, subject %in% plotly_selected()$y) |> + select(all_of(names(col_defs))) + if (nrow(mm_response) == 0) { + return() + } + + reactable( + mm_response, + class = "custom-reactable", + columns = col_defs, + defaultPageSize = 10, + wrap = FALSE, + searchable = TRUE, + sortable = TRUE + ) + }) + + output$tx_listing <- renderReactable({ + swimlane_ds <- data()[["swimlane_ds"]] + + col_defs <- .with_tooltips( + site_name = colDef(name = "Site Name"), + subject = colDef(name = "Subject"), + visit_name = colDef(name = "Visit Name"), + visit_date = colDef(name = "Visit Date"), + form_name = colDef(name = "Form Name"), + source_system_url_link = colDef( + name = "Source System URL Link", + cell = function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } + ), + txnam = colDef(name = "Study Drug Name"), + txrec = colDef(name = "Study Drug Administered"), + txrecrs = colDef(name = "Reason Study Drug Not Admin"), + txd_study_day = colDef(name = "Date Administered Study Day"), + date_administered = colDef(name = "Date Administered"), + cydly = colDef(name = "Cycle Delay"), + cydlyrs = colDef(name = "Cycle Delay Reason"), + cydlyae = colDef(name = "Cycle Delay Adverse Event"), + txdly = colDef(name = "Dose Delay"), + txdlyrs = colDef(name = "Dose Delay Reason"), + txdlyae = colDef(name = "AE related to Dose Delay"), + txpdos = colDef(name = "Planned Dose per Admin"), + txpdosu = colDef(name = "Planned Dose per Admin Unit"), + frqdv = colDef(name = "Frequency"), + txrte = colDef(name = "Route of Administration"), + txform = colDef(name = "Dose Formulation"), + txdmod = colDef(name = "Dose Modification"), + txrmod = colDef(name = "Dose Modification Reason"), + txdmae = colDef(name = "AE related to Dose Modification"), + txad = colDef(name = "Total Dose Administered"), + txadu = colDef(name = "Total Dose Administered Unit"), + txd = colDef(name = "Date Administered"), + txstm = colDef(name = "Start Time Administered"), + txstmu = colDef(name = "Start Time Administered Unknown"), + txed = colDef(name = "End Date Administered"), + txetm = colDef(name = "End Time Administered"), + txetmu = colDef(name = "End Time Administered Unknown"), + txtm = colDef(name = "Time Administered"), + txtmu = colDef(name = "Time Administered Unknown"), + txed_study_day = colDef(name = "End Study Day"), + infrt = colDef(name = "Infusion Rate"), + infrtu = colDef(name = "Infusion Rate Unit"), + tximod = colDef(name = "Infusion Modified?"), + txirmod = colDef(name = "Reason for Infusion modification"), + tximae = colDef(name = "AE related to Infusion Modification") + ) + tx_listing <- swimlane_ds |> + filter(event_study_day %in% plotly_selected()$x, subject %in% plotly_selected()$y) |> + select(all_of(names(col_defs))) + if (nrow(tx_listing) == 0) { + return() + } + + reactable( + tx_listing, + columns = col_defs, + defaultPageSize = 10, + wrap = FALSE, + searchable = TRUE, + sortable = TRUE + ) + }) + }) + } + module( + label = label, + ui = ui, + server = server, + datanames = "all", + ui_args = list(height = plot_height) + ) +} \ No newline at end of file From d028c8e0d66e38c50b309ab3ea19c5918cfff3fd Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Fri, 14 Feb 2025 17:51:20 +0100 Subject: [PATCH 36/92] labels to the data --- R/tm_p_spiderplot.R | 200 ++++++++++++-------------------------------- 1 file changed, 52 insertions(+), 148 deletions(-) diff --git a/R/tm_p_spiderplot.R b/R/tm_p_spiderplot.R index acefe34f8..d5cb40251 100644 --- a/R/tm_p_spiderplot.R +++ b/R/tm_p_spiderplot.R @@ -1,6 +1,5 @@ - -tm_p_spiderplot <- function(label = "Spiderplot", - time_var, +tm_p_spiderplot <- function(label = "Spiderplot", + time_var, subject_var, value_var, plot_height = 600) { @@ -70,12 +69,12 @@ ui_p_spiderplot <- function(id, height) { ) } -srv_p_spiderplot <- function(id, - data, +srv_p_spiderplot <- function(id, + data, time_var, subject_var, value_var, - filter_panel_api, + filter_panel_api, plot_height = 600) { moduleServer(id, function(input, output, session) { spiderplot_ds <- reactive(data()[["spiderplot_ds"]]) @@ -98,7 +97,7 @@ srv_p_spiderplot <- function(id, y_title <- selected_event spiderplot_ds_filtered <- spiderplot_ds |> filter(event_type == selected_event) - + p <- plotly::plot_ly(source = "spiderplot", height = height) |> plotly::add_markers( x = ~time_var, y = ~value_var, color = ~subject_var, @@ -119,76 +118,40 @@ srv_p_spiderplot <- function(id, } ) }) - + output$plot <- plotly::renderPlotly({ plotly::event_register( plotly_q()$p, "plotly_selected" ) }) - + plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) - - - resp_cols <- .with_tooltips( - subject = colDef(name = "Subject"), - raise_query = colDef( - name = "Raise Query", - cell = function(value) { - if (!is.na(value) && !is.null(value) && value != "") { - htmltools::tags$a(href = value, target = "_blank", "Link") - } else { - "N/A" - } - } - ), - visit_name = colDef(name = "Visit Name"), - rspdn = colDef(name = "Assessment Performed"), - rspd = colDef(name = "Response Date"), - rspd_study_day = colDef(name = "Response Date Study Day"), - orsp = colDef(name = "Response"), - bma = colDef(name = "Best Marrow Aspirate"), - bmb = colDef(name = "Best Marrow Biopsy"), - comnts = colDef(name = "Comments") + + + resp_cols <- c( + subject, raise_query, visit_name, rspdn, rspd, rspd_study_day, + orsp, bma, bmb, comnts ) - - selected_recent_subject <- reactiveVal(NULL) - - data_w_brushed <- reactive({ - req(plotly_selected()) - within( - data(), - time_var = str2lang(time_var), - subject_var = str2lang(subject_var), - value_var = str2lang(value_var), - expr = { - selected_subjects <- spiderplot_ds |> - filter(time_var %in% plotly_selected()$x, value_var %in% plotly_selected()$y) |> - pull(subject_var) - } - ) - }) - plotly_selected_subjects <- reactive({ - req(data_w_brushed()) - within( - data_w_brushed(), { - spiderplot_ds <- spiderplot_ds |> - filter(event_type == "latest_response_assessment") |> - filter(subject %in% selected_subjects) |> - select(all_of(names(resp_cols))) - } - ) + data()[["spiderplot_ds"]] |> + filter(event_study_day %in% plotly_selected()$x, event_result %in% plotly_selected()$y) |> + pull(subject) + }) + recent_resp_ds <- reactive({ + data()[["spiderplot_ds"]] |> + filter(event_type == "latest_response_assessment") |> + filter(subject %in% plotly_selected_subjects()) |> + select(all_of(resp_cols)) }) - + output$recent_resp <- renderReactable({ req(plotly_selected_subjects()) - reactable( recent_resp_ds(), - columns = resp_cols, + # columns = resp_cols, selection = "single", onClick = "select", defaultPageSize = 15, @@ -203,128 +166,69 @@ srv_p_spiderplot <- function(id, ") ) }) - + table_selected_subjects <- reactive({ selected_row <- getReactableState("recent_resp", "selected") if (!is.null(selected_row)) { - recent_resp_ds()[selected_row, ][[subject_var]] + recent_resp_ds()[selected_row, ]$subject } else { - unique(recent_resp_ds()[[subject_var]]) + unique(recent_resp_ds()$subject) } }) - + all_resp <- reactive({ data()[["spiderplot_ds"]] |> filter(event_type == "response_assessment") |> - select(all_of(names(resp_cols))) |> + select(all_of(resp_cols)) |> filter(subject %in% plotly_selected_subjects()) |> filter(subject %in% table_selected_subjects()) }) - + output$all_resp <- renderReactable({ if (nrow(all_resp()) == 0) { return() } - + reactable( all_resp(), - columns = resp_cols, + # columns = resp_cols, defaultPageSize = 15, wrap = FALSE ) }) - - spep_cols <- .with_tooltips( - subject = colDef(name = "Subject"), - visit_name = colDef(name = "Visit Name"), - visit_date = colDef(name = "Visit Date"), - form_name = colDef(name = "Form Name"), - source_system_url_link = colDef( - name = "Source System URL Link", - cell = function(value) { - if (!is.na(value) && !is.null(value) && value != "") { - htmltools::tags$a(href = value, target = "_blank", "Link") - } else { - "N/A" - } - } - ), - rspdn = colDef(name = "Assessment Performed"), - rspd = colDef(name = "Response Date"), - rspd_study_day = colDef(name = "Response Date Study Day"), - orsp = colDef(name = "Response"), - bma = colDef(name = "Best Marrow Aspirate"), - bmb = colDef(name = "Best Marrow Biopsy"), - comnts = colDef(name = "Comments"), - asmntdn = colDef(name = "Assessment Not Done"), - blq = colDef(name = "Serum M-protein too small to quantify"), - coldr = colDef(name = "Collection Date"), - cold_study_day = colDef(name = "Collection Study Day"), - coltm = colDef(name = "Collection Time"), - coltmu = colDef(name = "Collection Time Unknown"), - lrspep1 = colDef(name = "Another Form added?"), - mprte_raw = colDef(name = "Serum M-protein"), - mprtec = colDef(name = "SPEP Serum M-protein detection") + + spep_cols <- with_tooltips( + subject, visit_name, visit_date, form_name, source_system_url_link, rspdn, rspd, rspd_study_day, orsp, bma, + bmb, comnts, asmntdn, blq, coldr, cold_study_day, coltm, coltmu, lrspep1, mprte_raw, mprtec ) - + spep <- reactive({ data()[["spiderplot_ds"]] |> filter(event_type == "Serum M-protein") |> filter(subject %in% table_selected_subjects()) |> - select(all_of(names(spep_cols))) + select(all_of(spep_cols)) }) - + output$spep_listing <- renderReactable({ if (nrow(spep()) == 0) { return() } - + reactable( spep(), - columns = spep_cols, + # columns = spep_cols, defaultPageSize = 5, wrap = FALSE ) }) - - - sflc_cols <- .with_tooltips( - subject = colDef(name = "Subject"), - visit_name = colDef(name = "Visit Name"), - visit_date = colDef(name = "Visit Date"), - form_name = colDef(name = "Form Name"), - source_system_url_link = colDef( - name = "Source System URL Link", - cell = function(value) { - if (!is.na(value) && !is.null(value) && value != "") { - htmltools::tags$a(href = value, target = "_blank", "Link") - } else { - "N/A" - } - } - ), - rspdn = colDef(name = "Assessment Performed"), - rspd = colDef(name = "Response Date"), - rspd_study_day = colDef(name = "Response Date Study Day"), - orsp = colDef(name = "Response"), - bma = colDef(name = "Best Marrow Aspirate"), - bmb = colDef(name = "Best Marrow Biopsy"), - comnts = colDef(name = "Comments"), - asmntdn = colDef(name = "Assessment Not Done"), - blq = colDef(name = "Serum M-protein too small to quantify"), - coldr = colDef(name = "Collection Date"), - cold_study_day = colDef(name = "Collection Study Day"), - coltm = colDef(name = "Collection Time"), - coltmu = colDef(name = "Collection Time Unknown"), - lchfrc = colDef(name = "Presence of Serum free light chains"), - lchfr_raw = colDef(name = "Serum free light chain results"), - klchf_raw = colDef(name = "Kappa free light chain results"), - llchf_raw = colDef(name = "Lambda free light chain results"), - klchp_raw = colDef(name = "Kappa-Lambda free light chain ratio"), - mprte_raw = colDef(name = "Serum M-protein"), - mprtec = colDef(name = "SPEP Serum M-protein detection") + + + sflc_cols <- with_tooltips( + subject, visit_name, visit_date, form_name, source_system_url_link, rspdn, rspd, rspd_study_day, orsp, bma, + bmb, comnts, asmntdn, blq, coldr, cold_study_day, coltm, coltmu, lchfrc, lchfr_raw, klchf_raw, llchf_raw, + klchp_raw, mprte_raw, mprtec ) - + sflc <- reactive({ data()[["spiderplot_ds"]] |> filter( @@ -335,17 +239,17 @@ srv_p_spiderplot <- function(id, ) ) |> filter(subject %in% table_selected_subjects()) |> - select(all_of(names(sflc_cols))) + select(all_of(sflc_cols)) }) - + output$sflc_listing <- renderReactable({ if (nrow(sflc()) == 0) { return() } - + reactable( sflc(), - columns = sflc_cols, + # columns = sflc_cols, defaultPageSize = 5, wrap = FALSE ) From 78e1f2a1807c67870ea354f87ca962196f3d6b54 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Fri, 14 Feb 2025 16:58:33 +0000 Subject: [PATCH 37/92] fix --- R/tm_p_spiderplot.R | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/R/tm_p_spiderplot.R b/R/tm_p_spiderplot.R index d5cb40251..c9db0d7d4 100644 --- a/R/tm_p_spiderplot.R +++ b/R/tm_p_spiderplot.R @@ -130,8 +130,8 @@ srv_p_spiderplot <- function(id, resp_cols <- c( - subject, raise_query, visit_name, rspdn, rspd, rspd_study_day, - orsp, bma, bmb, comnts + "subject", "raise_query", "visit_name", "rspdn", "rspd", "rspd_study_day", + "orsp", "bma", "bmb", "comnts" ) plotly_selected_subjects <- reactive({ @@ -197,9 +197,11 @@ srv_p_spiderplot <- function(id, ) }) - spep_cols <- with_tooltips( - subject, visit_name, visit_date, form_name, source_system_url_link, rspdn, rspd, rspd_study_day, orsp, bma, - bmb, comnts, asmntdn, blq, coldr, cold_study_day, coltm, coltmu, lrspep1, mprte_raw, mprtec + spep_cols <- c( + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", + "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts", + "asmntdn", "blq", "coldr", "cold_study_day", "coltm", "coltmu", "lrspep1", + "mprte_raw", "mprtec" ) spep <- reactive({ @@ -223,10 +225,11 @@ srv_p_spiderplot <- function(id, }) - sflc_cols <- with_tooltips( - subject, visit_name, visit_date, form_name, source_system_url_link, rspdn, rspd, rspd_study_day, orsp, bma, - bmb, comnts, asmntdn, blq, coldr, cold_study_day, coltm, coltmu, lchfrc, lchfr_raw, klchf_raw, llchf_raw, - klchp_raw, mprte_raw, mprtec + sflc_cols <- c( + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", + "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", + "coltm", "coltmu", "lchfrc", "lchfr_raw", "klchf_raw", "llchf_raw", + "klchp_raw", "mprte_raw", "mprtec" ) sflc <- reactive({ From 2c94370d94231b2318eb9ea04e5436b7a4be069e Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Fri, 14 Feb 2025 18:22:43 +0100 Subject: [PATCH 38/92] add reactable module --- R/tm_p_spiderplot.R | 16 +++++++-------- R/tm_t_reactable.R | 50 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+), 8 deletions(-) create mode 100644 R/tm_t_reactable.R diff --git a/R/tm_p_spiderplot.R b/R/tm_p_spiderplot.R index c9db0d7d4..25cdbb85d 100644 --- a/R/tm_p_spiderplot.R +++ b/R/tm_p_spiderplot.R @@ -51,19 +51,19 @@ ui_p_spiderplot <- function(id, height) { div( class = "simple-card", h4("Disease Assessment - SFLC"), - reactableOutput(ns("sflc_listing")) + ui_t_reactable(ns("sflc_listing")) ), div( class = "simple-card", h4("Disease Assessment - SPEP"), - reactableOutput(ns("spep_listing")) + ui_t_reactable(ns("spep_listing")) ) ), div( class = "simple-card", style = "width: 50%", h4("Multiple Myeloma Response"), - reactableOutput(ns("all_resp")) + ui_t_reactable(ns("all_resp")) ) ) ) @@ -198,9 +198,9 @@ srv_p_spiderplot <- function(id, }) spep_cols <- c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", - "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts", - "asmntdn", "blq", "coldr", "cold_study_day", "coltm", "coltmu", "lrspep1", + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", + "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts", + "asmntdn", "blq", "coldr", "cold_study_day", "coltm", "coltmu", "lrspep1", "mprte_raw", "mprtec" ) @@ -226,8 +226,8 @@ srv_p_spiderplot <- function(id, sflc_cols <- c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", - "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", + "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", "coltm", "coltmu", "lchfrc", "lchfr_raw", "klchf_raw", "llchf_raw", "klchp_raw", "mprte_raw", "mprtec" ) diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R new file mode 100644 index 000000000..e1ebd8c9d --- /dev/null +++ b/R/tm_t_reactable.R @@ -0,0 +1,50 @@ +#' @param ... () additional [reactable()] arguments +#' @export +tm_t_reactables <- function(label = "Table", datanames, transformators = list(), decorators = list(), ...) { + module( + label = label, + ui = ui_t_reactable, + srv = srv_t_reactable, + ui_args = list(decorators = decorators), + srv_args = c(list(datanames = datanames, decorators = decorators), rlang::list(...)) + datanames = datanames, + transformers = transformers + ) +} + +ui_t_reactable <- function(id) { + ns <- NS(id) + div( + class = "simple-card", + reactable::reactableOutput(ns("table")) + ) +} + +srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, ...) { + moduleServer(id, function(input, output, session)) { + output$table <- reactable::renderReactable({ + req(data()) + dataset <- data()[[dataname]] + args <- modifyList( + list( + dataset, + columns = teal.data::col_labels(dataset) + selection = "single", + onClick = "select", + defaultPageSize = 15, + wrap = FALSE, + rowClass = JS(" + function(rowInfo) { + console.log(rowInfo); + if (rowInfo.selected) { + return 'selected-row'; + } + } + ") + ), + list(...) + ) + do.call(reactable::reactable, args = args) + }) + }) +} From 4f62e13addf2a23c990c2e70975a5d2653e9a74c Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Fri, 14 Feb 2025 19:30:51 +0000 Subject: [PATCH 39/92] wip modularize --- R/tm_p_spiderplot.R | 254 ++++++++++++++++++++++---------------------- R/tm_t_reactable.R | 65 ++++++++---- 2 files changed, 169 insertions(+), 150 deletions(-) diff --git a/R/tm_p_spiderplot.R b/R/tm_p_spiderplot.R index 25cdbb85d..9bf83ef72 100644 --- a/R/tm_p_spiderplot.R +++ b/R/tm_p_spiderplot.R @@ -35,7 +35,7 @@ ui_p_spiderplot <- function(id, height) { style = "width: 50%", tagList( h4("Most Recent Resp and Best Resp"), - reactableOutput(ns("recent_resp")) + ui_t_reactable(ns("recent_resp")) ) ), div( @@ -51,12 +51,12 @@ ui_p_spiderplot <- function(id, height) { div( class = "simple-card", h4("Disease Assessment - SFLC"), - ui_t_reactable(ns("sflc_listing")) + reactable::reactableOutput(ns("sflc_listing")) ), div( class = "simple-card", h4("Disease Assessment - SPEP"), - ui_t_reactable(ns("spep_listing")) + reactable::reactableOutput(ns("spep_listing")) ) ), div( @@ -77,7 +77,8 @@ srv_p_spiderplot <- function(id, filter_panel_api, plot_height = 600) { moduleServer(id, function(input, output, session) { - spiderplot_ds <- reactive(data()[["spiderplot_ds"]]) + dataname <- "spiderplot_ds" + spiderplot_ds <- reactive(data()[[dataname]]) observeEvent(spiderplot_ds(), { event_types <- unique(spiderplot_ds()$event_type) updateSelectInput( @@ -88,24 +89,25 @@ srv_p_spiderplot <- function(id, plotly_q <- reactive({ data() |> within( - selected_event = input$event_type, - height = input$plot_height, + dataname = str2lang(dataname), + dataname_filtered = str2lang(sprintf("%s_filtered", dataname)), time_var = str2lang(time_var), subject_var = str2lang(subject_var), value_var = str2lang(value_var), + selected_event = input$event_type, + height = input$plot_height, expr = { y_title <- selected_event - spiderplot_ds_filtered <- spiderplot_ds |> - filter(event_type == selected_event) + dataname_filtered <- filter(dataname, event_type == selected_event) p <- plotly::plot_ly(source = "spiderplot", height = height) |> plotly::add_markers( x = ~time_var, y = ~value_var, color = ~subject_var, - data = spiderplot_ds_filtered + data = dataname_filtered ) |> plotly::add_lines( x = ~time_var, y = ~value_var, color = ~subject_var, - data = spiderplot_ds_filtered, + data = dataname_filtered, showlegend = FALSE ) |> plotly::layout( @@ -120,10 +122,7 @@ srv_p_spiderplot <- function(id, }) output$plot <- plotly::renderPlotly({ - plotly::event_register( - plotly_q()$p, - "plotly_selected" - ) + plotly::event_register(plotly_q()$p, "plotly_selected") }) plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) @@ -134,129 +133,126 @@ srv_p_spiderplot <- function(id, "orsp", "bma", "bmb", "comnts" ) - plotly_selected_subjects <- reactive({ - data()[["spiderplot_ds"]] |> - filter(event_study_day %in% plotly_selected()$x, event_result %in% plotly_selected()$y) |> - pull(subject) - }) - - recent_resp_ds <- reactive({ - data()[["spiderplot_ds"]] |> - filter(event_type == "latest_response_assessment") |> - filter(subject %in% plotly_selected_subjects()) |> - select(all_of(resp_cols)) - }) - - output$recent_resp <- renderReactable({ - req(plotly_selected_subjects()) - reactable( - recent_resp_ds(), - # columns = resp_cols, - selection = "single", - onClick = "select", - defaultPageSize = 15, - wrap = FALSE, - rowClass = JS(" - function(rowInfo) { - console.log(rowInfo); - if (rowInfo.selected) { - return 'selected-row'; - } - } - ") - ) - }) - - table_selected_subjects <- reactive({ - selected_row <- getReactableState("recent_resp", "selected") - if (!is.null(selected_row)) { - recent_resp_ds()[selected_row, ]$subject - } else { - unique(recent_resp_ds()$subject) - } - }) - - all_resp <- reactive({ - data()[["spiderplot_ds"]] |> - filter(event_type == "response_assessment") |> - select(all_of(resp_cols)) |> - filter(subject %in% plotly_selected_subjects()) |> - filter(subject %in% table_selected_subjects()) - }) - - output$all_resp <- renderReactable({ - if (nrow(all_resp()) == 0) { - return() - } - - reactable( - all_resp(), - # columns = resp_cols, - defaultPageSize = 15, - wrap = FALSE + plotly_selected_q <- reactive({ + req(plotly_selected()) + within( + plotly_q(), + dataname = str2lang(dataname), # todo: replace with argument + time_var = str2lang(time_var), + subject_var = subject_var, + value_var = str2lang(value_var), + time_vals = plotly_selected()$x, + value_vals = plotly_selected()$y, + expr = { + brushed_subjects <- dplyr::filter( + dataname, time_var %in% time_vals, value_var %in% value_vals + )[[subject_var]] + } ) }) - spep_cols <- c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", - "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts", - "asmntdn", "blq", "coldr", "cold_study_day", "coltm", "coltmu", "lrspep1", - "mprte_raw", "mprtec" - ) - - spep <- reactive({ - data()[["spiderplot_ds"]] |> - filter(event_type == "Serum M-protein") |> - filter(subject %in% table_selected_subjects()) |> - select(all_of(spep_cols)) - }) - - output$spep_listing <- renderReactable({ - if (nrow(spep()) == 0) { - return() - } - - reactable( - spep(), - # columns = spep_cols, - defaultPageSize = 5, - wrap = FALSE + recent_resp_q <- reactive({ + req(plotly_selected_q()) + within( + plotly_selected_q(), + dataname = str2lang(dataname), + subject_var = str2lang(subject_var), + resp_cols = resp_cols, + expr = { + recent_resp <- dplyr::filter( + dataname, + event_type == "latest_response_assessment", + subject_var %in% brushed_subjects # todo: figure this out + ) |> + select(all_of(resp_cols)) + } ) }) - - - sflc_cols <- c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", - "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", - "coltm", "coltmu", "lchfrc", "lchfr_raw", "klchf_raw", "llchf_raw", - "klchp_raw", "mprte_raw", "mprtec" - ) - - sflc <- reactive({ - data()[["spiderplot_ds"]] |> - filter( - event_type %in% c( - "Kappa free light chain quantity", - "Lambda free light chain quantity", - "Kappa-Lambda free light chain ratio" + + recent_resp_selected_q <- srv_t_reactable("recent_resp", data = recent_resp_q, dataname = "recent_resp") + # + all_resp_q <- reactive({ + req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) + within( + recent_resp_selected_q(), + dataname = str2lang(dataname), + subject_var = str2lang(subject_var), + subject_var_char = subject_var, + expr = { + all_resp <- filter( + dataname, + event_type == "response_assessment", + subject_var == recent_resp_selected[[subject_var_char]] ) - ) |> - filter(subject %in% table_selected_subjects()) |> - select(all_of(sflc_cols)) - }) - - output$sflc_listing <- renderReactable({ - if (nrow(sflc()) == 0) { - return() - } - - reactable( - sflc(), - # columns = sflc_cols, - defaultPageSize = 5, - wrap = FALSE + } ) }) + + #todo: show all_resp only if recent_resp is selected + srv_t_reactable("all_resp", data = all_resp_q, dataname = "all_resp") + + # + # spep_cols <- c( + # "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", + # "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts", + # "asmntdn", "blq", "coldr", "cold_study_day", "coltm", "coltmu", "lrspep1", + # "mprte_raw", "mprtec" + # ) + # + # spep <- reactive({ + # req(table_selected_subjects()) + # data()[["spiderplot_ds"]] |> + # filter(event_type == "Serum M-protein") |> + # filter(subject %in% table_selected_subjects()) |> + # select(all_of(spep_cols)) + # }) + # + # output$spep_listing <- renderReactable({ + # if (nrow(spep()) == 0) { + # return() + # } + # + # reactable( + # spep(), + # # columns = spep_cols, + # defaultPageSize = 5, + # wrap = FALSE + # ) + # }) + # + # + # sflc_cols <- c( + # "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", + # "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", + # "coltm", "coltmu", "lchfrc", "lchfr_raw", "klchf_raw", "llchf_raw", + # "klchp_raw", "mprte_raw", "mprtec" + # ) + # + # sflc <- reactive({ + # data()[["spiderplot_ds"]] |> + # filter( + # event_type %in% c( + # "Kappa free light chain quantity", + # "Lambda free light chain quantity", + # "Kappa-Lambda free light chain ratio" + # ) + # ) |> + # filter(subject %in% table_selected_subjects()) |> + # select(all_of(sflc_cols)) + # }) + # + # output$sflc_listing <- renderReactable({ + # if (nrow(sflc()) == 0) { + # return() + # } + # + # reactable( + # sflc(), + # # columns = sflc_cols, + # defaultPageSize = 5, + # wrap = FALSE + # ) + # }) }) } diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index e1ebd8c9d..de72d3ed5 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -6,7 +6,7 @@ tm_t_reactables <- function(label = "Table", datanames, transformators = list(), ui = ui_t_reactable, srv = srv_t_reactable, ui_args = list(decorators = decorators), - srv_args = c(list(datanames = datanames, decorators = decorators), rlang::list(...)) + srv_args = c(list(datanames = datanames, decorators = decorators), rlang::list(...)), datanames = datanames, transformers = transformers ) @@ -21,30 +21,53 @@ ui_t_reactable <- function(id) { } srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, ...) { - moduleServer(id, function(input, output, session)) { - output$table <- reactable::renderReactable({ + moduleServer(id, function(input, output, session) { + dataname_reactable <- sprintf("%s_reactable", dataname) + table_q <- reactive({ req(data()) - dataset <- data()[[dataname]] - args <- modifyList( - list( - dataset, - columns = teal.data::col_labels(dataset) - selection = "single", - onClick = "select", - defaultPageSize = 15, - wrap = FALSE, - rowClass = JS(" + within( + data(), + dataname_reactable = str2lang(dataname_reactable), + dataname = str2lang(dataname), + { + dataname_reactable <- reactable::reactable( + dataname, + #columns = teal.data::col_labels(dataset), # todo: replace with labels + selection = "single", + onClick = "select", + defaultPageSize = 15, + wrap = FALSE, + rowClass = JS(" function(rowInfo) { - console.log(rowInfo); - if (rowInfo.selected) { - return 'selected-row'; + console.log(rowInfo); + if (rowInfo.selected) { + return 'selected-row'; + } } - } - ") - ), - list(...) + ") + ) + dataname_reactable + + } ) - do.call(reactable::reactable, args = args) }) + output$table <- reactable::renderReactable(table_q()[[dataname_reactable]]) + table_selected_q <- reactive({ + selected_row <- reactable::getReactableState("table", "selected") + if (!is.null(selected_row)) { + within( + table_q(), + selected_row = selected_row, + dataname_selected = str2lang(sprintf("%s_selected", dataname)), + dataname = str2lang(dataname), + expr = { + dataname_selected <- dataname[selected_row, ] + } + ) + } else { + table_q() + } + }) + table_selected_q }) } From 2065b713560d4373c644d3de70bb5f50ee0f442d Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Fri, 14 Feb 2025 22:17:19 +0000 Subject: [PATCH 40/92] autolabels --- R/tm_p_spiderplot.R | 138 +++++++++++++++++++++----------------------- R/tm_t_reactable.R | 83 +++++++++++++++++--------- 2 files changed, 124 insertions(+), 97 deletions(-) diff --git a/R/tm_p_spiderplot.R b/R/tm_p_spiderplot.R index 9bf83ef72..ff5c984c2 100644 --- a/R/tm_p_spiderplot.R +++ b/R/tm_p_spiderplot.R @@ -51,12 +51,12 @@ ui_p_spiderplot <- function(id, height) { div( class = "simple-card", h4("Disease Assessment - SFLC"), - reactable::reactableOutput(ns("sflc_listing")) + ui_t_reactable(ns("sflc_listing")) ), div( class = "simple-card", h4("Disease Assessment - SPEP"), - reactable::reactableOutput(ns("spep_listing")) + ui_t_reactable(ns("spep_listing")) ) ), div( @@ -132,6 +132,18 @@ srv_p_spiderplot <- function(id, "subject", "raise_query", "visit_name", "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts" ) + spep_cols <- c( + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", + "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts", + "asmntdn", "blq", "coldr", "cold_study_day", "coltm", "coltmu", "lrspep1", + "mprte_raw", "mprtec" + ) + sflc_cols <- c( + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", + "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", + "coltm", "coltmu", "lchfrc", "lchfr_raw", "klchf_raw", "llchf_raw", + "klchp_raw", "mprte_raw", "mprtec" + ) plotly_selected_q <- reactive({ req(plotly_selected()) @@ -169,8 +181,11 @@ srv_p_spiderplot <- function(id, ) }) - recent_resp_selected_q <- srv_t_reactable("recent_resp", data = recent_resp_q, dataname = "recent_resp") - # + recent_resp_selected_q <- srv_t_reactable( + "recent_resp", data = recent_resp_q, dataname = "recent_resp", selection = "single" + ) + + all_resp_q <- reactive({ req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) within( @@ -178,81 +193,62 @@ srv_p_spiderplot <- function(id, dataname = str2lang(dataname), subject_var = str2lang(subject_var), subject_var_char = subject_var, + resp_cols = resp_cols, expr = { - all_resp <- filter( + all_resp <- dplyr::filter( dataname, event_type == "response_assessment", - subject_var == recent_resp_selected[[subject_var_char]] - ) + subject_var %in% unique(recent_resp_selected[[subject_var_char]]) + ) |> + select(all_of(resp_cols)) + } + ) + }) + spep_q <- reactive({ + req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) + within( + recent_resp_selected_q(), + dataname = str2lang(dataname), + subject_var = str2lang(subject_var), + subject_var_char = subject_var, + spep_cols = spep_cols, + expr = { + spep <- dplyr::filter( + dataname, + event_type == "Serum M-protein", + subject_var %in% unique(recent_resp_selected[[subject_var_char]]) + ) |> + select(all_of(spep_cols)) + } + ) + }) + sflc_q <- reactive({ + req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) + within( + recent_resp_selected_q(), + dataname = str2lang(dataname), + subject_var = str2lang(subject_var), + subject_var_char = subject_var, + sflc_cols = sflc_cols, + expr = { + sflc <- dplyr::filter( + dataname, + event_type %in% c( + "Kappa free light chain quantity", + "Lambda free light chain quantity", + "Kappa-Lambda free light chain ratio" + ), + subject_var %in% unique(recent_resp_selected[[subject_var_char]]) + ) |> + select(all_of(sflc_cols)) } ) }) #todo: show all_resp only if recent_resp is selected - srv_t_reactable("all_resp", data = all_resp_q, dataname = "all_resp") - - # - # spep_cols <- c( - # "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", - # "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts", - # "asmntdn", "blq", "coldr", "cold_study_day", "coltm", "coltmu", "lrspep1", - # "mprte_raw", "mprtec" - # ) - # - # spep <- reactive({ - # req(table_selected_subjects()) - # data()[["spiderplot_ds"]] |> - # filter(event_type == "Serum M-protein") |> - # filter(subject %in% table_selected_subjects()) |> - # select(all_of(spep_cols)) - # }) - # - # output$spep_listing <- renderReactable({ - # if (nrow(spep()) == 0) { - # return() - # } - # - # reactable( - # spep(), - # # columns = spep_cols, - # defaultPageSize = 5, - # wrap = FALSE - # ) - # }) - # - # - # sflc_cols <- c( - # "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", - # "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", - # "coltm", "coltmu", "lchfrc", "lchfr_raw", "klchf_raw", "llchf_raw", - # "klchp_raw", "mprte_raw", "mprtec" - # ) - # - # sflc <- reactive({ - # data()[["spiderplot_ds"]] |> - # filter( - # event_type %in% c( - # "Kappa free light chain quantity", - # "Lambda free light chain quantity", - # "Kappa-Lambda free light chain ratio" - # ) - # ) |> - # filter(subject %in% table_selected_subjects()) |> - # select(all_of(sflc_cols)) - # }) - # - # output$sflc_listing <- renderReactable({ - # if (nrow(sflc()) == 0) { - # return() - # } - # - # reactable( - # sflc(), - # # columns = sflc_cols, - # defaultPageSize = 5, - # wrap = FALSE - # ) - # }) + all_resp_selected_q <- srv_t_reactable("all_resp", data = all_resp_q, dataname = "all_resp") + spep_selected_d <- srv_t_reactable("spep_listing", data = spep_q, dataname = "spep") + sflc_selected_d <- srv_t_reactable("sflc_listing", data = sflc_q, dataname = "sflc") }) } diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index de72d3ed5..e6cea5e7c 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -6,7 +6,7 @@ tm_t_reactables <- function(label = "Table", datanames, transformators = list(), ui = ui_t_reactable, srv = srv_t_reactable, ui_args = list(decorators = decorators), - srv_args = c(list(datanames = datanames, decorators = decorators), rlang::list(...)), + srv_args = c(list(datanames = datanames, decorators = decorators), rlang::list2(...)), datanames = datanames, transformers = transformers ) @@ -23,33 +23,34 @@ ui_t_reactable <- function(id) { srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, ...) { moduleServer(id, function(input, output, session) { dataname_reactable <- sprintf("%s_reactable", dataname) - table_q <- reactive({ - req(data()) - within( - data(), - dataname_reactable = str2lang(dataname_reactable), - dataname = str2lang(dataname), - { - dataname_reactable <- reactable::reactable( - dataname, - #columns = teal.data::col_labels(dataset), # todo: replace with labels - selection = "single", - onClick = "select", - defaultPageSize = 15, - wrap = FALSE, - rowClass = JS(" - function(rowInfo) { - console.log(rowInfo); - if (rowInfo.selected) { - return 'selected-row'; - } + + reactable_call <- reactive({ + default_args <- list( + columns = .make_reactable_columns_call(data()[[dataname]]), + onClick = "select", + defaultPageSize = 15, + wrap = FALSE, + rowClass = JS(" + function(rowInfo) { + if (rowInfo.selected) { + return 'selected-row'; } - ") - ) - dataname_reactable - - } + } + ") + ) + args <- modifyList(default_args, rlang::list2(...)) + substitute( + lhs <- rhs, + list( + lhs = dataname_reactable, + rhs = .make_reactable_call(dataname = dataname, args = args) + ) ) + + }) + table_q <- reactive({ + req(data()) + eval_code(data(), reactable_call()) }) output$table <- reactable::renderReactable(table_q()[[dataname_reactable]]) table_selected_q <- reactive({ @@ -71,3 +72,33 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, .. table_selected_q }) } + +.make_reactable_call <- function(dataname, args) { + args <- c( + list(data = str2lang(dataname)), + args + ) + do.call(call, c(list(name = "reactable"), args), quote = TRUE) + +} + +.make_reactable_columns_call <- function(dataset) { + # todo: what to do with urls? + args <- lapply( + teal.data::col_labels(dataset), + function(label) { + if (!is.null(label) && !is.na(label)) { + substitute( + colDef(name = label), + list(label = label) + ) + } + } + ) + args <- Filter(length, args) + if (length(args)) { + do.call(call, c(list("list"), args), quote = TRUE) + } +} + + From 7b5ed646d15468fd2878e1ac7da308064a4192e7 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Mon, 17 Feb 2025 11:18:42 +0000 Subject: [PATCH 41/92] further abstraction --- R/tm_a_spiderplot_mdr.R | 184 +++++++++++++++++++++++++++++++++++++ R/tm_p_spiderplot.R | 199 ++++++++++------------------------------ 2 files changed, 234 insertions(+), 149 deletions(-) create mode 100644 R/tm_a_spiderplot_mdr.R diff --git a/R/tm_a_spiderplot_mdr.R b/R/tm_a_spiderplot_mdr.R new file mode 100644 index 000000000..05620717a --- /dev/null +++ b/R/tm_a_spiderplot_mdr.R @@ -0,0 +1,184 @@ +tm_a_spiderplot_mdr <- function(label = "Spiderplot", + time_var, + subject_var, + value_var, + event_var, + resp_cols = c( + "subject", "raise_query", "visit_name", "rspdn", "rspd", "rspd_study_day", + "orsp", "bma", "bmb", "comnts" + ), + spep_cols = c( + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", + "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", + "coltm", "coltmu", "lrspep1", "mprte_raw", "mprtec" + ), + sflc_cols = c( + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", + "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", + "coltm", "coltmu", "lchfrc", "lchfr_raw", "klchf_raw", "llchf_raw", + "klchp_raw", "mprte_raw", "mprtec" + ), + plot_height = 600) { + module( + label = label, + ui = ui_a_spiderplot_mdr, + server = srv_a_spiderplot_mdr, + ui_args = list(height = plot_height), + server_args = list( + time_var = time_var, + subject_var = subject_var, + value_var = value_var, + event_var = event_var, + resp_cols = resp_cols, + spep_cols = spep_cols, + sflc_cols = sflc_cols + ), + datanames = "all", + ) +} + + +ui_a_spiderplot_mdr <- function(id, height) { + ns <- NS(id) + tagList( + ui_p_spiderplot(ns("spiderplot"), height = height), + div( + style = "display: flex", + div( + style = "width: 50%", + div( + class = "simple-card", + h4("Disease Assessment - SFLC"), + ui_t_reactable(ns("sflc_listing")) + ), + div( + class = "simple-card", + h4("Disease Assessment - SPEP"), + ui_t_reactable(ns("spep_listing")) + ) + ), + div( + class = "simple-card", + style = "width: 50%", + h4("Multiple Myeloma Response"), + ui_t_reactable(ns("all_resp")) + ) + ) + ) +} + +srv_a_spiderplot_mdr <- function(id, + data, + time_var, + subject_var, + value_var, + event_var, + resp_cols, + spep_cols, + sflc_cols, + filter_panel_api, + plot_height = 600) { + moduleServer(id, function(input, output, session) { + dataname <- "spiderplot_ds" + recent_resp_selected_q <- srv_p_spiderplot( + "spiderplot", + data = data, + time_var = time_var, + subject_var = subject_var, + value_var = value_var, + event_var = event_var, + table_cols = resp_cols, + filter_panel_api = filter_panel_api, + plot_height = plot_height + ) + + all_resp_q <- reactive({ + req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) + within( + recent_resp_selected_q(), + dataname = str2lang(dataname), + subject_var = str2lang(subject_var), + subject_var_char = subject_var, + event_var = str2lang(event_var), + resp_cols = resp_cols, + expr = { + all_resp <- dplyr::filter( + dataname, + event_var == "response_assessment", + subject_var %in% unique(recent_resp_selected[[subject_var_char]]) + ) |> + select(all_of(resp_cols)) + } + ) + }) + + spep_q <- reactive({ + req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) + within( + recent_resp_selected_q(), + dataname = str2lang(dataname), + subject_var = str2lang(subject_var), + subject_var_char = subject_var, + event_var = str2lang(event_var), + spep_cols = spep_cols, + expr = { + spep <- dplyr::filter( + dataname, + event_var == "Serum M-protein", + subject_var %in% unique(recent_resp_selected[[subject_var_char]]) + ) |> + select(all_of(spep_cols)) + } + ) + }) + + sflc_q <- reactive({ + req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) + within( + recent_resp_selected_q(), + dataname = str2lang(dataname), + subject_var = str2lang(subject_var), + event_var = str2lang(event_var), + subject_var_char = subject_var, + sflc_cols = sflc_cols, + expr = { + sflc <- dplyr::filter( + dataname, + event_var %in% c( + "Kappa free light chain quantity", + "Lambda free light chain quantity", + "Kappa-Lambda free light chain ratio" + ), + subject_var %in% unique(recent_resp_selected[[subject_var_char]]) + ) |> + select(all_of(sflc_cols)) + } + ) + }) + + #todo: show all_resp only if recent_resp is selected + all_resp_selected_q <- srv_t_reactable("all_resp", data = all_resp_q, dataname = "all_resp") + spep_selected_d <- srv_t_reactable("spep_listing", data = spep_q, dataname = "spep") + sflc_selected_d <- srv_t_reactable("sflc_listing", data = sflc_q, dataname = "sflc") + + all_q <- reactive({ + # all_resp_selected_q could be nothing and `c` won't work because the result is unavailable before clicking subjects in the table + c(recent_resp_selected_q(), all_resp_selected_q()) + }) + + observeEvent(all_q(), { + "do nothing" + }) + + + }) +} + + +.with_tooltips <- function(...) { + args <- list(...) + lapply(args, function(col) { + col$header <- tags$span(col$name, title = col$name) + return(col) + }) +} diff --git a/R/tm_p_spiderplot.R b/R/tm_p_spiderplot.R index ff5c984c2..241d859f8 100644 --- a/R/tm_p_spiderplot.R +++ b/R/tm_p_spiderplot.R @@ -2,6 +2,8 @@ tm_p_spiderplot <- function(label = "Spiderplot", time_var, subject_var, value_var, + event_var, + table_cols, plot_height = 600) { module( label = label, @@ -11,7 +13,9 @@ tm_p_spiderplot <- function(label = "Spiderplot", server_args = list( time_var = time_var, subject_var = subject_var, - value_var = value_var + value_var = value_var, + event_var = event_var, + table_cols = table__cols ), datanames = "all", ) @@ -24,7 +28,7 @@ ui_p_spiderplot <- function(id, height) { div( style = "display: flex; justify-content: center; align-items: center; gap: 30px;", div( - selectInput(NS(id, "event_type"), "Select Y Axis", NULL) + selectInput(ns("select_event"), "Select Y Axis", NULL) ), div(sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)) ), @@ -43,28 +47,6 @@ ui_p_spiderplot <- function(id, height) { style = "width: 50%", plotly::plotlyOutput(ns("plot"), height = "100%") ) - ), - div( - style = "display: flex", - div( - style = "width: 50%", - div( - class = "simple-card", - h4("Disease Assessment - SFLC"), - ui_t_reactable(ns("sflc_listing")) - ), - div( - class = "simple-card", - h4("Disease Assessment - SPEP"), - ui_t_reactable(ns("spep_listing")) - ) - ), - div( - class = "simple-card", - style = "width: 50%", - h4("Multiple Myeloma Response"), - ui_t_reactable(ns("all_resp")) - ) ) ) } @@ -74,77 +56,60 @@ srv_p_spiderplot <- function(id, time_var, subject_var, value_var, + event_var, + table_cols, filter_panel_api, plot_height = 600) { moduleServer(id, function(input, output, session) { dataname <- "spiderplot_ds" + excl_events <- c("response_assessment", "latest_response_assessment") spiderplot_ds <- reactive(data()[[dataname]]) observeEvent(spiderplot_ds(), { - event_types <- unique(spiderplot_ds()$event_type) - updateSelectInput( - inputId = "event_type", - choices = event_types[!event_types %in% c("response_assessment", "latest_response_assessment")] - ) + event_levels <- setdiff(unique(spiderplot_ds()[[event_var]]), excl_events) + updateSelectInput(inputId = "select_event", choices = event_levels) }) + plotly_q <- reactive({ - data() |> - within( - dataname = str2lang(dataname), - dataname_filtered = str2lang(sprintf("%s_filtered", dataname)), - time_var = str2lang(time_var), - subject_var = str2lang(subject_var), - value_var = str2lang(value_var), - selected_event = input$event_type, - height = input$plot_height, - expr = { - y_title <- selected_event - dataname_filtered <- filter(dataname, event_type == selected_event) + within( + data(), + dataname = str2lang(dataname), + dataname_filtered = str2lang(sprintf("%s_filtered", dataname)), + time_var = str2lang(time_var), + subject_var = str2lang(subject_var), + value_var = str2lang(value_var), + selected_event = input$select_event, + height = input$plot_height, + event_var = str2lang(event_var), + expr = { + y_title <- selected_event + dataname_filtered <- filter(dataname, event_var == selected_event) - p <- plotly::plot_ly(source = "spiderplot", height = height) |> - plotly::add_markers( - x = ~time_var, y = ~value_var, color = ~subject_var, - data = dataname_filtered - ) |> - plotly::add_lines( - x = ~time_var, y = ~value_var, color = ~subject_var, - data = dataname_filtered, - showlegend = FALSE - ) |> - plotly::layout( - xaxis = list(title = "Collection Date Study Day", zeroline = FALSE), - yaxis = list(title = ~y_title), - title = ~ paste0(y_title, " Over Time") - ) |> - plotly::layout(dragmode = "select") |> - plotly::config(displaylogo = FALSE) - } - ) + p <- plotly::plot_ly(source = "spiderplot", height = height) |> + plotly::add_markers( + x = ~time_var, y = ~value_var, color = ~subject_var, + data = dataname_filtered + ) |> + plotly::add_lines( + x = ~time_var, y = ~value_var, color = ~subject_var, + data = dataname_filtered, + showlegend = FALSE + ) |> + plotly::layout( + xaxis = list(title = "Collection Date Study Day", zeroline = FALSE), + yaxis = list(title = ~y_title), + title = ~ paste0(y_title, " Over Time") + ) |> + plotly::layout(dragmode = "select") |> + plotly::config(displaylogo = FALSE) + } + ) }) - output$plot <- plotly::renderPlotly({ - plotly::event_register(plotly_q()$p, "plotly_selected") - }) + output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) - resp_cols <- c( - "subject", "raise_query", "visit_name", "rspdn", "rspd", "rspd_study_day", - "orsp", "bma", "bmb", "comnts" - ) - spep_cols <- c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", - "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts", - "asmntdn", "blq", "coldr", "cold_study_day", "coltm", "coltmu", "lrspep1", - "mprte_raw", "mprtec" - ) - sflc_cols <- c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", - "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", - "coltm", "coltmu", "lchfrc", "lchfr_raw", "klchf_raw", "llchf_raw", - "klchp_raw", "mprte_raw", "mprtec" - ) - plotly_selected_q <- reactive({ req(plotly_selected()) within( @@ -169,86 +134,22 @@ srv_p_spiderplot <- function(id, plotly_selected_q(), dataname = str2lang(dataname), subject_var = str2lang(subject_var), - resp_cols = resp_cols, + table_cols = table_cols, + event_var = str2lang(event_var), expr = { recent_resp <- dplyr::filter( dataname, - event_type == "latest_response_assessment", + event_var == "latest_response_assessment", subject_var %in% brushed_subjects # todo: figure this out ) |> - select(all_of(resp_cols)) + select(all_of(table_cols)) } ) }) - recent_resp_selected_q <- srv_t_reactable( + srv_t_reactable( "recent_resp", data = recent_resp_q, dataname = "recent_resp", selection = "single" ) - - - all_resp_q <- reactive({ - req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) - within( - recent_resp_selected_q(), - dataname = str2lang(dataname), - subject_var = str2lang(subject_var), - subject_var_char = subject_var, - resp_cols = resp_cols, - expr = { - all_resp <- dplyr::filter( - dataname, - event_type == "response_assessment", - subject_var %in% unique(recent_resp_selected[[subject_var_char]]) - ) |> - select(all_of(resp_cols)) - } - ) - }) - spep_q <- reactive({ - req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) - within( - recent_resp_selected_q(), - dataname = str2lang(dataname), - subject_var = str2lang(subject_var), - subject_var_char = subject_var, - spep_cols = spep_cols, - expr = { - spep <- dplyr::filter( - dataname, - event_type == "Serum M-protein", - subject_var %in% unique(recent_resp_selected[[subject_var_char]]) - ) |> - select(all_of(spep_cols)) - } - ) - }) - sflc_q <- reactive({ - req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) - within( - recent_resp_selected_q(), - dataname = str2lang(dataname), - subject_var = str2lang(subject_var), - subject_var_char = subject_var, - sflc_cols = sflc_cols, - expr = { - sflc <- dplyr::filter( - dataname, - event_type %in% c( - "Kappa free light chain quantity", - "Lambda free light chain quantity", - "Kappa-Lambda free light chain ratio" - ), - subject_var %in% unique(recent_resp_selected[[subject_var_char]]) - ) |> - select(all_of(sflc_cols)) - } - ) - }) - - #todo: show all_resp only if recent_resp is selected - all_resp_selected_q <- srv_t_reactable("all_resp", data = all_resp_q, dataname = "all_resp") - spep_selected_d <- srv_t_reactable("spep_listing", data = spep_q, dataname = "spep") - sflc_selected_d <- srv_t_reactable("sflc_listing", data = sflc_q, dataname = "sflc") }) } From 7426193f61c512dd04a4da498db16f12397ac732 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Mon, 17 Feb 2025 12:25:07 +0000 Subject: [PATCH 42/92] fixes --- R/tm_a_spiderplot_mdr.R | 48 ++++++++++++++++++++++------------------- R/tm_data_table.R | 16 ++++++++------ R/tm_p_spiderplot.R | 15 +++++++------ R/tm_p_swimlane.R | 2 -- 4 files changed, 44 insertions(+), 37 deletions(-) diff --git a/R/tm_a_spiderplot_mdr.R b/R/tm_a_spiderplot_mdr.R index 05620717a..569ce07d0 100644 --- a/R/tm_a_spiderplot_mdr.R +++ b/R/tm_a_spiderplot_mdr.R @@ -1,30 +1,32 @@ tm_a_spiderplot_mdr <- function(label = "Spiderplot", - time_var, - subject_var, - value_var, - event_var, - resp_cols = c( - "subject", "raise_query", "visit_name", "rspdn", "rspd", "rspd_study_day", - "orsp", "bma", "bmb", "comnts" - ), - spep_cols = c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", - "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", - "coltm", "coltmu", "lrspep1", "mprte_raw", "mprtec" - ), - sflc_cols = c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", - "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", - "coltm", "coltmu", "lchfrc", "lchfr_raw", "klchf_raw", "llchf_raw", - "klchp_raw", "mprte_raw", "mprtec" - ), - plot_height = 600) { + dataname, + time_var, + subject_var, + value_var, + event_var, + resp_cols = c( + "subject", "raise_query", "visit_name", "rspdn", "rspd", "rspd_study_day", + "orsp", "bma", "bmb", "comnts" + ), + spep_cols = c( + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", + "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", + "coltm", "coltmu", "lrspep1", "mprte_raw", "mprtec" + ), + sflc_cols = c( + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", + "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", + "coltm", "coltmu", "lchfrc", "lchfr_raw", "klchf_raw", "llchf_raw", + "klchp_raw", "mprte_raw", "mprtec" + ), + plot_height = 600) { module( label = label, ui = ui_a_spiderplot_mdr, server = srv_a_spiderplot_mdr, ui_args = list(height = plot_height), server_args = list( + dataname = dataname, time_var = time_var, subject_var = subject_var, value_var = value_var, @@ -33,7 +35,7 @@ tm_a_spiderplot_mdr <- function(label = "Spiderplot", spep_cols = spep_cols, sflc_cols = sflc_cols ), - datanames = "all", + datanames = dataname, ) } @@ -69,6 +71,7 @@ ui_a_spiderplot_mdr <- function(id, height) { srv_a_spiderplot_mdr <- function(id, data, + dataname, time_var, subject_var, value_var, @@ -79,10 +82,10 @@ srv_a_spiderplot_mdr <- function(id, filter_panel_api, plot_height = 600) { moduleServer(id, function(input, output, session) { - dataname <- "spiderplot_ds" recent_resp_selected_q <- srv_p_spiderplot( "spiderplot", data = data, + dataname = dataname, time_var = time_var, subject_var = subject_var, value_var = value_var, @@ -92,6 +95,7 @@ srv_a_spiderplot_mdr <- function(id, plot_height = plot_height ) + # todo: whattodo with three specific reactives? all_resp_q <- reactive({ req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) within( diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 692d22df9..e103aecd8 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -206,10 +206,14 @@ srv_data_table <- function(id, if_filtered <- reactive(as.logical(input$if_filtered)) if_distinct <- reactive(as.logical(input$if_distinct)) - datanames <- Filter(function(name) { - is.data.frame(isolate(data())[[name]]) - }, if (identical(datanames, "all")) names(isolate(data())) else datanames) - + datanames_r <- reactive({ + Filter( + function(name) { + is.data.frame(data()[[name]]) + }, + if (identical(datanames, "all")) names(data()) else datanames + ) + }) output$dataset_table <- renderUI({ do.call( @@ -217,7 +221,7 @@ srv_data_table <- function(id, c( list(id = session$ns("dataname_tab")), lapply( - datanames(), + datanames_r(), function(x) { dataset <- isolate(data()[[x]]) choices <- names(dataset) @@ -258,7 +262,7 @@ srv_data_table <- function(id, # server should be run only once modules_run <- reactiveVal() - modules_to_run <- reactive(setdiff(datanames(), modules_run())) + modules_to_run <- reactive(setdiff(datanames_r(), modules_run())) observeEvent(modules_to_run(), { lapply( modules_to_run(), diff --git a/R/tm_p_spiderplot.R b/R/tm_p_spiderplot.R index 241d859f8..bad055bab 100644 --- a/R/tm_p_spiderplot.R +++ b/R/tm_p_spiderplot.R @@ -4,7 +4,8 @@ tm_p_spiderplot <- function(label = "Spiderplot", value_var, event_var, table_cols, - plot_height = 600) { + plot_height = 600, + transformator = transformator) { module( label = label, ui = ui_p_spiderplot, @@ -38,7 +39,7 @@ ui_p_spiderplot <- function(id, height) { class = "simple-card", style = "width: 50%", tagList( - h4("Most Recent Resp and Best Resp"), + h4("Most Recent Resp and Best Resp"), # todo: whattodo? ui_t_reactable(ns("recent_resp")) ) ), @@ -53,6 +54,7 @@ ui_p_spiderplot <- function(id, height) { srv_p_spiderplot <- function(id, data, + dataname, time_var, subject_var, value_var, @@ -61,8 +63,7 @@ srv_p_spiderplot <- function(id, filter_panel_api, plot_height = 600) { moduleServer(id, function(input, output, session) { - dataname <- "spiderplot_ds" - excl_events <- c("response_assessment", "latest_response_assessment") + excl_events <- c("response_assessment", "latest_response_assessment") # todo: whattodo? spiderplot_ds <- reactive(data()[[dataname]]) observeEvent(spiderplot_ds(), { event_levels <- setdiff(unique(spiderplot_ds()[[event_var]]), excl_events) @@ -114,7 +115,7 @@ srv_p_spiderplot <- function(id, req(plotly_selected()) within( plotly_q(), - dataname = str2lang(dataname), # todo: replace with argument + dataname = str2lang(dataname), time_var = str2lang(time_var), subject_var = subject_var, value_var = str2lang(value_var), @@ -139,8 +140,8 @@ srv_p_spiderplot <- function(id, expr = { recent_resp <- dplyr::filter( dataname, - event_var == "latest_response_assessment", - subject_var %in% brushed_subjects # todo: figure this out + event_var == "latest_response_assessment", # todo: whattodo? + subject_var %in% brushed_subjects ) |> select(all_of(table_cols)) } diff --git a/R/tm_p_swimlane.R b/R/tm_p_swimlane.R index e0c9481a8..9daee6dde 100644 --- a/R/tm_p_swimlane.R +++ b/R/tm_p_swimlane.R @@ -28,8 +28,6 @@ srv_p_swimlane <- function(id, ggplot_call <- reactive({ plot_call <- bquote(ggplot2::ggplot()) points_calls <- lapply(geom_specs, function(x) { - # todo: convert $geom, $data, and $mapping elements from character to language - # others can be kept as character if (!is.null(x$mapping)) { x$mapping <- as.call(c(as.name("aes"), x$mapping)) } From c398ee846907412bb2dfb61205df919244d9bd1e Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Mon, 17 Feb 2025 16:22:22 +0000 Subject: [PATCH 43/92] swimlane module wip --- R/tm_a_spiderplot_mdr.R | 6 +- R/tm_p_spiderplot.R | 2 +- R/tm_p_swimlane.R | 289 +++++++++++++++++++++++++++++++++------- R/tm_p_swimlane2.r | 102 -------------- R/tm_swimlane.R | 287 --------------------------------------- 5 files changed, 245 insertions(+), 441 deletions(-) delete mode 100644 R/tm_p_swimlane2.r delete mode 100644 R/tm_swimlane.R diff --git a/R/tm_a_spiderplot_mdr.R b/R/tm_a_spiderplot_mdr.R index 569ce07d0..3a8f4eea9 100644 --- a/R/tm_a_spiderplot_mdr.R +++ b/R/tm_a_spiderplot_mdr.R @@ -161,9 +161,9 @@ srv_a_spiderplot_mdr <- function(id, }) #todo: show all_resp only if recent_resp is selected - all_resp_selected_q <- srv_t_reactable("all_resp", data = all_resp_q, dataname = "all_resp") - spep_selected_d <- srv_t_reactable("spep_listing", data = spep_q, dataname = "spep") - sflc_selected_d <- srv_t_reactable("sflc_listing", data = sflc_q, dataname = "sflc") + all_resp_selected_q <- srv_t_reactable("all_resp", data = all_resp_q, dataname = "all_resp", selection = NULL) + spep_selected_d <- srv_t_reactable("spep_listing", data = spep_q, dataname = "spep", selection = NULL) + sflc_selected_d <- srv_t_reactable("sflc_listing", data = sflc_q, dataname = "sflc", selection = NULL) all_q <- reactive({ # all_resp_selected_q could be nothing and `c` won't work because the result is unavailable before clicking subjects in the table diff --git a/R/tm_p_spiderplot.R b/R/tm_p_spiderplot.R index bad055bab..629ff8778 100644 --- a/R/tm_p_spiderplot.R +++ b/R/tm_p_spiderplot.R @@ -78,9 +78,9 @@ srv_p_spiderplot <- function(id, time_var = str2lang(time_var), subject_var = str2lang(subject_var), value_var = str2lang(value_var), + event_var = str2lang(event_var), selected_event = input$select_event, height = input$plot_height, - event_var = str2lang(event_var), expr = { y_title <- selected_event dataname_filtered <- filter(dataname, event_var == selected_event) diff --git a/R/tm_p_swimlane.R b/R/tm_p_swimlane.R index 9daee6dde..6194abccc 100644 --- a/R/tm_p_swimlane.R +++ b/R/tm_p_swimlane.R @@ -1,67 +1,260 @@ -tm_p_swimlane <- function(label = "Swimlane Plot Module", geom_specs, title) { +tm_p_swimlane <- function(label = "Swimlane", dataname, time_var, subject_var, value_var, event_var, plot_height = 700) { module( label = label, ui = ui_p_swimlane, server = srv_p_swimlane, datanames = "all", + ui_args = list(height = plot_height), server_args = list( - geom_specs = geom_specs, - title = title + dataname = dataname, + time_var = time_var, + subject_var = subject_var, + value_var = value_var, + event_var = event_var ) ) } -ui_p_swimlane <- function(id) { +ui_p_swimlane <- function(id, height) { ns <- NS(id) - shiny::tagList( - teal.widgets::plot_with_settings_ui(ns("myplot")), - teal::ui_brush_filter(ns("brush_filter")) + tagList( + fluidRow( + class = "simple-card", + h4("Swim Lane - Duration of Tx"), + sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height, width = "100%"), + plotly::plotlyOutput(ns("plot"), height = "100%") + ), + fluidRow( + column( + 6, + class = "simple-card", + tagList( + h4("Multiple Myeloma Response"), + ui_t_reactable(ns("mm_response")) + ) + ), + column( + 6, + class = "simple-card", + tagList( + h4("Study Tx Listing"), + ui_t_reactable(ns("tx_listing")) + ) + ) + ) ) } - -srv_p_swimlane <- function(id, - data, - geom_specs, - title = "Swimlane plot", - filter_panel_api) { +srv_p_swimlane <- function(id, + data, + dataname, + time_var, + subject_var, + value_var, + event_var, + filter_panel_api, + plot_height = 600) { moduleServer(id, function(input, output, session) { - ggplot_call <- reactive({ - plot_call <- bquote(ggplot2::ggplot()) - points_calls <- lapply(geom_specs, function(x) { - if (!is.null(x$mapping)) { - x$mapping <- as.call(c(as.name("aes"), x$mapping)) - } - basic_call <- as.call( - c( - list(x$geom), - x[!names(x) %in% "geom"] - ) + plotly_q <- reactive({ + data() |> + within( + dataname = str2lang(dataname), + dataname_filtered = str2lang(sprintf("%s_filtered", dataname)), + time_var = str2lang(time_var), + subject_var = str2lang(subject_var), + value_var = str2lang(value_var), + event_var = str2lang(event_var), + subject_var_char = subject_var, + height = input$plot_height, + { + dataname <- dataname |> + mutate( + subject_var_char := forcats::fct_reorder(as.factor(subject_var), time_var, .fun = max), + tooltip = case_when( + event_var == "study_drug_administration" ~ paste( + "Subject:", subject_var, + "
Study Day:", time_var, + "
Administration:", value_var + ), + event_var == "response_assessment" ~ paste( + "Subject:", subject_var, + "
Study Day:", time_var, + "
Response Assessment:", value_var + ), + event_var == "disposition" ~ paste( + "Subject:", subject_var, + "
Study Day:", time_var, + "
Disposition:", value_var + ), + TRUE ~ NA_character_ + ) + ) + + dataname <- dataname |> + group_by(subject_var, time_var) |> + mutate(tooltip = paste(unique(tooltip), collapse = "
")) |> + ungroup() |> + mutate(tooltip = stringr::str_remove_all(tooltip, "
Subject: [0-9]+
Study Day: [0-9]+")) + + + disposition <- dataname |> + filter(!is.na(time_var)) |> + filter(event_var == "disposition") |> + mutate(subject_var, event_var, catagory = value_var, study_day = time_var, tooltip, .keep = "none") + + response_assessment <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "response_assessment") |> + mutate(subject_var, event_var, catagory = value_var, study_day = time_var, tooltip, .keep = "none") + + study_drug_administration <- swimlane_ds |> + filter(!is.na(event_study_day)) |> + filter(event_type == "study_drug_administration") |> + mutate(subject_var, event_var, catagory = value_var, study_day = time_var, tooltip, .keep = "none") + + max_subject_day <- swimlane_ds |> + group_by(subject_var) |> + summarise(study_day = max(time_var)) |> + bind_rows(tibble(subject_var_char := unique(dataname[[subject_var_char]]), study_day = 0)) + + p <- plotly::plot_ly( + source = "swimlane", + colors = c( + "DEATH" = "black", + "WITHDRAWAL BY SUBJECT" = "grey", + "PD (Progressive Disease)" = "red", + "SD (Stable Disease)" = "darkorchid4", + "MR (Minimal/Minor Response)" = "sienna4", + "PR (Partial Response)" = "maroon", + "VGPR (Very Good Partial Response)" = "chartreuse4", + "CR (Complete Response)" = "#3a41fc", + "SCR (Stringent Complete Response)" = "midnightblue", + "X Administration Injection" = "goldenrod", + "Y Administration Infusion" = "deepskyblue3", + "Z Administration Infusion" = "darkorchid" + ), + symbols = c( + "DEATH" = "circle", + "WITHDRAWAL BY SUBJECT" = "square", + "PD (Progressive Disease)" = "circle", + "SD (Stable Disease)" = "square-open", + "MR (Minimal/Minor Response)" = "star-open", + "PR (Partial Response)" = "star-open", + "VGPR (Very Good Partial Response)" = "star-open", + "CR (Complete Response)" = "star-open", + "SCR (Stringent Complete Response)" = "star-open", + "X Administration Injection" = "line-ns-open", + "Y Administration Infusion" = "line-ns-open", + "Z Administration Infusion" = "line-ns-open" + ), + height = height + ) |> + plotly::add_markers( + x = ~study_day, y = ~subject_var, color = ~catagory, symbol = ~catagory, + text = ~tooltip, + hoverinfo = "text", + data = study_drug_administration + ) |> + plotly::add_markers( + x = ~study_day, y = ~subject_var, color = ~catagory, symbol = ~catagory, + text = ~tooltip, + hoverinfo = "text", + data = response_assessment + ) |> + plotly::add_markers( + x = ~study_day, y = ~subject_var, color = ~catagory, symbol = ~catagory, + text = ~tooltip, + hoverinfo = "text", + data = disposition + ) |> + plotly::add_segments( + x = ~0, xend = ~study_day, y = ~subject_var, yend = ~subject_var, + data = max_subject_day, + line = list(width = 1, color = "grey"), + showlegend = FALSE + ) |> + plotly::layout( + xaxis = list(title = "Study Day"), yaxis = list(title = "Subject") + ) |> + plotly::layout(dragmode = "select") |> + plotly::config(displaylogo = FALSE) + }, + height = input$plot_height ) - }) - - title_call <- substitute(ggtitle(title), list(title = title)) - - rhs <- Reduce( - x = c(plot_call, points_calls, title_call), - f = function(x, y) call("+", x, y) + }) + + output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) + + plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "swimlane")) + + plotly_selected_q <- reactive({ + req(plotly_selected()) + within( + plotly_q(), + dataname = str2lang(dataname), + time_var = str2lang(time_var), + subject_var = subject_var, + value_var = str2lang(value_var), + time_vals = plotly_selected()$x, + value_vals = plotly_selected()$y, + expr = { + brushed_subjects <- dplyr::filter( + dataname, time_var %in% time_vals, value_var %in% value_vals + )[[subject_var]] + } ) - substitute(p <- rhs, list(rhs = rhs)) }) - - output_q <- reactive(eval_code(data(), ggplot_call())) - - plot_r <- reactive(output_q()$p) - pws <- teal.widgets::plot_with_settings_srv(id = "myplot", plot_r = plot_r) - - teal::srv_brush_filter( - "brush_filter", - brush = pws$brush, - dataset = reactive(teal.code::dev_suppress(output_q()$synthetic_data)), - filter_panel_api = filter_panel_api + + mm_response_vars <- c( + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", + "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts" ) - }) -} + + tx_listing_vars <- c( + "site_name", "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "txnam", + "txrec", "txrecrs", "txd_study_day", "date_administered", "cydly", "cydlyrs", "cydlyae", "txdly", + "txdlyrs", "txdlyae", "txpdos", "txpdosu", "frqdv", "txrte", "txform", "txdmod", "txrmod", + "txdmae", "txad", "txadu", "txd", "txstm", "txstmu", "txed", "txetm", "txetmu", "txtm", "txtmu", + "txed_study_day", "infrt", "infrtu", "tximod", "txirmod", "tximae" + ) + + mm_response_q <- reactive({ + within( + plotly_selected_q(), + dataname = str2lang(dataname), + time_var = str2lang(time_var), + subject_var = str2lang(subject_var), + time_vals = plotly_selected()$x, + subject_vals = plotly_selected()$y, + col_defs = mm_response_vars, + expr = { + mm_response <- dataname |> + filter(time_var %in% time_vals, subject_var %in% subject_vals) |> + select(all_of(col_defs)) + } + ) + + }) + + tx_listing_q <- reactive({ + within( + plotly_selected_q(), + dataname = str2lang(dataname), + time_var = str2lang(time_var), + subject_var = str2lang(subject_var), + time_vals = plotly_selected()$x, + subject_vals = plotly_selected()$y, + col_defs = tx_listing_vars, + expr = { + tx_listing <- dataname |> + filter(time_var %in% time_vals, subject_var %in% subject_vals) |> + select(all_of(col_defs)) + } + ) + + }) + + mm_reactable_q <- srv_t_reactable("mm_response", data = mm_response_q, dataname = "mm_response", selection = NULL) + tx_reactable_q <- srv_t_reactable("tx_listing", data = tx_listing_q, dataname = "tx_listing", selection = NULL) -merge_selectors2 <- function() { - lappl -} + }) +} \ No newline at end of file diff --git a/R/tm_p_swimlane2.r b/R/tm_p_swimlane2.r deleted file mode 100644 index a1fbef1be..000000000 --- a/R/tm_p_swimlane2.r +++ /dev/null @@ -1,102 +0,0 @@ -#' @export -tm_p_swimlane2 <- function( - label = "Swimlane Plot Module", plotly_specs, title, - colors = c(), symbols = c(), transformators = list(), - ui_mod = ui_data_table, - srv_mod = srv_data_table, - plot_height = 800) { - module( - label = label, - ui = ui_p_swimlane2, - server = srv_p_swimlane2, - datanames = "all", - ui_args = list(ui_mod = ui_mod, height = plot_height), - server_args = list( - plotly_specs = plotly_specs, - title = title, - colors = colors, - symbols = symbols, - srv_mod = srv_mod - ), - transformators = transformators - ) -} - - -ui_p_swimlane2 <- function(id, ui_mod, height) { - ns <- NS(id) - shiny::tagList( - sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height), - plotly::plotlyOutput(ns("plot"), height = "100%"), - ui_mod(ns("brush_tables")) - ) -} - -srv_p_swimlane2 <- function(id, - data, - plotly_specs, - title = "Swimlane plot", - colors, - symbols, - plot_source = "A", - srv_mod, - filter_panel_api) { - moduleServer(id, function(input, output, session) { - plotly_q <- reactive({ - plotly_call <- .make_plotly_call( - specs = plotly_specs, - colors = colors, - symbols = symbols, - height = input$plot_height, - source = plot_source - ) - code <- substitute( - p <- plotly_call, - list(plotly_call = plotly_call) - ) - eval_code(data(), code = code) - }) - - output$plot <- plotly::renderPlotly({ - plotly::event_register( - plotly_q()$p, - "plotly_selected" - ) - }) - - plotly_selected <- reactive(plotly::event_data("plotly_selected"), source = plot_source) - - observeEvent(plotly_selected(), once = TRUE, { - if ("plotly_selected" %in% names(formals(srv_mod))) { - srv_mod("brush_tables", data = data, filter_panel_api = filter_panel_api, plotly_selected = plotly_selected) - } else { - srv_mod("brush_tables", data = data, filter_panel_api = filter_panel_api) - } - }) - }) -} - - - -.make_plotly_call <- function(specs, colors = c(), symbols = c(), height = 800, source = "A") { - init_call <- substitute( - plotly::plot_ly(source = source, colors = colors, symbols = symbols, height = height), - list(colors = colors, symbols = symbols, height = height) - ) - points_calls <- lapply(specs, function(x) { - which_fun <- c(which(names(x) == "fun"), 1)[1] - if (is.character(x[[which_fun]])) { - x[[which_fun]] <- str2lang(x[[which_fun]]) - } - as.call( - c( - list(x[[which_fun]]), - x[-which_fun] - ) - ) - }) - rhs <- Reduce( - x = c(init_call, points_calls), - f = function(x, y) call("%>%", x, y) - ) -} diff --git a/R/tm_swimlane.R b/R/tm_swimlane.R deleted file mode 100644 index 772f5ca03..000000000 --- a/R/tm_swimlane.R +++ /dev/null @@ -1,287 +0,0 @@ -tm_swimlane <- function(label = "Swimlane", plot_height = 700) { - ui <- function(id, height) { - ns <- NS(id) - tagList( - fluidRow( - class = "simple-card", - h4("Swim Lane - Duration of Tx"), - sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height, width = "100%"), - plotly::plotlyOutput(ns("plot"), height = "100%") - ), - fluidRow( - column( - 6, - class = "simple-card", - tagList( - h4("Multiple Myeloma Response"), - reactableOutput(ns("mm_response")) - ) - ), - column( - 6, - class = "simple-card", - tagList( - h4("Study Tx Listing"), - reactableOutput(ns("tx_listing")) - ) - ) - ) - ) - } - server <- function(id, data, filter_panel_api, plot_height = 600) { - moduleServer(id, function(input, output, session) { - plotly_q <- reactive({ - data() |> - within( - { - swimlane_ds <- swimlane_ds |> - mutate(subject = forcats::fct_reorder(as.factor(subject), event_study_day, .fun = max)) |> - mutate( - subject = forcats::fct_reorder(as.factor(subject), event_study_day, .fun = max), - tooltip = case_when( - event_type == "study_drug_administration" ~ paste( - "Subject:", subject, - "
Study Day:", event_study_day, - "
Administration:", event_result - ), - event_type == "response_assessment" ~ paste( - "Subject:", subject, - "
Study Day:", event_study_day, - "
Response Assessment:", event_result - ), - event_type == "disposition" ~ paste( - "Subject:", subject, - "
Study Day:", event_study_day, - "
Disposition:", event_result - ), - TRUE ~ NA_character_ - ) - ) - - swimlane_ds <- swimlane_ds |> - group_by(subject, event_study_day) |> - mutate( - tooltip = paste(unique(tooltip), collapse = "
") - ) |> - ungroup() |> - mutate(tooltip = stringr::str_remove_all(tooltip, "
Subject: [0-9]+
Study Day: [0-9]+")) - - disposition <- swimlane_ds |> - filter(!is.na(event_study_day)) |> - filter(event_type == "disposition") |> - transmute(subject, event_type, catagory = event_result, study_day = event_study_day, tooltip) - - response_assessment <- swimlane_ds |> - filter(!is.na(event_study_day)) |> - filter(event_type == "response_assessment") |> - transmute(subject, event_type, catagory = event_result, study_day = event_study_day, tooltip) - - study_drug_administration <- swimlane_ds |> - filter(!is.na(event_study_day)) |> - filter(event_type == "study_drug_administration") |> - transmute(subject, event_type, catagory = event_result, study_day = event_study_day, tooltip) - - max_subject_day <- swimlane_ds |> - group_by(subject) |> - summarise(study_day = max(event_study_day)) |> - bind_rows(tibble(subject = unique(swimlane_ds$subject), study_day = 0)) - - p <- plotly::plot_ly( - source = "swimlane", - colors = c( - "DEATH" = "black", - "WITHDRAWAL BY SUBJECT" = "grey", - "PD (Progressive Disease)" = "red", - "SD (Stable Disease)" = "darkorchid4", - "MR (Minimal/Minor Response)" = "sienna4", - "PR (Partial Response)" = "maroon", - "VGPR (Very Good Partial Response)" = "chartreuse4", - "CR (Complete Response)" = "#3a41fc", - "SCR (Stringent Complete Response)" = "midnightblue", - "X Administration Injection" = "goldenrod", - "Y Administration Infusion" = "deepskyblue3", - "Z Administration Infusion" = "darkorchid" - ), - symbols = c( - "DEATH" = "circle", - "WITHDRAWAL BY SUBJECT" = "square", - "PD (Progressive Disease)" = "circle", - "SD (Stable Disease)" = "square-open", - "MR (Minimal/Minor Response)" = "star-open", - "PR (Partial Response)" = "star-open", - "VGPR (Very Good Partial Response)" = "star-open", - "CR (Complete Response)" = "star-open", - "SCR (Stringent Complete Response)" = "star-open", - "X Administration Injection" = "line-ns-open", - "Y Administration Infusion" = "line-ns-open", - "Z Administration Infusion" = "line-ns-open" - ), - height = height - ) |> - plotly::add_markers( - x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, - text = ~tooltip, - hoverinfo = "text", - data = study_drug_administration - ) |> - plotly::add_markers( - x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, - text = ~tooltip, - hoverinfo = "text", - data = response_assessment - ) |> - plotly::add_markers( - x = ~study_day, y = ~subject, color = ~catagory, symbol = ~catagory, - text = ~tooltip, - hoverinfo = "text", - data = disposition - ) |> - plotly::add_segments( - x = ~0, xend = ~study_day, y = ~subject, yend = ~subject, - data = max_subject_day, - line = list(width = 1, color = "grey"), - showlegend = FALSE - ) |> - plotly::layout( - xaxis = list(title = "Study Day"), yaxis = list(title = "Subject") - ) |> - plotly::layout(dragmode = "select") |> - plotly::config(displaylogo = FALSE) - }, - height = input$plot_height - ) - }) - - output$plot <- plotly::renderPlotly({ - plotly::event_register( - plotly_q()$p, - "plotly_selected" - ) - }) - - plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "swimlane")) - - output$mm_response <- renderReactable({ - swimlane_ds <- data()[["swimlane_ds"]] - col_defs <- .with_tooltips( - subject = colDef(name = "Subject"), - visit_name = colDef(name = "Visit Name", width = 250), - visit_date = colDef(name = "Visit Date"), - form_name = colDef(name = "Form Name", width = 250), - source_system_url_link = colDef( - name = "Source System URL Link", - cell = function(value) { - if (!is.na(value) && !is.null(value) && value != "") { - htmltools::tags$a(href = value, target = "_blank", "Link") - } else { - "N/A" - } - } - ), - rspdn = colDef(name = "Assessment Performed"), - rspd = colDef(name = "Response Date"), - rspd_study_day = colDef(name = "Response Date Study Day"), - orsp = colDef(name = "Response", width = 250), - bma = colDef(name = "Best Marrow Aspirate"), - bmb = colDef(name = "Best Marrow Biopsy"), - comnts = colDef(name = "Comments") - ) - mm_response <- swimlane_ds |> - filter(event_study_day %in% plotly_selected()$x, subject %in% plotly_selected()$y) |> - select(all_of(names(col_defs))) - if (nrow(mm_response) == 0) { - return() - } - - reactable( - mm_response, - class = "custom-reactable", - columns = col_defs, - defaultPageSize = 10, - wrap = FALSE, - searchable = TRUE, - sortable = TRUE - ) - }) - - output$tx_listing <- renderReactable({ - swimlane_ds <- data()[["swimlane_ds"]] - - col_defs <- .with_tooltips( - site_name = colDef(name = "Site Name"), - subject = colDef(name = "Subject"), - visit_name = colDef(name = "Visit Name"), - visit_date = colDef(name = "Visit Date"), - form_name = colDef(name = "Form Name"), - source_system_url_link = colDef( - name = "Source System URL Link", - cell = function(value) { - if (!is.na(value) && !is.null(value) && value != "") { - htmltools::tags$a(href = value, target = "_blank", "Link") - } else { - "N/A" - } - } - ), - txnam = colDef(name = "Study Drug Name"), - txrec = colDef(name = "Study Drug Administered"), - txrecrs = colDef(name = "Reason Study Drug Not Admin"), - txd_study_day = colDef(name = "Date Administered Study Day"), - date_administered = colDef(name = "Date Administered"), - cydly = colDef(name = "Cycle Delay"), - cydlyrs = colDef(name = "Cycle Delay Reason"), - cydlyae = colDef(name = "Cycle Delay Adverse Event"), - txdly = colDef(name = "Dose Delay"), - txdlyrs = colDef(name = "Dose Delay Reason"), - txdlyae = colDef(name = "AE related to Dose Delay"), - txpdos = colDef(name = "Planned Dose per Admin"), - txpdosu = colDef(name = "Planned Dose per Admin Unit"), - frqdv = colDef(name = "Frequency"), - txrte = colDef(name = "Route of Administration"), - txform = colDef(name = "Dose Formulation"), - txdmod = colDef(name = "Dose Modification"), - txrmod = colDef(name = "Dose Modification Reason"), - txdmae = colDef(name = "AE related to Dose Modification"), - txad = colDef(name = "Total Dose Administered"), - txadu = colDef(name = "Total Dose Administered Unit"), - txd = colDef(name = "Date Administered"), - txstm = colDef(name = "Start Time Administered"), - txstmu = colDef(name = "Start Time Administered Unknown"), - txed = colDef(name = "End Date Administered"), - txetm = colDef(name = "End Time Administered"), - txetmu = colDef(name = "End Time Administered Unknown"), - txtm = colDef(name = "Time Administered"), - txtmu = colDef(name = "Time Administered Unknown"), - txed_study_day = colDef(name = "End Study Day"), - infrt = colDef(name = "Infusion Rate"), - infrtu = colDef(name = "Infusion Rate Unit"), - tximod = colDef(name = "Infusion Modified?"), - txirmod = colDef(name = "Reason for Infusion modification"), - tximae = colDef(name = "AE related to Infusion Modification") - ) - tx_listing <- swimlane_ds |> - filter(event_study_day %in% plotly_selected()$x, subject %in% plotly_selected()$y) |> - select(all_of(names(col_defs))) - if (nrow(tx_listing) == 0) { - return() - } - - reactable( - tx_listing, - columns = col_defs, - defaultPageSize = 10, - wrap = FALSE, - searchable = TRUE, - sortable = TRUE - ) - }) - }) - } - module( - label = label, - ui = ui, - server = server, - datanames = "all", - ui_args = list(height = plot_height) - ) -} \ No newline at end of file From e68d78fd51bd5192600f9f23672276a9d72b13a9 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Fri, 28 Feb 2025 14:07:58 +0000 Subject: [PATCH 44/92] further changes .adjust_colors --- R/tm_a_spiderplot_mdr.R | 92 +- R/{tm_p_spiderplot.R => tm_g_spiderplot.R} | 108 +- R/{tm_p_swimlane.R => tm_g_swimlane.R} | 188 +- R/tm_g_waterfall.R | 113 + R/tm_t_reactable.R | 41 +- inst/poc_crf2.R | 4 +- inst/teal_app.lock | 5853 ++++++++++++++++++++ 7 files changed, 6203 insertions(+), 196 deletions(-) rename R/{tm_p_spiderplot.R => tm_g_spiderplot.R} (50%) rename R/{tm_p_swimlane.R => tm_g_swimlane.R} (50%) create mode 100644 R/tm_g_waterfall.R create mode 100644 inst/teal_app.lock diff --git a/R/tm_a_spiderplot_mdr.R b/R/tm_a_spiderplot_mdr.R index 3a8f4eea9..e7e481c6f 100644 --- a/R/tm_a_spiderplot_mdr.R +++ b/R/tm_a_spiderplot_mdr.R @@ -43,7 +43,25 @@ tm_a_spiderplot_mdr <- function(label = "Spiderplot", ui_a_spiderplot_mdr <- function(id, height) { ns <- NS(id) tagList( - ui_p_spiderplot(ns("spiderplot"), height = height), + + tagList( + div( + style = "display: flex", + div( + class = "simple-card", + style = "width: 50%", + tagList( + h4("Most Recent Resp and Best Resp"), + ui_t_reactable(ns("recent_resp")) + ) + ), + div( + class = "simple-card", + style = "width: 50%", + ui_g_spiderplot(ns("spiderplot"), height = height) + ) + ) + ), div( style = "display: flex", div( @@ -82,20 +100,60 @@ srv_a_spiderplot_mdr <- function(id, filter_panel_api, plot_height = 600) { moduleServer(id, function(input, output, session) { - recent_resp_selected_q <- srv_p_spiderplot( + # todo: plotly_excl_events should be a positive selection or tidyselect + # and exposed as arg + plotly_excl_events <- c("response_assessment", "latest_response_assessment") + plotly_data <- reactive({ + req(data()) + within( + data(), + dataname = str2lang(dataname), + event_var = str2lang(event_var), + plotly_excl_events = plotly_excl_events, + expr = spiderplot_data <- dplyr::filter(dataname, !event_var %in% plotly_excl_events) + ) + }) + plotly_selected_q <- srv_g_spiderplot( "spiderplot", - data = data, - dataname = dataname, + data = plotly_data, + dataname = "spiderplot_data", time_var = time_var, subject_var = subject_var, value_var = value_var, event_var = event_var, - table_cols = resp_cols, filter_panel_api = filter_panel_api, plot_height = plot_height ) - # todo: whattodo with three specific reactives? + recent_resp_q <- reactive({ + req(plotly_selected_q()) + within( + plotly_selected_q(), + dataname = str2lang(dataname), + subject_var = str2lang(subject_var), + event_var = str2lang(event_var), + recent_resp_event = "latest_response_assessment", # todo: whattodo? + resp_cols = resp_cols, + expr = { + recent_resp <- dplyr::filter( + dataname, + event_var %in% recent_resp_event, + subject_var %in% brushed_subjects + ) |> + select(all_of(resp_cols)) + } + ) + }) + + recent_resp_selected_q <- srv_t_reactable( + "recent_resp", data = recent_resp_q, dataname = "recent_resp", selection = "single" + ) + + # todo: these tables do have the same filters and select. It is just a matter of parametrising + # to named list: + # - (table) label + # - event_level for filter + # - columns all_resp_q <- reactive({ req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) within( @@ -104,11 +162,12 @@ srv_a_spiderplot_mdr <- function(id, subject_var = str2lang(subject_var), subject_var_char = subject_var, event_var = str2lang(event_var), + all_resp_events = "response_assessment", resp_cols = resp_cols, expr = { all_resp <- dplyr::filter( dataname, - event_var == "response_assessment", + event_var %in% all_resp_events, subject_var %in% unique(recent_resp_selected[[subject_var_char]]) ) |> select(all_of(resp_cols)) @@ -124,11 +183,12 @@ srv_a_spiderplot_mdr <- function(id, subject_var = str2lang(subject_var), subject_var_char = subject_var, event_var = str2lang(event_var), + spep_events = "Serum M-protein", spep_cols = spep_cols, expr = { spep <- dplyr::filter( dataname, - event_var == "Serum M-protein", + event_var %in% spep_events, subject_var %in% unique(recent_resp_selected[[subject_var_char]]) ) |> select(all_of(spep_cols)) @@ -142,17 +202,18 @@ srv_a_spiderplot_mdr <- function(id, recent_resp_selected_q(), dataname = str2lang(dataname), subject_var = str2lang(subject_var), - event_var = str2lang(event_var), subject_var_char = subject_var, + event_var = str2lang(event_var), + sflc_events = c( + "Kappa free light chain quantity", + "Lambda free light chain quantity", + "Kappa-Lambda free light chain ratio" + ), sflc_cols = sflc_cols, expr = { sflc <- dplyr::filter( dataname, - event_var %in% c( - "Kappa free light chain quantity", - "Lambda free light chain quantity", - "Kappa-Lambda free light chain ratio" - ), + event_var %in% sflc_events, subject_var %in% unique(recent_resp_selected[[subject_var_char]]) ) |> select(all_of(sflc_cols)) @@ -166,6 +227,7 @@ srv_a_spiderplot_mdr <- function(id, sflc_selected_d <- srv_t_reactable("sflc_listing", data = sflc_q, dataname = "sflc", selection = NULL) all_q <- reactive({ + req(recent_resp_selected_q(), all_resp_selected_q()) # all_resp_selected_q could be nothing and `c` won't work because the result is unavailable before clicking subjects in the table c(recent_resp_selected_q(), all_resp_selected_q()) }) @@ -179,6 +241,8 @@ srv_a_spiderplot_mdr <- function(id, } + + .with_tooltips <- function(...) { args <- list(...) lapply(args, function(col) { diff --git a/R/tm_p_spiderplot.R b/R/tm_g_spiderplot.R similarity index 50% rename from R/tm_p_spiderplot.R rename to R/tm_g_spiderplot.R index 629ff8778..b28595d63 100644 --- a/R/tm_p_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -1,106 +1,96 @@ -tm_p_spiderplot <- function(label = "Spiderplot", +tm_g_spiderplot <- function(label = "Spiderplot", time_var, subject_var, value_var, event_var, - table_cols, plot_height = 600, transformator = transformator) { module( label = label, - ui = ui_p_spiderplot, - server = srv_p_spiderplot, + ui = ui_g_spiderplot, + server = srv_g_spiderplot, ui_args = list(height = plot_height), server_args = list( time_var = time_var, subject_var = subject_var, value_var = value_var, - event_var = event_var, - table_cols = table__cols + event_var = event_var ), datanames = "all", ) } -ui_p_spiderplot <- function(id, height) { +ui_g_spiderplot <- function(id, height) { ns <- NS(id) - tagList( + div( div( - style = "display: flex; justify-content: center; align-items: center; gap: 30px;", + class = "simple-card", div( - selectInput(ns("select_event"), "Select Y Axis", NULL) + class = "row", + column( + width = 6, + selectInput(ns("select_event"), "Select Y Axis", NULL) + ), + column( + width = 6, + sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) + ) ), - div(sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)) - ), - div( - style = "display: flex", - div( - class = "simple-card", - style = "width: 50%", - tagList( - h4("Most Recent Resp and Best Resp"), # todo: whattodo? - ui_t_reactable(ns("recent_resp")) - ) - ), - div( - class = "simple-card", - style = "width: 50%", - plotly::plotlyOutput(ns("plot"), height = "100%") - ) + plotly::plotlyOutput(ns("plot"), height = "100%") ) ) } -srv_p_spiderplot <- function(id, +srv_g_spiderplot <- function(id, data, dataname, time_var, subject_var, value_var, event_var, - table_cols, filter_panel_api, plot_height = 600) { moduleServer(id, function(input, output, session) { - excl_events <- c("response_assessment", "latest_response_assessment") # todo: whattodo? - spiderplot_ds <- reactive(data()[[dataname]]) - observeEvent(spiderplot_ds(), { - event_levels <- setdiff(unique(spiderplot_ds()[[event_var]]), excl_events) - updateSelectInput(inputId = "select_event", choices = event_levels) + event_levels <- reactive({ + req(data()) + unique(data()[[dataname]][[event_var]]) + }) + observeEvent(event_levels(), { + updateSelectInput(inputId = "select_event", choices = event_levels(), selected = event_levels()[1]) }) plotly_q <- reactive({ + # todo: tooltip! + req(input$select_event) within( data(), dataname = str2lang(dataname), - dataname_filtered = str2lang(sprintf("%s_filtered", dataname)), time_var = str2lang(time_var), subject_var = str2lang(subject_var), value_var = str2lang(value_var), event_var = str2lang(event_var), selected_event = input$select_event, height = input$plot_height, + xaxis_label = attr(data()[[dataname]][[time_var]], "label"), + yaxis_label = input$select_event, + title = paste0(input$select_event, " Over Time"), expr = { - y_title <- selected_event - dataname_filtered <- filter(dataname, event_var == selected_event) - - p <- plotly::plot_ly(source = "spiderplot", height = height) |> + p <- dataname |> filter(event_var == selected_event)|> + plotly::plot_ly(source = "spiderplot", height = height) |> plotly::add_markers( - x = ~time_var, y = ~value_var, color = ~subject_var, - data = dataname_filtered + x = ~time_var, y = ~value_var, color = ~subject_var ) |> plotly::add_lines( x = ~time_var, y = ~value_var, color = ~subject_var, - data = dataname_filtered, showlegend = FALSE ) |> plotly::layout( - xaxis = list(title = "Collection Date Study Day", zeroline = FALSE), - yaxis = list(title = ~y_title), - title = ~ paste0(y_title, " Over Time") + xaxis = list(title = xaxis_label, zeroline = FALSE), + yaxis = list(title = yaxis_label), + title = title, + dragmode = "select" ) |> - plotly::layout(dragmode = "select") |> plotly::config(displaylogo = FALSE) } ) @@ -110,8 +100,7 @@ srv_p_spiderplot <- function(id, plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) - - plotly_selected_q <- reactive({ + reactive({ req(plotly_selected()) within( plotly_q(), @@ -128,29 +117,6 @@ srv_p_spiderplot <- function(id, } ) }) - - recent_resp_q <- reactive({ - req(plotly_selected_q()) - within( - plotly_selected_q(), - dataname = str2lang(dataname), - subject_var = str2lang(subject_var), - table_cols = table_cols, - event_var = str2lang(event_var), - expr = { - recent_resp <- dplyr::filter( - dataname, - event_var == "latest_response_assessment", # todo: whattodo? - subject_var %in% brushed_subjects - ) |> - select(all_of(table_cols)) - } - ) - }) - - srv_t_reactable( - "recent_resp", data = recent_resp_q, dataname = "recent_resp", selection = "single" - ) }) } diff --git a/R/tm_p_swimlane.R b/R/tm_g_swimlane.R similarity index 50% rename from R/tm_p_swimlane.R rename to R/tm_g_swimlane.R index 6194abccc..9d41e19f1 100644 --- a/R/tm_p_swimlane.R +++ b/R/tm_g_swimlane.R @@ -1,8 +1,16 @@ -tm_p_swimlane <- function(label = "Swimlane", dataname, time_var, subject_var, value_var, event_var, plot_height = 700) { +tm_g_swimlane <- function(label = "Swimlane", + dataname, + time_var, + subject_var, + value_var, + event_var, + value_var_color, + value_var_symbol, + plot_height = 700) { module( label = label, - ui = ui_p_swimlane, - server = srv_p_swimlane, + ui = ui_g_swimlane, + server = srv_g_swimlane, datanames = "all", ui_args = list(height = plot_height), server_args = list( @@ -10,12 +18,14 @@ tm_p_swimlane <- function(label = "Swimlane", dataname, time_var, subject_var, v time_var = time_var, subject_var = subject_var, value_var = value_var, - event_var = event_var + event_var = event_var, + value_var_color = value_var_color, + value_var_symbol = value_var_symbol ) ) } -ui_p_swimlane <- function(id, height) { +ui_g_swimlane <- function(id, height) { ns <- NS(id) tagList( fluidRow( @@ -44,17 +54,24 @@ ui_p_swimlane <- function(id, height) { ) ) } -srv_p_swimlane <- function(id, +srv_g_swimlane <- function(id, data, dataname, time_var, subject_var, value_var, event_var, + value_var_color, + value_var_symbol, filter_panel_api, plot_height = 600) { moduleServer(id, function(input, output, session) { plotly_q <- reactive({ + req(data()) + adjusted_colors <- .adjust_colors( + x = unique(data()[[dataname]][[value_var]]), + predefined = value_var_color + ) data() |> within( dataname = str2lang(dataname), @@ -63,122 +80,58 @@ srv_p_swimlane <- function(id, subject_var = str2lang(subject_var), value_var = str2lang(value_var), event_var = str2lang(event_var), - subject_var_char = subject_var, + colors = adjusted_colors, + symbols = value_var_symbol, height = input$plot_height, + filtered_events = c("disposition","response_assessment", "study_drug_administration"), + xaxis_label = "Study Day", + yaxis_label = "Subject", { dataname <- dataname |> + mutate(subject_var_ordered = forcats::fct_reorder(as.factor(subject_var), time_var, .fun = max)) |> + group_by(subject_var, time_var) |> mutate( - subject_var_char := forcats::fct_reorder(as.factor(subject_var), time_var, .fun = max), - tooltip = case_when( - event_var == "study_drug_administration" ~ paste( - "Subject:", subject_var, - "
Study Day:", time_var, - "
Administration:", value_var - ), - event_var == "response_assessment" ~ paste( - "Subject:", subject_var, - "
Study Day:", time_var, - "
Response Assessment:", value_var - ), - event_var == "disposition" ~ paste( - "Subject:", subject_var, - "
Study Day:", time_var, - "
Disposition:", value_var - ), - TRUE ~ NA_character_ + tooltip = paste( + "Subject:", subject_var, + "
Study Day:", time_var, + paste( + unique( + sprintf("
%s: %s", tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", event_var)), value_var) + ), + collapse = "" + ) ) ) + - dataname <- dataname |> - group_by(subject_var, time_var) |> - mutate(tooltip = paste(unique(tooltip), collapse = "
")) |> - ungroup() |> - mutate(tooltip = stringr::str_remove_all(tooltip, "
Subject: [0-9]+
Study Day: [0-9]+")) - - - disposition <- dataname |> - filter(!is.na(time_var)) |> - filter(event_var == "disposition") |> - mutate(subject_var, event_var, catagory = value_var, study_day = time_var, tooltip, .keep = "none") - - response_assessment <- swimlane_ds |> - filter(!is.na(event_study_day)) |> - filter(event_type == "response_assessment") |> - mutate(subject_var, event_var, catagory = value_var, study_day = time_var, tooltip, .keep = "none") - - study_drug_administration <- swimlane_ds |> - filter(!is.na(event_study_day)) |> - filter(event_type == "study_drug_administration") |> - mutate(subject_var, event_var, catagory = value_var, study_day = time_var, tooltip, .keep = "none") - - max_subject_day <- swimlane_ds |> - group_by(subject_var) |> - summarise(study_day = max(time_var)) |> - bind_rows(tibble(subject_var_char := unique(dataname[[subject_var_char]]), study_day = 0)) - - p <- plotly::plot_ly( + p <- dataname |> + dplyr::filter( + event_var %in% filtered_events, + !is.na(time_var) + ) |> + plotly::plot_ly( source = "swimlane", - colors = c( - "DEATH" = "black", - "WITHDRAWAL BY SUBJECT" = "grey", - "PD (Progressive Disease)" = "red", - "SD (Stable Disease)" = "darkorchid4", - "MR (Minimal/Minor Response)" = "sienna4", - "PR (Partial Response)" = "maroon", - "VGPR (Very Good Partial Response)" = "chartreuse4", - "CR (Complete Response)" = "#3a41fc", - "SCR (Stringent Complete Response)" = "midnightblue", - "X Administration Injection" = "goldenrod", - "Y Administration Infusion" = "deepskyblue3", - "Z Administration Infusion" = "darkorchid" - ), - symbols = c( - "DEATH" = "circle", - "WITHDRAWAL BY SUBJECT" = "square", - "PD (Progressive Disease)" = "circle", - "SD (Stable Disease)" = "square-open", - "MR (Minimal/Minor Response)" = "star-open", - "PR (Partial Response)" = "star-open", - "VGPR (Very Good Partial Response)" = "star-open", - "CR (Complete Response)" = "star-open", - "SCR (Stringent Complete Response)" = "star-open", - "X Administration Injection" = "line-ns-open", - "Y Administration Infusion" = "line-ns-open", - "Z Administration Infusion" = "line-ns-open" - ), + colors = colors, + symbols = symbols, height = height ) |> plotly::add_markers( - x = ~study_day, y = ~subject_var, color = ~catagory, symbol = ~catagory, + x = ~time_var, y = ~subject_var_ordered, color = ~value_var, symbol = ~value_var, text = ~tooltip, - hoverinfo = "text", - data = study_drug_administration - ) |> - plotly::add_markers( - x = ~study_day, y = ~subject_var, color = ~catagory, symbol = ~catagory, - text = ~tooltip, - hoverinfo = "text", - data = response_assessment - ) |> - plotly::add_markers( - x = ~study_day, y = ~subject_var, color = ~catagory, symbol = ~catagory, - text = ~tooltip, - hoverinfo = "text", - data = disposition + hoverinfo = "text" ) |> plotly::add_segments( - x = ~0, xend = ~study_day, y = ~subject_var, yend = ~subject_var, - data = max_subject_day, + x = ~0, xend = ~study_day, y = ~subject_var_ordered, yend = ~subject_var_ordered, + data = dataname |> group_by(subject_var_ordered) |> summarise(study_day = max(time_var)), line = list(width = 1, color = "grey"), showlegend = FALSE ) |> plotly::layout( - xaxis = list(title = "Study Day"), yaxis = list(title = "Subject") + xaxis = list(title = xaxis_label), yaxis = list(title = yaxis_label) ) |> plotly::layout(dragmode = "select") |> plotly::config(displaylogo = FALSE) - }, - height = input$plot_height + } ) }) @@ -257,4 +210,35 @@ srv_p_swimlane <- function(id, tx_reactable_q <- srv_t_reactable("tx_listing", data = tx_listing_q, dataname = "tx_listing", selection = NULL) }) -} \ No newline at end of file +} + +.adjust_colors <- function(x, predefined) { + p <- predefined[names(predefined) %in% x] + p_rgb_num <- col2rgb(p) + p_hex <- rgb(p_rgb_num[1,]/255, p_rgb_num[2,]/255, p_rgb_num[3,]/255) + p <- setNames(p_hex, names(p)) + missing_x <- setdiff(x, names(p)) + N <- length(x) + n <- length(p) + m <- N - n + adjusted_colors <- if (m & n) { + current_space <- rgb2hsv(col2rgb(p)) + optimal_color_space <- colorspace::qualitative_hcl(N) + color_distances <- dist(t(cbind(current_space, rgb2hsv(col2rgb(optimal_color_space))))) + optimal_to_current_dist <- as.matrix(color_distances)[seq_len(n), -seq_len(n)] + furthest_neighbours_idx <- order(apply(optimal_to_current_dist, 2, min), decreasing = TRUE) + missing_colors <- optimal_color_space[furthest_neighbours_idx][seq_len(m)] + missing_colors <- setNames(missing_colors, missing_x) + p <- c(p, missing_colors) + } else if (n) { + # todo: generate color palette + hsv( + h = seq(0, by = 1/N, length.out = N + 1), + s = 1, + v = 1 + ) + } else { + p + } +} + diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R new file mode 100644 index 000000000..cac455bab --- /dev/null +++ b/R/tm_g_waterfall.R @@ -0,0 +1,113 @@ +tm_g_waterfall <- function(label = "Waterfall", time_var, subject_var, value_var, event_var, plot_height = 700) { + time_var$dataname <- "ADRS" + subject_var$dataname <- "ADRS" + value_var$dataname <- "ADRS" + event_var$dataname <- "ADRS" + module( + label = label, + ui = ui_g_waterfall, + server = srv_g_waterfall, + datanames = "all", + ui_args = list(height = plot_height), + server_args = list( + time_var = time_var, + subject_var = subject_var, + value_var = value_var, + event_var = event_var + ) + ) +} + +ui_g_waterfall <- function(id, height) { + ns <- NS(id) + tagList( + fluidRow( + class = "simple-card", + div( + class = "row", + column( + width = 4, + selectInput(ns("select_event"), "Select Y Axis (to remove)", NULL) + ), + column( + width = 4, + sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) + ), + column( + width = 4, + sliderInput(ns("color_by"), "Plot Height (px)", 400, 1200, height) + ) + ), + h4("Waterfall"), + plotly::plotlyOutput(ns("plot"), height = "100%") + ), + fluidRow( + h4("All lesions"), + ui_t_reactable(ns("all_lesions")) + + ) + ) +} +srv_g_waterfall <- function(id, + data, + dataname, + time_var, + subject_var, + value_var, + event_var, + filter_panel_api, + plot_height = 600) { + moduleServer(id, function(input, output, session) { + event_levels <- reactive({ + req(data()) + unique(data()[[event_var$dataname]][[event_var$selected]]) + }) + observeEvent(event_levels(), { + updateSelectInput(inputId = "select_event", choices = event_levels(), selected = event_levels()[1]) + }) + + plotly_q <- reactive({ + data() |> + within( + dataname = str2lang(time_var$dataname), + dataname_filtered = str2lang(sprintf("%s_filtered", time_var$dataname)), + time_var = str2lang(time_var$selected), + subject_var = str2lang(subject_var$selected), + value_var = str2lang(value_var$selected), + event_var = str2lang(event_var$selected), + selected_event = input$select_event, + height = input$plot_height, + xaxis_label = attr(data()[[subject_var$dataname]][[subject_var$selected]], "label"), + yaxis_label = input$select_event, + title = paste0(input$select_event, " Over Time"), + expr = { + p <- dataname |> + dplyr::filter(event_var %in% selected_event) |> + dplyr::mutate( + subject_var_ordered = forcats::fct_reorder(as.factor(subject_var), value_var, .fun = max, .desc = TRUE) + ) |> + # todo: one value for x, y: distinct or summarize(value = foo(value_var)) [foo: summarize_fun] + plotly::plot_ly( + source = "waterfall", + height = height + ) |> + plotly::add_bars( + x = ~subject_var_ordered, y = ~value_var, + showlegend = FALSE + ) |> + plotly::layout( + xaxis = list(title = xaxis_label), yaxis = list(title = yaxis_label) + ) |> + plotly::layout(dragmode = "select") |> + plotly::config(displaylogo = FALSE) + }, + height = input$plot_height + ) + }) + + output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) + + plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "waterfall")) + + }) +} \ No newline at end of file diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index e6cea5e7c..2b0f941fd 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -82,19 +82,46 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, .. } +#' Makes `reactable::colDef` call containing: +#' name = +#' cell = +#' Arguments of [reactable::colDef()] are specified only if necessary +#' @param dataset (`data.frame`) +#' @return named list of `colDef` calls +#' @keywords internal .make_reactable_columns_call <- function(dataset) { - # todo: what to do with urls? + checkmate::assert_data_frame(dataset) args <- lapply( - teal.data::col_labels(dataset), - function(label) { - if (!is.null(label) && !is.na(label)) { - substitute( - colDef(name = label), - list(label = label) + seq_along(dataset), + function(i) { + label <- attr(dataset[[i]], "label") + is_labelled <- length(label) == 1 && !is.na(label) && !identical(label, "") + is_url <- is.character(dataset[[i]]) && any( + grepl( + "https?:\\/\\/(www\\.)?[-a-zA-Z0-9@:%._\\+~#=]{1,256}\\.[a-zA-Z0-9()]{1,6}\\b([-a-zA-Z0-9()@:%_\\+.~#?&//=]*)", + x = head(dataset[[i]]), + perl = TRUE + ) + ) + + args <- c( + if (is_labelled) list(name = label), + if (is_url) list(cell = quote(function(value) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + }) ) + ) + + if (length(args)) { + do.call(call, c(list(name = "colDef"), args), quote = TRUE) } } ) + names(args) <- names(dataset) args <- Filter(length, args) if (length(args)) { do.call(call, c(list("list"), args), quote = TRUE) diff --git a/inst/poc_crf2.R b/inst/poc_crf2.R index 812ea3e46..412cb07fb 100644 --- a/inst/poc_crf2.R +++ b/inst/poc_crf2.R @@ -2,7 +2,7 @@ library(teal) library(DT) library(labelled) library(reactable) -pkgload::load_all("teal.modules.general") +#pkgload::load_all("teal.modules.general") # Note: Please add the `PATH_TO_DATA` and change the X, Y, and Z Administrations to the actual values in the data with_tooltips <- function(...) { @@ -17,7 +17,7 @@ data <- within(teal_data(), { library(dplyr) library(arrow) library(forcats) - data_path <- "PATH_TO_DATA" + data_path <- "/ocean/harbour/CDT70436/GO43979/CSRInterim_roak_upver/dev/data/other/mdr_spotfire/" swimlane_ds <- read_parquet(file.path(data_path, "swimlane_ds.parquet")) |> filter(!is.na(event_result), !is.na(event_study_day)) |> diff --git a/inst/teal_app.lock b/inst/teal_app.lock new file mode 100644 index 000000000..9bbf330de --- /dev/null +++ b/inst/teal_app.lock @@ -0,0 +1,5853 @@ +{ + "R": { + "Version": "4.4.1", + "Repositories": [ + { + "Name": "NON_VALIDATED", + "URL": "https://packages.roche.com/Non-Validated/2024-10-14+2K_YKWmH" + }, + { + "Name": "CRAN", + "URL": "https://packages.roche.com/CRAN/2024-10-14" + } + ] + }, + "Packages": { + "DT": { + "Package": "DT", + "Version": "0.33", + "Source": "Repository", + "Type": "Package", + "Title": "A Wrapper of the JavaScript Library 'DataTables'", + "Authors@R": "c( person(\"Yihui\", \"Xie\", role = \"aut\"), person(\"Joe\", \"Cheng\", email = \"joe@posit.co\", role = c(\"aut\", \"cre\")), person(\"Xianying\", \"Tan\", role = \"aut\"), person(\"JJ\", \"Allaire\", role = \"ctb\"), person(\"Maximilian\", \"Girlich\", role = \"ctb\"), person(\"Greg\", \"Freedman Ellis\", role = \"ctb\"), person(\"Johannes\", \"Rauh\", role = \"ctb\"), person(\"SpryMedia Limited\", role = c(\"ctb\", \"cph\"), comment = \"DataTables in htmlwidgets/lib\"), person(\"Brian\", \"Reavis\", role = c(\"ctb\", \"cph\"), comment = \"selectize.js in htmlwidgets/lib\"), person(\"Leon\", \"Gersen\", role = c(\"ctb\", \"cph\"), comment = \"noUiSlider in htmlwidgets/lib\"), person(\"Bartek\", \"Szopka\", role = c(\"ctb\", \"cph\"), comment = \"jquery.highlight.js in htmlwidgets/lib\"), person(\"Alex\", \"Pickering\", role = c(\"ctb\")), person(\"William\", \"Holmes\", role = c(\"ctb\")), person(\"Mikko\", \"Marttila\", role = c(\"ctb\")), person(\"Andres\", \"Quintero\", role = c(\"ctb\")), person(\"Stéphane\", \"Laurent\", role = c(\"ctb\")), person(given = \"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Data objects in R can be rendered as HTML tables using the JavaScript library 'DataTables' (typically via R Markdown or Shiny). The 'DataTables' library has been included in this R package. The package name 'DT' is an abbreviation of 'DataTables'.", + "URL": "https://github.com/rstudio/DT", + "BugReports": "https://github.com/rstudio/DT/issues", + "License": "GPL-3 | file LICENSE", + "Imports": [ + "htmltools (>= 0.3.6)", + "htmlwidgets (>= 1.3)", + "httpuv", + "jsonlite (>= 0.9.16)", + "magrittr", + "crosstalk", + "jquerylib", + "promises" + ], + "Suggests": [ + "knitr (>= 1.8)", + "rmarkdown", + "shiny (>= 1.6)", + "bslib", + "future", + "testit", + "tibble" + ], + "VignetteBuilder": "knitr", + "RoxygenNote": "7.3.1", + "Encoding": "UTF-8", + "NeedsCompilation": "no", + "Author": "Yihui Xie [aut], Joe Cheng [aut, cre], Xianying Tan [aut], JJ Allaire [ctb], Maximilian Girlich [ctb], Greg Freedman Ellis [ctb], Johannes Rauh [ctb], SpryMedia Limited [ctb, cph] (DataTables in htmlwidgets/lib), Brian Reavis [ctb, cph] (selectize.js in htmlwidgets/lib), Leon Gersen [ctb, cph] (noUiSlider in htmlwidgets/lib), Bartek Szopka [ctb, cph] (jquery.highlight.js in htmlwidgets/lib), Alex Pickering [ctb], William Holmes [ctb], Mikko Marttila [ctb], Andres Quintero [ctb], Stéphane Laurent [ctb], Posit Software, PBC [cph, fnd]", + "Maintainer": "Joe Cheng ", + "Repository": "RSPM" + }, + "DescTools": { + "Package": "DescTools", + "Version": "0.99.59", + "Source": "Repository", + "Type": "Package", + "Title": "Tools for Descriptive Statistics", + "Date": "2025-01-25", + "Authors@R": "c( person(given=\"Andri\", family=\"Signorell\", email = \"andri@signorell.net\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0003-4311-1969\")), person(\"Ken\" , \"Aho\", role = c(\"ctb\")), person(\"Andreas\" , \"Alfons\", role = c(\"ctb\")), person(\"Nanina\" , \"Anderegg\", role = c(\"ctb\")), person(\"Tomas\" , \"Aragon\", role = c(\"ctb\")), person(\"Chandima\" , \"Arachchige\", role = c(\"ctb\")), person(\"Antti\" , \"Arppe\", role = c(\"ctb\")), person(\"Adrian\" , \"Baddeley\", role = c(\"ctb\")), person(\"Kamil\" , \"Barton\", role = c(\"ctb\")), person(\"Ben\" , \"Bolker\", role = c(\"ctb\")), person(\"Hans W.\" , \"Borchers\", role = c(\"ctb\")), person(\"Frederico\" , \"Caeiro\", role = c(\"ctb\")), person(\"Stephane\" , \"Champely\", role = c(\"ctb\")), person(\"Daniel\" , \"Chessel\", role = c(\"ctb\")), person(\"Leanne\" , \"Chhay\", role = c(\"ctb\")), person(\"Nicholas\" , \"Cooper\", role = c(\"ctb\")), person(\"Clint\" , \"Cummins\", role = c(\"ctb\")), person(\"Michael\" , \"Dewey\", role = c(\"ctb\")), person(\"Harold C.\" , \"Doran\", role = c(\"ctb\")), person(\"Stephane\" , \"Dray\", role = c(\"ctb\")), person(\"Charles\" , \"Dupont\", role = c(\"ctb\")), person(\"Dirk\" , \"Eddelbuettel\", role = c(\"ctb\")), person(\"Claus\" , \"Ekstrom\", role = c(\"ctb\")), person(\"Martin\" , \"Elff\", role = c(\"ctb\")), person(\"Jeff\" , \"Enos\", role = c(\"ctb\")), person(\"Richard W.\" , \"Farebrother\", role = c(\"ctb\")), person(\"John\" , \"Fox\", role = c(\"ctb\")), person(\"Romain\" , \"Francois\", role = c(\"ctb\")), person(\"Michael\" , \"Friendly\", role = c(\"ctb\")), person(\"Tal\" , \"Galili\", role = c(\"ctb\")), person(\"Matthias\" , \"Gamer\", role = c(\"ctb\")), person(\"Joseph L.\" , \"Gastwirth\", role = c(\"ctb\")), person(\"Vilmantas\" , \"Gegzna\", role = c(\"ctb\")), person(\"Yulia R.\" , \"Gel\", role = c(\"ctb\")), person(\"Sereina\" , \"Graber\", role = c(\"ctb\")), person(\"Juergen\" , \"Gross\", role = c(\"ctb\")), person(\"Gabor\" , \"Grothendieck\", role = c(\"ctb\")), person(\"Frank E.\" , \"Harrell Jr\", role = c(\"ctb\")), person(\"Richard\" , \"Heiberger\", role = c(\"ctb\")), person(\"Michael\" , \"Hoehle\", role = c(\"ctb\")), person(\"Christian W.\" , \"Hoffmann\", role = c(\"ctb\")), person(\"Soeren\" , \"Hojsgaard\", role = c(\"ctb\")), person(\"Torsten\" , \"Hothorn\", role = c(\"ctb\")), person(\"Markus\" , \"Huerzeler\", role = c(\"ctb\")), person(\"Wallace W.\" , \"Hui\", role = c(\"ctb\")), person(\"Pete\" , \"Hurd\", role = c(\"ctb\")), person(\"Rob J.\" , \"Hyndman\", role = c(\"ctb\")), person(\"Christopher\" , \"Jackson\", role = c(\"ctb\")), person(\"Matthias\" , \"Kohl\", role = c(\"ctb\")), person(\"Mikko\" , \"Korpela\", role = c(\"ctb\")), person(\"Max\" , \"Kuhn\", role = c(\"ctb\")), person(\"Detlew\" , \"Labes\", role = c(\"ctb\")), person(\"Friederich\" , \"Leisch\", role = c(\"ctb\")), person(\"Jim\" , \"Lemon\", role = c(\"ctb\")), person(\"Dong\" , \"Li\", role = c(\"ctb\")), person(\"Martin\" , \"Maechler\", role = c(\"ctb\")), person(\"Arni\" , \"Magnusson\", role = c(\"ctb\")), person(\"Ben\" , \"Mainwaring\", role = c(\"ctb\")), person(\"Daniel\" , \"Malter\", role = c(\"ctb\")), person(\"George\" , \"Marsaglia\", role = c(\"ctb\")), person(\"John\" , \"Marsaglia\", role = c(\"ctb\")), person(\"Alina\" , \"Matei\", role = c(\"ctb\")), person(\"David\" , \"Meyer\", role = c(\"ctb\")), person(\"Weiwen\" , \"Miao\", role = c(\"ctb\")), person(\"Giovanni\" , \"Millo\", role = c(\"ctb\")), person(\"Yongyi\" , \"Min\", role = c(\"ctb\")), person(\"David\" , \"Mitchell\", role = c(\"ctb\")), person(\"Cyril Flurin\" , \"Moser\", role = c(\"ctb\")), person(\"Franziska\" , \"Mueller\", role = c(\"ctb\")), person(\"Markus\" , \"Naepflin\", role = c(\"ctb\")), person(\"Danielle\" , \"Navarro\", role = c(\"ctb\")), person(\"Henric\" , \"Nilsson\", role = c(\"ctb\")), person(\"Klaus\" , \"Nordhausen\", role = c(\"ctb\")), person(\"Derek\" , \"Ogle\", role = c(\"ctb\")), person(\"Hong\" , \"Ooi\", role = c(\"ctb\")), person(\"Nick\" , \"Parsons\", role = c(\"ctb\")), person(\"Sandrine\" , \"Pavoine\", role = c(\"ctb\")), person(\"Tony\" , \"Plate\", role = c(\"ctb\")), person(\"Luke\" , \"Prendergast\", role = c(\"ctb\")), person(\"Roland\" , \"Rapold\", role = c(\"ctb\")), person(\"William\" , \"Revelle\", role = c(\"ctb\")), person(\"Tyler\" , \"Rinker\", role = c(\"ctb\")), person(\"Brian D.\" , \"Ripley\", role = c(\"ctb\")), person(\"Caroline\" , \"Rodriguez\", role = c(\"ctb\")), person(\"Nathan\" , \"Russell\", role = c(\"ctb\")), person(\"Nick\" , \"Sabbe\", role = c(\"ctb\")), person(\"Ralph\" , \"Scherer\", role = c(\"ctb\")), person(\"Venkatraman E.\", \"Seshan\", role = c(\"ctb\")), person(\"Michael\" , \"Smithson\", role = c(\"ctb\")), person(\"Greg\" , \"Snow\", role = c(\"ctb\")), person(\"Karline\" , \"Soetaert\", role = c(\"ctb\")), person(\"Werner A.\" , \"Stahel\", role = c(\"ctb\")), person(\"Alec\" , \"Stephenson\", role = c(\"ctb\")), person(\"Mark\" , \"Stevenson\", role = c(\"ctb\")), person(\"Ralf\" , \"Stubner\", role = c(\"ctb\")), person(\"Matthias\" , \"Templ\", role = c(\"ctb\")), person(\"Duncan\" , \"Temple Lang\", role = c(\"ctb\")), person(\"Terry\" , \"Therneau\", role = c(\"ctb\")), person(\"Yves\" , \"Tille\", role = c(\"ctb\")), person(\"Luis\" , \"Torgo\", role = c(\"ctb\")), person(\"Adrian\" , \"Trapletti\", role = c(\"ctb\")), person(\"Joshua\" , \"Ulrich\", role = c(\"ctb\")), person(\"Kevin\" , \"Ushey\", role = c(\"ctb\")), person(\"Jeremy\" , \"VanDerWal\", role = c(\"ctb\")), person(\"Bill\" , \"Venables\", role = c(\"ctb\")), person(\"John\" , \"Verzani\", role = c(\"ctb\")), person(\"Pablo J.\" , \"Villacorta Iglesias\", role = c(\"ctb\")), person(\"Gregory R.\" , \"Warnes\", role = c(\"ctb\")), person(\"Stefan\" , \"Wellek\", role = c(\"ctb\")), person(\"Hadley\" , \"Wickham\", role = c(\"ctb\")), person(\"Rand R.\" , \"Wilcox\", role = c(\"ctb\")), person(\"Peter\" , \"Wolf\", role = c(\"ctb\")), person(\"Daniel\" , \"Wollschlaeger\", role = c(\"ctb\")), person(\"Joseph\" , \"Wood\", role = c(\"ctb\")), person(\"Ying\" , \"Wu\", role = c(\"ctb\")), person(\"Thomas\" , \"Yee\", role = c(\"ctb\")), person(\"Achim\" , \"Zeileis\", role = c(\"ctb\")) )", + "Description": "A collection of miscellaneous basic statistic functions and convenience wrappers for efficiently describing data. The author's intention was to create a toolbox, which facilitates the (notoriously time consuming) first descriptive tasks in data analysis, consisting of calculating descriptive statistics, drawing graphical summaries and reporting the results. The package contains furthermore functions to produce documents using MS Word (or PowerPoint) and functions to import data from Excel. Many of the included functions can be found scattered in other packages and other sources written partly by Titans of R. The reason for collecting them here, was primarily to have them consolidated in ONE instead of dozens of packages (which themselves might depend on other packages which are not needed at all), and to provide a common and consistent interface as far as function and arguments naming, NA handling, recycling rules etc. are concerned. Google style guides were used as naming rules (in absence of convincing alternatives). The 'BigCamelCase' style was consequently applied to functions borrowed from contributed R packages as well.", + "Suggests": [ + "RDCOMClient", + "tcltk", + "VGAM", + "R.rsp", + "testthat (>= 3.0.0)" + ], + "Depends": [ + "base", + "stats", + "R (>= 4.2.0)" + ], + "Imports": [ + "graphics", + "grDevices", + "methods", + "MASS", + "utils", + "boot", + "mvtnorm", + "expm", + "Rcpp (>= 0.12.10)", + "rstudioapi", + "Exact", + "gld", + "data.table", + "readxl", + "haven", + "httr", + "withr", + "cli" + ], + "LinkingTo": [ + "Rcpp" + ], + "License": "GPL (>= 2)", + "LazyLoad": "yes", + "LazyData": "yes", + "Additional_repositories": "http://www.omegahat.net/R", + "URL": "https://andrisignorell.github.io/DescTools/, https://github.com/AndriSignorell/DescTools/", + "BugReports": "https://github.com/AndriSignorell/DescTools/issues", + "RoxygenNote": "7.3.2", + "Encoding": "UTF-8", + "NeedsCompilation": "yes", + "SystemRequirements": "C++17", + "VignetteBuilder": "R.rsp", + "Config/testthat/edition": "3", + "Author": "Andri Signorell [aut, cre] (), Ken Aho [ctb], Andreas Alfons [ctb], Nanina Anderegg [ctb], Tomas Aragon [ctb], Chandima Arachchige [ctb], Antti Arppe [ctb], Adrian Baddeley [ctb], Kamil Barton [ctb], Ben Bolker [ctb], Hans W. Borchers [ctb], Frederico Caeiro [ctb], Stephane Champely [ctb], Daniel Chessel [ctb], Leanne Chhay [ctb], Nicholas Cooper [ctb], Clint Cummins [ctb], Michael Dewey [ctb], Harold C. Doran [ctb], Stephane Dray [ctb], Charles Dupont [ctb], Dirk Eddelbuettel [ctb], Claus Ekstrom [ctb], Martin Elff [ctb], Jeff Enos [ctb], Richard W. Farebrother [ctb], John Fox [ctb], Romain Francois [ctb], Michael Friendly [ctb], Tal Galili [ctb], Matthias Gamer [ctb], Joseph L. Gastwirth [ctb], Vilmantas Gegzna [ctb], Yulia R. Gel [ctb], Sereina Graber [ctb], Juergen Gross [ctb], Gabor Grothendieck [ctb], Frank E. Harrell Jr [ctb], Richard Heiberger [ctb], Michael Hoehle [ctb], Christian W. Hoffmann [ctb], Soeren Hojsgaard [ctb], Torsten Hothorn [ctb], Markus Huerzeler [ctb], Wallace W. Hui [ctb], Pete Hurd [ctb], Rob J. Hyndman [ctb], Christopher Jackson [ctb], Matthias Kohl [ctb], Mikko Korpela [ctb], Max Kuhn [ctb], Detlew Labes [ctb], Friederich Leisch [ctb], Jim Lemon [ctb], Dong Li [ctb], Martin Maechler [ctb], Arni Magnusson [ctb], Ben Mainwaring [ctb], Daniel Malter [ctb], George Marsaglia [ctb], John Marsaglia [ctb], Alina Matei [ctb], David Meyer [ctb], Weiwen Miao [ctb], Giovanni Millo [ctb], Yongyi Min [ctb], David Mitchell [ctb], Cyril Flurin Moser [ctb], Franziska Mueller [ctb], Markus Naepflin [ctb], Danielle Navarro [ctb], Henric Nilsson [ctb], Klaus Nordhausen [ctb], Derek Ogle [ctb], Hong Ooi [ctb], Nick Parsons [ctb], Sandrine Pavoine [ctb], Tony Plate [ctb], Luke Prendergast [ctb], Roland Rapold [ctb], William Revelle [ctb], Tyler Rinker [ctb], Brian D. Ripley [ctb], Caroline Rodriguez [ctb], Nathan Russell [ctb], Nick Sabbe [ctb], Ralph Scherer [ctb], Venkatraman E. Seshan [ctb], Michael Smithson [ctb], Greg Snow [ctb], Karline Soetaert [ctb], Werner A. Stahel [ctb], Alec Stephenson [ctb], Mark Stevenson [ctb], Ralf Stubner [ctb], Matthias Templ [ctb], Duncan Temple Lang [ctb], Terry Therneau [ctb], Yves Tille [ctb], Luis Torgo [ctb], Adrian Trapletti [ctb], Joshua Ulrich [ctb], Kevin Ushey [ctb], Jeremy VanDerWal [ctb], Bill Venables [ctb], John Verzani [ctb], Pablo J. Villacorta Iglesias [ctb], Gregory R. Warnes [ctb], Stefan Wellek [ctb], Hadley Wickham [ctb], Rand R. Wilcox [ctb], Peter Wolf [ctb], Daniel Wollschlaeger [ctb], Joseph Wood [ctb], Ying Wu [ctb], Thomas Yee [ctb], Achim Zeileis [ctb]", + "Maintainer": "Andri Signorell ", + "Repository": "CRAN" + }, + "Exact": { + "Package": "Exact", + "Version": "3.3", + "Source": "Repository", + "Type": "Package", + "Title": "Unconditional Exact Test", + "Authors@R": "person(\"Peter\", \"Calhoun\", email=\"calhoun.peter@gmail.com\", role=c(\"aut\", \"cre\"))", + "Author": "Peter Calhoun [aut, cre]", + "Maintainer": "Peter Calhoun ", + "Description": "Performs unconditional exact tests and power calculations for 2x2 contingency tables. For comparing two independent proportions, performs Barnard's test (1945) using the original CSM test (Barnard, 1947 ), using Fisher's p-value referred to as Boschloo's test (1970) , or using a Z-statistic (Suissa and Shuster, 1985, ). For comparing two binary proportions, performs unconditional exact test using McNemar's Z-statistic (Berger and Sidik, 2003, ), using McNemar's conditional p-value, using McNemar's Z-statistic with continuity correction, or using CSM test. Calculates confidence intervals for the difference in proportion. This package interacts with pre-computed data available through the ExactData R package, which is available in a 'drat' repository. Install the ExactData R package from GitHub at . The ExactData R package is approximately 85 MB.", + "License": "GPL-2", + "Depends": [ + "R (>= 3.5.0)" + ], + "Imports": [ + "graphics", + "stats", + "utils", + "rootSolve" + ], + "Suggests": [ + "ExactData" + ], + "Additional_repositories": "https://pcalhoun1.github.io/drat", + "NeedsCompilation": "no", + "Repository": "CRAN" + }, + "MASS": { + "Package": "MASS", + "Version": "7.3-64", + "Source": "Repository", + "Priority": "recommended", + "Date": "2025-01-06", + "Revision": "$Rev: 3680 $", + "Depends": [ + "R (>= 4.4.0)", + "grDevices", + "graphics", + "stats", + "utils" + ], + "Imports": [ + "methods" + ], + "Suggests": [ + "lattice", + "nlme", + "nnet", + "survival" + ], + "Authors@R": "c(person(\"Brian\", \"Ripley\", role = c(\"aut\", \"cre\", \"cph\"), email = \"Brian.Ripley@R-project.org\"), person(\"Bill\", \"Venables\", role = c(\"aut\", \"cph\")), person(c(\"Douglas\", \"M.\"), \"Bates\", role = \"ctb\"), person(\"Kurt\", \"Hornik\", role = \"trl\", comment = \"partial port ca 1998\"), person(\"Albrecht\", \"Gebhardt\", role = \"trl\", comment = \"partial port ca 1998\"), person(\"David\", \"Firth\", role = \"ctb\", comment = \"support functions for polr\"))", + "Description": "Functions and datasets to support Venables and Ripley, \"Modern Applied Statistics with S\" (4th edition, 2002).", + "Title": "Support Functions and Datasets for Venables and Ripley's MASS", + "LazyData": "yes", + "ByteCompile": "yes", + "License": "GPL-2 | GPL-3", + "URL": "http://www.stats.ox.ac.uk/pub/MASS4/", + "Contact": "", + "NeedsCompilation": "yes", + "Author": "Brian Ripley [aut, cre, cph], Bill Venables [aut, cph], Douglas M. Bates [ctb], Kurt Hornik [trl] (partial port ca 1998), Albrecht Gebhardt [trl] (partial port ca 1998), David Firth [ctb] (support functions for polr)", + "Maintainer": "Brian Ripley ", + "Repository": "CRAN" + }, + "Matrix": { + "Package": "Matrix", + "Version": "1.7-2", + "Source": "Repository", + "VersionNote": "do also bump src/version.h, inst/include/Matrix/version.h", + "Date": "2025-01-20", + "Priority": "recommended", + "Title": "Sparse and Dense Matrix Classes and Methods", + "Description": "A rich hierarchy of sparse and dense matrix classes, including general, symmetric, triangular, and diagonal matrices with numeric, logical, or pattern entries. Efficient methods for operating on such matrices, often wrapping the 'BLAS', 'LAPACK', and 'SuiteSparse' libraries.", + "License": "GPL (>= 2) | file LICENCE", + "URL": "https://Matrix.R-forge.R-project.org", + "BugReports": "https://R-forge.R-project.org/tracker/?atid=294&group_id=61", + "Contact": "Matrix-authors@R-project.org", + "Authors@R": "c(person(\"Douglas\", \"Bates\", role = \"aut\", comment = c(ORCID = \"0000-0001-8316-9503\")), person(\"Martin\", \"Maechler\", role = c(\"aut\", \"cre\"), email = \"mmaechler+Matrix@gmail.com\", comment = c(ORCID = \"0000-0002-8685-9910\")), person(\"Mikael\", \"Jagan\", role = \"aut\", comment = c(ORCID = \"0000-0002-3542-2938\")), person(\"Timothy A.\", \"Davis\", role = \"ctb\", comment = c(ORCID = \"0000-0001-7614-6899\", \"SuiteSparse libraries\", \"collaborators listed in dir(system.file(\\\"doc\\\", \\\"SuiteSparse\\\", package=\\\"Matrix\\\"), pattern=\\\"License\\\", full.names=TRUE, recursive=TRUE)\")), person(\"George\", \"Karypis\", role = \"ctb\", comment = c(ORCID = \"0000-0003-2753-1437\", \"METIS library\", \"Copyright: Regents of the University of Minnesota\")), person(\"Jason\", \"Riedy\", role = \"ctb\", comment = c(ORCID = \"0000-0002-4345-4200\", \"GNU Octave's condest() and onenormest()\", \"Copyright: Regents of the University of California\")), person(\"Jens\", \"Oehlschlägel\", role = \"ctb\", comment = \"initial nearPD()\"), person(\"R Core Team\", role = \"ctb\", comment = c(ROR = \"02zz1nj61\", \"base R's matrix implementation\")))", + "Depends": [ + "R (>= 4.4)", + "methods" + ], + "Imports": [ + "grDevices", + "graphics", + "grid", + "lattice", + "stats", + "utils" + ], + "Suggests": [ + "MASS", + "datasets", + "sfsmisc", + "tools" + ], + "Enhances": [ + "SparseM", + "graph" + ], + "LazyData": "no", + "LazyDataNote": "not possible, since we use data/*.R and our S4 classes", + "BuildResaveData": "no", + "Encoding": "UTF-8", + "NeedsCompilation": "yes", + "Author": "Douglas Bates [aut] (), Martin Maechler [aut, cre] (), Mikael Jagan [aut] (), Timothy A. Davis [ctb] (, SuiteSparse libraries, collaborators listed in dir(system.file(\"doc\", \"SuiteSparse\", package=\"Matrix\"), pattern=\"License\", full.names=TRUE, recursive=TRUE)), George Karypis [ctb] (, METIS library, Copyright: Regents of the University of Minnesota), Jason Riedy [ctb] (, GNU Octave's condest() and onenormest(), Copyright: Regents of the University of California), Jens Oehlschlägel [ctb] (initial nearPD()), R Core Team [ctb] (02zz1nj61, base R's matrix implementation)", + "Maintainer": "Martin Maechler ", + "Repository": "CRAN" + }, + "R.cache": { + "Package": "R.cache", + "Version": "0.16.0", + "Source": "Repository", + "Depends": [ + "R (>= 2.14.0)" + ], + "Imports": [ + "utils", + "R.methodsS3 (>= 1.8.1)", + "R.oo (>= 1.24.0)", + "R.utils (>= 2.10.1)", + "digest (>= 0.6.13)" + ], + "Title": "Fast and Light-Weight Caching (Memoization) of Objects and Results to Speed Up Computations", + "Authors@R": "c(person(\"Henrik\", \"Bengtsson\", role=c(\"aut\", \"cre\", \"cph\"), email = \"henrikb@braju.com\"))", + "Author": "Henrik Bengtsson [aut, cre, cph]", + "Maintainer": "Henrik Bengtsson ", + "Description": "Memoization can be used to speed up repetitive and computational expensive function calls. The first time a function that implements memoization is called the results are stored in a cache memory. The next time the function is called with the same set of parameters, the results are momentarily retrieved from the cache avoiding repeating the calculations. With this package, any R object can be cached in a key-value storage where the key can be an arbitrary set of R objects. The cache memory is persistent (on the file system).", + "License": "LGPL (>= 2.1)", + "LazyLoad": "TRUE", + "URL": "https://github.com/HenrikBengtsson/R.cache", + "BugReports": "https://github.com/HenrikBengtsson/R.cache/issues", + "RoxygenNote": "7.2.1", + "NeedsCompilation": "no", + "Repository": "CRAN" + }, + "R.methodsS3": { + "Package": "R.methodsS3", + "Version": "1.8.2", + "Source": "Repository", + "Depends": [ + "R (>= 2.13.0)" + ], + "Imports": [ + "utils" + ], + "Suggests": [ + "codetools" + ], + "Title": "S3 Methods Simplified", + "Authors@R": "c(person(\"Henrik\", \"Bengtsson\", role=c(\"aut\", \"cre\", \"cph\"), email = \"henrikb@braju.com\"))", + "Author": "Henrik Bengtsson [aut, cre, cph]", + "Maintainer": "Henrik Bengtsson ", + "Description": "Methods that simplify the setup of S3 generic functions and S3 methods. Major effort has been made in making definition of methods as simple as possible with a minimum of maintenance for package developers. For example, generic functions are created automatically, if missing, and naming conflict are automatically solved, if possible. The method setMethodS3() is a good start for those who in the future may want to migrate to S4. This is a cross-platform package implemented in pure R that generates standard S3 methods.", + "License": "LGPL (>= 2.1)", + "LazyLoad": "TRUE", + "URL": "https://github.com/HenrikBengtsson/R.methodsS3", + "BugReports": "https://github.com/HenrikBengtsson/R.methodsS3/issues", + "NeedsCompilation": "no", + "Repository": "CRAN" + }, + "R.oo": { + "Package": "R.oo", + "Version": "1.27.0", + "Source": "Repository", + "Depends": [ + "R (>= 2.13.0)", + "R.methodsS3 (>= 1.8.2)" + ], + "Imports": [ + "methods", + "utils" + ], + "Suggests": [ + "tools" + ], + "Title": "R Object-Oriented Programming with or without References", + "Authors@R": "c(person(\"Henrik\", \"Bengtsson\", role=c(\"aut\", \"cre\", \"cph\"), email = \"henrikb@braju.com\"))", + "Author": "Henrik Bengtsson [aut, cre, cph]", + "Maintainer": "Henrik Bengtsson ", + "Description": "Methods and classes for object-oriented programming in R with or without references. Large effort has been made on making definition of methods as simple as possible with a minimum of maintenance for package developers. The package has been developed since 2001 and is now considered very stable. This is a cross-platform package implemented in pure R that defines standard S3 classes without any tricks.", + "License": "LGPL (>= 2.1)", + "LazyLoad": "TRUE", + "URL": "https://github.com/HenrikBengtsson/R.oo", + "BugReports": "https://github.com/HenrikBengtsson/R.oo/issues", + "NeedsCompilation": "no", + "Repository": "CRAN" + }, + "R.utils": { + "Package": "R.utils", + "Version": "2.12.3", + "Source": "Repository", + "Depends": [ + "R (>= 2.14.0)", + "R.oo" + ], + "Imports": [ + "methods", + "utils", + "tools", + "R.methodsS3" + ], + "Suggests": [ + "datasets", + "digest (>= 0.6.10)" + ], + "Title": "Various Programming Utilities", + "Authors@R": "c(person(\"Henrik\", \"Bengtsson\", role=c(\"aut\", \"cre\", \"cph\"), email = \"henrikb@braju.com\"))", + "Author": "Henrik Bengtsson [aut, cre, cph]", + "Maintainer": "Henrik Bengtsson ", + "Description": "Utility functions useful when programming and developing R packages.", + "License": "LGPL (>= 2.1)", + "LazyLoad": "TRUE", + "URL": "https://henrikbengtsson.github.io/R.utils/, https://github.com/HenrikBengtsson/R.utils", + "BugReports": "https://github.com/HenrikBengtsson/R.utils/issues", + "NeedsCompilation": "no", + "Repository": "CRAN" + }, + "R6": { + "Package": "R6", + "Version": "2.6.0", + "Source": "Repository", + "Title": "Encapsulated Classes with Reference Semantics", + "Authors@R": "c( person(\"Winston\", \"Chang\", , \"winston@posit.co\", role = c(\"aut\", \"cre\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Creates classes with reference semantics, similar to R's built-in reference classes. Compared to reference classes, R6 classes are simpler and lighter-weight, and they are not built on S4 classes so they do not require the methods package. These classes allow public and private members, and they support inheritance, even when the classes are defined in different packages.", + "License": "MIT + file LICENSE", + "URL": "https://r6.r-lib.org, https://github.com/r-lib/R6", + "BugReports": "https://github.com/r-lib/R6/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Suggests": [ + "lobstr", + "testthat (>= 3.0.0)" + ], + "Config/Needs/website": "tidyverse/tidytemplate, ggplot2, microbenchmark, scales", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "no", + "Author": "Winston Chang [aut, cre], Posit Software, PBC [cph, fnd]", + "Maintainer": "Winston Chang ", + "Repository": "CRAN" + }, + "RColorBrewer": { + "Package": "RColorBrewer", + "Version": "1.1-3", + "Source": "Repository", + "Date": "2022-04-03", + "Title": "ColorBrewer Palettes", + "Authors@R": "c(person(given = \"Erich\", family = \"Neuwirth\", role = c(\"aut\", \"cre\"), email = \"erich.neuwirth@univie.ac.at\"))", + "Author": "Erich Neuwirth [aut, cre]", + "Maintainer": "Erich Neuwirth ", + "Depends": [ + "R (>= 2.0.0)" + ], + "Description": "Provides color schemes for maps (and other graphics) designed by Cynthia Brewer as described at http://colorbrewer2.org.", + "License": "Apache License 2.0", + "NeedsCompilation": "no", + "Repository": "RSPM", + "Encoding": "UTF-8" + }, + "Rcpp": { + "Package": "Rcpp", + "Version": "1.0.14", + "Source": "Repository", + "Title": "Seamless R and C++ Integration", + "Date": "2025-01-11", + "Authors@R": "c(person(\"Dirk\", \"Eddelbuettel\", role = c(\"aut\", \"cre\"), email = \"edd@debian.org\", comment = c(ORCID = \"0000-0001-6419-907X\")), person(\"Romain\", \"Francois\", role = \"aut\", comment = c(ORCID = \"0000-0002-2444-4226\")), person(\"JJ\", \"Allaire\", role = \"aut\", comment = c(ORCID = \"0000-0003-0174-9868\")), person(\"Kevin\", \"Ushey\", role = \"aut\", comment = c(ORCID = \"0000-0003-2880-7407\")), person(\"Qiang\", \"Kou\", role = \"aut\", comment = c(ORCID = \"0000-0001-6786-5453\")), person(\"Nathan\", \"Russell\", role = \"aut\"), person(\"Iñaki\", \"Ucar\", role = \"aut\", comment = c(ORCID = \"0000-0001-6403-5550\")), person(\"Doug\", \"Bates\", role = \"aut\", comment = c(ORCID = \"0000-0001-8316-9503\")), person(\"John\", \"Chambers\", role = \"aut\"))", + "Description": "The 'Rcpp' package provides R functions as well as C++ classes which offer a seamless integration of R and C++. Many R data types and objects can be mapped back and forth to C++ equivalents which facilitates both writing of new code as well as easier integration of third-party libraries. Documentation about 'Rcpp' is provided by several vignettes included in this package, via the 'Rcpp Gallery' site at , the paper by Eddelbuettel and Francois (2011, ), the book by Eddelbuettel (2013, ) and the paper by Eddelbuettel and Balamuta (2018, ); see 'citation(\"Rcpp\")' for details.", + "Imports": [ + "methods", + "utils" + ], + "Suggests": [ + "tinytest", + "inline", + "rbenchmark", + "pkgKitten (>= 0.1.2)" + ], + "URL": "https://www.rcpp.org, https://dirk.eddelbuettel.com/code/rcpp.html, https://github.com/RcppCore/Rcpp", + "License": "GPL (>= 2)", + "BugReports": "https://github.com/RcppCore/Rcpp/issues", + "MailingList": "rcpp-devel@lists.r-forge.r-project.org", + "RoxygenNote": "6.1.1", + "Encoding": "UTF-8", + "NeedsCompilation": "yes", + "Author": "Dirk Eddelbuettel [aut, cre] (), Romain Francois [aut] (), JJ Allaire [aut] (), Kevin Ushey [aut] (), Qiang Kou [aut] (), Nathan Russell [aut], Iñaki Ucar [aut] (), Doug Bates [aut] (), John Chambers [aut]", + "Maintainer": "Dirk Eddelbuettel ", + "Repository": "CRAN" + }, + "arrow": { + "Package": "arrow", + "Version": "17.0.0.1", + "Source": "Repository", + "Title": "Integration to 'Apache' 'Arrow'", + "Authors@R": "c( person(\"Neal\", \"Richardson\", email = \"neal.p.richardson@gmail.com\", role = c(\"aut\")), person(\"Ian\", \"Cook\", email = \"ianmcook@gmail.com\", role = c(\"aut\")), person(\"Nic\", \"Crane\", email = \"thisisnic@gmail.com\", role = c(\"aut\")), person(\"Dewey\", \"Dunnington\", role = c(\"aut\"), email = \"dewey@fishandwhistle.net\", comment = c(ORCID = \"0000-0002-9415-4582\")), person(\"Romain\", \"Fran\\u00e7ois\", role = c(\"aut\"), comment = c(ORCID = \"0000-0002-2444-4226\")), person(\"Jonathan\", \"Keane\", email = \"jkeane@gmail.com\", role = c(\"aut\", \"cre\")), person(\"Drago\\u0219\", \"Moldovan-Gr\\u00fcnfeld\", email = \"dragos.mold@gmail.com\", role = c(\"aut\")), person(\"Jeroen\", \"Ooms\", email = \"jeroen@berkeley.edu\", role = c(\"aut\")), person(\"Jacob\", \"Wujciak-Jens\", email = \"jacob@wujciak.de\", role = c(\"aut\")), person(\"Javier\", \"Luraschi\", email = \"javier@rstudio.com\", role = c(\"ctb\")), person(\"Karl\", \"Dunkle Werner\", email = \"karldw@users.noreply.github.com\", role = c(\"ctb\"), comment = c(ORCID = \"0000-0003-0523-7309\")), person(\"Jeffrey\", \"Wong\", email = \"jeffreyw@netflix.com\", role = c(\"ctb\")), person(\"Apache Arrow\", email = \"dev@arrow.apache.org\", role = c(\"aut\", \"cph\")) )", + "Description": "'Apache' 'Arrow' is a cross-language development platform for in-memory data. It specifies a standardized language-independent columnar memory format for flat and hierarchical data, organized for efficient analytic operations on modern hardware. This package provides an interface to the 'Arrow C++' library.", + "Depends": [ + "R (>= 4.0)" + ], + "License": "Apache License (>= 2.0)", + "URL": "https://github.com/apache/arrow/, https://arrow.apache.org/docs/r/", + "BugReports": "https://github.com/apache/arrow/issues", + "Encoding": "UTF-8", + "Language": "en-US", + "SystemRequirements": "C++17; for AWS S3 support on Linux, libcurl and openssl (optional); cmake >= 3.16 (build-time only, and only for full source build)", + "Biarch": "true", + "Imports": [ + "assertthat", + "bit64 (>= 0.9-7)", + "glue", + "methods", + "purrr", + "R6", + "rlang (>= 1.0.0)", + "stats", + "tidyselect (>= 1.0.0)", + "utils", + "vctrs" + ], + "RoxygenNote": "7.3.1", + "Config/testthat/edition": "3", + "Config/build/bootstrap": "TRUE", + "Suggests": [ + "blob", + "curl", + "cli", + "DBI", + "dbplyr", + "decor", + "distro", + "dplyr", + "duckdb (>= 0.2.8)", + "hms", + "jsonlite", + "knitr", + "lubridate", + "pillar", + "pkgload", + "reticulate", + "rmarkdown", + "stringi", + "stringr", + "sys", + "testthat (>= 3.1.0)", + "tibble", + "tzdb", + "withr" + ], + "LinkingTo": [ + "cpp11 (>= 0.4.2)" + ], + "Collate": "'arrowExports.R' 'enums.R' 'arrow-object.R' 'type.R' 'array-data.R' 'arrow-datum.R' 'array.R' 'arrow-info.R' 'arrow-package.R' 'arrow-tabular.R' 'buffer.R' 'chunked-array.R' 'io.R' 'compression.R' 'scalar.R' 'compute.R' 'config.R' 'csv.R' 'dataset.R' 'dataset-factory.R' 'dataset-format.R' 'dataset-partition.R' 'dataset-scan.R' 'dataset-write.R' 'dictionary.R' 'dplyr-across.R' 'dplyr-arrange.R' 'dplyr-by.R' 'dplyr-collect.R' 'dplyr-count.R' 'dplyr-datetime-helpers.R' 'dplyr-distinct.R' 'dplyr-eval.R' 'dplyr-filter.R' 'dplyr-funcs-agg.R' 'dplyr-funcs-augmented.R' 'dplyr-funcs-conditional.R' 'dplyr-funcs-datetime.R' 'dplyr-funcs-doc.R' 'dplyr-funcs-math.R' 'dplyr-funcs-simple.R' 'dplyr-funcs-string.R' 'dplyr-funcs-type.R' 'expression.R' 'dplyr-funcs.R' 'dplyr-glimpse.R' 'dplyr-group-by.R' 'dplyr-join.R' 'dplyr-mutate.R' 'dplyr-select.R' 'dplyr-slice.R' 'dplyr-summarize.R' 'dplyr-union.R' 'record-batch.R' 'table.R' 'dplyr.R' 'duckdb.R' 'extension.R' 'feather.R' 'field.R' 'filesystem.R' 'flight.R' 'install-arrow.R' 'ipc-stream.R' 'json.R' 'memory-pool.R' 'message.R' 'metadata.R' 'parquet.R' 'python.R' 'query-engine.R' 'record-batch-reader.R' 'record-batch-writer.R' 'reexports-bit64.R' 'reexports-tidyselect.R' 'schema.R' 'udf.R' 'util.R'", + "NeedsCompilation": "yes", + "Author": "Neal Richardson [aut], Ian Cook [aut], Nic Crane [aut], Dewey Dunnington [aut] (), Romain François [aut] (), Jonathan Keane [aut, cre], Dragoș Moldovan-Grünfeld [aut], Jeroen Ooms [aut], Jacob Wujciak-Jens [aut], Javier Luraschi [ctb], Karl Dunkle Werner [ctb] (), Jeffrey Wong [ctb], Apache Arrow [aut, cph]", + "Maintainer": "Jonathan Keane ", + "Repository": "RSPM" + }, + "askpass": { + "Package": "askpass", + "Version": "1.2.1", + "Source": "Repository", + "Type": "Package", + "Title": "Password Entry Utilities for R, Git, and SSH", + "Authors@R": "person(\"Jeroen\", \"Ooms\", role = c(\"aut\", \"cre\"), email = \"jeroenooms@gmail.com\", comment = c(ORCID = \"0000-0002-4035-0289\"))", + "Description": "Cross-platform utilities for prompting the user for credentials or a passphrase, for example to authenticate with a server or read a protected key. Includes native programs for MacOS and Windows, hence no 'tcltk' is required. Password entry can be invoked in two different ways: directly from R via the askpass() function, or indirectly as password-entry back-end for 'ssh-agent' or 'git-credential' via the SSH_ASKPASS and GIT_ASKPASS environment variables. Thereby the user can be prompted for credentials or a passphrase if needed when R calls out to git or ssh.", + "License": "MIT + file LICENSE", + "URL": "https://r-lib.r-universe.dev/askpass", + "BugReports": "https://github.com/r-lib/askpass/issues", + "Encoding": "UTF-8", + "Imports": [ + "sys (>= 2.1)" + ], + "RoxygenNote": "7.2.3", + "Suggests": [ + "testthat" + ], + "Language": "en-US", + "NeedsCompilation": "yes", + "Author": "Jeroen Ooms [aut, cre] ()", + "Maintainer": "Jeroen Ooms ", + "Repository": "RSPM" + }, + "assertthat": { + "Package": "assertthat", + "Version": "0.2.1", + "Source": "Repository", + "Title": "Easy Pre and Post Assertions", + "Authors@R": "person(\"Hadley\", \"Wickham\", , \"hadley@rstudio.com\", c(\"aut\", \"cre\"))", + "Description": "An extension to stopifnot() that makes it easy to declare the pre and post conditions that you code should satisfy, while also producing friendly error messages so that your users know what's gone wrong.", + "License": "GPL-3", + "Imports": [ + "tools" + ], + "Suggests": [ + "testthat", + "covr" + ], + "RoxygenNote": "6.0.1", + "Collate": "'assert-that.r' 'on-failure.r' 'assertions-file.r' 'assertions-scalar.R' 'assertions.r' 'base.r' 'base-comparison.r' 'base-is.r' 'base-logical.r' 'base-misc.r' 'utils.r' 'validate-that.R'", + "NeedsCompilation": "no", + "Author": "Hadley Wickham [aut, cre]", + "Maintainer": "Hadley Wickham ", + "Repository": "RSPM", + "Encoding": "UTF-8" + }, + "backports": { + "Package": "backports", + "Version": "1.5.0", + "Source": "Repository", + "Type": "Package", + "Title": "Reimplementations of Functions Introduced Since R-3.0.0", + "Authors@R": "c( person(\"Michel\", \"Lang\", NULL, \"michellang@gmail.com\", role = c(\"cre\", \"aut\"), comment = c(ORCID = \"0000-0001-9754-0393\")), person(\"Duncan\", \"Murdoch\", NULL, \"murdoch.duncan@gmail.com\", role = c(\"aut\")), person(\"R Core Team\", role = \"aut\"))", + "Maintainer": "Michel Lang ", + "Description": "Functions introduced or changed since R v3.0.0 are re-implemented in this package. The backports are conditionally exported in order to let R resolve the function name to either the implemented backport, or the respective base version, if available. Package developers can make use of new functions or arguments by selectively importing specific backports to support older installations.", + "URL": "https://github.com/r-lib/backports", + "BugReports": "https://github.com/r-lib/backports/issues", + "License": "GPL-2 | GPL-3", + "NeedsCompilation": "yes", + "ByteCompile": "yes", + "Depends": [ + "R (>= 3.0.0)" + ], + "Encoding": "UTF-8", + "RoxygenNote": "7.3.1", + "Author": "Michel Lang [cre, aut] (), Duncan Murdoch [aut], R Core Team [aut]", + "Repository": "RSPM" + }, + "base64enc": { + "Package": "base64enc", + "Version": "0.1-3", + "Source": "Repository", + "Title": "Tools for base64 encoding", + "Author": "Simon Urbanek ", + "Maintainer": "Simon Urbanek ", + "Depends": [ + "R (>= 2.9.0)" + ], + "Enhances": [ + "png" + ], + "Description": "This package provides tools for handling base64 encoding. It is more flexible than the orphaned base64 package.", + "License": "GPL-2 | GPL-3", + "URL": "http://www.rforge.net/base64enc", + "NeedsCompilation": "yes", + "Repository": "RSPM", + "Encoding": "UTF-8" + }, + "bit": { + "Package": "bit", + "Version": "4.5.0.1", + "Source": "Repository", + "Type": "Package", + "Title": "Classes and Methods for Fast Memory-Efficient Boolean Selections", + "Date": "2024-09-17", + "Authors@R": "c(person(given = \"Jens\", family = \"Oehlschlägel\", role = c(\"aut\", \"cre\"), email = \"Jens.Oehlschlaegel@truecluster.com\"), person(given = \"Brian\", family = \"Ripley\", role = \"ctb\"))", + "Author": "Jens Oehlschlägel [aut, cre], Brian Ripley [ctb]", + "Maintainer": "Jens Oehlschlägel ", + "Depends": [ + "R (>= 3.4.0)" + ], + "Suggests": [ + "testthat (>= 0.11.0)", + "roxygen2", + "knitr", + "markdown", + "rmarkdown", + "microbenchmark", + "bit64 (>= 4.0.0)", + "ff (>= 4.0.0)" + ], + "Description": "Provided are classes for boolean and skewed boolean vectors, fast boolean methods, fast unique and non-unique integer sorting, fast set operations on sorted and unsorted sets of integers, and foundations for ff (range index, compression, chunked processing).", + "License": "GPL-2 | GPL-3", + "LazyLoad": "yes", + "ByteCompile": "yes", + "Encoding": "UTF-8", + "URL": "https://github.com/truecluster/bit", + "VignetteBuilder": "knitr, rmarkdown", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "yes", + "Repository": "CRAN" + }, + "bit64": { + "Package": "bit64", + "Version": "4.6.0-1", + "Source": "Repository", + "Title": "A S3 Class for Vectors of 64bit Integers", + "Authors@R": "c( person(\"Michael\", \"Chirico\", email = \"michaelchirico4@gmail.com\", role = c(\"aut\", \"cre\")), person(\"Jens\", \"Oehlschlägel\", role = \"aut\"), person(\"Leonardo\", \"Silvestri\", role = \"ctb\"), person(\"Ofek\", \"Shilon\", role = \"ctb\") )", + "Depends": [ + "R (>= 3.4.0)", + "bit (>= 4.0.0)" + ], + "Description": "Package 'bit64' provides serializable S3 atomic 64bit (signed) integers. These are useful for handling database keys and exact counting in +-2^63. WARNING: do not use them as replacement for 32bit integers, integer64 are not supported for subscripting by R-core and they have different semantics when combined with double, e.g. integer64 + double => integer64. Class integer64 can be used in vectors, matrices, arrays and data.frames. Methods are available for coercion from and to logicals, integers, doubles, characters and factors as well as many elementwise and summary functions. Many fast algorithmic operations such as 'match' and 'order' support inter- active data exploration and manipulation and optionally leverage caching.", + "License": "GPL-2 | GPL-3", + "LazyLoad": "yes", + "ByteCompile": "yes", + "URL": "https://github.com/r-lib/bit64", + "Encoding": "UTF-8", + "Imports": [ + "graphics", + "methods", + "stats", + "utils" + ], + "Suggests": [ + "testthat (>= 3.0.3)", + "withr" + ], + "Config/testthat/edition": "3", + "Config/needs/development": "testthat", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "yes", + "Author": "Michael Chirico [aut, cre], Jens Oehlschlägel [aut], Leonardo Silvestri [ctb], Ofek Shilon [ctb]", + "Maintainer": "Michael Chirico ", + "Repository": "CRAN" + }, + "boot": { + "Package": "boot", + "Version": "1.3-31", + "Source": "Repository", + "Priority": "recommended", + "Date": "2024-08-28", + "Authors@R": "c(person(\"Angelo\", \"Canty\", role = \"aut\", email = \"cantya@mcmaster.ca\", comment = \"author of original code for S\"), person(\"Brian\", \"Ripley\", role = c(\"aut\", \"trl\"), email = \"ripley@stats.ox.ac.uk\", comment = \"conversion to R, maintainer 1999--2022, author of parallel support\"), person(\"Alessandra R.\", \"Brazzale\", role = c(\"ctb\", \"cre\"), email = \"brazzale@stat.unipd.it\", comment = \"minor bug fixes\"))", + "Maintainer": "Alessandra R. Brazzale ", + "Note": "Maintainers are not available to give advice on using a package they did not author.", + "Description": "Functions and datasets for bootstrapping from the book \"Bootstrap Methods and Their Application\" by A. C. Davison and D. V. Hinkley (1997, CUP), originally written by Angelo Canty for S.", + "Title": "Bootstrap Functions (Originally by Angelo Canty for S)", + "Depends": [ + "R (>= 3.0.0)", + "graphics", + "stats" + ], + "Suggests": [ + "MASS", + "survival" + ], + "LazyData": "yes", + "ByteCompile": "yes", + "License": "Unlimited", + "NeedsCompilation": "no", + "Author": "Angelo Canty [aut] (author of original code for S), Brian Ripley [aut, trl] (conversion to R, maintainer 1999--2022, author of parallel support), Alessandra R. Brazzale [ctb, cre] (minor bug fixes)", + "Repository": "RSPM", + "Encoding": "UTF-8" + }, + "bslib": { + "Package": "bslib", + "Version": "0.9.0", + "Source": "Repository", + "Title": "Custom 'Bootstrap' 'Sass' Themes for 'shiny' and 'rmarkdown'", + "Authors@R": "c( person(\"Carson\", \"Sievert\", , \"carson@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-4958-2844\")), person(\"Joe\", \"Cheng\", , \"joe@posit.co\", role = \"aut\"), person(\"Garrick\", \"Aden-Buie\", , \"garrick@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0002-7111-0077\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")), person(, \"Bootstrap contributors\", role = \"ctb\", comment = \"Bootstrap library\"), person(, \"Twitter, Inc\", role = \"cph\", comment = \"Bootstrap library\"), person(\"Javi\", \"Aguilar\", role = c(\"ctb\", \"cph\"), comment = \"Bootstrap colorpicker library\"), person(\"Thomas\", \"Park\", role = c(\"ctb\", \"cph\"), comment = \"Bootswatch library\"), person(, \"PayPal\", role = c(\"ctb\", \"cph\"), comment = \"Bootstrap accessibility plugin\") )", + "Description": "Simplifies custom 'CSS' styling of both 'shiny' and 'rmarkdown' via 'Bootstrap' 'Sass'. Supports 'Bootstrap' 3, 4 and 5 as well as their various 'Bootswatch' themes. An interactive widget is also provided for previewing themes in real time.", + "License": "MIT + file LICENSE", + "URL": "https://rstudio.github.io/bslib/, https://github.com/rstudio/bslib", + "BugReports": "https://github.com/rstudio/bslib/issues", + "Depends": [ + "R (>= 2.10)" + ], + "Imports": [ + "base64enc", + "cachem", + "fastmap (>= 1.1.1)", + "grDevices", + "htmltools (>= 0.5.8)", + "jquerylib (>= 0.1.3)", + "jsonlite", + "lifecycle", + "memoise (>= 2.0.1)", + "mime", + "rlang", + "sass (>= 0.4.9)" + ], + "Suggests": [ + "bsicons", + "curl", + "fontawesome", + "future", + "ggplot2", + "knitr", + "magrittr", + "rappdirs", + "rmarkdown (>= 2.7)", + "shiny (> 1.8.1)", + "testthat", + "thematic", + "tools", + "utils", + "withr", + "yaml" + ], + "Config/Needs/deploy": "BH, chiflights22, colourpicker, commonmark, cpp11, cpsievert/chiflights22, cpsievert/histoslider, dplyr, DT, ggplot2, ggridges, gt, hexbin, histoslider, htmlwidgets, lattice, leaflet, lubridate, markdown, modelr, plotly, reactable, reshape2, rprojroot, rsconnect, rstudio/shiny, scales, styler, tibble", + "Config/Needs/routine": "chromote, desc, renv", + "Config/Needs/website": "brio, crosstalk, dplyr, DT, ggplot2, glue, htmlwidgets, leaflet, lorem, palmerpenguins, plotly, purrr, rprojroot, rstudio/htmltools, scales, stringr, tidyr, webshot2", + "Config/testthat/edition": "3", + "Config/testthat/parallel": "true", + "Config/testthat/start-first": "zzzz-bs-sass, fonts, zzz-precompile, theme-*, rmd-*", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "Collate": "'accordion.R' 'breakpoints.R' 'bs-current-theme.R' 'bs-dependencies.R' 'bs-global.R' 'bs-remove.R' 'bs-theme-layers.R' 'bs-theme-preset-bootswatch.R' 'bs-theme-preset-brand.R' 'bs-theme-preset-builtin.R' 'bs-theme-preset.R' 'utils.R' 'bs-theme-preview.R' 'bs-theme-update.R' 'bs-theme.R' 'bslib-package.R' 'buttons.R' 'card.R' 'deprecated.R' 'files.R' 'fill.R' 'imports.R' 'input-dark-mode.R' 'input-switch.R' 'layout.R' 'nav-items.R' 'nav-update.R' 'navbar_options.R' 'navs-legacy.R' 'navs.R' 'onLoad.R' 'page.R' 'popover.R' 'precompiled.R' 'print.R' 'shiny-devmode.R' 'sidebar.R' 'staticimports.R' 'tooltip.R' 'utils-deps.R' 'utils-shiny.R' 'utils-tags.R' 'value-box.R' 'version-default.R' 'versions.R'", + "NeedsCompilation": "no", + "Author": "Carson Sievert [aut, cre] (), Joe Cheng [aut], Garrick Aden-Buie [aut] (), Posit Software, PBC [cph, fnd], Bootstrap contributors [ctb] (Bootstrap library), Twitter, Inc [cph] (Bootstrap library), Javi Aguilar [ctb, cph] (Bootstrap colorpicker library), Thomas Park [ctb, cph] (Bootswatch library), PayPal [ctb, cph] (Bootstrap accessibility plugin)", + "Maintainer": "Carson Sievert ", + "Repository": "CRAN" + }, + "cachem": { + "Package": "cachem", + "Version": "1.1.0", + "Source": "Repository", + "Title": "Cache R Objects with Automatic Pruning", + "Description": "Key-value stores with automatic pruning. Caches can limit either their total size or the age of the oldest object (or both), automatically pruning objects to maintain the constraints.", + "Authors@R": "c( person(\"Winston\", \"Chang\", , \"winston@posit.co\", c(\"aut\", \"cre\")), person(family = \"Posit Software, PBC\", role = c(\"cph\", \"fnd\")))", + "License": "MIT + file LICENSE", + "Encoding": "UTF-8", + "ByteCompile": "true", + "URL": "https://cachem.r-lib.org/, https://github.com/r-lib/cachem", + "Imports": [ + "rlang", + "fastmap (>= 1.2.0)" + ], + "Suggests": [ + "testthat" + ], + "RoxygenNote": "7.2.3", + "Config/Needs/routine": "lobstr", + "Config/Needs/website": "pkgdown", + "NeedsCompilation": "yes", + "Author": "Winston Chang [aut, cre], Posit Software, PBC [cph, fnd]", + "Maintainer": "Winston Chang ", + "Repository": "RSPM" + }, + "callr": { + "Package": "callr", + "Version": "3.7.6", + "Source": "Repository", + "Title": "Call R from R", + "Authors@R": "c( person(\"Gábor\", \"Csárdi\", , \"csardi.gabor@gmail.com\", role = c(\"aut\", \"cre\", \"cph\"), comment = c(ORCID = \"0000-0001-7098-9676\")), person(\"Winston\", \"Chang\", role = \"aut\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")), person(\"Ascent Digital Services\", role = c(\"cph\", \"fnd\")) )", + "Description": "It is sometimes useful to perform a computation in a separate R process, without affecting the current R process at all. This packages does exactly that.", + "License": "MIT + file LICENSE", + "URL": "https://callr.r-lib.org, https://github.com/r-lib/callr", + "BugReports": "https://github.com/r-lib/callr/issues", + "Depends": [ + "R (>= 3.4)" + ], + "Imports": [ + "processx (>= 3.6.1)", + "R6", + "utils" + ], + "Suggests": [ + "asciicast (>= 2.3.1)", + "cli (>= 1.1.0)", + "mockery", + "ps", + "rprojroot", + "spelling", + "testthat (>= 3.2.0)", + "withr (>= 2.3.0)" + ], + "Config/Needs/website": "r-lib/asciicast, glue, htmlwidgets, igraph, tibble, tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "Language": "en-US", + "RoxygenNote": "7.3.1.9000", + "NeedsCompilation": "no", + "Author": "Gábor Csárdi [aut, cre, cph] (), Winston Chang [aut], Posit Software, PBC [cph, fnd], Ascent Digital Services [cph, fnd]", + "Maintainer": "Gábor Csárdi ", + "Repository": "RSPM" + }, + "cellranger": { + "Package": "cellranger", + "Version": "1.1.0", + "Source": "Repository", + "Title": "Translate Spreadsheet Cell Ranges to Rows and Columns", + "Authors@R": "c( person(\"Jennifer\", \"Bryan\", , \"jenny@stat.ubc.ca\", c(\"cre\", \"aut\")), person(\"Hadley\", \"Wickham\", , \"hadley@rstudio.com\", \"ctb\") )", + "Description": "Helper functions to work with spreadsheets and the \"A1:D10\" style of cell range specification.", + "Depends": [ + "R (>= 3.0.0)" + ], + "License": "MIT + file LICENSE", + "LazyData": "true", + "URL": "https://github.com/rsheets/cellranger", + "BugReports": "https://github.com/rsheets/cellranger/issues", + "Suggests": [ + "covr", + "testthat (>= 1.0.0)", + "knitr", + "rmarkdown" + ], + "RoxygenNote": "5.0.1.9000", + "VignetteBuilder": "knitr", + "Imports": [ + "rematch", + "tibble" + ], + "NeedsCompilation": "no", + "Author": "Jennifer Bryan [cre, aut], Hadley Wickham [ctb]", + "Maintainer": "Jennifer Bryan ", + "Repository": "RSPM", + "Encoding": "UTF-8" + }, + "checkmate": { + "Package": "checkmate", + "Version": "2.3.2", + "Source": "Repository", + "Type": "Package", + "Title": "Fast and Versatile Argument Checks", + "Description": "Tests and assertions to perform frequent argument checks. A substantial part of the package was written in C to minimize any worries about execution time overhead.", + "Authors@R": "c( person(\"Michel\", \"Lang\", NULL, \"michellang@gmail.com\", role = c(\"cre\", \"aut\"), comment = c(ORCID = \"0000-0001-9754-0393\")), person(\"Bernd\", \"Bischl\", NULL, \"bernd_bischl@gmx.net\", role = \"ctb\"), person(\"Dénes\", \"Tóth\", NULL, \"toth.denes@kogentum.hu\", role = \"ctb\", comment = c(ORCID = \"0000-0003-4262-3217\")) )", + "URL": "https://mllg.github.io/checkmate/, https://github.com/mllg/checkmate", + "URLNote": "https://github.com/mllg/checkmate", + "BugReports": "https://github.com/mllg/checkmate/issues", + "NeedsCompilation": "yes", + "ByteCompile": "yes", + "Encoding": "UTF-8", + "Depends": [ + "R (>= 3.0.0)" + ], + "Imports": [ + "backports (>= 1.1.0)", + "utils" + ], + "Suggests": [ + "R6", + "fastmatch", + "data.table (>= 1.9.8)", + "devtools", + "ggplot2", + "knitr", + "magrittr", + "microbenchmark", + "rmarkdown", + "testthat (>= 3.0.4)", + "tinytest (>= 1.1.0)", + "tibble" + ], + "License": "BSD_3_clause + file LICENSE", + "VignetteBuilder": "knitr", + "RoxygenNote": "7.3.2", + "Collate": "'AssertCollection.R' 'allMissing.R' 'anyInfinite.R' 'anyMissing.R' 'anyNaN.R' 'asInteger.R' 'assert.R' 'helper.R' 'makeExpectation.R' 'makeTest.R' 'makeAssertion.R' 'checkAccess.R' 'checkArray.R' 'checkAtomic.R' 'checkAtomicVector.R' 'checkCharacter.R' 'checkChoice.R' 'checkClass.R' 'checkComplex.R' 'checkCount.R' 'checkDataFrame.R' 'checkDataTable.R' 'checkDate.R' 'checkDirectoryExists.R' 'checkDisjunct.R' 'checkDouble.R' 'checkEnvironment.R' 'checkFALSE.R' 'checkFactor.R' 'checkFileExists.R' 'checkFlag.R' 'checkFormula.R' 'checkFunction.R' 'checkInt.R' 'checkInteger.R' 'checkIntegerish.R' 'checkList.R' 'checkLogical.R' 'checkMatrix.R' 'checkMultiClass.R' 'checkNamed.R' 'checkNames.R' 'checkNull.R' 'checkNumber.R' 'checkNumeric.R' 'checkOS.R' 'checkPOSIXct.R' 'checkPathForOutput.R' 'checkPermutation.R' 'checkR6.R' 'checkRaw.R' 'checkScalar.R' 'checkScalarNA.R' 'checkSetEqual.R' 'checkString.R' 'checkSubset.R' 'checkTRUE.R' 'checkTibble.R' 'checkVector.R' 'coalesce.R' 'isIntegerish.R' 'matchArg.R' 'qassert.R' 'qassertr.R' 'vname.R' 'wfwl.R' 'zzz.R'", + "Author": "Michel Lang [cre, aut] (), Bernd Bischl [ctb], Dénes Tóth [ctb] ()", + "Maintainer": "Michel Lang ", + "Repository": "RSPM" + }, + "class": { + "Package": "class", + "Version": "7.3-23", + "Source": "Repository", + "Priority": "recommended", + "Date": "2025-01-01", + "Depends": [ + "R (>= 3.0.0)", + "stats", + "utils" + ], + "Imports": [ + "MASS" + ], + "Authors@R": "c(person(\"Brian\", \"Ripley\", role = c(\"aut\", \"cre\", \"cph\"), email = \"Brian.Ripley@R-project.org\"), person(\"William\", \"Venables\", role = \"cph\"))", + "Description": "Various functions for classification, including k-nearest neighbour, Learning Vector Quantization and Self-Organizing Maps.", + "Title": "Functions for Classification", + "ByteCompile": "yes", + "License": "GPL-2 | GPL-3", + "URL": "http://www.stats.ox.ac.uk/pub/MASS4/", + "NeedsCompilation": "yes", + "Author": "Brian Ripley [aut, cre, cph], William Venables [cph]", + "Maintainer": "Brian Ripley ", + "Repository": "CRAN" + }, + "cli": { + "Package": "cli", + "Version": "3.6.4", + "Source": "Repository", + "Title": "Helpers for Developing Command Line Interfaces", + "Authors@R": "c( person(\"Gábor\", \"Csárdi\", , \"gabor@posit.co\", role = c(\"aut\", \"cre\")), person(\"Hadley\", \"Wickham\", role = \"ctb\"), person(\"Kirill\", \"Müller\", role = \"ctb\"), person(\"Salim\", \"Brüggemann\", , \"salim-b@pm.me\", role = \"ctb\", comment = c(ORCID = \"0000-0002-5329-5987\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "A suite of tools to build attractive command line interfaces ('CLIs'), from semantic elements: headings, lists, alerts, paragraphs, etc. Supports custom themes via a 'CSS'-like language. It also contains a number of lower level 'CLI' elements: rules, boxes, trees, and 'Unicode' symbols with 'ASCII' alternatives. It support ANSI colors and text styles as well.", + "License": "MIT + file LICENSE", + "URL": "https://cli.r-lib.org, https://github.com/r-lib/cli", + "BugReports": "https://github.com/r-lib/cli/issues", + "Depends": [ + "R (>= 3.4)" + ], + "Imports": [ + "utils" + ], + "Suggests": [ + "callr", + "covr", + "crayon", + "digest", + "glue (>= 1.6.0)", + "grDevices", + "htmltools", + "htmlwidgets", + "knitr", + "methods", + "processx", + "ps (>= 1.3.4.9000)", + "rlang (>= 1.0.2.9003)", + "rmarkdown", + "rprojroot", + "rstudioapi", + "testthat (>= 3.2.0)", + "tibble", + "whoami", + "withr" + ], + "Config/Needs/website": "r-lib/asciicast, bench, brio, cpp11, decor, desc, fansi, prettyunits, sessioninfo, tidyverse/tidytemplate, usethis, vctrs", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "yes", + "Author": "Gábor Csárdi [aut, cre], Hadley Wickham [ctb], Kirill Müller [ctb], Salim Brüggemann [ctb] (), Posit Software, PBC [cph, fnd]", + "Maintainer": "Gábor Csárdi ", + "Repository": "CRAN" + }, + "clipr": { + "Package": "clipr", + "Version": "0.8.0", + "Source": "Repository", + "Type": "Package", + "Title": "Read and Write from the System Clipboard", + "Authors@R": "c( person(\"Matthew\", \"Lincoln\", , \"matthew.d.lincoln@gmail.com\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-4387-3384\")), person(\"Louis\", \"Maddox\", role = \"ctb\"), person(\"Steve\", \"Simpson\", role = \"ctb\"), person(\"Jennifer\", \"Bryan\", role = \"ctb\") )", + "Description": "Simple utility functions to read from and write to the Windows, OS X, and X11 clipboards.", + "License": "GPL-3", + "URL": "https://github.com/mdlincoln/clipr, http://matthewlincoln.net/clipr/", + "BugReports": "https://github.com/mdlincoln/clipr/issues", + "Imports": [ + "utils" + ], + "Suggests": [ + "covr", + "knitr", + "rmarkdown", + "rstudioapi (>= 0.5)", + "testthat (>= 2.0.0)" + ], + "VignetteBuilder": "knitr", + "Encoding": "UTF-8", + "Language": "en-US", + "RoxygenNote": "7.1.2", + "SystemRequirements": "xclip (https://github.com/astrand/xclip) or xsel (http://www.vergenet.net/~conrad/software/xsel/) for accessing the X11 clipboard, or wl-clipboard (https://github.com/bugaevc/wl-clipboard) for systems using Wayland.", + "NeedsCompilation": "no", + "Author": "Matthew Lincoln [aut, cre] (), Louis Maddox [ctb], Steve Simpson [ctb], Jennifer Bryan [ctb]", + "Maintainer": "Matthew Lincoln ", + "Repository": "RSPM" + }, + "colorspace": { + "Package": "colorspace", + "Version": "2.1-1", + "Source": "Repository", + "Date": "2024-07-26", + "Title": "A Toolbox for Manipulating and Assessing Colors and Palettes", + "Authors@R": "c(person(given = \"Ross\", family = \"Ihaka\", role = \"aut\", email = \"ihaka@stat.auckland.ac.nz\"), person(given = \"Paul\", family = \"Murrell\", role = \"aut\", email = \"paul@stat.auckland.ac.nz\", comment = c(ORCID = \"0000-0002-3224-8858\")), person(given = \"Kurt\", family = \"Hornik\", role = \"aut\", email = \"Kurt.Hornik@R-project.org\", comment = c(ORCID = \"0000-0003-4198-9911\")), person(given = c(\"Jason\", \"C.\"), family = \"Fisher\", role = \"aut\", email = \"jfisher@usgs.gov\", comment = c(ORCID = \"0000-0001-9032-8912\")), person(given = \"Reto\", family = \"Stauffer\", role = \"aut\", email = \"Reto.Stauffer@uibk.ac.at\", comment = c(ORCID = \"0000-0002-3798-5507\")), person(given = c(\"Claus\", \"O.\"), family = \"Wilke\", role = \"aut\", email = \"wilke@austin.utexas.edu\", comment = c(ORCID = \"0000-0002-7470-9261\")), person(given = c(\"Claire\", \"D.\"), family = \"McWhite\", role = \"aut\", email = \"claire.mcwhite@utmail.utexas.edu\", comment = c(ORCID = \"0000-0001-7346-3047\")), person(given = \"Achim\", family = \"Zeileis\", role = c(\"aut\", \"cre\"), email = \"Achim.Zeileis@R-project.org\", comment = c(ORCID = \"0000-0003-0918-3766\")))", + "Description": "Carries out mapping between assorted color spaces including RGB, HSV, HLS, CIEXYZ, CIELUV, HCL (polar CIELUV), CIELAB, and polar CIELAB. Qualitative, sequential, and diverging color palettes based on HCL colors are provided along with corresponding ggplot2 color scales. Color palette choice is aided by an interactive app (with either a Tcl/Tk or a shiny graphical user interface) and shiny apps with an HCL color picker and a color vision deficiency emulator. Plotting functions for displaying and assessing palettes include color swatches, visualizations of the HCL space, and trajectories in HCL and/or RGB spectrum. Color manipulation functions include: desaturation, lightening/darkening, mixing, and simulation of color vision deficiencies (deutanomaly, protanomaly, tritanomaly). Details can be found on the project web page at and in the accompanying scientific paper: Zeileis et al. (2020, Journal of Statistical Software, ).", + "Depends": [ + "R (>= 3.0.0)", + "methods" + ], + "Imports": [ + "graphics", + "grDevices", + "stats" + ], + "Suggests": [ + "datasets", + "utils", + "KernSmooth", + "MASS", + "kernlab", + "mvtnorm", + "vcd", + "tcltk", + "shiny", + "shinyjs", + "ggplot2", + "dplyr", + "scales", + "grid", + "png", + "jpeg", + "knitr", + "rmarkdown", + "RColorBrewer", + "rcartocolor", + "scico", + "viridis", + "wesanderson" + ], + "VignetteBuilder": "knitr", + "License": "BSD_3_clause + file LICENSE", + "URL": "https://colorspace.R-Forge.R-project.org/, https://hclwizard.org/", + "BugReports": "https://colorspace.R-Forge.R-project.org/contact.html", + "LazyData": "yes", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.1", + "NeedsCompilation": "yes", + "Author": "Ross Ihaka [aut], Paul Murrell [aut] (), Kurt Hornik [aut] (), Jason C. Fisher [aut] (), Reto Stauffer [aut] (), Claus O. Wilke [aut] (), Claire D. McWhite [aut] (), Achim Zeileis [aut, cre] ()", + "Maintainer": "Achim Zeileis ", + "Repository": "RSPM" + }, + "commonmark": { + "Package": "commonmark", + "Version": "1.9.2", + "Source": "Repository", + "Type": "Package", + "Title": "High Performance CommonMark and Github Markdown Rendering in R", + "Authors@R": "c( person(\"Jeroen\", \"Ooms\", ,\"jeroenooms@gmail.com\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-4035-0289\")), person(\"John MacFarlane\", role = \"cph\", comment = \"Author of cmark\"))", + "Description": "The CommonMark specification defines a rationalized version of markdown syntax. This package uses the 'cmark' reference implementation for converting markdown text into various formats including html, latex and groff man. In addition it exposes the markdown parse tree in xml format. Also includes opt-in support for GFM extensions including tables, autolinks, and strikethrough text.", + "License": "BSD_2_clause + file LICENSE", + "URL": "https://docs.ropensci.org/commonmark/ https://ropensci.r-universe.dev/commonmark", + "BugReports": "https://github.com/r-lib/commonmark/issues", + "Suggests": [ + "curl", + "testthat", + "xml2" + ], + "RoxygenNote": "7.2.3", + "Language": "en-US", + "Encoding": "UTF-8", + "NeedsCompilation": "yes", + "Author": "Jeroen Ooms [aut, cre] (), John MacFarlane [cph] (Author of cmark)", + "Maintainer": "Jeroen Ooms ", + "Repository": "RSPM" + }, + "cowplot": { + "Package": "cowplot", + "Version": "1.1.3", + "Source": "Repository", + "Title": "Streamlined Plot Theme and Plot Annotations for 'ggplot2'", + "Authors@R": "person( given = \"Claus O.\", family = \"Wilke\", role = c(\"aut\", \"cre\"), email = \"wilke@austin.utexas.edu\", comment = c(ORCID = \"0000-0002-7470-9261\") )", + "Description": "Provides various features that help with creating publication-quality figures with 'ggplot2', such as a set of themes, functions to align plots and arrange them into complex compound figures, and functions that make it easy to annotate plots and or mix plots with images. The package was originally written for internal use in the Wilke lab, hence the name (Claus O. Wilke's plot package). It has also been used extensively in the book Fundamentals of Data Visualization.", + "URL": "https://wilkelab.org/cowplot/", + "BugReports": "https://github.com/wilkelab/cowplot/issues", + "Depends": [ + "R (>= 3.5.0)" + ], + "Imports": [ + "ggplot2 (>= 3.4.0)", + "grid", + "gtable", + "grDevices", + "methods", + "rlang", + "scales" + ], + "License": "GPL-2", + "Suggests": [ + "Cairo", + "covr", + "dplyr", + "forcats", + "gridGraphics (>= 0.4-0)", + "knitr", + "lattice", + "magick", + "maps", + "PASWR", + "patchwork", + "rmarkdown", + "ragg", + "testthat (>= 1.0.0)", + "tidyr", + "vdiffr (>= 0.3.0)", + "VennDiagram" + ], + "VignetteBuilder": "knitr", + "Collate": "'add_sub.R' 'align_plots.R' 'as_grob.R' 'as_gtable.R' 'axis_canvas.R' 'cowplot.R' 'draw.R' 'get_plot_component.R' 'get_axes.R' 'get_titles.R' 'get_legend.R' 'get_panel.R' 'gtable.R' 'key_glyph.R' 'plot_grid.R' 'save.R' 'set_null_device.R' 'setup.R' 'stamp.R' 'themes.R' 'utils_ggplot2.R'", + "RoxygenNote": "7.2.3", + "Encoding": "UTF-8", + "NeedsCompilation": "no", + "Author": "Claus O. Wilke [aut, cre] ()", + "Maintainer": "Claus O. Wilke ", + "Repository": "CRAN" + }, + "cpp11": { + "Package": "cpp11", + "Version": "0.5.1", + "Source": "Repository", + "Title": "A C++11 Interface for R's C Interface", + "Authors@R": "c( person(\"Davis\", \"Vaughan\", email = \"davis@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0003-4777-038X\")), person(\"Jim\",\"Hester\", role = \"aut\", comment = c(ORCID = \"0000-0002-2739-7082\")), person(\"Romain\", \"François\", role = \"aut\", comment = c(ORCID = \"0000-0002-2444-4226\")), person(\"Benjamin\", \"Kietzman\", role = \"ctb\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Provides a header only, C++11 interface to R's C interface. Compared to other approaches 'cpp11' strives to be safe against long jumps from the C API as well as C++ exceptions, conform to normal R function semantics and supports interaction with 'ALTREP' vectors.", + "License": "MIT + file LICENSE", + "URL": "https://cpp11.r-lib.org, https://github.com/r-lib/cpp11", + "BugReports": "https://github.com/r-lib/cpp11/issues", + "Depends": [ + "R (>= 4.0.0)" + ], + "Suggests": [ + "bench", + "brio", + "callr", + "cli", + "covr", + "decor", + "desc", + "ggplot2", + "glue", + "knitr", + "lobstr", + "mockery", + "progress", + "rmarkdown", + "scales", + "Rcpp", + "testthat (>= 3.2.0)", + "tibble", + "utils", + "vctrs", + "withr" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Config/Needs/cpp11/cpp_register": "brio, cli, decor, desc, glue, tibble, vctrs", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "no", + "Author": "Davis Vaughan [aut, cre] (), Jim Hester [aut] (), Romain François [aut] (), Benjamin Kietzman [ctb], Posit Software, PBC [cph, fnd]", + "Maintainer": "Davis Vaughan ", + "Repository": "CRAN" + }, + "crayon": { + "Package": "crayon", + "Version": "1.5.3", + "Source": "Repository", + "Title": "Colored Terminal Output", + "Authors@R": "c( person(\"Gábor\", \"Csárdi\", , \"csardi.gabor@gmail.com\", role = c(\"aut\", \"cre\")), person(\"Brodie\", \"Gaslam\", , \"brodie.gaslam@yahoo.com\", role = \"ctb\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "The crayon package is now superseded. Please use the 'cli' package for new projects. Colored terminal output on terminals that support 'ANSI' color and highlight codes. It also works in 'Emacs' 'ESS'. 'ANSI' color support is automatically detected. Colors and highlighting can be combined and nested. New styles can also be created easily. This package was inspired by the 'chalk' 'JavaScript' project.", + "License": "MIT + file LICENSE", + "URL": "https://r-lib.github.io/crayon/, https://github.com/r-lib/crayon", + "BugReports": "https://github.com/r-lib/crayon/issues", + "Imports": [ + "grDevices", + "methods", + "utils" + ], + "Suggests": [ + "mockery", + "rstudioapi", + "testthat", + "withr" + ], + "Config/Needs/website": "tidyverse/tidytemplate", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.1", + "Collate": "'aaa-rstudio-detect.R' 'aaaa-rematch2.R' 'aab-num-ansi-colors.R' 'aac-num-ansi-colors.R' 'ansi-256.R' 'ansi-palette.R' 'combine.R' 'string.R' 'utils.R' 'crayon-package.R' 'disposable.R' 'enc-utils.R' 'has_ansi.R' 'has_color.R' 'link.R' 'styles.R' 'machinery.R' 'parts.R' 'print.R' 'style-var.R' 'show.R' 'string_operations.R'", + "NeedsCompilation": "no", + "Author": "Gábor Csárdi [aut, cre], Brodie Gaslam [ctb], Posit Software, PBC [cph, fnd]", + "Maintainer": "Gábor Csárdi ", + "Repository": "RSPM" + }, + "crosstalk": { + "Package": "crosstalk", + "Version": "1.2.1", + "Source": "Repository", + "Type": "Package", + "Title": "Inter-Widget Interactivity for HTML Widgets", + "Authors@R": "c( person(\"Joe\", \"Cheng\", role = \"aut\", email = \"joe@posit.co\"), person(\"Carson\", \"Sievert\", role = c(\"aut\", \"cre\"), email = \"carson@posit.co\", comment = c(ORCID = \"0000-0002-4958-2844\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")), person(family = \"jQuery Foundation\", role = \"cph\", comment = \"jQuery library and jQuery UI library\"), person(family = \"jQuery contributors\", role = c(\"ctb\", \"cph\"), comment = \"jQuery library; authors listed in inst/www/shared/jquery-AUTHORS.txt\"), person(\"Mark\", \"Otto\", role = \"ctb\", comment = \"Bootstrap library\"), person(\"Jacob\", \"Thornton\", role = \"ctb\", comment = \"Bootstrap library\"), person(family = \"Bootstrap contributors\", role = \"ctb\", comment = \"Bootstrap library\"), person(family = \"Twitter, Inc\", role = \"cph\", comment = \"Bootstrap library\"), person(\"Brian\", \"Reavis\", role = c(\"ctb\", \"cph\"), comment = \"selectize.js library\"), person(\"Kristopher Michael\", \"Kowal\", role = c(\"ctb\", \"cph\"), comment = \"es5-shim library\"), person(family = \"es5-shim contributors\", role = c(\"ctb\", \"cph\"), comment = \"es5-shim library\"), person(\"Denis\", \"Ineshin\", role = c(\"ctb\", \"cph\"), comment = \"ion.rangeSlider library\"), person(\"Sami\", \"Samhuri\", role = c(\"ctb\", \"cph\"), comment = \"Javascript strftime library\") )", + "Description": "Provides building blocks for allowing HTML widgets to communicate with each other, with Shiny or without (i.e. static .html files). Currently supports linked brushing and filtering.", + "License": "MIT + file LICENSE", + "Imports": [ + "htmltools (>= 0.3.6)", + "jsonlite", + "lazyeval", + "R6" + ], + "Suggests": [ + "shiny", + "ggplot2", + "testthat (>= 2.1.0)", + "sass", + "bslib" + ], + "URL": "https://rstudio.github.io/crosstalk/, https://github.com/rstudio/crosstalk", + "BugReports": "https://github.com/rstudio/crosstalk/issues", + "RoxygenNote": "7.2.3", + "Encoding": "UTF-8", + "NeedsCompilation": "no", + "Author": "Joe Cheng [aut], Carson Sievert [aut, cre] (), Posit Software, PBC [cph, fnd], jQuery Foundation [cph] (jQuery library and jQuery UI library), jQuery contributors [ctb, cph] (jQuery library; authors listed in inst/www/shared/jquery-AUTHORS.txt), Mark Otto [ctb] (Bootstrap library), Jacob Thornton [ctb] (Bootstrap library), Bootstrap contributors [ctb] (Bootstrap library), Twitter, Inc [cph] (Bootstrap library), Brian Reavis [ctb, cph] (selectize.js library), Kristopher Michael Kowal [ctb, cph] (es5-shim library), es5-shim contributors [ctb, cph] (es5-shim library), Denis Ineshin [ctb, cph] (ion.rangeSlider library), Sami Samhuri [ctb, cph] (Javascript strftime library)", + "Maintainer": "Carson Sievert ", + "Repository": "RSPM" + }, + "curl": { + "Package": "curl", + "Version": "6.2.0", + "Source": "Repository", + "Type": "Package", + "Title": "A Modern and Flexible Web Client for R", + "Authors@R": "c( person(\"Jeroen\", \"Ooms\", role = c(\"aut\", \"cre\"), email = \"jeroenooms@gmail.com\", comment = c(ORCID = \"0000-0002-4035-0289\")), person(\"Hadley\", \"Wickham\", role = \"ctb\"), person(\"Posit Software, PBC\", role = \"cph\"))", + "Description": "Bindings to 'libcurl' for performing fully configurable HTTP/FTP requests where responses can be processed in memory, on disk, or streaming via the callback or connection interfaces. Some knowledge of 'libcurl' is recommended; for a more-user-friendly web client see the 'httr2' package which builds on this package with http specific tools and logic.", + "License": "MIT + file LICENSE", + "SystemRequirements": "libcurl (>= 7.62): libcurl-devel (rpm) or libcurl4-openssl-dev (deb)", + "URL": "https://jeroen.r-universe.dev/curl", + "BugReports": "https://github.com/jeroen/curl/issues", + "Suggests": [ + "spelling", + "testthat (>= 1.0.0)", + "knitr", + "jsonlite", + "later", + "rmarkdown", + "httpuv (>= 1.4.4)", + "webutils" + ], + "VignetteBuilder": "knitr", + "Depends": [ + "R (>= 3.0.0)" + ], + "RoxygenNote": "7.3.2.9000", + "Encoding": "UTF-8", + "Language": "en-US", + "NeedsCompilation": "yes", + "Author": "Jeroen Ooms [aut, cre] (), Hadley Wickham [ctb], Posit Software, PBC [cph]", + "Maintainer": "Jeroen Ooms ", + "Repository": "CRAN" + }, + "data.table": { + "Package": "data.table", + "Version": "1.16.4", + "Source": "Repository", + "Title": "Extension of `data.frame`", + "Depends": [ + "R (>= 3.3.0)" + ], + "Imports": [ + "methods" + ], + "Suggests": [ + "bit64 (>= 4.0.0)", + "bit (>= 4.0.4)", + "R.utils", + "xts", + "zoo (>= 1.8-1)", + "yaml", + "knitr", + "markdown" + ], + "Description": "Fast aggregation of large data (e.g. 100GB in RAM), fast ordered joins, fast add/modify/delete of columns by group using no copies at all, list columns, friendly and fast character-separated-value read/write. Offers a natural and flexible syntax, for faster development.", + "License": "MPL-2.0 | file LICENSE", + "URL": "https://r-datatable.com, https://Rdatatable.gitlab.io/data.table, https://github.com/Rdatatable/data.table", + "BugReports": "https://github.com/Rdatatable/data.table/issues", + "VignetteBuilder": "knitr", + "Encoding": "UTF-8", + "ByteCompile": "TRUE", + "Authors@R": "c( person(\"Tyson\",\"Barrett\", role=c(\"aut\",\"cre\"), email=\"t.barrett88@gmail.com\", comment = c(ORCID=\"0000-0002-2137-1391\")), person(\"Matt\",\"Dowle\", role=\"aut\", email=\"mattjdowle@gmail.com\"), person(\"Arun\",\"Srinivasan\", role=\"aut\", email=\"asrini@pm.me\"), person(\"Jan\",\"Gorecki\", role=\"aut\"), person(\"Michael\",\"Chirico\", role=\"aut\", comment = c(ORCID=\"0000-0003-0787-087X\")), person(\"Toby\",\"Hocking\", role=\"aut\", comment = c(ORCID=\"0000-0002-3146-0865\")), person(\"Benjamin\",\"Schwendinger\",role=\"aut\", comment = c(ORCID=\"0000-0003-3315-8114\")), person(\"Pasha\",\"Stetsenko\", role=\"ctb\"), person(\"Tom\",\"Short\", role=\"ctb\"), person(\"Steve\",\"Lianoglou\", role=\"ctb\"), person(\"Eduard\",\"Antonyan\", role=\"ctb\"), person(\"Markus\",\"Bonsch\", role=\"ctb\"), person(\"Hugh\",\"Parsonage\", role=\"ctb\"), person(\"Scott\",\"Ritchie\", role=\"ctb\"), person(\"Kun\",\"Ren\", role=\"ctb\"), person(\"Xianying\",\"Tan\", role=\"ctb\"), person(\"Rick\",\"Saporta\", role=\"ctb\"), person(\"Otto\",\"Seiskari\", role=\"ctb\"), person(\"Xianghui\",\"Dong\", role=\"ctb\"), person(\"Michel\",\"Lang\", role=\"ctb\"), person(\"Watal\",\"Iwasaki\", role=\"ctb\"), person(\"Seth\",\"Wenchel\", role=\"ctb\"), person(\"Karl\",\"Broman\", role=\"ctb\"), person(\"Tobias\",\"Schmidt\", role=\"ctb\"), person(\"David\",\"Arenburg\", role=\"ctb\"), person(\"Ethan\",\"Smith\", role=\"ctb\"), person(\"Francois\",\"Cocquemas\", role=\"ctb\"), person(\"Matthieu\",\"Gomez\", role=\"ctb\"), person(\"Philippe\",\"Chataignon\", role=\"ctb\"), person(\"Nello\",\"Blaser\", role=\"ctb\"), person(\"Dmitry\",\"Selivanov\", role=\"ctb\"), person(\"Andrey\",\"Riabushenko\", role=\"ctb\"), person(\"Cheng\",\"Lee\", role=\"ctb\"), person(\"Declan\",\"Groves\", role=\"ctb\"), person(\"Daniel\",\"Possenriede\", role=\"ctb\"), person(\"Felipe\",\"Parages\", role=\"ctb\"), person(\"Denes\",\"Toth\", role=\"ctb\"), person(\"Mus\",\"Yaramaz-David\", role=\"ctb\"), person(\"Ayappan\",\"Perumal\", role=\"ctb\"), person(\"James\",\"Sams\", role=\"ctb\"), person(\"Martin\",\"Morgan\", role=\"ctb\"), person(\"Michael\",\"Quinn\", role=\"ctb\"), person(\"@javrucebo\",\"\", role=\"ctb\"), person(\"@marc-outins\",\"\", role=\"ctb\"), person(\"Roy\",\"Storey\", role=\"ctb\"), person(\"Manish\",\"Saraswat\", role=\"ctb\"), person(\"Morgan\",\"Jacob\", role=\"ctb\"), person(\"Michael\",\"Schubmehl\", role=\"ctb\"), person(\"Davis\",\"Vaughan\", role=\"ctb\"), person(\"Leonardo\",\"Silvestri\", role=\"ctb\"), person(\"Jim\",\"Hester\", role=\"ctb\"), person(\"Anthony\",\"Damico\", role=\"ctb\"), person(\"Sebastian\",\"Freundt\", role=\"ctb\"), person(\"David\",\"Simons\", role=\"ctb\"), person(\"Elliott\",\"Sales de Andrade\", role=\"ctb\"), person(\"Cole\",\"Miller\", role=\"ctb\"), person(\"Jens Peder\",\"Meldgaard\", role=\"ctb\"), person(\"Vaclav\",\"Tlapak\", role=\"ctb\"), person(\"Kevin\",\"Ushey\", role=\"ctb\"), person(\"Dirk\",\"Eddelbuettel\", role=\"ctb\"), person(\"Tony\",\"Fischetti\", role=\"ctb\"), person(\"Ofek\",\"Shilon\", role=\"ctb\"), person(\"Vadim\",\"Khotilovich\", role=\"ctb\"), person(\"Hadley\",\"Wickham\", role=\"ctb\"), person(\"Bennet\",\"Becker\", role=\"ctb\"), person(\"Kyle\",\"Haynes\", role=\"ctb\"), person(\"Boniface Christian\",\"Kamgang\", role=\"ctb\"), person(\"Olivier\",\"Delmarcell\", role=\"ctb\"), person(\"Josh\",\"O'Brien\", role=\"ctb\"), person(\"Dereck\",\"de Mezquita\", role=\"ctb\"), person(\"Michael\",\"Czekanski\", role=\"ctb\"), person(\"Dmitry\", \"Shemetov\", role=\"ctb\"), person(\"Nitish\", \"Jha\", role=\"ctb\"), person(\"Joshua\", \"Wu\", role=\"ctb\"), person(\"Iago\", \"Giné-Vázquez\", role=\"ctb\"), person(\"Anirban\", \"Chetia\", role=\"ctb\"), person(\"Doris\", \"Amoakohene\", role=\"ctb\"), person(\"Ivan\", \"Krylov\", role=\"ctb\") )", + "NeedsCompilation": "yes", + "Author": "Tyson Barrett [aut, cre] (), Matt Dowle [aut], Arun Srinivasan [aut], Jan Gorecki [aut], Michael Chirico [aut] (), Toby Hocking [aut] (), Benjamin Schwendinger [aut] (), Pasha Stetsenko [ctb], Tom Short [ctb], Steve Lianoglou [ctb], Eduard Antonyan [ctb], Markus Bonsch [ctb], Hugh Parsonage [ctb], Scott Ritchie [ctb], Kun Ren [ctb], Xianying Tan [ctb], Rick Saporta [ctb], Otto Seiskari [ctb], Xianghui Dong [ctb], Michel Lang [ctb], Watal Iwasaki [ctb], Seth Wenchel [ctb], Karl Broman [ctb], Tobias Schmidt [ctb], David Arenburg [ctb], Ethan Smith [ctb], Francois Cocquemas [ctb], Matthieu Gomez [ctb], Philippe Chataignon [ctb], Nello Blaser [ctb], Dmitry Selivanov [ctb], Andrey Riabushenko [ctb], Cheng Lee [ctb], Declan Groves [ctb], Daniel Possenriede [ctb], Felipe Parages [ctb], Denes Toth [ctb], Mus Yaramaz-David [ctb], Ayappan Perumal [ctb], James Sams [ctb], Martin Morgan [ctb], Michael Quinn [ctb], @javrucebo [ctb], @marc-outins [ctb], Roy Storey [ctb], Manish Saraswat [ctb], Morgan Jacob [ctb], Michael Schubmehl [ctb], Davis Vaughan [ctb], Leonardo Silvestri [ctb], Jim Hester [ctb], Anthony Damico [ctb], Sebastian Freundt [ctb], David Simons [ctb], Elliott Sales de Andrade [ctb], Cole Miller [ctb], Jens Peder Meldgaard [ctb], Vaclav Tlapak [ctb], Kevin Ushey [ctb], Dirk Eddelbuettel [ctb], Tony Fischetti [ctb], Ofek Shilon [ctb], Vadim Khotilovich [ctb], Hadley Wickham [ctb], Bennet Becker [ctb], Kyle Haynes [ctb], Boniface Christian Kamgang [ctb], Olivier Delmarcell [ctb], Josh O'Brien [ctb], Dereck de Mezquita [ctb], Michael Czekanski [ctb], Dmitry Shemetov [ctb], Nitish Jha [ctb], Joshua Wu [ctb], Iago Giné-Vázquez [ctb], Anirban Chetia [ctb], Doris Amoakohene [ctb], Ivan Krylov [ctb]", + "Maintainer": "Tyson Barrett ", + "Repository": "CRAN" + }, + "desc": { + "Package": "desc", + "Version": "1.4.3", + "Source": "Repository", + "Title": "Manipulate DESCRIPTION Files", + "Authors@R": "c( person(\"Gábor\", \"Csárdi\", , \"csardi.gabor@gmail.com\", role = c(\"aut\", \"cre\")), person(\"Kirill\", \"Müller\", role = \"aut\"), person(\"Jim\", \"Hester\", , \"james.f.hester@gmail.com\", role = \"aut\"), person(\"Maëlle\", \"Salmon\", role = \"ctb\", comment = c(ORCID = \"0000-0002-2815-0399\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Maintainer": "Gábor Csárdi ", + "Description": "Tools to read, write, create, and manipulate DESCRIPTION files. It is intended for packages that create or manipulate other packages.", + "License": "MIT + file LICENSE", + "URL": "https://desc.r-lib.org/, https://github.com/r-lib/desc", + "BugReports": "https://github.com/r-lib/desc/issues", + "Depends": [ + "R (>= 3.4)" + ], + "Imports": [ + "cli", + "R6", + "utils" + ], + "Suggests": [ + "callr", + "covr", + "gh", + "spelling", + "testthat", + "whoami", + "withr" + ], + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "Language": "en-US", + "RoxygenNote": "7.2.3", + "Collate": "'assertions.R' 'authors-at-r.R' 'built.R' 'classes.R' 'collate.R' 'constants.R' 'deps.R' 'desc-package.R' 'description.R' 'encoding.R' 'find-package-root.R' 'latex.R' 'non-oo-api.R' 'package-archives.R' 'read.R' 'remotes.R' 'str.R' 'syntax_checks.R' 'urls.R' 'utils.R' 'validate.R' 'version.R'", + "NeedsCompilation": "no", + "Author": "Gábor Csárdi [aut, cre], Kirill Müller [aut], Jim Hester [aut], Maëlle Salmon [ctb] (), Posit Software, PBC [cph, fnd]", + "Repository": "RSPM" + }, + "digest": { + "Package": "digest", + "Version": "0.6.37", + "Source": "Repository", + "Authors@R": "c(person(\"Dirk\", \"Eddelbuettel\", role = c(\"aut\", \"cre\"), email = \"edd@debian.org\", comment = c(ORCID = \"0000-0001-6419-907X\")), person(\"Antoine\", \"Lucas\", role=\"ctb\"), person(\"Jarek\", \"Tuszynski\", role=\"ctb\"), person(\"Henrik\", \"Bengtsson\", role=\"ctb\", comment = c(ORCID = \"0000-0002-7579-5165\")), person(\"Simon\", \"Urbanek\", role=\"ctb\", comment = c(ORCID = \"0000-0003-2297-1732\")), person(\"Mario\", \"Frasca\", role=\"ctb\"), person(\"Bryan\", \"Lewis\", role=\"ctb\"), person(\"Murray\", \"Stokely\", role=\"ctb\"), person(\"Hannes\", \"Muehleisen\", role=\"ctb\"), person(\"Duncan\", \"Murdoch\", role=\"ctb\"), person(\"Jim\", \"Hester\", role=\"ctb\"), person(\"Wush\", \"Wu\", role=\"ctb\", comment = c(ORCID = \"0000-0001-5180-0567\")), person(\"Qiang\", \"Kou\", role=\"ctb\", comment = c(ORCID = \"0000-0001-6786-5453\")), person(\"Thierry\", \"Onkelinx\", role=\"ctb\", comment = c(ORCID = \"0000-0001-8804-4216\")), person(\"Michel\", \"Lang\", role=\"ctb\", comment = c(ORCID = \"0000-0001-9754-0393\")), person(\"Viliam\", \"Simko\", role=\"ctb\"), person(\"Kurt\", \"Hornik\", role=\"ctb\", comment = c(ORCID = \"0000-0003-4198-9911\")), person(\"Radford\", \"Neal\", role=\"ctb\", comment = c(ORCID = \"0000-0002-2473-3407\")), person(\"Kendon\", \"Bell\", role=\"ctb\", comment = c(ORCID = \"0000-0002-9093-8312\")), person(\"Matthew\", \"de Queljoe\", role=\"ctb\"), person(\"Dmitry\", \"Selivanov\", role=\"ctb\"), person(\"Ion\", \"Suruceanu\", role=\"ctb\"), person(\"Bill\", \"Denney\", role=\"ctb\"), person(\"Dirk\", \"Schumacher\", role=\"ctb\"), person(\"András\", \"Svraka\", role=\"ctb\"), person(\"Sergey\", \"Fedorov\", role=\"ctb\"), person(\"Will\", \"Landau\", role=\"ctb\", comment = c(ORCID = \"0000-0003-1878-3253\")), person(\"Floris\", \"Vanderhaeghe\", role=\"ctb\", comment = c(ORCID = \"0000-0002-6378-6229\")), person(\"Kevin\", \"Tappe\", role=\"ctb\"), person(\"Harris\", \"McGehee\", role=\"ctb\"), person(\"Tim\", \"Mastny\", role=\"ctb\"), person(\"Aaron\", \"Peikert\", role=\"ctb\", comment = c(ORCID = \"0000-0001-7813-818X\")), person(\"Mark\", \"van der Loo\", role=\"ctb\", comment = c(ORCID = \"0000-0002-9807-4686\")), person(\"Chris\", \"Muir\", role=\"ctb\", comment = c(ORCID = \"0000-0003-2555-3878\")), person(\"Moritz\", \"Beller\", role=\"ctb\", comment = c(ORCID = \"0000-0003-4852-0526\")), person(\"Sebastian\", \"Campbell\", role=\"ctb\"), person(\"Winston\", \"Chang\", role=\"ctb\", comment = c(ORCID = \"0000-0002-1576-2126\")), person(\"Dean\", \"Attali\", role=\"ctb\", comment = c(ORCID = \"0000-0002-5645-3493\")), person(\"Michael\", \"Chirico\", role=\"ctb\", comment = c(ORCID = \"0000-0003-0787-087X\")), person(\"Kevin\", \"Ushey\", role=\"ctb\"))", + "Date": "2024-08-19", + "Title": "Create Compact Hash Digests of R Objects", + "Description": "Implementation of a function 'digest()' for the creation of hash digests of arbitrary R objects (using the 'md5', 'sha-1', 'sha-256', 'crc32', 'xxhash', 'murmurhash', 'spookyhash', 'blake3', 'crc32c', 'xxh3_64', and 'xxh3_128' algorithms) permitting easy comparison of R language objects, as well as functions such as'hmac()' to create hash-based message authentication code. Please note that this package is not meant to be deployed for cryptographic purposes for which more comprehensive (and widely tested) libraries such as 'OpenSSL' should be used.", + "URL": "https://github.com/eddelbuettel/digest, https://dirk.eddelbuettel.com/code/digest.html", + "BugReports": "https://github.com/eddelbuettel/digest/issues", + "Depends": [ + "R (>= 3.3.0)" + ], + "Imports": [ + "utils" + ], + "License": "GPL (>= 2)", + "Suggests": [ + "tinytest", + "simplermarkdown" + ], + "VignetteBuilder": "simplermarkdown", + "Encoding": "UTF-8", + "NeedsCompilation": "yes", + "Author": "Dirk Eddelbuettel [aut, cre] (), Antoine Lucas [ctb], Jarek Tuszynski [ctb], Henrik Bengtsson [ctb] (), Simon Urbanek [ctb] (), Mario Frasca [ctb], Bryan Lewis [ctb], Murray Stokely [ctb], Hannes Muehleisen [ctb], Duncan Murdoch [ctb], Jim Hester [ctb], Wush Wu [ctb] (), Qiang Kou [ctb] (), Thierry Onkelinx [ctb] (), Michel Lang [ctb] (), Viliam Simko [ctb], Kurt Hornik [ctb] (), Radford Neal [ctb] (), Kendon Bell [ctb] (), Matthew de Queljoe [ctb], Dmitry Selivanov [ctb], Ion Suruceanu [ctb], Bill Denney [ctb], Dirk Schumacher [ctb], András Svraka [ctb], Sergey Fedorov [ctb], Will Landau [ctb] (), Floris Vanderhaeghe [ctb] (), Kevin Tappe [ctb], Harris McGehee [ctb], Tim Mastny [ctb], Aaron Peikert [ctb] (), Mark van der Loo [ctb] (), Chris Muir [ctb] (), Moritz Beller [ctb] (), Sebastian Campbell [ctb], Winston Chang [ctb] (), Dean Attali [ctb] (), Michael Chirico [ctb] (), Kevin Ushey [ctb]", + "Maintainer": "Dirk Eddelbuettel ", + "Repository": "CRAN" + }, + "dplyr": { + "Package": "dplyr", + "Version": "1.1.4", + "Source": "Repository", + "Type": "Package", + "Title": "A Grammar of Data Manipulation", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0003-4757-117X\")), person(\"Romain\", \"François\", role = \"aut\", comment = c(ORCID = \"0000-0002-2444-4226\")), person(\"Lionel\", \"Henry\", role = \"aut\"), person(\"Kirill\", \"Müller\", role = \"aut\", comment = c(ORCID = \"0000-0002-1416-3412\")), person(\"Davis\", \"Vaughan\", , \"davis@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0003-4777-038X\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "A fast, consistent tool for working with data frame like objects, both in memory and out of memory.", + "License": "MIT + file LICENSE", + "URL": "https://dplyr.tidyverse.org, https://github.com/tidyverse/dplyr", + "BugReports": "https://github.com/tidyverse/dplyr/issues", + "Depends": [ + "R (>= 3.5.0)" + ], + "Imports": [ + "cli (>= 3.4.0)", + "generics", + "glue (>= 1.3.2)", + "lifecycle (>= 1.0.3)", + "magrittr (>= 1.5)", + "methods", + "pillar (>= 1.9.0)", + "R6", + "rlang (>= 1.1.0)", + "tibble (>= 3.2.0)", + "tidyselect (>= 1.2.0)", + "utils", + "vctrs (>= 0.6.4)" + ], + "Suggests": [ + "bench", + "broom", + "callr", + "covr", + "DBI", + "dbplyr (>= 2.2.1)", + "ggplot2", + "knitr", + "Lahman", + "lobstr", + "microbenchmark", + "nycflights13", + "purrr", + "rmarkdown", + "RMySQL", + "RPostgreSQL", + "RSQLite", + "stringi (>= 1.7.6)", + "testthat (>= 3.1.5)", + "tidyr (>= 1.3.0)", + "withr" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse, shiny, pkgdown, tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "LazyData": "true", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [aut, cre] (), Romain François [aut] (), Lionel Henry [aut], Kirill Müller [aut] (), Davis Vaughan [aut] (), Posit Software, PBC [cph, fnd]", + "Maintainer": "Hadley Wickham ", + "Repository": "RSPM" + }, + "e1071": { + "Package": "e1071", + "Version": "1.7-16", + "Source": "Repository", + "Title": "Misc Functions of the Department of Statistics, Probability Theory Group (Formerly: E1071), TU Wien", + "Imports": [ + "graphics", + "grDevices", + "class", + "stats", + "methods", + "utils", + "proxy" + ], + "Suggests": [ + "cluster", + "mlbench", + "nnet", + "randomForest", + "rpart", + "SparseM", + "xtable", + "Matrix", + "MASS", + "slam" + ], + "Authors@R": "c(person(given = \"David\", family = \"Meyer\", role = c(\"aut\", \"cre\"), email = \"David.Meyer@R-project.org\", comment = c(ORCID = \"0000-0002-5196-3048\")), person(given = \"Evgenia\", family = \"Dimitriadou\", role = c(\"aut\",\"cph\")), person(given = \"Kurt\", family = \"Hornik\", role = \"aut\", email = \"Kurt.Hornik@R-project.org\", comment = c(ORCID = \"0000-0003-4198-9911\")), person(given = \"Andreas\", family = \"Weingessel\", role = \"aut\"), person(given = \"Friedrich\", family = \"Leisch\", role = \"aut\"), person(given = \"Chih-Chung\", family = \"Chang\", role = c(\"ctb\",\"cph\"), comment = \"libsvm C++-code\"), person(given = \"Chih-Chen\", family = \"Lin\", role = c(\"ctb\",\"cph\"), comment = \"libsvm C++-code\"))", + "Description": "Functions for latent class analysis, short time Fourier transform, fuzzy clustering, support vector machines, shortest path computation, bagged clustering, naive Bayes classifier, generalized k-nearest neighbour ...", + "License": "GPL-2 | GPL-3", + "LazyLoad": "yes", + "NeedsCompilation": "yes", + "Author": "David Meyer [aut, cre] (), Evgenia Dimitriadou [aut, cph], Kurt Hornik [aut] (), Andreas Weingessel [aut], Friedrich Leisch [aut], Chih-Chung Chang [ctb, cph] (libsvm C++-code), Chih-Chen Lin [ctb, cph] (libsvm C++-code)", + "Maintainer": "David Meyer ", + "Repository": "CRAN" + }, + "evaluate": { + "Package": "evaluate", + "Version": "1.0.3", + "Source": "Repository", + "Type": "Package", + "Title": "Parsing and Evaluation Tools that Provide More Details than the Default", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = c(\"aut\", \"cre\")), person(\"Yihui\", \"Xie\", role = \"aut\", comment = c(ORCID = \"0000-0003-0645-5666\")), person(\"Michael\", \"Lawrence\", role = \"ctb\"), person(\"Thomas\", \"Kluyver\", role = \"ctb\"), person(\"Jeroen\", \"Ooms\", role = \"ctb\"), person(\"Barret\", \"Schloerke\", role = \"ctb\"), person(\"Adam\", \"Ryczkowski\", role = \"ctb\"), person(\"Hiroaki\", \"Yutani\", role = \"ctb\"), person(\"Michel\", \"Lang\", role = \"ctb\"), person(\"Karolis\", \"Koncevičius\", role = \"ctb\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Parsing and evaluation tools that make it easy to recreate the command line behaviour of R.", + "License": "MIT + file LICENSE", + "URL": "https://evaluate.r-lib.org/, https://github.com/r-lib/evaluate", + "BugReports": "https://github.com/r-lib/evaluate/issues", + "Depends": [ + "R (>= 3.6.0)" + ], + "Suggests": [ + "callr", + "covr", + "ggplot2 (>= 3.3.6)", + "lattice", + "methods", + "pkgload", + "rlang", + "knitr", + "testthat (>= 3.0.0)", + "withr" + ], + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "no", + "Author": "Hadley Wickham [aut, cre], Yihui Xie [aut] (), Michael Lawrence [ctb], Thomas Kluyver [ctb], Jeroen Ooms [ctb], Barret Schloerke [ctb], Adam Ryczkowski [ctb], Hiroaki Yutani [ctb], Michel Lang [ctb], Karolis Koncevičius [ctb], Posit Software, PBC [cph, fnd]", + "Maintainer": "Hadley Wickham ", + "Repository": "CRAN" + }, + "expm": { + "Package": "expm", + "Version": "1.0-0", + "Source": "Repository", + "Type": "Package", + "Title": "Matrix Exponential, Log, 'etc'", + "Date": "2024-08-19", + "Authors@R": "c(person(\"Martin\", \"Maechler\", role=c(\"aut\",\"cre\"), email=\"maechler@stat.math.ethz.ch\", comment = c(ORCID = \"0000-0002-8685-9910\")) , person(\"Christophe\",\"Dutang\", role = \"aut\", comment = c(ORCID = \"0000-0001-6732-1501\")) , person(\"Vincent\", \"Goulet\", role = \"aut\", comment = c(ORCID = \"0000-0002-9315-5719\")) , person(\"Douglas\", \"Bates\", role = \"ctb\", comment = \"cosmetic clean up, in svn r42\") , person(\"David\", \"Firth\", role = \"ctb\", comment = \"expm(method= \\\"PadeO\\\" and \\\"TaylorO\\\")\") , person(\"Marina\", \"Shapira\", role = \"ctb\", comment = \"expm(method= \\\"PadeO\\\" and \\\"TaylorO\\\")\") , person(\"Michael\", \"Stadelmann\", role = \"ctb\", comment = \"\\\"Higham08*\\\" methods, see ?expm.Higham08...\") )", + "Contact": "expm-developers@lists.R-forge.R-project.org", + "Description": "Computation of the matrix exponential, logarithm, sqrt, and related quantities, using traditional and modern methods.", + "Depends": [ + "Matrix" + ], + "Imports": [ + "methods" + ], + "Suggests": [ + "RColorBrewer", + "sfsmisc", + "Rmpfr" + ], + "BuildResaveData": "no", + "License": "GPL (>= 2)", + "URL": "https://R-Forge.R-project.org/projects/expm/", + "BugReports": "https://R-forge.R-project.org/tracker/?atid=472&group_id=107", + "Encoding": "UTF-8", + "NeedsCompilation": "yes", + "Author": "Martin Maechler [aut, cre] (), Christophe Dutang [aut] (), Vincent Goulet [aut] (), Douglas Bates [ctb] (cosmetic clean up, in svn r42), David Firth [ctb] (expm(method= \"PadeO\" and \"TaylorO\")), Marina Shapira [ctb] (expm(method= \"PadeO\" and \"TaylorO\")), Michael Stadelmann [ctb] (\"Higham08*\" methods, see ?expm.Higham08...)", + "Maintainer": "Martin Maechler ", + "Repository": "CRAN" + }, + "fansi": { + "Package": "fansi", + "Version": "1.0.6", + "Source": "Repository", + "Title": "ANSI Control Sequence Aware String Functions", + "Description": "Counterparts to R string manipulation functions that account for the effects of ANSI text formatting control sequences.", + "Authors@R": "c( person(\"Brodie\", \"Gaslam\", email=\"brodie.gaslam@yahoo.com\", role=c(\"aut\", \"cre\")), person(\"Elliott\", \"Sales De Andrade\", role=\"ctb\"), person(family=\"R Core Team\", email=\"R-core@r-project.org\", role=\"cph\", comment=\"UTF8 byte length calcs from src/util.c\" ))", + "Depends": [ + "R (>= 3.1.0)" + ], + "License": "GPL-2 | GPL-3", + "URL": "https://github.com/brodieG/fansi", + "BugReports": "https://github.com/brodieG/fansi/issues", + "VignetteBuilder": "knitr", + "Suggests": [ + "unitizer", + "knitr", + "rmarkdown" + ], + "Imports": [ + "grDevices", + "utils" + ], + "RoxygenNote": "7.2.3", + "Encoding": "UTF-8", + "Collate": "'constants.R' 'fansi-package.R' 'internal.R' 'load.R' 'misc.R' 'nchar.R' 'strwrap.R' 'strtrim.R' 'strsplit.R' 'substr2.R' 'trimws.R' 'tohtml.R' 'unhandled.R' 'normalize.R' 'sgr.R'", + "NeedsCompilation": "yes", + "Author": "Brodie Gaslam [aut, cre], Elliott Sales De Andrade [ctb], R Core Team [cph] (UTF8 byte length calcs from src/util.c)", + "Maintainer": "Brodie Gaslam ", + "Repository": "RSPM" + }, + "farver": { + "Package": "farver", + "Version": "2.1.2", + "Source": "Repository", + "Type": "Package", + "Title": "High Performance Colour Space Manipulation", + "Authors@R": "c( person(\"Thomas Lin\", \"Pedersen\", , \"thomas.pedersen@posit.co\", role = c(\"cre\", \"aut\"), comment = c(ORCID = \"0000-0002-5147-4711\")), person(\"Berendea\", \"Nicolae\", role = \"aut\", comment = \"Author of the ColorSpace C++ library\"), person(\"Romain\", \"François\", , \"romain@purrple.cat\", role = \"aut\", comment = c(ORCID = \"0000-0002-2444-4226\")), person(\"Posit, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "The encoding of colour can be handled in many different ways, using different colour spaces. As different colour spaces have different uses, efficient conversion between these representations are important. The 'farver' package provides a set of functions that gives access to very fast colour space conversion and comparisons implemented in C++, and offers speed improvements over the 'convertColor' function in the 'grDevices' package.", + "License": "MIT + file LICENSE", + "URL": "https://farver.data-imaginist.com, https://github.com/thomasp85/farver", + "BugReports": "https://github.com/thomasp85/farver/issues", + "Suggests": [ + "covr", + "testthat (>= 3.0.0)" + ], + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.1", + "NeedsCompilation": "yes", + "Author": "Thomas Lin Pedersen [cre, aut] (), Berendea Nicolae [aut] (Author of the ColorSpace C++ library), Romain François [aut] (), Posit, PBC [cph, fnd]", + "Maintainer": "Thomas Lin Pedersen ", + "Repository": "RSPM" + }, + "fastmap": { + "Package": "fastmap", + "Version": "1.2.0", + "Source": "Repository", + "Title": "Fast Data Structures", + "Authors@R": "c( person(\"Winston\", \"Chang\", email = \"winston@posit.co\", role = c(\"aut\", \"cre\")), person(given = \"Posit Software, PBC\", role = c(\"cph\", \"fnd\")), person(given = \"Tessil\", role = \"cph\", comment = \"hopscotch_map library\") )", + "Description": "Fast implementation of data structures, including a key-value store, stack, and queue. Environments are commonly used as key-value stores in R, but every time a new key is used, it is added to R's global symbol table, causing a small amount of memory leakage. This can be problematic in cases where many different keys are used. Fastmap avoids this memory leak issue by implementing the map using data structures in C++.", + "License": "MIT + file LICENSE", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "Suggests": [ + "testthat (>= 2.1.1)" + ], + "URL": "https://r-lib.github.io/fastmap/, https://github.com/r-lib/fastmap", + "BugReports": "https://github.com/r-lib/fastmap/issues", + "NeedsCompilation": "yes", + "Author": "Winston Chang [aut, cre], Posit Software, PBC [cph, fnd], Tessil [cph] (hopscotch_map library)", + "Maintainer": "Winston Chang ", + "Repository": "RSPM" + }, + "flextable": { + "Package": "flextable", + "Version": "0.9.7", + "Source": "Repository", + "Type": "Package", + "Title": "Functions for Tabular Reporting", + "Authors@R": "c( person(\"David\", \"Gohel\", , \"david.gohel@ardata.fr\", role = c(\"aut\", \"cre\")), person(\"ArData\", role = \"cph\"), person(\"Clementine\", \"Jager\", role = \"ctb\"), person(\"Eli\", \"Daniels\", role = \"ctb\"), person(\"Panagiotis\", \"Skintzos\", , \"panagiotis.skintzos@ardata.fr\", role = \"aut\"), person(\"Quentin\", \"Fazilleau\", role = \"ctb\"), person(\"Maxim\", \"Nazarov\", role = \"ctb\"), person(\"Titouan\", \"Robert\", role = \"ctb\"), person(\"Michael\", \"Barrowman\", role = \"ctb\"), person(\"Atsushi\", \"Yasumoto\", role = \"ctb\"), person(\"Paul\", \"Julian\", role = \"ctb\"), person(\"Sean\", \"Browning\", role = \"ctb\"), person(\"Rémi\", \"Thériault\", role = \"ctb\", comment = c(ORCID = \"0000-0003-4315-6788\")), person(\"Samuel\", \"Jobert\", role = \"ctb\"), person(\"Keith\", \"Newman\", role = \"ctb\") )", + "Description": "Use a grammar for creating and customizing pretty tables. The following formats are supported: 'HTML', 'PDF', 'RTF', 'Microsoft Word', 'Microsoft PowerPoint' and R 'Grid Graphics'. 'R Markdown', 'Quarto' and the package 'officer' can be used to produce the result files. The syntax is the same for the user regardless of the type of output to be produced. A set of functions allows the creation, definition of cell arrangement, addition of headers or footers, formatting and definition of cell content with text and or images. The package also offers a set of high-level functions that allow tabular reporting of statistical models and the creation of complex cross tabulations.", + "License": "GPL-3", + "URL": "https://ardata-fr.github.io/flextable-book/, https://davidgohel.github.io/flextable/", + "BugReports": "https://github.com/davidgohel/flextable/issues", + "Imports": [ + "data.table (>= 1.13.0)", + "gdtools (>= 0.4.0)", + "graphics", + "grDevices", + "grid", + "htmltools", + "knitr", + "officer (>= 0.6.7)", + "ragg", + "rlang", + "rmarkdown (>= 2.0)", + "stats", + "utils", + "uuid (>= 0.1-4)", + "xml2" + ], + "Suggests": [ + "bookdown (>= 0.40)", + "broom", + "broom.mixed", + "chromote", + "cluster", + "commonmark", + "doconv (>= 0.3.0)", + "equatags", + "ggplot2", + "lme4", + "magick", + "mgcv", + "nlme", + "officedown", + "pdftools", + "pkgdown (>= 2.0.0)", + "scales", + "svglite", + "tables (>= 0.9.17)", + "testthat (>= 3.0.0)", + "webshot2", + "withr", + "xtable" + ], + "VignetteBuilder": "knitr", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "no", + "Author": "David Gohel [aut, cre], ArData [cph], Clementine Jager [ctb], Eli Daniels [ctb], Panagiotis Skintzos [aut], Quentin Fazilleau [ctb], Maxim Nazarov [ctb], Titouan Robert [ctb], Michael Barrowman [ctb], Atsushi Yasumoto [ctb], Paul Julian [ctb], Sean Browning [ctb], Rémi Thériault [ctb] (), Samuel Jobert [ctb], Keith Newman [ctb]", + "Maintainer": "David Gohel ", + "Repository": "CRAN" + }, + "fontBitstreamVera": { + "Package": "fontBitstreamVera", + "Version": "0.1.1", + "Source": "Repository", + "Title": "Fonts with 'Bitstream Vera Fonts' License", + "Authors@R": "c( person(\"Lionel\", \"Henry\", , \"lionel.hry@gmail.com\", c(\"cre\", \"aut\")), person(\"Bitstream\", role = \"cph\"))", + "Description": "Provides fonts licensed under the 'Bitstream Vera Fonts' license for the 'fontquiver' package.", + "Depends": [ + "R (>= 3.0.0)" + ], + "License": "file LICENCE", + "Encoding": "UTF-8", + "LazyData": "true", + "RoxygenNote": "5.0.1", + "NeedsCompilation": "no", + "Author": "Lionel Henry [cre, aut], Bitstream [cph]", + "Maintainer": "Lionel Henry ", + "License_is_FOSS": "yes", + "Repository": "CRAN" + }, + "fontLiberation": { + "Package": "fontLiberation", + "Version": "0.1.0", + "Source": "Repository", + "Title": "Liberation Fonts", + "Authors@R": "c( person(\"Lionel\", \"Henry\", , \"lionel@rstudio.com\", \"cre\"), person(\"Pravin Satpute\", role = \"aut\"), person(\"Steve Matteson\", role = \"aut\"), person(\"Red Hat, Inc\", role = \"cph\"), person(\"Google Corporation\", role = \"cph\"))", + "Description": "A placeholder for the Liberation fontset intended for the `fontquiver` package. This fontset covers the 12 combinations of families (sans, serif, mono) and faces (plain, bold, italic, bold italic) supported in R graphics devices.", + "Depends": [ + "R (>= 3.0)" + ], + "License": "file LICENSE", + "Encoding": "UTF-8", + "LazyData": "true", + "RoxygenNote": "5.0.1", + "NeedsCompilation": "no", + "Author": "Lionel Henry [cre], Pravin Satpute [aut], Steve Matteson [aut], Red Hat, Inc [cph], Google Corporation [cph]", + "Maintainer": "Lionel Henry ", + "Repository": "CRAN", + "License_is_FOSS": "yes" + }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.5.3", + "Source": "Repository", + "Type": "Package", + "Title": "Easily Work with 'Font Awesome' Icons", + "Description": "Easily and flexibly insert 'Font Awesome' icons into 'R Markdown' documents and 'Shiny' apps. These icons can be inserted into HTML content through inline 'SVG' tags or 'i' tags. There is also a utility function for exporting 'Font Awesome' icons as 'PNG' images for those situations where raster graphics are needed.", + "Authors@R": "c( person(\"Richard\", \"Iannone\", , \"rich@posit.co\", c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0003-3925-190X\")), person(\"Christophe\", \"Dervieux\", , \"cderv@posit.co\", role = \"ctb\", comment = c(ORCID = \"0000-0003-4474-2498\")), person(\"Winston\", \"Chang\", , \"winston@posit.co\", role = \"ctb\"), person(\"Dave\", \"Gandy\", role = c(\"ctb\", \"cph\"), comment = \"Font-Awesome font\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "License": "MIT + file LICENSE", + "URL": "https://github.com/rstudio/fontawesome, https://rstudio.github.io/fontawesome/", + "BugReports": "https://github.com/rstudio/fontawesome/issues", + "Encoding": "UTF-8", + "ByteCompile": "true", + "RoxygenNote": "7.3.2", + "Depends": [ + "R (>= 3.3.0)" + ], + "Imports": [ + "rlang (>= 1.0.6)", + "htmltools (>= 0.5.1.1)" + ], + "Suggests": [ + "covr", + "dplyr (>= 1.0.8)", + "gt (>= 0.9.0)", + "knitr (>= 1.31)", + "testthat (>= 3.0.0)", + "rsvg" + ], + "Config/testthat/edition": "3", + "NeedsCompilation": "no", + "Author": "Richard Iannone [aut, cre] (), Christophe Dervieux [ctb] (), Winston Chang [ctb], Dave Gandy [ctb, cph] (Font-Awesome font), Posit Software, PBC [cph, fnd]", + "Maintainer": "Richard Iannone ", + "Repository": "CRAN" + }, + "fontquiver": { + "Package": "fontquiver", + "Version": "0.2.1", + "Source": "Repository", + "Title": "Set of Installed Fonts", + "Authors@R": "c( person(\"Lionel\", \"Henry\", , \"lionel@rstudio.com\", c(\"cre\", \"aut\")), person(\"RStudio\", role = \"cph\"), person(\"George Douros\", role = \"cph\", comment = \"Symbola font\"))", + "Description": "Provides a set of fonts with permissive licences. This is useful when you want to avoid system fonts to make sure your outputs are reproducible.", + "Depends": [ + "R (>= 3.0.0)" + ], + "Imports": [ + "fontBitstreamVera (>= 0.1.0)", + "fontLiberation (>= 0.1.0)" + ], + "Suggests": [ + "testthat", + "htmltools" + ], + "License": "GPL-3 | file LICENSE", + "Encoding": "UTF-8", + "LazyData": "true", + "RoxygenNote": "5.0.1", + "Collate": "'font-getters.R' 'fontset.R' 'fontset-bitstream-vera.R' 'fontset-dejavu.R' 'fontset-liberation.R' 'fontset-symbola.R' 'html-dependency.R' 'utils.R'", + "NeedsCompilation": "no", + "Author": "Lionel Henry [cre, aut], RStudio [cph], George Douros [cph] (Symbola font)", + "Maintainer": "Lionel Henry ", + "Repository": "CRAN" + }, + "forcats": { + "Package": "forcats", + "Version": "1.0.0", + "Source": "Repository", + "Title": "Tools for Working with Categorical Variables (Factors)", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@rstudio.com\", role = c(\"aut\", \"cre\")), person(\"RStudio\", role = c(\"cph\", \"fnd\")) )", + "Description": "Helpers for reordering factor levels (including moving specified levels to front, ordering by first appearance, reversing, and randomly shuffling), and tools for modifying factor levels (including collapsing rare levels into other, 'anonymising', and manually 'recoding').", + "License": "MIT + file LICENSE", + "URL": "https://forcats.tidyverse.org/, https://github.com/tidyverse/forcats", + "BugReports": "https://github.com/tidyverse/forcats/issues", + "Depends": [ + "R (>= 3.4)" + ], + "Imports": [ + "cli (>= 3.4.0)", + "glue", + "lifecycle", + "magrittr", + "rlang (>= 1.0.0)", + "tibble" + ], + "Suggests": [ + "covr", + "dplyr", + "ggplot2", + "knitr", + "readr", + "rmarkdown", + "testthat (>= 3.0.0)", + "withr" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "LazyData": "true", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "no", + "Author": "Hadley Wickham [aut, cre], RStudio [cph, fnd]", + "Maintainer": "Hadley Wickham ", + "Repository": "RSPM" + }, + "formatters": { + "Package": "formatters", + "Version": "0.5.10.9001", + "Source": "Repository", + "Title": "ASCII Formatting for Values and Tables", + "Date": "2025-02-05", + "Authors@R": "c( person(\"Gabriel\", \"Becker\", , \"gabembecker@gmail.com\", role = \"aut\", comment = \"original creator of the package\"), person(\"Adrian\", \"Waddell\", , \"adrian.waddell@gene.com\", role = \"aut\"), person(\"Davide\", \"Garolini\", , \"davide.garolini@roche.com\", role = \"aut\"), person(\"Emily\", \"de la Rua\", , \"emily.de_la_rua@contractors.roche.com\", role = \"aut\"), person(\"Abinaya\", \"Yogasekaram\", , \"abinaya.yogasekaram@contractors.roche.com\", role = \"ctb\"), person(\"Joe\", \"Zhu\", , \"joe.zhu@roche.com\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0001-7566-2787\")), person(\"F. Hoffmann-La Roche AG\", role = c(\"cph\", \"fnd\")) )", + "Description": "We provide a framework for rendering complex tables to ASCII, and a set of formatters for transforming values or sets of values into ASCII-ready display strings.", + "License": "Apache License 2.0", + "URL": "https://insightsengineering.github.io/formatters/, https://github.com/insightsengineering/formatters/", + "BugReports": "https://github.com/insightsengineering/formatters/issues", + "Depends": [ + "methods", + "R (>= 2.10)" + ], + "Imports": [ + "checkmate (>= 2.1.0)", + "grid", + "htmltools (>= 0.5.3)", + "lifecycle (>= 0.2.0)", + "stringi (>= 1.7.12)" + ], + "Suggests": [ + "dplyr (>= 1.0.9)", + "gt (>= 0.10.0)", + "huxtable (>= 2.0.0)", + "knitr (>= 1.42)", + "r2rtf (>= 0.3.2)", + "rmarkdown (>= 2.23)", + "testthat (>= 3.0.4)", + "withr (>= 2.0.0)" + ], + "VignetteBuilder": "knitr, rmarkdown", + "Config/Needs/verdepcheck": "mllg/checkmate, rstudio/htmltools, r-lib/lifecycle, tidyverse/dplyr, rstudio/gt, hughjonesd/huxtable, yihui/knitr, Merck/r2rtf, rstudio/rmarkdown, gagolews/stringi, r-lib/testthat, r-lib/withr", + "Config/Needs/website": "insightsengineering/nesttemplate", + "Encoding": "UTF-8", + "Language": "en-US", + "LazyData": "true", + "Roxygen": "list(markdown = TRUE)", + "RoxygenNote": "7.3.2", + "Collate": "'data.R' 'format_value.R' 'matrix_form.R' 'generics.R' 'labels.R' 'mpf_exporters.R' 'package.R' 'page_size.R' 'pagination.R' 'tostring.R' 'utils.R' 'zzz.R'", + "Config/pak/sysreqs": "libicu-dev", + "Repository": "https://pharmaverse.r-universe.dev", + "RemoteUrl": "https://github.com/insightsengineering/formatters", + "RemoteRef": "HEAD", + "RemoteSha": "ee566c9b53f010edae9d0d9a64af82b41cee7b66", + "NeedsCompilation": "no", + "Author": "Gabriel Becker [aut] (original creator of the package), Adrian Waddell [aut], Davide Garolini [aut], Emily de la Rua [aut], Abinaya Yogasekaram [ctb], Joe Zhu [aut, cre] (), F. Hoffmann-La Roche AG [cph, fnd]", + "Maintainer": "Joe Zhu " + }, + "fs": { + "Package": "fs", + "Version": "1.6.5", + "Source": "Repository", + "Title": "Cross-Platform File System Operations Based on 'libuv'", + "Authors@R": "c( person(\"Jim\", \"Hester\", role = \"aut\"), person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\"), person(\"Gábor\", \"Csárdi\", , \"csardi.gabor@gmail.com\", role = c(\"aut\", \"cre\")), person(\"libuv project contributors\", role = \"cph\", comment = \"libuv library\"), person(\"Joyent, Inc. and other Node contributors\", role = \"cph\", comment = \"libuv library\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "A cross-platform interface to file system operations, built on top of the 'libuv' C library.", + "License": "MIT + file LICENSE", + "URL": "https://fs.r-lib.org, https://github.com/r-lib/fs", + "BugReports": "https://github.com/r-lib/fs/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "methods" + ], + "Suggests": [ + "covr", + "crayon", + "knitr", + "pillar (>= 1.0.0)", + "rmarkdown", + "spelling", + "testthat (>= 3.0.0)", + "tibble (>= 1.1.0)", + "vctrs (>= 0.3.0)", + "withr" + ], + "VignetteBuilder": "knitr", + "ByteCompile": "true", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Copyright": "file COPYRIGHTS", + "Encoding": "UTF-8", + "Language": "en-US", + "RoxygenNote": "7.2.3", + "SystemRequirements": "GNU make", + "NeedsCompilation": "yes", + "Author": "Jim Hester [aut], Hadley Wickham [aut], Gábor Csárdi [aut, cre], libuv project contributors [cph] (libuv library), Joyent, Inc. and other Node contributors [cph] (libuv library), Posit Software, PBC [cph, fnd]", + "Maintainer": "Gábor Csárdi ", + "Repository": "CRAN" + }, + "gdtools": { + "Package": "gdtools", + "Version": "0.4.1", + "Source": "Repository", + "Title": "Utilities for Graphical Rendering and Fonts Management", + "Authors@R": "c( person(\"David\", \"Gohel\", , \"david.gohel@ardata.fr\", role = c(\"aut\", \"cre\")), person(\"Hadley\", \"Wickham\", , \"hadley@rstudio.com\", role = \"aut\"), person(\"Lionel\", \"Henry\", , \"lionel@rstudio.com\", role = \"aut\"), person(\"Jeroen\", \"Ooms\", , \"jeroen@berkeley.edu\", role = \"aut\", comment = c(ORCID = \"0000-0002-4035-0289\")), person(\"Yixuan\", \"Qiu\", role = \"ctb\"), person(\"R Core Team\", role = \"cph\", comment = \"Cairo code from X11 device\"), person(\"ArData\", role = \"cph\"), person(\"RStudio\", role = \"cph\") )", + "Description": "Tools are provided to compute metrics of formatted strings and to check the availability of a font. Another set of functions is provided to support the collection of fonts from 'Google Fonts' in a cache. Their use is simple within 'R Markdown' documents and 'shiny' applications but also with graphic productions generated with the 'ggiraph', 'ragg' and 'svglite' packages or with tabular productions from the 'flextable' package.", + "License": "GPL-3 | file LICENSE", + "URL": "https://davidgohel.github.io/gdtools/", + "BugReports": "https://github.com/davidgohel/gdtools/issues", + "Depends": [ + "R (>= 4.0.0)" + ], + "Imports": [ + "fontquiver (>= 0.2.0)", + "htmltools", + "Rcpp (>= 0.12.12)", + "systemfonts (>= 1.1.0)", + "tools" + ], + "Suggests": [ + "curl", + "gfonts", + "methods", + "testthat" + ], + "LinkingTo": [ + "Rcpp" + ], + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "SystemRequirements": "cairo, freetype2, fontconfig", + "NeedsCompilation": "yes", + "Author": "David Gohel [aut, cre], Hadley Wickham [aut], Lionel Henry [aut], Jeroen Ooms [aut] (), Yixuan Qiu [ctb], R Core Team [cph] (Cairo code from X11 device), ArData [cph], RStudio [cph]", + "Maintainer": "David Gohel ", + "Repository": "CRAN" + }, + "generics": { + "Package": "generics", + "Version": "0.1.3", + "Source": "Repository", + "Title": "Common S3 Generics not Provided by Base R Methods Related to Model Fitting", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@rstudio.com\", role = c(\"aut\", \"cre\")), person(\"Max\", \"Kuhn\", , \"max@rstudio.com\", role = \"aut\"), person(\"Davis\", \"Vaughan\", , \"davis@rstudio.com\", role = \"aut\"), person(\"RStudio\", role = \"cph\") )", + "Description": "In order to reduce potential package dependencies and conflicts, generics provides a number of commonly used S3 generics.", + "License": "MIT + file LICENSE", + "URL": "https://generics.r-lib.org, https://github.com/r-lib/generics", + "BugReports": "https://github.com/r-lib/generics/issues", + "Depends": [ + "R (>= 3.2)" + ], + "Imports": [ + "methods" + ], + "Suggests": [ + "covr", + "pkgload", + "testthat (>= 3.0.0)", + "tibble", + "withr" + ], + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.0", + "NeedsCompilation": "no", + "Author": "Hadley Wickham [aut, cre], Max Kuhn [aut], Davis Vaughan [aut], RStudio [cph]", + "Maintainer": "Hadley Wickham ", + "Repository": "RSPM" + }, + "ggplot2": { + "Package": "ggplot2", + "Version": "3.5.1", + "Source": "Repository", + "Title": "Create Elegant Data Visualisations Using the Grammar of Graphics", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0003-4757-117X\")), person(\"Winston\", \"Chang\", role = \"aut\", comment = c(ORCID = \"0000-0002-1576-2126\")), person(\"Lionel\", \"Henry\", role = \"aut\"), person(\"Thomas Lin\", \"Pedersen\", , \"thomas.pedersen@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-5147-4711\")), person(\"Kohske\", \"Takahashi\", role = \"aut\"), person(\"Claus\", \"Wilke\", role = \"aut\", comment = c(ORCID = \"0000-0002-7470-9261\")), person(\"Kara\", \"Woo\", role = \"aut\", comment = c(ORCID = \"0000-0002-5125-4188\")), person(\"Hiroaki\", \"Yutani\", role = \"aut\", comment = c(ORCID = \"0000-0002-3385-7233\")), person(\"Dewey\", \"Dunnington\", role = \"aut\", comment = c(ORCID = \"0000-0002-9415-4582\")), person(\"Teun\", \"van den Brand\", role = \"aut\", comment = c(ORCID = \"0000-0002-9335-7468\")), person(\"Posit, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "A system for 'declaratively' creating graphics, based on \"The Grammar of Graphics\". You provide the data, tell 'ggplot2' how to map variables to aesthetics, what graphical primitives to use, and it takes care of the details.", + "License": "MIT + file LICENSE", + "URL": "https://ggplot2.tidyverse.org, https://github.com/tidyverse/ggplot2", + "BugReports": "https://github.com/tidyverse/ggplot2/issues", + "Depends": [ + "R (>= 3.5)" + ], + "Imports": [ + "cli", + "glue", + "grDevices", + "grid", + "gtable (>= 0.1.1)", + "isoband", + "lifecycle (> 1.0.1)", + "MASS", + "mgcv", + "rlang (>= 1.1.0)", + "scales (>= 1.3.0)", + "stats", + "tibble", + "vctrs (>= 0.6.0)", + "withr (>= 2.5.0)" + ], + "Suggests": [ + "covr", + "dplyr", + "ggplot2movies", + "hexbin", + "Hmisc", + "knitr", + "mapproj", + "maps", + "multcomp", + "munsell", + "nlme", + "profvis", + "quantreg", + "ragg (>= 1.2.6)", + "RColorBrewer", + "rmarkdown", + "rpart", + "sf (>= 0.7-3)", + "svglite (>= 2.1.2)", + "testthat (>= 3.1.2)", + "vdiffr (>= 1.0.6)", + "xml2" + ], + "Enhances": [ + "sp" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "ggtext, tidyr, forcats, tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "LazyData": "true", + "RoxygenNote": "7.3.1", + "Collate": "'ggproto.R' 'ggplot-global.R' 'aaa-.R' 'aes-colour-fill-alpha.R' 'aes-evaluation.R' 'aes-group-order.R' 'aes-linetype-size-shape.R' 'aes-position.R' 'compat-plyr.R' 'utilities.R' 'aes.R' 'utilities-checks.R' 'legend-draw.R' 'geom-.R' 'annotation-custom.R' 'annotation-logticks.R' 'geom-polygon.R' 'geom-map.R' 'annotation-map.R' 'geom-raster.R' 'annotation-raster.R' 'annotation.R' 'autolayer.R' 'autoplot.R' 'axis-secondary.R' 'backports.R' 'bench.R' 'bin.R' 'coord-.R' 'coord-cartesian-.R' 'coord-fixed.R' 'coord-flip.R' 'coord-map.R' 'coord-munch.R' 'coord-polar.R' 'coord-quickmap.R' 'coord-radial.R' 'coord-sf.R' 'coord-transform.R' 'data.R' 'docs_layer.R' 'facet-.R' 'facet-grid-.R' 'facet-null.R' 'facet-wrap.R' 'fortify-lm.R' 'fortify-map.R' 'fortify-multcomp.R' 'fortify-spatial.R' 'fortify.R' 'stat-.R' 'geom-abline.R' 'geom-rect.R' 'geom-bar.R' 'geom-bin2d.R' 'geom-blank.R' 'geom-boxplot.R' 'geom-col.R' 'geom-path.R' 'geom-contour.R' 'geom-count.R' 'geom-crossbar.R' 'geom-segment.R' 'geom-curve.R' 'geom-defaults.R' 'geom-ribbon.R' 'geom-density.R' 'geom-density2d.R' 'geom-dotplot.R' 'geom-errorbar.R' 'geom-errorbarh.R' 'geom-freqpoly.R' 'geom-function.R' 'geom-hex.R' 'geom-histogram.R' 'geom-hline.R' 'geom-jitter.R' 'geom-label.R' 'geom-linerange.R' 'geom-point.R' 'geom-pointrange.R' 'geom-quantile.R' 'geom-rug.R' 'geom-sf.R' 'geom-smooth.R' 'geom-spoke.R' 'geom-text.R' 'geom-tile.R' 'geom-violin.R' 'geom-vline.R' 'ggplot2-package.R' 'grob-absolute.R' 'grob-dotstack.R' 'grob-null.R' 'grouping.R' 'theme-elements.R' 'guide-.R' 'guide-axis.R' 'guide-axis-logticks.R' 'guide-axis-stack.R' 'guide-axis-theta.R' 'guide-legend.R' 'guide-bins.R' 'guide-colorbar.R' 'guide-colorsteps.R' 'guide-custom.R' 'layer.R' 'guide-none.R' 'guide-old.R' 'guides-.R' 'guides-grid.R' 'hexbin.R' 'import-standalone-obj-type.R' 'import-standalone-types-check.R' 'labeller.R' 'labels.R' 'layer-sf.R' 'layout.R' 'limits.R' 'margins.R' 'performance.R' 'plot-build.R' 'plot-construction.R' 'plot-last.R' 'plot.R' 'position-.R' 'position-collide.R' 'position-dodge.R' 'position-dodge2.R' 'position-identity.R' 'position-jitter.R' 'position-jitterdodge.R' 'position-nudge.R' 'position-stack.R' 'quick-plot.R' 'reshape-add-margins.R' 'save.R' 'scale-.R' 'scale-alpha.R' 'scale-binned.R' 'scale-brewer.R' 'scale-colour.R' 'scale-continuous.R' 'scale-date.R' 'scale-discrete-.R' 'scale-expansion.R' 'scale-gradient.R' 'scale-grey.R' 'scale-hue.R' 'scale-identity.R' 'scale-linetype.R' 'scale-linewidth.R' 'scale-manual.R' 'scale-shape.R' 'scale-size.R' 'scale-steps.R' 'scale-type.R' 'scale-view.R' 'scale-viridis.R' 'scales-.R' 'stat-align.R' 'stat-bin.R' 'stat-bin2d.R' 'stat-bindot.R' 'stat-binhex.R' 'stat-boxplot.R' 'stat-contour.R' 'stat-count.R' 'stat-density-2d.R' 'stat-density.R' 'stat-ecdf.R' 'stat-ellipse.R' 'stat-function.R' 'stat-identity.R' 'stat-qq-line.R' 'stat-qq.R' 'stat-quantilemethods.R' 'stat-sf-coordinates.R' 'stat-sf.R' 'stat-smooth-methods.R' 'stat-smooth.R' 'stat-sum.R' 'stat-summary-2d.R' 'stat-summary-bin.R' 'stat-summary-hex.R' 'stat-summary.R' 'stat-unique.R' 'stat-ydensity.R' 'summarise-plot.R' 'summary.R' 'theme.R' 'theme-defaults.R' 'theme-current.R' 'utilities-break.R' 'utilities-grid.R' 'utilities-help.R' 'utilities-matrix.R' 'utilities-patterns.R' 'utilities-resolution.R' 'utilities-tidy-eval.R' 'zxx.R' 'zzz.R'", + "NeedsCompilation": "no", + "Author": "Hadley Wickham [aut] (), Winston Chang [aut] (), Lionel Henry [aut], Thomas Lin Pedersen [aut, cre] (), Kohske Takahashi [aut], Claus Wilke [aut] (), Kara Woo [aut] (), Hiroaki Yutani [aut] (), Dewey Dunnington [aut] (), Teun van den Brand [aut] (), Posit, PBC [cph, fnd]", + "Maintainer": "Thomas Lin Pedersen ", + "Repository": "RSPM" + }, + "gld": { + "Package": "gld", + "Version": "2.6.7", + "Source": "Repository", + "Date": "2025-01-17", + "Title": "Estimation and Use of the Generalised (Tukey) Lambda Distribution", + "Suggests": [], + "Imports": [ + "stats", + "graphics", + "e1071", + "lmom" + ], + "Authors@R": "c(person(given=\"Robert\",family=\"King\", role=c(\"aut\",\"cre\"), email=\"Robert.King.Newcastle@gmail.com\", comment=c(ORCID=\"0000-0001-7495-6599\")), person(given=\"Benjamin\",family=\"Dean\", role=\"aut\", email=\"Benjamin.Dean@uon.edu.au\"), person(given=\"Sigbert\",family=\"Klinke\", role=\"aut\"), person(given=\"Paul\",family=\"van Staden\", role=\"aut\",email=\"paul.vanstaden@up.ac.za\", comment=c(ORCID=\"0000-0002-5710-5984\")) )", + "Description": "The generalised lambda distribution, or Tukey lambda distribution, provides a wide variety of shapes with one functional form. This package provides random numbers, quantiles, probabilities, densities and density quantiles for four different types of the distribution, the FKML (Freimer et al 1988), RS (Ramberg and Schmeiser 1974), GPD (van Staden and Loots 2009) and FM5 - see documentation for details. It provides the density function, distribution function, and Quantile-Quantile plots. It implements a variety of estimation methods for the distribution, including diagnostic plots. Estimation methods include the starship (all 4 types), method of L-Moments for the GPD and FKML types, and a number of methods for only the FKML type. These include maximum likelihood, maximum product of spacings, Titterington's method, Moments, Trimmed L-Moments and Distributional Least Absolutes.", + "License": "GPL (>= 2)", + "URL": "https://github.com/newystats/gld/", + "NeedsCompilation": "yes", + "Author": "Robert King [aut, cre] (), Benjamin Dean [aut], Sigbert Klinke [aut], Paul van Staden [aut] ()", + "Maintainer": "Robert King ", + "Repository": "CRAN" + }, + "glue": { + "Package": "glue", + "Version": "1.8.0", + "Source": "Repository", + "Title": "Interpreted String Literals", + "Authors@R": "c( person(\"Jim\", \"Hester\", role = \"aut\", comment = c(ORCID = \"0000-0002-2739-7082\")), person(\"Jennifer\", \"Bryan\", , \"jenny@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-6983-2759\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "An implementation of interpreted string literals, inspired by Python's Literal String Interpolation and Docstrings and Julia's Triple-Quoted String Literals .", + "License": "MIT + file LICENSE", + "URL": "https://glue.tidyverse.org/, https://github.com/tidyverse/glue", + "BugReports": "https://github.com/tidyverse/glue/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "methods" + ], + "Suggests": [ + "crayon", + "DBI (>= 1.2.0)", + "dplyr", + "knitr", + "magrittr", + "rlang", + "rmarkdown", + "RSQLite", + "testthat (>= 3.2.0)", + "vctrs (>= 0.3.0)", + "waldo (>= 0.5.3)", + "withr" + ], + "VignetteBuilder": "knitr", + "ByteCompile": "true", + "Config/Needs/website": "bench, forcats, ggbeeswarm, ggplot2, R.utils, rprintf, tidyr, tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "yes", + "Author": "Jim Hester [aut] (), Jennifer Bryan [aut, cre] (), Posit Software, PBC [cph, fnd]", + "Maintainer": "Jennifer Bryan ", + "Repository": "RSPM" + }, + "gridExtra": { + "Package": "gridExtra", + "Version": "2.3", + "Source": "Repository", + "Authors@R": "c(person(\"Baptiste\", \"Auguie\", email = \"baptiste.auguie@gmail.com\", role = c(\"aut\", \"cre\")), person(\"Anton\", \"Antonov\", email = \"tonytonov@gmail.com\", role = c(\"ctb\")))", + "License": "GPL (>= 2)", + "Title": "Miscellaneous Functions for \"Grid\" Graphics", + "Type": "Package", + "Description": "Provides a number of user-level functions to work with \"grid\" graphics, notably to arrange multiple grid-based plots on a page, and draw tables.", + "VignetteBuilder": "knitr", + "Imports": [ + "gtable", + "grid", + "grDevices", + "graphics", + "utils" + ], + "Suggests": [ + "ggplot2", + "egg", + "lattice", + "knitr", + "testthat" + ], + "RoxygenNote": "6.0.1", + "NeedsCompilation": "no", + "Author": "Baptiste Auguie [aut, cre], Anton Antonov [ctb]", + "Maintainer": "Baptiste Auguie ", + "Repository": "RSPM", + "Encoding": "UTF-8" + }, + "gtable": { + "Package": "gtable", + "Version": "0.3.6", + "Source": "Repository", + "Title": "Arrange 'Grobs' in Tables", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\"), person(\"Thomas Lin\", \"Pedersen\", , \"thomas.pedersen@posit.co\", role = c(\"aut\", \"cre\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Tools to make it easier to work with \"tables\" of 'grobs'. The 'gtable' package defines a 'gtable' grob class that specifies a grid along with a list of grobs and their placement in the grid. Further the package makes it easy to manipulate and combine 'gtable' objects so that complex compositions can be built up sequentially.", + "License": "MIT + file LICENSE", + "URL": "https://gtable.r-lib.org, https://github.com/r-lib/gtable", + "BugReports": "https://github.com/r-lib/gtable/issues", + "Depends": [ + "R (>= 4.0)" + ], + "Imports": [ + "cli", + "glue", + "grid", + "lifecycle", + "rlang (>= 1.1.0)", + "stats" + ], + "Suggests": [ + "covr", + "ggplot2", + "knitr", + "profvis", + "rmarkdown", + "testthat (>= 3.0.0)" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Config/usethis/last-upkeep": "2024-10-25", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "no", + "Author": "Hadley Wickham [aut], Thomas Lin Pedersen [aut, cre], Posit Software, PBC [cph, fnd]", + "Maintainer": "Thomas Lin Pedersen ", + "Repository": "CRAN" + }, + "haven": { + "Package": "haven", + "Version": "2.5.4", + "Source": "Repository", + "Title": "Import and Export 'SPSS', 'Stata' and 'SAS' Files", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = c(\"aut\", \"cre\")), person(\"Evan\", \"Miller\", role = c(\"aut\", \"cph\"), comment = \"Author of included ReadStat code\"), person(\"Danny\", \"Smith\", role = \"aut\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Import foreign statistical formats into R via the embedded 'ReadStat' C library, .", + "License": "MIT + file LICENSE", + "URL": "https://haven.tidyverse.org, https://github.com/tidyverse/haven, https://github.com/WizardMac/ReadStat", + "BugReports": "https://github.com/tidyverse/haven/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "cli (>= 3.0.0)", + "forcats (>= 0.2.0)", + "hms", + "lifecycle", + "methods", + "readr (>= 0.1.0)", + "rlang (>= 0.4.0)", + "tibble", + "tidyselect", + "vctrs (>= 0.3.0)" + ], + "Suggests": [ + "covr", + "crayon", + "fs", + "knitr", + "pillar (>= 1.4.0)", + "rmarkdown", + "testthat (>= 3.0.0)", + "utf8" + ], + "LinkingTo": [ + "cpp11" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "SystemRequirements": "GNU make, zlib: zlib1g-dev (deb), zlib-devel (rpm)", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [aut, cre], Evan Miller [aut, cph] (Author of included ReadStat code), Danny Smith [aut], Posit Software, PBC [cph, fnd]", + "Maintainer": "Hadley Wickham ", + "Repository": "RSPM" + }, + "highr": { + "Package": "highr", + "Version": "0.11", + "Source": "Repository", + "Type": "Package", + "Title": "Syntax Highlighting for R Source Code", + "Authors@R": "c( person(\"Yihui\", \"Xie\", role = c(\"aut\", \"cre\"), email = \"xie@yihui.name\", comment = c(ORCID = \"0000-0003-0645-5666\")), person(\"Yixuan\", \"Qiu\", role = \"aut\"), person(\"Christopher\", \"Gandrud\", role = \"ctb\"), person(\"Qiang\", \"Li\", role = \"ctb\") )", + "Description": "Provides syntax highlighting for R source code. Currently it supports LaTeX and HTML output. Source code of other languages is supported via Andre Simon's highlight package ().", + "Depends": [ + "R (>= 3.3.0)" + ], + "Imports": [ + "xfun (>= 0.18)" + ], + "Suggests": [ + "knitr", + "markdown", + "testit" + ], + "License": "GPL", + "URL": "https://github.com/yihui/highr", + "BugReports": "https://github.com/yihui/highr/issues", + "VignetteBuilder": "knitr", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.1", + "NeedsCompilation": "no", + "Author": "Yihui Xie [aut, cre] (), Yixuan Qiu [aut], Christopher Gandrud [ctb], Qiang Li [ctb]", + "Maintainer": "Yihui Xie ", + "Repository": "RSPM" + }, + "hms": { + "Package": "hms", + "Version": "1.1.3", + "Source": "Repository", + "Title": "Pretty Time of Day", + "Date": "2023-03-21", + "Authors@R": "c( person(\"Kirill\", \"Müller\", role = c(\"aut\", \"cre\"), email = \"kirill@cynkra.com\", comment = c(ORCID = \"0000-0002-1416-3412\")), person(\"R Consortium\", role = \"fnd\"), person(\"RStudio\", role = \"fnd\") )", + "Description": "Implements an S3 class for storing and formatting time-of-day values, based on the 'difftime' class.", + "Imports": [ + "lifecycle", + "methods", + "pkgconfig", + "rlang (>= 1.0.2)", + "vctrs (>= 0.3.8)" + ], + "Suggests": [ + "crayon", + "lubridate", + "pillar (>= 1.1.0)", + "testthat (>= 3.0.0)" + ], + "License": "MIT + file LICENSE", + "Encoding": "UTF-8", + "URL": "https://hms.tidyverse.org/, https://github.com/tidyverse/hms", + "BugReports": "https://github.com/tidyverse/hms/issues", + "RoxygenNote": "7.2.3", + "Config/testthat/edition": "3", + "Config/autostyle/scope": "line_breaks", + "Config/autostyle/strict": "false", + "Config/Needs/website": "tidyverse/tidytemplate", + "NeedsCompilation": "no", + "Author": "Kirill Müller [aut, cre] (), R Consortium [fnd], RStudio [fnd]", + "Maintainer": "Kirill Müller ", + "Repository": "RSPM" + }, + "htmltools": { + "Package": "htmltools", + "Version": "0.5.8.1", + "Source": "Repository", + "Type": "Package", + "Title": "Tools for HTML", + "Authors@R": "c( person(\"Joe\", \"Cheng\", , \"joe@posit.co\", role = \"aut\"), person(\"Carson\", \"Sievert\", , \"carson@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-4958-2844\")), person(\"Barret\", \"Schloerke\", , \"barret@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0001-9986-114X\")), person(\"Winston\", \"Chang\", , \"winston@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0002-1576-2126\")), person(\"Yihui\", \"Xie\", , \"yihui@posit.co\", role = \"aut\"), person(\"Jeff\", \"Allen\", role = \"aut\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Tools for HTML generation and output.", + "License": "GPL (>= 2)", + "URL": "https://github.com/rstudio/htmltools, https://rstudio.github.io/htmltools/", + "BugReports": "https://github.com/rstudio/htmltools/issues", + "Depends": [ + "R (>= 2.14.1)" + ], + "Imports": [ + "base64enc", + "digest", + "fastmap (>= 1.1.0)", + "grDevices", + "rlang (>= 1.0.0)", + "utils" + ], + "Suggests": [ + "Cairo", + "markdown", + "ragg", + "shiny", + "testthat", + "withr" + ], + "Enhances": [ + "knitr" + ], + "Config/Needs/check": "knitr", + "Config/Needs/website": "rstudio/quillt, bench", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.1", + "Collate": "'colors.R' 'fill.R' 'html_dependency.R' 'html_escape.R' 'html_print.R' 'htmltools-package.R' 'images.R' 'known_tags.R' 'selector.R' 'staticimports.R' 'tag_query.R' 'utils.R' 'tags.R' 'template.R'", + "NeedsCompilation": "yes", + "Author": "Joe Cheng [aut], Carson Sievert [aut, cre] (), Barret Schloerke [aut] (), Winston Chang [aut] (), Yihui Xie [aut], Jeff Allen [aut], Posit Software, PBC [cph, fnd]", + "Maintainer": "Carson Sievert ", + "Repository": "RSPM" + }, + "htmlwidgets": { + "Package": "htmlwidgets", + "Version": "1.6.4", + "Source": "Repository", + "Type": "Package", + "Title": "HTML Widgets for R", + "Authors@R": "c( person(\"Ramnath\", \"Vaidyanathan\", role = c(\"aut\", \"cph\")), person(\"Yihui\", \"Xie\", role = \"aut\"), person(\"JJ\", \"Allaire\", role = \"aut\"), person(\"Joe\", \"Cheng\", , \"joe@posit.co\", role = \"aut\"), person(\"Carson\", \"Sievert\", , \"carson@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-4958-2844\")), person(\"Kenton\", \"Russell\", role = c(\"aut\", \"cph\")), person(\"Ellis\", \"Hughes\", role = \"ctb\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "A framework for creating HTML widgets that render in various contexts including the R console, 'R Markdown' documents, and 'Shiny' web applications.", + "License": "MIT + file LICENSE", + "URL": "https://github.com/ramnathv/htmlwidgets", + "BugReports": "https://github.com/ramnathv/htmlwidgets/issues", + "Imports": [ + "grDevices", + "htmltools (>= 0.5.7)", + "jsonlite (>= 0.9.16)", + "knitr (>= 1.8)", + "rmarkdown", + "yaml" + ], + "Suggests": [ + "testthat" + ], + "Enhances": [ + "shiny (>= 1.1)" + ], + "VignetteBuilder": "knitr", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "no", + "Author": "Ramnath Vaidyanathan [aut, cph], Yihui Xie [aut], JJ Allaire [aut], Joe Cheng [aut], Carson Sievert [aut, cre] (), Kenton Russell [aut, cph], Ellis Hughes [ctb], Posit Software, PBC [cph, fnd]", + "Maintainer": "Carson Sievert ", + "Repository": "RSPM" + }, + "httpuv": { + "Package": "httpuv", + "Version": "1.6.15", + "Source": "Repository", + "Type": "Package", + "Title": "HTTP and WebSocket Server Library", + "Authors@R": "c( person(\"Joe\", \"Cheng\", , \"joe@posit.co\", role = \"aut\"), person(\"Winston\", \"Chang\", , \"winston@posit.co\", role = c(\"aut\", \"cre\")), person(\"Posit, PBC\", \"fnd\", role = \"cph\"), person(\"Hector\", \"Corrada Bravo\", role = \"ctb\"), person(\"Jeroen\", \"Ooms\", role = \"ctb\"), person(\"Andrzej\", \"Krzemienski\", role = \"cph\", comment = \"optional.hpp\"), person(\"libuv project contributors\", role = \"cph\", comment = \"libuv library, see src/libuv/AUTHORS file\"), person(\"Joyent, Inc. and other Node contributors\", role = \"cph\", comment = \"libuv library, see src/libuv/AUTHORS file; and http-parser library, see src/http-parser/AUTHORS file\"), person(\"Niels\", \"Provos\", role = \"cph\", comment = \"libuv subcomponent: tree.h\"), person(\"Internet Systems Consortium, Inc.\", role = \"cph\", comment = \"libuv subcomponent: inet_pton and inet_ntop, contained in src/libuv/src/inet.c\"), person(\"Alexander\", \"Chemeris\", role = \"cph\", comment = \"libuv subcomponent: stdint-msvc2008.h (from msinttypes)\"), person(\"Google, Inc.\", role = \"cph\", comment = \"libuv subcomponent: pthread-fixes.c\"), person(\"Sony Mobile Communcations AB\", role = \"cph\", comment = \"libuv subcomponent: pthread-fixes.c\"), person(\"Berkeley Software Design Inc.\", role = \"cph\", comment = \"libuv subcomponent: android-ifaddrs.h, android-ifaddrs.c\"), person(\"Kenneth\", \"MacKay\", role = \"cph\", comment = \"libuv subcomponent: android-ifaddrs.h, android-ifaddrs.c\"), person(\"Emergya (Cloud4all, FP7/2007-2013, grant agreement no 289016)\", role = \"cph\", comment = \"libuv subcomponent: android-ifaddrs.h, android-ifaddrs.c\"), person(\"Steve\", \"Reid\", role = \"aut\", comment = \"SHA-1 implementation\"), person(\"James\", \"Brown\", role = \"aut\", comment = \"SHA-1 implementation\"), person(\"Bob\", \"Trower\", role = \"aut\", comment = \"base64 implementation\"), person(\"Alexander\", \"Peslyak\", role = \"aut\", comment = \"MD5 implementation\"), person(\"Trantor Standard Systems\", role = \"cph\", comment = \"base64 implementation\"), person(\"Igor\", \"Sysoev\", role = \"cph\", comment = \"http-parser\") )", + "Description": "Provides low-level socket and protocol support for handling HTTP and WebSocket requests directly from within R. It is primarily intended as a building block for other packages, rather than making it particularly easy to create complete web applications using httpuv alone. httpuv is built on top of the libuv and http-parser C libraries, both of which were developed by Joyent, Inc. (See LICENSE file for libuv and http-parser license information.)", + "License": "GPL (>= 2) | file LICENSE", + "URL": "https://github.com/rstudio/httpuv", + "BugReports": "https://github.com/rstudio/httpuv/issues", + "Depends": [ + "R (>= 2.15.1)" + ], + "Imports": [ + "later (>= 0.8.0)", + "promises", + "R6", + "Rcpp (>= 1.0.7)", + "utils" + ], + "Suggests": [ + "callr", + "curl", + "testthat", + "websocket" + ], + "LinkingTo": [ + "later", + "Rcpp" + ], + "Encoding": "UTF-8", + "RoxygenNote": "7.3.1", + "SystemRequirements": "GNU make, zlib", + "Collate": "'RcppExports.R' 'httpuv.R' 'random_port.R' 'server.R' 'staticServer.R' 'static_paths.R' 'utils.R'", + "NeedsCompilation": "yes", + "Author": "Joe Cheng [aut], Winston Chang [aut, cre], Posit, PBC fnd [cph], Hector Corrada Bravo [ctb], Jeroen Ooms [ctb], Andrzej Krzemienski [cph] (optional.hpp), libuv project contributors [cph] (libuv library, see src/libuv/AUTHORS file), Joyent, Inc. and other Node contributors [cph] (libuv library, see src/libuv/AUTHORS file; and http-parser library, see src/http-parser/AUTHORS file), Niels Provos [cph] (libuv subcomponent: tree.h), Internet Systems Consortium, Inc. [cph] (libuv subcomponent: inet_pton and inet_ntop, contained in src/libuv/src/inet.c), Alexander Chemeris [cph] (libuv subcomponent: stdint-msvc2008.h (from msinttypes)), Google, Inc. [cph] (libuv subcomponent: pthread-fixes.c), Sony Mobile Communcations AB [cph] (libuv subcomponent: pthread-fixes.c), Berkeley Software Design Inc. [cph] (libuv subcomponent: android-ifaddrs.h, android-ifaddrs.c), Kenneth MacKay [cph] (libuv subcomponent: android-ifaddrs.h, android-ifaddrs.c), Emergya (Cloud4all, FP7/2007-2013, grant agreement no 289016) [cph] (libuv subcomponent: android-ifaddrs.h, android-ifaddrs.c), Steve Reid [aut] (SHA-1 implementation), James Brown [aut] (SHA-1 implementation), Bob Trower [aut] (base64 implementation), Alexander Peslyak [aut] (MD5 implementation), Trantor Standard Systems [cph] (base64 implementation), Igor Sysoev [cph] (http-parser)", + "Maintainer": "Winston Chang ", + "Repository": "RSPM" + }, + "httr": { + "Package": "httr", + "Version": "1.4.7", + "Source": "Repository", + "Title": "Tools for Working with URLs and HTTP", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = c(\"aut\", \"cre\")), person(\"Posit, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Useful tools for working with HTTP organised by HTTP verbs (GET(), POST(), etc). Configuration functions make it easy to control additional request components (authenticate(), add_headers() and so on).", + "License": "MIT + file LICENSE", + "URL": "https://httr.r-lib.org/, https://github.com/r-lib/httr", + "BugReports": "https://github.com/r-lib/httr/issues", + "Depends": [ + "R (>= 3.5)" + ], + "Imports": [ + "curl (>= 5.0.2)", + "jsonlite", + "mime", + "openssl (>= 0.8)", + "R6" + ], + "Suggests": [ + "covr", + "httpuv", + "jpeg", + "knitr", + "png", + "readr", + "rmarkdown", + "testthat (>= 0.8.0)", + "xml2" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "no", + "Author": "Hadley Wickham [aut, cre], Posit, PBC [cph, fnd]", + "Maintainer": "Hadley Wickham ", + "Repository": "RSPM" + }, + "isoband": { + "Package": "isoband", + "Version": "0.2.7", + "Source": "Repository", + "Title": "Generate Isolines and Isobands from Regularly Spaced Elevation Grids", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0003-4757-117X\")), person(\"Claus O.\", \"Wilke\", , \"wilke@austin.utexas.edu\", role = \"aut\", comment = c(\"Original author\", ORCID = \"0000-0002-7470-9261\")), person(\"Thomas Lin\", \"Pedersen\", , \"thomasp85@gmail.com\", role = \"aut\", comment = c(ORCID = \"0000-0002-5147-4711\")) )", + "Description": "A fast C++ implementation to generate contour lines (isolines) and contour polygons (isobands) from regularly spaced grids containing elevation data.", + "License": "MIT + file LICENSE", + "URL": "https://isoband.r-lib.org", + "BugReports": "https://github.com/r-lib/isoband/issues", + "Imports": [ + "grid", + "utils" + ], + "Suggests": [ + "covr", + "ggplot2", + "knitr", + "magick", + "microbenchmark", + "rmarkdown", + "sf", + "testthat", + "xml2" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "SystemRequirements": "C++11", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [aut, cre] (), Claus O. Wilke [aut] (Original author, ), Thomas Lin Pedersen [aut] ()", + "Maintainer": "Hadley Wickham ", + "Repository": "RSPM" + }, + "jquerylib": { + "Package": "jquerylib", + "Version": "0.1.4", + "Source": "Repository", + "Title": "Obtain 'jQuery' as an HTML Dependency Object", + "Authors@R": "c( person(\"Carson\", \"Sievert\", role = c(\"aut\", \"cre\"), email = \"carson@rstudio.com\", comment = c(ORCID = \"0000-0002-4958-2844\")), person(\"Joe\", \"Cheng\", role = \"aut\", email = \"joe@rstudio.com\"), person(family = \"RStudio\", role = \"cph\"), person(family = \"jQuery Foundation\", role = \"cph\", comment = \"jQuery library and jQuery UI library\"), person(family = \"jQuery contributors\", role = c(\"ctb\", \"cph\"), comment = \"jQuery library; authors listed in inst/lib/jquery-AUTHORS.txt\") )", + "Description": "Obtain any major version of 'jQuery' () and use it in any webpage generated by 'htmltools' (e.g. 'shiny', 'htmlwidgets', and 'rmarkdown'). Most R users don't need to use this package directly, but other R packages (e.g. 'shiny', 'rmarkdown', etc.) depend on this package to avoid bundling redundant copies of 'jQuery'.", + "License": "MIT + file LICENSE", + "Encoding": "UTF-8", + "Config/testthat/edition": "3", + "RoxygenNote": "7.0.2", + "Imports": [ + "htmltools" + ], + "Suggests": [ + "testthat" + ], + "NeedsCompilation": "no", + "Author": "Carson Sievert [aut, cre] (), Joe Cheng [aut], RStudio [cph], jQuery Foundation [cph] (jQuery library and jQuery UI library), jQuery contributors [ctb, cph] (jQuery library; authors listed in inst/lib/jquery-AUTHORS.txt)", + "Maintainer": "Carson Sievert ", + "Repository": "RSPM" + }, + "jsonlite": { + "Package": "jsonlite", + "Version": "1.8.9", + "Source": "Repository", + "Title": "A Simple and Robust JSON Parser and Generator for R", + "License": "MIT + file LICENSE", + "Depends": [ + "methods" + ], + "Authors@R": "c( person(\"Jeroen\", \"Ooms\", role = c(\"aut\", \"cre\"), email = \"jeroenooms@gmail.com\", comment = c(ORCID = \"0000-0002-4035-0289\")), person(\"Duncan\", \"Temple Lang\", role = \"ctb\"), person(\"Lloyd\", \"Hilaiel\", role = \"cph\", comment=\"author of bundled libyajl\"))", + "URL": "https://jeroen.r-universe.dev/jsonlite https://arxiv.org/abs/1403.2805", + "BugReports": "https://github.com/jeroen/jsonlite/issues", + "Maintainer": "Jeroen Ooms ", + "VignetteBuilder": "knitr, R.rsp", + "Description": "A reasonably fast JSON parser and generator, optimized for statistical data and the web. Offers simple, flexible tools for working with JSON in R, and is particularly powerful for building pipelines and interacting with a web API. The implementation is based on the mapping described in the vignette (Ooms, 2014). In addition to converting JSON data from/to R objects, 'jsonlite' contains functions to stream, validate, and prettify JSON data. The unit tests included with the package verify that all edge cases are encoded and decoded consistently for use with dynamic data in systems and applications.", + "Suggests": [ + "httr", + "vctrs", + "testthat", + "knitr", + "rmarkdown", + "R.rsp", + "sf" + ], + "RoxygenNote": "7.2.3", + "Encoding": "UTF-8", + "NeedsCompilation": "yes", + "Author": "Jeroen Ooms [aut, cre] (), Duncan Temple Lang [ctb], Lloyd Hilaiel [cph] (author of bundled libyajl)", + "Repository": "RSPM" + }, + "knitr": { + "Package": "knitr", + "Version": "1.49", + "Source": "Repository", + "Type": "Package", + "Title": "A General-Purpose Package for Dynamic Report Generation in R", + "Authors@R": "c( person(\"Yihui\", \"Xie\", role = c(\"aut\", \"cre\"), email = \"xie@yihui.name\", comment = c(ORCID = \"0000-0003-0645-5666\")), person(\"Abhraneel\", \"Sarma\", role = \"ctb\"), person(\"Adam\", \"Vogt\", role = \"ctb\"), person(\"Alastair\", \"Andrew\", role = \"ctb\"), person(\"Alex\", \"Zvoleff\", role = \"ctb\"), person(\"Amar\", \"Al-Zubaidi\", role = \"ctb\"), person(\"Andre\", \"Simon\", role = \"ctb\", comment = \"the CSS files under inst/themes/ were derived from the Highlight package http://www.andre-simon.de\"), person(\"Aron\", \"Atkins\", role = \"ctb\"), person(\"Aaron\", \"Wolen\", role = \"ctb\"), person(\"Ashley\", \"Manton\", role = \"ctb\"), person(\"Atsushi\", \"Yasumoto\", role = \"ctb\", comment = c(ORCID = \"0000-0002-8335-495X\")), person(\"Ben\", \"Baumer\", role = \"ctb\"), person(\"Brian\", \"Diggs\", role = \"ctb\"), person(\"Brian\", \"Zhang\", role = \"ctb\"), person(\"Bulat\", \"Yapparov\", role = \"ctb\"), person(\"Cassio\", \"Pereira\", role = \"ctb\"), person(\"Christophe\", \"Dervieux\", role = \"ctb\"), person(\"David\", \"Hall\", role = \"ctb\"), person(\"David\", \"Hugh-Jones\", role = \"ctb\"), person(\"David\", \"Robinson\", role = \"ctb\"), person(\"Doug\", \"Hemken\", role = \"ctb\"), person(\"Duncan\", \"Murdoch\", role = \"ctb\"), person(\"Elio\", \"Campitelli\", role = \"ctb\"), person(\"Ellis\", \"Hughes\", role = \"ctb\"), person(\"Emily\", \"Riederer\", role = \"ctb\"), person(\"Fabian\", \"Hirschmann\", role = \"ctb\"), person(\"Fitch\", \"Simeon\", role = \"ctb\"), person(\"Forest\", \"Fang\", role = \"ctb\"), person(c(\"Frank\", \"E\", \"Harrell\", \"Jr\"), role = \"ctb\", comment = \"the Sweavel package at inst/misc/Sweavel.sty\"), person(\"Garrick\", \"Aden-Buie\", role = \"ctb\"), person(\"Gregoire\", \"Detrez\", role = \"ctb\"), person(\"Hadley\", \"Wickham\", role = \"ctb\"), person(\"Hao\", \"Zhu\", role = \"ctb\"), person(\"Heewon\", \"Jeon\", role = \"ctb\"), person(\"Henrik\", \"Bengtsson\", role = \"ctb\"), person(\"Hiroaki\", \"Yutani\", role = \"ctb\"), person(\"Ian\", \"Lyttle\", role = \"ctb\"), person(\"Hodges\", \"Daniel\", role = \"ctb\"), person(\"Jacob\", \"Bien\", role = \"ctb\"), person(\"Jake\", \"Burkhead\", role = \"ctb\"), person(\"James\", \"Manton\", role = \"ctb\"), person(\"Jared\", \"Lander\", role = \"ctb\"), person(\"Jason\", \"Punyon\", role = \"ctb\"), person(\"Javier\", \"Luraschi\", role = \"ctb\"), person(\"Jeff\", \"Arnold\", role = \"ctb\"), person(\"Jenny\", \"Bryan\", role = \"ctb\"), person(\"Jeremy\", \"Ashkenas\", role = c(\"ctb\", \"cph\"), comment = \"the CSS file at inst/misc/docco-classic.css\"), person(\"Jeremy\", \"Stephens\", role = \"ctb\"), person(\"Jim\", \"Hester\", role = \"ctb\"), person(\"Joe\", \"Cheng\", role = \"ctb\"), person(\"Johannes\", \"Ranke\", role = \"ctb\"), person(\"John\", \"Honaker\", role = \"ctb\"), person(\"John\", \"Muschelli\", role = \"ctb\"), person(\"Jonathan\", \"Keane\", role = \"ctb\"), person(\"JJ\", \"Allaire\", role = \"ctb\"), person(\"Johan\", \"Toloe\", role = \"ctb\"), person(\"Jonathan\", \"Sidi\", role = \"ctb\"), person(\"Joseph\", \"Larmarange\", role = \"ctb\"), person(\"Julien\", \"Barnier\", role = \"ctb\"), person(\"Kaiyin\", \"Zhong\", role = \"ctb\"), person(\"Kamil\", \"Slowikowski\", role = \"ctb\"), person(\"Karl\", \"Forner\", role = \"ctb\"), person(c(\"Kevin\", \"K.\"), \"Smith\", role = \"ctb\"), person(\"Kirill\", \"Mueller\", role = \"ctb\"), person(\"Kohske\", \"Takahashi\", role = \"ctb\"), person(\"Lorenz\", \"Walthert\", role = \"ctb\"), person(\"Lucas\", \"Gallindo\", role = \"ctb\"), person(\"Marius\", \"Hofert\", role = \"ctb\"), person(\"Martin\", \"Modrák\", role = \"ctb\"), person(\"Michael\", \"Chirico\", role = \"ctb\"), person(\"Michael\", \"Friendly\", role = \"ctb\"), person(\"Michal\", \"Bojanowski\", role = \"ctb\"), person(\"Michel\", \"Kuhlmann\", role = \"ctb\"), person(\"Miller\", \"Patrick\", role = \"ctb\"), person(\"Nacho\", \"Caballero\", role = \"ctb\"), person(\"Nick\", \"Salkowski\", role = \"ctb\"), person(\"Niels Richard\", \"Hansen\", role = \"ctb\"), person(\"Noam\", \"Ross\", role = \"ctb\"), person(\"Obada\", \"Mahdi\", role = \"ctb\"), person(\"Pavel N.\", \"Krivitsky\", role = \"ctb\", comment=c(ORCID = \"0000-0002-9101-3362\")), person(\"Pedro\", \"Faria\", role = \"ctb\"), person(\"Qiang\", \"Li\", role = \"ctb\"), person(\"Ramnath\", \"Vaidyanathan\", role = \"ctb\"), person(\"Richard\", \"Cotton\", role = \"ctb\"), person(\"Robert\", \"Krzyzanowski\", role = \"ctb\"), person(\"Rodrigo\", \"Copetti\", role = \"ctb\"), person(\"Romain\", \"Francois\", role = \"ctb\"), person(\"Ruaridh\", \"Williamson\", role = \"ctb\"), person(\"Sagiru\", \"Mati\", role = \"ctb\", comment = c(ORCID = \"0000-0003-1413-3974\")), person(\"Scott\", \"Kostyshak\", role = \"ctb\"), person(\"Sebastian\", \"Meyer\", role = \"ctb\"), person(\"Sietse\", \"Brouwer\", role = \"ctb\"), person(c(\"Simon\", \"de\"), \"Bernard\", role = \"ctb\"), person(\"Sylvain\", \"Rousseau\", role = \"ctb\"), person(\"Taiyun\", \"Wei\", role = \"ctb\"), person(\"Thibaut\", \"Assus\", role = \"ctb\"), person(\"Thibaut\", \"Lamadon\", role = \"ctb\"), person(\"Thomas\", \"Leeper\", role = \"ctb\"), person(\"Tim\", \"Mastny\", role = \"ctb\"), person(\"Tom\", \"Torsney-Weir\", role = \"ctb\"), person(\"Trevor\", \"Davis\", role = \"ctb\"), person(\"Viktoras\", \"Veitas\", role = \"ctb\"), person(\"Weicheng\", \"Zhu\", role = \"ctb\"), person(\"Wush\", \"Wu\", role = \"ctb\"), person(\"Zachary\", \"Foster\", role = \"ctb\"), person(\"Zhian N.\", \"Kamvar\", role = \"ctb\", comment = c(ORCID = \"0000-0003-1458-7108\")), person(given = \"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Provides a general-purpose tool for dynamic report generation in R using Literate Programming techniques.", + "Depends": [ + "R (>= 3.6.0)" + ], + "Imports": [ + "evaluate (>= 0.15)", + "highr (>= 0.11)", + "methods", + "tools", + "xfun (>= 0.48)", + "yaml (>= 2.1.19)" + ], + "Suggests": [ + "bslib", + "codetools", + "DBI (>= 0.4-1)", + "digest", + "formatR", + "gifski", + "gridSVG", + "htmlwidgets (>= 0.7)", + "jpeg", + "JuliaCall (>= 0.11.1)", + "magick", + "litedown", + "markdown (>= 1.3)", + "png", + "ragg", + "reticulate (>= 1.4)", + "rgl (>= 0.95.1201)", + "rlang", + "rmarkdown", + "sass", + "showtext", + "styler (>= 1.2.0)", + "targets (>= 0.6.0)", + "testit", + "tibble", + "tikzDevice (>= 0.10)", + "tinytex (>= 0.46)", + "webshot", + "rstudioapi", + "svglite" + ], + "License": "GPL", + "URL": "https://yihui.org/knitr/", + "BugReports": "https://github.com/yihui/knitr/issues", + "Encoding": "UTF-8", + "VignetteBuilder": "litedown, knitr", + "SystemRequirements": "Package vignettes based on R Markdown v2 or reStructuredText require Pandoc (http://pandoc.org). The function rst2pdf() requires rst2pdf (https://github.com/rst2pdf/rst2pdf).", + "Collate": "'block.R' 'cache.R' 'utils.R' 'citation.R' 'hooks-html.R' 'plot.R' 'defaults.R' 'concordance.R' 'engine.R' 'highlight.R' 'themes.R' 'header.R' 'hooks-asciidoc.R' 'hooks-chunk.R' 'hooks-extra.R' 'hooks-latex.R' 'hooks-md.R' 'hooks-rst.R' 'hooks-textile.R' 'hooks.R' 'output.R' 'package.R' 'pandoc.R' 'params.R' 'parser.R' 'pattern.R' 'rocco.R' 'spin.R' 'table.R' 'template.R' 'utils-conversion.R' 'utils-rd2html.R' 'utils-string.R' 'utils-sweave.R' 'utils-upload.R' 'utils-vignettes.R' 'zzz.R'", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "no", + "Author": "Yihui Xie [aut, cre] (), Abhraneel Sarma [ctb], Adam Vogt [ctb], Alastair Andrew [ctb], Alex Zvoleff [ctb], Amar Al-Zubaidi [ctb], Andre Simon [ctb] (the CSS files under inst/themes/ were derived from the Highlight package http://www.andre-simon.de), Aron Atkins [ctb], Aaron Wolen [ctb], Ashley Manton [ctb], Atsushi Yasumoto [ctb] (), Ben Baumer [ctb], Brian Diggs [ctb], Brian Zhang [ctb], Bulat Yapparov [ctb], Cassio Pereira [ctb], Christophe Dervieux [ctb], David Hall [ctb], David Hugh-Jones [ctb], David Robinson [ctb], Doug Hemken [ctb], Duncan Murdoch [ctb], Elio Campitelli [ctb], Ellis Hughes [ctb], Emily Riederer [ctb], Fabian Hirschmann [ctb], Fitch Simeon [ctb], Forest Fang [ctb], Frank E Harrell Jr [ctb] (the Sweavel package at inst/misc/Sweavel.sty), Garrick Aden-Buie [ctb], Gregoire Detrez [ctb], Hadley Wickham [ctb], Hao Zhu [ctb], Heewon Jeon [ctb], Henrik Bengtsson [ctb], Hiroaki Yutani [ctb], Ian Lyttle [ctb], Hodges Daniel [ctb], Jacob Bien [ctb], Jake Burkhead [ctb], James Manton [ctb], Jared Lander [ctb], Jason Punyon [ctb], Javier Luraschi [ctb], Jeff Arnold [ctb], Jenny Bryan [ctb], Jeremy Ashkenas [ctb, cph] (the CSS file at inst/misc/docco-classic.css), Jeremy Stephens [ctb], Jim Hester [ctb], Joe Cheng [ctb], Johannes Ranke [ctb], John Honaker [ctb], John Muschelli [ctb], Jonathan Keane [ctb], JJ Allaire [ctb], Johan Toloe [ctb], Jonathan Sidi [ctb], Joseph Larmarange [ctb], Julien Barnier [ctb], Kaiyin Zhong [ctb], Kamil Slowikowski [ctb], Karl Forner [ctb], Kevin K. Smith [ctb], Kirill Mueller [ctb], Kohske Takahashi [ctb], Lorenz Walthert [ctb], Lucas Gallindo [ctb], Marius Hofert [ctb], Martin Modrák [ctb], Michael Chirico [ctb], Michael Friendly [ctb], Michal Bojanowski [ctb], Michel Kuhlmann [ctb], Miller Patrick [ctb], Nacho Caballero [ctb], Nick Salkowski [ctb], Niels Richard Hansen [ctb], Noam Ross [ctb], Obada Mahdi [ctb], Pavel N. Krivitsky [ctb] (), Pedro Faria [ctb], Qiang Li [ctb], Ramnath Vaidyanathan [ctb], Richard Cotton [ctb], Robert Krzyzanowski [ctb], Rodrigo Copetti [ctb], Romain Francois [ctb], Ruaridh Williamson [ctb], Sagiru Mati [ctb] (), Scott Kostyshak [ctb], Sebastian Meyer [ctb], Sietse Brouwer [ctb], Simon de Bernard [ctb], Sylvain Rousseau [ctb], Taiyun Wei [ctb], Thibaut Assus [ctb], Thibaut Lamadon [ctb], Thomas Leeper [ctb], Tim Mastny [ctb], Tom Torsney-Weir [ctb], Trevor Davis [ctb], Viktoras Veitas [ctb], Weicheng Zhu [ctb], Wush Wu [ctb], Zachary Foster [ctb], Zhian N. Kamvar [ctb] (), Posit Software, PBC [cph, fnd]", + "Maintainer": "Yihui Xie ", + "Repository": "CRAN" + }, + "labeling": { + "Package": "labeling", + "Version": "0.4.3", + "Source": "Repository", + "Type": "Package", + "Title": "Axis Labeling", + "Date": "2023-08-29", + "Author": "Justin Talbot,", + "Maintainer": "Nuno Sempere ", + "Description": "Functions which provide a range of axis labeling algorithms.", + "License": "MIT + file LICENSE | Unlimited", + "Collate": "'labeling.R'", + "NeedsCompilation": "no", + "Imports": [ + "stats", + "graphics" + ], + "Repository": "RSPM", + "Encoding": "UTF-8" + }, + "labelled": { + "Package": "labelled", + "Version": "2.14.0", + "Source": "Repository", + "Type": "Package", + "Title": "Manipulating Labelled Data", + "Maintainer": "Joseph Larmarange ", + "Authors@R": "c( person(\"Joseph\", \"Larmarange\", email = \"joseph@larmarange.net\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0001-7097-700X\")), person(\"Daniel\", \"Ludecke\", role = \"ctb\"), person(\"Hadley\", \"Wickham\", role = \"ctb\"), person(\"Michal\", \"Bojanowski\", role = \"ctb\"), person(\"François\", \"Briatte\", role = \"ctb\") )", + "Description": "Work with labelled data imported from 'SPSS' or 'Stata' with 'haven' or 'foreign'. This package provides useful functions to deal with \"haven_labelled\" and \"haven_labelled_spss\" classes introduced by 'haven' package.", + "License": "GPL (>= 3)", + "Encoding": "UTF-8", + "Depends": [ + "R (>= 3.2)" + ], + "Imports": [ + "haven (>= 2.4.1)", + "cli", + "dplyr (>= 1.1.0)", + "lifecycle", + "rlang (>= 1.1.0)", + "vctrs", + "stringr", + "tidyr", + "tidyselect" + ], + "Suggests": [ + "testthat (>= 3.2.0)", + "knitr", + "rmarkdown", + "questionr", + "snakecase", + "spelling" + ], + "Enhances": [ + "memisc" + ], + "URL": "https://larmarange.github.io/labelled/, https://github.com/larmarange/labelled", + "BugReports": "https://github.com/larmarange/labelled/issues", + "VignetteBuilder": "knitr", + "LazyData": "true", + "RoxygenNote": "7.3.2", + "Language": "en-US", + "Config/testthat/edition": "3", + "Config/Needs/check": "memisc", + "NeedsCompilation": "no", + "Author": "Joseph Larmarange [aut, cre] (), Daniel Ludecke [ctb], Hadley Wickham [ctb], Michal Bojanowski [ctb], François Briatte [ctb]", + "Repository": "CRAN" + }, + "later": { + "Package": "later", + "Version": "1.4.1", + "Source": "Repository", + "Type": "Package", + "Title": "Utilities for Scheduling Functions to Execute Later with Event Loops", + "Authors@R": "c( person(\"Winston\", \"Chang\", role = c(\"aut\", \"cre\"), email = \"winston@posit.co\"), person(\"Joe\", \"Cheng\", role = c(\"aut\"), email = \"joe@posit.co\"), person(\"Charlie\", \"Gao\", role = c(\"aut\"), email = \"charlie.gao@shikokuchuo.net\", comment = c(ORCID = \"0000-0002-0750-061X\")), person(family = \"Posit Software, PBC\", role = \"cph\"), person(\"Marcus\", \"Geelnard\", role = c(\"ctb\", \"cph\"), comment = \"TinyCThread library, https://tinycthread.github.io/\"), person(\"Evan\", \"Nemerson\", role = c(\"ctb\", \"cph\"), comment = \"TinyCThread library, https://tinycthread.github.io/\") )", + "Description": "Executes arbitrary R or C functions some time after the current time, after the R execution stack has emptied. The functions are scheduled in an event loop.", + "URL": "https://r-lib.github.io/later/, https://github.com/r-lib/later", + "BugReports": "https://github.com/r-lib/later/issues", + "License": "MIT + file LICENSE", + "Imports": [ + "Rcpp (>= 0.12.9)", + "rlang" + ], + "LinkingTo": [ + "Rcpp" + ], + "RoxygenNote": "7.3.2", + "Suggests": [ + "knitr", + "nanonext", + "R6", + "rmarkdown", + "testthat (>= 2.1.0)" + ], + "VignetteBuilder": "knitr", + "Encoding": "UTF-8", + "NeedsCompilation": "yes", + "Author": "Winston Chang [aut, cre], Joe Cheng [aut], Charlie Gao [aut] (), Posit Software, PBC [cph], Marcus Geelnard [ctb, cph] (TinyCThread library, https://tinycthread.github.io/), Evan Nemerson [ctb, cph] (TinyCThread library, https://tinycthread.github.io/)", + "Maintainer": "Winston Chang ", + "Repository": "CRAN" + }, + "lattice": { + "Package": "lattice", + "Version": "0.22-6", + "Source": "Repository", + "Date": "2024-03-20", + "Priority": "recommended", + "Title": "Trellis Graphics for R", + "Authors@R": "c(person(\"Deepayan\", \"Sarkar\", role = c(\"aut\", \"cre\"), email = \"deepayan.sarkar@r-project.org\", comment = c(ORCID = \"0000-0003-4107-1553\")), person(\"Felix\", \"Andrews\", role = \"ctb\"), person(\"Kevin\", \"Wright\", role = \"ctb\", comment = \"documentation\"), person(\"Neil\", \"Klepeis\", role = \"ctb\"), person(\"Johan\", \"Larsson\", role = \"ctb\", comment = \"miscellaneous improvements\"), person(\"Zhijian (Jason)\", \"Wen\", role = \"cph\", comment = \"filled contour code\"), person(\"Paul\", \"Murrell\", role = \"ctb\", email = \"paul@stat.auckland.ac.nz\"), person(\"Stefan\", \"Eng\", role = \"ctb\", comment = \"violin plot improvements\"), person(\"Achim\", \"Zeileis\", role = \"ctb\", comment = \"modern colors\"), person(\"Alexandre\", \"Courtiol\", role = \"ctb\", comment = \"generics for larrows, lpolygon, lrect and lsegments\") )", + "Description": "A powerful and elegant high-level data visualization system inspired by Trellis graphics, with an emphasis on multivariate data. Lattice is sufficient for typical graphics needs, and is also flexible enough to handle most nonstandard requirements. See ?Lattice for an introduction.", + "Depends": [ + "R (>= 4.0.0)" + ], + "Suggests": [ + "KernSmooth", + "MASS", + "latticeExtra", + "colorspace" + ], + "Imports": [ + "grid", + "grDevices", + "graphics", + "stats", + "utils" + ], + "Enhances": [ + "chron", + "zoo" + ], + "LazyLoad": "yes", + "LazyData": "yes", + "License": "GPL (>= 2)", + "URL": "https://lattice.r-forge.r-project.org/", + "BugReports": "https://github.com/deepayan/lattice/issues", + "NeedsCompilation": "yes", + "Author": "Deepayan Sarkar [aut, cre] (), Felix Andrews [ctb], Kevin Wright [ctb] (documentation), Neil Klepeis [ctb], Johan Larsson [ctb] (miscellaneous improvements), Zhijian (Jason) Wen [cph] (filled contour code), Paul Murrell [ctb], Stefan Eng [ctb] (violin plot improvements), Achim Zeileis [ctb] (modern colors), Alexandre Courtiol [ctb] (generics for larrows, lpolygon, lrect and lsegments)", + "Maintainer": "Deepayan Sarkar ", + "Repository": "RSPM", + "Encoding": "UTF-8" + }, + "lazyeval": { + "Package": "lazyeval", + "Version": "0.2.2", + "Source": "Repository", + "Title": "Lazy (Non-Standard) Evaluation", + "Description": "An alternative approach to non-standard evaluation using formulas. Provides a full implementation of LISP style 'quasiquotation', making it easier to generate code with other code.", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", ,\"hadley@rstudio.com\", c(\"aut\", \"cre\")), person(\"RStudio\", role = \"cph\") )", + "License": "GPL-3", + "LazyData": "true", + "Depends": [ + "R (>= 3.1.0)" + ], + "Suggests": [ + "knitr", + "rmarkdown (>= 0.2.65)", + "testthat", + "covr" + ], + "VignetteBuilder": "knitr", + "RoxygenNote": "6.1.1", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [aut, cre], RStudio [cph]", + "Maintainer": "Hadley Wickham ", + "Repository": "RSPM", + "Encoding": "UTF-8" + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.4", + "Source": "Repository", + "Title": "Manage the Life Cycle of your Package Functions", + "Authors@R": "c( person(\"Lionel\", \"Henry\", , \"lionel@posit.co\", role = c(\"aut\", \"cre\")), person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0003-4757-117X\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Manage the life cycle of your exported functions with shared conventions, documentation badges, and user-friendly deprecation warnings.", + "License": "MIT + file LICENSE", + "URL": "https://lifecycle.r-lib.org/, https://github.com/r-lib/lifecycle", + "BugReports": "https://github.com/r-lib/lifecycle/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "cli (>= 3.4.0)", + "glue", + "rlang (>= 1.1.0)" + ], + "Suggests": [ + "covr", + "crayon", + "knitr", + "lintr", + "rmarkdown", + "testthat (>= 3.0.1)", + "tibble", + "tidyverse", + "tools", + "vctrs", + "withr" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate, usethis", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.1", + "NeedsCompilation": "no", + "Author": "Lionel Henry [aut, cre], Hadley Wickham [aut] (), Posit Software, PBC [cph, fnd]", + "Maintainer": "Lionel Henry ", + "Repository": "RSPM" + }, + "lmom": { + "Package": "lmom", + "Version": "3.2", + "Source": "Repository", + "Date": "2024-09-29", + "Title": "L-Moments", + "Author": "J. R. M. Hosking [aut, cre]", + "Maintainer": "J. R. M. Hosking ", + "Authors@R": "person(given = c(\"J.\", \"R.\", \"M.\"), family = \"Hosking\", role = c(\"aut\", \"cre\"), email = \"jrmhosking@gmail.com\")", + "Description": "Functions related to L-moments: computation of L-moments and trimmed L-moments of distributions and data samples; parameter estimation; L-moment ratio diagram; plot vs. quantiles of an extreme-value distribution.", + "Depends": [ + "R (>= 3.0.0)" + ], + "Imports": [ + "stats", + "graphics" + ], + "License": "Common Public License Version 1.0", + "NeedsCompilation": "yes", + "Repository": "CRAN" + }, + "logger": { + "Package": "logger", + "Version": "0.4.0", + "Source": "Repository", + "Type": "Package", + "Title": "A Lightweight, Modern and Flexible Logging Utility", + "Date": "2024-10-19", + "Authors@R": "c( person(\"Gergely\", \"Daróczi\", , \"daroczig@rapporter.net\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0003-3149-8537\")), person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0003-4757-117X\")), person(\"System1\", role = \"fnd\") )", + "Description": "Inspired by the the 'futile.logger' R package and 'logging' Python module, this utility provides a flexible and extensible way of formatting and delivering log messages with low overhead.", + "License": "MIT + file LICENSE", + "URL": "https://daroczig.github.io/logger/", + "BugReports": "https://github.com/daroczig/logger/issues", + "Depends": [ + "R (>= 4.0.0)" + ], + "Imports": [ + "utils" + ], + "Suggests": [ + "botor", + "covr", + "crayon", + "devtools", + "glue", + "jsonlite", + "knitr", + "mirai (>= 1.3.0)", + "pander", + "parallel", + "R.utils", + "rmarkdown", + "roxygen2", + "RPushbullet", + "rsyslog", + "shiny", + "slackr (>= 1.4.1)", + "syslognet", + "telegram", + "testthat (>= 3.0.0)", + "withr" + ], + "Enhances": [ + "futile.logger", + "log4r", + "logging" + ], + "VignetteBuilder": "knitr", + "Config/testthat/edition": "3", + "Config/testthat/parallel": "TRUE", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "no", + "Author": "Gergely Daróczi [aut, cre] (), Hadley Wickham [aut] (), System1 [fnd]", + "Maintainer": "Gergely Daróczi ", + "Repository": "CRAN" + }, + "magrittr": { + "Package": "magrittr", + "Version": "2.0.3", + "Source": "Repository", + "Type": "Package", + "Title": "A Forward-Pipe Operator for R", + "Authors@R": "c( person(\"Stefan Milton\", \"Bache\", , \"stefan@stefanbache.dk\", role = c(\"aut\", \"cph\"), comment = \"Original author and creator of magrittr\"), person(\"Hadley\", \"Wickham\", , \"hadley@rstudio.com\", role = \"aut\"), person(\"Lionel\", \"Henry\", , \"lionel@rstudio.com\", role = \"cre\"), person(\"RStudio\", role = c(\"cph\", \"fnd\")) )", + "Description": "Provides a mechanism for chaining commands with a new forward-pipe operator, %>%. This operator will forward a value, or the result of an expression, into the next function call/expression. There is flexible support for the type of right-hand side expressions. For more information, see package vignette. To quote Rene Magritte, \"Ceci n'est pas un pipe.\"", + "License": "MIT + file LICENSE", + "URL": "https://magrittr.tidyverse.org, https://github.com/tidyverse/magrittr", + "BugReports": "https://github.com/tidyverse/magrittr/issues", + "Depends": [ + "R (>= 3.4.0)" + ], + "Suggests": [ + "covr", + "knitr", + "rlang", + "rmarkdown", + "testthat" + ], + "VignetteBuilder": "knitr", + "ByteCompile": "Yes", + "Config/Needs/website": "tidyverse/tidytemplate", + "Encoding": "UTF-8", + "RoxygenNote": "7.1.2", + "NeedsCompilation": "yes", + "Author": "Stefan Milton Bache [aut, cph] (Original author and creator of magrittr), Hadley Wickham [aut], Lionel Henry [cre], RStudio [cph, fnd]", + "Maintainer": "Lionel Henry ", + "Repository": "CRAN" + }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Title": "'Memoisation' of Functions", + "Authors@R": "c(person(given = \"Hadley\", family = \"Wickham\", role = \"aut\", email = \"hadley@rstudio.com\"), person(given = \"Jim\", family = \"Hester\", role = \"aut\"), person(given = \"Winston\", family = \"Chang\", role = c(\"aut\", \"cre\"), email = \"winston@rstudio.com\"), person(given = \"Kirill\", family = \"Müller\", role = \"aut\", email = \"krlmlr+r@mailbox.org\"), person(given = \"Daniel\", family = \"Cook\", role = \"aut\", email = \"danielecook@gmail.com\"), person(given = \"Mark\", family = \"Edmondson\", role = \"ctb\", email = \"r@sunholo.com\"))", + "Description": "Cache the results of a function so that when you call it again with the same arguments it returns the previously computed value.", + "License": "MIT + file LICENSE", + "URL": "https://memoise.r-lib.org, https://github.com/r-lib/memoise", + "BugReports": "https://github.com/r-lib/memoise/issues", + "Imports": [ + "rlang (>= 0.4.10)", + "cachem" + ], + "Suggests": [ + "digest", + "aws.s3", + "covr", + "googleAuthR", + "googleCloudStorageR", + "httr", + "testthat" + ], + "Encoding": "UTF-8", + "RoxygenNote": "7.1.2", + "NeedsCompilation": "no", + "Author": "Hadley Wickham [aut], Jim Hester [aut], Winston Chang [aut, cre], Kirill Müller [aut], Daniel Cook [aut], Mark Edmondson [ctb]", + "Maintainer": "Winston Chang ", + "Repository": "RSPM" + }, + "mgcv": { + "Package": "mgcv", + "Version": "1.9-1", + "Source": "Repository", + "Author": "Simon Wood ", + "Maintainer": "Simon Wood ", + "Title": "Mixed GAM Computation Vehicle with Automatic Smoothness Estimation", + "Description": "Generalized additive (mixed) models, some of their extensions and other generalized ridge regression with multiple smoothing parameter estimation by (Restricted) Marginal Likelihood, Generalized Cross Validation and similar, or using iterated nested Laplace approximation for fully Bayesian inference. See Wood (2017) for an overview. Includes a gam() function, a wide variety of smoothers, 'JAGS' support and distributions beyond the exponential family.", + "Priority": "recommended", + "Depends": [ + "R (>= 3.6.0)", + "nlme (>= 3.1-64)" + ], + "Imports": [ + "methods", + "stats", + "graphics", + "Matrix", + "splines", + "utils" + ], + "Suggests": [ + "parallel", + "survival", + "MASS" + ], + "LazyLoad": "yes", + "ByteCompile": "yes", + "License": "GPL (>= 2)", + "NeedsCompilation": "yes", + "Repository": "RSPM", + "Encoding": "UTF-8" + }, + "mime": { + "Package": "mime", + "Version": "0.12", + "Source": "Repository", + "Type": "Package", + "Title": "Map Filenames to MIME Types", + "Authors@R": "c( person(\"Yihui\", \"Xie\", role = c(\"aut\", \"cre\"), email = \"xie@yihui.name\", comment = c(ORCID = \"0000-0003-0645-5666\")), person(\"Jeffrey\", \"Horner\", role = \"ctb\"), person(\"Beilei\", \"Bian\", role = \"ctb\") )", + "Description": "Guesses the MIME type from a filename extension using the data derived from /etc/mime.types in UNIX-type systems.", + "Imports": [ + "tools" + ], + "License": "GPL", + "URL": "https://github.com/yihui/mime", + "BugReports": "https://github.com/yihui/mime/issues", + "RoxygenNote": "7.1.1", + "Encoding": "UTF-8", + "NeedsCompilation": "yes", + "Author": "Yihui Xie [aut, cre] (), Jeffrey Horner [ctb], Beilei Bian [ctb]", + "Maintainer": "Yihui Xie ", + "Repository": "RSPM" + }, + "munsell": { + "Package": "munsell", + "Version": "0.5.1", + "Source": "Repository", + "Type": "Package", + "Title": "Utilities for Using Munsell Colours", + "Author": "Charlotte Wickham ", + "Maintainer": "Charlotte Wickham ", + "Description": "Provides easy access to, and manipulation of, the Munsell colours. Provides a mapping between Munsell's original notation (e.g. \"5R 5/10\") and hexadecimal strings suitable for use directly in R graphics. Also provides utilities to explore slices through the Munsell colour tree, to transform Munsell colours and display colour palettes.", + "Suggests": [ + "ggplot2", + "testthat" + ], + "Imports": [ + "colorspace", + "methods" + ], + "License": "MIT + file LICENSE", + "URL": "https://cran.r-project.org/package=munsell, https://github.com/cwickham/munsell/", + "RoxygenNote": "7.3.1", + "Encoding": "UTF-8", + "BugReports": "https://github.com/cwickham/munsell/issues", + "NeedsCompilation": "no", + "Repository": "RSPM" + }, + "mvtnorm": { + "Package": "mvtnorm", + "Version": "1.3-3", + "Source": "Repository", + "Title": "Multivariate Normal and t Distributions", + "Date": "2025-01-09", + "Authors@R": "c(person(\"Alan\", \"Genz\", role = \"aut\"), person(\"Frank\", \"Bretz\", role = \"aut\"), person(\"Tetsuhisa\", \"Miwa\", role = \"aut\"), person(\"Xuefei\", \"Mi\", role = \"aut\"), person(\"Friedrich\", \"Leisch\", role = \"ctb\"), person(\"Fabian\", \"Scheipl\", role = \"ctb\"), person(\"Bjoern\", \"Bornkamp\", role = \"ctb\", comment = c(ORCID = \"0000-0002-6294-8185\")), person(\"Martin\", \"Maechler\", role = \"ctb\", comment = c(ORCID = \"0000-0002-8685-9910\")), person(\"Torsten\", \"Hothorn\", role = c(\"aut\", \"cre\"), email = \"Torsten.Hothorn@R-project.org\", comment = c(ORCID = \"0000-0001-8301-0471\")))", + "Description": "Computes multivariate normal and t probabilities, quantiles, random deviates, and densities. Log-likelihoods for multivariate Gaussian models and Gaussian copulae parameterised by Cholesky factors of covariance or precision matrices are implemented for interval-censored and exact data, or a mix thereof. Score functions for these log-likelihoods are available. A class representing multiple lower triangular matrices and corresponding methods are part of this package.", + "Imports": [ + "stats" + ], + "Depends": [ + "R(>= 3.5.0)" + ], + "Suggests": [ + "qrng", + "numDeriv" + ], + "License": "GPL-2", + "URL": "http://mvtnorm.R-forge.R-project.org", + "NeedsCompilation": "yes", + "Author": "Alan Genz [aut], Frank Bretz [aut], Tetsuhisa Miwa [aut], Xuefei Mi [aut], Friedrich Leisch [ctb], Fabian Scheipl [ctb], Bjoern Bornkamp [ctb] (), Martin Maechler [ctb] (), Torsten Hothorn [aut, cre] ()", + "Maintainer": "Torsten Hothorn ", + "Repository": "CRAN" + }, + "nlme": { + "Package": "nlme", + "Version": "3.1-167", + "Source": "Repository", + "Date": "2025-01-27", + "Priority": "recommended", + "Title": "Linear and Nonlinear Mixed Effects Models", + "Authors@R": "c(person(\"José\", \"Pinheiro\", role = \"aut\", comment = \"S version\"), person(\"Douglas\", \"Bates\", role = \"aut\", comment = \"up to 2007\"), person(\"Saikat\", \"DebRoy\", role = \"ctb\", comment = \"up to 2002\"), person(\"Deepayan\", \"Sarkar\", role = \"ctb\", comment = \"up to 2005\"), person(\"EISPACK authors\", role = \"ctb\", comment = \"src/rs.f\"), person(\"Siem\", \"Heisterkamp\", role = \"ctb\", comment = \"Author fixed sigma\"), person(\"Bert\", \"Van Willigen\",role = \"ctb\", comment = \"Programmer fixed sigma\"), person(\"Johannes\", \"Ranke\", role = \"ctb\", comment = \"varConstProp()\"), person(\"R Core Team\", email = \"R-core@R-project.org\", role = c(\"aut\", \"cre\"), comment = c(ROR = \"02zz1nj61\")))", + "Contact": "see 'MailingList'", + "Description": "Fit and compare Gaussian linear and nonlinear mixed-effects models.", + "Depends": [ + "R (>= 3.6.0)" + ], + "Imports": [ + "graphics", + "stats", + "utils", + "lattice" + ], + "Suggests": [ + "MASS", + "SASmixed" + ], + "LazyData": "yes", + "Encoding": "UTF-8", + "License": "GPL (>= 2)", + "BugReports": "https://bugs.r-project.org", + "MailingList": "R-help@r-project.org", + "URL": "https://svn.r-project.org/R-packages/trunk/nlme/", + "NeedsCompilation": "yes", + "Author": "José Pinheiro [aut] (S version), Douglas Bates [aut] (up to 2007), Saikat DebRoy [ctb] (up to 2002), Deepayan Sarkar [ctb] (up to 2005), EISPACK authors [ctb] (src/rs.f), Siem Heisterkamp [ctb] (Author fixed sigma), Bert Van Willigen [ctb] (Programmer fixed sigma), Johannes Ranke [ctb] (varConstProp()), R Core Team [aut, cre] (02zz1nj61)", + "Maintainer": "R Core Team ", + "Repository": "CRAN" + }, + "officer": { + "Package": "officer", + "Version": "0.6.7", + "Source": "Repository", + "Type": "Package", + "Title": "Manipulation of Microsoft Word and PowerPoint Documents", + "Authors@R": "c( person(\"David\", \"Gohel\", , \"david.gohel@ardata.fr\", role = c(\"aut\", \"cre\")), person(\"Stefan\", \"Moog\", , \"moogs@gmx.de\", role = \"aut\"), person(\"Mark\", \"Heckmann\", , \"heckmann.mark@gmail.com\", role = \"aut\", comment = c(ORCID = \"0000-0002-0736-7417\")), person(\"ArData\", role = \"cph\"), person(\"Frank\", \"Hangler\", , \"frank@plotandscatter.com\", role = \"ctb\", comment = \"function body_replace_all_text\"), person(\"Liz\", \"Sander\", , \"lsander@civisanalytics.com\", role = \"ctb\", comment = \"several documentation fixes\"), person(\"Anton\", \"Victorson\", , \"anton@victorson.se\", role = \"ctb\", comment = \"fixes xml structures\"), person(\"Jon\", \"Calder\", , \"jonmcalder@gmail.com\", role = \"ctb\", comment = \"update vignettes\"), person(\"John\", \"Harrold\", , \"john.m.harrold@gmail.com\", role = \"ctb\", comment = \"function annotate_base\"), person(\"John\", \"Muschelli\", , \"muschellij2@gmail.com\", role = \"ctb\", comment = \"google doc compatibility\"), person(\"Bill\", \"Denney\", , \"wdenney@humanpredictions.com\", role = \"ctb\", comment = c(ORCID = \"0000-0002-5759-428X\", \"function as.matrix.rpptx\")), person(\"Nikolai\", \"Beck\", , \"beck.nikolai@gmail.com\", role = \"ctb\", comment = \"set speaker notes for .pptx documents\"), person(\"Greg\", \"Leleu\", , \"gregoire.leleu@gmail.com\", role = \"ctb\", comment = \"fields functionality in ppt\"), person(\"Majid\", \"Eismann\", role = \"ctb\"), person(\"Hongyuan\", \"Jia\", , \"hongyuanjia@cqust.edu.cn\", role = \"ctb\", comment = c(ORCID = \"0000-0002-0075-8183\")) )", + "Description": "Access and manipulate 'Microsoft Word', 'RTF' and 'Microsoft PowerPoint' documents from R. The package focuses on tabular and graphical reporting from R; it also provides two functions that let users get document content into data objects. A set of functions lets add and remove images, tables and paragraphs of text in new or existing documents. The package does not require any installation of Microsoft products to be able to write Microsoft files.", + "License": "MIT + file LICENSE", + "URL": "https://ardata-fr.github.io/officeverse/, https://davidgohel.github.io/officer/", + "BugReports": "https://github.com/davidgohel/officer/issues", + "Imports": [ + "cli", + "graphics", + "grDevices", + "openssl", + "R6", + "ragg", + "stats", + "utils", + "uuid", + "xml2 (>= 1.1.0)", + "zip (>= 2.1.0)" + ], + "Suggests": [ + "devEMF", + "doconv (>= 0.3.0)", + "ggplot2", + "knitr", + "magick", + "rmarkdown", + "rsvg", + "testthat" + ], + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "no", + "Author": "David Gohel [aut, cre], Stefan Moog [aut], Mark Heckmann [aut] (), ArData [cph], Frank Hangler [ctb] (function body_replace_all_text), Liz Sander [ctb] (several documentation fixes), Anton Victorson [ctb] (fixes xml structures), Jon Calder [ctb] (update vignettes), John Harrold [ctb] (function annotate_base), John Muschelli [ctb] (google doc compatibility), Bill Denney [ctb] (, function as.matrix.rpptx), Nikolai Beck [ctb] (set speaker notes for .pptx documents), Greg Leleu [ctb] (fields functionality in ppt), Majid Eismann [ctb], Hongyuan Jia [ctb] ()", + "Maintainer": "David Gohel ", + "Repository": "CRAN" + }, + "openssl": { + "Package": "openssl", + "Version": "2.3.2", + "Source": "Repository", + "Type": "Package", + "Title": "Toolkit for Encryption, Signatures and Certificates Based on OpenSSL", + "Authors@R": "c(person(\"Jeroen\", \"Ooms\", role = c(\"aut\", \"cre\"), email = \"jeroenooms@gmail.com\", comment = c(ORCID = \"0000-0002-4035-0289\")), person(\"Oliver\", \"Keyes\", role = \"ctb\"))", + "Description": "Bindings to OpenSSL libssl and libcrypto, plus custom SSH key parsers. Supports RSA, DSA and EC curves P-256, P-384, P-521, and curve25519. Cryptographic signatures can either be created and verified manually or via x509 certificates. AES can be used in cbc, ctr or gcm mode for symmetric encryption; RSA for asymmetric (public key) encryption or EC for Diffie Hellman. High-level envelope functions combine RSA and AES for encrypting arbitrary sized data. Other utilities include key generators, hash functions (md5, sha1, sha256, etc), base64 encoder, a secure random number generator, and 'bignum' math methods for manually performing crypto calculations on large multibyte integers.", + "License": "MIT + file LICENSE", + "URL": "https://jeroen.r-universe.dev/openssl", + "BugReports": "https://github.com/jeroen/openssl/issues", + "SystemRequirements": "OpenSSL >= 1.0.2", + "VignetteBuilder": "knitr", + "Imports": [ + "askpass" + ], + "Suggests": [ + "curl", + "testthat (>= 2.1.0)", + "digest", + "knitr", + "rmarkdown", + "jsonlite", + "jose", + "sodium" + ], + "RoxygenNote": "7.3.2", + "Encoding": "UTF-8", + "NeedsCompilation": "yes", + "Author": "Jeroen Ooms [aut, cre] (), Oliver Keyes [ctb]", + "Maintainer": "Jeroen Ooms ", + "Repository": "CRAN" + }, + "osprey": { + "Package": "osprey", + "Version": "0.1.16.9018", + "Source": "Repository", + "Type": "Package", + "Title": "R Package to Create TLGs", + "Date": "2025-01-31", + "Authors@R": "c( person(\"Nina\", \"Qi\", , \"qit3@gene.com\", role = c(\"aut\", \"cre\")), person(\"Dawid\", \"Kaledkowski\", , \"dawid.kaledkowski@roche.com\", role = \"aut\"), person(\"Chendi\", \"Liao\", , \"chendi.liao@roche.com\", role = \"aut\"), person(\"Liming\", \"Li\", , \"liming.li@roche.com\", role = \"aut\"), person(\"F. Hoffmann-La Roche AG\", role = c(\"cph\", \"fnd\")), person(\"Molly\", \"He\", role = \"ctb\"), person(\"Carolyn\", \"Zhang\", role = \"ctb\"), person(\"Tina\", \"Cho\", role = \"ctb\") )", + "Description": "Community effort to collect TLG code and create a catalogue.", + "License": "Apache License 2.0 | file LICENSE", + "URL": "https://insightsengineering.github.io/osprey/, https://github.com/insightsengineering/osprey/", + "BugReports": "https://github.com/insightsengineering/osprey/issues", + "Depends": [ + "dplyr (>= 0.8.0)", + "ggplot2 (>= 3.5.0)", + "R (>= 3.6)" + ], + "Imports": [ + "checkmate (>= 2.1.0)", + "cowplot", + "DescTools (>= 0.99.53)", + "grDevices", + "grid", + "gridExtra", + "gtable (>= 0.3.4)", + "methods", + "rlang (>= 1.1.0)", + "stats", + "stringr (>= 1.4.1)", + "tibble (>= 2.0.0)", + "tidyr (>= 1.0.0)" + ], + "Suggests": [ + "knitr (>= 1.42)", + "nestcolor (>= 0.1.0)", + "rmarkdown (>= 2.23)", + "tern (>= 0.7.10)", + "testthat (>= 2.0)" + ], + "Config/Needs/verdepcheck": "tidyverse/dplyr, tidyverse/ggplot2, mllg/checkmate, wilkelab/cowplot, AndriSignorell/DescTools, baptiste/gridExtra, r-lib/gtable, r-lib/rlang, tidyverse/stringr, tidyverse/tibble, tidyverse/tidyr, yihui/knitr, insightsengineering/nestcolor, rstudio/rmarkdown, insightsengineering/tern, r-lib/testthat", + "Config/Needs/website": "insightsengineering/nesttemplate", + "Encoding": "UTF-8", + "Language": "en-US", + "LazyData": "true", + "Roxygen": "list(markdown = TRUE)", + "RoxygenNote": "7.3.2", + "Config/pak/sysreqs": "make libicu-dev libssl-dev libx11-dev zlib1g-dev", + "Repository": "https://pharmaverse.r-universe.dev", + "RemoteUrl": "https://github.com/insightsengineering/osprey", + "RemoteRef": "HEAD", + "RemoteSha": "eff27e6d997cf23a13d9c3e7d0134d88afebff45", + "NeedsCompilation": "no", + "Author": "Nina Qi [aut, cre], Dawid Kaledkowski [aut], Chendi Liao [aut], Liming Li [aut], F. Hoffmann-La Roche AG [cph, fnd], Molly He [ctb], Carolyn Zhang [ctb], Tina Cho [ctb]", + "Maintainer": "Nina Qi " + }, + "pillar": { + "Package": "pillar", + "Version": "1.10.1", + "Source": "Repository", + "Title": "Coloured Formatting for Columns", + "Authors@R": "c(person(given = \"Kirill\", family = \"M\\u00fcller\", role = c(\"aut\", \"cre\"), email = \"kirill@cynkra.com\", comment = c(ORCID = \"0000-0002-1416-3412\")), person(given = \"Hadley\", family = \"Wickham\", role = \"aut\"), person(given = \"RStudio\", role = \"cph\"))", + "Description": "Provides 'pillar' and 'colonnade' generics designed for formatting columns of data using the full range of colours provided by modern terminals.", + "License": "MIT + file LICENSE", + "URL": "https://pillar.r-lib.org/, https://github.com/r-lib/pillar", + "BugReports": "https://github.com/r-lib/pillar/issues", + "Imports": [ + "cli (>= 2.3.0)", + "glue", + "lifecycle", + "rlang (>= 1.0.2)", + "utf8 (>= 1.1.0)", + "utils", + "vctrs (>= 0.5.0)" + ], + "Suggests": [ + "bit64", + "DBI", + "debugme", + "DiagrammeR", + "dplyr", + "formattable", + "ggplot2", + "knitr", + "lubridate", + "nanotime", + "nycflights13", + "palmerpenguins", + "rmarkdown", + "scales", + "stringi", + "survival", + "testthat (>= 3.1.1)", + "tibble", + "units (>= 0.7.2)", + "vdiffr", + "withr" + ], + "VignetteBuilder": "knitr", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2.9000", + "Config/testthat/edition": "3", + "Config/testthat/parallel": "true", + "Config/testthat/start-first": "format_multi_fuzz, format_multi_fuzz_2, format_multi, ctl_colonnade, ctl_colonnade_1, ctl_colonnade_2", + "Config/autostyle/scope": "line_breaks", + "Config/autostyle/strict": "true", + "Config/gha/extra-packages": "DiagrammeR=?ignore-before-r=3.5.0", + "Config/Needs/website": "tidyverse/tidytemplate", + "NeedsCompilation": "no", + "Author": "Kirill Müller [aut, cre] (), Hadley Wickham [aut], RStudio [cph]", + "Maintainer": "Kirill Müller ", + "Repository": "CRAN" + }, + "pkgbuild": { + "Package": "pkgbuild", + "Version": "1.4.6", + "Source": "Repository", + "Title": "Find Tools Needed to Build R Packages", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", role = \"aut\"), person(\"Jim\", \"Hester\", role = \"aut\"), person(\"Gábor\", \"Csárdi\", , \"csardi.gabor@gmail.com\", role = c(\"aut\", \"cre\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Provides functions used to build R packages. Locates compilers needed to build R packages on various platforms and ensures the PATH is configured appropriately so R can use them.", + "License": "MIT + file LICENSE", + "URL": "https://github.com/r-lib/pkgbuild, https://pkgbuild.r-lib.org", + "BugReports": "https://github.com/r-lib/pkgbuild/issues", + "Depends": [ + "R (>= 3.5)" + ], + "Imports": [ + "callr (>= 3.2.0)", + "cli (>= 3.4.0)", + "desc", + "processx", + "R6" + ], + "Suggests": [ + "covr", + "cpp11", + "knitr", + "Rcpp", + "rmarkdown", + "testthat (>= 3.2.0)", + "withr (>= 2.3.0)" + ], + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "no", + "Author": "Hadley Wickham [aut], Jim Hester [aut], Gábor Csárdi [aut, cre], Posit Software, PBC [cph, fnd]", + "Maintainer": "Gábor Csárdi ", + "Repository": "CRAN" + }, + "pkgconfig": { + "Package": "pkgconfig", + "Version": "2.0.3", + "Source": "Repository", + "Title": "Private Configuration for 'R' Packages", + "Author": "Gábor Csárdi", + "Maintainer": "Gábor Csárdi ", + "Description": "Set configuration options on a per-package basis. Options set by a given package only apply to that package, other packages are unaffected.", + "License": "MIT + file LICENSE", + "LazyData": "true", + "Imports": [ + "utils" + ], + "Suggests": [ + "covr", + "testthat", + "disposables (>= 1.0.3)" + ], + "URL": "https://github.com/r-lib/pkgconfig#readme", + "BugReports": "https://github.com/r-lib/pkgconfig/issues", + "Encoding": "UTF-8", + "NeedsCompilation": "no", + "Repository": "RSPM" + }, + "pkgload": { + "Package": "pkgload", + "Version": "1.4.0", + "Source": "Repository", + "Title": "Simulate Package Installation and Attach", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", role = \"aut\"), person(\"Winston\", \"Chang\", role = \"aut\"), person(\"Jim\", \"Hester\", role = \"aut\"), person(\"Lionel\", \"Henry\", , \"lionel@posit.co\", role = c(\"aut\", \"cre\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")), person(\"R Core team\", role = \"ctb\", comment = \"Some namespace and vignette code extracted from base R\") )", + "Description": "Simulates the process of installing a package and then attaching it. This is a key part of the 'devtools' package as it allows you to rapidly iterate while developing a package.", + "License": "GPL-3", + "URL": "https://github.com/r-lib/pkgload, https://pkgload.r-lib.org", + "BugReports": "https://github.com/r-lib/pkgload/issues", + "Depends": [ + "R (>= 3.4.0)" + ], + "Imports": [ + "cli (>= 3.3.0)", + "desc", + "fs", + "glue", + "lifecycle", + "methods", + "pkgbuild", + "processx", + "rlang (>= 1.1.1)", + "rprojroot", + "utils", + "withr (>= 2.4.3)" + ], + "Suggests": [ + "bitops", + "jsonlite", + "mathjaxr", + "pak", + "Rcpp", + "remotes", + "rstudioapi", + "testthat (>= 3.2.1.1)", + "usethis" + ], + "Config/Needs/website": "tidyverse/tidytemplate, ggplot2", + "Config/testthat/edition": "3", + "Config/testthat/parallel": "TRUE", + "Config/testthat/start-first": "dll", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.1", + "NeedsCompilation": "no", + "Author": "Hadley Wickham [aut], Winston Chang [aut], Jim Hester [aut], Lionel Henry [aut, cre], Posit Software, PBC [cph, fnd], R Core team [ctb] (Some namespace and vignette code extracted from base R)", + "Maintainer": "Lionel Henry ", + "Repository": "RSPM" + }, + "plotly": { + "Package": "plotly", + "Version": "4.10.4", + "Source": "Repository", + "Title": "Create Interactive Web Graphics via 'plotly.js'", + "Authors@R": "c(person(\"Carson\", \"Sievert\", role = c(\"aut\", \"cre\"), email = \"cpsievert1@gmail.com\", comment = c(ORCID = \"0000-0002-4958-2844\")), person(\"Chris\", \"Parmer\", role = \"aut\", email = \"chris@plot.ly\"), person(\"Toby\", \"Hocking\", role = \"aut\", email = \"tdhock5@gmail.com\"), person(\"Scott\", \"Chamberlain\", role = \"aut\", email = \"myrmecocystus@gmail.com\"), person(\"Karthik\", \"Ram\", role = \"aut\", email = \"karthik.ram@gmail.com\"), person(\"Marianne\", \"Corvellec\", role = \"aut\", email = \"marianne.corvellec@igdore.org\", comment = c(ORCID = \"0000-0002-1994-3581\")), person(\"Pedro\", \"Despouy\", role = \"aut\", email = \"pedro@plot.ly\"), person(\"Salim\", \"Brüggemann\", role = \"ctb\", email = \"salim-b@pm.me\", comment = c(ORCID = \"0000-0002-5329-5987\")), person(\"Plotly Technologies Inc.\", role = \"cph\"))", + "License": "MIT + file LICENSE", + "Description": "Create interactive web graphics from 'ggplot2' graphs and/or a custom interface to the (MIT-licensed) JavaScript library 'plotly.js' inspired by the grammar of graphics.", + "URL": "https://plotly-r.com, https://github.com/plotly/plotly.R, https://plotly.com/r/", + "BugReports": "https://github.com/plotly/plotly.R/issues", + "Depends": [ + "R (>= 3.2.0)", + "ggplot2 (>= 3.0.0)" + ], + "Imports": [ + "tools", + "scales", + "httr (>= 1.3.0)", + "jsonlite (>= 1.6)", + "magrittr", + "digest", + "viridisLite", + "base64enc", + "htmltools (>= 0.3.6)", + "htmlwidgets (>= 1.5.2.9001)", + "tidyr (>= 1.0.0)", + "RColorBrewer", + "dplyr", + "vctrs", + "tibble", + "lazyeval (>= 0.2.0)", + "rlang (>= 0.4.10)", + "crosstalk", + "purrr", + "data.table", + "promises" + ], + "Suggests": [ + "MASS", + "maps", + "hexbin", + "ggthemes", + "GGally", + "ggalluvial", + "testthat", + "knitr", + "shiny (>= 1.1.0)", + "shinytest (>= 1.3.0)", + "curl", + "rmarkdown", + "Cairo", + "broom", + "webshot", + "listviewer", + "dendextend", + "sf", + "png", + "IRdisplay", + "processx", + "plotlyGeoAssets", + "forcats", + "withr", + "palmerpenguins", + "rversions", + "reticulate", + "rsvg" + ], + "LazyData": "true", + "RoxygenNote": "7.2.3", + "Encoding": "UTF-8", + "Config/Needs/check": "tidyverse/ggplot2, rcmdcheck, devtools, reshape2", + "NeedsCompilation": "no", + "Author": "Carson Sievert [aut, cre] (), Chris Parmer [aut], Toby Hocking [aut], Scott Chamberlain [aut], Karthik Ram [aut], Marianne Corvellec [aut] (), Pedro Despouy [aut], Salim Brüggemann [ctb] (), Plotly Technologies Inc. [cph]", + "Maintainer": "Carson Sievert ", + "Repository": "CRAN" + }, + "prettyunits": { + "Package": "prettyunits", + "Version": "1.2.0", + "Source": "Repository", + "Title": "Pretty, Human Readable Formatting of Quantities", + "Authors@R": "c( person(\"Gabor\", \"Csardi\", email=\"csardi.gabor@gmail.com\", role=c(\"aut\", \"cre\")), person(\"Bill\", \"Denney\", email=\"wdenney@humanpredictions.com\", role=c(\"ctb\"), comment=c(ORCID=\"0000-0002-5759-428X\")), person(\"Christophe\", \"Regouby\", email=\"christophe.regouby@free.fr\", role=c(\"ctb\")) )", + "Description": "Pretty, human readable formatting of quantities. Time intervals: '1337000' -> '15d 11h 23m 20s'. Vague time intervals: '2674000' -> 'about a month ago'. Bytes: '1337' -> '1.34 kB'. Rounding: '99' with 3 significant digits -> '99.0' p-values: '0.00001' -> '<0.0001'. Colors: '#FF0000' -> 'red'. Quantities: '1239437' -> '1.24 M'.", + "License": "MIT + file LICENSE", + "URL": "https://github.com/r-lib/prettyunits", + "BugReports": "https://github.com/r-lib/prettyunits/issues", + "Depends": [ + "R(>= 2.10)" + ], + "Suggests": [ + "codetools", + "covr", + "testthat" + ], + "RoxygenNote": "7.2.3", + "Encoding": "UTF-8", + "NeedsCompilation": "no", + "Author": "Gabor Csardi [aut, cre], Bill Denney [ctb] (), Christophe Regouby [ctb]", + "Maintainer": "Gabor Csardi ", + "Repository": "RSPM" + }, + "processx": { + "Package": "processx", + "Version": "3.8.5", + "Source": "Repository", + "Title": "Execute and Control System Processes", + "Authors@R": "c( person(\"Gábor\", \"Csárdi\", , \"csardi.gabor@gmail.com\", role = c(\"aut\", \"cre\", \"cph\"), comment = c(ORCID = \"0000-0001-7098-9676\")), person(\"Winston\", \"Chang\", role = \"aut\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")), person(\"Ascent Digital Services\", role = c(\"cph\", \"fnd\")) )", + "Description": "Tools to run system processes in the background. It can check if a background process is running; wait on a background process to finish; get the exit status of finished processes; kill background processes. It can read the standard output and error of the processes, using non-blocking connections. 'processx' can poll a process for standard output or error, with a timeout. It can also poll several processes at once.", + "License": "MIT + file LICENSE", + "URL": "https://processx.r-lib.org, https://github.com/r-lib/processx", + "BugReports": "https://github.com/r-lib/processx/issues", + "Depends": [ + "R (>= 3.4.0)" + ], + "Imports": [ + "ps (>= 1.2.0)", + "R6", + "utils" + ], + "Suggests": [ + "callr (>= 3.7.3)", + "cli (>= 3.3.0)", + "codetools", + "covr", + "curl", + "debugme", + "parallel", + "rlang (>= 1.0.2)", + "testthat (>= 3.0.0)", + "webfakes", + "withr" + ], + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.1.9000", + "NeedsCompilation": "yes", + "Author": "Gábor Csárdi [aut, cre, cph] (), Winston Chang [aut], Posit Software, PBC [cph, fnd], Ascent Digital Services [cph, fnd]", + "Maintainer": "Gábor Csárdi ", + "Repository": "CRAN" + }, + "progress": { + "Package": "progress", + "Version": "1.2.3", + "Source": "Repository", + "Title": "Terminal Progress Bars", + "Authors@R": "c( person(\"Gábor\", \"Csárdi\", , \"csardi.gabor@gmail.com\", role = c(\"aut\", \"cre\")), person(\"Rich\", \"FitzJohn\", role = \"aut\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Configurable Progress bars, they may include percentage, elapsed time, and/or the estimated completion time. They work in terminals, in 'Emacs' 'ESS', 'RStudio', 'Windows' 'Rgui' and the 'macOS' 'R.app'. The package also provides a 'C++' 'API', that works with or without 'Rcpp'.", + "License": "MIT + file LICENSE", + "URL": "https://github.com/r-lib/progress#readme, http://r-lib.github.io/progress/", + "BugReports": "https://github.com/r-lib/progress/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "crayon", + "hms", + "prettyunits", + "R6" + ], + "Suggests": [ + "Rcpp", + "testthat (>= 3.0.0)", + "withr" + ], + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "no", + "Author": "Gábor Csárdi [aut, cre], Rich FitzJohn [aut], Posit Software, PBC [cph, fnd]", + "Maintainer": "Gábor Csárdi ", + "Repository": "RSPM" + }, + "promises": { + "Package": "promises", + "Version": "1.3.2", + "Source": "Repository", + "Type": "Package", + "Title": "Abstractions for Promise-Based Asynchronous Programming", + "Authors@R": "c( person(\"Joe\", \"Cheng\", , \"joe@posit.co\", role = c(\"aut\", \"cre\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Provides fundamental abstractions for doing asynchronous programming in R using promises. Asynchronous programming is useful for allowing a single R process to orchestrate multiple tasks in the background while also attending to something else. Semantics are similar to 'JavaScript' promises, but with a syntax that is idiomatic R.", + "License": "MIT + file LICENSE", + "URL": "https://rstudio.github.io/promises/, https://github.com/rstudio/promises", + "BugReports": "https://github.com/rstudio/promises/issues", + "Imports": [ + "fastmap (>= 1.1.0)", + "later", + "magrittr (>= 1.5)", + "R6", + "Rcpp", + "rlang", + "stats" + ], + "Suggests": [ + "future (>= 1.21.0)", + "knitr", + "purrr", + "rmarkdown", + "spelling", + "testthat", + "vembedr" + ], + "LinkingTo": [ + "later", + "Rcpp" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "rsconnect", + "Encoding": "UTF-8", + "Language": "en-US", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "yes", + "Author": "Joe Cheng [aut, cre], Posit Software, PBC [cph, fnd]", + "Maintainer": "Joe Cheng ", + "Repository": "CRAN" + }, + "proxy": { + "Package": "proxy", + "Version": "0.4-27", + "Source": "Repository", + "Type": "Package", + "Title": "Distance and Similarity Measures", + "Authors@R": "c(person(given = \"David\", family = \"Meyer\", role = c(\"aut\", \"cre\"), email = \"David.Meyer@R-project.org\"), person(given = \"Christian\", family = \"Buchta\", role = \"aut\"))", + "Description": "Provides an extensible framework for the efficient calculation of auto- and cross-proximities, along with implementations of the most popular ones.", + "Depends": [ + "R (>= 3.4.0)" + ], + "Imports": [ + "stats", + "utils" + ], + "Suggests": [ + "cba" + ], + "Collate": "registry.R database.R dist.R similarities.R dissimilarities.R util.R seal.R", + "License": "GPL-2", + "NeedsCompilation": "yes", + "Author": "David Meyer [aut, cre], Christian Buchta [aut]", + "Maintainer": "David Meyer ", + "Repository": "CRAN" + }, + "ps": { + "Package": "ps", + "Version": "1.8.1", + "Source": "Repository", + "Title": "List, Query, Manipulate System Processes", + "Authors@R": "c( person(\"Jay\", \"Loden\", role = \"aut\"), person(\"Dave\", \"Daeschler\", role = \"aut\"), person(\"Giampaolo\", \"Rodola'\", role = \"aut\"), person(\"Gábor\", \"Csárdi\", , \"csardi.gabor@gmail.com\", role = c(\"aut\", \"cre\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "List, query and manipulate all system processes, on 'Windows', 'Linux' and 'macOS'.", + "License": "MIT + file LICENSE", + "URL": "https://github.com/r-lib/ps, https://ps.r-lib.org/", + "BugReports": "https://github.com/r-lib/ps/issues", + "Depends": [ + "R (>= 3.4)" + ], + "Imports": [ + "utils" + ], + "Suggests": [ + "callr", + "covr", + "curl", + "pillar", + "pingr", + "processx (>= 3.1.0)", + "R6", + "rlang", + "testthat (>= 3.0.0)", + "webfakes", + "withr" + ], + "Biarch": "true", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "yes", + "Author": "Jay Loden [aut], Dave Daeschler [aut], Giampaolo Rodola' [aut], Gábor Csárdi [aut, cre], Posit Software, PBC [cph, fnd]", + "Maintainer": "Gábor Csárdi ", + "Repository": "CRAN" + }, + "purrr": { + "Package": "purrr", + "Version": "1.0.4", + "Source": "Repository", + "Title": "Functional Programming Tools", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0003-4757-117X\")), person(\"Lionel\", \"Henry\", , \"lionel@posit.co\", role = \"aut\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\"), comment = c(ROR = \"03wc8by49\")) )", + "Description": "A complete and consistent functional programming toolkit for R.", + "License": "MIT + file LICENSE", + "URL": "https://purrr.tidyverse.org/, https://github.com/tidyverse/purrr", + "BugReports": "https://github.com/tidyverse/purrr/issues", + "Depends": [ + "R (>= 4.0)" + ], + "Imports": [ + "cli (>= 3.6.1)", + "lifecycle (>= 1.0.3)", + "magrittr (>= 1.5.0)", + "rlang (>= 1.1.1)", + "vctrs (>= 0.6.3)" + ], + "Suggests": [ + "covr", + "dplyr (>= 0.7.8)", + "httr", + "knitr", + "lubridate", + "rmarkdown", + "testthat (>= 3.0.0)", + "tibble", + "tidyselect" + ], + "LinkingTo": [ + "cli" + ], + "VignetteBuilder": "knitr", + "Biarch": "true", + "Config/build/compilation-database": "true", + "Config/Needs/website": "tidyverse/tidytemplate, tidyr", + "Config/testthat/edition": "3", + "Config/testthat/parallel": "TRUE", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [aut, cre] (), Lionel Henry [aut], Posit Software, PBC [cph, fnd] (03wc8by49)", + "Maintainer": "Hadley Wickham ", + "Repository": "CRAN" + }, + "ragg": { + "Package": "ragg", + "Version": "1.3.3", + "Source": "Repository", + "Type": "Package", + "Title": "Graphic Devices Based on AGG", + "Authors@R": "c( person(\"Thomas Lin\", \"Pedersen\", , \"thomas.pedersen@posit.co\", role = c(\"cre\", \"aut\"), comment = c(ORCID = \"0000-0002-5147-4711\")), person(\"Maxim\", \"Shemanarev\", role = c(\"aut\", \"cph\"), comment = \"Author of AGG\"), person(\"Tony\", \"Juricic\", , \"tonygeek@yahoo.com\", role = c(\"ctb\", \"cph\"), comment = \"Contributor to AGG\"), person(\"Milan\", \"Marusinec\", , \"milan@marusinec.sk\", role = c(\"ctb\", \"cph\"), comment = \"Contributor to AGG\"), person(\"Spencer\", \"Garrett\", role = \"ctb\", comment = \"Contributor to AGG\"), person(\"Posit, PBC\", role = c(\"cph\", \"fnd\")) )", + "Maintainer": "Thomas Lin Pedersen ", + "Description": "Anti-Grain Geometry (AGG) is a high-quality and high-performance 2D drawing library. The 'ragg' package provides a set of graphic devices based on AGG to use as alternative to the raster devices provided through the 'grDevices' package.", + "License": "MIT + file LICENSE", + "URL": "https://ragg.r-lib.org, https://github.com/r-lib/ragg", + "BugReports": "https://github.com/r-lib/ragg/issues", + "Imports": [ + "systemfonts (>= 1.0.3)", + "textshaping (>= 0.3.0)" + ], + "Suggests": [ + "covr", + "graphics", + "grid", + "testthat (>= 3.0.0)" + ], + "LinkingTo": [ + "systemfonts", + "textshaping" + ], + "Config/Needs/website": "ggplot2, devoid, magick, bench, tidyr, ggridges, hexbin, sessioninfo, pkgdown, tidyverse/tidytemplate", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.1", + "SystemRequirements": "freetype2, libpng, libtiff, libjpeg", + "Config/testthat/edition": "3", + "NeedsCompilation": "yes", + "Author": "Thomas Lin Pedersen [cre, aut] (), Maxim Shemanarev [aut, cph] (Author of AGG), Tony Juricic [ctb, cph] (Contributor to AGG), Milan Marusinec [ctb, cph] (Contributor to AGG), Spencer Garrett [ctb] (Contributor to AGG), Posit, PBC [cph, fnd]", + "Repository": "RSPM" + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.3", + "Source": "Repository", + "Type": "Package", + "Title": "Application Directories: Determine Where to Save Data, Caches, and Logs", + "Authors@R": "c(person(given = \"Hadley\", family = \"Wickham\", role = c(\"trl\", \"cre\", \"cph\"), email = \"hadley@rstudio.com\"), person(given = \"RStudio\", role = \"cph\"), person(given = \"Sridhar\", family = \"Ratnakumar\", role = \"aut\"), person(given = \"Trent\", family = \"Mick\", role = \"aut\"), person(given = \"ActiveState\", role = \"cph\", comment = \"R/appdir.r, R/cache.r, R/data.r, R/log.r translated from appdirs\"), person(given = \"Eddy\", family = \"Petrisor\", role = \"ctb\"), person(given = \"Trevor\", family = \"Davis\", role = c(\"trl\", \"aut\")), person(given = \"Gabor\", family = \"Csardi\", role = \"ctb\"), person(given = \"Gregory\", family = \"Jefferis\", role = \"ctb\"))", + "Description": "An easy way to determine which directories on the users computer you should use to save data, caches and logs. A port of Python's 'Appdirs' () to R.", + "License": "MIT + file LICENSE", + "URL": "https://rappdirs.r-lib.org, https://github.com/r-lib/rappdirs", + "BugReports": "https://github.com/r-lib/rappdirs/issues", + "Depends": [ + "R (>= 3.2)" + ], + "Suggests": [ + "roxygen2", + "testthat (>= 3.0.0)", + "covr", + "withr" + ], + "Copyright": "Original python appdirs module copyright (c) 2010 ActiveState Software Inc. R port copyright Hadley Wickham, RStudio. See file LICENSE for details.", + "Encoding": "UTF-8", + "RoxygenNote": "7.1.1", + "Config/testthat/edition": "3", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [trl, cre, cph], RStudio [cph], Sridhar Ratnakumar [aut], Trent Mick [aut], ActiveState [cph] (R/appdir.r, R/cache.r, R/data.r, R/log.r translated from appdirs), Eddy Petrisor [ctb], Trevor Davis [trl, aut], Gabor Csardi [ctb], Gregory Jefferis [ctb]", + "Maintainer": "Hadley Wickham ", + "Repository": "RSPM" + }, + "reactR": { + "Package": "reactR", + "Version": "0.6.1", + "Source": "Repository", + "Type": "Package", + "Title": "React Helpers", + "Date": "2024-09-14", + "Authors@R": "c( person( \"Facebook\", \"Inc\" , role = c(\"aut\", \"cph\") , comment = \"React library in lib, https://reactjs.org/; see AUTHORS for full list of contributors\" ), person( \"Michel\",\"Weststrate\", , role = c(\"aut\", \"cph\") , comment = \"mobx library in lib, https://github.com/mobxjs\" ), person( \"Kent\", \"Russell\" , role = c(\"aut\", \"cre\") , comment = \"R interface\" , email = \"kent.russell@timelyportfolio.com\" ), person( \"Alan\", \"Dipert\" , role = c(\"aut\") , comment = \"R interface\" , email = \"alan@rstudio.com\" ), person( \"Greg\", \"Lin\" , role = c(\"aut\") , comment = \"R interface\" , email = \"glin@glin.io\" ) )", + "Maintainer": "Kent Russell ", + "Description": "Make it easy to use 'React' in R with 'htmlwidget' scaffolds, helper dependency functions, an embedded 'Babel' 'transpiler', and examples.", + "URL": "https://github.com/react-R/reactR", + "BugReports": "https://github.com/react-R/reactR/issues", + "License": "MIT + file LICENSE", + "Encoding": "UTF-8", + "Imports": [ + "htmltools" + ], + "Suggests": [ + "htmlwidgets (>= 1.5.3)", + "rmarkdown", + "shiny", + "V8", + "knitr", + "usethis", + "jsonlite" + ], + "RoxygenNote": "7.3.2", + "VignetteBuilder": "knitr", + "NeedsCompilation": "no", + "Author": "Facebook Inc [aut, cph] (React library in lib, https://reactjs.org/; see AUTHORS for full list of contributors), Michel Weststrate [aut, cph] (mobx library in lib, https://github.com/mobxjs), Kent Russell [aut, cre] (R interface), Alan Dipert [aut] (R interface), Greg Lin [aut] (R interface)", + "Repository": "RSPM" + }, + "reactable": { + "Package": "reactable", + "Version": "0.4.4", + "Source": "Repository", + "Type": "Package", + "Title": "Interactive Data Tables for R", + "Authors@R": "c( person(\"Greg\", \"Lin\", email = \"glin@glin.io\", role = c(\"aut\", \"cre\")), person(\"Tanner\", \"Linsley\", role = c(\"ctb\", \"cph\"), comment = \"React Table library\"), person(family = \"Emotion team and other contributors\", role = c(\"ctb\", \"cph\"), comment = \"Emotion library\"), person(\"Kent\", \"Russell\", role = c(\"ctb\", \"cph\"), comment = \"reactR package\"), person(\"Ramnath\", \"Vaidyanathan\", role = c(\"ctb\", \"cph\"), comment = \"htmlwidgets package\"), person(\"Joe\", \"Cheng\", role = c(\"ctb\", \"cph\"), comment = \"htmlwidgets package\"), person(\"JJ\", \"Allaire\", role = c(\"ctb\", \"cph\"), comment = \"htmlwidgets package\"), person(\"Yihui\", \"Xie\", role = c(\"ctb\", \"cph\"), comment = \"htmlwidgets package\"), person(\"Kenton\", \"Russell\", role = c(\"ctb\", \"cph\"), comment = \"htmlwidgets package\"), person(family = \"Facebook, Inc. and its affiliates\", role = c(\"ctb\", \"cph\"), comment = \"React library\"), person(family = \"FormatJS\", role = c(\"ctb\", \"cph\"), comment = \"FormatJS libraries\"), person(family = \"Feross Aboukhadijeh, and other contributors\", role = c(\"ctb\", \"cph\"), comment = \"buffer library\"), person(\"Roman\", \"Shtylman\", role = c(\"ctb\", \"cph\"), comment = \"process library\"), person(\"James\", \"Halliday\", role = c(\"ctb\", \"cph\"), comment = \"stream-browserify library\"), person(family = \"Posit Software, PBC\", role = c(\"fnd\", \"cph\")) )", + "Description": "Interactive data tables for R, based on the 'React Table' JavaScript library. Provides an HTML widget that can be used in 'R Markdown' or 'Quarto' documents, 'Shiny' applications, or viewed from an R console.", + "License": "MIT + file LICENSE", + "URL": "https://glin.github.io/reactable/, https://github.com/glin/reactable", + "BugReports": "https://github.com/glin/reactable/issues", + "Depends": [ + "R (>= 3.1)" + ], + "Imports": [ + "digest", + "htmltools (>= 0.5.2)", + "htmlwidgets (>= 1.5.3)", + "jsonlite", + "reactR" + ], + "Suggests": [ + "covr", + "crosstalk", + "dplyr", + "fontawesome", + "knitr", + "leaflet", + "MASS", + "rmarkdown", + "shiny", + "sparkline", + "testthat", + "tippy", + "V8" + ], + "Encoding": "UTF-8", + "RoxygenNote": "7.2.1", + "Config/testthat/edition": "3", + "NeedsCompilation": "no", + "Author": "Greg Lin [aut, cre], Tanner Linsley [ctb, cph] (React Table library), Emotion team and other contributors [ctb, cph] (Emotion library), Kent Russell [ctb, cph] (reactR package), Ramnath Vaidyanathan [ctb, cph] (htmlwidgets package), Joe Cheng [ctb, cph] (htmlwidgets package), JJ Allaire [ctb, cph] (htmlwidgets package), Yihui Xie [ctb, cph] (htmlwidgets package), Kenton Russell [ctb, cph] (htmlwidgets package), Facebook, Inc. and its affiliates [ctb, cph] (React library), FormatJS [ctb, cph] (FormatJS libraries), Feross Aboukhadijeh, and other contributors [ctb, cph] (buffer library), Roman Shtylman [ctb, cph] (process library), James Halliday [ctb, cph] (stream-browserify library), Posit Software, PBC [fnd, cph]", + "Maintainer": "Greg Lin ", + "Repository": "RSPM" + }, + "readr": { + "Package": "readr", + "Version": "2.1.5", + "Source": "Repository", + "Title": "Read Rectangular Text Data", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\"), person(\"Jim\", \"Hester\", role = \"aut\"), person(\"Romain\", \"Francois\", role = \"ctb\"), person(\"Jennifer\", \"Bryan\", , \"jenny@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-6983-2759\")), person(\"Shelby\", \"Bearrows\", role = \"ctb\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")), person(\"https://github.com/mandreyel/\", role = \"cph\", comment = \"mio library\"), person(\"Jukka\", \"Jylänki\", role = c(\"ctb\", \"cph\"), comment = \"grisu3 implementation\"), person(\"Mikkel\", \"Jørgensen\", role = c(\"ctb\", \"cph\"), comment = \"grisu3 implementation\") )", + "Description": "The goal of 'readr' is to provide a fast and friendly way to read rectangular data (like 'csv', 'tsv', and 'fwf'). It is designed to flexibly parse many types of data found in the wild, while still cleanly failing when data unexpectedly changes.", + "License": "MIT + file LICENSE", + "URL": "https://readr.tidyverse.org, https://github.com/tidyverse/readr", + "BugReports": "https://github.com/tidyverse/readr/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "cli (>= 3.2.0)", + "clipr", + "crayon", + "hms (>= 0.4.1)", + "lifecycle (>= 0.2.0)", + "methods", + "R6", + "rlang", + "tibble", + "utils", + "vroom (>= 1.6.0)" + ], + "Suggests": [ + "covr", + "curl", + "datasets", + "knitr", + "rmarkdown", + "spelling", + "stringi", + "testthat (>= 3.2.0)", + "tzdb (>= 0.1.1)", + "waldo", + "withr", + "xml2" + ], + "LinkingTo": [ + "cpp11", + "tzdb (>= 0.1.1)" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse, tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Config/testthat/parallel": "false", + "Encoding": "UTF-8", + "Language": "en-US", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [aut], Jim Hester [aut], Romain Francois [ctb], Jennifer Bryan [aut, cre] (), Shelby Bearrows [ctb], Posit Software, PBC [cph, fnd], https://github.com/mandreyel/ [cph] (mio library), Jukka Jylänki [ctb, cph] (grisu3 implementation), Mikkel Jørgensen [ctb, cph] (grisu3 implementation)", + "Maintainer": "Jennifer Bryan ", + "Repository": "RSPM" + }, + "readxl": { + "Package": "readxl", + "Version": "1.4.3", + "Source": "Repository", + "Title": "Read Excel Files", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0003-4757-117X\")), person(\"Jennifer\", \"Bryan\", , \"jenny@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-6983-2759\")), person(\"Posit, PBC\", role = c(\"cph\", \"fnd\"), comment = \"Copyright holder of all R code and all C/C++ code without explicit copyright attribution\"), person(\"Marcin\", \"Kalicinski\", role = c(\"ctb\", \"cph\"), comment = \"Author of included RapidXML code\"), person(\"Komarov Valery\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\"), person(\"Christophe Leitienne\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\"), person(\"Bob Colbert\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\"), person(\"David Hoerl\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\"), person(\"Evan Miller\", role = c(\"ctb\", \"cph\"), comment = \"Author of included libxls code\") )", + "Description": "Import excel files into R. Supports '.xls' via the embedded 'libxls' C library and '.xlsx' via the embedded 'RapidXML' C++ library . Works on Windows, Mac and Linux without external dependencies.", + "License": "MIT + file LICENSE", + "URL": "https://readxl.tidyverse.org, https://github.com/tidyverse/readxl", + "BugReports": "https://github.com/tidyverse/readxl/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "cellranger", + "tibble (>= 2.0.1)", + "utils" + ], + "Suggests": [ + "covr", + "knitr", + "rmarkdown", + "testthat (>= 3.1.6)", + "withr" + ], + "LinkingTo": [ + "cpp11 (>= 0.4.0)", + "progress" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate, tidyverse", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "Note": "libxls v1.6.2 (patched) 45abe77", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [aut] (), Jennifer Bryan [aut, cre] (), Posit, PBC [cph, fnd] (Copyright holder of all R code and all C/C++ code without explicit copyright attribution), Marcin Kalicinski [ctb, cph] (Author of included RapidXML code), Komarov Valery [ctb, cph] (Author of included libxls code), Christophe Leitienne [ctb, cph] (Author of included libxls code), Bob Colbert [ctb, cph] (Author of included libxls code), David Hoerl [ctb, cph] (Author of included libxls code), Evan Miller [ctb, cph] (Author of included libxls code)", + "Maintainer": "Jennifer Bryan ", + "Repository": "RSPM" + }, + "rematch": { + "Package": "rematch", + "Version": "2.0.0", + "Source": "Repository", + "Title": "Match Regular Expressions with a Nicer 'API'", + "Author": "Gabor Csardi", + "Maintainer": "Gabor Csardi ", + "Description": "A small wrapper on 'regexpr' to extract the matches and captured groups from the match of a regular expression to a character vector.", + "License": "MIT + file LICENSE", + "URL": "https://github.com/gaborcsardi/rematch", + "BugReports": "https://github.com/gaborcsardi/rematch/issues", + "RoxygenNote": "5.0.1.9000", + "Suggests": [ + "covr", + "testthat" + ], + "Encoding": "UTF-8", + "NeedsCompilation": "no", + "Repository": "RSPM" + }, + "renv": { + "Package": "renv", + "Version": "1.1.1", + "Source": "Repository", + "Type": "Package", + "Title": "Project Environments", + "Authors@R": "c( person(\"Kevin\", \"Ushey\", role = c(\"aut\", \"cre\"), email = \"kevin@rstudio.com\", comment = c(ORCID = \"0000-0003-2880-7407\")), person(\"Hadley\", \"Wickham\", role = c(\"aut\"), email = \"hadley@rstudio.com\", comment = c(ORCID = \"0000-0003-4757-117X\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "A dependency management toolkit for R. Using 'renv', you can create and manage project-local R libraries, save the state of these libraries to a 'lockfile', and later restore your library as required. Together, these tools can help make your projects more isolated, portable, and reproducible.", + "License": "MIT + file LICENSE", + "URL": "https://rstudio.github.io/renv/, https://github.com/rstudio/renv", + "BugReports": "https://github.com/rstudio/renv/issues", + "Imports": [ + "utils" + ], + "Suggests": [ + "BiocManager", + "cli", + "compiler", + "covr", + "cpp11", + "devtools", + "gitcreds", + "jsonlite", + "jsonvalidate", + "knitr", + "miniUI", + "modules", + "packrat", + "pak", + "R6", + "remotes", + "reticulate", + "rmarkdown", + "rstudioapi", + "shiny", + "testthat", + "uuid", + "waldo", + "yaml", + "webfakes" + ], + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Config/testthat/parallel": "true", + "Config/testthat/start-first": "bioconductor,python,install,restore,snapshot,retrieve,remotes", + "NeedsCompilation": "no", + "Author": "Kevin Ushey [aut, cre] (), Hadley Wickham [aut] (), Posit Software, PBC [cph, fnd]", + "Maintainer": "Kevin Ushey ", + "Repository": "CRAN" + }, + "rlang": { + "Package": "rlang", + "Version": "1.1.5", + "Source": "Repository", + "Title": "Functions for Base Types and Core R and 'Tidyverse' Features", + "Description": "A toolbox for working with base types, core R features like the condition system, and core 'Tidyverse' features like tidy evaluation.", + "Authors@R": "c( person(\"Lionel\", \"Henry\", ,\"lionel@posit.co\", c(\"aut\", \"cre\")), person(\"Hadley\", \"Wickham\", ,\"hadley@posit.co\", \"aut\"), person(given = \"mikefc\", email = \"mikefc@coolbutuseless.com\", role = \"cph\", comment = \"Hash implementation based on Mike's xxhashlite\"), person(given = \"Yann\", family = \"Collet\", role = \"cph\", comment = \"Author of the embedded xxHash library\"), person(given = \"Posit, PBC\", role = c(\"cph\", \"fnd\")) )", + "License": "MIT + file LICENSE", + "ByteCompile": "true", + "Biarch": "true", + "Depends": [ + "R (>= 3.5.0)" + ], + "Imports": [ + "utils" + ], + "Suggests": [ + "cli (>= 3.1.0)", + "covr", + "crayon", + "fs", + "glue", + "knitr", + "magrittr", + "methods", + "pillar", + "rmarkdown", + "stats", + "testthat (>= 3.0.0)", + "tibble", + "usethis", + "vctrs (>= 0.2.3)", + "withr" + ], + "Enhances": [ + "winch" + ], + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "URL": "https://rlang.r-lib.org, https://github.com/r-lib/rlang", + "BugReports": "https://github.com/r-lib/rlang/issues", + "Config/testthat/edition": "3", + "Config/Needs/website": "dplyr, tidyverse/tidytemplate", + "NeedsCompilation": "yes", + "Author": "Lionel Henry [aut, cre], Hadley Wickham [aut], mikefc [cph] (Hash implementation based on Mike's xxhashlite), Yann Collet [cph] (Author of the embedded xxHash library), Posit, PBC [cph, fnd]", + "Maintainer": "Lionel Henry ", + "Repository": "CRAN" + }, + "rlistings": { + "Package": "rlistings", + "Version": "0.2.10.9002", + "Source": "Repository", + "Title": "Clinical Trial Style Data Readout Listings", + "Date": "2025-02-06", + "Authors@R": "c( person(\"Gabriel\", \"Becker\", , \"gabembecker@gmail.com\", role = \"aut\", comment = \"original creator of the package\"), person(\"Adrian\", \"Waddell\", , \"adrian.waddell@gene.com\", role = \"aut\"), person(\"Joe\", \"Zhu\", , \"joe.zhu@roche.com\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0001-7566-2787\")), person(\"Davide\", \"Garolini\", , \"davide.garolini@roche.com\", role = \"aut\"), person(\"Emily\", \"de la Rua\", , \"emily.de_la_rua@contractors.roche.com\", role = \"aut\"), person(\"Abinaya\", \"Yogasekaram\", , \"abinaya.yogasekaram@contractors.roche.com\", role = \"ctb\"), person(\"F. Hoffmann-La Roche AG\", role = c(\"cph\", \"fnd\")) )", + "Description": "Listings are often part of the submission of clinical trial data in regulatory settings. We provide a framework for the specific formatting features often used when displaying large datasets in that context.", + "License": "Apache License 2.0", + "URL": "https://insightsengineering.github.io/rlistings/, https://github.com/insightsengineering/rlistings/", + "BugReports": "https://github.com/insightsengineering/rlistings/issues", + "Depends": [ + "formatters (>= 0.5.10)", + "methods", + "tibble (>= 2.0.0)" + ], + "Imports": [ + "checkmate (>= 2.1.0)", + "grDevices", + "grid", + "stats", + "utils" + ], + "Suggests": [ + "dplyr (>= 1.0.2)", + "knitr (>= 1.42)", + "lifecycle (>= 0.2.0)", + "rmarkdown (>= 2.23)", + "stringi (>= 1.6)", + "testthat (>= 3.1.5)", + "withr (>= 2.0.0)" + ], + "VignetteBuilder": "knitr, rmarkdown", + "Config/Needs/verdepcheck": "insightsengineering/formatters, tidyverse/tibble, mllg/checkmate, tidyverse/dplyr, yihui/knitr, r-lib/lifecycle, rstudio/rmarkdown, gagolews/stringi, r-lib/testthat, r-lib/withr", + "Config/Needs/website": "insightsengineering/nesttemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "Language": "en-US", + "Roxygen": "list(markdown = TRUE)", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "no", + "Author": "Gabriel Becker [aut] (original creator of the package), Adrian Waddell [aut], Joe Zhu [aut, cre] (), Davide Garolini [aut], Emily de la Rua [aut], Abinaya Yogasekaram [ctb], F. Hoffmann-La Roche AG [cph, fnd]", + "Maintainer": "Joe Zhu ", + "Repository": "RSPM" + }, + "rmarkdown": { + "Package": "rmarkdown", + "Version": "2.29", + "Source": "Repository", + "Type": "Package", + "Title": "Dynamic Documents for R", + "Authors@R": "c( person(\"JJ\", \"Allaire\", , \"jj@posit.co\", role = \"aut\"), person(\"Yihui\", \"Xie\", , \"xie@yihui.name\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0003-0645-5666\")), person(\"Christophe\", \"Dervieux\", , \"cderv@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0003-4474-2498\")), person(\"Jonathan\", \"McPherson\", , \"jonathan@posit.co\", role = \"aut\"), person(\"Javier\", \"Luraschi\", role = \"aut\"), person(\"Kevin\", \"Ushey\", , \"kevin@posit.co\", role = \"aut\"), person(\"Aron\", \"Atkins\", , \"aron@posit.co\", role = \"aut\"), person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\"), person(\"Joe\", \"Cheng\", , \"joe@posit.co\", role = \"aut\"), person(\"Winston\", \"Chang\", , \"winston@posit.co\", role = \"aut\"), person(\"Richard\", \"Iannone\", , \"rich@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0003-3925-190X\")), person(\"Andrew\", \"Dunning\", role = \"ctb\", comment = c(ORCID = \"0000-0003-0464-5036\")), person(\"Atsushi\", \"Yasumoto\", role = c(\"ctb\", \"cph\"), comment = c(ORCID = \"0000-0002-8335-495X\", cph = \"Number sections Lua filter\")), person(\"Barret\", \"Schloerke\", role = \"ctb\"), person(\"Carson\", \"Sievert\", role = \"ctb\", comment = c(ORCID = \"0000-0002-4958-2844\")), person(\"Devon\", \"Ryan\", , \"dpryan79@gmail.com\", role = \"ctb\", comment = c(ORCID = \"0000-0002-8549-0971\")), person(\"Frederik\", \"Aust\", , \"frederik.aust@uni-koeln.de\", role = \"ctb\", comment = c(ORCID = \"0000-0003-4900-788X\")), person(\"Jeff\", \"Allen\", , \"jeff@posit.co\", role = \"ctb\"), person(\"JooYoung\", \"Seo\", role = \"ctb\", comment = c(ORCID = \"0000-0002-4064-6012\")), person(\"Malcolm\", \"Barrett\", role = \"ctb\"), person(\"Rob\", \"Hyndman\", , \"Rob.Hyndman@monash.edu\", role = \"ctb\"), person(\"Romain\", \"Lesur\", role = \"ctb\"), person(\"Roy\", \"Storey\", role = \"ctb\"), person(\"Ruben\", \"Arslan\", , \"ruben.arslan@uni-goettingen.de\", role = \"ctb\"), person(\"Sergio\", \"Oller\", role = \"ctb\"), person(given = \"Posit Software, PBC\", role = c(\"cph\", \"fnd\")), person(, \"jQuery UI contributors\", role = c(\"ctb\", \"cph\"), comment = \"jQuery UI library; authors listed in inst/rmd/h/jqueryui/AUTHORS.txt\"), person(\"Mark\", \"Otto\", role = \"ctb\", comment = \"Bootstrap library\"), person(\"Jacob\", \"Thornton\", role = \"ctb\", comment = \"Bootstrap library\"), person(, \"Bootstrap contributors\", role = \"ctb\", comment = \"Bootstrap library\"), person(, \"Twitter, Inc\", role = \"cph\", comment = \"Bootstrap library\"), person(\"Alexander\", \"Farkas\", role = c(\"ctb\", \"cph\"), comment = \"html5shiv library\"), person(\"Scott\", \"Jehl\", role = c(\"ctb\", \"cph\"), comment = \"Respond.js library\"), person(\"Ivan\", \"Sagalaev\", role = c(\"ctb\", \"cph\"), comment = \"highlight.js library\"), person(\"Greg\", \"Franko\", role = c(\"ctb\", \"cph\"), comment = \"tocify library\"), person(\"John\", \"MacFarlane\", role = c(\"ctb\", \"cph\"), comment = \"Pandoc templates\"), person(, \"Google, Inc.\", role = c(\"ctb\", \"cph\"), comment = \"ioslides library\"), person(\"Dave\", \"Raggett\", role = \"ctb\", comment = \"slidy library\"), person(, \"W3C\", role = \"cph\", comment = \"slidy library\"), person(\"Dave\", \"Gandy\", role = c(\"ctb\", \"cph\"), comment = \"Font-Awesome\"), person(\"Ben\", \"Sperry\", role = \"ctb\", comment = \"Ionicons\"), person(, \"Drifty\", role = \"cph\", comment = \"Ionicons\"), person(\"Aidan\", \"Lister\", role = c(\"ctb\", \"cph\"), comment = \"jQuery StickyTabs\"), person(\"Benct Philip\", \"Jonsson\", role = c(\"ctb\", \"cph\"), comment = \"pagebreak Lua filter\"), person(\"Albert\", \"Krewinkel\", role = c(\"ctb\", \"cph\"), comment = \"pagebreak Lua filter\") )", + "Description": "Convert R Markdown documents into a variety of formats.", + "License": "GPL-3", + "URL": "https://github.com/rstudio/rmarkdown, https://pkgs.rstudio.com/rmarkdown/", + "BugReports": "https://github.com/rstudio/rmarkdown/issues", + "Depends": [ + "R (>= 3.0)" + ], + "Imports": [ + "bslib (>= 0.2.5.1)", + "evaluate (>= 0.13)", + "fontawesome (>= 0.5.0)", + "htmltools (>= 0.5.1)", + "jquerylib", + "jsonlite", + "knitr (>= 1.43)", + "methods", + "tinytex (>= 0.31)", + "tools", + "utils", + "xfun (>= 0.36)", + "yaml (>= 2.1.19)" + ], + "Suggests": [ + "digest", + "dygraphs", + "fs", + "rsconnect", + "downlit (>= 0.4.0)", + "katex (>= 1.4.0)", + "sass (>= 0.4.0)", + "shiny (>= 1.6.0)", + "testthat (>= 3.0.3)", + "tibble", + "vctrs", + "cleanrmd", + "withr (>= 2.4.2)", + "xml2" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "rstudio/quillt, pkgdown", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "SystemRequirements": "pandoc (>= 1.14) - http://pandoc.org", + "NeedsCompilation": "no", + "Author": "JJ Allaire [aut], Yihui Xie [aut, cre] (), Christophe Dervieux [aut] (), Jonathan McPherson [aut], Javier Luraschi [aut], Kevin Ushey [aut], Aron Atkins [aut], Hadley Wickham [aut], Joe Cheng [aut], Winston Chang [aut], Richard Iannone [aut] (), Andrew Dunning [ctb] (), Atsushi Yasumoto [ctb, cph] (, Number sections Lua filter), Barret Schloerke [ctb], Carson Sievert [ctb] (), Devon Ryan [ctb] (), Frederik Aust [ctb] (), Jeff Allen [ctb], JooYoung Seo [ctb] (), Malcolm Barrett [ctb], Rob Hyndman [ctb], Romain Lesur [ctb], Roy Storey [ctb], Ruben Arslan [ctb], Sergio Oller [ctb], Posit Software, PBC [cph, fnd], jQuery UI contributors [ctb, cph] (jQuery UI library; authors listed in inst/rmd/h/jqueryui/AUTHORS.txt), Mark Otto [ctb] (Bootstrap library), Jacob Thornton [ctb] (Bootstrap library), Bootstrap contributors [ctb] (Bootstrap library), Twitter, Inc [cph] (Bootstrap library), Alexander Farkas [ctb, cph] (html5shiv library), Scott Jehl [ctb, cph] (Respond.js library), Ivan Sagalaev [ctb, cph] (highlight.js library), Greg Franko [ctb, cph] (tocify library), John MacFarlane [ctb, cph] (Pandoc templates), Google, Inc. [ctb, cph] (ioslides library), Dave Raggett [ctb] (slidy library), W3C [cph] (slidy library), Dave Gandy [ctb, cph] (Font-Awesome), Ben Sperry [ctb] (Ionicons), Drifty [cph] (Ionicons), Aidan Lister [ctb, cph] (jQuery StickyTabs), Benct Philip Jonsson [ctb, cph] (pagebreak Lua filter), Albert Krewinkel [ctb, cph] (pagebreak Lua filter)", + "Maintainer": "Yihui Xie ", + "Repository": "CRAN" + }, + "rootSolve": { + "Package": "rootSolve", + "Version": "1.8.2.4", + "Source": "Repository", + "Title": "Nonlinear Root Finding, Equilibrium and Steady-State Analysis of Ordinary Differential Equations", + "Authors@R": "c(person(\"Karline\",\"Soetaert\", role = c(\"aut\", \"cre\"), email = \"karline.soetaert@nioz.nl\"), person(\"Alan C.\",\"Hindmarsh\", role = \"ctb\", comment = \"files lsodes.f, sparse.f\"), person(\"S.C.\",\"Eisenstat\", role = \"ctb\", comment = \"file sparse.f\"), person(\"Cleve\",\"Moler\", role = \"ctb\", comment = \"file dlinpk.f\"), person(\"Jack\",\"Dongarra\", role = \"ctb\", comment = \"file dlinpk.f\"), person(\"Youcef\", \"Saad\", role = \"ctb\", comment = \"file dsparsk.f\"))", + "Maintainer": "Karline Soetaert ", + "Author": "Karline Soetaert [aut, cre], Alan C. Hindmarsh [ctb] (files lsodes.f, sparse.f), S.C. Eisenstat [ctb] (file sparse.f), Cleve Moler [ctb] (file dlinpk.f), Jack Dongarra [ctb] (file dlinpk.f), Youcef Saad [ctb] (file dsparsk.f)", + "Depends": [ + "R (>= 2.01)" + ], + "Imports": [ + "stats", + "graphics", + "grDevices" + ], + "Description": "Routines to find the root of nonlinear functions, and to perform steady-state and equilibrium analysis of ordinary differential equations (ODE). Includes routines that: (1) generate gradient and jacobian matrices (full and banded), (2) find roots of non-linear equations by the 'Newton-Raphson' method, (3) estimate steady-state conditions of a system of (differential) equations in full, banded or sparse form, using the 'Newton-Raphson' method, or by dynamically running, (4) solve the steady-state conditions for uni-and multicomponent 1-D, 2-D, and 3-D partial differential equations, that have been converted to ordinary differential equations by numerical differencing (using the method-of-lines approach). Includes fortran code.", + "License": "GPL (>= 2)", + "NeedsCompilation": "yes", + "Repository": "CRAN" + }, + "rprojroot": { + "Package": "rprojroot", + "Version": "2.0.4", + "Source": "Repository", + "Title": "Finding Files in Project Subdirectories", + "Authors@R": "person(given = \"Kirill\", family = \"M\\u00fcller\", role = c(\"aut\", \"cre\"), email = \"kirill@cynkra.com\", comment = c(ORCID = \"0000-0002-1416-3412\"))", + "Description": "Robust, reliable and flexible paths to files below a project root. The 'root' of a project is defined as a directory that matches a certain criterion, e.g., it contains a certain regular file.", + "License": "MIT + file LICENSE", + "URL": "https://rprojroot.r-lib.org/, https://github.com/r-lib/rprojroot", + "BugReports": "https://github.com/r-lib/rprojroot/issues", + "Depends": [ + "R (>= 3.0.0)" + ], + "Suggests": [ + "covr", + "knitr", + "lifecycle", + "mockr", + "rlang", + "rmarkdown", + "testthat (>= 3.0.0)", + "withr" + ], + "VignetteBuilder": "knitr", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "no", + "Author": "Kirill Müller [aut, cre] ()", + "Maintainer": "Kirill Müller ", + "Repository": "RSPM" + }, + "rstudioapi": { + "Package": "rstudioapi", + "Version": "0.17.1", + "Source": "Repository", + "Title": "Safely Access the RStudio API", + "Description": "Access the RStudio API (if available) and provide informative error messages when it's not.", + "Authors@R": "c( person(\"Kevin\", \"Ushey\", role = c(\"aut\", \"cre\"), email = \"kevin@rstudio.com\"), person(\"JJ\", \"Allaire\", role = c(\"aut\"), email = \"jj@posit.co\"), person(\"Hadley\", \"Wickham\", role = c(\"aut\"), email = \"hadley@posit.co\"), person(\"Gary\", \"Ritchie\", role = c(\"aut\"), email = \"gary@posit.co\"), person(family = \"RStudio\", role = \"cph\") )", + "Maintainer": "Kevin Ushey ", + "License": "MIT + file LICENSE", + "URL": "https://rstudio.github.io/rstudioapi/, https://github.com/rstudio/rstudioapi", + "BugReports": "https://github.com/rstudio/rstudioapi/issues", + "RoxygenNote": "7.3.2", + "Suggests": [ + "testthat", + "knitr", + "rmarkdown", + "clipr", + "covr" + ], + "VignetteBuilder": "knitr", + "Encoding": "UTF-8", + "NeedsCompilation": "no", + "Author": "Kevin Ushey [aut, cre], JJ Allaire [aut], Hadley Wickham [aut], Gary Ritchie [aut], RStudio [cph]", + "Repository": "CRAN" + }, + "rtables": { + "Package": "rtables", + "Version": "0.6.11.9004", + "Source": "Repository", + "Title": "Reporting Tables", + "Date": "2025-02-06", + "Authors@R": "c( person(\"Gabriel\", \"Becker\", , \"gabembecker@gmail.com\", role = \"aut\", comment = \"Original creator of the package\"), person(\"Adrian\", \"Waddell\", , \"adrian.waddell@gene.com\", role = \"aut\"), person(\"Daniel\", \"Sabanés Bové\", , \"daniel.sabanes_bove@roche.com\", role = \"ctb\"), person(\"Maximilian\", \"Mordig\", , \"maximilian_oliver.mordig@roche.com\", role = \"ctb\"), person(\"Davide\", \"Garolini\", , \"davide.garolini@roche.com\", role = \"aut\"), person(\"Emily\", \"de la Rua\", , \"emily.de_la_rua@contractors.roche.com\", role = \"aut\"), person(\"Abinaya\", \"Yogasekaram\", , \"abinaya.yogasekaram@contractors.roche.com\", role = \"ctb\"), person(\"Joe\", \"Zhu\", , \"joe.zhu@roche.com\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0001-7566-2787\")), person(\"F. Hoffmann-La Roche AG\", role = c(\"cph\", \"fnd\")) )", + "Description": "Reporting tables often have structure that goes beyond simple rectangular data. The 'rtables' package provides a framework for declaring complex multi-level tabulations and then applying them to data. This framework models both tabulation and the resulting tables as hierarchical, tree-like objects which support sibling sub-tables, arbitrary splitting or grouping of data in row and column dimensions, cells containing multiple values, and the concept of contextual summary computations. A convenient pipe-able interface is provided for declaring table layouts and the corresponding computations, and then applying them to data.", + "License": "Apache License 2.0 | file LICENSE", + "URL": "https://github.com/insightsengineering/rtables, https://insightsengineering.github.io/rtables/", + "BugReports": "https://github.com/insightsengineering/rtables/issues", + "Depends": [ + "formatters (>= 0.5.10)", + "magrittr (>= 1.5)", + "methods", + "R (>= 2.10)" + ], + "Imports": [ + "checkmate (>= 2.1.0)", + "htmltools (>= 0.5.4)", + "lifecycle (>= 0.2.0)", + "stats", + "stringi (>= 1.6)" + ], + "Suggests": [ + "broom (>= 1.0.5)", + "car (>= 3.0-13)", + "dplyr (>= 1.0.5)", + "knitr (>= 1.42)", + "r2rtf (>= 0.3.2)", + "rmarkdown (>= 2.23)", + "survival (>= 3.3-1)", + "testthat (>= 3.2.1)", + "tibble (>= 3.2.1)", + "tidyr (>= 1.1.3)", + "withr (>= 2.0.0)", + "xml2 (>= 1.3.5)" + ], + "VignetteBuilder": "knitr, rmarkdown", + "Config/Needs/verdepcheck": "insightsengineering/formatters, tidyverse/magrittr, mllg/checkmate, rstudio/htmltools, gagolews/stringi, tidymodels/broom, cran/car, tidyverse/dplyr, davidgohel/flextable, yihui/knitr, r-lib/lifecycle, davidgohel/officer, Merck/r2rtf, rstudio/rmarkdown, therneau/survival, r-lib/testthat, tidyverse/tibble, tidyverse/tidyr, r-lib/withr, r-lib/xml2", + "Encoding": "UTF-8", + "Language": "en-US", + "Roxygen": "list(markdown = TRUE)", + "RoxygenNote": "7.3.2", + "Collate": "'00tabletrees.R' 'Viewer.R' 'argument_conventions.R' 'as_html.R' 'utils.R' 'colby_constructors.R' 'compare_rtables.R' 'format_rcell.R' 'indent.R' 'make_subset_expr.R' 'custom_split_funs.R' 'default_split_funs.R' 'make_split_fun.R' 'summary.R' 'package.R' 'tree_accessors.R' 'tt_afun_utils.R' 'tt_as_df.R' 'tt_compare_tables.R' 'tt_compatibility.R' 'tt_dotabulation.R' 'tt_paginate.R' 'tt_pos_and_access.R' 'tt_showmethods.R' 'tt_sort.R' 'tt_test_afuns.R' 'tt_toString.R' 'tt_export.R' 'index_footnotes.R' 'tt_from_df.R' 'validate_table_struct.R' 'zzz_constants.R'", + "NeedsCompilation": "no", + "Author": "Gabriel Becker [aut] (Original creator of the package), Adrian Waddell [aut], Daniel Sabanés Bové [ctb], Maximilian Mordig [ctb], Davide Garolini [aut], Emily de la Rua [aut], Abinaya Yogasekaram [ctb], Joe Zhu [aut, cre] (), F. Hoffmann-La Roche AG [cph, fnd]", + "Maintainer": "Joe Zhu ", + "Repository": "RSPM" + }, + "rtables.officer": { + "Package": "rtables.officer", + "Version": "0.0.2", + "Source": "Repository", + "Title": "Exporting Tools for 'rtables'", + "Date": "2025-01-14", + "Authors@R": "c( person(\"Gabriel\", \"Becker\", , \"gabembecker@gmail.com\", role = \"ctb\"), person(\"Davide\", \"Garolini\", , \"davide.garolini@roche.com\", role = \"aut\"), person(\"Emily\", \"de la Rua\", , \"emily.de_la_rua@contractors.roche.com\", role = \"aut\"), person(\"Abinaya\", \"Yogasekaram\", , \"abinaya.yogasekaram@contractors.roche.com\", role = \"aut\"), person(\"Joe\", \"Zhu\", , \"joe.zhu@roche.com\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0001-7566-2787\")), person(\"F. Hoffmann-La Roche AG\", role = c(\"cph\", \"fnd\")) )", + "Description": "Designed to create and display complex tables with R, the 'rtables' R package allows cells in an 'rtables' object to contain any high-dimensional data structure, which can then be displayed with cell-specific formatting instructions. Additionally, the 'rtables.officer' package supports export formats related to the Microsoft Office software suite, including Microsoft Word ('docx') and Microsoft PowerPoint ('pptx').", + "License": "Apache License 2.0", + "URL": "https://github.com/insightsengineering/rtables.officer, https://insightsengineering.github.io/rtables.officer/", + "BugReports": "https://github.com/insightsengineering/rtables.officer/issues", + "Depends": [ + "formatters (>= 0.5.10)", + "magrittr (>= 1.5)", + "methods", + "R (>= 2.10)", + "rtables (>= 0.6.11)" + ], + "Imports": [ + "checkmate (>= 2.1.0)", + "flextable (>= 0.9.6)", + "lifecycle (>= 0.2.0)", + "officer (>= 0.6.6)", + "stats", + "stringi (>= 1.6)" + ], + "Suggests": [ + "broom (>= 1.0.5)", + "car (>= 3.0-13)", + "dplyr (>= 1.0.5)", + "knitr (>= 1.42)", + "r2rtf (>= 0.3.2)", + "rmarkdown (>= 2.23)", + "survival (>= 3.3-1)", + "testthat (>= 3.0.4)", + "tibble (>= 3.2.1)", + "tidyr (>= 1.1.3)", + "withr (>= 2.0.0)", + "xml2 (>= 1.1.0)" + ], + "VignetteBuilder": "knitr, rmarkdown", + "Config/Needs/verdepcheck": "insightsengineering/formatters, insightsengineering/rtables, tidyverse/magrittr, mllg/checkmate, rstudio/htmltools, gagolews/stringi, tidymodels/broom, cran/car, tidyverse/dplyr, davidgohel/flextable, yihui/knitr, r-lib/lifecycle, davidgohel/officer, Merck/r2rtf, rstudio/rmarkdown, therneau/survival, r-lib/testthat, tidyverse/tibble, tidyverse/tidyr, r-lib/withr, r-lib/xml2", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "Language": "en-US", + "RoxygenNote": "7.3.2", + "Collate": "'package.R' 'export_as_docx.R' 'as_flextable.R'", + "NeedsCompilation": "no", + "Author": "Gabriel Becker [ctb], Davide Garolini [aut], Emily de la Rua [aut], Abinaya Yogasekaram [aut], Joe Zhu [aut, cre] (), F. Hoffmann-La Roche AG [cph, fnd]", + "Maintainer": "Joe Zhu ", + "Repository": "CRAN" + }, + "sass": { + "Package": "sass", + "Version": "0.4.9", + "Source": "Repository", + "Type": "Package", + "Title": "Syntactically Awesome Style Sheets ('Sass')", + "Description": "An 'SCSS' compiler, powered by the 'LibSass' library. With this, R developers can use variables, inheritance, and functions to generate dynamic style sheets. The package uses the 'Sass CSS' extension language, which is stable, powerful, and CSS compatible.", + "Authors@R": "c( person(\"Joe\", \"Cheng\", , \"joe@rstudio.com\", \"aut\"), person(\"Timothy\", \"Mastny\", , \"tim.mastny@gmail.com\", \"aut\"), person(\"Richard\", \"Iannone\", , \"rich@rstudio.com\", \"aut\", comment = c(ORCID = \"0000-0003-3925-190X\")), person(\"Barret\", \"Schloerke\", , \"barret@rstudio.com\", \"aut\", comment = c(ORCID = \"0000-0001-9986-114X\")), person(\"Carson\", \"Sievert\", , \"carson@rstudio.com\", c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-4958-2844\")), person(\"Christophe\", \"Dervieux\", , \"cderv@rstudio.com\", c(\"ctb\"), comment = c(ORCID = \"0000-0003-4474-2498\")), person(family = \"RStudio\", role = c(\"cph\", \"fnd\")), person(family = \"Sass Open Source Foundation\", role = c(\"ctb\", \"cph\"), comment = \"LibSass library\"), person(\"Greter\", \"Marcel\", role = c(\"ctb\", \"cph\"), comment = \"LibSass library\"), person(\"Mifsud\", \"Michael\", role = c(\"ctb\", \"cph\"), comment = \"LibSass library\"), person(\"Hampton\", \"Catlin\", role = c(\"ctb\", \"cph\"), comment = \"LibSass library\"), person(\"Natalie\", \"Weizenbaum\", role = c(\"ctb\", \"cph\"), comment = \"LibSass library\"), person(\"Chris\", \"Eppstein\", role = c(\"ctb\", \"cph\"), comment = \"LibSass library\"), person(\"Adams\", \"Joseph\", role = c(\"ctb\", \"cph\"), comment = \"json.cpp\"), person(\"Trifunovic\", \"Nemanja\", role = c(\"ctb\", \"cph\"), comment = \"utf8.h\") )", + "License": "MIT + file LICENSE", + "URL": "https://rstudio.github.io/sass/, https://github.com/rstudio/sass", + "BugReports": "https://github.com/rstudio/sass/issues", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.1", + "SystemRequirements": "GNU make", + "Imports": [ + "fs (>= 1.2.4)", + "rlang (>= 0.4.10)", + "htmltools (>= 0.5.1)", + "R6", + "rappdirs" + ], + "Suggests": [ + "testthat", + "knitr", + "rmarkdown", + "withr", + "shiny", + "curl" + ], + "VignetteBuilder": "knitr", + "Config/testthat/edition": "3", + "NeedsCompilation": "yes", + "Author": "Joe Cheng [aut], Timothy Mastny [aut], Richard Iannone [aut] (), Barret Schloerke [aut] (), Carson Sievert [aut, cre] (), Christophe Dervieux [ctb] (), RStudio [cph, fnd], Sass Open Source Foundation [ctb, cph] (LibSass library), Greter Marcel [ctb, cph] (LibSass library), Mifsud Michael [ctb, cph] (LibSass library), Hampton Catlin [ctb, cph] (LibSass library), Natalie Weizenbaum [ctb, cph] (LibSass library), Chris Eppstein [ctb, cph] (LibSass library), Adams Joseph [ctb, cph] (json.cpp), Trifunovic Nemanja [ctb, cph] (utf8.h)", + "Maintainer": "Carson Sievert ", + "Repository": "RSPM" + }, + "scales": { + "Package": "scales", + "Version": "1.3.0", + "Source": "Repository", + "Title": "Scale Functions for Visualization", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = c(\"aut\")), person(\"Thomas Lin\", \"Pedersen\", , \"thomas.pedersen@posit.co\", role = c(\"cre\", \"aut\"), comment = c(ORCID = \"0000-0002-5147-4711\")), person(\"Dana\", \"Seidel\", role = \"aut\"), person(\"Posit, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Graphical scales map data to aesthetics, and provide methods for automatically determining breaks and labels for axes and legends.", + "License": "MIT + file LICENSE", + "URL": "https://scales.r-lib.org, https://github.com/r-lib/scales", + "BugReports": "https://github.com/r-lib/scales/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "cli", + "farver (>= 2.0.3)", + "glue", + "labeling", + "lifecycle", + "munsell (>= 0.5)", + "R6", + "RColorBrewer", + "rlang (>= 1.0.0)", + "viridisLite" + ], + "Suggests": [ + "bit64", + "covr", + "dichromat", + "ggplot2", + "hms (>= 0.5.0)", + "stringi", + "testthat (>= 3.0.0)" + ], + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "LazyLoad": "yes", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [aut], Thomas Lin Pedersen [cre, aut] (), Dana Seidel [aut], Posit, PBC [cph, fnd]", + "Maintainer": "Thomas Lin Pedersen ", + "Repository": "RSPM" + }, + "shiny": { + "Package": "shiny", + "Version": "1.10.0", + "Source": "Repository", + "Type": "Package", + "Title": "Web Application Framework for R", + "Authors@R": "c( person(\"Winston\", \"Chang\", role = c(\"aut\", \"cre\"), email = \"winston@posit.co\", comment = c(ORCID = \"0000-0002-1576-2126\")), person(\"Joe\", \"Cheng\", role = \"aut\", email = \"joe@posit.co\"), person(\"JJ\", \"Allaire\", role = \"aut\", email = \"jj@posit.co\"), person(\"Carson\", \"Sievert\", role = \"aut\", email = \"carson@posit.co\", comment = c(ORCID = \"0000-0002-4958-2844\")), person(\"Barret\", \"Schloerke\", role = \"aut\", email = \"barret@posit.co\", comment = c(ORCID = \"0000-0001-9986-114X\")), person(\"Yihui\", \"Xie\", role = \"aut\", email = \"yihui@posit.co\"), person(\"Jeff\", \"Allen\", role = \"aut\"), person(\"Jonathan\", \"McPherson\", role = \"aut\", email = \"jonathan@posit.co\"), person(\"Alan\", \"Dipert\", role = \"aut\"), person(\"Barbara\", \"Borges\", role = \"aut\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")), person(family = \"jQuery Foundation\", role = \"cph\", comment = \"jQuery library and jQuery UI library\"), person(family = \"jQuery contributors\", role = c(\"ctb\", \"cph\"), comment = \"jQuery library; authors listed in inst/www/shared/jquery-AUTHORS.txt\"), person(family = \"jQuery UI contributors\", role = c(\"ctb\", \"cph\"), comment = \"jQuery UI library; authors listed in inst/www/shared/jqueryui/AUTHORS.txt\"), person(\"Mark\", \"Otto\", role = \"ctb\", comment = \"Bootstrap library\"), person(\"Jacob\", \"Thornton\", role = \"ctb\", comment = \"Bootstrap library\"), person(family = \"Bootstrap contributors\", role = \"ctb\", comment = \"Bootstrap library\"), person(family = \"Twitter, Inc\", role = \"cph\", comment = \"Bootstrap library\"), person(\"Prem Nawaz\", \"Khan\", role = \"ctb\", comment = \"Bootstrap accessibility plugin\"), person(\"Victor\", \"Tsaran\", role = \"ctb\", comment = \"Bootstrap accessibility plugin\"), person(\"Dennis\", \"Lembree\", role = \"ctb\", comment = \"Bootstrap accessibility plugin\"), person(\"Srinivasu\", \"Chakravarthula\", role = \"ctb\", comment = \"Bootstrap accessibility plugin\"), person(\"Cathy\", \"O'Connor\", role = \"ctb\", comment = \"Bootstrap accessibility plugin\"), person(family = \"PayPal, Inc\", role = \"cph\", comment = \"Bootstrap accessibility plugin\"), person(\"Stefan\", \"Petre\", role = c(\"ctb\", \"cph\"), comment = \"Bootstrap-datepicker library\"), person(\"Andrew\", \"Rowls\", role = c(\"ctb\", \"cph\"), comment = \"Bootstrap-datepicker library\"), person(\"Brian\", \"Reavis\", role = c(\"ctb\", \"cph\"), comment = \"selectize.js library\"), person(\"Salmen\", \"Bejaoui\", role = c(\"ctb\", \"cph\"), comment = \"selectize-plugin-a11y library\"), person(\"Denis\", \"Ineshin\", role = c(\"ctb\", \"cph\"), comment = \"ion.rangeSlider library\"), person(\"Sami\", \"Samhuri\", role = c(\"ctb\", \"cph\"), comment = \"Javascript strftime library\"), person(family = \"SpryMedia Limited\", role = c(\"ctb\", \"cph\"), comment = \"DataTables library\"), person(\"John\", \"Fraser\", role = c(\"ctb\", \"cph\"), comment = \"showdown.js library\"), person(\"John\", \"Gruber\", role = c(\"ctb\", \"cph\"), comment = \"showdown.js library\"), person(\"Ivan\", \"Sagalaev\", role = c(\"ctb\", \"cph\"), comment = \"highlight.js library\"), person(family = \"R Core Team\", role = c(\"ctb\", \"cph\"), comment = \"tar implementation from R\") )", + "Description": "Makes it incredibly easy to build interactive web applications with R. Automatic \"reactive\" binding between inputs and outputs and extensive prebuilt widgets make it possible to build beautiful, responsive, and powerful applications with minimal effort.", + "License": "GPL-3 | file LICENSE", + "Depends": [ + "R (>= 3.0.2)", + "methods" + ], + "Imports": [ + "utils", + "grDevices", + "httpuv (>= 1.5.2)", + "mime (>= 0.3)", + "jsonlite (>= 0.9.16)", + "xtable", + "fontawesome (>= 0.4.0)", + "htmltools (>= 0.5.4)", + "R6 (>= 2.0)", + "sourcetools", + "later (>= 1.0.0)", + "promises (>= 1.3.2)", + "tools", + "crayon", + "rlang (>= 0.4.10)", + "fastmap (>= 1.1.1)", + "withr", + "commonmark (>= 1.7)", + "glue (>= 1.3.2)", + "bslib (>= 0.6.0)", + "cachem (>= 1.1.0)", + "lifecycle (>= 0.2.0)" + ], + "Suggests": [ + "coro (>= 1.1.0)", + "datasets", + "DT", + "Cairo (>= 1.5-5)", + "testthat (>= 3.0.0)", + "knitr (>= 1.6)", + "markdown", + "rmarkdown", + "ggplot2", + "reactlog (>= 1.0.0)", + "magrittr", + "yaml", + "future", + "dygraphs", + "ragg", + "showtext", + "sass" + ], + "URL": "https://shiny.posit.co/, https://github.com/rstudio/shiny", + "BugReports": "https://github.com/rstudio/shiny/issues", + "Collate": "'globals.R' 'app-state.R' 'app_template.R' 'bind-cache.R' 'bind-event.R' 'bookmark-state-local.R' 'bookmark-state.R' 'bootstrap-deprecated.R' 'bootstrap-layout.R' 'conditions.R' 'map.R' 'utils.R' 'bootstrap.R' 'busy-indicators-spinners.R' 'busy-indicators.R' 'cache-utils.R' 'deprecated.R' 'devmode.R' 'diagnose.R' 'extended-task.R' 'fileupload.R' 'graph.R' 'reactives.R' 'reactive-domains.R' 'history.R' 'hooks.R' 'html-deps.R' 'image-interact-opts.R' 'image-interact.R' 'imageutils.R' 'input-action.R' 'input-checkbox.R' 'input-checkboxgroup.R' 'input-date.R' 'input-daterange.R' 'input-file.R' 'input-numeric.R' 'input-password.R' 'input-radiobuttons.R' 'input-select.R' 'input-slider.R' 'input-submit.R' 'input-text.R' 'input-textarea.R' 'input-utils.R' 'insert-tab.R' 'insert-ui.R' 'jqueryui.R' 'knitr.R' 'middleware-shiny.R' 'middleware.R' 'timer.R' 'shiny.R' 'mock-session.R' 'modal.R' 'modules.R' 'notifications.R' 'priorityqueue.R' 'progress.R' 'react.R' 'reexports.R' 'render-cached-plot.R' 'render-plot.R' 'render-table.R' 'run-url.R' 'runapp.R' 'serializers.R' 'server-input-handlers.R' 'server-resource-paths.R' 'server.R' 'shiny-options.R' 'shiny-package.R' 'shinyapp.R' 'shinyui.R' 'shinywrappers.R' 'showcase.R' 'snapshot.R' 'staticimports.R' 'tar.R' 'test-export.R' 'test-server.R' 'test.R' 'update-input.R' 'utils-lang.R' 'version_bs_date_picker.R' 'version_ion_range_slider.R' 'version_jquery.R' 'version_jqueryui.R' 'version_selectize.R' 'version_strftime.R' 'viewer.R'", + "RoxygenNote": "7.3.2", + "Encoding": "UTF-8", + "RdMacros": "lifecycle", + "Config/testthat/edition": "3", + "Config/Needs/check": "shinytest2", + "NeedsCompilation": "no", + "Author": "Winston Chang [aut, cre] (), Joe Cheng [aut], JJ Allaire [aut], Carson Sievert [aut] (), Barret Schloerke [aut] (), Yihui Xie [aut], Jeff Allen [aut], Jonathan McPherson [aut], Alan Dipert [aut], Barbara Borges [aut], Posit Software, PBC [cph, fnd], jQuery Foundation [cph] (jQuery library and jQuery UI library), jQuery contributors [ctb, cph] (jQuery library; authors listed in inst/www/shared/jquery-AUTHORS.txt), jQuery UI contributors [ctb, cph] (jQuery UI library; authors listed in inst/www/shared/jqueryui/AUTHORS.txt), Mark Otto [ctb] (Bootstrap library), Jacob Thornton [ctb] (Bootstrap library), Bootstrap contributors [ctb] (Bootstrap library), Twitter, Inc [cph] (Bootstrap library), Prem Nawaz Khan [ctb] (Bootstrap accessibility plugin), Victor Tsaran [ctb] (Bootstrap accessibility plugin), Dennis Lembree [ctb] (Bootstrap accessibility plugin), Srinivasu Chakravarthula [ctb] (Bootstrap accessibility plugin), Cathy O'Connor [ctb] (Bootstrap accessibility plugin), PayPal, Inc [cph] (Bootstrap accessibility plugin), Stefan Petre [ctb, cph] (Bootstrap-datepicker library), Andrew Rowls [ctb, cph] (Bootstrap-datepicker library), Brian Reavis [ctb, cph] (selectize.js library), Salmen Bejaoui [ctb, cph] (selectize-plugin-a11y library), Denis Ineshin [ctb, cph] (ion.rangeSlider library), Sami Samhuri [ctb, cph] (Javascript strftime library), SpryMedia Limited [ctb, cph] (DataTables library), John Fraser [ctb, cph] (showdown.js library), John Gruber [ctb, cph] (showdown.js library), Ivan Sagalaev [ctb, cph] (highlight.js library), R Core Team [ctb, cph] (tar implementation from R)", + "Maintainer": "Winston Chang ", + "Repository": "CRAN" + }, + "shinyWidgets": { + "Package": "shinyWidgets", + "Version": "0.8.7", + "Source": "Repository", + "Title": "Custom Inputs Widgets for Shiny", + "Authors@R": "c( person(\"Victor\", \"Perrier\", email = \"victor.perrier@dreamrs.fr\", role = c(\"aut\", \"cre\", \"cph\")), person(\"Fanny\", \"Meyer\", role = \"aut\"), person(\"David\", \"Granjon\", role = \"aut\"), person(\"Ian\", \"Fellows\", role = \"ctb\", comment = \"Methods for mutating vertical tabs & updateMultiInput\"), person(\"Wil\", \"Davis\", role = \"ctb\", comment = \"numericRangeInput function\"), person(\"Spencer\", \"Matthews\", role = \"ctb\", comment = \"autoNumeric methods\"), person(family = \"JavaScript and CSS libraries authors\", role = c(\"ctb\", \"cph\"), comment = \"All authors are listed in LICENSE.md\") )", + "Description": "Collection of custom input controls and user interface components for 'Shiny' applications. Give your applications a unique and colorful style !", + "URL": "https://github.com/dreamRs/shinyWidgets, https://dreamrs.github.io/shinyWidgets/", + "BugReports": "https://github.com/dreamRs/shinyWidgets/issues", + "License": "GPL-3", + "Encoding": "UTF-8", + "LazyData": "true", + "RoxygenNote": "7.3.2", + "Depends": [ + "R (>= 3.1.0)" + ], + "Imports": [ + "bslib", + "sass", + "shiny (>= 1.6.0)", + "htmltools (>= 0.5.1)", + "jsonlite", + "grDevices", + "rlang" + ], + "Suggests": [ + "testthat", + "covr", + "ggplot2", + "DT", + "scales", + "shinydashboard", + "shinydashboardPlus" + ], + "NeedsCompilation": "no", + "Author": "Victor Perrier [aut, cre, cph], Fanny Meyer [aut], David Granjon [aut], Ian Fellows [ctb] (Methods for mutating vertical tabs & updateMultiInput), Wil Davis [ctb] (numericRangeInput function), Spencer Matthews [ctb] (autoNumeric methods), JavaScript and CSS libraries authors [ctb, cph] (All authors are listed in LICENSE.md)", + "Maintainer": "Victor Perrier ", + "Repository": "CRAN" + }, + "shinybusy": { + "Package": "shinybusy", + "Version": "0.3.3", + "Source": "Repository", + "Title": "Busy Indicators and Notifications for 'Shiny' Applications", + "Authors@R": "c(person(\"Fanny\", \"Meyer\", role = \"aut\"), person(\"Victor\", \"Perrier\", email = \"victor.perrier@dreamrs.fr\", role = c(\"aut\", \"cre\")), person(\"Silex Technologies\", comment = \"https://www.silex-ip.com\", role = \"fnd\"))", + "Description": "Add indicators (spinner, progress bar, gif) in your 'shiny' applications to show the user that the server is busy. And other tools to let your users know something is happening (send notifications, reports, ...).", + "License": "GPL-3", + "Encoding": "UTF-8", + "Imports": [ + "htmltools", + "shiny", + "jsonlite", + "htmlwidgets" + ], + "RoxygenNote": "7.3.1", + "URL": "https://github.com/dreamRs/shinybusy, https://dreamrs.github.io/shinybusy/", + "BugReports": "https://github.com/dreamRs/shinybusy/issues", + "Suggests": [ + "testthat", + "covr", + "knitr", + "rmarkdown" + ], + "VignetteBuilder": "knitr", + "NeedsCompilation": "no", + "Author": "Fanny Meyer [aut], Victor Perrier [aut, cre], Silex Technologies [fnd] (https://www.silex-ip.com)", + "Maintainer": "Victor Perrier ", + "Repository": "CRAN" + }, + "shinycssloaders": { + "Package": "shinycssloaders", + "Version": "1.1.0", + "Source": "Repository", + "Title": "Add Loading Animations to a 'shiny' Output While It's Recalculating", + "Authors@R": "c( person(\"Dean\",\"Attali\",email=\"daattali@gmail.com\",role=c(\"aut\",\"cre\"), comment = c(\"Maintainer/developer of shinycssloaders since 2019\", ORCID=\"0000-0002-5645-3493\")), person(\"Andras\",\"Sali\",email=\"andras.sali@alphacruncher.hu\",role=c(\"aut\"),comment=\"Original creator of shinycssloaders package\"), person(\"Luke\",\"Hass\",role=c(\"ctb\",\"cph\"),comment=\"Author of included CSS loader code\") )", + "Description": "When a 'Shiny' output (such as a plot, table, map, etc.) is recalculating, it remains visible but gets greyed out. Using 'shinycssloaders', you can add a loading animation (\"spinner\") to outputs instead. By wrapping a 'Shiny' output in 'withSpinner()', a spinner will automatically appear while the output is recalculating. You can also manually show and hide the spinner, or add a full-page spinner to cover the entire page. See the demo online at .", + "License": "MIT + file LICENSE", + "URL": "https://github.com/daattali/shinycssloaders, https://daattali.com/shiny/shinycssloaders-demo/", + "BugReports": "https://github.com/daattali/shinycssloaders/issues", + "Depends": [ + "R (>= 3.1)" + ], + "Imports": [ + "digest", + "glue", + "grDevices", + "htmltools (>= 0.3.5)", + "shiny" + ], + "Suggests": [ + "knitr", + "shinydisconnect", + "shinyjs" + ], + "RoxygenNote": "7.2.3", + "Encoding": "UTF-8", + "NeedsCompilation": "no", + "Author": "Dean Attali [aut, cre] (Maintainer/developer of shinycssloaders since 2019, ), Andras Sali [aut] (Original creator of shinycssloaders package), Luke Hass [ctb, cph] (Author of included CSS loader code)", + "Maintainer": "Dean Attali ", + "Repository": "CRAN" + }, + "shinyjs": { + "Package": "shinyjs", + "Version": "2.1.0", + "Source": "Repository", + "Title": "Easily Improve the User Experience of Your Shiny Apps in Seconds", + "Authors@R": "person(\"Dean\", \"Attali\", email = \"daattali@gmail.com\", role = c(\"aut\", \"cre\"), comment= c(ORCID=\"0000-0002-5645-3493\"))", + "Description": "Perform common useful JavaScript operations in Shiny apps that will greatly improve your apps without having to know any JavaScript. Examples include: hiding an element, disabling an input, resetting an input back to its original value, delaying code execution by a few seconds, and many more useful functions for both the end user and the developer. 'shinyjs' can also be used to easily call your own custom JavaScript functions from R.", + "URL": "https://deanattali.com/shinyjs/", + "BugReports": "https://github.com/daattali/shinyjs/issues", + "Depends": [ + "R (>= 3.1.0)" + ], + "Imports": [ + "digest (>= 0.6.8)", + "jsonlite", + "shiny (>= 1.0.0)" + ], + "Suggests": [ + "htmltools (>= 0.2.9)", + "knitr (>= 1.7)", + "rmarkdown", + "shinyAce", + "shinydisconnect", + "testthat (>= 0.9.1)" + ], + "License": "MIT + file LICENSE", + "VignetteBuilder": "knitr", + "RoxygenNote": "7.1.1", + "Encoding": "UTF-8", + "NeedsCompilation": "no", + "Author": "Dean Attali [aut, cre] ()", + "Maintainer": "Dean Attali ", + "Repository": "RSPM" + }, + "sourcetools": { + "Package": "sourcetools", + "Version": "0.1.7-1", + "Source": "Repository", + "Type": "Package", + "Title": "Tools for Reading, Tokenizing and Parsing R Code", + "Author": "Kevin Ushey", + "Maintainer": "Kevin Ushey ", + "Description": "Tools for the reading and tokenization of R code. The 'sourcetools' package provides both an R and C++ interface for the tokenization of R code, and helpers for interacting with the tokenized representation of R code.", + "License": "MIT + file LICENSE", + "Depends": [ + "R (>= 3.0.2)" + ], + "Suggests": [ + "testthat" + ], + "RoxygenNote": "5.0.1", + "BugReports": "https://github.com/kevinushey/sourcetools/issues", + "Encoding": "UTF-8", + "NeedsCompilation": "yes", + "Repository": "RSPM" + }, + "stringi": { + "Package": "stringi", + "Version": "1.8.4", + "Source": "Repository", + "Date": "2024-05-06", + "Title": "Fast and Portable Character String Processing Facilities", + "Description": "A collection of character string/text/natural language processing tools for pattern searching (e.g., with 'Java'-like regular expressions or the 'Unicode' collation algorithm), random string generation, case mapping, string transliteration, concatenation, sorting, padding, wrapping, Unicode normalisation, date-time formatting and parsing, and many more. They are fast, consistent, convenient, and - thanks to 'ICU' (International Components for Unicode) - portable across all locales and platforms. Documentation about 'stringi' is provided via its website at and the paper by Gagolewski (2022, ).", + "URL": "https://stringi.gagolewski.com/, https://github.com/gagolews/stringi, https://icu.unicode.org/", + "BugReports": "https://github.com/gagolews/stringi/issues", + "SystemRequirements": "ICU4C (>= 61, optional)", + "Type": "Package", + "Depends": [ + "R (>= 3.4)" + ], + "Imports": [ + "tools", + "utils", + "stats" + ], + "Biarch": "TRUE", + "License": "file LICENSE", + "Author": "Marek Gagolewski [aut, cre, cph] (), Bartek Tartanus [ctb], and others (stringi source code); Unicode, Inc. and others (ICU4C source code, Unicode Character Database)", + "Maintainer": "Marek Gagolewski ", + "RoxygenNote": "7.2.3", + "Encoding": "UTF-8", + "NeedsCompilation": "yes", + "License_is_FOSS": "yes", + "Repository": "RSPM" + }, + "stringr": { + "Package": "stringr", + "Version": "1.5.1", + "Source": "Repository", + "Title": "Simple, Consistent Wrappers for Common String Operations", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = c(\"aut\", \"cre\", \"cph\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "A consistent, simple and easy to use set of wrappers around the fantastic 'stringi' package. All function and argument names (and positions) are consistent, all functions deal with \"NA\"'s and zero length vectors in the same way, and the output from one function is easy to feed into the input of another.", + "License": "MIT + file LICENSE", + "URL": "https://stringr.tidyverse.org, https://github.com/tidyverse/stringr", + "BugReports": "https://github.com/tidyverse/stringr/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "cli", + "glue (>= 1.6.1)", + "lifecycle (>= 1.0.3)", + "magrittr", + "rlang (>= 1.0.0)", + "stringi (>= 1.5.3)", + "vctrs (>= 0.4.0)" + ], + "Suggests": [ + "covr", + "dplyr", + "gt", + "htmltools", + "htmlwidgets", + "knitr", + "rmarkdown", + "testthat (>= 3.0.0)", + "tibble" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "LazyData": "true", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "no", + "Author": "Hadley Wickham [aut, cre, cph], Posit Software, PBC [cph, fnd]", + "Maintainer": "Hadley Wickham ", + "Repository": "RSPM" + }, + "styler": { + "Package": "styler", + "Version": "1.10.3", + "Source": "Repository", + "Type": "Package", + "Title": "Non-Invasive Pretty Printing of R Code", + "Authors@R": "c(person(given = \"Kirill\", family = \"Müller\", role = \"aut\", email = \"kirill@cynkra.com\", comment = c(ORCID = \"0000-0002-1416-3412\")), person(given = \"Lorenz\", family = \"Walthert\", role = c(\"cre\", \"aut\"), email = \"lorenz.walthert@icloud.com\"), person(given = \"Indrajeet\", family = \"Patil\", role = \"ctb\", email = \"patilindrajeet.science@gmail.com\", comment = c(ORCID = \"0000-0003-1995-6531\", Twitter = \"@patilindrajeets\")))", + "Description": "Pretty-prints R code without changing the user's formatting intent.", + "License": "MIT + file LICENSE", + "URL": "https://github.com/r-lib/styler, https://styler.r-lib.org", + "BugReports": "https://github.com/r-lib/styler/issues", + "Depends": [ + "R (>= 3.6.0)" + ], + "Imports": [ + "cli (>= 3.1.1)", + "magrittr (>= 2.0.0)", + "purrr (>= 0.2.3)", + "R.cache (>= 0.15.0)", + "rlang (>= 1.0.0)", + "rprojroot (>= 1.1)", + "tools", + "vctrs (>= 0.4.1)", + "withr (>= 2.3.0)" + ], + "Suggests": [ + "data.tree (>= 0.1.6)", + "digest", + "here", + "knitr", + "prettycode", + "rmarkdown", + "roxygen2", + "rstudioapi (>= 0.7)", + "tibble (>= 1.4.2)", + "testthat (>= 3.0.0)" + ], + "VignetteBuilder": "knitr", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.1", + "Config/testthat/edition": "3", + "Config/testthat/parallel": "true", + "Collate": "'addins.R' 'communicate.R' 'compat-dplyr.R' 'compat-tidyr.R' 'detect-alignment-utils.R' 'detect-alignment.R' 'environments.R' 'expr-is.R' 'indent.R' 'initialize.R' 'io.R' 'nest.R' 'nested-to-tree.R' 'parse.R' 'reindent.R' 'token-define.R' 'relevel.R' 'roxygen-examples-add-remove.R' 'roxygen-examples-find.R' 'roxygen-examples-parse.R' 'roxygen-examples.R' 'rules-indention.R' 'rules-line-breaks.R' 'rules-spaces.R' 'rules-tokens.R' 'serialize.R' 'set-assert-args.R' 'style-guides.R' 'styler-package.R' 'stylerignore.R' 'testing-mocks.R' 'testing-public-api.R' 'ui-caching.R' 'testing.R' 'token-create.R' 'transform-block.R' 'transform-code.R' 'transform-files.R' 'ui-styling.R' 'unindent.R' 'utils-cache.R' 'utils-files.R' 'utils-navigate-nest.R' 'utils-strings.R' 'utils.R' 'vertical.R' 'visit.R' 'zzz.R'", + "NeedsCompilation": "no", + "Author": "Kirill Müller [aut] (), Lorenz Walthert [cre, aut], Indrajeet Patil [ctb] (, @patilindrajeets)", + "Maintainer": "Lorenz Walthert ", + "Repository": "CRAN" + }, + "sys": { + "Package": "sys", + "Version": "3.4.3", + "Source": "Repository", + "Type": "Package", + "Title": "Powerful and Reliable Tools for Running System Commands in R", + "Authors@R": "c(person(\"Jeroen\", \"Ooms\", role = c(\"aut\", \"cre\"), email = \"jeroenooms@gmail.com\", comment = c(ORCID = \"0000-0002-4035-0289\")), person(\"Gábor\", \"Csárdi\", , \"csardi.gabor@gmail.com\", role = \"ctb\"))", + "Description": "Drop-in replacements for the base system2() function with fine control and consistent behavior across platforms. Supports clean interruption, timeout, background tasks, and streaming STDIN / STDOUT / STDERR over binary or text connections. Arguments on Windows automatically get encoded and quoted to work on different locales.", + "License": "MIT + file LICENSE", + "URL": "https://jeroen.r-universe.dev/sys", + "BugReports": "https://github.com/jeroen/sys/issues", + "Encoding": "UTF-8", + "RoxygenNote": "7.1.1", + "Suggests": [ + "unix (>= 1.4)", + "spelling", + "testthat" + ], + "Language": "en-US", + "NeedsCompilation": "yes", + "Author": "Jeroen Ooms [aut, cre] (), Gábor Csárdi [ctb]", + "Maintainer": "Jeroen Ooms ", + "Repository": "RSPM" + }, + "systemfonts": { + "Package": "systemfonts", + "Version": "1.2.1", + "Source": "Repository", + "Type": "Package", + "Title": "System Native Font Finding", + "Authors@R": "c( person(\"Thomas Lin\", \"Pedersen\", , \"thomas.pedersen@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-5147-4711\")), person(\"Jeroen\", \"Ooms\", , \"jeroen@berkeley.edu\", role = \"aut\", comment = c(ORCID = \"0000-0002-4035-0289\")), person(\"Devon\", \"Govett\", role = \"aut\", comment = \"Author of font-manager\"), person(\"Posit, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Provides system native access to the font catalogue. As font handling varies between systems it is difficult to correctly locate installed fonts across different operating systems. The 'systemfonts' package provides bindings to the native libraries on Windows, macOS and Linux for finding font files that can then be used further by e.g. graphic devices. The main use is intended to be from compiled code but 'systemfonts' also provides access from R.", + "License": "MIT + file LICENSE", + "URL": "https://github.com/r-lib/systemfonts, https://systemfonts.r-lib.org", + "BugReports": "https://github.com/r-lib/systemfonts/issues", + "Depends": [ + "R (>= 3.2.0)" + ], + "Suggests": [ + "covr", + "farver", + "graphics", + "knitr", + "rmarkdown", + "testthat (>= 2.1.0)" + ], + "LinkingTo": [ + "cpp11 (>= 0.2.1)" + ], + "VignetteBuilder": "knitr", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "SystemRequirements": "fontconfig, freetype2", + "Config/Needs/website": "tidyverse/tidytemplate", + "Imports": [ + "grid", + "jsonlite", + "lifecycle", + "tools", + "utils" + ], + "Config/build/compilation-database": "true", + "NeedsCompilation": "yes", + "Author": "Thomas Lin Pedersen [aut, cre] (), Jeroen Ooms [aut] (), Devon Govett [aut] (Author of font-manager), Posit, PBC [cph, fnd]", + "Maintainer": "Thomas Lin Pedersen ", + "Repository": "CRAN" + }, + "teal": { + "Package": "teal", + "Version": "0.15.2.9131", + "Source": "Repository", + "Type": "Package", + "Title": "Exploratory Web Apps for Analyzing Clinical Trials Data", + "Date": "2025-02-12", + "Authors@R": "c( person(\"Dawid\", \"Kaledkowski\", , \"dawid.kaledkowski@roche.com\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0001-9533-457X\")), person(\"Pawel\", \"Rucki\", , \"pawel.rucki@roche.com\", role = \"aut\"), person(\"Aleksander\", \"Chlebowski\", , \"aleksander.chlebowski@contractors.roche.com\", role = \"aut\", comment = c(ORCID = \"0000-0001-5018-6294\")), person(\"Andre\", \"Verissimo\", , \"andre.verissimo@roche.com\", role = \"aut\", comment = c(ORCID = \"0000-0002-2212-339X\")), person(\"Kartikeya\", \"Kirar\", , \"kartikeya.kirar@businesspartner.roche.com\", role = \"aut\"), person(\"Vedha\", \"Viyash\", , \"vedha.viyash@roche.com\", role = \"aut\"), person(\"Marcin\", \"Kosinski\", , \"marcin.kosinski.mk1@roche.com\", role = \"aut\"), person(\"Adrian\", \"Waddell\", , \"adrian.waddell@gene.com\", role = \"aut\"), person(\"Chendi\", \"Liao\", , \"chendi.liao@roche.com\", role = \"rev\"), person(\"Dony\", \"Unardi\", , \"unardid@gene.com\", role = \"rev\"), person(\"Nikolas\", \"Burkoff\", role = \"aut\"), person(\"Mahmoud\", \"Hallal\", role = \"aut\"), person(\"Maciej\", \"Nasinski\", role = \"aut\"), person(\"Konrad\", \"Pagacz\", role = \"aut\"), person(\"Junlue\", \"Zhao\", role = \"aut\"), person(\"Tadeusz\", \"Lewandowski\", role = \"aut\"), person(\"F. Hoffmann-La Roche AG\", role = c(\"cph\", \"fnd\")), person(\"Maximilian\", \"Mordig\", role = \"ctb\") )", + "Description": "A 'shiny' based interactive exploration framework for analyzing clinical trials data. 'teal' currently provides a dynamic filtering facility and different data viewers. 'teal' 'shiny' applications are built using standard 'shiny' modules.", + "License": "Apache License 2.0", + "URL": "https://insightsengineering.github.io/teal/, https://github.com/insightsengineering/teal/", + "BugReports": "https://github.com/insightsengineering/teal/issues", + "Depends": [ + "R (>= 4.1)", + "shiny (>= 1.8.1)", + "teal.data (>= 0.7.0)", + "teal.slice (>= 0.6.0)" + ], + "Imports": [ + "checkmate (>= 2.1.0)", + "cli", + "htmltools", + "jsonlite", + "lifecycle (>= 0.2.0)", + "logger (>= 0.2.0)", + "methods", + "rlang (>= 1.0.0)", + "shinyjs", + "stats", + "teal.code (>= 0.6.0)", + "teal.logger (>= 0.3.1)", + "teal.reporter (>= 0.4.0)", + "teal.widgets (>= 0.4.3)", + "tools", + "utils" + ], + "Suggests": [ + "bslib", + "ggplot2 (>= 3.4.0)", + "knitr (>= 1.42)", + "mirai (>= 1.1.1)", + "MultiAssayExperiment", + "R6", + "renv (>= 1.0.11)", + "rmarkdown (>= 2.23)", + "roxy.shinylive", + "rvest (>= 1.0.0)", + "shinytest2", + "shinyvalidate", + "testthat (>= 3.2.0)", + "withr (>= 2.1.0)", + "yaml (>= 1.1.0)" + ], + "VignetteBuilder": "knitr, rmarkdown", + "RdMacros": "lifecycle", + "Config/Needs/verdepcheck": "rstudio/shiny, insightsengineering/teal.data, insightsengineering/teal.slice, mllg/checkmate, jeroen/jsonlite, r-lib/lifecycle, daroczig/logger, shikokuchuo/mirai, r-lib/cli, shikokuchuo/nanonext, rstudio/renv, r-lib/rlang, daattali/shinyjs, insightsengineering/teal.code, insightsengineering/teal.logger, insightsengineering/teal.reporter, insightsengineering/teal.widgets, rstudio/bslib, yihui/knitr, bioc::MultiAssayExperiment, r-lib/R6, rstudio/rmarkdown, tidyverse/rvest, rstudio/shinytest2, rstudio/shinyvalidate, r-lib/testthat, r-lib/withr, yaml=vubiostat/r-yaml, rstudio/htmltools, bioc::matrixStats, insightsengineering/roxy.shinylive", + "Config/Needs/website": "insightsengineering/nesttemplate", + "Encoding": "UTF-8", + "Language": "en-US", + "Roxygen": "list(markdown = TRUE, packages = c(\"roxy.shinylive\"))", + "RoxygenNote": "7.3.2", + "Collate": "'TealAppDriver.R' 'checkmate.R' 'dummy_functions.R' 'include_css_js.R' 'modules.R' 'init.R' 'landing_popup_module.R' 'module_bookmark_manager.R' 'module_data_summary.R' 'module_filter_data.R' 'module_filter_manager.R' 'module_init_data.R' 'module_nested_tabs.R' 'module_session_info.R' 'module_snapshot_manager.R' 'module_teal.R' 'module_teal_data.R' 'module_teal_lockfile.R' 'module_teal_with_splash.R' 'module_transform_data.R' 'reporter_previewer_module.R' 'show_rcode_modal.R' 'tdata.R' 'teal.R' 'teal_data_module.R' 'teal_data_module-eval_code.R' 'teal_data_module-within.R' 'teal_data_utils.R' 'teal_modifiers.R' 'teal_reporter.R' 'teal_slices-store.R' 'teal_slices.R' 'teal_transform_module.R' 'utils.R' 'validate_inputs.R' 'validations.R' 'zzz.R'", + "Config/pak/sysreqs": "libcairo2-dev libfontconfig1-dev libfreetype6-dev libfribidi-dev make libharfbuzz-dev libicu-dev libjpeg-dev libpng-dev libtiff-dev libxml2-dev libssl-dev zlib1g-dev", + "Repository": "https://pharmaverse.r-universe.dev", + "RemoteUrl": "https://github.com/insightsengineering/teal", + "RemoteRef": "HEAD", + "RemoteSha": "c75f39ed4f4eb989059e7a22aace4a8cfb020bc6", + "NeedsCompilation": "no", + "Author": "Dawid Kaledkowski [aut, cre] (), Pawel Rucki [aut], Aleksander Chlebowski [aut] (), Andre Verissimo [aut] (), Kartikeya Kirar [aut], Vedha Viyash [aut], Marcin Kosinski [aut], Adrian Waddell [aut], Chendi Liao [rev], Dony Unardi [rev], Nikolas Burkoff [aut], Mahmoud Hallal [aut], Maciej Nasinski [aut], Konrad Pagacz [aut], Junlue Zhao [aut], Tadeusz Lewandowski [aut], F. Hoffmann-La Roche AG [cph, fnd], Maximilian Mordig [ctb]", + "Maintainer": "Dawid Kaledkowski " + }, + "teal.code": { + "Package": "teal.code", + "Version": "0.6.0.9002", + "Source": "Repository", + "Type": "Package", + "Title": "Code Storage and Execution Class for 'teal' Applications", + "Date": "2025-02-04", + "Authors@R": "c( person(\"Dawid\", \"Kaledkowski\", , \"dawid.kaledkowski@roche.com\", role = c(\"aut\", \"cre\")), person(\"Aleksander\", \"Chlebowski\", , \"aleksander.chlebowski@contractors.roche.com\", role = \"aut\"), person(\"Marcin\", \"Kosinski\", , \"marcin.kosinski.mk1@roche.com\", role = \"aut\"), person(\"Pawel\", \"Rucki\", , \"pawel.rucki@roche.com\", role = \"aut\"), person(\"Nikolas\", \"Burkoff\", , \"nikolas.burkoff@roche.com\", role = \"aut\"), person(\"Mahmoud\", \"Hallal\", , \"mahmoud.hallal@roche.com\", role = \"aut\"), person(\"Maciej\", \"Nasinski\", , \"maciej.nasinski@contractors.roche.com\", role = \"aut\"), person(\"Konrad\", \"Pagacz\", , \"konrad.pagacz@contractors.roche.com\", role = \"aut\"), person(\"Junlue\", \"Zhao\", , \"zhaoj88@gene.com\", role = \"aut\"), person(\"Chendi\", \"Liao\", , \"chendi.liao@roche.com\", role = \"rev\"), person(\"Dony\", \"Unardi\", , \"unardid@gene.com\", role = \"rev\"), person(\"F. Hoffmann-La Roche AG\", role = c(\"cph\", \"fnd\")) )", + "Description": "Introduction of 'qenv' S4 class, that facilitates code execution and reproducibility in 'teal' applications.", + "License": "Apache License 2.0", + "URL": "https://insightsengineering.github.io/teal.code/, https://github.com/insightsengineering/teal.code", + "BugReports": "https://github.com/insightsengineering/teal.code/issues", + "Depends": [ + "methods", + "R (>= 4.0)" + ], + "Imports": [ + "checkmate (>= 2.1.0)", + "cli (>= 3.4.0)", + "grDevices", + "lifecycle (>= 0.2.0)", + "rlang (>= 1.1.0)", + "stats", + "utils" + ], + "Suggests": [ + "knitr (>= 1.42)", + "rmarkdown (>= 2.23)", + "shiny (>= 1.6.0)", + "testthat (>= 3.1.8)", + "withr (>= 2.0.0)" + ], + "VignetteBuilder": "knitr, rmarkdown", + "RdMacros": "lifecycle", + "Config/Needs/verdepcheck": "mllg/checkmate, r-lib/cli, r-lib/lifecycle, r-lib/rlang, r-lib/cli, yihui/knitr, rstudio/rmarkdown, rstudio/shiny, r-lib/testthat, r-lib/withr", + "Config/Needs/website": "insightsengineering/nesttemplate", + "Encoding": "UTF-8", + "Language": "en-US", + "Roxygen": "list(markdown = TRUE)", + "RoxygenNote": "7.3.2", + "Collate": "'qenv-c.R' 'qenv-class.R' 'qenv-errors.R' 'qenv-concat.R' 'qenv-constructor.R' 'qenv-eval_code.R' 'qenv-extract.R' 'qenv-get_code.R' 'qenv-get_env.R' 'qenv-get_messages.r' 'qenv-get_var.R' 'qenv-get_warnings.R' 'qenv-join.R' 'qenv-length.R' 'qenv-show.R' 'qenv-within.R' 'teal.code-package.R' 'utils-get_code_dependency.R' 'utils.R'", + "Repository": "https://pharmaverse.r-universe.dev", + "RemoteUrl": "https://github.com/insightsengineering/teal.code", + "RemoteRef": "HEAD", + "RemoteSha": "b336941dcc830a9b01fc8e206831cc4367599161", + "NeedsCompilation": "no", + "Author": "Dawid Kaledkowski [aut, cre], Aleksander Chlebowski [aut], Marcin Kosinski [aut], Pawel Rucki [aut], Nikolas Burkoff [aut], Mahmoud Hallal [aut], Maciej Nasinski [aut], Konrad Pagacz [aut], Junlue Zhao [aut], Chendi Liao [rev], Dony Unardi [rev], F. Hoffmann-La Roche AG [cph, fnd]", + "Maintainer": "Dawid Kaledkowski " + }, + "teal.data": { + "Package": "teal.data", + "Version": "0.7.0.9001", + "Source": "Repository", + "Type": "Package", + "Title": "Data Model for 'teal' Applications", + "Date": "2025-01-31", + "Authors@R": "c( person(\"Dawid\", \"Kaledkowski\", , \"dawid.kaledkowski@roche.com\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0001-9533-457X\")), person(\"Aleksander\", \"Chlebowski\", , \"aleksander.chlebowski@contractors.roche.com\", role = \"aut\", comment = c(ORCID = \"0000-0001-5018-6294\")), person(\"Marcin\", \"Kosinski\", , \"marcin.kosinski.mk1@roche.com\", role = \"aut\"), person(\"Andre\", \"Verissimo\", , \"andre.verissimo@roche.com\", role = \"aut\", comment = c(ORCID = \"0000-0002-2212-339X\")), person(\"Pawel\", \"Rucki\", , \"pawel.rucki@roche.com\", role = \"aut\"), person(\"Mahmoud\", \"Hallal\", , \"mahmoud.hallal@roche.com\", role = \"aut\"), person(\"Nikolas\", \"Burkoff\", role = \"aut\"), person(\"Maciej\", \"Nasinski\", role = \"aut\"), person(\"Konrad\", \"Pagacz\", role = \"aut\"), person(\"Junlue\", \"Zhao\", role = \"aut\"), person(\"Chendi\", \"Liao\", , \"chendi.liao@roche.com\", role = \"rev\"), person(\"Dony\", \"Unardi\", , \"unardid@gene.com\", role = \"rev\"), person(\"F. Hoffmann-La Roche AG\", role = c(\"cph\", \"fnd\")) )", + "Description": "Provides a 'teal_data' class as a unified data model for 'teal' applications focusing on reproducibility and relational data.", + "License": "Apache License 2.0", + "URL": "https://insightsengineering.github.io/teal.data/, https://github.com/insightsengineering/teal.data/", + "BugReports": "https://github.com/insightsengineering/teal.data/issues", + "Depends": [ + "R (>= 4.0)", + "teal.code (>= 0.6.0)" + ], + "Imports": [ + "checkmate (>= 2.1.0)", + "lifecycle (>= 0.2.0)", + "methods", + "rlang (>= 1.1.0)", + "stats", + "utils" + ], + "Suggests": [ + "knitr (>= 1.42)", + "rmarkdown (>= 2.23)", + "testthat (>= 3.2.2)", + "withr (>= 2.0.0)" + ], + "VignetteBuilder": "knitr, rmarkdown", + "RdMacros": "lifecycle", + "Config/Needs/verdepcheck": "insightsengineering/teal.code, mllg/checkmate, r-lib/lifecycle, r-lib/rlang, yihui/knitr, rstudio/rmarkdown, r-lib/testthat, r-lib/withr", + "Config/Needs/website": "insightsengineering/nesttemplate", + "Encoding": "UTF-8", + "Language": "en-US", + "LazyData": "true", + "Roxygen": "list(markdown = TRUE)", + "RoxygenNote": "7.3.2", + "Collate": "'cdisc_data.R' 'data.R' 'formatters_var_labels.R' 'deprecated.R' 'dummy_function.R' 'join_key.R' 'join_keys-c.R' 'join_keys-extract.R' 'join_keys-names.R' 'join_keys-parents.R' 'join_keys-print.R' 'join_keys-utils.R' 'join_keys.R' 'teal.data.R' 'teal_data-class.R' 'teal_data-constructor.R' 'teal_data-extract.R' 'teal_data-get_code.R' 'teal_data-names.R' 'teal_data-show.R' 'testhat-helpers.R' 'topological_sort.R' 'verify.R' 'zzz.R'", + "Repository": "https://pharmaverse.r-universe.dev", + "RemoteUrl": "https://github.com/insightsengineering/teal.data", + "RemoteRef": "HEAD", + "RemoteSha": "9100800ce0572092f6f2e0288d099e6b77ab160c", + "NeedsCompilation": "no", + "Author": "Dawid Kaledkowski [aut, cre] (), Aleksander Chlebowski [aut] (), Marcin Kosinski [aut], Andre Verissimo [aut] (), Pawel Rucki [aut], Mahmoud Hallal [aut], Nikolas Burkoff [aut], Maciej Nasinski [aut], Konrad Pagacz [aut], Junlue Zhao [aut], Chendi Liao [rev], Dony Unardi [rev], F. Hoffmann-La Roche AG [cph, fnd]", + "Maintainer": "Dawid Kaledkowski " + }, + "teal.logger": { + "Package": "teal.logger", + "Version": "0.3.1.9001", + "Source": "Repository", + "Title": "Logging Setup for the 'teal' Family of Packages", + "Date": "2025-02-06", + "Authors@R": "c( person(\"Dawid\", \"Kaledkowski\", , \"dawid.kaledkowski@roche.com\", role = c(\"aut\", \"cre\")), person(\"Konrad\", \"Pagacz\", role = \"aut\"), person(\"F. Hoffmann-La Roche AG\", role = c(\"cph\", \"fnd\")) )", + "Description": "Utilizing the 'logger' framework to record events within a package, specific to 'teal' family of packages. Supports logging namespaces, hierarchical logging, various log destinations, vectorization, and more.", + "License": "Apache License 2.0", + "URL": "https://insightsengineering.github.io/teal.logger/, https://github.com/insightsengineering/teal.logger/", + "BugReports": "https://github.com/insightsengineering/teal.logger/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "glue (>= 1.0.0)", + "lifecycle (>= 0.2.0)", + "logger (>= 0.3.0)", + "methods", + "shiny (>= 1.6.0)", + "utils", + "withr (>= 2.1.0)" + ], + "Suggests": [ + "knitr (>= 1.42)", + "rmarkdown (>= 2.23)", + "testthat (>= 3.1.7)" + ], + "VignetteBuilder": "knitr, rmarkdown", + "RdMacros": "lifecycle", + "Config/Needs/verdepcheck": "tidyverse/glue, r-lib/lifecycle, daroczig/logger, rstudio/shiny, r-lib/withr, yihui/knitr, rstudio/rmarkdown, r-lib/testthat", + "Config/Needs/website": "insightsengineering/nesttemplate", + "Encoding": "UTF-8", + "Language": "en-US", + "Roxygen": "list(markdown = TRUE)", + "RoxygenNote": "7.3.2", + "Config/pak/sysreqs": "make zlib1g-dev", + "Repository": "https://pharmaverse.r-universe.dev", + "RemoteUrl": "https://github.com/insightsengineering/teal.logger", + "RemoteRef": "HEAD", + "RemoteSha": "99657d4725f47966d9f7502f7d266947228011d6", + "NeedsCompilation": "no", + "Author": "Dawid Kaledkowski [aut, cre], Konrad Pagacz [aut], F. Hoffmann-La Roche AG [cph, fnd]", + "Maintainer": "Dawid Kaledkowski " + }, + "teal.reporter": { + "Package": "teal.reporter", + "Version": "0.4.0.9003", + "Source": "Repository", + "Title": "Reporting Tools for 'shiny' Modules", + "Date": "2025-01-31", + "Authors@R": "c( person(\"Dawid\", \"Kaledkowski\", , \"dawid.kaledkowski@roche.com\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0001-9533-457X\")), person(\"Kartikeya\", \"Kirar\", , \"kartikeya.kirar@businesspartner.roche.com\", role = \"aut\", comment = c(ORCID = \"0009-0005-1258-4757\")), person(\"Marcin\", \"Kosinski\", , \"marcin.kosinski.mk1@roche.com\", role = \"aut\"), person(\"Maciej\", \"Nasinski\", role = \"aut\"), person(\"Konrad\", \"Pagacz\", role = \"aut\"), person(\"Mahmoud\", \"Hallal\", , \"mahmoud.hallal@roche.com\", role = \"aut\"), person(\"Chendi\", \"Liao\", , \"chendi.liao@roche.com\", role = \"rev\"), person(\"Dony\", \"Unardi\", , \"unardid@gene.com\", role = \"rev\"), person(\"F. Hoffmann-La Roche AG\", role = c(\"cph\", \"fnd\")) )", + "Description": "Prebuilt 'shiny' modules containing tools for the generation of 'rmarkdown' reports, supporting reproducible research and analysis.", + "License": "Apache License 2.0", + "URL": "https://github.com/insightsengineering/teal.reporter, https://insightsengineering.github.io/teal.reporter/", + "BugReports": "https://github.com/insightsengineering/teal.reporter/issues", + "Imports": [ + "bslib", + "checkmate (>= 2.1.0)", + "flextable (>= 0.9.2)", + "grid", + "htmltools (>= 0.5.4)", + "knitr (>= 1.42)", + "lifecycle (>= 0.2.0)", + "R6", + "rlistings (>= 0.2.10)", + "rmarkdown (>= 2.23)", + "rtables (>= 0.6.11)", + "rtables.officer (>= 0.0.2)", + "shiny (>= 1.6.0)", + "shinybusy (>= 0.3.2)", + "shinyWidgets (>= 0.5.1)", + "yaml (>= 1.1.0)", + "zip (>= 1.1.0)" + ], + "Suggests": [ + "DT (>= 0.13)", + "formatR (>= 1.5)", + "formatters (>= 0.5.10)", + "ggplot2 (>= 3.4.3)", + "lattice (>= 0.18-4)", + "png", + "testthat (>= 3.2.2)", + "tinytex", + "withr (>= 2.0.0)" + ], + "VignetteBuilder": "knitr, rmarkdown", + "RdMacros": "lifecycle", + "Config/Needs/verdepcheck": "rstudio/bslib, mllg/checkmate, davidgohel/flextable, rstudio/htmltools, yihui/knitr, r-lib/lifecycle, r-lib/R6, insightsengineering/rlistings, rstudio/rmarkdown, insightsengineering/rtables, insightsengineering/rtables.officer, rstudio/shiny, dreamRs/shinybusy, dreamRs/shinyWidgets, yaml=vubiostat/r-yaml, r-lib/zip, rstudio/DT, yihui/formatR, insightsengineering/formatters, tidyverse/ggplot2, deepayan/lattice, cran/png, r-lib/testthat, rstudio/tinytex, r-lib/withr", + "Config/Needs/website": "insightsengineering/nesttemplate", + "Encoding": "UTF-8", + "Language": "en-US", + "Roxygen": "list(markdown = TRUE)", + "RoxygenNote": "7.3.2", + "Config/pak/sysreqs": "libcairo2-dev libfontconfig1-dev libfreetype6-dev libfribidi-dev make libharfbuzz-dev libicu-dev libjpeg-dev libpng-dev libtiff-dev libxml2-dev libssl-dev zlib1g-dev", + "Repository": "https://pharmaverse.r-universe.dev", + "RemoteUrl": "https://github.com/insightsengineering/teal.reporter", + "RemoteRef": "HEAD", + "RemoteSha": "b19bdd307fe24c9678a984beb57bc6e9e5c1643f", + "NeedsCompilation": "no", + "Author": "Dawid Kaledkowski [aut, cre] (), Kartikeya Kirar [aut] (), Marcin Kosinski [aut], Maciej Nasinski [aut], Konrad Pagacz [aut], Mahmoud Hallal [aut], Chendi Liao [rev], Dony Unardi [rev], F. Hoffmann-La Roche AG [cph, fnd]", + "Maintainer": "Dawid Kaledkowski " + }, + "teal.slice": { + "Package": "teal.slice", + "Version": "0.6.0.9000", + "Source": "Repository", + "Type": "Package", + "Title": "Filter Module for 'teal' Applications", + "Date": "2025-02-04", + "Authors@R": "c( person(\"Dawid\", \"Kaledkowski\", , \"dawid.kaledkowski@roche.com\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0001-9533-457X\")), person(\"Pawel\", \"Rucki\", , \"pawel.rucki@roche.com\", role = \"aut\"), person(\"Aleksander\", \"Chlebowski\", , \"aleksander.chlebowski@contractors.roche.com\", role = \"aut\", comment = c(ORCID = \"0000-0001-5018-6294\")), person(\"Andre\", \"Verissimo\", , \"andre.verissimo@roche.com\", role = \"aut\", comment = c(ORCID = \"0000-0002-2212-339X\")), person(\"Kartikeya\", \"Kirar\", , \"kartikeya.kirar@businesspartner.roche.com\", role = \"aut\"), person(\"Marcin\", \"Kosinski\", , \"marcin.kosinski.mk1@roche.com\", role = \"aut\"), person(\"Chendi\", \"Liao\", , \"chendi.liao@roche.com\", role = \"rev\"), person(\"Dony\", \"Unardi\", , \"unardid@gene.com\", role = \"rev\"), person(\"Andrew\", \"Bates\", role = \"aut\"), person(\"Mahmoud\", \"Hallal\", role = \"aut\"), person(\"Nikolas\", \"Burkoff\", role = \"aut\"), person(\"Maciej\", \"Nasinski\", role = \"aut\"), person(\"Konrad\", \"Pagacz\", role = \"aut\"), person(\"Junlue\", \"Zhao\", role = \"aut\"), person(\"F. Hoffmann-La Roche AG\", role = c(\"cph\", \"fnd\")) )", + "Description": "Data filtering module for 'teal' applications. Allows for interactive filtering of data stored in 'data.frame' and 'MultiAssayExperiment' objects. Also displays filtered and unfiltered observation counts.", + "License": "Apache License 2.0", + "URL": "https://insightsengineering.github.io/teal.slice/, https://github.com/insightsengineering/teal.slice/", + "BugReports": "https://github.com/insightsengineering/teal.slice/issues", + "Depends": [ + "R (>= 4.0)" + ], + "Imports": [ + "bslib (>= 0.4.0)", + "checkmate (>= 2.1.0)", + "dplyr (>= 1.0.5)", + "grDevices", + "htmltools (>= 0.5.4)", + "jsonlite", + "lifecycle (>= 0.2.0)", + "logger (>= 0.3.0)", + "methods", + "plotly (>= 4.9.2.2)", + "R6 (>= 2.2.0)", + "rlang (>= 1.0.0)", + "shiny (>= 1.6.0)", + "shinycssloaders (>= 1.0.0)", + "shinyjs", + "shinyWidgets (>= 0.6.2)", + "teal.data (>= 0.7.0)", + "teal.logger (>= 0.3.1)", + "teal.widgets (>= 0.4.3)", + "utils" + ], + "Suggests": [ + "knitr (>= 1.42)", + "MultiAssayExperiment", + "rmarkdown (>= 2.23)", + "SummarizedExperiment", + "testthat (>= 3.2.2)", + "withr (>= 3.0.2)" + ], + "VignetteBuilder": "knitr, rmarkdown", + "RdMacros": "lifecycle", + "Config/Needs/verdepcheck": "rstudio/shiny, rstudio/bslib, mllg/checkmate, tidyverse/dplyr, rstudio/htmltools, jeroen/jsonlite, r-lib/lifecycle, daroczig/logger, plotly/plotly, r-lib/R6, daattali/shinycssloaders, daattali/shinyjs, dreamRs/shinyWidgets, insightsengineering/teal.data, insightsengineering/teal.logger, insightsengineering/teal.widgets, yihui/knitr, bioc::MultiAssayExperiment, bioc::SummarizedExperiment, rstudio/rmarkdown, r-lib/testthat, r-lib/withr, bioc::matrixStats", + "Config/Needs/website": "insightsengineering/nesttemplate", + "Encoding": "UTF-8", + "Language": "en-US", + "Roxygen": "list(markdown = TRUE)", + "RoxygenNote": "7.3.2", + "Config/pak/sysreqs": "make libicu-dev libssl-dev zlib1g-dev", + "Repository": "https://pharmaverse.r-universe.dev", + "RemoteUrl": "https://github.com/insightsengineering/teal.slice", + "RemoteRef": "HEAD", + "RemoteSha": "7f261e0e59a95c29dd511ef64099c53c9617baf4", + "NeedsCompilation": "no", + "Author": "Dawid Kaledkowski [aut, cre] (), Pawel Rucki [aut], Aleksander Chlebowski [aut] (), Andre Verissimo [aut] (), Kartikeya Kirar [aut], Marcin Kosinski [aut], Chendi Liao [rev], Dony Unardi [rev], Andrew Bates [aut], Mahmoud Hallal [aut], Nikolas Burkoff [aut], Maciej Nasinski [aut], Konrad Pagacz [aut], Junlue Zhao [aut], F. Hoffmann-La Roche AG [cph, fnd]", + "Maintainer": "Dawid Kaledkowski " + }, + "teal.widgets": { + "Package": "teal.widgets", + "Version": "0.4.3.9000", + "Source": "Repository", + "Title": "'shiny' Widgets for 'teal' Applications", + "Date": "2025-01-31", + "Authors@R": "c( person(\"Dawid\", \"Kaledkowski\", , \"dawid.kaledkowski@roche.com\", role = c(\"aut\", \"cre\")), person(\"Pawel\", \"Rucki\", , \"pawel.rucki@roche.com\", role = \"aut\"), person(\"Mahmoud\", \"Hallal\", , \"mahmoud.hallal@roche.com\", role = \"aut\"), person(\"Nikolas\", \"Burkoff\", role = \"aut\"), person(\"Maciej\", \"Nasinski\", role = \"aut\"), person(\"Konrad\", \"Pagacz\", role = \"aut\"), person(\"Junlue\", \"Zhao\", role = \"aut\"), person(\"F. Hoffmann-La Roche AG\", role = c(\"cph\", \"fnd\")) )", + "Description": "Collection of 'shiny' widgets to support 'teal' applications. Enables the manipulation of application layout and plot or table settings.", + "License": "Apache License 2.0", + "URL": "https://insightsengineering.github.io/teal.widgets/, https://github.com/insightsengineering/teal.widgets", + "BugReports": "https://github.com/insightsengineering/teal.widgets/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "bslib", + "checkmate (>= 2.1.0)", + "ggplot2 (>= 3.4.3)", + "graphics", + "grDevices", + "htmltools (>= 0.5.4)", + "lifecycle (>= 0.2.0)", + "methods", + "rtables (>= 0.6.6)", + "shiny (>= 1.6.0)", + "shinyjs", + "shinyWidgets (>= 0.5.1)", + "styler (>= 1.2.0)" + ], + "Suggests": [ + "DT", + "knitr (>= 1.42)", + "lattice (>= 0.18-4)", + "magrittr (>= 1.5)", + "png", + "rmarkdown (>= 2.23)", + "rvest (>= 1.0.3)", + "shinytest2 (>= 0.2.0)", + "shinyvalidate", + "testthat (>= 3.1.5)", + "withr (>= 2.1.0)" + ], + "VignetteBuilder": "knitr, rmarkdown", + "Config/Needs/verdepcheck": "rstudio/bslib, mllg/checkmate, tidyverse/ggplot2, rstudio/htmltools, r-lib/lifecycle, insightsengineering/rtables, rstudio/shiny, daattali/shinyjs, dreamRs/shinyWidgets, r-lib/styler, rstudio/DT, yihui/knitr, deepayan/lattice, tidyverse/magrittr, cran/png, tidyverse/rvest, rstudio/rmarkdown, rstudio/shinytest2, rstudio/shinyvalidate, r-lib/testthat, r-lib/withr", + "Config/Needs/website": "insightsengineering/nesttemplate", + "Encoding": "UTF-8", + "Language": "en-US", + "Roxygen": "list(markdown = TRUE)", + "RoxygenNote": "7.3.2", + "Config/pak/sysreqs": "make libicu-dev zlib1g-dev", + "Repository": "https://pharmaverse.r-universe.dev", + "RemoteUrl": "https://github.com/insightsengineering/teal.widgets", + "RemoteRef": "HEAD", + "RemoteSha": "ec4a5eed3915e4fa905a45e28b38ca13e78d09ac", + "NeedsCompilation": "no", + "Author": "Dawid Kaledkowski [aut, cre], Pawel Rucki [aut], Mahmoud Hallal [aut], Nikolas Burkoff [aut], Maciej Nasinski [aut], Konrad Pagacz [aut], Junlue Zhao [aut], F. Hoffmann-La Roche AG [cph, fnd]", + "Maintainer": "Dawid Kaledkowski " + }, + "textshaping": { + "Package": "textshaping", + "Version": "1.0.0", + "Source": "Repository", + "Title": "Bindings to the 'HarfBuzz' and 'Fribidi' Libraries for Text Shaping", + "Authors@R": "c( person(\"Thomas Lin\", \"Pedersen\", , \"thomas.pedersen@posit.co\", role = c(\"cre\", \"aut\"), comment = c(ORCID = \"0000-0002-5147-4711\")), person(\"Posit, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Provides access to the text shaping functionality in the 'HarfBuzz' library and the bidirectional algorithm in the 'Fribidi' library. 'textshaping' is a low-level utility package mainly for graphic devices that expands upon the font tool-set provided by the 'systemfonts' package.", + "License": "MIT + file LICENSE", + "URL": "https://github.com/r-lib/textshaping", + "BugReports": "https://github.com/r-lib/textshaping/issues", + "Depends": [ + "R (>= 3.2.0)" + ], + "Imports": [ + "lifecycle", + "stats", + "stringi", + "systemfonts (>= 1.1.0)", + "utils" + ], + "Suggests": [ + "covr", + "grDevices", + "grid", + "knitr", + "rmarkdown", + "testthat (>= 3.0.0)" + ], + "LinkingTo": [ + "cpp11 (>= 0.2.1)", + "systemfonts (>= 1.0.0)" + ], + "VignetteBuilder": "knitr", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "SystemRequirements": "freetype2, harfbuzz, fribidi", + "Config/build/compilation-database": "true", + "Config/testthat/edition": "3", + "NeedsCompilation": "yes", + "Author": "Thomas Lin Pedersen [cre, aut] (), Posit, PBC [cph, fnd]", + "Maintainer": "Thomas Lin Pedersen ", + "Repository": "CRAN" + }, + "tibble": { + "Package": "tibble", + "Version": "3.2.1", + "Source": "Repository", + "Title": "Simple Data Frames", + "Authors@R": "c(person(given = \"Kirill\", family = \"M\\u00fcller\", role = c(\"aut\", \"cre\"), email = \"kirill@cynkra.com\", comment = c(ORCID = \"0000-0002-1416-3412\")), person(given = \"Hadley\", family = \"Wickham\", role = \"aut\", email = \"hadley@rstudio.com\"), person(given = \"Romain\", family = \"Francois\", role = \"ctb\", email = \"romain@r-enthusiasts.com\"), person(given = \"Jennifer\", family = \"Bryan\", role = \"ctb\", email = \"jenny@rstudio.com\"), person(given = \"RStudio\", role = c(\"cph\", \"fnd\")))", + "Description": "Provides a 'tbl_df' class (the 'tibble') with stricter checking and better formatting than the traditional data frame.", + "License": "MIT + file LICENSE", + "URL": "https://tibble.tidyverse.org/, https://github.com/tidyverse/tibble", + "BugReports": "https://github.com/tidyverse/tibble/issues", + "Depends": [ + "R (>= 3.4.0)" + ], + "Imports": [ + "fansi (>= 0.4.0)", + "lifecycle (>= 1.0.0)", + "magrittr", + "methods", + "pillar (>= 1.8.1)", + "pkgconfig", + "rlang (>= 1.0.2)", + "utils", + "vctrs (>= 0.4.2)" + ], + "Suggests": [ + "bench", + "bit64", + "blob", + "brio", + "callr", + "cli", + "covr", + "crayon (>= 1.3.4)", + "DiagrammeR", + "dplyr", + "evaluate", + "formattable", + "ggplot2", + "here", + "hms", + "htmltools", + "knitr", + "lubridate", + "mockr", + "nycflights13", + "pkgbuild", + "pkgload", + "purrr", + "rmarkdown", + "stringi", + "testthat (>= 3.0.2)", + "tidyr", + "withr" + ], + "VignetteBuilder": "knitr", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "Config/testthat/edition": "3", + "Config/testthat/parallel": "true", + "Config/testthat/start-first": "vignette-formats, as_tibble, add, invariants", + "Config/autostyle/scope": "line_breaks", + "Config/autostyle/strict": "true", + "Config/autostyle/rmd": "false", + "Config/Needs/website": "tidyverse/tidytemplate", + "NeedsCompilation": "yes", + "Author": "Kirill Müller [aut, cre] (), Hadley Wickham [aut], Romain Francois [ctb], Jennifer Bryan [ctb], RStudio [cph, fnd]", + "Maintainer": "Kirill Müller ", + "Repository": "RSPM" + }, + "tidyr": { + "Package": "tidyr", + "Version": "1.3.1", + "Source": "Repository", + "Title": "Tidy Messy Data", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = c(\"aut\", \"cre\")), person(\"Davis\", \"Vaughan\", , \"davis@posit.co\", role = \"aut\"), person(\"Maximilian\", \"Girlich\", role = \"aut\"), person(\"Kevin\", \"Ushey\", , \"kevin@posit.co\", role = \"ctb\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Tools to help to create tidy data, where each column is a variable, each row is an observation, and each cell contains a single value. 'tidyr' contains tools for changing the shape (pivoting) and hierarchy (nesting and 'unnesting') of a dataset, turning deeply nested lists into rectangular data frames ('rectangling'), and extracting values out of string columns. It also includes tools for working with missing values (both implicit and explicit).", + "License": "MIT + file LICENSE", + "URL": "https://tidyr.tidyverse.org, https://github.com/tidyverse/tidyr", + "BugReports": "https://github.com/tidyverse/tidyr/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "cli (>= 3.4.1)", + "dplyr (>= 1.0.10)", + "glue", + "lifecycle (>= 1.0.3)", + "magrittr", + "purrr (>= 1.0.1)", + "rlang (>= 1.1.1)", + "stringr (>= 1.5.0)", + "tibble (>= 2.1.1)", + "tidyselect (>= 1.2.0)", + "utils", + "vctrs (>= 0.5.2)" + ], + "Suggests": [ + "covr", + "data.table", + "knitr", + "readr", + "repurrrsive (>= 1.1.0)", + "rmarkdown", + "testthat (>= 3.0.0)" + ], + "LinkingTo": [ + "cpp11 (>= 0.4.0)" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "LazyData": "true", + "RoxygenNote": "7.3.0", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [aut, cre], Davis Vaughan [aut], Maximilian Girlich [aut], Kevin Ushey [ctb], Posit Software, PBC [cph, fnd]", + "Maintainer": "Hadley Wickham ", + "Repository": "RSPM" + }, + "tidyselect": { + "Package": "tidyselect", + "Version": "1.2.1", + "Source": "Repository", + "Title": "Select from a Set of Strings", + "Authors@R": "c( person(\"Lionel\", \"Henry\", , \"lionel@posit.co\", role = c(\"aut\", \"cre\")), person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "A backend for the selecting functions of the 'tidyverse'. It makes it easy to implement select-like functions in your own packages in a way that is consistent with other 'tidyverse' interfaces for selection.", + "License": "MIT + file LICENSE", + "URL": "https://tidyselect.r-lib.org, https://github.com/r-lib/tidyselect", + "BugReports": "https://github.com/r-lib/tidyselect/issues", + "Depends": [ + "R (>= 3.4)" + ], + "Imports": [ + "cli (>= 3.3.0)", + "glue (>= 1.3.0)", + "lifecycle (>= 1.0.3)", + "rlang (>= 1.0.4)", + "vctrs (>= 0.5.2)", + "withr" + ], + "Suggests": [ + "covr", + "crayon", + "dplyr", + "knitr", + "magrittr", + "rmarkdown", + "stringr", + "testthat (>= 3.1.1)", + "tibble (>= 2.1.3)" + ], + "VignetteBuilder": "knitr", + "ByteCompile": "true", + "Config/testthat/edition": "3", + "Config/Needs/website": "tidyverse/tidytemplate", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.0.9000", + "NeedsCompilation": "yes", + "Author": "Lionel Henry [aut, cre], Hadley Wickham [aut], Posit Software, PBC [cph, fnd]", + "Maintainer": "Lionel Henry ", + "Repository": "RSPM" + }, + "tinytex": { + "Package": "tinytex", + "Version": "0.54", + "Source": "Repository", + "Type": "Package", + "Title": "Helper Functions to Install and Maintain TeX Live, and Compile LaTeX Documents", + "Authors@R": "c( person(\"Yihui\", \"Xie\", role = c(\"aut\", \"cre\", \"cph\"), email = \"xie@yihui.name\", comment = c(ORCID = \"0000-0003-0645-5666\")), person(given = \"Posit Software, PBC\", role = c(\"cph\", \"fnd\")), person(\"Christophe\", \"Dervieux\", role = \"ctb\", comment = c(ORCID = \"0000-0003-4474-2498\")), person(\"Devon\", \"Ryan\", role = \"ctb\", email = \"dpryan79@gmail.com\", comment = c(ORCID = \"0000-0002-8549-0971\")), person(\"Ethan\", \"Heinzen\", role = \"ctb\"), person(\"Fernando\", \"Cagua\", role = \"ctb\"), person() )", + "Description": "Helper functions to install and maintain the 'LaTeX' distribution named 'TinyTeX' (), a lightweight, cross-platform, portable, and easy-to-maintain version of 'TeX Live'. This package also contains helper functions to compile 'LaTeX' documents, and install missing 'LaTeX' packages automatically.", + "Imports": [ + "xfun (>= 0.48)" + ], + "Suggests": [ + "testit", + "rstudioapi" + ], + "License": "MIT + file LICENSE", + "URL": "https://github.com/rstudio/tinytex", + "BugReports": "https://github.com/rstudio/tinytex/issues", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "NeedsCompilation": "no", + "Author": "Yihui Xie [aut, cre, cph] (), Posit Software, PBC [cph, fnd], Christophe Dervieux [ctb] (), Devon Ryan [ctb] (), Ethan Heinzen [ctb], Fernando Cagua [ctb]", + "Maintainer": "Yihui Xie ", + "Repository": "CRAN" + }, + "tzdb": { + "Package": "tzdb", + "Version": "0.4.0", + "Source": "Repository", + "Title": "Time Zone Database Information", + "Authors@R": "c( person(\"Davis\", \"Vaughan\", , \"davis@posit.co\", role = c(\"aut\", \"cre\")), person(\"Howard\", \"Hinnant\", role = \"cph\", comment = \"Author of the included date library\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Provides an up-to-date copy of the Internet Assigned Numbers Authority (IANA) Time Zone Database. It is updated periodically to reflect changes made by political bodies to time zone boundaries, UTC offsets, and daylight saving time rules. Additionally, this package provides a C++ interface for working with the 'date' library. 'date' provides comprehensive support for working with dates and date-times, which this package exposes to make it easier for other R packages to utilize. Headers are provided for calendar specific calculations, along with a limited interface for time zone manipulations.", + "License": "MIT + file LICENSE", + "URL": "https://tzdb.r-lib.org, https://github.com/r-lib/tzdb", + "BugReports": "https://github.com/r-lib/tzdb/issues", + "Depends": [ + "R (>= 3.5.0)" + ], + "Suggests": [ + "covr", + "testthat (>= 3.0.0)" + ], + "LinkingTo": [ + "cpp11 (>= 0.4.2)" + ], + "Biarch": "yes", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "yes", + "Author": "Davis Vaughan [aut, cre], Howard Hinnant [cph] (Author of the included date library), Posit Software, PBC [cph, fnd]", + "Maintainer": "Davis Vaughan ", + "Repository": "RSPM" + }, + "utf8": { + "Package": "utf8", + "Version": "1.2.4", + "Source": "Repository", + "Title": "Unicode Text Processing", + "Authors@R": "c(person(given = c(\"Patrick\", \"O.\"), family = \"Perry\", role = c(\"aut\", \"cph\")), person(given = \"Kirill\", family = \"M\\u00fcller\", role = \"cre\", email = \"kirill@cynkra.com\"), person(given = \"Unicode, Inc.\", role = c(\"cph\", \"dtc\"), comment = \"Unicode Character Database\"))", + "Description": "Process and print 'UTF-8' encoded international text (Unicode). Input, validate, normalize, encode, format, and display.", + "License": "Apache License (== 2.0) | file LICENSE", + "URL": "https://ptrckprry.com/r-utf8/, https://github.com/patperry/r-utf8", + "BugReports": "https://github.com/patperry/r-utf8/issues", + "Depends": [ + "R (>= 2.10)" + ], + "Suggests": [ + "cli", + "covr", + "knitr", + "rlang", + "rmarkdown", + "testthat (>= 3.0.0)", + "withr" + ], + "VignetteBuilder": "knitr, rmarkdown", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "yes", + "Author": "Patrick O. Perry [aut, cph], Kirill Müller [cre], Unicode, Inc. [cph, dtc] (Unicode Character Database)", + "Maintainer": "Kirill Müller ", + "Repository": "RSPM" + }, + "uuid": { + "Package": "uuid", + "Version": "1.2-1", + "Source": "Repository", + "Title": "Tools for Generating and Handling of UUIDs", + "Author": "Simon Urbanek [aut, cre, cph] (https://urbanek.org, ), Theodore Ts'o [aut, cph] (libuuid)", + "Maintainer": "Simon Urbanek ", + "Authors@R": "c(person(\"Simon\", \"Urbanek\", role=c(\"aut\",\"cre\",\"cph\"), email=\"Simon.Urbanek@r-project.org\", comment=c(\"https://urbanek.org\", ORCID=\"0000-0003-2297-1732\")), person(\"Theodore\",\"Ts'o\", email=\"tytso@thunk.org\", role=c(\"aut\",\"cph\"), comment=\"libuuid\"))", + "Depends": [ + "R (>= 2.9.0)" + ], + "Description": "Tools for generating and handling of UUIDs (Universally Unique Identifiers).", + "License": "MIT + file LICENSE", + "URL": "https://www.rforge.net/uuid", + "BugReports": "https://github.com/s-u/uuid/issues", + "NeedsCompilation": "yes", + "Repository": "RSPM", + "Encoding": "UTF-8" + }, + "vctrs": { + "Package": "vctrs", + "Version": "0.6.5", + "Source": "Repository", + "Title": "Vector Helpers", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\"), person(\"Lionel\", \"Henry\", , \"lionel@posit.co\", role = \"aut\"), person(\"Davis\", \"Vaughan\", , \"davis@posit.co\", role = c(\"aut\", \"cre\")), person(\"data.table team\", role = \"cph\", comment = \"Radix sort based on data.table's forder() and their contribution to R's order()\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Defines new notions of prototype and size that are used to provide tools for consistent and well-founded type-coercion and size-recycling, and are in turn connected to ideas of type- and size-stability useful for analysing function interfaces.", + "License": "MIT + file LICENSE", + "URL": "https://vctrs.r-lib.org/, https://github.com/r-lib/vctrs", + "BugReports": "https://github.com/r-lib/vctrs/issues", + "Depends": [ + "R (>= 3.5.0)" + ], + "Imports": [ + "cli (>= 3.4.0)", + "glue", + "lifecycle (>= 1.0.3)", + "rlang (>= 1.1.0)" + ], + "Suggests": [ + "bit64", + "covr", + "crayon", + "dplyr (>= 0.8.5)", + "generics", + "knitr", + "pillar (>= 1.4.4)", + "pkgdown (>= 2.0.1)", + "rmarkdown", + "testthat (>= 3.0.0)", + "tibble (>= 3.1.3)", + "waldo (>= 0.2.0)", + "withr", + "xml2", + "zeallot" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "Language": "en-GB", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [aut], Lionel Henry [aut], Davis Vaughan [aut, cre], data.table team [cph] (Radix sort based on data.table's forder() and their contribution to R's order()), Posit Software, PBC [cph, fnd]", + "Maintainer": "Davis Vaughan ", + "Repository": "RSPM" + }, + "viridisLite": { + "Package": "viridisLite", + "Version": "0.4.2", + "Source": "Repository", + "Type": "Package", + "Title": "Colorblind-Friendly Color Maps (Lite Version)", + "Date": "2023-05-02", + "Authors@R": "c( person(\"Simon\", \"Garnier\", email = \"garnier@njit.edu\", role = c(\"aut\", \"cre\")), person(\"Noam\", \"Ross\", email = \"noam.ross@gmail.com\", role = c(\"ctb\", \"cph\")), person(\"Bob\", \"Rudis\", email = \"bob@rud.is\", role = c(\"ctb\", \"cph\")), person(\"Marco\", \"Sciaini\", email = \"sciaini.marco@gmail.com\", role = c(\"ctb\", \"cph\")), person(\"Antônio Pedro\", \"Camargo\", role = c(\"ctb\", \"cph\")), person(\"Cédric\", \"Scherer\", email = \"scherer@izw-berlin.de\", role = c(\"ctb\", \"cph\")) )", + "Maintainer": "Simon Garnier ", + "Description": "Color maps designed to improve graph readability for readers with common forms of color blindness and/or color vision deficiency. The color maps are also perceptually-uniform, both in regular form and also when converted to black-and-white for printing. This is the 'lite' version of the 'viridis' package that also contains 'ggplot2' bindings for discrete and continuous color and fill scales and can be found at .", + "License": "MIT + file LICENSE", + "Encoding": "UTF-8", + "Depends": [ + "R (>= 2.10)" + ], + "Suggests": [ + "hexbin (>= 1.27.0)", + "ggplot2 (>= 1.0.1)", + "testthat", + "covr" + ], + "URL": "https://sjmgarnier.github.io/viridisLite/, https://github.com/sjmgarnier/viridisLite/", + "BugReports": "https://github.com/sjmgarnier/viridisLite/issues/", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "no", + "Author": "Simon Garnier [aut, cre], Noam Ross [ctb, cph], Bob Rudis [ctb, cph], Marco Sciaini [ctb, cph], Antônio Pedro Camargo [ctb, cph], Cédric Scherer [ctb, cph]", + "Repository": "CRAN" + }, + "vroom": { + "Package": "vroom", + "Version": "1.6.5", + "Source": "Repository", + "Title": "Read and Write Rectangular Text Data Quickly", + "Authors@R": "c( person(\"Jim\", \"Hester\", role = \"aut\", comment = c(ORCID = \"0000-0002-2739-7082\")), person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\", comment = c(ORCID = \"0000-0003-4757-117X\")), person(\"Jennifer\", \"Bryan\", , \"jenny@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-6983-2759\")), person(\"Shelby\", \"Bearrows\", role = \"ctb\"), person(\"https://github.com/mandreyel/\", role = \"cph\", comment = \"mio library\"), person(\"Jukka\", \"Jylänki\", role = \"cph\", comment = \"grisu3 implementation\"), person(\"Mikkel\", \"Jørgensen\", role = \"cph\", comment = \"grisu3 implementation\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "The goal of 'vroom' is to read and write data (like 'csv', 'tsv' and 'fwf') quickly. When reading it uses a quick initial indexing step, then reads the values lazily , so only the data you actually use needs to be read. The writer formats the data in parallel and writes to disk asynchronously from formatting.", + "License": "MIT + file LICENSE", + "URL": "https://vroom.r-lib.org, https://github.com/tidyverse/vroom", + "BugReports": "https://github.com/tidyverse/vroom/issues", + "Depends": [ + "R (>= 3.6)" + ], + "Imports": [ + "bit64", + "cli (>= 3.2.0)", + "crayon", + "glue", + "hms", + "lifecycle (>= 1.0.3)", + "methods", + "rlang (>= 0.4.2)", + "stats", + "tibble (>= 2.0.0)", + "tidyselect", + "tzdb (>= 0.1.1)", + "vctrs (>= 0.2.0)", + "withr" + ], + "Suggests": [ + "archive", + "bench (>= 1.1.0)", + "covr", + "curl", + "dplyr", + "forcats", + "fs", + "ggplot2", + "knitr", + "patchwork", + "prettyunits", + "purrr", + "rmarkdown", + "rstudioapi", + "scales", + "spelling", + "testthat (>= 2.1.0)", + "tidyr", + "utils", + "waldo", + "xml2" + ], + "LinkingTo": [ + "cpp11 (>= 0.2.0)", + "progress (>= 1.2.1)", + "tzdb (>= 0.1.1)" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "nycflights13, tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Config/testthat/parallel": "false", + "Copyright": "file COPYRIGHTS", + "Encoding": "UTF-8", + "Language": "en-US", + "RoxygenNote": "7.2.3.9000", + "NeedsCompilation": "yes", + "Author": "Jim Hester [aut] (), Hadley Wickham [aut] (), Jennifer Bryan [aut, cre] (), Shelby Bearrows [ctb], https://github.com/mandreyel/ [cph] (mio library), Jukka Jylänki [cph] (grisu3 implementation), Mikkel Jørgensen [cph] (grisu3 implementation), Posit Software, PBC [cph, fnd]", + "Maintainer": "Jennifer Bryan ", + "Repository": "RSPM" + }, + "withr": { + "Package": "withr", + "Version": "3.0.2", + "Source": "Repository", + "Title": "Run Code 'With' Temporarily Modified Global State", + "Authors@R": "c( person(\"Jim\", \"Hester\", role = \"aut\"), person(\"Lionel\", \"Henry\", , \"lionel@posit.co\", role = c(\"aut\", \"cre\")), person(\"Kirill\", \"Müller\", , \"krlmlr+r@mailbox.org\", role = \"aut\"), person(\"Kevin\", \"Ushey\", , \"kevinushey@gmail.com\", role = \"aut\"), person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\"), person(\"Winston\", \"Chang\", role = \"aut\"), person(\"Jennifer\", \"Bryan\", role = \"ctb\"), person(\"Richard\", \"Cotton\", role = \"ctb\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "A set of functions to run code 'with' safely and temporarily modified global state. Many of these functions were originally a part of the 'devtools' package, this provides a simple package with limited dependencies to provide access to these functions.", + "License": "MIT + file LICENSE", + "URL": "https://withr.r-lib.org, https://github.com/r-lib/withr#readme", + "BugReports": "https://github.com/r-lib/withr/issues", + "Depends": [ + "R (>= 3.6.0)" + ], + "Imports": [ + "graphics", + "grDevices" + ], + "Suggests": [ + "callr", + "DBI", + "knitr", + "methods", + "rlang", + "rmarkdown (>= 2.12)", + "RSQLite", + "testthat (>= 3.0.0)" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "Collate": "'aaa.R' 'collate.R' 'connection.R' 'db.R' 'defer-exit.R' 'standalone-defer.R' 'defer.R' 'devices.R' 'local_.R' 'with_.R' 'dir.R' 'env.R' 'file.R' 'language.R' 'libpaths.R' 'locale.R' 'makevars.R' 'namespace.R' 'options.R' 'par.R' 'path.R' 'rng.R' 'seed.R' 'wrap.R' 'sink.R' 'tempfile.R' 'timezone.R' 'torture.R' 'utils.R' 'with.R'", + "NeedsCompilation": "no", + "Author": "Jim Hester [aut], Lionel Henry [aut, cre], Kirill Müller [aut], Kevin Ushey [aut], Hadley Wickham [aut], Winston Chang [aut], Jennifer Bryan [ctb], Richard Cotton [ctb], Posit Software, PBC [cph, fnd]", + "Maintainer": "Lionel Henry ", + "Repository": "CRAN" + }, + "xfun": { + "Package": "xfun", + "Version": "0.50", + "Source": "Repository", + "Type": "Package", + "Title": "Supporting Functions for Packages Maintained by 'Yihui Xie'", + "Authors@R": "c( person(\"Yihui\", \"Xie\", role = c(\"aut\", \"cre\", \"cph\"), email = \"xie@yihui.name\", comment = c(ORCID = \"0000-0003-0645-5666\")), person(\"Wush\", \"Wu\", role = \"ctb\"), person(\"Daijiang\", \"Li\", role = \"ctb\"), person(\"Xianying\", \"Tan\", role = \"ctb\"), person(\"Salim\", \"Brüggemann\", role = \"ctb\", email = \"salim-b@pm.me\", comment = c(ORCID = \"0000-0002-5329-5987\")), person(\"Christophe\", \"Dervieux\", role = \"ctb\"), person() )", + "Description": "Miscellaneous functions commonly used in other packages maintained by 'Yihui Xie'.", + "Depends": [ + "R (>= 3.2.0)" + ], + "Imports": [ + "grDevices", + "stats", + "tools" + ], + "Suggests": [ + "testit", + "parallel", + "codetools", + "methods", + "rstudioapi", + "tinytex (>= 0.30)", + "mime", + "litedown (>= 0.4)", + "commonmark", + "knitr (>= 1.47)", + "remotes", + "pak", + "rhub", + "renv", + "curl", + "xml2", + "jsonlite", + "magick", + "yaml", + "qs", + "rmarkdown" + ], + "License": "MIT + file LICENSE", + "URL": "https://github.com/yihui/xfun", + "BugReports": "https://github.com/yihui/xfun/issues", + "Encoding": "UTF-8", + "RoxygenNote": "7.3.2", + "VignetteBuilder": "litedown", + "NeedsCompilation": "yes", + "Author": "Yihui Xie [aut, cre, cph] (), Wush Wu [ctb], Daijiang Li [ctb], Xianying Tan [ctb], Salim Brüggemann [ctb] (), Christophe Dervieux [ctb]", + "Maintainer": "Yihui Xie ", + "Repository": "CRAN" + }, + "xml2": { + "Package": "xml2", + "Version": "1.3.6", + "Source": "Repository", + "Title": "Parse XML", + "Authors@R": "c( person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = c(\"aut\", \"cre\")), person(\"Jim\", \"Hester\", role = \"aut\"), person(\"Jeroen\", \"Ooms\", role = \"aut\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")), person(\"R Foundation\", role = \"ctb\", comment = \"Copy of R-project homepage cached as example\") )", + "Description": "Work with XML files using a simple, consistent interface. Built on top of the 'libxml2' C library.", + "License": "MIT + file LICENSE", + "URL": "https://xml2.r-lib.org/, https://github.com/r-lib/xml2", + "BugReports": "https://github.com/r-lib/xml2/issues", + "Depends": [ + "R (>= 3.6.0)" + ], + "Imports": [ + "cli", + "methods", + "rlang (>= 1.1.0)" + ], + "Suggests": [ + "covr", + "curl", + "httr", + "knitr", + "magrittr", + "mockery", + "rmarkdown", + "testthat (>= 3.0.0)" + ], + "VignetteBuilder": "knitr", + "Config/Needs/website": "tidyverse/tidytemplate", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "SystemRequirements": "libxml2: libxml2-dev (deb), libxml2-devel (rpm)", + "Collate": "'S4.R' 'as_list.R' 'xml_parse.R' 'as_xml_document.R' 'classes.R' 'format.R' 'import-standalone-obj-type.R' 'import-standalone-purrr.R' 'import-standalone-types-check.R' 'init.R' 'nodeset_apply.R' 'paths.R' 'utils.R' 'xml2-package.R' 'xml_attr.R' 'xml_children.R' 'xml_document.R' 'xml_find.R' 'xml_missing.R' 'xml_modify.R' 'xml_name.R' 'xml_namespaces.R' 'xml_node.R' 'xml_nodeset.R' 'xml_path.R' 'xml_schema.R' 'xml_serialize.R' 'xml_structure.R' 'xml_text.R' 'xml_type.R' 'xml_url.R' 'xml_write.R' 'zzz.R'", + "Config/testthat/edition": "3", + "NeedsCompilation": "yes", + "Author": "Hadley Wickham [aut, cre], Jim Hester [aut], Jeroen Ooms [aut], Posit Software, PBC [cph, fnd], R Foundation [ctb] (Copy of R-project homepage cached as example)", + "Maintainer": "Hadley Wickham ", + "Repository": "RSPM" + }, + "xtable": { + "Package": "xtable", + "Version": "1.8-4", + "Source": "Repository", + "Date": "2019-04-08", + "Title": "Export Tables to LaTeX or HTML", + "Authors@R": "c(person(\"David B.\", \"Dahl\", role=\"aut\"), person(\"David\", \"Scott\", role=c(\"aut\",\"cre\"), email=\"d.scott@auckland.ac.nz\"), person(\"Charles\", \"Roosen\", role=\"aut\"), person(\"Arni\", \"Magnusson\", role=\"aut\"), person(\"Jonathan\", \"Swinton\", role=\"aut\"), person(\"Ajay\", \"Shah\", role=\"ctb\"), person(\"Arne\", \"Henningsen\", role=\"ctb\"), person(\"Benno\", \"Puetz\", role=\"ctb\"), person(\"Bernhard\", \"Pfaff\", role=\"ctb\"), person(\"Claudio\", \"Agostinelli\", role=\"ctb\"), person(\"Claudius\", \"Loehnert\", role=\"ctb\"), person(\"David\", \"Mitchell\", role=\"ctb\"), person(\"David\", \"Whiting\", role=\"ctb\"), person(\"Fernando da\", \"Rosa\", role=\"ctb\"), person(\"Guido\", \"Gay\", role=\"ctb\"), person(\"Guido\", \"Schulz\", role=\"ctb\"), person(\"Ian\", \"Fellows\", role=\"ctb\"), person(\"Jeff\", \"Laake\", role=\"ctb\"), person(\"John\", \"Walker\", role=\"ctb\"), person(\"Jun\", \"Yan\", role=\"ctb\"), person(\"Liviu\", \"Andronic\", role=\"ctb\"), person(\"Markus\", \"Loecher\", role=\"ctb\"), person(\"Martin\", \"Gubri\", role=\"ctb\"), person(\"Matthieu\", \"Stigler\", role=\"ctb\"), person(\"Robert\", \"Castelo\", role=\"ctb\"), person(\"Seth\", \"Falcon\", role=\"ctb\"), person(\"Stefan\", \"Edwards\", role=\"ctb\"), person(\"Sven\", \"Garbade\", role=\"ctb\"), person(\"Uwe\", \"Ligges\", role=\"ctb\"))", + "Maintainer": "David Scott ", + "Imports": [ + "stats", + "utils" + ], + "Suggests": [ + "knitr", + "plm", + "zoo", + "survival" + ], + "VignetteBuilder": "knitr", + "Description": "Coerce data to LaTeX and HTML tables.", + "URL": "http://xtable.r-forge.r-project.org/", + "Depends": [ + "R (>= 2.10.0)" + ], + "License": "GPL (>= 2)", + "Repository": "RSPM", + "NeedsCompilation": "no", + "Author": "David B. Dahl [aut], David Scott [aut, cre], Charles Roosen [aut], Arni Magnusson [aut], Jonathan Swinton [aut], Ajay Shah [ctb], Arne Henningsen [ctb], Benno Puetz [ctb], Bernhard Pfaff [ctb], Claudio Agostinelli [ctb], Claudius Loehnert [ctb], David Mitchell [ctb], David Whiting [ctb], Fernando da Rosa [ctb], Guido Gay [ctb], Guido Schulz [ctb], Ian Fellows [ctb], Jeff Laake [ctb], John Walker [ctb], Jun Yan [ctb], Liviu Andronic [ctb], Markus Loecher [ctb], Martin Gubri [ctb], Matthieu Stigler [ctb], Robert Castelo [ctb], Seth Falcon [ctb], Stefan Edwards [ctb], Sven Garbade [ctb], Uwe Ligges [ctb]", + "Encoding": "UTF-8" + }, + "yaml": { + "Package": "yaml", + "Version": "2.3.10", + "Source": "Repository", + "Type": "Package", + "Title": "Methods to Convert R Data to YAML and Back", + "Date": "2024-07-22", + "Suggests": [ + "RUnit" + ], + "Author": "Shawn P Garbett [aut], Jeremy Stephens [aut, cre], Kirill Simonov [aut], Yihui Xie [ctb], Zhuoer Dong [ctb], Hadley Wickham [ctb], Jeffrey Horner [ctb], reikoch [ctb], Will Beasley [ctb], Brendan O'Connor [ctb], Gregory R. Warnes [ctb], Michael Quinn [ctb], Zhian N. Kamvar [ctb], Charlie Gao [ctb]", + "Maintainer": "Shawn Garbett ", + "License": "BSD_3_clause + file LICENSE", + "Description": "Implements the 'libyaml' 'YAML' 1.1 parser and emitter () for R.", + "URL": "https://github.com/vubiostat/r-yaml/", + "BugReports": "https://github.com/vubiostat/r-yaml/issues", + "NeedsCompilation": "yes", + "Repository": "RSPM", + "Encoding": "UTF-8" + }, + "zip": { + "Package": "zip", + "Version": "2.3.2", + "Source": "Repository", + "Title": "Cross-Platform 'zip' Compression", + "Authors@R": "c( person(\"Gábor\", \"Csárdi\", , \"csardi.gabor@gmail.com\", role = c(\"aut\", \"cre\")), person(\"Kuba\", \"Podgórski\", role = \"ctb\"), person(\"Rich\", \"Geldreich\", role = \"ctb\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", + "Description": "Cross-Platform 'zip' Compression Library. A replacement for the 'zip' function, that does not require any additional external tools on any platform.", + "License": "MIT + file LICENSE", + "URL": "https://github.com/r-lib/zip, https://r-lib.github.io/zip/", + "BugReports": "https://github.com/r-lib/zip/issues", + "Suggests": [ + "covr", + "pillar", + "processx", + "R6", + "testthat", + "withr" + ], + "Config/Needs/website": "tidyverse/tidytemplate", + "Config/testthat/edition": "3", + "Encoding": "UTF-8", + "RoxygenNote": "7.2.3", + "NeedsCompilation": "yes", + "Author": "Gábor Csárdi [aut, cre], Kuba Podgórski [ctb], Rich Geldreich [ctb], Posit Software, PBC [cph, fnd]", + "Maintainer": "Gábor Csárdi ", + "Repository": "CRAN" + } + } +} From 0cd5adc2caead82ec56b169c72f9ff8e931366c3 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Wed, 5 Mar 2025 07:08:00 +0000 Subject: [PATCH 45/92] recent --- R/tm_a_spiderplot_mdr.R | 19 ++-- R/tm_data_table.R | 16 ++-- R/tm_g_spiderplot.R | 14 +-- R/tm_g_swimlane.R | 187 ++++++++++------------------------------ R/tm_g_waterfall.R | 8 +- R/tm_swimlane_mdr.R | 146 +++++++++++++++++++++++++++++++ R/tm_t_reactable.R | 117 ++++++++++++++++++++++++- R/utils.R | 34 ++++++++ inst/poc_crf2.R | 4 +- 9 files changed, 362 insertions(+), 183 deletions(-) create mode 100644 R/tm_swimlane_mdr.R diff --git a/R/tm_a_spiderplot_mdr.R b/R/tm_a_spiderplot_mdr.R index e7e481c6f..4d4338ce5 100644 --- a/R/tm_a_spiderplot_mdr.R +++ b/R/tm_a_spiderplot_mdr.R @@ -130,11 +130,19 @@ srv_a_spiderplot_mdr <- function(id, within( plotly_selected_q(), dataname = str2lang(dataname), + time_var = str2lang(time_var), subject_var = str2lang(subject_var), + value_var = str2lang(value_var), + subject_var_char = subject_var, event_var = str2lang(event_var), recent_resp_event = "latest_response_assessment", # todo: whattodo? resp_cols = resp_cols, expr = { + brushed_subjects <- dplyr::filter( + dataname, + time_var %in% plotly_brushed_time, + value_var %in% plotly_brushed_value + )[[subject_var_char]] recent_resp <- dplyr::filter( dataname, event_var %in% recent_resp_event, @@ -239,14 +247,3 @@ srv_a_spiderplot_mdr <- function(id, }) } - - - - -.with_tooltips <- function(...) { - args <- list(...) - lapply(args, function(col) { - col$header <- tags$span(col$name, title = col$name) - return(col) - }) -} diff --git a/R/tm_data_table.R b/R/tm_data_table.R index e103aecd8..437540a11 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -316,14 +316,14 @@ ui_dataset_table <- function(id, choices, selected) { # Server function for the data_table module srv_dataset_table <- function(id, - data, - dataname, - if_filtered, - if_distinct, - dt_args, - dt_options, - server_rendering, - filter_panel_api) { + data, + dataname, + if_filtered, + if_distinct, + dt_args, + dt_options, + server_rendering, + filter_panel_api) { moduleServer(id, function(input, output, session) { iv <- shinyvalidate::InputValidator$new() iv$add_rule("variables", shinyvalidate::sv_required("Please select valid variable names")) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index b28595d63..2364a0ee1 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -111,20 +111,10 @@ srv_g_spiderplot <- function(id, time_vals = plotly_selected()$x, value_vals = plotly_selected()$y, expr = { - brushed_subjects <- dplyr::filter( - dataname, time_var %in% time_vals, value_var %in% value_vals - )[[subject_var]] + plotly_brushed_time <- time_vals + plotly_brushed_value <- value_vals } ) }) }) } - - -.with_tooltips <- function(...) { - args <- list(...) - lapply(args, function(col) { - col$header <- tags$span(col$name, title = col$name) - return(col) - }) -} diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 9d41e19f1..37cbddbdf 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -4,7 +4,7 @@ tm_g_swimlane <- function(label = "Swimlane", subject_var, value_var, event_var, - value_var_color, + value_var_color = character(0), value_var_symbol, plot_height = 700) { module( @@ -27,51 +27,31 @@ tm_g_swimlane <- function(label = "Swimlane", ui_g_swimlane <- function(id, height) { ns <- NS(id) - tagList( - fluidRow( - class = "simple-card", - h4("Swim Lane - Duration of Tx"), - sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height, width = "100%"), - plotly::plotlyOutput(ns("plot"), height = "100%") - ), - fluidRow( - column( - 6, - class = "simple-card", - tagList( - h4("Multiple Myeloma Response"), - ui_t_reactable(ns("mm_response")) - ) - ), - column( - 6, - class = "simple-card", - tagList( - h4("Study Tx Listing"), - ui_t_reactable(ns("tx_listing")) - ) - ) - ) + div( + class = "simple-card", + sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height, width = "100%"), + plotly::plotlyOutput(ns("plot"), height = "100%") ) } srv_g_swimlane <- function(id, - data, - dataname, - time_var, - subject_var, - value_var, - event_var, - value_var_color, - value_var_symbol, - filter_panel_api, - plot_height = 600) { + data, + dataname, + time_var, + subject_var, + value_var, + event_var, + value_var_color, + value_var_symbol, + filter_panel_api) { moduleServer(id, function(input, output, session) { plotly_q <- reactive({ req(data()) - adjusted_colors <- .adjust_colors( - x = unique(data()[[dataname]][[value_var]]), - predefined = value_var_color + adjusted_colors <- .color_palette_discrete( + levels = unique(data()[[dataname]][[value_var]]), + color = value_var_color ) + subject_var_label <- c(attr(data()[[dataname]][[subject_var]], "label"), "Subject")[1] + time_var_label <- c(attr(data()[[dataname]][[time_var]], "label"), "Study Day")[1] data() |> within( dataname = str2lang(dataname), @@ -80,28 +60,27 @@ srv_g_swimlane <- function(id, subject_var = str2lang(subject_var), value_var = str2lang(value_var), event_var = str2lang(event_var), + subject_var_label = sprintf("%s:", subject_var_label), + time_var_label = sprintf("%s:", time_var_label), colors = adjusted_colors, symbols = value_var_symbol, height = input$plot_height, filtered_events = c("disposition","response_assessment", "study_drug_administration"), - xaxis_label = "Study Day", - yaxis_label = "Subject", - { + subject_axis_label = subject_var_label, + time_axis_label = time_var_label, + expr = { dataname <- dataname |> mutate(subject_var_ordered = forcats::fct_reorder(as.factor(subject_var), time_var, .fun = max)) |> group_by(subject_var, time_var) |> mutate( tooltip = paste( - "Subject:", subject_var, - "
Study Day:", time_var, - paste( - unique( - sprintf("
%s: %s", tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", event_var)), value_var) - ), - collapse = "" - ) - ) - ) + unique(c( + paste(subject_var_label, subject_var), + paste(time_var_label, time_var), + sprintf("%s: %s", tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", event_var)), value_var) + )), + collapse = "
" + )) p <- dataname |> @@ -127,7 +106,7 @@ srv_g_swimlane <- function(id, showlegend = FALSE ) |> plotly::layout( - xaxis = list(title = xaxis_label), yaxis = list(title = yaxis_label) + xaxis = list(title = time_axis_label), yaxis = list(title = subject_axis_label) ) |> plotly::layout(dragmode = "select") |> plotly::config(displaylogo = FALSE) @@ -135,11 +114,18 @@ srv_g_swimlane <- function(id, ) }) - output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) + output$plot <- plotly::renderPlotly({ + plotly_q()$p |> + plotly::event_register("plotly_selected") |> + plotly::event_register("plotly_deselect") # todo: deselect doesn't work + }) - plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "swimlane")) + plotly_selected <- reactive({ + plotly::event_data("plotly_deselect", source = "swimlane") # todo: deselect doesn't work + plotly::event_data("plotly_selected", source = "swimlane") + }) - plotly_selected_q <- reactive({ + reactive({ req(plotly_selected()) within( plotly_q(), @@ -148,97 +134,14 @@ srv_g_swimlane <- function(id, subject_var = subject_var, value_var = str2lang(value_var), time_vals = plotly_selected()$x, - value_vals = plotly_selected()$y, - expr = { - brushed_subjects <- dplyr::filter( - dataname, time_var %in% time_vals, value_var %in% value_vals - )[[subject_var]] - } - ) - }) - - mm_response_vars <- c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", - "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts" - ) - - tx_listing_vars <- c( - "site_name", "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "txnam", - "txrec", "txrecrs", "txd_study_day", "date_administered", "cydly", "cydlyrs", "cydlyae", "txdly", - "txdlyrs", "txdlyae", "txpdos", "txpdosu", "frqdv", "txrte", "txform", "txdmod", "txrmod", - "txdmae", "txad", "txadu", "txd", "txstm", "txstmu", "txed", "txetm", "txetmu", "txtm", "txtmu", - "txed_study_day", "infrt", "infrtu", "tximod", "txirmod", "tximae" - ) - - mm_response_q <- reactive({ - within( - plotly_selected_q(), - dataname = str2lang(dataname), - time_var = str2lang(time_var), - subject_var = str2lang(subject_var), - time_vals = plotly_selected()$x, subject_vals = plotly_selected()$y, - col_defs = mm_response_vars, expr = { - mm_response <- dataname |> - filter(time_var %in% time_vals, subject_var %in% subject_vals) |> - select(all_of(col_defs)) + plotly_brushed_time <- time_vals + plotly_brushed_subject <- subject_vals } ) - }) - - tx_listing_q <- reactive({ - within( - plotly_selected_q(), - dataname = str2lang(dataname), - time_var = str2lang(time_var), - subject_var = str2lang(subject_var), - time_vals = plotly_selected()$x, - subject_vals = plotly_selected()$y, - col_defs = tx_listing_vars, - expr = { - tx_listing <- dataname |> - filter(time_var %in% time_vals, subject_var %in% subject_vals) |> - select(all_of(col_defs)) - } - ) - - }) - - mm_reactable_q <- srv_t_reactable("mm_response", data = mm_response_q, dataname = "mm_response", selection = NULL) - tx_reactable_q <- srv_t_reactable("tx_listing", data = tx_listing_q, dataname = "tx_listing", selection = NULL) - + }) } -.adjust_colors <- function(x, predefined) { - p <- predefined[names(predefined) %in% x] - p_rgb_num <- col2rgb(p) - p_hex <- rgb(p_rgb_num[1,]/255, p_rgb_num[2,]/255, p_rgb_num[3,]/255) - p <- setNames(p_hex, names(p)) - missing_x <- setdiff(x, names(p)) - N <- length(x) - n <- length(p) - m <- N - n - adjusted_colors <- if (m & n) { - current_space <- rgb2hsv(col2rgb(p)) - optimal_color_space <- colorspace::qualitative_hcl(N) - color_distances <- dist(t(cbind(current_space, rgb2hsv(col2rgb(optimal_color_space))))) - optimal_to_current_dist <- as.matrix(color_distances)[seq_len(n), -seq_len(n)] - furthest_neighbours_idx <- order(apply(optimal_to_current_dist, 2, min), decreasing = TRUE) - missing_colors <- optimal_color_space[furthest_neighbours_idx][seq_len(m)] - missing_colors <- setNames(missing_colors, missing_x) - p <- c(p, missing_colors) - } else if (n) { - # todo: generate color palette - hsv( - h = seq(0, by = 1/N, length.out = N + 1), - s = 1, - v = 1 - ) - } else { - p - } -} - diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index cac455bab..d3c106d32 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -1,8 +1,8 @@ tm_g_waterfall <- function(label = "Waterfall", time_var, subject_var, value_var, event_var, plot_height = 700) { - time_var$dataname <- "ADRS" - subject_var$dataname <- "ADRS" - value_var$dataname <- "ADRS" - event_var$dataname <- "ADRS" + time_var$dataname <- "ADTR" + subject_var$dataname <- "ADTR" + value_var$dataname <- "ADTR" + event_var$dataname <- "ADTR" module( label = label, ui = ui_g_waterfall, diff --git a/R/tm_swimlane_mdr.R b/R/tm_swimlane_mdr.R new file mode 100644 index 000000000..440dad248 --- /dev/null +++ b/R/tm_swimlane_mdr.R @@ -0,0 +1,146 @@ +tm_g_swimlane_mdr <- function(label = "Swimlane", + dataname, + time_var, + subject_var, + value_var, + event_var, + subtable_labels = c("Multiple Myeloma Response", "Study Tx Listing"), + subtable_cols = list( + c( + "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", + "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts" + ), + c( + "site_name", "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "txnam", + "txrec", "txrecrs", "txd_study_day", "date_administered", "cydly", "cydlyrs", "cydlyae", "txdly", + "txdlyrs", "txdlyae", "txpdos", "txpdosu", "frqdv", "txrte", "txform", "txdmod", "txrmod", + "txdmae", "txad", "txadu", "txd", "txstm", "txstmu", "txed", "txetm", "txetmu", "txtm", "txtmu", + "txed_study_day", "infrt", "infrtu", "tximod", "txirmod", "tximae" + ) + ), + value_var_color = c( + "DEATH" = "black", + "WITHDRAWAL BY SUBJECT" = "grey", + "PD (Progressive Disease)" = "red", + "SD (Stable Disease)" = "darkorchid4", + "MR (Minimal/Minor Response)" = "sienna4", + "PR (Partial Response)" = "maroon", + "VGPR (Very Good Partial Response)" = "chartreuse4", + "CR (Complete Response)" = "#3a41fc", + "SCR (Stringent Complete Response)" = "midnightblue", + "X Administration Injection" = "goldenrod", + "Y Administration Infusion" = "deepskyblue3", + "Z Administration Infusion" = "darkorchid" + ), + # possible markers https://plotly.com/python/marker-style/ + value_var_symbol = c( + "DEATH" = "circle", + "WITHDRAWAL BY SUBJECT" = "square", + "PD (Progressive Disease)" = "circle", + "SD (Stable Disease)" = "square-open", + "MR (Minimal/Minor Response)" = "star-open", + "PR (Partial Response)" = "star-open", + "VGPR (Very Good Partial Response)" = "star-open", + "CR (Complete Response)" = "star-open", + "SCR (Stringent Complete Response)" = "star-open", + "X Administration Injection" = "line-ns", + "Y Administration Infusion" = "line-ns", + "Z Administration Infusion" = "line-ns" + ), + plot_height = 700) { + checkmate::assert_character(subtable_labels) + checkmate::assert_list(subtable_cols) + checkmate::assert_character(value_var_color) + module( + label = label, + ui = ui_g_swimlane_mdr, + server = srv_g_swimlane_mdr, + datanames = dataname, + ui_args = list(height = plot_height), + server_args = list( + dataname = dataname, + time_var = time_var, + subject_var = subject_var, + value_var = value_var, + event_var = event_var, + value_var_color = value_var_color, + value_var_symbol = value_var_symbol, + subtable_labels = subtable_labels, + subtable_cols = subtable_cols, + plot_height = plot_height + ) + ) +} + +ui_g_swimlane_mdr <- function(id, height) { + ns <- NS(id) + tagList( + fluidRow( + class = "simple-card", + h4("Swim Lane - Duration of Tx"), + ui_g_swimlane(ns("plot"), height = height) + ), + fluidRow( + class = "simple-card", + ui_t_reactables(ns("subtables")) + ) + + ) +} +srv_g_swimlane_mdr <- function(id, + data, + dataname, + time_var, + subject_var, + value_var, + event_var, + value_var_color, + value_var_symbol, + subtable_labels, + subtable_cols, + filter_panel_api, + plot_height = 600) { + moduleServer(id, function(input, output, session) { + plotly_selected_q <- srv_g_swimlane( + "plot", + data = data, + dataname = dataname, + time_var = time_var, + subject_var = subject_var, + value_var = value_var, + event_var = event_var, + value_var_color = value_var_color, + value_var_symbol = value_var_symbol, + filter_panel_api = filter_panel_api + ) + + subtable_names <- gsub("[[:space:][:punct:]]+", "_", x = tolower(subtable_labels)) + subtables_q <- reactive({ + req(plotly_selected_q()) + calls <- lapply(seq_along(subtable_names), function(i) { + substitute( + list( + dataname = str2lang(dataname), + subtable_name = str2lang(subtable_names[i]), + subtable_label = subtable_labels[i], + time_var = str2lang(time_var), + subject_var = str2lang(subject_var), + col_defs = subtable_cols[[i]] + ), + expr = { + subtable_name <- dataname |> + dplyr::filter( + time_var %in% plotly_brushed_time, + subject_var %in% plotly_brushed_subject + ) |> + dplyr::select(dplyr::all_of(col_defs)) + attr(subtable_name, "label") <- subtable_label + } + ) + }) + teal.code::eval_code(plotly_selected_q(), as.expression(calls)) + }) + + srv_t_reactables("subtables", data = subtables_q, datanames = subtable_names) + }) +} diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 2b0f941fd..a05cd1d14 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -1,17 +1,124 @@ #' @param ... () additional [reactable()] arguments #' @export -tm_t_reactables <- function(label = "Table", datanames, transformators = list(), decorators = list(), ...) { +tm_t_reactables <- function(label = "Table", datanames = "all", columns = list(), transformators = list(), decorators = list(), ...) { module( label = label, ui = ui_t_reactable, srv = srv_t_reactable, ui_args = list(decorators = decorators), - srv_args = c(list(datanames = datanames, decorators = decorators), rlang::list2(...)), - datanames = datanames, + srv_args = c( + list(datanames = datanames, columns = columns, decorators = decorators), + rlang::list2(...) + ), + datanames = subtables, transformers = transformers ) } +ui_t_reactables <- function(id) { + ns <- NS(id) + div( + class = "simple-card", + uiOutput(ns("subtables")) + ) +} + +srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, decorators, ...) { + moduleServer(id, function(input, output, session) { + + all_datanames_r <- reactive({ + req(data()) + names(Filter(is.data.frame, as.list(data()))) + }) + + datanames_r <- reactive({ + req(all_datanames_r()) + df_datanames <- all_datanames_r() + if (identical(datanames, "all")) { + df_datanames + } else { + intersect(datanames, df_datanames) + } + }) |> bindEvent(all_datanames_r()) + + columns_r <- reactive({ + req(datanames_r()) + sapply(datanames_r(), function(dataname) { + if (length(columns[[dataname]])) { + columns()[[dataname]] + } else { + colnames(isolate(data())[[dataname]]) + } + }) + }) |> bindEvent(datanames_r()) + + datalabels_r <- reactive({ + req(datanames_r()) + sapply(datanames_r(), function(dataname) { + datalabel <- attr(isolate(data())[[dataname]], "label") + if (length(datalabel)) datalabel else dataname + }) + }) |> bindEvent(datanames_r()) + + # todo: re-render only if datanames changes + output$subtables <- renderUI({ + if (length(datanames_r()) == 0) return(NULL) + isolate({ + do.call( + tabsetPanel, + c( + list(id = session$ns("reactables")), + lapply( + datanames_r(), + function(dataname) { + tabPanel( + title = datalabels_r()[dataname], + ui_t_reactable(session$ns(dataname)) + ) + } + ) + ) + ) + }) + }) |> bindCache(datanames_r()) + + called_datanames <- reactiveVal() + observeEvent(datanames_r(), { + lapply( + setdiff(datanames_r(), called_datanames()), # call module only once per dataname + function(dataname) srv_t_reactable(dataname, data = data, dataname = dataname, filter_panel_api = filter_panel_api, ...) + ) + called_datanames(union(called_datanames(), datanames_r())) + }) + + + # lapply( + # seq_along(subtables), + # function(i) { + # table_q <- reactive({ + # within( + # plotly_selected_q(), + # dataname = str2lang(dataname), + # subtable_name = subtable_names[i], + # time_var = str2lang(time_var), + # subject_var = str2lang(subject_var), + # col_defs = subtables[[i]], + # expr = { + # subtable_name <- dataname |> + # dplyr::filter( + # time_var %in% plotly_brushed_time, + # subject_var %in% plotly_brushed_subject + # ) |> + # dplyr::select(dplyr::all_of(col_defs)) + # } + # ) + # }) + # srv_t_reactable(subtable_names[i], data = table_q, dataname = subtable_names[i], selection = NULL) + # } + # ) + }) +} + ui_t_reactable <- function(id) { ns <- NS(id) div( @@ -128,4 +235,6 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, .. } } - +.name_to_id <- function(name) { + gsub("[[:space:][:punct:]]+", "_", x = tolower(name)) +} diff --git a/R/utils.R b/R/utils.R index 1166de42e..a6a48cbf5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -428,3 +428,37 @@ normalize_decorators <- function(decorators) { decorators } } + + +#' Color palette discrete +#' +#' To specify custom discrete colors to `plotly` or `ggplot` elements one needs to specify a vector named by +#' levels of variable used for coloring. This function allows to specify only some or none of the colors/levels +#' as the rest will be filled automatically. +#' @param levels (`character`) values of possible variable levels +#' @param color (`named character`) valid color names (see [colors()]) or hex-colors named by `levels`. +#' @return `character` with hex colors named by `levels`. +.color_palette_discrete <- function(levels, color) { + p <- color[names(color) %in% levels] + p_rgb_num <- col2rgb(p) + p_hex <- rgb(p_rgb_num[1,]/255, p_rgb_num[2,]/255, p_rgb_num[3,]/255) + p <- setNames(p_hex, names(p)) + missing_levels <- setdiff(levels, names(p)) + N <- length(levels) + n <- length(p) + m <- N - n + if (m & n) { + current_space <- rgb2hsv(col2rgb(p)) + optimal_color_space <- colorspace::qualitative_hcl(N) + color_distances <- dist(t(cbind(current_space, rgb2hsv(col2rgb(optimal_color_space))))) + optimal_to_current_dist <- as.matrix(color_distances)[seq_len(n), -seq_len(n)] + furthest_neighbours_idx <- order(apply(optimal_to_current_dist, 2, min), decreasing = TRUE) + missing_colors <- optimal_color_space[furthest_neighbours_idx][seq_len(m)] + p <- c(p, setNames(missing_colors, missing_levels)) + } else if (n) { + colorspace::qualitative_hcl(N) + } else { + p + } +} + diff --git a/inst/poc_crf2.R b/inst/poc_crf2.R index 412cb07fb..4560e5ce6 100644 --- a/inst/poc_crf2.R +++ b/inst/poc_crf2.R @@ -2,7 +2,7 @@ library(teal) library(DT) library(labelled) library(reactable) -#pkgload::load_all("teal.modules.general") +pkgload::load_all("teal.modules.general") # Note: Please add the `PATH_TO_DATA` and change the X, Y, and Z Administrations to the actual values in the data with_tooltips <- function(...) { @@ -17,7 +17,7 @@ data <- within(teal_data(), { library(dplyr) library(arrow) library(forcats) - data_path <- "/ocean/harbour/CDT70436/GO43979/CSRInterim_roak_upver/dev/data/other/mdr_spotfire/" + data_path <- "PATH/TO/THE/DATA" swimlane_ds <- read_parquet(file.path(data_path, "swimlane_ds.parquet")) |> filter(!is.na(event_result), !is.na(event_study_day)) |> From 1596f2d171b5e631b6a9012924944e74aa4ce8a6 Mon Sep 17 00:00:00 2001 From: vedhav Date: Wed, 5 Mar 2025 03:24:17 -0500 Subject: [PATCH 46/92] update the app code --- inst/poc_crf2.R | 95 +++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 84 insertions(+), 11 deletions(-) diff --git a/inst/poc_crf2.R b/inst/poc_crf2.R index 4560e5ce6..3b74c614b 100644 --- a/inst/poc_crf2.R +++ b/inst/poc_crf2.R @@ -126,6 +126,40 @@ tm_swimlane <- function(label = "Swimlane", plot_height = 700) { summarise(study_day = max(event_study_day)) |> bind_rows(tibble(subject = unique(swimlane_ds$subject), study_day = 0)) + adverse_events <- swimlane_ds |> + filter(event_type == "adverse_event") |> + select(subject, event_study_day, event_result, aenum, aeraw, icrsgr, ecrsgr, igrnci, egrnci, aeod_study_day, aerd_study_day) |> + mutate( + initial_grade = coalesce(icrsgr, igrnci), + extreme_grade = coalesce(ecrsgr, egrnci), + initial_label = case_when( + !is.na(icrsgr) ~ "Initial ASTCT Grade", + !is.na(igrnci) ~ "Initial NCI CTCAE Grade", + TRUE ~ "Initial Grade" + ), + extreme_label = case_when( + !is.na(ecrsgr) ~ "Most Extreme ASTCT Grade", + !is.na(egrnci) ~ "Most Extreme NCI CTCAE Grade", + TRUE ~ "Most Extreme Grade" + ) + ) |> + mutate( + tooltip = sprintf( + "Subject: %s
Study Day: %d
AENUM: %d
Event of Interest: %s
Primary Adverse Event: %s
Onset Study Day: %d
End Date Study Day: %d
%s: %d
%s: %d", + subject, + event_study_day, + aenum, + event_result, + aeraw, + aeod_study_day, + aerd_study_day, + initial_label, + initial_grade, + extreme_label, + extreme_grade + ) + ) + p <- plotly::plot_ly( source = "swimlane", colors = c( @@ -140,7 +174,13 @@ tm_swimlane <- function(label = "Swimlane", plot_height = 700) { "SCR (Stringent Complete Response)" = "midnightblue", "X Administration Injection" = "goldenrod", "Y Administration Infusion" = "deepskyblue3", - "Z Administration Infusion" = "darkorchid" + "Z Administration Infusion" = "darkorchid", + "Cytokine Release Syndrome" = "#f5a733", + "Cytokine Release Syndrome Start" = "#fccf79", + "Cytokine Release Syndrome End" = "#f59505", + "Infection" = "pink", + "Infection Start" = "#f2ced3", + "Infection End" = "#d65668" ), symbols = c( "DEATH" = "circle", @@ -182,6 +222,41 @@ tm_swimlane <- function(label = "Swimlane", plot_height = 700) { line = list(width = 1, color = "grey"), showlegend = FALSE ) |> + plotly::add_segments( + data = adverse_events, + x = ~aeod_study_day, + xend = ~aerd_study_day, + y = ~subject, + yend = ~subject, + color = ~event_result, + line = list(width = 2), + showlegend = TRUE, + name = ~event_result, + legendgroup = ~event_result, + hoverinfo = "none" + ) |> + plotly::add_markers( + data = adverse_events |> filter(event_study_day == aeod_study_day), + x = ~aeod_study_day, + y = ~subject, + text = ~tooltip, + hoverinfo = "text", + color = ~ paste0(event_result, " Start"), + showlegend = TRUE, + legendgroup = ~event_result, + marker = list(size = 6, symbol = "arrow-down") + ) |> + plotly::add_markers( + data = adverse_events |> filter(event_study_day == aerd_study_day), + x = ~aerd_study_day, + y = ~subject, + text = ~tooltip, + hoverinfo = "text", + color = ~ paste0(event_result, " End"), + showlegend = TRUE, + legendgroup = ~event_result, + marker = list(size = 6, symbol = "arrow-down") + ) |> plotly::layout( xaxis = list(title = "Study Day"), yaxis = list(title = "Subject") ) |> @@ -205,11 +280,8 @@ tm_swimlane <- function(label = "Swimlane", plot_height = 700) { swimlane_ds <- data()[["swimlane_ds"]] col_defs <- with_tooltips( subject = colDef(name = "Subject"), - visit_name = colDef(name = "Visit Name", width = 250), - visit_date = colDef(name = "Visit Date"), - form_name = colDef(name = "Form Name", width = 250), - source_system_url_link = colDef( - name = "Source System URL Link", + raise_query = colDef( + name = "Raise Query", cell = function(value) { if (!is.na(value) && !is.null(value) && value != "") { htmltools::tags$a(href = value, target = "_blank", "Link") @@ -218,16 +290,17 @@ tm_swimlane <- function(label = "Swimlane", plot_height = 700) { } } ), + visit_name = colDef(name = "Visit Name"), rspdn = colDef(name = "Assessment Performed"), rspd = colDef(name = "Response Date"), rspd_study_day = colDef(name = "Response Date Study Day"), - orsp = colDef(name = "Response", width = 250), + orsp = colDef(name = "Response"), bma = colDef(name = "Best Marrow Aspirate"), bmb = colDef(name = "Best Marrow Biopsy"), comnts = colDef(name = "Comments") ) mm_response <- swimlane_ds |> - filter(event_study_day %in% plotly_selected()$x, subject %in% plotly_selected()$y) |> + filter(event_study_day %in% plotly_selected()$x, subject %in% plotly_selected()$y, event_type == "response_assessment") |> select(all_of(names(col_defs))) if (nrow(mm_response) == 0) { return() @@ -394,6 +467,7 @@ tm_spider <- function(label = "Spiderplot", plot_height = 600) { y_title <- selected_event spiderplot_ds_filtered <- spiderplot_ds |> filter(event_type == selected_event) + ticksuffix <- ifelse(grepl("Change from baseline", selected_event), "%", "") p <- plotly::plot_ly(source = "spiderplot", height = height) |> plotly::add_markers( @@ -407,8 +481,8 @@ tm_spider <- function(label = "Spiderplot", plot_height = 600) { ) |> plotly::layout( xaxis = list(title = "Collection Date Study Day", zeroline = FALSE), - yaxis = list(title = ~y_title), - title = ~ paste0(y_title, " Over Time") + yaxis = list(title = ~y_title, ticksuffix = ticksuffix, separatethousands = TRUE, exponentformat = "none"), + title = ~ paste0(paste(strwrap(y_title, width = 50), collapse = "
"), " Over Time") ) |> plotly::layout(dragmode = "select") |> plotly::config(displaylogo = FALSE) @@ -689,4 +763,3 @@ app <- init( ) shinyApp(app$ui, app$server) - From bb0917c1ebb596acf4507a8c9780c4c38986df22 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Wed, 5 Mar 2025 16:46:49 +0100 Subject: [PATCH 47/92] WIP waterfall --- R/tm_g_waterfall.R | 219 +++++++++++++++++++++++++++++++-------------- 1 file changed, 152 insertions(+), 67 deletions(-) diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index d3c106d32..0548454e4 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -1,19 +1,28 @@ -tm_g_waterfall <- function(label = "Waterfall", time_var, subject_var, value_var, event_var, plot_height = 700) { - time_var$dataname <- "ADTR" - subject_var$dataname <- "ADTR" - value_var$dataname <- "ADTR" - event_var$dataname <- "ADTR" +tm_g_waterfall <- function(label = "Waterfall", + plot_dataname, + table_datanames, + subject_var, + value_var, + color_var = NULL, + bar_colors = list(), + value_arbitrary_hlines = c(0.2, -0.3), + plot_title = "Waterfall plot", + plot_height = 700) { module( label = label, ui = ui_g_waterfall, server = srv_g_waterfall, - datanames = "all", + datanames = union(plot_dataname, table_datanames), ui_args = list(height = plot_height), server_args = list( - time_var = time_var, + plot_dataname = plot_dataname, + table_datanames = table_datanames, subject_var = subject_var, value_var = value_var, - event_var = event_var + color_var = color_var, + bar_colors = bar_colors, + value_arbitrary_hlines = value_arbitrary_hlines, + plot_title = plot_title ) ) } @@ -25,64 +34,69 @@ ui_g_waterfall <- function(id, height) { class = "simple-card", div( class = "row", - column( - width = 4, - selectInput(ns("select_event"), "Select Y Axis (to remove)", NULL) - ), - column( - width = 4, - sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) - ), - column( - width = 4, - sliderInput(ns("color_by"), "Plot Height (px)", 400, 1200, height) - ) + column(width = 6, uiOutput(ns("color_by_output"))), + column(width = 6, sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)) ), - h4("Waterfall"), plotly::plotlyOutput(ns("plot"), height = "100%") ), fluidRow( - h4("All lesions"), - ui_t_reactable(ns("all_lesions")) - + uiOutput(ns("tables")) ) ) } -srv_g_waterfall <- function(id, - data, - dataname, - time_var, - subject_var, - value_var, - event_var, - filter_panel_api, - plot_height = 600) { +srv_g_waterfall <- function(id, + data, + plot_dataname, + table_datanames, + subject_var, + value_var, + color_var, + bar_colors, + filter_panel_api, + value_arbitrary_hlines, + plot_title, + plot_height = 600) { moduleServer(id, function(input, output, session) { - event_levels <- reactive({ - req(data()) - unique(data()[[event_var$dataname]][[event_var$selected]]) - }) - observeEvent(event_levels(), { - updateSelectInput(inputId = "select_event", choices = event_levels(), selected = event_levels()[1]) + output$color_by_output <- renderUI({ + selectInput(session$ns("color_by"), label = "Color by:", choices = color_var$choices, selected = color_var$selected) }) - + if (length(color_var$choices) > 1) { + shinyjs::show("color_by") + } else { + shinyjs::hide("color_by") + } plotly_q <- reactive({ + req(data(), input$color_by) + adjusted_colors <- .color_palette_discrete( + levels = unique(data()[[plot_dataname]][[input$color_by]]), + color = bar_colors[[input$color_by]] + ) + + subject_var_label <- c( + attr(data()[[plot_dataname]][[subject_var]], "label"), + subject_var + )[1] + + value_var_label <- c( + attr(data()[[plot_dataname]][[value_var]], "label"), + value_var + )[1] + data() |> within( - dataname = str2lang(time_var$dataname), - dataname_filtered = str2lang(sprintf("%s_filtered", time_var$dataname)), - time_var = str2lang(time_var$selected), - subject_var = str2lang(subject_var$selected), - value_var = str2lang(value_var$selected), - event_var = str2lang(event_var$selected), - selected_event = input$select_event, + dataname = str2lang(plot_dataname), + dataname_filtered = str2lang(sprintf("%s_filtered", plot_dataname)), + subject_var = str2lang(subject_var), + value_var = str2lang(value_var), + color_var = str2lang(input$color_by), + colors = adjusted_colors, + value_arbitrary_hlines = value_arbitrary_hlines, + subject_var_label = subject_var_label, + value_var_label = value_var_label, + title = paste0(value_var_label, " (Waterfall plot)"), height = input$plot_height, - xaxis_label = attr(data()[[subject_var$dataname]][[subject_var$selected]], "label"), - yaxis_label = input$select_event, - title = paste0(input$select_event, " Over Time"), expr = { p <- dataname |> - dplyr::filter(event_var %in% selected_event) |> dplyr::mutate( subject_var_ordered = forcats::fct_reorder(as.factor(subject_var), value_var, .fun = max, .desc = TRUE) ) |> @@ -91,23 +105,94 @@ srv_g_waterfall <- function(id, source = "waterfall", height = height ) |> - plotly::add_bars( - x = ~subject_var_ordered, y = ~value_var, - showlegend = FALSE - ) |> - plotly::layout( - xaxis = list(title = xaxis_label), yaxis = list(title = yaxis_label) - ) |> - plotly::layout(dragmode = "select") |> - plotly::config(displaylogo = FALSE) - }, - height = input$plot_height - ) + plotly::add_bars( + x = ~subject_var_ordered, + y = ~value_var, + color = ~color_var, + colors = colors, + text = ~ paste( + subject_var_label, ":", subject_var, + value_var_label, ":", value_var, "
" + ), + hoverinfo = "text" + ) |> + plotly::layout( + shapes = lapply(value_arbitrary_hlines, function(y) { + list( + type = "line", + x0 = 0, + x1 = 1, + xref = "paper", + y0 = y, + y1 = y, + line = list(color = "black", dash = "dot") + ) + }), + title = title, + xaxis = list(title = subject_var_label, tickangle = -45), + yaxis = list(title = value_var_label), + legend = list(title = list(text = "Color by:")), + barmode = "relative", + dragmode = "select" + ) |> + plotly::config(displaylogo = FALSE) + }, + height = input$plot_height + ) }) - + output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) - + plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "waterfall")) - + plotly_selected_q <- reactive({ + req(plotly_selected()) + within( + plotly_q(), + subject_vals = plotly_selected()$x, + value_vals = plotly_selected()$y, + expr = { + # todo: this should use the join keys instead. Probably need to filter visualization data.frame and use its column + plotly_brushed_subjects <- subject_vals + plotly_brushed_value <- value_vals + } + ) + }) + + tables_selected_q <- reactive({ + req(plotly_selected_q()) + teal.code::eval_code( + plotly_selected_q(), + code = as.expression( + lapply( + table_datanames, + function(dataname) { + substitute( + expr = dataname_brushed <- dplyr::filter(dataname, subject_var %in% plotly_brushed_subjects), + env = list( + dataname_brushed = str2lang(sprintf("%s_brushed", dataname)), + dataname = str2lang(dataname), + subject_var = str2lang(subject_var) + ) + ) + } + ) + ) + ) + }) + + output$tables <- renderUI({ + if (length(table_datanames) > 1) { + ui_t_reactables(session$ns("subtables")) + } else if (length(table_datanames) == 1) { + ui_t_reactable(session$ns("subtables")) + } + }) + + + if (length(table_datanames) > 1) { + srv_t_reactables("subtables", data = tables_selected_q, datanames = sprintf("%s_brushed", table_datanames)) + } else if (length(table_datanames) == 1) { + srv_t_reactable("subtables", data = tables_selected_q, dataname = sprintf("%s_brushed", table_datanames)) + } }) -} \ No newline at end of file +} From ef300f5b64e7df53404824906362e9ffe2ec4441 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Thu, 6 Mar 2025 07:48:35 +0000 Subject: [PATCH 48/92] update --- R/tm_g_waterfall.R | 16 ++----------- R/tm_t_reactable.R | 60 +++++++++++++++++++++++++++++----------------- 2 files changed, 40 insertions(+), 36 deletions(-) diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 0548454e4..0bb8ca74e 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -180,19 +180,7 @@ srv_g_waterfall <- function(id, ) }) - output$tables <- renderUI({ - if (length(table_datanames) > 1) { - ui_t_reactables(session$ns("subtables")) - } else if (length(table_datanames) == 1) { - ui_t_reactable(session$ns("subtables")) - } - }) - - - if (length(table_datanames) > 1) { - srv_t_reactables("subtables", data = tables_selected_q, datanames = sprintf("%s_brushed", table_datanames)) - } else if (length(table_datanames) == 1) { - srv_t_reactable("subtables", data = tables_selected_q, dataname = sprintf("%s_brushed", table_datanames)) - } + output$tables <- renderUI(ui_t_reactables(session$ns("subtables"))) + srv_t_reactables("subtables", data = tables_selected_q, dataname = sprintf("%s_brushed", table_datanames)) }) } diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index a05cd1d14..f7851b38a 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -1,13 +1,13 @@ #' @param ... () additional [reactable()] arguments #' @export -tm_t_reactables <- function(label = "Table", datanames = "all", columns = list(), transformators = list(), decorators = list(), ...) { +tm_t_reactables <- function(label = "Table", datanames = "all", columns = list(), layout = "grid", transformators = list(), decorators = list(), ...) { module( label = label, ui = ui_t_reactable, srv = srv_t_reactable, ui_args = list(decorators = decorators), srv_args = c( - list(datanames = datanames, columns = columns, decorators = decorators), + list(datanames = datanames, columns = columns, layout = layout, decorators = decorators), rlang::list2(...) ), datanames = subtables, @@ -17,15 +17,11 @@ tm_t_reactables <- function(label = "Table", datanames = "all", columns = list() ui_t_reactables <- function(id) { ns <- NS(id) - div( - class = "simple-card", - uiOutput(ns("subtables")) - ) + uiOutput(ns("subtables"), container = fluidRow) } -srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, decorators, ...) { +srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, decorators, layout = "grid", ...) { moduleServer(id, function(input, output, session) { - all_datanames_r <- reactive({ req(data()) names(Filter(is.data.frame, as.list(data()))) @@ -63,23 +59,43 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, dec # todo: re-render only if datanames changes output$subtables <- renderUI({ if (length(datanames_r()) == 0) return(NULL) - isolate({ - do.call( - tabsetPanel, - c( - list(id = session$ns("reactables")), - lapply( - datanames_r(), - function(dataname) { - tabPanel( - title = datalabels_r()[dataname], - ui_t_reactable(session$ns(dataname)) + + if (layout == "grid") { + tagList( + lapply( + datanames_r(), + function(dataname) { + column( + width = if (length(datanames_r()) == 1) 12 else 6, + div( + class = "simple-card", + h4(datalabels_r()[dataname]), + ui_t_reactable(session$ns(dataname)) ) - } - ) + ) + } ) ) - }) + } else if (layout == "tabs") { + isolate({ + do.call( + tabsetPanel, + c( + list(id = session$ns("reactables")), + lapply( + datanames_r(), + function(dataname) { + tabPanel( + title = datalabels_r()[dataname], + ui_t_reactable(session$ns(dataname)) + ) + } + ) + ) + ) + }) + } + }) |> bindCache(datanames_r()) called_datanames <- reactiveVal() From 3536699fbcde2ed10f8ebfba79d9f5eb58df1e31 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Thu, 6 Mar 2025 07:53:47 +0000 Subject: [PATCH 49/92] namespace fix --- NAMESPACE | 7 ++++++- R/tm_a_spiderplot_mdr.R | 1 + R/tm_g_spiderplot.R | 1 + R/tm_g_swimlane.R | 1 + R/tm_g_waterfall.R | 1 + R/tm_swimlane_mdr.R | 1 + R/tm_t_reactable.R | 1 - man/dot-color_palette_discrete.Rd | 21 +++++++++++++++++++++ man/dot-make_reactable_columns_call.Rd | 24 ++++++++++++++++++++++++ man/tm_a_pca.Rd | 12 +----------- man/tm_a_regression.Rd | 12 +----------- man/tm_data_table.Rd | 7 +------ man/tm_front_page.Rd | 7 +------ man/tm_g_association.Rd | 7 +------ man/tm_g_bivariate.Rd | 7 +------ man/tm_g_distribution.Rd | 12 +----------- man/tm_g_response.Rd | 7 +------ man/tm_g_scatterplot.Rd | 12 +----------- man/tm_g_scatterplotmatrix.Rd | 12 +----------- man/tm_missing_data.Rd | 12 +----------- man/tm_outliers.Rd | 12 +----------- man/tm_t_crosstable.Rd | 12 +----------- man/tm_variable_browser.Rd | 12 +----------- 23 files changed, 70 insertions(+), 131 deletions(-) create mode 100644 man/dot-color_palette_discrete.Rd create mode 100644 man/dot-make_reactable_columns_call.Rd diff --git a/NAMESPACE b/NAMESPACE index bff1753a2..1c5bcba30 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,7 @@ export(add_facet_labels) export(get_scatterplotmatrix_stats) export(tm_a_pca) export(tm_a_regression) +export(tm_a_spiderplot_mdr) export(tm_data_table) export(tm_file_viewer) export(tm_front_page) @@ -21,10 +22,14 @@ export(tm_g_distribution) export(tm_g_response) export(tm_g_scatterplot) export(tm_g_scatterplotmatrix) +export(tm_g_spiderplot) +export(tm_g_swimlane) +export(tm_g_swimlane_mdr) +export(tm_g_waterfall) export(tm_missing_data) export(tm_outliers) -export(tm_p_swimlane2) export(tm_t_crosstable) +export(tm_t_reactables) export(tm_variable_browser) import(ggmosaic) import(ggplot2) diff --git a/R/tm_a_spiderplot_mdr.R b/R/tm_a_spiderplot_mdr.R index 4d4338ce5..7627adc00 100644 --- a/R/tm_a_spiderplot_mdr.R +++ b/R/tm_a_spiderplot_mdr.R @@ -1,3 +1,4 @@ +#' @export tm_a_spiderplot_mdr <- function(label = "Spiderplot", dataname, time_var, diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 2364a0ee1..42a69859c 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -1,3 +1,4 @@ +#' @export tm_g_spiderplot <- function(label = "Spiderplot", time_var, subject_var, diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 37cbddbdf..2405b8f34 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -1,3 +1,4 @@ +#' @export tm_g_swimlane <- function(label = "Swimlane", dataname, time_var, diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 0bb8ca74e..80b240214 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -1,3 +1,4 @@ +#' @export tm_g_waterfall <- function(label = "Waterfall", plot_dataname, table_datanames, diff --git a/R/tm_swimlane_mdr.R b/R/tm_swimlane_mdr.R index 440dad248..70e31f944 100644 --- a/R/tm_swimlane_mdr.R +++ b/R/tm_swimlane_mdr.R @@ -1,3 +1,4 @@ +#' @export tm_g_swimlane_mdr <- function(label = "Swimlane", dataname, time_var, diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index f7851b38a..db4ff7ef6 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -1,4 +1,3 @@ -#' @param ... () additional [reactable()] arguments #' @export tm_t_reactables <- function(label = "Table", datanames = "all", columns = list(), layout = "grid", transformators = list(), decorators = list(), ...) { module( diff --git a/man/dot-color_palette_discrete.Rd b/man/dot-color_palette_discrete.Rd new file mode 100644 index 000000000..ce42d0d3a --- /dev/null +++ b/man/dot-color_palette_discrete.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{.color_palette_discrete} +\alias{.color_palette_discrete} +\title{Color palette discrete} +\usage{ +.color_palette_discrete(levels, color) +} +\arguments{ +\item{levels}{(\code{character}) values of possible variable levels} + +\item{color}{(\verb{named character}) valid color names (see \code{\link[=colors]{colors()}}) or hex-colors named by \code{levels}.} +} +\value{ +\code{character} with hex colors named by \code{levels}. +} +\description{ +To specify custom discrete colors to \code{plotly} or \code{ggplot} elements one needs to specify a vector named by +levels of variable used for coloring. This function allows to specify only some or none of the colors/levels +as the rest will be filled automatically. +} diff --git a/man/dot-make_reactable_columns_call.Rd b/man/dot-make_reactable_columns_call.Rd new file mode 100644 index 000000000..22b11063e --- /dev/null +++ b/man/dot-make_reactable_columns_call.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tm_t_reactable.R +\name{.make_reactable_columns_call} +\alias{.make_reactable_columns_call} +\title{Makes \code{reactable::colDef} call containing: +name = \if{html}{\out{}} +cell = \if{html}{\out{}} +Arguments of \code{\link[reactable:colDef]{reactable::colDef()}} are specified only if necessary} +\usage{ +.make_reactable_columns_call(dataset) +} +\arguments{ +\item{dataset}{(\code{data.frame})} +} +\value{ +named list of \code{colDef} calls +} +\description{ +Makes \code{reactable::colDef} call containing: +name = \if{html}{\out{}} +cell = \if{html}{\out{}} +Arguments of \code{\link[reactable:colDef]{reactable::colDef()}} are specified only if necessary +} +\keyword{internal} diff --git a/man/tm_a_pca.Rd b/man/tm_a_pca.Rd index 5a1d7fdb6..d6d8a3f10 100644 --- a/man/tm_a_pca.Rd +++ b/man/tm_a_pca.Rd @@ -74,7 +74,7 @@ with text placed before the output to put the output into context. For example a adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module}) optional, @@ -194,15 +194,6 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlY4AygCCjNUtonG6fYPDpKJKAL5dSmioYyp57BX+GboAvJtBuBt8QiKju0fCYuvdlbqkMIlQiagEqRs3ugpgAAoAwv2fB2u7xiOz2jzCpGYGkSolQcAIV3ewIy0HgoM+EyGYmmALeSNEcBEGlBBKJpBhcIReKRugI+SItAIYlBWhYtCg9BEiTpDKZokRNKRKVBKWAwAxAyxI0+AF0ZaUqWAALKCRj8GQAj5gfqiURQYSkTUYxj0KAQL5EVBGsBYNBwT5dQU3OSAp2VUnw8j8UGKlVqjV4LU6vUGh2ut0wA20SJ6XYOFzU53hmkmWjUciMUEAOUcABlc4nHc6Nl0urQTLp2CoM+pNDobLZytdRIUIKx+uh2EsACT1Uo9gmMHSdOZKMCzGVAA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} - } - \item{example-2}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWT64bGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0CZVi9lqQ3N0AF5-uFcH8+EIRKIgboIcIxL8BnVdKQYGkoGlUAQsn9kboFGAAApeQYEsFIvGJGGZNLRUjMDRpUSoOAERF4ym5B56YEEqajMm4jmiOAiDQwkVi47M1nsjl4gglJYEMQwrQsWhQegiE5K2gqzZC+V1TLU3LAYB8kYCsAvF5VNkEgBCAFksABpLAARjJ+LAgwA4q48H7nAB5AI+ACaBP6xuRcnJ8bqktZ5H4MMdYFdHu9vr5QdjSeTMCOtDiPPsTlcFI5iaNyJMtGo5EYMIAco5RgLa3U4wm-v1+rQTLp2CpW+pNDobLYakjRGUIKxBuh2GhUAASFpVDebkWMHR9WZKMAzF5AA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokrcQAxLqkQ11XfxQpFC6cAAesKgiSoHBBsZc1AD6sVA2MUEhRroA7rSkABYq7Km4uiBKurqMcACOgrQ17L6ipMTURIyKEFWOAMoAgow1raLxuv1DI6SiSgC+3UpoqOMq+eyVAZm6ALxbwbibfEIiY3vHwmIbPVW6pDBJUEmoBGmbt7oKYAAKAMIDX0ONw+sV2+ye4VIzA0SVEqDgBGuHxBmWg8DBX0mwzEM0B72RojgIg0YMJxNIsPhiPxyN0BAKRFoBDEYK0LFoUHoIiS9MZzNESNpyNSYNSwGAmMG2NGXwAurKytSwABZQSMfgyQGfMADUSiKDCUhazGMehQCDfIioY1gLBoOBfbpC25yIHOqpkhHkfhgpWq9WavDa3X6w2Ot3umCG2hRPR7BwuGkuiO0ky0ajkRhggByjgAMnmk06XZtut1aCZdOwVJn1JodDZbBUbqIihBWAN0OxlgASBplXuExg6LrzJRgOayoA}{Open in Shinylive} \if{html}{\out{}} \if{html}{\out{}} @@ -210,7 +201,6 @@ if (interactive()) { \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokrcQAxLoDCAEQCSAMreuvxQpFC6cAAesKgiSmERBsZc1AD6SVA2ieGRRroA7rSkABYq7Fm4uiBKurqMcACOgrSN7BBipMTURIyKEPUAgr6BADIpumkYWYiIjCPjSgC+AwBWRCrpANZwrKKVebYF-HAmUMKk6QT8tKIE6Rtbu-vA0PAHWXIAuu5oqJMVCV2HVQnldABeMERXCgvhCESiSG6eHCMQgwb1KYwdJQdKoAjZUFY3QKMAABW8QzJsMxJKSyKy6RipGYGnSolQcAIGJJ9Ly7z0ULJizGNOJfNEcBEGmRUplV053N5fJJBFKmwIYmRWhYtCg9BE1w1tC1BwlqvqWUZeWAwBFozFYG+32qPLJACEALJYADSWAAjDTSWAhgBxVx4EPOADygV8AE0yQNLVi5LTU-V5dzyPxke6wN6-YHgyKI8mM5mYJdaPEhfYnK46Xz0xasSZaNRyIxkQA5RxjMXN+optOggYDWgmXTsFTd9SaHQ2Wy1TGicoQVhDdDsf4AEla1X3UsYOn6KyUYGW3yAA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_a_regression.Rd b/man/tm_a_regression.Rd index 266473299..5e8703be1 100644 --- a/man/tm_a_regression.Rd +++ b/man/tm_a_regression.Rd @@ -98,7 +98,7 @@ argument in \code{teal.widgets::optionalSliderInputValMinMax}. }} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module}) optional, @@ -219,15 +219,6 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQDCAPIATHG6-QNKAL5dSmiowyp57BX+GboAvMtBuEt8QiKia7o7wmKL3ZW6pDCJUInVEtWiolYQp+fn1FD0cH7rCmBYcHuYieJD+WzObweqBIoj06xSiTCpGYGkSolQcAIrze5xS0HgBz+ozBSxxulhIg0BwpmNIaIxWNJZN0Hy+P10fwAyt9abotCxaJ8RIgSRDmQR8kRaAQxISwIJUEEANZwUXM840jRwfhyhXK1V4JlkmDCTSROG6ABiAEEADKc5zg9WVEy0ULag4OFxG85dMlyJ04u4PUQdA4IpEounozHYsl42AWomDNXMzWkak81Exxlisms75y7mUjP8xiC+h7EWGvM4iVSmX7dZlisiRL16UnFLAYDJsZgAC6A9KjMIJAIYI5YDs1UC8DIfzkAZ9b3THt+Y4sqfVJuoZpEnqcjpX51d7p16xt9tctcqfpx97vSy6XVoJl07BU5Cj2jgNls5RnKIhQQKw1roOwMwACT1KU0GwowOidBMShgOMA5AA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} - } - \item{example-2}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWT64bGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0CZVi9lqQ3N0AF5-uFcH8+EIRKIgboIcIxL8BnVdKQYGkoGkGhIGqJRFYIIjkcjqFB6HBqDCFGAsHBsWI8SQqWCkUScagSKI9MDMmloqRmBo0qJUHACISicjMg8uboqVNRky-hLdJyRBoYarRcdhaLxcq6iSyRTgVSAuStbotCxaKSRIhFSz9QQSksCGJKWAAEIAWSwAGksABGB365GajRwfgen3+oMh0Owo60OIygBig1GAWczITploUUjMIcLiVEv6yrkOYlWJxol6MJ5fIF2pFYtLRKlsBlcpGCrw7bD5vVwPDLd1A6JhvJHrNatIluttrE9v7juVztd7uBVsYNvoIhOLtobqeuWAwB70zALxeVTbYEGAHFXHhZWAswANJlvrCDLwvuRKwnQc50LE0H2feNQxgJMUyLJxs2AuoTHzMDdHTTNXDXZFyzLUtcP6fpaBMXR2BUchm20OAbFsGokVEMoIFYQZ0HYNBUAAEhaKp2I4zlGB0PpZiUMAZheIA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokrcQAxLqkQ11XfxQpFC6cAAesKgiSoHBBsZc1AD6sVA2MUEhRroA7rSkABYq7Km4uiBKurqMcACOgrQ17L6ipMTURIyKEFUAwgDyAEzxugODSgC+3UpoqCMq+eyVAZm6ALwrwbjLfEIiouu6u8JiSz1VuqQwSVBJNRI1oqJWEGcXF9RQ9HD+GwpgWDgDzEzxI-2253ej1QJFEeg2qSS4VIzA0SVEqDgBDe7wuqWg8EO-zG4OWuN0cJEGkOlKxpHRmOxZPJuk+31+un+AGUfnTdFoWLQviJEKTISyCAUiLQCGIiWBBKhggBrOBilkXWkaOD8eWKlVqvDM8kwYSaKLw3QAMQAggAZLnOCEaqomWhhHWHBwuY0XbrkuTO3H3R6iTqHRHI1H0jFYnHk-GwS3Eobqlla0g03lo2NM8Xktk-eU8qmZgWMIX0faio353GS6Wyg4bcuVkRJBsy06pYDAFPjMAAXUHZSZhBIBHBnLAdhqQXgZH+ckDvveGc9f3HFjTGtN1HNIi9Tidq4ubo9uo2todrjrVX9uIf9+W3W6tBMunYKnI0e0cBstgVOcohFBArA2ug7CzAAJA0ZQwXCjA6F0kxKGAEyDkAA}{Open in Shinylive} \if{html}{\out{}} \if{html}{\out{}} @@ -235,7 +226,6 @@ if (interactive()) { \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjA0lA0g0JA1RKIrBB0ZjMdQoPQ4NQkQowFg4ASxMSSPSYRjyYTUCRRHpIZk0tFSMwNGlRKg4AQyeTMZk3vzdPSFqN2SDZbo+SINEitVLLhKpTKNXVKdTaZD6QEafrdFoWLQqSJEGrOSaCCUNgQxHSwAAhACyWAA0lgAIyuk2YvUaOD8X2BkPhyNR5EXWhxRUAMUGowCzg5qdMtCicaRDhc6tl-Q1ckLsvxhNEvSRguFooNkulVfJ8tgiuVI1VeB70ZtOshMc7RtH5LNNN91u1pDtDqdYhdI7dGo9Xp9kPtjEd9BEV09tG9H1ywGAg8WYC+Xyq3bAgwA4q48EqwPmABrs78sEGLxPzkOtZzHZcy0tV8PxTKMYHTTNyycAsILqEwS2g3QczzVxt0xGtqyrIj+n6WgTF0dgVHIDttDgGxbBqDFRDKCBWEGdB2DQVAABIWiqHjeL5RgdD6ZYlDAJYviAA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_data_table.Rd b/man/tm_data_table.Rd index a23d3d170..e5084fbf8 100644 --- a/man/tm_data_table.Rd +++ b/man/tm_data_table.Rd @@ -57,7 +57,7 @@ with text placed before the output to put the output into context. For example a adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -126,13 +126,8 @@ if (interactive()) { \if{html}{\out{}} } \item{example-2}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWT64bGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0CZVi9lqQ3N0AF5-uFcH8+EIRKIgboIcIxL8BnVdKQYBlcmlwvQRIjkcitCxaFBsWI0qI4CINHB+DC6KJSOwpuNgQRfmAAnZHD4AJp+HwKPC6AWOAKOABCACk+QKqgLRZLpYK5X47M5FbKwIMAOKuJXs5wADQFcjkYKReP4xxYEmhwLpDIIaE0JBhAqZ9mJIm8TqsEGNfzq-UDSn6tBMunYKnIzEsOhsthqSNEZQgrEG6HYaFQABIWlUs9nyYwdH1ZkowDMXkA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjAMrk0uF6CJ0ZjMVoWLQoASxGlRHARBo4PwkXRRKR2AtxpCCMCwAE7I4fABNPw+BR4XSixwBRwAIQAUsLRVVRVK5Qqxcq-HZnGqlWBBgBxVzqnnOAAaorkchhGOJ-EuLAkiMhzNZBDQmhISNF7PsFJE3ndVggFpBdX6YaU-VoJl07BU5GYlh0NlsNQxojKEFYg3Q7DQqAAJC0qvmCzTGDo+sslGAll8gA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_front_page.Rd b/man/tm_front_page.Rd index 048a794df..36a288b5a 100644 --- a/man/tm_front_page.Rd +++ b/man/tm_front_page.Rd @@ -46,7 +46,7 @@ argument. }} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -99,13 +99,8 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG3dPbyNdAHdaUgALFXYgqFxdECVdXUY4AEdBWiz2CDFSYmoiRkUIDIBBABEAZQAZH0y6pvTdT1JGdjbGlIUweC8kwdsIulFSdkHqwTjywd0AXl1BgDlnertdLhhBgbAk-1EiQUYCOCXVwdFWMli4TQJdUbBKgF9KgCsiFX8ANZwViiRJhcbGfhwExQYSkfwEfi0UQEfy-f5AkHAaDwUFJOQAXTcZCg9BE-gAjC0khgTMx4OwAJIQExEFa6AgzMDVA5rMAAITGKTscAAHqR2ZzZrzBoL3pUvGS4P4AEzUsK0+lwdgAAwAwkRqIIYFUKTrJVy9TKwLUhbp9YbjVUVebVpyAKwYd0pABsGB9chSDqNJt0AGZXRyuTy8Hy5XIFaTyWH1V5NbBtczWRbBq5Y4MAGJ2kXinNgADi1oAEmNKkpFeSVKh5i1JtMOoM7Em9BTrrtu5TcB2wF2lboVX2G8qVUOqnzRyJw5OB2GlHXoOgWioYjM50l2UlZxk+EIRKJ2SfhGJdxkMqQYP46SR4agoFIb7eMo8oFDGP5yKWbofp+GSDIyMCoOUXhkLoKisowMCeFYEB9mBEoEFAVQSGyjxZBgBwdCBfIAPJxDIsEsuUiGaCQqFgHqmG6Nhui4XA+FgIRt6Bpxd7dueqxTv4TbzEeIE-kiNHQAEXgSPxuhVnYACyjTRvwEnIdw8lKc05S6KI8QQKw-ayUxOEyHo+hMAAfEKPGmEQRCkBAjliGWAAadHIrsjymPkUz2Y5znkNaACasHnmRelwMQED8AFTkubZc6fvpRCRP4ww-mE7IOC4nGVBk3Fzt+v7sjJogACSxBSXL1LAqCLtU6B0BhklJRkrIuYwZVvpVqDRs1tCtch8UyEl660CYujsCo5DMJYOg2LYaRzvpKisE1-VoKgFV5Ck20VaIMg6BUSgfEoYAfASQA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG3dPbyNdAHdaUgALFXYgqFxdECVdXUY4AEdBWiz2CDFSYmoiRkUIDIBBABEAZQAZH10-DCTEREY6pvTdT1JGdh7GlIUweC8k8dsIulFSdnHqwTjy8d0AXl1xgDlnertWuFhxsbAk-1EiQUYCOA3t8dFWMli4TQJdabBKgF9KgArIgqfwAazgrFEiTCs2M-DgJigwlI-gI-FoogI-mBoIhUOA0Hg0KScgAum4yFB6CJ-ABGFpJDAmZjwdgASQgJiIW10BCWYGqZx2YAAQjMUnY4AAPUi8-nLYXjcW-SpeGlwfwAJkZYWZrLg7AABgBhIjUQQwKp0o3ygUmpVgWoS3Sm82Wqpa23bfkAVgwvpSADYMEG5Ck3RarboAMzevkCoV4EUquRq6m0mO6rz62CGzncu3jVzJ8YAMRdUtlRbAAHFHQAJGaVJTq2kqVCrFrzRZ9cZ2DN6OmPVqD+m4PtgAca3RakdtzVaidVEXTkSx+djmNKFvQdAtFQxJYrpK8pLLjJ8IQiUS8q-CMTHjIZUgwfwskio1BQKRP58Zd4oARRh-HIasfT-f8MnGdkYFQcovDIXQVG5RgYE8KwIBHGC5QIKAqgkHl3iyDAzj6KCRQAeTiGRkK5cp0M0EhsLAE18N0QjdGIuBSLAcjn3DfiX0HW9tgXfwO1WC8oKAjEmOgAIvAkUTdAbOwAFlGkTfg5Mw7hVI05pyl0UR4ggVhR2UjiiJkPR9CYAA+CUhNMIgiFICB3LEGsAA0WMxVp3lMfIFlc9zPPIR0AE1kNvGiTLgYgIH4MKPK8mZ+MqDJKlsAAfJyVyvWgTFYfxAOAzgf1EAASWI6QFepYFQddqnQOg8Pk5tdHyvoipK983PIIYlJq1BEza2gOsw1KZGbSlit0dgVCG9RNB0GxbDSFdTJUVhWrGtBUGqvIUkO6rRBkHQKiUP4lDAP4ySAA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_g_association.Rd b/man/tm_g_association.Rd index 2a574f9ea..6833eec2f 100644 --- a/man/tm_g_association.Rd +++ b/man/tm_g_association.Rd @@ -59,7 +59,7 @@ List names should match the following: \code{c("default", "Bivariate1", "Bivaria For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module}) optional, @@ -187,13 +187,8 @@ if (interactive()) { \if{html}{\out{}} } \item{example-2}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWT64bGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0CZVi9lqQ3N0AF5-uFcH8+EIRKIgboIcIxL8BnVdKQYGkJGkoKJREQCLQwlYIIjkciGiYYZk0tFSMwNGlRKg4ARiSTkZkHnpgQowFNRtywUjWbpRHARBoYSKxccGUyWUK6tQoPRRTDuQFRUzSLotCx8fQRIh+X95boCCUlgQxDCdYw9SITubaJbNsaTSCoMBgNzedyXi8BW7kcy1c4ABr83TcrCDLyuPCRsBeADyjgAcg4AJoR71YACy2bAAQcgzsgwAjAWi9HSwAmAt+Ox2ABifPj3IAQrmsABpLB1sD9QNyANuyWauD8VVgaOxo2C+UmWhRCcwpuDUYBVzzkmD1nD111G3Q4GU6m06WM4Pbtm5DlTn14A-Isfi4Evi+yp8kxXK6hT9VStqupKlChqPteJJmhaVrAjadpwA60EuhBrKZJ63ojK2fojoGwaFmGBYznGVTcsmaaZgWgx5pWxalhWbaFrRgz9iRYANs2rasZ2PZ9tyu4mvuKF1O+K5cmA3G9ixX7IjARy0HEnL2E4zg4QuS6iboa4bluAlPvxui7v0-S0OS7AqOQ57aHANi2DUSKiGUECsIM6DsGgqAACQtFU7keSKjA6H0sxKGAMwvEAA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjA0hI0lBRKIiARaGErBB0ZjMQ0TEjMmloqRmBo0qJUHACBTKZjMm89JCFGAFqMBTCMVzdKI4CINEjJdLLqz2ZzxXVqFB6FKkQKAlL2aRdFoWCT6CJECKQSrdAQShsCGIkYbGMaRFcbbQ7fsLZaoVBgMABUKBV8vqLvZiOdrnAANEW6AVYQZeVx4ONgLwAeUcADkHABNWMBrAAWQLYACDkGdkGAEZS+WE1WAEylvx2OwAMWFKYFACEi1gANJYZtgfphuSh71yvVwfhasAJpPmsUqky0KKzpHtwajAKuFeUsdcideuqOxGQukMpkKtkRg-c3K8+eBvCnzHTmWQz+3pXvylqhq1Dzjq8oGka6oImab4PpS1q2vakKOs6cCughnqwVymR+gGIxdsGk5hhGZbRqWi7JlUAoZtmealoMxZ1hWVa1t2ZZMYMI6UWArYdl2XF9oOw4CkelonphdQ-pu-JgAJQ6cf+mIwBctBxHy9hOM4hGruuUm6Nuu77qJ74iboR79P0tA0uwKjkDe2hwDYtg1BiohlBArCDOg7BoKgAAkLRVD5vmSowOh9MsShgEsXxAA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_g_bivariate.Rd b/man/tm_g_bivariate.Rd index 599a05777..6827af17b 100644 --- a/man/tm_g_bivariate.Rd +++ b/man/tm_g_bivariate.Rd @@ -104,7 +104,7 @@ with text placed before the output to put the output into context. For example a adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module}) optional, @@ -258,13 +258,8 @@ if (interactive()) { \if{html}{\out{}} } \item{example-2}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWT64bGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0CZVi9lqQ3N0AF5-uFcH8+EIRKIgbpSDA0hI0vRtCxaGE4L8BnVdFEYZk0tFSMwNGlRKg4ARMdjsZkHnpgQowFNRoywVjqaI4CINDDOdzjmSKVTqdjqFB6FyYYyAlyKaRdFpUeKRIhWX8RboCCUlgQxDDFYw0fQRCdtbRdU9csBgIzmYyXi85GyNXU+XK4PwpUyAOKuPDqkUmWhRD0wgBig1GAVc7Ox-WpToDrDxuQJUSJ6gF5MpAbqtNg9N0tpGLP9sddsp5wLdJMFOfLovFkoZYBl-IVSuNcFVZZdmrNFv1nZNWp1Yi24WtxemYAdiYbFf5oZb0YAGmqF7oYEdaHFCxGo85nS6gyHPcCD9Hc7p43Hj3VGEQCmkDrr5cD8YTiVmhdf8-AvTtXsRRrd9dFA0ls2FDUxQlagvTbOUO0NZVuw3PtR3NPVgQNI0RwHcdMinJkS3tR17xAytyHPIsmSwABZdCT2DZddEvGMNVvOp52pboX3UOAwM-dNv0g38G3-Qtp1LCjFyQ6sqLE+s+1g5taMQnlcNQntZOxTDBxw4c4FNMdLUnG0SJnOddLkjRWMZLwAHlHAAOQcABNJiNVPVj2OvLibz+fp+loExdHYFRyG-bQMTkWwaixUQyggVhBnQdg0FQAASFoqkyrLOUYHQ+lmJQwBmF4gA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIZMYGkJGl6NoWLQwnBgQM6rookjMmloqRmBo0qJUHACHiCQTMm89JCFGAFqM2TD8QzRHARBokXyBZdqbT6QyCdQoPR+Ui2QF+bTSLotFiZSJEFyQZLdAQShsCGIkWrGNj6CIrgbaEaPrlgMA2Ry2V8vnJubq6sLlXB+PL2QBxVx4HWSky0KK+pEAMUGowCrh5BP6DPdodYxNypKi5PUoppdNDdSZsBZuidI05IaTXqVgsh3spYsLNalMrlrLAipFqvVFrgWurnr11ttJr7lv1hrEB3CDorizArrTrdrIqjnYTAA1tavdDALrQ4mXY-HnB7PeHI37IaeE0XdCnkxe6owiAU0mcjSrISSyRT83FB8S3gf1nSHSVGx-XQoKpAsJV1aVZWof1u2VXszQ1Add2HKcbWNSFTXNSdRxnTJ53ZSsXTdF9ILrcgb3LdksAAWRwy8Iw3XQ70TXUnzqFcGW6T91DgaC-xzAC4KA1sQLLBcq1otd0IbejpJbYckI7Ji0MFIisMHJSCTwsdCInOArWnO050dSjF2XIzlI0Li2S8AB5RwADkHAATXY3Ury4niH34x8QX6fpaBMXR2BUcgAO0XE5FsGp8VEMoIFYQZ0HYNBUAAEhaKo8vyvlGB0PpliUMAli+IA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_g_distribution.Rd b/man/tm_g_distribution.Rd index 5abf2c7b6..66ce1c672 100644 --- a/man/tm_g_distribution.Rd +++ b/man/tm_g_distribution.Rd @@ -66,7 +66,7 @@ with text placed before the output to put the output into context. For example a into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module}) optional, @@ -189,15 +189,6 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBISqDC0ogT+uLpetHCk1Ky6ALz2Ts62AGTpuu7Rvv6B6BFR3rHxSSkuGVk53nkBRCbkoqRF0aUJyQ6VupnZnrVwfmAAsgCCAMrjrSVxHRVpPdX9PoP+TEREMNMxs+VdaUoAxLpSEGrUuvxQpFC6cAAesKgiSlc3BsZc1AD6b1A2r2utyMugA7rRSAALFTsP6REBKXS6HyhD7IxihJQAX0UECUaFQaJUEL8ECRf3KcMRuj4QhEonKdGapKRSNIMG+El+oVIGPogk01mprMuPO+WhYlKB3wevPUpG+olQcAILJFrL+0Hg5X8KNEEWF6tEcBEGnKxtNCqVKvYEoxUHoIm+BEhRFoBDEQz1-jkkX8AAVYtwMAAZCgSKE+w1I3Ei2O6XG42gmXTsFTkZiWHQ2WwIsm6UTQiCsUbodgEgAk3kileNjB0jFxWKUYCxAF0gA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} - } - \item{example-2}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBISqDC0ogT+uLpetHCk1Ky6ALz2Ts62AGTpuu7Rvv6B6BFR3rHxSSkuGVk53nkBRCbkoqRF0aUJyQ6VupnZnrVwfmAAsgCCAMrjrSVxHRVpPdX9PoP+TEREMNMxs+VdaUoAxLoAwgAiAJLjJ7r8UKRQunAAHrCoIkp3DwbGXNQA+l8oDZPvdHkZdAB3WikAAWKnYQMiICUul0ozO4wAMj9shjsUoAL6KCAAKyIKn+AGs4KxRIiwbYIfw4CYoMJSP8CPxQgR-uTKTS6cBoPB6UC5ABdJRKLQsUQARlxBFhFIIYn+ojgIg0cH4fggaLljFoUHoIi5qto6vFYOAwH8+Kx-klksiBCGoywwyK-hOAHlHAA5BwATV9YHGzgAGv45HJcKjdFqdeR+OUg44sc6ICSlGhULiVDCDWigeUkUm+EIRKJytXhGJS2jdKQYP8JIDQqQTfRBJprEmW7du-9jRWwf8Xj31JzRKg4B6h8PbmDRXpko7Mc68MvhynF6RygeNJqF0vDSvhyq1WJysbTea4Jbb7aHvatwSwK73Z6AOKuHguj+AAQsMWAANJYAqcYJnuK4nmm5SgeBUEwbul5XmiMAcrQ7wbroABioxYlGiaYVhJi0M8erlMRpGuBRw4klecFMcmM4PGOLATlx07MKe86Ls2V5AuuyFgE6ETwWiVHUOQjDlHJClnsJMktsadbJJpCrkVhLY4fJeEiHsqTqSxK5sVeEiMEQgioNxinJECU7PDOgnniJK5ibABGfjuemUbQ8kyEpwUqUJF76Ua8r3vKunqdhuH4aZLjmfBFlohZJIkrQJi6OwKgKbO2iDPGugopeojwhArCjOg7AFgAJN4kTNVqjA6IwJKEkoYCEpKQA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6urSMtKJxVTWiSgC+ihBKaKj1KnnsFf4ZugC8A0G4-XxCInUjdKKkfRCVlaQwiRLJtaQ19IKa1v3L-luJWizDo1CJYdvqpImiqHAEi0dHKdDwFwpg1bU-4yWb0qojgIg0F1B4Puj2e7DONSg9BEiQI+SItAIYj6v0aPzkpR+AAU4EEeAAZCgSAr4w7LNpHBm6NptWgmXTsFTkZiWHQ2WzlIGiQoQVgAQXQ7E6ABJBLRSjLQYwdIw2s0lGBmgBdIA}{Open in Shinylive} \if{html}{\out{}} \if{html}{\out{}} @@ -205,7 +196,6 @@ if (interactive()) { \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXQBBHwCAGWTdVIxMxERGRpalAF9FCAArIhU0gGs4VlEK3Nt8-jgTKGFSNIJ+WlECNLGJ6dngaHg5zLkAXTcILRZRAEY2ghLxgjE00TgRDTh+dlqujujFoUHoIk2r1o73OuWAwAUYD6zURl0uVQIAKRWAAsoiqoivAB5RwAOQcAE18bpEQFnAANRFyOS4QFfH7kfi6AC8ulJjmaKIgwyUaFQbRUxQBEDqmR5IVyrJluj4QhEonlquEYmldTqpBgaQkGR2pBB9EEmmsgL1IVNaWB8syaWiZvUG1EqDgmJttoV4VOel5iOR+N9tvZ3tI8sjGk+Xp9yr9epebzE8uBoPBcEhadh4XhIaaKLAaIxWPqAHFXHgaWAAEI4rAAaSwDyZLPDftjnPliMbLbbYaTyZV61ocSDugAYvVmnSlaO9SZaFE-vLZ-PXCPbcNk52d7pRG7wg6WE7ci6om6457vbrR5lA32kcXh0uV9RyIx5Z-v-H7y7W1gQ1XkQIeRclzHL8JxEeUHBcIDdD3P0D2TCRGCIQRUDPH9eWdV1mFvBMH2TJ9YCnIt+jwJC-xkX9aC-GQAMTKCgXuDN7ggpC6hgcdJ3gpxtyXFDd19FDhmGWgTF0dgVG-d1tDgGxbBqZVRDKCBWHqdB2DFAASQRaCqAyvkYHRGGGAYlDAAZLiAA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_g_response.Rd b/man/tm_g_response.Rd index a569d7dd3..7b8a9c752 100644 --- a/man/tm_g_response.Rd +++ b/man/tm_g_response.Rd @@ -84,7 +84,7 @@ with text placed before the output to put the output into context. For example a adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module}) optional, @@ -214,13 +214,8 @@ if (interactive()) { \if{html}{\out{}} } \item{example-2}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWT64bGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0CZVi9lqQ3N0AF5-uFcH8+EIRKIgboIcIxL8BnVdKQYGkJGkGqJUCRRHBEcjkdQoPQ4NQYQowFgxDiIHjdAAFHqkUSUsFIwlY2n04GZNLRUjMDRpbFwAgEwnIzIPPTAylTUZsv6S3R4kQaGFqsXHUXi5Uq3TE0nkuVgAJk7W6LQsWgkkSIJUcg0EEpLAhiGHWxi2+giE6u2jup65YDAeUjRVgF4vKp6sAAIQAslgANJYABMbN0lK8AHlHAA5BwATUpcjk7INyK1Gjg-ApCeTaczeH1KpgR1ocVlugAYoNRgFnJWq6ZaFE6zD+4PXE7Cf0VRW27oojC+QKhTrUGKJSrpbAe+Hpq259WLRrgTWtzvl4SjWSG+b1aQrTa7XAHSfR7oXW6PcCvR9P1f0DBFMlDI9I2jWNfjNZwAA0s0pLBBi8VwwHLEcqyvSdTRQtDHW-DtqE0bspwHIcsINExx1wvsKNnKsF0lZi6mY-p+loExdHYFRyE3bR8XLao-lEMoIFYQZ0HYNBUAAEhaKpZLkvFGB0PpZiUMAZheIA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjA0hI0g1RKgSKI4OjMZjqFB6HBqEiFGAsGJCRBiboAAo9UiiOkwjFk-FMlmQzJpaKkZgaNIEuAEUlkzGZN56SF0hajbkguW6YkiDRI7XSy5SmUazW6ClUmnKsABakG3RaFi0SkiRDq3mmgglDYEMRIh2MJ30ERXL20H0fXLAYAqkZqsBfL5VY1gABCAFksABpLAAJm5ujpXgA8o4AHIOACadLkch5psx+o0cH4tNTGezebwJs1MAutDiSt0ADFBqMAs46-XTLQos2kSOx653WT+pra93dFEkcLReLDahpbLNQrYIOY4su8uG7bdZDG-vDxuyebqa2bTrSPbHc64K7L1PdE9b1fUhf1A2DICwzRTIo3POMEyTYFrWcAANfM6SwQYvFcMAa0net7znK1MOwt0AN7ahNAHedR3HfDTRMGciOHWil3rVc5Q4uoOP6fpaBMXR2BUcg920Eka2qEFRDKCBWEGdB2DQVAABIWiqJTlOJRgdD6ZYlDAJYviAA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_g_scatterplot.Rd b/man/tm_g_scatterplot.Rd index 7609aa5cf..ff8cedc54 100644 --- a/man/tm_g_scatterplot.Rd +++ b/man/tm_g_scatterplot.Rd @@ -97,7 +97,7 @@ The argument is merged with options variable \code{teal.ggplot2_args} and defaul For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module}) optional, @@ -303,15 +303,6 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBISqDC0ogT+uLpetHCk1Ky6ALz2Ts62AGTpuu7Rvv6BzgAepMwRUd6x8UkpLhlZOd55hETURIKMqLQEANYyZdGVCckOtUoAxLpSEGrUuvxQpFC6cIWwqCJK84sGxlzUAPpbUDabC0tGugDutKQAFirsR5EgSrrZno1w7NOipMStjEUEDeAGEAPIAJh2unBEKUAF8gUo0KhoSobn5gXMztUnq9dHwhCJRNVCcIxJi3m9SDB9hJ9mEFuQOq1SJSqW9qFB6HBZsl-ABlAhMmTrIikGG3IhdMQRfEcwq4s77FYldSkBmoOAEdkct5HaDwar+WFyrF63SiXnaiXJK0iDSa7W6i26Lk8vm6QXWjS6LQsWjckSIM2uqkEKUyknJf2MQP0ET7CPSggUo7AYAmyH+AC6OciOv8xAsZX8glQi16-jkclw8td9ptcH4xuaJbw9YtMGEmnWemSADEAIIAGQFzjr5tdJlohWb1WHY9cU45QIttc7uiG2MWKuKzEdoi1hZXVINsH7XrApo7p7ejd9dp9GqPzs3HPdvNbAuffoDQbgENbzDN5kyjapY3jRMwNTURHjODMszhMA8wLPw23CPAr3LSs4GrDc7ypB9yBbfkwBwqAq2AkDu2oXsRAXUdx0nEDTFnedByY5cwzXPUCItf4iEYfZ6G3I49zVQ9jxdDlzyNMibxYhtfyfB0X2k98qU-T1vTUv84wAoClLDGCxAg-8EzgJNI1gmTXXTTNr2zFD800jlCzAAAFLkyFLMA7FYLU-LsdwFngXysKLEhMMiMsK0ovCwF4njjOUtSON0AA5RwRxHVKux7Wg+0Ypd8r1Gc51I3RF3HTTkqpfi9VEWgAC8rNEpVd1VA91LfQi5MvJDQzSm1qmIp0T1Y7Tv1-SDDOGkybLMmMLOgpa4IcoaXLQqL21i8j4qomsyo5YiMri3CFtdWj6MvGqJzctjKpK2rCPqt5Go5RgiEufYTHUWJOqgCSeomuz9TOQ1Bqc5CTstFT4bUsHHumsifz0ubLKMx7TOjfSoKs3H4MWRCYdzfNdA87yoAi-aAqCyL-NCmkKFIfC4fvZ8Muy3KOYJQris40rHoqjL7rqzdPvDFo-oB20d2B7r1WR-rIYvVtFM04ixufFWpu5L80dm1bAKugT1vMgzLOslM0wQxyb1Qyn0Op2mr3pxK6eZ8K2aSqWLTOqqebyx6bqKhiheYkX2Kq8W3sl+teKBIFaBMXR2BUZl1W0L4a10F4sVEe4IFYId0HYFEABJvEiKurUYHRAQRJQwHhHMgA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} - } - \item{example-2}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBISqDC0ogT+uLpetHCk1Ky6ALz2Ts62AGTpuu7Rvv6BzgAepMwRUd6x8UkpLhlZOd55hETURIKMqLQEANYyZdGVCckOtUoAxLoAwgAiAJIAypO6-FCkULpwhbCoIkorawbGXNQA+vtQNnur60a6AO60pAAWKuznkSBKutmejXDsEDEpGIrUYigg3wAgtN5gAZQ7ZaFwpQAX3BACsiCoTr1WKI3tdbLd+HATFBhKQTgR+KECCdMdjcaJgNB4PjznIALpKJRoVAIlSPPwQ5bXarvL66PhCESiarS4RiYXfb6kGAnCQnMKrcgdVqkZUq77UKD0ODUar+eYEHUyHZEUhTJ5YghiCKSo2FcXXE6bErqSmiVBwAiGo3fc6svTJfxI2HukXh3Sic0hx3JFMiDRa4Ohj1J3Qms0WmNgeapjS6LQsWimkSIBMFlUEZ1dMTVauMWv0ERU1uu9nXYDAWMw+NgTmcyJ5sCQgDirjwun8ACEALJYADSWAAjGVVxvtwAmfxyOS4fNJzNpuD8S2zheNptSim0HbR3QAMUhsPmzgviYFiYtCFLe1Tfr+riAUa4JJuel66EMoprL6xTMNmQYhmG4aRrAH6jsieAId816VhmFaBrm2FJkW5r3uWWaOp23b1k+TYti67bJMxdZwH2nGDmsw4EeOk7Tn4D6LpEB5bru+5gOusknmAZ4Ac+yYUWBpaKdue5EdB4YwK+77gT+f5qc+wGgXeyQQX+xG6LB4bwQZIJEIwJz0Eh5yof6GFUQ5uHwPecZseGpHphpjE5lhDnGqadGlgxaZVjWvENvp6kcW2crcWlPZ8dlA7UQW5zCbOY7+GJcXNhJ85ScuCmHnJS4yce8lYJCkwNf4WDOHOswAPIAHJ6U5TYuepEVabow2OLCsIWU2RnUJoJm2WZ-41VZM12VBE0IZN4W0AAXnxXneihfroZRsUGRG1xRiFlWZQWEXVBFMV5vdKq0SWjXJZWPEFRlS0FkVXGpV2vH8TlBJCSOFWEWJugzvV8k6S1qk1dNNmNejr3LcZIimZBYNJjteN7Q540qkdRqMEQdwnGSrqRT510Bl9JUPWsT2lqFhPhRRH0UdzNV-fRIvA6xQtJhDuVQyxhX9kqZWI4LKMzpjynSWAnXdR1-VDaNp7029ml43NC3k4ZxMfntttGpTpP2T9tPfOb3wgiz6ixJdUC+Td4s-UF+FI+OTtRSl5HRZh33qZLSXS-lstR97quKzLKsCfDUDlZrU6oxJOsdV1PX68bI1jV7wuMTN1uLTVK1rSTG1k9tIG7ZtNOHfmTnguCtAmLo7AqLqAbaP8Z66J8IqiC8ECsJC6DsHyAAk3iRBvKaMDoYKokoYAopyQA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQDCAPIATHG6-QNKAL5dSmiowyp57BX+GboAvMtBuEt8QiKia7o7wmKL3ZW6pDCJEomiBIHkjJFEpKfn59RQ9HB+6wpgAGV7qRHs9SCN8kRaAQxP8tmd3qEDilEmFSMwNLdUHACG93ucUtB4Ad-qM4Ut8bpRD8ceD1tSRJjRNjcRTKbpPt9frp-gCaRpdFoWLQviJEOSEeyCJDoWIDkLGCL6CJEtKoTDRMUMsBgKTBv8ALoG0qswgkAhwnlgQSoIIAazg-zkcnh7PODNpcH4JLNFglbsqMGEmkienWADEAIIAGQBzldAZMtFCXoOUdjrkl7y6lJdbMqrGRGVRoXR6lIWJxeMphNgYatZLw+fd-LpVNbldZWfxnJ+Pr5jPBCqVYv9AbVsv262HorgqplGq1QR1erGYCNJsWvoteCtNvtjrAzoTbo9GlTf2ttqgDrHbqD1BDIjTMbjJ-ZSZT3ojr8zbpz+J5t2bQdIk9CFusKJohiFbMlWzaVLWxKXo277vGebYYZ21bsr23K8q2grCrO4pNt27wThq8rEcqc6UScCH4ikK5gI2G6MRRW4AAqfGQlr-HYrDYvxYB2NUgTwHxu7-MQfrSVeB5OhxuhAQG7aDheugAHKONG0ZofiD5PvW6Zvspn6aaZf7sgB2YGaItAAF5zuBRZBCWZZMiyOHvEh9arne+IYQcWFwV2al4f2hEzrRpEGRRC5ytONEqvRmrMbqrH6uuxq6Kask7qU-z7jeh7HspGGacV163mRalGbQoYvhm8XnBZ366FZjG2ecqn4owRDZIkJjqHAbZQaWMHYYxfk+qhjHBfSHZhT5PZfH2l4DrSRGKiRgWUml1G7bR87qicGUBTlm7-DxUBSUVolCYeD1iXAEkUKQTp9aeraaTpemtYGwaNc+P4teZyaWb+3XNt95xtMNo3jcW0HltN5EbHddZzdlrWLeptLoxF634YC0UpXAcXKYdyXHaliXpdqmVsblpq3fdVqCcJ8mve9UnlRjlSVR1-36cpDVNWDZmC6YkMdV1GM9ZUPUAV0XS0CYujsCojzltocA2LY5RnKIhQQKwkboOwMwACT1KUtvUowOidBMShgOMBpAA}{Open in Shinylive} \if{html}{\out{}} \if{html}{\out{}} @@ -319,7 +310,6 @@ if (interactive()) { \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjA0hI0ncwuRGHEiKR0ZjMdQoPQ4NQkQowAECASZMTSN4ShsCGJ6TCMeSokjMmloqRmBo8ag4AQyeTMZk3npIfSFqMeSDZbpRDSpWzIVqROLRJLpeqNbpKdTaUqGdqNLotCxaFSRIg1XyzQQObQuYjIQ7GE76CIrl6fQdwsBgMqRqqwF8vlUTWBBgBxVx4XT0gBCAFksABpLAARh5mbAuYLWAATPS5HJeWbMfqdXB+HTk2m3Y26jALrQ4ordAAxQajALOBvdky0KKtpEjseud3k-oa+umuqsQW5YVRUXqS5GqUyjXy2CD6OLPAbpu23Wau8S4838kWmntgJ3+2O51wV3X5dZU9TkxCRf1A2DYDvTRTJI0vWN40TYEO3TKpszzQsSwzdDKxrMA60nRtmw0OdrQrTCu27XtqE0Ad51HcdCLNadZzbSEF3HF9dFXWV10A7pejSegt0hIURTFQ9jRPWUz3gdsVUojViPvZSnxNQDXypd9rU-A02XA39-yYjUoJ9MCfyDOAQxA-YuPJWCo2TGN6UQuzMSTVNULLcji1LHDCzwtCwCwQYvC8+ksGcFM-AAeQAOSwnjGz47sHz00jdDixxRlGYzZWo2iRHoxc8vJFiMo4pdkpvFLZVEWgAC8rOE7dwl3fdDSkrjZIvJyr1KtKdSRVSj3U1K3ytMtdKGgzLKMtzTNAv0LMg0MYNyOC+oQhNdA8ztsPLDDfPw2qiLvDLlX2gaez7Oj2IYic3PKtjhweriksxU7MUYIgCjSM4uXvMS9wktTpPs3IFXk5yALOvThsfUbwdlCaPy-WaXUUj01t9b8A1-azoI+DbHIUuMdqTHzArLEKwr84KotihLay+pTzperKcuu5FbqK+6SqemcKrejTuJqvLun+9Q4CBndxIPMHush89of6rjlIRvTFdFupUZ09GVr-LGTJx8z8cswmwwc+CXIp5Cqfp2nwoZ6L4sS1m6vZpFOdytyCv7PnXoFnXTCFl7KvemrTR4-p+loExdHYFRCQPbQ4BsWwagxUQyggVhBnQdg0FQAASFoqmLkutUYHQ+mWJQwCWL4gA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_g_scatterplotmatrix.Rd b/man/tm_g_scatterplotmatrix.Rd index a269c3ee3..ffa2ada65 100644 --- a/man/tm_g_scatterplotmatrix.Rd +++ b/man/tm_g_scatterplotmatrix.Rd @@ -38,7 +38,7 @@ with text placed before the output to put the output into context. For example a adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module}) optional, @@ -211,15 +211,6 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CmlCkmgRw-ri6XrRwpNSsugC89k7OihAAxLpSEGrUuvyBULpwAB6wqCJK+aSFRrpc1AD6VVA2lQUGxgDutKQAFirszeEgSrq6xOakjFGiHXkFGCbM8H4QY2O0-AnjfmAAIq54uv4AYlhhx2AAknYX-s4AyndgAAq3R-4A4ucfYAByABlngAhQ7hfwAxzPACC7zkuFG6wkRB0jAg8DI2xM6lIREYq3W6wI7AATOEyboKQBGcm03Q0+nhBkk+GIwnUKD0ODUWaJYn+ACyJBYBF6rGeWDgqEE9DoBH8qUJrLW6w5EAkgigUga2JgtFiWJxeIJhJ2DIAzOFLbprdbqUyrUzlabdByuTztvywJ8ZDAoMp5b8ABLckQBiVEP0WUJgRXrZ3rVBEaUczQkT3sAAc1oAbAB2cI5gAM4QALAX6SX6QyqRWqQyixgc+EAJwJsYsOCFPnsc0AVgrfb7FqLDL7Rb7rep5oppZH5Kb4Wz7cy-FQGfNGFLC4rJIwNa34Ub1sbFMbFcbk90jYbW5X-Dg9FIGb3zIwdsPlMXX4-25-C7-PdfzjONRG4MQ5maRZljgE0Ni2RIqUQccERVMYJjINgGk2bYwJgcpYLZIldgOZ4zmeG5nkeZ43meb5nkBEEwUuSEYThVCXVEWgAC89ESFCiLGdxynUPikhcIiV1YLtGFwvFSHYPCCNJUci0QEkiw08IUN0YSORCbYHBcOQVx0CBBDEpSRHYL1RD9ahqGeeB+FoQQYGeDlGCkZ4SDobIFW0qs9NEwzkhXAh-RCBy4AQ3QrNg4kjOccITmhAEHhSQLwmCgzEiSlcvH9TRSDiRI0TxGB2B0qkiyrDTwqIURSF5XSIAqqqq0zOqixXVBGCIEwem2crGEqnStMrEClAAX1SAArIgVAaABrOBWFEQYClsWoFqW1b1pNXaIBWtbdgwqYZmec7pjEZ5NgCxEjpOjh-DAkRRGeN7bt+e7Yw43Qnv2s6iEmG6Pt+L7wfCL1fu2fxrtYbD+AVVJUiUNB11qFQehNZptiGRE+CEd7tiJ4QxDguoYAaCQGlECKghkcoiFIP0LuKSmxjdbk4bAB4GfIRhmefNnpmKMJBN0LQWFoTkScSOgms59ZmgaEophxOnUDgfk0JdeZqmgeBeeuy68ElwlRG5HXn0SK2RA0LWdeVl1udyRJ-Aea2NClmW5bERAJb1-Xxl6RaQha6Xpn9hpRXDinmmAYB4ZBzCzYAXXTlcQ-tm2YozfxOygZ4JDXZ4HyfB7g-1mBhE0AjQpcf6Q7GPEH3cWKkublvBuKfPElS9LXGrpULd0bOVYKNXig1x3RG13WW4N-1YDE17wKhsexkG6hBaxfVBadxel9dTkeY9vnvefKPZdlOBA-NkfTSjlqU9BxHfu7kO49oCPtml6gFlY5h1-gnAoSd17vX8JncEhBU5TA-sjP6W91i5w0P3HY-hSK-HIr8SivxqK-For8eivxGK-FBM8VivxYRVxProWuu9aANzyskFBE9LZX1wlfI+LtTRu15l7B218-Z31EA-L++sf5-0SDfGO0iwHVAgWASG0D07Q12IVMgPRxS-GIE1KGlw+oDR6CjSRnEr4YK9Fo4qujYH6Oas8Yxg1SB0JPow+uIhG7JRQa3Rg7cMFd18aYWgfdYqDwyuwsecZR56ymhAVItATC6HYCoQWOJtCwRMroEYKpRD9AgKwaE6B2AYwACTeHCOUq2jBUSpGmkoMA0105AA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} - } - \item{example-2}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CmlCkmgRw-ri6XrRwpNSsugC89k7OihAAxLoAwgAiAJIAypm6-IFQunAAHrCoIkolpGVGulzUAPr1UDZ1pQbGAO60pAAWKuwd4SBKuroAgtn5ADK9uoxzi1Oz2Vj5y6tb+UoAvqkAVkQqrQDWcKyiY6W2TfxwJlDCpK0E-LSiBK1nF2ut2A0Hgdw6cgAukolGhUMsVIM-BBph0EsVSrgNnwhCJROiccIxMjptNSDBWhJWr9AuRGDUiOTAoxaBUSaTptQoPQ4NR0f58gRaTIGaRdDBmaywhsOVoWLRuXj0XRRKR2RzUaVWpVSMwNNTUHACOqNZqGqC9Il-GsFtKUabSaJeUaxYknSJ9aJDcaZQ7OdzefywPlnRpdHKWYqxIg7X6OQQhucQvjEhGFfQRJ9E7Rk-cGsBgNb5rawJDIXIsfa47p3S64Px0T6wDMAOKuPC6fxYGaZdvhAXOAAa-grvr9MHetBqlqSLkr1emREYz3cDcSDjnY4dJlZ9fRADEZgt8q4qw7Un7R2eOR1tRVdeoPl6jSbTR0LUG5ttY3Gd9Q6eif50gaL5bqaXI8nyVrBqGYoUPwqDnGQogxngYEahGKa6E2AAKMzdgAsjkYSds2ABqBS5HYI7zguCZJmI6JytQghwFmDHgqUBZFt+paQuEuH4TMRHZCR1oUfkVE0dhfhgHhhFieRlHUWAchXguNawXu0G5AAcmRzh2LoxjOLp2S6AA8vuuh6dkjiZHYuQWbpP7VhO-5TiI6Ibqe1bqXGtZhm6sEgT614OhBgbQSGHpimmUYoa5cb0TmjGpvKUbsalnH5oWzb7P4Zb+dWgXkGuMnWm2ikzGRR7VdkACaNHoRy7maNO3nJLR1ZLiu2mzs43W-ru5WHsevlxhe55blN0xTakqS0CYujsCodKPtocA2LYkz2qIIwQKwMzoOwcIACTeOE51OowOiMKkhxKGAhyQkAA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6usTmpIy0YnH+GRgmzPDsFZW6tPy6ALxVHWAAIq54ugpgAGJYk6WTAJJ2cxNgzgDKK5MACsvjkwDis-tgAHIAMltgAEJj82DnjlcAgntyuJ2VEkQ6jBDwZH6pnUpCIjA6EC6XQI7AATKV4bpEQBGBFo3SojGlTGw96fLrUKD0ODUURAmGTACyJBYBHyrCuWDgqEE9DoBEmikhXTx3MqhIgEkEUCkiRMsFo1FYQPFGjBEKhlRhmIAzKU1boNRqUdj1djeYrdITiaTyUMDjIYFBlByTgAJEkiG2MohWixwTn4g1dVBEFmEzQkM0ADg1ADYAOylMMABlKABYoxi4xjMcik8jMTGMGHSgBOb2VFhwYIDGEqgCsSYrFdVMcxFZjFfzKJViPjdYROdKocLXn4qDNKow8a7SdhGDTI9K2Y12cR2aT2ebumzWZHff4cHopDNE5xGG106R3ZPR9HZ67F4n565lTvulE3AaWRSLTacAVXR6QORiEbHx8lURA1GwiQ-gMT4wJEn74kqQyjFcMxXEsVwbFcuxXEcVwXFctxXI8LxvIBhqiLQABeegDABcG6IwzKEgQVH2E4rhAX2rAlowQKiGCpDsFBMFwvWMaILCMbiaUAF0Qx6jMQ4LhyH2OgQIIzGCSI7AUmAohWtQ1BXPA-C0IIMBXISjBSFcJB0D4nJSSm9GRHJQIKc4fYENaTH6XAvSQREmkwm5pRTM85zrO5DmlE5jHyaxfYAI7CmQeTSgMfxgjA7DSciMYpuJHlEKIpBkulECZdlKbBvlMZ9qgjBECYeRAhljBZdJknJg+XIAL5cgAVkQKiJAA1nArCiMUGS2Fkg3DWNE1fnNECjeNQzVGQdRiFcG21PUohXD09mdMtq0cJMT4iAdJyXdtJxHWA3qnQt60gZt+1XLd12lNpD1ApMu1gQ9SlKFyShoIOWQqHkX4pECJSdHwQhXUCSPCGIX6VKQMCJBIiSiJ5pDkIwkRENjgR1KEmMEkSJL-WA6yE8TpO7lae2hHMtFaCwtBEijAx0MV1NQikiRhLUIL46gcAUkBhopNA8D04DH14LRUKiCSMu7pBWsaFLMvC4aRq034AyTOseu7tzdR82IiCc3Lxt0kNTGlboNu82ycCJC7tBu1NQTAMAANvXtd0ALoR32xuPlbvlmpMxZQFcEgDlcW47sdTuGjAwiaDBrmsSRsddGCW70X5LEuCXpemLQoQJwMoXhWxdcPoaMddKL4vMProjS7LdcK7AzEXc+33q10TXUMTMqSsTBtD3XJsmvTlsiBoHs83bDtqznio2+7oegaw4H8I7K9VPkrsNAM3PUGpvs3-7GMpMH49XZMUf3IDZ-A7XUumtN7kCrtpRCJxkInFQicdCJxMInGwicXCJx8InEIicV42cr551nrQQuAw3JT3vIA0iVseJWyXkbQ0xo6bmwZuQz2dtRB71Ic7F+bsgRMO9s-W+k134hx0hPb+EcfpDCStaTQpAGQnGIMVb6qx6qNTyJyLuZCQFN0GJMCRKVpE7SKiVK4SimqkGwSvXBBcRBFxrsQsujAK6aOCrYyoTVG5VxbhFWxHdFTePvF6ToXIuS0BMLodgKhiYgm0J+JSZROiiEKBAVgzx0DsAhgAEkELQUo6TNaMF+L1JQYAeoRyAA}{Open in Shinylive} \if{html}{\out{}} \if{html}{\out{}} @@ -227,7 +218,6 @@ if (interactive()) { \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXQBBHwCAGWTdVIxMxERGRpbahp8sALaOrp7G4aUAX0UIACsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI0xeW1jeBoeE3MuQBdN2h0NpVi9gHM3QAvCFcrgBnwhCJRIDdODhGJfhA6nVSDA0hI0hcwuRGHEiCiwoxaFEEUikdQoPQ4NRoQowAECFiZLjSDCCUTaaDEaTdFoWLQKZDoXRRKQSdy6pk0tFSMwNBjUHACGLxRLcg89EDaX1mhyBirdKIqYqWUDDSI5aIFUq9frdOTKdTNXSjRoeXyBWJELqubbdAQSksCGJobzCR6TgHaEGnrlgMAtU0dWAXi85JzfXUzca4PxodawPUAOKuPC6WlYepeEtVWkBZwADVpaZt+pgR1ocQ19icznTGaIjD2jBz0IcLj7vpMRJHQIAYvVmnWW9y5vrmz7uZLpbLjpbFcqVZl1TSC0MAt7J7RqNjoVPrzJ5fvl+L7VSTwEXSyKPxUEsyKIvTwZ9uVDKEgXzAAFeoKwAWV8DkywLAA1QI-DsJsJ1tf1A2DIFeWoQQ4AjHCY3COMEymZMXiqSDoPqOCfAQrUUICNCML9X4wCg2CmOQ1D0LAOR1wzA1PxnRC-AAOSQ5w7F0YxnEknxdAAeVnXQpJ8RwvDsPwVMki8Mzba8OxEUce2AuphNtLNXVNT9H2tDd9VfR1EI-c0WVDfl6EhQDMP1bCo1wt0w18oigujLYyPjU9KJTazfVs8hc3Azii2rRD6iQhdeMaABNDDLKRYzNE7czx2KuoByHcSx17KrTGnVLdHnRdXGcldgNXLqNx6uY5loExdHYFRsXUTQdBsWwai5UQyggVh6nQdg0FQAASQRaCqNb1sNRgdEYOZpiUMBpheIA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_missing_data.Rd b/man/tm_missing_data.Rd index d1c672c23..eb26df1f9 100644 --- a/man/tm_missing_data.Rd +++ b/man/tm_missing_data.Rd @@ -59,7 +59,7 @@ with text placed before the output to put the output into context. For example a adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module}) optional, @@ -164,15 +164,6 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBKMtPzOAB6kzP64ul60cKTUrLoAvPZOzrYAZJm67rG+-ozUUBASUTHe8YkpaS6KEADEulIQatS6cKGwqCK6-FCkUEr9gwbGXNQA+iNQNsMDUGO6AO60pAAWKuwz0SBKurme3r6toqTE1ESM9fu6UPz8k9CiS2YWmtahtnsQBwehwFE3RE7FEnkm3BIEnYX2iJkuV3YIlKGxhtgAVLlzLQTOwAIzRDAABgArIS8QB2OTUgC6SwAcgBBW7-W4AXyUtx8tBeRl03NEtxg5xYvOMwoIos5v35QVEwDpfOK6ES7AF0Xuj2e9QOEtFCqWyp6HD1jFEGoeTygoh1ulN8uA-gIrGo-hpiuM1owJnUpER9uAjsILrdNNtAaDUhYoaWXp9Gn9IrNgf8UcYofqbJu0HQSxUaz8MpmNR2QoEwjENT4QhEokLf10pBgkxgPNEKgk0wWcxl9XqON0atUzEsOhs31uok2EFYjPQ7DQqAAJN4Negl2DGDprkoORAwGyaUA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} - } - \item{example-2}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsBKMtPzOAB6kzP64ul60cKTUrLoAvPZOzrYAZJm67rG+-ozUUBASUTHe8YkpaS6KEADEugDCACIAkgDKzbpwobCoIrr8UKRQSiNjBsZc1AD6k1A2E6NQ07oA7rSkABYq7IvRIEq6uZ7evhBipMTURIz1pwCCrZ0AMuuML+8nui9YnU+-06SgAvvUAFZEFRzADWcFYogOq1sRmGcBMUGEpDmBH4tFEBDmUJh8MRwGg8CRizkAF0lEo0Kh1iptn4IKdFjVDr8+EIRKIanzhGJ2adTqQYHMYATRCoJAtVssObp6vVaCZdOwVORmJYdDZbMcVaI9hBWE90OwmQASbzRW2iGQ6B5gpRgUG0oA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrquuAAesKgiuvxQpFBK4ZEGxlzUAPoxUDbREVBxugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQFbpQ-PyJ0KJZZhaa1gG25RCVlQHAosEi7KK1idwkEuyTpSbtHewiEBIF27YAVFXmtCbsAIylGAAMAKyPdwDsct8AulkAcgBBHpzHoAXzcM10DVowyM0MYsJ6MFaLDhxhRBDRkMqMNEwD+8OoaBCHDxpT6AyGXUqmLRBKyxPQ1A4dMYogp-UGUFENN0bPxwAUhFY1GFP0Jxh5GBM6lIBwFwCFIrFYAlfMVyqkLHFkt64llGgVqPZSuF2sYuq6YK6ShJWRUeXYPRSugAvGEMrhkQJhGJ3fzfSJRM6oZVSDBEjBYaIVBJkhl2KgWBRSAnItB4AHhQLhXyul0brp2CpyMxLDobFMeqJChBWID0OwSQASeoU9At1aMHSdJQQiBgME-IA}{Open in Shinylive} \if{html}{\out{}} \if{html}{\out{}} @@ -180,7 +171,6 @@ if (interactive()) { \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dOAAPWFQRXX4oUiglGLiDYy5qAH1EqBsE2Khk3QB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGXzUjEzEREZhsdrdYawA-LmfFaUAX36AKyIVNIBrOFZRCtzbI2i4EyhhUjSCflpRAjT9w5Oz4Gh4c8ycgAum5oOh8ipiuxFpldABeaK5XCLPhCESieG6VHCMTQgZ1XSkGBpGCvUQqCQZXLZfH9fq0Ey6dgqcjMSw6Gy2Gr40RlCCsQbodhoVAAEhaVRFotEMh0fW2SjAWyBQA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_outliers.Rd b/man/tm_outliers.Rd index 68768f6e9..74437cb3d 100644 --- a/man/tm_outliers.Rd +++ b/man/tm_outliers.Rd @@ -50,7 +50,7 @@ with text placed before the output to put the output into context. For example a adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module}) optional, @@ -198,15 +198,6 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6ugDCAPIATHHV9RVNdcDACmCojLQwLKyJANZwrJ0AumONonAAjokiEOwQjETZ7LV1cooQAL7bAFZEKkMjosUZtlmHx8OsZ9cQJxydG52lL814up3dvf1PnS2bggWhYokaBHyRwIYkS0xEGjg-HYoJ6UHoIkSkOhYnOQXaHzq4zGpQI7E6AAVqFAyG9vmA7KxUHA6Z07Iw4IF4LSwFttko0KhGio8uSIJUUroALz+DK4Fp8IQicEyxXCXEtSqkGCJIiCUh0GRnTWVXR6g20GSJVHS3R0USkMWm52yoKJMKkZgaOHMskml2ummwPQywlvf0u+FwDS2qPe0S+p0Bl3U+hwPyhsAAZXT0dIulRtHRIkQ4fFyed2NoMJVBZYRYxcCxUOruJSBLArzAE1J5MIJAIrLAglQQWGgLk8vLFcqcfI-FtnRHY5ZeAjAZgwk0kRDugAYgBBAAyWecU5nppMtFCSNth5Prmnye2FZfLsnEYIgTgEiIPS-SQ2jK9qOuugbuqEnrqKQPrRkmFYpNA8CLp2nznjOV7UOQjC2ph2GwX6T4VqitYkehF5VjWtqgtQghNpRbYZB2XY9nWjCiAAJHOSIfkRybcQuMo0XRzY4mc7YdKhRLdiSbGcQJvEXpUm5YbQO62g4LhgZUb4Brppr6W+2zbLQJi6OwKjYdB2hwDYtjlOWoiFBArAHug7CChxgi0KUnnTIwOiMNsOxKGAOxjEAA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} - } - \item{example-2}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXQBBHwCAGWTdRkaWpQBfRQgAKyIVNIBrOFZRCtzbfP44EyhhUjSCflpRAjTB4bGJ4Gh4Scy5AF03CAWNNK0WUTSoflFqNoOxdgAxWmpyRnZ1hxcVVEaDiHEywGACjAnWaUJOJyq6wwl1IREYcgxShujFEbQIJSGBDEaVEcBEGjg-HY2NoUHoIhWBNoRKOuQhUJhcIRpnUy2xdweT0xECUILaKmK7FqIVyugAvDLwrhpXwhCJcQrVcI3tK6qQYGkiIJSHQZJNdXVdEaTbQZNcWPLdHRRKQpRBLR7FVA0tFSMwrqJUHACG7PZ7Mq9HRymrC8Baw6TyaRHYng8tA8HQ2HPdQ6WSo2AAmS07oaXSRIgocr3dmPfjCWJHWX6XBGQ3WeF2dCY1yqiGOQBxVx4XRQgBCAFksABpLAARihGOrtY9qYp-AL9SHVfj2ZgS1ocT0Cve9WaAWcy5XdRMtCilMdp-Prhrtb6b93civdbCcAkaOZbh7UYR1nVdXc6kyH0oj9XkSSDftX2zCNYGPUduy6OMkLDW9vhkR1cJ+eDMwgz1+SbW5vxXetmUbBUbmoQRWxolkpk7SEMNjeEqn5AASNdyH4L9SNXYt1woxjmKZVjwQ4zkwG40tbn4sTBOE7C9wPI9HQBF9r3fbMDI9IzdAMvo+loExdD+VR-U0HQbFsGoa1EMoIFYep0HYEFeMEWgqh80lGB0dEeiUMBuhOIA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokrcQAxLqkQ11XfxQpFC6cAAesKgiSoHBBsZc1AD6sVA2MUEhRroA7rSkABYq7Km4uiBKuroAwgDyAEzxNQ2VzfXAwApgqIy0MCysSQDWcKxdALrjTaJwAI5JIhDsEIxEOex19XKKEAC+OwBWRCrDo6IlmbbZRycjrOc3EKccXZtdZa8teLpdPX0Dzy623cWhYoiaBAKxwIYiSMxEGjg-HYoN6UHoIiSkOhYguwQ6n3qE3GZQI7C6AAVqFAyO8fmA7KxUHA6V07Iw4EF4LSwNsdko0Kgmip8uSIFVUroALwBTK4Vp8IQicEyxXCXGtKqkGBJIiCUh0GTnTVVXR6g20GRJVHS3R0USkMWm52y4JJcKkZgaOHMskml2ummwPQywnvf0u+FwDS2qPe0S+p0Bl3U+hwfyhsAAZXT0dIulRtHRIkQ4fFyed2NoMJVBZYRYxcCxUOruNSBLAbzAk1J5MIJAIrLAglQwRGQLk8vLFaqcfI-FtXRHY5ZeAjAZgwk0URDugAYgBBAAyWecU5nppMtDCSNth5PrmnyZ2FZfLsnEYIQTgEiIvS-yQ2jK9qOuugbumEnrqKQPrRkmFapNA8CLp2XznjOV7UOQjC2ph2GwX6T4VqitYkehF5VjWtqgtQghNpRbaZB2XY9nWjCiAAJHOSIfkRybcQuMo0XRzY4uc7adKhRLdiSbGcQJvEXlUm5YbQO62g4LhgVUb4Brppr6W+Ow7LQJi6OwKjYdB2hwDYtgVOWohFBArAHug7CChxgi0GUnkzIwOiMDsuxKGAuzjEAA}{Open in Shinylive} \if{html}{\out{}} \if{html}{\out{}} @@ -214,7 +205,6 @@ if (interactive()) { \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokrcQAxLoDCAEQCSAMreuvxQpFC6cAAesKgiSmERBsZc1AD6SVA2ieGRRroA7rSkABYq7Fm4uiBKuroAgr6BADIpumkYWYiIjE2tSgC+ihAAVkQq6QDWcKyilXm2BfxwJlDCpOkE-LSiBOnjkzNzwNDw81lyALruaxrpWiyi6VD8otTtZ2LsAGK01ORGOxdg4XNVRGh4hwssBgAowP0WvCrldqrsMHdSERGHJcUpHoxRO0CKUJgQxOlRHARBo4Px2ATaFB6CItqTaOSLnlYfDEcjUaZ1JsCc9Xu88RB3EpIe0VCV2HVQnldABeJURXCKvhCEREtXa4TfRX1UgwdJEQSkOgyebG+q6C1W2gyB4sVW6OiiUgKiD2v3qqDpGKkZj3USoOAEH3+-1ZL7u3nNJF4O0xqk00ju9ORzbhyPRmP+6jM6kJsCBak53SM5kiRDwzW+wt+klksTumssuBsttciI8hFJ-nVKO8gDirjwunhACEALJYADSWAAjPDcY3m37s7T+GWGhOG6nCzANrR4no1T8Gi1As5N1v6iZaNE6e7r7fXE3myMf8e5A+LbhHAEjYhy3Cuow7qet6x71FkQbRCGQqUhGo7foWcawJe06DgMKYYTGz4AjI7rEYCqH5nB-oih2TyAVurYcu2aqPNQgjdkxnILP2cJ4cmKLVCKAAkO7kPwAHUdula7nR7Gcey3EwnxfJgIJ1ZPKJMniZJhEnmeF7uqCX6Pr+hZmX6Fm6GZIwjLQJi6MCqihpoOg2LYtRNqI5QQKwDToOwkLCYItDVEFVKMDoOJDEoYCDFcQA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_t_crosstable.Rd b/man/tm_t_crosstable.Rd index c93e08a55..3f9aed2d5 100644 --- a/man/tm_t_crosstable.Rd +++ b/man/tm_t_crosstable.Rd @@ -53,7 +53,7 @@ The argument is merged with options variable \code{teal.basic_table_args} and de For more details see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module}) optional, @@ -182,15 +182,6 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsIykUPQiov64ul60cKTUrLoAvPZOzooQAMS6UhBq1Lr8UEG6cAAesKgiSgVFRrpc1AD61VA2VYVQBsYA7rSkABYq7M0RIEq6ujCkBCyinRNTM2OmRIy67Fq6KroEfoSs1OG6-lpheEcoMIf+Uiz+crajEOPjk9OMosDAWgC633NQ4hM6lIK3Yrxmnx+3zS4wAvktwe9Pv5UIxaDAWKwGgBrOCsfy-OaiTwNEQQdgQRhELpghbve5KWFpABWRBUOLxoiG7VstVZ7NxrC5-IgHI4-kRpwiErpUvOqPRmLFdzSSjQqDmKl6fie+XaiT1QVwCIEwjEBr4QlCOuedRgDVIDQIVNEoiCITgNttumowTgeSS-gAwi7ZnZgpU8EtbSUDc0GqVSMwNA1RKg4Dto97mtB4AaZW8pVnbcSRBoDaWM460xmvd7nr76P782AAMr+qu6LQsWgRuCIcLF70EPpsgjmpLdtF9p2j2jjrnNZFgSUE74RTN7A5nY5y-ywK5gG6MFXG3X18aVjRwfgGzcEfaH493M8X54wYSaCp6JIOFyvt9dBWfgZBvA0-2cAC3xMWgSjApIADEAEEABlW1cc9vRhLCoOeeIknjRNk2rdNM0w20c1gH9zlXKNyOeK9SArDsUxrMjAJ9P0A3OdsyyYqdew9Ac6I4kcxwnLsexnMT5zEbkgmXWjfg3XYH23aUwBOQ8Dx3I84FuMB7lw+tGPg84tJEwCP2oL8RANZC0MgodbRguDb0Q1D0Oc3RsNtXyfKWNI0loEw1hUchiO0T17l0R5LwGCBWCQ9B2HVAASbwInS4lGB0Rg0nhCAwFhb4gA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} - } - \item{example-2}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsIykUPQiov64ul60cKTUrLoAvPZOzooQAMS6AMIAIgCSAMpZuvxQQbpwAB6wqCJKpeVGulzUAPoNUDb1ZVAGxgDutKQAFirsHREgSrq6AII5BQAyfbqM80tKAL5pAFZEKq0A1nCsouM9tk38cCZQwqStBPy0ogStewfHp8DQ8GcdcgAukolGhUCsVEM-BAZh1EiUerhpro+EJQvDUcIxNCZjNSDBWg8CIwiKJREEQnAcbiZtRgnBqPD-FkSWT7ME6nhkTTKvCOq0qqRmBpWqJUHACNSabCer89El-OtFuFudLRAyJaR4eqRCKxRKpdLafTGQqwAUNRpdFoWLQOXBECqYUbcQRhvsCGJ4TbGHbKY93bRPf8esBgIqFsqwIDARFRIJ6OqtUkzBZNNYAbops6XbjaPxeU0AIQ29Bxc5BCIqYYyIaiCLUIgSIPcdgARjkEUl-hyZTg4V0-gACgB5Ap5AAaGgHw7Hk+opH8cjSuZp7lIgkYEHYcpDQTkwHzlUBK9X2yROZdOs1cH4TLAWRHjgAcg4AJpO1co+60Wry5IuBeX5EIw1zuHeSQOIBqpGiYtCVLe8IAGKzIsBSuJeNKnlhQHSvEST8oKwoPPq3aYbiHRyveSqflelrJro156uKZFfnS9AMveFq6lqPp+iIjpcuRNJuh6XpJHx9oBmJe5QGGEYbNGsaMQmSbwqmlgZhcWYwS6R4rKWtQcBMugvBgtwaCBDZNi21DtsuulGuum7bruFZQAeR4no5uLnj5MxMeQEGDuazgTrRuYwD+f7Iah6G4bmcEIcFKFoRhubYbimWnmkaS0CYujsCo5DEdoVLLjpzqiKMECsLM6DsGCAAk3gRM16qMDojBpJsShgJsgJAA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6ujCkBCyicVU1dRWmRIy67Fq6KroE7AqErNQDpQNaoiO6A7CTA1IsA3K25RCVldW1jKLAwFoAunsNUOIm6qRt7Bt1O-t7iqu6AL4tV1s7A6iMtDAsrIkA1nBWAMDg1RHAAI6JEQQdgQRhEbKXJpbJZKR73ABWRBUAKBomKGVsWWxuMBrAJpIgeI4A1eEzwUzA9NmYE+31+NMW9yUaFQDRUeX6DxSugAvP4MrgXgJhGJxVVZSICS1KqQYIlSIkCAjRKIgvQRMK1mtqFB6HA-BKBgBhXX1OzmqJ4VVrUIKlKJMKkZgaRKiVBwPquk0paDwBV0lEM6UPE2VcEiDQKxNBrUBoPG+Mms0Wq1MgDKlrTui0LFoTrgiBGIfjBHyOII8olZa+le1DdoTYJKXezOjIL2pWDg2GjLGMaZM3HYHmjG5sezJtTGjg-AVI4IQ1Zc8Wi6X62EmkieglDhc+4PbX4MjXCvPzkvS5MtFCd4lADEAIIAGQLrjjeN7mzOQn0qVgPQyL1Qh9M5-UDYNANDDJw1PJkWRdJC1hXUgU2LP0M0Qg9KlzS1IzAIsk1w1sK0NKsaywk160bZtS3LdtmK7MRCSCPsMIOYd+lHVlxlZadRlnOAFjAJYwPjHD3yZUTMOIqoj1oE8FW-P9H1rE0XzfddP1-f89N0YCgNdCz7nuWgTA6FRyF9TQdBsZYWlEQoIFYL90HYPkABJBFoUpAvBRgdEYe5nggMBHj2IA}{Open in Shinylive} \if{html}{\out{}} \if{html}{\out{}} @@ -198,7 +189,6 @@ if (interactive()) { \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXQBBHwCAGWTdVIxMxERGRpalAF9FCAArIhU0gGs4VlEK3Nt8-jgTKGFSNIJ+WlECNLGJ6dngaHg5zLkAXTdodDaVYvZakNzdAF4X8NxnviERUXeul+wjETwgdTqpBgaQ2BEYRFEonC9BEYIhEOoUHocGogIUYC88MR9ix8Twz3RUUBmTS0VIzA0aVEqDgBDR6IhmVOeg++L6zXx33BHLqohxrNIgLFIkZzNZ7JFdUx2NxvLAAXFGl0WhYtFJcEQgopioIJXGBDEgJ1jD1KLgmzNtAt51ywGAfKaArAl0uVVEgnoYslHzMFk01gu1WNit0tH4VPyAEIdehqBxKrGICUZMVRFVqEQJE7uOwAIxyKps-E+MJwQW6fEABQA8gE-AANDT1putjvUUj4uTDGPoxhwUiCRgQdjcl3hOTAONRS7DkdDIUj3TSiVwfh4gnNxwAOQcAE0jcKYzB1rQ4jz7E5nBuR0RGMsx3uPg4XM+YyZaFEu6AgAYvUzQBK4l4cqu6IVtGuisNSuS0lE9LqBscpVlB6JcrA94ev05LYRC25ah8pEYSyWGbsqOL7hqMqStatoiIaRGbqa5qWh8zH6g6XFzlAboEV6Pp+gGQaAqGlgRgsUbESKS5tCmcTprkVQ7BgqwaK++aFsW1BlkO8EimOE5TjOeGCQuS4riZELrvZoqauQn4Nuqzjthem7Xv2t4iCBYEQb+ir-oBbmgeBkExjBEKxauwzDLQJi6OwKjkAymg6DYtg1MKohlBArD1Og7BoKgAAkgi0FU5UVWKjA6IwwwDEoYADJcQA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } diff --git a/man/tm_variable_browser.Rd b/man/tm_variable_browser.Rd index 28b64606a..9f439c157 100644 --- a/man/tm_variable_browser.Rd +++ b/man/tm_variable_browser.Rd @@ -51,7 +51,7 @@ The argument is merged with options variable \code{teal.ggplot2_args} and defaul For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}} \item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. -To learn more check \code{vignette("data-transform-as-shiny-module", package = "teal")}.} +To learn more check \code{vignette("transform-input-data", package = "teal")}.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -113,15 +113,6 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ -<<<<<<< HEAD - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsKKoLADWdBBw-ri6XrRwpNSsugC89k7OtgBkGbruMb7+ABakMNQA7rT8UqSikdHecQnJqS6Z2bne+WAAVqIkdOS1MQ2JKQ4tSgDEulLhsrr8UKRQunAAHrCoIkoLSwbGXNQA+jtQNtuLy0a65aQFKuwnUSBKuro+tKJ7b4wfL7owpAILE+VwBQMYNQgr1KRHgUKuMLhfxMUFotzM1C+KLRBQxfwAwgB5ABMXyJxKUAF9FBAlGhUF8VGi-FD5hcmo8-nwhCJPilucIxCzXq9ioctCxaFB6CJDkwiKVRDJhSLXtRpXBMSl-AA1SXSkS6eWKmT+P6vGkWpQ02gmXTsFTkZiWHQ2WzPVmiO4QVgAQXQ7HpABJvFFg0rGDpGDTKUowJSALpAA}{Open in Shinylive} - \if{html}{\out{}} - \if{html}{\out{}} - } - \item{example-2}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAoksZwAjoNrv2CsKKoLADWdBBw-ri6XrRwpNSsugC89k7OtgBkGbruMb7+ABakMNQA7rT8UqSikdHecQnJqS6Z2bne+WAAVqIkdOS1MQ2JKQ4tSgDEugDCACIAkgDK07pwAB6wqCK6-FCkUEp0TCwcgSFhcIoQu-sGxlzUAPo3UDZKL3e65aQFKuwvURASl0ugAgrNFgAZT6McFQ4Fg2Z2OzOGHg5GuCAAXyuXSIKkewTgrFE-z2UFsRh2cBMUGEpEeBH4tFEBEeeIJRJJwGg8FJLzkAF0lEo0KhPipaKQ-BAQR8UgCEXwhCJRE1lcIxDKQSDio8tCxaFB6CJHkwiKVRDJtTqQdRjXBqE1-AA1Q3G7bmy0yfwIkFXf1KK60Ey6dgqcjMSw6Gy2IGy3SiX4QVig9DsMUAEm8USzVsYOkYVyxSjAWMFQA}{Open in Shinylive} - \if{html}{\out{}} -======= \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6urSMtKJxVTWiFbowpAQsdVmt7YxNEJXZRPD9WYPDzSZQeflmflmT07PNAMIA8gBM9WvrSgC+ihBKaKj1KnnszSm6ALz+GbjNfEIidbdPwmIX-ZW6pDCJWhYtCg9BEiSYRGyohkXx+P2oILgfluCjAADUgSCRLoIVCZKjmpUDkSlAdaCZdOwVORmJYdDZbOVvqJChBWABBdDsY4AEkEtFKvOhjB0jAOuyUYF2AF0gA}{Open in Shinylive} \if{html}{\out{}} \if{html}{\out{}} @@ -129,7 +120,6 @@ if (interactive()) { \item{example-2}{ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dOAAPWFQRXX4oUiglOiYWDlFUFgBrOgg4RQgYuINjLmoAfXyoGyVywt0Ad1pSAAsVdnLcXRAlXV0AQR8AgBka4oxyxERGPsGu3p87O2dhuG5R2KhxybmFpQBfXIArIhUS9LhWUVa12yNouBMoYVISgn5aUQISw+PT8+BoeAu5TkAF03NB0DUVA12DNqgBeaJrXAzPhCESiXQI1HCMQwiDdbqkGAlLQsWhQegiEpMIi1UQyPEEgnUClwaiY3QKMAANTJFKiNLpMi5M26uTFSlytBMunYKnIzEsOhstk6+N0omaEFYPXQ7DQqAAJIJaO0DYb6YwdIxcjslGAdsCgA}{Open in Shinylive} \if{html}{\out{}} ->>>>>>> main \if{html}{\out{}} } } From 3eb068acaca247aa6a20c6f2d9a564b05748889d Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Thu, 6 Mar 2025 13:08:54 +0000 Subject: [PATCH 50/92] swimlane with tabs --- R/tm_g_spiderplot.R | 24 +++++++++++------------- R/tm_g_waterfall.R | 11 ++++------- R/tm_swimlane_mdr.R | 11 +++-------- R/tm_t_reactable.R | 22 ++++++++++------------ 4 files changed, 28 insertions(+), 40 deletions(-) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 42a69859c..082cb8213 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -26,20 +26,18 @@ ui_g_spiderplot <- function(id, height) { ns <- NS(id) div( div( - class = "simple-card", - div( - class = "row", - column( - width = 6, - selectInput(ns("select_event"), "Select Y Axis", NULL) - ), - column( - width = 6, - sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) - ) + class = "row", + column( + width = 6, + selectInput(ns("select_event"), "Select Y Axis", NULL) ), - plotly::plotlyOutput(ns("plot"), height = "100%") - ) + column( + width = 6, + sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) + ) + ), + plotly::plotlyOutput(ns("plot"), height = "100%") + ) } diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 80b240214..382d6bf02 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -31,18 +31,15 @@ tm_g_waterfall <- function(label = "Waterfall", ui_g_waterfall <- function(id, height) { ns <- NS(id) tagList( - fluidRow( + div( class = "simple-card", - div( - class = "row", + fluidRow( column(width = 6, uiOutput(ns("color_by_output"))), - column(width = 6, sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)) + column(width = 6, sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)), ), plotly::plotlyOutput(ns("plot"), height = "100%") ), - fluidRow( - uiOutput(ns("tables")) - ) + uiOutput(ns("tables")) ) } srv_g_waterfall <- function(id, diff --git a/R/tm_swimlane_mdr.R b/R/tm_swimlane_mdr.R index 70e31f944..77842d05a 100644 --- a/R/tm_swimlane_mdr.R +++ b/R/tm_swimlane_mdr.R @@ -76,16 +76,11 @@ tm_g_swimlane_mdr <- function(label = "Swimlane", ui_g_swimlane_mdr <- function(id, height) { ns <- NS(id) tagList( - fluidRow( - class = "simple-card", + div( h4("Swim Lane - Duration of Tx"), ui_g_swimlane(ns("plot"), height = height) ), - fluidRow( - class = "simple-card", - ui_t_reactables(ns("subtables")) - ) - + ui_t_reactables(ns("subtables")) ) } srv_g_swimlane_mdr <- function(id, @@ -142,6 +137,6 @@ srv_g_swimlane_mdr <- function(id, teal.code::eval_code(plotly_selected_q(), as.expression(calls)) }) - srv_t_reactables("subtables", data = subtables_q, datanames = subtable_names) + srv_t_reactables("subtables", data = subtables_q, datanames = subtable_names, layout = "tabs") }) } diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index db4ff7ef6..05fe43086 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -16,7 +16,10 @@ tm_t_reactables <- function(label = "Table", datanames = "all", columns = list() ui_t_reactables <- function(id) { ns <- NS(id) - uiOutput(ns("subtables"), container = fluidRow) + div( + class = "simple-card", + uiOutput(ns("subtables"), container = div, style = "display: flex;") + ) } srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, decorators, layout = "grid", ...) { @@ -64,13 +67,11 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, dec lapply( datanames_r(), function(dataname) { - column( - width = if (length(datanames_r()) == 1) 12 else 6, - div( - class = "simple-card", - h4(datalabels_r()[dataname]), - ui_t_reactable(session$ns(dataname)) - ) + div( + class = "simple-card", + style = if (length(datanames_r()) > 1) "width: 50%" else "width: 100%", + h4(datalabels_r()[dataname]), + ui_t_reactable(session$ns(dataname)) ) } ) @@ -136,10 +137,7 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, dec ui_t_reactable <- function(id) { ns <- NS(id) - div( - class = "simple-card", - reactable::reactableOutput(ns("table")) - ) + reactable::reactableOutput(ns("table")) } srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, ...) { From cfbabc2d91590615a4ce7100e44f77ad211bb902 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Thu, 6 Mar 2025 16:55:12 +0000 Subject: [PATCH 51/92] poc_onco_v1 --- R/tm_g_waterfall.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 382d6bf02..77b1a63c4 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -98,6 +98,7 @@ srv_g_waterfall <- function(id, dplyr::mutate( subject_var_ordered = forcats::fct_reorder(as.factor(subject_var), value_var, .fun = max, .desc = TRUE) ) |> + dplyr::filter(!duplicated(subject_var)) |> # todo: one value for x, y: distinct or summarize(value = foo(value_var)) [foo: summarize_fun] plotly::plot_ly( source = "waterfall", From bea4996e2db5cba264373e4a13a668895ad837e1 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Tue, 11 Mar 2025 08:47:12 +0000 Subject: [PATCH 52/92] WIP --- R/tm_a_spiderplot_mdr.R | 2 +- R/tm_data_table.R | 19 +++++----- R/tm_g_waterfall.R | 2 +- R/tm_swimlane_mdr.R | 81 +++++++++++++++-------------------------- R/tm_t_reactable.R | 77 ++++++++++++++++++++++++++------------- R/utils.R | 2 +- inst/poc_crf2.R | 6 +-- 7 files changed, 96 insertions(+), 93 deletions(-) diff --git a/R/tm_a_spiderplot_mdr.R b/R/tm_a_spiderplot_mdr.R index 7627adc00..6be6b7904 100644 --- a/R/tm_a_spiderplot_mdr.R +++ b/R/tm_a_spiderplot_mdr.R @@ -242,7 +242,7 @@ srv_a_spiderplot_mdr <- function(id, }) observeEvent(all_q(), { - "do nothing" + cat(teal.code::get_code(all_q())) }) diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 437540a11..fd93bd213 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -155,7 +155,6 @@ tm_data_table <- function(label = "Data Table", # UI page module ui_data_table <- function(id, pre_output = NULL, post_output = NULL) { ns <- NS(id) - tagList( include_css_files("custom"), teal.widgets::standard_layout( @@ -208,18 +207,17 @@ srv_data_table <- function(id, datanames_r <- reactive({ Filter( - function(name) { - is.data.frame(data()[[name]]) - }, + function(name) is.data.frame(data()[[name]]), if (identical(datanames, "all")) names(data()) else datanames ) }) - output$dataset_table <- renderUI({ + output$data_tables <- renderUI({ + req(datanames_r()) do.call( tabsetPanel, c( - list(id = session$ns("dataname_tab")), + list(id = session$ns("tabs_selected"), selected = datanames_r()[1]), lapply( datanames_r(), function(x) { @@ -258,12 +256,16 @@ srv_data_table <- function(id, ) ) ) - }) + }) |> + bindCache(datanames_r()) |> + bindEvent(datanames_r()) + # server should be run only once modules_run <- reactiveVal() - modules_to_run <- reactive(setdiff(datanames_r(), modules_run())) + modules_to_run <- reactive(setdiff(datanames_r(), isolate(modules_run()))) observeEvent(modules_to_run(), { + print(modules_to_run()) lapply( modules_to_run(), function(dataname) { @@ -288,7 +290,6 @@ srv_data_table <- function(id, # UI function for the data_table module ui_dataset_table <- function(id, choices, selected) { ns <- NS(id) - if (!is.null(selected)) { all_choices <- choices choices <- c(selected, setdiff(choices, selected)) diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 77b1a63c4..69c4b3c15 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -180,6 +180,6 @@ srv_g_waterfall <- function(id, }) output$tables <- renderUI(ui_t_reactables(session$ns("subtables"))) - srv_t_reactables("subtables", data = tables_selected_q, dataname = sprintf("%s_brushed", table_datanames)) + srv_t_reactables("subtables", data = tables_selected_q, dataname = sprintf("%s_brushed", table_datanames), layout = "grid") }) } diff --git a/R/tm_swimlane_mdr.R b/R/tm_swimlane_mdr.R index 77842d05a..d5125d99e 100644 --- a/R/tm_swimlane_mdr.R +++ b/R/tm_swimlane_mdr.R @@ -1,24 +1,11 @@ #' @export tm_g_swimlane_mdr <- function(label = "Swimlane", - dataname, + plot_dataname, time_var, subject_var, value_var, event_var, - subtable_labels = c("Multiple Myeloma Response", "Study Tx Listing"), - subtable_cols = list( - c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", - "rspdn", "rspd", "rspd_study_day", "orsp", "bma", "bmb", "comnts" - ), - c( - "site_name", "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "txnam", - "txrec", "txrecrs", "txd_study_day", "date_administered", "cydly", "cydlyrs", "cydlyae", "txdly", - "txdlyrs", "txdlyae", "txpdos", "txpdosu", "frqdv", "txrte", "txform", "txdmod", "txrmod", - "txdmae", "txad", "txadu", "txd", "txstm", "txstmu", "txed", "txetm", "txetmu", "txtm", "txtmu", - "txed_study_day", "infrt", "infrtu", "tximod", "txirmod", "tximae" - ) - ), + listing_datanames = character(0), value_var_color = c( "DEATH" = "black", "WITHDRAWAL BY SUBJECT" = "grey", @@ -49,25 +36,22 @@ tm_g_swimlane_mdr <- function(label = "Swimlane", "Z Administration Infusion" = "line-ns" ), plot_height = 700) { - checkmate::assert_character(subtable_labels) - checkmate::assert_list(subtable_cols) checkmate::assert_character(value_var_color) module( label = label, ui = ui_g_swimlane_mdr, server = srv_g_swimlane_mdr, - datanames = dataname, + datanames = union(plot_dataname, listing_datanames), ui_args = list(height = plot_height), server_args = list( - dataname = dataname, + plot_dataname = plot_dataname, time_var = time_var, subject_var = subject_var, value_var = value_var, event_var = event_var, value_var_color = value_var_color, value_var_symbol = value_var_symbol, - subtable_labels = subtable_labels, - subtable_cols = subtable_cols, + listing_datanames = listing_datanames, plot_height = plot_height ) ) @@ -85,22 +69,21 @@ ui_g_swimlane_mdr <- function(id, height) { } srv_g_swimlane_mdr <- function(id, data, - dataname, + plot_dataname, time_var, subject_var, value_var, event_var, value_var_color, value_var_symbol, - subtable_labels, - subtable_cols, + listing_datanames, filter_panel_api, plot_height = 600) { moduleServer(id, function(input, output, session) { plotly_selected_q <- srv_g_swimlane( "plot", data = data, - dataname = dataname, + dataname = plot_dataname, time_var = time_var, subject_var = subject_var, value_var = value_var, @@ -110,33 +93,27 @@ srv_g_swimlane_mdr <- function(id, filter_panel_api = filter_panel_api ) - subtable_names <- gsub("[[:space:][:punct:]]+", "_", x = tolower(subtable_labels)) - subtables_q <- reactive({ - req(plotly_selected_q()) - calls <- lapply(seq_along(subtable_names), function(i) { - substitute( - list( - dataname = str2lang(dataname), - subtable_name = str2lang(subtable_names[i]), - subtable_label = subtable_labels[i], - time_var = str2lang(time_var), - subject_var = str2lang(subject_var), - col_defs = subtable_cols[[i]] - ), - expr = { - subtable_name <- dataname |> - dplyr::filter( - time_var %in% plotly_brushed_time, - subject_var %in% plotly_brushed_subject - ) |> - dplyr::select(dplyr::all_of(col_defs)) - attr(subtable_name, "label") <- subtable_label - } - ) + if (length(listing_datanames)) { + listings_q <- reactive({ + req(plotly_selected_q()) + calls <- lapply(seq_along(listing_datanames), function(i) { + listing_name <- listing_names[i] + listing_label <- attr(plotly_selected_q()[[listing_name]], "label") + substitute( + list( + listing_name = str2lang(listing_name), + listing_selected = str2lang(sprintf("%s_selected", listing_name)), + listing_label = listing_label, + subject_var = str2lang(subject_var) + ), + expr = { + listing_selected <- dplyr::filter(listing_name, subject_var %in% plotly_brushed_subject) + } + ) + }) + teal.code::eval_code(plotly_selected_q(), as.expression(calls)) }) - teal.code::eval_code(plotly_selected_q(), as.expression(calls)) - }) - - srv_t_reactables("subtables", data = subtables_q, datanames = subtable_names, layout = "tabs") + srv_t_reactables("subtables", data = listings_q, datanames = listing_datanames, layout = "tabs") + } }) } diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 05fe43086..2ad8d14df 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -78,21 +78,25 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, dec ) } else if (layout == "tabs") { isolate({ - do.call( - tabsetPanel, - c( - list(id = session$ns("reactables")), - lapply( - datanames_r(), - function(dataname) { - tabPanel( - title = datalabels_r()[dataname], - ui_t_reactable(session$ns(dataname)) - ) - } + div( + do.call( + tabsetPanel, + c( + list(id = session$ns("reactables")), + lapply( + datanames_r(), + function(dataname) { + tabPanel( + title = datalabels_r()[dataname], + class = "simple-card", + ui_t_reactable(session$ns(dataname)) + ) + } + ) ) ) ) + }) } @@ -147,6 +151,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, .. reactable_call <- reactive({ default_args <- list( columns = .make_reactable_columns_call(data()[[dataname]]), + resizable = TRUE, onClick = "select", defaultPageSize = 15, wrap = FALSE, @@ -195,7 +200,32 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, .. .make_reactable_call <- function(dataname, args) { args <- c( - list(data = str2lang(dataname)), + list( + data = str2lang(dataname), + defaultColDef = quote( + colDef( + cell = function(value) { + is_url <- is.character(value) && any( + grepl( + "https?:\\/\\/(www\\.)?[-a-zA-Z0-9@:%._\\+~#=]{1,256}\\.[a-zA-Z0-9()]{1,6}\\b([-a-zA-Z0-9()@:%_\\+.~#?&//=]*)", + x = head(value), + perl = TRUE + ) + ) + if (is_url) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") + } else { + "N/A" + } + } else { + value + } + } + ) + + ) + ), args ) do.call(call, c(list(name = "reactable"), args), quote = TRUE) @@ -214,26 +244,21 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, .. args <- lapply( seq_along(dataset), function(i) { - label <- attr(dataset[[i]], "label") + column <- dataset[[i]] + label <- attr(column, "label") is_labelled <- length(label) == 1 && !is.na(label) && !identical(label, "") - is_url <- is.character(dataset[[i]]) && any( + is_url <- is.character(column) && any( grepl( "https?:\\/\\/(www\\.)?[-a-zA-Z0-9@:%._\\+~#=]{1,256}\\.[a-zA-Z0-9()]{1,6}\\b([-a-zA-Z0-9()@:%_\\+.~#?&//=]*)", - x = head(dataset[[i]]), + x = head(column), perl = TRUE ) ) - + # todo: move url formatter to the defaultColDef + width <- max(nchar(head(as.character(column), 100))) * 9 args <- c( - if (is_labelled) list(name = label), - if (is_url) list(cell = quote(function(value) { - if (!is.na(value) && !is.null(value) && value != "") { - htmltools::tags$a(href = value, target = "_blank", "Link") - } else { - "N/A" - } - }) - ) + if (!is.na(width) && width > 100 && !is_url) list(width = width), + if (is_labelled) list(name = label) ) if (length(args)) { diff --git a/R/utils.R b/R/utils.R index a6a48cbf5..ec25fe476 100644 --- a/R/utils.R +++ b/R/utils.R @@ -455,7 +455,7 @@ normalize_decorators <- function(decorators) { furthest_neighbours_idx <- order(apply(optimal_to_current_dist, 2, min), decreasing = TRUE) missing_colors <- optimal_color_space[furthest_neighbours_idx][seq_len(m)] p <- c(p, setNames(missing_colors, missing_levels)) - } else if (n) { + } else if (length(missing_levels)) { colorspace::qualitative_hcl(N) } else { p diff --git a/inst/poc_crf2.R b/inst/poc_crf2.R index 3b74c614b..b025610d5 100644 --- a/inst/poc_crf2.R +++ b/inst/poc_crf2.R @@ -2,7 +2,7 @@ library(teal) library(DT) library(labelled) library(reactable) -pkgload::load_all("teal.modules.general") +pkgload::load_all("~/nest/teal.modules.general") # Note: Please add the `PATH_TO_DATA` and change the X, Y, and Z Administrations to the actual values in the data with_tooltips <- function(...) { @@ -17,7 +17,7 @@ data <- within(teal_data(), { library(dplyr) library(arrow) library(forcats) - data_path <- "PATH/TO/THE/DATA" + data_path <- "PATH/TO/DATA" swimlane_ds <- read_parquet(file.path(data_path, "swimlane_ds.parquet")) |> filter(!is.na(event_result), !is.na(event_study_day)) |> @@ -159,7 +159,7 @@ tm_swimlane <- function(label = "Swimlane", plot_height = 700) { extreme_grade ) ) - + p <- plotly::plot_ly( source = "swimlane", colors = c( From b496a7e108e7e07e1ce7b537d4ac893aa427cb4a Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Tue, 11 Mar 2025 11:32:02 +0000 Subject: [PATCH 53/92] swimlane fix shapes and fct order --- R/tm_data_table.R | 33 ++++++++++++--------------------- R/tm_g_swimlane.R | 34 +++++++++++++++++++--------------- R/tm_g_waterfall.R | 35 +++++++++++++++++++++++------------ R/tm_t_reactable.R | 41 +++++++++++++++++------------------------ R/utils.R | 10 ++++++++-- 5 files changed, 79 insertions(+), 74 deletions(-) diff --git a/R/tm_data_table.R b/R/tm_data_table.R index d2236b70a..35f94641b 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -155,20 +155,12 @@ tm_data_table <- function(label = "Data Table", # UI page module ui_data_table <- function(id, pre_output = NULL, post_output = NULL) { ns <- NS(id) - tagList( + bslib::page_fluid( include_css_files("custom"), teal.widgets::standard_layout( - output = teal.widgets::white_small_well( - bslib::page_fluid( - checkboxInput( - ns("if_distinct"), - "Show only distinct rows:", - value = FALSE - ) - ), - bslib::page_fluid( - uiOutput(ns("dataset_table")) - ) + output = bslib::page_fluid( + div(checkboxInput(ns("if_distinct"), "Show only distinct rows:", value = FALSE)), + uiOutput(ns("data_tables")) ), pre_output = pre_output, post_output = post_output @@ -213,12 +205,12 @@ srv_data_table <- function(id, list(id = session$ns("tabs_selected"), selected = datanames_r()[1]), lapply( datanames_r(), - function(x) { - dataset <- isolate(data()[[x]]) + function(dataname) { + dataset <- isolate(data()[[dataname]]) choices <- names(dataset) labels <- vapply( dataset, - function(x) ifelse(is.null(attr(x, "label")), "", attr(x, "label")), + function(column) ifelse(is.null(attr(column, "label")), "", attr(column, "label")), character(1) ) names(choices) <- ifelse( @@ -226,17 +218,17 @@ srv_data_table <- function(id, choices, paste(choices, labels, sep = ": ") ) - variables_selected <- if (!is.null(variables_selected[[x]])) { - variables_selected[[x]] + variables_selected <- if (!is.null(variables_selected[[dataname]])) { + variables_selected[[dataname]] } else { utils::head(choices) } tabPanel( - title = x, + title = dataname, bslib::layout_columns( col_widths = 12, - ui_data_table( - id = session$ns(x), + ui_dataset_table( + id = session$ns(dataname), choices = choices, selected = variables_selected ) @@ -255,7 +247,6 @@ srv_data_table <- function(id, modules_run <- reactiveVal() modules_to_run <- reactive(setdiff(datanames_r(), isolate(modules_run()))) observeEvent(modules_to_run(), { - print(modules_to_run()) lapply( modules_to_run(), function(dataname) { diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 2405b8f34..10bb57417 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -51,6 +51,10 @@ srv_g_swimlane <- function(id, levels = unique(data()[[dataname]][[value_var]]), color = value_var_color ) + adjusted_symbols <- .shape_palette_discrete( + levels = unique(data()[[dataname]][[value_var]]), + symbol = value_var_symbol + ) subject_var_label <- c(attr(data()[[dataname]][[subject_var]], "label"), "Subject")[1] time_var_label <- c(attr(data()[[dataname]][[time_var]], "label"), "Study Day")[1] data() |> @@ -64,15 +68,16 @@ srv_g_swimlane <- function(id, subject_var_label = sprintf("%s:", subject_var_label), time_var_label = sprintf("%s:", time_var_label), colors = adjusted_colors, - symbols = value_var_symbol, + symbols = adjusted_symbols, height = input$plot_height, - filtered_events = c("disposition","response_assessment", "study_drug_administration"), subject_axis_label = subject_var_label, time_axis_label = time_var_label, expr = { - dataname <- dataname |> - mutate(subject_var_ordered = forcats::fct_reorder(as.factor(subject_var), time_var, .fun = max)) |> - group_by(subject_var, time_var) |> + # todo: forcats::fct_reorder didn't work. + levels <- with(dataname, tapply(time_var, subject_var, max)) |> sort() + dataname <- dataname %>% + mutate(subject_var_ordered = factor(subject_var, levels = names(levels))) %>% + group_by(subject_var, time_var) %>% mutate( tooltip = paste( unique(c( @@ -84,31 +89,27 @@ srv_g_swimlane <- function(id, )) - p <- dataname |> - dplyr::filter( - event_var %in% filtered_events, - !is.na(time_var) - ) |> + p <- dataname %>% plotly::plot_ly( source = "swimlane", colors = colors, symbols = symbols, height = height - ) |> + ) %>% plotly::add_markers( x = ~time_var, y = ~subject_var_ordered, color = ~value_var, symbol = ~value_var, text = ~tooltip, hoverinfo = "text" - ) |> + ) %>% plotly::add_segments( x = ~0, xend = ~study_day, y = ~subject_var_ordered, yend = ~subject_var_ordered, data = dataname |> group_by(subject_var_ordered) |> summarise(study_day = max(time_var)), line = list(width = 1, color = "grey"), showlegend = FALSE - ) |> + ) %>% plotly::layout( xaxis = list(title = time_axis_label), yaxis = list(title = subject_axis_label) - ) |> + ) %>% plotly::layout(dragmode = "select") |> plotly::config(displaylogo = FALSE) } @@ -126,6 +127,10 @@ srv_g_swimlane <- function(id, plotly::event_data("plotly_selected", source = "swimlane") }) + observeEvent(plotly_q(), { + cat(paste(collapse = "\n", teal.code::get_code(plotly_q()))) + }) + reactive({ req(plotly_selected()) within( @@ -142,7 +147,6 @@ srv_g_swimlane <- function(id, } ) }) - }) } diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 69c4b3c15..210666696 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -8,22 +8,26 @@ tm_g_waterfall <- function(label = "Waterfall", bar_colors = list(), value_arbitrary_hlines = c(0.2, -0.3), plot_title = "Waterfall plot", - plot_height = 700) { + plot_height = 700, + ...) { module( label = label, ui = ui_g_waterfall, server = srv_g_waterfall, datanames = union(plot_dataname, table_datanames), ui_args = list(height = plot_height), - server_args = list( - plot_dataname = plot_dataname, - table_datanames = table_datanames, - subject_var = subject_var, - value_var = value_var, - color_var = color_var, - bar_colors = bar_colors, - value_arbitrary_hlines = value_arbitrary_hlines, - plot_title = plot_title + server_args = c( + list( + plot_dataname = plot_dataname, + table_datanames = table_datanames, + subject_var = subject_var, + value_var = value_var, + color_var = color_var, + bar_colors = bar_colors, + value_arbitrary_hlines = value_arbitrary_hlines, + plot_title = plot_title + ), + list(...) ) ) } @@ -53,7 +57,8 @@ srv_g_waterfall <- function(id, filter_panel_api, value_arbitrary_hlines, plot_title, - plot_height = 600) { + plot_height = 600, + ...) { moduleServer(id, function(input, output, session) { output$color_by_output <- renderUI({ selectInput(session$ns("color_by"), label = "Color by:", choices = color_var$choices, selected = color_var$selected) @@ -180,6 +185,12 @@ srv_g_waterfall <- function(id, }) output$tables <- renderUI(ui_t_reactables(session$ns("subtables"))) - srv_t_reactables("subtables", data = tables_selected_q, dataname = sprintf("%s_brushed", table_datanames), layout = "grid") + srv_t_reactables( + "subtables", + data = tables_selected_q, + dataname = sprintf("%s_brushed", table_datanames), + layout = "accordion", + ... + ) }) } diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 2ad8d14df..63b12a0d4 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -16,10 +16,7 @@ tm_t_reactables <- function(label = "Table", datanames = "all", columns = list() ui_t_reactables <- function(id) { ns <- NS(id) - div( - class = "simple-card", - uiOutput(ns("subtables"), container = div, style = "display: flex;") - ) + uiOutput(ns("subtables"), container = bslib::page_fluid) } srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, decorators, layout = "grid", ...) { @@ -76,28 +73,24 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, dec } ) ) - } else if (layout == "tabs") { - isolate({ - div( - do.call( - tabsetPanel, - c( - list(id = session$ns("reactables")), - lapply( - datanames_r(), - function(dataname) { - tabPanel( - title = datalabels_r()[dataname], - class = "simple-card", - ui_t_reactable(session$ns(dataname)) - ) - } - ) + } else if (layout == "accordion") { + div( + do.call( + bslib::accordion, + c( + list(id = session$ns("reactables")), + lapply( + datanames_r(), + function(dataname) { + bslib::accordion_panel( + title = datalabels_r()[dataname], + ui_t_reactable(session$ns(dataname)) + ) + } ) ) ) - - }) + ) } }) |> bindCache(datanames_r()) @@ -153,7 +146,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, .. columns = .make_reactable_columns_call(data()[[dataname]]), resizable = TRUE, onClick = "select", - defaultPageSize = 15, + defaultPageSize = 10, wrap = FALSE, rowClass = JS(" function(rowInfo) { diff --git a/R/utils.R b/R/utils.R index cceea176c..ad198658f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -416,7 +416,7 @@ select_decorators <- function(decorators, scope) { N <- length(levels) n <- length(p) m <- N - n - if (m & n) { + if (m > 0 && n > 0) { current_space <- rgb2hsv(col2rgb(p)) optimal_color_space <- colorspace::qualitative_hcl(N) color_distances <- dist(t(cbind(current_space, rgb2hsv(col2rgb(optimal_color_space))))) @@ -428,6 +428,12 @@ select_decorators <- function(decorators, scope) { colorspace::qualitative_hcl(N) } else { p - } + } + p[levels] } +.shape_palette_discrete <- function(levels, symbol) { + s <- setNames(symbol[levels], levels) + s[is.na(s)] <- "circle-open" + s +} From 7590be1cd7f3843fc89e3eddedac86df1556dd9c Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Wed, 12 Mar 2025 11:47:27 +0000 Subject: [PATCH 54/92] wip --- R/tm_data_table.R | 18 ++-- R/tm_g_swimlane.R | 12 ++- R/tm_g_waterfall.R | 13 ++- R/tm_t_reactable.R | 214 +++++++++++++++++++++++++++------------------ 4 files changed, 149 insertions(+), 108 deletions(-) diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 35f94641b..724254aa8 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -324,6 +324,14 @@ srv_dataset_table <- function(id, teal.code::eval_code( qenv, substitute( + env = list( + dataname = as.name(dataname), + if_distinct = if_distinct(), + vars = input$variables, + args = dt_args, + dt_options = dt_options, + dt_rows = input$dt_rows + ), expr = { variables <- vars dataframe_selected <- if (if_distinct) { @@ -338,15 +346,7 @@ srv_dataset_table <- function(id, } dt_args$data <- dataframe_selected table <- do.call(DT::datatable, dt_args) - }, - env = list( - dataname = as.name(dataname), - if_distinct = if_distinct(), - vars = input$variables, - args = dt_args, - dt_options = dt_options, - dt_rows = input$dt_rows - ) + } ) ) }) diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 10bb57417..28aa68b7c 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -28,9 +28,11 @@ tm_g_swimlane <- function(label = "Swimlane", ui_g_swimlane <- function(id, height) { ns <- NS(id) - div( - class = "simple-card", - sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height, width = "100%"), + bslib::page_fluid( + fluidRow( + column(6, uiOutput(ns("sort_by_output"))), + column(6, sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)) + ), plotly::plotlyOutput(ns("plot"), height = "100%") ) } @@ -127,10 +129,6 @@ srv_g_swimlane <- function(id, plotly::event_data("plotly_selected", source = "swimlane") }) - observeEvent(plotly_q(), { - cat(paste(collapse = "\n", teal.code::get_code(plotly_q()))) - }) - reactive({ req(plotly_selected()) within( diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 210666696..b17d54f17 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -34,15 +34,12 @@ tm_g_waterfall <- function(label = "Waterfall", ui_g_waterfall <- function(id, height) { ns <- NS(id) - tagList( - div( - class = "simple-card", - fluidRow( - column(width = 6, uiOutput(ns("color_by_output"))), - column(width = 6, sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)), - ), - plotly::plotlyOutput(ns("plot"), height = "100%") + bslib::page_fluid( + fluidRow( + column(6, uiOutput(ns("color_by_output"))), + column(6, sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)) ), + plotly::plotlyOutput(ns("plot"), height = "100%"), uiOutput(ns("tables")) ) } diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 63b12a0d4..48184eb3f 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -2,19 +2,19 @@ tm_t_reactables <- function(label = "Table", datanames = "all", columns = list(), layout = "grid", transformators = list(), decorators = list(), ...) { module( label = label, - ui = ui_t_reactable, - srv = srv_t_reactable, + ui = ui_t_reactables, + server = srv_t_reactables, ui_args = list(decorators = decorators), - srv_args = c( + server_args = c( list(datanames = datanames, columns = columns, layout = layout, decorators = decorators), rlang::list2(...) ), - datanames = subtables, - transformers = transformers + datanames = datanames, + transformators = transformators ) } -ui_t_reactables <- function(id) { +ui_t_reactables <- function(id, decorators) { ns <- NS(id) uiOutput(ns("subtables"), container = bslib::page_fluid) } @@ -34,7 +34,8 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, dec } else { intersect(datanames, df_datanames) } - }) |> bindEvent(all_datanames_r()) + }) |> + bindEvent(all_datanames_r()) columns_r <- reactive({ req(datanames_r()) @@ -45,7 +46,9 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, dec colnames(isolate(data())[[dataname]]) } }) - }) |> bindEvent(datanames_r()) + }) |> + bindCache(datanames_r()) |> + bindEvent(datanames_r()) datalabels_r <- reactive({ req(datanames_r()) @@ -53,97 +56,134 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, dec datalabel <- attr(isolate(data())[[dataname]], "label") if (length(datalabel)) datalabel else dataname }) - }) |> bindEvent(datanames_r()) + }) |> + bindCache(datanames_r()) |> + bindEvent(datanames_r()) # todo: re-render only if datanames changes output$subtables <- renderUI({ if (length(datanames_r()) == 0) return(NULL) - - if (layout == "grid") { - tagList( - lapply( - datanames_r(), - function(dataname) { - div( - class = "simple-card", - style = if (length(datanames_r()) > 1) "width: 50%" else "width: 100%", - h4(datalabels_r()[dataname]), - ui_t_reactable(session$ns(dataname)) - ) - } - ) - ) - } else if (layout == "accordion") { - div( - do.call( - bslib::accordion, - c( - list(id = session$ns("reactables")), - lapply( - datanames_r(), - function(dataname) { - bslib::accordion_panel( - title = datalabels_r()[dataname], - ui_t_reactable(session$ns(dataname)) - ) - } - ) + logger::log_debug("srv_t_reactables@1 render subtables") + div( + do.call( + bslib::accordion, + c( + list(id = session$ns("reactables")), + lapply( + datanames_r(), + function(dataname) { + bslib::accordion_panel( + title = datalabels_r()[dataname], + ui_t_reactable(session$ns(dataname)) + ) + } ) ) ) - } - - }) |> bindCache(datanames_r()) + ) + }) |> + bindCache(datanames_r()) |> + bindEvent(datanames_r()) called_datanames <- reactiveVal() observeEvent(datanames_r(), { lapply( setdiff(datanames_r(), called_datanames()), # call module only once per dataname - function(dataname) srv_t_reactable(dataname, data = data, dataname = dataname, filter_panel_api = filter_panel_api, ...) + function(dataname) { + srv_t_reactable( + dataname, + data = data, + dataname = dataname, + filter_panel_api = filter_panel_api, + columns = columns[[dataname]], + ... + ) + } ) called_datanames(union(called_datanames(), datanames_r())) }) - - - # lapply( - # seq_along(subtables), - # function(i) { - # table_q <- reactive({ - # within( - # plotly_selected_q(), - # dataname = str2lang(dataname), - # subtable_name = subtable_names[i], - # time_var = str2lang(time_var), - # subject_var = str2lang(subject_var), - # col_defs = subtables[[i]], - # expr = { - # subtable_name <- dataname |> - # dplyr::filter( - # time_var %in% plotly_brushed_time, - # subject_var %in% plotly_brushed_subject - # ) |> - # dplyr::select(dplyr::all_of(col_defs)) - # } - # ) - # }) - # srv_t_reactable(subtable_names[i], data = table_q, dataname = subtable_names[i], selection = NULL) - # } - # ) }) } ui_t_reactable <- function(id) { ns <- NS(id) - reactable::reactableOutput(ns("table")) + bslib::page_fluid( + shinyWidgets::pickerInput( + ns("columns"), + label = "Select columns", + choices = NULL, + selected = NULL, + multiple = TRUE, + width = "100%", + options = shinyWidgets::pickerOptions( + actionsBox = TRUE, + `show-subtext` = TRUE, + countSelectedText = TRUE, + liveSearch = TRUE + ) + ), + reactable::reactableOutput(ns("table")) + ) + } -srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, ...) { +srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decorators, ...) { moduleServer(id, function(input, output, session) { + logger::log_debug("srv_t_reactable initializing for dataname: { dataname }") dataname_reactable <- sprintf("%s_reactable", dataname) + dataset_labels <- reactive({ + req(data()) + teal.data::col_labels(data()[[dataname]], fill = TRUE) + }) + + cols_choices <- reactive({ + req(dataset_labels()) + choices <- if (length(columns)) { + columns + } else { + names(dataset_labels()) + } + labels_choices <- dataset_labels()[choices] + setNames(choices, labels_choices) + }) |> + bindCache(dataset_labels()) + + + observeEvent(cols_choices(), { + logger::log_debug("srv_t_reactable@1 update column choices") + shinyWidgets::updatePickerInput( + inputId = "columns", + choices = cols_choices(), + selected = cols_choices() + ) + }) + + # this is needed because picker input reacts to the selection while dropdown is open + # to avoid this we need to bypass input through reactiveVal + # https://forum.posit.co/t/only-update-pickerinput-on-close/173833 + cols_selected <- reactiveVal(isolate(cols_choices())) + observeEvent(input$columns_open, `if`(!isTruthy(input$columns_open), cols_selected(input$columns))) + + select_call <- reactive({ + req(cols_selected()) + substitute( + lhs <- rhs, + list( + lhs = str2lang(dataname), + rhs = as.call( + c( + list(name = str2lang("dplyr::select"), .data = str2lang(dataname)), + lapply(cols_selected(), str2lang) + ) + ) + ) + ) + }) reactable_call <- reactive({ + req(input$columns, data()) default_args <- list( - columns = .make_reactable_columns_call(data()[[dataname]]), + columns = .make_reactable_columns_call(data()[[dataname]][cols_selected()]), resizable = TRUE, onClick = "select", defaultPageSize = 10, @@ -157,20 +197,28 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, .. ") ) args <- modifyList(default_args, rlang::list2(...)) + substitute( lhs <- rhs, list( - lhs = dataname_reactable, - rhs = .make_reactable_call(dataname = dataname, args = args) + lhs = str2lang(dataname_reactable), + rhs = .make_reactable_call(dataname = dataname, args = args) ) ) }) + table_q <- reactive({ - req(data()) - eval_code(data(), reactable_call()) + req(reactable_call(), select_call()) + data() |> + eval_code(select_call()) |> + eval_code(reactable_call()) }) - output$table <- reactable::renderReactable(table_q()[[dataname_reactable]]) + output$table <- reactable::renderReactable({ + logger::log_debug("srv_t_reactable@2 render table for dataset { dataname }") + table_q()[[dataname_reactable]] + }) + table_selected_q <- reactive({ selected_row <- reactable::getReactableState("table", "selected") if (!is.null(selected_row)) { @@ -192,7 +240,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, .. } .make_reactable_call <- function(dataname, args) { - args <- c( + args <- modifyList( list( data = str2lang(dataname), defaultColDef = quote( @@ -214,15 +262,13 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, .. } else { value } - } + } ) - ) ), args ) - do.call(call, c(list(name = "reactable"), args), quote = TRUE) - + as.call(c(list(name = "reactable"), args)) } #' Makes `reactable::colDef` call containing: @@ -255,14 +301,14 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, decorators, .. ) if (length(args)) { - do.call(call, c(list(name = "colDef"), args), quote = TRUE) + as.call(c(list(name = "colDef"), args)) } } ) names(args) <- names(dataset) args <- Filter(length, args) if (length(args)) { - do.call(call, c(list("list"), args), quote = TRUE) + as.call(c(list("list"), args)) } } From cabb6952c65f3848acc47f79ae863ef1c9746bdb Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Wed, 12 Mar 2025 13:22:47 +0100 Subject: [PATCH 55/92] fix reactables reactivity --- R/tm_t_reactable.R | 127 ++++++++++++++++++++++----------------------- 1 file changed, 63 insertions(+), 64 deletions(-) diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 48184eb3f..1ffdc8c40 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -1,12 +1,18 @@ #' @export -tm_t_reactables <- function(label = "Table", datanames = "all", columns = list(), layout = "grid", transformators = list(), decorators = list(), ...) { +tm_t_reactables <- function(label = "Table", + datanames = "all", + columns = list(), + layout = "grid", + transformators = list(), + decorators = list(), + ...) { module( label = label, ui = ui_t_reactables, server = srv_t_reactables, ui_args = list(decorators = decorators), server_args = c( - list(datanames = datanames, columns = columns, layout = layout, decorators = decorators), + list(datanames = datanames, columns = columns, layout = layout, decorators = decorators), rlang::list2(...) ), datanames = datanames, @@ -25,18 +31,20 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, dec req(data()) names(Filter(is.data.frame, as.list(data()))) }) - - datanames_r <- reactive({ - req(all_datanames_r()) + + datanames_r <- reactiveVal() + observeEvent(all_datanames_r(), { df_datanames <- all_datanames_r() - if (identical(datanames, "all")) { + new_datanames <- if (identical(datanames, "all")) { df_datanames } else { intersect(datanames, df_datanames) } - }) |> - bindEvent(all_datanames_r()) - + if (!identical(new_datanames, datanames_r())) { + datanames_r(new_datanames) + } + }) + columns_r <- reactive({ req(datanames_r()) sapply(datanames_r(), function(dataname) { @@ -46,24 +54,22 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, dec colnames(isolate(data())[[dataname]]) } }) - }) |> - bindCache(datanames_r()) |> - bindEvent(datanames_r()) - + }) + datalabels_r <- reactive({ req(datanames_r()) sapply(datanames_r(), function(dataname) { datalabel <- attr(isolate(data())[[dataname]], "label") if (length(datalabel)) datalabel else dataname }) - }) |> - bindCache(datanames_r()) |> - bindEvent(datanames_r()) - + }) + # todo: re-render only if datanames changes output$subtables <- renderUI({ - if (length(datanames_r()) == 0) return(NULL) logger::log_debug("srv_t_reactables@1 render subtables") + if (length(datanames_r()) == 0) { + return(NULL) + } div( do.call( bslib::accordion, @@ -81,20 +87,18 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, dec ) ) ) - }) |> - bindCache(datanames_r()) |> - bindEvent(datanames_r()) - + }) + called_datanames <- reactiveVal() observeEvent(datanames_r(), { lapply( setdiff(datanames_r(), called_datanames()), # call module only once per dataname function(dataname) { srv_t_reactable( - dataname, - data = data, - dataname = dataname, - filter_panel_api = filter_panel_api, + dataname, + data = data, + dataname = dataname, + filter_panel_api = filter_panel_api, columns = columns[[dataname]], ... ) @@ -109,10 +113,10 @@ ui_t_reactable <- function(id) { ns <- NS(id) bslib::page_fluid( shinyWidgets::pickerInput( - ns("columns"), - label = "Select columns", - choices = NULL, - selected = NULL, + ns("columns"), + label = "Select columns", + choices = NULL, + selected = NULL, multiple = TRUE, width = "100%", options = shinyWidgets::pickerOptions( @@ -122,22 +126,23 @@ ui_t_reactable <- function(id) { liveSearch = TRUE ) ), - reactable::reactableOutput(ns("table")) + reactable::reactableOutput(ns("table")) ) - } srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decorators, ...) { moduleServer(id, function(input, output, session) { logger::log_debug("srv_t_reactable initializing for dataname: { dataname }") dataname_reactable <- sprintf("%s_reactable", dataname) - + dataset_labels <- reactive({ - req(data()) + req(data()) teal.data::col_labels(data()[[dataname]], fill = TRUE) }) - - cols_choices <- reactive({ + + cols_choices <- reactiveVal() + cols_selected <- reactiveVal() + observeEvent(dataset_labels(), { req(dataset_labels()) choices <- if (length(columns)) { columns @@ -145,33 +150,28 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor names(dataset_labels()) } labels_choices <- dataset_labels()[choices] - setNames(choices, labels_choices) - }) |> - bindCache(dataset_labels()) - - - observeEvent(cols_choices(), { - logger::log_debug("srv_t_reactable@1 update column choices") - shinyWidgets::updatePickerInput( - inputId = "columns", - choices = cols_choices(), - selected = cols_choices() - ) + cols_choices_new <- setNames(choices, labels_choices) + if (!identical(cols_choices_new, cols_choices())) { + logger::log_debug("srv_t_reactable@1 update column choices") + shinyWidgets::updatePickerInput( + inputId = "columns", + choices = cols_choices_new, + selected = cols_choices_new + ) + cols_choices(cols_choices_new) + cols_selected(cols_choices_new) + } }) - - # this is needed because picker input reacts to the selection while dropdown is open - # to avoid this we need to bypass input through reactiveVal - # https://forum.posit.co/t/only-update-pickerinput-on-close/173833 - cols_selected <- reactiveVal(isolate(cols_choices())) + observeEvent(input$columns_open, `if`(!isTruthy(input$columns_open), cols_selected(input$columns))) select_call <- reactive({ req(cols_selected()) substitute( - lhs <- rhs, + lhs <- rhs, list( lhs = str2lang(dataname), - rhs = as.call( + rhs = as.call( c( list(name = str2lang("dplyr::select"), .data = str2lang(dataname)), lapply(cols_selected(), str2lang) @@ -197,17 +197,16 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor ") ) args <- modifyList(default_args, rlang::list2(...)) - + substitute( lhs <- rhs, list( lhs = str2lang(dataname_reactable), - rhs = .make_reactable_call(dataname = dataname, args = args) + rhs = .make_reactable_call(dataname = dataname, args = args) ) ) - }) - + table_q <- reactive({ req(reactable_call(), select_call()) data() |> @@ -218,7 +217,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor logger::log_debug("srv_t_reactable@2 render table for dataset { dataname }") table_q()[[dataname_reactable]] }) - + table_selected_q <- reactive({ selected_row <- reactable::getReactableState("table", "selected") if (!is.null(selected_row)) { @@ -228,7 +227,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor dataname_selected = str2lang(sprintf("%s_selected", dataname)), dataname = str2lang(dataname), expr = { - dataname_selected <- dataname[selected_row, ] + dataname_selected <- dataname[selected_row, ] } ) } else { @@ -258,7 +257,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor htmltools::tags$a(href = value, target = "_blank", "Link") } else { "N/A" - } + } } else { value } @@ -281,7 +280,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor .make_reactable_columns_call <- function(dataset) { checkmate::assert_data_frame(dataset) args <- lapply( - seq_along(dataset), + seq_along(dataset), function(i) { column <- dataset[[i]] label <- attr(column, "label") @@ -308,7 +307,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor names(args) <- names(dataset) args <- Filter(length, args) if (length(args)) { - as.call(c(list("list"), args)) + as.call(c(list("list"), args)) } } From 29517c8586e9b1ad0a86cbcb6e2582dd14d603d3 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Wed, 12 Mar 2025 16:18:38 +0000 Subject: [PATCH 56/92] sort input swimlane --- R/tm_g_swimlane.R | 106 +++++++++++++++++++++++++++++++------------- R/tm_g_waterfall.R | 3 +- R/tm_swimlane_mdr.R | 8 ++++ R/tm_t_reactable.R | 50 ++++++++++++--------- 4 files changed, 112 insertions(+), 55 deletions(-) diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 28aa68b7c..58fe9535c 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -5,6 +5,8 @@ tm_g_swimlane <- function(label = "Swimlane", subject_var, value_var, event_var, + sort_var = NULL, + group_var = NULL, value_var_color = character(0), value_var_symbol, plot_height = 700) { @@ -20,6 +22,8 @@ tm_g_swimlane <- function(label = "Swimlane", subject_var = subject_var, value_var = value_var, event_var = event_var, + sort_var = sort_var, + group_var = group_var, value_var_color = value_var_color, value_var_symbol = value_var_symbol ) @@ -29,9 +33,9 @@ tm_g_swimlane <- function(label = "Swimlane", ui_g_swimlane <- function(id, height) { ns <- NS(id) bslib::page_fluid( - fluidRow( - column(6, uiOutput(ns("sort_by_output"))), - column(6, sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)) + bslib::layout_columns( + selectInput(ns("sort_by"), label = "Select variable:", choices = NULL, selected = NULL, multiple = FALSE), + sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), plotly::plotlyOutput(ns("plot"), height = "100%") ) @@ -43,12 +47,39 @@ srv_g_swimlane <- function(id, subject_var, value_var, event_var, + sort_var = time_var, + group_var = NULL, value_var_color, value_var_symbol, filter_panel_api) { moduleServer(id, function(input, output, session) { + + sort_choices <- reactiveVal() + sort_selected <- reactiveVal() + if (inherits(sort_var, c("choices_selected", "select_spec"))) { + if (length(sort_var$choices) == 1) { + sort_var <- sort_var$choices + } else { + updateSelectInput(inputId = "sort_by", choices = sort_var$choices, selected = sort_var$selected) + observeEvent(input$sort_by, { + if (!identical(input$sort_by, sort_selected())) { + sort_selected(input$sort_by) + } + }) + } + } + if (length(sort_var) == 1) { + isolate(sort_choices(sort_var)) + isolate(sort_selected(sort_var)) + shinyjs::hide("sort_by") + } + + + + + plotly_q <- reactive({ - req(data()) + req(data(), sort_selected()) adjusted_colors <- .color_palette_discrete( levels = unique(data()[[dataname]][[value_var]]), color = value_var_color @@ -67,6 +98,8 @@ srv_g_swimlane <- function(id, subject_var = str2lang(subject_var), value_var = str2lang(value_var), event_var = str2lang(event_var), + sort_var = str2lang(sort_selected()), + group_var = if (length(group_var)) group_var, subject_var_label = sprintf("%s:", subject_var_label), time_var_label = sprintf("%s:", time_var_label), colors = adjusted_colors, @@ -76,8 +109,39 @@ srv_g_swimlane <- function(id, time_axis_label = time_var_label, expr = { # todo: forcats::fct_reorder didn't work. - levels <- with(dataname, tapply(time_var, subject_var, max)) |> sort() - dataname <- dataname %>% + plotly_fun <- function(data) { + data %>% + plotly::plot_ly( + source = "swimlane", + colors = colors, + symbols = symbols, + height = height + ) %>% + plotly::add_markers( + x = ~time_var, + y = ~subject_var_ordered, + color = ~value_var, + symbol = ~value_var, + text = ~tooltip, + legendgroup = ~event_var, + hoverinfo = "text" + ) %>% + plotly::add_segments( + x = ~0, xend = ~study_day, + y = ~subject_var_ordered, yend = ~subject_var_ordered, + color = ~event_var, + data = data |> group_by(subject_var_ordered, event_var) |> summarise(study_day = max(time_var)), + line = list(width = 1, color = "grey"), + showlegend = FALSE + ) %>% + plotly::layout( + xaxis = list(title = time_axis_label), yaxis = list(title = subject_axis_label) + ) %>% + plotly::layout(dragmode = "select") %>% + plotly::config(displaylogo = FALSE) + } + levels <- with(dataname, tapply(sort_var, subject_var, max)) |> sort() + p <- dataname %>% mutate(subject_var_ordered = factor(subject_var, levels = names(levels))) %>% group_by(subject_var, time_var) %>% mutate( @@ -88,32 +152,10 @@ srv_g_swimlane <- function(id, sprintf("%s: %s", tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", event_var)), value_var) )), collapse = "
" - )) - - - p <- dataname %>% - plotly::plot_ly( - source = "swimlane", - colors = colors, - symbols = symbols, - height = height - ) %>% - plotly::add_markers( - x = ~time_var, y = ~subject_var_ordered, color = ~value_var, symbol = ~value_var, - text = ~tooltip, - hoverinfo = "text" - ) %>% - plotly::add_segments( - x = ~0, xend = ~study_day, y = ~subject_var_ordered, yend = ~subject_var_ordered, - data = dataname |> group_by(subject_var_ordered) |> summarise(study_day = max(time_var)), - line = list(width = 1, color = "grey"), - showlegend = FALSE - ) %>% - plotly::layout( - xaxis = list(title = time_axis_label), yaxis = list(title = subject_axis_label) - ) %>% - plotly::layout(dragmode = "select") |> - plotly::config(displaylogo = FALSE) + )) %>% + split(if (is.null(group_var)) "" else .[[group_var]]) %>% + lapply(plotly_fun) %>% + plotly::subplot(nrows = length(.), shareX = TRUE, titleX = FALSE) } ) }) diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index b17d54f17..9b21261a7 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -185,8 +185,7 @@ srv_g_waterfall <- function(id, srv_t_reactables( "subtables", data = tables_selected_q, - dataname = sprintf("%s_brushed", table_datanames), - layout = "accordion", + dataname = sprintf("%s_brushed", table_datanames), ... ) }) diff --git a/R/tm_swimlane_mdr.R b/R/tm_swimlane_mdr.R index d5125d99e..68557078e 100644 --- a/R/tm_swimlane_mdr.R +++ b/R/tm_swimlane_mdr.R @@ -5,6 +5,8 @@ tm_g_swimlane_mdr <- function(label = "Swimlane", subject_var, value_var, event_var, + sort_var = time_var, + group_var = NULL, listing_datanames = character(0), value_var_color = c( "DEATH" = "black", @@ -49,6 +51,8 @@ tm_g_swimlane_mdr <- function(label = "Swimlane", subject_var = subject_var, value_var = value_var, event_var = event_var, + sort_var = sort_var, + group_var = group_var, value_var_color = value_var_color, value_var_symbol = value_var_symbol, listing_datanames = listing_datanames, @@ -74,6 +78,8 @@ srv_g_swimlane_mdr <- function(id, subject_var, value_var, event_var, + sort_var, + group_var, value_var_color, value_var_symbol, listing_datanames, @@ -88,6 +94,8 @@ srv_g_swimlane_mdr <- function(id, subject_var = subject_var, value_var = value_var, event_var = event_var, + sort_var = sort_var, + group_var = group_var, value_var_color = value_var_color, value_var_symbol = value_var_symbol, filter_panel_api = filter_panel_api diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 1ffdc8c40..fe60de13d 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -2,7 +2,6 @@ tm_t_reactables <- function(label = "Table", datanames = "all", columns = list(), - layout = "grid", transformators = list(), decorators = list(), ...) { @@ -12,7 +11,7 @@ tm_t_reactables <- function(label = "Table", server = srv_t_reactables, ui_args = list(decorators = decorators), server_args = c( - list(datanames = datanames, columns = columns, layout = layout, decorators = decorators), + list(datanames = datanames, columns = columns, decorators = decorators), rlang::list2(...) ), datanames = datanames, @@ -20,12 +19,12 @@ tm_t_reactables <- function(label = "Table", ) } -ui_t_reactables <- function(id, decorators) { +ui_t_reactables <- function(id, decorators = list()) { ns <- NS(id) uiOutput(ns("subtables"), container = bslib::page_fluid) } -srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, decorators, layout = "grid", ...) { +srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns = list(), decorators = list(), ...) { moduleServer(id, function(input, output, session) { all_datanames_r <- reactive({ req(data()) @@ -111,21 +110,26 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns, dec ui_t_reactable <- function(id) { ns <- NS(id) + + input <- shinyWidgets::pickerInput( + ns("columns"), + label = NULL, + choices = NULL, + selected = NULL, + multiple = TRUE, + width = "100%", + options = shinyWidgets::pickerOptions( + actionsBox = TRUE, + `show-subtext` = TRUE, + countSelectedText = TRUE, + liveSearch = TRUE + ) + ) + + # input <- actionButton(ns("show_select_columns"), "Nothing selected", class = "rounded-pill btn-sm primary") |> + # bslib::popover(input) bslib::page_fluid( - shinyWidgets::pickerInput( - ns("columns"), - label = "Select columns", - choices = NULL, - selected = NULL, - multiple = TRUE, - width = "100%", - options = shinyWidgets::pickerOptions( - actionsBox = TRUE, - `show-subtext` = TRUE, - countSelectedText = TRUE, - liveSearch = TRUE - ) - ), + input, reactable::reactableOutput(ns("table")) ) } @@ -162,8 +166,13 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor cols_selected(cols_choices_new) } }) - observeEvent(input$columns_open, `if`(!isTruthy(input$columns_open), cols_selected(input$columns))) + observeEvent(cols_selected(), { + updateActionButton( + inputId = "show_select_columns", + label = paste(substring(toString(cols_selected()), 1, 100), "...") + ) + }) select_call <- reactive({ req(cols_selected()) @@ -181,13 +190,12 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor ) }) reactable_call <- reactive({ - req(input$columns, data()) + req(cols_selected(), data()) default_args <- list( columns = .make_reactable_columns_call(data()[[dataname]][cols_selected()]), resizable = TRUE, onClick = "select", defaultPageSize = 10, - wrap = FALSE, rowClass = JS(" function(rowInfo) { if (rowInfo.selected) { From 246bfb2e501196f2d8694fa3e93413566d6c991a Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Wed, 12 Mar 2025 16:23:52 +0000 Subject: [PATCH 57/92] v3 --- R/tm_g_swimlane.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 58fe9535c..61fd7324f 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -34,7 +34,7 @@ ui_g_swimlane <- function(id, height) { ns <- NS(id) bslib::page_fluid( bslib::layout_columns( - selectInput(ns("sort_by"), label = "Select variable:", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("sort_by"), label = "Sort by:", choices = NULL, selected = NULL, multiple = FALSE), sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), plotly::plotlyOutput(ns("plot"), height = "100%") From 9d51de31bef33593944e38cd7f9dbab68a822f7a Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Thu, 13 Mar 2025 15:36:21 +0000 Subject: [PATCH 58/92] v4 --- R/tm_g_swimlane.R | 47 +++++++++++-------- R/tm_g_waterfall.R | 113 ++++++++++++++++++++++++++++----------------- R/tm_t_reactable.R | 89 +++++++++++++++++++++-------------- 3 files changed, 154 insertions(+), 95 deletions(-) diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 61fd7324f..41f93b17c 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -140,9 +140,16 @@ srv_g_swimlane <- function(id, plotly::layout(dragmode = "select") %>% plotly::config(displaylogo = FALSE) } - levels <- with(dataname, tapply(sort_var, subject_var, max)) |> sort() + + levels <- dataname %>% + group_by(subject_var, group_var) %>% + summarize(v = max(sort_var)) %>% + ungroup() %>% + arrange(group_var, v) %>% + pull(subject_var) + p <- dataname %>% - mutate(subject_var_ordered = factor(subject_var, levels = names(levels))) %>% + mutate(subject_var_ordered = factor(subject_var, levels = levels)) %>% group_by(subject_var, time_var) %>% mutate( tooltip = paste( @@ -153,9 +160,7 @@ srv_g_swimlane <- function(id, )), collapse = "
" )) %>% - split(if (is.null(group_var)) "" else .[[group_var]]) %>% - lapply(plotly_fun) %>% - plotly::subplot(nrows = length(.), shareX = TRUE, titleX = FALSE) + plotly_fun() } ) }) @@ -173,19 +178,25 @@ srv_g_swimlane <- function(id, reactive({ req(plotly_selected()) - within( - plotly_q(), - dataname = str2lang(dataname), - time_var = str2lang(time_var), - subject_var = subject_var, - value_var = str2lang(value_var), - time_vals = plotly_selected()$x, - subject_vals = plotly_selected()$y, - expr = { - plotly_brushed_time <- time_vals - plotly_brushed_subject <- subject_vals - } - ) + primary_key_cols <- join_keys(plotly_q())[dataname, dataname] + if (length(primary_key_cols)) { + within( + plotly_q(), + dataname = str2lang(dataname), + time_var = str2lang(time_var), + subject_var = subject_var, + value_var = str2lang(value_var), + time_vals = plotly_selected()$x, + subject_vals = plotly_selected()$y, + primary_key_cols = primary_key_cols, + expr = { + plotly_selected_keys <- dplyr::filter(time_var %in% time_vals, subject_var %in% subject_vals) %>% + dplyr::select(primary_key_cols) + plotly_brushed_time <- time_vals + plotly_brushed_subject <- subject_vals + } + ) + } }) }) } diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 9b21261a7..e8b014f4a 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -1,14 +1,14 @@ #' @export tm_g_waterfall <- function(label = "Waterfall", plot_dataname, - table_datanames, subject_var, value_var, color_var = NULL, bar_colors = list(), value_arbitrary_hlines = c(0.2, -0.3), plot_title = "Waterfall plot", - plot_height = 700, + plot_height = 700, + table_datanames, ...) { module( label = label, @@ -46,15 +46,15 @@ ui_g_waterfall <- function(id, height) { srv_g_waterfall <- function(id, data, plot_dataname, - table_datanames, subject_var, value_var, color_var, bar_colors, - filter_panel_api, value_arbitrary_hlines, plot_title, plot_height = 600, + table_datanames = character(0), + filter_panel_api, ...) { moduleServer(id, function(input, output, session) { output$color_by_output <- renderUI({ @@ -96,16 +96,16 @@ srv_g_waterfall <- function(id, title = paste0(value_var_label, " (Waterfall plot)"), height = input$plot_height, expr = { - p <- dataname |> + p <- dataname %>% dplyr::mutate( subject_var_ordered = forcats::fct_reorder(as.factor(subject_var), value_var, .fun = max, .desc = TRUE) - ) |> - dplyr::filter(!duplicated(subject_var)) |> + ) %>% + dplyr::filter(!duplicated(subject_var)) %>% # todo: one value for x, y: distinct or summarize(value = foo(value_var)) [foo: summarize_fun] plotly::plot_ly( source = "waterfall", height = height - ) |> + ) %>% plotly::add_bars( x = ~subject_var_ordered, y = ~value_var, @@ -116,7 +116,7 @@ srv_g_waterfall <- function(id, value_var_label, ":", value_var, "
" ), hoverinfo = "text" - ) |> + ) %>% plotly::layout( shapes = lapply(value_arbitrary_hlines, function(y) { list( @@ -133,9 +133,9 @@ srv_g_waterfall <- function(id, xaxis = list(title = subject_var_label, tickangle = -45), yaxis = list(title = value_var_label), legend = list(title = list(text = "Color by:")), - barmode = "relative", - dragmode = "select" - ) |> + barmode = "relative" + ) %>% + plotly::layout( dragmode = "select") %>% plotly::config(displaylogo = FALSE) }, height = input$plot_height @@ -145,48 +145,77 @@ srv_g_waterfall <- function(id, output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "waterfall")) + plotly_selected_q <- reactive({ req(plotly_selected()) + primary_keys <- unname(join_keys(data())[plot_dataname, plot_dataname]) + req(primary_keys) within( plotly_q(), - subject_vals = plotly_selected()$x, - value_vals = plotly_selected()$y, expr = { - # todo: this should use the join keys instead. Probably need to filter visualization data.frame and use its column - plotly_brushed_subjects <- subject_vals - plotly_brushed_value <- value_vals - } + waterfall_selected <- dplyr::filter(dataname, xvar %in% xvals, yvar %in% yvals) %>% + dplyr::select(primary_keys) + }, + dataname = str2lang(plot_dataname), + xvar = str2lang(subject_var), + yvar = str2lang(value_var), + xvals = plotly_selected()$x, + yvals = plotly_selected()$y, + primary_keys = primary_keys ) }) - - tables_selected_q <- reactive({ - req(plotly_selected_q()) - teal.code::eval_code( - plotly_selected_q(), - code = as.expression( - lapply( - table_datanames, - function(dataname) { - substitute( - expr = dataname_brushed <- dplyr::filter(dataname, subject_var %in% plotly_brushed_subjects), - env = list( - dataname_brushed = str2lang(sprintf("%s_brushed", dataname)), - dataname = str2lang(dataname), - subject_var = str2lang(subject_var) - ) + + children_names <- reactive({ + if (length(table_datanames) == 0) { + children(plotly_selected_q(), plot_dataname) + } else { + table_datanames + } + }) + + tables_selected_q <- eventReactive(plotly_selected_q(), { + exprs <- as.expression( + lapply( + children_names(), + function(childname) { + join_cols <- join_keys(plotly_selected_q())[childname, plot_dataname] + substitute( + expr = { + childname <- dplyr::right_join(childname, waterfall_selected, by = by) + }, + list( + childname = str2lang(childname), + by = join_cols ) - } - ) + ) + } ) ) + eval_code(plotly_selected_q(), exprs) }) output$tables <- renderUI(ui_t_reactables(session$ns("subtables"))) - srv_t_reactables( - "subtables", - data = tables_selected_q, - dataname = sprintf("%s_brushed", table_datanames), - ... - ) + srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, ...) }) } + +# todo: to teal_data +children <- function(x, dataset_name = character(0)) { + checkmate::assert_multi_class(x, c("teal_data", "join_keys")) + checkmate::assert_character(dataset_name, max.len = 1) + if (length(dataset_name)) { + names( + Filter( + function(parent) parent == dataset_name, + parents(x) + ) + ) + } else { + all_parents <- unique(unlist(parents(x))) + names(all_parents) <- all_parents + lapply( + all_parents, + function(parent) children(x = x, dataset_name = parent) + ) + } +} diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index fe60de13d..a8f8e9afc 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -1,7 +1,7 @@ #' @export tm_t_reactables <- function(label = "Table", datanames = "all", - columns = list(), + colnames = list(), transformators = list(), decorators = list(), ...) { @@ -11,7 +11,7 @@ tm_t_reactables <- function(label = "Table", server = srv_t_reactables, ui_args = list(decorators = decorators), server_args = c( - list(datanames = datanames, columns = columns, decorators = decorators), + list(datanames = datanames, colnames = colnames, decorators = decorators), rlang::list2(...) ), datanames = datanames, @@ -24,31 +24,15 @@ ui_t_reactables <- function(id, decorators = list()) { uiOutput(ns("subtables"), container = bslib::page_fluid) } -srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns = list(), decorators = list(), ...) { +srv_t_reactables <- function(id, data, filter_panel_api, datanames, colnames = list(), decorators = list(), ...) { moduleServer(id, function(input, output, session) { - all_datanames_r <- reactive({ - req(data()) - names(Filter(is.data.frame, as.list(data()))) - }) - - datanames_r <- reactiveVal() - observeEvent(all_datanames_r(), { - df_datanames <- all_datanames_r() - new_datanames <- if (identical(datanames, "all")) { - df_datanames - } else { - intersect(datanames, df_datanames) - } - if (!identical(new_datanames, datanames_r())) { - datanames_r(new_datanames) - } - }) - - columns_r <- reactive({ + # todo: this to the function .validate_datanames + datanames_r <- .validate_datanames(datanames = datanames, data = data) + colnames_r <- reactive({ req(datanames_r()) sapply(datanames_r(), function(dataname) { - if (length(columns[[dataname]])) { - columns()[[dataname]] + if (length(colnames[[dataname]])) { + colnames()[[dataname]] } else { colnames(isolate(data())[[dataname]]) } @@ -98,7 +82,7 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, columns = li data = data, dataname = dataname, filter_panel_api = filter_panel_api, - columns = columns[[dataname]], + colnames = colnames[[dataname]], ... ) } @@ -112,7 +96,7 @@ ui_t_reactable <- function(id) { ns <- NS(id) input <- shinyWidgets::pickerInput( - ns("columns"), + ns("colnames"), label = NULL, choices = NULL, selected = NULL, @@ -126,7 +110,7 @@ ui_t_reactable <- function(id) { ) ) - # input <- actionButton(ns("show_select_columns"), "Nothing selected", class = "rounded-pill btn-sm primary") |> + # input <- actionButton(ns("show_select_colnames"), "Nothing selected", class = "rounded-pill btn-sm primary") |> # bslib::popover(input) bslib::page_fluid( input, @@ -134,7 +118,7 @@ ui_t_reactable <- function(id) { ) } -srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decorators, ...) { +srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, decorators, ...) { moduleServer(id, function(input, output, session) { logger::log_debug("srv_t_reactable initializing for dataname: { dataname }") dataname_reactable <- sprintf("%s_reactable", dataname) @@ -148,8 +132,8 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor cols_selected <- reactiveVal() observeEvent(dataset_labels(), { req(dataset_labels()) - choices <- if (length(columns)) { - columns + choices <- if (length(colnames)) { + colnames } else { names(dataset_labels()) } @@ -158,7 +142,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor if (!identical(cols_choices_new, cols_choices())) { logger::log_debug("srv_t_reactable@1 update column choices") shinyWidgets::updatePickerInput( - inputId = "columns", + inputId = "colnames", choices = cols_choices_new, selected = cols_choices_new ) @@ -166,10 +150,10 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor cols_selected(cols_choices_new) } }) - observeEvent(input$columns_open, `if`(!isTruthy(input$columns_open), cols_selected(input$columns))) + observeEvent(input$colnames_open, `if`(!isTruthy(input$colnames_open), cols_selected(input$colnames))) observeEvent(cols_selected(), { updateActionButton( - inputId = "show_select_columns", + inputId = "show_select_colnames", label = paste(substring(toString(cols_selected()), 1, 100), "...") ) }) @@ -192,7 +176,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor reactable_call <- reactive({ req(cols_selected(), data()) default_args <- list( - columns = .make_reactable_columns_call(data()[[dataname]][cols_selected()]), + #columns = .make_reactable_columns_call(data()[[dataname]][cols_selected()]), resizable = TRUE, onClick = "select", defaultPageSize = 10, @@ -217,6 +201,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor table_q <- reactive({ req(reactable_call(), select_call()) + print(reactable_call()) data() |> eval_code(select_call()) |> eval_code(reactable_call()) @@ -275,7 +260,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor ), args ) - as.call(c(list(name = "reactable"), args)) + as.call(c(list(name = quote(reactable)), args)) } #' Makes `reactable::colDef` call containing: @@ -322,3 +307,37 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, columns, decor .name_to_id <- function(name) { gsub("[[:space:][:punct:]]+", "_", x = tolower(name)) } + +.validate_datanames <- function(datanames, data, class = "data.frame") { + all_datanames_r <- reactive({ + req(data()) + names( + Filter( + function(dataset) inherits(dataset, class), + as.list(data()) + ) + ) + }) + + this_datanames_r <- reactive({ + if (is.reactive(datanames)) { + datanames() + } else { + datanames + } + }) + + datanames_r <- reactiveVal() + + observeEvent(all_datanames_r(), { + new_datanames <- if (identical(this_datanames_r(), "all")) { + all_datanames_r() + } else { + intersect(this_datanames_r(), all_datanames_r()) + } + if (!identical(new_datanames, datanames_r())) { + datanames_r(new_datanames) + } + }) + datanames_r +} From b1e4f60dded368850eb1efd4bd75244d52314ed6 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Thu, 13 Mar 2025 15:43:09 +0000 Subject: [PATCH 59/92] wip --- R/tm_t_reactable.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index a8f8e9afc..f545b534b 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -201,7 +201,6 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco table_q <- reactive({ req(reactable_call(), select_call()) - print(reactable_call()) data() |> eval_code(select_call()) |> eval_code(reactable_call()) From 9c37a22d7621442749fba15530c2f434b0030a39 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Fri, 14 Mar 2025 10:45:46 +0000 Subject: [PATCH 60/92] freeze column --- R/tm_t_reactable.R | 129 ++++++++++++++++++++++----------------------- 1 file changed, 63 insertions(+), 66 deletions(-) diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index f545b534b..2e6b0b43f 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -158,52 +158,30 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco ) }) - select_call <- reactive({ + + table_q <- reactive({ req(cols_selected()) - substitute( - lhs <- rhs, - list( + data() |> + within( # select call + lhs <- rhs, lhs = str2lang(dataname), rhs = as.call( c( list(name = str2lang("dplyr::select"), .data = str2lang(dataname)), - lapply(cols_selected(), str2lang) + lapply(unname(cols_selected()), str2lang) ) ) - ) - ) - }) - reactable_call <- reactive({ - req(cols_selected(), data()) - default_args <- list( - #columns = .make_reactable_columns_call(data()[[dataname]][cols_selected()]), - resizable = TRUE, - onClick = "select", - defaultPageSize = 10, - rowClass = JS(" - function(rowInfo) { - if (rowInfo.selected) { - return 'selected-row'; - } - } - ") - ) - args <- modifyList(default_args, rlang::list2(...)) - - substitute( - lhs <- rhs, - list( + ) |> + within( # reactable call + lhs <- rhs, lhs = str2lang(dataname_reactable), - rhs = .make_reactable_call(dataname = dataname, args = args) + rhs = .make_reactable_call( + dataset = data()[[dataname]][cols_selected()], + dataname = dataname, + args = rlang::list2(...) + ) ) - ) - }) - - table_q <- reactive({ - req(reactable_call(), select_call()) - data() |> - eval_code(select_call()) |> - eval_code(reactable_call()) + }) output$table <- reactable::renderReactable({ logger::log_debug("srv_t_reactable@2 render table for dataset { dataname }") @@ -230,36 +208,58 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco }) } -.make_reactable_call <- function(dataname, args) { - args <- modifyList( - list( - data = str2lang(dataname), - defaultColDef = quote( - colDef( - cell = function(value) { - is_url <- is.character(value) && any( - grepl( - "https?:\\/\\/(www\\.)?[-a-zA-Z0-9@:%._\\+~#=]{1,256}\\.[a-zA-Z0-9()]{1,6}\\b([-a-zA-Z0-9()@:%_\\+.~#?&//=]*)", - x = head(value), - perl = TRUE - ) +.make_reactable_call <- function(dataset, dataname, args) { + columns <- .make_reactable_columns_call(dataset) + if (length(args$columns)) { + columns <- modifyList(columns, args$columns) + args <- args[!names(args) %in% "columns"] + } + + default_args <- list( + columns = columns, + resizable = TRUE, + onClick = "select", + defaultPageSize = 10, + rowClass = JS({" + function(rowInfo) { + if (rowInfo.selected) { + return 'selected-row'; + } + } + "}), + defaultColDef = quote( + colDef( + cell = function(value) { + is_url <- is.character(value) && any( + grepl( + "https?:\\/\\/(www\\.)?[-a-zA-Z0-9@:%._\\+~#=]{1,256}\\.[a-zA-Z0-9()]{1,6}\\b([-a-zA-Z0-9()@:%_\\+.~#?&//=]*)", + x = head(value), + perl = TRUE ) - if (is_url) { - if (!is.na(value) && !is.null(value) && value != "") { - htmltools::tags$a(href = value, target = "_blank", "Link") - } else { - "N/A" - } + ) + if (is_url) { + if (!is.na(value) && !is.null(value) && value != "") { + htmltools::tags$a(href = value, target = "_blank", "Link") } else { - value + "N/A" } + } else { + value } - ) + } ) - ), - args + ) + ) + + as.call( + c( + list( + name = quote(reactable), + data = str2lang(dataname) + ), + modifyList(default_args, args) + ) ) - as.call(c(list(name = quote(reactable)), args)) } #' Makes `reactable::colDef` call containing: @@ -292,15 +292,12 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco ) if (length(args)) { - as.call(c(list(name = "colDef"), args)) + as.call(c(list(name = quote(colDef)), args)) } } ) names(args) <- names(dataset) - args <- Filter(length, args) - if (length(args)) { - as.call(c(list("list"), args)) - } + Filter(length, args) } .name_to_id <- function(name) { From cf14bcfd909ba5debece336b7809556e38ee55ab Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Mon, 17 Mar 2025 13:52:21 +0000 Subject: [PATCH 61/92] wip v5 --- R/tm_g_swimlane.R | 105 +++++++++++++++++++++++++++++-------------- R/tm_t_reactable.R | 109 +++++++++++++-------------------------------- 2 files changed, 103 insertions(+), 111 deletions(-) diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 41f93b17c..0c34581d6 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -1,6 +1,6 @@ #' @export tm_g_swimlane <- function(label = "Swimlane", - dataname, + plot_dataname, time_var, subject_var, value_var, @@ -9,15 +9,17 @@ tm_g_swimlane <- function(label = "Swimlane", group_var = NULL, value_var_color = character(0), value_var_symbol, - plot_height = 700) { + plot_height = 700, + table_datanames, + ...) { module( label = label, ui = ui_g_swimlane, server = srv_g_swimlane, - datanames = "all", + datanames = c(plot_dataname, table_datanames), ui_args = list(height = plot_height), server_args = list( - dataname = dataname, + plot_dataname = plot_dataname, time_var = time_var, subject_var = subject_var, value_var = value_var, @@ -25,24 +27,29 @@ tm_g_swimlane <- function(label = "Swimlane", sort_var = sort_var, group_var = group_var, value_var_color = value_var_color, - value_var_symbol = value_var_symbol + value_var_symbol = value_var_symbol, + table_datanames = table_datanames, + ... ) ) } ui_g_swimlane <- function(id, height) { + + ns <- NS(id) bslib::page_fluid( bslib::layout_columns( selectInput(ns("sort_by"), label = "Sort by:", choices = NULL, selected = NULL, multiple = FALSE), sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), - plotly::plotlyOutput(ns("plot"), height = "100%") + plotly::plotlyOutput(ns("plot"), height = "100%"), + uiOutput(ns("tables")) ) } srv_g_swimlane <- function(id, data, - dataname, + plot_dataname, time_var, subject_var, value_var, @@ -51,7 +58,9 @@ srv_g_swimlane <- function(id, group_var = NULL, value_var_color, value_var_symbol, - filter_panel_api) { + table_datanames, + filter_panel_api, + ...) { moduleServer(id, function(input, output, session) { sort_choices <- reactiveVal() @@ -81,19 +90,19 @@ srv_g_swimlane <- function(id, plotly_q <- reactive({ req(data(), sort_selected()) adjusted_colors <- .color_palette_discrete( - levels = unique(data()[[dataname]][[value_var]]), + levels = unique(data()[[plot_dataname]][[value_var]]), color = value_var_color ) adjusted_symbols <- .shape_palette_discrete( - levels = unique(data()[[dataname]][[value_var]]), + levels = unique(data()[[plot_dataname]][[value_var]]), symbol = value_var_symbol ) - subject_var_label <- c(attr(data()[[dataname]][[subject_var]], "label"), "Subject")[1] - time_var_label <- c(attr(data()[[dataname]][[time_var]], "label"), "Study Day")[1] + subject_var_label <- c(attr(data()[[plot_dataname]][[subject_var]], "label"), "Subject")[1] + time_var_label <- c(attr(data()[[plot_dataname]][[time_var]], "label"), "Study Day")[1] data() |> within( - dataname = str2lang(dataname), - dataname_filtered = str2lang(sprintf("%s_filtered", dataname)), + dataname = str2lang(plot_dataname), + dataname_filtered = str2lang(sprintf("%s_filtered", plot_dataname)), time_var = str2lang(time_var), subject_var = str2lang(subject_var), value_var = str2lang(value_var), @@ -176,28 +185,58 @@ srv_g_swimlane <- function(id, plotly::event_data("plotly_selected", source = "swimlane") }) - reactive({ + plotly_selected_q <- reactive({ req(plotly_selected()) - primary_key_cols <- join_keys(plotly_q())[dataname, dataname] - if (length(primary_key_cols)) { - within( - plotly_q(), - dataname = str2lang(dataname), - time_var = str2lang(time_var), - subject_var = subject_var, - value_var = str2lang(value_var), - time_vals = plotly_selected()$x, - subject_vals = plotly_selected()$y, - primary_key_cols = primary_key_cols, - expr = { - plotly_selected_keys <- dplyr::filter(time_var %in% time_vals, subject_var %in% subject_vals) %>% - dplyr::select(primary_key_cols) - plotly_brushed_time <- time_vals - plotly_brushed_subject <- subject_vals - } - ) + primary_keys <- unname(join_keys(data())[plot_dataname, plot_dataname]) + req(primary_keys) + within( + plotly_q(), + expr = { + swimlane_selected <- dplyr::filter(dataname, xvar %in% xvals, yvar %in% yvals) %>% + dplyr::select(primary_keys) + }, + dataname = str2lang(plot_dataname), + xvar = str2lang(time_var), + yvar = str2lang(subject_var), + xvals = plotly_selected()$x, + yvals = plotly_selected()$y, + primary_keys = primary_keys + ) + }) + + children_names <- reactive({ + if (length(table_datanames) == 0) { + children(plotly_selected_q(), plot_dataname) + } else { + table_datanames } }) + + tables_selected_q <- eventReactive(plotly_selected_q(), { + exprs <- as.expression( + lapply( + children_names(), + function(childname) { + join_cols <- join_keys(plotly_selected_q())[childname, plot_dataname] + substitute( + expr = { + childname <- dplyr::right_join(childname, swimlane_selected, by = by) + }, + list( + childname = str2lang(childname), + by = join_cols + ) + ) + } + ) + ) + eval_code(plotly_selected_q(), exprs) + }) + + output$tables <- renderUI(ui_t_reactables(session$ns("subtables"))) + srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, ...) + + }) } diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 2e6b0b43f..2e70236eb 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -161,26 +161,22 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco table_q <- reactive({ req(cols_selected()) - data() |> - within( # select call - lhs <- rhs, - lhs = str2lang(dataname), - rhs = as.call( - c( - list(name = str2lang("dplyr::select"), .data = str2lang(dataname)), - lapply(unname(cols_selected()), str2lang) - ) - ) - ) |> - within( # reactable call - lhs <- rhs, - lhs = str2lang(dataname_reactable), - rhs = .make_reactable_call( - dataset = data()[[dataname]][cols_selected()], - dataname = dataname, - args = rlang::list2(...) - ) + select_call <- as.call( + c( + list(name = str2lang("dplyr::select"), .data = str2lang(dataname)), + lapply(unname(cols_selected()), str2lang) ) + ) + + reactable_call <- .make_reactable_call( + dataset = data()[[dataname]][cols_selected()], + dataname = dataname, + args = rlang::list2(...) + ) + + data() |> + within(lhs <- rhs, lhs = str2lang(dataname), rhs = select_call) |> + within(lhs <- rhs, lhs = str2lang(dataname_reactable), rhs = reactable_call) }) output$table <- reactable::renderReactable({ @@ -209,55 +205,18 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco } .make_reactable_call <- function(dataset, dataname, args) { - columns <- .make_reactable_columns_call(dataset) - if (length(args$columns)) { - columns <- modifyList(columns, args$columns) - args <- args[!names(args) %in% "columns"] - } - - default_args <- list( - columns = columns, - resizable = TRUE, - onClick = "select", - defaultPageSize = 10, - rowClass = JS({" - function(rowInfo) { - if (rowInfo.selected) { - return 'selected-row'; - } - } - "}), - defaultColDef = quote( - colDef( - cell = function(value) { - is_url <- is.character(value) && any( - grepl( - "https?:\\/\\/(www\\.)?[-a-zA-Z0-9@:%._\\+~#=]{1,256}\\.[a-zA-Z0-9()]{1,6}\\b([-a-zA-Z0-9()@:%_\\+.~#?&//=]*)", - x = head(value), - perl = TRUE - ) - ) - if (is_url) { - if (!is.na(value) && !is.null(value) && value != "") { - htmltools::tags$a(href = value, target = "_blank", "Link") - } else { - "N/A" - } - } else { - value - } - } - ) - ) + columns <- .make_reactable_columns_call(dataset = dataset, col_defs = args$columns) + call_args <- modifyList( + list(columns = columns, onClick = "select"), + args[!names(args) %in% "columns"] ) - as.call( c( list( name = quote(reactable), data = str2lang(dataname) ), - modifyList(default_args, args) + call_args ) ) } @@ -269,30 +228,24 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco #' @param dataset (`data.frame`) #' @return named list of `colDef` calls #' @keywords internal -.make_reactable_columns_call <- function(dataset) { +.make_reactable_columns_call <- function(dataset, col_defs) { checkmate::assert_data_frame(dataset) args <- lapply( - seq_along(dataset), + colnames(dataset), function(i) { column <- dataset[[i]] label <- attr(column, "label") is_labelled <- length(label) == 1 && !is.na(label) && !identical(label, "") - is_url <- is.character(column) && any( - grepl( - "https?:\\/\\/(www\\.)?[-a-zA-Z0-9@:%._\\+~#=]{1,256}\\.[a-zA-Z0-9()]{1,6}\\b([-a-zA-Z0-9()@:%_\\+.~#?&//=]*)", - x = head(column), - perl = TRUE + default_col_def <- if (is_labelled) list(name = label) else list() + col_def_override <- if (!is.null(col_defs[[i]])) col_defs[[i]] else list() + col_def_args <- modifyList(default_col_def, col_def_override) + if (length(col_def_args)) { + as.call( + c( + list(quote(colDef)), + col_def_args + ) ) - ) - # todo: move url formatter to the defaultColDef - width <- max(nchar(head(as.character(column), 100))) * 9 - args <- c( - if (!is.na(width) && width > 100 && !is_url) list(width = width), - if (is_labelled) list(name = label) - ) - - if (length(args)) { - as.call(c(list(name = quote(colDef)), args)) } } ) From bf0cbaddd5629080a7d2f6e575000b027691867b Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Mon, 17 Mar 2025 15:24:36 +0000 Subject: [PATCH 62/92] wip v5 --- R/tm_g_swimlane.R | 23 +++++++++++------------ R/tm_g_waterfall.R | 5 ++--- 2 files changed, 13 insertions(+), 15 deletions(-) diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 0c34581d6..de6747c4e 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -44,7 +44,7 @@ ui_g_swimlane <- function(id, height) { sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), plotly::plotlyOutput(ns("plot"), height = "100%"), - uiOutput(ns("tables")) + ui_t_reactables(ns("subtables")) ) } srv_g_swimlane <- function(id, @@ -82,10 +82,7 @@ srv_g_swimlane <- function(id, isolate(sort_selected(sort_var)) shinyjs::hide("sort_by") } - - - - + plotly_q <- reactive({ req(data(), sort_selected()) @@ -162,13 +159,16 @@ srv_g_swimlane <- function(id, group_by(subject_var, time_var) %>% mutate( tooltip = paste( - unique(c( - paste(subject_var_label, subject_var), - paste(time_var_label, time_var), - sprintf("%s: %s", tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", event_var)), value_var) - )), + unique( + c( + paste(subject_var_label, subject_var), + paste(time_var_label, time_var), + sprintf("%s: %s", tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", event_var)), value_var) + ) + ), collapse = "
" - )) %>% + ) + ) %>% plotly_fun() } ) @@ -233,7 +233,6 @@ srv_g_swimlane <- function(id, eval_code(plotly_selected_q(), exprs) }) - output$tables <- renderUI(ui_t_reactables(session$ns("subtables"))) srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, ...) diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index e8b014f4a..ec29003cd 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -40,7 +40,7 @@ ui_g_waterfall <- function(id, height) { column(6, sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)) ), plotly::plotlyOutput(ns("plot"), height = "100%"), - uiOutput(ns("tables")) + ui_t_reactables(ns("subtables")) ) } srv_g_waterfall <- function(id, @@ -193,8 +193,7 @@ srv_g_waterfall <- function(id, ) eval_code(plotly_selected_q(), exprs) }) - - output$tables <- renderUI(ui_t_reactables(session$ns("subtables"))) + srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, ...) }) } From e9ac8241d71fc5d4b9149ea318b02b43d710b5a1 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Mon, 17 Mar 2025 15:39:12 +0000 Subject: [PATCH 63/92] wip v5 --- R/tm_g_swimlane.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index de6747c4e..530028e57 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -234,7 +234,6 @@ srv_g_swimlane <- function(id, }) srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, ...) - }) } From 165d891f872c212380b8a357827714519942484d Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Tue, 18 Mar 2025 07:17:12 +0000 Subject: [PATCH 64/92] wip v5 --- R/tm_g_waterfall.R | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index ec29003cd..ebd02f243 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -81,7 +81,13 @@ srv_g_waterfall <- function(id, attr(data()[[plot_dataname]][[value_var]], "label"), value_var )[1] - + + color_var_label <- c( + attr(data()[[plot_dataname]][[input$color_by]], "label"), + input$color_by + )[1] + + data() |> within( dataname = str2lang(plot_dataname), @@ -93,13 +99,21 @@ srv_g_waterfall <- function(id, value_arbitrary_hlines = value_arbitrary_hlines, subject_var_label = subject_var_label, value_var_label = value_var_label, + color_var_label = color_var_label, title = paste0(value_var_label, " (Waterfall plot)"), height = input$plot_height, expr = { p <- dataname %>% dplyr::mutate( - subject_var_ordered = forcats::fct_reorder(as.factor(subject_var), value_var, .fun = max, .desc = TRUE) + subject_var_ordered = forcats::fct_reorder(as.factor(subject_var), value_var, .fun = max, .desc = TRUE), + tooltip = sprintf( + "%s: %s
%s: %s%%
%s: %s", + subject_var_label, subject_var, + value_var_label, value_var, + color_var_label, color_var + ) ) %>% + dplyr::filter(!duplicated(subject_var)) %>% # todo: one value for x, y: distinct or summarize(value = foo(value_var)) [foo: summarize_fun] plotly::plot_ly( @@ -111,10 +125,7 @@ srv_g_waterfall <- function(id, y = ~value_var, color = ~color_var, colors = colors, - text = ~ paste( - subject_var_label, ":", subject_var, - value_var_label, ":", value_var, "
" - ), + text = ~ tooltip, hoverinfo = "text" ) %>% plotly::layout( From 607105a15cb9e904f6f17a3abf7395ab2ce11b68 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Tue, 18 Mar 2025 13:43:23 +0000 Subject: [PATCH 65/92] spiderplot lines blue --- R/tm_g_spiderplot.R | 96 +++++++++++++++++++++++++-------- R/tm_g_swimlane.R | 7 +-- R/tm_g_waterfall.R | 2 +- R/tm_swimlane_mdr.R | 127 -------------------------------------------- 4 files changed, 79 insertions(+), 153 deletions(-) delete mode 100644 R/tm_swimlane_mdr.R diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 082cb8213..c3ad97faf 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -1,10 +1,16 @@ #' @export tm_g_spiderplot <- function(label = "Spiderplot", + plot_dataname, time_var, subject_var, value_var, event_var, + color_var, + point_colors, + point_symbols, plot_height = 600, + table_datanames = character(0), + reactable_args = list(), transformator = transformator) { module( label = label, @@ -12,12 +18,18 @@ tm_g_spiderplot <- function(label = "Spiderplot", server = srv_g_spiderplot, ui_args = list(height = plot_height), server_args = list( + plot_dataname = plot_dataname, time_var = time_var, subject_var = subject_var, value_var = value_var, - event_var = event_var + event_var = event_var, + color_var = color_var, + point_colors = point_colors, + point_symbols = point_symbols, + table_datanames = table_datanames, + reactable_args = reactable_args ), - datanames = "all", + datanames = union(plot_dataname, table_datanames) ) } @@ -43,17 +55,22 @@ ui_g_spiderplot <- function(id, height) { srv_g_spiderplot <- function(id, data, - dataname, + plot_dataname, time_var, subject_var, value_var, event_var, - filter_panel_api, - plot_height = 600) { + color_var, + point_colors, + point_symbols, + plot_height = 600, + table_datanames, + reactable_args, + filter_panel_api) { moduleServer(id, function(input, output, session) { event_levels <- reactive({ req(data()) - unique(data()[[dataname]][[event_var]]) + unique(data()[[plot_dataname]][[event_var]]) }) observeEvent(event_levels(), { updateSelectInput(inputId = "select_event", choices = event_levels(), selected = event_levels()[1]) @@ -62,34 +79,69 @@ srv_g_spiderplot <- function(id, plotly_q <- reactive({ # todo: tooltip! req(input$select_event) - within( + + time_var_label <- c( + attr(data()[[plot_dataname]][[time_var]], "label"), + time_var + )[1] + + subject_var_label <- c( + attr(data()[[plot_dataname]][[subject_var]], "label"), + subject_var + )[1] + + ee <- within( data(), - dataname = str2lang(dataname), + dataname = str2lang(plot_dataname), time_var = str2lang(time_var), subject_var = str2lang(subject_var), value_var = str2lang(value_var), event_var = str2lang(event_var), + color_var = str2lang(color_var), selected_event = input$select_event, height = input$plot_height, - xaxis_label = attr(data()[[dataname]][[time_var]], "label"), - yaxis_label = input$select_event, + time_var_label = time_var_label, + event_var_label = input$select_event, + subject_var_label = subject_var_label, title = paste0(input$select_event, " Over Time"), expr = { - p <- dataname |> filter(event_var == selected_event)|> - plotly::plot_ly(source = "spiderplot", height = height) |> + dd <- dataname %>% + arrange(subject_var, time_var) %>% + filter(event_var == selected_event) %>% + mutate( + tooltip = sprintf( + "%s: %s
%s: %s%%
%s: %s", + subject_var_label, subject_var, + time_var_label, time_var, + event_var_label, value_var + ) + ) %>% + group_by(subject_var) # %>% + # group_modify(~ { + # .first_x <- within(.x[1, ], { + # value_var <- 0 + # time_var <- 0 + # }) + # bind_rows(.first_x, .x) + # }) + p <- dd |> plotly::plot_ly(source = "spiderplot", height = height) %>% + plotly::add_trace( + x = ~time_var, + y = ~value_var, + mode = 'lines+markers', + text = ~ tooltip, + hoverinfo = "text" + ) %>% plotly::add_markers( - x = ~time_var, y = ~value_var, color = ~subject_var - ) |> - plotly::add_lines( - x = ~time_var, y = ~value_var, color = ~subject_var, - showlegend = FALSE - ) |> + x = ~time_var, y = ~value_var, color = ~color_var, symbol = ~color_var + ) %>% plotly::layout( - xaxis = list(title = xaxis_label, zeroline = FALSE), - yaxis = list(title = yaxis_label), + xaxis = list(title = time_var_label), + yaxis = list(title = event_var_label), title = title, + showlegend = FALSE, dragmode = "select" - ) |> + ) %>% plotly::config(displaylogo = FALSE) } ) @@ -103,7 +155,7 @@ srv_g_spiderplot <- function(id, req(plotly_selected()) within( plotly_q(), - dataname = str2lang(dataname), + dataname = str2lang(plot_dataname), time_var = str2lang(time_var), subject_var = subject_var, value_var = str2lang(value_var), diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 530028e57..8a4ae95df 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -10,7 +10,7 @@ tm_g_swimlane <- function(label = "Swimlane", value_var_color = character(0), value_var_symbol, plot_height = 700, - table_datanames, + table_datanames = character(0), ...) { module( label = label, @@ -137,11 +137,12 @@ srv_g_swimlane <- function(id, y = ~subject_var_ordered, yend = ~subject_var_ordered, color = ~event_var, data = data |> group_by(subject_var_ordered, event_var) |> summarise(study_day = max(time_var)), - line = list(width = 1, color = "grey"), + line = list(width = 2, color = "grey"), showlegend = FALSE ) %>% plotly::layout( - xaxis = list(title = time_axis_label), yaxis = list(title = subject_axis_label) + xaxis = list(title = time_axis_label), + yaxis = list(title = subject_axis_label) ) %>% plotly::layout(dragmode = "select") %>% plotly::config(displaylogo = FALSE) diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index ebd02f243..5e13188c8 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -8,7 +8,7 @@ tm_g_waterfall <- function(label = "Waterfall", value_arbitrary_hlines = c(0.2, -0.3), plot_title = "Waterfall plot", plot_height = 700, - table_datanames, + table_datanames = character(0), ...) { module( label = label, diff --git a/R/tm_swimlane_mdr.R b/R/tm_swimlane_mdr.R deleted file mode 100644 index 68557078e..000000000 --- a/R/tm_swimlane_mdr.R +++ /dev/null @@ -1,127 +0,0 @@ -#' @export -tm_g_swimlane_mdr <- function(label = "Swimlane", - plot_dataname, - time_var, - subject_var, - value_var, - event_var, - sort_var = time_var, - group_var = NULL, - listing_datanames = character(0), - value_var_color = c( - "DEATH" = "black", - "WITHDRAWAL BY SUBJECT" = "grey", - "PD (Progressive Disease)" = "red", - "SD (Stable Disease)" = "darkorchid4", - "MR (Minimal/Minor Response)" = "sienna4", - "PR (Partial Response)" = "maroon", - "VGPR (Very Good Partial Response)" = "chartreuse4", - "CR (Complete Response)" = "#3a41fc", - "SCR (Stringent Complete Response)" = "midnightblue", - "X Administration Injection" = "goldenrod", - "Y Administration Infusion" = "deepskyblue3", - "Z Administration Infusion" = "darkorchid" - ), - # possible markers https://plotly.com/python/marker-style/ - value_var_symbol = c( - "DEATH" = "circle", - "WITHDRAWAL BY SUBJECT" = "square", - "PD (Progressive Disease)" = "circle", - "SD (Stable Disease)" = "square-open", - "MR (Minimal/Minor Response)" = "star-open", - "PR (Partial Response)" = "star-open", - "VGPR (Very Good Partial Response)" = "star-open", - "CR (Complete Response)" = "star-open", - "SCR (Stringent Complete Response)" = "star-open", - "X Administration Injection" = "line-ns", - "Y Administration Infusion" = "line-ns", - "Z Administration Infusion" = "line-ns" - ), - plot_height = 700) { - checkmate::assert_character(value_var_color) - module( - label = label, - ui = ui_g_swimlane_mdr, - server = srv_g_swimlane_mdr, - datanames = union(plot_dataname, listing_datanames), - ui_args = list(height = plot_height), - server_args = list( - plot_dataname = plot_dataname, - time_var = time_var, - subject_var = subject_var, - value_var = value_var, - event_var = event_var, - sort_var = sort_var, - group_var = group_var, - value_var_color = value_var_color, - value_var_symbol = value_var_symbol, - listing_datanames = listing_datanames, - plot_height = plot_height - ) - ) -} - -ui_g_swimlane_mdr <- function(id, height) { - ns <- NS(id) - tagList( - div( - h4("Swim Lane - Duration of Tx"), - ui_g_swimlane(ns("plot"), height = height) - ), - ui_t_reactables(ns("subtables")) - ) -} -srv_g_swimlane_mdr <- function(id, - data, - plot_dataname, - time_var, - subject_var, - value_var, - event_var, - sort_var, - group_var, - value_var_color, - value_var_symbol, - listing_datanames, - filter_panel_api, - plot_height = 600) { - moduleServer(id, function(input, output, session) { - plotly_selected_q <- srv_g_swimlane( - "plot", - data = data, - dataname = plot_dataname, - time_var = time_var, - subject_var = subject_var, - value_var = value_var, - event_var = event_var, - sort_var = sort_var, - group_var = group_var, - value_var_color = value_var_color, - value_var_symbol = value_var_symbol, - filter_panel_api = filter_panel_api - ) - - if (length(listing_datanames)) { - listings_q <- reactive({ - req(plotly_selected_q()) - calls <- lapply(seq_along(listing_datanames), function(i) { - listing_name <- listing_names[i] - listing_label <- attr(plotly_selected_q()[[listing_name]], "label") - substitute( - list( - listing_name = str2lang(listing_name), - listing_selected = str2lang(sprintf("%s_selected", listing_name)), - listing_label = listing_label, - subject_var = str2lang(subject_var) - ), - expr = { - listing_selected <- dplyr::filter(listing_name, subject_var %in% plotly_brushed_subject) - } - ) - }) - teal.code::eval_code(plotly_selected_q(), as.expression(calls)) - }) - srv_t_reactables("subtables", data = listings_q, datanames = listing_datanames, layout = "tabs") - } - }) -} From cb5c6164e4bf153ccbac49c7977a13413fd4e7bd Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Tue, 18 Mar 2025 15:07:20 +0000 Subject: [PATCH 66/92] wip v5 --- R/tm_g_spiderplot.R | 98 ++++++++++++++++++++++++++++++--------------- R/tm_g_swimlane.R | 10 ++--- R/tm_g_waterfall.R | 30 +++++++------- R/tm_t_reactable.R | 18 +++++---- 4 files changed, 95 insertions(+), 61 deletions(-) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index c3ad97faf..05949fe2a 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -48,7 +48,8 @@ ui_g_spiderplot <- function(id, height) { sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ) ), - plotly::plotlyOutput(ns("plot"), height = "100%") + plotly::plotlyOutput(ns("plot"), height = "100%"), + ui_t_reactables(ns("subtables")) ) } @@ -64,8 +65,8 @@ srv_g_spiderplot <- function(id, point_colors, point_symbols, plot_height = 600, - table_datanames, - reactable_args, + table_datanames = character(0), + reactable_args = list(), filter_panel_api) { moduleServer(id, function(input, output, session) { event_levels <- reactive({ @@ -108,38 +109,38 @@ srv_g_spiderplot <- function(id, dd <- dataname %>% arrange(subject_var, time_var) %>% filter(event_var == selected_event) %>% + group_by(subject_var) %>% mutate( + x = dplyr::lag(time_var, default = 0), + y = dplyr:::lag(value_var, default = 0), tooltip = sprintf( "%s: %s
%s: %s%%
%s: %s", subject_var_label, subject_var, time_var_label, time_var, event_var_label, value_var ) - ) %>% - group_by(subject_var) # %>% - # group_modify(~ { - # .first_x <- within(.x[1, ], { - # value_var <- 0 - # time_var <- 0 - # }) - # bind_rows(.first_x, .x) - # }) - p <- dd |> plotly::plot_ly(source = "spiderplot", height = height) %>% - plotly::add_trace( - x = ~time_var, + ) + p <- dd |> plotly::plot_ly( + source = "spiderplot", + height = height, + x = ~x, + y = ~y, + xend = ~time_var, + yend = ~value_var, + color = ~color_var + ) %>% + plotly::add_segments() %>% + plotly::add_markers( + x = ~time_var, y = ~value_var, - mode = 'lines+markers', + symbol = ~color_var, text = ~ tooltip, hoverinfo = "text" ) %>% - plotly::add_markers( - x = ~time_var, y = ~value_var, color = ~color_var, symbol = ~color_var - ) %>% plotly::layout( xaxis = list(title = time_var_label), yaxis = list(title = event_var_label), title = title, - showlegend = FALSE, dragmode = "select" ) %>% plotly::config(displaylogo = FALSE) @@ -148,24 +149,57 @@ srv_g_spiderplot <- function(id, }) output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) - + plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) - - reactive({ + + plotly_selected_q <- reactive({ req(plotly_selected()) + primary_keys <- unname(join_keys(data())[plot_dataname, plot_dataname]) + req(primary_keys) within( plotly_q(), - dataname = str2lang(plot_dataname), - time_var = str2lang(time_var), - subject_var = subject_var, - value_var = str2lang(value_var), - time_vals = plotly_selected()$x, - value_vals = plotly_selected()$y, expr = { - plotly_brushed_time <- time_vals - plotly_brushed_value <- value_vals - } + spiderplot_selected <- dplyr::filter(dataname, xvar %in% xvals, yvar %in% yvals) %>% + dplyr::select(primary_keys) + }, + dataname = str2lang(plot_dataname), + xvar = str2lang(time_var), + yvar = str2lang(value_var), + xvals = plotly_selected()$x, + yvals = plotly_selected()$y, + primary_keys = primary_keys + ) + }) + + children_names <- reactive({ + if (length(table_datanames) == 0) { + children(plotly_selected_q(), plot_dataname) + } else { + table_datanames + } + }) + + tables_selected_q <- eventReactive(plotly_selected_q(), { + exprs <- as.expression( + lapply( + children_names(), + function(childname) { + join_cols <- join_keys(plotly_selected_q())[childname, plot_dataname] + substitute( + expr = { + childname <- dplyr::right_join(childname, spiderplot_selected, by = by) + }, + list( + childname = str2lang(childname), + by = join_cols + ) + ) + } + ) ) + eval_code(plotly_selected_q(), exprs) }) + + srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, reactable_args = reactable_args) }) } diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 8a4ae95df..771edca8a 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -11,7 +11,7 @@ tm_g_swimlane <- function(label = "Swimlane", value_var_symbol, plot_height = 700, table_datanames = character(0), - ...) { + reactable_args = list()) { module( label = label, ui = ui_g_swimlane, @@ -29,7 +29,7 @@ tm_g_swimlane <- function(label = "Swimlane", value_var_color = value_var_color, value_var_symbol = value_var_symbol, table_datanames = table_datanames, - ... + reactable_args = reactable_args ) ) } @@ -59,8 +59,8 @@ srv_g_swimlane <- function(id, value_var_color, value_var_symbol, table_datanames, - filter_panel_api, - ...) { + reactable_args = list(), + filter_panel_api) { moduleServer(id, function(input, output, session) { sort_choices <- reactiveVal() @@ -234,7 +234,7 @@ srv_g_swimlane <- function(id, eval_code(plotly_selected_q(), exprs) }) - srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, ...) + srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, reactable_args = reactable_args) }) } diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 5e13188c8..1ceabb29b 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -9,25 +9,23 @@ tm_g_waterfall <- function(label = "Waterfall", plot_title = "Waterfall plot", plot_height = 700, table_datanames = character(0), - ...) { + reactable_args = list()) { module( label = label, ui = ui_g_waterfall, server = srv_g_waterfall, datanames = union(plot_dataname, table_datanames), ui_args = list(height = plot_height), - server_args = c( - list( - plot_dataname = plot_dataname, - table_datanames = table_datanames, - subject_var = subject_var, - value_var = value_var, - color_var = color_var, - bar_colors = bar_colors, - value_arbitrary_hlines = value_arbitrary_hlines, - plot_title = plot_title - ), - list(...) + server_args = list( + plot_dataname = plot_dataname, + table_datanames = table_datanames, + subject_var = subject_var, + value_var = value_var, + color_var = color_var, + bar_colors = bar_colors, + value_arbitrary_hlines = value_arbitrary_hlines, + plot_title = plot_title, + reactable_args = reactable_args ) ) } @@ -54,8 +52,8 @@ srv_g_waterfall <- function(id, plot_title, plot_height = 600, table_datanames = character(0), - filter_panel_api, - ...) { + reactable_args = list(), + filter_panel_api) { moduleServer(id, function(input, output, session) { output$color_by_output <- renderUI({ selectInput(session$ns("color_by"), label = "Color by:", choices = color_var$choices, selected = color_var$selected) @@ -205,7 +203,7 @@ srv_g_waterfall <- function(id, eval_code(plotly_selected_q(), exprs) }) - srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, ...) + srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, reactable_args = reactable_args) }) } diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 2e70236eb..38745ee9c 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -4,15 +4,17 @@ tm_t_reactables <- function(label = "Table", colnames = list(), transformators = list(), decorators = list(), - ...) { + reactable_args = list()) { module( label = label, ui = ui_t_reactables, server = srv_t_reactables, ui_args = list(decorators = decorators), - server_args = c( - list(datanames = datanames, colnames = colnames, decorators = decorators), - rlang::list2(...) + server_args = list( + datanames = datanames, + colnames = colnames, + reactable_args = reactable_args, + decorators = decorators ), datanames = datanames, transformators = transformators @@ -24,7 +26,7 @@ ui_t_reactables <- function(id, decorators = list()) { uiOutput(ns("subtables"), container = bslib::page_fluid) } -srv_t_reactables <- function(id, data, filter_panel_api, datanames, colnames = list(), decorators = list(), ...) { +srv_t_reactables <- function(id, data, filter_panel_api, datanames, colnames = list(), decorators = list(), reactable_args = list()) { moduleServer(id, function(input, output, session) { # todo: this to the function .validate_datanames datanames_r <- .validate_datanames(datanames = datanames, data = data) @@ -83,7 +85,7 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, colnames = l dataname = dataname, filter_panel_api = filter_panel_api, colnames = colnames[[dataname]], - ... + reactable_args = reactable_args ) } ) @@ -118,7 +120,7 @@ ui_t_reactable <- function(id) { ) } -srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, decorators, ...) { +srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, decorators, reactable_args = list()) { moduleServer(id, function(input, output, session) { logger::log_debug("srv_t_reactable initializing for dataname: { dataname }") dataname_reactable <- sprintf("%s_reactable", dataname) @@ -171,7 +173,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco reactable_call <- .make_reactable_call( dataset = data()[[dataname]][cols_selected()], dataname = dataname, - args = rlang::list2(...) + args = reactable_args ) data() |> From 18fd08c41e336335ad04478da52359f2c5c1ffff Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Tue, 18 Mar 2025 15:08:28 +0000 Subject: [PATCH 67/92] wip v5 --- NAMESPACE | 1 - man/dot-make_reactable_columns_call.Rd | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 1c5bcba30..8edbf3232 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,7 +24,6 @@ export(tm_g_scatterplot) export(tm_g_scatterplotmatrix) export(tm_g_spiderplot) export(tm_g_swimlane) -export(tm_g_swimlane_mdr) export(tm_g_waterfall) export(tm_missing_data) export(tm_outliers) diff --git a/man/dot-make_reactable_columns_call.Rd b/man/dot-make_reactable_columns_call.Rd index 22b11063e..079641f10 100644 --- a/man/dot-make_reactable_columns_call.Rd +++ b/man/dot-make_reactable_columns_call.Rd @@ -7,7 +7,7 @@ name = \if{html}{\out{}} cell = \if{html}{\out{}} Arguments of \code{\link[reactable:colDef]{reactable::colDef()}} are specified only if necessary} \usage{ -.make_reactable_columns_call(dataset) +.make_reactable_columns_call(dataset, col_defs) } \arguments{ \item{dataset}{(\code{data.frame})} From 02040a5b2b4c511264b59072ab5c97b9e33e6c3e Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Tue, 18 Mar 2025 20:49:13 +0000 Subject: [PATCH 68/92] wip v5 --- R/tm_g_spiderplot.R | 76 ++++++++++++++++++++++++++++----------------- R/tm_g_swimlane.R | 2 +- R/tm_g_waterfall.R | 1 + R/tm_t_reactable.R | 6 ++-- 4 files changed, 51 insertions(+), 34 deletions(-) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 05949fe2a..770349e5c 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -78,9 +78,18 @@ srv_g_spiderplot <- function(id, }) plotly_q <- reactive({ - # todo: tooltip! req(input$select_event) + adjusted_colors <- .color_palette_discrete( + levels = unique(data()[[plot_dataname]][[color_var]]), + color = point_colors + ) + + adjusted_symbols <- .shape_palette_discrete( + levels = unique(data()[[plot_dataname]][[color_var]]), + symbol = point_symbols + ) + time_var_label <- c( attr(data()[[plot_dataname]][[time_var]], "label"), time_var @@ -100,50 +109,59 @@ srv_g_spiderplot <- function(id, event_var = str2lang(event_var), color_var = str2lang(color_var), selected_event = input$select_event, + colors = adjusted_colors, + symbols = adjusted_symbols, height = input$plot_height, time_var_label = time_var_label, event_var_label = input$select_event, subject_var_label = subject_var_label, title = paste0(input$select_event, " Over Time"), expr = { - dd <- dataname %>% - arrange(subject_var, time_var) %>% + plotly_fun <- function(data) { + data %>% + plotly::plot_ly( + source = "spiderplot", + height = height, + color = ~color_var, + colors = colors, + symbols = symbols + ) %>% + plotly::add_segments( + x = ~x, + y = ~y, + xend = ~time_var, + yend = ~value_var + ) %>% + plotly::add_markers( + x = ~time_var, + y = ~value_var, + symbol = ~color_var, + text = ~ tooltip, + hoverinfo = "text" + ) %>% + plotly::layout( + xaxis = list(title = time_var_label), + yaxis = list(title = event_var_label), + title = title, + dragmode = "select" + ) %>% + plotly::config(displaylogo = FALSE) + } + p <- dataname %>% filter(event_var == selected_event) %>% + arrange(subject_var, time_var) %>% group_by(subject_var) %>% mutate( x = dplyr::lag(time_var, default = 0), y = dplyr:::lag(value_var, default = 0), tooltip = sprintf( - "%s: %s
%s: %s%%
%s: %s", + "%s: %s
%s: %s
%s: %s%%", subject_var_label, subject_var, time_var_label, time_var, - event_var_label, value_var + event_var_label, value_var * 100 ) - ) - p <- dd |> plotly::plot_ly( - source = "spiderplot", - height = height, - x = ~x, - y = ~y, - xend = ~time_var, - yend = ~value_var, - color = ~color_var - ) %>% - plotly::add_segments() %>% - plotly::add_markers( - x = ~time_var, - y = ~value_var, - symbol = ~color_var, - text = ~ tooltip, - hoverinfo = "text" - ) %>% - plotly::layout( - xaxis = list(title = time_var_label), - yaxis = list(title = event_var_label), - title = title, - dragmode = "select" ) %>% - plotly::config(displaylogo = FALSE) + plotly_fun() } ) }) diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 771edca8a..70c1aafe4 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -135,7 +135,6 @@ srv_g_swimlane <- function(id, plotly::add_segments( x = ~0, xend = ~study_day, y = ~subject_var_ordered, yend = ~subject_var_ordered, - color = ~event_var, data = data |> group_by(subject_var_ordered, event_var) |> summarise(study_day = max(time_var)), line = list(width = 2, color = "grey"), showlegend = FALSE @@ -188,6 +187,7 @@ srv_g_swimlane <- function(id, plotly_selected_q <- reactive({ req(plotly_selected()) + # todo: change it to foreign keys needed to merge with table_datanames primary_keys <- unname(join_keys(data())[plot_dataname, plot_dataname]) req(primary_keys) within( diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 1ceabb29b..41ae0e99d 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -65,6 +65,7 @@ srv_g_waterfall <- function(id, } plotly_q <- reactive({ req(data(), input$color_by) + adjusted_colors <- .color_palette_discrete( levels = unique(data()[[plot_dataname]][[input$color_by]]), color = bar_colors[[input$color_by]] diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 38745ee9c..08ee2eb4d 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -28,7 +28,6 @@ ui_t_reactables <- function(id, decorators = list()) { srv_t_reactables <- function(id, data, filter_panel_api, datanames, colnames = list(), decorators = list(), reactable_args = list()) { moduleServer(id, function(input, output, session) { - # todo: this to the function .validate_datanames datanames_r <- .validate_datanames(datanames = datanames, data = data) colnames_r <- reactive({ req(datanames_r()) @@ -49,7 +48,6 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, colnames = l }) }) - # todo: re-render only if datanames changes output$subtables <- renderUI({ logger::log_debug("srv_t_reactables@1 render subtables") if (length(datanames_r()) == 0) { @@ -160,7 +158,6 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco ) }) - table_q <- reactive({ req(cols_selected()) select_call <- as.call( @@ -185,7 +182,8 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco logger::log_debug("srv_t_reactable@2 render table for dataset { dataname }") table_q()[[dataname_reactable]] }) - + + # todo: add select -> show children table table_selected_q <- reactive({ selected_row <- reactable::getReactableState("table", "selected") if (!is.null(selected_row)) { From b926f3553e423c322a65626dcbb32e408f1bce82 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Tue, 18 Mar 2025 21:23:17 +0000 Subject: [PATCH 69/92] wip v5 --- R/tm_g_spiderplot.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 770349e5c..8167b7136 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -161,6 +161,7 @@ srv_g_spiderplot <- function(id, event_var_label, value_var * 100 ) ) %>% + ungroup() %>% plotly_fun() } ) From 4495bc7428f7c6f33f8857b3e67ff902e4538fc0 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Tue, 25 Mar 2025 11:39:59 +0000 Subject: [PATCH 70/92] major cleaning --- R/module_colur_picker.R | 99 +++++++ R/roxygen2_templates.R | 52 ++++ R/tm_g_spiderplot.R | 253 ++++++++--------- R/tm_g_swimlane.R | 302 ++++++++++----------- R/tm_g_waterfall.R | 278 +++++++++---------- R/tm_t_reactable.R | 14 +- R/utils.R | 170 ++++++------ man/dot-color_palette_discrete.Rd | 2 +- man/dot-plotly_selected_filter_children.Rd | 35 +++ man/shared_params.Rd | 8 +- man/tm_a_pca.Rd | 4 +- man/tm_a_regression.Rd | 4 +- man/tm_g_association.Rd | 4 +- man/tm_g_bivariate.Rd | 4 +- man/tm_g_distribution.Rd | 4 +- man/tm_g_response.Rd | 4 +- man/tm_g_scatterplot.Rd | 4 +- man/tm_g_scatterplotmatrix.Rd | 4 +- man/tm_g_spiderplot.Rd | 57 ++++ man/tm_g_swimlane.Rd | 61 +++++ man/tm_g_waterfall.Rd | 52 ++++ man/tm_missing_data.Rd | 4 +- man/tm_outliers.Rd | 4 +- man/tm_t_crosstable.Rd | 4 +- man/tm_t_reactables.Rd | 41 +++ 25 files changed, 905 insertions(+), 563 deletions(-) create mode 100644 R/module_colur_picker.R create mode 100644 man/dot-plotly_selected_filter_children.Rd create mode 100644 man/tm_g_spiderplot.Rd create mode 100644 man/tm_g_swimlane.Rd create mode 100644 man/tm_g_waterfall.Rd create mode 100644 man/tm_t_reactables.Rd diff --git a/R/module_colur_picker.R b/R/module_colur_picker.R new file mode 100644 index 000000000..2d363e371 --- /dev/null +++ b/R/module_colur_picker.R @@ -0,0 +1,99 @@ +# todo: to teal widgets? + +colour_picker_ui <- function(id) { + ns <- NS(id) + bslib::accordion( + uiOutput(ns("module"), title = "Event colors:", container = bslib::accordion_panel), + open = FALSE + ) +} + +colour_picker_srv <- function(id, x, default_colors) { + moduleServer(id, function(input, output, session) { + default_colors_adjusted <- reactive({ + req(x()) + .color_palette_discrete( + levels = unique(x()), + color = default_colors + ) + }) + + color_values <- reactiveVal() + observeEvent(default_colors_adjusted(), { + if (!identical(default_colors_adjusted(), color_values())) { + color_values(default_colors_adjusted()) + } + }) + + output$module <- renderUI({ + tagList( + lapply( + names(color_values()), + function(level) { + div( + colourpicker::colourInput( + inputId = session$ns(.name_to_id(level)), + label = level, + value = color_values()[level] + ) + ) + } + ) + ) + }) + + color_input_values <- reactiveVal() + observe({ + req(color_values()) + new_input_values <- sapply(names(color_values()), function(level) { + c(input[[.name_to_id(level)]], color_values()[[level]])[1] + }) + if (!identical(new_input_values, isolate(color_input_values()))) { + isolate(color_input_values(new_input_values)) + } + }) + + color_input_values + }) +} + + + +#' Color palette discrete +#' +#' To specify custom discrete colors to `plotly` or `ggplot` elements one needs to specify a vector named by +#' levels of variable used for coloring. This function allows to specify only some or none of the colors/levels +#' as the rest will be filled automatically. +#' @param levels (`character`) values of possible variable levels +#' @param color (`named character`) valid color names (see [colors()]) or hex-colors named by `levels`. +#' @return `character` with hex colors named by `levels`. +.color_palette_discrete <- function(levels, color) { + p <- color[names(color) %in% levels] + p_rgb_num <- col2rgb(p) + p_hex <- rgb(p_rgb_num[1,]/255, p_rgb_num[2,]/255, p_rgb_num[3,]/255) + p <- setNames(p_hex, names(p)) + missing_levels <- setdiff(levels, names(p)) + N <- length(levels) + n <- length(p) + m <- N - n + if (m > 0 && n > 0) { + current_space <- rgb2hsv(col2rgb(p)) + optimal_color_space <- colorspace::qualitative_hcl(N) + color_distances <- dist(t(cbind(current_space, rgb2hsv(col2rgb(optimal_color_space))))) + optimal_to_current_dist <- as.matrix(color_distances)[seq_len(n), -seq_len(n)] + furthest_neighbours_idx <- order(apply(optimal_to_current_dist, 2, min), decreasing = TRUE) + missing_colors <- optimal_color_space[furthest_neighbours_idx][seq_len(m)] + p <- c(p, setNames(missing_colors, missing_levels)) + } else if (length(missing_levels)) { + colorspace::qualitative_hcl(N) + } else { + p + } + p[names(p) %in% levels] +} + +.shape_palette_discrete <- function(levels, symbol) { + s <- setNames(symbol[levels], levels) + s[is.na(s)] <- "circle-open" + s +} diff --git a/R/roxygen2_templates.R b/R/roxygen2_templates.R index 8ff396409..d8e1145f0 100644 --- a/R/roxygen2_templates.R +++ b/R/roxygen2_templates.R @@ -14,3 +14,55 @@ roxygen_ggplot2_args_param <- function(...) { } # nocov end + +#' Shared parameters documentation +#' +#' Defines common arguments shared across multiple functions in the package +#' to avoid repetition by using `inheritParams`. +#' +#' @param plot_height (`numeric`) optional, specifies the plot height as a three-element vector of +#' `value`, `min`, and `max` intended for use with a slider UI element. +#' @param plot_width (`numeric`) optional, specifies the plot width as a three-element vector of +#' `value`, `min`, and `max` for a slider encoding the plot width. +#' @param rotate_xaxis_labels (`logical`) optional, whether to rotate plot X axis labels. Does not +#' rotate by default (`FALSE`). +#' @param ggtheme (`character`) optional, `ggplot2` theme to be used by default. Defaults to `"gray"`. +#' @param ggplot2_args (`ggplot2_args`) object created by [teal.widgets::ggplot2_args()] +#' with settings for the module plot. +#' The argument is merged with options variable `teal.ggplot2_args` and default module setup. +#' +#' For more details see the vignette: `vignette("custom-ggplot2-arguments", package = "teal.widgets")` +#' @param basic_table_args (`basic_table_args`) object created by [teal.widgets::basic_table_args()] +#' with settings for the module table. +#' The argument is merged with options variable `teal.basic_table_args` and default module setup. +#' +#' For more details see the vignette: `vignette("custom-basic-table-arguments", package = "teal.widgets")` +#' @param pre_output (`shiny.tag`) optional, text or UI element to be displayed before the module's output, +#' providing context or a title. +#' with text placed before the output to put the output into context. For example a title. +#' @param post_output (`shiny.tag`) optional, text or UI element to be displayed after the module's output, +#' adding context or further instructions. Elements like `shiny::helpText()` are useful. +#' @param alpha (`integer(1)` or `integer(3)`) optional, specifies point opacity. +#' - When the length of `alpha` is one: the plot points will have a fixed opacity. +#' - When the length of `alpha` is three: the plot points opacity are dynamically adjusted based on +#' vector of `value`, `min`, and `max`. +#' @param size (`integer(1)` or `integer(3)`) optional, specifies point size. +#' - When the length of `size` is one: the plot point sizes will have a fixed size. +#' - When the length of `size` is three: the plot points size are dynamically adjusted based on +#' vector of `value`, `min`, and `max`. +#' @param decorators `r lifecycle::badge("experimental")` +#' (named `list` of lists of `teal_transform_module`) optional, +#' decorator for tables or plots included in the module output reported. +#' The decorators are applied to the respective output objects. +#' +#' @param table_datanames (`character`) names of the datasets which should be listed below the plot +#' when some data points are selected. Objects named after `table_datanames` will be pulled from +#' `data` so it is important that data actually contains these datasets. Please be aware that +#' table datasets must be linked with `plot_dataname` by the relevant [join_keys()]. +#' See section "Decorating Module" below for more details. +#' +#' @return Object of class `teal_module` to be used in `teal` applications. +#' +#' @name shared_params +#' @keywords internal +NULL \ No newline at end of file diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 8167b7136..4b4129e50 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -1,9 +1,27 @@ +#' `teal` module: Spider Plot +#' +#' Module visualizes value development in time grouped by subjects. +#' +#' @inheritParams teal::module +#' @inheritParams shared_params +#' @param plot_dataname (`character(1)`) name of the dataset which visualization is builded on. +#' @param time_var (`character(1)`) name of the `numeric` column in `plot_dataname` to be used as x-axis. +#' @param value_var (`character(1)`) name of the `numeric` column in `plot_dataname` to be used as y-axis. +#' column. +#' @param subject_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' to be used as grouping variable for displayed lines/points. +#' @param color_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' to be used to differentiate colors and symbols. +#' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named +#' by levels of `color_var` column. +#' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` +#' column. #' @export tm_g_spiderplot <- function(label = "Spiderplot", plot_dataname, time_var, - subject_var, value_var, + subject_var, event_var, color_var, point_colors, @@ -20,8 +38,8 @@ tm_g_spiderplot <- function(label = "Spiderplot", server_args = list( plot_dataname = plot_dataname, time_var = time_var, - subject_var = subject_var, value_var = value_var, + subject_var = subject_var, event_var = event_var, color_var = color_var, point_colors = point_colors, @@ -36,21 +54,16 @@ tm_g_spiderplot <- function(label = "Spiderplot", ui_g_spiderplot <- function(id, height) { ns <- NS(id) - div( - div( - class = "row", - column( - width = 6, - selectInput(ns("select_event"), "Select Y Axis", NULL) - ), - column( - width = 6, - sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) - ) + bslib::page_sidebar( + sidebar = div( + selectInput(ns("select_event"), "Select Y Axis", NULL), + colour_picker_ui(ns("colors")), + sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), - plotly::plotlyOutput(ns("plot"), height = "100%"), - ui_t_reactables(ns("subtables")) - + bslib::page_fillable( + plotly::plotlyOutput(ns("plot"), height = "100%"), + ui_t_reactables(ns("subtables")) + ) ) } @@ -58,8 +71,8 @@ srv_g_spiderplot <- function(id, data, plot_dataname, time_var, - subject_var, value_var, + subject_var, event_var, color_var, point_colors, @@ -77,92 +90,48 @@ srv_g_spiderplot <- function(id, updateSelectInput(inputId = "select_event", choices = event_levels(), selected = event_levels()[1]) }) + color_inputs <- colour_picker_srv( + "colors", + x = reactive(data()[[plot_dataname]][[color_var]]), + default_colors = point_colors + ) + plotly_q <- reactive({ - req(input$select_event) - - adjusted_colors <- .color_palette_discrete( - levels = unique(data()[[plot_dataname]][[color_var]]), - color = point_colors - ) - + req(input$select_event, color_inputs()) + adjusted_symbols <- .shape_palette_discrete( levels = unique(data()[[plot_dataname]][[color_var]]), symbol = point_symbols ) - time_var_label <- c( - attr(data()[[plot_dataname]][[time_var]], "label"), - time_var - )[1] - - subject_var_label <- c( - attr(data()[[plot_dataname]][[subject_var]], "label"), - subject_var - )[1] - - ee <- within( + within( data(), dataname = str2lang(plot_dataname), - time_var = str2lang(time_var), - subject_var = str2lang(subject_var), - value_var = str2lang(value_var), - event_var = str2lang(event_var), - color_var = str2lang(color_var), + event_var_lang = str2lang(event_var), + time_var = time_var, + value_var = value_var, + subject_var = subject_var, + event_var = event_var, + color_var = color_var, selected_event = input$select_event, - colors = adjusted_colors, + colors = color_inputs(), symbols = adjusted_symbols, height = input$plot_height, - time_var_label = time_var_label, - event_var_label = input$select_event, - subject_var_label = subject_var_label, - title = paste0(input$select_event, " Over Time"), + title = sprintf("%s over time", input$selected_event), expr = { - plotly_fun <- function(data) { - data %>% - plotly::plot_ly( - source = "spiderplot", - height = height, - color = ~color_var, - colors = colors, - symbols = symbols - ) %>% - plotly::add_segments( - x = ~x, - y = ~y, - xend = ~time_var, - yend = ~value_var - ) %>% - plotly::add_markers( - x = ~time_var, - y = ~value_var, - symbol = ~color_var, - text = ~ tooltip, - hoverinfo = "text" - ) %>% - plotly::layout( - xaxis = list(title = time_var_label), - yaxis = list(title = event_var_label), - title = title, - dragmode = "select" - ) %>% - plotly::config(displaylogo = FALSE) - } p <- dataname %>% - filter(event_var == selected_event) %>% - arrange(subject_var, time_var) %>% - group_by(subject_var) %>% - mutate( - x = dplyr::lag(time_var, default = 0), - y = dplyr:::lag(value_var, default = 0), - tooltip = sprintf( - "%s: %s
%s: %s
%s: %s%%", - subject_var_label, subject_var, - time_var_label, time_var, - event_var_label, value_var * 100 - ) + filter(event_var_lang == selected_event) %>% + spiderplotly( + time_var = time_var, + value_var = value_var, + subject_var = subject_var, + event_var = event_var, + color_var = color_var, + colors = colors, + symbols = symbols, + height = height ) %>% - ungroup() %>% - plotly_fun() + plotly::layout(title = title) } ) }) @@ -171,54 +140,66 @@ srv_g_spiderplot <- function(id, plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) - plotly_selected_q <- reactive({ - req(plotly_selected()) - primary_keys <- unname(join_keys(data())[plot_dataname, plot_dataname]) - req(primary_keys) - within( - plotly_q(), - expr = { - spiderplot_selected <- dplyr::filter(dataname, xvar %in% xvals, yvar %in% yvals) %>% - dplyr::select(primary_keys) - }, - dataname = str2lang(plot_dataname), - xvar = str2lang(time_var), - yvar = str2lang(value_var), - xvals = plotly_selected()$x, - yvals = plotly_selected()$y, - primary_keys = primary_keys - ) - }) - - children_names <- reactive({ - if (length(table_datanames) == 0) { - children(plotly_selected_q(), plot_dataname) - } else { - table_datanames - } - }) - - tables_selected_q <- eventReactive(plotly_selected_q(), { - exprs <- as.expression( - lapply( - children_names(), - function(childname) { - join_cols <- join_keys(plotly_selected_q())[childname, plot_dataname] - substitute( - expr = { - childname <- dplyr::right_join(childname, spiderplot_selected, by = by) - }, - list( - childname = str2lang(childname), - by = join_cols - ) - ) - } - ) - ) - eval_code(plotly_selected_q(), exprs) - }) + tables_selected_q <- .plotly_selected_filter_children( + data = plotly_q, + plot_dataname = plot_dataname, + xvar = time_var, + yvar = value_var, + plotly_selected = plotly_selected, + children_datanames = table_datanames + ) srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, reactable_args = reactable_args) }) } + +spiderplotly <- function(data, time_var, value_var, subject_var, event_var, color_var, colors, symbols, height) { + subject_var_label <- attr(data[[subject_var]], "label") + time_var_label <- attr(data[[time_var]], "label") + event_var_label <- attr(data[[event_var]], "label") + if (!length(subject_var_label)) subject_var_label <- subject_var + if (!length(time_var_label)) time_var_label <- time_var + if (!length(event_var_label)) event_var_label <- event_var + + data %>% + arrange(!!as.name(subject_var), !!as.name(time_var)) %>% + group_by(!!as.name(subject_var)) %>% + mutate( + x = dplyr::lag(!!as.name(time_var), default = 0), + y = dplyr:::lag(!!as.name(value_var), default = 0), + tooltip = sprintf( + "%s: %s
%s: %s
%s: %s%%
", + subject_var_label, !!as.name(subject_var), + time_var_label, !!as.name(time_var), + event_var_label, !!as.name(value_var) * 100 + ) + ) %>% + ungroup() %>% + plotly::plot_ly( + source = "spiderplot", + height = height, + color = as.formula(sprintf("~%s", color_var)), + colors = colors, + symbols = symbols + ) %>% + plotly::add_segments( + x = ~x, + y = ~y, + xend = as.formula(sprintf("~%s", time_var)), + yend = as.formula(sprintf("~%s", value_var)) + ) %>% + plotly::add_markers( + x = as.formula(sprintf("~%s", time_var)), + y = as.formula(sprintf("~%s", value_var)), + symbol = as.formula(sprintf("~%s", color_var)), + text = ~tooltip, + hoverinfo = "text" + ) %>% + plotly::layout( + xaxis = list(title = time_var_label), + yaxis = list(title = event_var_label), + title = title, + dragmode = "select" + ) %>% + plotly::config(displaylogo = FALSE) +} diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 70c1aafe4..bc0ef5d11 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -1,14 +1,35 @@ +#' `teal` module: Swimlane plot +#' +#' Module visualizes subjects' events in time. +#' +#' @inheritParams teal::module +#' @inheritParams shared_params +#' @param plot_dataname (`character(1)`) name of the dataset which visualization is builded on. +#' @param time_var (`character(1)`) name of the `numeric` column in `plot_dataname` to be used as x-axis. +#' @param subject_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' to be used as y-axis. +#' @param color_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' to name and color subject events in time. +#' @param group_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' to categorize type of event. +#' (legend is sorted according to this variable, and used in toolip to display type of the event) +#' todo: this can be fixed by ordering factor levels +#' @param sort_var (`character(1)` or `select_spec`) name(s) of the column in `plot_dataname` which +#' value determines order of the subjects displayed on the y-axis. +#' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named +#' by levels of `color_var` column. +#' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` +#' column. #' @export tm_g_swimlane <- function(label = "Swimlane", plot_dataname, time_var, subject_var, - value_var, - event_var, + color_var, + group_var, sort_var = NULL, - group_var = NULL, - value_var_color = character(0), - value_var_symbol, + point_colors = character(0), + point_symbols, plot_height = 700, table_datanames = character(0), reactable_args = list()) { @@ -22,12 +43,11 @@ tm_g_swimlane <- function(label = "Swimlane", plot_dataname = plot_dataname, time_var = time_var, subject_var = subject_var, - value_var = value_var, - event_var = event_var, - sort_var = sort_var, + color_var = color_var, group_var = group_var, - value_var_color = value_var_color, - value_var_symbol = value_var_symbol, + sort_var = sort_var, + point_colors = point_colors, + point_symbols = point_symbols, table_datanames = table_datanames, reactable_args = reactable_args ) @@ -38,13 +58,16 @@ ui_g_swimlane <- function(id, height) { ns <- NS(id) - bslib::page_fluid( - bslib::layout_columns( + bslib::page_sidebar( + sidebar = div( selectInput(ns("sort_by"), label = "Sort by:", choices = NULL, selected = NULL, multiple = FALSE), + colour_picker_ui(ns("colors")), sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), - plotly::plotlyOutput(ns("plot"), height = "100%"), - ui_t_reactables(ns("subtables")) + bslib::page_fillable( + plotly::plotlyOutput(ns("plot"), height = "100%"), + ui_t_reactables(ns("subtables")) + ) ) } srv_g_swimlane <- function(id, @@ -52,12 +75,11 @@ srv_g_swimlane <- function(id, plot_dataname, time_var, subject_var, - value_var, - event_var, + color_var, + group_var, sort_var = time_var, - group_var = NULL, - value_var_color, - value_var_symbol, + point_colors, + point_symbols, table_datanames, reactable_args = list(), filter_panel_api) { @@ -77,101 +99,50 @@ srv_g_swimlane <- function(id, }) } } + if (length(sort_var) == 1) { isolate(sort_choices(sort_var)) isolate(sort_selected(sort_var)) shinyjs::hide("sort_by") } + color_inputs <- colour_picker_srv( + "colors", + x = reactive(data()[[plot_dataname]][[color_var]]), + default_colors = point_colors + ) plotly_q <- reactive({ - req(data(), sort_selected()) - adjusted_colors <- .color_palette_discrete( - levels = unique(data()[[plot_dataname]][[value_var]]), - color = value_var_color - ) + req(data(), sort_selected(), color_inputs()) adjusted_symbols <- .shape_palette_discrete( - levels = unique(data()[[plot_dataname]][[value_var]]), - symbol = value_var_symbol + levels = unique(data()[[plot_dataname]][[color_var]]), + symbol = point_symbols + ) + within( + data(), + dataname = str2lang(plot_dataname), + time_var = time_var, + subject_var = subject_var, + color_var = color_var, + group_var = group_var, + sort_var = sort_selected(), + colors = color_inputs(), + symbols = adjusted_symbols, + height = input$plot_height, + expr = { + p <- swimlanely( + data = dataname, + time_var = time_var, + subject_var = subject_var, + color_var = color_var, + group_var = group_var, + sort_var = sort_var, + colors = colors, + symbols = symbols, + height = height + ) + } ) - subject_var_label <- c(attr(data()[[plot_dataname]][[subject_var]], "label"), "Subject")[1] - time_var_label <- c(attr(data()[[plot_dataname]][[time_var]], "label"), "Study Day")[1] - data() |> - within( - dataname = str2lang(plot_dataname), - dataname_filtered = str2lang(sprintf("%s_filtered", plot_dataname)), - time_var = str2lang(time_var), - subject_var = str2lang(subject_var), - value_var = str2lang(value_var), - event_var = str2lang(event_var), - sort_var = str2lang(sort_selected()), - group_var = if (length(group_var)) group_var, - subject_var_label = sprintf("%s:", subject_var_label), - time_var_label = sprintf("%s:", time_var_label), - colors = adjusted_colors, - symbols = adjusted_symbols, - height = input$plot_height, - subject_axis_label = subject_var_label, - time_axis_label = time_var_label, - expr = { - # todo: forcats::fct_reorder didn't work. - plotly_fun <- function(data) { - data %>% - plotly::plot_ly( - source = "swimlane", - colors = colors, - symbols = symbols, - height = height - ) %>% - plotly::add_markers( - x = ~time_var, - y = ~subject_var_ordered, - color = ~value_var, - symbol = ~value_var, - text = ~tooltip, - legendgroup = ~event_var, - hoverinfo = "text" - ) %>% - plotly::add_segments( - x = ~0, xend = ~study_day, - y = ~subject_var_ordered, yend = ~subject_var_ordered, - data = data |> group_by(subject_var_ordered, event_var) |> summarise(study_day = max(time_var)), - line = list(width = 2, color = "grey"), - showlegend = FALSE - ) %>% - plotly::layout( - xaxis = list(title = time_axis_label), - yaxis = list(title = subject_axis_label) - ) %>% - plotly::layout(dragmode = "select") %>% - plotly::config(displaylogo = FALSE) - } - - levels <- dataname %>% - group_by(subject_var, group_var) %>% - summarize(v = max(sort_var)) %>% - ungroup() %>% - arrange(group_var, v) %>% - pull(subject_var) - - p <- dataname %>% - mutate(subject_var_ordered = factor(subject_var, levels = levels)) %>% - group_by(subject_var, time_var) %>% - mutate( - tooltip = paste( - unique( - c( - paste(subject_var_label, subject_var), - paste(time_var_label, time_var), - sprintf("%s: %s", tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", event_var)), value_var) - ) - ), - collapse = "
" - ) - ) %>% - plotly_fun() - } - ) }) output$plot <- plotly::renderPlotly({ @@ -185,57 +156,84 @@ srv_g_swimlane <- function(id, plotly::event_data("plotly_selected", source = "swimlane") }) - plotly_selected_q <- reactive({ - req(plotly_selected()) - # todo: change it to foreign keys needed to merge with table_datanames - primary_keys <- unname(join_keys(data())[plot_dataname, plot_dataname]) - req(primary_keys) - within( - plotly_q(), - expr = { - swimlane_selected <- dplyr::filter(dataname, xvar %in% xvals, yvar %in% yvals) %>% - dplyr::select(primary_keys) - }, - dataname = str2lang(plot_dataname), - xvar = str2lang(time_var), - yvar = str2lang(subject_var), - xvals = plotly_selected()$x, - yvals = plotly_selected()$y, - primary_keys = primary_keys - ) - }) - - children_names <- reactive({ - if (length(table_datanames) == 0) { - children(plotly_selected_q(), plot_dataname) - } else { - table_datanames - } - }) - - tables_selected_q <- eventReactive(plotly_selected_q(), { - exprs <- as.expression( - lapply( - children_names(), - function(childname) { - join_cols <- join_keys(plotly_selected_q())[childname, plot_dataname] - substitute( - expr = { - childname <- dplyr::right_join(childname, swimlane_selected, by = by) - }, - list( - childname = str2lang(childname), - by = join_cols - ) - ) - } - ) - ) - eval_code(plotly_selected_q(), exprs) - }) + tables_selected_q <- .plotly_selected_filter_children( + data = plotly_q, + plot_dataname = plot_dataname, + xvar = time_var, + yvar = subject_var, + plotly_selected = plotly_selected, + children_datanames = table_datanames + ) srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, reactable_args = reactable_args) }) } + +swimlanely <- function(data, time_var, subject_var, color_var, group_var, sort_var, colors, symbols, height) { + subject_var_label <- attr(data[[subject_var]], "label") + time_var_label <- attr(data[[time_var]], "label") + if (!length(subject_var_label)) subject_var_label <- subject_var + if (!length(time_var_label)) time_var_label <- time_var + + # forcats::fct_reorder doesn't seem to work here + subject_levels <- data %>% + group_by(!!as.name(subject_var)) %>% + summarize(v = max(!!as.name(sort_var))) %>% + ungroup() %>% + arrange(v) %>% + pull(!!as.name(subject_var)) + data[[subject_var]] <- factor(data[[subject_var]], levels = subject_levels) + + data %>% + mutate( + !!as.name(color_var) := factor(!!as.name(color_var), levels = names(colors)), + ) %>% + group_by(!!as.name(subject_var), !!as.name(time_var)) %>% + mutate( + tooltip = paste( + unique( + c( + paste(subject_var_label, !!as.name(subject_var)), + paste(time_var_label, !!as.name(time_var)), + sprintf( + "%s: %s", + tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", !!as.name(group_var))), + !!as.name(color_var) + ) + ) + ), + collapse = "
" + ) + ) %>% + plotly::plot_ly( + source = "swimlane", + colors = colors, + symbols = symbols, + height = height + ) %>% + plotly::add_markers( + x = as.formula(sprintf("~%s", time_var)), + y = as.formula(sprintf("~%s", subject_var)), + color = as.formula(sprintf("~%s", color_var)), + symbol = as.formula(sprintf("~%s", color_var)), + text = ~tooltip, + hoverinfo = "text" + ) %>% + plotly::add_segments( + x = ~0, xend = ~study_day, + y = as.formula(sprintf("~%s", subject_var)), yend = as.formula(sprintf("~%s", subject_var)), + data = data |> + group_by(!!as.name(subject_var), !!as.name(group_var)) |> + summarise(study_day = max(!!as.name(time_var))), + line = list(width = 2, color = "grey"), + showlegend = FALSE + ) %>% + plotly::layout( + xaxis = list(title = time_var_label), + yaxis = list(title = subject_var_label) + ) %>% + plotly::layout(dragmode = "select") %>% + plotly::config(displaylogo = FALSE) +} diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 41ae0e99d..c39530c5f 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -1,3 +1,19 @@ +#' `teal` module: Waterfall plot +#' +#' Module visualizes subjects sorted decreasingly by y-values. +#' +#' @inheritParams teal::module +#' @inheritParams shared_params +#' @param plot_dataname (`character(1)`) name of the dataset which visualization is builded on. +#' @param subject_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' to be used as x-axis. +#' @param value_var (`character(1)`) name of the `numeric` column in `plot_dataname` to be used as y-axis. +#' @param color_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' to be used to differentiate bar colors. +#' @param bar_colors (`named character`) valid color names (see [colors()]) or hex-colors named +#' by levels of `color_var` column. +#' @param value_arbitrary_hlines (`numeric`) values in the same scale as `value_var` to horizontal +#' lines on the plot. #' @export tm_g_waterfall <- function(label = "Waterfall", plot_dataname, @@ -32,13 +48,17 @@ tm_g_waterfall <- function(label = "Waterfall", ui_g_waterfall <- function(id, height) { ns <- NS(id) - bslib::page_fluid( - fluidRow( - column(6, uiOutput(ns("color_by_output"))), - column(6, sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height)) + + bslib::page_sidebar( + sidebar = div( + uiOutput(ns("color_by_output")), + colour_picker_ui(ns("colors")), + sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), - plotly::plotlyOutput(ns("plot"), height = "100%"), - ui_t_reactables(ns("subtables")) + bslib::page_fillable( + plotly::plotlyOutput(ns("plot"), height = "100%"), + ui_t_reactables(ns("subtables")) + ) ) } srv_g_waterfall <- function(id, @@ -63,168 +83,116 @@ srv_g_waterfall <- function(id, } else { shinyjs::hide("color_by") } + + color_inputs <- colour_picker_srv( + "colors", + x = reactive({ + req(data(), input$color_by) + data()[[plot_dataname]][[input$color_by]] + }), + default_colors = bar_colors + ) + plotly_q <- reactive({ - req(data(), input$color_by) + req(data(), input$color_by, color_inputs()) - adjusted_colors <- .color_palette_discrete( - levels = unique(data()[[plot_dataname]][[input$color_by]]), - color = bar_colors[[input$color_by]] - ) - - subject_var_label <- c( - attr(data()[[plot_dataname]][[subject_var]], "label"), - subject_var - )[1] + within( + data(), + dataname = str2lang(plot_dataname), + subject_var = subject_var, + value_var = value_var, + color_var = input$color_by, + colors = color_inputs(), + value_arbitrary_hlines = value_arbitrary_hlines, + height = input$plot_height, + title = sprintf("Waterfall plot"), + expr = { + p <- waterfally( + dataname, + subject_var = subject_var, + value_var = value_var, + color_var = color_var, + colors = colors, + value_arbitrary_hlines = value_arbitrary_hlines, + height = height + ) %>% + plotly::layout(title = title) - value_var_label <- c( - attr(data()[[plot_dataname]][[value_var]], "label"), - value_var - )[1] - - color_var_label <- c( - attr(data()[[plot_dataname]][[input$color_by]], "label"), - input$color_by - )[1] - - - data() |> - within( - dataname = str2lang(plot_dataname), - dataname_filtered = str2lang(sprintf("%s_filtered", plot_dataname)), - subject_var = str2lang(subject_var), - value_var = str2lang(value_var), - color_var = str2lang(input$color_by), - colors = adjusted_colors, - value_arbitrary_hlines = value_arbitrary_hlines, - subject_var_label = subject_var_label, - value_var_label = value_var_label, - color_var_label = color_var_label, - title = paste0(value_var_label, " (Waterfall plot)"), - height = input$plot_height, - expr = { - p <- dataname %>% - dplyr::mutate( - subject_var_ordered = forcats::fct_reorder(as.factor(subject_var), value_var, .fun = max, .desc = TRUE), - tooltip = sprintf( - "%s: %s
%s: %s%%
%s: %s", - subject_var_label, subject_var, - value_var_label, value_var, - color_var_label, color_var - ) - ) %>% - - dplyr::filter(!duplicated(subject_var)) %>% - # todo: one value for x, y: distinct or summarize(value = foo(value_var)) [foo: summarize_fun] - plotly::plot_ly( - source = "waterfall", - height = height - ) %>% - plotly::add_bars( - x = ~subject_var_ordered, - y = ~value_var, - color = ~color_var, - colors = colors, - text = ~ tooltip, - hoverinfo = "text" - ) %>% - plotly::layout( - shapes = lapply(value_arbitrary_hlines, function(y) { - list( - type = "line", - x0 = 0, - x1 = 1, - xref = "paper", - y0 = y, - y1 = y, - line = list(color = "black", dash = "dot") - ) - }), - title = title, - xaxis = list(title = subject_var_label, tickangle = -45), - yaxis = list(title = value_var_label), - legend = list(title = list(text = "Color by:")), - barmode = "relative" - ) %>% - plotly::layout( dragmode = "select") %>% - plotly::config(displaylogo = FALSE) - }, - height = input$plot_height - ) + }, + height = input$plot_height + ) }) output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "waterfall")) - plotly_selected_q <- reactive({ - req(plotly_selected()) - primary_keys <- unname(join_keys(data())[plot_dataname, plot_dataname]) - req(primary_keys) - within( - plotly_q(), - expr = { - waterfall_selected <- dplyr::filter(dataname, xvar %in% xvals, yvar %in% yvals) %>% - dplyr::select(primary_keys) - }, - dataname = str2lang(plot_dataname), - xvar = str2lang(subject_var), - yvar = str2lang(value_var), - xvals = plotly_selected()$x, - yvals = plotly_selected()$y, - primary_keys = primary_keys - ) - }) - - children_names <- reactive({ - if (length(table_datanames) == 0) { - children(plotly_selected_q(), plot_dataname) - } else { - table_datanames - } - }) - - tables_selected_q <- eventReactive(plotly_selected_q(), { - exprs <- as.expression( - lapply( - children_names(), - function(childname) { - join_cols <- join_keys(plotly_selected_q())[childname, plot_dataname] - substitute( - expr = { - childname <- dplyr::right_join(childname, waterfall_selected, by = by) - }, - list( - childname = str2lang(childname), - by = join_cols - ) - ) - } - ) - ) - eval_code(plotly_selected_q(), exprs) - }) + tables_selected_q <- .plotly_selected_filter_children( + data = plotly_q, + plot_dataname = plot_dataname, + xvar = subject_var, + yvar = value_var, + plotly_selected = plotly_selected, + children_datanames = table_datanames + ) srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, reactable_args = reactable_args) }) } -# todo: to teal_data -children <- function(x, dataset_name = character(0)) { - checkmate::assert_multi_class(x, c("teal_data", "join_keys")) - checkmate::assert_character(dataset_name, max.len = 1) - if (length(dataset_name)) { - names( - Filter( - function(parent) parent == dataset_name, - parents(x) +waterfally <- function(data, subject_var, value_var, color_var, colors, value_arbitrary_hlines, height) { + subject_var_label <- attr(data[[subject_var]], "label") + value_var_label <- attr(data[[value_var]], "label") + color_var_label <- attr(data[[color_var]], "label") + if (!length(subject_var_label)) subject_var_label <- subject_var + if (!length(value_var_label)) value_var_label <- value_var + if (!length(color_var_label)) color_var_label <- color_var + + data %>% + dplyr::mutate( + !!as.name(subject_var) := forcats::fct_reorder( + as.factor(!!as.name(subject_var)), + !!as.name(value_var), + .fun = max, + .desc = TRUE + ), + tooltip = sprintf( + "%s: %s
%s: %s%%
%s: %s", + subject_var_label, !!as.name(subject_var), + value_var_label, !!as.name(value_var), + color_var_label, !!as.name(color_var) ) - ) - } else { - all_parents <- unique(unlist(parents(x))) - names(all_parents) <- all_parents - lapply( - all_parents, - function(parent) children(x = x, dataset_name = parent) - ) - } + ) %>% + dplyr::filter(!duplicated(!!as.name(subject_var))) %>% + plotly::plot_ly( + source = "waterfall", + height = height + ) %>% + plotly::add_bars( + x = as.formula(sprintf("~%s", subject_var)), + y = as.formula(sprintf("~%s", value_var)), + color = as.formula(sprintf("~%s", color_var)), + colors = colors, + text = ~tooltip, + hoverinfo = "text" + ) %>% + plotly::layout( + shapes = lapply(value_arbitrary_hlines, function(y) { + list( + type = "line", + x0 = 0, + x1 = 1, + xref = "paper", + y0 = y, + y1 = y, + line = list(color = "black", dash = "dot") + ) + }), + xaxis = list(title = subject_var_label, tickangle = -45), + yaxis = list(title = value_var_label), + legend = list(title = list(text = "Color by:")), + barmode = "relative" + ) %>% + plotly::layout( dragmode = "select") %>% + plotly::config(displaylogo = FALSE) } diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 08ee2eb4d..2f899a247 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -1,3 +1,10 @@ +#' `teal` module: Reactable +#' +#' Wrapper module on [reactable::reactable()] +#' +#' @inheritParams teal::module +#' @inheritParams shared_params +#' @param reactable_args (`list`) any argument of [reactable::reactable()]. #' @export tm_t_reactables <- function(label = "Table", datanames = "all", @@ -23,7 +30,7 @@ tm_t_reactables <- function(label = "Table", ui_t_reactables <- function(id, decorators = list()) { ns <- NS(id) - uiOutput(ns("subtables"), container = bslib::page_fluid) + uiOutput(ns("subtables"), container = div) } srv_t_reactables <- function(id, data, filter_panel_api, datanames, colnames = list(), decorators = list(), reactable_args = list()) { @@ -127,6 +134,8 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco req(data()) teal.data::col_labels(data()[[dataname]], fill = TRUE) }) + + reactable_args_r <- if (is.reactive(reactable_args)) reactable_args else reactive(reactable_args) cols_choices <- reactiveVal() cols_selected <- reactiveVal() @@ -170,7 +179,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco reactable_call <- .make_reactable_call( dataset = data()[[dataname]][cols_selected()], dataname = dataname, - args = reactable_args + args = reactable_args_r() ) data() |> @@ -200,6 +209,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco table_q() } }) + table_selected_q }) } diff --git a/R/utils.R b/R/utils.R index ad198658f..92a62bdb6 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,51 +1,3 @@ -#' Shared parameters documentation -#' -#' Defines common arguments shared across multiple functions in the package -#' to avoid repetition by using `inheritParams`. -#' -#' @param plot_height (`numeric`) optional, specifies the plot height as a three-element vector of -#' `value`, `min`, and `max` intended for use with a slider UI element. -#' @param plot_width (`numeric`) optional, specifies the plot width as a three-element vector of -#' `value`, `min`, and `max` for a slider encoding the plot width. -#' @param rotate_xaxis_labels (`logical`) optional, whether to rotate plot X axis labels. Does not -#' rotate by default (`FALSE`). -#' @param ggtheme (`character`) optional, `ggplot2` theme to be used by default. Defaults to `"gray"`. -#' @param ggplot2_args (`ggplot2_args`) object created by [teal.widgets::ggplot2_args()] -#' with settings for the module plot. -#' The argument is merged with options variable `teal.ggplot2_args` and default module setup. -#' -#' For more details see the vignette: `vignette("custom-ggplot2-arguments", package = "teal.widgets")` -#' @param basic_table_args (`basic_table_args`) object created by [teal.widgets::basic_table_args()] -#' with settings for the module table. -#' The argument is merged with options variable `teal.basic_table_args` and default module setup. -#' -#' For more details see the vignette: `vignette("custom-basic-table-arguments", package = "teal.widgets")` -#' @param pre_output (`shiny.tag`) optional, text or UI element to be displayed before the module's output, -#' providing context or a title. -#' with text placed before the output to put the output into context. For example a title. -#' @param post_output (`shiny.tag`) optional, text or UI element to be displayed after the module's output, -#' adding context or further instructions. Elements like `shiny::helpText()` are useful. -#' @param alpha (`integer(1)` or `integer(3)`) optional, specifies point opacity. -#' - When the length of `alpha` is one: the plot points will have a fixed opacity. -#' - When the length of `alpha` is three: the plot points opacity are dynamically adjusted based on -#' vector of `value`, `min`, and `max`. -#' @param size (`integer(1)` or `integer(3)`) optional, specifies point size. -#' - When the length of `size` is one: the plot point sizes will have a fixed size. -#' - When the length of `size` is three: the plot points size are dynamically adjusted based on -#' vector of `value`, `min`, and `max`. -#' @param decorators `r lifecycle::badge("experimental")` -#' (named `list` of lists of `teal_transform_module`) optional, -#' decorator for tables or plots included in the module output reported. -#' The decorators are applied to the respective output objects. -#' -#' See section "Decorating Module" below for more details. -#' -#' @return Object of class `teal_module` to be used in `teal` applications. -#' -#' @name shared_params -#' @keywords internal -NULL - #' Add labels for facets to a `ggplot2` object #' #' Enhances a `ggplot2` plot by adding labels that describe @@ -398,42 +350,96 @@ select_decorators <- function(decorators, scope) { } } - -#' Color palette discrete -#' -#' To specify custom discrete colors to `plotly` or `ggplot` elements one needs to specify a vector named by -#' levels of variable used for coloring. This function allows to specify only some or none of the colors/levels -#' as the rest will be filled automatically. -#' @param levels (`character`) values of possible variable levels -#' @param color (`named character`) valid color names (see [colors()]) or hex-colors named by `levels`. -#' @return `character` with hex colors named by `levels`. -.color_palette_discrete <- function(levels, color) { - p <- color[names(color) %in% levels] - p_rgb_num <- col2rgb(p) - p_hex <- rgb(p_rgb_num[1,]/255, p_rgb_num[2,]/255, p_rgb_num[3,]/255) - p <- setNames(p_hex, names(p)) - missing_levels <- setdiff(levels, names(p)) - N <- length(levels) - n <- length(p) - m <- N - n - if (m > 0 && n > 0) { - current_space <- rgb2hsv(col2rgb(p)) - optimal_color_space <- colorspace::qualitative_hcl(N) - color_distances <- dist(t(cbind(current_space, rgb2hsv(col2rgb(optimal_color_space))))) - optimal_to_current_dist <- as.matrix(color_distances)[seq_len(n), -seq_len(n)] - furthest_neighbours_idx <- order(apply(optimal_to_current_dist, 2, min), decreasing = TRUE) - missing_colors <- optimal_color_space[furthest_neighbours_idx][seq_len(m)] - p <- c(p, setNames(missing_colors, missing_levels)) - } else if (length(missing_levels)) { - colorspace::qualitative_hcl(N) +# todo: to teal_data +children <- function(x, dataset_name = character(0)) { + checkmate::assert_multi_class(x, c("teal_data", "join_keys")) + checkmate::assert_character(dataset_name, max.len = 1) + if (length(dataset_name)) { + names( + Filter( + function(parent) parent == dataset_name, + parents(x) + ) + ) } else { - p + all_parents <- unique(unlist(parents(x))) + names(all_parents) <- all_parents + lapply( + all_parents, + function(parent) children(x = x, dataset_name = parent) + ) } - p[levels] } -.shape_palette_discrete <- function(levels, symbol) { - s <- setNames(symbol[levels], levels) - s[is.na(s)] <- "circle-open" - s +.name_to_id <- function(name) { + gsub("[[:space:][:punct:]]+", "_", x = tolower(name)) +} + +#' Filter children on `plotly_selected` +#' +#' @description +#' Filters children datanames according to: +#' - selected x and y values on the plot (based on the parent dataset) +#' - [`teal.data::join_keys`] relationship between `children_datanames` +#' +#' @param data (`reactive teal_data`) +#' @param plot_dataname (`character(1)`) +#' @param xvar (`character(1)`) +#' @param yvar (`character(1)`) +#' @param plotly_selected (`reactive`) +#' @param children_datanames (`character`) +.plotly_selected_filter_children <- function(data, plot_dataname, xvar, yvar, plotly_selected, children_datanames) { + plotly_selected_q <- reactive({ + req(plotly_selected()) + # todo: change it to foreign keys needed to merge with children_datanames + primary_keys <- unname(join_keys(data())[plot_dataname, plot_dataname]) + if (length(primary_keys) == 0) { + primary_keys <- unique(sapply(children_datanames, USE.NAMES = FALSE, FUN = function(childname) { + names(join_keys(data())[plot_dataname, childname]) + })) + } + req(primary_keys) + within( + data(), + expr = { + swimlane_selected <- dplyr::filter(dataname, xvar %in% xvals, yvar %in% yvals) %>% + dplyr::select(primary_keys) + }, + dataname = str2lang(plot_dataname), + xvar = str2lang(xvar), + yvar = str2lang(yvar), + xvals = plotly_selected()$x, + yvals = plotly_selected()$y, + primary_keys = primary_keys + ) + }) + + children_names <- reactive({ + if (length(children_datanames) == 0) { + children(plotly_selected_q(), plot_dataname) + } else { + children_datanames + } + }) + + eventReactive(plotly_selected_q(), { + exprs <- as.expression( + lapply( + children_names(), + function(childname) { + join_cols <- join_keys(plotly_selected_q())[childname, plot_dataname] + substitute( + expr = { + childname <- dplyr::right_join(childname, swimlane_selected, by = by) + }, + list( + childname = str2lang(childname), + by = join_cols + ) + ) + } + ) + ) + q <- eval_code(plotly_selected_q(), exprs) + }) } diff --git a/man/dot-color_palette_discrete.Rd b/man/dot-color_palette_discrete.Rd index ce42d0d3a..c1b3ef4b1 100644 --- a/man/dot-color_palette_discrete.Rd +++ b/man/dot-color_palette_discrete.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R +% Please edit documentation in R/module_colur_picker.R \name{.color_palette_discrete} \alias{.color_palette_discrete} \title{Color palette discrete} diff --git a/man/dot-plotly_selected_filter_children.Rd b/man/dot-plotly_selected_filter_children.Rd new file mode 100644 index 000000000..b6531a345 --- /dev/null +++ b/man/dot-plotly_selected_filter_children.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{.plotly_selected_filter_children} +\alias{.plotly_selected_filter_children} +\title{Filter children on \code{plotly_selected}} +\usage{ +.plotly_selected_filter_children( + data, + plot_dataname, + xvar, + yvar, + plotly_selected, + children_datanames +) +} +\arguments{ +\item{data}{(\verb{reactive teal_data})} + +\item{plot_dataname}{(\code{character(1)})} + +\item{xvar}{(\code{character(1)})} + +\item{yvar}{(\code{character(1)})} + +\item{plotly_selected}{(\code{reactive})} + +\item{children_datanames}{(\code{character})} +} +\description{ +Filters children datanames according to: +\itemize{ +\item selected x and y values on the plot (based on the parent dataset) +\item \code{\link[teal.data:join_keys]{teal.data::join_keys}} relationship between \code{children_datanames} +} +} diff --git a/man/shared_params.Rd b/man/shared_params.Rd index 5e27ea0dc..979a02926 100644 --- a/man/shared_params.Rd +++ b/man/shared_params.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R +% Please edit documentation in R/roxygen2_templates.R \name{shared_params} \alias{shared_params} \title{Shared parameters documentation} @@ -51,8 +51,12 @@ vector of \code{value}, \code{min}, and \code{max}. \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (named \code{list} of lists of \code{teal_transform_module}) optional, decorator for tables or plots included in the module output reported. -The decorators are applied to the respective output objects. +The decorators are applied to the respective output objects.} +\item{table_datanames}{(\code{character}) names of the datasets which should be listed below the plot +when some data points are selected. Objects named after \code{table_datanames} will be pulled from +\code{data} so it is important that data actually contains these datasets. Please be aware that +table datasets must be linked with \code{plot_dataname} by the relevant \code{\link[=join_keys]{join_keys()}}. See section "Decorating Module" below for more details.} } \value{ diff --git a/man/tm_a_pca.Rd b/man/tm_a_pca.Rd index 2fdfdf650..5d8440667 100644 --- a/man/tm_a_pca.Rd +++ b/man/tm_a_pca.Rd @@ -79,9 +79,7 @@ To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (named \code{list} of lists of \code{teal_transform_module}) optional, decorator for tables or plots included in the module output reported. -The decorators are applied to the respective output objects. - -See section "Decorating Module" below for more details.} +The decorators are applied to the respective output objects.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. diff --git a/man/tm_a_regression.Rd b/man/tm_a_regression.Rd index 37a215e71..d401eb46a 100644 --- a/man/tm_a_regression.Rd +++ b/man/tm_a_regression.Rd @@ -103,9 +103,7 @@ To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (named \code{list} of lists of \code{teal_transform_module}) optional, decorator for tables or plots included in the module output reported. -The decorators are applied to the respective output objects. - -See section "Decorating Module" below for more details.} +The decorators are applied to the respective output objects.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. diff --git a/man/tm_g_association.Rd b/man/tm_g_association.Rd index 9e651dc70..c82e8f8b2 100644 --- a/man/tm_g_association.Rd +++ b/man/tm_g_association.Rd @@ -64,9 +64,7 @@ To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (named \code{list} of lists of \code{teal_transform_module}) optional, decorator for tables or plots included in the module output reported. -The decorators are applied to the respective output objects. - -See section "Decorating Module" below for more details.} +The decorators are applied to the respective output objects.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. diff --git a/man/tm_g_bivariate.Rd b/man/tm_g_bivariate.Rd index 09fd2e2d2..bd1f76af0 100644 --- a/man/tm_g_bivariate.Rd +++ b/man/tm_g_bivariate.Rd @@ -109,9 +109,7 @@ To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (named \code{list} of lists of \code{teal_transform_module}) optional, decorator for tables or plots included in the module output reported. -The decorators are applied to the respective output objects. - -See section "Decorating Module" below for more details.} +The decorators are applied to the respective output objects.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. diff --git a/man/tm_g_distribution.Rd b/man/tm_g_distribution.Rd index a064a26fe..dd61e723d 100644 --- a/man/tm_g_distribution.Rd +++ b/man/tm_g_distribution.Rd @@ -71,9 +71,7 @@ To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (named \code{list} of lists of \code{teal_transform_module}) optional, decorator for tables or plots included in the module output reported. -The decorators are applied to the respective output objects. - -See section "Decorating Module" below for more details.} +The decorators are applied to the respective output objects.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. diff --git a/man/tm_g_response.Rd b/man/tm_g_response.Rd index 2a617112a..44ce0a985 100644 --- a/man/tm_g_response.Rd +++ b/man/tm_g_response.Rd @@ -89,9 +89,7 @@ To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (named \code{list} of lists of \code{teal_transform_module}) optional, decorator for tables or plots included in the module output reported. -The decorators are applied to the respective output objects. - -See section "Decorating Module" below for more details.} +The decorators are applied to the respective output objects.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. diff --git a/man/tm_g_scatterplot.Rd b/man/tm_g_scatterplot.Rd index 556c87b34..383eeae00 100644 --- a/man/tm_g_scatterplot.Rd +++ b/man/tm_g_scatterplot.Rd @@ -102,9 +102,7 @@ To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (named \code{list} of lists of \code{teal_transform_module}) optional, decorator for tables or plots included in the module output reported. -The decorators are applied to the respective output objects. - -See section "Decorating Module" below for more details.} +The decorators are applied to the respective output objects.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. diff --git a/man/tm_g_scatterplotmatrix.Rd b/man/tm_g_scatterplotmatrix.Rd index f90d7cf52..f4b8bfe8c 100644 --- a/man/tm_g_scatterplotmatrix.Rd +++ b/man/tm_g_scatterplotmatrix.Rd @@ -43,9 +43,7 @@ To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (named \code{list} of lists of \code{teal_transform_module}) optional, decorator for tables or plots included in the module output reported. -The decorators are applied to the respective output objects. - -See section "Decorating Module" below for more details.} +The decorators are applied to the respective output objects.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. diff --git a/man/tm_g_spiderplot.Rd b/man/tm_g_spiderplot.Rd new file mode 100644 index 000000000..d0d23bb34 --- /dev/null +++ b/man/tm_g_spiderplot.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tm_g_spiderplot.R +\name{tm_g_spiderplot} +\alias{tm_g_spiderplot} +\title{\code{teal} module: Spider Plot} +\usage{ +tm_g_spiderplot( + label = "Spiderplot", + plot_dataname, + time_var, + value_var, + subject_var, + event_var, + color_var, + point_colors, + point_symbols, + plot_height = 600, + table_datanames = character(0), + reactable_args = list(), + transformator = transformator +) +} +\arguments{ +\item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. +For \code{modules()} defaults to \code{"root"}. See \code{Details}.} + +\item{plot_dataname}{(\code{character(1)}) name of the dataset which visualization is builded on.} + +\item{time_var}{(\code{character(1)}) name of the \code{numeric} column in \code{plot_dataname} to be used as x-axis.} + +\item{value_var}{(\code{character(1)}) name of the \code{numeric} column in \code{plot_dataname} to be used as y-axis. +column.} + +\item{subject_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +to be used as grouping variable for displayed lines/points.} + +\item{color_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +to be used to differentiate colors and symbols.} + +\item{point_colors}{(\verb{named character}) valid color names (see \code{\link[=colors]{colors()}}) or hex-colors named +by levels of \code{color_var} column.} + +\item{point_symbols}{(\verb{named character}) valid plotly symbol name named by levels of \code{color_var} +column.} + +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} + +\item{table_datanames}{(\code{character}) names of the datasets which should be listed below the plot +when some data points are selected. Objects named after \code{table_datanames} will be pulled from +\code{data} so it is important that data actually contains these datasets. Please be aware that +table datasets must be linked with \code{plot_dataname} by the relevant \code{\link[=join_keys]{join_keys()}}. +See section "Decorating Module" below for more details.} +} +\description{ +Module visualizes value development in time grouped by subjects. +} diff --git a/man/tm_g_swimlane.Rd b/man/tm_g_swimlane.Rd new file mode 100644 index 000000000..19c82a9be --- /dev/null +++ b/man/tm_g_swimlane.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tm_g_swimlane.R +\name{tm_g_swimlane} +\alias{tm_g_swimlane} +\title{\code{teal} module: Swimlane plot} +\usage{ +tm_g_swimlane( + label = "Swimlane", + plot_dataname, + time_var, + subject_var, + color_var, + group_var, + sort_var = NULL, + point_colors = character(0), + point_symbols, + plot_height = 700, + table_datanames = character(0), + reactable_args = list() +) +} +\arguments{ +\item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. +For \code{modules()} defaults to \code{"root"}. See \code{Details}.} + +\item{plot_dataname}{(\code{character(1)}) name of the dataset which visualization is builded on.} + +\item{time_var}{(\code{character(1)}) name of the \code{numeric} column in \code{plot_dataname} to be used as x-axis.} + +\item{subject_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +to be used as y-axis.} + +\item{color_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +to name and color subject events in time.} + +\item{group_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +to categorize type of event. +(legend is sorted according to this variable, and used in toolip to display type of the event) +todo: this can be fixed by ordering factor levels} + +\item{sort_var}{(\code{character(1)} or \code{select_spec}) name(s) of the column in \code{plot_dataname} which +value determines order of the subjects displayed on the y-axis.} + +\item{point_colors}{(\verb{named character}) valid color names (see \code{\link[=colors]{colors()}}) or hex-colors named +by levels of \code{color_var} column.} + +\item{point_symbols}{(\verb{named character}) valid plotly symbol name named by levels of \code{color_var} +column.} + +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} + +\item{table_datanames}{(\code{character}) names of the datasets which should be listed below the plot +when some data points are selected. Objects named after \code{table_datanames} will be pulled from +\code{data} so it is important that data actually contains these datasets. Please be aware that +table datasets must be linked with \code{plot_dataname} by the relevant \code{\link[=join_keys]{join_keys()}}. +See section "Decorating Module" below for more details.} +} +\description{ +Module visualizes subjects' events in time. +} diff --git a/man/tm_g_waterfall.Rd b/man/tm_g_waterfall.Rd new file mode 100644 index 000000000..660825bf3 --- /dev/null +++ b/man/tm_g_waterfall.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tm_g_waterfall.R +\name{tm_g_waterfall} +\alias{tm_g_waterfall} +\title{\code{teal} module: Waterfall plot} +\usage{ +tm_g_waterfall( + label = "Waterfall", + plot_dataname, + subject_var, + value_var, + color_var = NULL, + bar_colors = list(), + value_arbitrary_hlines = c(0.2, -0.3), + plot_title = "Waterfall plot", + plot_height = 700, + table_datanames = character(0), + reactable_args = list() +) +} +\arguments{ +\item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. +For \code{modules()} defaults to \code{"root"}. See \code{Details}.} + +\item{plot_dataname}{(\code{character(1)}) name of the dataset which visualization is builded on.} + +\item{subject_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +to be used as x-axis.} + +\item{value_var}{(\code{character(1)}) name of the \code{numeric} column in \code{plot_dataname} to be used as y-axis.} + +\item{color_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +to be used to differentiate bar colors.} + +\item{bar_colors}{(\verb{named character}) valid color names (see \code{\link[=colors]{colors()}}) or hex-colors named +by levels of \code{color_var} column.} + +\item{value_arbitrary_hlines}{(\code{numeric}) values in the same scale as \code{value_var} to horizontal +lines on the plot.} + +\item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of +\code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} + +\item{table_datanames}{(\code{character}) names of the datasets which should be listed below the plot +when some data points are selected. Objects named after \code{table_datanames} will be pulled from +\code{data} so it is important that data actually contains these datasets. Please be aware that +table datasets must be linked with \code{plot_dataname} by the relevant \code{\link[=join_keys]{join_keys()}}. +See section "Decorating Module" below for more details.} +} +\description{ +Module visualizes subjects sorted decreasingly by y-values. +} diff --git a/man/tm_missing_data.Rd b/man/tm_missing_data.Rd index 6d2f03824..80634f956 100644 --- a/man/tm_missing_data.Rd +++ b/man/tm_missing_data.Rd @@ -64,9 +64,7 @@ To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (named \code{list} of lists of \code{teal_transform_module}) optional, decorator for tables or plots included in the module output reported. -The decorators are applied to the respective output objects. - -See section "Decorating Module" below for more details.} +The decorators are applied to the respective output objects.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. diff --git a/man/tm_outliers.Rd b/man/tm_outliers.Rd index f8c15278d..888a972bc 100644 --- a/man/tm_outliers.Rd +++ b/man/tm_outliers.Rd @@ -55,9 +55,7 @@ To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (named \code{list} of lists of \code{teal_transform_module}) optional, decorator for tables or plots included in the module output reported. -The decorators are applied to the respective output objects. - -See section "Decorating Module" below for more details.} +The decorators are applied to the respective output objects.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. diff --git a/man/tm_t_crosstable.Rd b/man/tm_t_crosstable.Rd index c761018da..8a47037f8 100644 --- a/man/tm_t_crosstable.Rd +++ b/man/tm_t_crosstable.Rd @@ -58,9 +58,7 @@ To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (named \code{list} of lists of \code{teal_transform_module}) optional, decorator for tables or plots included in the module output reported. -The decorators are applied to the respective output objects. - -See section "Decorating Module" below for more details.} +The decorators are applied to the respective output objects.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. diff --git a/man/tm_t_reactables.Rd b/man/tm_t_reactables.Rd new file mode 100644 index 000000000..6257d9d2f --- /dev/null +++ b/man/tm_t_reactables.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tm_t_reactable.R +\name{tm_t_reactables} +\alias{tm_t_reactables} +\title{\code{teal} module: Reactable} +\usage{ +tm_t_reactables( + label = "Table", + datanames = "all", + colnames = list(), + transformators = list(), + decorators = list(), + reactable_args = list() +) +} +\arguments{ +\item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. +For \code{modules()} defaults to \code{"root"}. See \code{Details}.} + +\item{datanames}{(\code{character}) Names of the datasets relevant to the item. +There are 2 reserved values that have specific behaviors: +\itemize{ +\item The keyword \code{"all"} includes all datasets available in the data passed to the teal application. +\item \code{NULL} hides the sidebar panel completely. +\item If \code{transformators} are specified, their \code{datanames} are automatically added to this \code{datanames} +argument. +}} + +\item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input. +To learn more check \code{vignette("transform-input-data", package = "teal")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(named \code{list} of lists of \code{teal_transform_module}) optional, +decorator for tables or plots included in the module output reported. +The decorators are applied to the respective output objects.} + +\item{reactable_args}{(\code{list}) any argument of \code{\link[reactable:reactable]{reactable::reactable()}}.} +} +\description{ +Wrapper module on \code{\link[reactable:reactable]{reactable::reactable()}} +} From ae795f8959fda0ea1f9a9e2699293d87ca9f9610 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Tue, 25 Mar 2025 11:43:27 +0000 Subject: [PATCH 71/92] minor fix --- R/tm_a_spiderplot_mdr.R | 250 ---------------------------------------- 1 file changed, 250 deletions(-) delete mode 100644 R/tm_a_spiderplot_mdr.R diff --git a/R/tm_a_spiderplot_mdr.R b/R/tm_a_spiderplot_mdr.R deleted file mode 100644 index 6be6b7904..000000000 --- a/R/tm_a_spiderplot_mdr.R +++ /dev/null @@ -1,250 +0,0 @@ -#' @export -tm_a_spiderplot_mdr <- function(label = "Spiderplot", - dataname, - time_var, - subject_var, - value_var, - event_var, - resp_cols = c( - "subject", "raise_query", "visit_name", "rspdn", "rspd", "rspd_study_day", - "orsp", "bma", "bmb", "comnts" - ), - spep_cols = c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", - "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", - "coltm", "coltmu", "lrspep1", "mprte_raw", "mprtec" - ), - sflc_cols = c( - "subject", "visit_name", "visit_date", "form_name", "source_system_url_link", "rspdn", "rspd", - "rspd_study_day", "orsp", "bma", "bmb", "comnts", "asmntdn", "blq", "coldr", "cold_study_day", - "coltm", "coltmu", "lchfrc", "lchfr_raw", "klchf_raw", "llchf_raw", - "klchp_raw", "mprte_raw", "mprtec" - ), - plot_height = 600) { - module( - label = label, - ui = ui_a_spiderplot_mdr, - server = srv_a_spiderplot_mdr, - ui_args = list(height = plot_height), - server_args = list( - dataname = dataname, - time_var = time_var, - subject_var = subject_var, - value_var = value_var, - event_var = event_var, - resp_cols = resp_cols, - spep_cols = spep_cols, - sflc_cols = sflc_cols - ), - datanames = dataname, - ) -} - - -ui_a_spiderplot_mdr <- function(id, height) { - ns <- NS(id) - tagList( - - tagList( - div( - style = "display: flex", - div( - class = "simple-card", - style = "width: 50%", - tagList( - h4("Most Recent Resp and Best Resp"), - ui_t_reactable(ns("recent_resp")) - ) - ), - div( - class = "simple-card", - style = "width: 50%", - ui_g_spiderplot(ns("spiderplot"), height = height) - ) - ) - ), - div( - style = "display: flex", - div( - style = "width: 50%", - div( - class = "simple-card", - h4("Disease Assessment - SFLC"), - ui_t_reactable(ns("sflc_listing")) - ), - div( - class = "simple-card", - h4("Disease Assessment - SPEP"), - ui_t_reactable(ns("spep_listing")) - ) - ), - div( - class = "simple-card", - style = "width: 50%", - h4("Multiple Myeloma Response"), - ui_t_reactable(ns("all_resp")) - ) - ) - ) -} - -srv_a_spiderplot_mdr <- function(id, - data, - dataname, - time_var, - subject_var, - value_var, - event_var, - resp_cols, - spep_cols, - sflc_cols, - filter_panel_api, - plot_height = 600) { - moduleServer(id, function(input, output, session) { - # todo: plotly_excl_events should be a positive selection or tidyselect - # and exposed as arg - plotly_excl_events <- c("response_assessment", "latest_response_assessment") - plotly_data <- reactive({ - req(data()) - within( - data(), - dataname = str2lang(dataname), - event_var = str2lang(event_var), - plotly_excl_events = plotly_excl_events, - expr = spiderplot_data <- dplyr::filter(dataname, !event_var %in% plotly_excl_events) - ) - }) - plotly_selected_q <- srv_g_spiderplot( - "spiderplot", - data = plotly_data, - dataname = "spiderplot_data", - time_var = time_var, - subject_var = subject_var, - value_var = value_var, - event_var = event_var, - filter_panel_api = filter_panel_api, - plot_height = plot_height - ) - - recent_resp_q <- reactive({ - req(plotly_selected_q()) - within( - plotly_selected_q(), - dataname = str2lang(dataname), - time_var = str2lang(time_var), - subject_var = str2lang(subject_var), - value_var = str2lang(value_var), - subject_var_char = subject_var, - event_var = str2lang(event_var), - recent_resp_event = "latest_response_assessment", # todo: whattodo? - resp_cols = resp_cols, - expr = { - brushed_subjects <- dplyr::filter( - dataname, - time_var %in% plotly_brushed_time, - value_var %in% plotly_brushed_value - )[[subject_var_char]] - recent_resp <- dplyr::filter( - dataname, - event_var %in% recent_resp_event, - subject_var %in% brushed_subjects - ) |> - select(all_of(resp_cols)) - } - ) - }) - - recent_resp_selected_q <- srv_t_reactable( - "recent_resp", data = recent_resp_q, dataname = "recent_resp", selection = "single" - ) - - # todo: these tables do have the same filters and select. It is just a matter of parametrising - # to named list: - # - (table) label - # - event_level for filter - # - columns - all_resp_q <- reactive({ - req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) - within( - recent_resp_selected_q(), - dataname = str2lang(dataname), - subject_var = str2lang(subject_var), - subject_var_char = subject_var, - event_var = str2lang(event_var), - all_resp_events = "response_assessment", - resp_cols = resp_cols, - expr = { - all_resp <- dplyr::filter( - dataname, - event_var %in% all_resp_events, - subject_var %in% unique(recent_resp_selected[[subject_var_char]]) - ) |> - select(all_of(resp_cols)) - } - ) - }) - - spep_q <- reactive({ - req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) - within( - recent_resp_selected_q(), - dataname = str2lang(dataname), - subject_var = str2lang(subject_var), - subject_var_char = subject_var, - event_var = str2lang(event_var), - spep_events = "Serum M-protein", - spep_cols = spep_cols, - expr = { - spep <- dplyr::filter( - dataname, - event_var %in% spep_events, - subject_var %in% unique(recent_resp_selected[[subject_var_char]]) - ) |> - select(all_of(spep_cols)) - } - ) - }) - - sflc_q <- reactive({ - req(nrow(recent_resp_selected_q()[["recent_resp_selected"]])) - within( - recent_resp_selected_q(), - dataname = str2lang(dataname), - subject_var = str2lang(subject_var), - subject_var_char = subject_var, - event_var = str2lang(event_var), - sflc_events = c( - "Kappa free light chain quantity", - "Lambda free light chain quantity", - "Kappa-Lambda free light chain ratio" - ), - sflc_cols = sflc_cols, - expr = { - sflc <- dplyr::filter( - dataname, - event_var %in% sflc_events, - subject_var %in% unique(recent_resp_selected[[subject_var_char]]) - ) |> - select(all_of(sflc_cols)) - } - ) - }) - - #todo: show all_resp only if recent_resp is selected - all_resp_selected_q <- srv_t_reactable("all_resp", data = all_resp_q, dataname = "all_resp", selection = NULL) - spep_selected_d <- srv_t_reactable("spep_listing", data = spep_q, dataname = "spep", selection = NULL) - sflc_selected_d <- srv_t_reactable("sflc_listing", data = sflc_q, dataname = "sflc", selection = NULL) - - all_q <- reactive({ - req(recent_resp_selected_q(), all_resp_selected_q()) - # all_resp_selected_q could be nothing and `c` won't work because the result is unavailable before clicking subjects in the table - c(recent_resp_selected_q(), all_resp_selected_q()) - }) - - observeEvent(all_q(), { - cat(teal.code::get_code(all_q())) - }) - - - }) -} From c6e44f5538f12d829e79b0d98157938824961694 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Tue, 25 Mar 2025 11:45:07 +0000 Subject: [PATCH 72/92] major cleaning --- NAMESPACE | 1 - 1 file changed, 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 8edbf3232..80948c4be 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,7 +12,6 @@ export(add_facet_labels) export(get_scatterplotmatrix_stats) export(tm_a_pca) export(tm_a_regression) -export(tm_a_spiderplot_mdr) export(tm_data_table) export(tm_file_viewer) export(tm_front_page) From 08465f652bb62c47391ad310b328b1c18d65b8fd Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Tue, 25 Mar 2025 11:56:16 +0000 Subject: [PATCH 73/92] add graphs to the namespace --- NAMESPACE | 3 +++ R/tm_g_spiderplot.R | 2 ++ R/tm_g_swimlane.R | 2 ++ R/tm_g_waterfall.R | 3 +++ 4 files changed, 10 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 80948c4be..d37836710 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,8 @@ S3method(create_sparklines,logical) S3method(create_sparklines,numeric) export(add_facet_labels) export(get_scatterplotmatrix_stats) +export(spiderplotly) +export(swimlanely) export(tm_a_pca) export(tm_a_regression) export(tm_data_table) @@ -29,6 +31,7 @@ export(tm_outliers) export(tm_t_crosstable) export(tm_t_reactables) export(tm_variable_browser) +export(waterfally) import(ggmosaic) import(ggplot2) import(shiny) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 4b4129e50..f86a23fdb 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -153,6 +153,8 @@ srv_g_spiderplot <- function(id, }) } +# todo: export is temporary, this should go to a new package teal.graphs or another bird species +#' @export spiderplotly <- function(data, time_var, value_var, subject_var, event_var, color_var, colors, symbols, height) { subject_var_label <- attr(data[[subject_var]], "label") time_var_label <- attr(data[[time_var]], "label") diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index bc0ef5d11..64518f772 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -171,6 +171,8 @@ srv_g_swimlane <- function(id, } +# todo: export is temporary, this should go to a new package teal.graphs or another bird species +#' @export swimlanely <- function(data, time_var, subject_var, color_var, group_var, sort_var, colors, symbols, height) { subject_var_label <- attr(data[[subject_var]], "label") time_var_label <- attr(data[[time_var]], "label") diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index c39530c5f..b5af546a8 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -140,6 +140,9 @@ srv_g_waterfall <- function(id, }) } + +# todo: export is temporary, this should go to a new package teal.graphs or another bird species +#' @export waterfally <- function(data, subject_var, value_var, color_var, colors, value_arbitrary_hlines, height) { subject_var_label <- attr(data[[subject_var]], "label") value_var_label <- attr(data[[value_var]], "label") From b6ed6539af026c809d9377ae8b0eb0dbc0ecca8a Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Fri, 28 Mar 2025 11:16:02 +0000 Subject: [PATCH 74/92] tm_rmarkdown --- DESCRIPTION | 9 ++++- NAMESPACE | 2 + R/module_colur_picker.R | 14 +++---- R/plotly_with_settings.R | 10 +++++ R/tm_data_table.R | 2 +- R/tm_g_spiderplot.R | 22 +++++------ R/tm_g_swimlane.R | 51 +++++++++++++------------ R/tm_g_waterfall.R | 8 ++-- R/tm_markdown.R | 80 ++++++++++++++++++++++++++++++++++++++++ R/tm_t_reactable.R | 6 +-- R/tm_variable_browser.R | 2 +- R/utils.R | 12 +++--- R/zzz.R | 1 + man/tm_rmarkdown.Rd | 58 +++++++++++++++++++++++++++++ 14 files changed, 219 insertions(+), 58 deletions(-) create mode 100644 R/plotly_with_settings.R create mode 100644 R/tm_markdown.R create mode 100644 man/tm_rmarkdown.Rd diff --git a/DESCRIPTION b/DESCRIPTION index cfd5caacf..a69bec3fa 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -32,6 +32,7 @@ Depends: Imports: bslib (>= 0.8.0), checkmate (>= 2.1.0), + colorspace, colourpicker (>= 1.3.0), dplyr (>= 1.0.5), DT (>= 0.13), @@ -42,6 +43,8 @@ Imports: ggpp (>= 0.5.8-1), ggrepel (>= 0.9.6), goftest (>= 1.2-3), + graphics, + grDevices, grid, gridExtra (>= 2.3), htmlwidgets (>= 1.6.4), @@ -49,6 +52,10 @@ Imports: lattice (>= 0.18-4), lifecycle (>= 0.2.0), MASS (>= 7.3-60), + plotly, + reactable, + rlang (>= 1.0.0), + rmarkdown (>= 2.23), rtables (>= 0.6.11), scales (>= 1.3.0), shinyjs (>= 2.1.0), @@ -73,8 +80,6 @@ Suggests: logger (>= 0.2.0), nestcolor (>= 0.1.0), pkgload, - rlang (>= 1.0.0), - rmarkdown (>= 2.23), roxy.shinylive, rvest, shinytest2, diff --git a/NAMESPACE b/NAMESPACE index d37836710..d85616edb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,7 @@ export(tm_g_swimlane) export(tm_g_waterfall) export(tm_missing_data) export(tm_outliers) +export(tm_rmarkdown) export(tm_t_crosstable) export(tm_t_reactables) export(tm_variable_browser) @@ -39,3 +40,4 @@ import(teal) import(teal.transform) importFrom(dplyr,"%>%") importFrom(lifecycle,deprecated) +importFrom(rlang,":=") diff --git a/R/module_colur_picker.R b/R/module_colur_picker.R index 2d363e371..7d5fd7602 100644 --- a/R/module_colur_picker.R +++ b/R/module_colur_picker.R @@ -69,21 +69,21 @@ colour_picker_srv <- function(id, x, default_colors) { #' @return `character` with hex colors named by `levels`. .color_palette_discrete <- function(levels, color) { p <- color[names(color) %in% levels] - p_rgb_num <- col2rgb(p) - p_hex <- rgb(p_rgb_num[1,]/255, p_rgb_num[2,]/255, p_rgb_num[3,]/255) - p <- setNames(p_hex, names(p)) + p_rgb_num <- grDevices::col2rgb(p) + p_hex <- grDevices::rgb(p_rgb_num[1,]/255, p_rgb_num[2,]/255, p_rgb_num[3,]/255) + p <- stats::setNames(p_hex, names(p)) missing_levels <- setdiff(levels, names(p)) N <- length(levels) n <- length(p) m <- N - n if (m > 0 && n > 0) { - current_space <- rgb2hsv(col2rgb(p)) + current_space <- grDevices::rgb2hsv(grDevices::col2rgb(p)) optimal_color_space <- colorspace::qualitative_hcl(N) - color_distances <- dist(t(cbind(current_space, rgb2hsv(col2rgb(optimal_color_space))))) + color_distances <- stats::dist(t(cbind(current_space, grDevices::rgb2hsv(grDevices::col2rgb(optimal_color_space))))) optimal_to_current_dist <- as.matrix(color_distances)[seq_len(n), -seq_len(n)] furthest_neighbours_idx <- order(apply(optimal_to_current_dist, 2, min), decreasing = TRUE) missing_colors <- optimal_color_space[furthest_neighbours_idx][seq_len(m)] - p <- c(p, setNames(missing_colors, missing_levels)) + p <- c(p, stats::setNames(missing_colors, missing_levels)) } else if (length(missing_levels)) { colorspace::qualitative_hcl(N) } else { @@ -93,7 +93,7 @@ colour_picker_srv <- function(id, x, default_colors) { } .shape_palette_discrete <- function(levels, symbol) { - s <- setNames(symbol[levels], levels) + s <- stats::setNames(symbol[levels], levels) s[is.na(s)] <- "circle-open" s } diff --git a/R/plotly_with_settings.R b/R/plotly_with_settings.R new file mode 100644 index 000000000..7c00559a2 --- /dev/null +++ b/R/plotly_with_settings.R @@ -0,0 +1,10 @@ +plotly_with_settings_ui <- function(id, height) { + ns <- NS(id) + plotly::plotlyOutput(ns("plot"), height = height) +} + +plotly_with_settings_srv <- function(id, plot) { + moduleServer(id, function(input, output, session) { + output$plot <- plotly::renderPlotly(plot()) + }) +} \ No newline at end of file diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 724254aa8..7670a9337 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -377,7 +377,7 @@ srv_dataset_table <- function(id, id = "brush_filter" )) shinyjs::hide("apply_brush_filter") - set_filter_state(filter_panel_api, slice) + teal.slice::set_filter_state(filter_panel_api, slice) }) }) } diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index f86a23fdb..ecc79c07a 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -149,7 +149,7 @@ srv_g_spiderplot <- function(id, children_datanames = table_datanames ) - srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, reactable_args = reactable_args) + srv_t_reactables("subtables", data = tables_selected_q, datanames = table_datanames, reactable_args = reactable_args) }) } @@ -164,9 +164,9 @@ spiderplotly <- function(data, time_var, value_var, subject_var, event_var, colo if (!length(event_var_label)) event_var_label <- event_var data %>% - arrange(!!as.name(subject_var), !!as.name(time_var)) %>% - group_by(!!as.name(subject_var)) %>% - mutate( + dplyr::arrange(!!as.name(subject_var), !!as.name(time_var)) %>% + dplyr::group_by(!!as.name(subject_var)) %>% + dplyr::mutate( x = dplyr::lag(!!as.name(time_var), default = 0), y = dplyr:::lag(!!as.name(value_var), default = 0), tooltip = sprintf( @@ -176,24 +176,24 @@ spiderplotly <- function(data, time_var, value_var, subject_var, event_var, colo event_var_label, !!as.name(value_var) * 100 ) ) %>% - ungroup() %>% + dplyr::ungroup() %>% plotly::plot_ly( source = "spiderplot", height = height, - color = as.formula(sprintf("~%s", color_var)), + color = stats::as.formula(sprintf("~%s", color_var)), colors = colors, symbols = symbols ) %>% plotly::add_segments( x = ~x, y = ~y, - xend = as.formula(sprintf("~%s", time_var)), - yend = as.formula(sprintf("~%s", value_var)) + xend = stats::as.formula(sprintf("~%s", time_var)), + yend = stats::as.formula(sprintf("~%s", value_var)) ) %>% plotly::add_markers( - x = as.formula(sprintf("~%s", time_var)), - y = as.formula(sprintf("~%s", value_var)), - symbol = as.formula(sprintf("~%s", color_var)), + x = stats::as.formula(sprintf("~%s", time_var)), + y = stats::as.formula(sprintf("~%s", value_var)), + symbol = stats::as.formula(sprintf("~%s", color_var)), text = ~tooltip, hoverinfo = "text" ) %>% diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 64518f772..063dfe467 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -65,7 +65,7 @@ ui_g_swimlane <- function(id, height) { sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), bslib::page_fillable( - plotly::plotlyOutput(ns("plot"), height = "100%"), + plotly_with_settings_ui(ns("plot"), height = "100"), ui_t_reactables(ns("subtables")) ) ) @@ -145,11 +145,14 @@ srv_g_swimlane <- function(id, ) }) - output$plot <- plotly::renderPlotly({ - plotly_q()$p |> - plotly::event_register("plotly_selected") |> - plotly::event_register("plotly_deselect") # todo: deselect doesn't work - }) + output$plot <- plotly_with_settings_srv( + "plot", + plot = reactive({ + plotly_q()$p |> + plotly::event_register("plotly_selected") |> + plotly::event_register("plotly_deselect") # todo: deselect doesn't work + }) + ) plotly_selected <- reactive({ plotly::event_data("plotly_deselect", source = "swimlane") # todo: deselect doesn't work @@ -165,7 +168,7 @@ srv_g_swimlane <- function(id, children_datanames = table_datanames ) - srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, reactable_args = reactable_args) + srv_t_reactables("subtables", data = tables_selected_q, datanames = table_datanames, reactable_args = reactable_args) }) } @@ -181,19 +184,19 @@ swimlanely <- function(data, time_var, subject_var, color_var, group_var, sort_v # forcats::fct_reorder doesn't seem to work here subject_levels <- data %>% - group_by(!!as.name(subject_var)) %>% - summarize(v = max(!!as.name(sort_var))) %>% - ungroup() %>% - arrange(v) %>% - pull(!!as.name(subject_var)) + dplyr::group_by(!!as.name(subject_var)) %>% + dplyr::summarize(v = max(!!as.name(sort_var))) %>% + dplyr::ungroup() %>% + dplyr::arrange(v) %>% + dplyr::pull(!!as.name(subject_var)) data[[subject_var]] <- factor(data[[subject_var]], levels = subject_levels) data %>% - mutate( + dplyr::mutate( !!as.name(color_var) := factor(!!as.name(color_var), levels = names(colors)), ) %>% - group_by(!!as.name(subject_var), !!as.name(time_var)) %>% - mutate( + dplyr::group_by(!!as.name(subject_var), !!as.name(time_var)) %>% + dplyr::mutate( tooltip = paste( unique( c( @@ -216,19 +219,21 @@ swimlanely <- function(data, time_var, subject_var, color_var, group_var, sort_v height = height ) %>% plotly::add_markers( - x = as.formula(sprintf("~%s", time_var)), - y = as.formula(sprintf("~%s", subject_var)), - color = as.formula(sprintf("~%s", color_var)), - symbol = as.formula(sprintf("~%s", color_var)), + x = stats::as.formula(sprintf("~%s", time_var)), + y = stats::as.formula(sprintf("~%s", subject_var)), + color = stats::as.formula(sprintf("~%s", color_var)), + symbol = stats::as.formula(sprintf("~%s", color_var)), text = ~tooltip, hoverinfo = "text" ) %>% plotly::add_segments( - x = ~0, xend = ~study_day, - y = as.formula(sprintf("~%s", subject_var)), yend = as.formula(sprintf("~%s", subject_var)), + x = ~0, + xend = ~study_day, + y = stats::as.formula(sprintf("~%s", subject_var)), + yend = stats::as.formula(sprintf("~%s", subject_var)), data = data |> - group_by(!!as.name(subject_var), !!as.name(group_var)) |> - summarise(study_day = max(!!as.name(time_var))), + dplyr::group_by(!!as.name(subject_var), !!as.name(group_var)) |> + dplyr::summarise(study_day = max(!!as.name(time_var))), line = list(width = 2, color = "grey"), showlegend = FALSE ) %>% diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index b5af546a8..a83cfc58c 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -136,7 +136,7 @@ srv_g_waterfall <- function(id, children_datanames = table_datanames ) - srv_t_reactables("subtables", data = tables_selected_q, dataname = table_datanames, reactable_args = reactable_args) + srv_t_reactables("subtables", data = tables_selected_q, datanames = table_datanames, reactable_args = reactable_args) }) } @@ -172,9 +172,9 @@ waterfally <- function(data, subject_var, value_var, color_var, colors, value_ar height = height ) %>% plotly::add_bars( - x = as.formula(sprintf("~%s", subject_var)), - y = as.formula(sprintf("~%s", value_var)), - color = as.formula(sprintf("~%s", color_var)), + x = stats::as.formula(sprintf("~%s", subject_var)), + y = stats::as.formula(sprintf("~%s", value_var)), + color = stats::as.formula(sprintf("~%s", color_var)), colors = colors, text = ~tooltip, hoverinfo = "text" diff --git a/R/tm_markdown.R b/R/tm_markdown.R new file mode 100644 index 000000000..53d6d489e --- /dev/null +++ b/R/tm_markdown.R @@ -0,0 +1,80 @@ +#' `teal` module: Rmarkdown page +#' +#' Render arbitrary Rmarkdown code. `data` provided to teal application are available in the +#' rendered document. +#' +#' @inheritParams teal::module +#' @inheritParams shared_params +#' @inheritParams rmarkdown::render +#' @param text (`character`) arbitrary Rmd code +#' +#' @inherit shared_params return +#' +#' @examplesShinylive +#' library(teal.modules.general) +#' interactive <- function() TRUE +#' {{ next_example }} +#' @examples +#' data <- teal_data() |> +#' within({ +#' iris <- iris +#' mtcars <- mtcars +#' }) +# +#' +#' @export +#' +tm_rmarkdown <- function(label = "App Info", + text = character(0), + params = list(title = "Document", output = "html_output"), + datanames = "all") { + message("Initializing tm_front_page") + + # Start of assertions + checkmate::assert_string(label) + checkmate::assert_character(text, min.len = 0, any.missing = FALSE) + checkmate::assert_list(params) + + + ans <- module( + label = label, + server = srv_rmarkdown, + ui = ui_rmarkdown, + server_args = list(text = text, params = params), + datanames = datanames + ) + attr(ans, "teal_bookmarkable") <- TRUE + ans +} + +# UI function for the front page module +ui_rmarkdown <- function(id, ...) { + args <- list(...) + ns <- NS(id) + uiOutput(ns("output")) +} + +# Server function for the front page module +srv_rmarkdown <- function(id, data, text, params) { + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") + moduleServer(id, function(input, output, session) { + file <- tempfile(fileext = ".Rmd") + if (!file.exists(file)) { + cat(text, file = file) + } + + rmd_out <- reactive({ + rmarkdown::render( + file, + envir = data(), + params = utils::modifyList(params, list(output = "html_document")) # html_document always as we renderUI below + ) + }) + + output$output <- renderUI({ + on.exit(unlink(rmd_out())) + shiny::HTML(paste(readLines(rmd_out()), collpse = "\n")) + }) + }) +} diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 2f899a247..1f2a5ff13 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -147,7 +147,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco names(dataset_labels()) } labels_choices <- dataset_labels()[choices] - cols_choices_new <- setNames(choices, labels_choices) + cols_choices_new <- stats::setNames(choices, labels_choices) if (!identical(cols_choices_new, cols_choices())) { logger::log_debug("srv_t_reactable@1 update column choices") shinyWidgets::updatePickerInput( @@ -216,7 +216,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco .make_reactable_call <- function(dataset, dataname, args) { columns <- .make_reactable_columns_call(dataset = dataset, col_defs = args$columns) - call_args <- modifyList( + call_args <- utils::modifyList( list(columns = columns, onClick = "select"), args[!names(args) %in% "columns"] ) @@ -248,7 +248,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco is_labelled <- length(label) == 1 && !is.na(label) && !identical(label, "") default_col_def <- if (is_labelled) list(name = label) else list() col_def_override <- if (!is.null(col_defs[[i]])) col_defs[[i]] else list() - col_def_args <- modifyList(default_col_def, col_def_override) + col_def_args <- utils::modifyList(default_col_def, col_def_override) if (length(col_def_args)) { as.call( c( diff --git a/R/tm_variable_browser.R b/R/tm_variable_browser.R index c6819fadb..a48148dfa 100644 --- a/R/tm_variable_browser.R +++ b/R/tm_variable_browser.R @@ -956,7 +956,7 @@ render_tab_table <- function(dataset_name, parent_dataname, output, data, input, join_keys <- teal.data::join_keys(data()) if (!is.null(join_keys)) { - icons[intersect(join_keys[dataset_name, dataset_name], colnames(df))] <- "primary_key" + icons[intersect(teal.data::join_keys[dataset_name, dataset_name], colnames(df))] <- "primary_key" } icons <- variable_type_icons(icons) diff --git a/R/utils.R b/R/utils.R index 92a62bdb6..7d32953ed 100644 --- a/R/utils.R +++ b/R/utils.R @@ -358,11 +358,11 @@ children <- function(x, dataset_name = character(0)) { names( Filter( function(parent) parent == dataset_name, - parents(x) + teal.data::parents(x) ) ) } else { - all_parents <- unique(unlist(parents(x))) + all_parents <- unique(unlist(teal.data::parents(x))) names(all_parents) <- all_parents lapply( all_parents, @@ -392,10 +392,10 @@ children <- function(x, dataset_name = character(0)) { plotly_selected_q <- reactive({ req(plotly_selected()) # todo: change it to foreign keys needed to merge with children_datanames - primary_keys <- unname(join_keys(data())[plot_dataname, plot_dataname]) + primary_keys <- unname(teal.data::join_keys(data())[plot_dataname, plot_dataname]) if (length(primary_keys) == 0) { primary_keys <- unique(sapply(children_datanames, USE.NAMES = FALSE, FUN = function(childname) { - names(join_keys(data())[plot_dataname, childname]) + names(teal.data::join_keys(data())[plot_dataname, childname]) })) } req(primary_keys) @@ -427,7 +427,7 @@ children <- function(x, dataset_name = character(0)) { lapply( children_names(), function(childname) { - join_cols <- join_keys(plotly_selected_q())[childname, plot_dataname] + join_cols <- teal.data::join_keys(plotly_selected_q())[childname, plot_dataname] substitute( expr = { childname <- dplyr::right_join(childname, swimlane_selected, by = by) @@ -440,6 +440,6 @@ children <- function(x, dataset_name = character(0)) { } ) ) - q <- eval_code(plotly_selected_q(), exprs) + q <- teal.code::eval_code(plotly_selected_q(), exprs) }) } diff --git a/R/zzz.R b/R/zzz.R index 2ccb87747..fcc99baf1 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -7,4 +7,5 @@ ggplot_themes <- c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void") #' @importFrom lifecycle deprecated +#' @importFrom rlang := interactive <- NULL diff --git a/man/tm_rmarkdown.Rd b/man/tm_rmarkdown.Rd new file mode 100644 index 000000000..fcd41be03 --- /dev/null +++ b/man/tm_rmarkdown.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tm_markdown.R +\name{tm_rmarkdown} +\alias{tm_rmarkdown} +\title{\code{teal} module: Rmarkdown page} +\usage{ +tm_rmarkdown( + label = "App Info", + text = character(0), + params = list(title = "Document", output = "html_output"), + datanames = "all" +) +} +\arguments{ +\item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. +For \code{modules()} defaults to \code{"root"}. See \code{Details}.} + +\item{text}{(\code{character}) arbitrary Rmd code} + +\item{params}{A list of named parameters that override custom params +specified within the YAML front-matter (e.g. specifying a dataset to read or +a date range to confine output to). Pass \code{"ask"} to start an +application that helps guide parameter configuration.} + +\item{datanames}{(\code{character}) Names of the datasets relevant to the item. +There are 2 reserved values that have specific behaviors: +\itemize{ +\item The keyword \code{"all"} includes all datasets available in the data passed to the teal application. +\item \code{NULL} hides the sidebar panel completely. +\item If \code{transformators} are specified, their \code{datanames} are automatically added to this \code{datanames} +argument. +}} +} +\value{ +Object of class \code{teal_module} to be used in \code{teal} applications. +} +\description{ +Render arbitrary Rmarkdown code. \code{data} provided to teal application are available in the +rendered document. +} +\examples{ +data <- teal_data() |> + within({ + iris <- iris + mtcars <- mtcars + }) + +} +\section{Examples in Shinylive}{ +\describe{ + \item{example-1}{ + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG10AHwA+JV1dAHdaUgALFXYQKOjdWkZaUR8MrNE06JhSAhYco11i0sYCiGiAX0UIMHqAXSA}{Open in Shinylive} + \if{html}{\out{}} + \if{html}{\out{}} + } +} +} + From a128ff7a24f55c368044ae675d9ec45c897c133d Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Fri, 28 Mar 2025 11:46:07 +0000 Subject: [PATCH 75/92] tm_rmarkdown --- DESCRIPTION | 1 + R/tm_markdown.R | 22 +++++++++++++--------- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a69bec3fa..fc1849a59 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,6 +47,7 @@ Imports: grDevices, grid, gridExtra (>= 2.3), + htmltools, htmlwidgets (>= 1.6.4), jsonlite (>= 1.8.9), lattice (>= 0.18-4), diff --git a/R/tm_markdown.R b/R/tm_markdown.R index 53d6d489e..fd7947d37 100644 --- a/R/tm_markdown.R +++ b/R/tm_markdown.R @@ -26,9 +26,9 @@ #' tm_rmarkdown <- function(label = "App Info", text = character(0), - params = list(title = "Document", output = "html_output"), + params = list(title = "Document"), datanames = "all") { - message("Initializing tm_front_page") + message("Initializing tm_rmarkdown") # Start of assertions checkmate::assert_string(label) @@ -59,22 +59,26 @@ srv_rmarkdown <- function(id, data, text, params) { checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { - file <- tempfile(fileext = ".Rmd") - if (!file.exists(file)) { - cat(text, file = file) - } - rmd_out <- reactive({ + file <- tempfile(fileext = ".Rmd") + if (!file.exists(file)) { + cat(text, file = file) + } rmarkdown::render( file, envir = data(), - params = utils::modifyList(params, list(output = "html_document")) # html_document always as we renderUI below + params = utils::modifyList( + params, + list(output = list(github_document = list(html_preview = FALSE))) # html_document always as we renderUI below + ) ) }) output$output <- renderUI({ on.exit(unlink(rmd_out())) - shiny::HTML(paste(readLines(rmd_out()), collpse = "\n")) + # todo: includeMarkdown breaks css of the app + # https://stackoverflow.com/questions/42422771/including-markdown-tables-in-shiny-app-seems-to-break-css + shiny::includeMarkdown(rmd_out()) }) }) } From bc1b4adcc06eaba05729d47817ab8d80515314c6 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Fri, 28 Mar 2025 13:00:17 +0000 Subject: [PATCH 76/92] tm_rmarkdown --- R/tm_g_swimlane.R | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 063dfe467..d49f64b3d 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -65,7 +65,7 @@ ui_g_swimlane <- function(id, height) { sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), bslib::page_fillable( - plotly_with_settings_ui(ns("plot"), height = "100"), + plotly::plotlyOutput(ns("plot"), height = "100%"), ui_t_reactables(ns("subtables")) ) ) @@ -145,14 +145,7 @@ srv_g_swimlane <- function(id, ) }) - output$plot <- plotly_with_settings_srv( - "plot", - plot = reactive({ - plotly_q()$p |> - plotly::event_register("plotly_selected") |> - plotly::event_register("plotly_deselect") # todo: deselect doesn't work - }) - ) + output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) plotly_selected <- reactive({ plotly::event_data("plotly_deselect", source = "swimlane") # todo: deselect doesn't work From 2bbbb96d5d0d76f682b3edb3f05351d2eae41ce1 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Wed, 2 Apr 2025 08:26:26 +0000 Subject: [PATCH 77/92] choices selected --- R/tm_g_spiderplot.R | 78 +++++++++++++++++++++++++----------- R/tm_g_swimlane.R | 86 ++++++++++++++++++++------------------- R/tm_g_waterfall.R | 91 +++++++++++++++++++++++++----------------- R/utils.R | 20 ++++++++-- man/tm_g_spiderplot.Rd | 10 ++--- man/tm_g_swimlane.Rd | 12 +++--- man/tm_g_waterfall.Rd | 7 ++-- man/tm_rmarkdown.Rd | 2 +- 8 files changed, 185 insertions(+), 121 deletions(-) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index ecc79c07a..5653e0dda 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -4,13 +4,13 @@ #' #' @inheritParams teal::module #' @inheritParams shared_params -#' @param plot_dataname (`character(1)`) name of the dataset which visualization is builded on. -#' @param time_var (`character(1)`) name of the `numeric` column in `plot_dataname` to be used as x-axis. -#' @param value_var (`character(1)`) name of the `numeric` column in `plot_dataname` to be used as y-axis. +#' @param plot_dataname (`character(1)` or `choices_selected`) name of the dataset which visualization is builded on. +#' @param time_var (`character(1)` or `choices_selected`) name of the `numeric` column in `plot_dataname` to be used as x-axis. +#' @param value_var (`character(1)` or `choices_selected`) name of the `numeric` column in `plot_dataname` to be used as y-axis. #' column. -#' @param subject_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' @param subject_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` #' to be used as grouping variable for displayed lines/points. -#' @param color_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' @param color_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` #' to be used to differentiate colors and symbols. #' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named #' by levels of `color_var` column. @@ -30,6 +30,22 @@ tm_g_spiderplot <- function(label = "Spiderplot", table_datanames = character(0), reactable_args = list(), transformator = transformator) { + if (is.character(time_var)) { + time_var <- choices_selected(choices = time_var, selected = time_var) + } + if (is.character(value_var)) { + value_var <- choices_selected(choices = value_var, selected = value_var) + } + if (is.character(subject_var)) { + subject_var <- choices_selected(choices = subject_var, selected = subject_var) + } + if (is.character(color_var)) { + color_var <- choices_selected(choices = color_var, selected = color_var) + } + if (is.character(event_var)) { + event_var <- choices_selected(choices = event_var, selected = event_var) + } + module( label = label, ui = ui_g_spiderplot, @@ -56,7 +72,12 @@ ui_g_spiderplot <- function(id, height) { ns <- NS(id) bslib::page_sidebar( sidebar = div( - selectInput(ns("select_event"), "Select Y Axis", NULL), + selectInput(ns("time_var"), label = "Time variable (x-axis):", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("value_var"), label = "Value variable (y-axis):", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("subject_var"), label = "Subject variable:", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("color_var"), label = "Color by:", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("event_var"), label = "Event variable:", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("evant_var_level"), "Select an event:", NULL), colour_picker_ui(ns("colors")), sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), @@ -82,42 +103,51 @@ srv_g_spiderplot <- function(id, reactable_args = list(), filter_panel_api) { moduleServer(id, function(input, output, session) { - event_levels <- reactive({ - req(data()) - unique(data()[[plot_dataname]][[event_var]]) + .update_cs_input(inputId = "value_var", data = reactive(data()[[dataname]]), cs = value_var) + .update_cs_input(inputId = "time_var", data = reactive(data()[[dataname]]), cs = time_var) + .update_cs_input(inputId = "subject_var", data = reactive(data()[[dataname]]), cs = subject_var) + .update_cs_input(inputId = "color_var", data = reactive(data()[[dataname]]), cs = color_var) + .update_cs_input(inputId = "event_var", data = reactive(data()[[dataname]]), cs = event_var) + + evant_var_levels <- reactive({ + req(data(), input$event_var) + unique(data()[[plot_dataname]][[input$event_var]]) }) - observeEvent(event_levels(), { - updateSelectInput(inputId = "select_event", choices = event_levels(), selected = event_levels()[1]) + observeEvent(evant_var_levels(), { + updateSelectInput(inputId = "evant_var_level", choices = evant_var_levels(), selected = evant_var_levels()[1]) }) color_inputs <- colour_picker_srv( "colors", - x = reactive(data()[[plot_dataname]][[color_var]]), + x = reactive({ + req(input$color_var) + data()[[plot_dataname]][[input$color_var]] + }), default_colors = point_colors ) plotly_q <- reactive({ - req(input$select_event, color_inputs()) + req(input$evant_var_level, input$time_var, input$value_var, input$subject_var, input$event_var, input$color_var, color_inputs()) adjusted_symbols <- .shape_palette_discrete( - levels = unique(data()[[plot_dataname]][[color_var]]), + levels = unique(data()[[plot_dataname]][[input$color_var]]), symbol = point_symbols ) within( data(), dataname = str2lang(plot_dataname), - event_var_lang = str2lang(event_var), - time_var = time_var, - value_var = value_var, - subject_var = subject_var, - event_var = event_var, - color_var = color_var, - selected_event = input$select_event, + event_var_lang = str2lang(input$event_var), + time_var = input$time_var, + value_var = input$value_var, + subject_var = input$subject_var, + event_var = input$event_var, + selected_event = input$evant_var_level, + color_var = input$color_var, colors = color_inputs(), symbols = adjusted_symbols, height = input$plot_height, - title = sprintf("%s over time", input$selected_event), + title = sprintf("%s over time", input$evant_var_level), expr = { p <- dataname %>% filter(event_var_lang == selected_event) %>% @@ -143,8 +173,8 @@ srv_g_spiderplot <- function(id, tables_selected_q <- .plotly_selected_filter_children( data = plotly_q, plot_dataname = plot_dataname, - xvar = time_var, - yvar = value_var, + xvar = reactive(input$time_var), + yvar = reactive(input$value_var), plotly_selected = plotly_selected, children_datanames = table_datanames ) diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index d49f64b3d..4d6d767f3 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -4,17 +4,17 @@ #' #' @inheritParams teal::module #' @inheritParams shared_params -#' @param plot_dataname (`character(1)`) name of the dataset which visualization is builded on. -#' @param time_var (`character(1)`) name of the `numeric` column in `plot_dataname` to be used as x-axis. -#' @param subject_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' @param plot_dataname (`character(1)` or `choices_selected`) name of the dataset which visualization is builded on. +#' @param time_var (`character(1)` or `choices_selected`) name of the `numeric` column in `plot_dataname` to be used as x-axis. +#' @param subject_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` #' to be used as y-axis. -#' @param color_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' @param color_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` #' to name and color subject events in time. -#' @param group_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' @param group_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` #' to categorize type of event. #' (legend is sorted according to this variable, and used in toolip to display type of the event) #' todo: this can be fixed by ordering factor levels -#' @param sort_var (`character(1)` or `select_spec`) name(s) of the column in `plot_dataname` which +#' @param sort_var (`character(1)` or `choices_selected`) name(s) of the column in `plot_dataname` which #' value determines order of the subjects displayed on the y-axis. #' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named #' by levels of `color_var` column. @@ -33,6 +33,21 @@ tm_g_swimlane <- function(label = "Swimlane", plot_height = 700, table_datanames = character(0), reactable_args = list()) { + if (is.character(time_var)) { + time_var <- choices_selected(choices = time_var, selected = time_var) + } + if (is.character(subject_var)) { + subject_var <- choices_selected(choices = subject_var, selected = subject_var) + } + if (is.character(color_var)) { + color_var <- choices_selected(choices = color_var, selected = color_var) + } + if (is.character(group_var)) { + group_var <- choices_selected(choices = group_var, selected = group_var) + } + if (is.character(sort_var)) { + sort_var <- choices_selected(choices = sort_var, selected = sort_var) + } module( label = label, ui = ui_g_swimlane, @@ -55,12 +70,14 @@ tm_g_swimlane <- function(label = "Swimlane", } ui_g_swimlane <- function(id, height) { - - ns <- NS(id) bslib::page_sidebar( sidebar = div( - selectInput(ns("sort_by"), label = "Sort by:", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("time_var"), label = "Time variable:", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("subject_var"), label = "Color by:", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("color_var"), label = "Color by:", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("group_var"), label = "Group by:", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("sort_var"), label = "Sort by:", choices = NULL, selected = NULL, multiple = FALSE), colour_picker_ui(ns("colors")), sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), @@ -84,48 +101,35 @@ srv_g_swimlane <- function(id, reactable_args = list(), filter_panel_api) { moduleServer(id, function(input, output, session) { - - sort_choices <- reactiveVal() - sort_selected <- reactiveVal() - if (inherits(sort_var, c("choices_selected", "select_spec"))) { - if (length(sort_var$choices) == 1) { - sort_var <- sort_var$choices - } else { - updateSelectInput(inputId = "sort_by", choices = sort_var$choices, selected = sort_var$selected) - observeEvent(input$sort_by, { - if (!identical(input$sort_by, sort_selected())) { - sort_selected(input$sort_by) - } - }) - } - } - - if (length(sort_var) == 1) { - isolate(sort_choices(sort_var)) - isolate(sort_selected(sort_var)) - shinyjs::hide("sort_by") - } - + .update_cs_input(inputId = "time_var", data = reactive(data()[[dataname]]), cs = time_var) + .update_cs_input(inputId = "subject_var", data = reactive(data()[[dataname]]), cs = subject_var) + .update_cs_input(inputId = "color_var", data = reactive(data()[[dataname]]), cs = color_var) + .update_cs_input(inputId = "group_var", data = reactive(data()[[dataname]]), cs = group_var) + .update_cs_input(inputId = "sort_var", data = reactive(data()[[dataname]]), cs = sort_var) + color_inputs <- colour_picker_srv( "colors", - x = reactive(data()[[plot_dataname]][[color_var]]), + x = reactive({ + req(input$color_var) + data()[[plot_dataname]][[input$color_var]] + }), default_colors = point_colors ) plotly_q <- reactive({ - req(data(), sort_selected(), color_inputs()) + req(data(), input$time_var, input$subject_var, input$color_var, input$group_var, input$sort_var, color_inputs()) adjusted_symbols <- .shape_palette_discrete( - levels = unique(data()[[plot_dataname]][[color_var]]), + levels = unique(data()[[plot_dataname]][[input$color_var]]), symbol = point_symbols ) within( data(), dataname = str2lang(plot_dataname), - time_var = time_var, - subject_var = subject_var, - color_var = color_var, - group_var = group_var, - sort_var = sort_selected(), + time_var = input$time_var, + subject_var = input$subject_var, + color_var = input$color_var, + group_var = input$group_var, + sort_var = input$sort_var, colors = color_inputs(), symbols = adjusted_symbols, height = input$plot_height, @@ -155,8 +159,8 @@ srv_g_swimlane <- function(id, tables_selected_q <- .plotly_selected_filter_children( data = plotly_q, plot_dataname = plot_dataname, - xvar = time_var, - yvar = subject_var, + xvar = reactive(input$time_var), + yvar = reactive(input$subject_var), plotly_selected = plotly_selected, children_datanames = table_datanames ) diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index a83cfc58c..751528a18 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -5,10 +5,10 @@ #' @inheritParams teal::module #' @inheritParams shared_params #' @param plot_dataname (`character(1)`) name of the dataset which visualization is builded on. -#' @param subject_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' @param subject_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` #' to be used as x-axis. -#' @param value_var (`character(1)`) name of the `numeric` column in `plot_dataname` to be used as y-axis. -#' @param color_var (`character(1)`) name of the `factor` or `character` column in `plot_dataname` +#' @param value_var (`character(1)` or `choices_selected`) name of the `numeric` column in `plot_dataname` to be used as y-axis. +#' @param color_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` #' to be used to differentiate bar colors. #' @param bar_colors (`named character`) valid color names (see [colors()]) or hex-colors named #' by levels of `color_var` column. @@ -19,6 +19,7 @@ tm_g_waterfall <- function(label = "Waterfall", plot_dataname, subject_var, value_var, + sort_var = NULL, color_var = NULL, bar_colors = list(), value_arbitrary_hlines = c(0.2, -0.3), @@ -26,6 +27,19 @@ tm_g_waterfall <- function(label = "Waterfall", plot_height = 700, table_datanames = character(0), reactable_args = list()) { + if (is.character(subject_var)) { + subject_var <- choices_selected(choices = subject_var, selected = subject_var) + } + if (is.character(value_var)) { + value_var <- choices_selected(choices = value_var, selected = value_var) + } + if (is.character(sort_var)) { + sort_var <- choices_selected(choices = sort_var, selected = sort_var) + } + if (is.character(color_var)) { + color_var <- choices_selected(choices = color_var, selected = color_var) + } + module( label = label, ui = ui_g_waterfall, @@ -37,6 +51,7 @@ tm_g_waterfall <- function(label = "Waterfall", table_datanames = table_datanames, subject_var = subject_var, value_var = value_var, + sort_var = sort_var, color_var = color_var, bar_colors = bar_colors, value_arbitrary_hlines = value_arbitrary_hlines, @@ -51,7 +66,10 @@ ui_g_waterfall <- function(id, height) { bslib::page_sidebar( sidebar = div( - uiOutput(ns("color_by_output")), + selectInput(ns("subject_var"), label = "Subject variable (x-axis):", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("value_var"), label = "Value variable (y-axis):", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("sort_var"), label = "Sort by:", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("color_var"), label = "Color by:", choices = NULL, selected = NULL, multiple = FALSE), colour_picker_ui(ns("colors")), sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), @@ -66,6 +84,7 @@ srv_g_waterfall <- function(id, plot_dataname, subject_var, value_var, + sort_var, color_var, bar_colors, value_arbitrary_hlines, @@ -75,33 +94,30 @@ srv_g_waterfall <- function(id, reactable_args = list(), filter_panel_api) { moduleServer(id, function(input, output, session) { - output$color_by_output <- renderUI({ - selectInput(session$ns("color_by"), label = "Color by:", choices = color_var$choices, selected = color_var$selected) - }) - if (length(color_var$choices) > 1) { - shinyjs::show("color_by") - } else { - shinyjs::hide("color_by") - } + .update_cs_input(inputId = "subject_var", data = reactive(data()[[dataname]]), cs = subject_var) + .update_cs_input(inputId = "value_var", data = reactive(data()[[dataname]]), cs = value_var) + .update_cs_input(inputId = "sort_var", data = reactive(data()[[dataname]]), cs = sort_var) + .update_cs_input(inputId = "color_var", data = reactive(data()[[dataname]]), cs = color_var) color_inputs <- colour_picker_srv( "colors", x = reactive({ - req(data(), input$color_by) - data()[[plot_dataname]][[input$color_by]] + req(data(), input$color_var) + data()[[plot_dataname]][[input$color_var]] }), default_colors = bar_colors ) plotly_q <- reactive({ - req(data(), input$color_by, color_inputs()) + req(data(), input$subject_var, input$value_var, input$sort_var, input$color_var, color_inputs()) within( data(), dataname = str2lang(plot_dataname), - subject_var = subject_var, - value_var = value_var, - color_var = input$color_by, + subject_var = input$subject_var, + value_var = input$value_var, + sort_var = input$sort_var, + color_var = input$color_var, colors = color_inputs(), value_arbitrary_hlines = value_arbitrary_hlines, height = input$plot_height, @@ -110,7 +126,8 @@ srv_g_waterfall <- function(id, p <- waterfally( dataname, subject_var = subject_var, - value_var = value_var, + value_var = value_var, + sort_var = sort_var, color_var = color_var, colors = colors, value_arbitrary_hlines = value_arbitrary_hlines, @@ -130,8 +147,8 @@ srv_g_waterfall <- function(id, tables_selected_q <- .plotly_selected_filter_children( data = plotly_q, plot_dataname = plot_dataname, - xvar = subject_var, - yvar = value_var, + xvar = reactive(input$subject_var), + yvar = reactive(input$value_var), plotly_selected = plotly_selected, children_datanames = table_datanames ) @@ -143,29 +160,29 @@ srv_g_waterfall <- function(id, # todo: export is temporary, this should go to a new package teal.graphs or another bird species #' @export -waterfally <- function(data, subject_var, value_var, color_var, colors, value_arbitrary_hlines, height) { +waterfally <- function(data, subject_var, value_var, sort_var, color_var, colors, value_arbitrary_hlines, height) { subject_var_label <- attr(data[[subject_var]], "label") value_var_label <- attr(data[[value_var]], "label") color_var_label <- attr(data[[color_var]], "label") + if (!length(subject_var_label)) subject_var_label <- subject_var if (!length(value_var_label)) value_var_label <- value_var if (!length(color_var_label)) color_var_label <- color_var - data %>% - dplyr::mutate( - !!as.name(subject_var) := forcats::fct_reorder( - as.factor(!!as.name(subject_var)), - !!as.name(value_var), - .fun = max, - .desc = TRUE - ), - tooltip = sprintf( - "%s: %s
%s: %s%%
%s: %s", - subject_var_label, !!as.name(subject_var), - value_var_label, !!as.name(value_var), - color_var_label, !!as.name(color_var) - ) - ) %>% + dplyr::mutate( + if (identical(sort_var, value_var) || is.null(sort_var)) { + dplyr::arrange(data, desc(!!as.name(value_var))) + } else { + dplyr::arrange(data, !!as.name(sort_var), desc(!!as.name(value_var))) + }, + !!as.name(subject_var) := factor(!!as.name(subject_var), levels = unique(!!as.name(subject_var))), + tooltip = sprintf( + "%s: %s
%s: %s%%
%s: %s", + subject_var_label, !!as.name(subject_var), + value_var_label, !!as.name(value_var), + color_var_label, !!as.name(color_var) + ) + ) %>% dplyr::filter(!duplicated(!!as.name(subject_var))) %>% plotly::plot_ly( source = "waterfall", diff --git a/R/utils.R b/R/utils.R index 7d32953ed..565cfa6a7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -389,9 +389,11 @@ children <- function(x, dataset_name = character(0)) { #' @param plotly_selected (`reactive`) #' @param children_datanames (`character`) .plotly_selected_filter_children <- function(data, plot_dataname, xvar, yvar, plotly_selected, children_datanames) { + xvar_r <- if (is.reactive(xvar)) xvar else reactive(xvar) + yvar_r <- if (is.reactive(yvar)) yvar else reactive(yvar) + plotly_selected_q <- reactive({ - req(plotly_selected()) - # todo: change it to foreign keys needed to merge with children_datanames + req(plotly_selected(), xvar_r(), yvar_r()) primary_keys <- unname(teal.data::join_keys(data())[plot_dataname, plot_dataname]) if (length(primary_keys) == 0) { primary_keys <- unique(sapply(children_datanames, USE.NAMES = FALSE, FUN = function(childname) { @@ -406,8 +408,8 @@ children <- function(x, dataset_name = character(0)) { dplyr::select(primary_keys) }, dataname = str2lang(plot_dataname), - xvar = str2lang(xvar), - yvar = str2lang(yvar), + xvar = str2lang(xvar_r()), + yvar = str2lang(yvar_r()), xvals = plotly_selected()$x, yvals = plotly_selected()$y, primary_keys = primary_keys @@ -443,3 +445,13 @@ children <- function(x, dataset_name = character(0)) { q <- teal.code::eval_code(plotly_selected_q(), exprs) }) } + + +.update_cs_input <- function(inputId, data, cs) { + if (!missing(data) && !length(names(cs))) { + labels <- teal.data::col_labels(isolate(data()))[cs$choices] + names(cs$choices) <- labels + } + updateSelectInput(inputId = inputId, choices = cs$choices, selected = cs$selected) + if (length(cs$choices) < 2) shinyjs::hide(inputId) +} \ No newline at end of file diff --git a/man/tm_g_spiderplot.Rd b/man/tm_g_spiderplot.Rd index d0d23bb34..50d98e99a 100644 --- a/man/tm_g_spiderplot.Rd +++ b/man/tm_g_spiderplot.Rd @@ -24,17 +24,17 @@ tm_g_spiderplot( \item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. For \code{modules()} defaults to \code{"root"}. See \code{Details}.} -\item{plot_dataname}{(\code{character(1)}) name of the dataset which visualization is builded on.} +\item{plot_dataname}{(\code{character(1)} or \code{choices_selected}) name of the dataset which visualization is builded on.} -\item{time_var}{(\code{character(1)}) name of the \code{numeric} column in \code{plot_dataname} to be used as x-axis.} +\item{time_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{numeric} column in \code{plot_dataname} to be used as x-axis.} -\item{value_var}{(\code{character(1)}) name of the \code{numeric} column in \code{plot_dataname} to be used as y-axis. +\item{value_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{numeric} column in \code{plot_dataname} to be used as y-axis. column.} -\item{subject_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +\item{subject_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to be used as grouping variable for displayed lines/points.} -\item{color_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +\item{color_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to be used to differentiate colors and symbols.} \item{point_colors}{(\verb{named character}) valid color names (see \code{\link[=colors]{colors()}}) or hex-colors named diff --git a/man/tm_g_swimlane.Rd b/man/tm_g_swimlane.Rd index 19c82a9be..9e8afa574 100644 --- a/man/tm_g_swimlane.Rd +++ b/man/tm_g_swimlane.Rd @@ -23,22 +23,22 @@ tm_g_swimlane( \item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. For \code{modules()} defaults to \code{"root"}. See \code{Details}.} -\item{plot_dataname}{(\code{character(1)}) name of the dataset which visualization is builded on.} +\item{plot_dataname}{(\code{character(1)} or \code{choices_selected}) name of the dataset which visualization is builded on.} -\item{time_var}{(\code{character(1)}) name of the \code{numeric} column in \code{plot_dataname} to be used as x-axis.} +\item{time_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{numeric} column in \code{plot_dataname} to be used as x-axis.} -\item{subject_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +\item{subject_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to be used as y-axis.} -\item{color_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +\item{color_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to name and color subject events in time.} -\item{group_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +\item{group_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to categorize type of event. (legend is sorted according to this variable, and used in toolip to display type of the event) todo: this can be fixed by ordering factor levels} -\item{sort_var}{(\code{character(1)} or \code{select_spec}) name(s) of the column in \code{plot_dataname} which +\item{sort_var}{(\code{character(1)} or \code{choices_selected}) name(s) of the column in \code{plot_dataname} which value determines order of the subjects displayed on the y-axis.} \item{point_colors}{(\verb{named character}) valid color names (see \code{\link[=colors]{colors()}}) or hex-colors named diff --git a/man/tm_g_waterfall.Rd b/man/tm_g_waterfall.Rd index 660825bf3..c79898159 100644 --- a/man/tm_g_waterfall.Rd +++ b/man/tm_g_waterfall.Rd @@ -9,6 +9,7 @@ tm_g_waterfall( plot_dataname, subject_var, value_var, + sort_var = NULL, color_var = NULL, bar_colors = list(), value_arbitrary_hlines = c(0.2, -0.3), @@ -24,12 +25,12 @@ For \code{modules()} defaults to \code{"root"}. See \code{Details}.} \item{plot_dataname}{(\code{character(1)}) name of the dataset which visualization is builded on.} -\item{subject_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +\item{subject_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to be used as x-axis.} -\item{value_var}{(\code{character(1)}) name of the \code{numeric} column in \code{plot_dataname} to be used as y-axis.} +\item{value_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{numeric} column in \code{plot_dataname} to be used as y-axis.} -\item{color_var}{(\code{character(1)}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +\item{color_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to be used to differentiate bar colors.} \item{bar_colors}{(\verb{named character}) valid color names (see \code{\link[=colors]{colors()}}) or hex-colors named diff --git a/man/tm_rmarkdown.Rd b/man/tm_rmarkdown.Rd index fcd41be03..3609ef8b4 100644 --- a/man/tm_rmarkdown.Rd +++ b/man/tm_rmarkdown.Rd @@ -7,7 +7,7 @@ tm_rmarkdown( label = "App Info", text = character(0), - params = list(title = "Document", output = "html_output"), + params = list(title = "Document"), datanames = "all" ) } From 8234f77ca4ae3b314ffe4b63756bcc9036a84a47 Mon Sep 17 00:00:00 2001 From: Dawid Kaledkowski Date: Wed, 2 Apr 2025 08:57:48 +0000 Subject: [PATCH 78/92] update --- R/tm_g_spiderplot.R | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 5653e0dda..ab9a17ce7 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -77,7 +77,7 @@ ui_g_spiderplot <- function(id, height) { selectInput(ns("subject_var"), label = "Subject variable:", choices = NULL, selected = NULL, multiple = FALSE), selectInput(ns("color_var"), label = "Color by:", choices = NULL, selected = NULL, multiple = FALSE), selectInput(ns("event_var"), label = "Event variable:", choices = NULL, selected = NULL, multiple = FALSE), - selectInput(ns("evant_var_level"), "Select an event:", NULL), + selectInput(ns("event_var_level"), label = "Select an event:", choices = NULL, selected = NULL, multiple = FALSE), colour_picker_ui(ns("colors")), sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), @@ -109,12 +109,22 @@ srv_g_spiderplot <- function(id, .update_cs_input(inputId = "color_var", data = reactive(data()[[dataname]]), cs = color_var) .update_cs_input(inputId = "event_var", data = reactive(data()[[dataname]]), cs = event_var) - evant_var_levels <- reactive({ + event_var_levels <- reactive({ req(data(), input$event_var) + # comment: + # i don't know if it makes sense. I think it will be rare that dataset would have multiple + # category variables. There would rather be another dataset (consider responses, interventions etc.) unique(data()[[plot_dataname]][[input$event_var]]) }) - observeEvent(evant_var_levels(), { - updateSelectInput(inputId = "evant_var_level", choices = evant_var_levels(), selected = evant_var_levels()[1]) + observeEvent(event_var_levels(), { + label <- attr(data()[[plot_dataname]][[input$event_var]], "label") + updateSelectInput( + inputId = "event_var_level", + label = sprintf("Select %s:", if (length(label)) label else "en event:"), + choices = event_var_levels(), + selected = event_var_levels()[1] + ) + if (length(event_var_levels()) < 2) shinyjs::hide("event_var_level") }) color_inputs <- colour_picker_srv( @@ -127,7 +137,7 @@ srv_g_spiderplot <- function(id, ) plotly_q <- reactive({ - req(input$evant_var_level, input$time_var, input$value_var, input$subject_var, input$event_var, input$color_var, color_inputs()) + req(input$event_var_level, input$time_var, input$value_var, input$subject_var, input$event_var, input$color_var, color_inputs()) adjusted_symbols <- .shape_palette_discrete( levels = unique(data()[[plot_dataname]][[input$color_var]]), @@ -142,12 +152,12 @@ srv_g_spiderplot <- function(id, value_var = input$value_var, subject_var = input$subject_var, event_var = input$event_var, - selected_event = input$evant_var_level, + selected_event = input$event_var_level, color_var = input$color_var, colors = color_inputs(), symbols = adjusted_symbols, height = input$plot_height, - title = sprintf("%s over time", input$evant_var_level), + title = sprintf("%s over time", input$event_var_level), expr = { p <- dataname %>% filter(event_var_lang == selected_event) %>% From 7a2658900efdb1b5aceb3db2da181f503db623a2 Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 2 May 2025 12:53:23 +0530 Subject: [PATCH 79/92] chore: format package --- R/module_colur_picker.R | 20 ++++---- R/tm_g_spiderplot.R | 83 ++++++++++++++++++------------- R/tm_g_swimlane.R | 107 +++++++++++++++++++++------------------- R/tm_g_waterfall.R | 73 ++++++++++++++++----------- R/tm_t_reactable.R | 45 ++++++++--------- R/utils.R | 17 ++++--- man/tm_g_spiderplot.Rd | 11 +++-- man/tm_g_swimlane.Rd | 11 +++-- man/tm_g_waterfall.Rd | 7 +-- 9 files changed, 205 insertions(+), 169 deletions(-) diff --git a/R/module_colur_picker.R b/R/module_colur_picker.R index 7d5fd7602..460f9365e 100644 --- a/R/module_colur_picker.R +++ b/R/module_colur_picker.R @@ -17,14 +17,14 @@ colour_picker_srv <- function(id, x, default_colors) { color = default_colors ) }) - - color_values <- reactiveVal() + + color_values <- reactiveVal() observeEvent(default_colors_adjusted(), { if (!identical(default_colors_adjusted(), color_values())) { color_values(default_colors_adjusted()) } }) - + output$module <- renderUI({ tagList( lapply( @@ -35,10 +35,10 @@ colour_picker_srv <- function(id, x, default_colors) { inputId = session$ns(.name_to_id(level)), label = level, value = color_values()[level] - ) + ) ) } - ) + ) ) }) @@ -52,7 +52,7 @@ colour_picker_srv <- function(id, x, default_colors) { isolate(color_input_values(new_input_values)) } }) - + color_input_values }) } @@ -60,17 +60,17 @@ colour_picker_srv <- function(id, x, default_colors) { #' Color palette discrete -#' -#' To specify custom discrete colors to `plotly` or `ggplot` elements one needs to specify a vector named by +#' +#' To specify custom discrete colors to `plotly` or `ggplot` elements one needs to specify a vector named by #' levels of variable used for coloring. This function allows to specify only some or none of the colors/levels #' as the rest will be filled automatically. #' @param levels (`character`) values of possible variable levels #' @param color (`named character`) valid color names (see [colors()]) or hex-colors named by `levels`. #' @return `character` with hex colors named by `levels`. -.color_palette_discrete <- function(levels, color) { +.color_palette_discrete <- function(levels, color) { p <- color[names(color) %in% levels] p_rgb_num <- grDevices::col2rgb(p) - p_hex <- grDevices::rgb(p_rgb_num[1,]/255, p_rgb_num[2,]/255, p_rgb_num[3,]/255) + p_hex <- grDevices::rgb(p_rgb_num[1, ] / 255, p_rgb_num[2, ] / 255, p_rgb_num[3, ] / 255) p <- stats::setNames(p_hex, names(p)) missing_levels <- setdiff(levels, names(p)) N <- length(levels) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index ab9a17ce7..4d6a7f055 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -1,20 +1,21 @@ #' `teal` module: Spider Plot #' #' Module visualizes value development in time grouped by subjects. -#' +#' #' @inheritParams teal::module #' @inheritParams shared_params #' @param plot_dataname (`character(1)` or `choices_selected`) name of the dataset which visualization is builded on. -#' @param time_var (`character(1)` or `choices_selected`) name of the `numeric` column in `plot_dataname` to be used as x-axis. -#' @param value_var (`character(1)` or `choices_selected`) name of the `numeric` column in `plot_dataname` to be used as y-axis. -#' column. -#' @param subject_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` -#' to be used as grouping variable for displayed lines/points. -#' @param color_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` +#' @param time_var (`character(1)` or `choices_selected`) name of the `numeric` column +#' in `plot_dataname` to be used as x-axis. +#' @param value_var (`character(1)` or `choices_selected`) name of the `numeric` column +#' in `plot_dataname` to be used as y-axis. +#' @param subject_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column +#' in `plot_dataname` to be used as grouping variable for displayed lines/points. +#' @param color_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` #' to be used to differentiate colors and symbols. -#' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named +#' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named #' by levels of `color_var` column. -#' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` +#' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` #' column. #' @export tm_g_spiderplot <- function(label = "Spiderplot", @@ -28,7 +29,7 @@ tm_g_spiderplot <- function(label = "Spiderplot", point_symbols, plot_height = 600, table_datanames = character(0), - reactable_args = list(), + reactable_args = list(), transformator = transformator) { if (is.character(time_var)) { time_var <- choices_selected(choices = time_var, selected = time_var) @@ -73,7 +74,11 @@ ui_g_spiderplot <- function(id, height) { bslib::page_sidebar( sidebar = div( selectInput(ns("time_var"), label = "Time variable (x-axis):", choices = NULL, selected = NULL, multiple = FALSE), - selectInput(ns("value_var"), label = "Value variable (y-axis):", choices = NULL, selected = NULL, multiple = FALSE), + selectInput( + ns("value_var"), + label = "Value variable (y-axis):", + choices = NULL, selected = NULL, multiple = FALSE + ), selectInput(ns("subject_var"), label = "Subject variable:", choices = NULL, selected = NULL, multiple = FALSE), selectInput(ns("color_var"), label = "Color by:", choices = NULL, selected = NULL, multiple = FALSE), selectInput(ns("event_var"), label = "Event variable:", choices = NULL, selected = NULL, multiple = FALSE), @@ -83,7 +88,7 @@ ui_g_spiderplot <- function(id, height) { ), bslib::page_fillable( plotly::plotlyOutput(ns("plot"), height = "100%"), - ui_t_reactables(ns("subtables")) + ui_t_reactables(ns("subtables")) ) ) } @@ -108,11 +113,11 @@ srv_g_spiderplot <- function(id, .update_cs_input(inputId = "subject_var", data = reactive(data()[[dataname]]), cs = subject_var) .update_cs_input(inputId = "color_var", data = reactive(data()[[dataname]]), cs = color_var) .update_cs_input(inputId = "event_var", data = reactive(data()[[dataname]]), cs = event_var) - + event_var_levels <- reactive({ req(data(), input$event_var) - # comment: - # i don't know if it makes sense. I think it will be rare that dataset would have multiple + # comment: + # i don't know if it makes sense. I think it will be rare that dataset would have multiple # category variables. There would rather be another dataset (consider responses, interventions etc.) unique(data()[[plot_dataname]][[input$event_var]]) }) @@ -121,29 +126,32 @@ srv_g_spiderplot <- function(id, updateSelectInput( inputId = "event_var_level", label = sprintf("Select %s:", if (length(label)) label else "en event:"), - choices = event_var_levels(), + choices = event_var_levels(), selected = event_var_levels()[1] ) if (length(event_var_levels()) < 2) shinyjs::hide("event_var_level") }) - + color_inputs <- colour_picker_srv( - "colors", + "colors", x = reactive({ req(input$color_var) data()[[plot_dataname]][[input$color_var]] }), default_colors = point_colors ) - + plotly_q <- reactive({ - req(input$event_var_level, input$time_var, input$value_var, input$subject_var, input$event_var, input$color_var, color_inputs()) - + req( + input$event_var_level, input$time_var, input$value_var, + input$subject_var, input$event_var, input$color_var, color_inputs() + ) + adjusted_symbols <- .shape_palette_discrete( levels = unique(data()[[plot_dataname]][[input$color_var]]), symbol = point_symbols ) - + within( data(), dataname = str2lang(plot_dataname), @@ -177,19 +185,24 @@ srv_g_spiderplot <- function(id, }) output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) - + plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) - + tables_selected_q <- .plotly_selected_filter_children( - data = plotly_q, + data = plotly_q, plot_dataname = plot_dataname, - xvar = reactive(input$time_var), - yvar = reactive(input$value_var), - plotly_selected = plotly_selected, + xvar = reactive(input$time_var), + yvar = reactive(input$value_var), + plotly_selected = plotly_selected, children_datanames = table_datanames ) - - srv_t_reactables("subtables", data = tables_selected_q, datanames = table_datanames, reactable_args = reactable_args) + + srv_t_reactables( + "subtables", + data = tables_selected_q, + datanames = table_datanames, + reactable_args = reactable_args + ) }) } @@ -202,7 +215,7 @@ spiderplotly <- function(data, time_var, value_var, subject_var, event_var, colo if (!length(subject_var_label)) subject_var_label <- subject_var if (!length(time_var_label)) time_var_label <- time_var if (!length(event_var_label)) event_var_label <- event_var - + data %>% dplyr::arrange(!!as.name(subject_var), !!as.name(time_var)) %>% dplyr::group_by(!!as.name(subject_var)) %>% @@ -210,15 +223,15 @@ spiderplotly <- function(data, time_var, value_var, subject_var, event_var, colo x = dplyr::lag(!!as.name(time_var), default = 0), y = dplyr:::lag(!!as.name(value_var), default = 0), tooltip = sprintf( - "%s: %s
%s: %s
%s: %s%%
", + "%s: %s
%s: %s
%s: %s%%
", subject_var_label, !!as.name(subject_var), - time_var_label, !!as.name(time_var), + time_var_label, !!as.name(time_var), event_var_label, !!as.name(value_var) * 100 ) ) %>% dplyr::ungroup() %>% plotly::plot_ly( - source = "spiderplot", + source = "spiderplot", height = height, color = stats::as.formula(sprintf("~%s", color_var)), colors = colors, @@ -227,7 +240,7 @@ spiderplotly <- function(data, time_var, value_var, subject_var, event_var, colo plotly::add_segments( x = ~x, y = ~y, - xend = stats::as.formula(sprintf("~%s", time_var)), + xend = stats::as.formula(sprintf("~%s", time_var)), yend = stats::as.formula(sprintf("~%s", value_var)) ) %>% plotly::add_markers( diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 4d6d767f3..16a747c15 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -1,32 +1,33 @@ #' `teal` module: Swimlane plot #' #' Module visualizes subjects' events in time. -#' +#' #' @inheritParams teal::module #' @inheritParams shared_params #' @param plot_dataname (`character(1)` or `choices_selected`) name of the dataset which visualization is builded on. -#' @param time_var (`character(1)` or `choices_selected`) name of the `numeric` column in `plot_dataname` to be used as x-axis. -#' @param subject_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` -#' to be used as y-axis. -#' @param color_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` -#' to name and color subject events in time. +#' @param time_var (`character(1)` or `choices_selected`) name of the `numeric` column +#' in `plot_dataname` to be used as x-axis. +#' @param subject_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column +#' in `plot_dataname` to be used as y-axis. +#' @param color_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column +#' in `plot_dataname` to name and color subject events in time. #' @param group_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` -#' to categorize type of event. +#' to categorize type of event. #' (legend is sorted according to this variable, and used in toolip to display type of the event) #' todo: this can be fixed by ordering factor levels -#' @param sort_var (`character(1)` or `choices_selected`) name(s) of the column in `plot_dataname` which +#' @param sort_var (`character(1)` or `choices_selected`) name(s) of the column in `plot_dataname` which #' value determines order of the subjects displayed on the y-axis. -#' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named +#' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named #' by levels of `color_var` column. -#' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` -#' column. +#' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` +#' column. #' @export -tm_g_swimlane <- function(label = "Swimlane", - plot_dataname, - time_var, - subject_var, +tm_g_swimlane <- function(label = "Swimlane", + plot_dataname, + time_var, + subject_var, color_var, - group_var, + group_var, sort_var = NULL, point_colors = character(0), point_symbols, @@ -83,12 +84,12 @@ ui_g_swimlane <- function(id, height) { ), bslib::page_fillable( plotly::plotlyOutput(ns("plot"), height = "100%"), - ui_t_reactables(ns("subtables")) + ui_t_reactables(ns("subtables")) ) ) } -srv_g_swimlane <- function(id, - data, +srv_g_swimlane <- function(id, + data, plot_dataname, time_var, subject_var, @@ -97,7 +98,7 @@ srv_g_swimlane <- function(id, sort_var = time_var, point_colors, point_symbols, - table_datanames, + table_datanames, reactable_args = list(), filter_panel_api) { moduleServer(id, function(input, output, session) { @@ -108,14 +109,14 @@ srv_g_swimlane <- function(id, .update_cs_input(inputId = "sort_var", data = reactive(data()[[dataname]]), cs = sort_var) color_inputs <- colour_picker_srv( - "colors", + "colors", x = reactive({ req(input$color_var) data()[[plot_dataname]][[input$color_var]] }), default_colors = point_colors ) - + plotly_q <- reactive({ req(data(), input$time_var, input$subject_var, input$color_var, input$group_var, input$sort_var, color_inputs()) adjusted_symbols <- .shape_palette_discrete( @@ -135,38 +136,42 @@ srv_g_swimlane <- function(id, height = input$plot_height, expr = { p <- swimlanely( - data = dataname, - time_var = time_var, - subject_var = subject_var, - color_var = color_var, - group_var = group_var, - sort_var = sort_var, - colors = colors, - symbols = symbols, + data = dataname, + time_var = time_var, + subject_var = subject_var, + color_var = color_var, + group_var = group_var, + sort_var = sort_var, + colors = colors, + symbols = symbols, height = height ) } ) }) - + output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) - + plotly_selected <- reactive({ plotly::event_data("plotly_deselect", source = "swimlane") # todo: deselect doesn't work plotly::event_data("plotly_selected", source = "swimlane") }) - + tables_selected_q <- .plotly_selected_filter_children( - data = plotly_q, + data = plotly_q, plot_dataname = plot_dataname, - xvar = reactive(input$time_var), - yvar = reactive(input$subject_var), - plotly_selected = plotly_selected, + xvar = reactive(input$time_var), + yvar = reactive(input$subject_var), + plotly_selected = plotly_selected, children_datanames = table_datanames ) - - srv_t_reactables("subtables", data = tables_selected_q, datanames = table_datanames, reactable_args = reactable_args) + srv_t_reactables( + "subtables", + data = tables_selected_q, + datanames = table_datanames, + reactable_args = reactable_args + ) }) } @@ -178,7 +183,7 @@ swimlanely <- function(data, time_var, subject_var, color_var, group_var, sort_v time_var_label <- attr(data[[time_var]], "label") if (!length(subject_var_label)) subject_var_label <- subject_var if (!length(time_var_label)) time_var_label <- time_var - + # forcats::fct_reorder doesn't seem to work here subject_levels <- data %>% dplyr::group_by(!!as.name(subject_var)) %>% @@ -187,12 +192,12 @@ swimlanely <- function(data, time_var, subject_var, color_var, group_var, sort_v dplyr::arrange(v) %>% dplyr::pull(!!as.name(subject_var)) data[[subject_var]] <- factor(data[[subject_var]], levels = subject_levels) - + data %>% dplyr::mutate( !!as.name(color_var) := factor(!!as.name(color_var), levels = names(colors)), ) %>% - dplyr::group_by(!!as.name(subject_var), !!as.name(time_var)) %>% + dplyr::group_by(!!as.name(subject_var), !!as.name(time_var)) %>% dplyr::mutate( tooltip = paste( unique( @@ -200,8 +205,8 @@ swimlanely <- function(data, time_var, subject_var, color_var, group_var, sort_v paste(subject_var_label, !!as.name(subject_var)), paste(time_var_label, !!as.name(time_var)), sprintf( - "%s: %s", - tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", !!as.name(group_var))), + "%s: %s", + tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", !!as.name(group_var))), !!as.name(color_var) ) ) @@ -218,24 +223,24 @@ swimlanely <- function(data, time_var, subject_var, color_var, group_var, sort_v plotly::add_markers( x = stats::as.formula(sprintf("~%s", time_var)), y = stats::as.formula(sprintf("~%s", subject_var)), - color = stats::as.formula(sprintf("~%s", color_var)), + color = stats::as.formula(sprintf("~%s", color_var)), symbol = stats::as.formula(sprintf("~%s", color_var)), text = ~tooltip, hoverinfo = "text" ) %>% plotly::add_segments( - x = ~0, - xend = ~study_day, - y = stats::as.formula(sprintf("~%s", subject_var)), + x = ~0, + xend = ~study_day, + y = stats::as.formula(sprintf("~%s", subject_var)), yend = stats::as.formula(sprintf("~%s", subject_var)), - data = data |> - dplyr::group_by(!!as.name(subject_var), !!as.name(group_var)) |> + data = data |> + dplyr::group_by(!!as.name(subject_var), !!as.name(group_var)) |> dplyr::summarise(study_day = max(!!as.name(time_var))), line = list(width = 2, color = "grey"), showlegend = FALSE ) %>% plotly::layout( - xaxis = list(title = time_var_label), + xaxis = list(title = time_var_label), yaxis = list(title = subject_var_label) ) %>% plotly::layout(dragmode = "select") %>% diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 751528a18..d7aaf1f0f 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -1,16 +1,17 @@ #' `teal` module: Waterfall plot #' #' Module visualizes subjects sorted decreasingly by y-values. -#' +#' #' @inheritParams teal::module #' @inheritParams shared_params #' @param plot_dataname (`character(1)`) name of the dataset which visualization is builded on. -#' @param subject_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` -#' to be used as x-axis. -#' @param value_var (`character(1)` or `choices_selected`) name of the `numeric` column in `plot_dataname` to be used as y-axis. -#' @param color_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` +#' @param subject_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column +#' in `plot_dataname` to be used as x-axis. +#' @param value_var (`character(1)` or `choices_selected`) name of the `numeric` column +#' in `plot_dataname` to be used as y-axis. +#' @param color_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` #' to be used to differentiate bar colors. -#' @param bar_colors (`named character`) valid color names (see [colors()]) or hex-colors named +#' @param bar_colors (`named character`) valid color names (see [colors()]) or hex-colors named #' by levels of `color_var` column. #' @param value_arbitrary_hlines (`numeric`) values in the same scale as `value_var` to horizontal #' lines on the plot. @@ -63,11 +64,19 @@ tm_g_waterfall <- function(label = "Waterfall", ui_g_waterfall <- function(id, height) { ns <- NS(id) - + bslib::page_sidebar( sidebar = div( - selectInput(ns("subject_var"), label = "Subject variable (x-axis):", choices = NULL, selected = NULL, multiple = FALSE), - selectInput(ns("value_var"), label = "Value variable (y-axis):", choices = NULL, selected = NULL, multiple = FALSE), + selectInput( + ns("subject_var"), + label = "Subject variable (x-axis):", + choices = NULL, selected = NULL, multiple = FALSE + ), + selectInput( + ns("value_var"), + label = "Value variable (y-axis):", + choices = NULL, selected = NULL, multiple = FALSE + ), selectInput(ns("sort_var"), label = "Sort by:", choices = NULL, selected = NULL, multiple = FALSE), selectInput(ns("color_var"), label = "Color by:", choices = NULL, selected = NULL, multiple = FALSE), colour_picker_ui(ns("colors")), @@ -75,7 +84,7 @@ ui_g_waterfall <- function(id, height) { ), bslib::page_fillable( plotly::plotlyOutput(ns("plot"), height = "100%"), - ui_t_reactables(ns("subtables")) + ui_t_reactables(ns("subtables")) ) ) } @@ -98,19 +107,19 @@ srv_g_waterfall <- function(id, .update_cs_input(inputId = "value_var", data = reactive(data()[[dataname]]), cs = value_var) .update_cs_input(inputId = "sort_var", data = reactive(data()[[dataname]]), cs = sort_var) .update_cs_input(inputId = "color_var", data = reactive(data()[[dataname]]), cs = color_var) - + color_inputs <- colour_picker_srv( - "colors", + "colors", x = reactive({ req(data(), input$color_var) data()[[plot_dataname]][[input$color_var]] }), default_colors = bar_colors ) - + plotly_q <- reactive({ req(data(), input$subject_var, input$value_var, input$sort_var, input$color_var, color_inputs()) - + within( data(), dataname = str2lang(plot_dataname), @@ -124,8 +133,8 @@ srv_g_waterfall <- function(id, title = sprintf("Waterfall plot"), expr = { p <- waterfally( - dataname, - subject_var = subject_var, + dataname, + subject_var = subject_var, value_var = value_var, sort_var = sort_var, color_var = color_var, @@ -134,7 +143,6 @@ srv_g_waterfall <- function(id, height = height ) %>% plotly::layout(title = title) - }, height = input$plot_height ) @@ -143,17 +151,22 @@ srv_g_waterfall <- function(id, output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "waterfall")) - + tables_selected_q <- .plotly_selected_filter_children( - data = plotly_q, + data = plotly_q, plot_dataname = plot_dataname, - xvar = reactive(input$subject_var), - yvar = reactive(input$value_var), - plotly_selected = plotly_selected, + xvar = reactive(input$subject_var), + yvar = reactive(input$value_var), + plotly_selected = plotly_selected, children_datanames = table_datanames ) - - srv_t_reactables("subtables", data = tables_selected_q, datanames = table_datanames, reactable_args = reactable_args) + + srv_t_reactables( + "subtables", + data = tables_selected_q, + datanames = table_datanames, + reactable_args = reactable_args + ) }) } @@ -164,21 +177,21 @@ waterfally <- function(data, subject_var, value_var, sort_var, color_var, colors subject_var_label <- attr(data[[subject_var]], "label") value_var_label <- attr(data[[value_var]], "label") color_var_label <- attr(data[[color_var]], "label") - + if (!length(subject_var_label)) subject_var_label <- subject_var if (!length(value_var_label)) value_var_label <- value_var if (!length(color_var_label)) color_var_label <- color_var - + dplyr::mutate( if (identical(sort_var, value_var) || is.null(sort_var)) { - dplyr::arrange(data, desc(!!as.name(value_var))) + dplyr::arrange(data, desc(!!as.name(value_var))) } else { dplyr::arrange(data, !!as.name(sort_var), desc(!!as.name(value_var))) }, !!as.name(subject_var) := factor(!!as.name(subject_var), levels = unique(!!as.name(subject_var))), tooltip = sprintf( - "%s: %s
%s: %s%%
%s: %s", - subject_var_label, !!as.name(subject_var), + "%s: %s
%s: %s%%
%s: %s", + subject_var_label, !!as.name(subject_var), value_var_label, !!as.name(value_var), color_var_label, !!as.name(color_var) ) @@ -213,6 +226,6 @@ waterfally <- function(data, subject_var, value_var, sort_var, color_var, colors legend = list(title = list(text = "Color by:")), barmode = "relative" ) %>% - plotly::layout( dragmode = "select") %>% + plotly::layout(dragmode = "select") %>% plotly::config(displaylogo = FALSE) } diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 1f2a5ff13..07e0950a7 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -1,10 +1,10 @@ #' `teal` module: Reactable #' #' Wrapper module on [reactable::reactable()] -#' +#' #' @inheritParams teal::module #' @inheritParams shared_params -#' @param reactable_args (`list`) any argument of [reactable::reactable()]. +#' @param reactable_args (`list`) any argument of [reactable::reactable()]. #' @export tm_t_reactables <- function(label = "Table", datanames = "all", @@ -18,8 +18,8 @@ tm_t_reactables <- function(label = "Table", server = srv_t_reactables, ui_args = list(decorators = decorators), server_args = list( - datanames = datanames, - colnames = colnames, + datanames = datanames, + colnames = colnames, reactable_args = reactable_args, decorators = decorators ), @@ -33,7 +33,9 @@ ui_t_reactables <- function(id, decorators = list()) { uiOutput(ns("subtables"), container = div) } -srv_t_reactables <- function(id, data, filter_panel_api, datanames, colnames = list(), decorators = list(), reactable_args = list()) { +srv_t_reactables <- function( + id, data, filter_panel_api, datanames, + colnames = list(), decorators = list(), reactable_args = list()) { moduleServer(id, function(input, output, session) { datanames_r <- .validate_datanames(datanames = datanames, data = data) colnames_r <- reactive({ @@ -101,7 +103,7 @@ srv_t_reactables <- function(id, data, filter_panel_api, datanames, colnames = l ui_t_reactable <- function(id) { ns <- NS(id) - + input <- shinyWidgets::pickerInput( ns("colnames"), label = NULL, @@ -116,7 +118,7 @@ ui_t_reactable <- function(id) { liveSearch = TRUE ) ) - + # input <- actionButton(ns("show_select_colnames"), "Nothing selected", class = "rounded-pill btn-sm primary") |> # bslib::popover(input) bslib::page_fluid( @@ -134,7 +136,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco req(data()) teal.data::col_labels(data()[[dataname]], fill = TRUE) }) - + reactable_args_r <- if (is.reactive(reactable_args)) reactable_args else reactive(reactable_args) cols_choices <- reactiveVal() @@ -162,7 +164,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco observeEvent(input$colnames_open, `if`(!isTruthy(input$colnames_open), cols_selected(input$colnames))) observeEvent(cols_selected(), { updateActionButton( - inputId = "show_select_colnames", + inputId = "show_select_colnames", label = paste(substring(toString(cols_selected()), 1, 100), "...") ) }) @@ -175,23 +177,22 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco lapply(unname(cols_selected()), str2lang) ) ) - + reactable_call <- .make_reactable_call( - dataset = data()[[dataname]][cols_selected()], - dataname = dataname, + dataset = data()[[dataname]][cols_selected()], + dataname = dataname, args = reactable_args_r() ) - + data() |> within(lhs <- rhs, lhs = str2lang(dataname), rhs = select_call) |> within(lhs <- rhs, lhs = str2lang(dataname_reactable), rhs = reactable_call) - }) output$table <- reactable::renderReactable({ logger::log_debug("srv_t_reactable@2 render table for dataset { dataname }") table_q()[[dataname_reactable]] }) - + # todo: add select -> show children table table_selected_q <- reactive({ selected_row <- reactable::getReactableState("table", "selected") @@ -209,7 +210,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco table_q() } }) - + table_selected_q }) } @@ -217,7 +218,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco .make_reactable_call <- function(dataset, dataname, args) { columns <- .make_reactable_columns_call(dataset = dataset, col_defs = args$columns) call_args <- utils::modifyList( - list(columns = columns, onClick = "select"), + list(columns = columns, onClick = "select"), args[!names(args) %in% "columns"] ) as.call( @@ -225,7 +226,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco list( name = quote(reactable), data = str2lang(dataname) - ), + ), call_args ) ) @@ -272,12 +273,12 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco req(data()) names( Filter( - function(dataset) inherits(dataset, class), + function(dataset) inherits(dataset, class), as.list(data()) ) ) }) - + this_datanames_r <- reactive({ if (is.reactive(datanames)) { datanames() @@ -285,9 +286,9 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco datanames } }) - + datanames_r <- reactiveVal() - + observeEvent(all_datanames_r(), { new_datanames <- if (identical(this_datanames_r(), "all")) { all_datanames_r() diff --git a/R/utils.R b/R/utils.R index 565cfa6a7..17095fee0 100644 --- a/R/utils.R +++ b/R/utils.R @@ -365,7 +365,7 @@ children <- function(x, dataset_name = character(0)) { all_parents <- unique(unlist(teal.data::parents(x))) names(all_parents) <- all_parents lapply( - all_parents, + all_parents, function(parent) children(x = x, dataset_name = parent) ) } @@ -381,17 +381,18 @@ children <- function(x, dataset_name = character(0)) { #' Filters children datanames according to: #' - selected x and y values on the plot (based on the parent dataset) #' - [`teal.data::join_keys`] relationship between `children_datanames` -#' +#' #' @param data (`reactive teal_data`) #' @param plot_dataname (`character(1)`) #' @param xvar (`character(1)`) #' @param yvar (`character(1)`) #' @param plotly_selected (`reactive`) #' @param children_datanames (`character`) -.plotly_selected_filter_children <- function(data, plot_dataname, xvar, yvar, plotly_selected, children_datanames) { +.plotly_selected_filter_children <- function( + data, plot_dataname, xvar, yvar, plotly_selected, children_datanames) { xvar_r <- if (is.reactive(xvar)) xvar else reactive(xvar) yvar_r <- if (is.reactive(yvar)) yvar else reactive(yvar) - + plotly_selected_q <- reactive({ req(plotly_selected(), xvar_r(), yvar_r()) primary_keys <- unname(teal.data::join_keys(data())[plot_dataname, plot_dataname]) @@ -404,7 +405,7 @@ children <- function(x, dataset_name = character(0)) { within( data(), expr = { - swimlane_selected <- dplyr::filter(dataname, xvar %in% xvals, yvar %in% yvals) %>% + swimlane_selected <- dplyr::filter(dataname, xvar %in% xvals, yvar %in% yvals) %>% dplyr::select(primary_keys) }, dataname = str2lang(plot_dataname), @@ -415,7 +416,7 @@ children <- function(x, dataset_name = character(0)) { primary_keys = primary_keys ) }) - + children_names <- reactive({ if (length(children_datanames) == 0) { children(plotly_selected_q(), plot_dataname) @@ -423,7 +424,7 @@ children <- function(x, dataset_name = character(0)) { children_datanames } }) - + eventReactive(plotly_selected_q(), { exprs <- as.expression( lapply( @@ -454,4 +455,4 @@ children <- function(x, dataset_name = character(0)) { } updateSelectInput(inputId = inputId, choices = cs$choices, selected = cs$selected) if (length(cs$choices) < 2) shinyjs::hide(inputId) -} \ No newline at end of file +} diff --git a/man/tm_g_spiderplot.Rd b/man/tm_g_spiderplot.Rd index 50d98e99a..19477e291 100644 --- a/man/tm_g_spiderplot.Rd +++ b/man/tm_g_spiderplot.Rd @@ -26,13 +26,14 @@ For \code{modules()} defaults to \code{"root"}. See \code{Details}.} \item{plot_dataname}{(\code{character(1)} or \code{choices_selected}) name of the dataset which visualization is builded on.} -\item{time_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{numeric} column in \code{plot_dataname} to be used as x-axis.} +\item{time_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{numeric} column +in \code{plot_dataname} to be used as x-axis.} -\item{value_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{numeric} column in \code{plot_dataname} to be used as y-axis. -column.} +\item{value_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{numeric} column +in \code{plot_dataname} to be used as y-axis.} -\item{subject_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} -to be used as grouping variable for displayed lines/points.} +\item{subject_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column +in \code{plot_dataname} to be used as grouping variable for displayed lines/points.} \item{color_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to be used to differentiate colors and symbols.} diff --git a/man/tm_g_swimlane.Rd b/man/tm_g_swimlane.Rd index 9e8afa574..fdea953fd 100644 --- a/man/tm_g_swimlane.Rd +++ b/man/tm_g_swimlane.Rd @@ -25,13 +25,14 @@ For \code{modules()} defaults to \code{"root"}. See \code{Details}.} \item{plot_dataname}{(\code{character(1)} or \code{choices_selected}) name of the dataset which visualization is builded on.} -\item{time_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{numeric} column in \code{plot_dataname} to be used as x-axis.} +\item{time_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{numeric} column +in \code{plot_dataname} to be used as x-axis.} -\item{subject_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} -to be used as y-axis.} +\item{subject_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column +in \code{plot_dataname} to be used as y-axis.} -\item{color_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} -to name and color subject events in time.} +\item{color_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column +in \code{plot_dataname} to name and color subject events in time.} \item{group_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to categorize type of event. diff --git a/man/tm_g_waterfall.Rd b/man/tm_g_waterfall.Rd index c79898159..5ee97b703 100644 --- a/man/tm_g_waterfall.Rd +++ b/man/tm_g_waterfall.Rd @@ -25,10 +25,11 @@ For \code{modules()} defaults to \code{"root"}. See \code{Details}.} \item{plot_dataname}{(\code{character(1)}) name of the dataset which visualization is builded on.} -\item{subject_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} -to be used as x-axis.} +\item{subject_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column +in \code{plot_dataname} to be used as x-axis.} -\item{value_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{numeric} column in \code{plot_dataname} to be used as y-axis.} +\item{value_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{numeric} column +in \code{plot_dataname} to be used as y-axis.} \item{color_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to be used to differentiate bar colors.} From 0c2e874ee558126ef2f2fe4f1e04ba63f047657d Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 2 May 2025 18:38:57 +0530 Subject: [PATCH 80/92] fix: handle color and shape edge cases + rename `event_var` param in `tm_g_spiderplot` --- R/module_colur_picker.R | 62 ++++++++++++++++++++++++++++---------- R/tm_g_spiderplot.R | 67 +++++++++++++++++++++-------------------- R/tm_g_swimlane.R | 2 +- R/tm_g_waterfall.R | 2 +- man/tm_g_spiderplot.Rd | 10 ++++-- man/tm_g_swimlane.Rd | 2 +- man/tm_g_waterfall.Rd | 2 +- 7 files changed, 92 insertions(+), 55 deletions(-) diff --git a/R/module_colur_picker.R b/R/module_colur_picker.R index 460f9365e..137deed1e 100644 --- a/R/module_colur_picker.R +++ b/R/module_colur_picker.R @@ -69,31 +69,61 @@ colour_picker_srv <- function(id, x, default_colors) { #' @return `character` with hex colors named by `levels`. .color_palette_discrete <- function(levels, color) { p <- color[names(color) %in% levels] - p_rgb_num <- grDevices::col2rgb(p) - p_hex <- grDevices::rgb(p_rgb_num[1, ] / 255, p_rgb_num[2, ] / 255, p_rgb_num[3, ] / 255) - p <- stats::setNames(p_hex, names(p)) + + if (length(p) > 0) { + p_rgb_num <- grDevices::col2rgb(p) + p_hex <- grDevices::rgb(p_rgb_num[1, ] / 255, p_rgb_num[2, ] / 255, p_rgb_num[3, ] / 255) + p <- stats::setNames(p_hex, names(p)) + } + missing_levels <- setdiff(levels, names(p)) N <- length(levels) n <- length(p) m <- N - n + if (m > 0 && n > 0) { - current_space <- grDevices::rgb2hsv(grDevices::col2rgb(p)) - optimal_color_space <- colorspace::qualitative_hcl(N) - color_distances <- stats::dist(t(cbind(current_space, grDevices::rgb2hsv(grDevices::col2rgb(optimal_color_space))))) - optimal_to_current_dist <- as.matrix(color_distances)[seq_len(n), -seq_len(n)] - furthest_neighbours_idx <- order(apply(optimal_to_current_dist, 2, min), decreasing = TRUE) - missing_colors <- optimal_color_space[furthest_neighbours_idx][seq_len(m)] + all_colors <- colorspace::qualitative_hcl(N) + + if (n == 1) { + current_color_hsv <- grDevices::rgb2hsv(grDevices::col2rgb(p)) + all_colors_hsv <- grDevices::rgb2hsv(grDevices::col2rgb(all_colors)) + + distances <- numeric(length(all_colors)) + for (i in seq_along(all_colors)) { + h_diff <- min( + abs(current_color_hsv[1] - all_colors_hsv[1, i]), + 1 - abs(current_color_hsv[1] - all_colors_hsv[1, i]) + ) + s_diff <- abs(current_color_hsv[2] - all_colors_hsv[2, i]) + v_diff <- abs(current_color_hsv[3] - all_colors_hsv[3, i]) + distances[i] <- sqrt(h_diff^2 + s_diff^2 + v_diff^2) + } + + idx <- order(distances, decreasing = TRUE)[seq_len(m)] + missing_colors <- all_colors[idx] + } else { + remaining_colors <- all_colors[seq_len(m)] + missing_colors <- remaining_colors + } + p <- c(p, stats::setNames(missing_colors, missing_levels)) - } else if (length(missing_levels)) { - colorspace::qualitative_hcl(N) - } else { - p + } else if (m > 0) { + missing_colors <- colorspace::qualitative_hcl(m) + p <- stats::setNames(missing_colors, missing_levels) } - p[names(p) %in% levels] + + result <- p[match(levels, names(p))] + stats::setNames(result, levels) } + .shape_palette_discrete <- function(levels, symbol) { - s <- stats::setNames(symbol[levels], levels) - s[is.na(s)] <- "circle-open" + if (length(symbol) == 0) { + s <- rep("circle-open", length(levels)) + s <- stats::setNames(s, levels) + } else { + s <- stats::setNames(symbol[levels], levels) + s[is.na(s)] <- "circle-open" + } s } diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 4d6a7f055..292ee8f97 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -15,6 +15,9 @@ #' to be used to differentiate colors and symbols. #' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named #' by levels of `color_var` column. +#' @param filter_event_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column +#' in `plot_dataname` to be used to filter the data. +#' The plot will be updated with just the filtereed data when the user selects an event from the dropdown menu. #' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` #' column. #' @export @@ -23,10 +26,10 @@ tm_g_spiderplot <- function(label = "Spiderplot", time_var, value_var, subject_var, - event_var, + filter_event_var, color_var, - point_colors, - point_symbols, + point_colors = character(0), + point_symbols = character(0), plot_height = 600, table_datanames = character(0), reactable_args = list(), @@ -43,8 +46,8 @@ tm_g_spiderplot <- function(label = "Spiderplot", if (is.character(color_var)) { color_var <- choices_selected(choices = color_var, selected = color_var) } - if (is.character(event_var)) { - event_var <- choices_selected(choices = event_var, selected = event_var) + if (is.character(filter_event_var)) { + filter_event_var <- choices_selected(choices = filter_event_var, selected = filter_event_var) } module( @@ -57,7 +60,7 @@ tm_g_spiderplot <- function(label = "Spiderplot", time_var = time_var, value_var = value_var, subject_var = subject_var, - event_var = event_var, + filter_event_var = filter_event_var, color_var = color_var, point_colors = point_colors, point_symbols = point_symbols, @@ -81,8 +84,8 @@ ui_g_spiderplot <- function(id, height) { ), selectInput(ns("subject_var"), label = "Subject variable:", choices = NULL, selected = NULL, multiple = FALSE), selectInput(ns("color_var"), label = "Color by:", choices = NULL, selected = NULL, multiple = FALSE), - selectInput(ns("event_var"), label = "Event variable:", choices = NULL, selected = NULL, multiple = FALSE), - selectInput(ns("event_var_level"), label = "Select an event:", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("filter_event_var"), label = "Event variable:", choices = NULL, selected = NULL, multiple = FALSE), + selectInput(ns("filter_event_var_level"), label = "Select an event:", choices = NULL, selected = NULL, multiple = FALSE), colour_picker_ui(ns("colors")), sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), @@ -99,7 +102,7 @@ srv_g_spiderplot <- function(id, time_var, value_var, subject_var, - event_var, + filter_event_var, color_var, point_colors, point_symbols, @@ -112,24 +115,24 @@ srv_g_spiderplot <- function(id, .update_cs_input(inputId = "time_var", data = reactive(data()[[dataname]]), cs = time_var) .update_cs_input(inputId = "subject_var", data = reactive(data()[[dataname]]), cs = subject_var) .update_cs_input(inputId = "color_var", data = reactive(data()[[dataname]]), cs = color_var) - .update_cs_input(inputId = "event_var", data = reactive(data()[[dataname]]), cs = event_var) + .update_cs_input(inputId = "filter_event_var", data = reactive(data()[[dataname]]), cs = filter_event_var) - event_var_levels <- reactive({ - req(data(), input$event_var) + filter_event_var_levels <- reactive({ + req(data(), input$filter_event_var) # comment: # i don't know if it makes sense. I think it will be rare that dataset would have multiple # category variables. There would rather be another dataset (consider responses, interventions etc.) - unique(data()[[plot_dataname]][[input$event_var]]) + unique(data()[[plot_dataname]][[input$filter_event_var]]) }) - observeEvent(event_var_levels(), { - label <- attr(data()[[plot_dataname]][[input$event_var]], "label") + observeEvent(filter_event_var_levels(), { + label <- attr(data()[[plot_dataname]][[input$filter_event_var]], "label") updateSelectInput( - inputId = "event_var_level", + inputId = "filter_event_var_level", label = sprintf("Select %s:", if (length(label)) label else "en event:"), - choices = event_var_levels(), - selected = event_var_levels()[1] + choices = filter_event_var_levels(), + selected = filter_event_var_levels()[1] ) - if (length(event_var_levels()) < 2) shinyjs::hide("event_var_level") + if (length(filter_event_var_levels()) < 2) shinyjs::hide("filter_event_var_level") }) color_inputs <- colour_picker_srv( @@ -143,8 +146,8 @@ srv_g_spiderplot <- function(id, plotly_q <- reactive({ req( - input$event_var_level, input$time_var, input$value_var, - input$subject_var, input$event_var, input$color_var, color_inputs() + input$filter_event_var_level, input$time_var, input$value_var, + input$subject_var, input$filter_event_var, input$color_var, color_inputs() ) adjusted_symbols <- .shape_palette_discrete( @@ -155,25 +158,25 @@ srv_g_spiderplot <- function(id, within( data(), dataname = str2lang(plot_dataname), - event_var_lang = str2lang(input$event_var), + filter_event_var_lang = str2lang(input$filter_event_var), time_var = input$time_var, value_var = input$value_var, subject_var = input$subject_var, - event_var = input$event_var, - selected_event = input$event_var_level, + filter_event_var = input$filter_event_var, + selected_event = input$filter_event_var_level, color_var = input$color_var, colors = color_inputs(), symbols = adjusted_symbols, height = input$plot_height, - title = sprintf("%s over time", input$event_var_level), + title = sprintf("%s over time", input$filter_event_var_level), expr = { p <- dataname %>% - filter(event_var_lang == selected_event) %>% + dplyr::filter(filter_event_var_lang == selected_event) %>% spiderplotly( time_var = time_var, value_var = value_var, subject_var = subject_var, - event_var = event_var, + filter_event_var = filter_event_var, color_var = color_var, colors = colors, symbols = symbols, @@ -208,13 +211,13 @@ srv_g_spiderplot <- function(id, # todo: export is temporary, this should go to a new package teal.graphs or another bird species #' @export -spiderplotly <- function(data, time_var, value_var, subject_var, event_var, color_var, colors, symbols, height) { +spiderplotly <- function(data, time_var, value_var, subject_var, filter_event_var, color_var, colors, symbols, height) { subject_var_label <- attr(data[[subject_var]], "label") time_var_label <- attr(data[[time_var]], "label") - event_var_label <- attr(data[[event_var]], "label") + filter_event_var_label <- attr(data[[filter_event_var]], "label") if (!length(subject_var_label)) subject_var_label <- subject_var if (!length(time_var_label)) time_var_label <- time_var - if (!length(event_var_label)) event_var_label <- event_var + if (!length(filter_event_var_label)) filter_event_var_label <- filter_event_var data %>% dplyr::arrange(!!as.name(subject_var), !!as.name(time_var)) %>% @@ -226,7 +229,7 @@ spiderplotly <- function(data, time_var, value_var, subject_var, event_var, colo "%s: %s
%s: %s
%s: %s%%
", subject_var_label, !!as.name(subject_var), time_var_label, !!as.name(time_var), - event_var_label, !!as.name(value_var) * 100 + filter_event_var_label, !!as.name(value_var) * 100 ) ) %>% dplyr::ungroup() %>% @@ -252,7 +255,7 @@ spiderplotly <- function(data, time_var, value_var, subject_var, event_var, colo ) %>% plotly::layout( xaxis = list(title = time_var_label), - yaxis = list(title = event_var_label), + yaxis = list(title = filter_event_var_label), title = title, dragmode = "select" ) %>% diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 16a747c15..8523a989c 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -30,7 +30,7 @@ tm_g_swimlane <- function(label = "Swimlane", group_var, sort_var = NULL, point_colors = character(0), - point_symbols, + point_symbols = character(0), plot_height = 700, table_datanames = character(0), reactable_args = list()) { diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index d7aaf1f0f..71fceee17 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -22,7 +22,7 @@ tm_g_waterfall <- function(label = "Waterfall", value_var, sort_var = NULL, color_var = NULL, - bar_colors = list(), + bar_colors = character(0), value_arbitrary_hlines = c(0.2, -0.3), plot_title = "Waterfall plot", plot_height = 700, diff --git a/man/tm_g_spiderplot.Rd b/man/tm_g_spiderplot.Rd index 19477e291..2653b3ba3 100644 --- a/man/tm_g_spiderplot.Rd +++ b/man/tm_g_spiderplot.Rd @@ -10,10 +10,10 @@ tm_g_spiderplot( time_var, value_var, subject_var, - event_var, + filter_event_var, color_var, - point_colors, - point_symbols, + point_colors = character(0), + point_symbols = character(0), plot_height = 600, table_datanames = character(0), reactable_args = list(), @@ -35,6 +35,10 @@ in \code{plot_dataname} to be used as y-axis.} \item{subject_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to be used as grouping variable for displayed lines/points.} +\item{filter_event_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column +in \code{plot_dataname} to be used to filter the data. +The plot will be updated with just the filtereed data when the user selects an event from the dropdown menu.} + \item{color_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to be used to differentiate colors and symbols.} diff --git a/man/tm_g_swimlane.Rd b/man/tm_g_swimlane.Rd index fdea953fd..10182c11a 100644 --- a/man/tm_g_swimlane.Rd +++ b/man/tm_g_swimlane.Rd @@ -13,7 +13,7 @@ tm_g_swimlane( group_var, sort_var = NULL, point_colors = character(0), - point_symbols, + point_symbols = character(0), plot_height = 700, table_datanames = character(0), reactable_args = list() diff --git a/man/tm_g_waterfall.Rd b/man/tm_g_waterfall.Rd index 5ee97b703..9b9af3369 100644 --- a/man/tm_g_waterfall.Rd +++ b/man/tm_g_waterfall.Rd @@ -11,7 +11,7 @@ tm_g_waterfall( value_var, sort_var = NULL, color_var = NULL, - bar_colors = list(), + bar_colors = character(0), value_arbitrary_hlines = c(0.2, -0.3), plot_title = "Waterfall plot", plot_height = 700, From a065bf51c0127451d2924e22cf78dadb0116d48f Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 2 May 2025 19:17:45 +0530 Subject: [PATCH 81/92] docs: add examples --- R/tm_g_spiderplot.R | 59 ++++++++++++++++++++++++++++++++++++++++++ R/tm_g_swimlane.R | 46 ++++++++++++++++++++++++++++++++ R/tm_g_waterfall.R | 42 ++++++++++++++++++++++++++++++ man/tm_g_spiderplot.Rd | 59 ++++++++++++++++++++++++++++++++++++++++++ man/tm_g_swimlane.Rd | 46 ++++++++++++++++++++++++++++++++ man/tm_g_waterfall.Rd | 42 ++++++++++++++++++++++++++++++ 6 files changed, 294 insertions(+) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 292ee8f97..bea9da899 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -20,6 +20,65 @@ #' The plot will be updated with just the filtereed data when the user selects an event from the dropdown menu. #' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` #' column. +#' +#' @examples +#' data <- teal_data() |> +#' within({ +#' subjects <- data.frame( +#' subject_var = c("A", "B", "C"), +#' AGE = sample(30:100, 3), +#' ARM = c("Combination", "Combination", "Placebo") +#' ) +#' +#' swimlane_ds <- data.frame( +#' subject_var = sample(c("A", "B", "C"), 10, replace = TRUE), +#' time_var = sample(1:100, 10, replace = TRUE), +#' color_var = sample(c("CR", "PR", "SD", "PD"), 10, replace = TRUE) +#' ) +#' +#' spiderplot_ds <- data.frame( +#' subject_var = sample(c("A", "B", "C"), 10, replace = TRUE), +#' time_var = 1:10, +#' filter_event_var = "response", +#' color_var = sample(c("CR", "PR", "SD", "PD"), 10, replace = TRUE), +#' value_var = sample(-50:100, 10, replace = TRUE) +#' ) +#' +#' waterfall_ds <- data.frame( +#' subject_var = sample(c("A", "B", "C"), 10, replace = TRUE), +#' value_var = sample(-20:90, 10, replace = TRUE), +#' color_var = sample(c("CR", "PR", "SD", "PD"), 10, replace = TRUE) +#' ) +#' }) +#' join_keys(data) <- join_keys( +#' join_key("subjects", "spiderplot_ds", keys = c(subject_var = "subject_var")) +#' ) +#' +#' app <- init( +#' data = data, +#' modules = modules( +#' tm_g_spiderplot( +#' plot_dataname = "spiderplot_ds", +#' table_datanames = "subjects", +#' time_var = "time_var", +#' value_var = "value_var", +#' subject_var = "subject_var", +#' filter_event_var = "filter_event_var", +#' color_var = "color_var", +#' point_colors = c( +#' CR = "#FF0000", PR = "#00FF00", SD = "#0000FF", PD = "#FFFF00" +#' ), +#' point_symbols = c( +#' CR = "circle", PR = "square", SD = "triangle-up", PD = "diamond" +#' ) +#' ) +#' ) +#' ) +#' +#' if (interactive()) { +#' shinyApp(app$ui, app$server) +#' } +#' #' @export tm_g_spiderplot <- function(label = "Spiderplot", plot_dataname, diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 8523a989c..0d882c6db 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -21,6 +21,52 @@ #' by levels of `color_var` column. #' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` #' column. +#' +#' @examples +#' data <- teal_data() |> +#' within({ +#' subjects <- data.frame( +#' subject_var = c("A", "B", "C"), +#' AGE = sample(30:100, 3), +#' ARM = c("Combination", "Combination", "Placebo") +#' ) +#' +#' swimlane_ds <- data.frame( +#' subject_var = sample(c("A", "B", "C"), 10, replace = TRUE), +#' time_var = sample(1:100, 10, replace = TRUE), +#' color_var = sample(c("CR", "PR", "SD", "PD"), 10, replace = TRUE) +#' ) +#' }) +#' join_keys(data) <- join_keys( +#' join_key("subjects", "swimlane_ds", keys = c(subject_var = "subject_var")) +#' ) +#' +#' app <- init( +#' data = data, +#' modules = modules( +#' tm_g_swimlane( +#' plot_dataname = "swimlane_ds", +#' table_datanames = "subjects", +#' time_var = "time_var", +#' subject_var = "subject_var", +#' color_var = "color_var", +#' group_var = "color_var", +#' sort_var = "time_var", +#' plot_height = 400, +#' point_colors = c( +#' CR = "#FF0000", PR = "#00FF00", SD = "#0000FF", PD = "#FFFF00" +#' ), +#' point_symbols = c( +#' CR = "circle", PR = "square", SD = "triangle-up", PD = "diamond" +#' ) +#' ) +#' ) +#' ) +#' +#' if (interactive()) { +#' shinyApp(app$ui, app$server) +#' } +#' #' @export tm_g_swimlane <- function(label = "Swimlane", plot_dataname, diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 71fceee17..052af041d 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -15,6 +15,48 @@ #' by levels of `color_var` column. #' @param value_arbitrary_hlines (`numeric`) values in the same scale as `value_var` to horizontal #' lines on the plot. +#' +#' @examples +#' data <- teal_data() |> +#' within({ +#' subjects <- data.frame( +#' subject_var = c("A", "B", "C"), +#' AGE = sample(30:100, 3), +#' ARM = c("Combination", "Combination", "Placebo") +#' ) +#' +#' waterfall_ds <- data.frame( +#' subject_var = sample(c("A", "B", "C"), 10, replace = TRUE), +#' value_var = sample(-20:90, 10, replace = TRUE), +#' color_var = sample(c("CR", "PR", "SD", "PD"), 10, replace = TRUE) +#' ) +#' }) +#' join_keys(data) <- join_keys( +#' join_key("subjects", "waterfall_ds", keys = c(subject_var = "subject_var")) +#' ) +#' +#' app <- init( +#' data = data, +#' modules = modules( +#' tm_g_waterfall( +#' plot_dataname = "waterfall_ds", +#' table_datanames = "subjects", +#' subject_var = "subject_var", +#' value_var = "value_var", +#' sort_var = "value_var", +#' color_var = "color_var", +#' value_arbitrary_hlines = c(20, -30), +#' bar_colors = c( +#' CR = "#FF0000", PR = "#00FF00", SD = "#0000FF", PD = "#FFFF00" +#' ) +#' ) +#' ) +#' ) +#' +#' if (interactive()) { +#' shinyApp(app$ui, app$server) +#' } +#' #' @export tm_g_waterfall <- function(label = "Waterfall", plot_dataname, diff --git a/man/tm_g_spiderplot.Rd b/man/tm_g_spiderplot.Rd index 2653b3ba3..366a54bf2 100644 --- a/man/tm_g_spiderplot.Rd +++ b/man/tm_g_spiderplot.Rd @@ -60,3 +60,62 @@ See section "Decorating Module" below for more details.} \description{ Module visualizes value development in time grouped by subjects. } +\examples{ +data <- teal_data() |> + within({ + subjects <- data.frame( + subject_var = c("A", "B", "C"), + AGE = sample(30:100, 3), + ARM = c("Combination", "Combination", "Placebo") + ) + + swimlane_ds <- data.frame( + subject_var = sample(c("A", "B", "C"), 10, replace = TRUE), + time_var = sample(1:100, 10, replace = TRUE), + color_var = sample(c("CR", "PR", "SD", "PD"), 10, replace = TRUE) + ) + + spiderplot_ds <- data.frame( + subject_var = sample(c("A", "B", "C"), 10, replace = TRUE), + time_var = 1:10, + filter_event_var = "response", + color_var = sample(c("CR", "PR", "SD", "PD"), 10, replace = TRUE), + value_var = sample(-50:100, 10, replace = TRUE) + ) + + waterfall_ds <- data.frame( + subject_var = sample(c("A", "B", "C"), 10, replace = TRUE), + value_var = sample(-20:90, 10, replace = TRUE), + color_var = sample(c("CR", "PR", "SD", "PD"), 10, replace = TRUE) + ) + }) +join_keys(data) <- join_keys( + join_key("subjects", "spiderplot_ds", keys = c(subject_var = "subject_var")) +) + +app <- init( + data = data, + modules = modules( + tm_g_spiderplot( + plot_dataname = "spiderplot_ds", + table_datanames = "subjects", + time_var = "time_var", + value_var = "value_var", + subject_var = "subject_var", + filter_event_var = "filter_event_var", + color_var = "color_var", + point_colors = c( + CR = "#FF0000", PR = "#00FF00", SD = "#0000FF", PD = "#FFFF00" + ), + point_symbols = c( + CR = "circle", PR = "square", SD = "triangle-up", PD = "diamond" + ) + ) + ) +) + +if (interactive()) { + shinyApp(app$ui, app$server) +} + +} diff --git a/man/tm_g_swimlane.Rd b/man/tm_g_swimlane.Rd index 10182c11a..6ffe9dc82 100644 --- a/man/tm_g_swimlane.Rd +++ b/man/tm_g_swimlane.Rd @@ -60,3 +60,49 @@ See section "Decorating Module" below for more details.} \description{ Module visualizes subjects' events in time. } +\examples{ +data <- teal_data() |> + within({ + subjects <- data.frame( + subject_var = c("A", "B", "C"), + AGE = sample(30:100, 3), + ARM = c("Combination", "Combination", "Placebo") + ) + + swimlane_ds <- data.frame( + subject_var = sample(c("A", "B", "C"), 10, replace = TRUE), + time_var = sample(1:100, 10, replace = TRUE), + color_var = sample(c("CR", "PR", "SD", "PD"), 10, replace = TRUE) + ) + }) +join_keys(data) <- join_keys( + join_key("subjects", "swimlane_ds", keys = c(subject_var = "subject_var")) +) + +app <- init( + data = data, + modules = modules( + tm_g_swimlane( + plot_dataname = "swimlane_ds", + table_datanames = "subjects", + time_var = "time_var", + subject_var = "subject_var", + color_var = "color_var", + group_var = "color_var", + sort_var = "time_var", + plot_height = 400, + point_colors = c( + CR = "#FF0000", PR = "#00FF00", SD = "#0000FF", PD = "#FFFF00" + ), + point_symbols = c( + CR = "circle", PR = "square", SD = "triangle-up", PD = "diamond" + ) + ) + ) +) + +if (interactive()) { + shinyApp(app$ui, app$server) +} + +} diff --git a/man/tm_g_waterfall.Rd b/man/tm_g_waterfall.Rd index 9b9af3369..aa84a8fae 100644 --- a/man/tm_g_waterfall.Rd +++ b/man/tm_g_waterfall.Rd @@ -52,3 +52,45 @@ See section "Decorating Module" below for more details.} \description{ Module visualizes subjects sorted decreasingly by y-values. } +\examples{ +data <- teal_data() |> + within({ + subjects <- data.frame( + subject_var = c("A", "B", "C"), + AGE = sample(30:100, 3), + ARM = c("Combination", "Combination", "Placebo") + ) + + waterfall_ds <- data.frame( + subject_var = sample(c("A", "B", "C"), 10, replace = TRUE), + value_var = sample(-20:90, 10, replace = TRUE), + color_var = sample(c("CR", "PR", "SD", "PD"), 10, replace = TRUE) + ) + }) +join_keys(data) <- join_keys( + join_key("subjects", "waterfall_ds", keys = c(subject_var = "subject_var")) +) + +app <- init( + data = data, + modules = modules( + tm_g_waterfall( + plot_dataname = "waterfall_ds", + table_datanames = "subjects", + subject_var = "subject_var", + value_var = "value_var", + sort_var = "value_var", + color_var = "color_var", + value_arbitrary_hlines = c(20, -30), + bar_colors = c( + CR = "#FF0000", PR = "#00FF00", SD = "#0000FF", PD = "#FFFF00" + ) + ) + ) +) + +if (interactive()) { + shinyApp(app$ui, app$server) +} + +} From 589afce7eea09601fc3fad9ce8e9b976cb5a24e8 Mon Sep 17 00:00:00 2001 From: vedhav Date: Mon, 5 May 2025 12:25:09 +0530 Subject: [PATCH 82/92] feat: allow the app developer to customize tooltips using column names --- R/tm_g_spiderplot.R | 42 +++++++++++++++++++++-------------- R/tm_g_swimlane.R | 53 +++++++++++++++++++++++++++------------------ R/tm_g_waterfall.R | 43 +++++++++++++++++++++--------------- R/utils.R | 20 +++++++++++++++++ 4 files changed, 104 insertions(+), 54 deletions(-) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index bea9da899..cca7d859d 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -92,6 +92,7 @@ tm_g_spiderplot <- function(label = "Spiderplot", plot_height = 600, table_datanames = character(0), reactable_args = list(), + tooltip_cols = NULL, transformator = transformator) { if (is.character(time_var)) { time_var <- choices_selected(choices = time_var, selected = time_var) @@ -124,7 +125,8 @@ tm_g_spiderplot <- function(label = "Spiderplot", point_colors = point_colors, point_symbols = point_symbols, table_datanames = table_datanames, - reactable_args = reactable_args + reactable_args = reactable_args, + tooltip_cols = tooltip_cols ), datanames = union(plot_dataname, table_datanames) ) @@ -168,6 +170,7 @@ srv_g_spiderplot <- function(id, plot_height = 600, table_datanames = character(0), reactable_args = list(), + tooltip_cols = NULL, filter_panel_api) { moduleServer(id, function(input, output, session) { .update_cs_input(inputId = "value_var", data = reactive(data()[[dataname]]), cs = value_var) @@ -228,6 +231,7 @@ srv_g_spiderplot <- function(id, symbols = adjusted_symbols, height = input$plot_height, title = sprintf("%s over time", input$filter_event_var_level), + tooltip_cols = tooltip_cols, expr = { p <- dataname %>% dplyr::filter(filter_event_var_lang == selected_event) %>% @@ -239,7 +243,8 @@ srv_g_spiderplot <- function(id, color_var = color_var, colors = colors, symbols = symbols, - height = height + height = height, + tooltip_cols = tooltip_cols ) %>% plotly::layout(title = title) } @@ -270,13 +275,12 @@ srv_g_spiderplot <- function(id, # todo: export is temporary, this should go to a new package teal.graphs or another bird species #' @export -spiderplotly <- function(data, time_var, value_var, subject_var, filter_event_var, color_var, colors, symbols, height) { - subject_var_label <- attr(data[[subject_var]], "label") - time_var_label <- attr(data[[time_var]], "label") - filter_event_var_label <- attr(data[[filter_event_var]], "label") - if (!length(subject_var_label)) subject_var_label <- subject_var - if (!length(time_var_label)) time_var_label <- time_var - if (!length(filter_event_var_label)) filter_event_var_label <- filter_event_var +spiderplotly <- function( + data, time_var, value_var, subject_var, filter_event_var, + color_var, colors, symbols, height, tooltip_cols = NULL) { + subject_var_label <- .get_column_label(data, subject_var) + time_var_label <- .get_column_label(data, time_var) + value_var_label <- .get_column_label(data, value_var) data %>% dplyr::arrange(!!as.name(subject_var), !!as.name(time_var)) %>% @@ -284,12 +288,18 @@ spiderplotly <- function(data, time_var, value_var, subject_var, filter_event_va dplyr::mutate( x = dplyr::lag(!!as.name(time_var), default = 0), y = dplyr:::lag(!!as.name(value_var), default = 0), - tooltip = sprintf( - "%s: %s
%s: %s
%s: %s%%
", - subject_var_label, !!as.name(subject_var), - time_var_label, !!as.name(time_var), - filter_event_var_label, !!as.name(value_var) * 100 - ) + tooltip = { + if (is.null(tooltip_cols)) { + sprintf( + "%s: %s
%s: %s
%s: %s%%
", + subject_var_label, !!as.name(subject_var), + time_var_label, !!as.name(time_var), + value_var_label, !!as.name(value_var) * 100 + ) + } else { + .generate_tooltip(.data, tooltip_cols) + } + } ) %>% dplyr::ungroup() %>% plotly::plot_ly( @@ -314,7 +324,7 @@ spiderplotly <- function(data, time_var, value_var, subject_var, filter_event_va ) %>% plotly::layout( xaxis = list(title = time_var_label), - yaxis = list(title = filter_event_var_label), + yaxis = list(title = value_var_label), title = title, dragmode = "select" ) %>% diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 0d882c6db..2b1d42ab5 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -79,7 +79,8 @@ tm_g_swimlane <- function(label = "Swimlane", point_symbols = character(0), plot_height = 700, table_datanames = character(0), - reactable_args = list()) { + reactable_args = list(), + tooltip_cols = NULL) { if (is.character(time_var)) { time_var <- choices_selected(choices = time_var, selected = time_var) } @@ -111,7 +112,8 @@ tm_g_swimlane <- function(label = "Swimlane", point_colors = point_colors, point_symbols = point_symbols, table_datanames = table_datanames, - reactable_args = reactable_args + reactable_args = reactable_args, + tooltip_cols = tooltip_cols ) ) } @@ -146,6 +148,7 @@ srv_g_swimlane <- function(id, point_symbols, table_datanames, reactable_args = list(), + tooltip_cols = NULL, filter_panel_api) { moduleServer(id, function(input, output, session) { .update_cs_input(inputId = "time_var", data = reactive(data()[[dataname]]), cs = time_var) @@ -180,6 +183,7 @@ srv_g_swimlane <- function(id, colors = color_inputs(), symbols = adjusted_symbols, height = input$plot_height, + tooltip_cols = tooltip_cols, expr = { p <- swimlanely( data = dataname, @@ -190,7 +194,8 @@ srv_g_swimlane <- function(id, sort_var = sort_var, colors = colors, symbols = symbols, - height = height + height = height, + tooltip_cols = tooltip_cols ) } ) @@ -224,11 +229,11 @@ srv_g_swimlane <- function(id, # todo: export is temporary, this should go to a new package teal.graphs or another bird species #' @export -swimlanely <- function(data, time_var, subject_var, color_var, group_var, sort_var, colors, symbols, height) { - subject_var_label <- attr(data[[subject_var]], "label") - time_var_label <- attr(data[[time_var]], "label") - if (!length(subject_var_label)) subject_var_label <- subject_var - if (!length(time_var_label)) time_var_label <- time_var +swimlanely <- function( + data, time_var, subject_var, color_var, group_var, + sort_var, colors, symbols, height, tooltip_cols = NULL) { + subject_var_label <- .get_column_label(data, subject_var) + time_var_label <- .get_column_label(data, time_var) # forcats::fct_reorder doesn't seem to work here subject_levels <- data %>% @@ -245,20 +250,26 @@ swimlanely <- function(data, time_var, subject_var, color_var, group_var, sort_v ) %>% dplyr::group_by(!!as.name(subject_var), !!as.name(time_var)) %>% dplyr::mutate( - tooltip = paste( - unique( - c( - paste(subject_var_label, !!as.name(subject_var)), - paste(time_var_label, !!as.name(time_var)), - sprintf( - "%s: %s", - tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", !!as.name(group_var))), - !!as.name(color_var) - ) + tooltip = { + if (is.null(tooltip_cols)) { + paste( + unique( + c( + paste(subject_var_label, !!as.name(subject_var)), + paste(time_var_label, !!as.name(time_var)), + sprintf( + "%s: %s", + tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", !!as.name(group_var))), + !!as.name(color_var) + ) + ) + ), + collapse = "
" ) - ), - collapse = "
" - ) + } else { + .generate_tooltip(.data, tooltip_cols) + } + } ) %>% plotly::plot_ly( source = "swimlane", diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 052af041d..c4e24e87a 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -69,7 +69,8 @@ tm_g_waterfall <- function(label = "Waterfall", plot_title = "Waterfall plot", plot_height = 700, table_datanames = character(0), - reactable_args = list()) { + reactable_args = list(), + tooltip_cols = NULL) { if (is.character(subject_var)) { subject_var <- choices_selected(choices = subject_var, selected = subject_var) } @@ -99,7 +100,8 @@ tm_g_waterfall <- function(label = "Waterfall", bar_colors = bar_colors, value_arbitrary_hlines = value_arbitrary_hlines, plot_title = plot_title, - reactable_args = reactable_args + reactable_args = reactable_args, + tooltip_cols = tooltip_cols ) ) } @@ -143,6 +145,7 @@ srv_g_waterfall <- function(id, plot_height = 600, table_datanames = character(0), reactable_args = list(), + tooltip_cols = NULL, filter_panel_api) { moduleServer(id, function(input, output, session) { .update_cs_input(inputId = "subject_var", data = reactive(data()[[dataname]]), cs = subject_var) @@ -173,6 +176,7 @@ srv_g_waterfall <- function(id, value_arbitrary_hlines = value_arbitrary_hlines, height = input$plot_height, title = sprintf("Waterfall plot"), + tooltip_cols = tooltip_cols, expr = { p <- waterfally( dataname, @@ -182,7 +186,8 @@ srv_g_waterfall <- function(id, color_var = color_var, colors = colors, value_arbitrary_hlines = value_arbitrary_hlines, - height = height + height = height, + tooltip_cols = tooltip_cols ) %>% plotly::layout(title = title) }, @@ -215,14 +220,12 @@ srv_g_waterfall <- function(id, # todo: export is temporary, this should go to a new package teal.graphs or another bird species #' @export -waterfally <- function(data, subject_var, value_var, sort_var, color_var, colors, value_arbitrary_hlines, height) { - subject_var_label <- attr(data[[subject_var]], "label") - value_var_label <- attr(data[[value_var]], "label") - color_var_label <- attr(data[[color_var]], "label") - - if (!length(subject_var_label)) subject_var_label <- subject_var - if (!length(value_var_label)) value_var_label <- value_var - if (!length(color_var_label)) color_var_label <- color_var +waterfally <- function( + data, subject_var, value_var, sort_var, color_var, colors, + value_arbitrary_hlines, height, tooltip_cols = NULL) { + subject_var_label <- .get_column_label(data, subject_var) + value_var_label <- .get_column_label(data, value_var) + color_var_label <- .get_column_label(data, color_var) dplyr::mutate( if (identical(sort_var, value_var) || is.null(sort_var)) { @@ -231,12 +234,18 @@ waterfally <- function(data, subject_var, value_var, sort_var, color_var, colors dplyr::arrange(data, !!as.name(sort_var), desc(!!as.name(value_var))) }, !!as.name(subject_var) := factor(!!as.name(subject_var), levels = unique(!!as.name(subject_var))), - tooltip = sprintf( - "%s: %s
%s: %s%%
%s: %s", - subject_var_label, !!as.name(subject_var), - value_var_label, !!as.name(value_var), - color_var_label, !!as.name(color_var) - ) + tooltip = { + if (is.null(tooltip_cols)) { + sprintf( + "%s: %s
%s: %s%%
%s: %s", + subject_var_label, !!as.name(subject_var), + value_var_label, !!as.name(value_var), + color_var_label, !!as.name(color_var) + ) + } else { + .generate_tooltip(.data, tooltip_cols) + } + } ) %>% dplyr::filter(!duplicated(!!as.name(subject_var))) %>% plotly::plot_ly( diff --git a/R/utils.R b/R/utils.R index 17095fee0..80b60b975 100644 --- a/R/utils.R +++ b/R/utils.R @@ -456,3 +456,23 @@ children <- function(x, dataset_name = character(0)) { updateSelectInput(inputId = inputId, choices = cs$choices, selected = cs$selected) if (length(cs$choices) < 2) shinyjs::hide(inputId) } + +.get_column_label <- function(data, column) { + column_label <- attr(data[[column]], "label") + if (!length(column_label)) column_label <- column + column_label +} + + +.generate_tooltip <- function(data, tooltip_cols) { + tooltip_lines <- sapply(tooltip_cols, function(col) { + label <- .get_column_label(data, col) + value <- data[[col]] + paste0(label, ": ", value) + }) + if (is.vector(tooltip_lines)) { + paste(tooltip_lines, collapse = "
") + } else { + apply(tooltip_lines, 1, function(row) paste(row, collapse = "
")) + } +} From 4dd1b595f9b43e2523852b3bb1019f359d49af80 Mon Sep 17 00:00:00 2001 From: vedhav Date: Wed, 7 May 2025 14:40:00 +0530 Subject: [PATCH 83/92] feat: allow custome siize based on a column + expand cards --- R/tm_g_spiderplot.R | 23 ++++++++++++++++++++--- R/tm_g_swimlane.R | 25 +++++++++++++++++++++---- R/tm_g_waterfall.R | 9 +++++++-- R/tm_t_reactable.R | 12 +++++++++--- inst/css/reactable.css | 7 +++++++ 5 files changed, 64 insertions(+), 12 deletions(-) create mode 100644 inst/css/reactable.css diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index cca7d859d..8a13d263c 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -87,6 +87,7 @@ tm_g_spiderplot <- function(label = "Spiderplot", subject_var, filter_event_var, color_var, + size_var = NULL, point_colors = character(0), point_symbols = character(0), plot_height = 600, @@ -122,6 +123,7 @@ tm_g_spiderplot <- function(label = "Spiderplot", subject_var = subject_var, filter_event_var = filter_event_var, color_var = color_var, + size_var = size_var, point_colors = point_colors, point_symbols = point_symbols, table_datanames = table_datanames, @@ -150,8 +152,13 @@ ui_g_spiderplot <- function(id, height) { colour_picker_ui(ns("colors")), sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), - bslib::page_fillable( - plotly::plotlyOutput(ns("plot"), height = "100%"), + tags$div( + bslib::card( + full_screen = TRUE, + tags$div( + plotly::plotlyOutput(ns("plot"), height = "100%") + ) + ), ui_t_reactables(ns("subtables")) ) ) @@ -167,6 +174,7 @@ srv_g_spiderplot <- function(id, color_var, point_colors, point_symbols, + size_var = NULL, plot_height = 600, table_datanames = character(0), reactable_args = list(), @@ -229,6 +237,7 @@ srv_g_spiderplot <- function(id, color_var = input$color_var, colors = color_inputs(), symbols = adjusted_symbols, + size_var = size_var, height = input$plot_height, title = sprintf("%s over time", input$filter_event_var_level), tooltip_cols = tooltip_cols, @@ -243,6 +252,7 @@ srv_g_spiderplot <- function(id, color_var = color_var, colors = colors, symbols = symbols, + size_var = size_var, height = height, tooltip_cols = tooltip_cols ) %>% @@ -277,11 +287,17 @@ srv_g_spiderplot <- function(id, #' @export spiderplotly <- function( data, time_var, value_var, subject_var, filter_event_var, - color_var, colors, symbols, height, tooltip_cols = NULL) { + color_var, colors, symbols, height, tooltip_cols = NULL, size_var = NULL, point_size = 10) { subject_var_label <- .get_column_label(data, subject_var) time_var_label <- .get_column_label(data, time_var) value_var_label <- .get_column_label(data, value_var) + if (is.null(size_var)) { + size <- point_size + } else { + size <- stats::as.formula(sprintf("~%s", size_var)) + } + data %>% dplyr::arrange(!!as.name(subject_var), !!as.name(time_var)) %>% dplyr::group_by(!!as.name(subject_var)) %>% @@ -319,6 +335,7 @@ spiderplotly <- function( x = stats::as.formula(sprintf("~%s", time_var)), y = stats::as.formula(sprintf("~%s", value_var)), symbol = stats::as.formula(sprintf("~%s", color_var)), + size = size, text = ~tooltip, hoverinfo = "text" ) %>% diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 2b1d42ab5..6e36a9814 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -74,6 +74,7 @@ tm_g_swimlane <- function(label = "Swimlane", subject_var, color_var, group_var, + size_var = NULL, sort_var = NULL, point_colors = character(0), point_symbols = character(0), @@ -109,6 +110,7 @@ tm_g_swimlane <- function(label = "Swimlane", color_var = color_var, group_var = group_var, sort_var = sort_var, + size_var = size_var, point_colors = point_colors, point_symbols = point_symbols, table_datanames = table_datanames, @@ -130,8 +132,13 @@ ui_g_swimlane <- function(id, height) { colour_picker_ui(ns("colors")), sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), - bslib::page_fillable( - plotly::plotlyOutput(ns("plot"), height = "100%"), + tags$div( + bslib::card( + full_screen = TRUE, + tags$div( + plotly::plotlyOutput(ns("plot"), height = "100%") + ) + ), ui_t_reactables(ns("subtables")) ) ) @@ -144,6 +151,7 @@ srv_g_swimlane <- function(id, color_var, group_var, sort_var = time_var, + size_var = NULL, point_colors, point_symbols, table_datanames, @@ -180,6 +188,7 @@ srv_g_swimlane <- function(id, color_var = input$color_var, group_var = input$group_var, sort_var = input$sort_var, + size_var = size_var, colors = color_inputs(), symbols = adjusted_symbols, height = input$plot_height, @@ -192,6 +201,7 @@ srv_g_swimlane <- function(id, color_var = color_var, group_var = group_var, sort_var = sort_var, + size_var = size_var, colors = colors, symbols = symbols, height = height, @@ -230,11 +240,17 @@ srv_g_swimlane <- function(id, # todo: export is temporary, this should go to a new package teal.graphs or another bird species #' @export swimlanely <- function( - data, time_var, subject_var, color_var, group_var, - sort_var, colors, symbols, height, tooltip_cols = NULL) { + data, time_var, subject_var, color_var, group_var, sort_var, + colors, symbols, height, tooltip_cols = NULL, size_var = NULL, point_size = 10) { subject_var_label <- .get_column_label(data, subject_var) time_var_label <- .get_column_label(data, time_var) + if (is.null(size_var)) { + size <- point_size + } else { + size <- stats::as.formula(sprintf("~%s", size_var)) + } + # forcats::fct_reorder doesn't seem to work here subject_levels <- data %>% dplyr::group_by(!!as.name(subject_var)) %>% @@ -282,6 +298,7 @@ swimlanely <- function( y = stats::as.formula(sprintf("~%s", subject_var)), color = stats::as.formula(sprintf("~%s", color_var)), symbol = stats::as.formula(sprintf("~%s", color_var)), + size = size, text = ~tooltip, hoverinfo = "text" ) %>% diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index c4e24e87a..f1849637a 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -126,8 +126,13 @@ ui_g_waterfall <- function(id, height) { colour_picker_ui(ns("colors")), sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) ), - bslib::page_fillable( - plotly::plotlyOutput(ns("plot"), height = "100%"), + tags$div( + bslib::card( + full_screen = TRUE, + tags$div( + plotly::plotlyOutput(ns("plot"), height = "100%") + ) + ), ui_t_reactables(ns("subtables")) ) ) diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index 07e0950a7..a55ae6d0f 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -63,10 +63,11 @@ srv_t_reactables <- function( return(NULL) } div( + include_css_files("reactable.css"), do.call( bslib::accordion, c( - list(id = session$ns("reactables")), + list(id = session$ns("reactables"), class = "teal-modules-general reactable-accordion"), lapply( datanames_r(), function(dataname) { @@ -115,7 +116,8 @@ ui_t_reactable <- function(id) { actionsBox = TRUE, `show-subtext` = TRUE, countSelectedText = TRUE, - liveSearch = TRUE + liveSearch = TRUE, + container = "body" ) ) @@ -123,7 +125,11 @@ ui_t_reactable <- function(id) { # bslib::popover(input) bslib::page_fluid( input, - reactable::reactableOutput(ns("table")) + bslib::card( + class = "teal-modules-general reactable-card", + full_screen = TRUE, + reactable::reactableOutput(ns("table")) + ) ) } diff --git a/inst/css/reactable.css b/inst/css/reactable.css new file mode 100644 index 000000000..1b0c523aa --- /dev/null +++ b/inst/css/reactable.css @@ -0,0 +1,7 @@ +.teal-modules-general.reactable-accordion .accordion-body { + padding: 0; +} + +.teal-modules-general.reactable-card { + margin-bottom: 0; +} From ce441c3655484bed222bb5b0f6d4f49893a5183a Mon Sep 17 00:00:00 2001 From: vedhav Date: Wed, 7 May 2025 15:59:39 +0530 Subject: [PATCH 84/92] docs: update roxygen docs for new params --- R/tm_g_spiderplot.R | 38 +++++++++++++++++++++----------------- R/tm_g_swimlane.R | 41 +++++++++++++++++++++++++++-------------- R/tm_g_waterfall.R | 29 +++++++++++++++++------------ man/tm_g_spiderplot.Rd | 30 +++++++++++++++++------------- man/tm_g_swimlane.Rd | 24 ++++++++++++++++-------- man/tm_g_waterfall.Rd | 16 ++++++++++------ 6 files changed, 108 insertions(+), 70 deletions(-) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 8a13d263c..1410951c9 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -13,13 +13,18 @@ #' in `plot_dataname` to be used as grouping variable for displayed lines/points. #' @param color_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` #' to be used to differentiate colors and symbols. -#' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named -#' by levels of `color_var` column. #' @param filter_event_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column #' in `plot_dataname` to be used to filter the data. #' The plot will be updated with just the filtereed data when the user selects an event from the dropdown menu. -#' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` -#' column. +#' @param size_var (`character(1)` or `NULL`) If provided, this numeric column from the `plot_dataname` +#' will be used to determine the size of the points. If `NULL`, a fixed size based on the `point_size` is used. +#' @param tooltip_vars (`character` or `NULL`) A vector of column names to be displayed in the tooltip. +#' If `NULL`, default tooltip is created. +#' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named +#' by levels of `color_var` column. +#' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var`column. +#' @param table_datanames (`character`) Names of the datasets to be displayed in the tables below the plot. +#' @param reactable_args (`list`) Additional arguments passed to the `reactable` function for table customization. #' #' @examples #' data <- teal_data() |> @@ -85,16 +90,15 @@ tm_g_spiderplot <- function(label = "Spiderplot", time_var, value_var, subject_var, - filter_event_var, color_var, + filter_event_var, size_var = NULL, + tooltip_vars = NULL, point_colors = character(0), point_symbols = character(0), - plot_height = 600, + plot_height = c(600, 400, 1200), table_datanames = character(0), - reactable_args = list(), - tooltip_cols = NULL, - transformator = transformator) { + reactable_args = list()) { if (is.character(time_var)) { time_var <- choices_selected(choices = time_var, selected = time_var) } @@ -128,7 +132,7 @@ tm_g_spiderplot <- function(label = "Spiderplot", point_symbols = point_symbols, table_datanames = table_datanames, reactable_args = reactable_args, - tooltip_cols = tooltip_cols + tooltip_vars = tooltip_vars ), datanames = union(plot_dataname, table_datanames) ) @@ -150,7 +154,7 @@ ui_g_spiderplot <- function(id, height) { selectInput(ns("filter_event_var"), label = "Event variable:", choices = NULL, selected = NULL, multiple = FALSE), selectInput(ns("filter_event_var_level"), label = "Select an event:", choices = NULL, selected = NULL, multiple = FALSE), colour_picker_ui(ns("colors")), - sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) + sliderInput(ns("plot_height"), "Plot Height (px)", height[2], height[3], height[1]) ), tags$div( bslib::card( @@ -178,7 +182,7 @@ srv_g_spiderplot <- function(id, plot_height = 600, table_datanames = character(0), reactable_args = list(), - tooltip_cols = NULL, + tooltip_vars = NULL, filter_panel_api) { moduleServer(id, function(input, output, session) { .update_cs_input(inputId = "value_var", data = reactive(data()[[dataname]]), cs = value_var) @@ -240,7 +244,7 @@ srv_g_spiderplot <- function(id, size_var = size_var, height = input$plot_height, title = sprintf("%s over time", input$filter_event_var_level), - tooltip_cols = tooltip_cols, + tooltip_vars = tooltip_vars, expr = { p <- dataname %>% dplyr::filter(filter_event_var_lang == selected_event) %>% @@ -254,7 +258,7 @@ srv_g_spiderplot <- function(id, symbols = symbols, size_var = size_var, height = height, - tooltip_cols = tooltip_cols + tooltip_vars = tooltip_vars ) %>% plotly::layout(title = title) } @@ -287,7 +291,7 @@ srv_g_spiderplot <- function(id, #' @export spiderplotly <- function( data, time_var, value_var, subject_var, filter_event_var, - color_var, colors, symbols, height, tooltip_cols = NULL, size_var = NULL, point_size = 10) { + color_var, colors, symbols, height, tooltip_vars = NULL, size_var = NULL, point_size = 10) { subject_var_label <- .get_column_label(data, subject_var) time_var_label <- .get_column_label(data, time_var) value_var_label <- .get_column_label(data, value_var) @@ -305,7 +309,7 @@ spiderplotly <- function( x = dplyr::lag(!!as.name(time_var), default = 0), y = dplyr:::lag(!!as.name(value_var), default = 0), tooltip = { - if (is.null(tooltip_cols)) { + if (is.null(tooltip_vars)) { sprintf( "%s: %s
%s: %s
%s: %s%%
", subject_var_label, !!as.name(subject_var), @@ -313,7 +317,7 @@ spiderplotly <- function( value_var_label, !!as.name(value_var) * 100 ) } else { - .generate_tooltip(.data, tooltip_cols) + .generate_tooltip(.data, tooltip_vars) } } ) %>% diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 6e36a9814..c4c573a09 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -17,10 +17,16 @@ #' todo: this can be fixed by ordering factor levels #' @param sort_var (`character(1)` or `choices_selected`) name(s) of the column in `plot_dataname` which #' value determines order of the subjects displayed on the y-axis. +#' @param tooltip_vars (`character` or `NULL`) A vector of column names to be displayed in the tooltip. +#' If `NULL`, default tooltip is created. +#' @param size_var (`character(1)` or `NULL`) If provided, this numeric column from the `plot_dataname` +#' will be used to determine the size of the points. If `NULL`, a fixed size based on the `point_size` is used. +#' @param point_size (`numeric(1)`) Default point size of the points in the plot. #' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named #' by levels of `color_var` column. -#' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` -#' column. +#' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` column. +#' @param table_datanames (`character`) Names of the datasets to be displayed in the tables below the plot. +#' @param reactable_args (`list`) Additional arguments passed to the `reactable` function for table customization. #' #' @examples #' data <- teal_data() |> @@ -74,14 +80,17 @@ tm_g_swimlane <- function(label = "Swimlane", subject_var, color_var, group_var, - size_var = NULL, sort_var = NULL, + tooltip_vars = NULL, + size_var = NULL, + point_size = 10, point_colors = character(0), point_symbols = character(0), - plot_height = 700, + plot_height = c(700, 400, 1200), table_datanames = character(0), - reactable_args = list(), - tooltip_cols = NULL) { + reactable_args = list()) { + checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE) + checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height") if (is.character(time_var)) { time_var <- choices_selected(choices = time_var, selected = time_var) } @@ -111,11 +120,12 @@ tm_g_swimlane <- function(label = "Swimlane", group_var = group_var, sort_var = sort_var, size_var = size_var, + point_size = point_size, point_colors = point_colors, point_symbols = point_symbols, table_datanames = table_datanames, reactable_args = reactable_args, - tooltip_cols = tooltip_cols + tooltip_vars = tooltip_vars ) ) } @@ -130,7 +140,7 @@ ui_g_swimlane <- function(id, height) { selectInput(ns("group_var"), label = "Group by:", choices = NULL, selected = NULL, multiple = FALSE), selectInput(ns("sort_var"), label = "Sort by:", choices = NULL, selected = NULL, multiple = FALSE), colour_picker_ui(ns("colors")), - sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) + sliderInput(ns("plot_height"), "Plot Height (px)", height[2], height[3], height[1]) ), tags$div( bslib::card( @@ -152,11 +162,12 @@ srv_g_swimlane <- function(id, group_var, sort_var = time_var, size_var = NULL, + point_size = 10, point_colors, point_symbols, table_datanames, reactable_args = list(), - tooltip_cols = NULL, + tooltip_vars = NULL, filter_panel_api) { moduleServer(id, function(input, output, session) { .update_cs_input(inputId = "time_var", data = reactive(data()[[dataname]]), cs = time_var) @@ -189,10 +200,11 @@ srv_g_swimlane <- function(id, group_var = input$group_var, sort_var = input$sort_var, size_var = size_var, + point_size = point_size, colors = color_inputs(), symbols = adjusted_symbols, height = input$plot_height, - tooltip_cols = tooltip_cols, + tooltip_vars = tooltip_vars, expr = { p <- swimlanely( data = dataname, @@ -202,10 +214,11 @@ srv_g_swimlane <- function(id, group_var = group_var, sort_var = sort_var, size_var = size_var, + point_size = point_size, colors = colors, symbols = symbols, height = height, - tooltip_cols = tooltip_cols + tooltip_vars = tooltip_vars ) } ) @@ -241,7 +254,7 @@ srv_g_swimlane <- function(id, #' @export swimlanely <- function( data, time_var, subject_var, color_var, group_var, sort_var, - colors, symbols, height, tooltip_cols = NULL, size_var = NULL, point_size = 10) { + colors, symbols, height, tooltip_vars = NULL, size_var = NULL, point_size = 10) { subject_var_label <- .get_column_label(data, subject_var) time_var_label <- .get_column_label(data, time_var) @@ -267,7 +280,7 @@ swimlanely <- function( dplyr::group_by(!!as.name(subject_var), !!as.name(time_var)) %>% dplyr::mutate( tooltip = { - if (is.null(tooltip_cols)) { + if (is.null(tooltip_vars)) { paste( unique( c( @@ -283,7 +296,7 @@ swimlanely <- function( collapse = "
" ) } else { - .generate_tooltip(.data, tooltip_cols) + .generate_tooltip(.data, tooltip_vars) } } ) %>% diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index f1849637a..da71cb2e9 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -11,10 +11,15 @@ #' in `plot_dataname` to be used as y-axis. #' @param color_var (`character(1)` or `choices_selected`) name of the `factor` or `character` column in `plot_dataname` #' to be used to differentiate bar colors. +#' @param tooltip_vars (`character` or `NULL`) A vector of column names to be displayed in the tooltip. +#' If `NULL`, default tooltip is created. #' @param bar_colors (`named character`) valid color names (see [colors()]) or hex-colors named #' by levels of `color_var` column. #' @param value_arbitrary_hlines (`numeric`) values in the same scale as `value_var` to horizontal #' lines on the plot. +#' @param plot_title (`character`) Title of the plot. +#' @param table_datanames (`character`) Names of the datasets to be displayed in the tables below the plot. +#' @param reactable_args (`list`) Additional arguments passed to the `reactable` function for table customization. #' #' @examples #' data <- teal_data() |> @@ -64,13 +69,13 @@ tm_g_waterfall <- function(label = "Waterfall", value_var, sort_var = NULL, color_var = NULL, + tooltip_vars = NULL, bar_colors = character(0), value_arbitrary_hlines = c(0.2, -0.3), plot_title = "Waterfall plot", - plot_height = 700, + plot_height = c(600, 400, 1200), table_datanames = character(0), - reactable_args = list(), - tooltip_cols = NULL) { + reactable_args = list()) { if (is.character(subject_var)) { subject_var <- choices_selected(choices = subject_var, selected = subject_var) } @@ -101,7 +106,7 @@ tm_g_waterfall <- function(label = "Waterfall", value_arbitrary_hlines = value_arbitrary_hlines, plot_title = plot_title, reactable_args = reactable_args, - tooltip_cols = tooltip_cols + tooltip_vars = tooltip_vars ) ) } @@ -124,7 +129,7 @@ ui_g_waterfall <- function(id, height) { selectInput(ns("sort_var"), label = "Sort by:", choices = NULL, selected = NULL, multiple = FALSE), selectInput(ns("color_var"), label = "Color by:", choices = NULL, selected = NULL, multiple = FALSE), colour_picker_ui(ns("colors")), - sliderInput(ns("plot_height"), "Plot Height (px)", 400, 1200, height) + sliderInput(ns("plot_height"), "Plot Height (px)", height[2], height[3], height[1]) ), tags$div( bslib::card( @@ -147,10 +152,10 @@ srv_g_waterfall <- function(id, bar_colors, value_arbitrary_hlines, plot_title, - plot_height = 600, + plot_height = c(600, 400, 1200), table_datanames = character(0), reactable_args = list(), - tooltip_cols = NULL, + tooltip_vars = NULL, filter_panel_api) { moduleServer(id, function(input, output, session) { .update_cs_input(inputId = "subject_var", data = reactive(data()[[dataname]]), cs = subject_var) @@ -181,7 +186,7 @@ srv_g_waterfall <- function(id, value_arbitrary_hlines = value_arbitrary_hlines, height = input$plot_height, title = sprintf("Waterfall plot"), - tooltip_cols = tooltip_cols, + tooltip_vars = tooltip_vars, expr = { p <- waterfally( dataname, @@ -192,7 +197,7 @@ srv_g_waterfall <- function(id, colors = colors, value_arbitrary_hlines = value_arbitrary_hlines, height = height, - tooltip_cols = tooltip_cols + tooltip_vars = tooltip_vars ) %>% plotly::layout(title = title) }, @@ -227,7 +232,7 @@ srv_g_waterfall <- function(id, #' @export waterfally <- function( data, subject_var, value_var, sort_var, color_var, colors, - value_arbitrary_hlines, height, tooltip_cols = NULL) { + value_arbitrary_hlines, height, tooltip_vars = NULL) { subject_var_label <- .get_column_label(data, subject_var) value_var_label <- .get_column_label(data, value_var) color_var_label <- .get_column_label(data, color_var) @@ -240,7 +245,7 @@ waterfally <- function( }, !!as.name(subject_var) := factor(!!as.name(subject_var), levels = unique(!!as.name(subject_var))), tooltip = { - if (is.null(tooltip_cols)) { + if (is.null(tooltip_vars)) { sprintf( "%s: %s
%s: %s%%
%s: %s", subject_var_label, !!as.name(subject_var), @@ -248,7 +253,7 @@ waterfally <- function( color_var_label, !!as.name(color_var) ) } else { - .generate_tooltip(.data, tooltip_cols) + .generate_tooltip(.data, tooltip_vars) } } ) %>% diff --git a/man/tm_g_spiderplot.Rd b/man/tm_g_spiderplot.Rd index 366a54bf2..bd45f3360 100644 --- a/man/tm_g_spiderplot.Rd +++ b/man/tm_g_spiderplot.Rd @@ -10,14 +10,15 @@ tm_g_spiderplot( time_var, value_var, subject_var, - filter_event_var, color_var, + filter_event_var, + size_var = NULL, + tooltip_vars = NULL, point_colors = character(0), point_symbols = character(0), - plot_height = 600, + plot_height = c(600, 400, 1200), table_datanames = character(0), - reactable_args = list(), - transformator = transformator + reactable_args = list() ) } \arguments{ @@ -35,27 +36,30 @@ in \code{plot_dataname} to be used as y-axis.} \item{subject_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to be used as grouping variable for displayed lines/points.} +\item{color_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} +to be used to differentiate colors and symbols.} + \item{filter_event_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to be used to filter the data. The plot will be updated with just the filtereed data when the user selects an event from the dropdown menu.} -\item{color_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} -to be used to differentiate colors and symbols.} +\item{size_var}{(\code{character(1)} or \code{NULL}) If provided, this numeric column from the \code{plot_dataname} +will be used to determine the size of the points. If \code{NULL}, a fixed size based on the \code{point_size} is used.} + +\item{tooltip_vars}{(\code{character} or \code{NULL}) A vector of column names to be displayed in the tooltip. +If \code{NULL}, default tooltip is created.} \item{point_colors}{(\verb{named character}) valid color names (see \code{\link[=colors]{colors()}}) or hex-colors named by levels of \code{color_var} column.} -\item{point_symbols}{(\verb{named character}) valid plotly symbol name named by levels of \code{color_var} -column.} +\item{point_symbols}{(\verb{named character}) valid plotly symbol name named by levels of \code{color_var}column.} \item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of \code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{table_datanames}{(\code{character}) names of the datasets which should be listed below the plot -when some data points are selected. Objects named after \code{table_datanames} will be pulled from -\code{data} so it is important that data actually contains these datasets. Please be aware that -table datasets must be linked with \code{plot_dataname} by the relevant \code{\link[=join_keys]{join_keys()}}. -See section "Decorating Module" below for more details.} +\item{table_datanames}{(\code{character}) Names of the datasets to be displayed in the tables below the plot.} + +\item{reactable_args}{(\code{list}) Additional arguments passed to the \code{reactable} function for table customization.} } \description{ Module visualizes value development in time grouped by subjects. diff --git a/man/tm_g_swimlane.Rd b/man/tm_g_swimlane.Rd index 6ffe9dc82..daf534c55 100644 --- a/man/tm_g_swimlane.Rd +++ b/man/tm_g_swimlane.Rd @@ -12,9 +12,12 @@ tm_g_swimlane( color_var, group_var, sort_var = NULL, + tooltip_vars = NULL, + size_var = NULL, + point_size = 10, point_colors = character(0), point_symbols = character(0), - plot_height = 700, + plot_height = c(700, 400, 1200), table_datanames = character(0), reactable_args = list() ) @@ -42,20 +45,25 @@ todo: this can be fixed by ordering factor levels} \item{sort_var}{(\code{character(1)} or \code{choices_selected}) name(s) of the column in \code{plot_dataname} which value determines order of the subjects displayed on the y-axis.} +\item{tooltip_vars}{(\code{character} or \code{NULL}) A vector of column names to be displayed in the tooltip. +If \code{NULL}, default tooltip is created.} + +\item{size_var}{(\code{character(1)} or \code{NULL}) If provided, this numeric column from the \code{plot_dataname} +will be used to determine the size of the points. If \code{NULL}, a fixed size based on the \code{point_size} is used.} + +\item{point_size}{(\code{numeric(1)}) Default point size of the points in the plot.} + \item{point_colors}{(\verb{named character}) valid color names (see \code{\link[=colors]{colors()}}) or hex-colors named by levels of \code{color_var} column.} -\item{point_symbols}{(\verb{named character}) valid plotly symbol name named by levels of \code{color_var} -column.} +\item{point_symbols}{(\verb{named character}) valid plotly symbol name named by levels of \code{color_var} column.} \item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of \code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{table_datanames}{(\code{character}) names of the datasets which should be listed below the plot -when some data points are selected. Objects named after \code{table_datanames} will be pulled from -\code{data} so it is important that data actually contains these datasets. Please be aware that -table datasets must be linked with \code{plot_dataname} by the relevant \code{\link[=join_keys]{join_keys()}}. -See section "Decorating Module" below for more details.} +\item{table_datanames}{(\code{character}) Names of the datasets to be displayed in the tables below the plot.} + +\item{reactable_args}{(\code{list}) Additional arguments passed to the \code{reactable} function for table customization.} } \description{ Module visualizes subjects' events in time. diff --git a/man/tm_g_waterfall.Rd b/man/tm_g_waterfall.Rd index aa84a8fae..4afb01ecd 100644 --- a/man/tm_g_waterfall.Rd +++ b/man/tm_g_waterfall.Rd @@ -11,10 +11,11 @@ tm_g_waterfall( value_var, sort_var = NULL, color_var = NULL, + tooltip_vars = NULL, bar_colors = character(0), value_arbitrary_hlines = c(0.2, -0.3), plot_title = "Waterfall plot", - plot_height = 700, + plot_height = c(600, 400, 1200), table_datanames = character(0), reactable_args = list() ) @@ -34,20 +35,23 @@ in \code{plot_dataname} to be used as y-axis.} \item{color_var}{(\code{character(1)} or \code{choices_selected}) name of the \code{factor} or \code{character} column in \code{plot_dataname} to be used to differentiate bar colors.} +\item{tooltip_vars}{(\code{character} or \code{NULL}) A vector of column names to be displayed in the tooltip. +If \code{NULL}, default tooltip is created.} + \item{bar_colors}{(\verb{named character}) valid color names (see \code{\link[=colors]{colors()}}) or hex-colors named by levels of \code{color_var} column.} \item{value_arbitrary_hlines}{(\code{numeric}) values in the same scale as \code{value_var} to horizontal lines on the plot.} +\item{plot_title}{(\code{character}) Title of the plot.} + \item{plot_height}{(\code{numeric}) optional, specifies the plot height as a three-element vector of \code{value}, \code{min}, and \code{max} intended for use with a slider UI element.} -\item{table_datanames}{(\code{character}) names of the datasets which should be listed below the plot -when some data points are selected. Objects named after \code{table_datanames} will be pulled from -\code{data} so it is important that data actually contains these datasets. Please be aware that -table datasets must be linked with \code{plot_dataname} by the relevant \code{\link[=join_keys]{join_keys()}}. -See section "Decorating Module" below for more details.} +\item{table_datanames}{(\code{character}) Names of the datasets to be displayed in the tables below the plot.} + +\item{reactable_args}{(\code{list}) Additional arguments passed to the \code{reactable} function for table customization.} } \description{ Module visualizes subjects sorted decreasingly by y-values. From a840f295a0489881f1659afa8292daac75236feb Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 9 May 2025 16:37:23 +0530 Subject: [PATCH 85/92] feat: add the show selected tooltips module --- R/tm_g_spiderplot.R | 3 +++ R/tm_g_swimlane.R | 3 +++ R/utils.R | 50 ++++++++++++++++++++++++++++++++++++++ inst/js/triggerTooltips.js | 8 ++++++ 4 files changed, 64 insertions(+) create mode 100644 inst/js/triggerTooltips.js diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 1410951c9..f918efd84 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -160,6 +160,7 @@ ui_g_spiderplot <- function(id, height) { bslib::card( full_screen = TRUE, tags$div( + ui_trigger_tooltips(ns("show_tooltips")), plotly::plotlyOutput(ns("plot"), height = "100%") ) ), @@ -269,6 +270,8 @@ srv_g_spiderplot <- function(id, plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) + srv_trigger_tooltips("show_tooltips", plotly_selected, session$ns("plot")) + tables_selected_q <- .plotly_selected_filter_children( data = plotly_q, plot_dataname = plot_dataname, diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index c4c573a09..a2e65d9d1 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -146,6 +146,7 @@ ui_g_swimlane <- function(id, height) { bslib::card( full_screen = TRUE, tags$div( + ui_trigger_tooltips(ns("show_tooltips")), plotly::plotlyOutput(ns("plot"), height = "100%") ) ), @@ -231,6 +232,8 @@ srv_g_swimlane <- function(id, plotly::event_data("plotly_selected", source = "swimlane") }) + srv_trigger_tooltips("show_tooltips", plotly_selected, session$ns("plot")) + tables_selected_q <- .plotly_selected_filter_children( data = plotly_q, plot_dataname = plot_dataname, diff --git a/R/utils.R b/R/utils.R index 80b60b975..f467b19c5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -476,3 +476,53 @@ children <- function(x, dataset_name = character(0)) { apply(tooltip_lines, 1, function(row) paste(row, collapse = "
")) } } + + +#' @keywords internal +#' @noRd +trigger_tooltips_deps <- function() { + htmltools::htmlDependency( + name = "teal-modules-general-trigger-tooltips", + version = utils::packageVersion("teal.modules.general"), + package = "teal.modules.general", + src = "js", + script = "triggerTooltips.js" + ) +} + +#' @keywords internal +#' @noRd +ui_trigger_tooltips <- function(id) { + ns <- NS(id) + tags$div( + trigger_tooltips_deps(), + actionButton(ns("show_tooltips"), "Show Selected Tooltips") + ) +} + +#' @keywords internal +#' @noRd +srv_trigger_tooltips <- function(id, plotly_selected, plot_id) { + moduleServer(id, function(input, output, session) { + observeEvent(input$show_tooltips, { + sel <- plotly_selected() + + if (!is.null(sel) && nrow(sel) > 0) { + tooltip_points <- lapply(seq_len(nrow(sel)), function(i) { + list( + curve = sel$curveNumber[i], + index = sel$pointNumber[i] + ) + }) + + session$sendCustomMessage( + "triggerTooltips", + list( + plotID = plot_id, + tooltipPoints = jsonlite::toJSON(tooltip_points, auto_unbox = TRUE) + ) + ) + } + }) + }) +} diff --git a/inst/js/triggerTooltips.js b/inst/js/triggerTooltips.js new file mode 100644 index 000000000..bd1072f89 --- /dev/null +++ b/inst/js/triggerTooltips.js @@ -0,0 +1,8 @@ +Shiny.addCustomMessageHandler("triggerTooltips", function (message) { + const plotDiv = document.getElementById(message.plotID); + const hoverPoints = message.tooltipPoints.map((point) => ({ + curveNumber: point.curve || 0, + pointNumber: point.index, + })); + Plotly.Fx.hover(plotDiv, hoverPoints); +}); From 68d212f5f6f65700a4c33976ce45a6db763af052 Mon Sep 17 00:00:00 2001 From: vedhav Date: Wed, 14 May 2025 12:21:18 +0530 Subject: [PATCH 86/92] feat: improve the trigger tooltips --- R/tm_g_spiderplot.R | 31 +++++- R/tm_g_swimlane.R | 87 ++++++++++++++-- R/utils.R | 98 +++++++++++++------ inst/triggerTooltips/triggerTooltips.css | 46 +++++++++ .../triggerTooltips.js | 0 5 files changed, 223 insertions(+), 39 deletions(-) create mode 100644 inst/triggerTooltips/triggerTooltips.css rename inst/{js => triggerTooltips}/triggerTooltips.js (100%) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index f918efd84..8ea43f8bc 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -160,7 +160,7 @@ ui_g_spiderplot <- function(id, height) { bslib::card( full_screen = TRUE, tags$div( - ui_trigger_tooltips(ns("show_tooltips")), + trigger_tooltips_deps(), plotly::plotlyOutput(ns("plot"), height = "100%") ) ), @@ -266,11 +266,36 @@ srv_g_spiderplot <- function(id, ) }) - output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) + output$plot <- output$plot <- plotly::renderPlotly(plotly::event_register( + { + plotly_q()$p |> + setup_trigger_tooltips(session$ns, input) + }, + "plotly_selected" + )) plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) - srv_trigger_tooltips("show_tooltips", plotly_selected, session$ns("plot")) + observeEvent(input$show_tooltips, { + sel <- plotly_selected() + + if (!is.null(sel) && nrow(sel) > 0) { + tooltip_points <- lapply(seq_len(nrow(sel)), function(i) { + list( + curve = sel$curveNumber[i], + index = sel$pointNumber[i] + ) + }) + + session$sendCustomMessage( + "triggerTooltips", + list( + plotID = session$ns("plot"), + tooltipPoints = jsonlite::toJSON(tooltip_points, auto_unbox = TRUE) + ) + ) + } + }) tables_selected_q <- .plotly_selected_filter_children( data = plotly_q, diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index a2e65d9d1..f77fc73e5 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -140,13 +140,15 @@ ui_g_swimlane <- function(id, height) { selectInput(ns("group_var"), label = "Group by:", choices = NULL, selected = NULL, multiple = FALSE), selectInput(ns("sort_var"), label = "Sort by:", choices = NULL, selected = NULL, multiple = FALSE), colour_picker_ui(ns("colors")), - sliderInput(ns("plot_height"), "Plot Height (px)", height[2], height[3], height[1]) + sliderInput(ns("plot_height"), "Plot Height (px)", height[2], height[3], height[1]), + selectInput(ns("subjects"), "Subjects", choices = NULL, selected = NULL, multiple = TRUE), + actionButton(ns("subject_tooltips"), "Show Subject Tooltips") ), tags$div( bslib::card( full_screen = TRUE, tags$div( - ui_trigger_tooltips(ns("show_tooltips")), + trigger_tooltips_deps(), plotly::plotlyOutput(ns("plot"), height = "100%") ) ), @@ -188,6 +190,7 @@ srv_g_swimlane <- function(id, plotly_q <- reactive({ req(data(), input$time_var, input$subject_var, input$color_var, input$group_var, input$sort_var, color_inputs()) + print(input$subject_var) adjusted_symbols <- .shape_palette_discrete( levels = unique(data()[[plot_dataname]][[input$color_var]]), symbol = point_symbols @@ -225,14 +228,69 @@ srv_g_swimlane <- function(id, ) }) - output$plot <- plotly::renderPlotly(plotly::event_register(plotly_q()$p, "plotly_selected")) + output$plot <- plotly::renderPlotly(plotly::event_register( + { + plotly_q()$p |> + set_plot_data(session$ns("plot_data")) |> + setup_trigger_tooltips(session$ns) + }, + "plotly_selected" + )) + + plotly_data <- reactive({ + data.frame( + x = unlist(input$plot_data$x), + y = unlist(input$plot_data$y), + customdata = unlist(input$plot_data$customdata), + curve = unlist(input$plot_data$curveNumber), + index = unlist(input$plot_data$pointNumber) + ) + }) plotly_selected <- reactive({ plotly::event_data("plotly_deselect", source = "swimlane") # todo: deselect doesn't work plotly::event_data("plotly_selected", source = "swimlane") }) - srv_trigger_tooltips("show_tooltips", plotly_selected, session$ns("plot")) + observeEvent(input$show_tooltips, { + sel <- plotly_selected() + + if (!is.null(sel) && nrow(sel) > 0) { + tooltip_points <- lapply(seq_len(nrow(sel)), function(i) { + list( + curve = sel$curveNumber[i], + index = sel$pointNumber[i] + ) + }) + + session$sendCustomMessage( + "triggerTooltips", + list( + plotID = session$ns("plot"), + tooltipPoints = jsonlite::toJSON(tooltip_points, auto_unbox = TRUE) + ) + ) + } + }) + + observeEvent(input$subject_tooltips, { + hovervalues <- data()[[plot_dataname]] |> + dplyr::mutate(customdata = dplyr::row_number()) |> + dplyr::filter(!!rlang::sym(input$subject_var) %in% input$subjects) |> + dplyr::pull(customdata) + + + hovertips <- plotly_data() |> + dplyr::filter(customdata %in% hovervalues) + + session$sendCustomMessage( + "triggerTooltips", + list( + plotID = session$ns("plot"), + tooltipPoints = jsonlite::toJSON(hovertips) + ) + ) + }) tables_selected_q <- .plotly_selected_filter_children( data = plotly_q, @@ -243,6 +301,19 @@ srv_g_swimlane <- function(id, children_datanames = table_datanames ) + + observeEvent(data(), { + if (class(subject_var) == "choices_selected") { + subject_col <- subject_var$selected + } else { + subject_col <- subject_var + } + updateSelectInput( + inputId = "subjects", + choices = data()[[plot_dataname]][[subject_col]] + ) + }) + srv_t_reactables( "subtables", data = tables_selected_q, @@ -260,6 +331,8 @@ swimlanely <- function( colors, symbols, height, tooltip_vars = NULL, size_var = NULL, point_size = 10) { subject_var_label <- .get_column_label(data, subject_var) time_var_label <- .get_column_label(data, time_var) + data <- data |> + dplyr::mutate(customdata = dplyr::row_number()) if (is.null(size_var)) { size <- point_size @@ -307,7 +380,8 @@ swimlanely <- function( source = "swimlane", colors = colors, symbols = symbols, - height = height + height = height, + customdata = ~customdata ) %>% plotly::add_markers( x = stats::as.formula(sprintf("~%s", time_var)), @@ -327,7 +401,8 @@ swimlanely <- function( dplyr::group_by(!!as.name(subject_var), !!as.name(group_var)) |> dplyr::summarise(study_day = max(!!as.name(time_var))), line = list(width = 2, color = "grey"), - showlegend = FALSE + showlegend = FALSE, + customdata = NULL ) %>% plotly::layout( xaxis = list(title = time_var_label), diff --git a/R/utils.R b/R/utils.R index f467b19c5..a0e8a79c7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -485,44 +485,82 @@ trigger_tooltips_deps <- function() { name = "teal-modules-general-trigger-tooltips", version = utils::packageVersion("teal.modules.general"), package = "teal.modules.general", - src = "js", - script = "triggerTooltips.js" + src = "triggerTooltips", + script = "triggerTooltips.js", + stylesheet = "triggerTooltips.css" ) } + #' @keywords internal #' @noRd -ui_trigger_tooltips <- function(id) { - ns <- NS(id) - tags$div( - trigger_tooltips_deps(), - actionButton(ns("show_tooltips"), "Show Selected Tooltips") +setup_trigger_tooltips <- function(plot, ns) { + htmlwidgets::onRender( + plot, + paste0( + "function(el) { + const targetDiv = document.querySelector('#", ns("plot"), " .modebar-group:nth-child(4)'); + console.log(el.data); + if (targetDiv) { + const button = document.createElement('button'); + button.setAttribute('data-count', '0'); + button.className = 'teal-modules-general trigger-tooltips-button'; + + button.onclick = function () { + const current = parseInt(this.getAttribute('data-count')); + const next = current + 1; + this.setAttribute('data-count', next); + console.log('Button clicked ' + next + ' times'); + Shiny.setInputValue('", ns("show_tooltips"), "', next); + }; + + const icon = document.createElement('i'); + icon.className = 'fas fa-message'; + icon.setAttribute('role', 'presentation'); + icon.setAttribute('aria-label', 'info icon'); + + const tooltip = document.createElement('span'); + tooltip.className = 'plotly-icon-tooltip'; + tooltip.textContent = 'Hover selection'; + + button.appendChild(icon); + button.appendChild(tooltip); + targetDiv.appendChild(button); + } + }" + ) ) } #' @keywords internal #' @noRd -srv_trigger_tooltips <- function(id, plotly_selected, plot_id) { - moduleServer(id, function(input, output, session) { - observeEvent(input$show_tooltips, { - sel <- plotly_selected() - - if (!is.null(sel) && nrow(sel) > 0) { - tooltip_points <- lapply(seq_len(nrow(sel)), function(i) { - list( - curve = sel$curveNumber[i], - index = sel$pointNumber[i] - ) - }) - - session$sendCustomMessage( - "triggerTooltips", - list( - plotID = plot_id, - tooltipPoints = jsonlite::toJSON(tooltip_points, auto_unbox = TRUE) - ) - ) - } - }) - }) +set_plot_data <- function(plot, data_id) { + htmlwidgets::onRender( + plot, + paste0( + " + function(el) { + slicedData = el.data.slice(0, -1).map(({ x, y, customdata }) => ({ x, y, customdata })); + plotData = { + x: [], + y: [], + customdata: [], + curveNumber: [], + pointNumber: [] + }; + + slicedData.forEach((item, curveNumber) => { + for (let i = 0; i < item.x.length; i++) { + plotData.pointNumber.push(i); + plotData.x.push(item.x[i]); + plotData.y.push(item.y[i]); + plotData.customdata.push(item.customdata[i]); + plotData.curveNumber.push(curveNumber); + } + }); + Shiny.setInputValue('", data_id, "', plotData); + } + " + ) + ) } diff --git a/inst/triggerTooltips/triggerTooltips.css b/inst/triggerTooltips/triggerTooltips.css new file mode 100644 index 000000000..ef23f1b5b --- /dev/null +++ b/inst/triggerTooltips/triggerTooltips.css @@ -0,0 +1,46 @@ +.teal-modules-general.trigger-tooltips-button { + border: none; + background: white; + opacity: 0.2; +} + +.teal-modules-general.trigger-tooltips-button:hover { + opacity: 0.6; +} + +.teal-modules-general.trigger-tooltips-button i { + font-size: 0.85em; +} + +.teal-modules-general.trigger-tooltips-button { + position: relative; +} + +.teal-modules-general.trigger-tooltips-button > .plotly-icon-tooltip { + visibility: hidden; + position: absolute; + top: 125%; + right: 0; + transform: translateX(0); + background-color: #121f3d; + color: #fff; + padding: 6px 10px; + border-radius: 3px; + z-index: 1000; + font-size: 12px; +} + +.teal-modules-general.trigger-tooltips-button > .plotly-icon-tooltip::after { + content: ""; + position: absolute; + bottom: 100%; + right: 10px; + border-width: 5px; + border-style: solid; + border-color: transparent transparent #121f3d transparent; +} + +.teal-modules-general.trigger-tooltips-button:hover > .plotly-icon-tooltip { + visibility: visible; + opacity: 1; +} diff --git a/inst/js/triggerTooltips.js b/inst/triggerTooltips/triggerTooltips.js similarity index 100% rename from inst/js/triggerTooltips.js rename to inst/triggerTooltips/triggerTooltips.js From 8a364bd25985796792b4bd2b704550b73ce9cfeb Mon Sep 17 00:00:00 2001 From: vedhav Date: Wed, 14 May 2025 12:38:43 +0530 Subject: [PATCH 87/92] fix: remove unused param --- R/tm_g_spiderplot.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 8ea43f8bc..a5fa92f35 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -269,7 +269,7 @@ srv_g_spiderplot <- function(id, output$plot <- output$plot <- plotly::renderPlotly(plotly::event_register( { plotly_q()$p |> - setup_trigger_tooltips(session$ns, input) + setup_trigger_tooltips(session$ns) }, "plotly_selected" )) From 4d416764b1fd5fbd416337e4350dce55245561d2 Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 16 May 2025 09:48:56 +0530 Subject: [PATCH 88/92] feat: simplify the trigger tooltip logic --- R/tm_g_spiderplot.R | 21 --------------- R/tm_g_swimlane.R | 21 --------------- R/utils.R | 6 +---- inst/triggerTooltips/triggerTooltips.css | 15 +++++------ inst/triggerTooltips/triggerTooltips.js | 33 +++++++++++++++++++++--- 5 files changed, 36 insertions(+), 60 deletions(-) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index a5fa92f35..aa3356cb6 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -276,27 +276,6 @@ srv_g_spiderplot <- function(id, plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) - observeEvent(input$show_tooltips, { - sel <- plotly_selected() - - if (!is.null(sel) && nrow(sel) > 0) { - tooltip_points <- lapply(seq_len(nrow(sel)), function(i) { - list( - curve = sel$curveNumber[i], - index = sel$pointNumber[i] - ) - }) - - session$sendCustomMessage( - "triggerTooltips", - list( - plotID = session$ns("plot"), - tooltipPoints = jsonlite::toJSON(tooltip_points, auto_unbox = TRUE) - ) - ) - } - }) - tables_selected_q <- .plotly_selected_filter_children( data = plotly_q, plot_dataname = plot_dataname, diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index f77fc73e5..36378b7a8 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -252,27 +252,6 @@ srv_g_swimlane <- function(id, plotly::event_data("plotly_selected", source = "swimlane") }) - observeEvent(input$show_tooltips, { - sel <- plotly_selected() - - if (!is.null(sel) && nrow(sel) > 0) { - tooltip_points <- lapply(seq_len(nrow(sel)), function(i) { - list( - curve = sel$curveNumber[i], - index = sel$pointNumber[i] - ) - }) - - session$sendCustomMessage( - "triggerTooltips", - list( - plotID = session$ns("plot"), - tooltipPoints = jsonlite::toJSON(tooltip_points, auto_unbox = TRUE) - ) - ) - } - }) - observeEvent(input$subject_tooltips, { hovervalues <- data()[[plot_dataname]] |> dplyr::mutate(customdata = dplyr::row_number()) |> diff --git a/R/utils.R b/R/utils.R index a0e8a79c7..cf6b87ea3 100644 --- a/R/utils.R +++ b/R/utils.R @@ -507,11 +507,7 @@ setup_trigger_tooltips <- function(plot, ns) { button.className = 'teal-modules-general trigger-tooltips-button'; button.onclick = function () { - const current = parseInt(this.getAttribute('data-count')); - const next = current + 1; - this.setAttribute('data-count', next); - console.log('Button clicked ' + next + ' times'); - Shiny.setInputValue('", ns("show_tooltips"), "', next); + triggerSelectedTooltips('", ns("plot"), "') }; const icon = document.createElement('i'); diff --git a/inst/triggerTooltips/triggerTooltips.css b/inst/triggerTooltips/triggerTooltips.css index ef23f1b5b..5d639532b 100644 --- a/inst/triggerTooltips/triggerTooltips.css +++ b/inst/triggerTooltips/triggerTooltips.css @@ -22,7 +22,7 @@ top: 125%; right: 0; transform: translateX(0); - background-color: #121f3d; + background: #121f3d; color: #fff; padding: 6px 10px; border-radius: 3px; @@ -30,17 +30,14 @@ font-size: 12px; } +.teal-modules-general.trigger-tooltips-button:hover > .plotly-icon-tooltip { + visibility: visible; + opacity: 1; +} + .teal-modules-general.trigger-tooltips-button > .plotly-icon-tooltip::after { content: ""; position: absolute; bottom: 100%; right: 10px; - border-width: 5px; - border-style: solid; - border-color: transparent transparent #121f3d transparent; -} - -.teal-modules-general.trigger-tooltips-button:hover > .plotly-icon-tooltip { - visibility: visible; - opacity: 1; } diff --git a/inst/triggerTooltips/triggerTooltips.js b/inst/triggerTooltips/triggerTooltips.js index bd1072f89..59949c605 100644 --- a/inst/triggerTooltips/triggerTooltips.js +++ b/inst/triggerTooltips/triggerTooltips.js @@ -1,8 +1,33 @@ -Shiny.addCustomMessageHandler("triggerTooltips", function (message) { - const plotDiv = document.getElementById(message.plotID); +triggerTooltips = function (message) { + const plotElement = document.getElementById(message.plotID); const hoverPoints = message.tooltipPoints.map((point) => ({ curveNumber: point.curve || 0, pointNumber: point.index, })); - Plotly.Fx.hover(plotDiv, hoverPoints); -}); + Plotly.Fx.hover(plotElement, hoverPoints); +}; + +Shiny.addCustomMessageHandler("triggerTooltips", triggerTooltips); + +function triggerSelectedTooltips(plotID) { + const plotElement = document.getElementById(plotID); + const tooltipPoints = []; + + plotElement.data.forEach((trace, curveIndex) => { + if (trace.selectedpoints && Array.isArray(trace.selectedpoints)) { + trace.selectedpoints.forEach((pointIndex) => { + tooltipPoints.push({ + x: trace.x[pointIndex], + y: trace.y[pointIndex], + curve: curveIndex, + index: pointIndex, + }); + }); + } + }); + + triggerTooltips({ + plotID: plotID, + tooltipPoints: tooltipPoints, + }); +} From 00b5cf88963a68587afb93c90198fd65c64afed0 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Fri, 16 May 2025 06:07:54 +0000 Subject: [PATCH 89/92] [skip style] [skip vbump] Restyle files --- R/plotly_with_settings.R | 4 ++-- R/roxygen2_templates.R | 6 +++--- R/tm_data_table.R | 46 ++++++++++++++++++++-------------------- R/tm_markdown.R | 22 +++++++++---------- inst/poc_crf2.R | 2 +- 5 files changed, 40 insertions(+), 40 deletions(-) diff --git a/R/plotly_with_settings.R b/R/plotly_with_settings.R index 7c00559a2..b40414302 100644 --- a/R/plotly_with_settings.R +++ b/R/plotly_with_settings.R @@ -1,10 +1,10 @@ plotly_with_settings_ui <- function(id, height) { ns <- NS(id) plotly::plotlyOutput(ns("plot"), height = height) -} +} plotly_with_settings_srv <- function(id, plot) { moduleServer(id, function(input, output, session) { output$plot <- plotly::renderPlotly(plot()) }) -} \ No newline at end of file +} diff --git a/R/roxygen2_templates.R b/R/roxygen2_templates.R index d8e1145f0..7e928a97f 100644 --- a/R/roxygen2_templates.R +++ b/R/roxygen2_templates.R @@ -55,14 +55,14 @@ roxygen_ggplot2_args_param <- function(...) { #' decorator for tables or plots included in the module output reported. #' The decorators are applied to the respective output objects. #' -#' @param table_datanames (`character`) names of the datasets which should be listed below the plot +#' @param table_datanames (`character`) names of the datasets which should be listed below the plot #' when some data points are selected. Objects named after `table_datanames` will be pulled from #' `data` so it is important that data actually contains these datasets. Please be aware that -#' table datasets must be linked with `plot_dataname` by the relevant [join_keys()]. +#' table datasets must be linked with `plot_dataname` by the relevant [join_keys()]. #' See section "Decorating Module" below for more details. #' #' @return Object of class `teal_module` to be used in `teal` applications. #' #' @name shared_params #' @keywords internal -NULL \ No newline at end of file +NULL diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 7670a9337..02e2072ee 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -170,18 +170,18 @@ ui_data_table <- function(id, pre_output = NULL, post_output = NULL) { # Server page module srv_data_table <- function(id, - data, - datanames, - variables_selected = list(), - dt_args = list(), - dt_options = list( - searching = FALSE, - pageLength = 30, - lengthMenu = c(5, 15, 30, 100), - scrollX = TRUE - ), - server_rendering = FALSE, - filter_panel_api) { + data, + datanames, + variables_selected = list(), + dt_args = list(), + dt_options = list( + searching = FALSE, + pageLength = 30, + lengthMenu = c(5, 15, 30, 100), + scrollX = TRUE + ), + server_rendering = FALSE, + filter_panel_api) { checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { @@ -192,7 +192,7 @@ srv_data_table <- function(id, datanames_r <- reactive({ Filter( - function(name) is.data.frame(data()[[name]]), + function(name) is.data.frame(data()[[name]]), if (identical(datanames, "all")) names(data()) else datanames ) }) @@ -241,8 +241,8 @@ srv_data_table <- function(id, }) |> bindCache(datanames_r()) |> bindEvent(datanames_r()) - - + + # server should be run only once modules_run <- reactiveVal() modules_to_run <- reactive(setdiff(datanames_r(), isolate(modules_run()))) @@ -297,14 +297,14 @@ ui_dataset_table <- function(id, choices, selected) { # Server function for the data_table module srv_dataset_table <- function(id, - data, - dataname, - if_filtered, - if_distinct, - dt_args, - dt_options, - server_rendering, - filter_panel_api) { + data, + dataname, + if_filtered, + if_distinct, + dt_args, + dt_options, + server_rendering, + filter_panel_api) { moduleServer(id, function(input, output, session) { iv <- shinyvalidate::InputValidator$new() iv$add_rule("variables", shinyvalidate::sv_required("Please select valid variable names")) diff --git a/R/tm_markdown.R b/R/tm_markdown.R index fd7947d37..0e2561c7f 100644 --- a/R/tm_markdown.R +++ b/R/tm_markdown.R @@ -20,22 +20,22 @@ #' iris <- iris #' mtcars <- mtcars #' }) -# +#' # #' #' @export #' tm_rmarkdown <- function(label = "App Info", - text = character(0), - params = list(title = "Document"), - datanames = "all") { + text = character(0), + params = list(title = "Document"), + datanames = "all") { message("Initializing tm_rmarkdown") - + # Start of assertions checkmate::assert_string(label) checkmate::assert_character(text, min.len = 0, any.missing = FALSE) checkmate::assert_list(params) - + ans <- module( label = label, server = srv_rmarkdown, @@ -65,15 +65,15 @@ srv_rmarkdown <- function(id, data, text, params) { cat(text, file = file) } rmarkdown::render( - file, - envir = data(), + file, + envir = data(), params = utils::modifyList( - params, - list(output = list(github_document = list(html_preview = FALSE))) # html_document always as we renderUI below + params, + list(output = list(github_document = list(html_preview = FALSE))) # html_document always as we renderUI below ) ) }) - + output$output <- renderUI({ on.exit(unlink(rmd_out())) # todo: includeMarkdown breaks css of the app diff --git a/inst/poc_crf2.R b/inst/poc_crf2.R index b025610d5..6d52992f4 100644 --- a/inst/poc_crf2.R +++ b/inst/poc_crf2.R @@ -159,7 +159,7 @@ tm_swimlane <- function(label = "Swimlane", plot_height = 700) { extreme_grade ) ) - + p <- plotly::plot_ly( source = "swimlane", colors = c( From 723c084845f95c7dae2977bfc2c729bdd5191442 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Fri, 16 May 2025 06:15:00 +0000 Subject: [PATCH 90/92] [skip roxygen] [skip vbump] Roxygen Man Pages Auto Update --- man/tm_rmarkdown.Rd | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/man/tm_rmarkdown.Rd b/man/tm_rmarkdown.Rd index 3609ef8b4..7b0c159ab 100644 --- a/man/tm_rmarkdown.Rd +++ b/man/tm_rmarkdown.Rd @@ -44,13 +44,14 @@ data <- teal_data() |> iris <- iris mtcars <- mtcars }) +# } \section{Examples in Shinylive}{ \describe{ \item{example-1}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG10AHwA+JV1dAHdaUgALFXYQKOjdWkZaUR8MrNE06JhSAhYco11i0sYCiGiAX0UIMHqAXSA}{Open in Shinylive} - \if{html}{\out{}} + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG10AHwA+JV1dAHdaUgALFXYQKOjdWkZaUR8MrNE06JhSAhYco11i0sYCiGiAX0UIAGIlMHqAXSA}{Open in Shinylive} + \if{html}{\out{}} \if{html}{\out{}} } } From 4126c6b02911cff66dd49f9fb6cf250426608a5c Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 16 May 2025 18:49:21 +0530 Subject: [PATCH 91/92] feat: implement the subject selection for spiider plot --- R/tm_g_spiderplot.R | 53 +++++++++++++++++++++++-- R/tm_t_reactable.R | 2 +- R/utils.R | 18 ++++----- inst/triggerTooltips/triggerTooltips.js | 2 - 4 files changed, 60 insertions(+), 15 deletions(-) diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index aa3356cb6..8a697446b 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -154,7 +154,9 @@ ui_g_spiderplot <- function(id, height) { selectInput(ns("filter_event_var"), label = "Event variable:", choices = NULL, selected = NULL, multiple = FALSE), selectInput(ns("filter_event_var_level"), label = "Select an event:", choices = NULL, selected = NULL, multiple = FALSE), colour_picker_ui(ns("colors")), - sliderInput(ns("plot_height"), "Plot Height (px)", height[2], height[3], height[1]) + sliderInput(ns("plot_height"), "Plot Height (px)", height[2], height[3], height[1]), + selectInput(ns("subjects"), "Subjects", choices = NULL, selected = NULL, multiple = TRUE), + actionButton(ns("subject_tooltips"), "Show Subject Tooltips") ), tags$div( bslib::card( @@ -269,13 +271,54 @@ srv_g_spiderplot <- function(id, output$plot <- output$plot <- plotly::renderPlotly(plotly::event_register( { plotly_q()$p |> + set_plot_data(session$ns("plot_data")) |> setup_trigger_tooltips(session$ns) }, "plotly_selected" )) + observeEvent(data(), { + if (class(subject_var) == "choices_selected") { + subject_col <- subject_var$selected + } else { + subject_col <- subject_var + } + updateSelectInput( + inputId = "subjects", + choices = data()[[plot_dataname]][[subject_col]] + ) + }) + + plotly_data <- reactive({ + data.frame( + x = unlist(input$plot_data$x), + y = unlist(input$plot_data$y), + customdata = unlist(input$plot_data$customdata), + curve = unlist(input$plot_data$curveNumber), + index = unlist(input$plot_data$pointNumber) + ) + }) + plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "spiderplot")) + observeEvent(input$subject_tooltips, { + hovervalues <- data()[[plot_dataname]] |> + dplyr::mutate(customdata = dplyr::row_number()) |> + dplyr::filter(!!rlang::sym(input$subject_var) %in% input$subjects) |> + dplyr::pull(customdata) + + hovertips <- plotly_data() |> + dplyr::filter(customdata %in% hovervalues) + + session$sendCustomMessage( + "triggerTooltips", + list( + plotID = session$ns("plot"), + tooltipPoints = jsonlite::toJSON(hovertips) + ) + ) + }) + tables_selected_q <- .plotly_selected_filter_children( data = plotly_q, plot_dataname = plot_dataname, @@ -302,6 +345,8 @@ spiderplotly <- function( subject_var_label <- .get_column_label(data, subject_var) time_var_label <- .get_column_label(data, time_var) value_var_label <- .get_column_label(data, value_var) + data <- data |> + dplyr::mutate(customdata = dplyr::row_number()) if (is.null(size_var)) { size <- point_size @@ -340,7 +385,8 @@ spiderplotly <- function( x = ~x, y = ~y, xend = stats::as.formula(sprintf("~%s", time_var)), - yend = stats::as.formula(sprintf("~%s", value_var)) + yend = stats::as.formula(sprintf("~%s", value_var)), + customdata = NULL ) %>% plotly::add_markers( x = stats::as.formula(sprintf("~%s", time_var)), @@ -348,7 +394,8 @@ spiderplotly <- function( symbol = stats::as.formula(sprintf("~%s", color_var)), size = size, text = ~tooltip, - hoverinfo = "text" + hoverinfo = "text", + customdata = ~customdata ) %>% plotly::layout( xaxis = list(title = time_var_label), diff --git a/R/tm_t_reactable.R b/R/tm_t_reactable.R index a55ae6d0f..01a39fefa 100644 --- a/R/tm_t_reactable.R +++ b/R/tm_t_reactable.R @@ -224,7 +224,7 @@ srv_t_reactable <- function(id, data, filter_panel_api, dataname, colnames, deco .make_reactable_call <- function(dataset, dataname, args) { columns <- .make_reactable_columns_call(dataset = dataset, col_defs = args$columns) call_args <- utils::modifyList( - list(columns = columns, onClick = "select"), + list(columns = columns, onClick = "select", selection = "multiple"), args[!names(args) %in% "columns"] ) as.call( diff --git a/R/utils.R b/R/utils.R index cf6b87ea3..9f6db2efa 100644 --- a/R/utils.R +++ b/R/utils.R @@ -512,8 +512,6 @@ setup_trigger_tooltips <- function(plot, ns) { const icon = document.createElement('i'); icon.className = 'fas fa-message'; - icon.setAttribute('role', 'presentation'); - icon.setAttribute('aria-label', 'info icon'); const tooltip = document.createElement('span'); tooltip.className = 'plotly-icon-tooltip'; @@ -536,7 +534,7 @@ set_plot_data <- function(plot, data_id) { paste0( " function(el) { - slicedData = el.data.slice(0, -1).map(({ x, y, customdata }) => ({ x, y, customdata })); + slicedData = el.data.slice(0, -1).map(({ x, y, customdata, mode }) => ({ x, y, customdata, mode })); plotData = { x: [], y: [], @@ -546,12 +544,14 @@ set_plot_data <- function(plot, data_id) { }; slicedData.forEach((item, curveNumber) => { - for (let i = 0; i < item.x.length; i++) { - plotData.pointNumber.push(i); - plotData.x.push(item.x[i]); - plotData.y.push(item.y[i]); - plotData.customdata.push(item.customdata[i]); - plotData.curveNumber.push(curveNumber); + if (item.mode === 'markers') { + for (let i = 0; i < item.x.length; i++) { + plotData.pointNumber.push(i); + plotData.x.push(item.x[i]); + plotData.y.push(item.y[i]); + plotData.customdata.push(item.customdata[i]); + plotData.curveNumber.push(curveNumber); + } } }); Shiny.setInputValue('", data_id, "', plotData); diff --git a/inst/triggerTooltips/triggerTooltips.js b/inst/triggerTooltips/triggerTooltips.js index 59949c605..3ac743769 100644 --- a/inst/triggerTooltips/triggerTooltips.js +++ b/inst/triggerTooltips/triggerTooltips.js @@ -17,8 +17,6 @@ function triggerSelectedTooltips(plotID) { if (trace.selectedpoints && Array.isArray(trace.selectedpoints)) { trace.selectedpoints.forEach((pointIndex) => { tooltipPoints.push({ - x: trace.x[pointIndex], - y: trace.y[pointIndex], curve: curveIndex, index: pointIndex, }); From 25f7aac8839bd5d6f468b7f64d44c54c192bedc2 Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 29 May 2025 12:14:31 +0530 Subject: [PATCH 92/92] feat: modify the point_size to work like point_colors and point_symbols --- R/tm_g_swimlane.R | 33 +++++++++++++++++---------------- man/tm_g_swimlane.Rd | 7 ++----- 2 files changed, 19 insertions(+), 21 deletions(-) diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 36378b7a8..086e24eb0 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -19,9 +19,8 @@ #' value determines order of the subjects displayed on the y-axis. #' @param tooltip_vars (`character` or `NULL`) A vector of column names to be displayed in the tooltip. #' If `NULL`, default tooltip is created. -#' @param size_var (`character(1)` or `NULL`) If provided, this numeric column from the `plot_dataname` -#' will be used to determine the size of the points. If `NULL`, a fixed size based on the `point_size` is used. -#' @param point_size (`numeric(1)`) Default point size of the points in the plot. +#' @param point_size (`numeric(1)` or `named numeric`) Default point size of the points in the plot. +#' If `point_size` is a named numeric vector, it should be named by levels of `color_var` column. #' @param point_colors (`named character`) valid color names (see [colors()]) or hex-colors named #' by levels of `color_var` column. #' @param point_symbols (`named character`) valid plotly symbol name named by levels of `color_var` column. @@ -82,7 +81,6 @@ tm_g_swimlane <- function(label = "Swimlane", group_var, sort_var = NULL, tooltip_vars = NULL, - size_var = NULL, point_size = 10, point_colors = character(0), point_symbols = character(0), @@ -119,7 +117,6 @@ tm_g_swimlane <- function(label = "Swimlane", color_var = color_var, group_var = group_var, sort_var = sort_var, - size_var = size_var, point_size = point_size, point_colors = point_colors, point_symbols = point_symbols, @@ -164,7 +161,6 @@ srv_g_swimlane <- function(id, color_var, group_var, sort_var = time_var, - size_var = NULL, point_size = 10, point_colors, point_symbols, @@ -203,7 +199,6 @@ srv_g_swimlane <- function(id, color_var = input$color_var, group_var = input$group_var, sort_var = input$sort_var, - size_var = size_var, point_size = point_size, colors = color_inputs(), symbols = adjusted_symbols, @@ -217,7 +212,6 @@ srv_g_swimlane <- function(id, color_var = color_var, group_var = group_var, sort_var = sort_var, - size_var = size_var, point_size = point_size, colors = colors, symbols = symbols, @@ -307,18 +301,12 @@ srv_g_swimlane <- function(id, #' @export swimlanely <- function( data, time_var, subject_var, color_var, group_var, sort_var, - colors, symbols, height, tooltip_vars = NULL, size_var = NULL, point_size = 10) { + colors, symbols, height, tooltip_vars = NULL, point_size = 10) { subject_var_label <- .get_column_label(data, subject_var) time_var_label <- .get_column_label(data, time_var) data <- data |> dplyr::mutate(customdata = dplyr::row_number()) - if (is.null(size_var)) { - size <- point_size - } else { - size <- stats::as.formula(sprintf("~%s", size_var)) - } - # forcats::fct_reorder doesn't seem to work here subject_levels <- data %>% dplyr::group_by(!!as.name(subject_var)) %>% @@ -328,6 +316,19 @@ swimlanely <- function( dplyr::pull(!!as.name(subject_var)) data[[subject_var]] <- factor(data[[subject_var]], levels = subject_levels) + min_size <- min(point_size, na.rm = TRUE) + + if (length(point_size) > 1) { + data <- data %>% + dplyr::mutate( + size_var = ifelse( + as.character(color_var) %in% names(point_size), + point_size[as.character(color_var)], + min_size + ) + ) + } + data %>% dplyr::mutate( !!as.name(color_var) := factor(!!as.name(color_var), levels = names(colors)), @@ -367,7 +368,7 @@ swimlanely <- function( y = stats::as.formula(sprintf("~%s", subject_var)), color = stats::as.formula(sprintf("~%s", color_var)), symbol = stats::as.formula(sprintf("~%s", color_var)), - size = size, + size = ~size_var, text = ~tooltip, hoverinfo = "text" ) %>% diff --git a/man/tm_g_swimlane.Rd b/man/tm_g_swimlane.Rd index daf534c55..61054f64b 100644 --- a/man/tm_g_swimlane.Rd +++ b/man/tm_g_swimlane.Rd @@ -13,7 +13,6 @@ tm_g_swimlane( group_var, sort_var = NULL, tooltip_vars = NULL, - size_var = NULL, point_size = 10, point_colors = character(0), point_symbols = character(0), @@ -48,10 +47,8 @@ value determines order of the subjects displayed on the y-axis.} \item{tooltip_vars}{(\code{character} or \code{NULL}) A vector of column names to be displayed in the tooltip. If \code{NULL}, default tooltip is created.} -\item{size_var}{(\code{character(1)} or \code{NULL}) If provided, this numeric column from the \code{plot_dataname} -will be used to determine the size of the points. If \code{NULL}, a fixed size based on the \code{point_size} is used.} - -\item{point_size}{(\code{numeric(1)}) Default point size of the points in the plot.} +\item{point_size}{(\code{numeric(1)} or \verb{named numeric}) Default point size of the points in the plot. +If \code{point_size} is a named numeric vector, it should be named by levels of \code{color_var} column.} \item{point_colors}{(\verb{named character}) valid color names (see \code{\link[=colors]{colors()}}) or hex-colors named by levels of \code{color_var} column.}