R/rbin-addins.R

In rsquaredacademy/rbin: Tools for Binning Data

#' Bin continuous data
#'
#' Manually bin continuous data using weight of evidence.
#'
#' @param data A \code{data.frame} or \code{tibble}.
#'
#' @examples
#' \dontrun{
#' rbinAddin(data = mbank)
#' }
#'
#' @export
#'
rbinAddin <- function(data = NULL) {

  pkg_deps <- c("shiny", "miniUI", "rstudioapi")

  is_installed <- sapply(pkg_deps, try_pkg)
  to_install <- pkg_deps[is.na(is_installed)]

  if (length(to_install) > 0) {
    if (interactive()) {
      message('The following package(s) must be installed:', '\n')
      for (i in seq_len(length(to_install))) {
        cat(paste('-', to_install[i], '\n'))
      }
      message('\n', 'Would you like to install?')
      if (menu(c("Yes", "No")) == 1) {
        install.packages(to_install)
      } else {
        stop('Sorry! The addin cannot be launched without installing the required packages.', call. = FALSE)
      }
    }
  }

  context <- rstudioapi::getActiveDocumentContext()
  text <- context$selection[[1]]$text
  default_data <- text

  if (is.null(data)) {
    if (nzchar(default_data)) {
      data <- default_data
    }
  }

  if (any(class(data) %in% c("data.frame","tibble","tbl_df"))) {
    mydata <- deparse(substitute(data))
  } else if (is.character(data)) {
    result <- tryCatch(eval(parse(text = data)), error = function(e) "error")
    if (any(class(result) %in% c("data.frame","tibble","tbl_df"))) {
      mydata <- data
    } else {
      return(NULL)
    }
  }

  ui <- miniUI::miniPage(
    miniUI::gadgetTitleBar("Variable Binning"),
    miniUI::miniTabstripPanel(
      miniUI::miniTabPanel("Data", icon = shiny::icon("database"),
                           miniUI::miniContentPanel(
                             shiny::tabPanel('Data', value = 'tab_upload_csv',
                                             shiny::fluidPage(

                                               shiny::br(),
                                               shiny::fluidRow(
                                                 shiny::column(12, align = 'center',
                                                               shiny::textInput("mydata", "Data Name", value = mydata)
                                                 )
                                               )

                                             )
                             )
                           )
      ),
      miniUI::miniTabPanel("Variables", icon = shiny::icon("bars"),
                           miniUI::miniContentPanel(
                             shiny::fluidPage(
                               shiny::fluidRow(
                                 shiny::column(12, align = 'center',
                                               shiny::selectInput("resp_var", "Response Variable", choices = NULL, selected = NULL),
                                               shiny::selectInput("pred_var", "Predictor Variable", choices = NULL, selected = NULL)
                                 )
                               )
                             )
                           )
      ),
      miniUI::miniTabPanel("Intervals", icon = shiny::icon("scissors"),
                           miniUI::miniContentPanel(
                             shiny::fluidPage(
                               shiny::fluidRow(
                                 shiny::column(4,
                                               shiny::h4('Cut Points'),
                                               shiny::p('For manual binning, you need to specify the cut points for the bins. `rbin`
			    								follows the left closed and right open interval for creating bins. The
                          number of cut points you specify is one less than the number of bins you
                          want to create i.e. if you want to create 10 bins, you need to specify only
                          9 cut points. View the vignette or documentation for more information.')
                                 ),
                                 shiny::column(8, align = 'center',
                                               shiny::numericInput("n_bins", "Bins", value = 5, min = 2, step = 1),
                                               shiny::br(),
                                               shiny::uiOutput("ui_bins"),
                                               shiny::br(),
                                               shiny::br(),
                                               shiny::actionButton("create_bins", "Create Bins")
                                 )
                               )
                             )
                           )
      ),
      miniUI::miniTabPanel("Bins", icon = shiny::icon("table"),
                           miniUI::miniContentPanel(
                             shiny::fluidPage(
                               shiny::fluidRow(
                                 shiny::column(12, align = 'center',
                                               shiny::verbatimTextOutput("woe_manual"),
                                               shiny::br()
                                 )
                               )
                             )
                           )
      ),
      miniUI::miniTabPanel("WoE Trend", icon = shiny::icon("line-chart"),
                           miniUI::miniContentPanel(
                             shiny::fluidPage(
                               shiny::column(12, align = 'center',
                                             shiny::plotOutput("woe", height = '500px', width = '500px')
                               )
                             )
                           )
      )
    )
  )


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

    data1 <- shiny::reactive({
      out <- get(input$mydata)
      return(out)
    })

    shiny::observe({

      shiny::updateSelectInput(
        session,
        inputId = "resp_var",
        choices = names(data1()),
        selected = names(data1())
      )

      shiny::updateSelectInput(
        session,
        inputId = "pred_var",
        choices = names(data1()),
        selected = names(data1())
      )

    })

    output$ui_bins <- shiny::renderUI({

      ncol <- as.integer(input$n_bins) - 1
      lapply(1:ncol, function(i) {
        shiny::fluidRow(
          shiny::column(12, align = 'center',
                        shiny::numericInput(paste("n_bins_", i),
                                            label = paste("Bin", i), value = NULL, step = 1)
          )
        )

      })

    })

    bins_values <- shiny::reactive({

      ncol <- as.integer(input$n_bins) - 1

      collect <- list(lapply(1:ncol, function(i) {
        input[[paste("n_bins_", i)]]
      }))

      unlist(collect)

    })

    compute_bins <- shiny::eventReactive(input$create_bins, {
      shiny_rbin_manual(data1(), input$resp_var, input$pred_var, bins_values())
    })

    down_bins <- shiny::reactive({
      compute_bins()$bins[c('cut_point', 'bin_count', 'good', 'bad', 'woe', 'iv')]
    })

    output$woe_manual <- shiny::renderPrint({
      compute_bins()
    })

    output$woe <- shiny::renderPlot({
      graphics::plot(compute_bins())
    })

    create_woe <- shiny::reactive({
      rbin_create(data1(), input$pred_var, compute_bins())
    })

    shiny::observeEvent(input$done, {
      shiny::stopApp()
    })

  }

  shiny::runGadget(ui, server, viewer = shiny::browserViewer())

}

#' Custom binning
#'
#' Manually combine categorical variables using weight of evidence.
#'
#' @param data A \code{data.frame} or \code{tibble}.
#'
#' @examples
#' \dontrun{
#' rbinFactorAddin(data = mbank)
#' }
#'
#' @export
#'
rbinFactorAddin <- function(data = NULL) {

  pkg_deps <- c("shiny", "miniUI", "rstudioapi")

  is_installed <- sapply(pkg_deps, try_pkg)
  to_install <- pkg_deps[is.na(is_installed)]

  if (length(to_install) > 0) {
    if (interactive()) {
      message('The following package(s) must be installed:', '\n')
      for (i in seq_len(length(to_install))) {
        cat(paste('-', to_install[i], '\n'))
      }
      message('\n', 'Would you like to install?')
      if (menu(c("Yes", "No")) == 1) {
        install.packages(to_install)
      } else {
        stop('Sorry! The addin cannot be launched without installing the required packages.', call. = FALSE)
      }
    }
  }

  context <- rstudioapi::getActiveDocumentContext()
  text <- context$selection[[1]]$text
  default_data <- text

  if (is.null(data)) {
    if(nzchar(default_data)) {
      data <- default_data
    }
  }

  if (any(class(data) %in% c("data.frame","tibble","tbl_df"))) {
    mydata <- deparse(substitute(data))
  } else if (is.character(data)) {
    result <- tryCatch(eval(parse(text = data)), error = function(e) "error")
    if (any(class(result) %in% c("data.frame","tibble","tbl_df"))) {
      mydata <- data
    } else {
      return(NULL)
    }
  }

  ui <- miniUI::miniPage(
    miniUI::gadgetTitleBar("Custom Binning"),
    miniUI::miniTabstripPanel(
      miniUI::miniTabPanel("Data", icon = shiny::icon("database"),
                           miniUI::miniContentPanel(
                             shiny::tabPanel('CSV', value = 'tab_upload_csv',
                                             shiny::fluidPage(

                                               shiny::br(),

                                               shiny::fluidRow(
                                                 shiny::column(12, align = 'center',
                                                               shiny::textInput("mydata", "Data Name", value = mydata)
                                                 )
                                               )
                                             )
                             )
                           )
      ),
      miniUI::miniTabPanel("Variables", icon = shiny::icon("bars"),
                           miniUI::miniContentPanel(
                             shiny::fluidPage(
                               shiny::fluidRow(
                                 shiny::column(12, align = 'center',
                                               shiny::selectInput("resp_var", "Response Variable", choices = NULL, selected = NULL),
                                               shiny::selectInput("pred_var", "Predictor Variable", choices = NULL, selected = NULL)
                                 )
                               ),
                               shiny::fluidRow(
                                 shiny::column(12, align = 'center',
                                               shiny::br(),
                                               shiny::br(),
                                               shiny::actionButton("select_vars", "Select Variables")
                                 )
                               )
                             )
                           )
      ),
      miniUI::miniTabPanel("Intervals", icon = shiny::icon("scissors"),
                           miniUI::miniContentPanel(
                             shiny::fluidPage(
                               shiny::fluidRow(
                                 shiny::column(4,
                                               shiny::h4('Combine Levels'),
                                               shiny::p('Combine levels of categorical variables.')
                                 )
                               ),
                               shiny::fluidRow(
                                 shiny::column(12, align = 'center',
                                               shiny::textInput("new_lev", "New Category", value = NULL),
                                               shiny::selectInput("sel_cat", "Select Categories", choices = NULL, selected = NULL, multiple = TRUE,
                                                                  selectize = TRUE)
                                 )
                               ),
                               shiny::fluidRow(
                                 shiny::column(12, align = 'center',
                                               shiny::actionButton("create_bins", "Create Bins")
                                 )
                               )
                             )
                           )
      ),
      miniUI::miniTabPanel("Bins", icon = shiny::icon("table"),
                           miniUI::miniContentPanel(
                             shiny::fluidPage(
                               shiny::fluidRow(
                                 shiny::column(12, align = 'center',
                                               shiny::verbatimTextOutput("woe_manual"),
                                               shiny::br()
                                 )
                               )
                             )
                           )
      ),
      miniUI::miniTabPanel("WoE Trend", icon = shiny::icon("line-chart"),
                           miniUI::miniContentPanel(
                             shiny::fluidPage(
                               shiny::column(12, align = 'center',
                                             shiny::plotOutput("woe", height = '500px', width = '500px')
                               )
                             )
                           )
      )
    )
  )

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

    data1 <- shiny::reactive({
      out <- get(input$mydata)
      return(out)
    })

    shiny::observe({

      shiny::updateSelectInput(
        session,
        inputId = "resp_var",
        choices = names(data1()),
        selected = names(data1())
      )

      shiny::updateSelectInput(
        session,
        inputId = "pred_var",
        choices = names(data1()),
        selected = names(data1())
      )

    })

    shiny::observeEvent(input$select_vars, {

      shiny::updateSelectInput(
        session,
        inputId = "sel_cat",
        choices = levels(as.factor(data1()[[input$pred_var]])),
        selected = levels(as.factor(data1()[[input$pred_var]]))
      )

    })

    selected_levs <- shiny::reactive({
      out <- as.factor(input$sel_cat)
      return(out)
    })

    new_comb <- shiny::eventReactive(input$create_bins, {
      shiny_rbin_factor_combine(data1(), as.character(input$pred_var),
                                as.character(selected_levs()), as.character(input$new_lev))
    })

    woe_man <- shiny::eventReactive(input$create_bins, {
      shiny_rbin_factor(new_comb(), as.character(input$resp_var), as.character(input$pred_var))
    })

    down_bins <- shiny::reactive({
      woe_man()$bins[c('level', 'bin_count', 'good', 'bad', 'woe', 'iv')]
    })

    woe_plot <- shiny::eventReactive(input$create_bins, {
      graphics::plot(shiny_rbin_factor(new_comb(), as.character(input$resp_var),
                                       as.character(input$pred_var)))
    })

    output$woe_manual <- shiny::renderPrint({
      woe_man()
    })

    output$woe <- shiny::renderPlot({
      woe_plot()
    })

    shiny::observeEvent(input$done, {
      shiny::stopApp()
    })

  }

  shiny::runGadget(ui, server, viewer = shiny::browserViewer())

}