I have the following R-Shiny Module which tries to take the excel file path, sheet name and data range upon click of a button.
The excel will always contain "Date" as the first column.
I then read the inputs using read_excel() to form a dataframe and then try to convert the data frame into an XTS object by extracting the first column of the dataframe as the datevector. (in lines 117 to 123).
This is part of the relevant code
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.
However, i am facing a strange trouble. I am able to return the "dataframe object" correctly BUT unable to return the "XTS" object.
The same code to convert dataframe into XTS works outside of the shiny environment, but within the shiny environment, I am getting an error which says
Warning: Error in array: length of 'dimnames' [1] not equal to array extent
if I replace the line 123 with return(temp.df) instead of return(temp.xts), this works fine.
Please help!!
Full code
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()
