The code below generates a table from the start and end dates that I select in my daterange
, it works fine as you can see, if you test. The only thing I would like to do is that instead of defining the database in my code, I would like just use fileInput
. In other words, I have a database df1
in excel, and I would like to use fileInput
to load this database and so the code will be executed. I even insert more or less the code for this, but it didn't work well, so I left it in #
. So can you help me run the code just using fileInput
and so don't leave my database defined in the code? Can you please help me?
Thanks in advance!
library(shiny)
library(shinythemes)
library(dplyr)
library(writexl)
library(tidyverse)
library(lubridate)
function.test<-function(){
df1 <- structure(
list(date1= c("2021-06-28","2021-06-28","2021-06-28"),
date2 = c("2021-07-01","2021-07-02","2021-07-03"),
Category = c("ABC","CDE","FGH"),
Week= c("Wednesday","Thursday","Friday"),
DR1 = c(4,1,4),
DR01 = c(4,1,3), DR02= c(4,2,0),DR03= c(9,5,0),
DR04 = c(5,4,0),DR05 = c(5,4,3),DR06 = c(5,4,0),DR07 = c(5,4,0),DR08 = c(5,4,0)),
class = "data.frame", row.names = c(NA, -3L))
return(df1)
}
return_coef <- function(df1, dmda, CategoryChosse) {
x<-df1 %>% select(starts_with("DR0"))
x<-cbind(df1, setNames(df1$DR1 - x, paste0(names(x), "_PV")))
PV<-select(x, date2,Week, Category, DR1, ends_with("PV"))
med<-PV %>%
group_by(Category,Week) %>%
summarize(across(ends_with("PV"), median))
SPV<-df1%>%
inner_join(med, by = c('Category', 'Week')) %>%
mutate(across(matches("^DR0\\d+$"), ~.x +
get(paste0(cur_column(), '_PV')),
.names = '{col}_{col}_PV')) %>%
select(date1:Category, DR01_DR01_PV:last_col())
SPV<-data.frame(SPV)
mat1 <- df1 %>%
filter(date2 == dmda, Category == CategoryChosse) %>%
select(starts_with("DR0")) %>%
pivot_longer(cols = everything()) %>%
arrange(desc(row_number())) %>%
mutate(cs = cumsum(value)) %>%
filter(cs == 0) %>%
pull(name)
(dropnames <- paste0(mat1,"_",mat1, "_PV"))
SPV <- SPV %>%
filter(date2 == dmda, Category == CategoryChosse) %>%
select(-any_of(dropnames))
if(length(grep("DR0", names(SPV))) == 0) {
SPV[head(mat1,10)] <- NA_real_
}
datas <-SPV %>%
filter(date2 == ymd(dmda)) %>%
group_by(Category) %>%
summarize(across(starts_with("DR0"), sum)) %>%
pivot_longer(cols= -Category, names_pattern = "DR0(.+)", values_to = "val") %>%
mutate(name = readr::parse_number(name))
colnames(datas)[-1]<-c("Days","Numbers")
datas <- datas %>%
group_by(Category) %>%
slice((as.Date(dmda) - min(as.Date(df1$date1) [
df1$Category == first(Category)])):max(Days)+1) %>%
ungroup
m<-df1 %>%
group_by(Category,Week) %>%
summarize(across(starts_with("DR1"), mean))
m<-subset(m, Week == df1$Week[match(ymd(dmda), ymd(df1$date2))] & Category == CategoryChosse)$DR1
if (nrow(datas)<=2){
return (as.numeric(m))
}
else if(any(table(datas$Numbers) >= 3) & length(unique(datas$Numbers)) == 1){
yz <- unique(datas$Numbers)
return(as.numeric(yz))
}
else{
mod <- nls(Numbers ~ b1*Days^2+b2,start = list(b1 = 0,b2 = 0),data = datas, algorithm = "port")
return(as.numeric(coef(mod)[2]))
}
}
ui <- fluidPage(
shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
br(),
tabPanel("",
sidebarLayout(
sidebarPanel(
#uiOutput('fileInput')
uiOutput('daterange')
),
mainPanel(
dataTableOutput('table')
)
))
))
server <- function(input, output,session) {
data <- reactive(function.test())
#data <- eventReactive(input$file, {
# if (is.null(input$file)) {
# return(NULL)
# }
#else {
# ext <- tools::file_ext(input$file$datapath)
# validate(need(ext == "xlsx", "Incorrect file"))
# if(ext == "xlsx") {
# df3 <- read_excel(input$file$datapath)
# validate(need(all(c('date1', 'date2') %in% colnames(df3)), "Incorrect file"))
# return(df3)
# }
#}
# })
#output$fileInput <- renderUI({
# fileInput("file",h4(tags$span("Import file"),
# tags$span(icon("info-circle"), id = "icon1", style = "color: grey")),
# multiple = T,accept = ".xlsx",
# placeholder = "No file selected")
#})
data_subset <- reactive({
req(input$daterange1)
req(input$daterange1[1] <= input$daterange1[2])
days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
showModal(modalDialog("Wait", footer=NULL))
on.exit(removeModal())
df1 <- subset(data(), as.Date(date2) %in% days)
df2 <- df1 %>% select(date2,Category)
Test <- cbind(df2, coef = apply(df2, 1, function(x) {return_coef(df1,x[1],x[2])}))
Test
})
output$daterange <- renderUI({
dateRangeInput("daterange1", "Period you want to see:",
min = min(data()$date2),
max = max(data()$date2))
})
output$table <- renderDataTable({
data_subset()
})
}
shinyApp(ui = ui, server = server)