r - 无法使用 R Shiny 中的应用生成 XTS 对象列表

Question

我有以下 R-Shiny 模块，它尝试在单击按钮时获取 excel 文件路径、工作表名称和数据范围。

excel 将始终包含“日期”作为第一列。

然后我使用 read_excel() 读取输入以形成数据帧，然后尝试通过将数据帧的第一列提取为日期向量来将数据帧转换为 XTS 对象。（在第 117 至 123 行）。

这是相关代码的一部分

 
      XLdata.list <- apply(XLdata.matrix, MARGIN=1, function(x) {temp.tibble <- (read_excel(path =x[2], sheet =x[3], range = x[4], col_names=TRUE, trim_ws=TRUE))
                                                                 temp.df <- as.data.frame(temp.tibble) %>% filter_all(any_vars(complete.cases(.)))
                                                                 temp.dv <- temp.df[,"Date"]
                                                                 temp.matrix <- temp.df %>% dplyr::select(-c("Date"))
                                                                 temp.xts <- xts(temp.matrix, order.by = as.Date(temp.dv))
                                                                 
                                                                 return(temp.df)} ) # if i replace temp.df with temp.xts, this doesnt work. 
      

但是，我面临着一个奇怪的麻烦。我能够正确返回“数据框对象”但无法返回“XTS”对象。

将数据帧转换为 XTS 的相同代码在闪亮环境之外工作，但在闪亮环境中，我收到一条错误消息

Warning: Error in array: length of 'dimnames' [1] not equal to array extent

return(temp.df)如果我用而不是替换第 123 行return(temp.xts)，这工作正常。

请帮忙！！

完整代码

library(shiny)
library(readxl)
library(dplyr)
library(xts)


#----
#Import Excel Data Module
#On User Click, UI for Excel path, sheet and range will be generated
#This will ask for Excel File Path, Sheet Name and Data Range
#This will then convert these details into File Name based on click 
#This module will give the list of dataframes as Output.  The checkbox button is now used. 
#----



#----
#UI for import Excel Data
#----
library(shiny)

Import.Excel.Data.UI <- function(id){
  
   ns <- NS(id)
  
  tagList(
    actionButton(ns("AddExcelDataButton"), label = HTML("Click Here to Add Excel Data <br/> There should a 'Date' Column")),
    verbatimTextOutput(ns("XLlist"))
  )
  
}




Import.Excel.Data.Server <- function(id){
  moduleServer(id, function(input, output, session){
    ns <- session$ns
    observeEvent(eventExpr = input$AddExcelDataButton,
                
                 insertUI(selector=paste0("#",ns("AddExcelDataButton")),
                          multiple=TRUE,
                          where = "afterEnd",
                          
                          ui = tags$hr(
                            tags$div(fileInput(inputId = ns(paste0("ExcelFile",input$AddExcelDataButton)),
                                         label = paste0("Path for File",input$AddExcelDataButton),
                                         multiple  = FALSE),
                                     style = "display:inline-block; vertical-align:top"
                                     ),#end of tags$div
                          
                             tags$div(textInput(inputId = ns(paste0("ExcelSheetName",input$AddExcelDataButton)),
                                      label = paste0("Excel Sheet Name",input$AddExcelDataButton),
                                      value = "AllTickers"),
                                      style = "display:inline-block; vertical-align:top"
                                      ),#end of tags$div
                            
                            tags$div(textInput(inputId = ns(paste0("ExcelSheetRange",input$AddExcelDataButton)),
                                               label = paste0("Excel Sheet Range", input$AddExcelDataButton),
                                               value = "M7:AL10000"),
                                     style = "display:inline-block; vertical-align:top"
                            ),#end of tags$div
                            
                            
                            tags$div(checkboxInput(inputId = ns(paste0("ExcelFileCheck",input$AddExcelDataButton)),
                                               label = paste0("Check to Use File", input$AddExcelDataButton),
                                               value = TRUE),
                                     style = "display:inline-block;"
                            ),#end of tags$div
                            
                            tags$div(textInput(inputId = ns(paste0("ExcelDataName",input$AddExcelDataButton)),
                                                   label = paste0("Data Name", input$AddExcelDataButton,"(make sure no repeat names)"),
                                                   placeholder = "Default name is filename. make sure there is no repeat. No checks"),
                                     style = "display:inline-block; vertical-align:top"
                            )#end of tags$div
                 
                 
                            
                            
                 )#end of tags$hr  
                 
                 )#end of insertUI
    )#end of observeEvent
    
   
    
    XLdata <- reactive({
      req(input[[paste0("ExcelFile",input$AddExcelDataButton)]]) ###added as per suggestion from stackoverflow. may not be necessary. 
      for (i in 1: input$AddExcelDataButton)
      {
       temp.filename <- input[[paste0("ExcelFile",i)]]$name
       temp.filepath <- input[[paste0("ExcelFile",i)]]$datapath
       temp.sheetname <- input[[paste0("ExcelSheetName",i)]]
       temp.sheetrange <- input[[paste0("ExcelSheetRange",i)]]
       temp.filecheck <- input[[paste0("ExcelFileCheck",i)]]
       ifelse(input[[paste0("ExcelDataName",i)]]=="", temp.dataname <- input[[paste0("ExcelFile",i)]]$name, temp.dataname <-input[[paste0("ExcelDataName",i)]]  )
       row.temp <- cbind(temp.filename, temp.filepath, temp.sheetname, temp.sheetrange, temp.filecheck, temp.dataname)
        
        
        
        ifelse(i<=1,
              {
                XLdata.matrix <- row.temp
              },#end of if condition in ifelse i<=1
              {
                XLdata.matrix <- rbind(XLdata.matrix, row.temp)
              } #end of else in ifelse i<=1
              )#end of ifelse brackets
        
      }#end of for-loop
      
   
      XLdata.matrix <- as.data.frame(XLdata.matrix)
      
      
      
      XLdata.list <- apply(XLdata.matrix, MARGIN=1, function(x) {temp.tibble <- (read_excel(path =x[2], sheet =x[3], range = x[4], col_names=TRUE, trim_ws=TRUE))
                                                                 temp.df <- as.data.frame(temp.tibble) %>% filter_all(any_vars(complete.cases(.)))
                                                                 temp.dv <- temp.df[,"Date"]
                                                                 temp.matrix <- temp.df %>% dplyr::select(-c("Date"))
                                                                 temp.xts <- xts(temp.matrix, order.by = as.Date(temp.dv))
                                                                 
                                                                 return(temp.xts)} ) # removes only rows with ALL NA's including the DATE column. 
      
      names(XLdata.list) <- XLdata.matrix$temp.dataname
        
      XLdata.list
      
      
    })#end of reactive for XLdata
    
    output$XLlist <- renderPrint(glimpse(XLdata()))
    return(XLdata)  ## added based on the suggestion from stackoverflow. this is necessary.  No double brackets for XLdata() -- but why? 

  })#end of module server
}



#----BELOW CODE IS TO TEST  THE MODULE ON ITS OWN-------
Import.Excel.Data.App <- function(){
  ui <- fluidPage(
   Import.Excel.Data.UI("File1"),
   verbatimTextOutput("XLdata.list.output")




  )


  server <- function(input, output, session){
    XLdata.list <- Import.Excel.Data.Server("File1")
    output$XLdata.list.output <- renderPrint(XLdata.list())


  }

  shinyApp(ui, server)
}

Import.Excel.Data.App()

标签： rshinyxtsshiny-reactivity