R/table_options.r

In sooyongl/ESS:

#' @include import.r
NULL

dt_table_out_indi <- function(tab1_indi_res, table_options){
  # tab1_indi_res <- tab1$indi_table
  maxRow <- tab1_indi_res %>% count(GCA) %>% pull(2) %>% .[1]
  grades <- tab1_indi_res %>% pull(1) %>% unique()
  colors <- c('#DAF7A6',"#A6B1F7","#A6F7C3","#A6DAF7","#FFC300")

  tab1_indi_res$Correlation <- round(tab1_indi_res$Correlation,2)

  level_name <- names(tab1_indi_res)[str_detect(names(tab1_indi_res), "_p")]
  level_name <-
    str_split(level_name, "_p") %>%
    map(., ~ .x[[1]]) %>%
    unlist() %>%
    str_replace(., "L", "Level")
  num_level <- length(level_name)

  levels <-
    foreach(pi = 1:num_level, .combine = 'c') %do% {
      glue::glue("th(colspan = 2, '{level_name[pi]}'),")

    } %>% paste(., collapse = "\n")
  con_dt <- glue::glue(
    "container_dt = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'GCA'),
      th(rowspan = 2, 'Table'),
      th(rowspan = 2, 'Panelist'),
      th(rowspan = 2, 'Correlation'),

      th(colspan = {num_level}, 'Pages'),

      {levels}

      th(colspan = 2, 'SUM'),

    tr(
      lapply(c(level_name,rep(c('Count','Weight'), (num_level+1))), th)
      )

      )
    )
  )
)"
  )

  DT::datatable(tab1_indi_res,
                container = eval(parse(text = con_dt)),
                class = 'table-bordered stripe table-condensed',
                # filter = 'top',
                rownames = F,
                extensions =
                  c('RowGroup'),
                options = match.fun(table_options)(maxRow)


  ) %>%
    formatStyle(1,
                backgroundColor = styleEqual(grades,
                                             colors[1:length(grades)]
                )
    )

}
#
dt_table_out_mode <- function(tab1_indi_res, table_options){

  maxRow <- nrow(tab1_indi_res)
  grades <- tab1_indi_res %>% pull(1) %>% unique()
  colors <- c('#DAF7A6',"#A6B1F7","#A6F7C3","#A6DAF7","#FFC300")

  tab1_indi_res$Correlation <- round(tab1_indi_res$Correlation,2)

  level_name <- names(tab1_indi_res)[str_detect(names(tab1_indi_res), "_p")]
  level_name <-
    str_split(level_name, "_p") %>%
    map(., ~ .x[[1]]) %>%
    unlist() %>%
    str_replace(., "L", "Level")
  num_level <- length(level_name)

  levels <-
    foreach(pi = 1:num_level, .combine = 'c') %do% {
      glue::glue("th(colspan = 2, '{level_name[pi]}'),")

    } %>% paste(., collapse = "\n")
  con_dt <- glue::glue(
    "container_dt = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'GCA'),
      th(rowspan = 2, 'Table'),
      th(rowspan = 2, 'Correlation'),

      th(colspan = {num_level}, 'Pages'),

      {levels}

      th(colspan = 2, 'SUM'),

    tr(
      lapply(c(level_name,rep(c('Count','Weight'), (num_level+1))), th)
      )

      )
    )
  )
)"
  )

  DT::datatable(tab1_indi_res,
                container = eval(parse(text = con_dt)),
                class = 'table-bordered stripe table-condensed',
                # filter = 'top',
                rownames = F,
                extensions =
                  c('RowGroup'),
                options = match.fun(table_options)(maxRow)

  ) %>%
    formatStyle(1,
                backgroundColor = styleEqual(grades,
                                             colors[1:length(grades)]
                )
    )
}
#
dt_table_out_med <- function(tab1_indi_res, table_options){

  maxRow <- nrow(tab1_indi_res)
  grades <- tab1_indi_res %>% pull(1) %>% unique()
  colors <- c('#DAF7A6',"#A6B1F7","#A6F7C3","#A6DAF7","#FFC300")

  level_name <- names(tab1_indi_res)[str_detect(names(tab1_indi_res), "_p")]
  level_name <-
    str_split(level_name, "_p") %>%
    map(., ~ .x[[1]]) %>%
    unlist() %>%
    str_replace(., "L", "Level")
  num_level <- length(level_name)

  levels <-
    foreach(pi = 1:num_level, .combine = 'c') %do% {
      glue::glue("th(colspan = 2, '{level_name[pi]}'),")

    } %>% paste(., collapse = "\n")
  con_dt <- glue::glue(
    "container_dt = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'GCA'),
      th(rowspan = 2, 'Table'),

      th(colspan = {num_level}, 'Pages'),


    tr(
      lapply(c(level_name), th)
      )

      )
    )
  )
)"
  )

  DT::datatable(tab1_indi_res,
                container = eval(parse(text = con_dt)),
                class = 'table-bordered stripe table-condensed',
                # filter = 'top',
                rownames = F,
                extensions =
                  c('RowGroup'),
                options = match.fun(table_options)(maxRow)

  ) %>%
    formatStyle(1,
                backgroundColor = styleEqual(grades,
                                             colors[1:length(grades)]
                )
    )
}

# options -------------------------------------------
table_options_new_1 <- function(maxRow){
  list(
    dom = 'Bftrip',
    pageLength = maxRow,
    scrollX = T,
    scroller = TRUE,
    fixedHeader = TRUE,
    autoWidth = F,
    rowGroup = list(dataSrc = c(1)),
    initComplete = JS(
      "function(settings, json) {",
      "$(this.api().table().header()).css({'background-color': '##DEF7F9', 'color': '#000', 'font-weight': 'bold', 'text-align': 'center'});",
      "}"
    ),
    columnDefs = list(
      list(
        className = 'dt-center', targets = "_all"
      )
    )
  )
}
#
table_options_new_2 <- function(maxRow){
  list(
    dom = 't',
    pageLength = maxRow,
    scrollX = T,
    scroller = TRUE,
    fixedHeader = TRUE,
    autoWidth = F,
    initComplete = JS(
      "function(settings, json) {",
      "$(this.api().table().header()).css({'background-color': '##DEF7F9', 'color': '#000', 'font-weight': 'bold', 'text-align': 'center'});",
      "}"
    ),
    columnDefs = list(
      list(
        className = 'dt-center', targets = "_all"
      )
    )
  )
}