问题描述
我使用 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,"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","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",]#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,"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)
我遇到了错误
警告：
任何帮助都会很好。提前致谢。
解决方法
暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！
如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。
小编邮箱:dio#foxmail.com (将#修改为@）