R/mod_cohort.R

In piotrgruszecki/sw.dashboard: Sellwerk Dashboard

#' cohort UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
#' @import R6
#' @importFrom shinycssloaders withSpinner
#' @importFrom sunburstR sund2bOutput
mod_cohort_ui <- function(id){
  ns <- NS(id)
  tagList(

    h2("Cohorts report"),

    #-- 1. data subset & reference plot
    fluidRow(

      column(width = 4,
             shinydashboard::box(width = 12, title = "Cohort definition", collapsible = TRUE, footer = "This box can be closed by minus sign above", status = "primary",
                                 shinyWidgets::airDatepickerInput(inputId = ns("dates_interval_selected"), label = "Dates interval",  placeholder = "When 1st user's interaction occured", range = TRUE, separator = " - ",
                                                                  minDate = "2020-12-01", maxDate = lubridate::today(), update_on = "close", language = "de",
                                                                  value = c("2021-02-01", "2021-02-28"))
                                 )
      ),

      column(width = 8,
             shinydashboard::box(width = 12, title = "Cohort glimpse: Categories and Geos", status = "primary", collapsible = TRUE,
                                 column(width = 6, sunburstR::sund2bOutput(outputId = ns("sunburst_categories_plot"))),
                                 column(width = 6, sunburstR::sund2bOutput(outputId = ns("sunburst_geos_plot")))
                                 )
      )

    ), #-- fluidRow

    #-- 2. main analysis section
    fluidRow(
      shinydashboard::tabBox(
        title = "First tabBox", id = "tabset1", height = "250px", width = 12,
        shiny::tabPanel(title = "Cohort analysis",
          fluidRow(shinydashboard::box(width = 6, plotOutput(outputId = ns("plot_cumulative_line"))), shinydashboard::box(width = 6))
          ),

        shiny::tabPanel("Tabular", fluidPage(
          fluidRow(
            DT::DTOutput(outputId = ns("sunburst_sessions_dt_chk"))))
        ) #-- tabPanel

      ) #-- tabBox
    ) #-- fluidRow
  )
}

#' cohort Server Functions
#'
#' @noRd
#' @import R6
#' @import shinipsum
#' @importFrom sunburstR sund2b
mod_cohort_server <- function(id, aws_buffer){
  moduleServer( id, function(input, output, session){
    ns <- session$ns

    #-- 1. get data from the buffer
    temp_dt <- aws_buffer$migrated_dt

    #-- 1.1 test printout
    #-- 1.1.1 table
    output$temp_dt <- DT::renderDT(temp_dt)

    #-- 1.1.3 tabular printout of key parameters, per company
    observeEvent(eventExpr = input$dates_interval_selected,
                 handlerExpr = {

                   output$sunburst_sessions_dt_chk <- DT::renderDT(aws_buffer$sunburst_sessions_dt[, .(sessions = .N, time = sum(session_duration_minutes)), .(company_id, company_town, company_zip, company_category, company_name)])

                   })

    #-- 2. get sessions, based on cohort definition
    cohort_sessions_dt <- reactive({

      interval_selected  <- input$dates_interval_selected[1] %--% input$dates_interval_selected[2]
      cohort_sessions_dt <- sw.dashboard::get_cohort_time_cumsum(interval = interval_selected, aws_buffer = aws_buffer)

      cohort_sunburst_sequences <- sw.dashboard::produce_sunburst_sequences(aws_buffer)
      cohort_sunburst_sequences_aggr <- cohort_sunburst_sequences[, .N, .(category_seq)]
      cohort_sunburst_sequences_sub <- cohort_sunburst_sequences[, .(user_id, session_id, session_duration, category_seq, geo_seq)]

      tables_cohort <- list(table_sessions = cohort_sessions_dt,
                            cohort_sunburst_sequences = cohort_sunburst_sequences,
                            table_sunburst = cohort_sunburst_sequences_aggr,
                            cohort_sunburst_sequences_sub = cohort_sunburst_sequences_sub)

      return(tables_cohort)
    })
    #output$cohort_sessions_dt_check <- DT::renderDT({cohort_sessions_dt()})
    output$cohort_sessions_dt_check      <- DT::renderDT({cohort_sessions_dt()$table_sessions})
    output$cohort_sunburst_sequences_chk <- DT::renderDT({cohort_sessions_dt()$cohort_sunburst_sequences})
    output$cohort_sunburst_dt_check      <- DT::renderDT({cohort_sessions_dt()$table_sunburst})
    output$cohort_sunburst_sequences_sub_chk      <- DT::renderDT({cohort_sessions_dt()$cohort_sunburst_sequences_sub})

    #-- 3. produce plots
    produce_cohort_plots_list <- function(){

      plot_cumulative_line <- cohort_sessions_dt()$table_sessions %>% sw.dashboard::plot_cumulative_line()

      sunburst_categories <- cohort_sessions_dt()$cohort_sunburst_sequences[, .(minutes = sum(as.double(session_duration_minutes))), .(category_seq)] %>% sunburstR::sund2b()
      sunburst_geos       <- cohort_sessions_dt()$cohort_sunburst_sequences[, .(minutes = sum(as.double(session_duration_minutes))), .(geo_seq)]      %>% sunburstR::sund2b()

      #sunburst_input_dt <- cohort_sessions_dt()$cohort_sunburst_sequences[, .N, .(category_seq)]

      cohort_plots_list <- list(plot_cumulative_line = plot_cumulative_line,
                                sunburst_categories = sunburst_categories,
                                sunburst_geos = sunburst_geos)
                                #sunburst_input_dt = sunburst_input_dt)
      return(cohort_plots_list)
    }
    output$plot_cumulative_line <- renderPlot({produce_cohort_plots_list()["plot_cumulative_line"]})
    output$sunburst_categories_plot <- sunburstR::renderSund2b({produce_cohort_plots_list()$sunburst_categories})
    output$sunburst_geos_plot       <- sunburstR::renderSund2b({produce_cohort_plots_list()$sunburst_geos})
    #output$sunburst_input_dt_check <- DT::renderDT({produce_cohort_plots_list()$sunburst_input_dt})




    #-- lorem ipsum below
    #output$plot_01       <- renderPlot({shinipsum::random_ggplot()})

    #output$table_02       <- DT::renderDT({shinipsum::random_DT(nrow = 5, ncol = 3, type = "numeric")})



  })
}

## To be copied in the UI
# mod_cohort_ui("cohort_ui_1")

## To be copied in the server
# mod_cohort_server("cohort_ui_1")