WIP

R/brush_filter.R

@@ -0,0 +1,121 @@
+#' @export
+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%")
+  )
+}
+
+#' @export
+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("data_table")
+      } else {
+        shinyjs::show("title")
+        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"
+          )
+        )
+      )
+    })
+
+    brushed_table <- reactive({
+      plot_brush <- brush()
+      if (is.null(plot_brush)) {
+        return(NULL)
+      }
+      dataset <- isolate(teal.code::dev_suppress(data()[["ANL"]]))
+      teal.widgets::clean_brushedPoints(dataset, plot_brush)
+    })
+
+    observeEvent(input$apply_brush_filter, {
+      if (is.null(input$data_table_rows_selected)) {
+        return(NULL)
+      }
+
+      isolate({
+        foo1(brush, selector_list)
+      })
+
+      brushed_df <- brushed_table()[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(brushed_df$USUBJID), # todo: this needs to be parametrised or based on join_keys
+        id = "brush_filter"
+      ))
+      set_filter_state(filter_panel_api, slice)
+    })
+
+    output$data_table <- DT::renderDataTable(server = TRUE, {
+      brushed_df <- brushed_table()
+      if (is.null(brushed_df)) {
+        return(NULL)
+      }
+      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"))])
+    )
+  })
+}