How to solve Error: NA/NaN argument in a shiny code

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.

Maybe you need req(data_subset()) in output$table as well.

When shiny starts, all variables tend to have a NULL value, which can cause this kind of crash at startup.

Thanks for the answer @woodward . I tried what you mentioned, but unfortunately it didn't work. Thank you anyway. =)

So df2 is this. Then it's crashing in the apply() function. Does that look right? I think your return_coeff function isn't working.

# A tibble: 1 x 3
     Id date2                   Category
  <dbl> <chr>                   <chr>   
1     1 2022-01-12 00:00:00 UTC ABC

Thanks for the answer @woodward ! I found the error now, I was missing inserting as.Date in x[2], because it is data, so: All <- cbind(df2, coef = apply(df2, 1, function(x) {return_coef(data(), x[1],as.Date(x[2]),x[3],var1,var2)})). That way it works! =))

1 Like