I'm not able to generate the output table in shiny, and if I do it only through the function I can. When I try to generate from shiny, I get the following error: NA/NaN argument. What am I doing wrong?
library(shiny)
library(shinythemes)
library(dplyr)
library(tidyverse)
library(lubridate)
df1 <- structure(
list(
Id = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1),
date1 = c(
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC",
"2022-01-12 00:00:00 UTC"
),
date2 = c(
"2022-01-05 00:00:00 UTC",
"2022-01-05 00:00:00 UTC",
"2022-01-06 00:00:00 UTC",
"2022-01-06 00:00:00 UTC",
"2022-01-07 00:00:00 UTC",
"2022-01-07 00:00:00 UTC",
"2022-01-08 00:00:00 UTC",
"2022-01-08 00:00:00 UTC",
"2022-01-09 00:00:00 UTC",
"2022-01-09 00:00:00 UTC",
"2022-01-10 00:00:00 UTC",
"2022-01-10 00:00:00 UTC",
"2022-01-11 00:00:00 UTC",
"2022-01-11 00:00:00 UTC",
"2022-01-12 00:00:00 UTC"
),
Week = c(
"Wednesday",
"Wednesday",
"Thursday",
"Thursday",
"Friday",
"Friday",
"Saturday",
"Saturday",
"Sunday",
"Sunday",
"Monday",
"Monday",
"Tuesday",
"Tuesday",
"Wednesday"
),
Category = c(
"ABC",
"EFG",
"ABC",
"EFG",
"ABC",
"EFG",
"ABC",
"EFG",
"ABC",
"EFG",
"ABC",
"EFG",
"ABC",
"EFG",
"ABC"
),
DR1 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0),
DRM0 = c(300, 300, 300, 300, 300, 300, 300, 300, 300,
300, 300, 300, 300, 300, 0),
DRM01 = c(300, 300, 300, 300, 300,
300, 300, 300, 300, 300, 300, 300, 300, 300, 0),
DRM02 = c(
300,
300,
300,
300,
300,
300,
300,
300,
300,
300,
300,
300,
300,
300,
300
),
DRM03 = c(
300,
300,
300,
300,
300,
300,
300,
300,
300,
300,
300,
300,
300,
300,
300
),
DRM04 = c(
300,
250,
250,
250,
250,
250,
250,
250,
250,
250,
300,
300,
300,
300,
300
)
),
row.names = c(NA,-15L),
class = c("tbl_df", "tbl", "data.frame")
)
return_coef <- function(df1, idd,dmda, CategoryChosse, var1, var2, graf=1) {
x<-df1 %>% select(starts_with("DRM"))
x<-cbind(df1, setNames(df1$DR1 - x, paste0(names(x), "_PV")))
PV<-select(x,Id, date2,Week, Category, DR1, ends_with("PV"))
med<-PV %>%
group_by(Id,Category,Week) %>%
dplyr::summarize(dplyr::across(ends_with("PV"), median),.groups = 'drop')
SPV<-df1%>%
inner_join(med, by = c('Id','Category', 'Week')) %>%
mutate(across(matches("^DRM\\d+$"), ~.x +
get(paste0(cur_column(), '_PV')),
.names = '{col}_{col}_PV')) %>%
select(Id:Category, DRM0_DRM0_PV:last_col())
SPV<-data.frame(SPV)
mat1 <- df1 %>%
dplyr::filter(Id==idd,date2 == ymd(dmda), Category == CategoryChosse) %>%
select(starts_with("DRM")) %>%
pivot_longer(cols = everything()) %>%
arrange(desc(row_number())) %>%
mutate(cs = cumsum(value)) %>%
dplyr::filter(cs == 0) %>%
pull(name)
(dropnames <- paste0(mat1,"_",mat1, "_PV"))
SPV <- SPV %>%
filter(Id==idd,date2 == ymd(dmda), Category == CategoryChosse) %>%
select(-any_of(dropnames))
if(length(grep("DRM", names(SPV))) == 0) {
SPV[head(mat1,20)] <- NA_real_
}
datas <-SPV %>%
filter(Id==idd,date2 == ymd(dmda)) %>%
group_by(Category) %>%
summarize(across(starts_with("DRM"), sum),.groups = 'drop') %>%
pivot_longer(cols= -Category, names_pattern = "DRM(.+)", values_to = "val") %>%
mutate(name = readr::parse_number(name))
colnames(datas)[-1]<-c(var1,var2)
datas$days <- datas[[as.name(var1)]]
datas$numbers <- datas[[as.name(var2)]]
datas <- datas %>%
group_by(Category) %>%
slice((ymd(dmda) - min(as.Date(df1$date1) [
df1$Category == first(Category)])):max(days)+1) %>%
ungroup
mod <- lm(numbers ~ I(days^2), datas)
coef<-coef(mod)[1]
val<-as.numeric(coef(mod)[1])
}
return(val)
}
ui <- fluidPage(
shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
br(),
tabPanel("PAGE1",
sidebarLayout(
sidebarPanel(
uiOutput('daterange')
),
mainPanel(
dataTableOutput('table')
)))))
server <- function(input, output) {
data<-reactive(df1)
output$daterange <- renderUI({
req(data())
dateRangeInput("daterange1", "Period you want to see:",
min = min(data()$date1),
max = max(data()$date2),
format = "dd-mm-yyyy")
})
data_subset <- reactive({
req(input$daterange1)
req(input$daterange1[1] <= input$daterange1[2])
var1 = "Days"
var2 = "Numbers"
days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
df1<-subset(data(), as.Date(date2) %in% days)
Datas <- subset(df1, date2 >= date1)
df2 <- Datas %>% select(Id,date2,Category)
All <- cbind(df2, coef = apply(df2, 1, function(x) {return_coef(data(),x[1],x[2],x[3],var1,var2)}))
})
output$table <- renderDataTable({
data_subset()
})
}
shinyApp(ui = ui, server = server)
If I do return_coef(df1, "1","2022-01-12","ABC", var1=0,var2=1), I get:
[1] -116.8966
This value would have to be shown in shiny.