How can I provide a single double and not a double vector in my code

Viewed 147

I have some code that utilizes pmap_dbl to calculate some splits. I have created an unweighted version and a weighted version. The unweighted version runs as expected and produces the desired output.

The weighted version utilizes my getRwt function (recency weight) and attempts to apply the calculated weight to split calculation. This version is throwing the following error:

Error: Problem with `mutate()` input `splt_1a`. x Result 1 must be a single double, not a double vector of length 4 i Input `splt_1a` is `pmap_dbl(...)`.

I believe this error is telling me instead of providing my function an individual race_date I'm providing a race_date column. Unfortunately, I can't figure out how to provide the individual date. The race_date the function is looking fore is the race date of the current row.

Here is a reprex of my tibble, function and code.

library(tidyverse)
library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#> 
#>     date, intersect, setdiff, union

df <- tibble(name=c("Bill","Bill","Bill","Bill"), n=c(1,2,3,4), trk=c("GP","GP","SA","GP"), TE=c(2,4,0,1), race_date=c("11/1/2020", "12/31/2020","2/28/2021","4/7/2021"))

df
#> # A tibble: 4 x 5
#>   name      n trk      TE race_date 
#>   <chr> <dbl> <chr> <dbl> <chr>     
#> 1 Bill      1 GP        2 11/1/2020 
#> 2 Bill      2 GP        4 12/31/2020
#> 3 Bill      3 SA        0 2/28/2021 
#> 4 Bill      4 GP        1 4/7/2021

getRwt <- function(a, b){
  interval <- interval(a, b)
  d <- round(time_length(interval, "day"))
  t <- if_else(d < 366,d/7, d/5) /290
  rwt <- exp(1)^-t
  return(rwt)
}

# Unweighted Version

df %>% 
  mutate(splt_1 = pmap_dbl(list(trk, n),  ~ sum(if_else(trk == ..1 & ..2 > n, TE, as.numeric(0))))) 
#> # A tibble: 4 x 6
#>   name      n trk      TE race_date  splt_1
#>   <chr> <dbl> <chr> <dbl> <chr>       <dbl>
#> 1 Bill      1 GP        2 11/1/2020       0
#> 2 Bill      2 GP        4 12/31/2020      2
#> 3 Bill      3 SA        0 2/28/2021       0
#> 4 Bill      4 GP        1 4/7/2021        6

# Recency Weighted Version

df %>% 
  mutate(splt_1a = pmap_dbl(list(trk, n, race_date),  ~ sum(if_else(trk == ..1 & ..2 > n, TE, as.numeric(0))) * getRwt(race_date, ..3)))

#> Error: Problem with `mutate()` input `splt_1a`.
#> x Result 1 must be a single double, not a double vector of length 4
#> i Input `splt_1a` is `pmap_dbl(...)`.

Created on 2021-04-14 by the reprex package (v0.3.0)

1 Answers

Problem solved thanks to a great collaboration

You have to change the column type of race_date to Date:

library(dplyr)
library(tidyr)
library(purrr)
library(lubridate)

df %>% 
  mutate(race_date = mdy(race_date), 
         splt_1a = pmap_dbl(list(trk, n, race_date),  ~ sum(if_else(trk == ..1 & ..2 > n, TE * getRwt(race_date, ..3), as.numeric(0))))) %>%
  unnest_wider(splt_1a) 

# A tibble: 4 x 6
  name      n trk      TE race_date   ...1
  <chr> <dbl> <chr> <dbl> <date>     <dbl>
1 Bill      1 GP        2 2020-11-01  0   
2 Bill      2 GP        4 2020-12-31  1.94
3 Bill      3 SA        0 2021-02-28  0   
4 Bill      4 GP        1 2021-04-07  5.66

Related