R/tisefka_multiple_aggregator_UI.R

In Aqvayli06/SaldaeModulesUI: Shiny Dashboard modules by Fair Analytics

#------------------------ multiple-select, multiple output
#' Saldae Dashboard Module UI (aggregator)
#' @description Saldae Dashboard module UI : time based aggregator
#' @author Farid Azouaou
#' @param id  server module ID
#' @param div_width dimension information about the framework(html object)
#' @param mod_title module title (default NULL)
#' @return UI module
#' @export

SA_tisefka_aggregator_UI <- function(id,mod_title = NULL ,div_width = "col-xs-12 col-sm-6 col-md-8") {
  ns <- NS(id)
  fluidPage(
    uiOutput(ns("aggregator_board_box")),
    uiOutput(ns("graphs_ui"))
  )
}





#' Saldae Dashboard Module Server(aggregator)
#' @description Saldae Dashboard module SERVER : render and generate multiple output objects (chart/table)
#' @author Farid Azouaou
#' @param input  input shinydashboard elements containing information to use for output generation
#' @param output output shinydashboard element
#' @param session shiny session
#' @param tisefka reactive object containing data
#' @param div_width dimension information about the framework(html object)
#' @return output objects to be displayed in corresponding UI module
#' @export

SA_tisefka_aggregator_mod <- function(input, output, session,tisefka,i18n,div_width = "col-xs-6 col-sm-12 col-md-6") {

  ns <- session$ns

  tisefka_choices <- reactive({
    req(tisefka())
    tisefka()$numeric_variables
  })
  tisefka_tizegzawin <- reactive({
    req(tisefka())
    tisefka()$tisefka_tizegzawin
  })
  non_numeric_variables <- reactive({
    req(tisefka())
    tisefka()$non_numeric_variables
  })
  categoricals_unique_values <- reactive({
    req(tisefka())
    tisefka()$categoricals_unique_values
  })
  ts_time_units <- reactive({
    tisefka()$ts_time_units
  })

  output$aggregator_board_box <- renderUI({
    bs4Dash::box(title = i18n$t("Aggregation Board"),collapsible = TRUE,
                        status = "info",width = 12,solidHeader = TRUE,
                        #-----HEADER CONTENT
                        fluidRow(
                          column(width = 2, uiOutput(ns("select_element")))    ,
                          column(width = 2, uiOutput(ns("var_granularity"))),
                          column(width = 3, uiOutput(ns("time_unit_data")))    ,
                          column(width = 1, uiOutput(ns("aggregation_metric"))),
                          column(width = 3, uiOutput(ns("graph_type"))),
                          column(width = 1, br(), uiOutput(ns("submit")))
                        ),
                 uiOutput(ns("non_numeric_variables_inputs")),
                 SaldaeReporting::add_to_report_ui(ns("add_aggregation"))

    )
  })


  output$submit <- renderUI({
    req(input$variable_picker)
    bs4Dash::actionButton(inputId = ns("submit"), label = i18n$t("Start"), icon = icon("play"), status  = "info")
  })

  observeEvent(eventExpr=non_numeric_variables(),handlerExpr= {
    non_numeric_variables()%>%purrr::imap( ~{
      output_name_app <- paste0("non_numeric_variables_", .x)
      output[[output_name_app]] <- renderUI({
        ml_choices <- tisefka()$var_factors[[.x]]
        shinyWidgets::pickerInput(
          inputId = ns(output_name_app),
          label = gsub("_"," ",.x),
          choices = categoricals_unique_values()[[.x]],
          options = list(
            `actions-box` = TRUE,
            size = 10,
            `selected-text-format` = "count > 3"
          ),
          multiple = TRUE
        )
      })
    })
  })

  output$non_numeric_variables_inputs <- renderUI({
    req(non_numeric_variables())
    fluidRow(
     purrr::map(non_numeric_variables(), ~{
        column(width = 2, uiOutput(ns(paste0("non_numeric_variables_",.x))))
      })
    )
  })

  output$select_element <- renderUI({
    req(tisefka_tizegzawin())
    shinyWidgets::pickerInput(inputId = ns("variable_picker"),
                              label = i18n$t("Target variables"),
                              multiple = TRUE,
                              choices = tisefka_choices(),
                              selected = NULL
    )
  })
  output$var_granularity <- renderUI({
    req(non_numeric_variables())
    shinyWidgets::pickerInput(inputId = ns("var_granularity"),
                              label = i18n$t("Granularity"),
                              multiple = TRUE,
                              choices = non_numeric_variables(),
                              selected = NULL
    )
  })
  # aggregation metric
  output$aggregation_metric <- renderUI({
    req(input$time_unit_data)
      aggregation_choices <- c("Average","Sum","Min","Max","Median","Count")
      names(aggregation_choices) <- i18n$t(aggregation_choices)

      shinyWidgets::pickerInput(inputId = ns("aggregation_metric"),
                                label = i18n$t("Aggregation"),
                                multiple = FALSE,
                                selected = aggregation_choices[1],
                                choices = aggregation_choices
      )
  })

  #--------------- chart type
  output$graph_type <- renderUI({
    req(tisefka_tizegzawin())
    plot_choices <- c(
      `<i class='fa fa-line-chart'></i>` = "Lines", `<i class='fas fa-circle'></i>` = "Markers", `<i class='fa fa-line-chart'></i>` = "Lines+Markers",
      `<i class='fas fa-chart-area'></i>` = "Filled", `<i class='fa fa-bar-chart'></i>` = "Bar", `<i class='fas fa-bell'></i>` = "Density"
    )

    shinyWidgets::radioGroupButtons(
      inputId = ns("graph_type"),
      label = i18n$t("Chart Type"),
      choices = plot_choices,
      status = "info",
      justified = TRUE,
      selected = plot_choices[1]
    )
  })


  tisefka_iheggan <- reactive({
    req(tisefka_tizegzawin())
    req(input$variable_picker)

    aggreg_fun <- SA_aggregation_funs(aggregation_metric = input$aggregation_metric )
    tisefka_iheggan <- tisefka_tizegzawin()

    if(length(non_numeric_variables())>0){
      categ_input_filter <-non_numeric_variables()%>%purrr::map(~input[[paste0("non_numeric_variables_",.x)]])%>%
        stats::setNames(non_numeric_variables())
      categ_input_filter <- categ_input_filter[!unlist(lapply(categ_input_filter, is.null))]
      for(cat_input in names(categ_input_filter)){
        if("NA" %in% categ_input_filter[[cat_input]])categ_input_filter[[cat_input]] <- c( categ_input_filter[[cat_input]], NA)
        tisefka_iheggan <- tisefka_iheggan%>%dplyr::filter(!!rlang::sym(cat_input)%in%categ_input_filter[[cat_input]])
      }
    }

    tisefka_iheggan <- tisefka_iheggan%>%janitor::clean_names()

    return(tisefka_iheggan)
  })

  SA_div_width <- reactive({
    req(target_variables())
    if(length(target_variables())==1){
      div_width  <- c(12,6)
    }else if(length(target_variables())==2){
      div_width  <- c(6,6)
    }else{
      div_width  <- c(4,6)
    }
    return(div_width)
  })

  #---------------------------------------
  output$time_unit_data <- renderUI({
    req(ts_time_units())
    shinyWidgets::radioGroupButtons(
      inputId = ns("time_unit_data"),
      label = i18n$t("Aggregate by"),
      choices =  ts_time_units(),
      status = "info",
      justified = FALSE,
      checkIcon = list(
        yes = shiny::icon("ok",
                          lib = "glyphicon"
        )
      )
    )
  })
  #----------------

  tisefka_aggregated_all <- eventReactive(input$submit,{
    req(input$time_unit_data)
    req(input$variable_picker)
    SaldaeModulesUI:::data_aggregation_f(tisefka = tisefka_iheggan(),target_ts = input$variable_picker,
                                         time_unit =  input$time_unit_data,
                                         sdukkel = input$var_granularity)
  })

  tisefka_aggregated <- reactive({
    req(tisefka_aggregated_all())
    tisefka_aggregated <- tisefka_aggregated_all()[[input$aggregation_metric]]
    colnames(tisefka_aggregated) <- gsub("[[:punct:]]| ","_",colnames(tisefka_aggregated))
    return(tisefka_aggregated)
  })

  target_variables <- reactive({
    req(tisefka_aggregated())
    target_variables <- colnames(tisefka_aggregated())
    target_variables <- target_variables[target_variables!="date"]
    names(target_variables) <- target_variables
    target_variables <- head(target_variables,12)
    return(target_variables)
  })

  tisefka_tables <- reactive({
    req(tisefka_aggregated())
    tisefka_tables<- target_variables()%>%
      purrr::map(~tisefka_aggregated()%>%
                   dplyr::select("date",!!.x)%>%
                   DT::datatable(.,extensions = c('Scroller'),
                                  options = list(dom = 'Bfrtip', deferRender = TRUE, scrollY = 200, scroller = TRUE)))
  })

  tisefka_yiwen_plots <- reactive({
    req(tisefka_aggregated())
    tisefka_tables<- target_variables()%>%
      purrr::map(~tisefka_aggregated()%>%
                   dplyr::select("date",!!.x)%>%
                   mod_sekned_yiwet_tisefka(tisefka = .,graph_col = input[[paste0("color_",.x)]] , variable_inu = .x,graph_type = input$graph_type))
  })
  #---------------------
  output$graphs_ui <- renderUI({
    req(tisefka_tables())
    req(SA_div_width())
    plots_list <- purrr::imap(tisefka_tables(), ~{
      bs4Dash::tabBox(width = SA_div_width()[1],  title = .y,status = "info", solidHeader = TRUE,
                      tabPanel(icon("fas fa-chart-bar"),
                               plotly::plotlyOutput(ns(paste0("tisefka_plot_",.y)), height = "300px"),
                               fluidRow(column(width = 1,colourpicker::colourInput(ns(paste0("color_",.y)), label = i18n$t(""), value =  "#00868B", showColour = "background", closeOnClick = TRUE,palette = "limited")))
                      ),
                      tabPanel(icon("table"),
                               save_datatable_ui(ns(paste0("data_export_agg_",.y))),
                               DT::dataTableOutput(ns(paste0("tisefka_table_",.y)))
                      )
      )
    })
    fluidRow(plots_list)
  })


  observeEvent(tisefka_tables(), {
    req(tisefka_tables())
    purrr::map(names(tisefka_tables()), ~{
      output_name_plot <- paste0("tisefka_plot_", .x)
      output_name_table <- paste0("tisefka_table_", .x)
      output[[output_name_plot]] <- plotly::renderPlotly(tisefka_yiwen_plots()[[.x]])
      output[[output_name_table]] <- DT::renderDataTable(tisefka_tables()[[.x]])
      save_datatable_server(paste0("data_export_agg_",.x),export_name = .x, data_table = reactive({tisefka_aggregated()%>%dplyr::select("date",!!.x)}))
    })
  })



  report_dir <- "./thaink2_report/"

  report_details <- reactive({
    list(
      report_dir = report_dir,
      report_id  = "0001"
    )
  })


  item_elements <- reactive({
    req(tisefka_aggregated())
    req(tisefka_yiwen_plots())

    output_data <- target_variables()%>%
      purrr::map(~tisefka_aggregated()%>%
                   dplyr::select("date",!!.x))

    data_result <- list(output_data = output_data,
                        output_graph = tisefka_yiwen_plots(),
                        output_comment = "output_comment")
    graph_type <- "lines"; categoricals <- NULL; output_type <- c("aggregator");time_frequency <- "hours"
    list(
      data_result = data_result, # result to include into the report, can be table or graph or both
      granularity = input$var_granularity, # NULL or a list of categoricals
      aggregation_metric = input$aggregation_metric, # raw, max, min, mean,
      time_frequency = time_frequency, # hours, days, weeks, months, quarters, years
      graph_type = graph_type, # lines , markers, aread
      categoricals = categoricals,
      output_type = output_type #c("exploration","forecast","growth_rate")
    )
  })

  SaldaeReporting::add_to_report_server("add_aggregation", report_details = report_details(),item_elements = reactive({ item_elements() }))

}