Nothing
#' @importFrom data.table data.table := setDF setorder .N
#' @importFrom stats na.omit
bin_create <- function(bm) {
bm <- data.table(bm)
setorder(bm, predictor) # sort
# group and summarize
bm_group <- bm[, .(bin_count = .N,
good = sum(response == 1),
bad = sum(response == 0)),
by = bin]
# create new columns
bm_group[, ':='(bin_cum_count = cumsum(bin_count),
good_cum_count = cumsum(good),
bad_cum_count = cumsum(bad),
bin_prop = bin_count / sum(bin_count),
good_rate = good / bin_count,
bad_rate = bad / bin_count,
good_dist = good / sum(good),
bad_dist = bad / sum(bad))]
bm_group[, woe := log(bad_dist / good_dist)]
bm_group[, dist_diff := bad_dist - good_dist,]
bm_group[, iv := dist_diff * woe,]
bm_group[, entropy := (-1) * (((good / bin_count) * log2(good / bin_count)) +
((bad / bin_count) * log2(bad / bin_count)))]
bm_group[, prop_entropy := (bin_count / sum(bin_count)) * entropy]
setDF(bm_group)
return(bm_group)
}
f_bin <- function(u_freq) {
len_fbin <- length(u_freq)
fbin <- u_freq[-len_fbin]
l_fbin <- length(fbin)
c(fbin, fbin[l_fbin])
}
create_intervals <- function(sym_sign, fbin2) {
result <- data.frame(sym_sign, fbin2)
result$cut_point <- paste(result$sym_sign, result$fbin2)
result['cut_point']
}
freq_bin_create <- function(bm, bin_rep) {
bm$bin <- bin_rep
bin_create(bm)
}
plot_bins <- function(x) {
plot_data <- x$bins
xseq <- nrow(plot_data)
p <-
ggplot2::ggplot(data = plot_data) +
ggplot2::geom_line(ggplot2::aes(x = bin, y = woe), color = "blue") +
ggplot2::geom_point(ggplot2::aes(x = bin, y = woe), color = "red") +
ggplot2::xlab("Bins") + ggplot2::ylab("WoE") + ggplot2::ggtitle("WoE Trend") +
ggplot2::scale_x_continuous(breaks = seq(xseq))
return(p)
}
#' @importFrom utils packageVersion menu install.packages
check_suggests <- function(pkg) {
pkg_flag <- tryCatch(utils::packageVersion(pkg), error = function(e) NA)
if (is.na(pkg_flag)) {
msg <- message(paste0('\n', pkg, ' must be installed for this functionality.'))
if (interactive()) {
message(msg, "\nWould you like to install it?")
if (utils::menu(c("Yes", "No")) == 1) {
utils::install.packages(pkg)
} else {
stop(msg, call. = FALSE)
}
} else {
stop(msg, call. = FALSE)
}
}
}
#' @importFrom stats quantile
#' @importFrom utils head tail
winsor <- function(x, min_val = NULL, max_val = NULL, probs = c(0.05, 0.95),
na.rm = TRUE, type = 7) {
if (is.null(min_val)) {
y <- quantile(x, probs = probs, type = type, na.rm = na.rm)
x[x > y[2]] <- y[2]
x[x < y[1]] <- y[1]
} else {
if (is.null(max_val)) {
stop("Argument max_val is missing.")
}
z <- sort(x)
min_replace <- max(head(z, min_val))
max_replace <- min(tail(z, max_val))
x[x < min_replace] <- min_replace
x[x > max_replace] <- max_replace
}
return(x)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.