如何构建可打开 excel 和工作表的 Shiny 应用程序?

How to build a Shiny app that opens excel and worksheet?

我正在尝试构建一个允许用户上传 excel 文件、选择工作表和一些数据(即列)并制作图表的应用程序。

我准备了一个虚拟应用程序来展示我的问题。我有两个...

  1. 工作表名称输入的更新无效。虽然输入字段由 updateSelectInput 更新,但它总是重写为默认值(我认为存在嵌套问题,但我尝试解决它超过两天,但没有任何运气......)
  2. 我不知道如何设置工作表的输入以后可以接收任何名称,现在它总是跳回到第一个WS(如果我设置choices = c('')choices = 1 它给出了一个错误,没有这样的 WS)
library(shiny)
library(xlsx)
library(readxl)

#++++++++++++++++++++++++
# create dummy excel

first  <-  data.frame(ID_1 = 1:5, a1 = letters[1:5], a2 = sample(1:10, 5))
second  <- data.frame(ID_1 = 1:10, b1 = letters[6:15], b2 = sample(1:30, 10),b3 = sample(1:30, 10))
third  <-  data.frame(ID_1 = 1:8, b1 = letters[6:13], b2 = sample(5:30, 8), b3 = sample(5:30, 8))
                      
write.xlsx(first, file = "dummy.xlsx", sheetName = "first", row.names = FALSE, append = FALSE)
write.xlsx(second, file = "dummy.xlsx", sheetName = "second", row.names = FALSE, append = TRUE)
write.xlsx(third, file = "dummy.xlsx", sheetName = "third", row.names = FALSE, append = TRUE)

#++++++++++++++++++++++++
not_sel="not selected"

ui <- fluidPage(

   sidebarLayout(
    sidebarPanel(
      fileInput("xls_input","choose file",accept=c(".xlsx")),  
      selectInput("ws_var", "choose WS", choices = c("second")), 
      selectInput("data_var","choose cloumn", c(not_sel)),
    actionButton("run_button","cacluate",icon=icon("play")),
    ),
    mainPanel(
      textOutput("calc")
    )
  )
)  

server <- function(input, output){
  
  xdata <- reactive({
    req(input$xls_input)
    infile<-input$xls_input
    observeEvent(input$ws_var,{
      choices_ws <- excel_sheets(path = infile$datapath)
      updateSelectInput(inputId = "ws_var", choices = choices_ws)
    })
    read_excel(infile$datapath,input$ws_var)
  })
   
  observeEvent(xdata(),{
      choices <- names(xdata())
      updateSelectInput(inputId = "data_var", choices = choices)
  })
     
  output$calc <- eventReactive(input$run_button,{
      xdata_<-xdata()
      xdata_var_<-input$data_var
      calc_data <- sum(xdata_[[xdata_var_]])
  })
  
}
shinyApp(ui = ui, server = server)

为了尝试解决这个问题,我添加的内容比你要求的要多,所以我希望额外的步骤对你有所帮助或有见地。我也没有 xlsx 因为我没有 java,所以我用 openxlsx 代替。

我可以发现您当前代码的一些问题。例如,您的反应式中有一个 observeEvent,它观察 ws_var 输入,旨在根据选择工作表的时间更新工作表名称。如果您改为观察 xls_input,它可能会更好。

我提供的可能更可靠一些。我使用 shinyjs 添加了 show/hide 功能,因为每一步都依赖于上一步。这意味着只有在选择了上一个步骤时才会显示下一个步骤。此外,并非表中的所有列都是数字的。对于 output$calc,它会尝试对那些对我来说有问题的字符求和。所以我添加了一个 if 语句来查看该列是否为数字(使用 dplyr

library(shiny)
# library(xlsx) #I don't have java, using xlsx instead
library(openxlsx)
library(readxl)
library(shinyjs) #Using to hide/show elements
library(dplyr) #Using to select numeric columns

#++++++++++++++++++++++++
# create dummy excel

first  <-  data.frame(ID_1 = 1:5, a1 = letters[1:5], a2 = sample(1:10, 5))
second  <- data.frame(ID_1 = 1:10, b1 = letters[6:15], b2 = sample(1:30, 10),b3 = sample(1:30, 10))
third  <-  data.frame(ID_1 = 1:8, b1 = letters[6:13], b2 = sample(5:30, 8), b3 = sample(5:30, 8))

wb<-createWorkbook()
addWorksheet(wb, "first")
addWorksheet(wb, "second")
addWorksheet(wb, "third")
writeData(wb, "first", first)
writeData(wb, "second", second)
writeData(wb, "third", third)
saveWorkbook(wb, "dummy.xlsx", overwrite = T)

#++++++++++++++++++++++++
not_sel="not selected"

ui <- fluidPage(
  useShinyjs(),
  sidebarLayout(
    sidebarPanel(
      fileInput("xls_input","choose file",accept=c(".xlsx")),  
      hidden( #Hide the later lines as they depend on the file used
        selectInput("ws_var", "choose WS", choices = not_sel), 
        selectInput("data_var","choose cloumn", c(not_sel)),
        actionButton("run_button","cacluate",icon=icon("play"))
      )
    ),
    mainPanel(
      hidden(
        textOutput("calc")
      )
    )
  )
)  

server <- function(input, output){
  
  observeEvent(input$xls_input,{ 
    infile<-input$xls_input #Gets uploaded file information
    choices_ws <- excel_sheets(path = infile$datapath) #Shows worksheets in said file
    updateSelectInput(inputId = "ws_var", choices = c(not_sel, choices_ws)) #Updates the worksheet select input with the choices
    shinyjs::show("ws_var") #Shows the worksheet select input
    shinyjs::hide("data_var") #File will adjust worksheet and column choices and further steps, hide when file chosen
    shinyjs::hide("run_button")
    shinyjs::hide("calc")
  })
  
  observeEvent(input$ws_var,{
    shinyjs::hide("run_button") #When selecting a worksheet, it will alter the column choices, and the calculation, so hide the next steps
    shinyjs::hide("calc")
    updateSelectInput(inputId = "data_var", choices = c(not_sel, names(xdata()))) #Based on the reactive data, shows worksheet choices
    if(input$ws_var == not_sel) { #If worksheet choice is the default "not selected", don't show next step, else show next step
      shinyjs::hide("data_var") #Hide the column choice if worksheet not selected
    } else {
      shinyjs::show("data_var") #Shows the column choice if worksheet selected
    }
  })
  
  xdata<-reactive({
    req(input$xls_input, input$ws_var != not_sel) #If file uploaded, and a worksheet is selected, proceed with function
    infile<-input$xls_input #Gets uploaded file information
    read_excel(infile$datapath, input$ws_var) #Reads the selected worksheet of the uploaded file
  })

  observeEvent(input$data_var,{
    shinyjs::hide("calc") #Calculation will change based on column chosen but won't occur until run_button pressed, so hide until pressed
    if(input$data_var == not_sel) { #If column choice is default "not selected", don't show calculate button, else show it
      shinyjs::hide("run_button")
    } else {
      shinyjs::show("run_button")
    }
  })

  observeEvent(input$run_button,{ #When calculate button is pressed, shows text output for calculation
    shinyjs::show("calc")
  })
  
  output$calc<-renderText({ #Calculation text output
    numeric_columns<-names(xdata()%>%select_if(is.numeric)) #Which columns in the selected worksheet are numeric
    if(input$data_var %in% numeric_columns) { #If the column is numeric, then sum the data, else say column is not numeric
      sum(xdata()[[input$data_var]])
    } else ("Column selected is not numeric")
  })
  
}
shinyApp(ui = ui, server = server)

希望这些额外的步骤对您有所帮助,祝您好运!