R/SaldaeClustering.R

In Aqvayli06/SaldaeModulesUI: Shiny Dashboard modules by Fair Analytics

#' Saldae Clustering Time series
#' @description proceed to
#' @author Farid Azouaou
#' @param tisefka data containing a set time serie
#' @return a list containing information about clustering results
#' @export

Saldae_cluserting_main <- function(tisefka = NULL,anomaly_detection= FALSE,num_clusters =  NULL,clust_distance = "dtw_basic" ,clust_algo = "partitional"){
  num_clusters<-as.numeric(num_clusters)
  tisefka_date <- tisefka$date
  tisefka$date <- NULL
  tisefka <- purrr::map_df(.x= tisefka,~SaldaeDataExplorer::interp_na_value(ts_x = .x, interp_mode = "spline"))
  #. outliers correction
  if (anomaly_detection == TRUE) {
    tisefka <- SaldaeDataExplorer::anomaly_detection_nnegh(tisefka = tisefka, anomaly_mode = "anomalize", target_ts = target_variables)
  }

  tisefka <- purrr::map_df(.x= tisefka,~base::scale(x = .x))


  tisefka_clust <- dtwclust::tsclust(series = t(tisefka),type = clust_algo, k = num_clusters,distance =  clust_distance,centroid = "pam")

  clust_output <- list()
  clust_output[["tisefka_origin"]]<- tisefka%>%dplyr::mutate(date = tisefka_date)
  clust_output[["tisefka_clust"]] <- tisefka_clust

  clust_output[["cluster_mapping"]] <- tibble(ts_cluster = tisefka_clust@cluster,ts_name = names(tisefka_clust@datalist))

  return(clust_output)
}


#' Saldae Clustering Time series UI module
#' @description UI module for time series clustering
#' @author Farid Azouaou
#' @param id session ID
#' @return t.b.d
#' @export

SA_clustering_core_ui <- function(id){
  ns <- NS(id)
  fluidPage(
    uiOutput(ns("tisefka_view_box"))
  )
  bs4Dash::tabBox(width = 12,
                  tabPanel(title = "Causal Dashbaord",icon = icon("fas fa-chart-bar"),
                           uiOutput(ns("tisefka_view_box"))

                  )

  )
}


#' Saldae Clustering Time series SERVER module
#' @description SERVER module for time series clustering
#' @author Farid Azouaou
#' @param tisefka data containing a set time serie
#' @param input shiny input
#' @param output shiny output
#' @param session shiny session
#' @return a list containing information about clustering results
#' @export
SA_clustering_core_mod <- function(input, output, session,i18n,tisefka) {

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


  output$tisefka_view_box <- renderUI({
    bs4Dash::box(title = i18n$t("Connections Board"),collapsible = TRUE,
                 status = "success",width = 12,
                 #-----HEADER CONTENT
                 fluidRow(
                   column(width = 3,uiOutput(session$ns("select_element"))),
                   column(width = 3,uiOutput(session$ns("var_granularity"))),
                   column(width = 2,uiOutput(session$ns("aggregation_metric"))),
                   column(width = 2,uiOutput(session$ns("number_clusters"))),
                   column(width = 2,uiOutput(session$ns("start_clustering")))
                   ),
                 uiOutput(session$ns("non_numeric_variables_inputs"))
    )
  })


  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 = session$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(session$ns(paste0("non_numeric_variables_",.x))))
      })
    )
  })

  output$select_element <- renderUI({
    req(tisefka_tizegzawin())
    shinyWidgets::pickerInput(inputId = session$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 = session$ns("var_granularity"),
                              label = i18n$t("Granularity"),
                              multiple = TRUE,
                              choices = non_numeric_variables(),
                              selected = NULL
    )
  })
  output$aggregation_metric <- renderUI({
    req(input$variable_picker)
    aggregation_choices <- c("Average","Sum","Max","Min","Median")
    names(aggregation_choices) <- i18n$t(aggregation_choices)
    shinyWidgets::pickerInput(inputId = session$ns("aggregation_metric"),
                              label = i18n$t("Aggregation"),
                              multiple = FALSE,
                              choices = aggregation_choices,
                              selected = aggregation_choices[1]
    )
  })


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

    aggreg_fun <- SaldaeModulesUI:::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)){
        tisefka_iheggan <- tisefka_iheggan%>%dplyr::filter(!!rlang::sym(cat_input)%in%categ_input_filter[[cat_input]])
      }
    }
    if(is.null(input$var_granularity)){
      tisefka_iheggan<- tisefka_iheggan%>%dplyr::select(date,!!input$variable_picker)
    }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)
    return(tisefka_iheggan)
  })


  output$number_clusters <- renderUI({
    clusters_choices <- c(2:10)
    shinyWidgets::pickerInput(inputId = session$ns("number_clusters"),
                              label = i18n$t("Number of clusters"),
                              choices = clusters_choices,
                              selected = 5)
  })

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


#--------- Start clustering
 clust_results <- eventReactive(input$start_clustering,{
   tisefka_clust<-tail(tisefka_iheggan(),700)
   if(ncol(tisefka_clust) <= input$number_clusters){
     shinyalert::shinyalert(title = i18n$t("Clustering"), text = i18n$t("Number of clusters is higher than number of variables"),type = "error")
   }else{
     Saldae_cluserting_main(tisefka = tisefka_clust,num_clusters = input$number_clusters)
   }
 })
}