Pimer comit funcional
This commit is contained in:
@@ -0,0 +1,94 @@
|
||||
library(shiny)
|
||||
library(readxl)
|
||||
library(DT)
|
||||
library(dplyr)
|
||||
|
||||
# Define UI for application
|
||||
ui <- fluidPage(
|
||||
navbarPage("Nitrogen CIT",
|
||||
tabPanel("Listado",
|
||||
sidebarPanel(
|
||||
fileInput(inputId = "file", label = "Fichero", multiple = F)
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
DTOutput("DT")
|
||||
)
|
||||
),
|
||||
tabPanel("Caja",
|
||||
sidebarPanel(
|
||||
selectInput(inputId = "test", "", choices = ""),
|
||||
uiOutput(outputId = "caja_out")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tableOutput("DT_caja")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# Define server logic required
|
||||
server <- function(input, output) {
|
||||
dades<-reactiveValues()
|
||||
dades$taula<-NULL
|
||||
|
||||
## Listado ----
|
||||
|
||||
observe({
|
||||
req(input$file)
|
||||
df.list<-lapply(excel_sheets(input$file$datapath), read_xlsx, path=input$file$datapath, range="B1:K31", col_type="text")
|
||||
names(df.list)<-excel_sheets(input$file$datapath)
|
||||
name.row<-seq(from=1, to=nrow(df.list[[1]]), by=3)
|
||||
date.row<-seq(from=2, to=nrow(df.list[[1]]), by=3)
|
||||
desc.row<-seq(from=3, to=nrow(df.list[[1]]), by=3)
|
||||
for (i in 1:length(df.list)){
|
||||
df.list[[i]]<-data.frame(
|
||||
Tanque=gsub("-[0-9]* #[0-9]*$","",names(df.list)[i]),
|
||||
Rack=gsub("^[A-Z]-| #[0-9]*$","",names(df.list)[i]),
|
||||
Caja=names(df.list)[i],
|
||||
Fila=rep(LETTERS[1:10], 10),
|
||||
Columna=factor(as.character(rep(1:10, each=10)),levels=as.character(1:10)),
|
||||
Nombre=unlist(df.list[[i]][name.row,]),
|
||||
Fecha=unlist(df.list[[i]][date.row,]),
|
||||
Descripción=unlist(df.list[[i]][desc.row,])
|
||||
)
|
||||
}
|
||||
df<-do.call(rbind, df.list)
|
||||
df[grepl("^[0-9]*$", df$Fecha),"Fecha"]<-as.character(as.Date(as.numeric(df[grepl("^[0-9]*$", df$Fecha),"Fecha"]), origin = "1899-12-30"))
|
||||
for (i in c("Tanque", "Rack","Caja","Fila")){
|
||||
df[,i]<-factor(df[,i])
|
||||
}
|
||||
dades$taula<-df
|
||||
})
|
||||
|
||||
output$DT <- renderDT({
|
||||
req(dades$taula)
|
||||
datatable(dades$taula, filter = "top", rownames = F, escape = F, extensions='Buttons',options = list(autoWidth=TRUE, dom = 'Bfrtip',buttons=I('colvis'), lengthMenu=c(10,20,50), pageLength=30))
|
||||
})
|
||||
|
||||
## Caja ----
|
||||
|
||||
output$caja_out<-renderUI({
|
||||
observeEvent(dades$taula, {})
|
||||
selectInput(inputId = "caja", "Caja", choices = unique(dades$taula$Caja))
|
||||
})
|
||||
|
||||
output$DT_caja <- renderTable({
|
||||
req(dades$taula)
|
||||
caja_l<-dades$taula[dades$taula$Caja == input$caja,]
|
||||
caja_l$Nombre[is.na(caja_l$Nombre)]<-""
|
||||
caja_l$Fecha[is.na(caja_l$Fecha)]<-""
|
||||
caja_l$Descripción[is.na(caja_l$Descripción)]<-""
|
||||
caja<-as.data.frame(matrix(data= paste(caja_l$Nombre, caja_l$Fecha, caja_l$Descripción, sep="<br>"),
|
||||
ncol = 10, nrow=10))
|
||||
colnames(caja)<-as.character(1:10)
|
||||
rownames(caja)<-LETTERS[1:10]
|
||||
|
||||
caja
|
||||
}, rownames = TRUE, sanitize.text.function=identity, bordered = TRUE)
|
||||
|
||||
}
|
||||
|
||||
# Run the application
|
||||
shinyApp(ui = ui, server = server)
|
||||
Reference in New Issue
Block a user