Could you help me tweak the second code below. The first code works normally. In the first I use a database called Test and it does exactly what I want. In the second code notice that I have a df1 database, a function and then it generates a Test database. The result generated by this Test datbase of the second code is exactly the same as the Test database of the first code, the difference is that in the first I am specifying the values of the Test and in the other I use a function to generate. However, in the second code when I run shiny it doesn't show the results, like in the first code, I'd like to adjust that.
First code
library(shiny)
library(shinythemes)
library(dplyr)
library(writexl)
library(tidyverse)
library(lubridate)
Test <- structure(list(date2 = structure(c(18808, 18808, 18809, 18810
), class = "Date"), Category = c("FDE", "ABC", "FDE", "ABC"),
coef = c(4, 1, 6, 1)), row.names = c(NA, 4L), class = "data.frame")
ui <- fluidPage(
shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
br(),
tabPanel("",
sidebarLayout(
sidebarPanel(
uiOutput('daterange'),
br()
),
mainPanel(
dataTableOutput('table'),
br(), br(),
downloadButton("dl", "Download")
),
))
))
server <- function(input, output,session) {
data <- reactive(Test)
data_subset <- reactive({
req(input$daterange1)
days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
subset(data(), date2 %in% days)
})
output$daterange <- renderUI({
dateRangeInput("daterange1", "Period you want to see:",
start = min(data()$date2),
end = max(data()$date2))
})
output$table <- renderDataTable({
data_subset()
})
output$dl <- downloadHandler(
filename = function() { "data.xlsx"},
content = function(file) {
writexl::write_xlsx(data_subset(), path = file)
}
)
}
shinyApp(ui = ui, server = server)
Second code
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","2021-06-28"),
date2 = c("2021-06-30","2021-06-30","2021-07-01","2021-07-02"),
Category = c("FDE","ABC","FDE","ABC"),
Week= c("Wednesday","Wednesday","Friday","Friday"),
DR1 = c(4,1,6,1),
DR01 = c(4,1,4,4), DR02= c(4,2,6,0),DR03= c(9,5,4,0),
DR04 = c(5,4,3,5),DR05 = c(5,4,5,0),
DR06 = c(2,4,3,5),DR07 = c(2,5,4,0),
DR08 = c(3,4,5,0),DR09 = c(2,3,4,0)),
class = "data.frame", row.names = c(NA, -4L))
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))
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
mod <- nls(Numbers ~ b1*Days^2+b2,start = list(b1 = 0,b2 = 0),data = datas, algorithm = "port")
as.numeric(coef(mod)[2])
Test<-cbind(df1 %>% select(date2,Category), coef = mapply(return_coef, df1$date2, df1$Category))
}
ui <- fluidPage(
shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
br(),
tabPanel("",
sidebarLayout(
sidebarPanel(
uiOutput('daterange'),
br()
),
mainPanel(
dataTableOutput('table'),
br(), br(),
downloadButton("dl", "Download")
),
))
))
server <- function(input, output,session) {
data <- reactive(function.test())
data_subset <- reactive({
req(input$daterange1)
days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
subset(data(), date2 %in% days)
})
output$daterange <- renderUI({
dateRangeInput("daterange1", "Period you want to see:",
start = min(data()$date2),
end = max(data()$date2))
})
output$table <- renderDataTable({
data_subset()
})
output$dl <- downloadHandler(
filename = function() { "data.xlsx"},
content = function(file) {
writexl::write_xlsx(data_subset(), path = file)
}
)
}
shinyApp(ui = ui, server = server)
