ESS:

# Required Packages
library(shiny);
library(shinythemes);
library(shinyWidgets);
library(tidyverse);
library(glue);
library(foreach);
library(stringi);
library(DT);
library(knitr);
library(kableExtra);
library(readxl);
library(officer);
library(flextable);
library(shinycssloaders);
library(waiter)
library(ESS)
##################################################################

select <- dplyr::select

# options
# options(pillar.sigfig = 10)

# if(Sys.getenv('SHINY_PORT') != "") options(shiny.maxRequestSize=10000*1024^2)
#
tabStyle <- "color: #fff; background-color: #337ab7; border-color: #2e6da4"

pull_unique <- function(inpData, colNum) {
  inpData %>% pull(colNum) %>% unique()
}


#------------------------------------------------------------------
# Word Report
#------------------------------------------------------------------
# Specify 'Class'
classAppend <- function(x, classname){
  class(x) <- append(class(x), classname)
  return(x)
}
# Generic for Word Tables
mytable <- function(table_inp, ...){

  UseMethod("mytable", table_inp)
}
#
mytable.inpdata <- function(x, caption = "Table: Example") {

  flextable(x) %>%
    set_caption(
      caption = caption) %>%
    font(fontname = "Times", part = "all") %>%
    fontsize(size = 12, part = "header") %>%
    fontsize(size = 12, part = "body") %>%
    border(.,
           border.top = fp_border(color = "black", width = 1.25),
           border.bottom = fp_border(color = "black", width = .75),
           part = "header"# partname of the table (all body header footer)
           ) %>%
    border_inner_h(.,
                   border = fp_border(color="transparent", width = 1)) %>%
    hline_bottom(.,
                 part="body",
                 border = fp_border(color="black", width = 1.25) ) %>%

    bold(i = c(1), part = 'header') %>%
    align(., align = 'center', part = "body") %>%
    align(align = "center", part = "header") %>%
    set_table_properties(width = .9, layout = "autofit")

}
#
mytable.ESSresult1 <- function(table_inp, caption = "Table. Example") {

  # table_inp <- modal_table
  table_inp$Cors <- round(table_inp$Cors, 3)

  line_n <- table_inp %>% count(GCA) %>% pull(n) %>% cumsum()
  col_names <- names(table_inp)
  cors_p = which(col_names=="Cors")
  non_multi = 1:which(col_names=="Cors")
  pages = which(str_detect(col_names, "_p"))

  level_names_0 <- col_names[-c(non_multi, pages)]
  num_set <- length(level_names_0)/2

  count_weight <- c()
    for(i in 1:num_set-1){
    count_weight[i] <- pages[length(pages)] + 2*(i)
    }

  level_names_each <- rep(paste("Level", 2:(num_set)), each = 2)
  level_names_sum <-  rep("SUM", each = 2)

  # Header 1
  header1 <- c()
  header1[non_multi] <- " "
  header1[pages] <- "Pages"
  header1[(pages[length(pages)]+1):(length(col_names)-2)] <- level_names_each
  header1[(length(col_names)-1):length(col_names)] <- level_names_sum
  # Header 2
  header2 <- c()
  header2[non_multi] <- col_names[non_multi]
  header2[pages] <- paste("Level", 1:length(pages))
  header2[(pages[length(pages)]+1):length(col_names)] <-
    rep(c("Ct","Wt"), (num_set))


  multiple_header <- data.frame(
    col_keys = col_names,
    header1 = header1,
    header2 = header2,
    stringsAsFactors = FALSE )

  ft_1 <- flextable( table_inp )
  ft_1 <- set_header_df(ft_1, mapping = multiple_header, key = "col_keys" )
  ft_1 <- merge_h(ft_1, part = "header")

  ft_1 %>%
  set_caption(caption = caption) %>%
    font(fontname = "Times", part = "all") %>%
    fontsize(size = 12, part = "header") %>%
    fontsize(size = 12, part = "body") %>%
    align(., align = 'center', part = "body") %>%
    align(align = "center", part = "header") %>%

    border(.,
           i = 1, # row selection
           border.top = fp_border(color = "black", width = 1.25),
           border.bottom = fp_border(color = "black", width = .75),
           part = "header"# partname of the table (all body header footer)
           ) %>%

    border(.,
           i = 2, # row selection
           border.bottom = fp_border(color = "black", width = 1.25),
           part = "header"# partname of the table (all body header footer)
           ) %>%
    border(.,

           j = c(cors_p, pages[c(length(pages))]), # column selection)
           border.right = fp_border(color = "black", width = .75),
           part = "all"# partname of the table (all body header footer)
           ) %>%

    border(.,
      j = count_weight, # column selection)
      border.right = fp_border(color = "black", width = .75),
      part = "all"# partname of the table (all body header footer)
      ) %>%

    border(.,
           i = line_n, # row selection
           border.bottom = fp_border(color = "black", width = 0.75),
           part = "body"# partname of the table (all body header footer)
           ) %>%

    hline_bottom(.,
                 part="body",
                 border = fp_border(color="black", width = 1.25) ) %>%
    bold(i = c(1,2), part = 'header') %>%

    merge_v(j = c(1,2), part = "body") %>%
    valign(j = c(1,2), valign = 'top') %>%
    set_table_properties(width = 1, layout = "autofit")
}
#
mytable.ESSresult2 <- function(table_inp, caption = "Table. Example") {
  # table_inp <- tab1$median_table
  line_n <- table_inp %>% count(GCA) %>% pull(n) %>% cumsum()

  col_names <- names(table_inp)

  non_multi = 1:which(col_names=="Table")
  pages = which(str_detect(col_names, "_p"))

  # Header 1
  header1 <- c()
  header1[non_multi] <- " "
  header1[pages] <- "Pages"

  # Header 2
  header2 <- c()
  header2[non_multi] <- col_names[non_multi]
  header2[pages] <- paste("Level", 1:length(pages))

  multiple_header <- data.frame(
    col_keys = col_names,
    header1 = header1,
    header2 = header2,
    stringsAsFactors = FALSE )

  ft_1 <- flextable( table_inp )
  ft_1 <- set_header_df(ft_1, mapping = multiple_header, key = "col_keys" )

  ft_1 <- merge_h(ft_1, part = "header")


  ft_1 %>%
  set_caption(caption = caption) %>%
    font(fontname = "Times", part = "all") %>%
    fontsize(size = 12, part = "header") %>%
    fontsize(size = 12, part = "body") %>%

    merge_v(j = c(1), part = "body") %>%
    valign(j = c(1), valign = 'top') %>%

    border(.,
           border.top = fp_border(color = "black", width = 1.25),
           part = "header"# partname of the table (all body header footer)
           ) %>%
    border(.,
           i = 2, # row selection

           border.top = fp_border(color = "black", width = .75),
           border.bottom = fp_border(color = "black", width = 1.25),
           part = "header"# partname of the table (all body header footer)
           ) %>%

    border(.,
           i = line_n, # row selection

           border.bottom = fp_border(color = "black", width = 0.75),
           part = "body"# partname of the table (all body header footer)
           ) %>%
    hline_bottom(.,
                 part="body",
                 border = fp_border(color="black", width = 1.25) ) %>%

    bold(i = c(1,2), part = 'header') %>%
    align(., align = 'center', part = "body") %>%
    align(align = "center", part = "header") %>%
    set_table_properties(width = .8, layout = "autofit")
}
#
mytable.detailESS <- function(table_inp, caption = "Table. Example") {

  # table_inp <- tab2$for_tab2_out[[1]][[1]][["t_out"]]
  table_inp$Round <- NULL
  names(table_inp)[c(2,4)] <- c("ID", "LOC")
  col_names <- names(table_inp)

  non_multi = 1:which(col_names=="ALD")
  weights = which(str_detect(col_names, "_W"))
  counts = which(col_names %in% col_names[-c(non_multi, weights, length(col_names))])
  new_order <- col_names[c(counts, weights)] %>% sort()

  class(table_inp) <- "data.frame"

  table_inp <- table_inp %>% select(non_multi, new_order, everything())
  col_names <- names(table_inp)
  #
  level_names_0 <- col_names[counts]
  num_set <- length(counts)
  #
  level_names_each <- rep(paste("Level", 2:(num_set+1)), each = 2)

  # Header 1
  header1 <- c()
  header1[non_multi] <- " "
  header1[c(counts, weights)] <- level_names_each
  header1[length(col_names)] <- " "

  # Header 2
  header2 <- c()
  header2[non_multi] <- col_names[non_multi]
  header2[c(counts, weights)] <- rep(c("Ct","W"), num_set)
  header2[length(col_names)] <- "OpLV"

  multiple_header <- data.frame(
    col_keys = col_names,
    header1 = header1,
    header2 = header2,
    stringsAsFactors = FALSE )

    weights = which(str_detect(col_names, "_W"))
  counts = which(col_names %in% col_names[-c(non_multi, weights, length(col_names))])

  ft_1 <- flextable( table_inp )
  ft_1 <- set_header_df(ft_1, mapping = multiple_header, key = "col_keys" )

  ft_1 <- merge_h(ft_1, part = "header")


  ft_1 %>%
  set_caption(caption = caption) %>%
    font(fontname = "Times", part = "all") %>%
    fontsize(size = 12, part = "header") %>%
    fontsize(size = 12, part = "body") %>%

    merge_v(j = c(1,2), part = "body") %>%
    valign(j = c(1,2), valign = 'top') %>%

    border(.,
           border.top = fp_border(color = "black", width = 1.25),
           part = "header"# partname of the table (all body header footer)
           ) %>%
    border(.,
           i = 2, # row selection
           border.top = fp_border(color = "black", width = 0.75),
           border.bottom = fp_border(color = "black", width = 1.25),
           part = "header"# partname of the table (all body header footer)
           ) %>%

    border(.,

           j = counts, # column selection)
           border.left = fp_border(color = "black", width = .75),
           part = "all"
           ) %>%
        border(.,

           j = weights[length(weights)], # column selection)
           border.right = fp_border(color = "black", width = .75),
           part = "all"
           ) %>%
    border_inner_h(.,
                   border = fp_border(color="transparent", width = 1)) %>%
    hline_bottom(.,
                 part="body",
                 border = fp_border(color="black", width = 2) ) %>%
    padding(.,
            padding = 0.5,
            part = "all") %>%

    bold(i = c(1,2), part = 'header') %>%
    align(., align = 'center', part = "body") %>%
    align(align = "center", part = "header") %>%
    set_table_properties(width = 1, layout = "autofit")
}
#
mytable.crosst <- function(table_inp, caption = "Table. Example") {

  # table_inp <- for_tab2_out[[vi]][[1]][["crosst"]]
  table_inp <-
    as.data.frame.matrix(table_inp) %>%
    mutate(".." := rownames(.),
      .before = 1) %>%
    mutate("." := "Operational Level",
      .before = 1)

  col_names <- names(table_inp)

  # Header 1
  header1 <- c()
  header1[1:2] <- " "
  header1[3:length(col_names)] <- "Aligned ALD"

  # Header 2
  header2 <- c()
  header2[1:2] <- ""
  header2[3:length(col_names)] <- col_names[-c(1:2)]

  multiple_header <- data.frame(
    col_keys = col_names,
    header1 = header1,
    header2 = header2,
    stringsAsFactors = FALSE )

  ft_1 <- flextable( table_inp )
  ft_1 <- set_header_df(ft_1, mapping = multiple_header, key = "col_keys" )
  ft_1 <- merge_h(ft_1, part = "header")


  ft_1 %>%
  set_caption(caption = caption) %>%
    font(fontname = "Times", part = "all") %>%
    fontsize(size = 12, part = "header") %>%
    fontsize(size = 12, part = "body") %>%

    merge_v(j = c(1), part = "body") %>%
    valign(j = c(1), valign = 'top') %>%

    border(.,

           border.top = fp_border(color = "black", width = 1.25),
           border.bottom = fp_border(color = "white", width = 1),
           part = "header"# partname of the table (all body header footer)
           ) %>%
    hline_bottom(.,
                 part="body",
                 border = fp_border(color="black", width = 1.25) ) %>%
    bold(
      i = c(1),

      part = 'all') %>%
    bold(

      j = c(1),
      part = 'all') %>%

    align(., align = 'center', part = "body") %>%
    align(align = "center", part = "header") %>%
    set_table_properties(width = .8, layout = "autofit")
}
#
mytable.effpage <- function(table_inp, caption = "Table. Example") {

  # table_inp <- tab3$eff_page
  # caption = "a"
  line_n <- table_inp %>% count(GCA) %>% pull(n)
  line_n <- cumsum(line_n)

  ft_1 <- flextable( table_inp )

  ft_1 %>%
  set_caption(caption = caption) %>%
    font(fontname = "Times", part = "all") %>%
    fontsize(size = 12, part = "header") %>%
    fontsize(size = 12, part = "body") %>%

    merge_v(j = c(1), part = "body") %>%
    valign(j = c(1), valign = 'top') %>%

    border(.,

           border.top = fp_border(color = "black", width = 1.25),
           border.bottom = fp_border(color = "black", width = 0.75),

           part = "header"# partname of the table (all body header footer)
           ) %>%
    border(.,
           i = line_n,
           # j = , # column selection)
           border.bottom = fp_border(color = "black", width = .75),
           part = "body"
           ) %>%

    hline_bottom(.,
                 part="body",
                 border = fp_border(color="black", width = 1.25) ) %>%

    bold(i = c(1), part = 'header') %>%
    align(., align = 'center', part = "body") %>%
    align(align = "center", part = "header") %>%
    align(j = 2, align = 'left', part = "body") %>%
    set_table_properties(width = 1, layout = "autofit")
}
#
mytable.review <- function(table_inp, caption = "Table. Example") {

  # table_inp <- tab4$for_tab4_out
  names(table_inp) <- c("GCA","ID", "OOD", "Aligned ALD",
    "Op Level", "Diff Lv", "LOC", "Diff:Loc-Cut", "Cut", "Std Weight")
  ft_1 <- flextable( table_inp )

  ft_1 %>%
  set_caption(caption = caption) %>%
    font(fontname = "Times", part = "all") %>%
    fontsize(size = 12, part = "header") %>%
    fontsize(size = 12, part = "body") %>%

    border(.,

           border.top = fp_border(color = "black", width = 1.25),
           border.bottom = fp_border(color = "black", width = .75),

           part = "header"# partname of the table (all body header footer)
           ) %>%

    border_inner_h(.,
                   border = fp_border(color="transparent", width = .75)) %>%
    hline_bottom(.,
                 part="body",
                 border = fp_border(color="black", width = 1.25) ) %>%
    bold(i = c(1), part = 'header') %>%
    align(., align = 'center', part = "body") %>%
    align(align = "center", part = "header") %>%
    set_table_properties(width = 1, layout = "autofit")
}
#
text_add <-
  function(x.doc, x.text, x.align = "left", x.fsize = 12, x.bold = F){

    body_add_fpar(
    x.doc,
    fpar(
      ftext(
        text = x.text,
        prop =
          fp_text(
            font.size = x.fsize, bold = x.bold,
            font.family = "Times")),
      fp_p = fp_par(text.align = x.align)
      )
  )
}
#
table_add <- function(x.doc, x.tb) {
  flextable::body_add_flextable(
    x.doc,
    value = x.tb,
    align = "left"
    )

  body_add_par(x.doc, " ")
}
#
plot_add <- function(x.doc, gg, p.title) {
  body_add_gg(x.doc,gg,
    width = 7, height = 5) %>%
  body_add_par(value = p.title, style = "Image Caption")

  body_add_par(x.doc, " ")
}
# Generate Word Documnet
word_out3 <-
  function(
    # filename = file_docx;reportTables = reportTables;
    #     for_tab2_out = for_tab2_out; tab3 = tab3
    filename,

    titleInp = "Embedded Standard Setting Technical Report",
    stateNM = "State Name",
    testNM = "Testing Program Name",
    admNM = "Creative Measurement Solutions LLC",
    reportTables, for_tab2_out, tab3){

  todaydate<- as.character(Sys.Date())
  fakewords = "Input Text"

  my.doc =
    tryCatch(
      read_docx(path = "www/template.docx"),
      error = function(cond) {
        read_docx()
      }
    )

  body_add_par(my.doc, " ")
  body_add_par(my.doc, " ")

  text_add(my.doc, x.text = titleInp, x.align = "center", 16, F)
  body_add_par(my.doc, " ")

  text_add(my.doc, x.text = stateNM, x.align = "center", 14, F)
  text_add(my.doc, x.text = testNM, x.align = "center", 14, F)

  body_add_par(my.doc, " ")
  body_add_par(my.doc, " ")
  body_add_par(my.doc, " ")
  body_add_par(my.doc, " ")
  body_add_par(my.doc, " ")
  body_add_par(my.doc, " ")
  body_add_par(my.doc, " ")
  body_add_par(my.doc, " ")

  text_add(my.doc, x.text = admNM, x.align = "center", 14, F)
  text_add(my.doc, x.text = todaydate, x.align = "center", 14, F)

  body_add_break(my.doc, pos = "after")

  body_add_par(my.doc, "Table of Contents", style = "Normal")
  body_add_toc(my.doc, level = 2)
  body_add_break(my.doc)

  body_add_par(my.doc, value = "Introduction", style = "heading 1")

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  body_add_par(my.doc, value = "Grades, Content Areas, and Panelists",
      style = "heading 2")

  table_add(my.doc, reportTables[["setup"]])

  table_add(my.doc, reportTables[["panel"]])

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  body_add_break(my.doc, pos = "after")

  body_add_par(my.doc, value = "Data",
      style = "heading 1")

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  body_add_break(my.doc, pos = "after")

  body_add_par(my.doc, value = "Method",
      style = "heading 1")

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  body_add_break(my.doc, pos = "after")

  body_add_par(my.doc, value = "Results",
      style = "heading 1")

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  body_add_par(my.doc, value = "ESS Individual Results",
      style = "heading 2")

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  my.doc = body_end_section_continuous(my.doc)

  table_add(my.doc, reportTables[["indi"]])

  my.doc = body_end_section_landscape(my.doc)

  body_add_par(my.doc, value = "ESS Group Modal Results",
      style = "heading 2")

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  my.doc = body_end_section_continuous(my.doc)

  table_add(my.doc, reportTables[["modal"]])

  my.doc = body_end_section_landscape(my.doc)

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  body_add_par(my.doc, value = "Cross Tabs",
      style = "heading 2")

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  cross_name <- names(reportTables)[str_detect(names(reportTables), "crosst")]
  for(cti in 1:length(cross_name)){
    # i <- 1
    table_add(my.doc,reportTables[[cross_name[cti]]])
    }

  body_add_par(my.doc, value = "ESS Group Median Results",
      style = "heading 2")

  table_add(my.doc, reportTables[["med"]])

  body_add_par(my.doc, value = "Detailed ESS Group Results",
      style = "heading 2")

  text_add(my.doc, x.text = "", x.align = "left", 12, F)

  detail_name <- names(reportTables)[str_detect(names(reportTables), "detailESS")]
  for(di in 1:length(detail_name)){
    table_add(my.doc,reportTables[[detail_name[di]]])

    plot_add(my.doc, for_tab2_out[[di]][[1]][["p1"]], paste0("Figure ",di,". "))
  }

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  body_add_par(my.doc, value = "Cut Score and Impact Data",
      style = "heading 2")

  text_add(my.doc, x.text = "", x.align = "left", 12, F)

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  table_add(my.doc, reportTables[["effpage"]])

  page_plot <- names(tab3)[str_detect(names(tab3), "^p_")]
  for(i in 1:length(page_plot)){
    plot_add(my.doc, tab3[[ page_plot[i] ]], paste0("Figure 8-",i,". "))
  }

  body_add_par(my.doc, value = "Item Review: Lists of Inconsistency Items by Grade",
      style = "heading 2")

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  table_add(my.doc, reportTables[["ireview"]])

  body_add_break(my.doc, pos = "after")

  body_add_par(my.doc, value = "Discussion and Actionable Recommendations",
      style = "heading 1")

  text_add(my.doc, x.text = fakewords, x.align = "left", 12, F)

  print(my.doc, target = filename)
  }