% !Rnw root = Transformation_Report_KR.Rnw

<<init, echo=FALSE, warning=FALSE, message=FALSE>>=
options(warn = -1)

if (!requireNamespace("mice", quietly = TRUE)) {
  stop("Package 'mice' needed for this function to work. Please install it.", 
       call. = FALSE)
} else {
  library(mice)
}

if (!requireNamespace("rpart", quietly = TRUE)) {
  stop("Package 'rpart' needed for this function to work. Please install it.", 
       call. = FALSE)
}

library(grid)
library(knitr)
library(kableExtra)

opts_chunk$set(fig.path = 'figure/minimal-', fig.align = 'center',
               fig.show = 'hold', warning = FALSE, message = FALSE)
knit_hooks$set(document = function(x) {sub('\\usepackage[]{color}', '\\usepackage{xcolor}', x, fixed = TRUE)})

options(replace.assign = TRUE, width = 90)

edaData <- as.data.frame(get("edaData", .dlookrEnv))
targetVariable <- get("targetVariable", .dlookrEnv)

if (length(targetVariable) == 0) targetVariable <- NULL

names(edaData) <- gsub("[[:punct:][:space:]]", "_", names(edaData))

idx.numeric <- find_class(edaData, type = "numerical")
varname <- names(edaData)[idx.numeric]

varname <- setdiff(varname, targetVariable)

change_under <- function(x) {
  gsub("_", "\\\\_", x)
}

N <- NROW(edaData)

options(knitr.table.format = "latex")
@

\chapter{대체 (Imputation)}
\section{결측치 (Missing Values)}
\subsection{결측치 대체 정보}
결측값을 대체하기 위한 변수는 다음과 같다.

<<nalist, tidy=TRUE, echo=FALSE, warning=FALSE, message=FALSE, comment="", tidy.opts=list(width.cutoff=65), size="small">>=
nalist <- find_na(edaData, index = FALSE)

if (length(nalist) > 0) {
  naclass <- get_class(edaData) %>%
    filter(variable %in% nalist) %>%
    select(class) %>%
    pull() %>%
    as.character()

  cat(paste(nalist, collapse = ", "))
} else {
  cat("결측치를 포함한 변수가 없습니다.")
}
@


<<impute_function, tidy=TRUE, echo=FALSE, warning=FALSE, message=FALSE, comment="", tidy.opts=list(width.cutoff=65), size="small">>=
numerics <- c("mean", "median", "mode", "knn", "rpart", "mice")
categories <- c("mode", "rpart", "mice")

imputae_summary <- function(object) {
  type <- attr(object, "type")
  method <- attr(object, "method")
  var_type <- attr(object, "var_type")

  original <- object

  if (type == "missing values") {
    na_pos <- attr(object, "na_pos")
    seed <- attr(object, "seed")

    original[na_pos] <- NA
  } else if (type == "outliers") {
    outlier_pos <- attr(object, "outlier_pos")
    outliers <- attr(object, "outliers")

    original[outlier_pos] <- outliers
  }

  if (var_type == "numerical") {
    original <- as.numeric(original)
    object <- as.numeric(object)
  } else if (var_type == "categorical") {
    original <- factor(original)
    object <- factor(object)
  }

  dframe <- data.frame(original = original,
    imputation = object) %>%
    tidyr::gather()

  if (var_type == "numerical") {
    smmry <- dframe %>%
      group_by(key) %>%
      describe("value") %>%
      select(-variable, -key) %>%
      t

    smmry <- smmry[, 2:1]
    colnames(smmry) <- c("Original", "Imputation")
    row.names(smmry)[5] <- c("se(mean)")
  } else if (var_type == "categorical") {
    tab_freq <- xtabs(~ value + key, dframe, addNA = TRUE)
    tab_relat <- round(prop.table(tab_freq, 2) * 100, 2)

    smmry <- cbind(tab_freq, tab_relat)
    smmry <- smmry[, c(2, 1, 4, 3)]
    colnames(smmry) <- c("original", "imputation",
      "original\\_percent", "imputation\\_percent")
  }

  if (method %in% c("knn", "rpart", "mice")) {
    if (method == "knn") {
      met <- "K-Nearest Neighbors"
    } else if (method == "rpart") {
      met <- "Recursive Partitioning and Regression Trees"
    } else if (method == "mice") {
      met <- "Multivariate Imputation by Chained Equations"
      met <- sprintf("%s\n\\\\ - random seed : %s", met, seed)
    }
    cat(sprintf("* Imputate %s based on %s\n\n", type, met))
  }

  invisible(smmry)
}
@

<<imputate_na, tidy=TRUE, echo=FALSE, warning=FALSE, message=FALSE, comment="", tidy.opts=list(width.cutoff=65), size="small", fig.height=5, fig.width=7, fig.align='center', results='asis'>>=
if (length(nalist) > 0) {
  for (i in 1:length(nalist)) {
    cat("\n")
    cat("\\subsection{", change_under(nalist[i]), "}\n")

    if (naclass[i] %in% c("integer", "numeric")) {
      method <- numerics
    } else if (naclass[i] %in% c("factor", "ordered")) {
      method <- categories
    }

    if (is.null(targetVariable)) {
      method <- setdiff(method, c("knn", "rpart", "mice"))
    }

    for (j in 1:length(method)) {
      cat("\n")
      cat(sprintf("\\subsubsection{%s 방법의 결측치 대체}\n", method[j]))

      impu <- imputate_na(edaData, nalist[i], targetVariable, method = method[j], print_flag = FALSE)
      
      if (!attr(impu, "success")) {
        cat(attr(impu, "message"), "\n\n")
        next
      }
      
      tab <- imputae_summary(impu)

      cap <- sprintf("'%s' 방법에 대한 %s의 기술통계량", method[j], nalist[i])
      cap <- paste(unlist(strsplit(cap, "_")), collapse = "\\_")

      kable(tab, digits = 2, caption = cap, 
            label = paste0("imputate_na", i, j),
            booktabs = TRUE, escape = FALSE) %>%
        kable_styling(latex_options = c("striped", "hold_position")) %>%
        cat()

      cat("\n")

      png(filename = sprintf("./figure/na-%s-method%s.png", i, j), width = 800, height = 400)
        grid.draw(plot(impu))
      dev.off()

      cap <- paste(change_under(nalist[i]), method[j], sep = " - ")

      cat("\n")
      cat("\\subsubsection{결측치 대체 정보 (대체 전 vs 대체 후)}\n")

      cat("\n\\begin{center}\n")
      cat("\\begin{figure}[!ht]\n")
      cat("\\centering\n")
      cat(sprintf("\\includegraphics[width=0.7\\textwidth]{figure/na-%s-method%s.png}\n", i, j))
      cat(sprintf("\\caption{%s}\n", cap))
      cat("\\end{figure}\n")

      cat("\n\\end{center}\n")
      cat("\\clearpage")
    }
  }
}
@


\section{이상치 (Outliers)}
\subsection{이상치 대체 정보}
이상치를 대체하기 위한 수치 변수는 다음과 같다.

<<outlist, tidy=TRUE, echo=FALSE, warning=FALSE, message=FALSE, comment="", tidy.opts=list(width.cutoff=65), size="small">>=
outlist <- find_outliers(edaData, index = FALSE)

if (length(outlist) > 0) {
  cat(paste(outlist, collapse = ", "))
} else {
  cat("이상치를 포함한 수치변수가 없습니다.")
}
@

<<impute_outliers, tidy=TRUE, echo=FALSE, warning=FALSE, message=FALSE, comment="", tidy.opts=list(width.cutoff=65), size="small", fig.height=5, fig.width=7, fig.align='center', results='asis'>>=
if (length(outlist) > 0) {
  for (i in 1:length(outlist)) {
    cat("\n")
    cat("\\subsection{", change_under(outlist[i]), "}\n")

    method <- c("mean", "median", "mode", "capping")

    for (j in 1:length(method)) {
      cat("\n")
      cat(sprintf("\\subsubsection{%s 방법의 이상치 대체}\n", method[j]))
      
      impu <- imputate_outlier(edaData, outlist[i], method = method[j])
      tab <- imputae_summary(impu)

      cap <- sprintf("'%s' 방법에 대한 %s의 기술통계량", method[j], outlist[i])
      cap <- paste(unlist(strsplit(cap, "_")), collapse = "\\_")

      kable(tab, digits = 2, caption = cap, 
            label = paste0("impute_outliers", i, j),
            booktabs = TRUE, escape = FALSE) %>%
        kable_styling(latex_options = c("striped", "hold_position")) %>%
        cat()

      cat("\n")

      png(filename = sprintf("./figure/outlier-%s-method%s.png", i, j), width = 800, height = 400)
        grid.draw(plot(impu))
      dev.off()

      cap <- paste(change_under(outlist[i]), method[j], sep = " - ")

      cat("\n")
      cat("\\subsubsection{이상치 대체 정보 (대체 전 vs 대체 후)}\n")

      cat("\n\\begin{center}\n")
      cat("\\begin{figure}[!ht]\n")
      cat("\\centering\n")
      cat(sprintf("\\includegraphics[width=0.7\\textwidth]{figure/outlier-%s-method%s.png}\n", i, j))
      cat(sprintf("\\caption{%s}\n", cap))
      cat("\\end{figure}\n")

      cat("\n\\end{center}\n")
      cat("\\clearpage")
    }
  }
}
@

\chapter{비대칭 보정 (Resolving Skewness)}
\section{비대칭 변수 정보}
비대칭을 해결하기위한 수치 변수는 다음과 같다.

<<summary_transform, echo=FALSE, warning=FALSE, message=FALSE>>=
summary_transform <- function(object, ...) {
  method <- attr(object, "method")
  origin <- attr(object, "origin")

  suppressWarnings({dframe <- data.frame(original = origin,
    trans = object) %>%
    tidyr::gather()})

  smmry <- dframe %>%
    group_by(key) %>%
    describe("value") %>%
    select(-variable, -key) %>%
    t
  colnames(smmry) <- c("원본", "변환값")
  invisible(smmry)
}
@

<<skewlist, tidy=TRUE, echo=FALSE, warning=FALSE, message=FALSE, comment="", tidy.opts=list(width.cutoff=65), size="small">>=
skewlist <- find_skewness(edaData, index = FALSE)
skew <- find_skewness(edaData, value = TRUE)

if (length(skewlist) > 0) {
  cat(paste(skewlist, collapse = ", "))
  skew <- skew[skewlist]
} else {
  cat("비대칭이 아주 심한 변수는 없습니다.")
}
@

<<resolve_skewness, tidy=TRUE, echo=FALSE, warning=FALSE, message=FALSE, comment="", tidy.opts=list(width.cutoff=65), size="small", fig.height=4, fig.width=8, fig.align='center', results='asis'>>=
if (length(skewlist) > 0) {
  for (i in 1:length(skewlist)) {
    cat("\n")
    cat("\\subsection{", change_under(skewlist[i]), "}\n")

    if (skew[i] <= 0)
      method <- c("1/x", "x^2", "x^3")
    else
      method <- c("log", "log+1", "sqrt")

    for (j in 1:length(method)) {
      cat("\n")

      if (stringr::str_detect(method[j], "\\^"))
        str_method <- sprintf("$%s$", method[j])
      else
        str_method <- method[j]

      cat(sprintf("\\subsubsection{%s 방법의 비대칭 보정}\n", str_method))

      trans <- transform(pull(edaData, skewlist[i]), method = method[j])
      tab <- summary_transform(trans)
      row.names(tab)[5] <- c("se(mean)")

      cap <- sprintf("'%s' 방법에 대한 %s의 기술통계량", str_method, skewlist[i])
      cap <- paste(unlist(strsplit(cap, "_")), collapse = "\\_")

      kable(tab, digits = 2, caption = cap, 
            label = paste0("resolve_skewness", j),
            booktabs = TRUE, escape = FALSE) %>%
        kable_styling(latex_options = c("striped", "hold_position")) %>%
        cat()

      cat("\n")
      png(filename = sprintf("./figure/skew-%s-method%s.png", i, j), width = 800, height = 400)
        grid.draw(plot(trans))
      dev.off()

      cap <- paste(change_under(skewlist[i]), str_method, sep = " - ")

      cat("\n")
      cat("\\subsubsection{비대칭 보정 정보 (대체 전 vs 대체 후)}\n")      

      cat("\n\\begin{center}\n")
      cat("\\begin{figure}[!ht]\n")
      cat("\\centering\n")
      cat(sprintf("\\includegraphics[width=0.7\\textwidth]{figure/skew-%s-method%s.png}\n", i, j))
      cat(sprintf("\\caption{%s}\n", cap))
      cat("\\end{figure}\n")

      cat("\n\\end{center}\n")
      cat("\\clearpage")
    }
  }
}
@


\chapter{비닝 (Binning)}
\section{비닝을 위한 수치형 변수}
비닝을 위한 수치형 변수는 다음과 같습니다.

<<var_numeric, echo=FALSE, warning=FALSE, message=FALSE>>=
idx.numeric <- find_class(edaData, type = "numerical")
var_numeric <- names(edaData)[idx.numeric]

var_numeric <- setdiff(var_numeric, targetVariable)
@

<<target, tidy=TRUE, echo=FALSE, warning=FALSE, message=FALSE, comment="", tidy.opts=list(width.cutoff=65), size="small">>=
if (length(var_numeric) > 0) {
  cat(paste(var_numeric, collapse = ", "))
} else {
  cat("수치형 변수가 없습니다.")
}
@

\section{비닝}
<<binning, tidy=TRUE, echo=FALSE, warning=FALSE, message=FALSE, comment="", tidy.opts=list(width.cutoff=65), size="small", fig.height=4, fig.width=8, fig.align='center', results='asis'>>=
if (length(var_numeric) > 0) {
  for (i in 1:length(var_numeric)) {
    cat("\n")
    cat("\\subsection{", change_under(var_numeric[i]), "}\n")

    method <- c("quantile", "equal", "pretty", "kmeans", "bclust")

    for (j in 1:length(method)) {
      cat("\n")
      cat(sprintf("\\subsubsection{%s 방법의 비닝}\n", method[j]))

      error_flag <- FALSE
      tryCatch(binn <- binning(pull(edaData, var_numeric[i]), type = method[j]),
        error = function(e) {
          msg <<- e$message
          error_flag <<- TRUE
      }, finally = NULL)
      
      if (error_flag) {
        cat(msg, "\n\n")
        rm(msg, error_flag)
        next
      }
      
      tab <- summary(binn)
      tab$levels <- c(paste("{", tab$levels[1], "}", sep = ""), as.character(tab$levels)[-1])

      cap <- sprintf("'%s' 방법에 대한 %s의 범주의 도수분포", method[j], var_numeric[i])
      cap <- paste(unlist(strsplit(cap, "_")), collapse = "\\_")

      kable(tab, digits = 4, caption = cap, 
            label = paste0("binning", i, j),
            booktabs = TRUE, escape = FALSE) %>%
        kable_styling(latex_options = c("striped", "hold_position")) %>%
        cat()

      cat("\n")
      png(filename = sprintf("./figure/binn-%s-method%s.png", i, j), width = 600, height = 500)
        plot(binn)
      dev.off()

      cap <- paste(change_under(var_numeric[i]), method[j], sep = " - ")

      cat("\n")
      cat("\\subsubsection{비닝 정보}\n")

      cat("\n\\begin{center}\n")
      cat("\\begin{figure}[!ht]\n")
      cat("\\centering\n")
      cat(sprintf("\\includegraphics[width=0.7\\textwidth]{figure/binn-%s-method%s.png}\n", i, j))
      cat(sprintf("\\caption{%s}\n", cap))
      cat("\\end{figure}\n")

      cat("\n\\end{center}\n")
      cat("\\clearpage")
    }
  }
}
@

\section{최적 비닝(Optimal Binning)}

스코어링(scorecard) 모델링의 경우에는 일반적으로 수치형 데이터와 목적변수와의 특성을 고려하여 최적의 비닝(optimal binning)을 수행한다.
optimal binning 작업에서는 수치형 데이터를 범주형 데이터로 범주화할 때, supervised discretization이라고 하는 재귀적 분할(recursive partitioning) 기법을 사용한다.
단, optimal binning은 목적변수가 이진분류(binary class)일 경우만 가능하다.

<<optimal, tidy=TRUE, echo=FALSE, warning=FALSE, message=FALSE, comment="", tidy.opts=list(width.cutoff=65), size="small", fig.height=4, fig.width=8, fig.align='center', fig.pos="!ht", results='asis'>>=
if (!is.null(targetVariable)) {
  n_levles <- length(table(pull(edaData, targetVariable)))

  if (n_levles == 2) {
    # Optimal Binning for Scoring Modeling
    results <- lapply(varname, function(x)
      binning_by(.data = edaData, y = targetVariable, x = x, p = 0.05))

    # could also use tapply here
    for (i in 1:length(varname)) {
      cat("\n")
      cat("\\subsection{", change_under(varname[i]), "}")

      result <- results[[i]]

      if (is.character(result)) {
        result <- sub("<", "$<$", result)
        
        if (result == "No significant splits")
          result <- "목적변수와의 관계에서 유효한 범주화를 도출할 수 없습니다."
        
        cat(result)
        next
      }

      tab <- attr(result, "performance") %>% 
        select(-CntCumPos, -CntCumNeg, -RateCumPos, -RateCumNeg) %>% 
        mutate(Bin = sub("\\[", "{[}", Bin))

      kable(tab, booktabs = TRUE, 
            label = paste0("optimal", i), escape = FALSE) %>%
        kable_styling(latex_options = c("striped", "scale_down")) %>%
        cat()

      cat(sprintf("Information value = %s\\\\", attr(result, "iv")))

      cat("\\bloodp{", i, "}{",
        change_under(varname[i]), "}\n", sep = "")

      if (N >= 5000) {
        png(paste("./figure/binns", i, ".png", sep = ""), width = 700, height = 500)
      } else {
        cairo_pdf(paste("./figure/binns", i, ".pdf", sep = ""), width = 7, height = 5)
      }
      
      plot(result)
      dev.off()
    }
  } else {
    cat("목적변수가 이진분류(binary class)가 아닙니다.\n\n")
  }
} else {
  cat("\n\\enspace\\textbf{목적변수를 지정하지 않았습니다.}\n\n")
}
@

<<option_undo, echo=FALSE>>=
options(warn = 0)
@


