How to run shiny code through fileInput only

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 df1in 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)

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.