R/app_server.R

In datasketch/DSAppTemplate: DS App Template

#' The application server-side
#' 
#' @param input,output,session Internal parameters for {shiny}. 
#'     DO NOT REMOVE.
#' @import shiny
#' @importFrom dplyr %>%
#' @noRd
app_server <- function(input, output, session) {
  
  r <- reactiveValues()
  
  observe({
    r$uiClasses <- input$shi18ny_ui_classes
  })

  mod_internationalization_server("internationalization_ui", r = r)

  mod_data_upload_server("data_upload_ui", r = r)

  mod_data_selection_server("data_selection_ui", r = r)

  mod_data_processing_server("data_processing_ui", r = r)

  # callModule(mod_viz_config_server, "viz_config_ui", r = r)
  
  fillValueSelected <- reactive({
    r$datasetColumnSelected[1]
  })

  colourMethodChoices <- reactive({
    colour_method_choices <- list("colourpalette" = "colourpalette", "custom" = "custom")
    names(colour_method_choices) <- shi18ny::i_(names(colour_method_choices), lang = r$lang(), i18n = r$i18n)
    colour_method_choices
  })

  background <- reactive({
    dsthemer::dsthemer_get("datasketch")$background_color
  })

  colourPaletteChoices <- reactive({
    c("Accent", "Dark2", "Paired", "Pastel1",
      "Pastel2", "Set1", "Set2", "Set3", "Greys")
  })

  dataLabelChoices <- reactive({
    label <- c("node_name", "total", "percentage")
    names(label) <- shi18ny::i_(c("node_name", "total", "percentage"), lang = r$lang(), i18n = r$i18n)
    label
  })

  categoriesFill <- reactive({
    req(r$plot_data_orig)
    d <- r$plot_data_orig %>% dplyr::distinct() %>% as.data.frame()
    nodes_unique <- c()
    for(col in names(d)){
      nodes_unique <- c(nodes_unique, unique(d[,col]))
    }
    unique(nodes_unique)
  })

  categoriesMissingsEncode <- reactive({
    categoriesFill()[!is.na(categoriesFill())]
  })

  colourCustomChoices <- reactive({
    paletero::paletero_cat(categoriesFill(), palette = "Set1")
  })

  maxCustomChoices <- reactive({
    length(categoriesFill())
  })
  
  customColours <- reactive({
    req(input$colour_custom)
    colours <- input$colour_custom
    names(colours) <- sort(categoriesFill())
    colours
  })

  fillFlow <- reactive({
    flow <- c("from", "to")
    names(flow) <- shi18ny::i_(c("left_to_right", "right_to_left"), lang = r$lang(), i18n = r$i18n)
    flow
  })

  hasdataNA <- reactive({
    data <- r$plot_data_orig
    cols_contain_na <- purrr::map_lgl(.x = data,
                                      .f = function(.x) any(is.na(.x)))
    if(length(input$code_as_na > 0)){
      cols_contain_na <- c(cols_contain_na, TRUE)
    }
    any(cols_contain_na)
  })

  input_drop_na <- reactive({
    if(is.null(input$drop_na)){
      drop_na <- FALSE
    } else {
      drop_na <- input$drop_na
    }
    drop_na
  })


  path <- system.file("app/parmesan", package = "DSAppTemplate")
  parmesan <- parmesan::parmesan_load(path)
  parmesan_input <- parmesan::parmesan_watch(input, parmesan)
  parmesan::parmesan_alert(parmesan, env = environment())
  parmesan_lang <- reactive({shi18ny::i_(parmesan, lang = r$lang(), i18n = r$i18n, keys = c("label", "choices", "text"))})

  parmesan::output_parmesan("controls",
                            parmesan = parmesan_lang,
                            input = input,
                            output = output,
                            env = environment())

  observe({
    r$colour_method <- input$colour_method
  })
  
  observe({
    r$customColours <- input$customColours
  })
  
  observe({
    r$palette <- input$palette
  })
  
  observe({
    r$fillval <- input$fillval
  })
  
  observe({
    r$title <- input$title
  })
  
  observe({
    r$subtitle <- input$subtitle
  })
  
  observe({
    r$caption <- input$caption
  })
  
  observe({
    r$background_color <- input$background_color
  })
  
  observe({
    r$dataLabel_type <- input$dataLabel_type
  })

  mod_viz_display_server("viz_display_ui", r = r)

  mod_save_publish_server("save_publish_ui", r = r)
  
}