R/mod_data_selection.R

In datasketch/DSAppTemplate: DS App Template

#' data_processing UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList
#' @importFrom dplyr %>%
mod_data_selection_ui <- function(id){
  ns <- NS(id)
  tagList(
   div(uiOutput(ns("select_var")),
       uiOutput(ns("dataset"))
  ))
}
    
#' data_processing Server Function
#'
#' @noRd 
mod_data_selection_server <- function(id, r){
  
  moduleServer(id, function(input, output, session){
    ns <- session$ns
    
    output$dataset <- renderUI({
      if (is.null(r$inputData))
        return()
      suppressWarnings(hotr::hotr(ns("hotr_input"), data = r$inputData, options = list(height = 470)))
    })
    
    data_fringe <- reactive({
      req(input$hotr_input)
      suppressWarnings( hotr::hotr_fringe(input$hotr_input))
    })
    
    dic_load <- reactive({
      data_fringe()$dic
    })
    
    data_load <- reactive({
      data <- data_fringe()$data
      names(data) <- dic_load()$label
      as.data.frame(data)
    })
    
    datasetColumnChoices <- reactive({
      dic_load()$label
    })
    
    moreDataInfo <- reactive({
      data_load() %>% purrr::map_df( ~ (data.frame(
        n_distinct = dplyr::n_distinct(.x),
        class = class(.x))), .id = "variable") %>% dplyr::filter(!class == "vctrs_vctr")
    })
    
    datasetColumnSelected <- reactive({
      possible_columns <- moreDataInfo() %>% dplyr::filter(n_distinct <= 20) %>% dplyr::distinct(variable) %>% dplyr::pull()
      dic_cat <- dic_load() %>% dplyr::filter(hdType %in% c("Cat", "Dat")) %>% dplyr::filter(label %in% possible_columns)
      dic_cat$label[1:2]
    })
    
    output$select_var <- renderUI({
      req(datasetColumnChoices())
      selectInput(inputId = ns("chooseColumns"), label= shi18ny::i_("chooseColumns", lang = r$lang(), i18n = r$i18n),
                  choices = datasetColumnChoices(),
                  selected = datasetColumnSelected(),
                  multiple = TRUE)
    })
    
    observe({
      r$chooseColumns <- input$chooseColumns
    })
    
    dic_draw <- reactive({
      req(input$chooseColumns)
      moreDataInfo() %>% dplyr::filter(variable %in% input$chooseColumns)
    })
    
    plot_data_orig <- reactive({
      req(input$chooseColumns)
      if(!any(input$chooseColumns %in% names(data_load()))) return()
      dic_draw <- dic_draw()
      if(!all(dic_draw$class %in% c("hd_Cat", "hd_Dat")) | any(dic_draw$n_distinct > 20)) return()
      if(length(input$chooseColumns) < 2) return()
      d <- data_load() %>% dplyr::select(input$chooseColumns)
      if(any(dic_draw$class == "hd_Dat")){
        dat_cols <- dic_draw[dic_draw$class == "hd_Dat",]$variable
        d <- d %>%
          dplyr::mutate_at(dplyr::vars(all_of(dat_cols)), ~homodatum::as_Cat(as.character(.)))
      }
      d
    })
    
    observe({
      r$datasetColumnSelected <- datasetColumnSelected()
    })
    
    observe({
      r$dic_draw <- dic_draw()
    })
    
    observe({
      r$plot_data_orig <- plot_data_orig()
    })
    
  })
  
}