我已经使用 RShiny 创建了一个界面。从那里用户可以输入一个 excel 文件，xlsx 将被处理，并在 Rshiny 上显示一个具有 5 列和超过 2000 行的数据框。显示数据框后，用户应该能够从 textInput 插入一个新列，并且当用户按下提交按钮并呈现新表时，该列的信息将在所有行上重复。如何做到这一点？
library(shiny)
library(readxl)
library(xlsx)
library(tidyxl)
library(dplyr)
library(stringr)
library(DT)
shinyApp(
ui <- fluidPage(
titlePanel("BoQ Excel"),
sidebarLayout(
sidebarPanel(
fileInput("file1" , "Choose Boq Excel File",
multiple = TRUE,
accept = c(".xlsx")),
uiOutput('buttonUI'),
tags$hr(),
radioButtons('disp', "Display",
choices = c(Head = "head",
All = "all"),
selected = "head")
),
tableOutput('tbl')
)
),
server <- function(input, output){
controlVar <- reactiveValues(fileReady = FALSE, tableReady = F)
dat <- NULL
observeEvent(input$file1,
{
controlVar$fileReady <- F
if(is.null(input$file1)){
return()
}else{
data <- tidyxl::xlsx_cells(input$file1$datapath) #
formats <- tidyxl::xlsx_formats(input$file1$datapath)
#select column row character & sheet which are bold
sheet_data <- data[
data$local_format_id %in% which(formats$local$font$bold)
& !is.na(data$character), c("row", "character", 'sheet')]
colnames(sheet_data) <- c("rowNumber", "content", 'sheetRow')
grouped_sheets <- sheet_data %>%
group_by(sheetRow, rowNumber, .add = TRUE) %>%
mutate(check = str_trim(stringr::str_to_lower(content)) %in% c("qty", "item", "description", "rate", "unit")) %>%
summarise(check = sum(check))
anchor1 <- grouped_sheets %>% filter(check == 5) %>% select(sheetRow)
z <- data.frame()
#loop with the selected sheets
for(sheet in anchor1$sheetRow){
#identify bold caracters
bold <- data[
data$local_format_id %in% which(formats$local$font$bold)
& !is.na(data$character)
& data$sheet == sheet, c("row", "character")
]
#View(bold)
#rename colnames
colnames(bold) <- c("rownumber", "content")
grouped_rows <- bold %>%
group_by(rownumber) %>%
mutate(check = str_trim(stringr::str_to_lower(content)) %in% c("qty", "item", "description", "rate", "unit")) %>%
summarise(check = sum(check))
anchor <- grouped_rows %>% filter(check >= 4) %>% select(rownumber)
#View(anchor)
#as.integer(anchor['rownumber'])
bold_rows <- grouped_rows %>%
select(rownumber) %>%
mutate(a_row = rownumber - as.integer(anchor['rownumber'])) %>%
select(a_row) %>%
filter(a_row > 0)
excel <- read.xlsx(input$file1$datapath,
sheetName = sheet,
startRow = as.integer(anchor['rownumber']))[c('Item', 'Description', 'Unit', 'Qty', 'Rate')]
#View(excel)
excel[,"Type"] <- NA #new column type
excel[bold_rows$a_row, "Type"] <- "BOLD"
a = excel[rowSums(is.na(excel)) != ncol(excel), ]#removing empty rows(Na)remove na after bold
a=a[- grep("Carried", a$Qty),] #removing rows having carried to...
a=a[is.na(as.numeric(a$Unit)),] #replacing rows by NA where unit is numeric
a=a[- grep("Brought forward from", a$Description),]#removing rows having brought forward
e=a[- grep("Collection for", a$Description),]#removing rows having collection
e[,"IsItem"] <- FALSE #new column IsItem
e[,"IsPreamble"] <- FALSE
e[grep("Preambles",e$Description,ignore.case = TRUE),"IsPreamble"]<- TRUE
for (i in 1:length(e$Item)) {
if(!is.na(e$Description[i]) && !is.na(e$Item[i]) && !is.na(e$Rate[i])&&
!is.na(e$Unit[i])&& !is.na(e$Qty[i])){
e$IsItem[i] <- TRUE
}
if(e$IsPreamble[i] == TRUE && !is.na(e$Type[i])){
e$IsPreamble[i] <- TRUE
}else{
e$IsPreamble[i] <- FALSE
}
}
v<-read.xlsx("~/Section/allSection.xlsx",
sheetName = "Sheet1")
e[,"IsSection"] <- FALSE #new column IsSection
pattern <- paste0(trimws(v$Item),collapse = '|')#trim with whitespace and concatenate vector after converting to vector
e[grepl(pattern,e$Description,ignore.case = TRUE),"IsSection"]<- TRUE
e[,"IsTitle"] <- FALSE
e[,"IsInstruction"] <- FALSE
for (i in 1:length(e$Description)) {
if(e$IsSection[i] == TRUE && !is.na(e$Type[i])){
e$IsSection[i] <- TRUE
}else{
e$IsSection[i] <- FALSE
}
if(!is.na(e$Description[i]) && is.na(e$Unit[i]) && is.na(e$Qty[i]) &&
is.na(e$Rate[i]) && !is.na(e$Type[i]) && e$IsItem[i] == 'FALSE' && e$IsPreamble[i] == 'FALSE'
&& e$IsSection[i] == 'FALSE'){
e$IsTitle[i] <- TRUE
}
if(!is.na(e$Description[i]) && is.na(e$Unit[i]) && is.na(e$Qty[i]) &&
is.na(e$Rate[i]) && is.na(e$Type[i]) && e$IsItem[i] == 'FALSE' && e$IsPreamble[i] == 'FALSE'
&& e$IsSection[i] == 'FALSE' && e$IsTitle[i] == 'FALSE'){
e$IsInstruction[i] <- TRUE
}
}
e[, "Sheet_Name"] <- sheet
z = rbind(z, e)
gc(verbose = F)
}
df = subset(z, select = -c(Item, IsPreamble))
}
output$tbl <- renderTable({
if(input$disp == "head"){
return(head(as.data.frame(df)))
}else{
return(as.data.frame(df))
}
})
controlVar$fileReady <- T
})
output$buttonUI <- renderUI({
if(controlVar$fileReady)
div(
dateInput('date', 'Select when the file was created',
value = NULL,
format = 'yyyy-mm-dd'),
textInput('x', 'Enter the project name here' , ""),
textInput('y', 'Enter the supplier name here' , ""),
actionButton("submit","Submit")
#actionButton('add', 'Add to BoQ')
)
})
df1 <- data.frame()
total <- length(df)
observeEvent(input$submit, {
controlVar$tableReady <- F
req(input$x)
req(input$y)
if(!is.null(input$x) | !is.null(input$y)){
for(i in 1:total){
df[, "projectName"] <- input$x
df[, "Suppliername"] <- input$y
df1 <- rbind(df1, df)
}
df1
}
Sys.sleep(2)
controlVar$tableReady <- T
})
output$tbl <- renderTable({
input$submit
if(controlVar$fileReady || controlVar$tableReady){
df1
}
})
}
)
shinyApp(ui, server)
我有一个错误
警告：<-中的错误：“闭包”类型的对象不是子集
任何帮助都会很好。提前致谢。