如何将反应性流格式化为具有多个数据输入的闪亮的健壮xlsx对象

Question

我已经完成了一个rmd脚本，该脚本可以自动执行我的工作中的定期过程。为了使其更加用户友好，我尝试将其转换为闪亮的应用程序（我对闪亮的经验很少）。最终结果是一个工作簿，其中包含列联表和原始数据。所需的3个用户输入是指定每月周期的数字和2组原始数据。由于需要进行分析，因此我必须创建几个变量（例如，两个数据集中的变量逐月变化）。我正在努力为这些变量正确设置反应流的格式，以便最终将它们发布在从该应用程序下载的最终excel工作簿中。为了保护公司数据，我发布了该脚本的简化版本，该脚本使用以下虚拟数据作为输入：

（对于当前和上个月的文件输入来说，与该特定代码的目的无关，当前月索引的输入都无关紧要）

文件1： 实体SAT ABC 45 TYPE1 ABC 34 TYPE1 ABC 23 TYPE1 DEF 12 TYPE1 防守23类型2 DEF 12 TYPE2 防守54 TYPE3 GHI 65 TYPE3 GHI 45 TYPE3

文件2： 实体SAT 防守23类型2 ABC 23类型2 ABC 34 TYPE1 ABC 45 TYPE1 防守56 TYPE2 ABC 76 TYPE1 防守54 TYPE3 GHI 23 TYPE3 GHI 34 TYPE2 GHI 34 TYPE2 ABC 76 TYPE1 ABC 34 TYPE1

总体而言，从脚本下载的实际数据甚至都不是excel工作簿。如何精确格式化反应流，以便最终用户可以实际下载正确的工作簿对象？

图书馆（tidyr） 图书馆（plyr） 图书馆（dplyr） 库（data.table） 库（openxlsx） 图书馆（readxl） 库（发光）

ui <- fluidPage(

   titlePanel("Title"),
   sidebarLayout(
      sidebarPanel(
         numericInput("Month",
                      "Current Month Index",
                      value = 1,
                      min = 1,
                      max = 12),
         fileInput(inputId = "CUR_MONTH_FILE",
                   label = "Current Month File"),
         fileInput(inputId = "PREV_MONTH_FILE",
                   label = "Previous Month File"),
         downloadButton("downloadData", "Download")),
      mainPanel(
         submitButton("Submit")
      )
    )
  )

server <- function(input, output) {
  observeEvent(input$Submit, {  
  DESIRED_MONTH_INDEX <- reactive({input$Month})
  CURR_DATA <- reactive({input$CUR_MONTH_FILE})
  PREV_DATA <- reactive({input$PREV_MONTH_FILE})

  COB <- Sys.Date()
  COB_DAY <- as.character(substr(COB, start = 9, stop =  10))
  COB_MONTH <- as.character(substr(COB, start = 6, stop = 7))
  COB_YEAR <- as.character(substr(COB, start = 1, stop = 4))
  PREV_COB_YEAR <- as.character(substr(COB, start = 1, stop = 4))
  if (COB_MONTH == "01") {
    COB_YEAR <- as.numeric(COB_YEAR) - 1
    COB_YEAR <- as.character(COB_YEAR)
    PREV_COB_YEAR <- as.numeric(PREV_COB_YEAR) - 1
    PREV_COB_YEAR <- as.character(PREV_COB_YEAR)
  }
  if (COB_MONTH == "02") {
    PREV_COB_YEAR <- as.numeric(PREV_COB_YEAR) - 1
    PREV_COB_YEAR <- as.character(PREV_COB_YEAR)
  }
  months <- c("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")

PREV_MONTH_INDEX <- reactive({DESIRED_MONTH_INDEX - 1
if (DESIRED_MONTH_INDEX == 1) {
  PREV_MONTH_INDEX = 12
}})
########
CURR_DATA_ALL <- read_xlsx(path = CURR_DATA)
PREV_DATA_ALL <- read_xlsx(path = PREV_DATA)
########
CURR_DATA_SUB <- CURR_DATA_ALL %>%
  select(names((CURR_DATA_ALL[1])), names((CURR_DATA_ALL[2])), names((CURR_DATA_ALL[3])))
PREV_DATA_SUB <- PREV_DATA_ALL %>%
  select(names((PREV_DATA_ALL[1])), names((PREV_DATA_ALL[2])), names((PREV_DATA_ALL[3])))
########
CURR_UNITS <- as.vector(unique(as.character(CURR_DATA_SUB[[1]])))
PREV_UNITS <- as.vector(unique(as.character(PREV_DATA_SUB[[1]])))
a <- setdiff(CURR_UNITS, PREV_UNITS) 
CURR_UNITS_TEST <- identical(a, character(0))
b <- setdiff(PREV_UNITS, CURR_UNITS) 
PREV_UNITS_TEST <- identical(b, character(0))
entity_added <- setdiff(CURR_UNITS, PREV_UNITS)
entity_removed <- setdiff(PREV_UNITS, CURR_UNITS)
entity_check <- if(CURR_UNITS_TEST == TRUE & PREV_UNITS_TEST == TRUE) {
  print(paste("No entities were added or removed for the month of", months[DESIRED_MONTH_INDEX]))
} else if(CURR_UNITS_TEST == FALSE & PREV_UNITS_TEST == FALSE) {
  print(paste("The entity (or entities)", entity_added, "was added and", entity_removed, "was removed", "for the month of", months[DESIRED_MONTH_INDEX]))
} else if(length(CURR_UNITS) - length(PREV_UNITS) >= 1) {
  print(paste("The entity (or entities)", entity_added, "was added for the month of", months[DESIRED_MONTH_INDEX]))
} else if(length(CURR_UNITS) - length(PREV_UNITS) < 1) {
  print(paste("The entity (or entities)", entity_removed, "was removed for the month of", months[DESIRED_MONTH_INDEX]))
}
########
CURR_SAT <- as.vector(unique(as.character(CURR_DATA_SUB[[3]])))
PREV_SAT <- as.vector(unique(as.character(PREV_DATA_SUB[[3]])))
c <- setdiff(CURR_SAT, PREV_SAT) 
CURR_SAT_TEST <- identical(c, character(0))
d <- setdiff(PREV_SAT, CURR_SAT) 
PREV_SAT_TEST <- identical(d, character(0))
sat_added <- setdiff(CURR_SAT, PREV_SAT)
sat_removed <- setdiff(PREV_SAT, CURR_SAT)
SAT_Check <- if(CURR_SAT_TEST == TRUE & PREV_SAT_TEST == TRUE) {
  print(paste("No SAT accounts were added or removed for the month of", months[DESIRED_MONTH_INDEX]))
} else if(CURR_SAT_TEST == FALSE & PREV_SAT_TEST == FALSE) {
  print(paste("The SAT account (or accounts)", sat_added, "was added and", sat_removed, "was removed", "for the month of", months[DESIRED_MONTH_INDEX])) 
} else if(length(CURR_SAT) - length(PREV_SAT) >= 1) {
  print(paste("The SAT account (or accounts)", sat_added, "was added for the month of", months[DESIRED_MONTH_INDEX]))
}  else if(length(CURR_SAT) - length(PREV_SAT) < 1) {
  print(paste("The SAT account (or accounts)", sat_removed, "was removed for the month of", months[DESIRED_MONTH_INDEX]))
} 
########
CONTING_CURR <- table(CURR_DATA_SUB[,c(3, 1)])
CONTING_PREV <- table(PREV_DATA_SUB[,c(3, 1)])
CONTING_CURR_DF <- as.data.frame.matrix(CONTING_CURR)
CONTING_PREV_DF <- as.data.frame.matrix(CONTING_PREV)
COL_TOTALS_CURR <- CONTING_CURR_DF %>%
  summarise_each(funs(sum))
COL_TOTALS_PREV <- CONTING_PREV_DF %>%
  summarise_each(funs(sum))
CONTING_CURR_DF["COL GRAND TOTALs",] <- COL_TOTALS_CURR
CONTING_PREV_DF["COL GRAND TOTALs",] <- COL_TOTALS_PREV
CONTING_CURR_DF[,"ROW GRAND TOTALS"] <- rowSums(CONTING_CURR_DF)
CONTING_PREV_DF[,"ROW GRAND TOTALS"] <- rowSums(CONTING_PREV_DF)
########
CURR_DF_CALC <- CONTING_CURR_DF
PREV_DF_CALC <- CONTING_PREV_DF
if(CURR_SAT_TEST != TRUE) {
  PREV_DF_CALC[sat_added,] <- CURR_DF_CALC[sat_added,] * 0
}
if(PREV_SAT_TEST != TRUE) {
  CURR_DF_CALC[sat_removed,] <- PREV_DF_CALC[sat_removed,] * 0
}
if(CURR_UNITS_TEST != TRUE) {
  PREV_DF_CALC[,entity_added] <- CURR_DF_CALC[,entity_added] * 0
}
if(PREV_BUS_UNITS_TEST != TRUE) {
  CURR_DF_CALC[,entity_removed] <- PREV_DF_CALC[,entity_removed] * 0
}
MoM_CHANGE_DF <- CURR_DF_CALC[order(rownames(CURR_DF_CALC)),order(colnames(CURR_DF_CALC))] - PREV_DF_CALC[order(rownames(PREV_DF_CALC)),order(colnames(PREV_DF_CALC))]
MoM_COL_TOTALS <- MoM_CHANGE_DF %>%
  summarise_all(funs(sum))
MoM_CHANGE_DF["COL GRAND TOTALs",] <- MoM_COL_TOTALS
MoM_CHANGE_DF[,"ROW GRAND TOTALS"] <- rowSums(MoM_CHANGE_DF)
########
names(CURR_DATA_ALL[,2]) <- "AMOUNT"
bt <- CURR_DATA_ALL %>% 
  group_by(SAT) %>%
  summarise(BASE = sum(`AMOUNT`))
bt_amounts <- bt %>%
  select(BASE)
bt_sums <- colSums(bt_amounts)
bt[nrow(bt)+1,] <- c("Totals", bt_sums[[1]])
bt_final <- as.data.frame(bt)
bt_final$BASE <- as.numeric(bt_final$BASE)
})
########
  output$downloadData <- downloadHandler(
    filename = "pivot_file",
    content = function(file) {
      wkb <- openxlsx::createWorkbook()
      addWorksheet(wkb, "CURRENT")
      addWorksheet(wkb, "PREVIOUS")
      reactive({addWorksheet(wkb, months[DESIRED_MONTH_INDEX])})
      reactive({addWorksheet(wkb, months[PREV_MONTH_INDEX])})
      addWorksheet(wkb, "Summary")

      reactive({writeData(wkb, sheet = "Summary", SAT_Check, startCol = 1, startRow = 1, colNames = FALSE, rowNames = FALSE)})
      reactive({writeData(wkb, sheet = "Summary", entity_check, startCol = 1, startRow = 2, colNames = FALSE, rowNames = FALSE)})

      CD <- reactive({CURR_DATA_ALL})
      reactive({writeData(wkb, sheet = months[DESIRED_MONTH_INDEX], CD, startCol = 1, startRow = 1, colNames = TRUE, rowNames = FALSE)})
      PD <- reactive({PREV_DATA_ALL})
      reactive({writeData(wkb, sheet = months[PREV_MONTH_INDEX], PD, startCol = 1, startRow = 1, colNames = TRUE, rowNames = FALSE)})

      reactive({writeData(wkb, sheet = "CURRENT", CONTING_CURR, startCol = 1, startRow = 1)})
      reactive({writeData(wkb, sheet = "PREVIOUS", CONTING_PREV, startCol = 1, startRow = 1)})
      saveWorkbook(wkb, file)
    })
  }

shinyApp(ui = ui, server = server)