Error: Problem with `mutate()` column in R-CodePudding

This question is very similar to this one Error in UseMethod("select") : no applicable method for 'select' applied to an object of class "character", what is different is a few things in the return_coef function and it's also that I'm filtering the function by Id, date and Category, and in the answered question, it was just by date and Category.

You will see below that I can generate the coefficients for each Id/date/Category, but when I ask to do it for everyone at once, I get the following error:

Error: Problem with `mutate()` column `coef`.
i `coef = mapply(...)`.
x negative length vectors are not allowed

Executable code:

library(dplyr)
library(tidyverse)
library(lubridate)
library(data.table)


df1<- structure(
  list(
    Id = c(1, 1, 1, 1),
    date1 = c("2022-01-06","2022-01-06","2022-01-06","2022-01-06"),
    date2 = c("2022-01-02","2022-01-03","2022-01-09","2022-01-10"),
    Week = c("Sunday","Monday","Sunday","Monday"),
    Category = c("EFG", "ABC","EFG","ABC"),
    DR1 = c(200, 300, 200, 200),
    DRM01 = c(300, 300, 300, 300),
    DRM02 = c(300, 300, 300, 300),
    DRM03 = c(300,300,300,300),
    DRM04 = c(300,300,300,300),
    DRM05 = c(300,250,350,350)),row.names = c(NA, 4L), class = "data.frame")

return_coef <- function (df1, idd, dmda, CategoryChosse) {
  
  selection = startsWith(names(df1), "DRM0")
  
  df1[selection][is.na(df1[selection])] = 0
  
  data1<-subset(df1,df1$date2<df1$date1)
  
  dt1 <- as.data.table(data1)
  
  cols <- grep("^DRM0", colnames(dt1), value = TRUE)
  
  med <- 
    dt1[, (paste0(cols, "_PV")) := DR1 - .SD, .SDcols = cols
    ][, lapply(.SD, median), by = .(Id, Category, Week), .SDcols = paste0(cols, "_PV") ]
  
  SPV<-df1%>%
    inner_join(med, by = c('Id','Category', 'Week')) %>%
    mutate(across(matches("^DRM0\\d $"), ~.x   
                    get(paste0(cur_column(), '_PV')),
                  .names = '{col}_{col}_PV')) %>%
    select(Id:Category, DRM01_DRM01_PV:last_col())%>%
    data.frame()

  mat1 <- df1 %>%
    dplyr::filter(Id==idd, date2 == ymd(dmda), Category == CategoryChosse) %>%
    select(starts_with("DRM0")) %>%
    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("DRM0", names(SPV))) == 0) {
    SPV[head(mat1,10)] <- NA_real_
  }
  
  datas <-SPV %>%
    dplyr::filter(Id==idd,date2 == ymd(dmda)) %>%
    group_by(Category) %>%
    dplyr::summarize(dplyr::across(starts_with("DRM0"), sum)) %>%
    pivot_longer(cols= -Category, names_pattern = "DRM0(. )", 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((as.Date(dmda) - min(as.Date(df1$date1) [
      df1$Category == first(Category)])):max(days) 1) %>%
    ungroup
  
  m<-df1 %>%
    group_by(Id,Category,Week) %>%
    dplyr::summarize(dplyr::across(starts_with("DR1"), mean), .groups = 'drop')
  
  m<-subset(m, Week == df1$Week[match(ymd(dmda), ymd(df1$date2))] & Category == CategoryChosse)$DR1
  
  if (nrow(datas)<=2){
    val<-as.numeric(m)
  }
  
  else{
    mod <- nls(numbers ~ b1*days^2 b2,start = list(b1 = 0,b2 = 0),data = datas, algorithm = "port")
    coef<-coef(mod)[2]
    val<-as.numeric(coef(mod)[2])
  }
  
  
  return(val)
  
}

Find the coef one by one (It works):

return_coef(df1,"1","2022-01-09","EFG")
[1] 200
return_coef(df1,"1","2022-01-10","ABC")
[1] 250

Find all coef at once (Does not work)

subset_df1 <- subset(df1, date2 > date1)

All<-subset_df1%>%
  transmute(
    Id,date2,Category,
    coef = mapply(return_coef, list(cur_data()), Id, as.Date(date2), Category))

Error: Problem with `mutate()` column `coef`.
i `coef = mapply(...)`.
x negative length vectors are not allowed

CodePudding user response：

The function seems to be use df1 as the full data

library(dplyr)
subset_df1 %>%
   rowwise %>%
   mutate(coef = return_coef(df1, Id, date2, Category)) %>%
   ungroup

-output

# A tibble: 2 × 12
     Id date1      date2      Week   Category   DR1 DRM01 DRM02 DRM03 DRM04 DRM05   coef
  <dbl> <chr>      <chr>      <chr>  <chr>    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1     1 2022-01-06 2022-01-09 Sunday EFG        200   300   300   300   300   350   200
2     1 2022-01-06 2022-01-10 Monday ABC        200   300   300   300   300   350   250

Or using pmap

library(purrr)
subset_df1  %>% 
 transmute(Id, date2, Category, 
  coeff = pmap_dbl(across(c(Id, date2, Category)),
    ~ return_coef(df1, ..1, ..2, ..3)))

-output

   Id      date2 Category coeff
3  1 2022-01-09      EFG   200
4  1 2022-01-10      ABC   250