R/analytics_UI.R

In Aqvayli06/SaldaeModulesUI: Shiny Dashboard modules by Fair Analytics

key_value_calculator <- function(tisefka = NULL,key_value =NULL){
  tisefka <- na.omit(tisefka)
  my_value <- vector()
  if("Sum"%in%key_value){
    my_value["Sum"] <- sum(tisefka,na.rm = TRUE)
  }
  if("Average"%in%key_value){
    my_value["Average"] <- colMeans(tisefka,na.rm = TRUE)
  }
  if("Maximum"%in%key_value){
    my_value["Maximum"] <- max(tisefka,na.rm = TRUE)
  }
  if("Minimum"%in%key_value ){
    my_value["Minimum"] <- min(tisefka,na.rm = TRUE)
  }
  if("First Value"%in%key_value){
    my_value["First Value"] <- head(tisefka,1)
  }
  if( "Last Value"%in%key_value ){
    my_value["Last Value"]<- tail(tisefka,1)
  }
  return(round(my_value,3))
}

#------------------------ multiple-select, multiple output
#' Saldae Dashboard Module UI (analytics)
#' @description Saldae Dashboard module UI : forecasting
#' @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_forecast_UI <- function(id,mod_title = NULL ,div_width = "col-xs-12 col-sm-6 col-md-8") {
  ns <- NS(id)
  fluidPage(
    fluidRow(
      column(width = 12,
             uiOutput(ns("analytics_header_box"))
      )
    ),
    fluidRow(
      column(width = 6,
             uiOutput(ns("analytics_config_box"))
      ),
      column(width = 6,
             uiOutput(ns("analytics_advanced_box"))
      )
    ),
    uiOutput(ns("graphs_ui"))
  )
}



#' Saldae Dashboard Module Server Analytics
#' @description Saldae Dashboard module SERVER : render and generate multiple output objects for analytics
#' @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_forecast_mod <- function(input, output, session,i18n ,tisefka,div_width = "col-xs-6 col-sm-12 col-md-6") {
  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
  })

  ns <- session$ns

  output$analytics_header_box <- renderUI({
    bs4Dash::box(title = i18n$t("Forecasting Board"),collapsible = TRUE,
                        status = "info",width = 12,solidHeader = TRUE,
                        #-----HEADER CONTENT
                        fluidRow(
                          column(width = 3,uiOutput(ns("select_element")))    ,
                          column(width = 2,uiOutput(ns("var_granularity"))),
                          column(width = 2,uiOutput(ns("aggregation_metric"))),
                          # column(width = 4,uiOutput(ns("SA_outliers"))),
                          column(width = 3,shiny::br(), uiOutput(ns("forecasting_submit")))
                        ),
                 uiOutput(ns("non_numeric_variables_inputs")),
                 SaldaeReporting::add_to_report_ui(ns("add_forecasting"))

    )
  })


  output$actuals_time_periode <- renderUI({
    req(tisefka_tizegzawin())
    actuals_time_periode <- tisefka_tizegzawin()%>%dplyr::pull(date)
    actuals_time_periode <- c(min(actuals_time_periode),max(actuals_time_periode))
    dateRangeInput(inputId = ns("actuals_time_periode"), label = i18n$t("Time periode"),
              max = actuals_time_periode[2], min = actuals_time_periode[1], start =actuals_time_periode[1], end = actuals_time_periode[2])
  })
  output$forecast_horizon <- renderUI({
    req(tisefka_iheggan())
    forecast_horizon <- ceiling(nrow(tisefka_iheggan())/3)
    shiny::sliderInput(inputId = ns("forecast_horizon"), label = i18n$t("Forecast Horizon"), min = 5, max = nrow(tisefka_iheggan()), value = forecast_horizon)
  })

  output$analytics_config_box <- renderUI({
    shinyWidgets::dropdown(
      tags$h2("Advanced Configs"),
      fluidRow(
        column(colourpicker::colourInput(ns("obs_col"), i18n$t("Observations"), "#00AFBB",  palette = "limited"),width = 3),
        column(colourpicker::colourInput(ns("fcast_col"), i18n$t("Predictions"), "#E1AF00", palette = "limited"),width = 3)
      ),
      fluidRow(
        column(width = 6,uiOutput(ns("actuals_time_periode"))),
        column(width = 6,uiOutput(ns("forecast_horizon")))
      ),
      fluidRow(
        column(width = 6,uiOutput(ns("SA_key_figure_select")))
      ),
      style = "unite", icon = icon("gear"),
      status = "primary", width = "450px",
      animate = shinyWidgets::animateOptions(
        enter = shinyWidgets::animations$fading_entrances$fadeInLeftBig,
        exit = shinyWidgets::animations$fading_exits$fadeOutRightBig
      )
    )
  })

  # output$SA_outliers <- renderUI({
  #   shinyWidgets::prettySwitch(
  #     inputId = ns("SA_outliers"),
  #     label = i18n$t("Anomaly detection"),
  #     status = "info",
  #     fill = TRUE)
  # })

  output$forecasting_submit <- renderUI({
    req(input$variable_picker)
    bs4Dash::actionButton(inputId = ns("forecasting_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(non_numeric_variables())
    aggregation_choices <- c("Average","Sum","Min","Max","Median")
    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
    )
  })


  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]])
      }
    }

    if(is.null(input$var_granularity)){
      if(is.null(aggreg_fun)) aggreg_fun <- sum
      tisefka_iheggan<- tisefka_iheggan%>%dplyr::select(date,!!input$variable_picker)%>%
        dplyr::group_by(date)%>%dplyr::summarise_all(aggreg_fun)
    }else{
      list_val_fn <- input$variable_picker%>%purrr::map(~aggreg_fun)%>%stats::setNames(input$variable_picker)
      tisefka_iheggan<- tisefka_iheggan %>%
        tidyr::pivot_wider(
          id_cols  = date,
          names_from  = input$var_granularity,
          values_from = input$variable_picker,
          values_fn = list_val_fn)
    }
    tisefka_iheggan <- tisefka_iheggan%>%dplyr::arrange(date)%>%
      dplyr::group_by(date)%>%dplyr::summarise_all(aggreg_fun,na.rm = TRUE)

    max_variables <- min(ncol(tisefka_iheggan),13)
    tisefka_iheggan <- tisefka_iheggan[1:max_variables]
    return(tisefka_iheggan)
  })



  target_variables <- reactive({
    req(tisefka_iheggan())
    target_variables <- colnames(tisefka_iheggan())
    target_variables <- target_variables[target_variables!="date"]
    return(target_variables)
  })

  #----------------
  tisefka_forecast_aqerru <- eventReactive(input$forecasting_submit,{
    req(tisefka_iheggan())
    req(target_variables())
    tisefka_forecast_aqerru <- SaldaeForecasting::Saldae_Forecaster(tisefka = tisefka_iheggan(),actuals_time_periode =input$actuals_time_periode ,target_variables = target_variables(), anomaly_detection = TRUE, Saldae_model = "saldae_prophet")
  })

  tisefka_forecast <- reactive({
    req(tisefka_forecast_aqerru())
    purrr::map(.x= tisefka_forecast_aqerru(),  ~SaldaeForecasting::sbed_forecast_aqerru(.x , asurif_arzdat = input$forecast_horizon))
  })


  tisefka_plots <- reactive({
    plot_settings <- list()
    plot_settings[["colors_inu"]] <- c(input$obs_col,"darkgreen",input$fcast_col,"#EBCC2A")
    purrr::map(.x =names(tisefka_forecast()),~ SaldaeForecasting::sekned_forecast_aqeru(fcast_df =  tisefka_forecast()[[.x]],target_variable = .x ,plot_settings = plot_settings))%>%
      stats::setNames(names(tisefka_forecast()))
  })

  tisefka_tables <- reactive({
    req(tisefka_forecast())
    return(purrr::map(.x = tisefka_forecast(),~DT::datatable(.x,extensions = c('Scroller','Buttons'), options = list(dom = 'Bfrtip',buttons = c('copy', 'csv', 'excel', 'pdf', 'print'), deferRender = TRUE, scrollY = 200,scrollX = TRUE, scroller = TRUE)) )%>%
             stats::setNames(names(tisefka_forecast())))
  })
  output$SA_key_figure_select <- renderUI({
    req(tisefka_forecast())
    key_figures_choices <- c("Average","Sum","Maximum","Minimum","First Value","Last Value")
    names(key_figures_choices) <- i18n$t(key_figures_choices)
    shinyWidgets::pickerInput(
      inputId = ns("SA_key_figure_select"),
      label = i18n$t("Key Numbers"),
      choices = key_figures_choices,
      multiple = FALSE
    )
  })
  #---------------------

  observeEvent(eventExpr=tisefka_tables(),handlerExpr= {
    purrr::map(names(tisefka_plots()), ~{
      output_name_plot <- paste0("tisefka_plot_", .x)
      output_name_table <- paste0("tisefka_table_", .x)
      output_name_figures <- paste0("tisefka_key_figures_", .x)
      output_name_performances <- paste0("forecast_performances_", .x)
      output[[output_name_table]] <- DT::renderDataTable(tisefka_tables()[[.x]])
      output[[output_name_plot]] <- plotly::renderPlotly(tisefka_plots()[[.x]])
      output[[output_name_performances]] <- DT::renderDataTable({
        forecast_performances()[[.x]]
      })
      output[[output_name_figures]] <- bs4Dash::renderInfoBox({
        my_title <- paste(.x,":",input$SA_key_figure_select)
        bs4Dash::infoBox(title = my_title,
                         value = my_analytics_key_values()[[.x]],color = "success",
                         width = 6,
                         shiny::icon("fas fa-chart-bar")
        )
      })

      #
    })
  })
  # dynamic size of the panel
  SA_div_width <- reactive({
    req(target_variables())
    if(length(target_variables())==1){
      div_width  <- c(12,12)
    }else if(length(target_variables())==2){
      div_width  <- c(6,12)
    }else{
      div_width  <- c(4,12)
    }
    return(div_width)
  })
  # display the panels
  output$graphs_ui <- renderUI({
    req(tisefka_plots())
    plots_list <- purrr::imap(tisefka_plots(), ~{
      bs4Dash::tabBox(width = SA_div_width()[1], title = .y,
                      tabPanel(icon("fas fa-chart-bar"),
                               plotly::plotlyOutput(ns(paste0("tisefka_plot_",.y)), height = "300px")
                      ),tabPanel(icon("table"),
                                 DT::dataTableOutput(ns(paste0("tisefka_table_",.y)))
                      ),tabPanel(icon("align-left"),
                                 shiny::textAreaInput(inputId = ns(paste0("tisefka_awal_",.y)),label = "Comments",value = "insert your comments here",width = "100%",height = "50%")
                      ),tabPanel(icon("fa-scale-unbalanced"),
                                 DT::dataTableOutput(ns(paste0("forecast_performances_",.y)))
                      ),tabPanel(icon("percentage"),
                                 fluidRow(
                                   bs4Dash::infoBoxOutput(ns(paste0("tisefka_key_figures_",.y)), width = 8)
                                 )# fluidRow
                      )# tabPanle: percentage

      )
    })
    fluidRow(plots_list)
  })
  my_analytics_key_values <- reactive({
    SA_key_figure_select<- input$SA_key_figure_select
    if(is.null(SA_key_figure_select))SA_key_figure_select  <- "Sum"
    my_value <- purrr::map(names(tisefka_forecast()),~key_value_calculator(tisefka = tisefka_forecast()[[.x]][,"forecast"],key_value = SA_key_figure_select))%>%
              stats::setNames(names(tisefka_forecast()))
  })

  forecast_performances <- reactive({
    forecast_performances <- tisefka_forecast()%>%purrr::map(~SaldaeForecasting::calculate_forecast_performances(fcast_df = .x))%>%
      stats::setNames(names(tisefka_forecast()))
  })


# add to report
  report_dir <- "./thaink2_report/"

  report_details <- reactive({
    list(
      report_dir = report_dir,
      report_id  = "0001"
    )
  })
  item_elements <- reactive({
    req(tisefka_forecast())
    req(tisefka_plots())

    output_data <- prepare_data_to_report(data_object = tisefka_forecast(), output_type = "forecast")

    data_result <- list(output_data  = output_data,
                        output_graph = tisefka_plots(),
                        output_comment = "output_comment")
    graph_type <- "lines"; categoricals <- NULL; output_type <- c("forecasting");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_forecasting", report_details = report_details(),item_elements = reactive({ item_elements() }))
  #

  analytics_output <- reactive({
    output <- list()
    output$analytics_plots    <- tisefka_plots()
    output$analytics_tisefka  <- tisefka_forecast()
    output$analytics_awal <- purrr::map(names(tisefka_plots()),~ input[[paste0("tisefka_awal_",.x)]])%>%stats::setNames(names(tisefka_plots()))
    output$analytics_key_figures <- list(key_metric = input$SA_key_figure_select,
                                         key_figures =  my_analytics_key_values())
    output$tisefka            <- tisefka_iheggan()
    output$forecast_performances <- forecast_performances()

    output$analytics_settings <- "ulac"
    return(output)
  })
}