icrmkpi: KPI formula

###############################################################################
####                          Marelli GRC KPI                              ####
###############################################################################

# -------------------------------------------------------------------------
# ----------------------------     PKGS     -------------------------------
# -------------------------------------------------------------------------
library(shiny)
library(plyr)
library(ggplot2)
library(icrmkpi)
library(dplyr)
library(lubridate)
library(shinydashboard)

# -------------------------------------------------------------------------
# ----------------------------     FUNS     -------------------------------
# -------------------------------------------------------------------------
prettify_string <- function (x){

  special_char <- c("$", "€", "+", "^", "~", "<", ">", "=", "|")
  s_special_char <- paste0("\\", special_char, collapse = "|")
  x <- stringr::str_replace_all(x, s_special_char, "_")
  x <- iconv(x, from = "UTF-8", to = "ASCII//TRANSLIT")
  x

}

# -------------------------------------------------------------------------
# ----------------------------     PARS     -------------------------------
# -------------------------------------------------------------------------
data_dir_iwo = "~/data/icrmkpi/iwo/"
data_dir_aging = "~/data/icrmkpi/aging"
data_dir_unusual= "~/data/icrmkpi/unusual/"

# define default values
today          <- Sys.Date()
min_amount_dft <- 5000
exemption_dft  <- TRUE
rolling_dft    <- 13

# -------------------------------------------------------------------------
# -------------------------     LOAD DATA     -----------------------------
# -------------------------------------------------------------------------
# IWO Related
iwo_data     <- load_iwo_all(data_dir_iwo)
niagara_data <- load_niagara(data_dir_iwo, 'niagara.csv')
company_region_data <- load_company_region (data_dir_iwo, 'company-region.csv')
exemption_data <- load_exemption( data_dir_iwo, 'exemption.csv')

# Aging Related
aging_data <- load_aging_all(data_dir_aging, company_region_data)

# Unusual Related
unusual_data <- load_unusual_all(data_dir_unusual)
fg_data      <- load_fg(data_dir_unusual, file = 'fg-year.csv')

# Available years
years_list_iwo <- iwo_data %>%
  distinct(year) %>%
  pull %>%
  sort(decreasing = TRUE)

years_list_aging <- aging_data %>%
  distinct(year) %>%
  pull %>%
  sort(decreasing = TRUE)

years_list_unusual <- unusual_data %>%
  distinct(year) %>%
  pull %>%
  sort(decreasing = TRUE)

# Available companies
companies_iwo <- iwo_data %>%
  distinct(company) %>%
  purrr::flatten() %>%
  setNames(prettify_string(unique(iwo_data$company_input)))

companies_aging <- aging_data %>%
  distinct(company) %>%
  purrr::flatten() %>%
  setNames(prettify_string(unique(aging_data$company_input)))

companies_unusual <- unusual_data %>%
  distinct(company) %>%
  purrr::flatten() %>%
  setNames(prettify_string(unique(unusual_data$company)))

# -------------------------------------------------------------------------
# -------------------------     UI    -------------------------------------
# -------------------------------------------------------------------------

ui <- shinyUI(navbarPage(
  title = tags$a(href   = "https://www.marelli.com/it/",
                 target = "_blank",
                 tags$img(src    = "https://www.marelli.com/img/marelli-logo.svg",
                          height = "40px",
                          style  = "vertical-align:top")
  ),
  tabPanel("Summary", uiOutput('page1')),
  tabPanel("Invoice Without Order", uiOutput('page2')),
  tabPanel("Aging", uiOutput('page3')),
  tabPanel("Unusual Movement", uiOutput('page4'))
)
)

# First Panel: Summary --------------------------------------------------

ui1 <- fluidPage(
  box(width = 12,
      withMathJax(includeHTML("glossary.html")))
)

# IWO ---------------------------------------------------------------------

ui2 <- fluidPage(
  sidebarLayout(
    position = "left",
    sidebarPanel(
      tags$style(".well{background-color:#009CDE;}"),
      selectizeInput("select_company_iwo",
                     h3("Company", style = "color:white"),
                     choices = companies_iwo,
                     multiple = FALSE),
      numericInput("min_amount",
                   label = h3("Minimum Amount", style = "color:white"),
                   value = min_amount_dft),
      numericInput("rolling_iwo",
                   label = h3("Rolling Months", style = "color:white"),
                   value = rolling_dft),
      fluidRow(
        column(width = 6,
               selectInput("year_iwo",
                           label = h3("Year", style = "color:white"),
                           choices  = years_list_iwo,
                           selected = as.numeric(format(today,"%Y")))
        ),
        column(width = 6,
               selectInput("month_iwo",
                           label = h3("Month", style = "color:white"),
                           choices  = "")
        )
      ),
      fluidRow(
        column(width = 6,
               checkboxInput("exemption",
                             label = tags$b("Include exemptions", style = "color:white"),
                             value = exemption_dft)),
        column(width = 6,
               actionButton("reset_to_default_iwo", "Reset"))
      )
    ),
    mainPanel(
      box(title = tags$b("Invoices Without Order"),
          plotOutput("plot_kpi"), width = 12),
    )
  )
)

# Aging -------------------------------------------------------------------

ui3 <- fluidPage(
  sidebarLayout(
    position = "left",
    sidebarPanel(
      tags$style(".well{background-color:#009CDE;}"),
      selectizeInput("select_company_aging",
                     h3("Company", style = "color:white"),
                     choices = companies_aging,
                     multiple = FALSE),
      numericInput("rolling_aging",
                   label = h3("Rolling Months", style = "color:white"),
                   value = rolling_dft),
      fluidRow(
        column(width = 6,
               selectInput("year_aging",
                           label = h3("Year", style = "color:white"),
                           choices  = years_list_aging,
                           selected = as.numeric(format(today,"%Y")))
        ),
        column(width = 6,
               selectInput("month_aging",
                           label = h3("Month", style = "color:white"),
                           choices  = "")
        )
      ),
      actionButton("reset_to_default_aging", "Reset")),
    mainPanel(
      box(title = tags$b("Aging Assets in Progress"),
          plotOutput("plot_aging"), width = 12),
    )
  )
)


# Unusual Movement ----------------------------------------------------

ui4 <- fluidPage(
  sidebarLayout(
    position = "left",
    sidebarPanel(
      tags$style(".well{background-color:#009CDE;}"),
      selectizeInput("select_company_unusual",
                     h3("Company", style = "color:white"),
                     choices = companies_aging,
                     multiple = FALSE),
      numericInput("rolling_unusual",
                   label = h3("Rolling Months", style = "color:white"),
                   value = rolling_dft),
      fluidRow(
        column(width = 6,
               selectInput("year_unusual",
                           label = h3("Year", style = "color:white"),
                           choices  = years_list_unusual,
                           selected = as.numeric(format(today,"%Y")))
        ),
        column(width = 6,
               selectInput("month_unusual",
                           label = h3("Month", style = "color:white"),
                           choices  = "")
        )
      ),
      actionButton("reset_to_default_unusual", "Reset")),
    mainPanel(
      box(title = tags$b("Unusual Movements"),
          plotOutput("plot_unusual"),
          width = 12),
    )
  )
)

# -------------------------------------------------------------------------
# -----------------------   SERVER  ---------------------------------------
# -------------------------------------------------------------------------
server <- function(input, output, session) {

  # Generate dynamic months list
  months_list_iwo <- reactive({

    iwo_data %>%
      filter(year == req(input$year_iwo)) %>%
      distinct(month) %>%
      pull %>%
      sort(decreasing = FALSE)

  })

  months_list_aging <- reactive({

    aging_data %>%
      filter(year == req(input$year_aging)) %>%
      distinct(month) %>%
      pull %>%
      sort(decreasing = FALSE)

  })

  months_list_unusual <- reactive({

    unusual_data %>%
      filter(year == req(input$year_unusual)) %>%
      distinct(month) %>%
      pull %>%
      sort(decreasing = FALSE)

  })

  # Update month input
  observe({
    updateSelectInput(session,
                      inputId  = 'month_iwo',
                      choices  = months_list_iwo(),
                      selected = max(months_list_iwo()))
    updateSelectInput(session,
                      inputId  = 'month_aging',
                      choices  = months_list_aging(),
                      selected = max(months_list_aging()))
    updateSelectInput(session,
                      inputId  = 'month_unusual',
                      choices  = months_list_unusual(),
                      selected = max(months_list_unusual()))
  })

  # Prepare IWO Data
  df_iwo_data <- reactive({
    prepare_iwo(data = iwo_data,
                .company       = input$select_company_iwo,
                exemption      = input$exemption,
                min_amount     = input$min_amount,
                .year          = input$year_iwo,
                .month         = input$month_iwo,
                niagara_data   = niagara_data,
                exemption_data = exemption_data,
                rolling        = input$rolling_iwo
    )
  })

  # Plot IWO
  output$plot_kpi <- renderPlot({ plot_iwo(df_iwo_data()) })

  # Prepare Aging Data
  df_aging_data <- reactive({
    prepare_aging(data = aging_data,
                  .company       = input$select_company_aging,
                  .year          = input$year_aging,
                  .month         = input$month_aging,
                  rolling        = input$rolling_aging
    )
  })

  # Plot Aging
  output$plot_aging <- renderPlot({ plot_aging(df_aging_data()) })

  # Prepare Unusual Data
  df_unusual_data <- reactive({
    prepare_unusual(data = unusual_data,
                  .company       = input$select_company_unusual,
                  fg_data        = fg_data,
                  .year          = input$year_unusual,
                  .month         = input$month_unusual,
                  rolling        = input$rolling_unusual
    )
  })

  # Plot Unusual
  output$plot_unusual <- renderPlot({ plot_unusual(df_unusual_data()) })

  # Reset to default values
  observeEvent(input$reset_to_default_iwo,{
    updateCheckboxInput(session, "exemption",   value = exemption_dft)
    updateNumericInput(session,  "min_amount",  value = min_amount_dft)
    updateSelectInput(session,   "year_iwo",    selected = as.numeric(format(today,"%Y")))
    updateSelectInput(session,   "month_iwo",   selected = max(months_list_iwo()))
    updateSelectInput(session,   "rolling_iwo", selected = rolling_dft)
  })

  observeEvent(input$reset_to_default_aging,{
    updateSelectInput(session,   "year_aging",    selected = as.numeric(format(today,"%Y")))
    updateSelectInput(session,   "month_aging",   selected = max(months_list_aging()))
    updateSelectInput(session,   "rolling_aging", selected = rolling_dft)
  })

  observeEvent(input$reset_to_default_unusual,{
    updateSelectInput(session,   "year_unusual",    selected = as.numeric(format(today,"%Y")))
    updateSelectInput(session,   "month_unusual",   selected = max(months_list_unusual()))
    updateSelectInput(session,   "rolling_unusual", selected = rolling_dft)
  })

  # Render First Panel (Summary)
  output$page1 <- renderUI({ui1})
  # Render Second Panel (Invoice Without Order)
  output$page2 <- renderUI({ui2})
  # Render Third Panel (Aging)
  output$page3 <- renderUI({ui3})
  # Render Fourth Panel (Unusual Movement)
  output$page4 <- renderUI({ui4})
}

shinyApp(ui = ui,
         shinyServer(server)
)