Showing 3 of 5 files from the diff.
Newly tracked file
R/rbin-shiny.R created.
Other files ignored by Codecov
DESCRIPTION has changed.
man/rbinAddin.Rd has changed.

@@ -37,8 +37,8 @@
Loading
37 37
  resp <- deparse(substitute(response))
38 38
  pred <- deparse(substitute(predictor))
39 39
40 -
  var_names <- names(data[, c(resp, pred)])
41 -
  prep_data <- data[, c(resp, pred)]
40 +
  var_names <- names(data[c(resp, pred)])
41 +
  prep_data <- data[c(resp, pred)]
42 42
43 43
  if (include_na) {
44 44
    bm <- prep_data

@@ -8,7 +8,7 @@
Loading
8 8
#' \dontrun{
9 9
#' rbinAddin(data = mbank)
10 10
#' }
11 -
#'
11 +
#'  
12 12
#' @export
13 13
#'
14 14
rbinAddin <- function(data = NULL) {
@@ -171,7 +171,7 @@
Loading
171 171
	})
172 172
173 173
	compute_bins <- shiny::eventReactive(input$create_bins, {
174 -
      rbin_manual(data1(), input$resp_var, input$pred_var, bins_values())
174 +
      shiny_rbin_manual(data1(), input$resp_var, input$pred_var, bins_values())
175 175
	})
176 176
177 177
	down_bins <- shiny::reactive({
@@ -364,11 +364,12 @@
Loading
364 364
	})
365 365
366 366
	new_comb <- shiny::eventReactive(input$create_bins, {
367 -
		rbin_factor_combine(data1(), !! rlang::sym(as.character(input$pred_var)), as.character(selected_levs()), as.character(input$new_lev))
367 +
		shiny_rbin_factor_combine(data1(), as.character(input$pred_var), 
368 +
      as.character(selected_levs()), as.character(input$new_lev))
368 369
	})
369 370
370 371
	woe_man <- shiny::eventReactive(input$create_bins, {
371 -
		rbin_factor(new_comb(), !! rlang::sym(as.character(input$resp_var)), !! rlang::sym(as.character(input$pred_var)))
372 +
		shiny_rbin_factor(new_comb(), as.character(input$resp_var), as.character(input$pred_var))
372 373
	})
373 374
374 375
	down_bins <- shiny::reactive({
@@ -376,7 +377,8 @@
Loading
376 377
	})
377 378
378 379
	woe_plot <- shiny::eventReactive(input$create_bins, {
379 -
		graphics::plot(rbin_factor(new_comb(), !! rlang::sym(as.character(input$resp_var)), !! rlang::sym(as.character(input$pred_var))))
380 +
		graphics::plot(shiny_rbin_factor(new_comb(), as.character(input$resp_var), 
381 +
      as.character(input$pred_var)))
380 382
	})
381 383
382 384
	output$woe_manual <- shiny::renderPrint({
@@ -387,10 +389,6 @@
Loading
387 389
	  woe_plot()
388 390
	})
389 391
390 -
	create_woe <- shiny::reactive({
391 -
	  rbin_factor_create(new_comb(), !! rlang::sym(as.character(input$pred_var)))
392 -
	})
393 -
394 392
  shiny::observeEvent(input$done, {
395 393
    shiny::stopApp()
396 394
  })

@@ -0,0 +1,126 @@
Loading
1 +
shiny_rbin_manual <- function(data = NULL, response = NULL, predictor = NULL, 
2 +
                              cut_points = NULL, include_na = TRUE) {
3 +
  
4 +
  resp <- response
5 +
  pred <- predictor
6 +
  
7 +
  var_names <- names(data[c(resp, pred)])
8 +
  prep_data <- data[c(resp, pred)]
9 +
  
10 +
  if (include_na) {
11 +
    bm <- prep_data
12 +
  } else {
13 +
    bm <- na.omit(prep_data)
14 +
  }
15 +
  
16 +
  colnames(bm) <- c("response", "predictor")
17 +
  
18 +
  bm$bin    <- NA
19 +
  byd       <- bm$predictor
20 +
  l_freq    <- append(min(byd, na.rm = TRUE), cut_points)
21 +
  u_freq    <- c(cut_points, (max(byd, na.rm = TRUE) + 1))
22 +
  bins      <- length(cut_points) + 1
23 +
  
24 +
  for (i in seq_len(bins)) {
25 +
    bm$bin[bm$predictor >= l_freq[i] & bm$predictor < u_freq[i]] <- i
26 +
  }
27 +
  
28 +
  k         <- bin_create(bm)
29 +
  sym_sign  <- c(rep("<", (bins - 1)), ">=")
30 +
  fbin2     <- f_bin(u_freq)
31 +
  intervals <- create_intervals(sym_sign, fbin2)
32 +
  
33 +
  if (include_na) {
34 +
    
35 +
    na_present <- nrow(k) > bins
36 +
    
37 +
    if (na_present) {
38 +
      intervals <- rbind(intervals, cut_point = 'NA')
39 +
    }
40 +
    
41 +
  }
42 +
  
43 +
  result <- list(bins = cbind(intervals, k),
44 +
                 method = "Manual",
45 +
                 vars = var_names,
46 +
                 lower_cut = l_freq,
47 +
                 upper_cut = u_freq)
48 +
  
49 +
  class(result) <- c("rbin_manual")
50 +
  return(result)
51 +
  
52 +
}
53 +
54 +
55 +
shiny_rbin_factor_combine <- function(data, var, new_var, new_name) {
56 +
57 +
  vars           <- var
58 +
  mydata         <- data[[vars]]
59 +
  current_lev    <- levels(mydata)
60 +
  l              <- length(new_var)
61 +
62 +
  for (i in seq_len(l)) {
63 +
    current_lev  <- gsub(new_var[i], new_name, current_lev)
64 +
  }
65 +
66 +
  levels(mydata) <- current_lev
67 +
  data[vars]     <- NULL
68 +
  out            <- cbind(data, mydata)
69 +
  nl             <- ncol(out)
70 +
  names(out)[nl] <- vars
71 +
72 +
  return(out)
73 +
74 +
}
75 +
76 +
shiny_rbin_factor <- function(data = NULL, response = NULL, predictor = NULL, include_na = TRUE) {
77 +
78 +
  resp <- response
79 +
  pred <- predictor
80 +
81 +
  var_names <- names(data[, c(resp, pred)])
82 +
  prep_data <- data[, c(resp, pred)]
83 +
84 +
  if (include_na) {
85 +
    bm <- prep_data
86 +
  } else {
87 +
    bm <- na.omit(prep_data)
88 +
  }
89 +
90 +
  colnames(bm) <- c("response", "predictor")
91 +
92 +
  bm <- data.table(bm)
93 +
94 +
  # group and summarize
95 +
  bm_group <- bm[, .(bin_count = .N,
96 +
                     good = sum(response == 1),
97 +
                     bad = sum(response == 0)),
98 +
                 by = predictor]
99 +
100 +
  # create new columns
101 +
  bm_group[, ':='(bin_cum_count   = cumsum(bin_count),
102 +
                  good_cum_count  = cumsum(good),
103 +
                  bad_cum_count   = cumsum(bad),
104 +
                  bin_prop        = bin_count / sum(bin_count),
105 +
                  good_rate       = good / bin_count,
106 +
                  bad_rate        = bad / bin_count,
107 +
                  good_dist       = good / sum(good),
108 +
                  bad_dist        = bad / sum(bad))]
109 +
110 +
  bm_group[, woe := log(bad_dist / good_dist)]
111 +
  bm_group[, dist_diff := bad_dist - good_dist,]
112 +
  bm_group[, iv := dist_diff * woe,]
113 +
  bm_group[, entropy := (-1) * (((good / bin_count) * log2(good / bin_count)) +
114 +
                                  ((bad / bin_count) * log2(bad / bin_count)))]
115 +
  bm_group[, prop_entropy := (bin_count / sum(bin_count)) * entropy]
116 +
117 +
  setDF(bm_group)
118 +
  colnames(bm_group)[1] <- 'level'
119 +
120 +
  result <- list(bins = bm_group, method = "Custom", vars = var_names)
121 +
122 +
  class(result) <- c("rbin_factor")
123 +
  return(result)
124 +
125 +
}
126 +
Files Coverage
R 51.79%
Project Totals (12 files) 51.79%
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading