In bit2r/BitStat: Statistical Analytics using R and Shiny

library(flextable)
library(dplyr)
library(dlookr)

id_dataset <- "$id_dataset$"
variables <- "$variables$"
method <- "$method$"
digits <- $digits$
group_flag <- $group_flag$
group_variable <- "$group_variable$"
plot_flag <- $plot_flag$  

htmltools::h3(
  BitStat::translate("상관행렬")
)

.data <- get("list_datasets", envir = .BitStatEnv) %>% 
  "[["(id_dataset) %>% 
  "[["("dataset")

if (variables != "") {
  variables <- variables %>% 
  # stringr::str_replace_all("^|$", "`") %>% 
  # stringr::str_replace_all(",", "`,`") %>% 
  strsplit(",") %>% 
  unlist() 
}

lab_method <- case_when(
  method %in% "pearson" ~ translate("피어슨의 적률 상관계수"),
  method %in% "kendall" ~ translate("켄달의 순위 상관계수"),
  method %in% "spearman" ~ translate("스피어만의 순위 상관계수")
)

if (!group_flag) {
  if (variables != "") {  
    corr <- .data %>% 
      select(all_of(variables)) %>% 
      dlookr::correlate(method = method)     
  } else {
    corr <- .data %>% 
      dlookr::correlate(method = method)     
  }  

  corr %>% 
    tidyr::spread(var1, coef_corr, fill = 1) %>% 
    rename("variables" = var2) %>% 
    flextable::flextable() %>%
    flextable::colformat_double(digits = digits) %>% 
    flextable::set_caption(caption = glue::glue("{translate('상관행렬')} ({lab_method})")) %>% 
    flextable::theme_booktabs() %>% 
    flextable::flextable_to_rmd()
} else {
  group_variable <- group_variable %>% 
  strsplit(",") %>% 
  unlist()

  if (variables != "") {  
    corr <- .data %>% 
      select(all_of(c(variables, group_variable))) %>% 
      group_by(across(all_of(group_variable))) %>% 
      dlookr::correlate(method = method)    
  } else {
    corr <- .data %>% 
      group_by(across(all_of(group_variable))) %>% 
      dlookr::correlate(method = method)      
  }  

  mat_group <- corr %>% 
    tidyr::spread(var1, coef_corr, fill = 1) %>% 
    rename("variables" = var2) 

  cases <- mat_group %>% 
    select(all_of(group_variable)) %>% 
    unique()

  cases %>% 
    NROW() %>% 
    seq() %>% 
    purrr::walk(
      function(x) {
        condition <- cases[x, ] %>% unlist() 
        labs <- paste(names(condition), condition, sep = "=", collapse = ", ")

        cases[x, ] %>% 
          inner_join(
            mat_group,
            by = cases %>% names()
          ) %>% 
          select(-all_of(group_variable)) %>%
          flextable::flextable() %>%
          flextable::colformat_double(digits = digits) %>% 
          flextable::set_caption(caption = glue::glue("{translate('상관행렬')} ({labs} : {lab_method})")) %>% 
          flextable::theme_booktabs() %>% 
          flextable::flextable_to_rmd()
        }
    )
}

if (plot_flag) {
  htmltools::h3(
    BitStat::translate("상관행렬 플롯")
  )
}

if (plot_flag) {
  plot(corr, base_family = 'NanumSquare')
}

bit2r/BitStat documentation built on Nov. 8, 2022, 4:17 p.m.