Reputation: 1111
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
dput(head(df1))
structure(list(Id = c(1, 1, 1, 1), date1 = structure(c(1641427200,
1641427200, 1641427200, 1641427200), tzone = "UTC", class = c("POSIXct",
"POSIXt")), date2 = structure(c(1641081600, 1641168000, 1641686400,
1641772800), tzone = "UTC", class = c("POSIXct", "POSIXt")),
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 = c("tbl_df",
"tbl", "data.frame"))
Upvotes: 1
Views: 5345
Reputation: 887951
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
In the new dataset, the columns 'date1', 'date2' are POSIXct, convert to Date
class and it should work
df2 <- df1 %>%
mutate(across(c(date1, date2), as.Date))
subset_df2 <- subset(df2, date2 > date1)
subset_df2 %>%
rowwise %>%
mutate(coef = return_coef(df2, Id, date2, Category)) %>%
ungroup
# A tibble: 2 × 12
Id date1 date2 Week Category DR1 DRM01 DRM02 DRM03 DRM04 DRM05 coef
<dbl> <date> <date> <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
Upvotes: 2