In choonghyunryu/dlookr: Tools for Data Diagnosis, Exploration, Transformation

knitr::opts_chunk$set(echo = TRUE)

library(dplyr)
library(ggplot2)
library(gridExtra)
library(knitr)
library(kableExtra)

dist_numeric <- function(df, target, predictor) {
  library(dplyr)

  descr <- df %>%
    target_by(target) %>%
    relate(predictor)

  vars <- unlist(descr[, 2])

  descr <- descr %>%
    select(-c(1:2)) %>%
    t

  colnames(descr) <- vars

  descr <- descr[, rev(seq(NCOL(descr)))]

  rnames <- c("n", "NA", "mean", "sd", "se(mean)", "IQR",
              "skewness", "kurtosis")
  rnames <- c(rnames, paste0(c(0, 1, 5, 10, 20, 25, 30, 40, 50, 60, 70,
                               75, 80, 90, 95, 99, 100), "%"))
  row.names(descr) <- rnames

  as.data.frame(descr)
}

setUnder <- function(x) {
  gsub("_", ".", x)
}

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

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

if (!is.null(font_family)) {
  ggplot2::theme_update(text = element_text(family = font_family))
}

idx.numeric <- find_class(edaData, type = "numerical")
idx.factor <- find_class(edaData, type = "categorical")
nm.numeric <- find_class(edaData, type = "numerical", index = FALSE)
nm.factor <- find_class(edaData, type = "categorical", index = FALSE)

if (!is.null(targetVariable)) {
  # remove target variable from variable index
  idx.numeric <- idx.numeric[nm.numeric != targetVariable]
  idx.factor <- idx.factor[nm.factor != targetVariable]

  factor_flag <- class(pull(edaData, targetVariable))[1] %in% c("factor", "ordered")
  numeric_flag <- class(pull(edaData, targetVariable))[1] %in% c("integer", "numeric")

  target <- if (!factor_flag & numeric_flag) 
    factor(pull(edaData, targetVariable)) else
      pull(edaData, targetVariable)
} else { # fix error while performing eda_web_report() #83
  factor_flag <- FALSE
  numeric_flag <- FALSE
}

# if all elements of a numerical variable are NA,
# remove from correlation coefficient calculation
idx.numeric <- idx.numeric[apply(edaData[, idx.numeric], 2,
                                 function(x) !all(is.na(x)))]

# if all elements of the numerical variable are the same value,
# remove from the correlation coefficient calculation
idx.numeric <- idx.numeric[apply(edaData[, idx.numeric], 2,
                                 function(x) diff(range(x, na.rm = TRUE)) > 0)]

개요

데이터 분석 정보를 제공한다.

데이터셋 정보

EDA 보고서를 생성한 데이터셋은 'r class(edaData)[1]' 객체다. 이 데이터 객체는 r format(NROW(edaData), big.mark = ",")개의 관측치 와 r NCOL(edaData)개의 변수로 구성되었다.

변수들의 정보

EDA 보고서를 생성한 데이터셋의 변수 정보가 다음 표에 나와 있다.:

cap <- "변수들의 정보 목록"

vars <- edaData %>% 
  diagnose() 


knitr::kable(vars, caption = cap, format = "html") %>% 
  kable_styling(full_width = FALSE, font_size = 15, position = "left") %>% 
  cat()

target_nm <- if (is.null(targetVariable)) "NULL" else targetVariable
target_type <- if (is.null(targetVariable)) 
  "NULL(You did not specify a target variable)" else 
  class(pull(edaData, targetVariable))[1]

데이터셋의 목적변수(target variable) 이름은 'r target_nm', 변수의 데이터 유형(data type)은 r target_type이다.

EDA 보고서에 대해

EDA 보고서는 EDA 프로세스를 지원하는 정보 및 시각화 결과를 제공한다. 특히 목적변수와 나머지 변수(predictor, 예측자 혹은 독립변수)의 관계를 이해하기 위한 다양한 정보를 제공한다.

단변량 분석

기술통계(Descriptive Statistics)

x <- Hmisc:::describe.data.frame(edaData)
Hmisc::html(x, file = "")

정규성 검정

통계량과 시각화

if (length(idx.numeric) == 0) {
  cat("\n\n수치형 변수가 없습니다.\n\n")
} else {
  for (i in idx.numeric) {
    cap <- sprintf("%s", names(edaData)[i])
    cap <- paste(unlist(strsplit(cap, "_")), collapse = "\\_")

    cat("<b><font size='3' face='verdana'>[", names(edaData)[i], 
            "]</font></b>", "\n")

    cat("\n검정 방법 : Shapiro-Wilk normality test\n\n")

    x <- pull(edaData, i) %>%
      .[!is.na(.)]

    if (length(x) == 0) {
      cat("모든 관측치가 결측치입니다.\n\n")
      next
    }

    if (length(x) > 5000) {
      x <- sample(x, size = 5000, replace = TRUE)
    }

    if(length(x) < 3L || length(x) > 5000L) {
      cat("검정을 위한 샘플의 크기는 3 이상 5000 이하여야 합니다.\n\n")
      next
    }

    if(diff(range(x, na.rm = TRUE)) == 0) {
      cat("모든 관측치가 동일한 값입니다.\n\n")
      next
    }

    y <- shapiro.test(x)

    cat(sprintf("\t statistic : %s,  p-value : %G\n\n",
                round(y$statistic, 5),  y$p.value))
    cat("\n<br>\n")

    if (sum(x < 0, na.rm = TRUE) > 0) {
      type <- c("original", "log+a transformation", "Box-Cox transformation")

      skew <- c(skewness(x, na.rm = TRUE),
                skewness(get_transform(x, "log+a"), na.rm = TRUE),
                skewness(get_transform(x, "Box-Cox"), na.rm = TRUE))

      kurt <- c(kurtosis(x, na.rm = TRUE),
                kurtosis(get_transform(x, "log+a"), na.rm = TRUE),
                kurtosis(get_transform(x, "Box-Cox"), na.rm = TRUE))          
    } else {
      type <- c("original", "log transformation", "sqrt transformation")

      skew <- c(skewness(x, na.rm = TRUE),
                skewness(log(x), na.rm = TRUE),
                skewness(sqrt(x), na.rm = TRUE))

      kurt <- c(kurtosis(x, na.rm = TRUE),
                kurtosis(log(x), na.rm = TRUE),
                kurtosis(sqrt(x), na.rm = TRUE))      
    }

    stats <- data.frame(type = type, skewness = skew, kurtosis = kurt)

    cap <- "skewness and kurtosis"
    knitr::kable(stats, caption = cap, format = "html") %>% 
      kable_styling(full_width = FALSE, font_size = 15, position = "left") %>% 
      cat()

    cat("\n<br>\n")

    x <- data.frame(x)

    if (sum(x < 0, na.rm = TRUE) > 0) {
      plot_normality(x, x, left = "log+a", right = "Box-Cox")
    } else {
      if (any(x == 0, na.rm = TRUE)) 
        plot_normality(x, x, left = "log+1", right = "sqrt")
      else
        plot_normality(x, x)
    }

    cat("\n<hr>\n<br>\n")
  }
}  

변수들간의 관계

상관계수

변수조합별 상관계수

if (length(idx.numeric) > 2) {
  eps <- 0.5

  cors <- edaData %>%
    correlate %>%
    filter(abs(coef_corr) >= eps) %>%
    filter(as.integer(var1) > as.integer(var2)) %>%
    arrange(desc(abs(coef_corr)))

  if (NROW(cors) > 0) {
    names(cors) <- c("기준변수", "대응변수", "상관계수")

    cap <- "변수별 상관계수 목록 (0.5 이상)"
    knitr::kable(cors, caption = cap, format = "html") %>% 
      kable_styling(full_width = FALSE, font_size = 15, position = "left")
  } else {
    cat("상관계수의 절대치가 0.5 이상인 수치형 변수의 조합이 없습니다.\n\n")
  }
} else {
  cat("수치형 변수의 개수가 2보다 적습니다.\n\n")
}

변수조합별 상관계수 시각화

if (length(idx.numeric) > 2) {
  edaData %>%
    correlate() %>% 
    plot()
} else {
  cat("수치형 변수의 개수가 2보다 적습니다.\n\n")
}  

목적변수 기반의 분석

목적변수 그룹별 기술통계

목적변수 대응 수치형 변수

if (!is.null(targetVariable)) {
  target_by_obj <- target_by(edaData, all_of(targetVariable))
}  

if (!is.null(targetVariable)) {
  if (factor_flag) {
    if (length(idx.numeric) == 0) {
      cat("수치형 변수가 없습니다.\n\n")
    } else {
      for (i in idx.numeric) {
        cat("<b><font size='3' face='verdana'>[", names(edaData)[i], "]</font></b>", "\n")

        z <- dist_numeric(edaData, targetVariable, names(edaData)[i])

        ncols <- NCOL(z)
        rcnt <- round(ncols / 3)

        cap <- names(edaData)[i]
        cap <- sprintf("%s의 분포", cap)

        cat(sprintf("<br><br>\n * %s", cap))

        knitr::kable(z, digits = 2, caption = cap, format = "html",
                     format.args = list(big.mark = ",")) %>% 
          kable_styling(full_width = FALSE, font_size = 15, position = "left") %>% 
          cat()

        cat("<br>")

        cat("<br>\n * 분포의 시각화<br>\n")

        plot_outlier(target_by_obj, names(edaData)[i])

        cat("<br><br>\n<hr>")
      }
    }  
  } else if (numeric_flag) {
    if (length(idx.numeric) == 0) {
        cat("단순 선형모형 정보\n\n")
    } else {
      targetby <- target_by(edaData, targetVariable)
      for (i in idx.numeric) {
        cat("<b><font size='3' face='verdana'>[", names(edaData)[i], 
            "]</font></b>", "\n")

        num_num <- relate(targetby, names(edaData)[i])

        tab <- summary(num_num)$coefficients
        rsq <- summary(num_num)$r.squared
        adj <- summary(num_num)$adj.r.squared
        fstat <- summary(num_num)$fstatistic
        df <- summary(num_num)$df
        rse <- summary(num_num)$sigma

        cat("\n단순 선형모형 정보\n\n")
        cat(sprintf("\t Residual standard error: %s on %s degrees of freedom\n",
                round(rse),  df[2]))
        cat(sprintf("\t Multiple R-squared:  %s,    Adjusted R-squared:  %s\n",
                round(rsq, 5), round(adj, 5)))        
        cat(sprintf("\t F-statistic: %s on %s and %s DF,  p-value: %s\n",
                round(fstat["value"]),  fstat["numdf"], fstat["dendf"],
                tab[2, 4]))    
        cat("\n<br>")

        cat("Coefficients:\n")
        cap <- sprintf("단순 선형모형의 계수 : %s", names(edaData)[i])
        cap <- paste(unlist(strsplit(cap, "_")), collapse = "\\\\_")

        knitr::kable(tab, digits = 2, caption = cap, format = "html") %>% 
          kable_styling(full_width = FALSE, font_size = 15, position = "left") %>% 
          cat()

        cat("\n<br>시각화 - 산점도:\n")
        cat("\n<br>\n")

        plot(num_num)

        cat("\n<hr>\n<br>\n")
      }
    }  
  }
} else {
  cat("목적변수를 지정하지 않았습니다.\n\n")
}

목적변수 대응 범주형 변수

if (!is.null(targetVariable)) {
  if (factor_flag) {
    if (length(idx.factor) == 0) {
      cat("There is no categorical variable.\n\n")
    } else {
      for (i in idx.factor) {
        if (sum(!is.na(edaData[, i])) == 0) next

        cat("\n")
        cat("<b><font size='3' face='verdana'>[", names(edaData)[i], "]</font></b>", "\n")

        cat("<br><br>\n * 도수분포표(Frequency Table)")

        tab <- edaData %>%
          target_by(targetVariable) %>%
          relate(names(edaData)[i]) %>%
          t()

        freq <- addmargins(tab)
        idx.na <- which(is.na(rownames(freq)))
        rownames(freq)[idx.na] <- "NA"

        ncols <- NCOL(freq) - 1
        rcnt <- round(ncols / 3)

        ratio <- sweep(freq, 2, c(apply(tab, 2, sum), sum(tab)), "/") * 100
        idx.na <- which(is.na(rownames(ratio)))
        rownames(ratio)[idx.na] <- "NA"

        cap <- sprintf("%s : frequency", names(edaData)[i])
        cap <- paste(unlist(strsplit(cap, "_")), collapse = "\\\\_")

        knitr::kable(freq, digits = 2, caption = cap, format = "html",
                     format.args = list(big.mark = ",")) %>% 
          kable_styling(full_width = FALSE, font_size = 15, position = "left") %>% 
          column_spec(NCOL(freq) + 1, bold = TRUE) %>%
          row_spec(NROW(freq), bold = TRUE, color = "white", background = "#FFA349") %>% 
          cat()

        cat("<br>\n")

        if (ncols > 2) {
          cat("\n")
        }

        cat("<br>\n * 상대 도수분포표(Relative Frequency Table (%))")
        cap <- sprintf("%s : ratio", names(edaData)[i])
        cap <- paste(unlist(strsplit(cap, "_")), collapse = "\\_")

        knitr::kable(ratio, digits = 2, caption = cap, format = "html") %>% 
          kable_styling(full_width = FALSE, font_size = 15, position = "left") %>% 
          column_spec(NCOL(ratio) + 1, bold = TRUE) %>%
          row_spec(NROW(ratio), bold = TRUE, color = "white", background = "#FFA349") %>% 
          cat()

        cat("<br>\n")

        cat("<br>\n * 도수의 시각화<br>\n")

        mosaics <- relate(target_by_obj, names(edaData)[i])
        print(plot(mosaics))

        cat("<br><br>\n<hr>")
      }
    }  
  } else if (numeric_flag) {
    if (length(idx.factor) == 0) {
        cat("범주형 변수가 없습니다.\n\n")
    } else {
      targetby <- target_by(edaData, targetVariable)
      for (i in idx.factor) {
        cat("<b><font size='3' face='verdana'>[", names(edaData)[i], 
            "]</font></b>", "\n<br>\n")

        num_cat <- relate(targetby, names(edaData)[i])

        tab_aov <- data.frame(anova(num_cat))

        cat("<br>\n1. 분산분석(ANOVA)\n\n")

        cap <- sprintf("분산분석표 : %s", names(edaData)[i])
        cap <- paste(unlist(strsplit(cap, "_")), collapse = "\\\\_")

        knitr::kable(tab_aov, digits = 2, caption = cap, format = "html") %>% 
          kable_styling(full_width = FALSE, font_size = 15, position = "left") %>% 
          cat()

        cat("\n<br>")

        tab <- summary(num_cat)$coefficients
        rsq <- summary(num_cat)$r.squared
        adj <- summary(num_cat)$adj.r.squared
        fstat <- summary(num_cat)$fstatistic
        df <- summary(num_cat)$df
        rse <- summary(num_cat)$sigma

        cat("\n2. 단순 선형모형 정보\n\n")
        cat(sprintf("\t Residual standard error: %s on %s degrees of freedom\n",
                round(rse),  df[2]))
        cat(sprintf("\t Multiple R-squared:  %s,    Adjusted R-squared:  %s\n",
                round(rsq, 5), round(adj, 5)))        
        cat(sprintf("\t F-statistic: %s on %s and %s DF,  p-value: %s\n",
                round(fstat["value"]),  fstat["numdf"], fstat["dendf"],
                tab[2, 4]))    
        cat("\n<br>")

        cat("Coefficients:\n")
        cap <- sprintf("단순 선형모형 계수 : %s", names(edaData)[i])
        cap <- paste(unlist(strsplit(cap, "_")), collapse = "\\\\_")

        knitr::kable(tab, digits = 2, caption = cap, format = "html") %>% 
          kable_styling(full_width = FALSE, font_size = 15, position = "left") %>% 
          cat()

        cat("\n<br>3. 시각화:\n")
        cat("\n<br>\n")

        print(plot(num_cat))

        cat("\n<hr>\n<br>\n")
      }
    }  
  }
} else {
  cat("목적변수를 지정하지 않았습니다.\n\n")
} 

목적변수 그룹별 변수들간의 관계

목적변수 대응 상관계수

if (!is.null(targetVariable)) {
  if (factor_flag) {
    if (length(idx.numeric) > 2) {
      eps <- 0.5

      idx <- which(names(edaData) %in% targetVariable)
      names(edaData)[idx] <- "targetVariable"

      cors <- edaData %>%
        group_by(targetVariable) %>%
        correlate %>%
        filter(abs(coef_corr) >= eps) %>%
        filter(as.integer(var1) > as.integer(var2)) %>%
        arrange(targetVariable, desc(abs(coef_corr)))

      if (NROW(cors) > 0) {
        names(cors) <- c(targetVariable, "기준변수", "대응변수", "상관계수")

        cap <- "변수별 상관계수 목록 (0.5 이상)"
        knitr::kable(cors, caption = cap, format = "html") %>% 
          kable_styling(full_width = FALSE, font_size = 15, position = "left")
      } else {
        cat("N상관계수의 절대치가 0.5 이상인 수치형 변수의 조합이 없습니다.\n\n")
      }
    } else {
      cat("수치형 변수의 개수가 2보다 적습니다.\n\n")
    }
  } else if (numeric_flag) {
    cat("목적변수가 수치형 변수인 경우에는 지원하지 않습니다.\n\n")
  }  
} else {
  cat("목적변수를 지정하지 않았습니다.\n\n")
}  

목적변수 대응 상관계수 시각화

if (!is.null(targetVariable)) {
  if (factor_flag) {
    if (length(idx.numeric) > 2) {
      level_name <- levels(edaData$targetVariable)

      for (nm in level_name) {
        cat(sprintf("- 목적변수의 조건 (%s == %s)\n", targetVariable, nm))

        edaData %>%
          filter(targetVariable %in% nm) %>% 
          correlate() %>% 
          plot()
      }
    } else {
      cat("수치형 변수의 개수가 2보다 적습니다.\n\n")
    }
  } else if (numeric_flag) {
    cat("목적변수가 수치형 변수인 경우에는 지원하지 않습니다.\n\n")
  } 
} else {
  cat("목적변수를 지정하지 않았습니다.\n\n")
}  

choonghyunryu/dlookr documentation built on June 11, 2024, 9:12 a.m.